Einzelnen Beitrag anzeigen

e-gon

Registriert seit: 7. Jul 2003
Ort: Stuttgart
156 Beiträge
 
Delphi 6 Enterprise
 
#1

Enabled-Phänomen bei eigener Komponente

  Alt 8. Mär 2012, 13:01
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:
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.
Und hier der Aufruf:

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;
  Mit Zitat antworten Zitat