Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   Delphi MessageDlg schliessen durch X Button verhindern (https://www.delphipraxis.net/110092-messagedlg-schliessen-durch-x-button-verhindern.html)

nachtstreuner60 12. Mär 2008 20:18


MessageDlg schliessen durch X Button verhindern
 
Einen wunderschönen Abend zusammen,

vielleicht kann mir bei meinem Problemchen jemand weiterhelfen.

Ich möchte verhindern, das ein MessageDlg-Fenster durch den Schliessen-Button(rechts oben) geschlossen werden kann, nur durch
anklicken des OK-Buttons soll dies möglich sein.

Wie gehe ich hier am besten vor ?


mfg
nachtstreuner60

bitsetter 12. Mär 2008 21:17

Re: MessageDlg schliessen durch X Button verhindern
 
Hallo,

eine Möglichkeit wäre:
Delphi-Quellcode:
function MessageDlgEx(Msg: AnsiString; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
var
  hMenu : THandle;
begin
  with CreateMessageDialog(Msg, DlgType, Buttons) do
  try
  hMenu := GetSystemMenu(Handle, False);
  if hMenu <> 0 then
    EnableMenuItem(hMenu, SC_CLOSE, MF_BYCOMMAND or MF_GRAYED);
    Result := ShowModal;
  finally
    Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  MessageDlgEx('Test', mtConfirmation, mbYesNoCancel, 0);
end;
EDIT: Oder einfach die Eigenschaft BorderIcons abändern:
Delphi-Quellcode:
function MessageDlgEx(Msg: AnsiString; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
begin
  with CreateMessageDialog(Msg, DlgType, Buttons) do
  try
    borderIcons:= [];
    Result := ShowModal;
  finally
    Free;
  end;
end;

nachtstreuner60 12. Mär 2008 21:26

Re: MessageDlg schliessen durch X Button verhindern
 
Hallo bitsetter

vielen Dank für diesen Tip.

Ich habe vergessen, zu erwähnen, daß ich eine Komponente aus den freien LMD-Tools benutze, dort kann ich den MessageDLg
einfärben.

In Deinem Tip wird, wenn ich nicht falsch liege eine Eigener MessageDlg erzeugt.

Da ich nicht weiß, wie man einen MessageDLg einfärbt, habe ich auf diese Komponente zurückgegriffen.

Wie gehe ich nun dieses Problem an ?

Hier der Quellcode
Delphi-Quellcode:
IF lmdMessage.Execute('Unquittierte Datensätze gefunden !',' ACHTUNG !!! Es wurden noch '+
    'unquittierte Datensätze gefunden !'+#13#10+
    ' Diese sind älter als zwei Stunden und sollten schnellstmöglich quittiert'+#13#10+
    ' werden ! Diese Meldung erscheint alle '+IntToStr( dZyklus div 60000 ) +' min'+#10#13#10#13+
    ' Unten in der Fusszeile sehen Sie im gelben Balken einen weiteren Hinweis hierzu !'
    ,[0], [],-1,-1,-1,-1,0) = mrOK then begin
    sTEXT := 'MELDUNG an : '+dUSER+' über unquittierte Datensätze : Anz.: '+ inttostr(Anzahl)+' Sätze !';
    writelog;
    tZyklus.Enabled := true;
  end;
mfg
nachtstreuner60

DeddyH 12. Mär 2008 21:34

Re: MessageDlg schliessen durch X Button verhindern
 
Wenn der LMD-MessageDlg ein Handle hat (geh ich mal davon aus), müsstest Du es ja irgendwie ermitteln können. Danach ist es nur noch eine kleine Änderung in bitsetters Code, dann sollte es IMO gehen.

bitsetter 12. Mär 2008 21:53

Re: MessageDlg schliessen durch X Button verhindern
 
Zitat:

Zitat von nachtstreuner60
Da ich nicht weiß, wie man einen MessageDLg einfärbt, habe ich auf diese Komponente zurückgegriffen.

Falls du nur die Farbe ändern möchtest, dann ändere doch die Eigenschaft Color ab.
Delphi-Quellcode:
 
...
with CreateMessageDialog(Msg, DlgType, Buttons) do
  try
    Color:= clRed;
    borderIcons:= [];
...

nachtstreuner60 12. Mär 2008 21:57

Re: MessageDlg schliessen durch X Button verhindern
 
Halo deddyH

danke für den Tip !

Werd mich mal dran machen, das Handle rauszufinden.

Hab sowas zwar noch nie gemacht, aber ich denke mal, das ich hier in dem tollen Forum über die Suchfunktion was finden werde.
htstreuner60
mfg
nac

nachtstreuner60 12. Mär 2008 22:00

Re: MessageDlg schliessen durch X Button verhindern
 
Danke Bitsetter,

werde auch deinen nachträglichen TIP ausprobieren.

Echt fun, dieses Forum

Gruß nachtstreuner60


Alle Zeitangaben in WEZ +1. Es ist jetzt 08:02 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz