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;