1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
| program PopTV;
uses
Windows, Messages;
function floattostr(const i: Extended): string;
begin
Str(i:2:1,Result);
end;
const
IDC_TIMER = 1;
fMenuState : array[boolean]of cardinal = (0,MF_CHECKED);
var
Timer1 : UINT;
iIntervall : integer = 300;
function WndProc(wnd: HWND; uMsg: UINT; wp: WPARAM; lp: LPARAM): LRESULT; stdcall;
var
hm : HMENU;
i : integer;
p : TPoint;
Can,
me : HDC;
r1,
r2 : TRect;
begin
Result := 0;
case uMsg of
WM_CREATE:
Timer1 := SetTimer(wnd,IDC_TIMER,iIntervall,nil);
WM_DESTROY:
begin
KillTimer(wnd,IDC_TIMER);
PostQuitMessage(0);
end;
WM_GETMINMAXINFO:
begin
PMinMaxInfo(lp)^.ptMinTrackSize.X := 304;
PMinMaxInfo(lp)^.ptMinTrackSize.Y := 190;
end;
WM_TIMER:
if(wp = IDC_TIMER) then begin
Can := GetDC(GetDesktopWindow);
me := GetDC(wnd);
GetClientRect(wnd,r1);
GetWindowRect(GetDesktopWindow,r2);
StretchBlt(me,r1.Left,r1.Top,r1.Right,r1.Bottom,
Can,r2.Left,r2.Top,r2.Right,r2.Bottom,SRCCOPY);
ReleaseDC(wnd,me);
ReleaseDC(GetDesktopWindow,Can);
end;
WM_COMMAND:
if(HIWORD(wp) = BN_CLICKED) and (LOWORD(wp) in[1..10]) then begin
iIntervall := LOWORD(wp) * 100;
Timer1 := SetTimer(wnd,IDC_TIMER,iIntervall,nil);
end;
WM_RBUTTONUP:
begin
hm := CreatePopupMenu;
for i := 1 to 10 do
AppendMenu(hm,MF_STRING or fMenuState[iIntervall=i*100],i,
pchar('Aktualisierung alle ' + floattostr(i/10) + ' Sek.'));
GetCursorPos(p);
SetForegroundWindow(wnd);
TrackPopupMenu(hm,TPM_RIGHTALIGN,p.X,p.Y,0,wnd,nil);
DestroyMenu(hm);
end;
else
Result := DefWindowProc(wnd,uMsg,wp,lp);
end;
end;
const
szClassName = 'TfrmMain';
szAppName = 'Monitor TV';
var
popM : THandle = 0;
aWnd : HWND;
msg : TMsg;
wc : TWndClassEx =
(cbSize:sizeof(TWndClassEx);
Style:CS_HREDRAW or CS_VREDRAW;
lpfnWndProc:@WndProc;
cbClsExtra:0;
cbWndExtra:0;
hIcon:0;
hbrBackground:COLOR_APPWORKSPACE;
lpszMenuName:nil;
lpszClassName:szClassName;
hIconSm:0; );
begin
popM := CreateMutex(nil,false,'PopTV_NonVCL');
if(GetLastError = ERROR_ALREADY_EXISTS) then
begin
if(not IsWindowVisible(findwindow(szClassName,nil))) then
PostMessage(findwindow(szClassName,nil),WM_SYSCOMMAND,SC_RESTORE,0);
SetForegroundWindow(findwindow(szClassName,nil));
exit;
end;
while(findwindow(szClassName,szAppName) <> 0) do
SendMessage(findwindow(szClassName,szAppName),WM_CLOSE,0,0);
wc.hInstance := hInstance;
wc.hIcon := LoadIcon(hInstance,IDI_WINLOGO);
wc.hCursor := LoadCursor(0,IDC_ARROW);
if(RegisterClassEx(wc) = 0) then exit;
aWnd := CreateWindowEx(WS_EX_TOOLWINDOW,szClassname,szAppname,
WS_OVERLAPPEDWINDOW or WS_VISIBLE,integer(CW_USEDEFAULT),
integer(CW_USEDEFAULT),304,190,0,0,hInstance,nil);
if(aWnd = 0) then exit;
ShowWindow(aWnd,SW_SHOW);
UpdateWindow(aWnd);
while(GetMessage(msg,0,0,0)) do
begin
TranslateMessage(msg);
DispatchMessage (msg);
end;
CloseHandle(popM);
end. |