Hey
Ich lerne grad für ein Examen und habe Probleme mit dem Programm. Im Programm ist es möglich Linien aus Rechtecken,Kreuzen und Kreisen. Wenn man die Animation startet dann wird jede Figur einzeln gemalt. Weiß nicht ob das Problem beim Pointer liegt oder woanders. Wenn man die linke Maustaste drückt wir eine Figur erstellt. Solange man die nicht loslässt werden weitere Figuren gemallt und die werden mit Pointer verbunden.
Hier ist mal der Quellcode:
Code
unit UListeFigures;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TPCoord = ^TCoord;
TCoord = record
X,Y : integer;
Suivant : TPCoord;
end;
TTypeFigure = (tfCarre,tfCercle,tfCroix);
TFigure = class
private
Couleur : TColor;
TypeFigure : TTypeFigure;
DebutCoord : TPCoord; //Pointer der den Anfang der Figur markiert
ActuelCoord : TPCoord; //Pointer der auf die aktuelle Figur zeigt
public
Suivant : TFigure;
constructor Create(pCouleur:TColor; pTypeFigure:TTypeFigure);
procedure AjouterCoord(X,Y:integer;lb:TListbox);
procedure DessinerActuel(Canvas:TCanvas);
procedure Avancer;
destructor Destroy; override;
end;
TListeFigures = class
private
DebutFigures : TFigure;
public
constructor Create;
procedure AjouterFigure(pFigure:TFigure);
procedure DessinerActuel(Canvas:TCanvas);
procedure Avancer;
procedure Vider;
destructor Destroy; override;
end;
implementation
{****************************************************************************}
// à compléter ...
{****************************************************************************}
{ TListeFigures }
procedure TListeFigures.AjouterFigure(pFigure: TFigure);
begin
if DebutFigures = nil then
begin
DebutFigures:=pFigure;
end
else
begin
//pFigure.
end;
end;
procedure TListeFigures.Avancer;
begin
end;
constructor TListeFigures.Create;
begin
DebutFigures:=nil;
end;
procedure TListeFigures.DessinerActuel(Canvas: TCanvas);
begin
end;
destructor TListeFigures.Destroy;
begin
end;
procedure TListeFigures.Vider;
begin
end;
{ TFigure }
procedure TFigure.AjouterCoord(X, Y: integer;lb:TListbox); //Setzt eine neue Figur an ende hinzu
var PNouveau,PHelp:TPCoord;
X1,Y1:integer;
begin
New(PNouveau);
PNouveau^.X:=X;
PNouveau^.Y:=Y;
PNouveau^.Suivant:=nil;
if DebutCoord <> nil then
begin
ActuelCoord^.Suivant:=PNouveau;
ActuelCoord:=PNouveau;
ActuelCoord^.Suivant:=nil;
end
else
begin
DebutCoord:=PNouveau;
ActuelCoord:=PNouveau;
end;
PHelp:=DebutCoord;
while PHelp <> nil do
begin
X1:=PHelp^.X;
Y1:=PHelp^.Y;
lb.Items.Add(inttostr(X1) + ' ' + inttostr(Y1)); //die ListBox hab ich zur kontrolle eingebaut und meines erachtens funktionniert es
PHelp:=PHelp^.Suivant;
end;
end;
procedure TFigure.Avancer; //Geht eine Figur weiter
var PHelp:TPCoord;
begin
if ActuelCoord^.Suivant = nil then
begin
ActuelCoord:=DebutCoord;
end
else
begin
PHelp:=ActuelCoord^.Suivant;
ActuelCoord:=PHelp;
end;
end;
constructor TFigure.Create(pCouleur: TColor; pTypeFigure: TTypeFigure); //Erstellt eine neue Figur
begin
inherited Create;
Couleur:=pCouleur;
TypeFigure:=pTypeFigure;
DebutCoord:=nil;
ActuelCoord:=nil;
end;
procedure TFigure.DessinerActuel(Canvas: TCanvas); //Zeichnet die aktuelle Figur
var X,Y:integer;
begin
if ActuelCoord <> nil then
begin
if (TypeFigure = tfCarre) then
begin
Canvas.Pen.Color:=clred;
canvas.Brush.Color:=clRed;
X:=ActuelCoord^.X;
Y:=ActuelCoord^.Y;
Canvas.Rectangle(X-5,Y-5,X+5,Y+5);
end
else if (TypeFigure = tfCercle) then
begin
Canvas.Pen.Color:=clblue;
canvas.Brush.Color:=clblue;
X:=ActuelCoord^.X;
Y:=ActuelCoord^.Y;
Canvas.Ellipse(X-5,Y-5,X+5,Y+5);
end
else if (TypeFigure = tfCroix) then
begin
Canvas.Pen.Color:=clGreen;
canvas.Brush.Color:=clGreen;
X:=ActuelCoord^.X;
Y:=ActuelCoord^.Y;
Canvas.Moveto(X-5,Y-5);
Canvas.LineTo(X+5,Y+5);
Canvas.Moveto(X+5,Y-5);
Canvas.LineTo(X-5,Y+5);
end;
end;
end;
destructor TFigure.Destroy;
var PHelp:TPCoord;
begin
PHelp:=DebutCoord;
while PHelp <> nil do
begin
DebutCoord:=PHelp^.Suivant;
Dispose(PHelp);
PHelp:=DebutCoord;
end;
end;
end.
Alles anzeigen
Hier ein Aufbau wie das mit den Pointern aussehen soll: Pointer
Wenn ihr weitere Fragen habt dann könnt ihr sie ruhig stellen.
MfG HolyBeast
#edit dongdong: link fixed