Я работаю над простым небольшим приложением, которое имеет 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.
Это окно ЦП (не знаю, поможет ли оно), так как впервые возникло исключение:
А стек вызовов пуст:
РЕДАКТИРОВАТЬ: Эта проблема была решена. Проблема (как видно из ответов ниже) заключалась в записи в индекс массива, который не был выделен (я пропустил - 1 после Length(MyArray)). Вот изображение конечного продукта (с двумя шарами, гоняющимися вперед и назад в противоположных направлениях):
