uses ExtCtrls, ExtDlgs
type
BasisTyp=Record
Typ:Integer; // 1=Bild 2= Form
X,Y,Height,Width:Integer;
end;
BildTyp=Record
Typ:Integer;
X,Y,Height,Width:Integer;
Image:TBitmap;
end;
type
FormTyp=Record
Typ:Integer;
X,Y,Height,Width:Integer;
FormTyp:Integer; // 1 = RechtEck 2 = Ellipse
LinienFarbe,FuellFarbe:TColor;
end;
public
{ Public-Deklarationen }
Objekte:TList;
AnGewaehlt:Integer; // welches Objekt ist gerade angewählt
MausDown:boolean;
MausX,MausY:Integer;
procedure LoescheObjekt(Objekt:Pointer);
procedure NeuesBild(FileName:String);
procedure NeueForm(WelcheForm:Integer);
procedure PaintIt;
//
procedure TForm1.PaintIt;
var loop:Integer;
Basis:^BasisTyp;
bild:^BildTyp;
Form:^FormTyp;
begin
with Image1.Canvas do
begin
// Löschen
Brush.Color:=clWhite;
Pen.Color:=clWhite;
Rectangle(0,0,Image1.Width,Image1.Height);
for loop:=0 to Objekte.Count-1 do // das letzte zuerst zeichnen
begin
Basis:=Objekte[loop];
case Basis^.Typ of
1: begin
Bild:=Objekte[loop];
StretchDraw(Rect(Bild^.X,Bild^.Y,Bild^.X+Bild^.Width,Bild^.Y+Bild^.Height),Bild^.Image);
//Draw(Bild^.X,Bild^.Y,Bild^.Image);
end; // Bild;
2: begin
Form:=Objekte[loop];
Brush.Color:=Form^.FuellFarbe;
Pen.Color:=Form^.LinienFarbe;
case Form^.FormTyp of
1: Rectangle(Form^.X,Form^.Y,Form^.X+Form^.Width,Form^.Y+Form^.Height);
2: Ellipse(Form^.X,Form^.Y,Form^.X+Form^.Width,Form^.Y+Form^.Height);
end; // Rechteck oder Kreis
end; // Form
end; // case
if loop=AnGewaehlt then
begin
Brush.Style:=bsClear;
Pen.Color:=clRed;
Rectangle(Basis^.X,Basis^.Y,Basis^.X+Basis^.Width,Basis^.Y+Basis^.Height);
Brush.Style:=bsSolid;
end; // angewaehlt
end; // jedes Objekt
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
Objekte:=tList.Create;
Image1.Align:=alClient;
AngeWaehlt:=-1;
MausDown:=false;
end;
procedure TForm1.NeuesBild(FileName:String);
var Bild:^BildTyp;
begin
New(Bild);
with Bild^ do
begin
Typ:=1;
X:=0;
y:=0;
Image:=TBitmap.Create;
Image.LoadFromFile(FileName);
Width:=Image.Width;
Height:=Image.Height;
caption:=inttostr(height);
end;
Objekte.Add(Bild);
AnGewaehlt:=Objekte.Count-1; // das neueste
end;
procedure TForm1.NeueForm(WelcheForm:Integer);
var Form:^FormTyp;
begin
New(Form);
with Form^ do
begin
Typ:=2;
X:=Random(Image1.ClientWidth div 2);
y:=Random(Image1.ClientHeight div 2);
Width:=Random(Image1.ClientWidth div 4)+10;
Height:=Random(Image1.ClientHeight div 4)+10;
FormTyp:=WelcheForm;
LinienFarbe:=clBlack;
FuellFarbe:=clBlue;
end;
Objekte.Add(Form);
AnGewaehlt:=Objekte.Count-1;
end;
procedure TForm1.LoescheObjekt(Objekt:Pointer);
var Basis:^BasisTyp;
bild:^BildTyp;
Form:^FormTyp;
begin
Basis:=Objekt;
case Basis^.Typ of
1: begin
Bild:=Objekt;
Bild^.Image.Free;
Dispose(bild);
end; // bild
2: begin
Form:=Objekt;
Dispose(Form);
end; // form
end; // case
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
while Objekte.Count>0 do
begin
LoescheObjekt(Objekte[0]);
Objekte.Delete(0);
end;
Objekte.Clear;
Objekte.Free;
end;
procedure TForm1.Image1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var loop:Integer;
Basis:^BasisTyp;
begin
MausDown:=true;
MausX:=X;
MausY:=Y;
for loop:= Objekte.Count-1 downto 0 do // das vorderste zuerst prüfen
begin
Basis:=Objekte[loop];
if X>Basis^.X then if X<Basis^.X+Basis^.Width then
if Y>Basis^.Y then if Y<Basis^.Y+Basis^.Height then
begin
AnGewaehlt:=loop;
PaintIt;
exit; // raus
end; // gefunden
end;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var Basis:^BasisTyp;
begin
if AnGewaehlt=-1 then Exit; // noch kein Objekt
Basis:=Objekte[AnGewaehlt];
if not (ssShift in Shift) then
begin
if key=vk_Left then Dec(Basis^.X,5);
if key=vk_Right then Inc(Basis^.X,5);
if key=vk_Up then Dec(Basis^.Y,5);
if key=vk_Down then Inc(Basis^.Y,5);
end else begin
if key=vk_Left then Dec(Basis^.Width,5);
if key=vk_Right then Inc(Basis^.Width,5);
if key=vk_Up then Dec(Basis^.Height,5);
if key=vk_Down then Inc(Basis^.Height,5);
end;
if key=vk_F1 then // nach hinten
begin
Objekte.Move(AnGewaehlt,0);
AnGewaehlt:=0;
end;
if key=vk_F2 then // nach vorne
begin
Objekte.Move(AnGewaehlt,Objekte.Count-1);
Angewaehlt:=Objekte.Count-1;
end;
PaintIt;
end;
procedure TForm1.Image1MouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
MausDown:=false;
end;
procedure TForm1.Image1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var Basis:^BasisTyp;
begin
if MausDown then
begin
if AnGewaehlt=-1 then Exit; // noch kein Objekt
Basis:=Objekte[AnGewaehlt];
caption:=inttostr(MausX-X);
Basis^.X:=Basis^.X+(X-MausX);
Basis^.Y:=Basis^.Y+(Y-MausY);
MausX:=X;
MausY:=Y;
PaintIt;
end;
end;
Rechteck :
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
NeueForm(1);
PaintIt;
end;
Kreis :
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
NeueForm(2);
PaintIt;
end;
Bild :
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
if PictureDialog.Execute then NeuesBild(PictureDialog.FileName);
PaintIt;
end;
Keine Kommentare:
Kommentar veröffentlichen