Delphi 客户区背景

窗口客户区句柄是 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;