Eigene Kompo / Dynamisch erstellt / Form best. erkennen

[Neutral General]

grml

Das dürfte egal sein.. Weil TCustomControls von Natur aus ein OnClick Erreignis haben das du im OI freischalten kannst indem du bei deiner Klasse unter published folgendes schreibst:

Delphi-Quellcode:

TMyKompo = class(TCustomControl)
private
 //...
public
 // ..
published
  property OnClick;
end;

Naja egal ob die Property jetzt Published ist oder nicht kannst du trotzdem den Code benutzen den ich dir da geschrieben habe...

[owolicious]

hmm leider funktioniert das ganze nur wenn ich die message wm_lbuttondown von der anderen prozedur wegnehme... leider müsste ich das jetzt in eine prozedur packen? oder gibts noch ne andere lösung?

[Neutral General]

Naja das Problem ist grad das ich deine Komponente zu schlecht kenne um da jetzt mehr sagen zu können

[owolicious]

das sollte kein problem sein

Delphi-Quellcode:

unit Shape3;

interface

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

type
  TShapeType = (stRechteck, stDreieck, stProzess);

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

    rx, ry,
    rXObj, rYObj,
    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;
     procedure onExit(var msg:TMessage);message cm_exit;
//     protected procedure onClick();
     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;
    property onClick;
  end;

procedure Register;

implementation

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

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

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

  rX  :=  Mouse.CursorPos.X-Parent.Left-Self.Left;
  rXObj := rX - 4;
  rY  :=  Mouse.CursorPos.Y-Parent.Top-Self.Top;
  rYObj := rY - 30;

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

  self.BringToFront;
end;

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

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

procedure TMyShape.SetSelection(Value : Boolean);
begin
  FSelected := Value;
  if Value = True then
    Self.DoubleBuffered := true
  else
    Self.DoubleBuffered := False;
  Invalidate;
end;

procedure TMyShape.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;

    if(self.Shape = stRechteck) then self.Brush.Color := clBlue;
    if(self.Shape = stProzess) then self.Brush.Color := clRed;
    if(self.Shape = stDreieck) then self.Brush.Color := clYellow;

    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)), 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 TMyShape.MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
begin
{  mp := ScreenToClient(Mouse.CursorPos);

  rX  :=  Mouse.CursorPos.X-Parent.Left-Self.Left;
  rY  :=  mp.Y;

  self.Caption := '.'+IntToStr(mp.X);

  oH  := self.Height;
  oW  := self.Width;
  oT  := self.Top;
  oL  := self.Left;    }
//  Self.Selected := True;
end;

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

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

end.

[Neutral General]

Ehm setz mal als erste Zeile von jeder Message Procedure ein

inherited; Hab auch mal ne Kompo gebaut wo ich Probleme hatte und das hat alle Probleme gelöst ^^

Gruß
Neutral General

[owolicious]

du bist klasse!!!

danke!!!