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

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

Автор: Nomadic

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

Программный код на Delphi для создания пользовательского формата MDI (Multiple Document Interface), который переопределяет стандартное поведение рисования фона. Форма использует битмап для заполнения клиентской области.

Вот разбивка кода:

1. В разделе type мы определяем новый класс (TForm) с несколькими процедурами и переменными:
   • FormCreate: Вызывается при создании формы.
   • FormDestroy: Вызывается при уничтожении формы.
   • FHBrush: Объект кисти для рисования фона.
   • FCover: Битмап для использования как изображения фона.
   • FNewClientInstance и FOldClientInstance: Указатели на процедуры экземпляра для обработки сообщений окон.
2. В процедуре FormCreate:
   • Мы создаем новый объект TBitmap (FCover) и загружаем его из ресурса с именем 'BMPCOVER'.
   • Мы создаем объект TLogbrush (LogBrush) со стилем, установленным в BS_ПATTERN, и шаблоном рисования, установленным в handle нашего битмапа.
   • Мы используем CreateBrushIndirect для создания кисти из логкраски.
3. В процедуре FormDestroy:
   • Мы уничтожаем объект кисти, созданный в FormCreate.
   • Мы освобождаем объект битмапа (FCover).
4. В процедуре CreateWnd (переопределение):
   • Мы вызываем метод CreateWnd, наследуемый от предка.
   • Если клиентский handle является действительным, мы устанавливаем стиль окна, включая клиентскую кромку.
5. В процедуре NewClientWndProc:
   • Эта процедура обрабатывает сообщения окон для нашего пользовательского формата MDI.
   • Она использует оператор case для определения типа получаемого сообщения и отвечает соответствующим образом.
   • Для WM_ERASEBKGND, мы заполняем клиентскую область битмапом с помощью FillRect.
   • Для всех других типов сообщений, мы вызываем стандартный процедуру обработки (CallWindowProc) для их обработки.

Цель этого кода - создать пользовательский формат MDI, который использует изображение фона вместо стандартного поведения рисования. Это может быть полезно для создания форм с уникальными визуальными дизайнами или брендингом.

В статье описывается реализация MDI-формы в Delphi с помощью заполнения изображением и изменением стиля окон.

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

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

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