delphi - 自定义图形的指针操作无效+运行时错误

Question

我正在开发一个简单的小应用程序，其中包含1张图片和3个计时器。目标是画出多个球，每个球在来回追逐，颜色逐渐褪色。看起来像这样：



现在的问题是，当我关闭应用程序时，我按此顺序遇到了许多错误，并且在代码中没有给我断点。它仅在它从右向左移动而不是从左向右移动时发生。我认为这可能与关闭应用程序后继续运行计时器有关，因此我在OnClose事件中禁用了计时器-但还是没有运气。







这是DFM代码：

object Form1: TForm1
  Left = 379
  Top = 631
  Width = 696
  Height = 254
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Img: TImage
    Left = 16
    Top = 56
    Width = 649
    Height = 15
  end
  object tmrDraw: TTimer
    Enabled = False
    Interval = 50
    OnTimer = tmrDrawTimer
    Left = 88
    Top = 128
  end
  object tmrBalls: TTimer
    Enabled = False
    Interval = 50
    OnTimer = tmrBallsTimer
    Left = 128
    Top = 128
  end
  object tmrChase: TTimer
    Enabled = False
    Interval = 60
    OnTimer = tmrChaseTimer
    Left = 168
    Top = 128
  end
end

这是源代码：

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Math;

type
  TBallStates = array of Integer;

  TForm1 = class(TForm)
    Img: TImage;
    tmrDraw: TTimer;
    tmrBalls: TTimer;
    tmrChase: TTimer;
    procedure tmrDrawTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure tmrBallsTimer(Sender: TObject);
    procedure tmrChaseTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    fPos: Integer;
    fDir: Integer;
    fBalls: TBallStates;
    fBallCount: Integer;
    fBMin: Integer;
    fBMax: Integer;
    fBStep: Integer;
    fCMin: TColor;
    fCMax: TColor;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function ColorBetween(const ColorA, ColorB: TColor; const Percent: Single): TColor;
var
  R1, G1, B1: Byte;
  R2, G2, B2: Byte;
begin
  R1:= GetRValue(ColorA);
  G1:= GetGValue(ColorA);
  B1:= GetBValue(ColorA);
  R2:= GetRValue(ColorB);
  G2:= GetGValue(ColorB);
  B2:= GetBValue(ColorB);
  Result:= RGB(
    EnsureRange(Round(R1*Percent + R2*(100-Percent) / 100), 0, 255),
    EnsureRange(Round(G1*Percent + G2*(100-Percent) / 100), 0, 255),
    EnsureRange(Round(B1*Percent + B2*(100-Percent) / 100), 0, 255)
  );
end;

//This timer sets the intensities of the balls
procedure TForm1.tmrBallsTimer(Sender: TObject);
var
  X: Integer;   //Loop counter
  C: Integer;   //Count of balls
  V: Integer;   //Value of individual ball intensity
begin
  C:= Length(fBalls);
  for X:= 0 to C - 1 do begin
    V:= fBalls[X];    
    if (V >= fBMin - fBStep - 1) and (V <= fBMin + fBStep + 1) then begin
      V:= fBMin;
    end else
    if V > fBMin then begin
      V:= V - fBStep;
    end else
    if V < fBMin then begin
      V:= V + fBStep;
    end;
    fBalls[X]:= V;
  end;
end;

//This timer draws the balls
procedure TForm1.tmrDrawTimer(Sender: TObject);
var
  X: Integer;   //Loop counter
  V: Integer;   //Value of individual ball intensity
  C: Integer;   //Count of balls
  R: TRect;     //Rect of individual ball
  Z: Integer;   //Size of each ball
  Col: TColor;  //Color to draw each ball
  B: TBitmap;
begin
  B:= TBitmap.Create;
  try
    B.Width:= Img.ClientWidth;
    B.Height:= Img.ClientHeight;
    C:= Length(fBalls);
    Z:= Img.Height;
    R:= Rect(0, 0, Z, Z);
    B.TransparentColor:= clWhite;
    B.Transparent:= True;
    B.Canvas.Brush.Style:= bsSolid;
    B.Canvas.Pen.Style:= psClear;
    B.Canvas.Brush.Color:= clWhite;
    B.Canvas.FillRect(B.Canvas.ClipRect);
    for X:= 0 to C - 1 do begin
      V:= fBalls[X];
      Col:= ColorBetween(fCMin, fCMax, (V / fBMax)*100);
      B.Canvas.Brush.Color:= Col;
      B.Canvas.Ellipse(R);
      R.Left:= R.Left + Z;
      R.Right:= R.Right + Z;
    end;
    Img.Picture.Assign(B);
  finally
    B.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  X: Integer;
begin
  fDir:= 1;
  fPos:= 0;
  fBMin:= 0;
  fBMax:= 100;
  fBallCount:= 40;
  fBStep:= 8;
  fCMin:= clNavy;
  fCMax:= clSkyBlue;
  SetLength(fBalls, fBallCount);
  for X:= 0 to Length(fBalls) - 1 do
    fBalls[X]:= fBMin;
  tmrDraw.Enabled:= True;
  tmrBalls.Enabled:= True;
  tmrChase.Enabled:= True;
end;

procedure TForm1.tmrChaseTimer(Sender: TObject);
begin
  fPos:= fPos + fDir;
  if (fPos >= fBallCount) then begin
    fDir:= -1;
  end;
  if (fPos <= 0) then begin
    fDir:= 1;
  end;
  fBalls[fPos]:= fBMax;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  tmrDraw.Enabled:= False;
  tmrBalls.Enabled:= False;
  tmrChase.Enabled:= False;
end;

end.

这是CPU窗口（不知道是否有帮助），因为首先引发了异常：



调用堆栈为空：



编辑：这个问题已经解决。问题（从下面的答案中看到）正在写入未分配的数组的索引（在 - 1之后缺少 Length(MyArray)）。这是最终产品的图片（两个球以相反的方向来回移动）：

Answer 1

我只是在Delphi 6上尝试过，但是遇到了同样的问题。经过一番跟踪，我发现释放FBalls动态数组时发生了错误，

在旧的Delphi内存管理器中发生了此错误，将其更改为FastMM4即可解决-但这有点麻烦。它还可以解释为什么该问题不会影响较早版本的Delphi。

即使以关闭形式使用SetLength（FBalls，0）也会产生此错误。

编辑-根本原因

这使我对数组处理产生怀疑，然后我注意到tmrChaseTimer中的一个错误，该错误导致它在数组范围之外进行写入。我对此进行了一些检查，一切正常：

procedure TForm1.tmrChaseTimer(Sender: TObject);
begin
  fPos:= fPos + fDir;
  if (fPos >= fBallCount) then begin
    fDir:= -1;
  end;
  if (fPos <= 0) then begin
    fDir:= 1;
  end;
  if (fPos >= 0) and (fPos < fBallCount) then // <-- prevent writing outside array bounds
    fBalls[fPos]:= fBMax;
end;

我停用了启用范围检查的代码，然后立即抛出错误：



调试器异常通知

项目Project1.exe引发异常类ERangeError，并显示消息“范围检查错误”。进程已停止。使用“步骤”或“运行”继续。

好的帮助