AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Enabled-Phänomen bei eigener Komponente

Ein Thema von e-gon · begonnen am 8. Mär 2012 · letzter Beitrag vom 8. Mär 2012
Antwort Antwort
e-gon

Registriert seit: 7. Jul 2003
Ort: Stuttgart
141 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
Benutzerbild von Uwe Raabe
Uwe Raabe

Registriert seit: 20. Jan 2006
Ort: Lübbecke
6.976 Beiträge
 
Delphi 10.3 Rio
 
#2

AW: Enabled-Phänomen bei eigener Komponente

  Alt 8. Mär 2012, 13:08
Vielleicht hilft es, wenn du nicht das property Enabled überschreibst, sondern einfach


    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
Uwe Raabe
Certified Delphi Master Developer
Embarcadero MVP
Blog: The Art of Delphi Programming
  Mit Zitat antworten Zitat
e-gon

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

AW: Enabled-Phänomen bei eigener Komponente

  Alt 8. Mär 2012, 13:23
Hallo Uwe,

vielen Dank für die schnelle Antwort! Es funktioniert!!!

Da wäre ich von selbst wohl nie drauf gekommen! - Danke!

Gruß
e-gon
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es 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

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 08:11 Uhr.
Powered by vBulletin® Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2019 by Daniel R. Wolf