窗口客户区句柄是 ClientHandle ,它有自己的窗口处理过程,通过重设其窗口处理过程,实现背景图的绘制。
Var FClientInstance : TFarProc; // 新的窗口过程 FPrevClientProc : TFarProc; // 旧的窗口过程 |
// 保存旧的过程 FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC)); // 生成新的窗口过程 FClientInstance := MakeObjectInstance(ClientWndProc); // 设置新的窗口过程 SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance)); // 恢复旧的窗口过程 SetWindowLong(ClientHandle , GWL_WNDPROC, LongInt(FPrevClientProc)); |
需要一个图象元素 Image1。
PROCEDURE TMainForm.ClientWndProc(VAR mesg: TMessage); VAR MyDC : hDC; Ro, Co : Word; img : TImage; const piece = 3; // 图象平铺时,每行错位 1/piece begin img := Image1; if (img.Width<1) or (img.Height<1) or (mesg.Msg<>WM_ERASEBKGND) then mesg.Result := CallWindowProc(FPrevClientProc, ClientHandle, mesg.Msg, mesg.wParam, mesg.LParam) else begin MyDC := mesg.WParam; // 从 Image1 复制位图到客户区 FOR Ro := 0 TO ClientHeight DIV img.Picture.Height DO FOR Co := 0 TO ClientWIDTH DIV img.Picture.Width + 1 DO BitBlt( MyDC, Co*img.Picture.Width - img.Picture.Width div piece * (Ro mod piece), Ro*img.Picture.Height, img.Picture.Width, img.Picture.Height, img.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY); mesg.Result := 1; end; end; |