lazarus-ccr/components/exctrls/source/excheckcombo.pas

unit ExCheckCombo;

{$mode objfpc}{$H+}

interface

uses
  LCLIntf, LCLType,
  Classes, SysUtils, Controls, StdCtrls, ImgList,
  GroupedEdit, EditBtn, CheckLst, Forms;

type
  { TCheckComboBoxEx }
  TCheckComboBoxEx = class;

  TCheckItemChange = procedure(Sender: TObject; AIndex: Integer) of object;
  TCheckComboBoxHintMode = (cbhmDefault, cbhmItems);
                
  TCheckComboBoxExStrings = class(TStringList)
  private
    function GetChecked(AIndex: Integer): Boolean;
    function GetEnabled(AIndex: Integer): Boolean;
    function GetObj(AIndex: Integer): TObject;
    function GetState(AIndex: Integer): TCheckboxState;
    procedure SetChecked(AIndex: Integer; AValue: Boolean);
    procedure SetEnabled(AIndex: Integer; AValue: Boolean);
    procedure SetObj(AIndex: Integer; AValue: TObject);
    procedure SetState(AIndex: Integer; AValue: TCheckboxState);
  protected
    procedure InsertItem(AIndex: Integer; const AText: string); override;
    procedure InsertItem(AIndex: Integer; const AText: string; Obj: TObject); override;
    
  public
    destructor Destroy; override;
    procedure Assign(ASource: TPersistent); override;
    procedure Clear; override;
    procedure Delete(AIndex: Integer); override;
    property Checked[AIndex: Integer]: Boolean read GetChecked write SetChecked;
    property Enabled[AIndex: Integer]: boolean read GetEnabled write SetEnabled;
    property Objects[AIndex: Integer]: TObject read GetObj write SetObj;
    property State[AIndex: Integer]: TCheckboxState read GetState write SetState;
  end;
  
  TCheckComboBoxExImageIndex = class(TPersistent)
  private
    FOwner: TCheckComboBoxEx;
    FImgIndex: array[0..7] of TImageIndex;
    function GetImgIndex(AIndex: Integer): TImageIndex;
    procedure SetImgIndex(AIndex: Integer; AValue: TImageIndex);
  public
    constructor Create(AOwner: TCheckComboBoxEx);
    property Owner: TCheckComboBoxEx read FOwner;
  published
    property NormalDown: TImageIndex index 0 read GetImgIndex write SetImgIndex default -1;
    property HotDown: TImageIndex index 1 read GetImgIndex write SetImgIndex default -1;
    property PressedDown: TImageIndex index 2 read GetImgIndex write SetImgIndex default -1;
    property DisabledDown: TImageIndex index 3 read GetImgIndex write SetImgIndex default -1;
    property NormalUp: TImageIndex index 4 read GetImgIndex write SetImgIndex default -1;
    property HotUp: TImageIndex index 5 read GetImgIndex write SetImgIndex default -1;
    property PressedUp: TImageIndex index 6 read GetImgIndex write SetImgIndex default -1;
    property DisabledUp: TImageIndex index 7 read GetImgIndex write SetImgIndex default -1;
  end;
    
  TCheckComboBoxEx = class(TCustomEditButton)
  private
    FAllowGrayed: Boolean;
    FAutoDropDown: Boolean;
    FButtonWidth: Integer;
    FCheckListBox: TCheckListBox;
    FCloseUpTime: TDateTime;
    FDelimiter: Char;
    FDropDownCount: Integer;
    FDropDownImageIndex: TCheckComboBoxExImageIndex;
    FDroppedDown: Boolean;
    FEscCancels: Boolean;
    FItemIndex: Integer;
    FItems: TCheckComboBoxExStrings;
    FItemWidth: Integer;
    FHintMode: TCheckComboBoxHintMode;
    FSavedChecks: array of Integer;
    FSorted: Boolean;
    FOnChange: TNotifyEvent;
    FOnCloseUp: TNotifyEvent;
    FOnDropDown: TNotifyEvent;
    FOnItemChange: TCheckItemChange;
    FOnItemClick: TCheckListClicked;
    procedure ButtonMouseDownHandler(Sender: TObject;
      {%H-}AButton: TMouseButton; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
    procedure CheckComboBoxFormCloseHandler(Sender: TObject; var CloseAction: TCloseAction);
    function GetButtonWidth: Integer;
    function GetChecked(AIndex: Integer): Boolean;
    function GetImages: TCustomImagelist;
    function GetImageWidth: Integer;
    function GetItemEnabled(AIndex: Integer): Boolean;
    function GetItems: TStrings;
    function GetState(AIndex: Integer): TCheckBoxState;
    procedure ItemClickHandler(Sender: TObject; AIndex: Integer);
    procedure ItemsToCheckListbox(ACheckListbox: TCheckListbox);
    procedure SetAllowGrayed(AValue: Boolean);
    procedure SetButtonWidth(AValue: Integer);
    procedure SetChecked(AIndex: Integer; const AValue: Boolean);
    procedure SetDelimiter(AValue: Char);
    procedure SetDropDownCount(AValue: Integer);
    procedure SetImages(AValue: TCustomImageList);
    procedure SetImageWidth(AValue: Integer);
    procedure SetItemEnabled(AIndex: Integer; const AValue: Boolean);
    procedure SetItemIndex(AValue: Integer);
    procedure SetItems(const AValue: TStrings);
    procedure SetItemWidth(AValue: Integer);
    procedure SetSorted(AValue: Boolean);
    procedure SetState(AIndex: Integer; const AValue: TCheckboxState);
  protected
    procedure ButtonClick; override;
    procedure CloseUp;
    function CreateBuddy: TControl; override;
    procedure CreateHandle; override;
    procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
      const AXProportion, AYProportion: Double); override;
    procedure DoEnter; override;
    procedure DoChange; virtual;
    procedure DoItemChange(AIndex: Integer); virtual;
    procedure DoCloseUp; virtual;
    procedure DoDropDown; virtual;
    procedure DoItemClick(AIndex: Integer); virtual;
    procedure DoOnShowHint(HintInfo: PHintInfo); override;
    procedure EditKeyDown(var Key: Word; Shift: TShiftState); override;
    function GetBuddyClassType: TControlClass; override;
    function GetEditorClassType: TGEEditClass; override;
    procedure InvalidateButton; virtual;
    procedure RestoreInitialChecks;
    procedure SaveInitialChecks;
    procedure SetBiDiMode(AValue: TBiDiMode); override;
    procedure ShowPopup;
    procedure UpdateCaption;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function AddItem(AText: String; AChecked: Boolean = false; AEnabled: Boolean = true): Integer;
    procedure CheckAll(AState: TCheckBoxState; AAllowGrayed: Boolean = true; AAllowDisabled: Boolean = true);
    procedure Clear;
    procedure Toggle(AIndex: Integer);
    // public properties
    property Checked[AIndex: Integer]: Boolean read GetChecked write SetChecked;
    property DroppedDown: Boolean read FDroppedDown;
    property ItemEnabled[AIndex: Integer]: Boolean read GetItemEnabled write SetItemEnabled;
    property Text;
  published
    property AllowGrayed: Boolean read FAllowGrayed write SetAllowGrayed default false;
    property AutoDropDown: Boolean read FAutoDropDown write FAutoDropDown default false;
    property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default -1;
    property Delimiter: char read FDelimiter write SetDelimiter default ';';
    property DropDownCount: Integer read FDropDownCount write SetDropDownCount default 8;
    property DropDownImageIndex: TCheckComboBoxExImageIndex read FDropDownImageIndex write FDropDownImageIndex;
    property EscCancels: Boolean read FEscCancels write FEscCancels default true;
    property HintMode: TCheckComboBoxHintMode read FHintMode write FHintMode default cbhmDefault;
    property Images: TCustomImageList read GetImages write SetImages;
    property ImageWidth: Integer read GetImageWidth write SetImageWidth default 0;
    property ItemIndex: Integer read FItemIndex write SetItemIndex default -1;
    property Items: TStrings read GetItems write SetItems;
    property ItemWidth: Integer read FItemWidth write FItemWidth default 0;
    property Sorted: Boolean read FSorted write SetSorted default false;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
    property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
    property OnItemChange: TCheckItemChange read FOnItemChange write FOnItemChange;
    property OnItemClick: TCheckListClicked read FOnItemClick write FOnItemClick;
    // inherited properties
    property Align;
    property Anchors;
    property AutoSize;
    property BiDiMode;
    property BorderSpacing;
    property Color;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Hint;
    property ParentBidiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Spacing default 0;
    property TabOrder;
    property TabStop;
    property TextHint;
    property Visible;  
    // inherited events
    property OnChangeBounds;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

  
implementation

uses
  Buttons, Themes, WSForms;

type
  TCustomListboxHelper = class helper for TCustomListbox
  public
    function CalculateStandardItemHeight: Integer;
  end;

function TCustomListboxHelper.CalculateStandardItemHeight: Integer;
begin
  Result := inherited;
end;

{ TCCBItem }     // CCB = CheckComboBox
type
  TCCBItem = class
    Caption: String;
    State: TCheckboxState;
    Enabled: Boolean;
    Obj: TObject;
    constructor Create;
  end;

constructor TCCBItem.Create;
begin
  State := cbUnchecked;
  Enabled := true;
end;


{ TCheckComboBoxExStrings }

destructor TCheckComboBoxExStrings.Destroy;
begin
  Clear;
  inherited;
end;

procedure TCheckComboBoxExStrings.Assign(ASource: TPersistent);
var
  i: Integer;
begin
  inherited Assign(ASource);
  if (ASource is TCheckComboBoxExStrings) then
    for i := 0 to Count-1 do
    begin
      State[i] := TCheckComboBoxExStrings(ASource).State[i];
      Enabled[i] := TCheckComboBoxExStrings(ASource).Enabled[i];
    end;
end;
    
procedure TCheckComboBoxExStrings.Clear;
var
  i: Integer;
begin
  for i := 0 to Count-1 do
    TCCBItem(inherited Objects[i]).Free;
  inherited;
end;

procedure TCheckComboBoxExStrings.Delete(AIndex: Integer);
begin
  TCCBItem(inherited Objects[AIndex]).Free;
  inherited;
end;

function TCheckComboBoxExStrings.GetChecked(AIndex: Integer): Boolean;
begin
  Result := GetState(AIndex) = cbChecked;
end;

function TCheckComboBoxExStrings.GetEnabled(AIndex: Integer): Boolean;
begin
  Result := TCCBItem(inherited Objects[AIndex]).Enabled;
end;

function TCheckComboBoxExStrings.GetObj(AIndex: Integer): TObject;
begin
  Result := TCCBItem(inherited Objects[AIndex]).Obj;
end;

function TCheckComboBoxExStrings.GetState(AIndex: Integer): TCheckboxState;
begin
  Result := TCCBItem(inherited Objects[AIndex]).State;
end;

procedure TCheckComboBoxExStrings.InsertItem(AIndex: Integer; const AText: String);
begin
  inherited InsertItem(AIndex, AText, TCCBItem.Create);
end;
  
procedure TCheckComboBoxExStrings.InsertItem(AIndex: Integer; const AText: String;
  Obj: TObject);
begin
  InsertItem(AIndex, AText);
  TCCBItem(inherited Objects[AIndex]).Obj := Obj;
end;
  
procedure TCheckComboBoxExStrings.SetChecked(AIndex: Integer; AValue: Boolean);
begin
  if AValue then
    SetState(AIndex, cbChecked)
  else
    SetState(AIndex, cbUnchecked);
end;

procedure TCheckComboBoxExStrings.SetEnabled(AIndex: Integer; AValue: Boolean);
var
  item: TCCBItem;
begin
  item := TCCBItem(inherited Objects[AIndex]);
  if item.Enabled = AValue then exit;
  item.Enabled := AValue;
end;

procedure TCheckComboBoxExStrings.SetObj(AIndex: Integer; AValue: TObject);
begin
  TCCBItem(inherited Objects[AIndex]).Obj := AValue;
end;

procedure TCheckComboBoxExStrings.SetState(AIndex: Integer; AValue: TCheckBoxState);
var
  item: TCCBItem;
begin
  item := TCCBItem(inherited Objects[AIndex]);
  if item.State = AValue then exit;
  item.State := AValue;
end;


{ TCCBEdit }     
type
  TCCBEdit = class(TEbEdit)
  protected
    procedure DoOnShowHint(HintInfo: PHintInfo); override;
  end;

procedure TCCBEdit.DoOnShowHint(HintInfo: PHintInfo); 
begin
  (Parent as TCheckComboBoxEx).DoOnShowHint(HintInfo);
end;

  
{ TCCBButton }
type
  TCCBButton = class(TSpeedButton)
  private
    procedure SetHotImageIndex;
    procedure SetImageIndex(AEnabledIndex, ADisabledIndex: Integer; Up: Boolean);
    procedure SetNormalImageIndex;
    procedure SetPressedImageIndex;
  protected
    procedure DoOnShowHint(HintInfo: PHintInfo); override;
    procedure MouseEnter; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;     
    procedure MouseLeave; override;
    procedure Paint; override;
  public
    procedure UpdateImageIndex;
  end;

procedure TCCBButton.DoOnShowHint(HintInfo: PHintInfo); 
begin
  (Parent as TCheckComboBoxEx).DoOnShowHint(HintInfo);
end;
  
procedure TCCBButton.MouseEnter;
begin
  inherited;
  SetHotImageIndex;
end;

procedure TCCBButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X,Y: Integer);
begin
  inherited;
  if (Button = mbLeft) and (Shift = []) then
    SetPressedImageIndex;
end;

procedure TCCBButton.MouseLeave;
begin
  inherited;
  SetNormalImageIndex;
end;

procedure TCCBButton.Paint;
const
  DETAILS: array[TButtonState] of TThemedComboBox = (
    tcDropDownButtonNormal,   // bsUp = button is up
    tcDropDownButtonDisabled, // bsDisabled = button is disabled
    tcDropDownButtonPressed,  // bsPressed = button is down
    tcDropDownButtonPressed,  // (not used)
    tcDropDownButtonHot       // bsHot = mouse is under mouse
  );
var
  detail: TThemedElementDetails;
begin
  inherited Paint;
  if Images = nil then
  begin
    detail := ThemeServices.GetElementDetails(DETAILS[FState]);
    ThemeServices.DrawElement(Canvas.Handle, detail, ClientRect);
  end;
end;
  
procedure TCCBButton.SetHotImageIndex;
begin
  with Parent as TCheckComboBoxEx do
    if DroppedDown then
      Self.SetImageIndex(DropDownImageIndex.HotUp, DropDownImageIndex.DisabledUp, true)
    else
      Self.SetImageIndex(DropDownImageIndex.HotDown, DropDownImageIndex.DisabledDown, false);
end;

procedure TCCBButton.SetImageIndex(AEnabledIndex, ADisabledIndex: Integer;
  Up: Boolean);
var
  idx: Integer;
begin
  if Parent.Enabled then
  begin
    if AEnabledIndex > -1 then
      ImageIndex := AEnabledIndex
    else
      ImageIndex := (Parent as TCheckComboBoxEx).DropDownImageIndex.NormalDown;
  end else
  begin
    if ADisabledIndex > -1 then
      ImageIndex := ADisabledIndex
    else
    begin
      idx := -1;
      if Up then
        idx := (Parent as TCheckComboBoxEx).DropDownImageIndex.NormalUp;
      if idx = -1 then 
        idx := (Parent as TCheckComboBoxEx).DropDownImageIndex.NormalDown;
      ImageIndex := idx;
    end;
  end;
end;

procedure TCCBButton.SetNormalImageIndex;
begin
  with Parent as TCheckComboBoxEx do
    if DroppedDown then
      Self.SetImageIndex(DropDownImageIndex.NormalUp, DropDownImageIndex.DisabledUp, true)
    else
      Self.SetImageIndex(DropDownImageIndex.NormalDown, DropDownImageIndex.DisabledDown, false);
end;
  
procedure TCCBButton.SetPressedImageIndex;
begin
  with Parent as TCheckComboBoxEx do
    if DroppedDown then
      Self.SetImageIndex(DropDownImageIndex.PressedUp, DropDownImageIndex.DisabledUp, true)
    else
      Self.SetImageIndex(DropDownImageIndex.PressedDown, DropDownImageIndex.DisabledDown, false);
end;

procedure TCCBButton.UpdateImageIndex;
var
  P: TPoint;
begin
  P := ScreenToClient(Mouse.CursorPos);
  if PtInRect(BoundsRect, P) then
    SetHotImageIndex
  else
    SetNormalImageIndex;
end;


{ TCheckComboBoxForm }
type
  TCheckComboBoxForm = class(TForm)
  private
    FCaller: TControl;
    FCheckListBox: TCheckListBox;
    FDropDownCount: Integer;
    FStdItemHeight: Integer;
  protected
    procedure ActivateDoubleBuffered;
    procedure DblClickHandler(Sender: TObject);
    procedure Deactivate; override;
    procedure KeepInView(APopupOrigin: TPoint);    
    procedure KeyDownHandler(Sender: TObject; var Key: Word; Shift: TShiftState); 
    procedure MeasureHeight(out AHeight: Integer);
  public
    constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
    procedure Initialize(ADropdownCount: Integer; APosition: TPoint; AWidth: Integer);
  end;

constructor TCheckComboBoxForm.CreateNew(AOwner: TComponent; Num: Integer = 0);
begin
  inherited CreateNew(AOwner, Num);
  BorderStyle := bsNone;
  FCheckListbox := TCheckListbox.Create(self);
  FCheckListbox.Align := alClient;
  FCheckListbox.Parent := self;
  FCheckListbox.OnDblClick := @DblClickHandler;
  FCheckListbox.OnKeyDown := @KeyDownHandler;
  FDropDownCount := 8;
  FStdItemHeight := FCheckListbox.CalculateStandardItemHeight;
end;
  
procedure TCheckComboBoxForm.ActivateDoubleBuffered;
begin
  DoubleBuffered := TWSCustomFormClass(WidgetSetClass).GetDefaultDoubleBuffered;
end;

procedure TCheckComboBoxForm.Deactivate;
begin
  Close;
end;

procedure TCheckComboboxForm.DblClickHandler(Sender: TObject);
begin
  {$IFDEF LCLCocoa}
  Free;
  {$ELSE}
  Close;
  {$ENDIF}
end;

procedure TCheckComboBoxForm.Initialize(ADropDownCount: Integer;
  APosition: TPoint; AWidth: Integer);
var
  h: Integer;
begin
  FDropDownCount := ADropDownCount;
  MeasureHeight(h);
  SetBounds(APosition.X, APosition.Y, AWidth, h);
  KeepInView(APosition);
  AutoScroll := FCheckListBox.Items.Count > FDropDownCount;
end;
  
procedure TCheckComboBoxForm.KeepInView(APopupOrigin: TPoint);
var
  R: TRect;
begin
  R := Screen.MonitorFromPoint(APopupOrigin).WorkAreaRect; // take care of taskbar
  
  if APopupOrigin.X + Width > R.Right then
    Left := R.Right - Width
  else if APopupOrigin.X < R.Left then
    Left := R.Left
  else
    Left := APopupOrigin.X;
  
  if APopupOrigin.Y + Height > R.Bottom then
  begin
    if Assigned(FCaller) then
      Top := APopupOrigin.Y - FCaller.Height - Height
    else
      Top := R.Bottom - Height;
  end else if APopupOrigin.Y < R.Top then
    Top := R.Top
  else
    Top := APopupOrigin.Y;
  
  if Left < R.Left then Left := 0;
  if Top < R.Top then Top := 0;
end;
  
procedure TCheckComboBoxForm.KeyDownHandler(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin
  inherited;
  if (Key = VK_ESCAPE) and TCheckComboBoxEx(FCaller).EscCancels then
    TCheckComboBoxEx(FCaller).RestoreInitialChecks;
  if (Key = VK_ESCAPE) or (Key = VK_TAB) or (Key = VK_RETURN) or
     (((Key = VK_UP) or (Key = VK_DOWN)) and (Shift = [ssAlt])) 
  then
    Close;
end;

procedure TCheckComboBoxForm.MeasureHeight(out AHeight: Integer);
var
  i, h, n: Integer;
begin
  AHeight := 0;
  n := FCheckListbox.Items.Count;
  if FDropDownCount < n then
    n := FDropDownCount;
  for i := 0 to n-1 do
  begin
    h := -1;
    FCheckListbox.MeasureItem(i, h);
    if h = -1 then
      h := FStdItemHeight;
    inc(AHeight, h);
  end;
  inc(AHeight, 6);
end;
    

{ TCheckComboBoxExImageIndex }

constructor TCheckComboBoxExImageIndex.Create(AOwner: TCheckComboBoxEx);
var
  i: Integer;
begin
  inherited Create;
  FOwner := AOwner;
  for i := 0 to High(FImgIndex) do
    FImgIndex[i] := -1;
end;

function TCheckComboBoxExImageIndex.GetImgIndex(AIndex: Integer): TImageIndex;
begin
  Result := FImgIndex[AIndex];
end;

procedure TCheckComboBoxExImageIndex.SetImgIndex(AIndex: Integer; AValue: TImageIndex);
begin
  if FImgIndex[AIndex] = AValue then
    exit;
  FImgIndex[AIndex] := AValue;
  TCheckComboBoxEx(FOwner).InvalidateButton;
end;


{ TCheckComboBoxEx }

constructor TCheckComboBoxEx.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Spacing := 0;
  Button.Flat := true;
  FButtonWidth := -1;
  FDelimiter := ';';
  FDropDownCount := 8;
  FDropDownImageIndex := TCheckComboBoxExImageIndex.Create(self);
  ImageIndex := FDropDownImageIndex.NormalDown;
  FItems := TCheckComboBoxExStrings.Create;
  FEscCancels := true;
end;

destructor TCheckComboBoxEx.Destroy;
begin
  FItems.Free;
  FDropdownImageIndex.Free;
  inherited Destroy;
end;

function TCheckComboBoxEx.AddItem(AText: String; AChecked: Boolean = false; 
  AEnabled: Boolean = true): Integer;
var
  j: Integer;
begin
  j := FItems.Add(AText);
  if AChecked then
    FItems.State[j] := cbChecked
  else
    FItems.State[j] := cbUnchecked;
  FItems.Enabled[j] := AEnabled;

  if FDroppedDown then
    with FCheckListBox do
    begin
      Result := Items.Add(AText);
      Checked[Result] := AChecked;
      ItemEnabled[Result] := AEnabled;
    end;
  
  UpdateCaption;
end;

procedure TCheckComboBoxEx.ButtonClick;
begin
  {
  if DroppedDown then
    CloseUp
  else
    ShowPopup;
}
end;

procedure TCheckComboBoxEx.ButtonMouseDownHandler(Sender: TObject;
  AButton: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if DroppedDown then
    CloseUp
  else
    ShowPopup;
end;

procedure TCheckComboBoxEx.CheckAll(AState: TCheckBoxState;
  AAllowGrayed: Boolean = true; AAllowDisabled: Boolean = true);
var
  i: Integer;
begin
  for i := 0 to FItems.Count-1 do
  begin
    if not FItems.Enabled[i] and not AAllowDisabled then
      Continue;
    if AState in [cbChecked, cbUnchecked] then
      FItems.State[i] := AState
    else if (AState = cbGrayed) then
    begin
      if AAllowGrayed then
        FItems.State[i] := cbGrayed
      else
        FItems.State[i] := cbUnChecked;
    end;
  end;

  if FDroppedDown then
    with FCheckListBox do
      CheckAll(AState, AAllowGrayed, AAllowDisabled);
  
  UpdateCaption;
  DoChange;
end;

procedure TCheckComboBoxEx.CheckComboBoxFormCloseHandler(Sender: TObject;
  var CloseAction: TCloseAction);
begin
  CloseUp;
  FCheckListBox := nil;
  CloseAction := caFree;
end;

procedure TCheckComboBoxEx.Clear;
begin
  FItems.Clear;
  
  if FDroppedDown then
    FCheckListBox.Clear;
  UpdateCaption;
  DoChange;
end;

procedure TCheckComboBoxEx.CloseUp;
begin
  FDroppedDown := false;
  InvalidateButton;
  UpdateCaption;
  DoCloseUp;
  FCloseUpTime := Now();
end;

function TCheckComboBoxEx.CreateBuddy: TControl;
begin
  Result := inherited;
  TSpeedButton(Result).OnMouseDown := @ButtonMouseDownHandler;
end;

procedure TCheckComboBoxEx.CreateHandle;
begin
  inherited;
  if FButtonWidth < 0 then
    Buddy.Width := GetSystemMetrics(SM_CXVSCROLL);
end;

procedure TCheckComboBoxEx.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
  const AXProportion, AYProportion: Double);
begin
  inherited;
  if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
  begin
    if FButtonWidth < 0 then
      Buddy.Width := GetSystemMetrics(SM_CXVSCROLL)
    else
    begin
      FButtonWidth := round(AXProportion * FButtonWidth);
      Buddy.Width := FButtonWidth;
    end;
  end;
end;

procedure TCheckComboBoxEx.DoChange;
begin
  if Assigned(FOnChange) then FOnChange(self);
end;

procedure TCheckComboBoxEx.DoCloseUp;
begin
  if Assigned(FOnCloseUp) then FOnCloseUp(self);
end;
  
procedure TCheckComboBoxEx.DoDropDown;
begin
  if Assigned(FOnDropDown) then FOnDropDown(self);
end;

procedure TCheckComboBoxEx.DoEnter;
begin
  inherited;
  if FAutoDropDown then ShowPopup;
end;

procedure TCheckComboBoxEx.DoItemChange(AIndex: Integer);
begin
  if Assigned(FOnItemChange) then
    FOnItemChange(self, AIndex);
end;

procedure TCheckComboBoxEx.DoItemClick(AIndex: Integer);
begin
  if Assigned(FOnItemClick) then
    FOnItemClick(self, AIndex);
end;

procedure TCheckComboBoxEx.DoOnShowHint(HintInfo: PHintInfo); 
begin
  if FHintMode = cbhmItems then
    HintInfo^.HintStr := StringReplace(Text, FDelimiter+' ', LineEnding, [rfReplaceAll]);
  inherited;
end;

procedure TCheckComboBoxEx.EditKeyDown(var Key: Word; Shift: TShiftState); 
begin
  if (Key = VK_TAB) then
  begin
    inherited;
    exit;
  end;
  
  if (Key = VK_RETURN) or (Key = VK_SPACE) or 
     (((Key = VK_DOWN) or (Key = VK_UP)) and (Shift = [ssAlt])) 
  then
    ShowPopup;
  
  // Kill all other keys
  Key := 0;
end;

function TCheckComboBoxEx.GetBuddyClassType: TControlClass;
begin
  Result := TCCBButton;
end;

function TCheckComboBoxEx.GetButtonWidth: Integer;
begin
  Result := Buddy.Width;
end;

function TCheckComboBoxEx.GetChecked(AIndex: Integer): Boolean;
begin
  Result := FItems.Checked[AIndex];
end;

function TCheckComboBoxEx.GetEditorClassType: TGEEditClass; 
begin
  Result := TCCBEdit;
end;

function TCheckComboBoxEx.GetImages: TCustomImageList;
begin
  Result := (Buddy as TSpeedButton).Images;
end;

function TCheckComboBoxEx.GetImageWidth: Integer;
begin
  Result := (Buddy as TSpeedButton).ImageWidth;
end;

function TCheckComboBoxEx.GetItemEnabled(AIndex: Integer): Boolean;
begin
  Result := FItems.Enabled[AIndex];
end;

function TCheckComboBoxEx.GetItems: TStrings;
begin
  Result := FItems;
end;

function TCheckComboBoxEx.GetState(AIndex: Integer): TCheckboxState;
begin
  Result := FItems.State[AIndex];
end;

procedure TCheckComboBoxEx.InvalidateButton;
begin
  with (Buddy as TCCBButton) do
    UpdateImageIndex;
end;

procedure TCheckComboBoxEx.ItemClickHandler(Sender: TObject; AIndex: Integer);
begin
  UpdateCaption;
  DoChange;
  DoItemChange(AIndex);
  DoItemClick(AIndex);
end;

procedure TCheckComboBoxEx.ItemsToCheckListbox(ACheckListbox: TCheckListbox);
var
  i: Integer;
begin
  ACheckListbox.Items.BeginUpdate;
  try
    ACheckListbox.Items.Clear;
    for i := 0 to FItems.Count-1 do
    begin
      ACheckListbox.Items.Add(FItems[i]);
      ACheckListbox.State[i] := FItems.State[i];
      ACheckListbox.ItemEnabled[i] := FItems.Enabled[i];
    end;
    if (FItemIndex > -1) and (FItemIndex < ACheckListbox.Count) then
      ACheckListbox.ItemIndex := FItemIndex;
  finally
    ACheckListbox.Items.EndUpdate;
  end;
end;
    
procedure TCheckComboBoxEx.RestoreInitialChecks;
var
  i: Integer;
begin
  for i := 0 to FItems.Count-1 do
    FItems.Checked[i] := false;
  for i := 0 to High(FSavedChecks) do
    FItems.Checked[FSavedChecks[i]] := true;
end;
  
procedure TCheckComboBoxEx.SaveInitialChecks;
var
  i, n: Integer;
begin
  SetLength(FSavedChecks, FItems.Count);
  n := 0;
  for i := 0 to FItems.Count-1 do
    if FItems.Checked[i] then 
    begin
      FSavedChecks[n] := i;
      inc(n);
    end;
  SetLength(FSavedChecks, n);
end;

procedure TCheckComboBoxEx.SetAllowGrayed(AValue: Boolean);
begin
  if FAllowGrayed = AValue then exit;
  FAllowGrayed := AValue;
  
  if FDroppedDown then
    FCheckListBox.AllowGrayed := AValue;
end;

procedure TCheckComboBoxEx.SetBiDiMode(AValue: TBiDiMode);
begin
  if AValue = BiDiMode then exit;
  
  inherited SetBiDiMode(AValue);
  
  if FDroppedDown then
    FCheckListBox.BiDiMode := AValue;
  if IsRightToLeft then
    Buddy.Align := alLeft 
  else
    Buddy.Align := alRight;
  
  UpdateCaption;
end;

procedure TCheckComboBoxEx.SetButtonWidth(AValue: Integer);
begin
  if FButtonWidth = AValue then
    exit;
  FButtonWidth := AValue;
  if FButtonWidth < 0 then
    Buddy.Width := GetSystemMetrics(SM_CXVSCROLL)
  else
    Buddy.Width := FButtonWidth;
end;

procedure TCheckComboBoxEx.SetChecked(AIndex: Integer; const AValue: Boolean);
begin
  if FItems.Checked[AIndex] = AValue then
    exit;
  if AValue then
    FItems.State[AIndex] := cbChecked
  else
    FItems.State[AIndex] := cbUnchecked;
  
  if FDroppedDown then
    FCheckListBox.Checked[AIndex] := AValue;
  
  UpdateCaption;
  DoChange;
  DoItemChange(AIndex);
end;

procedure TCheckComboBoxEx.SetDelimiter(AValue: Char);
begin
  if FDelimiter = AValue then exit;
  FDelimiter := AValue;
  UpdateCaption;
end;

procedure TCheckComboBoxEx.SetDropDownCount(AValue: Integer);
begin
  if (FDropDownCount = AValue) or (AValue <= 0) then exit;
  FDropDownCount := AValue;
end;

procedure TCheckComboBoxEx.SetImages(AValue: TCustomImageList);
begin
  (Buddy as TSpeedButton).Images := AValue;
end;

procedure TCheckComboBoxEx.SetImageWidth(AValue: Integer);
begin
  (Buddy as TSpeedButton).ImageWidth := AValue;
end;

procedure TCheckComboBoxEx.SetItemEnabled(AIndex: Integer; const AValue: Boolean);
begin
  if FItems.Enabled[AIndex] = AValue then exit;
  FItems.Enabled[AIndex] := AValue;
  
  if FDroppedDown then
    FCheckListbox.ItemEnabled[AIndex] := AValue;
end;

procedure TCheckComboBoxEx.SetItemIndex(AValue: Integer);
begin
  if FItemIndex = AValue then exit;
  FItemIndex := AValue;
  if FDroppedDown then
    FCheckListBox.ItemIndex := AValue;
end;

procedure TCheckComboBoxEx.SetItems(const AValue: TStrings);
begin
  FItems.Assign(AValue);
  if FDroppedDown then
    FCheckListBox.Items.Assign(AValue);
end;

procedure TCheckComboBoxEx.SetItemWidth(AValue: Integer);
begin
  if FItemWidth = AValue then exit;
  if AValue < 0 then
    FItemWidth := 0
  else
    FItemWidth := AValue;
end;

procedure TCheckComboBoxEx.SetSorted(AValue: Boolean);
begin
  if AValue = FSorted then
    exit;
  
  FSorted := AValue;
  if FSorted then
    FItems.Sort;

  UpdateCaption;
end;

procedure TCheckComboBoxEx.SetState(AIndex: Integer; const AValue: TCheckBoxState);
begin
  if FItems.State[AIndex] = AValue then
    exit;
  
  FItems.State[AIndex] := AValue;
  if FDroppedDown then
    FCheckListbox.State[AIndex] := AValue;
  
  DoChange;
  DoItemChange(AIndex);
end;

procedure TCheckComboBoxEx.ShowPopup;
const
  MILLISECOND = 1.0/(24*60*60*100);
  DELAY = 10*MILLISECOND;
var
  PopupOrigin: TPoint;
  PopupWidth: Integer;
  F: TCheckComboBoxForm;
begin
  if FItems.Count = 0 then
    exit;

  if Now() - FCloseUpTime < DELAY then
    exit;
    
  F := TCheckComboBoxForm.CreateNew(Application);
  F.FCaller := Self;
  F.BiDiMode := BiDiMode;
  if DoubleBuffered then
    F.ActivateDoubleBuffered;
  F.FCheckListBox.AllowGrayed := FAllowGrayed;
  PopupOrigin := ControlToScreen(Point(0, Height));
  if FItemWidth > 0 then
    PopupWidth := FItemWidth
  else
    PopupWidth := Self.Width;
  ItemsToCheckListbox(F.FCheckListbox);
  F.Initialize(FDropDownCount, PopupOrigin, PopupWidth);
  SaveInitialChecks;
  F.FCheckListbox.OnItemClick := @ItemClickHandler;
  F.OnClose := @CheckComboBoxFormCloseHandler;
  F.Show;
  FDroppedDown := true;
  FCheckListbox := F.FCheckListbox;
  InvalidateButton;
  DoDropDown;
end;

procedure TCheckComboBoxEx.Toggle(AIndex: Integer);
begin
  SetChecked(AIndex, not GetChecked(AIndex));
end;

procedure TCheckComboBoxEx.UpdateCaption;
var
  i: Integer;
  s: String;
begin
  if FDroppedDown then
    for i := 0 to FCheckListBox.Items.Count - 1 do
      FItems.State[i] := FCheckListbox.State[i];
  
  s := '';
  if IsRightToLeft then
  begin
    for i := FItems.Count-1 downto 0 do
      if FItems.Checked[i] then
        s := s + FItems[i] + FDelimiter + ' '
  end else  
  begin
    for i := 0 to FItems.Count-1 do
      if FItems.Checked[i] then
        s := s + FItems[i] + FDelimiter + ' ';
  end;
  if s <> '' then
    SetLength(s, Length(s)-2);
  Text := s;
end;
  

end.