CheckListBox und virtuelle Einträge - wieso kein Checked?

[Sir Rufo]

Moinsen,

da gibt es eine tolle TCheckListBox die man per Style auf lbVirtual stellen kann.
Aber checken lässt sich da nix ... oder ich check es grad nicht

In dem Event "OnData" (da hätte ich jetzt die Checked-Eigenschaft erwartet) gibt es aber nur Data als string und da wird nur der Text gesetzt.

Wer weiß da Rat?

Delphi-Quellcode:

unit frmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, CheckLst;

type
  TFMain = class( TForm )
    CheckListBox1 : TCheckListBox;
    procedure CheckListBox1Data( Control : TWinControl; index : Integer; var Data : string );
    procedure FormCreate( Sender : TObject );

  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  FMain : TFMain;

implementation

{$R *.dfm}

procedure TFMain.CheckListBox1Data( Control : TWinControl; index : Integer; var Data : string );
  begin
    Data := Format( 'Data %d', [ index ] );
  end;

procedure TFMain.FormCreate( Sender : TObject );
  begin
    CheckListBox1.Style := lbVirtual;
    CheckListBox1.Count := 10;
  end;

end.

[himitsu]

In Delphi 2010 - mit Debug-DCUs compiliert:

Delphi-Quellcode:

CheckListBox1.Style := lbVirtual;
CheckListBox1.Count := 10;
CheckListBox1.State[1] := cbChecked;
CheckListBox1.State[1] := cbChecked;

Beim ersten Aufruf/Setzen von State wird ein "Wrapper" erzeugt (ohne diesen "Wrapper" wird immer nur der Standardwert angezeigt)

Delphi-Quellcode:

function TCheckListBox.GetState(Index: Integer): TCheckBoxState;
begin
  if HaveWrapper(Index) then
    Result := TCheckListBoxDataWrapper(GetWrapper(Index)).State
  else
    Result := TCheckListBoxDataWrapper.GetDefaultState;
end;

function TCheckListBox.GetWrapper(Index: Integer): TObject;
begin
  Result := ExtractWrapper(Index);
  if Result = nil then
    Result := CreateWrapper(Index);
end;

Nur irgendwie ist er beim 2. Aufruf wieder weg, so daß der gesetzte/geänderte Wert wieder verschwunden ist.
Dieser "Wrapper" wird in ItemData gespeichert und beim Auslesen dessen kommt NIL zurück.

(Frag mich bloß nicht nach dem Wieso.)

[Sir Rufo]

Zitat von himitsu:

(Frag mich bloß nicht nach dem Wieso.)

Frag ich ja auch gar nicht ... ich frag ja nach dem "Wie geht das?"

[Sir Rufo]

(ich push mal ganz vorsichtig)

[himitsu]

Wie gesagt, irgendwo verschwindet der Wert in ItemData oder dieser wird einfach nicht richtig gespeichert.
Also müßte man die VCL debuggen und versuchen rauszufinden, was da schief läuft.

Für den Anfang könnt ma ja diesen Code nehmen und ihn ab der State-Zuweisung (inkl. Debug-DCUs) debuggen.

Delphi-Quellcode:

CheckListBox1.Style := lbVirtual;
CheckListBox1.Count := 10;
CheckListBox1.State[1] := cbChecked;
x := CheckListBox1.State[1];
if x = cbChecked then ;

(das IF ist nur vorhanden, damit das X nicht sofort wegoptimiert wird)

[thkerkmann]

Hallo Leute,
da hab ich ja grad den richtigen Thread zu meinem Problem gefunden, aber eine Antwort gibt er leider nicht her.
Gibt es irgendwelche neuen Erkenntnisse dazu ?

Gruß
Thomas

[SirThornberry]

So wie der Quelltext der Checklistbox aussieht ist das ganz nicht vorgesehen das jemand auf virtuell stellt.
Eine direkte Abfrage ob checked bzw. des State gibt es nicht. Das läuft (wie himitsu bereits erwähnt hat) intern alles über einen Wrapper. Und dieser wird per lb_setitemdata gesetzt und über lb_getitemdata abgefragt. Bei Virtual hat lb_setitemdata allerdings keinen Effekt so das man selbst auf die messages reagieren müsste.

Unvollständiges Beispiel (auf Löschen von Items wird zum Beispiel nicht reagiert):

Delphi-Quellcode:

  TCheckListbox = class(vcl.CheckLst.TCheckListBox)
  private
    fDict: TDictionary<Integer,TListBoxItemData>;
    procedure LBGetItemData(var amsg: TMessage); message LB_GETITEMDATA;
    procedure LBSetItemData(var amsg: TMessage); message LB_SETITEMDATA;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
  end;
[...]
{ TCheckListbox }

constructor TCheckListbox.Create(aOwner: TComponent);
begin
  inherited;
  fDict := TDictionary<Integer,TListBoxItemData>.Create;
end;

destructor TCheckListbox.Destroy;
begin
  fDict.Free;
  inherited;
end;

procedure TCheckListbox.LBGetItemData(var amsg: TMessage);
begin
  fDict.TryGetValue(aMsg.WParam, aMsg.Result);
end;

procedure TCheckListbox.LBSetItemData(var amsg: TMessage);
begin
  fDict.AddOrSetValue(amsg.WParam, aMsg.LParam);
end;

[Voyager07]

Ich stieß ebenfalls auf dieses Problem habe das so gelöst:

1: Ableiten einer eigenen Klasse aus TCustomListBox, als Vorlage dazu nutzte ich TCheckListBox aus der Unit CheckLst.

2: Ergänzt vor der Definition der neuen Klasse:

Delphi-Quellcode:

TYPE
  TCheckListBoxData= RECORD
    Data: longint;
    State: TCheckBoxState;
    Disabled: boolean;
    Header: boolean;
  END;

  TOnGetCheckListBoxData= function(const Index: longint): TCheckListBoxData of object;
  TOnSetCheckListBoxData= procedure(const Index: longint; const Data: TCheckListBoxData) of object;

3: Ergänzt in der neuen Klasse:

Delphi-Quellcode:

public
    OnGetCheckListBoxData: TOnGetCheckListBoxData;
    OnSetCheckListBoxData: TOnSetCheckListBoxData;

4: Die Methode SetState geändert:

Delphi-Quellcode:

procedure TITfMMultiCheckListBox.SetState(Index: Integer; AState: TCheckBoxState);

VAR
  lbData: TCheckListBoxData;

begin
  if AState <> GetState(Index) then
  begin
    IF Style= lbVirtual THEN begin
      IF assigned(OnSetCheckListBoxData) AND assigned(OnGetCheckListBoxData) THEN begin
        lbData:= OnGetCheckListBoxData(Index);

        lbData.State:= AState;

        OnSetCheckListBoxData(Index, lbData);
      end;
    end
    ELSE begin
      TCheckListBoxDataWrapper(GetWrapper(Index)).State := AState;
    end;

    InvalidateCheck(Index);
  end;
end;

5: Die Methode GetState geändert:

Delphi-Quellcode:

function TITfMMultiCheckListBox.GetState(Index: Integer): TCheckBoxState;

begin
  Result := TCheckListBoxDataWrapper.GetDefaultState;

  IF Style= lbVirtual THEN begin
    IF assigned(OnGetCheckListBoxData) THEN begin
      Result:= OnGetCheckListBoxData(Index).State;
    end;
  end
  ELSE begin
    if HaveWrapper(Index) then
      Result := TCheckListBoxDataWrapper(GetWrapper(Index)).State
    else
      Result := TCheckListBoxDataWrapper.GetDefaultState;
  end;

end;

Damit ist jetzt auch State "virtualisiert".

Für den Fall, dass auch die anderen Felder von TCheckListBoxData virtualisiert werden sollen, müssten analog die Methoden wie GetHeader/SetHeader modifiziert werden.