3

Having a nullable dataset field of a boolean type, how to display its NULL value as an unchecked state in a TDBCheckBox control descendant linked to this field. By default, TDBCheckBox displays the NULL value of the field as a grayed check box:

enter image description here

but I need it to be displayed as an unchecked state in my TDBCheckBox control descendant:

enter image description here

Modifying the original TDBCheckBox source code is not an option for me, nor I cannot override the TDBCheckBox.GetFieldState because it's a private method.

So, how can I display the NULL value as an unchecked state in my TDBCheckBox descendant ?

TLama
  • 75,147
  • 17
  • 214
  • 392
Roman Marusyk
  • 23,328
  • 24
  • 73
  • 116
  • sorry for my English :-) – Roman Marusyk Jan 23 '15 at 22:00
  • Having only Delphi 2009 by hand right now... There's not much code for this control, so you may consider creating a `TCustomCheckBox` control descendant. Or you can override the `TDBCheckBox`'s constructor providing your own handlers for the `FDataLink`'s `OnDataChange` and `OnUpdateData` events (turning off the `AllowGrayed` property). Or you can `COALESCE(Field, False)` your field data when fetching (if that's an option). Or you can make a calculated field for the dataset. Or maybe the dataset provider can do this cast globally for you... – TLama Jan 23 '15 at 22:45
  • Thanks a lot for your answer. I overrided the TDBCheckBox's constructor for the FDataLink's OnDataChange and OnUpdateData events but it doesn't work ((. I have a lot of datasets, so I can't add a calculated field. – Roman Marusyk Jan 23 '15 at 22:57
  • Err, taking back my idea with providing event handlers for the `FDataLink`, it's a private field only, at least in D2009 (cannot say if that changed, nor even what version do you have). It's nearly closed control there. – TLama Jan 23 '15 at 22:59
  • Maybe I can use WMPaint(var Message: TWMPaint); message WM_PAINT? – Roman Marusyk Jan 23 '15 at 23:06
  • At painting stage, the field state is being read when the `csPaintCopy` state is included in the control's state (when a copy of the control is being painted), so no. But I'm talking about the code I'm looking at, which version of Delphi do you use ? Could you [`edit your question`](http://stackoverflow.com/posts/28119398/edit) and include a version tag there, please ? – TLama Jan 23 '15 at 23:16
  • Yes, I changed the question. I used Delphi 6 (2000 something like that) – Roman Marusyk Jan 23 '15 at 23:44

2 Answers2

2

If your project is closed source I suggest taking a copy of DBCtrls, change that one line where it says Result := cbGrayed and add that explicitly to your project. The change will be in your entire application but did not change the original code.

However there is another way - actually a hack so be careful and I suggest putting a compiler directive preventing this to be compiled in a different Delphi version to require looking at that code again and making sure it works.

Here is the code that works in Delphi XE - it might look different in Delphi 6 but you will get the idea.

type
  TDBCheckBoxHack = class(TCustomCheckBox)
  private
    FDataLink: TFieldDataLink;
    FValueCheck: string;
    FValueUncheck: string;
    procedure DataChange(Sender: TObject);
    function GetFieldState: TCheckBoxState;
    function ValueMatch(const ValueList, Value: string): Boolean;
  end;

I leave the implementation of these methods out because they are just a copy from the original copyrighted code. You have to change one or two lines in the GetFieldState method.

The trick is to create the same memory layout as the original TDBCheckBox so you can access the private fields - that is why this code should be used with care!

Then you assign the fixed DataChange method to the datalink:

TDBCheckBoxHack(DBCheckBox1).FDataLink.OnDataChange := 
  TDBCheckBoxHack(DBCheckBox1).DataChange;

To make this easier to use you can use another trick of inheriting from the original TDBCheckBox and call your class exactly the same. You can then put this into some unit and add this after the DBCtrls in your uses. That causes calling your constructor for every TDBCheckBox you placed on your form without the need to use your own and register it to the IDE:

type
  TDBCheckBox = class(DBCtrls.TDBCheckBox)
  public
    constructor Create(AOwner: TComponent); override;
  end;

constructor TDBCheckBox.Create(AOwner: TComponent);
begin
  inherited;
  TDBCheckBoxHack(Self).FDataLink.OnDataChange := TDBCheckBoxHack(Self).DataChange;
end;
Stefan Glienke
  • 20,860
  • 2
  • 48
  • 102
  • @Stefan Thanks for the excellent answer - especially the last part - makes it simple to add to existing units (and simple to remove if it blows up!) – TomB Apr 15 '22 at 20:03
0

Thanks everyone for help!

I implemented it following way:

  type
  TDBCheckBoxHack = class(TDBCheckBox)
    FDataLink: TFieldDataLink;
    procedure DataChange(Sender: TObject); virtual;
    function GetFieldState: TCheckBoxState; virtual;
  public
    constructor Create(AOwner: TComponent); override;
  end;

In constructor I used message CM_GETDATALINK for retrieve DataLink to my component

  constructor TDBCheckBoxHack.Create(AOwner: TComponent);
  var
    AMessage: TMessage;
  begin
    inherited;
    FillChar(AMessage, 0, sizeof(AMessage));
    AMessage.Msg := CM_GETDATALINK;
    Dispatch(AMessage);
    FDataLink := TFieldDataLink(Pointer(AMessage.Result));
    FDataLink.OnDataChange := DataChange;
  end;

and GetFieldState implementation:

  function TFsDBCheckBox.GetFieldState: TCheckBoxState;
  var
    Text: string;
  begin
    if FDatalink.Field <> nil then
      if FDataLink.Field.IsNull then
        Result := cbUnchecked
      else if FDataLink.Field.DataType = ftBoolean then
        if FDataLink.Field.AsBoolean then
          Result := cbChecked
        else
          Result := cbUnchecked
      else
      begin
        Result := cbGrayed;
        Text := FDataLink.Field.Text;
        if ValueMatch(ValueChecked, Text) then Result := cbChecked else
          if ValueMatch(ValueUnchecked, Text) then Result := cbUnchecked;
      end
   else
     Result := cbUnchecked;
 end;
Roman Marusyk
  • 23,328
  • 24
  • 73
  • 116