|
Registriert seit: 14. Nov 2005 561 Beiträge RAD-Studio 2009 Ent |
#17
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!?
|
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |