Komischer Absturtz nach Image1Click

redplug · Beitrag von **redplug** » Di 8. Dez 2009, 20:38

Hallo.
ich habe einen sehr komischen Absturz der auftritt nachdem auf ein Bild geclikt wurde und der Programmcode durchgelaufen ist.
Der Error kommt immer genau beim End.

Da ist der Code:

Code: Alles auswählen

unit Unit1; 
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, StdCtrls, Spin;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    CheckBox1: TCheckBox;
    Image1: TImage;
    Label2: TLabel;
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Panel1: TPanel;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    SpinEdit3: TSpinEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
      );
  private
    { private declarations }
  public
    { public declarations }
  end; 
 
var
  Form1: TForm1;
  StartPoints, EndPoints: Boolean;
  MouseX, MouseY: Integer;
  StartPointsArr, EndPointsArr, CachePointsArr: Array of Array [1..2] of Integer;
  ArraySet: Integer;
 
implementation
 
{ TForm1 }
 
procedure PrintFromCache(Color: Integer);
var
  LastColor, i: Integer;
begin
  LastColor := form1.Image1.Canvas.Brush.Color;
  form1.Image1.Canvas.Brush.Color := Color;
  form1.Image1.Canvas.MoveTo(CachePointsArr[1][1], CachePointsArr[1][2]);
  for i := 2 to ArraySet do
  begin
    form1.Image1.Canvas.LineTo(CachePointsArr[i][1], CachePointsArr[i][2]);
    form1.Image1.Update;
  end;
  form1.Image1.Canvas.Brush.Color := LastColor;
end;
 
procedure ClearLast;
begin
  PrintFromCache(clWhite);
end;
 
procedure SetCachePos(Go, Steps: Integer);
var
  i: Integer;
begin
  for i := 1 to ArraySet do
  begin
    CachePointsArr[i][1] := Round((EndPointsArr[i][1] - StartPointsArr[i][1]) / Steps * Go);
    CachePointsArr[i][2] := Round((EndPointsArr[i][2] - StartPointsArr[i][2]) / Steps * Go);
  end;
end;
 
procedure StartMove;
var
  Steps, Go: Integer;
begin
  ShowMessage('Starte nun die Bewegung!');
  Steps := form1.SpinEdit2.Value;
  SetCachePos(0, Steps);
  for Go := 0 to Steps do
  begin
    if form1.CheckBox1.Checked then
      ClearLast;
    SetCachePos(Go, Steps);
    PrintFromCache(clBlack);
    sleep(form1.SpinEdit3.Value);
  end;
  ArraySet := 0;
  Form1.Button1.Enabled := True;
end;
 
procedure SetEndPoints;
begin
  ArraySet := 0;
  StartPoints := False;
  ShowMessage('Bitte nun die Endpunkte auswählen');
  EndPoints := True;
end;
 
procedure SetStartPoints;
begin
  ArraySet := 0;
  EndPoints := False;
  ShowMessage('Bitte nun die Startpunkte auswählen');
  StartPoints := True;
end;
 
procedure CheckPointSet;
begin
  if (StartPoints and (ArraySet >= Form1.SpinEdit1.Value)) then
    SetEndPoints
  else if (EndPoints and (ArraySet >= Form1.SpinEdit1.Value)) then
  begin
    SetLength(CachePointsArr, ArraySet);
    EndPoints := False;
    StartMove;
  end;
end;
 
procedure SetEndPoint(X, Y: Integer);
begin
  ArraySet := ArraySet + 1;
  SetLength(EndPointsArr, ArraySet);
  EndPointsArr[ArraySet][1] := X;
  EndPointsArr[ArraySet][2] := Y;
  Form1.Image1.Canvas.Pixels[X,Y] := clGreen;
  CheckPointSet;
end;
 
procedure SetStartPoint(X, Y: Integer);
begin
  ArraySet := ArraySet + 1;
  SetLength(StartPointsArr, ArraySet);
  StartPointsArr[ArraySet][1] := X;
  StartPointsArr[ArraySet][2] := Y;
  Form1.Image1.Canvas.Pixels[X,Y] := clRed;
  CheckPointSet;
end;
 
procedure ClearImage(Color: Integer);
var
  OldColor: Integer;
begin
  OldColor := Form1.Image1.Canvas.Brush.Color;
  Form1.Image1.Canvas.Brush.Color := Color;
  Form1.Image1.Canvas.Rectangle(0, 0, Form1.Image1.Width, Form1.Image1.Height);
  Form1.Image1.Canvas.Brush.Color := OldColor;
end;
 
procedure TForm1.FormShow(Sender: TObject);
begin
  StartPoints := False;
  EndPoints := False;
  ClearImage(clWhite);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  ClearImage(clWhite);
  SetStartPoints;
  Form1.Button1.Enabled := False;
end;
 
procedure TForm1.Image1Click(Sender: TObject);
begin
  if StartPoints then
    SetStartPoint(MouseX, MouseY)
  else if EndPoints then
    SetEndPoint(MouseX, MouseY);
end;
 
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Form1.Label1.Caption := 'X: ' + IntToStr(X) + ' Y: ' + IntToStr(Y);
  MouseX := X;
  MouseY := Y;
end;
 
 
procedure TForm1.FormResize(Sender: TObject);
begin
  Form1.Image1.Picture.Bitmap.Width := Form1.Image1.Width;
  Form1.Image1.Picture.Bitmap.Height := Form1.Image1.Height;
  ClearImage(clWhite);
end;
 
 
initialization
  {$I unit1.lrs}
 
end.

Das Projekt ist im Anhang

Villeicht kann mir wer helfen xD

Hitman · Beitrag von **Hitman** » Di 8. Dez 2009, 20:50

Du greifst falsch auf die Arrays zu. Arrays sind (so wie du sie benutzt) von 0 bis Length-1 indiziert und NICHT von 1 bis Length.
Folglich musst du deine for-Schleifen und die vier Zuweisungen korrigieren.

redplug · Beitrag von **redplug** » Di 8. Dez 2009, 20:57

Also müsste es jetzt so richtig sein oder wie:

Code: Alles auswählen

unit Unit1; 
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, StdCtrls, Spin;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    CheckBox1: TCheckBox;
    Image1: TImage;
    Label2: TLabel;
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Panel1: TPanel;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    SpinEdit3: TSpinEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
      );
  private
    { private declarations }
  public
    { public declarations }
  end; 
 
var
  Form1: TForm1;
  StartPoints, EndPoints: Boolean;
  MouseX, MouseY: Integer;
  StartPointsArr, EndPointsArr, CachePointsArr: Array of Array [1..2] of Integer;
  ArraySet: Integer;
 
implementation
 
{ TForm1 }
 
procedure PrintFromCache(Color: Integer);
var
  LastColor, i: Integer;
begin
  LastColor := form1.Image1.Canvas.Brush.Color;
  form1.Image1.Canvas.Brush.Color := Color;
  form1.Image1.Canvas.MoveTo(CachePointsArr[0][1], CachePointsArr[01][2]);
  for i := 1 to ArraySet do
  begin
    form1.Image1.Canvas.LineTo(CachePointsArr[i][1], CachePointsArr[i][2]);
    form1.Image1.Canvas.MoveTo(CachePointsArr[i][1], CachePointsArr[i][2]);
  end;
  form1.Image1.Update;
  form1.Image1.Canvas.Brush.Color := LastColor;
end;
 
procedure ClearLast;
begin
  PrintFromCache(clWhite);
end;
 
procedure SetCachePos(Go, Steps: Integer);
var
  i: Integer;
begin
  for i := 0 to ArraySet do
  begin
    CachePointsArr[i][1] := Round((EndPointsArr[i][1] - StartPointsArr[i][1]) / Steps * Go);
    CachePointsArr[i][2] := Round((EndPointsArr[i][2] - StartPointsArr[i][2]) / Steps * Go);
  end;
end;
 
procedure StartMove;
var
  Steps, Go: Integer;
begin
  ShowMessage('Starte nun die Bewegung!');
  Steps := form1.SpinEdit2.Value;
  SetCachePos(0, Steps);
  for Go := 0 to Steps do
  begin
    if form1.CheckBox1.Checked then
      ClearLast;
    SetCachePos(Go, Steps);
    PrintFromCache(clBlack);
    sleep(form1.SpinEdit3.Value);
  end;
  ArraySet := 0;
  Form1.Button1.Enabled := True;
end;
 
procedure SetEndPoints;
begin
  ArraySet := 0;
  StartPoints := False;
  ShowMessage('Bitte nun die Endpunkte auswählen');
  EndPoints := True;
end;
 
procedure SetStartPoints;
begin
  ArraySet := 0;
  EndPoints := False;
  ShowMessage('Bitte nun die Startpunkte auswählen');
  StartPoints := True;
end;
 
procedure CheckPointSet;
begin
  if (StartPoints and (ArraySet >= Form1.SpinEdit1.Value)) then
    SetEndPoints
  else if (EndPoints and (ArraySet >= Form1.SpinEdit1.Value)) then
  begin
    SetLength(CachePointsArr, ArraySet + 1);
    EndPoints := False;
    StartMove;
  end;
end;
 
procedure SetEndPoint(X, Y: Integer);
begin
  SetLength(EndPointsArr, (ArraySet + 1));
  EndPointsArr[ArraySet][1] := X;
  EndPointsArr[ArraySet][2] := Y;
  ArraySet := ArraySet + 1;
  Form1.Image1.Canvas.Pixels[X,Y] := clGreen;
  CheckPointSet;
end;
 
procedure SetStartPoint(X, Y: Integer);
begin
  SetLength(StartPointsArr, (ArraySet + 1));
  StartPointsArr[ArraySet][1] := X;
  StartPointsArr[ArraySet][2] := Y;
  ArraySet := ArraySet + 1;
  Form1.Image1.Canvas.Pixels[X,Y] := clRed;
  CheckPointSet;
end;
 
procedure ClearImage(Color: Integer);
var
  OldColor: Integer;
begin
  OldColor := Form1.Image1.Canvas.Brush.Color;
  Form1.Image1.Canvas.Brush.Color := Color;
  Form1.Image1.Canvas.Rectangle(0, 0, Form1.Image1.Width, Form1.Image1.Height);
  Form1.Image1.Canvas.Brush.Color := OldColor;
end;
 
procedure TForm1.FormShow(Sender: TObject);
begin
  StartPoints := False;
  EndPoints := False;
  ClearImage(clWhite);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  ClearImage(clWhite);
  SetStartPoints;
  Form1.Button1.Enabled := False;
end;
 
procedure TForm1.Image1Click(Sender: TObject);
begin
  if StartPoints then
    SetStartPoint(MouseX, MouseY)
  else if EndPoints then
    SetEndPoint(MouseX, MouseY);
end;
 
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Form1.Label1.Caption := 'X: ' + IntToStr(X) + ' Y: ' + IntToStr(Y);
  MouseX := X;
  MouseY := Y;
end;
 
 
procedure TForm1.FormResize(Sender: TObject);
begin
  Form1.Image1.Picture.Bitmap.Width := Form1.Image1.Width;
  Form1.Image1.Picture.Bitmap.Height := Form1.Image1.Height;
  ClearImage(clWhite);
end;
 
 
initialization
  {$I unit1.lrs}
 
end.

nur nochmal zur sicherheit. Ich bekomm langsam ne Macke mit den Arrays (In Pascal noch nicht so oft benutzt)

theo · Beitrag von **theo** » Di 8. Dez 2009, 20:59

Hitman war schneller.

Ausserdem: Wenn du in Compilereinstellungen -> Quelltext die Überprüfungen einschaltest, siehst du zuverlässiger wo's in die Hose geht.

theo · Beitrag von **theo** » Di 8. Dez 2009, 21:03

Deine Lösung ist falsch:
Inc(ArraySet);
SetLength(EndPointsArr, ArraySet); //Jetzt hat das Arr beim ersten Mal die Länge eins, also Platz für ein Element
EndPointsArr[ArraySet][1] := X; //Dieses Element liegt jetzt bei 0 nicht 1, also EndPointsArr[ArraySet-1] wäre richtig.

Deutsches Lazarusforum

Komischer Absturtz nach Image1Click

Komischer Absturtz nach Image1Click

Re: Komischer Absturtz nach Image1Click

Re: Komischer Absturtz nach Image1Click

Re: Komischer Absturtz nach Image1Click

Re: Komischer Absturtz nach Image1Click