Subversion Repositories delphiutils

Rev

Rev 12 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, ComCtrls, ShellAPI, Menus;
  8.  
  9. const
  10.   WM_TASKABAREVENT = WM_USER+1; //Taskbar message
  11.  
  12. type
  13.   TMainForm = class(TForm)
  14.     PopupMenu1: TPopupMenu;
  15.     Anzeigen1: TMenuItem;
  16.     Beenden1: TMenuItem;
  17.     procedure FormDestroy(Sender: TObject);
  18.     procedure FormCreate(Sender: TObject);
  19.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  20.     procedure Anzeigen1Click(Sender: TObject);
  21.     procedure Beenden1Click(Sender: TObject);
  22.   private
  23.     RealClose: boolean;
  24.     procedure TaskbarEvent(var Msg: TMessage);
  25.       Message WM_TASKABAREVENT;
  26.     procedure OnQueryEndSession(var Msg: TWMQueryEndSession);
  27.       message WM_QUERYENDSESSION ;
  28.     procedure NotifyIconChange(dwMessage: Cardinal);
  29.   protected
  30.     cal: TMonthCalendar;
  31.   public
  32.     procedure Vordergrund;
  33.   end;
  34.  
  35. var
  36.   MainForm: TMainForm;
  37.  
  38. implementation
  39.  
  40. {$R *.dfm}
  41.  
  42. uses
  43.   CommCtrl, FullYearCalendar, Functions;
  44.  
  45. // Ref: http://www.delphi-fundgrube.de/faq01.htm
  46.  
  47. procedure TMainForm.TaskbarEvent(var Msg: TMessage);
  48. var
  49.   Point: TPoint;
  50. begin
  51.  
  52.   { Die WM_TaskbarEvent-Message "Msg" gibt in Msg.LParam
  53.     das genaue Ereignis an. Msg.LParam kann folgende Werte für
  54.     Mausereignisse annehmen:
  55.  
  56.     WM_MouseMove
  57.     WM_LButtonDown
  58.     WM_LButtonUp
  59.     WM_LButtonDblClk
  60.     WM_RButtonDown
  61.     WM_RButtonUp
  62.     WM_RButtonDblClk }
  63.  
  64.   case Msg.LParam of
  65.     WM_LButtonDblClk:
  66.       begin
  67.         Vordergrund;
  68.       end;
  69.     WM_RButtonUp:
  70.       begin
  71.         // Rechtsklick
  72.         // Diese Zeile ist wichtig, damit das PopupMenu korrekt
  73.         // wieder geschlossen wird:
  74.         SetForegroundWindow(Handle);
  75.         // PopupMenu anzeigen:
  76.         GetCursorPos(Point);
  77.         PopupMenu1.Popup(Point.x, Point.y);
  78.         //oder ohne Variable Point:
  79.         //PopupMenu1.Popup(Mouse.CursorPos.x, Mouse.CursorPos.y);
  80.       end;
  81.   end;
  82. end;
  83.  
  84. procedure TMainForm.NotifyIconChange(dwMessage: Cardinal);
  85. var
  86.   NotifyIconData: TNotifyIconData;
  87. begin
  88.   Fillchar(NotifyIconData,Sizeof(NotifyIconData),0);
  89.   NotifyIconData.cbSize := Sizeof(NotifyIconData);
  90.   NotifyIconData.Wnd    := Handle;
  91.   NotifyIconData.uFlags := NIF_MESSAGE
  92.     or NIF_ICON
  93.     or NIF_TIP;
  94.   NotifyIconData.uCallbackMessage := WM_TASKABAREVENT;
  95.   NotifyIconData.hIcon := Application.Icon.Handle;
  96.   NotifyIconData.szTip := 'Kalender';
  97.   Shell_NotifyIcon(dwMessage, @NotifyIconData);
  98. end;
  99.  
  100. procedure TMainForm.FormDestroy(Sender: TObject);
  101. begin
  102.   cal.Free;
  103.   NotifyIconChange(NIM_DELETE);
  104. end;
  105.  
  106. procedure TMainForm.FormCreate(Sender: TObject);
  107. begin
  108.   NotifyIconChange(NIM_ADD);
  109.  
  110.   cal := TFullYearCalendar.Create(Self);
  111.   cal.Parent := Self;
  112.   cal.WeekNumbers := true;
  113.  
  114.   ClientWidth := cal.Width;
  115.   ClientHeight := cal.Height;
  116. end;
  117.  
  118. procedure TMainForm.Vordergrund;
  119. begin
  120.   Show;
  121.   ShowWindow(Handle, SW_RESTORE);
  122.   ForceForegroundWindow(Handle);
  123. end;
  124.  
  125. procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  126. begin
  127.   Hide;
  128.   CanClose := RealClose;
  129. end;
  130.  
  131. procedure TMainForm.OnQueryEndSession;
  132. begin
  133.   RealClose := true;
  134.   Close;
  135.   Msg.Result := 1;
  136. end;
  137.  
  138. procedure TMainForm.Anzeigen1Click(Sender: TObject);
  139. begin
  140.   Vordergrund;
  141. end;
  142.  
  143. procedure TMainForm.Beenden1Click(Sender: TObject);
  144. begin
  145.   RealClose := true;
  146.   Close;
  147. end;
  148.  
  149. end.
  150.