Ok, evo koda (ko mene je radilo :)
Code:
type
TMainForm = class(TForm)
....
private
FClientInstance : TFarProc;
FPrevClientProc : TFarProc;
procedure ClientWndProc(var Message: TMessage);
end;
implementation
Procedure TMainForm.ClientWndProc(Var Message : TMessage);
var
dc : hdc;
row, col : integer;
begin
with message do
case msg of
wm_erasebkgnd:
begin
dc := twmerasebkgnd(message).dc;
for row := 0 to clientheight div wallpaper.picture.height do
for col := 0 to clientwidth div wallpaper.picture.width do
bitblt(dc, col * wallpaper.picture.width, row * wallpaper.picture.height,
wallpaper.picture.width, wallpaper.picture.height,
wallpaper.picture.bitmap.canvas.handle, 0, 0, srccopy);
result := 1;
end;
else
Result := Callwindowproc(FPrevclientproc, clienthandle,msg, wparam, lparam);
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
Fclientinstance := makeobjectinstance(clientwndproc);
FPrevClientProc := Pointer(Getwindowlong(Clienthandle, gwl_wndproc));
SetWindowLong(Clienthandle, gwl_wndproc, longint(Fclientinstance));
end;
gde je wallpaper TImage( stretch := false, align := alnone)
Pozdrav!