Nomadic советует:
Я делал так:
type .... =class(TForm) .... procedure FormCreate(Sender:TObject); procedure FormDestroy(Sender:TObject); .... private FHBrush:HBRUSH; FCover:TBitmap; FNewClientInstance:TFarProc; FOldClientInstance:TFarProc; procedure NewClientWndProc(var Message:TMessage); .... protected .... procedure CreateWnd;override; .... end; ..... implementation {$R myRes.res} //pесуpс с битмапом фона procedure .FormCreate(...); var LogBrush:TLogbrush; begin FCover:=TBitmap.Create; FCover.LoadFromResourceName(hinstance,'BMPCOVER'); With LogBrush do begin lbStyle:=BS_PATTERN; lbHatch:=FCover.Handle; end; FHBrush:=CreateBrushIndirect(Logbrush); end; procedure .FormDestroy(...); begin DeleteObject(FHBrush); FCover.Free; end; procedure .CreateWnd; begin inherited CreateWnd; if (ClientHandle <> 0) then begin if NewStyleControls then SetWindowLong(ClientHandle, GWL_EXSTYLE, WS_EX_CLIENTEDGE or GetWindowLong(ClientHandle, GWL_EXSTYLE)); FNewClientInstance:=MakeObjectInstance(NewClientWndProc); FOldClientInstance:=pointer(GetWindowLong(ClientHandle,GWL_WNDPROC)); SetWindowLong(ClientHandle,GWL_WNDPROC,longint(FNewClientInstance)); end; end; procedure .NewClientWndProc(var Message:TMessage); procedure Default; begin with Message do Result := CallWindowProc(FOldClientInstance, ClientHandle, Msg, wParam, lParam); end; begin with Message do begin case Msg of WM_ERASEBKGND: begin FillRect(TWMEraseBkGnd(Message).DC, ClientRect,FHBrush); Result := 1; end; else Default; end; end; end; |
[001228]