How to override the standard OnClick event of a TDBCheckBox

Problem/Question/Abstract:

When showing a form with checkboxes connected to a database table it seems the OnClick event of the checkboxes is being run when the form is shown but before OnActivate is run. Does anyone know what can cause this? I have code in the OnClick to enable certain other controls etc. and I am having to disable them conditionally if the checkbox has focus.

Answer:

Unfortunately the OnClick event executes when the value of the checkbox changes, not just when the object is "clicked". So if you scroll from a record that is True to one that is False, the event will be triggered. This is because the component sets the State of the check box after each record is scrolled. That in turn fires the Click event. You can override this behavior by subclassing from TDBCheckBox and override the property ClicksDisabled which is defined in TButtonControl. You'll also need to override the WndProc method and reset the var FClicksDisabled to True. This should keep the OnClick executing only when the mouse is clicked and not when the data is scrolled to a new value. I have no idea why the CheckBox was implemented this way, it really doesn't make much sense to me.

Here's one that should only fire the onClick event when the mouse is clicked.

{ ... }
type
  TMyDBCheckBox = class(TDBCheckBox)
  private
    { Private declarations }
    FClickOK: Boolean;
  protected
    { Protected declarations }
    procedure WndProc(var Message: TMessage); override;
    procedure Click; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure TMyDBCheckBox.WndProc(var Message: TMessage);
begin
  inherited;
  case Message.Msg of
    WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
      FClickOK := True;
  end;
end;

constructor TMyDBCheckBox.Create(AOwner: TComponent);
begin
  inherited;
  FClickOK := False;
end;

procedure TMyDBCheckBox.Click;
begin
  try
    if FClickOK then
      inherited;
  finally
    FClickOK := False;
  end;
end;

procedure Register;
begin
  RegisterComponents('Custom', [TMyDBCheckBox]);
end;