Пишу сабж.
Основываюсь на статье http://ch-13.narod.ru/screen1.htm, точнее пока на 90% передираю оттуда, попутно изучая используемые функции. 
Не могу заставить заработать preview в окошке настроек скринсейвера WinXP. Проверил и координаты окна preview и выполняется ли код перерисовки и тот ли хендл окна, а оно не работает.  Если кому не влом проверьте пжлст. Код прилагаю
| Код |
program scrfromscratch;
uses
SysUtils,
Utilities in 'Utilities.pas';
begin
RunScreenSaver;
end.
|
| Код |
unit Utilities;
interface
procedure RunScreenSaver;
implementation
uses windows,messages,sysutils;
var
classname:lpctstr;
PreviewWindow:hWnd;
Error:integer;
QuitSaver: boolean;
MouseMove: integer;
IsPreview:boolean;
//----------------------------------------
procedure DrawSingleBox;
var
PaintDC: hDC;
Info : TPaintStruct;
Color:integer;
OldBrush:hBrush;
R:TRect;
begin
PaintDC:=BeginPaint(PreviewWindow,Info);
Color := RGB(Random(255),Random(255),Random(255));
OldBrush:=SelectObject(PaintDC,CreateSolidBrush(Color));
GetWindowRect(PreviewWindow,R);
Rectangle(PaintDC,R.Left,R.Top,R.Right,R.Bottom);
DeleteObject(SelectObject(PaintDC,OldBrush));
EndPaint(PreviewWindow,Info);
end;
//-----------------------------------------
function PreviewWndProc(Window:hWnd;Msg,wparam,lparam:integer):integer; stdcall;
begin
Result := 0;
case Msg of
WM_DESTROY: PostQuitMessage(0);
WM_PAINT: DrawSingleBox;
WM_NCCREATE: Result := 1;
WM_KEYDOWN:
if not IsPreview then
QuitSaver := true;
WM_LBUTTONDOWN , WM_MBUTTONDOWN , WM_RBUTTONDOWN :
if not IsPreview then
QuitSaver := true;
WM_MOUSEMOVE:
if not IsPreview then begin
if MouseMove >0 then
dec(MouseMove)
else
QuitSaver := true;
end;
else
Result := DefWindowProc(Window,Msg,wparam,lparam);
end;
end;
//-----------------------------------------
function PreviewThreadProc(Data:integer):integer; stdcall;
begin
Result := 0; Randomize;
ShowWindow(PreviewWindow,sw_Show);
UpdateWindow(PreviewWindow);
Repeat
InvalidateRect(PreviewWindow,nil,False);
Sleep(2000);
until QuitSaver;
PostMessage(PreviewWindow, wm_Destroy, 0, 0);
end;
//-----------------------------------------
function WndClassReg: Boolean;
var
WC:TWndClass;
begin
With WC do begin
Style := cs_ParentDC;//cs_hredraw or cs_vredraw;
lpfnWndProc := @PreviewWndProc;
cbclsExtra:=0;
cbwndExtra := 0;//sizeof(WC);
hIcon:=0;
hCursor:= 0;//LoadCursor(sysInit.hInstance,IDC_ARROW);
hbrBackGround :=0;
lpszMenuName := nil;
lpszClassName := classname;
hInstance := SysInit.HInstance;
end;
Error := GetLAstError;
Result := RegisterClass(WC)<>0;
end;
//-----------------------------------------
function CreateScreenSaverWindow (Width,Height:Integer;ParentWindow: hWnd):hWnd;
begin
if not WndClassReg then
Error := GetLAstError;
if ParentWindow <>0 then begin
Result := CreateWindow( classname,
'Simple',
WS_Child or ws_visible or ws_Disabled,
0,
0,
Width,
Height,
ParentWindow,
0,
hinstance,
nil);
end
else begin
Result := CreateWindow( classname,
'Simple',
WS_VISIBLE or ws_popup,
0,
0,
Width,
Height,
0,
0,
hinstance,
nil);
SetWindowPos(Result,
HWND_TopMost,
0,
0,
0,
0,
SWP_NoMove or SWP_NoSize
);
end;
Error := GetLAstError;
PreviewWindow:=Result;
end;
//-----------------------------------------
procedure RunPreview;
var
ParentWindow:hWnd;
Msg:TMsg;
R:TRect;
Dummy:dword;
begin
QuitSaver := false; MouseMove := 3; IsPreview:=true;
classname := 'SimpleScreenSaverClass';
ParentWindow := StrToInt(ParamStr(2));
GetWindowRect(ParentWindow,R);
CreateScreenSaverWindow(R.Right - R.Left,R.Bottom - R.Top,ParentWindow);
CreateThread(nil,0,@PreviewThreadProc,nil,0,Dummy);
while GetMessage(Msg,0,0,0) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
//-----------------------------------------
procedure RunFullScreen;
var
hw:hWnd;
Msg:TMsg;
R:TRect;
Dummy:dword;
begin
QuitSaver := false; MouseMove := 3; IsPreview := false;
classname := 'SimpleScreenSaverClass';
GetWindowRect(GetDesktopWindow,R);
hw := CreateScreenSaverWindow(R.Right - R.Left,R.Bottom - R.Top,0);
CreateThread(nil,0,@PreviewThreadProc,nil,0,Dummy);
SystemParametersInfo(spi_SetScreenSaveActive,1,@Dummy,0);
while GetMessage(Msg,0,0,0) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
SystemParametersInfo(spi_SetScreenSaveActive,0,@Dummy,0);
end;
//-----------------------------------------
procedure RunScreenSaver;
var s:string;
begin
s:= ParamStr(1);
if Length(s) > 1 then begin
delete(s,1,1);
s[1] := UpCase(s[1]);
end;
if s = 'P' then RunPreview
else RunFullScreen;
end;
end.
|
|