unit CheckListFrm;
{
  (C) 2000 - 2001 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, CheckLst, Math, TypInfo, PropUtl, ExtCtrls;

type
  TCheckListForm = class(TForm)
    CheckListBox: TCheckListBox;
    Panel1: TPanel;
    Button1: TButton;
  private
    { Private declarations }
    procedure SetList(AList: TStrings);
    function GetList: TStrings;
  public
    { Public declarations }
    procedure SetFlags(var AFlags; ASize: integer);
    procedure GetFlags(var AFlags; ASize: integer);
    property List: TStrings read GetList write SetList;
  end;

var
  CheckListForm: TCheckListForm;

procedure CheckListBoxSetFlags(ACheckListBox: TCheckListBox; var AFlags; ASizeOfFlags:integer);
procedure CheckListBoxGetFlags(ACheckListBox: TCheckListBox; var AFlags; ASizeOfFlags:integer);

procedure SETPropToCheckListBox(ACheckListBox: TCheckListBox;
  Instance: TObject; APropInfo: PPropInfo);
procedure CheckListBoxToSETProp(ACheckListBox: TCheckListBox;
  Instance: TObject; APropInfo: PPropInfo);

implementation

{$R *.DFM}

procedure CheckListBoxSetFlags(ACheckListBox: TCheckListBox; var AFlags; ASizeOfFlags:integer);
var
  l: integer;
  b: integer;
  i: integer;
begin
  l := 0;
  b := 1;
  move(AFlags, l, min(sizeof(l), ASizeOfFlags));
  for i := 0 to sizeof(l) * 8 - 1 do begin
    if i >= ACheckListBox.Items.Count then
      break;
    ACheckListBox.Checked[i] := (b and l) <> 0;
    b := b shl 1;
  end;
end;

procedure CheckListBoxGetFlags(ACheckListBox: TCheckListBox; var AFlags; ASizeOfFlags:integer);
var
  l: integer;
  b: integer;
  i: integer;
begin
  l := 0;
  FillChar(AFlags, ASizeOfFlags, 0);
  b := 1;
  for i := 0 to sizeof(l) * 8 - 1 do begin
    if i >= ACheckListBox.Items.Count then
      break;
    if ACheckListBox.Checked[i] then
      l := l or b;
    b := b shl 1;
  end;
  move(l, AFlags, min(sizeof(l), ASizeOfFlags));
end;

procedure SETPropToCheckListBox(ACheckListBox: TCheckListBox; Instance: TObject; APropInfo: PPropInfo);
var
  l: integer;
begin
  FillSetEnumNames(APropInfo, ACheckListBox.Items);
  l := GetOrdProp(Instance, APropInfo);
  CheckListBoxSetFlags(ACheckListBox, l, sizeof(l));
end;

procedure CheckListBoxToSETProp(ACheckListBox: TCheckListBox; Instance: TObject; APropInfo: PPropInfo);
var l: integer;
begin
  CheckListBoxGetFlags(ACheckListBox, l, sizeof(l));
  SetOrdProp(Instance, APropInfo, l);
end;


procedure TCheckListForm.SetList(AList: TStrings);
{var i: integer;}
begin
  CheckListBox.Items.Assign(AList);
{  CheckListBox.Items.Clear;
  for i := 0 to AList.Count - 1 do begin
    CheckListBox.Items.Add(AList[i]);
  end;}
end;

function TCheckListForm.GetList: TStrings;
begin
  Result := CheckListBox.Items;
end;

procedure TCheckListForm.SetFlags(var AFlags; ASize: integer);
begin
  CheckListBoxSetFlags(CheckListBox, AFlags, ASize);
end;

procedure TCheckListForm.GetFlags(var AFlags; ASize: integer);
begin
  CheckListBoxGetFlags(CheckListBox, AFlags, ASize);
end;

end.
