Hallo,
ich fange deshalb ein neues Thema an, da es nicht mehr um die Erstellung dynamischer Shapes geht, sondern um deren direkte verarbeitung:
Die erzeugte Shapes schießen immer weit über die top des Shapes1 hinaus, anstatt "umzudrehen" hat jemand eine Idee?
MfG Blck
ich fange deshalb ein neues Thema an, da es nicht mehr um die Erstellung dynamischer Shapes geht, sondern um deren direkte verarbeitung:
Code:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if (slepos <= shape1.left+shape1.width) then
begin
MyTShape:=TShape.Create(Self);
MyTShape.Parent:=Form1;
MyTShape.Show;
MyTShape.height:=sheight;
MyTShape.width:=swidth;
MyTShape.top:=stppos;
MyTShape.left:=slepos;
MyTShape.Name:='Shape'+inttostr(j);
MyTTimer:=TTimer.Create(Self);
MyTTimer.tag:=j;
MyTTimer.Interval:=1;
MyTTimer.OnTimer := TimerProc;
slepos:=slepos+periode;
j:=j+1;
end
else begin end;
end;
procedure TForm1.TimerProc(Sender: TObject);
var
Comp : TComponent;
Name : string;
Shape : TShape;
Nummer : integer;
begin
Nummer := (Sender as TTimer).Tag;
Name := 'Shape' + IntToStr(Nummer);
Comp := FindComponent(Name);
Shape := TShape(Comp);
edit1.text:=inttostr(shape.top);
if (untenshape=false) AND (rechtsshape=false) then
begin
Shape.top:=Shape.top-5;
end;
if (untenshape=true) AND (rechtsshape=false) then
begin
Shape.top:=Shape.top+5;
end;
if (Shape.top+Shape.height)>=(shape1.top+shape1.height) then
begin
untenshape:=true;
end;
if (Shape.top)<=(shape1.top) then
begin
untenshape:=false;
end;
if (Shape.left+Shape.width)>=(shape1.left+shape1.width) then
begin
rechtsshape:=true;
end;
end;
MfG Blck