在表单背景中的平铺/中心图像

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;