关于delphi 中的canvas重影问题

Posted 2023-04-01

大家好，我在delphi中的一个窗体上面用canvas来作图，由于画图的范围超过了窗体的范围，所以在窗体上面用了滚动条，但是当我向右拖动滚动条时，拖出来的部分却出现了重影，请问这个问题有办法来解决吗？

不要在窗体上用滚动条，在窗体上放一个 scrollBox，用scrollBox的canvas画图。 参考技术A 每滚动一下就重画一次。没有其他好方法

Delphi FMX组件重影去除子组件

【中文标题】Delphi FMX组件重影去除子组件

【英文标题】：Delphi FMX component ghosting removing subcomponents

【发布时间】：2014-10-20 13:39:24

【问题描述】：

我创建了一个 FMX 组件，它是一个按钮数组。这有一个简单的列和行计数属性。 数组中的每个按钮本身就是一个组件，当行数或列数发生变化时，我会删除所有按钮并重新创建所需的数字。

我遇到的问题是，在删除组件后，它们继续在屏幕上出现鬼影。 例如，默认的列数和行数为 10，但对于手机格式，我在设计时将其更改为 5 x 5。这是结果...

我确信这与“Stored”属性有关，但是我确信我已经尝试在按钮和数组上打开和关闭它，没有任何区别。 组件的源代码（试图删除多余的代码）：

type
  TLFArrayButton = class(TStyledControl)

  TLFButtonArray = class(TPanel)
  private
     Private declarations 
    FButtons: Array[0..9, 0..9] of TLFArrayButton;
    Sections: Array[0..3] of TRectangle;
    SectionsText: Array[0..3] of TText;
    FRowCount: integer;
    FColCount: integer;
    FFourUp: boolean;
    FOnArrayButtonClick: TLFButtonArrayButtonClick;
    procedure SetColCount(const Value: integer);
    procedure SetRowCount(const Value: integer);
    procedure CheckButtonArraySize;
    procedure PositionButtons;
    procedure FreeButtons;
    function GetButtonsText(Col, Row: Integer): String;
    procedure SetButtonsText(Col, Row: Integer; const Value: String);
    function GetButtonEnabled(Col, Row: Integer): Boolean;
    procedure SetButtonEnabled(Col, Row: Integer; const Value: Boolean);
    procedure SetFourUp(const Value: boolean);
    procedure OnButtonClick(Sender: TObject);

    procedure OnButtonMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure SetupSectionHeadders;
    function GetButton(id: integer): TLFArrayButton;
    function GetSectionHeadding(idx: integer): string;
    procedure SetSectionHeadding(idx: integer; const Value: string);
    procedure SetOnArrayButtonClick(const Value: TLFButtonArrayButtonClick);
  protected
     Protected declarations 
    function GetStyleObject: TFmxObject; override;
    procedure Resize; override;
    procedure ApplyTriggers; virtual;
    procedure DoButtonClick(id: integer); virtual;
  public
     Public declarations 
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Button[id: integer]: TLFArrayButton read GetButton;
    property ButtonEnabled[Col, Row: Integer]: Boolean read GetButtonEnabled write SetButtonEnabled;
    property ButtonsText[Col, Row: Integer]: String read GetButtonsText write SetButtonsText;
    property SectionHeadding[idx: integer]: string read GetSectionHeadding write SetSectionHeadding;
  published
     Published declarations 
    property FourUp: boolean read FFourUp write SetFourUp stored true default false;
    property ColCount: integer read FColCount write SetColCount stored true default 10;
    property RowCount: integer read FRowCount write SetRowCount stored true default 10;
    property OnArrayButtonClick: TLFButtonArrayButtonClick read FOnArrayButtonClick write SetOnArrayButtonClick;
 end;

procedure Register;

implementation

$R *.res

procedure Register;
begin
  RegisterComponents('LightFactoryFMX', [TLFButtonArray]);
  RegisterComponents('LightFactoryFMX', [TLFArrayButton]);
end;

 TLFButtonArray 

procedure TLFButtonArray.CheckButtonArraySize;
var
  r, c, i: Integer;
begin
  FreeButtons;
  InvalidateRect(RectF(0,0,width,height));
  i := 1;
  for r := 0 to FRowCount-1 do
  begin
    for c := 0 to FColCount-1 do
    begin
      FButtons[r,c] := TLFArrayButton.Create(Self);
      FButtons[r,c].Parent := Self;
      FButtons[r,c].Stored := false;
      FButtons[r,c].Locked := true;
      FButtons[r,c].ShowID := true;
      FButtons[r,c].ID := i;
      FButtons[r,c].OnClick := OnButtonClick;
      inc(i);
    end;
  end;
end;

constructor TLFButtonArray.Create(AOwner: TComponent);
begin
  inherited;
  Stored := false;
  StyleLookup := 'panelstyle';
  FFourUp := false;
  FColCount := 10;
  FRowCount := 10;
  CheckButtonArraySize;
  PositionButtons;
end;

procedure TLFButtonArray.FreeButtons;
var
  r, c: Integer;
begin
  for r := 0 to FRowCount-1 do
  begin
    for c := 0 to FColCount-1 do
    begin
      if assigned(FButtons[r, c]) then
      begin
        FButtons[r, c].Free;
        FButtons[r, c] := NIL;
      end;
    end;
  end;
end;

procedure TLFButtonArray.PositionButtons;
var
  r, c, s, b, loc_col, loc_row, num_per_sec: Integer;
  x, y, dw, dh: single;
  tmpBtn: TLFArrayButton;
begin
  if FFourUp then
  begin
    loc_col := ColCount div 2;
    loc_row := RowCount div 2;
    num_per_sec := loc_col * loc_row;
    //
    dw := (Width - INTER_SECTION_SPACING - ((FColCount+1) * BUTTON_SPACING)) / FColCount;
    dh := (Height - INTER_SECTION_SPACING - (Sections[0].Height * 2) - ((FRowCount+1) * BUTTON_SPACING)) / FRowCount;
    x := BUTTON_SPACING;
    y := BUTTON_SPACING;

    for s := 0 to 3 do
    begin
      x := Sections[s].Position.X;
      y := Sections[s].Position.Y + Sections[s].Height + BUTTON_SPACING;
      for b := 1 to num_per_sec do
      begin
        tmpBtn := GetButton((s*num_per_sec) + b);
        if assigned(tmpBtn) then
        begin
          tmpBtn.Position.X := x;
          tmpBtn.Position.Y := y;
          tmpBtn.Width := dw;
          tmpBtn.Height := dh;
          x := x + dw + BUTTON_SPACING;
          if x > (Sections[s].Position.X + Sections[s].Width) then
          begin
            x := Sections[s].Position.X;
            y := y + dh + BUTTON_SPACING;
          end;
        end;
      end;
    end;
  end
  else
  begin
    dw := (Width - ((FColCount+1) * BUTTON_SPACING)) / FColCount;
    dh := (Height - ((FRowCount+1) * BUTTON_SPACING)) / FRowCount;
    x := BUTTON_SPACING;
    y := BUTTON_SPACING;
    for r := 0 to FRowCount-1 do
    begin
      for c := 0 to FColCount-1 do
      begin
        FButtons[r,c].Position.X := x;
        FButtons[r,c].Position.Y := y;
        FButtons[r,c].Width := dw;
        FButtons[r,c].Height := dh;
        x := x + dw + BUTTON_SPACING;
      end;
      x := BUTTON_SPACING;
      y := y + dh + BUTTON_SPACING;
    end;
  end;
end;

procedure TLFButtonArray.Resize;
begin
  inherited;
  if FourUp then
    SetupSectionHeadders;
  PositionButtons;
end;

destructor TLFButtonArray.Destroy;
begin
  FreeButtons;
  inherited;
end;

procedure TLFButtonArray.SetColCount(const Value: integer);
begin
  if FColCount <> Value then
  begin
    if (Value > 0) and (Value < 11) then
    begin
      FColCount := Value;
      CheckButtonArraySize;
      PositionButtons;
    end;
  end;
end;

procedure TLFButtonArray.SetRowCount(const Value: integer);
begin
  if FRowCount <> Value then
  begin
    if (Value > 0) and (Value < 11) then
    begin
      FRowCount := Value;
      CheckButtonArraySize;
      PositionButtons;
    end;
  end;
end;

【问题讨论】：

相关***.com/q/27818697/960757.

【参考方案1】：

由于适用于 iOS/Android 的 Delphi 中的 ARC（自动引用计数），表单仍然引用按钮。因此FButtons[r, c].Free; 应该是FButtons[r, c].DisposeOf;。

【讨论】：

ARC 的陷阱。您始终需要记住谁都在引用您的类/组件。为什么。因为调用 SomeComponent.Free 不再调用析构函数类，而只是将“SomeComponent”变量设置为 nil。只有当该类/组件的引用计数为 0 时，才会调用类/组件的析构函数。