|
Registriert seit: 7. Jul 2003 Ort: Stuttgart 163 Beiträge Delphi 6 Enterprise |
#1
Hallo!
Für meine Anwendung brauche ich eine CheckBox mit drei Zuständen. Diese Komponente habe ich schnell selbst geschrieben, stieß jedoch nun auf ein Phänomen, was ich mir nicht erklären kann: Wird beim Erzeugen der CheckBox der Wert Enabled auf FALSE gesetzt, kann ich dieses Flag zwar zur Laufzeit auf TRUE setzen, aber die CheckBox reagiert trotzdem nicht auf OnClick und OnMouseDown. Ist der Wert von Enabled hingegen beim Erstellen TRUE, kann ich es zwar auf FALSE setzen, OnClick und OnMouseDown sind aber dennoch aktiv. Und dabei habe ich das Enabled-Zeugs doch alles schön brav überschrieben! Vielleicht kann mir jemand von Euch etwas dazu schreiben... Hier meine Komponente:
Delphi-Quellcode:
Und hier der Aufruf:
unit UCKBM;
interface uses StdCtrls, ExtCtrls, Classes, Types, Controls, Messages; type TCheckBoxMulti = class(TCustomPanel) private FIMG: TImage; // Box FCaptionText: TLabel; // Text FFucusRect: TRect; // Focus-Rahmen FState: Integer; FEnabled: Boolean; FCaption: string; FFocus: Boolean; procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS; procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS; protected function GetEnabled: Boolean; override; function GetCaption: string; procedure Paint; override; procedure SetState(const Value: Integer); procedure SetEnabled(Value: Boolean); override; procedure SetCaption(const Value: string); procedure SetCheck(const Value: Integer); procedure ChangeChecked; procedure ResizeCaptionText; procedure KeyPress(var Key:Char); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure SubClick(Sender: TObject); procedure SubMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure SubMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure SubMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); public procedure SetFocus; override; constructor Create(AOwner:TComponent); override; destructor Destroy; override; published property Enabled: Boolean read GetEnabled write SetEnabled default True; property Caption: string read GetCaption write SetCaption; property State: Integer read FState write SetState; end; implementation uses Graphics; { TCheckBoxMulti } constructor TCheckBoxMulti.Create(AOwner: TComponent); var BorderBMP: TBitmap; begin inherited Create(AOwner); Height:= 17; Width:= 97; BevelOuter:= bvNone; FIMG:= TImage.Create(Self); FIMG.Parent:= Self; FIMG.Top:= Top+2; FIMG.Height:= 13; FIMG.Left:= 0; FIMG.Width:= 13; FIMG.OnMouseDown:= SubMouseDown; FIMG.OnMouseMove:= SubMouseMove; FIMG.OnMouseUp:= SubMouseUp; FIMG.OnClick:= SubClick; FCaptionText:= TLabel.Create(Self); FCaptionText.Parent:= Self; FCaptionText.Top:= 1; FCaptionText.Left:= 18; FCaptionText.Canvas.Pen.Style:= psClear; FCaptionText.Canvas.Brush.Style:= bsClear; FCaptionText.OnMouseDown:= SubMouseDown; FCaptionText.OnMouseMove:= SubMouseMove; FCaptionText.OnMouseUp:= SubMouseUp; FCaptionText.OnClick:= SubClick; ResizeCaptionText; BorderBMP:= TBitmap.Create; try BorderBMP.Width:= 13; BorderBMP.Height:= 13; BorderBMP.Canvas.Brush.Style:= bsSolid; BorderBMP.Canvas.Brush.Color:= clWhite; BorderBMP.Canvas.FillRect(Rect(0,0,BorderBMP.Width,BorderBMP.Height)); BorderBMP.Canvas.Pen.Style:= psSolid; BorderBMP.Canvas.Pen.Color:= clBtnShadow; BorderBMP.Canvas.MoveTo(0,11); BorderBMP.Canvas.LineTo(0,0); BorderBMP.Canvas.LineTo(12,0); BorderBMP.Canvas.Pen.Color:= clBtnFace; BorderBMP.Canvas.MoveTo(11,1); BorderBMP.Canvas.LineTo(11,11); BorderBMP.Canvas.LineTo(0,11); BorderBMP.Canvas.Pen.Color:= cl3DDkShadow; BorderBMP.Canvas.MoveTo(1,10); BorderBMP.Canvas.LineTo(1,1); BorderBMP.Canvas.LineTo(11,1); FIMG.Picture.Bitmap.Assign(BorderBMP); finally BorderBMP.Free; end; Caption:= ''; TabStop:= True; FEnabled:= True; FFocus:= False; FState:= 0; ChangeChecked; end; destructor TCheckBoxMulti.Destroy; begin FIMG.Free; inherited Destroy; end; procedure TCheckBoxMulti.ChangeChecked; var x: Integer; begin if FEnabled then FIMG.Picture.Bitmap.Canvas.Brush.Color:= clWhite else FIMG.Picture.Bitmap.Canvas.Brush.Color:= clBtnFace; FIMG.Picture.Bitmap.Canvas.Brush.Style:= bsSolid; FIMG.Picture.Bitmap.Canvas.FillRect(Rect(2,2,FIMG.Picture.Bitmap.Width-2,FIMG.Picture.Bitmap.Height-2)); if FState<>0 then begin if FEnabled then begin if FState=1 then FIMG.Picture.Bitmap.Canvas.Pen.Color:= clBlack else FIMG.Picture.Bitmap.Canvas.Pen.Color:= clRed; end else begin if FState=1 then FIMG.Picture.Bitmap.Canvas.Pen.Color:= clBtnShadow else FIMG.Picture.Bitmap.Canvas.Pen.Color:= clMaroon; end; FIMG.Picture.Bitmap.Canvas.Pen.Style:= psSolid; for x:= 0 to 2 do begin FIMG.Picture.Bitmap.Canvas.MoveTo(3,5+x); FIMG.Picture.Bitmap.Canvas.LineTo(5,7+x); FIMG.Picture.Bitmap.Canvas.LineTo(10,2+x); end; end; end; procedure TCheckBoxMulti.SetState(const Value: Integer); var i: Integer; begin if Value=0 then i:= 0 else if Value>0 then i:= 1 else i:= -1; SetCheck(i); end; procedure TCheckBoxMulti.SetEnabled(Value: Boolean); begin if FEnabled<>Value then begin FEnabled:= Value; inherited Enabled:= Value; FCaptionText.Enabled:= Value; ChangeChecked; end; end; function TCheckBoxMulti.GetEnabled: Boolean; begin Result:= FEnabled; end; procedure TCheckBoxMulti.SetCaption(const Value: string); begin if FCaption<>Value then begin FCaption:= Value; FCaptionText.Caption:= FCaption; ResizeCaptionText; end; end; function TCheckBoxMulti.GetCaption: string; begin Result:= FCaption; end; procedure TCheckBoxMulti.ResizeCaptionText; begin FFucusRect.Top:= 0; FFucusRect.Left:= FCaptionText.Left-1; FFucusRect.Bottom:= FCaptionText.Height+3; FFucusRect.Right:= FCaptionText.Left+FCaptionText.Width+1; if FFucusRect.Right>Width-FCaptionText.Left then FFucusRect.Right:= Width-FCaptionText.Left; end; procedure TCheckBoxMulti.SetFocus; begin inherited; FFocus:= True; end; procedure TCheckBoxMulti.SetCheck(const Value: Integer); begin if FState<>Value then begin FState:= Value; if (FState<-1) or (FState>1) then FState:= 0; ChangeChecked; end; end; procedure TCheckBoxMulti.KeyPress(var Key: Char); var i: Integer; begin inherited; if Key=' ' then begin i:= FState+1; if i=2 then i:= -1; SetCheck(i); end; end; procedure TCheckBoxMulti.Paint; begin inherited; if Focused then begin Canvas.Brush.Color:= clWhite; Canvas.DrawFocusRect(FFucusRect); FFocus:= True; end; end; procedure TCheckBoxMulti.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; if FEnabled then begin if Button=mbRight then begin SetCheck(FState-1); Click; end else if Button=mbLeft then SetCheck(FState+1); SetFocus; end; end; procedure TCheckBoxMulti.SubClick(Sender: TObject); begin Click; end; procedure TCheckBoxMulti.SubMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin MouseDown(Button,Shift,X+(Sender as TControl).Left,Y+(Sender as TControl).Top); end; procedure TCheckBoxMulti.SubMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin MouseMove(Shift,X+(Sender as TControl).Left,Y+(Sender as TControl).Top); end; procedure TCheckBoxMulti.SubMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin MouseUp(Button,Shift,X+(Sender as TControl).Left,Y+(Sender as TControl).Top); end; procedure TCheckBoxMulti.WMKillFocus(var Message: TWMKillFocus); begin inherited; if FFocus then begin Canvas.DrawFocusRect(FFucusRect); FFocus:= False; end; end; procedure TCheckBoxMulti.WMSetFocus(var Message: TWMSetFocus); begin inherited; if Focused then begin Canvas.Brush.Color:= clWhite; Canvas.DrawFocusRect(FFucusRect); FFocus:= True; end; end; end.
Delphi-Quellcode:
var
CB: TCheckBoxMulti; procedure TForm1.FormCreate(Sender: TObject); begin CB:= TCheckBoxMulti.Create(Self); CB.Parent:= Form1; CB.Top:= 8; CB.Left:= 8; CB.Caption:= 'CheckBox1 CheckBox1CheckBox1'; CB.Enabled:= False; // <- Das Problem! end; procedure TForm1.Button1Click(Sender: TObject); begin CB.Enabled:= not CB.Enabled; end; |
![]() |
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 |
![]() |
![]() |