Delphi 7 - 如何在图像中心创建一个带有文本的组件

Posted 2023-02-23

【中文标题】Delphi 7 - 如何在图像中心创建一个带有文本的组件

【英文标题】：Delphi 7 - how to create a component with Text on the center of Image

【发布时间】：2014-05-27 14:46:31

【问题描述】：

我在创建组件时遇到问题。我想在这个图像的中心有一个图像和简单的标签。它必须是一个组件，因为我将根据代码动态创建它。这个怎么做？我不知道如何将两个组件合并为一个。

【问题讨论】：

它没有有成为一个组件。

我知道，但是编写拖放代码会容易得多 - 这就是我正在做的事情

为什么会更容易。制作一个绘画框并将图像和文本绘画到其中是微不足道的。

【参考方案1】：

如果您想将其实现为自己的组件，最快的方法可能是从 TImage 继承，这将提供图像所需的所有属性并覆盖 Paint 方法，访问祖先的画布，这不会有任何机会位图上。简短的示例不涉及 Stretch，您必须自己实现它。

unit CaptionImage;

interface

uses Windows, Classes, Controls, ExtCtrls, Graphics, PNGIMage, jpeg;

type
  // maybe we want to do some more action on the Canvas without manipulation the Bitmap
  TOnAfterpaintEvent = Procedure(Sender: TObject; Canvas: TCanvas) of object;

  TGraphicControl = Class(Controls.TGraphicControl) // make canvas accessable
  public
    Property Canvas;
  End;

  TCaptionImage = Class(ExtCtrls.TImage)
  private
    ICanvas: TCanvas;
    FOnAfterPaint: TOnAfterpaintEvent;
    function GetFont: TFont;
  published
  public
    procedure Paint; override;
  published
    Property OnAfterPaint: TOnAfterpaintEvent Read FOnAfterPaint Write FOnAfterPaint;
    Property Caption;
    Property Font: TFont read GetFont;
  End;

implementation

function TCaptionImage.GetFont: TFont;
begin
  Result := TGraphicControl(Self).Canvas.Font;
end;

procedure TCaptionImage.Paint;
var
  s: String;
  r: TRect;
begin
  inherited;
  r := ClientRect;
  s := Caption;
  ICanvas := TGraphicControl(Self).Canvas;
  ICanvas.Brush.Style := bsClear;
  ICanvas.Textrect(r, s, [tfVerticalCenter, tfCenter, tfSingleLine]);
  if Assigned(FOnAfterPaint) then
    FOnAfterPaint(Self, ICanvas);
end;

end.

一个示例用法是：

procedure TForm5.Button1Click(Sender: TObject);
begin
   With TCaptionImage.Create(self) do
    begin
      Parent := self;
      AutoSize := true;
      Font.Color := clBlue;
      Font.Size := 20;
      Picture.LoadFromFile('C:\temp\Bild 1.png');
      Caption := 'Test';
    end;
end;