Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Заполнение изображением MDI-формы 4

Автор: 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 World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.