Question

我需要制作一个可以添加对象的表单。我需要绘制这些对象（简单的矩形），并用渐变填充它们，该对象包含文本，并且某些对象之间需要有线条。

我创建了TPaintbox的后代：

  TKTPaintbox = class(TPaintbox)
    procedure Paint; override;

    procedure ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

  private
    FText:     string;
    FDownX:    integer;
    FDownY:    Integer;
    FDragging: Boolean;
    FBrush:    TBrush;
    FMiddle:   TPoint;

    procedure SetText(const Value: string); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Text:              string  read FText  write SetText;
    property Brush:             TBrush  read FBrush write FBrush;
    property Dragging:          boolean read FDragging;
  end;

procedure TKTFilePaintBox.Paint;
var
  w:  integer;
  h:  integer;
begin
  inherited;

  w := Round(Canvas.TextWidth(ShortFileName) / 2);
  h := Round(Canvas.TextHeight(ShortFileName) / 2);

  Canvas.Pen.Width := 1;
  Canvas.Pen.Color := clNavy;
  Canvas.Brush     := FBrush;

  Canvas.Ellipse(1,1,width,height);
  Canvas.TextOut(round(Width/2)-w, Round(Height/2)-h, ShortFileName);
end;

那很好，但是图形很糟糕。因此，我搜索了抗锯齿并尝试了Graphics32库。

var
  i:  integer;
  LinearGradFiller:  TLinearGradientPolygonFiller;
begin
  ImgView32.Bitmap.Clear(clWhite32);

  FGradient.ClearColorStops;
  FGradient.AddColorStop(Stop1, FColorFrom);
  FGradient.AddColorStop(Stop2, FColorTo);

  FGradientLUT := TColor32LookupTable.Create;
  FGradient.FillColorLookUpTable(FGradientLUT);

  if FFileCount > -1 then
  begin
    for i := 0 to Length(FFile)-1 do
    begin
      LinearGradFiller            := TLinearGradientPolygonFiller.Create(FGradientLUT);
      LinearGradFiller.WrapMode   := TWrapMode(1);

      LinearGradFiller.StartPoint := FFile[i].GradientFrom;
      LinearGradFiller.EndPoint   := FFile[i].GradientTo;

      PolygonFS(ImgView32.Bitmap, FFile[i].Points, LinearGradFiller);
      PolyLineFS(ImgView32.Bitmap, FFile[i].Points, FFile[i].Color, true, 3);


      LinearGradFiller.Free;

      with TText32.Create do
      begin
            Draw(ImgView32.Bitmap, trunc(FFile[i].Rect.Left)+10, trunc(FFile[i].Rect.Top)+12, FFile[i].Caption, ttfcArial16, clWhite32);
      end;
      //SimpleText(ImgView32.Bitmap, Font, trunc(FFile[i].Rect.Left)+10, trunc(FFile[i].Rect.Top)+10, FFile[i].Caption,clWhite32);
    end;
  end;
end;

效果也很好，而且肯定比Paintbox后裔漂亮。但是，当我在窗体上放置10个以上的对象时，移动这些对象是一种戏剧。非常缓慢和犹豫。添加文字会使情况变得更糟。

当前，我正在测试创建TPaintbox32的后代，但是，我不知道。我对此不确定。在继续测试之前，您将如何解决这个问题：

不同的抗锯齿画对象
填充2种颜色渐变
对象必须包含文本
对象应能够使用鼠标移动。移动必须平稳
某些对象之间有线条（箭头）。最好是我想在物体运动过程中画线
绘图和移动必须独立于对象的数量。即使有30-50个物体也要保持光滑

请检查下面的代码。这是我正在测试的表格，并且已经删除了注释。单击按钮将创建一个新的圆角矩形。单击并按住以移动这样的矩形。如果少于10个矩形，效果会很顺利，但如果矩形更多，效果会很差。我是图形编程的新手，还是graphics32库的新手。请帮帮我。

unit bollen32;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, GR32, GR32_Image, GR32_Layers, GR32_ColorGradients,
  GR32_Paths, GR32_Polygons, GR32_ArrowHeads, Vcl.ComCtrls, GR32_Text,
  Vcl.StdCtrls, Vcl.ExtCtrls, System.UITypes;

type
  TFile = record
    Color:         TColor32;
    Rect:          TFloatRect;
    Points:        TArrayOfFloatPoint;
    Width:         integer;
    Height:        integer;
    GradientFrom:  TFloatPoint;
    GradientTo:    TFloatPoint;
    Caption:       string;
  end;

  TForm3 = class(TForm)
    ImgView32: TImgView32;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ImgView32MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure ImgView32MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure ImgView32MouseUp(Sender: TObject; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    FFile:         Array of TFile;
    FFileCount:    integer;
    FFileSelect:   integer;

    FGradient:         TColor32Gradient;
    FGradientLUT:      TColor32LookupTable;
    LinearGradFiller:  TLinearGradientPolygonFiller;

    FLastPos:      TPoint;
    FText32:       TText32;
    ttfcArial16:   TTrueTypeFont;

    procedure ReDraw;
  public
    { Public declarations }
    procedure AddFile;

    property FileSelect: integer   read FFileSelect write FFileSelect;
  end;

const
  COLOR1 = $FF2B178F;
  COLOR2 = $FF5367C1;

var
  Form3: TForm3;

implementation
uses clipbrd, GR32_LowLevel, GR32_Geometry, GR32_VectorUtils;

{$R *.dfm}

procedure TForm3.AddFile;
var
  i:  integer;
begin
  i := Length(FFile);
  FFileCount := FFileCount + 1;

  if FFileCount > i-1 then
    SetLength(FFile, FFileCount+1);

  FFile[FFileCount].Width  := Random(150)+50;
  FFile[FFileCount].Height := Random(150)+50;

  FFile[FFileCount].Rect.Left := Random(ImgView32.Width)+30;
  FFile[FFileCount].Rect.Top  := Random(Height)+30;
  FFile[FFileCount].Rect.Right := FFile[FFileCount].Rect.Left + FFile[FFileCount].Width;
  FFile[FFileCount].Rect.Bottom := FFile[FFileCount].Rect.Top + FFile[FFileCount].Height;

  FFile[FFileCount].Points    := RoundRect(FFile[i].Rect, 20);

  FFile[FFileCOunt].GradientFrom.X := FFile[FFileCount].Rect.Left;
  FFile[FFileCOunt].GradientFrom.Y := (FFile[FFileCount].Rect.Bottom-FFile[FFileCount].Rect.Top)/2;
  FFile[FFileCOunt].GradientTo.X   := FFile[FFileCount].Rect.Right;
  FFile[FFileCOunt].GradientTo.Y   := FFile[FFileCOunt].GradientFrom.Y;

  FFile[FFileCount].Caption := 'Hello '+IntToStr(FFileCount+1);

  ReDraw;
end;

procedure TForm3.Button1Click(Sender: TObject);
begin
  AddFile;
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
  Left := 50;
  Top  := 50;
  Width := Screen.Width - 100;
  Height := Screen.Height - 100;

  ImgView32.Bitmap.DrawMode := dmOpaque;
  ImgView32.SetupBitmap(True, clWhite32);

  FGradient := TColor32Gradient.Create;
  FGradient.AddColorStop(0.2, COLOR1);
  FGradient.AddColorStop(0.8, COLOR2);

  FGradientLUT := TColor32LookupTable.Create;

  LinearGradFiller          := TLinearGradientPolygonFiller.Create(FGradientLUT);
  LinearGradFiller.WrapMode := TWrapMode(0);

  FGradient.FillColorLookUpTable(FGradientLUT);

  SetLength(FFile, 0);

  FFileCount := -1;
  FileSelect := -1;

  FText32 := TText32.Create;
  ttfcArial16 := TrueTypeFontClass.Create('Arial', 16, [fsBold]);
end;

procedure TForm3.FormDestroy(Sender: TObject);
begin
  LinearGradFiller.Free;
  FText32.Free;
end;

procedure TForm3.ImgView32MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
var
  b:  boolean;
  i:  integer;
begin
  Caption := 'Clicked';

  for i := Length(FFile)-1 downto 0 do
  begin
    b := PointInPolygon(FloatPoint(x,y), FFile[i].Points);

    if b then
    begin
      FLastPos   := Point(X, Y);
      FileSelect := i;
      Caption    := 'Selected!';
      Exit;
    end;
  end;
end;

procedure TForm3.ImgView32MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
begin
  if FileSelect > -1 then
  begin
    FFile[FileSelect].Rect.Left := FLastPos.X;
    FFile[FileSelect].Rect.Top  := FLastPos.Y;
    FFile[FileSelect].Rect      := FloatRect(FLastPos.X, FLastPos.Y, FLastPos.X+FFile[FileSelect].Width, FLastPos.Y+FFile[FileSelect].Height);
    FFile[FileSelect].Points    := RoundRect(FFile[FFileSelect].Rect, 20);

    FFile[FFileSelect].GradientFrom.X := FFile[FFileSelect].Rect.Left;
    FFile[FFileSelect].GradientFrom.Y := (FFile[FFileSelect].Rect.Bottom-FFile[FFileSelect].Rect.Top)/2;
    FFile[FFileSelect].GradientTo.X   := FFile[FFileSelect].Rect.Right;
    FFile[FFileSelect].GradientTo.Y   := FFile[FFileSelect].GradientFrom.Y;

    FLastPos := Point(X, Y);

    Redraw;
  end;
end;

procedure TForm3.ImgView32MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
begin
  FileSelect := -1;
end;

procedure TForm3.ReDraw;
var
  i:  integer;
begin
  ImgView32.Bitmap.Clear(clWhite32);

  if FFileCount > -1 then
  begin
    ImgView32.BeginUpdate;
    for i := 0 to Length(FFile)-1 do
    begin
      LinearGradFiller.StartPoint := FFile[i].GradientFrom;
      LinearGradFiller.EndPoint   := FFile[i].GradientTo;

      PolygonFS(ImgView32.Bitmap, FFile[i].Points, LinearGradFiller);
      PolyLineFS(ImgView32.Bitmap, FFile[i].Points, clRed32, true, 3);

      FText32.Draw(ImgView32.Bitmap, trunc(FFile[i].Rect.Left)+10, trunc(FFile[i].Rect.Top)+20, FFile[i].Caption, ttfcArial16, clWhite32);
    end;
    ImgView32.EndUpdate;
  end;
end;

end.

绘制和平滑抗锯齿绘制对象并将其移动的最佳方法是什么

0 个答案: