this slowpoke moves

Draw Vektor and Mode it

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

Beliebte Posts

Translate