Subversion Repositories delphiutils

Rev

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

Rev Author Line No. Line
5 daniel-mar 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
50 daniel-mar 43 
  CommCtrl, FullYearCalendar, Functions;
5 daniel-mar 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;
50 daniel-mar 121 
  ShowWindow(Handle, SW_RESTORE);
5 daniel-mar 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.