unit SRVTypeItems;

interface

uses Classes, SysUtils, StdCtrls, Graphics;

const
  SRVCB_FACE_START_BUTTON = $00EEEEEE;
  SRVCB_FACE_END_BUTTON = $00B7BBBF;
  SRVCB_FACE_START_VALUE = $00EEEEEE;
  SRVCB_FACE_END_VALUE = $00B7BBBF;
  SRVCB_FACE_START_FON = $00FFFFFF;
  SRVCB_FACE_END_FON = $00E7EBEF;

type
  TSRVItemOption = (srvioShowCheckBox, srvioShowImage,
                    srvioShowText, srvioCanSelect, srvioCanHaveChildren);
  TSRVItemOptions = set of TSRVItemOption;
  TLRAlignment =  (tlraLeftJustify, tlraRightJustify);

  TSRVCBOption = (srvcbQuickKeySelect);
  TSRVCBOptions = set of TSRVCBOption;

{ TSRVCBoxItem }
  TSRVCBoxItem = class(TCollectionItem)
  private
    FOwner : TCollection;
    FTag: Longint;
  protected
    FOpenParent : Boolean;
    FCaption : String;
    FSelected : Boolean;
    FImageIndex : Integer;
    FSelectedImageIndex : Integer;
    FIndent : Integer;
    FEnabled : Boolean;
    FStyle: TFontStyles;
    FColor : TColor;
    FBackColor : TColor;
    FFontName : TFontName;
    FExpanded : Boolean;
    FOption : TSRVItemOptions;
    FAlignImage : TLRAlignment;
    FAlignment : TAlignment;
    FHint : String;
    FSkinSchemeIndex : Integer;
    procedure SetCaption(const Value : String);
    procedure SetHint(const Value : String);
    procedure SetImageIndex(const Value : Integer);
    procedure SetSelectedImageIndex(const Value : Integer);
    procedure SetIndent(const Value : Integer);
    procedure SetEnabled(const Value : Boolean);
    procedure SetStyle(const Value : TFontStyles);
    procedure SetColor(const Value : TColor);
    procedure SetBackColor(const Value : TColor);
    procedure SetFontName(const Value : TFontName);
    procedure SetShowChild(const Value : Boolean);
    procedure SetOption(const Value : TSRVItemOptions);
    procedure SetSelected(const Value : Boolean); virtual;
    procedure SetAlignImage(const Value : TLRAlignment);
    procedure SetAlignment(const Value : TAlignment);
    procedure SetSkinSchemeIndex(const Value : Integer);
  public
    property OpenParent : Boolean read FOpenParent;
    constructor Create(Collection: TCollection); override;
    function GetOwner: TPersistent; override;
    procedure Assign(Source: TPersistent); override;
    function GetDisplayName: string; override;
    property Selected : Boolean read FSelected write SetSelected;
  published
    property SkinSchemeIndex : Integer read FSkinSchemeIndex write SetSkinSchemeIndex default -1;
    property ImageIndex : Integer read FImageIndex write SetImageIndex default -1;
    property SelectedImageIndex : Integer read FSelectedImageIndex write SetSelectedImageIndex default -1;
    property Indent : Integer read FIndent write SetIndent default 0;
    property Caption : String read FCaption write SetCaption;
    property Hint : String read FHint write SetHint;
    property Enabled : Boolean read FEnabled write SetEnabled default True;
    property Style: TFontStyles read FStyle write SetStyle;
    property Color : TColor read FColor write SetColor default clWindowText;
    property BackColor : TColor read FBackColor write SetBackColor default clWindow;
    property FontName : TFontName read FFontName write SetFontName;
    property Expanded : Boolean read FExpanded write SetShowChild default True;
    property Option : TSRVItemOptions read FOption write SetOption;
    property AlignImage : TLRAlignment read FAlignImage write SetAlignImage default tlraLeftJustify;
    property Alignment : TAlignment read FAlignment write SetAlignment default taLeftJustify;
    property Tag : Integer read FTag write FTag default 0;
  end;

{ TSRVCBoxItemCollection }
  TSRVCBoxItemCollection = class(TCollection)
  private
    FOwner: TPersistent;
    function GetCBoxItem(Index: Integer): TSRVCBoxItem;
    procedure SetCBoxItem(Index: Integer; const Value: TSRVCBoxItem);
  public
    OnAppend : TNotifyEvent;
    OnModify : TNotifyEvent;
    OnRemove : TNotifyEvent;
    constructor Create(ItemClass: TCollectionItemClass; Owner: TPersistent);
    function GetOwner: TPersistent; override;
    procedure AssignTo(Dest: TPersistent); override;
    procedure Assign(Source: TPersistent); override;
    procedure UpdateTree;
    property Items[Index: Integer]: TSRVCBoxItem read GetCBoxItem write SetCBoxItem; default;
  end;

{ TSRVLBoxItem }
  TSRVLBoxItem = class(TSRVCBoxItem)
  private
  protected
    FChecked : Boolean;
    FState : TCheckBoxState;
    FAlignCheckBox : TLRAlignment;
    procedure SetChecked(const Value : Boolean);
    procedure SetState(const Value : TCheckBoxState);
    procedure SetSelected(const Value : Boolean); override;
    procedure SetAlignChecked(const Value : TLRAlignment);
    function CountChild : Integer;
    function CountChecked : Integer;
    procedure UpdateState;
    procedure UpdateParentState;
    procedure UpdateChildState;
  public
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
  published
    property Checked : Boolean read FChecked write SetChecked default False;
    property State : TCheckBoxState read FState write SetState default cbUnchecked;
    property AlignCheckBox : TLRAlignment read FAlignCheckBox write SetAlignChecked default tlraLeftJustify;
  end;

{ TSRVLBoxItemCollection }
  TSRVLBoxItemCollection = class(TSRVCBoxItemCollection)
  private
    FOwner: TPersistent;
    FMultiSelect : Boolean;
    procedure SetMultiSelect(const Value : Boolean);
    function GetLBoxItem(Index: Integer): TSRVLBoxItem;
    procedure SetLBoxItem(Index: Integer; const Value: TSRVLBoxItem);
  public
    constructor Create(ItemClass: TCollectionItemClass; Owner: TPersistent);
    function GetOwner: TPersistent; override;
    procedure AssignTo(Dest: TPersistent); override;
    procedure Assign(Source: TPersistent); override;
    procedure ClearSelect;
    property MultiSelect : Boolean read FMultiSelect write SetMultiSelect;
    property Items[Index: Integer]: TSRVLBoxItem read GetLBoxItem write SetLBoxItem; default;
  end;

implementation

uses SRVComboBox, SRVListBox;

{=========================== TSRVCBoxItem =====================================}
constructor TSRVCBoxItem.Create(Collection: TCollection);
begin
  inherited;
    FOwner := Collection;

    FSkinSchemeIndex := -1;
    FImageIndex := -1;
    FSelectedImageIndex := -1;
    FIndent := 0;
    FCaption := '';
    FHint := '';
    FAlignImage := tlraLeftJustify;
    FAlignment := taLeftJustify;
    FTag := 0;

    FExpanded := True;
    FOpenParent := True;
    FEnabled := True;
    FSelected := False;
    FStyle := [];
    FOption := [srvioShowCheckBox, srvioShowImage, srvioShowText,
                srvioCanSelect, srvioCanHaveChildren];
    FColor := clWindowText;
    FBackColor := clWindow;
    FFontName := 'Microsoft Sans Serif';

    if Collection = nil then Exit;
    TSRVCBoxItemCollection(Collection).UpdateTree;
    if Assigned(TSRVCBoxItemCollection(Collection).OnAppend) then
      TSRVCBoxItemCollection(Collection).OnAppend(Self);
end;
{------------------------------------------------------------------------------}
function TSRVCBoxItem.GetOwner: TPersistent;
begin
  Result := FOwner;
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItem.SetAlignImage(const Value : TLRAlignment);
begin
  FAlignImage := Value;
  if Assigned(TSRVCBoxItemCollection(Collection).OnModify) then
    TSRVCBoxItemCollection(Collection).OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItem.SetAlignment(const Value : TAlignment);
begin
  FAlignment := Value;
  if Assigned(TSRVCBoxItemCollection(Collection).OnModify) then
    TSRVCBoxItemCollection(Collection).OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItem.SetSkinSchemeIndex(const Value : Integer);
begin
  FSkinSchemeIndex := Value;
  if Assigned(TSRVCBoxItemCollection(Collection).OnModify) then
    TSRVCBoxItemCollection(Collection).OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItem.SetImageIndex(const Value : Integer);
begin
  FImageIndex := Value;
  if Assigned(TSRVCBoxItemCollection(Collection).OnModify) then
    TSRVCBoxItemCollection(Collection).OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItem.SetSelectedImageIndex(const Value : Integer);
begin
  FSelectedImageIndex := Value;
  if Assigned(TSRVCBoxItemCollection(Collection).OnModify) then
    TSRVCBoxItemCollection(Collection).OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItem.SetIndent(const Value : Integer);
begin
  FIndent := Value;
  if Assigned(TSRVCBoxItemCollection(Collection).OnModify) then
    TSRVCBoxItemCollection(Collection).OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItem.SetCaption(const Value : string);
begin
  FCaption := Value;
  if Assigned(TSRVCBoxItemCollection(Collection).OnModify) then
    TSRVCBoxItemCollection(Collection).OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItem.SetHint(const Value : String);
begin
  FHint := Value;
  if Assigned(TSRVCBoxItemCollection(Collection).OnModify) then
    TSRVCBoxItemCollection(Collection).OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItem.SetEnabled(const Value : Boolean);
begin
  FEnabled := Value;
  if not Value then
    FSelected := False;
  if Assigned(TSRVCBoxItemCollection(Collection).OnModify) then
    TSRVCBoxItemCollection(Collection).OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItem.SetStyle(const Value : TFontStyles);
begin
  FStyle := Value;
  if Assigned(TSRVCBoxItemCollection(Collection).OnModify) then
    TSRVCBoxItemCollection(Collection).OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItem.SetColor(const Value : TColor);
begin
  FColor := Value;
  if Assigned(TSRVCBoxItemCollection(Collection).OnModify) then
    TSRVCBoxItemCollection(Collection).OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItem.SetBackColor(const Value : TColor);
begin
  FBackColor := Value;
  if Assigned(TSRVCBoxItemCollection(Collection).OnModify) then
    TSRVCBoxItemCollection(Collection).OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItem.SetFontName(const Value : TFontName);
begin
  FFontName := Value;
  if Assigned(TSRVCBoxItemCollection(Collection).OnModify) then
    TSRVCBoxItemCollection(Collection).OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItem.SetOption(const Value : TSRVItemOptions);
begin
  FOption := Value;
  if not (srvioCanSelect in Option) then
    FSelected := False;
  if Assigned(TSRVCBoxItemCollection(Collection).OnModify) then
    TSRVCBoxItemCollection(Collection).OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItem.SetShowChild(const Value : Boolean);
var
     i : Integer;
     isChange : Boolean;
     Col : TSRVCBoxItemCollection;
begin
  isChange := False;
  FExpanded := Value;
  Col := TSRVCBoxItemCollection(Collection);
  for i:=0 to Col.Count-1 do
    if isChange then
      if TSRVCBoxItem(Col.Items[i]).FIndent > FIndent then
        TSRVCBoxItem(Col.Items[i]).FOpenParent := Value
      else
        Break
    else if (Col.Items[i] = Self) then
      isChange := True;
  if Assigned(Col.OnModify) then
    Col.OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItem.SetSelected(const Value : Boolean);
var
     i : Integer;
     Col : TSRVCBoxItemCollection;
begin
  if not Enabled or not (srvioCanSelect in Option) then
    Exit;
  Col := TSRVCBoxItemCollection(Collection);
  if Value and (Value <> FSelected) then
    for i:=0 to Col.Count-1 do
      if TSRVCBoxItem(Col.Items[i]).Selected then
        TSRVCBoxItem(Col.Items[i]).Selected := False;
  FSelected := Value;
  if Assigned(Col.OnModify) then
    Col.OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItem.Assign(Source: TPersistent);
var  nProperty : TSRVCBoxItem;
begin
  if Source is TSRVCBoxItem then begin
    nProperty := TSRVCBoxItem(Source);
    FSkinSchemeIndex := nProperty.FSkinSchemeIndex;
    FImageIndex := nProperty.FImageIndex;
    FSelectedImageIndex := nProperty.FSelectedImageIndex;
    FIndent := nProperty.FIndent;
    FCaption := nProperty.FCaption;
    FHint := nProperty.FHint;
    FEnabled := nProperty.FEnabled;
    FStyle := nProperty.FStyle;
    FColor := nProperty.FColor;
    FBackColor := nProperty.FBackColor;
    FFontName := nProperty.FFontName;
    FTag := nProperty.FTag;
    FOption := nProperty.FOption;
    FExpanded := nProperty.FExpanded;
    FSelected := nProperty.FSelected;
    FAlignImage := nProperty.FAlignImage;
    FAlignment := nProperty.FAlignment;
    end
  else
    inherited;
end;
{------------------------------------------------------------------------------}
function TSRVCBoxItem.GetDisplayName: string;
begin
  If Caption <> '' then
    Result := Caption
  else
    Result := 'Button' + IntToStr(Index + 1);
end;
{====================== TSRVCBoxItemCollection ================================}
constructor TSRVCBoxItemCollection.Create(ItemClass: TCollectionItemClass;
                                          Owner: TPersistent);
begin
  inherited Create(ItemClass);
  FOwner := Owner;
end;
function TSRVCBoxItemCollection.GetCBoxItem(Index: Integer): TSRVCBoxItem;
begin
  Result := TSRVCBoxItem(GetItem(Index));
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItemCollection.SetCBoxItem(Index: Integer;
  const Value: TSRVCBoxItem);
begin
  SetItem(Index, Value);
end;
{------------------------------------------------------------------------------}
{ Allows assigning properties to TStrings: Captions are assigned. }
procedure TSRVCBoxItemCollection.AssignTo(Dest: TPersistent);
var i: Integer;
begin
  if Dest is TStrings then begin
    TStrings(Dest).Clear;
    for i:= 0 to Count-1 do
      TStrings(Dest).Add(Items[i].Caption);
    end
  else
    inherited AssignTo(Dest);
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItemCollection.Assign(Source: TPersistent);
var i: Integer;
begin
  if Source is TSRVCBoxItemCollection then begin
    Clear;
    for i:= 0 to TSRVCBoxItemCollection(Source).Count-1 do
      Add.Assign(TSRVCBoxItemCollection(Source).Items[i]);
    end
  else if Source is TStrings then begin
    Clear;
    for i:= 0 to TStrings(Source).Count-1 do
      TSRVCBoxItem(Add).Caption := TStrings(Source).Strings[i];
    end
  else
    inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
{ For designtime collection editor. }
function TSRVCBoxItemCollection.GetOwner: TPersistent;
begin
  Result := FOwner;
end;
{------------------------------------------------------------------------------}
procedure TSRVCBoxItemCollection.UpdateTree;
var i: Integer;
begin
  for i:=0 to Count-1 do
    if not TSRVCBoxItem(Items[i]).Expanded then
      if not (srvioCanHaveChildren in TSRVCBoxItem(Items[i]).Option) then
        TSRVCBoxItem(Items[i]).Expanded := True
      else
        TSRVCBoxItem(Items[i]).Expanded := False;
end;
{=============================== TSRVLBoxItem =================================}
constructor TSRVLBoxItem.Create(Collection: TCollection);
begin
  inherited;
  FChecked := False;
  FState := cbUnchecked;
  FAlignCheckBox := tlraLeftJustify;
end;
{------------------------------------------------------------------------------}
procedure TSRVLBoxItem.SetAlignChecked(const Value : TLRAlignment);
begin
  FAlignCheckBox := Value;

  if Assigned(TSRVLBoxItemCollection(Collection).OnModify) then
    TSRVLBoxItemCollection(Collection).OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVLBoxItem.SetChecked(const Value : Boolean);
begin
  FChecked := Value;
  if Value then begin
    FState := cbChecked;
  end else
    FState := cbUnchecked;

  UpdateChildState;
  UpdateParentState;

  if Assigned(TSRVLBoxItemCollection(Collection).OnModify) then
    TSRVLBoxItemCollection(Collection).OnModify(Self);
end;
{------------------------------------------------------------------------------}
function TSRVLBoxItem.CountChild : Integer;
var
     i : Integer;
     Col : TSRVCBoxItemCollection;
begin
  Result := 0;
  Col := TSRVLBoxItemCollection(Collection);
  if (srvioCanHaveChildren in Option) then
    for i:=Index+1 to Col.Count-1 do
      if (TSRVLBoxItem(Col.Items[i]).Indent > Indent) then
        Result := Result + 1
      else if (TSRVLBoxItem(Col.Items[i]).Indent <= Indent) then
        Break;
end;
{------------------------------------------------------------------------------}
function TSRVLBoxItem.CountChecked : Integer;
var
     i : Integer;
     Col : TSRVCBoxItemCollection;
begin
  Result := 0;
  Col := TSRVLBoxItemCollection(Collection);
  if (srvioCanHaveChildren in Option) then
    for i:=Index+1 to Col.Count-1 do
      if (TSRVLBoxItem(Col.Items[i]).Indent > Indent) and
         (TSRVLBoxItem(Col.Items[i]).Checked) then
        Result := Result + 1
      else if (TSRVLBoxItem(Col.Items[i]).Indent <= Indent) then
        Break;
end;
{------------------------------------------------------------------------------}
procedure TSRVLBoxItem.UpdateState;
begin
  If (CountChild > 0) then
    if (CountChild = CountChecked) then
      FState := cbChecked
    else If (CountChecked = 0) then
      FState := cbUnchecked
    else
      FState := cbGrayed
  else If FChecked then
    FState := cbChecked
  else
    FState := cbUnchecked;
  FChecked := FState <> cbUnchecked;

  UpdateParentState;
end;
{------------------------------------------------------------------------------}
procedure TSRVLBoxItem.UpdateParentState;
var
     i : Integer;
     Col : TSRVCBoxItemCollection;
begin
  Col := TSRVLBoxItemCollection(Collection);
  for i:=Index-1 downto 0 do
    if (TSRVLBoxItem(Col.Items[i]).Indent < Indent) then begin
      if (srvioCanHaveChildren in TSRVLBoxItem(Col.Items[i]).Option) then
        TSRVLBoxItem(Col.Items[i]).UpdateState;
      Break;
    end;
end;
{------------------------------------------------------------------------------}
procedure TSRVLBoxItem.UpdateChildState;
var
     i : Integer;
     Col : TSRVCBoxItemCollection;
begin
  Col := TSRVLBoxItemCollection(Collection);
  if (srvioCanHaveChildren in Option) then
    for i:=Index+1 to Col.Count-1 do
      if (TSRVLBoxItem(Col.Items[i]).Indent > Indent) then begin
        TSRVLBoxItem(Col.Items[i]).FChecked := Checked;
        if Checked then
          TSRVLBoxItem(Col.Items[i]).FState := cbChecked
        else
          TSRVLBoxItem(Col.Items[i]).FState := cbUnchecked;
      end else if (TSRVLBoxItem(Col.Items[i]).Indent <= Indent) then
        Break;
end;
{------------------------------------------------------------------------------}
procedure TSRVLBoxItem.SetState(const Value : TCheckBoxState);
begin
  FState := Value;
  Case Value of
    cbUnchecked :
      FChecked := False;
    cbChecked   :
      FChecked := True;
    cbGrayed    :
      FChecked := True;
  end;
  if Assigned(TSRVLBoxItemCollection(Collection).OnModify) then
    TSRVLBoxItemCollection(Collection).OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVLBoxItem.SetSelected(const Value : Boolean);
begin
  if not Enabled or not (srvioCanSelect in Option) then
    Exit;
  if not TSRVLBoxItemCollection(Collection).FMultiSelect then
    inherited
  else
    FSelected := Value;
  if Assigned(TSRVLBoxItemCollection(Collection).OnModify) then
    TSRVLBoxItemCollection(Collection).OnModify(Self);
end;
{------------------------------------------------------------------------------}
procedure TSRVLBoxItem.Assign(Source: TPersistent);
var  nProperty : TSRVLBoxItem;
begin
  if Source is TSRVLBoxItem then begin
    nProperty := TSRVLBoxItem(Source);
    FChecked := nProperty.FChecked;
    FState := nProperty.FState;
    FSelected := nProperty.FSelected;
    FAlignCheckBox := nProperty.FAlignCheckBox;
  end;
  inherited;
end;
{======================== TSRVLBoxItemCollection ==============================}
constructor TSRVLBoxItemCollection.Create(ItemClass: TCollectionItemClass;
                                          Owner: TPersistent);
begin
  inherited Create(ItemClass, Owner);
  FOwner := Owner;
end;
{------------------------------------------------------------------------------}
{ Allows assigning properties to TStrings: style names are assigned. }
procedure TSRVLBoxItemCollection.AssignTo(Dest: TPersistent);
var i: Integer;
begin
  if Dest is TStrings then begin
    TStrings(Dest).Clear;
    for i:= 0 to Count-1 do
      TStrings(Dest).Add(Items[i].Caption);
    end
  else
    inherited AssignTo(Dest);
end;
{------------------------------------------------------------------------------}
procedure TSRVLBoxItemCollection.Assign(Source: TPersistent);
var i: Integer;
begin
  if Source is TSRVCBoxItemCollection then begin
    Clear;
    for i:= 0 to TSRVCBoxItemCollection(Source).Count-1 do
      Add.Assign(TSRVCBoxItemCollection(Source).Items[i]);
    end
  else
    inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
{ For designtime collection editor. }
function TSRVLBoxItemCollection.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

{------------------------------------------------------------------------------}
procedure TSRVLBoxItemCollection.SetMultiSelect(const Value : Boolean);
var
     i, k : Integer;
begin
  k := 0;
  if FMultiSelect <> Value then
    for i:=0 to Count-1 do
      if TSRVCBoxItem(Items[i]).Selected then begin
        if k > 0 then
          TSRVCBoxItem(Items[i]).Selected := False;
        k := k + 1;
      end;
  FMultiSelect := Value;
end;

{------------------------------------------------------------------------------}
procedure TSRVLBoxItemCollection.ClearSelect;
var
     i : Integer;
begin
  for i:=0 to Count-1 do
    if TSRVCBoxItem(Items[i]).Selected then
      TSRVCBoxItem(Items[i]).Selected := False;
end;

function TSRVLBoxItemCollection.GetLBoxItem(Index: Integer): TSRVLBoxItem;
begin
  Result := TSRVLBoxItem(GetItem(Index));
end;
{------------------------------------------------------------------------------}
procedure TSRVLBoxItemCollection.SetLBoxItem(Index: Integer;
  const Value: TSRVLBoxItem);
begin
  SetItem(Index, Value);
end;

end.
