Плитка/изображение центра в фоновом режиме

Question

Есть ли способ разместить изображение в форме фона и уметь его или его поместить?

Также мне нужно поместить другие компоненты поверх изображения.

Я пробовал rmControls, но я не могу ничего разместить поверх изображения.

Answer 1

Вы можете нарисовать свое изображение в обработчике OnPaint для формы. Вот простой пример черепицы:

procedure TMyForm.FormPaint(Sender: TObject); 
var 
    Bitmap: TBitmap; 
    Left, Top: Integer; 
begin 
    Bitmap := TBitmap.Create; 
    Try 
    Bitmap.LoadFromFile('C:\desktop\bitmap.bmp'); 
    Left := 0; 
    while Left<Width do begin 
     Top := 0; 
     while Top<Height do begin 
     Canvas.Draw(Left, Top, Bitmap); 
     inc(Top, Bitmap.Height); 
     end; 
     inc(Left, Bitmap.Width); 
    end; 
    Finally 
    Bitmap.Free; 
    End; 
end; 

В реальном коде вы хотите кэшировать растровое изображение, а не загружать его каждый раз. Я уверен, что вы можете решить, как адаптировать это, чтобы центрировать растровое изображение.

Результат выглядит следующим образом:

Однако, так как это фон в форме, это гораздо лучше, чтобы сделать картину в обработчике для WM_ERASEBACKGROUND. Это также гарантирует, что при изменении размера вы не будете мерцать. Вот более продвинутая версия программы, которая демонстрирует это, а также вариант растягивания.

procedure TMyForm.FormCreate(Sender: TObject); 
begin 
    FBitmap := TBitmap.Create; 
    FBitmap.LoadFromFile('C:\desktop\bitmap.bmp'); 
end; 

procedure TMyForm.RadioGroup1Click(Sender: TObject); 
begin 
    Invalidate; 
end; 

procedure TMyForm.FormResize(Sender: TObject); 
begin 
    //needed for stretch drawing 
    Invalidate; 
end; 

procedure TMyForm.PaintTile(Canvas: TCanvas); 
var 
    Left, Top: Integer; 
begin 
    Left := 0; 
    while Left<Width do begin 
    Top := 0; 
    while Top<Height do begin 
     Canvas.Draw(Left, Top, FBitmap); 
     inc(Top, FBitmap.Height); 
    end; 
    inc(Left, FBitmap.Width); 
    end; 
end; 

procedure TMyForm.PaintStretch(Canvas: TCanvas); 
begin 
    Canvas.StretchDraw(ClientRect, FBitmap); 
end; 

procedure TMyForm.WMEraseBkgnd(var Message: TWmEraseBkgnd); 
var 
    Canvas: TCanvas; 
begin 
    Canvas := TCanvas.Create; 
    Try 
    Canvas.Handle := Message.DC; 
    case RadioGroup1.ItemIndex of 
    0: 
     PaintTile(Canvas); 
    1: 
     PaintStretch(Canvas); 
    end; 
    Finally 
    Canvas.Free; 
    End; 
    Message.Result := 1; 
end; 

Answer 2

В комментариях к моему первому ответу вы спрашиваете, как рисовать клиентскую область формы MDI. Это немного сложнее, потому что у вас нет готового события OnPaint, которое мы можем повесить.

Вместо этого нам нужно изменить процедуру окна окна клиента MDI и реализовать обработчик сообщения WM_ERASEBKGND.

Способ сделать это, чтобы переопределить ClientWndProc в вашей MDI форме:

procedure ClientWndProc(var Message: TMessage); override; 
.... 
procedure TMyMDIForm.ClientWndProc(var Message: TMessage); 
var 
    Canvas: TCanvas; 
    ClientRect: TRect; 
    Left, Top: Integer; 
begin 
    case Message.Msg of 
    WM_ERASEBKGND: 
    begin 
     Canvas := TCanvas.Create; 
     Try 
     Canvas.Handle := Message.WParam; 
     Windows.GetClientRect(ClientHandle, ClientRect); 
     Left := 0; 
     while Left<ClientRect.Width do begin 
      Top := 0; 
      while Top<ClientRect.Height do begin 
      Canvas.Draw(Left, Top, FBitmap); 
      inc(Top, FBitmap.Height); 
      end; 
      inc(Left, FBitmap.Width); 
     end; 
     Finally 
     Canvas.Free; 
     End; 
     Message.Result := 1; 
    end; 
    else 
    inherited; 
    end; 
end; 

И это выглядит следующим образом:

---

Оказывается, что вы используете старая версия Delphi, которая не позволяет вам переопределить ClientWndProc. Это делает его немного сложнее. Вам нужны модификации оконной процедуры. Я использовал тот же самый подход, который используется исходным кодом Delphi 6, поскольку это устаревшая Delphi, с которой мне приходится иметь дело.

Ваша форма хочет выглядеть следующим образом:

type 
    TMyForm = class(TForm) 
    procedure FormCreate(Sender: TObject); 
    private 
    FDefClientProc: TFarProc; 
    FClientInstance: TFarProc; 
    FBitmap: TBitmap; 
    procedure ClientWndProc(var Message: TMessage); 
    protected 
    procedure CreateWnd; override; 
    procedure DestroyWnd; override; 
    end; 

И реализация так:

procedure TMyForm.FormCreate(Sender: TObject); 
begin 
    FBitmap := TBitmap.Create; 
    FBitmap.LoadFromFile('C:\desktop\bitmap.bmp'); 
end; 

procedure TMyForm.ClientWndProc(var Message: TMessage); 
var 
    Canvas: TCanvas; 
    ClientRect: TRect; 
    Left, Top: Integer; 
begin 
    case Message.Msg of 
    WM_ERASEBKGND: 
    begin 
     Canvas := TCanvas.Create; 
     Try 
     Canvas.Handle := Message.WParam; 
     Windows.GetClientRect(ClientHandle, ClientRect); 
     Left := 0; 
     while Left<ClientRect.Right-ClientRect.Left do begin 
      Top := 0; 
      while Top<ClientRect.Bottom-ClientRect.Top do begin 
      Canvas.Draw(Left, Top, FBitmap); 
      inc(Top, FBitmap.Height); 
      end; 
      inc(Left, FBitmap.Width); 
     end; 
     Finally 
     Canvas.Free; 
     End; 
     Message.Result := 1; 
    end; 
    else 
    with Message do 
     Result := CallWindowProc(FDefClientProc, ClientHandle, Msg, wParam, lParam); 
    end; 
end; 

procedure TMyForm.CreateWnd; 
begin 
    inherited; 
    FClientInstance := Classes.MakeObjectInstance(ClientWndProc); 
    FDefClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC)); 
    SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(FClientInstance)); 
end; 

procedure TMyForm.DestroyWnd; 
begin 
    SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(FDefClientProc)); 
    Classes.FreeObjectInstance(FClientInstance); 
    inherited; 
end;