我需要制作一个可以添加对象的表单。我需要绘制这些对象（简单的矩形），并用渐变填充它们，该对象包含文本，并且某些对象之间需要有线条。
我创建了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的后代，但是，我不知道。我对此不确定。在继续测试之前，您将如何解决这个问题：
请检查下面的代码。这是我正在测试的表格，并且已经删除了注释。单击按钮将创建一个新的圆角矩形。单击并按住以移动这样的矩形。如果少于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.