Delphi 窗体背景中的平铺/居中图像

有没有一种方法可以将图像放置在窗体背景中，并能够平铺或居中显示

我还需要在图像的顶部放置其他组件

---

我尝试了rmControls，但无法在图像上方放置任何内容。

您可以在表单的

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;

---

在对我的第一个答案的评论中，您询问了如何绘制MDI表单的客户端区域。这有点困难，因为我们没有可以挂断的ready

OnPaint

事件

相反，我们需要做的是修改MDI客户端窗口的窗口过程，并实现一个

WM_ERASEBKGND

消息处理程序

方法是在MDI表单中覆盖

ClientWndProc

：

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;

实施方式如下：

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;

程序TMyForm.FormCreate（发送方：TObject）；
开始
FBitmap:=TBitmap.Create；
LoadFromFile（'C:\desktop\bitmap.bmp'）；
结束；
过程TMyForm.ClientWndProc（变量消息：TMessage）；
变量
画布：TCanvas；
ClientRect:TRect；
左上角：整数；
开始
case Message.Msg of of
WM_擦除BKGND：
开始
Canvas:=TCanvas.Create；
尝试
Canvas.Handle:=Message.WParam；
GetClientRect（ClientHandle，ClientRect）；
左：=0；
而左撇子在中间位没有问题。但是，如何在不关闭应用程序的情况下在这些应用程序之间进行切换呢？当您从一个应用程序切换到另一个应用程序时，请调用
MyForm.Invalidate
以强制绘制循环。@David。在将imagem放在表单中心并拉伸时遇到问题。它保持在顶部且较小。@DRokie使用
StretchDraw
，如下：
Canvas.StretchDraw（ClientRect，Bitmap）
如果我在onPaint中加载图像，它会非常平滑，但是如果我在创建表单之前加载图像以避免重新加载，它会弹动，而且myForm.DoubleBuffered也没用。现在我有一个空白表单！？我用D2007。无法将ClientWndProc设置为覆盖。ClientRect没有宽度，将其更改为右侧，并注意表单上的显示。FBitmap在哪里声明？在您希望声明它的任何位置。无论如何，无法覆盖
ClientWndProc
是一个问题。这是有办法的。但这需要时间。这有点让人恼火。在我写了第一个答案和第二个答案之后，你才提到MDI。你没告诉我你用的是这么旧的Delphi版本。这些细节似乎很重要。我现在的问题是，ClientWndProc从未被呼叫过：）别担心，只有他。
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;