没这么简单, 虽然我想肯定已经有人问过这个问题而且有了解答,我还是贴
private
{ Private declarations }
FClientInstance, FDefClientProc: TFarProc;
procedure ClientWndProc(var message:tmessage);
procedure TForm1.FormCreate(Sender: TObject);
begin
FClientInstance := MakeObjectInstance(ClientWndProc);
FDefClientProc := pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(clienthandle, GWL_WNDPROC, LongInt(FClientInstance));
end;
procedure TForm1.ClientWndProc(var message:tmessage);
var
DC: HDC;
Row, Col: WORD;
begin
if Assigned(@Form1) then
begin
with message do
begin
case Msg of
WM_ERASEBKGND:
begin
try
DC := TWMEraseBkgnd(message).DC;
for Row := 0 to ClientHeight div Image1.Picture.Height do
for Col := 0 to ClientWidth div Image1.Picture.Width do
begin
BitBlt(DC, Col*Image1.Picture.Width,
Row*Image1.Picture.Height, Image1.Picture.Width,
Image1.Picture.Height,
Image1.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;
Result:=1;
except
end;
end;
else
Result := CallWindowProc(
FDefClientProc, ClientHandle, Msg, WParam, LParam);
end;
end
end;
end;
