type
.... = class(TForm)
....
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
....
private
FHBrush: HBRUSH;
FCover: TBitmap;
FNewClientInstance: TFarProc;
FOldClientInstance: TFarProc;
procedure NewClientWndProc(varMessage: 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 dobegin
lbStyle := BS_PATTERN;
lbHatch := FCover.Handle;
end;
FHBrush := CreateBrushIndirect(Logbrush);
end;
procedure.FormDestroy(...);
begin
DeleteObject(FHBrush);
FCover.Free;
end;
procedure.CreateWnd;
begininherited CreateWnd;
if (ClientHandle <> 0) thenbeginif 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(varMessage: TMessage);
procedure Default;
beginwithMessagedo
Result := CallWindowProc(FOldClientInstance, ClientHandle, Msg,
wParam,
lParam);
end;
beginwithMessagedobegincase Msg of
WM_ERASEBKGND:
begin
FillRect(TWMEraseBkGnd(Message).DC, ClientRect, FHBrush);
Result := 1;
end;
else
Default;
end;
end;
end;
Статья Заполнение изображением MDI-формы 4 раздела Программа и Интерфейс MDI приложения может быть полезна для разработчиков на Delphi и FreePascal.
Комментарии и вопросы
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.