unit Form_CheckListBoxSelection;

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, {$ENDIF}
 {$IFDEF WINDOWS} windows, {$ENDIF}
 sysutils, classes, graphics, controls, forms, dialogs, stdctrls, buttons,
 extctrls, math, types, lcltype, lclproc, lclintf, checklst,
 _crw_alloc, _crw_str, _crw_ef, _crw_plut, _crw_eldraw,
 _crw_appforms, _crw_apptools;

type
  TFormCheckListBoxSelection = class(TMasterForm)
    PanelButtons: TPanel;
    BitBtnOk: TBitBtn;
    BitBtnCancel: TBitBtn;
    ButtonInvSelection: TButton;
    PanelSelector: TPanel;
    GroupBoxSelector: TGroupBox;
    CheckListBoxSelector: TCheckListBox;
    procedure FormCreate(Sender: TObject);
    procedure CheckListBoxSelectorDblClick(Sender: TObject);
    procedure CheckListBoxSelectorKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ButtonInvSelectionClick(Sender: TObject);
  private
    { Private declarations }
    apFlags : Integer;
  public
    { Public declarations }
    procedure ResetParams;
    function  ApplyParams(const Params:LongString):Integer;
  end;

function CheckListBoxSelection(const aCaption  : LongString;
                               const aTitle    : LongString;
                               const aItemList : LongString;
                               var   aFocused  : Integer;
                               const aParams   : LongString=''):Cardinal;

function CheckListBoxMenu(const aCaption  : LongString;
                          const aTitle    : LongString;
                          const aItemList : LongString;
                                aFocused  : Integer=0;
                          const aParams   : LongString=''
                                        ) : Integer;

function CheckListBoxMultiSelection(const aCaption  : LongString;
                                    const aTitle    : LongString;
                                    const aItemList : LongString;
                                          aExtended : Boolean = false;
                                          GetIndex  : Boolean = false;
                                          aFocused  : Integer = 0;
                                          aSelected : Integer = 0;
                                    const aParams   : LongString=''
                                                  ) : LongString;

const
  FormCheckListBoxSelection : TFormCheckListBoxSelection = nil;

implementation

{$R *.lfm}

const                 // ApplyParams flags:
 apFormL = $00000001; // Applied Form.Left
 apFormT = $00000002; // Applied Form.Top
 apFormW = $00000004; // Applied Form.Width
 apFormH = $00000008; // Applied Form.Height
 apFonts = $00000010; // Applied Panel.Font

function CheckListBoxSelection(const aCaption  : LongString;
                               const aTitle    : LongString;
                               const aItemList : LongString;
                               var   aFocused  : Integer;
                               const aParams   : LongString=''):Cardinal;
const
 wmin = 200;
 hmin = 200;
 dw1  = 60;
 dw2  = 40;
 dh1  = 110;
 dh2  = 60;
var i,j,w,h,l,vs:Integer;
begin
 Result:=mrCancel;
 if CanShowModal(FormCheckListBoxSelection) then
 try
  if (FormCheckListBoxSelection=nil) then begin
   Application.CreateForm(TFormCheckListBoxSelection, FormCheckListBoxSelection);
   FormCheckListBoxSelection.Master:=@FormCheckListBoxSelection;
   FormCheckListBoxSelection.Show;
   FormCheckListBoxSelection.Hide;
  end;
  if (FormCheckListBoxSelection<>nil) then
  with FormCheckListBoxSelection do
  try
   ResetParams;
   apFlags:=ApplyParams(aParams);
   vs:=max(GetSystemMetrics(SM_CXVSCROLL),0);
   l:=1; h:=1; j:=0;
   for i:=1 to Length(aItemList) do
   case aItemList[i] of
    ASCII_CR : begin inc(h); j:=0; end;
    ASCII_LF : j:=0;
    else begin inc(j); l:=max(l,j); end;
   end;
   w:=wmin;
   w:=max(w,EvalTextSize(Font,aCaption).cx+vs+dw1);
   w:=max(w,EvalTextSize(GroupBoxSelector.Font,aTitle).cx+vs+dw1);
   w:=max(w,EvalTextSize(CheckListBoxSelector.Font,StringOfChar('M',l)).cx+vs+dw1);
   w:=min(w,Screen.Width-dw2);
   h:=max(hmin,CheckListBoxSelector.ItemHeight*h+dh1);
   h:=min(h,Screen.Height-dh2);
   if not HasFlags(apFlags,apFormW) then Width:=w;
   if not HasFlags(apFlags,apFormH) then Height:=h;
   if not HasFlags(apFlags,apFormL+apFormT) then LocateFormToCenterOfScreen(FormCheckListBoxSelection);
   Caption:=aCaption;
   SmartUpdate(GroupBoxSelector,aTitle);
   SmartUpdate(CheckListBoxSelector,aItemList);
   aFocused:=max(0,min(CheckListBoxSelector.Items.Count-1,aFocused));
   CheckListBoxSelector.ItemIndex:=aFocused;
   ActiveControl:=CheckListBoxSelector;
   ValidateFormPosition(FormCheckListBoxSelection);
   Result:=mrVoice(ShowModal);
   aFocused:=CheckListBoxSelector.ItemIndex;
  finally
   ResetParams;
  end;
 except
  on E:Exception do BugReport(E,nil,'CheckListBoxSelection');
 end;
end;

function CheckListBoxMenu(const aCaption  : LongString;
                          const aTitle    : LongString;
                          const aItemList : LongString;
                                aFocused  : Integer=0;
                          const aParams   : LongString=''
                                        ) : Integer;
begin
 if CheckListBoxSelection(aCaption,aTitle,aItemList,aFocused,aParams)=mrOk then Result:=aFocused else Result:=-1;
end;

function CheckListBoxMultiSelection(const aCaption  : LongString;
                                    const aTitle    : LongString;
                                    const aItemList : LongString;
                                          aExtended : Boolean = false;
                                          GetIndex  : Boolean = false;
                                          aFocused  : Integer = 0;
                                          aSelected : Integer = 0;
                                    const aParams   : LongString=''
                                                  ) : LongString;
var i:Integer; p:TText;
begin
 Result:='';
 try
  if (FormCheckListBoxSelection=nil) then begin
   Application.CreateForm(TFormCheckListBoxSelection, FormCheckListBoxSelection);
   FormCheckListBoxSelection.Master:=@FormCheckListBoxSelection;
   FormCheckListBoxSelection.Show;
   FormCheckListBoxSelection.Hide;
  end;
  if (FormCheckListBoxSelection<>nil) then
  with FormCheckListBoxSelection do
  try
   p:=NewText;
   try
    ResetParams;
    Caption:=aCaption;
    SmartUpdate(GroupBoxSelector,aTitle);
    SmartUpdate(CheckListBoxSelector,aItemList);
    for i:=0 to CheckListBoxSelector.Items.Count-1 do
    CheckListBoxSelector.Checked[i]:=IsBit(aSelected,i);
    if CheckListBoxSelection(aCaption,aTitle,aItemList,aFocused,aParams)=mrOk then begin
     for i:=0 to CheckListBoxSelector.Items.Count-1 do
     if CheckListBoxSelector.Checked[i] then begin
      if GetIndex
      then p.Addln(IntToStr(i))
      else p.Addln(CheckListBoxSelector.Items[i]);
     end;
     Result:=p.Text;
    end;
   finally
    Kill(p);
   end;
  finally
   ResetParams;
  end;
 except
  on E:Exception do BugReport(E,nil,'CheckListBoxMultiSelection');
 end;
end;

function MultiSelectionIndexesToInt(Items:LongString; DefValue:Integer=0):Integer;
var p:TText; i,n:Integer;
begin
 Result:=DefValue;
 if Items<>'' then
 try
  Result:=0;
  p:=NewText;
  try
   p.Text:=Items;
   for i:=0 to p.Count-1 do if Str2Int(p[i],n) then Result:=Result or (1 shl n);
  finally
   Kill(p);
  end;
 except
  on E:Exception do BugReport(E,nil,'MultiSelectionIndexesToInt');
 end;
end;

procedure TFormCheckListBoxSelection.FormCreate(Sender: TObject);
begin
 SetStandardFont(Self);
 SetAllButtonsCursor(Self,crHandPoint);
 SmartUpdate(BitBtnOk,mrCaption(mrOk));
 SmartUpdate(BitBtnCancel,mrCaption(mrCancel));
end;

procedure TFormCheckListBoxSelection.ResetParams;
begin
 SetStandardFont(Self);
 PanelSelector.ParentFont:=true;
 CheckListBoxSelector.ParentFont:=true;
end;

 // @set Panel.Font   Name:PT_Mono\Size:10\Color:Black\Style:[Regular]
 // @set ListBox.Font Name:PT_Mono\Size:10\Color:Black\Style:[Regular]
 // @set Form.Left    400  relative WindowName  ComponentName
 // @set Form.Top     400  relative WindowName  ComponentName
 // @set Form.Width   400
 // @set Form.Height  300
 // @set Form.Width   80  relative Screen
 // @set Form.Height  50  relative Desktop
function TFormCheckListBoxSelection.ApplyParams(const Params:LongString):Integer;
var pars:TText; i,w,h,l,t:Integer; line:LongString; FontPars:TFontParams; p:TPoint;
begin
 Result:=0;
 if (Self<>nil) then
 if UseEditSettings then
 if (SysUtils.Trim(Params)<>'') then
 try
  pars:=NewText;
  try
   SafeFillChar(FontPars,SizeOf(FontPars),0);
   pars.Text:=SysUtils.Trim(Params);
   for i:=0 to pars.Count-1 do begin
    line:=Trim(pars[i]);
    if (StrFetch(line,1)='@') then begin
     if SameText(ExtractWord(1,line,ScanSpaces),'@set') then begin
      if SameText(ExtractWord(2,line,ScanSpaces),'Panel.Font') then begin
       if ReadBufferedFont(FontPars,ExtractWord(3,line,ScanSpaces),true,StandardFont)
       then RestoreFont(PanelSelector.Font,FontPars);
       Result:=Result or apFonts;
      end;
      if SameText(ExtractWord(2,line,ScanSpaces),'ListBox.Font') then begin
       if ReadBufferedFont(FontPars,ExtractWord(3,line,ScanSpaces),true,StandardFont)
       then RestoreFont(CheckListBoxSelector.Font,FontPars);
       Result:=Result or apFonts;
      end;
      if SameText(ExtractWord(2,line,ScanSpaces),'Form.Width') then begin
       if Str2Int(ExtractWord(3,line,ScanSpaces),w) then begin
        if SameText(ExtractWord(4,line,ScanSpaces),'relative')
        then w:=FindRelativeSize(Point(w,0),ExtractWord(5,line,ScanSpaces),ExtractWord(6,line,ScanSpaces)).x;
        Width:=w;
        Result:=Result or apFormW;
       end;
      end;
      if SameText(ExtractWord(2,line,ScanSpaces),'Form.Height') then begin
       if Str2Int(ExtractWord(3,line,ScanSpaces),h) then begin
        if SameText(ExtractWord(4,line,ScanSpaces),'relative')
        then h:=FindRelativeSize(Point(0,h),ExtractWord(5,line,ScanSpaces),ExtractWord(6,line,ScanSpaces)).y;
        Height:=h;
        Result:=Result or apFormH;
       end;
      end;
      if SameText(ExtractWord(2,line,ScanSpaces),'Form.Left') then begin
       if Str2Int(ExtractWord(3,line,ScanSpaces),l) then begin
        p:=Point(l,0);
        if SameText(ExtractWord(4,line,ScanSpaces),'relative')
        then p:=FindRelativePos(p,ExtractWord(5,line,ScanSpaces),ExtractWord(6,line,ScanSpaces));
        Left:=p.x;
        Result:=Result or apFormL;
       end;
      end;
      if SameText(ExtractWord(2,line,ScanSpaces),'Form.Top') then begin
       if Str2Int(ExtractWord(3,line,ScanSpaces),t) then begin
        p:=Point(0,t);
        if SameText(ExtractWord(4,line,ScanSpaces),'relative')
        then p:=FindRelativePos(p,ExtractWord(5,line,ScanSpaces),ExtractWord(6,line,ScanSpaces));
        Top:=p.y;
        Result:=Result or apFormT;
       end;
      end;
     end;
    end;
   end;
  finally
   Kill(pars);
  end;
 except
  on E:Exception do BugReport(E,Self,'ApplyParams');
 end;
end;

procedure TFormCheckListBoxSelection.CheckListBoxSelectorDblClick(Sender: TObject);
begin
 ModalResult:=mrOk;
end;

procedure TFormCheckListBoxSelection.CheckListBoxSelectorKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
 case Key of
  VK_RETURN : ModalResult:=mrOk;
  VK_ESCAPE : ModalResult:=mrCancel;
 end;
end;

procedure TFormCheckListBoxSelection.ButtonInvSelectionClick(Sender: TObject);
var i:Integer;
begin
 try
  for i:=0 to CheckListBoxSelector.Items.Count-1 do
  CheckListBoxSelector.Checked[i]:=not CheckListBoxSelector.Checked[i];
 except
  on E:Exception do BugReport(E,Self,'ButtonInvSelectionClick');
 end;
end;

end.
