Einzelnen Beitrag anzeigen

Benutzerbild von cherry
cherry

Registriert seit: 14. Nov 2005
561 Beiträge
 
RAD-Studio 2009 Ent
 
#17

Re: Eigene Komponente von TCustomControl > Eigenschaftsed

  Alt 18. Apr 2006, 11:58
So, ich gebs auf.. Kann mir jmd helfen?
Das mit Font funzt immer noch nicht und ich werd nicht Schlau dabei... ich habs sicher schon auf 100 verschiedene
arten versucht..
Wenn mann diese Version so wie sie her Steht Compiliert kann man, wenn man den Eigenschaftseditor nicht aufruft
die Schrift teils verändern, eg. Style usw.
Ändert man sie jedoch durch den EigenschaftsEditor wird die Font zwär geändert, gibt aber trotzdem eine Zugriffsverletzung aus!
Ich kriegs nicht hingebogen..
Bitte um hilfe...

Delphi-Quellcode:
unit EButton;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, Graphics, Messages, Dialogs;

type
  TEnemyleftKind = (Button, ArrowRight, ArrowLeft, Ellipse, PNG);

  TEButton = class(TCustomControl)
  private
    { Private-Deklarationen }
    { Deklarationen der Variablen für die Propertys! }
    FEFont : TFont;
   // FEFontOver : TFont;
   // FEFontDown : TFont;
    FEColor : TColor;
    FEColorOver : TColor;
    FEColorDown : TColor;
    FEBrushStyle : TBrushStyle;
    FEBrushStyleOver : TBrushStyle;
    FEBrushStyleDown : TBrushStyle;
    FEPenColor : TColor;
    FEPenColorOver : TColor;
    FEPenColorDown : TColor;
    FEnemyleftKind : TEnemyleftKind;
    FEnemyleftKindOver : TEnemyleftKind;
    FEnemyleftKindDown : TEnemyleftKind;

    EMouseOver : Boolean;

    FEOnMouseDown : TNotifyEvent;
    FEOnMouseUp : TNotifyEvent;
    EMouseDown : Boolean;

    { Deklarationen der Procedures der Propertys
      Die folgenden Procedures verarbeiten erhaltene Propertywerte }


    { Die Zwei folgenden Prozeduren }
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    //procedure SetEFont(const Value: TFont);
    //procedure SetEFontOver(const Value: TFont);
    //procedure SetEFontDown(const Value: TFont);
    procedure SetEColor(const Value: TColor);
    procedure SetEColorOver(const Value: TColor);
    procedure SetEColorDown(const Value: TColor);
    procedure SetEBrushStyle(const Value: TBrushStyle);
    procedure SetEBrushStyleOver(const Value: TBrushStyle);
    procedure SetEBrushStyleDown(const Value: TBrushStyle);
    procedure SetEPenColor(const Value: TColor);
    procedure SetEPenColorOver(const Value: TColor);
    procedure SetEPenColorDown(const Value: TColor);

    procedure SetEOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure SetEOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  protected
    { Protected-Deklarationen }
    procedure Paint; override;
  public
    { Public-Deklarationen }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published-Deklarationen }

    { Propertys, Einstellungen die zur entwicklungszeit vorgenommen werden können.
      z.B. bei EFont und EColor [E für Enemyleft^^], werden standardmässige Eigenschafts-
      editoren angezeigt. Sprich Schrift / Farbeditor usw.
      write: geschrieben wird nicht einfach der "Wert" als solches, sonder über eine Prozedur.}


    property EFont: TFont read FEFont write FEFont;
    //property EFontOver: TFont read FEFontOver write SetEFontOver;
    //property EFontDown: TFont read FEFontDown write SetEFontDown;
    property EColor: TColor read FEColor write SetEColor;
    property EColorOver: TColor read FEColorOver write SetEColorOver;
    property EColorDown: TColor read FEColorDown write SetEColorDown;
    property EBrushStyle : TBrushStyle read FEBrushStyle write SetEBrushStyle;
    property EBrushStyleOver : TBrushStyle read FEBrushStyleOver write SetEBrushStyleOver;
    property EBrushStyleDown : TBrushStyle read FEBrushStyleDown write SetEBrushStyleDown;
    property EPenColor : TColor read FEPenColor write SetEPenColor;
    property EPenColorOver : TColor read FEPenColorOver write SetEPenColorOver;
    property EPenColorDown : TColor read FEPenColorDown write SetEPenColorDown;
    property EnemyleftKind: TEnemyleftKind read FEnemyleftKind write FEnemyleftKind;
    property OnMouseDown: TNotifyEvent read FEOnMouseDown write FEOnMouseDown;
    property OnMouseUp: TNotifyEvent read FEOnMouseUp write FEOnMouseUp;

    { Diese Ereignisse wurden geerbt von TCustomControl und können
      deshald so simpel deklariert werden }

      
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseMove;
  end;

procedure Register;

implementation

procedure Register;
begin
  { Procedure wird bei der Komponenteninstallation verwendet! }
  RegisterComponents('enemyleft', [TEButton]);
end;

constructor TEButton.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 { Hier im Konstruktor wird das OnMouseDown/Up-Ereigniss der
   "oberen Klasse (inherited)" überschrieben }

 //DoubleBuffered := True; {Zeichen Prozesse werden sonst vielleicht in Zwischenstufen angezeigt - Flackern}
 FEFont := TFont.Create;
 inherited OnMouseDown := SetEOnMouseDown;
 inherited OnMouseUp := SetEOnMouseUp;
 //FEFont.Create;
 //FEFontOver := TFont.Create;
 //FEFontDown := TFont.Create;
 FEColor:=clWhite;
 FEColorOver:=clAqua;
 FEColorDown:=clBlack;
 FEBrushStyle:=bsSolid;
 FEBrushStyleOver:=bsDiagCross;
 FEBrushStyleDown:=bsDiagCross;
 FEPenColor:=clRed;
 FEPenColorOver:=clBlue;
 FEPenColorDown:=clYellow;
 EMouseOver:=false;
 EMouseDown:=false;
 Width:=75;
 Height:=25;
end;

destructor TEButton.Destroy;
begin
 FEFont.Free;
 inherited Destroy;
end;

procedure TEButton.Paint;

 { Methode Paint wird überschrieben, die diversen if abfragen sind nötig um
  Den Button korrekt zu Zeichen, trifft das Ereignis MouseDown, oder RollOver
  zu, wird der Button anders gezeichnet als in ComponentState(Entwicklungsumgebung)
   oder wenn kein Ereignis zutrifft. }


begin
 inherited;//Zeichen Procedure des Vorfahren aufrufen.
 if (csDesigning in ComponentState) or (not EMouseOver) then
 begin
  {Zeichung eines Rahmens}
  Canvas.Brush.Color := FEColor;
  Canvas.Brush.Style := FEBrushStyle;
  Canvas.Pen.Color := FEPenColor;
  Canvas.Rectangle(0,0,width,height);//Rechteck zeichnen

  {Namen der Komponente in die Mitte schreiben}
  canvas.Font := FEFont;
  canvas.TextOut((width - Canvas.TextWidth(Name)) div 2,(height - Canvas.TextHeight(Name)) div 2,name);

  {Keine weitern Zeichnungen mehr ausführen}
  //exit;//Verlässt die Procedure
 end
 else if (EMouseOver) then
 begin
  if (EMouseDown) then
  begin
   Canvas.Brush.Color := FEColorDown;
   Canvas.Brush.Style := FEBrushStyleDown;
   Canvas.Pen.Color := FEPenColorDown;
   Canvas.Rectangle(0,0,width,height);

   canvas.Font := FEFont;
   canvas.TextOut((width - Canvas.TextWidth(Name)) div 2,(height - Canvas.TextHeight(Name)) div 2,name);

   exit;
  end
  else
  begin
   Canvas.Brush.Color := FEColorOver;
   Canvas.Brush.Style := FEBrushStyleOver;
   Canvas.Pen.Color := FEPenColorOver;
   Canvas.Rectangle(0,0,width,height);

   canvas.Font := FEFont;
   canvas.TextOut((width - Canvas.TextWidth(Name)) div 2,(height - Canvas.TextHeight(Name)) div 2,name);

   exit;
  end;
 end;
end;

{ Proceduren (Selbsterklärens) }

procedure TEButton.CMMouseEnter(var Message: TMessage);
begin
 inherited;
 EMouseOver := true;
 RePaint;
end;

procedure TEButton.CMMouseLeave(var Message: TMessage);
begin
 inherited;
 EMouseOver := false;
 RePaint;
end;

{procedure TEButton.SetEFont(const Value: TFont);
begin
FEFont := Value;
RePaint;
end;   }


{procedure TEButton.SetEFontOver(const Value: TFont);
begin
FEFontOver := Value;
RePaint;
end;

procedure TEButton.SetEFontDown(const Value: TFont);
begin
FEFontDown := Value;
RePaint;
end;       }


procedure TEButton.SetEColor(const Value: TColor);
begin
 FEColor := Value;
 RePaint;
end;

procedure TEButton.SetEColorOver(const Value: TColor);
begin
 FEColorOver := Value;
 RePaint;
end;

procedure TEButton.SetEColorDown(const Value: TColor);
begin
 FEColorDown := Value;
 RePaint;
end;

procedure TEButton.SetEBrushStyle(const Value: TBrushStyle);
begin
 FEBrushStyle := Value;
 RePaint;
end;

procedure TEButton.SetEBrushStyleOver(const Value: TBrushStyle);
begin
 FEBrushStyleOver := Value;
 RePaint;
end;

procedure TEButton.SetEBrushStyleDown(const Value: TBrushStyle);
begin
 FEBrushStyleDown := Value;
 RePaint;
end;

procedure TEButton.SetEPenColor(const Value: TColor);
begin
 FEPenColor := Value;
 RePaint;
end;

procedure TEButton.SetEPenColorOver(const Value: TColor);
begin
 FEPenColorOver := Value;
 RePaint;
end;

procedure TEButton.SetEPenColorDown(const Value: TColor);
begin
 FEPenColorDown := Value;
 RePaint;
end;

{ Vor das Ereignis wird die Variable MouseDown, weleche einfluss auf
  auf die Procedure Paint hat auf true gesetzt. /
  Im Konstruktor wird mit "inherited OnMouseDown / UP := Proc" auf die jeweilige
  Procedure hingewiesen, die das Ereignis "steuert" }


procedure TEButton.SetEOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 EMouseDown := true;
 RePaint;
 if Assigned(FEOnMouseDown) then FEOnMouseDown(Sender);
end;

procedure TEButton.SetEOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 EMouseDown := false;
 RePaint;
 if Assigned(FEOnMouseUp) then FEOnMouseUp(Sender);
end;

end.
Ist das nur mein Gefühl, oder ist die ganze Welt verrückt geworden!?
  Mit Zitat antworten Zitat