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

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

Автор: Neil Rubenkind

Несколько людей уже спрашивали, как залить фон главной MDI-формы повторяющимся изображением. Ключевым моментом здесь является работа с дескриптором окна MDI-клиента (свойство ClientHandle) и заполнение изображением окно клиента в ответ на сообщение WM_ERASEBKGND. Тем не менее здесь существует пара проблем: прокрутка главного окна и перемещение дочернего MDI-окна за пределы экрана портят фон, и закрашивание за иконками дочерних окон не происходит.

Ну наконец-то! Похоже я нашел как решить обе проблемы. Вот код для тех, кому все это интересно. Я начинаю с проблемы дочерних форм, ниже код для решения проблемы с главной формой (модули с именами MDIWAL2U.PAS и MDIWAL1U.PAS). На главной форме расположен компонент TImage с именем Image1, содержащий изображение для заливки фона.

private

{ Private declarations }

procedure WMIconEraseBkgnd(var Message: TWMIconEraseBkgnd);

message WM_ICONERASEBKGND;

USES MdiWal1u;

procedure TForm2.WMIconEraseBkgnd(var Message: TWMIconEraseBkgnd);

begin

TForm1(Application.Mainform).PaintUnderIcon(Self, Message.DC);

Message.Result := 0;

end;

{ Private declarations }

bmW, bmH: Integer;

FClientInstance,

FPrevClientProc: TFarProc;

procedure ClientWndProc(var Message: TMessage);

public

procedure PaintUnderIcon(F: TForm; D: hDC);

procedure TForm1.PaintUnderIcon(F: TForm; D: hDC);

var

DestR, WndR: TRect;

Ro, Co,

xOfs, yOfs,

xNum, yNum: Integer;

begin

{вычисляем необходимое число изображений для заливки D}

GetClipBox(D, DestR);

with DestR do

begin

xNum := Succ((Right — Left) div bmW);

yNum := Succ((Bottom — Top) div bmW);

end;

{вычисление смещения изображения в D}

GetWindowRect(F.Handle, WndR);

with ScreenToClient(WndR.TopLeft) do

begin

xOfs := X mod bmW;

yOfs := Y mod bmH;

end;

for Ro := 0 to xNum do

for Co := 0 to yNum do

BitBlt(D, Co * bmW — xOfs, Ro * bmH — Yofs, bmW, bmH,

Image1.Picture.Bitmap.Canvas.Handle,

0, 0, SRCCOPY);

end;

procedure TForm1.ClientWndProc(var Message: TMessage);

var

Ro, Co: Word;

begin

with Message do

case Msg of

WM_ERASEBKGND:

begin

for Ro := 0 to ClientHeight div bmH do

for Co := 0 to ClientWIDTH div bmW do

BitBlt(TWMEraseBkGnd(Message).DC,

Co * bmW, Ro * bmH, bmW, bmH,

Image1.Picture.Bitmap.Canvas.Handle,

0, 0, SRCCOPY);

Result := 1;

end;

WM_VSCROLL,

WM_HSCROLL:

begin

Result := CallWindowProc(FPrevClientProc,

ClientHandle, Msg, wParam, lParam);

InvalidateRect(ClientHandle, nil, True);

end;

else

Result := CallWindowProc(FPrevClientProc,

ClientHandle, Msg, wParam, lParam);

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

bmW := Image1.Picture.Width;

bmH := Image1.Picture.Height;

FClientInstance := MakeObjectInstance(ClientWndProc);

FPrevClientProc := Pointer(

GetWindowLong(ClientHandle, GWL_WNDPROC));

SetWindowLong(ClientHandle, GWL_WNDPROC,

LongInt(FClientInstance));

end;

{/codecitation}

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