发信人: shan_wan(飞雪连天)
整理人: teleme(2001-03-28 12:21:23), 站内信件
|
//在主窗体中添加Image1控件
//申明
private
FClientInstance : TFarProc;
FPrevClientProc : TFarProc;
procedure ClientWndProc(var Message: Tmessage);
//------------------------------
procedure TMainFrm.ClientWndProc(var Message: Tmessage);
var
Dc : hDC;
Row : Integer;
Col : Integer;
begin
with Message do
case Msg of
WM_ERASEBKGND:
begin
Dc := TWMEraseBkGnd(Message).Dc;
for Row := 0 to ClientHeight div Image1.Picture.Height do
for Col := 0 to ClientWidth div Image1.Picture.Width do
BitBlt(Dc,
Col * Image1.Picture.Width,
Row * Image1.Picture.Height,
Image1.Picture.Width,
Image1.Picture.Height,
Image1.Picture.Bitmap.Canvas.Handle,
0,
0,
SRCCOPY);
Result := 1;
end;
else
Result := CallWindowProc(FPrevClientProc,
ClientHandle,
Msg,
wParam,
lParam);
end;
end;
//FormOnCreate
procedure TMainFrm.FormCreate(Sender: Tobject);
begin
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle,GWL_WNDPROC));
SetWindowLong(ClientHandle,GWL_WNDPROC, LongInt(FClientInstance));
end;
|
|