Einzelnen Beitrag anzeigen

merlin2004

Registriert seit: 11. Sep 2006
5 Beiträge
 
#1

TShape an Größe von TForm oder TImage anpassen

  Alt 26. Okt 2007, 23:15
Hi,

ich habe folgendes Problem:

Ich benutze ein TImage und lade mir ein Picture rein. (TImageAlign = alClient)
Über dem Image zeichne ich zur Laufzeit ein neues TShape an die Position des Mauszeigers.
Das Shape kann ich auch mit der Maus verschieben etc. geht alles.
Jetzt soll aber die Position des Shapes immer an die Größe des darunter liegenden Images angepasst werden (also wenn ich die Formgröße verändere).
Ich bekomme das nicht hin, weil ich nicht weiß wie ich den Resize an meine selbst erzeugte Tshape Komponente weitergeben kann.

Hat jemand eine Idee?
Anbei der Quellcode - die Mauspoition stimmt noch nicht ganz, aber das ist momentan Nebensache.


Gruß Merlin


Code:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, Menus, ComCtrls;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    NeuesRechteck: TMenuItem;
    StatusBar1: TStatusBar;
    Image1: TImage;
    procedure NeuesRechteckClick(Sender: TObject);
    procedure ShapeMouseOver(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure ShapeMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
    procedure ShapeMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);

  private
    { Private-Deklarationen }
  public
    p: TPoint;
    schieben: Boolean;
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  p.X := X;
  p.Y := Y;
end;

procedure TForm1.NeuesRechteckClick(Sender: TObject);
var
  MyShape: TShape;
begin
    MyShape := TShape.Create(Self);
    MyShape.Parent := Self;
    MyShape.Width := 20;
    MyShape.Height := 20;
    MyShape.Pen.Color:=clBlue;
    MyShape.Brush.Color:=clBlue;
    MyShape.Shape := stRectangle;
    MyShape.Left := p.X;
    MyShape.Top := p.Y;
    MyShape.visible := true;
    MyShape.Enabled := true;
    MyShape.Pen.Style := psSolid;
    MyShape.OnMouseMove := ShapeMouseOver;
    MyShape.OnMouseDown := ShapeMouseDown;
    MyShape.OnMouseUp := ShapeMouseUp;
end;

procedure TForm1.ShapeMouseOver(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if schieben then
  begin
    With TShape(sender) do
    begin
      left := left + X;
      top := top + Y;
    end;
  end;
end;

procedure TForm1.ShapeMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  schieben := true;
  p:= Point(x,y);
end;

procedure TForm1.ShapeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  schieben := false;
end;


end.
  Mit Zitat antworten Zitat