delphi - 表格背景中的平铺/中心图像

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;