Image auf Form dynamisch mit der Maus at run time erstellen ?

[Luckie]

Hast du ein Glück, dass ich nicht schlafen kann. Gebraucht wird nur eine Listbox (Listbox1) und eine Schaltfläche (Button1).

Delphi-Quellcode:

procedure TForm14.CreateImage;
  procedure Swap(var X1, X2: Integer);
  var
    Temp: Integer;
  begin
    Temp := X1;
    X1 := X2;
    X2 := Temp;
  end;
var
  Image: TImage;
begin
  SetLength(ImageArray, Length(ImageArray) + 1);
  Image := TImage.Create(nil);
  Image.Name := 'Image' + IntToStr(Length(ImageArray));
  Image.Parent := Form14;
  if (BottomRight.Y < TopLeft.Y) then
    Swap(BottomRight.Y, TopLeft.Y);
  if (BottomRight.X < TopLeft.X) then
    Swap(BottomRight.X, TopLeft.X);
  Image.Left := TopLeft.X;
  Image.Top := TopLeft.Y;
  Image.Height := BottomRight.Y - TopLeft.Y;
  Image.Width := BottomRight.X - TopLeft.X;
  //Image.Stretch := True;
  //Image.Proportional := True;
  Image.Picture.LoadFromFile('C:\Dokumente und Einstellungen\Michael\Eigene Dateien\Eigene Bilder\apollo_8earthrise_1280.bmp');
  ImageArray[High(ImageArray)] := Image;
end;

procedure TForm14.DeleteImages;
var
  i: Integer;
begin
  for i := High(ImageArray) downto 0 do
  begin
    ImageArray[i].Free;
  end;
  SetLength(ImageArray, 0);
end;

procedure TForm14.ListImages;
var
  i: Integer;
begin
  ListBox1.Items.Clear;
  for i := 0 to ControlCount - 1 do
  begin
    if (Controls[i] is TImage) then
    begin
      ListBox1.Items.Add(Format('%s (%d / %d)', [TImage(Controls[i]).Name, TImage(Controls[i]).Width, TImage(Controls[i]).Height]));
    end;
  end;
end;

procedure TForm14.Reset;
begin
  IsMouseDown := False;
  TopLeft.X := 0;
  TopLeft.Y := 0;
  BottomRight.X := 0;
  BottomRight.Y := 0;
end;

procedure TForm14.DrawImageBounds(X, Y: Integer);
begin
  if not Assigned(ImageBoundsRect) then
  begin
    ImageBoundsRect := TShape.Create(Form14);
    ImageBoundsRect.Parent := Form14;
    ImageBoundsRect.Shape := stRectangle;
    ImageBoundsRect.Brush.Style := bsClear;
    ImageBoundsRect.Pen.Width := 1;
    ImageBoundsRect.Pen.Color := clBlack;
    ImageBoundsRect.Pen.Style := psDash;
  end;
  ImageBoundsRect.Left := TopLeft.X;
  ImageBoundsRect.Top := TopLeft.Y;
  ImageBoundsRect.Width := X - TopLeft.X;
  ImageBoundsRect.Height := Y - TopLeft.Y;
end;

procedure TForm14.DeleteImageBounds;
begin
  FreeAndNil(ImageBoundsRect);
end;

procedure TForm14.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;
end;

procedure TForm14.FormDestroy(Sender: TObject);
begin
  DeleteImages;
end;

procedure TForm14.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  IsMouseDown := True;
  TopLeft.X := X;
  TopLeft.Y := Y;
end;

procedure TForm14.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if IsMouseDown then
  begin
    BottomRight.X := X;
    BottomRight.Y := Y;
    DrawImageBounds(X, Y);
  end;
end;

procedure TForm14.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if IsMouseDown then
  begin
    DeleteImageBounds;
    CreateImage;
    Reset;
    ListImages;
  end;
end;

procedure TForm14.Button1Click(Sender: TObject);
begin
  DeleteImages;
  ListImages;
end;

Die privaten Methoden der Form

Delphi-Quellcode:

procedure DrawImageBounds(X, Y: Integer);
procedure CreateImage;
procedure Reset;
procedure ListImages;
procedure DeleteImages;
procedure DeleteImageBounds;

Könnte man noch schön in einer Klasse packen, aber das überlasse ich dir.