Содержание материала

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

 

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

 

Code:

...

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;

  

Автор: Neil Rubenkind

 

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

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить