Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС ВЗЛОМ
выпущен 10 декабря!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Как задать в качестве фона MDIForm картинку из TBitmap?

Я делал так:

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
case Msg of
WM_ERASEBKGND:
begin
FillRect(TWMEraseBkGnd(Message).DC, ClientRect,FHBrush);
Result := 1;
end;
else
Default;
end;
end;
end;



<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS