[delphi] - hoe sluit ik het programma goed?

[MisterE]

In mijn applicatie heb ik nu een TrayIcon aangemaakt.
Zodra de user op close ('x') drukt wil ik dat de app naar
de tray gaat. Dat ziet er dus zo uit:

private
(* intercept the minimize/close commands from the window
procedure WM_OnMinimize(var Msg : TWMSysCommand ); message WM_SYSCOMMAND;


procedure TForm1.WM_OnMinimize(var Msg: TWMSysCommand);
if (Msg.CmdType = SC_MINIMIZE) or
(Msg.CmdType = SC_CLOSE ) then
begin
Hide;
end;

Dit gaf als probleem dat de app zich nooit meer 'goed' afsloot
omdat dat altijd 'intercept' werd.
Nou heb ik het volgende:



procedure TForm1.WM_OnMinimize(var Msg: TWMSysCommand);
begin
if chk = false then
begin
if (Msg.CmdType = SC_MINIMIZE) or
(Msg.CmdType = SC_CLOSE ) then
begin
Hide;
end
end else
Form1.Close;
end;

Wanneer ik de applicatie echt wil laten sluiten zet ik de
variabele 'chk' op 'True'
Dit werkt wel prima, maar eigenlijk heb ik het idee dat
ie nou toch een loop maakt?
Hij voert de regel 'Form1.Close' uit, die word ondervangen, etc.

Of is een 'SC_CLOSE' iets anders dan een form.close?

[MisterE]

laat maar....
heb ff een paar testjes gedaan.

Die routine word niet aangeroepen met Form1.close.
Dus er kan een slotje op

Misschien dat iemand nog wat aan m'n voorbeeld heeft of een tip hoe dit op te lossen zonder een globale variabele

[MisterE]

Sorry wil hier toch ff op terugkomen, toch sluit mijn prog niet goed. Kan iemand zien waar het aan ligt??
Heb maar de hele unit toegevoegd
Ik dacht eerst dat het ligt omdat nog steeds die hook staat op de muis, maar wat ik ook probeer hij wil niet sluiten....


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, CheckLst
, ExtCtrls, IniFiles, JPEG, ComCtrls, CommCtrl, Menus, ExtDlgs, ImgList, ComObj, ShlObj
, ActiveX, ShellAPI, Spin;

const
WM_MYTRAYICONCALLBACK = WM_USER + 1000;

type
TForm1 = class(TForm)
popupTrayIcon: TPopupMenu;
trayShow: TMenuItem;
trayExit: TMenuItem;
btnOpenForm2: TButton;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure btnOpenForm2Click(Sender: TObject);
procedure trayShowClick(Sender: TObject);
procedure trayExitClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
(* Tray icon
MyTrayIcon: TNotifyIconData;
procedure WM_TrayIconCallback(var Msg:TMessage); message WM_MYTRAYICONCALLBACK;

(* intercept the minimize/close commands from the window
procedure WM_OnMinimize(var Msg : TWMSysCommand ); message WM_SYSCOMMAND;

procedure SetTrayIcon;
Procedure RemoveTrayIcon;
public
{ Public declarations }
end;

var
Form1: TForm1;
TrayEnabled : Boolean = True;

implementation

uses Unit2, uFileIO;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
SetTrayIcon;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
ReadIniSettings;

if form2.chkVisibleAtStartup.Checked then
Form1.Visible := True;
end;



procedure TForm1.SetTrayIcon;
(* adds a TrayIcon to the taskbar
begin
Visible := False;
Application.ShowMainForm := Visible;

MyTrayIcon.cbSize := SizeOf(TNotifyIconData);
MyTrayIcon.Wnd := Handle;
MyTrayIcon.uId := 1;
MyTrayIcon.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
MyTrayIcon.uCallBackMessage := WM_MYTRAYICONCALLBACK;
MyTrayIcon.hIcon := Application.Icon.Handle;
MyTrayIcon.szTip := 'LULLO';

Shell_NotifyIcon(NIM_ADD, @MyTrayIcon);
Application.ProcessMessages;
end;


procedure TForm1.WM_OnMinimize(var Msg: TWMSysCommand);
begin
ShowMessage('called');

begin

if (Msg.CmdType = SC_MINIMIZE) or
(Msg.CmdType = SC_CLOSE ) then
begin
Hide;
end

end
end;




procedure TForm1.WM_TrayIconCallback(var Msg:TMessage);
var
CursorPos : TPoint;
begin

if TrayEnabled then
begin
if Msg.Msg = WM_MYTRAYICONCALLBACK then
begin

Case Msg.lParam of
WM_RBUTTONDOWN:
begin
SetForegroundWindow(Handle);

GetCursorPos(CursorPos);
popupTrayIcon.Popup(CursorPos.X,CursorPos.Y);
PostMessage(Handle, WM_NULL, 0, 0);
end;
WM_LBUTTONDBLCLK:
begin
ShowMessage('left mouse click');
end;
End;

Application.ProcessMessages;
end;

end;
end;




Procedure TForm1.RemoveTrayIcon;
var
bRetVal : Boolean;
begin
bRetVal := Shell_NotifyIcon(NIM_DELETE, @MyTrayIcon);
if bRetVal = false then showMessage('Error');
Application.ProcessMessages;
end;



procedure TForm1.btnOpenForm2Click(Sender: TObject);
begin
Form2.Visible := True;
end;

procedure TForm1.trayShowClick(Sender: TObject);
begin
Form1.Visible := True;
end;

procedure TForm1.trayExitClick(Sender: TObject);
begin
TrayEnabled := False;
Form1.Close;
end;



procedure TForm1.FormDestroy(Sender: TObject);
begin
RemoveTrayIcon;
end;

end.

[brid]

maak eerst maar een gebruik van [ code] bla bla [ /code]
geeft een iets mooiere opmaak, of je moet met een brakke opmaak programma's maken.

code:

 if netjes then
   helpuser
 else
   niethelpen;

[chris]

als je nou Form1.FormCloseQuery neemt, dan moet je zeggen CanClose:=False en dan minimizen maar. En geef trouwens de gebruiker een vakje waarmee ie de sluitoptie kan uitzetten, want sommige mensen vinden het razend irritant. O ik vind hier net een stukje code, rechtstreeks gekopiejeerd dus je moet em nog ff aanpassen.

code:

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose:=False;
  Shell_NotifyIcon(NIM_ADD, @TrayIcon);
  Form1.WindowState:=wsMinimized;
  Application.ShowMainForm:=False;
  Form1.Hide;
end;

en dit is de code om 'm te laten zien:

code:

procedure TForm1.FormCreate(Sender: TObject);
begin
  TrayIcon.cbSize := SizeOf(TrayIcon);    { This is required }
  TrayIcon.Wnd := Self.Handle;          { The handle to your main window }
  TrayIcon.uId := 0;
  TrayIcon.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
  TrayIcon.uCallBackMessage := WM_MOUSEMOVE;  { The message the icon answers to }
  TrayIcon.hIcon := Self.Icon.Handle;      { The handle of the icon to display }
  TrayIcon.szTip := 'Scripter';     { The bubble help of the icon }
end;

en de code om 'm weg te halen:

code:

procedure TForm1.Exit1Click(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @TrayIcon);
Halt;
end;

en voor als er op het icoontje geklikt wordt:

code:

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var CursorPos: TPoint;
begin
case(X) of
517: begin
  GetCursorPos(CursorPos);               { Get the cursor position on screen }
  Self.PopupMenu.Popup(CursorPos.X, CursorPos.Y);  { Popup your TPopupMenu }
  PostMessage(Handle, WM_NULL, 0, 0);         { Post a WM_NULL message; this will make sure the menu closes when it loses focus }
end;
514: begin
  Form1.Show;
  Form1.WindowState:=wsNormal;
  SetForegroundWindow(Handle);             { Set the foreground window as your application }
end;
end;
end;

en tot slot de code om 'm weer weer te geven:

code:

procedure TForm1.Show1Click(Sender: TObject);
begin
Form1.Show;
Form1.WindowState:=wsNormal;
Application.ShowMainform:=True;
SetForegroundWindow(Handle); { Set the foreground window as your application }
end;

Misschien heb ik iets dubbel geplakt maarja kijk maar ff wat je er mee doet.

[MisterE]

extra dan voor 'Brid'

code:

unit Unit1;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, CheckLst
   , ExtCtrls, IniFiles, JPEG, ComCtrls, CommCtrl, Menus, ExtDlgs, ImgList, ComObj, ShlObj
  , ActiveX, ShellAPI, Spin;

const
  WM_MYTRAYICONCALLBACK = WM_USER + 1000;

type
  TForm1 = class(TForm)
    popupTrayIcon: TPopupMenu;
    trayShow: TMenuItem;
    trayExit: TMenuItem;
    btnOpenForm2: TButton;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure btnOpenForm2Click(Sender: TObject);
    procedure trayShowClick(Sender: TObject);
    procedure trayExitClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
     (* Tray icon *)
    MyTrayIcon: TNotifyIconData;
    procedure WM_TrayIconCallback(var Msg:TMessage); message WM_MYTRAYICONCALLBACK;

    (* intercept the minimize/close commands from the window *)
    procedure WM_OnMinimize(var Msg : TWMSysCommand ); message WM_SYSCOMMAND;

    procedure SetTrayIcon;
    Procedure RemoveTrayIcon;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  TrayEnabled : Boolean = True;

implementation

uses Unit2, uFileIO;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  SetTrayIcon;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  ReadIniSettings;

  if form2.chkVisibleAtStartup.Checked then
    Form1.Visible := True;
end;



procedure TForm1.SetTrayIcon;
(* adds a TrayIcon to the taskbar *)
begin
  Visible := False;
  Application.ShowMainForm := Visible;

  MyTrayIcon.cbSize := SizeOf(TNotifyIconData);
  MyTrayIcon.Wnd    := Handle;
  MyTrayIcon.uId    := 1;
  MyTrayIcon.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
  MyTrayIcon.uCallBackMessage := WM_MYTRAYICONCALLBACK;
  MyTrayIcon.hIcon  := Application.Icon.Handle;
  MyTrayIcon.szTip  := 'LULLO';

  Shell_NotifyIcon(NIM_ADD, @MyTrayIcon);
  Application.ProcessMessages;
end;


procedure TForm1.WM_OnMinimize(var Msg: TWMSysCommand);
begin
  ShowMessage('called');

  begin

  if (Msg.CmdType = SC_MINIMIZE) or
     (Msg.CmdType = SC_CLOSE   ) then
    begin
    Hide;
    end

  end
end;




procedure TForm1.WM_TrayIconCallback(var Msg:TMessage);
var
 CursorPos : TPoint;
begin

  if TrayEnabled then
  begin
    if Msg.Msg = WM_MYTRAYICONCALLBACK then
    begin

    Case Msg.lParam of
      WM_RBUTTONDOWN:
        begin
        SetForegroundWindow(Handle);

        GetCursorPos(CursorPos);
        popupTrayIcon.Popup(CursorPos.X,CursorPos.Y);
        PostMessage(Handle, WM_NULL, 0, 0);
        end;
      WM_LBUTTONDBLCLK:
        begin
        ShowMessage('left mouse click');
        end;
    End;

    Application.ProcessMessages;
    end;
    
  end;
end;




Procedure TForm1.RemoveTrayIcon;
var
  bRetVal : Boolean;
begin
  bRetVal := Shell_NotifyIcon(NIM_DELETE, @MyTrayIcon);
  if bRetVal = false then showMessage('Error');
  Application.ProcessMessages;
end;



procedure TForm1.btnOpenForm2Click(Sender: TObject);
begin
  Form2.Visible := True;
end;

procedure TForm1.trayShowClick(Sender: TObject);
begin
  Form1.Visible := True;
end;

procedure TForm1.trayExitClick(Sender: TObject);
begin
  TrayEnabled := False;
  Form1.Close;
end;



procedure TForm1.FormDestroy(Sender: TObject);
begin
  RemoveTrayIcon;
end;

end.

'dev/ null' ik zal er eens na kijken, volgens mij gaat er idd iets fout met het zichtbaar/ontzichtbaar maken van de form.

[Delphi32]

Op zaterdag 27 juli 2002 21:16 schreef MisterE het volgende:
extra dan voor 'Brid'
[code]

procedure TForm1.WM_OnMinimize(var Msg: TWMSysCommand);
begin
ShowMessage('called');

begin

if (Msg.CmdType = SC_MINIMIZE) or
(Msg.CmdType = SC_CLOSE ) then
begin
Hide;
end

end
end;

In je eerste post vertel je dat je hier moet controleren of de gewenste actie Afsluiten of MinimizeToTray is. Waarom doe je die check hier dan niet meer? Want zoals ik het lees, zal jouw applicatie bij het binnenkrijgen van de SC_CLOSE altijd een self.Hide uitvoeren, hetgeen natuurlijk nooit tot een sluiten van de app leidt.

Ik heb een tip: gebruik de tray-icon uit de voortreffelijke (freeware) RxLib, die verlost je van een hoop ballast. En mocht je daar oren naar hebben, dan mag je me mailen om wat voorbeeldcode die ik hier heb liggen (met de RxLib dus).

[MisterE]

Op zondag 28 juli 2002 00:19 schreef Delphi32 het volgende:

[..]

In je eerste post vertel je dat je hier moet controleren of de gewenste actie Afsluiten of MinimizeToTray is. Waarom doe je die check hier dan niet meer? Want zoals ik het lees, zal jouw applicatie bij het binnenkrijgen van de SC_CLOSE altijd een self.Hide uitvoeren, hetgeen natuurlijk nooit tot een sluiten van de app leidt.

Ik heb een tip: gebruik de tray-icon uit de voortreffelijke (freeware) RxLib, die verlost je van een hoop ballast. En mocht je daar oren naar hebben, dan mag je me mailen om wat voorbeeldcode die ik hier heb liggen (met de RxLib dus).

Wel, i heb een test gedaan, (daarom de regel:ShowMessage('called');) Het blijkt dat die routine helemaal niet 'ge-called' word waneer je 'form.close' uitvoerd.
Daarom kan die check weer weg.

maar btw: ik heb nou CoolTrayIcon geistalled (mijn prog is nu meteen een stuk stabieler, en ik heb minder koppijn), maar als ie hem compiled geeft ie wat warnings. Daarom ben ik wel geinstresseerd in die code van je, iig, de RxLib heb ik wel ergens op mijn schijf, maar ik hoop dat je voor die tray-icon niet alle componenten hoef te installen.

Voor de zekerheid mail ik deze post ook maar ff naar je toe.

greetz,