Selected = False wenn Click außerhalb Komponente

[owolicious]

Hi,
also ich habe mir eine eigene Komponente gebastelt.
Sind im groben Shapes. Ich habe nun noch eine Eigenschaft (selected mit boolean) hinzugefügt. sobald ein shape selected ist erscheinen vier kleine weise vierecke an den ecken um die größe zu verändern.
das shape wird selected sobald ich mit der maus upclicke :) also bei onmouseup (ist auch schon in der komponente definiert)
wie mache ich es jetzt am besten dass wenn ein click auf den hintergrund erfolgt das die komponente selected = false wird. mache ich das am besten im hauptprogramm oder in der komponente? (auch im hinblick darauf das später mehrere objekte mit z.b. shift gehaltener taste markiert werden sollen)

merci beaucoup

:) owolicious

[sirius]

Von wo hast du denn deine Komponente abgeleitet?
Ein TWincontrol liefert das Ergeignis onExit mit, das kannst du ja auswerten.
Oder du reagierst auf die message CM_EXIT;

[owolicious]

Delphi-Quellcode:

TShape1 = class(TShape)

d.h. doch dass ich es von tShape abegeleitet habe oder??? :?:

[sirius]

Ja, das heist es.
Und Tshape ist von TGraphiccontrol, was widerum von TControl ist, usw...
Demnach hast du kein onExit-Ereignis.

Hmm, jetzt wirds schwieriger. TGraphiccontrol ist nicht auf Benutzerinteraktion ausgelegt. Entweder du baust um auf TWincontrol, oder du musst es irgendwie anders umgehen, indem du alle Nachrichten auf das Formular auswertest.

[Hawkeye219]

Hallo owolicious,

ich würde einen anderen Weg wählen und die Verwaltung der selektierten Controls auslagern. Die Komponente TStretchHandle ist zwar schon ziemlich alt, sie funktioniert aber auch mit den aktuellen Delphi-Versionen noch zuverlässig. Vielleicht löst sie ja bereits dein Problem.

Gruß Hawkeye

[owolicious]

hmmm wie kann man den TShape auf TWinControl umbauen??

[sirius]

Auf die Schnelle fällt mir nur das ein (ist sicherlich verbesserungswürdig):

Delphi-Quellcode:

type tShape1=class(Twincontrol)
       Shape:Tshape;
       procedure Exit(var msg:TMessage);message cm_exit;
       procedure Button(var msg:TMessage);message wm_lbuttondown;
       constructor create(Aowner:Tcomponent);override;
       destructor destroy;
end;

//....

constructor Tshape1.create;
begin
  inherited create(Aowner);
  shape:=Tshape.Create(self);
  shape.Parent:=self;
  shape.Align:=alclient;
  shape.Enabled:=false;
  self.TabStop:=true;
end;

destructor Tshape1.destroy;
begin
  shape.Free;
  inherited;
end;

procedure TShape1.Exit;
begin
  showmessage('Exit');
end;

procedure TShape1.button;
begin
  self.SetFocus;
end;

[owolicious]

hmm aber da sagt er jetzt das er die methode paint nicht gefunden hat in der basis klasse


hier mal mein code:

Delphi-Quellcode:

unit Shape2;

interface

uses
  SysUtils, Classes, Controls, ExtCtrls, Graphics;

type
  TShapeType = (stRechteck, stDreieck, stProzess);

  TShape1 = class(TWinControl)
    Shape   :  TShape;
  private
    { Private declarations }
    FShape    : TShapeType;
    FCaption  : String;
    FSelected : Boolean;

    rx, ry,
    oH, oW,
    oL, oT    : Integer;

    procedure SetShape(Value : TShapeType);
    procedure SetCaption(Value : String);
    procedure SetSelection(Value : Boolean);
  protected
    { Protected declarations }
     protected procedure Paint();override;
     protected procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
     protected procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
     protected procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
  public
    { Public declarations }
  published
    { Published declarations }
    property Shape: TShapeType read FShape write SetShape;
    property Caption: String read FCaption write SetCaption;
    property Selected: Boolean read FSelected write SetSelection;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TShape1]);
end;

procedure TShape1.SetShape(Value : TShapeType);
begin
  FShape := Value;
end;

procedure TShape1.SetCaption(Value : String);
begin
  FCaption := Value;
end;

procedure TShape1.SetSelection(Value : Boolean);
begin
  FSelected := Value;
  Paint;
end;

procedure TShape1.Paint();
var sw, sh: Integer;
begin
    Canvas.Brush.Color  := clWhite;
    Canvas.FillRect(Rect(0,0,self.Width, self.Height));
    sw := self.Width -1;
    sh := self.Height -1;
    Canvas.Brush.Color  :=  self.Brush.Color;
    Canvas.Font.Color   :=  $00FFFFFF;
    Canvas.Font.Style   :=  [fsBold];

    if Self.Shape = stRechteck then begin
      Canvas.Polygon([Point(4, 4), Point(Self.ClientWidth-4, 4), Point(Self.ClientWidth-4, Self.ClientHeight-4), Point(4, Self.ClientHeight-4)]);
    end;

    If Self.Shape = stDreieck then begin
      Canvas.Polygon([Point(4, Trunc(Self.ClientHeight / 2)-4), Point(Self.ClientWidth-4, 4), Point(Self.ClientWidth-4, Self.ClientHeight-4)]);
    end;

    If Self.Shape = stProzess then begin
      Canvas.Polygon([Point(4,4), Point(Trunc(0.85 * Self.Width),4), Point(Self.Width-4,Trunc(Self.Height / 2)), Point(Trunc(0.85 * Self.Width), Self.Height-4), Point(4,Self.Height-4), Point(Trunc(0.15*Self.Width),Trunc(Self.Height / 2))]);
    end;

    If Self.Selected = True then begin
      Canvas.Pen.Style  :=  psDot;
      Canvas.Pen.Color  :=  $00999999;
      Canvas.Brush.Style:=  bsClear;
      Canvas.Polyline([
        Point(0,0),
        Point(sw,0),
        Point(sw,sh),
        Point(0,sh),
        Point(0,0)
        ]);

      Canvas.Pen.Style  :=  psSolid;
      Canvas.Pen.Color  :=  $00000000;
      Canvas.Brush.Color  :=  $00FFFFFF;

      //Ecken [] zeichnen
      Canvas.Rectangle(0,0,8,8);
      Canvas.Rectangle(self.ClientWidth-8,0,self.ClientWidth,8);
      Canvas.Rectangle(0,self.ClientHeight-8,8,self.ClientHeight);
      Canvas.Rectangle(self.ClientWidth-8,self.ClientHeight-8,self.ClientWidth,self.ClientHeight);

      Canvas.Rectangle(Trunc(self.Width /2)-4,0,Trunc(self.Width /2)+4,8);
      Canvas.Rectangle(Trunc(self.Width /2)-4,self.Height-8,Trunc(self.Width /2)+4,self.Height);
      Canvas.Rectangle(0,Trunc(Self.Height / 2)-4,8,Trunc(Self.Height / 2)+4);
      Canvas.Rectangle(self.Width-8,Trunc(Self.Height / 2)-4,self.Width,Trunc(Self.Height / 2)+4);
    end;

    Canvas.Brush.Style := bsClear;
    Canvas.TextOut(Trunc(self.Width / 2)-Trunc(Canvas.TextWidth(Caption) / 2), Trunc(self.Height / 2) - Trunc(Canvas.TextHeight(Caption) / 2), Self.Caption);
end;

procedure TShape1.MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
begin
  rx := X;
  ry := Y;

  oH  := self.Height;
  oW  := self.Width;
  oT  := self.Top;
  oL  := self.Left;

  Self.Selected := True;
  Paint;
end;

procedure TShape1.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if ((ssLeft in Shift) AND (self.Selected = True)) then begin
    //links oben
    if ((rx < 9) AND (ry < 9)) then begin
      self.Top := Mouse.CursorPos.Y -30 - Parent.Top - ry;
      self.Left := Mouse.CursorPos.X -4 - Parent.Left - rx;
      self.Height := oH+(oT - self.Top);
      self.Width  := oW+(oL - self.Left);
    //rechts oben
    end else if ((rx > oW-8) AND (ry < 9)) then begin
      self.Top := Mouse.CursorPos.Y - 30 - Parent.Top - ry;
      self.Height := oH+(oT - self.Top);
      self.Width  := Mouse.CursorPos.X -4 - Parent.Left - oL + (oW-rX);
    //rechts unten
    end else if ((rx > oW-8) AND (ry > oH -8)) then begin
      self.Top    :=  oT;
      self.Left   :=  oL;
      self.Height :=  Mouse.CursorPos.Y - 30 - Parent.Top - oT + (oH-rY);
      self.Width  :=  Mouse.CursorPos.X - 4 - Parent.Left - oL + (oW-rX);
    //links unten
    end else if ((rx < 9) AND (ry > oH -8)) then begin
      self.Top := oT;
      self.Left := Mouse.CursorPos.X -4 - Parent.Left - rx;
      self.Height :=  Mouse.CursorPos.Y - 30 - Parent.Top - oT + (oH-rY);
      self.Width  := oW+(oL - self.Left);
    //mitte oben
    end else if ((rx > Trunc(oW / 2)-4) AND (rx < Trunc(oW / 2)+4) AND (ry < 9)) then begin
      self.Top := Mouse.CursorPos.Y -30 - Parent.Top - ry;
      self.Height := oH+(oT - self.Top);
    //mitte links
    end else if ((rx < 9) AND (ry > Trunc(oH/2) -4) AND (ry < Trunc(oH/2)+4)) then begin
      self.Left := Mouse.CursorPos.X -4 - Parent.Left - rx;
      self.Width  := oW+(oL - self.Left);
    //mitte rechts
    end else if ((rx > oW-8) AND (ry > Trunc(oH/2) -4) AND (ry < Trunc(oH/2)+4)) then begin
      self.Width  := Mouse.CursorPos.X -4 - Parent.Left - oL + (oW-rX);
    //mitte unten
    end else if ((rx > Trunc(oW / 2)-4) AND (rx < Trunc(oW / 2)+4) AND (ry > oH -8)) then begin
      self.Top := oT;
      self.Height :=  Mouse.CursorPos.Y - 30 - Parent.Top - oT + (oH-rY);
    //sonst verschiebe nur
    end else begin
      self.Top := Mouse.CursorPos.Y - Parent.Top - ry-30;
      self.Left := Mouse.CursorPos.X - Parent.Left - rx-4;
    end;
  end;
end;

procedure TShape1.MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
begin
end;

end.

[sirius]

Vielleicht solltest du eher ein Twincontrol um dein TShape1 bauen. Also du machst dein Tshape1 wie gehabt, veröffnetlichst dann aber Tmyshape:

Delphi-Quellcode:

type 
  TShape1 = class(TShape) 
  private 
    { Private declarations } 
    FShape    : TShapeType; 
    FCaption  : String; 
//...
end;


type TMyShape=class(Twincontrol) 
       Shape:TShape1; 
       procedure Exit(var msg:TMessage);message cm_exit; 
       procedure Button(var msg:TMessage);message wm_lbuttondown; 
       constructor create(Aowner:Tcomponent);override; 
       destructor destroy; 
end;

Aber vielleicht gibts auch noch viel bessere Ideen...

[owolicious]

also erstmal vielen dank für eure hilfe :)

also ich habs mal so gemacht aber leider passiert nix beim klicken :)

Delphi-Quellcode:

interface

uses
  SysUtils, Classes, Controls, ExtCtrls, Graphics, Messages;

type
  TShapeType = (stRechteck, stDreieck, stProzess);

  TShape1 = class(TShape)
  private
    { Private declarations }
    FShape    : TShapeType;
    FCaption  : String;
    FSelected : Boolean;

    rx, ry,
    oH, oW,
    oL, oT    : Integer;

    procedure SetShape(Value : TShapeType);
    procedure SetCaption(Value : String);
    procedure SetSelection(Value : Boolean);
  protected
    { Protected declarations }
     protected procedure Paint();override;
     protected procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
     protected procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
     protected procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
  public
    { Public declarations }
  published
    { Published declarations }
    property Shape: TShapeType read FShape write SetShape;
    property Caption: String read FCaption write SetCaption;
    property Selected: Boolean read FSelected write SetSelection;

  end;

type TMyShape = class(TWinControl)
  Shape : TShape1;
       procedure Exit(var msg:TMessage);message cm_exit;
       procedure Button(var msg:TMessage);message wm_lbuttondown;
       constructor create(Aowner:Tcomponent);override;
       destructor destroy;
end;
procedure Register;

implementation

constructor TMyShape.create;
begin
  inherited create(Aowner);
  shape:=Tshape1.Create(self);
  shape.Parent:=self;
  shape.Enabled:=false;
  self.TabStop:=true;
end;

destructor TMyShape.destroy;
begin
  shape.Free;
  inherited;
end;

procedure TMyShape.Exit(var msg:TMessage);
begin
  self.Shape.Selected := false;
end;

procedure TMyShape.Button(var msg:TMessage);
begin
  self.Shape.Selected := true;
end;

[sirius]

Du musst den Fokus schon noch setzen:

Delphi-Quellcode:

procedure TMyShape.Button(var msg:TMessage); 
begin 
  self.Shape.Selected := true; 
  self.SetFocus; //Die Zeile hier, ansonsten weis das Control ja gar nicht, dass du da warst und löst Exit nicht aus.
end;

[owolicious]

nein hilft leider auch nichts :) ?!?

[owolicious]

also das mit dem left click funktioniert... das twincontrol war nur mit enabled:=false initialisiert

aber das mit dem exit funktioniert noch nicht...

[sirius]

Also bei mir hat es funktioniert. Lass dir mal irgendetwas ausgeben!

Edit: oder nimm mal statt cm_exit -->wm_killfocus
Dann musst du in der Methode noch msg.result:=0 setzen

[owolicious]

sorry hab ich geirrt funktioniert mit dem leftclick doch nicht...


hier nochmal mein ganzer unübersichtlicher code ;)

Delphi-Quellcode:

unit Shape2;

interface

uses
  SysUtils, Classes, Controls, ExtCtrls, Graphics, Messages;

type
  TShapeType = (stRechteck, stDreieck, stProzess);

  TShape1 = class(TShape)
  private
    { Private declarations }
    FShape    : TShapeType;
    FCaption  : String;
    FSelected : Boolean;

    rx, ry,
    oH, oW,
    oL, oT    : Integer;

    procedure SetShape(Value : TShapeType);
    procedure SetCaption(Value : String);
    procedure SetSelection(Value : Boolean);
  protected
    { Protected declarations }
     protected procedure Paint();override;
     protected procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
     protected procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
     protected procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
  public
    { Public declarations }
  published
    { Published declarations }
    property Shape: TShapeType read FShape write SetShape;
    property Caption: String read FCaption write SetCaption;
    property Selected: Boolean read FSelected write SetSelection;

  end;

type TMyShape = class(TWinControl)
  Shape : TShape1;
       procedure Exit(var msg:TMessage);message cm_exit;
       procedure Button(var msg:TMessage);message wm_lbuttondown;
       constructor create(Aowner:Tcomponent);override;
       destructor destroy;
end;
procedure Register;

implementation

constructor TMyShape.create;
begin
  inherited create(Aowner);
  shape:=Tshape1.Create(self);
  self.Enabled:=true;
  self.TabStop:=true;
  with self.Shape do begin
    Parent:= self;
    Enabled := true;
    Shape := stProzess;
    Left  := 100;
    Top   := 100;
    Height:= 100;
    Width := 100;
    Brush.Color := $005555FF;
    Show;
  end;
end;

destructor TMyShape.destroy;
begin
  shape.Free;
  inherited;
end;

procedure TMyShape.Exit(var msg:TMessage);
begin
  self.Shape.Selected := false;
end;

procedure TMyShape.Button(var msg:TMessage);
begin
  self.Shape.Selected := true;
  self.SetFocus;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TShape1]);
end;

procedure TShape1.SetShape(Value : TShapeType);
begin
  FShape := Value;
end;

procedure TShape1.SetCaption(Value : String);
begin
  FCaption := Value;
//  Paint;
end;

procedure TShape1.SetSelection(Value : Boolean);
begin
  FSelected := Value;
  Paint;
end;

procedure TShape1.Paint();
var sw, sh: Integer;
begin
    Canvas.Brush.Color  := clWhite;
    Canvas.FillRect(Rect(0,0,self.Width, self.Height));
    sw := self.Width -1;
    sh := self.Height -1;
    Canvas.Brush.Color  :=  self.Brush.Color;
    Canvas.Font.Color   :=  $00FFFFFF;
    Canvas.Font.Style   :=  [fsBold];

    if Self.Shape = stRechteck then begin
      Canvas.Polygon([Point(4, 4), Point(Self.ClientWidth-4, 4), Point(Self.ClientWidth-4, Self.ClientHeight-4), Point(4, Self.ClientHeight-4)]);
    end;

    If Self.Shape = stDreieck then begin
      Canvas.Polygon([Point(4, Trunc(Self.ClientHeight / 2)-4), Point(Self.ClientWidth-4, 4), Point(Self.ClientWidth-4, Self.ClientHeight-4)]);
    end;

    If Self.Shape = stProzess then begin
      Canvas.Polygon([Point(4,4), Point(Trunc(0.85 * Self.Width),4), Point(Self.Width-4,Trunc(Self.Height / 2)), Point(Trunc(0.85 * Self.Width), Self.Height-4), Point(4,Self.Height-4), Point(Trunc(0.15*Self.Width),Trunc(Self.Height / 2))]);
    end;

    If Self.Selected = True then begin
      Canvas.Pen.Style  :=  psDot;
      Canvas.Pen.Color  :=  $00999999;
      Canvas.Brush.Style:=  bsClear;
      Canvas.Polyline([
        Point(0,0),
        Point(sw,0),
        Point(sw,sh),
        Point(0,sh),
        Point(0,0)
        ]);

      Canvas.Pen.Style  :=  psSolid;
      Canvas.Pen.Color  :=  $00000000;
      Canvas.Brush.Color  :=  $00FFFFFF;

      //Ecken [] zeichnen
      Canvas.Rectangle(0,0,8,8);
      Canvas.Rectangle(self.ClientWidth-8,0,self.ClientWidth,8);
      Canvas.Rectangle(0,self.ClientHeight-8,8,self.ClientHeight);
      Canvas.Rectangle(self.ClientWidth-8,self.ClientHeight-8,self.ClientWidth,self.ClientHeight);

      Canvas.Rectangle(Trunc(self.Width /2)-4,0,Trunc(self.Width /2)+4,8);
      Canvas.Rectangle(Trunc(self.Width /2)-4,self.Height-8,Trunc(self.Width /2)+4,self.Height);
      Canvas.Rectangle(0,Trunc(Self.Height / 2)-4,8,Trunc(Self.Height / 2)+4);
      Canvas.Rectangle(self.Width-8,Trunc(Self.Height / 2)-4,self.Width,Trunc(Self.Height / 2)+4);
    end;

    Canvas.Brush.Style := bsClear;
    Canvas.TextOut(Trunc(self.Width / 2)-Trunc(Canvas.TextWidth(Caption) / 2), Trunc(self.Height / 2) - Trunc(Canvas.TextHeight(Caption) / 2), Self.Caption);
end;

procedure TShape1.MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
begin
  rx := X;
  ry := Y;

  oH  := self.Height;
  oW  := self.Width;
  oT  := self.Top;
  oL  := self.Left;

//  Self.Selected := True;
  Paint;
end;

procedure TShape1.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if ((ssLeft in Shift) AND (self.Selected = True)) then begin
    //links oben
    if ((rx < 9) AND (ry < 9)) then begin
      self.Top := Mouse.CursorPos.Y -30 - Parent.Top - ry;
      self.Left := Mouse.CursorPos.X -4 - Parent.Left - rx;
      self.Height := oH+(oT - self.Top);
      self.Width  := oW+(oL - self.Left);
    //rechts oben
    end else if ((rx > oW-8) AND (ry < 9)) then begin
      self.Top := Mouse.CursorPos.Y - 30 - Parent.Top - ry;
      self.Height := oH+(oT - self.Top);
      self.Width  := Mouse.CursorPos.X -4 - Parent.Left - oL + (oW-rX);
    //rechts unten
    end else if ((rx > oW-8) AND (ry > oH -8)) then begin
      self.Top    :=  oT;
      self.Left   :=  oL;
      self.Height :=  Mouse.CursorPos.Y - 30 - Parent.Top - oT + (oH-rY);
      self.Width  :=  Mouse.CursorPos.X - 4 - Parent.Left - oL + (oW-rX);
    //links unten
    end else if ((rx < 9) AND (ry > oH -8)) then begin
      self.Top := oT;
      self.Left := Mouse.CursorPos.X -4 - Parent.Left - rx;
      self.Height :=  Mouse.CursorPos.Y - 30 - Parent.Top - oT + (oH-rY);
      self.Width  := oW+(oL - self.Left);
    //mitte oben
    end else if ((rx > Trunc(oW / 2)-4) AND (rx < Trunc(oW / 2)+4) AND (ry < 9)) then begin
      self.Top := Mouse.CursorPos.Y -30 - Parent.Top - ry;
      self.Height := oH+(oT - self.Top);
    //mitte links
    end else if ((rx < 9) AND (ry > Trunc(oH/2) -4) AND (ry < Trunc(oH/2)+4)) then begin
      self.Left := Mouse.CursorPos.X -4 - Parent.Left - rx;
      self.Width  := oW+(oL - self.Left);
    //mitte rechts
    end else if ((rx > oW-8) AND (ry > Trunc(oH/2) -4) AND (ry < Trunc(oH/2)+4)) then begin
      self.Width  := Mouse.CursorPos.X -4 - Parent.Left - oL + (oW-rX);
    //mitte unten
    end else if ((rx > Trunc(oW / 2)-4) AND (rx < Trunc(oW / 2)+4) AND (ry > oH -8)) then begin
      self.Top := oT;
      self.Height :=  Mouse.CursorPos.Y - 30 - Parent.Top - oT + (oH-rY);
    //sonst verschiebe nur
    end else begin
      self.Top := Mouse.CursorPos.Y - Parent.Top - ry-30;
      self.Left := Mouse.CursorPos.X - Parent.Left - rx-4;
    end;
  end;
end;

procedure TShape1.MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
begin
end;

end.

und so erstelle ich die shapes

Delphi-Quellcode:

  SetLength(Shapes,1);

  for i := 0 to high(Shapes) do begin
    Shapes[i] := TMyShape.Create(self);
    Shapes[i].Parent := self;

  with Shapes[i].Shape do begin
      Parent:= self;
      Shape := stProzess;
      Left  := 100;
      Top   := 100;
      Height:= 100;
      Width := 100;
      Brush.Color := $005555FF;
      Show;
  end;
  end;

[sirius]

Delphi-Quellcode:

  with self.Shape do begin 
    Parent:= self; 
    Enabled := false; //sonst liegt das Shape über unserem Twincontrol und nix funktioniert
    Shape := stProzess; 
    {Left  := 100; 
    Top   := 100; 
    Height:= 100; 
    Width := 100;}
    align := alclient; //reicht und dann musst du nur von aussen, die Größe von Twincontrol anpassen 
    Brush.Color := $005555FF; 
    Show; 
  end;

Edit: Du benutzt ja TShape nicht wirklich.
Dann anders: Lass das mit dem TmyShape und nehme Exit und Button mit in TShape1 und leitest das von TCustomControl (Nachfahr von Twincontrol) ab.

[owolicious]

also das exit funzt immer noch nich :) aber das selecten...
allerdings kann ich jetzt die größe nich mehr ändern bzw das shape verschieben.
wie verbinde ich dass denn jetzt?

vielen dank für deine hilfe!!!!!

[sirius]

Also, ich bin jetzt auch in neuen Gewässern. Aber da michs interessiert probiere ich gerne weiter mit.

Die Variante TShape1 und TmyShape funktioniert bei mir mit Selecten und Exit. Das verschieben natürlich nicht, weil ich da im falschen Bereich bin.


Ich hab jetzt mal Variante2 gemacht (alles auf Tcustoncontrol):

Delphi-Quellcode:

uses
  SysUtils, Classes, Controls, ExtCtrls, Graphics, Messages, Types;

type
  TShapeType = (stRechteck, stDreieck, stProzess);

  TShape1 = class(TCustomControl)  //<-- Achtung hier TcustomControl
  private
    { Private declarations }
    FShape    : TShapeType;
    FCaption  : String;
    FSelected : Boolean;

    rx, ry,
    oH, oW,
    oL, oT    : Integer;

    procedure SetShape(Value : TShapeType);
    procedure SetCaption(Value : String);
    procedure SetSelection(Value : Boolean);
  protected
    { Protected declarations }
     protected procedure Paint();override;
     protected procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
     protected procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
     protected procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
     
     //Die beiden Window Message Behandlungsroutinen
     procedure onExit(var msg:TMessage);message cm_exit;
     procedure onButton(var msg:TMessage);message wm_lbuttondown;
  public
    { Public declarations }
  published
    { Published declarations }
    property Shape: TShapeType read FShape write SetShape;
    property Caption: String read FCaption write SetCaption;
    property Selected: Boolean read FSelected write SetSelection;

  end;


procedure Register;

implementation


procedure TShape1.onExit(var msg:TMessage);
begin
  self.Selected := false;
end;

procedure TShape1.onButton(var msg:TMessage);
begin
  self.Selected := true;
  self.SetFocus;
end; 

procedure Register; 
begin
  RegisterComponents('Samples', [TShape1]); 
end; 

procedure TShape1.SetShape(Value : TShapeType);
begin
  FShape := Value;
end;

procedure TShape1.SetCaption(Value : String);
begin
  FCaption := Value;
//  Paint;
end;

procedure TShape1.SetSelection(Value : Boolean);
begin
  FSelected := Value;
  Paint;
end;

procedure TShape1.Paint();
var sw, sh: Integer; 
begin
  //was hier halt so steht
end; 

procedure TShape1.MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); 
begin 
  rx := X; 
  ry := Y; 

  oH  := self.Height; 
  oW  := self.Width; 
  oT  := self.Top;
  oL  := self.Left;

//  Self.Selected := True;
  Paint;
end;

procedure TShape1.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  //hier rechnest du falsch, benutze evtl. mal Screentoclient
end;

procedure TShape1.MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); 
begin 
end; 

end.

Das Selektieren und "ab-"selektieren funktioniert wenn ich so starte:

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
begin
  shape1:=Tshape1.Create(self);
  shape2:=tshape1.Create(self);
  with shape1 do begin
    left:=10;
    top:=10;
    width:=100;
    height:=100;
    parent:=form1;
    Shape := stProzess;
    Brush.Color := $005555FF;
  end;
  with shape2 do begin
    left:=200;
    top:=10;
    width:=100;
    height:=100;
    parent:=form1;
    Brush.Color := $005555FF;
  end;
end;

Nur beim Verschieben, rechnest du irgendwie falsch.

[owolicious]

hab jetzt grad keine zeit es auszuprobieren :)

aber mal ne andere frage: würdest du das so machen um ein programm zu schreiben (für flussdiagramme) ?
oder anders: z.b. fällt mir grad ein man könnte einfach EIN canvas nehmen und alle draufmalen... und einfach speicher wo was wie ist... und dann immer den canvas neu zeichnen... obwohl das wird das verschieben wahrscheinlich wieder schwerer oder? ...
was meinst du?

danke

[owolicious]

also habs jetzt mal getestet: leider verschwinden die shapes wenn ich sie z.b. verschieben will... wenn ich sie allerdings nur ganz kurz anklicke dann funktioniert das mit dem selecten jetzt wenigstens schon ;)

[sirius]

Ja, das MouseMove ist falsch (wie ich bereits schrieb). Bei einer Bewegung verschindet das Teil mit einem Sprung Richtung NordWest aus dem Bildschirm raus. Debug mal dein MouseMove, dann siehst du was passiert!

Ob ich es so machen würde? Weis nicht. Hab noch nie sowas programmiert. Ich denke, daraus ein eigenes Objekt zu machen ist recht sinnvoll (Grafikprogramme brauchen nunmal viel RAM). Die Frage ist, ob man, wie es mein Vorschlag war, gleich ein TWincontrol draus machen muss. Die andere Möglichkeit ist eben ein TGraphicControl zu nehmen (was du ja ursprünglich mit TShape hattest). Ein TGraphiccontrol bekommt halt leider nicht solche Nachrichten wie CM_Exit, dafür verbraucht es auch weniger Ressourcen als ein TWincontrol.

Was ich mir auch noch überlegt habe ist, ob dieses Verschieben und so nicht schon irgendwie in den TXXXControls mit implementiert ist.
Ich habe ja gehofft, dass sich nochmal jemand anderes hier zu Wort meldet, aber anscheinend haben das so viele noch nicht probiert.

Fazit: Ich würde das erstmal mit Twincontrol weiter verfolgen. Solange du unter 100 Objekten bleibst, dürfte das ok sein.

[owolicious]

hmmm also ob ich da unter 100 objekten bleibe is die frage... mit dem programm werden später wahrscheinlich ganze produktionsketten dargestellt. d.h. es kann denke ich leicht passieren dass man auf mehr als 100 objekte kommt...

hmm jetzt versuch ich dass nochmal mit dem twincontrol und dem tcustomcontrol... was war da nochmal besser?? bzw. vorteile nachteile?

danke

[sirius]

TCustomCtontrol ist die Erweiterung von TWinControl. die Erweiterung besteht im "Paint", was bei Tcustomcontrol möglich ist.

Schau dir mal die Hierarchien an:

TObject -> TPersistant -> TComponent -> TControl -> TWincontrol -> TCustomControl
oder für reine Grafik:
TObject -> TPersistant -> TComponent -> TControl -> TGraphicControl

Du musst dir etwa vorstellen das dann jedes deiner Objekte von der Hierarchie etwa einem Button ähneln:
TObject -> TPersistant -> TComponent -> TControl -> TWincontrol -> TButtonControl -> TButton


Über 100? Hmmm... Ich weis nicht, vielleicht ist auch der Link in Post #3 oder #4 interessant. Die Entscheidung kann ich dir nicht abnehmen. Hab ich zu wenig Erfahrung.

[owolicious]

hmm also inzwischen klappt das schon so wie ich will... fast zumindest :)

aber: wenn ich objekte vergrößer oder verkleiner flackert dass total ?!? weisst du da ne lösung?

merci

[sirius]

Da könnte das property doublebuffered (oder so ähnlich) helfen. Das kannst du mit dem selected zusammen setzen, damit nicht alle (unbenutzten) Objekte doublebuffered sind, weil das ja auch wieder Speicher benötigt.

[owolicious]

sehr gute idee :) hat funktioniert... :) danke!!!