{==============================================================================

  Custom Controls
  Copyright (C) 2000-2001 by Evgeny Kryukov
  All rights reserved

  All contents of this file and all other files included in this archive
  are Copyright (C) 2001 Evgeny Kryukov. Use and/or distribution of
  them requires acceptance of the License Agreement.

  See License.txt for licence information

===============================================================================}

unit KsListBoxs;

{$I KsCommonVer.Inc}
{$T-,W-,X+,P+}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, KsScrollBars, KsBitmap, KsUtils, KsControls;

const
  MOUSE_WHEEL_DELTA = 120;

type
  TKsCheckBoxState = (cbUnchecked, cbChecked, cbGrayed);
  TKsListBoxStyle = (lbStandard, lbOwnerDrawFixed, lbOwnerDrawVariable,
    lbFonts, lbFontSamples, lbColors, lbColorNames);

  TKsFontDevice = (fdScreen, fdPrinter);
  TKsFontType = (ftAll, ftTrueType, ftFixedPitch);

  TKsCustomListBox = class;

  TDrawItemEvent = procedure(ListBox: TKsCustomListBox; Canvas: TCanvas; Index: Integer;
    Rect: TRect; State: TOwnerDrawState) of object;

  TMeasureItemEvent = procedure(ListBox: TKsCustomListBox; Canvas: TCanvas; Index: Integer;
    var Height: Integer) of object;

  TKsCustomListBox = class(TKsCustomControl)
  private
    FUpdating: boolean;
    FItems: TStrings;
    FAlwaysShowScrlBar: boolean;
    FShowCheckBoxes: boolean;
    FFlat: boolean;
    FMousePressed: boolean;

    FMouseOnItemIndex: integer;
    FMouseOnCheckBoxIndex: integer;

    FMOldx, FMOldy: integer;

    FSelRangeBeg: integer;
    FFirstVisibleItem, FLastVisibleItem: integer;
    FScrlBarVizible: boolean;

    FState: array of TKsCheckBoxState;
    FItemEnabled: array of boolean;
    FAllowGrayed: boolean;
    FItemIndex: integer;
    FMultiSelect: boolean;
    FColumns: integer;
    FWordWrap: boolean;
    FListStyle: TKsListBoxStyle;
    FOnDrawItem: TDrawItemEvent;
    FOnMeasureItem: TMeasureItemEvent;
    FSorted: Boolean;
    FFontDevice: TKsFontDevice;
    FFontType: TKsFontType;
    FFontValue: TFont;
    FKeyboardClick: boolean;
    FItemHeight: integer;
    procedure EnumColorsProc(const S: string);
    procedure UpdateScrlBar;
    procedure ScrlBarScroll(Sender: TObject; ScrollCode: TKsScrollCode; var ScrollPos: Integer);
    procedure ScrlBarChange(Sender: TObject);
    procedure SetAlwaysShowScrlBar(const Value: boolean);
    procedure SetShowCheckBoxes(const Value: boolean);
    procedure SetFlat(const Value: boolean);
    function GetState(Index: Integer): TKsCheckBoxState;
    procedure SetState(Index: Integer; const Value: TKsCheckBoxState);
    procedure SetAllowGrayed(const Value: boolean);
    function GetItemEnabled(Index: Integer): boolean;
    procedure SetItemEnabled(Index: Integer; const Value: boolean);
    procedure SetItemIndex(const Value: integer);
    function GetSelected(Index: Integer): boolean;
    procedure SetSelected(Index: Integer; const Value: boolean);
    procedure SetMultiSelect(const Value: boolean);

    procedure ItemsChanged;
    procedure UpdateSelRange;

    procedure SetColumns(const Value: integer);
    procedure SetWordWrap(const Value: boolean);
    procedure SetListStyle(const Value: TKsListBoxStyle);

    procedure UpdateVisibleRange;

    procedure DoDrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); dynamic;
    function DoMeasureItem(Index: Integer): integer; dynamic;
    procedure SetSorted(const Value: Boolean);
    function GetSelCount: Integer;
    procedure SetFontDevice(const Value: TKsFontDevice);
    procedure SetFontType(const Value: TKsFontType);
    procedure SetItems(const Value: TStrings);
    function GetColorValue: TColor;
    function GetFontValue: TFont;
    function GetTopIndex: integer;
    procedure SetItemHeight(const Value: integer);
  protected
    FScrlBar: TKsCustomScrollBar;
    FSelected: array of boolean;
    { Messages }
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure CMMouseWheel(var Msg: TCMMouseWheel); message CM_MOUSEWHEEL;
    procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMMouseWheel(var Msg: TWMMouseWheel); message WM_MOUSEWHEEL;
    { Overrides }
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure HasFocus; override;
    procedure KillFocus; override;

    procedure UpdatePtInPart(x, y: integer);
    function GetListHeight: integer;
    function GetItemWidth: integer;
    function GetItemAreaBottom: integer;

    function GetItemTop(Index: integer): integer; virtual;
    function GetItemRect(Index: integer): TRect; virtual;

    function GetItemHeight(Index: integer): integer; virtual;
    function GetBorderWidth: integer; virtual;
    function GetChckBxFieldWidth: integer; virtual;
    function GetCheckBoxSize: TPoint; virtual;

    procedure DrawItem(Buffer: TKsBitmap; Index: integer; ARect: TRect); virtual;
    procedure DrawCheckBox(Index: integer; ARect: TRect); virtual;

    function PtInItem(x, y: integer; Index: integer; ARect: TRect): boolean; virtual;
    function PtInCheckBox(x, y: integer; Index: integer; ARect: TRect): boolean; virtual;

    function CreateScrollBar: TKsCustomScrollBar; virtual;

    procedure DrawBorder; virtual;
    procedure DrawBackground; virtual;
    procedure DrawItems; virtual;

    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; x, y: integer); override;
    procedure MouseMove(Shift: TShiftState; x, y: integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; x, y: integer); override;
    procedure KeyDown(var Key: word; Shift: TShiftState); override;
    procedure KeyUp(var Key: word; Shift: TShiftState); override;

    procedure PaintBuffer; override;

    property MouseOnItemIndex: integer read FMouseOnItemIndex;
    property MouseOnCheckBoxIndex: integer read FMouseOnCheckBoxIndex;
    property ScrollBar: TKsCustomScrollBar read FScrlBar;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

    procedure BuildFontList;
    procedure BuildColorList;

    function ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
    property ItemEnabled[Index: Integer]: boolean read GetItemEnabled write SetItemEnabled;
    property ItemIndex: integer read FItemIndex write SetItemIndex;
    property FontValue: TFont read GetFontValue;
    property ColorValue: TColor read GetColorValue;
    property KeyboardClick: boolean read FKeyboardClick write FKeyboardClick;
    property Selected[Index: Integer]: boolean read GetSelected write SetSelected;
    property State[Index: Integer]: TKsCheckBoxState read GetState write SetState;
    property TopIndex: integer read GetTopIndex;
  published
    property Align;
    property AllowGrayed: boolean read FAllowGrayed write SetAllowGrayed;
    property AlwaysShowScrlBar: boolean read FAlwaysShowScrlBar write SetAlwaysShowScrlBar;
    property Anchors;
    property Color;
    property Columns: integer read FColumns write SetColumns;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Flat: boolean read FFlat write SetFlat;
    property Font;
    property FontDevice: TKsFontDevice read FFontDevice write SetFontDevice default fdScreen;
    property FontType: TKsFontType read FFontType write SetFontType default ftAll;
    property ImeMode;
    property ImeName;
    property Items: TStrings read FItems write SetItems;
    property ItemHeight: integer read FItemHeight write SetItemHeight;
    property MultiSelect: boolean read FMultiSelect write SetMultiSelect;
    property ParentColor default False;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property SelCount: Integer read GetSelCount;
    property ShowCheckBoxes: boolean read FShowCheckBoxes write SetShowCheckBoxes;
    property ShowHint;
    property Sorted: Boolean read FSorted write SetSorted default False;
    property ListStyle: TKsListBoxStyle read FListStyle write SetListStyle;
    property TabOrder;
    property TabStop default True;
    property Visible;
    property WordWrap: boolean read FWordWrap write SetWordWrap;

    property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
    property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

const
  DefaultFontColorHeight  = 18;
  ColorRectWidth          = 20;

var
  IsWinNT, IsWin98: boolean;
  VerInfo: TOsVersionInfo;
  TrueTypeBmp: TKsBitmap;

implementation {===============================================================}

uses
  Extctrls, Printers;

{$R *.res}

procedure InitTrueTypeBitmap;
var
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  try
    Bitmap.Handle := LoadBitmap(HInstance, 'KS_TRUETYPE');

    TrueTypeBmp := TKsBitmap.Create;
    TrueTypeBmp.Assign(Bitmap);
    TrueTypeBmp.Blend := true;
    TrueTypeBmp.PerformTransparent(KColor(255, 0, 255));
  finally
    Bitmap.Free;
  end;
end;

function RectOffset(ARect: TRect; Offset: integer): TRect;
begin
  Result.Top := ARect.Top - Offset;
  Result.Left := ARect.Left - Offset;
  Result.Bottom := ARect.Bottom + Offset;
  Result.Right := ARect.Right + Offset;
end;

type

  TEkListBoxItems = class(TStringList)
  private
    FListBox: TKsCustomListBox;
  protected
    procedure Put(Index: Integer; const S: string); override;
    procedure PutObject(Index: Integer; AObject: TObject); override;
    procedure SetUpdateState(Updating: Boolean); override;
  public
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Insert(Index: Integer; const S: string); override;
    function Add(const S: string): Integer; override;
    function AddObject(const S: string; AObject: TObject): Integer; override;
  end;

{ TEkListBoxItems =============================================================}

function TEkListBoxItems.Add(const S: string): Integer;
begin
  Result := inherited Add(S);
  FListBox.ItemsChanged;
end;

function TEkListBoxItems.AddObject(const S: string;
  AObject: TObject): Integer;
begin
  Result := inherited AddObject(S, AObject);
  FListBox.ItemsChanged;
end;

procedure TEkListBoxItems.Clear;
begin
  inherited Clear;
  FListBox.ItemsChanged;
end;

procedure TEkListBoxItems.Delete(Index: Integer);
begin
  inherited Delete(Index);
  FListBox.ItemsChanged;
end;

procedure TEkListBoxItems.Insert(Index: Integer; const S: string);
begin
  inherited Insert(Index, S);
  FListBox.ItemsChanged;
end;

procedure TEkListBoxItems.Put(Index: Integer; const S: string);
begin
  inherited Put(Index, S);
  FListBox.ItemsChanged;
end;

procedure TEkListBoxItems.PutObject(Index: Integer; AObject: TObject);
begin
  inherited PutObject(Index, AObject);
  FListBox.ItemsChanged;
end;

procedure TEkListBoxItems.SetUpdateState(Updating: Boolean);
begin
  inherited SetUpdateState(Updating);
  FListBox.FUpdating := Updating;
  if not Updating then
  begin
    FListBox.Invalidate;
    FListBox.ItemsChanged;
  end;
end;

{ TKsCustomListBox ============================================================}

constructor TKsCustomListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FUpdating := false;
  FKeyboardClick := true;

  Color := clWindow;

  FItems := TEkListBoxItems.Create;
  TEkListBoxItems(FItems).FListBox := Self;

  FScrlBar := CreateScrollBar;
  with FScrlBar do
  begin
    Parent := Self;
    Kind := sbVertical;
    BorderWidth := 0;
    Visible := true;

    OnScroll := ScrlBarScroll;
    OnChange := ScrlBarChange;
  end;

  FItemHeight := 16; 
  FAlwaysShowScrlBar := false;
  FShowCheckBoxes := false;
  FFlat := true;
  FItemIndex := -1;
  FMultiSelect := false;
  FWordWrap := false;
  FListStyle := lbStandard;
  ParentColor := false;
  TabStop := true;
  FSorted := false;
  FFontValue := TFont.Create;

  FMOldx := -1;
  FMOldy := -1;

  FSelRangeBeg := -1;

  FMousePressed := false;

  FMouseOnItemIndex := -1;
  FMouseOnCheckBoxIndex := -1;

  Width := 121;
  Height := 97;

  ControlStyle := ControlStyle + [csCaptureMouse, csDoubleClicks];
  TabStop := true;
  DoubleBuffered := true;
end;

destructor TKsCustomListBox.Destroy;
begin
  FFontValue.Free;
  FScrlBar.Free;
  FItems.Free;
  inherited;
end;

procedure TKsCustomListBox.EnumColorsProc(const S: string);
begin
  Items.Add(S);
end;

procedure TKsCustomListBox.BuildColorList;
begin
  FItems.Clear;
  UpdateSelRange;
  Sorted := false;

  GetColorValues(EnumColorsProc);
end;

function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
begin
  with TKsCustomListBox(Data), TextMetric do
  begin
    case FontType of
      ftAll:
        Items.AddObject(LogFont.lfFaceName, TObject(tmPitchAndFamily));
      ftTrueType:
        if (tmPitchAndFamily and tmpf_TrueType) = tmpf_TrueType then
          Items.AddObject(LogFont.lfFaceName, TObject(tmPitchAndFamily));
      ftFixedPitch:
        if (tmPitchAndFamily and tmpf_Fixed_Pitch) = 0 then
          Items.AddObject(LogFont.lfFaceName, TObject(tmPitchAndFamily));
    end;
    Result := 1;
  end;
end;

procedure TKsCustomListBox.BuildFontList;
var
  DC: HDC;
begin

  FItems.Clear;
  Sorted := true;
  UpdateSelRange;

  if FFontDevice = fdScreen then
  begin
    DC := GetDC(0);
    try                 
      EnumFontFamilies(DC, nil, @EnumFontsProc, Longint(Self));
    finally
      ReleaseDC(0, DC);
    end;
  end
  else
  begin
    EnumFontFamilies(Printer.Handle, nil, @EnumFontsProc, Longint(Self));
  end;
end;

function TKsCustomListBox.CreateScrollBar: TKsCustomScrollBar;
begin
  Result := TKsCustomScrollBar.Create(Self);
end;

procedure TKsCustomListBox.PaintBuffer;
begin
  if Buffer = nil then Exit;
  if FScrlBar = nil then Exit;

  inherited;

  DrawBackground;
//  UpdateScrlBar;
  DrawItems;
  DrawBorder;
end;

procedure TKsCustomListBox.ItemsChanged;
var
  i, OldHigh: integer;
begin
  if FItems.Count <= 0 then
    FItemIndex := -1
  else
    if FItemIndex = -1 then
    FItemIndex := 0;

  if High(FState) < 0 then
    OldHigh := 0
  else
    OldHigh := High(FState);

  SetLength(FState, Items.Count);
  for i := OldHigh to High(FState) do
    FState[i] := cbUnchecked;

  if High(FItemEnabled) < 0 then
    OldHigh := 0
  else
    OldHigh := High(FItemEnabled);

  SetLength(FItemEnabled, Items.Count);
  for i := OldHigh to High(FItemEnabled) do
    FItemEnabled[i] := true;

  if High(FSelected) < 0 then
    OldHigh := 0
  else
    OldHigh := High(FSelected);

  SetLength(FSelected, Items.Count);
  for i := OldHigh to High(FSelected) do
    Selected[i] := false;

  if not FUpdating then
  begin
    UpdateScrlBar;
    Invalidate;
  end;
end;

function TKsCustomListBox.GetItemHeight(Index: integer): integer;
var
  TmpS: string;
  TmpRect: TRect;
begin
  Buffer.Font := Font;
  if (FListStyle = lbOwnerDrawVariable) and Assigned(FOnMeasureItem) then
    Result := DoMeasureItem(Index)
  else
    if WordWrap then
    begin
      TmpS := Items[Index];
      TmpRect := Rect(0, 0, GetItemWidth - 2, Buffer.TextHeight('Pq'));
      Result := Buffer.DrawText(TmpS, TmpRect, DrawTextBiDiModeFlags(DT_CALCRECT or DT_WORDBREAK or DT_NOPREFIX));
    end
    else
      if FListStyle in [lbFonts, lbFontSamples, lbColorNames, lbColors] then
        Result := DefaultFontColorHeight
      else
        Result := FItemHeight;

//  Result := Result + 1;
end;

function TKsCustomListBox.GetListHeight: integer;
var
  CurLine: integer;
begin
  Result := 0;
  for CurLine := 0 to Items.Count - 1 do
    Result := Result + GetItemHeight(CurLine);
end;

procedure TKsCustomListBox.DrawBorder;
var
  TmpRect: TRect;
begin
  TmpRect := RectOffset(Rect(0, 0, FWidth, FHeight), 0);
  Buffer.DrawEdge(TmpRect, KColor(clBtnShadow), KColor(clBtnHighlight));
  TmpRect := RectOffset(Rect(0, 0, FWidth, FHeight), -1);
  Buffer.DrawEdge(TmpRect, KColor(cl3DDkShadow), KColor(cl3DLight));
end;

function TKsCustomListBox.GetBorderWidth: integer;
begin
  Result := 2;
end;

procedure TKsCustomListBox.DrawBackground;
begin
  Buffer.FillRect(Rect(0, 0, FWidth, FHeight), KColor(Color));
end;

function TKsCustomListBox.GetItemTop(Index: integer): integer;
var
  CurItem: integer;
begin
  Result := -1;
  if FScrlBar = nil then Exit;
  
  if Index < FScrlBar.Position then
  begin
    Result := -1;
    Exit;
  end;

  Result := GetBorderWidth;
  for CurItem := FScrlBar.Position to Index - 1 do
    Result := Result + GetItemHeight(CurItem);
end;

function TKsCustomListBox.GetItemRect(Index: integer): TRect;
var
  LAreaRect: TRect;
begin
  Result := Rect(0, 0, 0, 0);
  if FScrlBar = nil then Exit;

  with Result do
  begin
    Left := LAreaRect.Left;
    Top := GetItemTop(Index);
    Right := Width - GetBorderWidth - FScrlBar.Width;
    Bottom := Top + GetItemHeight(Index);
  end;
end;

procedure TKsCustomListBox.DrawItems;
var
  CurItem: integer;
  CurItemTop: integer;
  LBorderWidth: integer;
  ItemLeft: integer;
  LCurItemHeight: integer;
  TmpRect: TRect;

  CurCol: integer;
  FirstInCol: boolean;
begin
  if FScrlBar = nil then Exit;

  LBorderWidth := GetBorderWidth;

  if Columns <= 0 then
  begin
    CurItem := FScrlBar.Position;
    CurItemTop := LBorderWidth;
    while (CurItemTop < Height - LBorderWidth) and (CurItem <= Items.Count - 1) do
    begin
      LCurItemHeight := GetItemHeight(CurItem);
      if CurItemTop + LCurItemHeight > Height - LBorderWidth then Break;

      ItemLeft := GetBorderWidth;
      if ShowCheckBoxes then
      begin
        with TmpRect do
        begin
          Left := GetBorderWidth + (GetChckBxFieldWidth - GetCheckBoxSize.x) div 2;
          Top := CurItemTop + (LCurItemHeight - GetCheckBoxSize.y) div 2;
          Right := Left + GetCheckBoxSize.x;
          Bottom := Top + GetCheckBoxSize.y;
        end;
        DrawCheckBox(CurItem, TmpRect);
        ItemLeft := ItemLeft + GetChckBxFieldWidth;
      end;

      DrawItem(Buffer, CurItem,
        Rect(ItemLeft,
        CurItemTop,
        ItemLeft + GetItemWidth,
        CurItemTop + LCurItemHeight));

      CurItemTop := CurItemTop + LCurItemHeight;
      Inc(CurItem);
    end;
  end
  else
  begin //MultiColumn mode
    CurItem := 0;
    CurCol := 0;
    FirstInCol := true;
    CurItemTop := LBorderWidth;

    while (CurCol - FScrlBar.Position < Columns) and (CurItem < Items.Count) do
    begin
      LCurItemHeight := GetItemHeight(CurItem);

      with TmpRect do
      begin
        if ShowCheckBoxes then
          Left := (CurCol - FScrlBar.Position) * (GetChckBxFieldWidth + GetItemWidth) + LBorderWidth
        else
          Left := (CurCol - FScrlBar.Position) * GetItemWidth + LBorderWidth;
        Top := CurItemTop;
        Right := Left + GetItemWidth;
        Bottom := Top + LCurItemHeight;
      end;

      if CurItemTop + LCurItemHeight > GetItemAreaBottom then
      begin
        if FirstInCol then
        begin
          if (CurCol - FScrlBar.Position >= 0) then
          begin
            if ShowCheckBoxes then
              with TmpRect do
              begin
                DrawCheckBox(CurItem,
                  Rect(Left + (GetChckBxFieldWidth - GetCheckBoxSize.x) div 2,
                  Top + (LCurItemHeight - GetCheckBoxSize.y) div 2,
                  Left + (GetChckBxFieldWidth - GetCheckBoxSize.x) div 2 + GetCheckBoxSize.x,
                  Top + (LCurItemHeight - GetCheckBoxSize.y) div 2 + GetCheckBoxSize.y));
                Left := Left + GetChckBxFieldWidth;
                Right := Right + GetChckBxFieldWidth;
              end;
            DrawItem(Buffer, CurItem, TmpRect);
          end;
          CurItem := CurItem + 1;
        end;
        CurCol := CurCol + 1;
        FirstInCol := true;
        CurItemTop := LBorderWidth;
      end
      else
      begin
        if (CurCol - FScrlBar.Position >= 0) then
        begin
          if ShowCheckBoxes then
            with TmpRect do
            begin
              DrawCheckBox(CurItem,
                Rect(Left + (GetChckBxFieldWidth - GetCheckBoxSize.x) div 2,
                Top + (LCurItemHeight - GetCheckBoxSize.y) div 2,
                Left + (GetChckBxFieldWidth - GetCheckBoxSize.x) div 2 + GetCheckBoxSize.x,
                Top + (LCurItemHeight - GetCheckBoxSize.y) div 2 + GetCheckBoxSize.y));
              Left := Left + GetChckBxFieldWidth;
              Right := Right + GetChckBxFieldWidth;
            end;
          DrawItem(Buffer, CurItem, TmpRect);
        end;
        FirstInCol := false;
        CurItem := CurItem + 1;
        CurItemTop := CurItemTop + LCurItemHeight;
      end;
    end;
  end;
end;

procedure TKsCustomListBox.DrawItem(Buffer: TKsBitmap; Index: integer; ARect: TRect);
var
  TmpS: string;
  R, TmpRect: TRect;
  TmpState: TOwnerDrawState;
  Color: Longint;
begin
  TmpRect := ARect;
  Inc(TmpRect.Left, 2);

  if FListStyle in [lbFonts, lbFontSamples, lbColors, lbColorNames] then
  begin
    if Index < 0 then
      TmpS := ''
    else
      TmpS := Items[Index];
    { Font and Color }
    case FListStyle of
      lbFonts:
        begin
          { Font Listbox }
          Buffer.Font := Font;

          if Selected[Index] then
          begin
            Buffer.FillRect(ARect, KColor(clHighlight));
            Buffer.Font.Color := clHighlightText;

            if Focused and not MultiSelect then
              Buffer.DrawFocusRect(ARect, KColor(clBlack));
          end
          else
            if Focused and (ItemIndex = Index) and (not MultiSelect) then
              Buffer.DrawFocusRect(ARect, KColor(clBlack));


          if (TrueTypeBmp <> nil) and (Integer(Items.Objects[Index]) and TMPF_TRUETYPE <> 0) then
          begin
            R := Rect(0, 0, TrueTypeBmp.Width, TrueTypeBmp.Height);
            RectCenter(R, Rect(TmpRect.Left, TmpRect.Top, TmpRect.Left + DefaultFontColorHeight, TmpRect.Bottom));
            TrueTypeBmp.Draw(Buffer, R.Left, R.Top);
          end;

          Inc(TmpRect.Left, DefaultFontColorHeight + 4);
          Buffer.DrawText(TmpS, TmpRect, DrawTextBiDiModeFlags(DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX));
        end;
      lbFontSamples:
        begin
          { Font Listbox }
          Buffer.Font := Font;
          if Index >= 0 then
            Buffer.Font.Name := Items[Index];

          if Selected[Index] then
          begin
            Buffer.FillRect(ARect, KColor(clHighlight));
            Buffer.Font.Color := clHighlightText;

            if Focused and not MultiSelect then
              Buffer.DrawFocusRect(ARect, KColor(clBlack));
          end
          else
            if Focused and (ItemIndex = Index) and (not MultiSelect) then
              Buffer.DrawFocusRect(ARect, KColor(clBlack));

          if (TrueTypeBmp <> nil) and (Integer(Items.Objects[Index]) and TMPF_TRUETYPE <> 0) then
          begin
            R := Rect(0, 0, TrueTypeBmp.Width, TrueTypeBmp.Height);
            RectCenter(R, Rect(TmpRect.Left, TmpRect.Top, TmpRect.Left + DefaultFontColorHeight, TmpRect.Bottom));
            TrueTypeBmp.Draw(Buffer, R.Left, R.Top);
          end;

          Inc(TmpRect.Left, DefaultFontColorHeight + 4);
          Buffer.DrawText(TmpS, TmpRect, DrawTextBiDiModeFlags(DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX));
        end;
      lbColors:
        begin
          { Font Listbox }
          if Selected[Index] then
          begin
            Buffer.FillRect(ARect, KColor(clHighlight));
            if Focused then
              Buffer.DrawFocusRect(ARect, KColor(clBlack));
          end
          else
            if Focused and (ItemIndex = Index) and (not MultiSelect) then
              Buffer.DrawFocusRect(ARect, KColor(clBlack));

          { Draw Color Rect }
          InflateRect(TmpRect, -4, -4);
          Color := StringToColor(TmpS);
          Buffer.FillRect(TmpRect, KColor(Color));
          Buffer.DrawRect(TmpRect, ckBlack);
        end;
      lbColorNames:
        begin
          { Font Listbox }
          Buffer.Font := Font;

          if Selected[Index] then
          begin
            Buffer.FillRect(ARect, KColor(clHighlight));
            Buffer.Font.Color := clHighlightText;

            if Focused and (not MultiSelect) then
              Buffer.DrawFocusRect(ARect, KColor(clBlack));
          end
          else
            if Focused and (ItemIndex = Index) and (not MultiSelect) then
              Buffer.DrawFocusRect(ARect, KColor(clBlack));

          { Draw Color Rect }
          Color := StringToColor(TmpS);
          R := Rect(0, 0, ColorRectWidth, DefaultFontColorHeight - 4);
          RectCenter(R, Rect(TmpRect.Left, TmpRect.Top, TmpRect.Left + ColorRectWidth, TmpRect.Bottom));
          Buffer.FillRect(R, KColor(Color));
          Buffer.DrawRect(R, ckBlack);
          { Draw Text}
          if Pos('cl', TmpS) > 0 then
            Delete(TmpS, 1, 2);
          Inc(TmpRect.Left, ColorRectWidth + 4);
          Buffer.DrawText(TmpS, TmpRect, DrawTextBiDiModeFlags(DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX));
        end;
    end;

    Exit;
  end;

  if (FListStyle = lbStandard) or (not Assigned(FOnDrawItem)) then
  begin
    if Index >= 0 then
      TmpS := Items[Index]
    else
      TmpS := '';

    Buffer.Font := Font;

    if Selected[Index] then
    begin
      Buffer.FillRect(ARect, KColor(clHighlight));
      Buffer.Font.Color := clHighlightText;
    end;

    if (Index = MouseOnItemIndex) and not Selected[Index] then
      Buffer.Font.Color := clHighlight;

    if WordWrap then
      Buffer.DrawText(TmpS, TmpRect, DrawTextBiDiModeFlags(DT_LEFT or DT_WORDBREAK or DT_NOPREFIX))
    else
      Buffer.DrawText(TmpS, TmpRect, DrawTextBiDiModeFlags(DT_LEFT or DT_NOPREFIX));

    if Selected[Index] and Focused and (not MultiSelect) then
    begin
      Buffer.Font.Color := clHighlight;
      Buffer.DrawFocusRect(ARect, KColor(clBlack));
    end;

    if not Selected[Index] and Focused and (ItemIndex = Index) and (not MultiSelect) then
      Buffer.DrawFocusRect(ARect, KColor(clBlack));
  end
  else
  begin
    { Owner Draw }
    TmpState := [];
    if Selected[Index] then
      TmpState := TmpState + [odSelected]
    {$IFDEF KS_COMPILER5}
    else
      if Index = MouseOnItemIndex then
        TmpState := TmpState + [odHotLight]{$ENDIF};
    if (Index = ItemIndex) and Focused then
      TmpState := TmpState + [odFocused];

    DoDrawItem(Index, TmpRect, TmpState);
  end;
end;

procedure TKsCustomListBox.DrawCheckBox(Index: integer; ARect: TRect);
begin
  with Buffer do
  begin

    if not ((not Flat) or ((Index = MouseOnCheckBoxIndex) and ItemEnabled[Index])) then
    begin
      if State[Index] in [cbChecked, cbGrayed] then
      begin
        DrawFrameControl(DC, ARect,
          DFC_BUTTON, DFCS_BUTTONCHECK or DFCS_CHECKED or DFCS_FLAT);
        DrawRect(ARect, KColor(clWindow));
      end;
      with ARect do
        DrawRect(Rect(Left + 1, Top + 1, Right - 1, Bottom - 1), KColor(clBtnShadow));
    end
    else
    begin
      if State[Index] in [cbChecked, cbGrayed] then
        DrawFrameControl(DC, ARect, DFC_BUTTON, DFCS_BUTTONCHECK or DFCS_CHECKED)
      else
        DrawFrameControl(DC, ARect, DFC_BUTTON, DFCS_BUTTONCHECK);
    end;

{    if (State[Index] = cbGrayed) or (not ItemEnabled[Index]) then
    begin
      if ItemEnabled[Index] then
        Brush.Color := clBtnHighlight
      else
        Brush.Color := clBtnFace;

      with ARect do
        FloodFill(Left + 2, Top + 2, Pixels[Left + 2, Top + 2], fsSurface);

      if State[Index] in [cbChecked, cbGrayed] then
      begin
        Brush.Color := clBtnShadow;
        with ARect do
          FloodFill(Left + 3, Top + 6, Pixels[Left + 3, Top + 6], fsSurface);
      end;
    end;}
  end;
end;

procedure TKsCustomListBox.ScrlBarScroll(Sender: TObject;
  ScrollCode: TKsScrollCode; var ScrollPos: Integer);
begin
  with Sender as TKsCustomScrollBar do
    if (ScrollPos > Max - PageSize + 1) and (PageSize <> 0) then
      ScrollPos := Max - PageSize + 1;
end;

procedure TKsCustomListBox.ScrlBarChange(Sender: TObject);
begin
  if FScrlBar = nil then Exit;

  if FScrlBar.AutoScrollUp then
  begin
    UpdateVisibleRange;
    ItemIndex := FFirstVisibleItem;
    UpdateSelRange;
  end
  else
    if FScrlBar.AutoScrollDown then
  begin
    UpdateVisibleRange;
    ItemIndex := FLastVisibleItem;
    UpdateSelRange;
  end;

  UpdatePtInPart(FMOldx, FMOldy);
  Invalidate;
end;

procedure TKsCustomListBox.UpdateScrlBar;
var
  LBorderWidth: integer;
  CurItemTop: integer;
  LTmpMax: integer;
  TmpColCount: integer;
  CurItem: integer;
  LCurItemHeight: integer;
  AB: integer;
begin
  if FScrlBar = nil then Exit;
  
  LBorderWidth := GetBorderWidth;
  FScrlBar.Min := 0;
  if Columns <= 0 then
  begin
    FScrlBar.Kind := sbVertical;
    FScrlBar.Top := LBorderWidth;
    FScrlBar.Height := Height - LBorderWidth * 2;
    FScrlBar.UpdateSytemSize;
    FScrlBar.Left := Width - FScrlBar.Width - LBorderWidth;

    if (FListStyle in [lbStandard, lbFonts, lbFontSamples, lbColors, lbColorNames]) and (not WordWrap) then
    begin
      if Items.Count > 0 then
        FScrlBar.PageSize := (ClientHeight - GetBorderWidth * 2) div GetItemHeight(0)
      else
        FScrlBar.PageSize := 0;
      FScrlBar.Max := Items.Count - 1;
    end
    else
    begin
      FScrlBar.PageSize := 0;
      if Items.Count > 0 then
      begin
        FScrlBarVizible := false;
        FScrlBar.Visible := true;
        LTmpMax := Items.Count - 1;
        CurItemTop := Height - GetBorderWidth - GetItemHeight(LTmpMax) {+2};
        while (LTmpMax > 0) and ((CurItemTop - GetItemHeight(LTmpMax - 1) >= GetBorderWidth) or not FScrlBarVizible) do
        begin
          CurItemTop := CurItemTop - GetItemHeight(LTmpMax - 1);
          LTmpMax := LTmpMax - 1;

          if (CurItemTop < GetBorderWidth) and not FScrlBarVizible then
          begin
            FScrlBarVizible := true;
            LTmpMax := Items.Count - 1;
            CurItemTop := Height - GetBorderWidth - GetItemHeight(LTmpMax) {+2};
          end;
        end;
        FScrlBar.Max := LTmpMax;
      end
      else
        FScrlBar.Max := 0;
    end;

  end
  else
  begin //MultiColumn mode
    FScrlBar.Kind := sbHorizontal;
    FScrlBar.Left := LBorderWidth;
    FScrlBar.Width := Width - LBorderWidth * 2;
    FScrlBar.UpdateSytemSize;
    FScrlBar.Top := Height - FScrlBar.Height - LBorderWidth;

    CurItem := 0;
    TmpColCount := 1;
    LBorderWidth := GetBorderWidth;
    CurItemTop := LBorderWidth;

    AB := Height - LBorderWidth;
    if AlwaysShowScrlBar or (csDesigning in ComponentState) then
      AB := AB - FScrlBar.Height;

    while CurItem < Items.Count do
    begin

      LCurItemHeight := GetItemHeight(CurItem);
      CurItemTop := CurItemTop + LCurItemHeight;

      if CurItemTop > AB then
      begin
        CurItemTop := LBorderWidth + LCurItemHeight;
        TmpColCount := TmpColCount + 1;
      end;

      if (TmpColCount > Columns) and (AB = Height - LBorderWidth) then
      begin
        CurItem := 0;
        TmpColCount := 1;
        CurItemTop := LBorderWidth;
        AB := AB - FScrlBar.Height;
      end
      else
        CurItem := CurItem + 1;
    end;

    FScrlBar.Max := TmpColCount - 1;

    FScrlBar.PageSize := Columns;
  end;

  with FScrlBar do
  begin
    if csDesigning in ComponentState then
      Visible := true
    else
      Visible := FAlwaysShowScrlBar or ((PageSize < Max - Min + 1) and (Max - Min <> 0));
    FScrlBarVizible := Visible;
    Enabled := (PageSize < Max - Min + 1) and (Max - Min <> 0);
  end;
end;

function TKsCustomListBox.GetItemWidth: integer;
begin
  Result := Width - GetBorderWidth * 2;
  if FScrlBar = nil then Exit;

  if Columns > 0 then
    Result := Result div Columns
  else
    if (FScrlBar.Visible and FScrlBarVizible) or (csDesigning in ComponentState) or
    AlwaysShowScrlBar then
    Result := Result - FScrlBar.Width;

  if ShowCheckBoxes then
    Result := Result - GetChckBxFieldWidth;
end;

function TKsCustomListBox.GetChckBxFieldWidth: integer;
begin
  Result := 15;
end;

procedure TKsCustomListBox.UpdatePtInPart(x, y: integer);
var
  CurItem: integer;
  CurItemTop: integer;
  LBorderWidth: integer;
  ItemLeft: integer;
  LCurItemHeight: integer;
  TmpRect: TRect;
  CurCol: integer;
  FirstInCol: boolean;
begin
  if FScrlBar = nil then Exit;

  FMouseOnItemIndex := -1;
  FMouseOnCheckBoxIndex := -1;

  LBorderWidth := GetBorderWidth;

  if Columns <= 0 then
  begin
    CurItem := FScrlBar.Position;
    CurItemTop := LBorderWidth;
    while (CurItemTop < Height - LBorderWidth) and (CurItem <= Items.Count - 1) do
    begin
      LCurItemHeight := GetItemHeight(CurItem);
      ItemLeft := GetBorderWidth;
      if ShowCheckBoxes then
      begin
        with TmpRect do
        begin
          Left := GetBorderWidth + (GetChckBxFieldWidth - GetCheckBoxSize.x) div 2;
          Top := CurItemTop + (LCurItemHeight - GetCheckBoxSize.y) div 2;
          Right := Left + GetCheckBoxSize.x;
          Bottom := Top + GetCheckBoxSize.y;
        end;

        if PtInCheckBox(x, y, CurItem, TmpRect) then
        begin
          FMouseOnCheckBoxIndex := CurItem;
          Exit;
        end;

        ItemLeft := ItemLeft + GetChckBxFieldWidth;
      end;

      if PtInItem(x, y, CurItem,
        Rect(ItemLeft,
        CurItemTop,
        ItemLeft + GetItemWidth,
        CurItemTop + LCurItemHeight)) then
      begin
        FMouseOnItemIndex := CurItem;
        Exit;
      end;

      Inc(CurItem);
      CurItemTop := CurItemTop + LCurItemHeight;
    end;
  end
  else
  begin //MultiColumn mode
    CurItem := 0;
    CurCol := 0;
    FirstInCol := true;
    CurItemTop := LBorderWidth;

    while (CurCol - FScrlBar.Position < Columns) and (CurItem < Items.Count) do
    begin
      LCurItemHeight := GetItemHeight(CurItem);

      with TmpRect do
      begin
        if ShowCheckBoxes then
          Left := (CurCol - FScrlBar.Position) * (GetChckBxFieldWidth + GetItemWidth) + LBorderWidth
        else
          Left := (CurCol - FScrlBar.Position) * GetItemWidth + LBorderWidth;
        Top := CurItemTop;
        Right := Left + GetItemWidth;
        Bottom := Top + LCurItemHeight;
      end;

      if CurItemTop + LCurItemHeight > GetItemAreaBottom then
      begin
        if FirstInCol then
        begin
          if (CurCol - FScrlBar.Position >= 0) then
          begin
            if ShowCheckBoxes then
              with TmpRect do
              begin
                if PtInCheckBox(x, y, CurItem,
                  Rect(Left + (GetChckBxFieldWidth - GetCheckBoxSize.x) div 2,
                  Top + (LCurItemHeight - GetCheckBoxSize.y) div 2,
                  Left + (GetChckBxFieldWidth - GetCheckBoxSize.x) div 2 + GetCheckBoxSize.x,
                  Top + (LCurItemHeight - GetCheckBoxSize.y) div 2 + GetCheckBoxSize.y)) then
                begin
                  FMouseOnCheckBoxIndex := CurItem;
                  Exit;
                end;
                Left := Left + GetChckBxFieldWidth;
                Right := Right + GetChckBxFieldWidth;
              end;
            if PtInItem(x, y, CurItem, TmpRect) then
            begin
              FMouseOnItemIndex := CurItem;
              Exit;
            end;
          end;
          CurItem := CurItem + 1;
        end;
        CurCol := CurCol + 1;
        FirstInCol := true;
        CurItemTop := LBorderWidth;
      end
      else
      begin
        if (CurCol - FScrlBar.Position >= 0) then
        begin
          if ShowCheckBoxes then
            with TmpRect do
            begin
              if PtInCheckBox(x, y, CurItem,
                Rect(Left + (GetChckBxFieldWidth - GetCheckBoxSize.x) div 2,
                Top + (LCurItemHeight - GetCheckBoxSize.y) div 2,
                Left + (GetChckBxFieldWidth - GetCheckBoxSize.x) div 2 + GetCheckBoxSize.x,
                Top + (LCurItemHeight - GetCheckBoxSize.y) div 2 + GetCheckBoxSize.y)) then
              begin
                FMouseOnCheckBoxIndex := CurItem;
                Exit;
              end;
              Left := Left + GetChckBxFieldWidth;
              Right := Right + GetChckBxFieldWidth;
            end;
          if PtInItem(x, y, CurItem, TmpRect) then
          begin
            FMouseOnItemIndex := CurItem;
            Exit;
          end;
        end;
        FirstInCol := false;
        CurItem := CurItem + 1;
        CurItemTop := CurItemTop + LCurItemHeight;
      end;
    end;
  end;
end;

procedure TKsCustomListBox.MouseMove(Shift: TShiftState; x, y: integer);
var
  OldMouseOnItemIndex,
    OldMouseOnCheckBoxIndex: integer;
begin
  if FScrlBar = nil then Exit;
  
  inherited;

  FMOldx := x;
  FMOldy := y;

  OldMouseOnItemIndex := MouseOnItemIndex;
  OldMouseOnCheckBoxIndex := MouseOnCheckBoxIndex;
  UpdatePtInPart(x, y);

  if (OldMouseOnItemIndex <> MouseOnItemIndex) or
    (OldMouseOnCheckBoxIndex <> MouseOnCheckBoxIndex) then
  begin
    Invalidate;
    Application.ProcessMessages;
  end;

  if ((y < 0) and (Columns = 0)) or ((x < 0) and (Columns <> 0)) then
    FScrlBar.AutoScrollUp := true
  else
    if ((y > Height) and (Columns = 0)) or ((x > Width) and (Columns <> 0)) then
    FScrlBar.AutoScrollDown := true
  else
  begin
    FScrlBar.AutoScrollUp := false;
    FScrlBar.AutoScrollDown := false;
    if (MouseOnItemIndex <> -1) and FMousePressed and not (ssCtrl in Shift) then
    begin
      ItemIndex := MouseOnItemIndex;
      UpdateSelRange;
    end;
  end;
end;

function TKsCustomListBox.PtInItem(x, y, Index: integer;
  ARect: TRect): boolean;
begin
  Result := PtInRect(ARect, Point(x, y));
end;

function TKsCustomListBox.PtInCheckBox(x, y, Index: integer;
  ARect: TRect): boolean;
begin
  Result := PtInRect(ARect, Point(x, y));
end;

function TKsCustomListBox.GetState(Index: Integer): TKsCheckBoxState;
begin
  Result := FState[Index];
end;

procedure TKsCustomListBox.MouseDown(Button: TMouseButton;
  Shift: TShiftState; x, y: integer);
begin
  inherited;
  SetFocus;

  FMousePressed := true;

  if Button <> mbLeft then
    Exit;

  if (MouseOnItemIndex <> -1) or (MouseOnCheckBoxIndex <> -1) then
  begin

    if MouseOnItemIndex <> -1 then
      ItemIndex := MouseOnItemIndex
    else
    begin
      ItemIndex := MouseOnCheckBoxIndex;
      if ItemEnabled[ItemIndex] then
        case State[ItemIndex] of
          cbUnchecked: State[ItemIndex] := cbChecked;
          cbChecked:
            if AllowGrayed then
              State[ItemIndex] := cbGrayed
            else
              State[ItemIndex] := cbUnchecked;
          cbGrayed: State[ItemIndex] := cbUnchecked;
        end;
    end;

    if not (ssShift in Shift) then
      FSelRangeBeg := ItemIndex;

    if (ssCtrl in Shift) and MultiSelect then
      Selected[ItemIndex] := not Selected[ItemIndex]
    else
      UpdateSelRange;

  end;
end;

function TKsCustomListBox.GetCheckBoxSize: TPoint;
begin
  with Result do
  begin
    x := 13;
    y := 13;
  end;
end;

function TKsCustomListBox.GetItemEnabled(Index: Integer): boolean;
begin
  Result := FItemEnabled[Index];
end;

procedure TKsCustomListBox.DoEnter;
begin
  inherited;
  Invalidate;
end;

procedure TKsCustomListBox.DoExit;
begin
  inherited;
  Invalidate;
end;

function TKsCustomListBox.GetSelected(Index: Integer): boolean;
begin
  Result := false;
  if (Low(FSelected) <= High(FSelected)) and
     (Index >= Low(FSelected)) and (Index <= High(FSelected))
  then
    Result := FSelected[Index];
end;

function TKsCustomListBox.GetItemAreaBottom: integer;
begin
  Result := Height - GetBorderWidth;
  if FScrlBar = nil then Exit;

  if (Columns > 0) and (FScrlBar.Visible or (csDesigning in ComponentState) or AlwaysShowScrlBar) then
    Result := Result - FScrlBar.Height;
end;

procedure TKsCustomListBox.DoDrawItem;
var
  Canvas: TCanvas;
begin
  if Assigned(FOnDrawItem) and (Buffer <> nil) and (not Buffer.Empty) then
  begin
    Canvas := TCanvas.Create;
    try
      Canvas.Handle := Buffer.DC;
      FOnDrawItem(Self, Canvas, Index, Rect, State);
    finally
      Canvas.Handle := 0;
      Canvas.Free;
    end;
  end;
end;

function TKsCustomListBox.DoMeasureItem;
var
  Canvas: TCanvas;
begin
  if Assigned(FOnMeasureItem) and (Buffer <> nil) and (not Buffer.Empty) then
  begin
    Canvas := TCanvas.Create;
    try
      Canvas.Handle := Buffer.DC;
      FOnMeasureItem(Self, Canvas, Index, Result);
    finally
      Canvas.Handle := 0;
      Canvas.Free;
    end;
  end
  else
    Result := -1;
end;

function TKsCustomListBox.ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
var
  i: integer;
  R: TRect;
begin
  Result := -1;

  for i := 0 to Items.Count - 1 do
  begin
    R := GetItemRect(i);
    if PtInRect(R, Pos) then
    begin
      Result := i;
      Break;
    end;
  end;

  if Result = -1 then
    if not Existing then
      Result := Items.Count; 
end;

procedure TKsCustomListBox.UpdateVisibleRange;
var
  CurItem: integer;
  CurItemTop: integer;
  LBorderWidth: integer;
  LCurItemHeight: integer;
  CurCol: integer;
  FirstInCol: boolean;
begin
  if FScrlBar = nil then Exit;

  LBorderWidth := GetBorderWidth;

  if Columns <= 0 then
  begin
    CurItem := FScrlBar.Position;
    FFirstVisibleItem := FScrlBar.Position;
    FLastVisibleItem := -1;
    CurItemTop := LBorderWidth;
    while (CurItemTop < Height - LBorderWidth) and (CurItem <= Items.Count - 1) do
    begin
      LCurItemHeight := GetItemHeight(CurItem);

      if CurItemTop + LCurItemHeight - 1 < Height - LBorderWidth then
        FLastVisibleItem := CurItem;

      CurItemTop := CurItemTop + LCurItemHeight;
      Inc(CurItem);
    end;
  end
  else
  begin //MultiColumn mode
    FFirstVisibleItem := -1;
    FLastVisibleItem := -1;

    CurItem := 0;
    CurCol := 0;
    FirstInCol := true;
    CurItemTop := LBorderWidth;

    while (CurCol - FScrlBar.Position < Columns) and (CurItem < Items.Count) do
    begin
      LCurItemHeight := GetItemHeight(CurItem);

      if CurItemTop + LCurItemHeight > GetItemAreaBottom then
      begin
        if (CurCol - FScrlBar.Position = 0) and (FFirstVisibleItem = -1) then
          FFirstVisibleItem := CurItem;

        if FirstInCol then
        begin
          FLastVisibleItem := CurItem;
          CurItem := CurItem + 1;
        end;

        CurCol := CurCol + 1;
        FirstInCol := true;
        CurItemTop := LBorderWidth;
      end
      else
      begin
        if (CurCol - FScrlBar.Position = 0) and (FFirstVisibleItem = -1) then
          FFirstVisibleItem := CurItem;

        FLastVisibleItem := CurItem;
        FirstInCol := false;
        CurItem := CurItem + 1;
        CurItemTop := CurItemTop + LCurItemHeight;
      end;
    end;
  end;
end;

procedure TKsCustomListBox.KeyDown(var Key: word; Shift: TShiftState);
var
  SaveIndex: integer;
begin
  inherited;

  SaveIndex := FItemIndex;

  case Key of
    VK_UP, VK_LEFT: ItemIndex := ItemIndex - 1;
    VK_DOWN, VK_RIGHT: ItemIndex := ItemIndex + 1;
    VK_PRIOR: if FScrlBar <> nil then
      ItemIndex := ItemIndex - (FScrlBar.PageSize - 1);
    VK_NEXT: if FScrlBar <> nil then
      ItemIndex := ItemIndex + (FScrlBar.PageSize - 1);
    VK_END: ItemIndex := Items.Count - 1;
    VK_HOME: ItemIndex := 0;
    VK_SPACE, VK_RETURN:
      if ItemEnabled[ItemIndex] then
      begin
        case State[ItemIndex] of
          cbUnchecked: State[ItemIndex] := cbChecked;
          cbChecked:
            if AllowGrayed then
              State[ItemIndex] := cbGrayed
            else
              State[ItemIndex] := cbUnchecked;
          cbGrayed: State[ItemIndex] := cbUnchecked;
        end;
      end;
  end;

  if ItemIndex < 0 then ItemIndex := 0;
    
  if FKeyboardClick and (SaveIndex <> FItemIndex) then
    Click;

  if Key in [VK_UP, VK_LEFT, VK_DOWN, VK_RIGHT,
    VK_PRIOR, VK_NEXT, VK_END, VK_HOME] then
  begin
    if not (ssShift in Shift) then
      FSelRangeBeg := ItemIndex;
    UpdateSelRange;
  end;
end;

procedure TKsCustomListBox.KeyUp(var Key: word; Shift: TShiftState);
begin
  inherited;

end;

procedure TKsCustomListBox.MouseUp(Button: TMouseButton;
  Shift: TShiftState; x, y: integer);
begin
  inherited;
  FMousePressed := false;
end;

procedure TKsCustomListBox.UpdateSelRange;
var
  i: integer;
begin
  if FSelRangeBeg = -1 then Exit;

  for i := Low(FSelected) to High(FSelected) do
    Selected[i] := false;

  if MultiSelect then
  begin
    if FSelRangeBeg > ItemIndex then
      for i := ItemIndex to FSelRangeBeg do
        Selected[i] := true
    else
      for i := ItemIndex downto FSelRangeBeg do
        Selected[i] := true;
  end
  else
    Selected[ItemIndex] := true;

  Repaint;
end;

function TKsCustomListBox.GetSelCount: Integer;
var
  i: integer;
begin
  Result := 0;
  for i := 0 to Items.Count - 1 do
    if Selected[i] then
      Inc(Result);
end;

procedure TKsCustomListBox.CMMouseLeave(var Msg: TMessage);
begin
  FMOldx := -1;
  FMOldy := -1;
  if (FMouseOnItemIndex > -1) or
    (FMouseOnCheckBoxIndex > -1) then
  begin
    FMouseOnItemIndex := -1;
    FMouseOnCheckBoxIndex := -1;
    Invalidate;
  end;
end;

procedure TKsCustomListBox.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TKsCustomListBox.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
  inherited;
  Msg.Result := dlgc_WantArrows;
end;

procedure TKsCustomListBox.CMMouseWheel(var Msg: TCMMouseWheel);
var
  Dy: integer;
  sl: integer;
begin
  if FScrlBar = nil then Exit;

  if IsWinNT or IsWin98 then
    SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @sl, SPIF_SENDCHANGE)
  else
    sl := 3;

  if sl = 0 then
    sl := 1;
    
  Dy := Msg.WheelDelta div (MOUSE_WHEEL_DELTA div sl);
  with FScrlBar do
    if Dy <> 0 then
      if (FScrlBar.Position - Dy > Max - PageSize + 1) and (PageSize <> 0) then
        FScrlBar.Position := Max - PageSize + 1
      else
        FScrlBar.Position := FScrlBar.Position - Dy;
end;

procedure TKsCustomListBox.WMMouseWheel(var Msg: TWMMouseWheel);
var
  Dy: integer;
  sl: integer;
begin
  if FScrlBar = nil then Exit;

  if IsWinNT or IsWin98 then
    SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @sl, SPIF_SENDCHANGE)
  else
    sl := 3;

  if sl = 0 then
    sl := 1;

  Dy := Msg.WheelDelta div (MOUSE_WHEEL_DELTA div sl);
  with FScrlBar do
    if Dy <> 0 then
      if (FScrlBar.Position - Dy > Max - PageSize + 1) and (PageSize <> 0) then
        FScrlBar.Position := Max - PageSize + 1
      else
        FScrlBar.Position := FScrlBar.Position - Dy
end;

procedure TKsCustomListBox.SetSorted(const Value: Boolean);
begin
  FSorted := Value;
  (Items as TStringList).Sorted := true;
end;

procedure TKsCustomListBox.SetWordWrap(const Value: boolean);
begin
  if FWordWrap <> Value then
  begin
    FWordWrap := Value;
    UpdateScrlBar;
    Height := Height;
    Invalidate;
  end;
end;

procedure TKsCustomListBox.SetSelected(Index: Integer;
  const Value: boolean);
begin
  if Low(FSelected) <= High(FSelected) then
    if (Index >= Low(FSelected)) and (Index <= High(FSelected)) then
      if Value <> FSelected[Index] then
      begin
        FSelected[Index] := Value;
        Invalidate;
      end;
end;

procedure TKsCustomListBox.SetItems(const Value: TStrings);
begin
  FItems.Assign(Value);
end;

procedure TKsCustomListBox.SetBounds(ALeft, ATop, AWidth,
  AHeight: Integer);
begin
  inherited;
  UpdateScrlBar;
end;

procedure TKsCustomListBox.SetAlwaysShowScrlBar(const Value: boolean);
begin
  if FAlwaysShowScrlBar <> Value then
  begin
    FAlwaysShowScrlBar := Value;
    UpdateScrlBar;
  end;
end;

procedure TKsCustomListBox.SetShowCheckBoxes(const Value: boolean);
begin
  if FShowCheckBoxes <> Value then
  begin
    FShowCheckBoxes := Value;
    Invalidate;
  end;
end;

procedure TKsCustomListBox.SetFlat(const Value: boolean);
begin
  if FFlat <> Value then
  begin
    FFlat := Value;
    Invalidate;
  end;
end;

procedure TKsCustomListBox.SetState(Index: Integer; const Value: TKsCheckBoxState);
begin
  if Value <> FState[Index] then
  begin
    FState[Index] := Value;
    Invalidate;
  end;
end;

procedure TKsCustomListBox.SetAllowGrayed(const Value: boolean);
var
  i: integer;
begin
  if FAllowGrayed <> Value then
  begin
    FAllowGrayed := Value;
    for i := 0 to High(FState) do
      if FState[i] = cbGrayed then
        FState[i] := cbChecked;
    Invalidate;
  end;
end;

procedure TKsCustomListBox.SetItemEnabled(Index: Integer;
  const Value: boolean);
begin
  if FItemEnabled[Index] <> Value then
  begin
    FItemEnabled[Index] := Value;
    Invalidate;
  end;
end;

procedure TKsCustomListBox.SetItemIndex(const Value: integer);
begin
  if FItemIndex <> Value then
  begin
    if Value > Items.Count - 1 then
      FItemIndex := Items.Count - 1
    else
      if Value < -1 then
        FItemIndex := 0
      else
        FItemIndex := Value;

    UpdateVisibleRange;

    if FItemIndex <> - 1 then
    begin
      while FItemIndex > FLastVisibleItem do
      begin
        FScrlBar.Position := FScrlBar.Position + 1;
        UpdateVisibleRange;
      end;
      while FItemIndex < FFirstVisibleItem do
      begin
        FScrlBar.Position := FScrlBar.Position - 1;
        UpdateVisibleRange;
      end;

      if FSelRangeBeg = -1 then
        FSelRangeBeg := ItemIndex;

    end;

    UpdateSelRange;

    Invalidate;
  end
  else
  begin
    if FSelRangeBeg = -1 then
      FSelRangeBeg := ItemIndex;

    UpdateSelRange;
  end;
end;

procedure TKsCustomListBox.SetMultiSelect(const Value: boolean);
var
  i: integer;
begin
  if FMultiSelect <> Value then
  begin
    FMultiSelect := Value;
    for i := 0 to High(FSelected) do
      Selected[i] := false;
    Invalidate;
  end;
end;

procedure TKsCustomListBox.SetColumns(const Value: integer);
begin
  if FColumns <> Value then
  begin
    FColumns := Value;
    UpdateScrlBar;
    Invalidate;
  end;
end;

procedure TKsCustomListBox.SetListStyle(const Value: TKsListBoxStyle);
begin
  if FListStyle <> Value then
  begin
    FListStyle := Value;

    case FListStyle of
      lbFonts, lbFontSamples: BuildFontList;
      lbColors, lbColorNames: BuildColorList;
    end;

    UpdateScrlBar;
    Height := Height;
    Invalidate;
  end;
end;

procedure TKsCustomListBox.SetFontDevice(const Value: TKsFontDevice);
begin
  if FFontDevice <> Value then
  begin
    FFontDevice := Value;

    if FListStyle in [lbFonts, lbFontSamples] then
      BuildFontList;

    Invalidate;
  end;
end;

procedure TKsCustomListBox.SetFontType(const Value: TKsFontType);
begin
  if FFontType <> Value then
  begin
    FFontType := Value;

    if FListStyle in [lbFonts, lbFontSamples] then
      BuildFontList;

    Invalidate;
  end;
end;

function TKsCustomListBox.GetColorValue: TColor;
begin
  if (ItemIndex >= 0) and (Items.Count > 0) then
    Result := StringToColor(Items[ItemIndex])
  else
    Result := clBlack;
end;

function TKsCustomListBox.GetFontValue: TFont;
begin
  if (ItemIndex >= 0) and (Items.Count > 0) then
    FFontValue.Name := Items[ItemIndex];

  Result := FFontValue;
end;

function TKsCustomListBox.GetTopIndex: integer;
begin
  if FScrlBar <> nil then
    Result := FScrlBar.Position
  else
    Result := 0;
end;

procedure TKsCustomListBox.HasFocus;
begin
  inherited;
  UpdateSelRange;
end;

procedure TKsCustomListBox.KillFocus;
begin
  inherited ;
  UpdateSelRange;
  FMousePressed := false;
end;

procedure TKsCustomListBox.SetItemHeight(const Value: integer);
begin
  if FItemHeight <> Value then
  begin
    FItemHeight := Value;
    Invalidate;
  end;
end;

initialization
  VerInfo.dwOsVersionInfoSize := SizeOf(VerInfo);
  GetVersionEx(VerInfo);
  IsWinNt := VerInfo.dwPlatformId = VER_PLATFORM_WIN32_NT;
  IsWin98 := (VerInfo.dwPlatformID = VER_PLATFORM_WIN32_WINDOWS) and
    (VerInfo.dwMinorVersion > 0);
  InitTrueTypeBitmap;
finalization
  if TrueTypeBmp <> nil then TrueTypeBmp.Free;
end.

