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

Delphi , Программа и Интерфейс , MDI приложения

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

Перевод контента на русский язык:

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

Однако, есть два проблемы: прокрутка основного окна и перемещение дочернего окна MDI за пределы области экрана портят фон; и рисование за иконками дочерних окон не происходит.

Автор, похоже, нашел решение для обоих проблем. Код использует компонент TImage с именем Image1, содержащий изображение, которое будет заполнять фон на основной форме. Процедура WMIconEraseBkgndOverride рисует за иконкой.

Вот некоторые наблюдения и предложения:

1. В процедуре WMIconEraseBkgndOverride вызов TForm1(Application.MainForm).PaintUnderIcon(Self, Message.DC) кажется ненужным, потому что не ясно, почему мы должны передавать сообщение другому форму.
2. Процедура ClientWndProc интересна, поскольку она обрабатывает различные сообщения, такие как WM_ERASEBKGND, WM_VSCROLL и WM_HSCROLL. Это может потенциально вызвать проблемы, если несколько форм используют этот код.

Альтернативное решение:

Вместо переопределения сообщения WMIconEraseBkgnd можно использовать объект TBitMap для рисования изображения в событии OnPaint вашей формы. Вот пример:

procedure TForm1.OnPaint(var PaintMessage: TPaintMessage);
begin
  with PaintMessage.Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := clWhite; // или любое другое значение цвета, которое вы хотите для фона
    FillRect(Rect(0, 0, ClientWidth, ClientHeight));

    // Рисуйте ваше изображение здесь
    // Например:
    BitBlt(Canvas.Handle, 0, 0, Image1.Width, Image1.Height,
      Image1.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
  end;
end;

В этом коде мы сначала рисуем фон белым цветом. Затем мы рисуем наше изображение с помощью BitBlt.

Это решение более простое и не требует обработки низкоуровневых сообщений, таких как WM_ERASEBKGND.

Заполнение изображением MDI-формы 2: решается проблема прокрутки главного окна и перемещения дочернего MDI-окна за пределы экрана, а также закрашивание за иконками дочерних окон.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: MDI приложения ::