问题描述
我正在开发一个简单的小应用程序，其中包含1张图片和3个计时器。目的是画出多个球，每个球在来回追逐，颜色逐渐褪色。看起来像这样：
I'm working on a simple little app which has 1 image and 3 timers. The goal is to draw a number of balls chasing back and forth with a decaying color after each one. It looks something like this:
现在的问题是，当我关闭应用程序时，此顺序出现了许多错误，并且代码中没有断点。它只会在它从右向左移动而不是从左向右移动时发生。我认为这可能与应用程序关闭后继续运行计时器有关，因此我在 OnClose 事件中禁用了计时器-但还是没有运气。
Now the problem is when I close the application, I get a number of errors in this order, and does not give me a breakpoint in the code. It only happens when it's moving from the right to the left, not from the left to the right. I thought it probably had to do with the timer(s) continuing after the app closed, so I disabled the timers in the OnClose event - but still no luck.
这是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窗口（不知道是否有帮助），因为第一次引发异常：
This is the CPU window (don't know if it will help) as the exception is first raised:
并且调用堆栈为空：
编辑：此问题已解决。问题（如下面的答案所示）正在写入未分配的数组的索引（在 Length之后我丢失了）。这是最终产品的图片（两个球朝相反的方向来回移动）： -1 （ MyArray）
This problem has been solved. The issue (as seen in the answers below) was writing to an index of an array which was not allocated (I was missing - 1 after Length(MyArray)). Here's a picture of the final product (with two balls chasing back and forth in opposite directions):
推荐答案
我刚刚在Delphi 6上尝试过问题。经过一番跟踪，我发现释放FBalls动态数组时发生了错误，
I just tried this on Delphi 6, and had the same problem. After a bit of tracing I discovered the error was occurring when releasing the FBalls dynamic array,
此错误发生在旧的Delphi内存管理器中，并更改为解决了该问题-但这有点骇人听闻。
This error occurred in the old Delphi memory manager, and changing to FastMM4 resolved it - but that is a bit of a hack. It may also explain why the problem doesn't affect older versions of Delphi.
即使在关闭表单时使用SetLength（FBalls，0），也会产生此错误。
Even using SetLength(FBalls, 0) in form close produced this error.
这使我对数组处理产生怀疑，然后我发现<$ c $中存在错误c> tmrChaseTimer ，导致它在数组范围之外进行写入。我对此添加了一些检查，然后一切正常：
This made me suspicious about the array handling, and I then noticed an error in tmrChaseTimer, that cause it to write outside the array bounds. I added some checking to this, and everything works OK:
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;
我在启用范围检查的情况下取消了代码，并立即引发错误：
I retied the code with Range checking turned on, and it immediately threw an error:
这篇关于自定义图形的指针操作无效+运行时错误的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！