Selected = False wenn Click außerhalb Komponente

[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