////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// CheckListBoxMenu - simple dialog with check listbox selection menu.        //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 2001xxxx - Created by A.K.                                                 //
// 2023xxxx - Modified for FPC - A.K.                                         //
// 20240626 - ApplyParams                                                     //
////////////////////////////////////////////////////////////////////////////////

unit form_checklistboxselection; // CheckListBox Selection dialog.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 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_utf8,
 _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);
  public
    procedure ResetParams;
    function  DoApplyParams(const Params:LongString):Integer; override;
  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}

function gmlIterator(n:SizeInt; Line:LongString; Custom:Pointer):Boolean;
var Len:Integer;
begin
 Result:=true;
 if Assigned(Custom) then begin
  if IsSysUtf8 and utf8_valid(Line)
  then Len:=utf8_length(Line)
  else Len:=Length(Line);
  Integer(Custom^):=Max(Integer(Custom^),Len);
 end;
end;

function CheckListBoxSelection(const aCaption  : LongString;
                               const aTitle    : LongString;
                               const aItemList : LongString;
                               var   aFocused  : Integer;
                               const aParams   : LongString=''):Cardinal;
var w,h,l,vs,wmin,hmin,iht,dw1,dw2,dh1,dh2,dih,apFlags: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
   dw1:=40+20;
   dw2:=40;
   dh1:=Height-CheckListBoxSelector.Height+8;
   dh2:=60;
   dih:=0;
   if IsWidgetSetName('win32') then dih:=0;
   if IsWidgetSetName('gtk,gtk2,gtk3') then dih:=5;
   ResetParams;
   apFlags:=ApplyParams(aParams);
   vs:=max(GetSystemMetrics(SM_CXVSCROLL),0);
   // Find items max. line length (l) & num. lines (h)
   l:=1; h:=Max(1,ForEachStringLine(aItemList,gmlIterator,@l));
   wmin:=Constraints.MinWidth; hmin:=Constraints.MinHeight;
   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);
   iht:=CheckListBoxSelector.ItemHeight;
   iht:=Max(iht,EvalTextSize(CheckListBoxSelector.Font,'Hg').cy+dih);
   h:=max(hmin,iht*h+dh1);
   h:=min(h,Screen.Height-dh2);
   if not HasFlags(apFlags,apf_FormWidth) then Width:=w;
   if not HasFlags(apFlags,apf_FormHeight) then Height:=h;
   if not HasFlags(apFlags,apf_FormLeft+apf_FormTop)
   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 "WindowTitle" ComponentName
 // @set Form.Top     400  relative "WindowTitle" ComponentName
 // @set Form.Width   400
 // @set Form.Height  300
 // @set Form.Width   80  relative Screen
 // @set Form.Height  50  relative Desktop
function TFormCheckListBoxSelection.DoApplyParams(const Params:LongString):Integer;
begin
 Result:=Form_ApplyParams_PosSize(Self,Params)
      or Form_ApplyParams_Font(PanelSelector.Font,Params,'Panel.Font',apf_Fonts1st)
      or Form_ApplyParams_Font(CheckListBoxSelector.Font,Params,'ListBox.Font',apf_Fonts2nd);
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;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_form_checklistboxselection;
begin
end;

procedure Free_form_checklistboxselection;
begin
end;

initialization

 Init_form_checklistboxselection;

finalization

 Free_form_checklistboxselection;

end.

//////////////
// END OF FILE
//////////////

