Einzelnen Beitrag anzeigen

thomas274

Registriert seit: 22. Sep 2010
10 Beiträge
 
#12

AW: Frage zur Komponentenerstellung graphisch

  Alt 23. Sep 2010, 19:54
Ok, ich poste hier nochmal den kompletten code des Ovals und der Oberklasse Tgeoform, die von Tgraphiccontrol abgeleitet ist

Delphi-Quellcode:
unit GraphicControl1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, mGeoForm, StdCtrls;

type
  toval = class(tgeoform)
  private
  

  public

    x1,x2,y1,y2:integer;
    zeichenflaeche:tform;
    constructor Create(AOwner:Tcomponent);override;
    procedure paint();override;
  procedure MyMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftstate;x,y : integer); override;
  procedure MyMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); override;
  procedure MyMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer) ; override;
  end;

implementation

constructor toval.Create(AOwner:Tcomponent);
begin
inherited ;

x1:=50;
y1:=50;
x2:=150;
y2:=100;
//zeichenflaeche:=f;
{OnMouseDown := MyMouseDown;
OnMouseMove := MyMouseMove;
OnMouseUp := MyMouseup; }


end;

procedure toval.MyMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer) ;
begin

// end;


end;
procedure toval.MyMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin

end;

procedure toval.MyMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer) ;
  begin
Canvas.Ellipse(x1+40,y1+40,x2+40,y2+40);
  end;

procedure toval.paint();
var vFuellfarbe,vRandfarbe : Tcolor;
begin
vFuellfarbe := self.Fuellfarbe;
vRandfarbe := self.Randfarbe;
Canvas.Brush.Color := vFuellfarbe;
Canvas.Pen.Color := vRandfarbe;
Canvas.Pen.Width := 3;
Canvas.Ellipse(x1,y1,x2,y2);

end;

end.
und hier der quellcode der oberklasse tgeoform


Delphi-Quellcode:
unit mGeoForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TGeoForm = class(TGraphicControl)
  // Basis aller graphischen Komponenten ohne eigenes Fenster.
  // Sie kapselt ein Canvasobjekt und eine paint-Methode.
  private
    FRandfarbe: TColor;
    FFuellfarbe: TColor;
    procedure SetFuellfarbe(const Value: TColor);
    function GetFuellfarbe: TColor;
    procedure SetRandfarbe(const Value: TColor);
    function GetRandfarbe: TColor;
  protected

    procedure MyMouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftstate;x,y : integer); virtual;

  procedure MyMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); virtual;

  procedure MyMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer) ; virtual;

    const ZIEH_RECT_LAENGE = 10;
    procedure Paint; virtual;
    function PunktZiehen(Punkt: TPoint): Boolean; virtual;
    function PunktBewegen(Punkt: TPoint): Boolean; virtual;
  public
  x1,x2,y1,y2:integer;
  zeichenflaeche:tform;
    constructor Create(AOwner: TComponent);virtual;

  published
  property Fuellfarbe : TColor read GetFuellfarbe write SetFuellfarbe;
  property Randfarbe : TColor read GetRandfarbe write SetRandfarbe;
  property OnMouseDown ;
  property OnMouseMove;
  property OnMouseUp;
end;

procedure Register; // registrieren der Komponente

implementation

procedure Register;
begin
  RegisterComponents('GeoForm', [TGeoForm]);
  // erster Parameter: Name des Registers der Componentenpalette, in das die Komponente eingefügt werden soll.
  // zweiter Parameter: Aufführen der Komponentenklassen, die registriert werden sollen.
end;

constructor TGeoForm.Create(AOwner: TComponent);
begin
  FFuellfarbe:=clWhite;
  FRandfarbe:=clBlack;
  Top:=0;
  Left:=0;
  Width:=100;
  Height:=50;
  OnMouseDown := MyMouseDown;
OnMouseMove := MyMouseMove;
OnMouseUp := MyMouseUp ;
end;

function TGeoForm.GetFuellfarbe: TColor;
begin
result:= FFuellfarbe;
end;

function TGeoForm.GetRandfarbe: TColor;
begin
result:= FRandfarbe;
end;

procedure TGeoForm.Paint;
begin
  inherited;
end;

function TGeoForm.PunktBewegen(Punkt: TPoint): Boolean;
begin
  Result := True;

end;

function TGeoForm.PunktZiehen(Punkt: TPoint): Boolean;
begin

  if (Punkt.X > Width -ZIEH_RECT_LAENGE) and (Punkt.X < Width)
  and (Punkt.Y > Height -ZIEH_RECT_LAENGE) and (Punkt.Y < Height) then
    Result := True
  else
    Result := False;
end;
{function TGeoForm.GetFuellfarbe : TColor;
begin
  result := FFuellfarbe;
end;        }

procedure TGeoForm.SetFuellfarbe(const Value: TColor);
begin
  FFuellfarbe := Value;
end;

procedure TGeoForm.SetRandfarbe(const Value: TColor);
begin
  FRandfarbe := Value;
end;

procedure tGeoform.MyMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer) ;

begin

//ShowMessage('Hallo');

end;

procedure tGeoform.MyMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);


begin

end;

procedure tGeoform.MyMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer) ;

begin

end;


end.
und zum schluss der aufruf im formular ( da kann es ja nur, wenn überhaupt, an dem aufruf liegen)

Delphi-Quellcode:
procedure TForm1.Button1Click(Sender: TObject);
begin
oval:=toval.create(self);
oval.Parent := Form1;
oval.Fuellfarbe := Colorbox1.Selected;
oval.Randfarbe := Colorbox2.Selected;
oval.Paint;

end;
  Mit Zitat antworten Zitat