Заполнение изображением MDI-формы 4

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: 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;

{/codecitation}

Добавить комментарий