{$I OVC.INC}

{$B-} {Complete Boolean Evaluation}
{$I+} {Input/Output-Checking}
{$P+} {Open Parameters}
{$T-} {Typed @ Operator}
{$W-} {Windows Stack Frame}
{$X+} {Extended Syntax}
{$Q-} {Arithmatic-Overflow Checking}

{$IFNDEF Win32}
{$G+} {286 Instructions}
{$N+} {Numeric Coprocessor}
{$C MOVEABLE,DEMANDLOAD,DISCARDABLE}
{$ENDIF}

{*********************************************************}
{*                   OVCVLB.PAS 2.00                     *}
{*     Copyright (c) TurboPower Software Co 1995-96      *}
{*                 All rights reserved.                  *}
{*********************************************************}

unit OvcVlb;
  {-virtual list box}

interface

uses
  {$IFDEF Win32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  Classes, Controls, DsgnIntf, Forms, Graphics, StdCtrls,
  Menus, Messages, SysUtils,
  OvcBase, OvcCmd, OvcConst, OvcData, OvcMisc, OvcExcpt, OvcColor;

const
  MaxItems    = MaxLongInt;      {maximum items managed}
  MaxTabStops = 128;             {maximum number of tab stops}

const
  {default property values}
  DefAutoRowHeight   = True;
  DefAlign           = alNone;
  DefBorderStyle     = bsSingle;
  DefColor           = clWindow;
  DefColumns         = 255;
  DefCtl3D           = True;
  DefHeaderBack      = clBtnFace;
  DefHeaderText      = clBtnText;
  DefIntegralHeight  = True;
  DefItemIndex       = -1;
  DefMultiSelect     = False;
  DefNumItems        = MaxItems;
  DefOwnerDraw       = False;
  DefParentColor     = False;
  DefParentCtl3D     = True;
  DefParentFont      = True;
  DefProtectBack     = clRed;
  DefProtectText     = clWhite;
  {$IFDEF Win32}
  DefRowHeight       = 17;
  {$ELSE}
  DefRowHeight       = 20;
  {$ENDIF}
  DefScrollBars      = ssVertical;
  DefSelectBack      = clHighlight;
  DefSelectText      = clHighlightText;
  DefShowHeader      = False;
  DefTopIndex        = 0;
  DefTabStop         = True;
  DefUseTabStops     = False;

type
  TCharToItemEvent =
    procedure(Sender : TObject; Ch : Char; var Index : LongInt)
    of object;
    {-event to notify caller of a key press and return new item index}
  TDrawItemEvent =
    procedure(Sender : TObject; Index : LongInt; Rect : TRect; const S : string)
    of object;
    {-event to allow user to draw the cell items}
  TGetItemEvent =
    procedure(Sender : TObject; Index : LongInt; var ItemString : string)
    of object;
    {-event to get string to display}
  TGetItemColorEvent =
    procedure(Sender : TObject; Index : LongInt; var FG, BG : TColor)
    of object;
    {-event to get color of the item cell}
  TGetItemStatusEvent =
    procedure(Sender : TObject; Index : LongInt; var Protect : Boolean)
    of object;
    {-event to get the protected status item cell}
  THeaderClickEvent =
    procedure(Sender : TObject; Point : TPoint)
    of object;
    {-event to notify of a mouse click in the header area}
  TIsSelectedEvent =
    procedure(Sender : TObject; Index : LongInt; var Selected : Boolean)
    of object;
    {-event to get the current selection status from the user}
  TSelectEvent =
    procedure(Sender : TObject; Index : LongInt; Selected : Boolean)
    of object;
    {-event to notify of a selection change}
  TTopIndexChanged =
    procedure(Sender : TObject; NewTopIndex : LongInt)
    of object;
    {-event to notify when the top index changes}

type
  TTabStopArray = array[0..MaxTabStops] of Integer;
  TBuffer = array[0..255] of AnsiChar;

type
  TOvcCustomVirtualListBox = class(TOvcBase)
  {.Z+}
  protected {private}
    {property variables}
    FItemIndex         : LongInt;     {selected item}
    FAutoRowHeight     : Boolean;     {true to handle row height calc}
    FBorderStyle       : TBorderStyle;{border style to use}
    FColumns           : Byte;        {number of char columns}
    FHeader            : string;      {the column header}
    FHeaderColor       : TOvcColors;  {header line colors}
    FIntegralHeight    : Boolean;     {adjust height based on font}
    FMultiSelect       : Boolean;     {allow multiple selections}
    FNumItems          : LongInt;     {total number of items}
    FOwnerDraw         : Boolean;     {true if user will draw rows}
    FProtectColor      : TOvcColors;  {protected item colors}
    FRowHeight         : Integer;     {height of one row}
    FScrollBars        : TScrollStyle;{scroll bar style to use}
    FSelectColor       : TOvcColors;  {selected item color}
    FShowHeader        : Boolean;     {true to use the header}
    FTopIndex          : LongInt;     {item at top of window}
    FUseTabStops       : Boolean;     {true to use tab stops}

    {event variables}
    FOnCharToItem      : TCharToItemEvent;
    FOnClickHeader     : THeaderClickEvent;
    FOnDrawItem        : TDrawItemEvent;
    FOnGetItem         : TGetItemEvent;
    FOnGetItemColor    : TGetItemColorEvent;
    FOnGetItemStatus   : TGetItemStatusEvent;
    FOnIsSelected      : TIsSelectedEvent;
    FOnSelect          : TSelectEvent;
    FOnTopIndexChanged : TTopIndexChanged;
    FOnUserCommand     : TUserCommandEvent;

    {internal/working variables}
    lAnchor            : LongInt;   {anchor point for extended selections}
    lDivisor           : LongInt;   {divisor for scroll bars}
    lDlgUnits          : Integer;   {used for tab spacing}
    lFocusedIndex      : LongInt;   {index of the focused item}
    lHaveHS            : Boolean;   {if True, we have a horizontal scroll bar}
    lHaveVS            : Boolean;   {if True, we have a vertical scroll bar}
    lHDelta            : Integer;   {horizontal scroll delta}
    lHighIndex         : LongInt;   {highest allowable index}
    lNumTabStops       : 0..MaxTabStops; {number of tab stops in tabstop array}
    lRows              : Integer;   {number of rows in window}
    lString            : TBuffer;   {temp item string buffer}
    lTabs              : TTabStopArray;
    lUpdating          : Boolean;   {user updating flag}
    lVSHigh            : Integer;   {vertical scroll limit}

    {property methods}
    procedure SetAutoRowHeight(Value : Boolean);
      {-set use of auto row height calculations}
    procedure SetBorderStyle(const Value : TBorderStyle);
      {-set the style used for the border}
    procedure SetHeader(const Value : string);
      {-set the header at top of list box}
    procedure SetIntegralHeight(Value : Boolean);
      {-set use of integral font height adjustment}
    procedure SetMultiSelect(Value : Boolean);
      {-set ability to select multiple items}
    procedure SetNumItems(Value : LongInt);
      {-set the number of items in the list box}
    procedure SetRowHeight(Value : Integer);
      {-set height of cell row}
    procedure SetScrollBars(const Value : TScrollStyle);
      {-set use of vertical and horizontal scroll bars}
    procedure SetShowHeader(Value : Boolean);
      {-set the header at top of list box}

    {internal methods}
    procedure vlbAdjustIntegralHeight;
      {-adjust height of the list box}
    procedure vlbCalcFontFields;
      {-calculate sizes based on font selection}
    procedure vlbClearAllItems;
      {-clear the highlight from all items}
    procedure vlbClearSelRange(First, Last : LongInt);
      {-clear the selection for the given range of indexes}
    procedure vlbColorChanged(AColor: TObject);
      {-a color has changed, refresh display}
    procedure vlbDragSelection(First, Last : LongInt);
      {-drag the selection}
    procedure vlbDrawFocusRect(Index : LongInt);
      {-draw the focus rectangle}
    procedure vlbDrawHeader;
      {-draw the header and text area}
    procedure vlbExtendSelection(Index : LongInt);
      {-process Shift-LMouseBtn}
    procedure vlbInitScrollInfo;
      {-setup scroll bar range and initial position}
    procedure vlbMakeItemVisible(Index : LongInt);
      {-make sure the item is visible}
    procedure vlbNewActiveItem(Index : LongInt);
      {-set the currently selected item}
    function  vlbScaleDown(N : LongInt) : Integer;
      {-scale down index for scroll bar use}
    function  vlbScaleUp(N : LongInt) : LongInt;
      {-scale up scroll index to our index}
    procedure vlbSelectAllItems;
      {-select all items in the list box}
    procedure vlbSelectRangePrim(First, Last : LongInt; Select : Boolean);
      {-change the selection for the given range of indexes}
    procedure vlbSetAllItemsPrim(Select : Boolean);
      {-primitive routine thats acts on all items}
    procedure vlbSetFocusedIndex(Index : LongInt);
      {-set focus to this item. invalidate previous}
    procedure vlbSetHScrollPos;
      {-set the horizontal scroll position}
    procedure vlbSetHScrollRange;
      {-set the horizontal scroll range}
    procedure vlbSetSelRange(First, Last : LongInt);
      {-set the selection on for the given range of indexes}
    procedure vlbSetVScrollPos;
      {-set the vertical scroll position}
    procedure vlbSetVScrollRange;
      {-set the vertical scroll range}
    procedure vlbToggleSelection(Index : LongInt);
      {-process Ctrl-LMouseBtn}
    procedure vlbValidateItem(Index : LongInt);
      {-validate the area for this item}

    {VCL control messages}
    procedure CMCtl3DChanged(var Message: TMessage);
      message CM_CTL3DCHANGED;
    procedure CMFontChanged(var Message: TMessage);
      message CM_FONTCHANGED;

    {windows message methods}
    procedure WMChar(var Msg : TWMChar);
      message WM_CHAR;
    procedure WMEraseBkgnd(var Msg : TWMEraseBkgnd);
      message WM_ERASEBKGND;
    procedure WMGetDlgCode(var Msg : TWMGetDlgCode);
      message WM_GETDLGCODE;
    procedure WMHScroll(var Msg : TWMScroll);
      message WM_HSCROLL;
    procedure WMKeyDown(var Msg : TWMKeyDown);
      message WM_KEYDOWN;
    procedure WMKillFocus(var Msg : TWMKillFocus);
      message WM_KILLFOCUS;
    procedure WMLButtonDown(var Msg : TWMLButtonDown);
      message WM_LBUTTONDOWN;
    procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk);
      message WM_LBUTTONDBLCLK;
    procedure WMMouseActivate(var Msg : TWMMouseActivate);
      message WM_MOUSEACTIVATE;
    procedure WMSetFocus(var Msg : TWMSetFocus);
      message WM_SETFOCUS;
    procedure WMSize(var Msg : TWMSize);
      message WM_SIZE;
    procedure WMVScroll(var Msg : TWMScroll);
      message WM_VSCROLL;

    {list box messages}
    procedure LBGetCaretIndex(var Msg : TMessage);
      message LB_GETCARETINDEX;
    procedure LBGetCount(var Msg : TMessage);
      message LB_GETCOUNT;
    procedure LBGetCurSel(var Msg : TMessage);
      message LB_GETCURSEL;
    procedure LBGetItemHeight(var Msg : TMessage);
      message LB_GETITEMHEIGHT;
    procedure LBGetItemRect(var Msg : TMessage);
      message LB_GETITEMRECT;
    procedure LBGetSel(var Msg : TMessage);
      message LB_GETSEL;
    procedure LBGetTopIndex(var Msg : TMessage);
      message LB_GETTOPINDEX;
    procedure LBResetContent(var Msg : TMessage);
      message LB_RESETCONTENT;
    procedure LBSelItemRange(var Msg : TMessage);
      message LB_SELITEMRANGE;
    procedure LBSetCurSel(var Msg : TMessage);
      message LB_SETCURSEL;
    procedure LBSetSel(var Msg : TMessage);
      message LB_SETSEL;
    procedure LBSetTabStops(var Msg : TMessage);
      message LB_SETTABSTOPS;
    procedure LBSetTopIndex(var Msg : TMessage);
      message LB_SETTOPINDEX;

  protected
    procedure ChangeScale(M, D : Integer);
      override;
    procedure CreateParams(var Params: TCreateParams);
      override;
    procedure CreateWnd;
      override;
    procedure Paint;
      override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
      override;

    {event wrappers}
    function DoOnCharToItem(Ch : AnsiChar) : LongInt;
      dynamic;
      {-call the OnCharToItem event, if assigned}
    procedure DoOnClickHeader(Point : TPoint);
      dynamic;
      {-call the OnClickHeader event, if assigned}
    procedure DoOnDrawItem(Index : LongInt; Rect : TRect; const S : string);
      virtual;
      {-call the OnDrawItem event, if assigned}
    function DoOnGetItem(Index : LongInt) : PAnsiChar;
      virtual;
      {-call the OnGetItem event, if assigned}
    procedure DoOnGetItemColor(Index : LongInt; var FG, BG : TColor);
      virtual;
      {-call the OnGetItemColor event, if assigned}
    function DoOnGetItemStatus(Index : LongInt) : Boolean;
      virtual;
      {-call the OnGetItemStatus event, if assigned}
    function DoOnIsSelected(Index : LongInt) : Boolean;
      virtual;
      {-call the OnIsSelected event, if assigned}
    procedure DoOnSelect(Index : LongInt; Selected : Boolean);
      dynamic;
      {-call the OnSelect event, if assigned}
    procedure DoOnTopIndexChanged(NewTopIndex : LongInt);
      dynamic;
      {-call the OnTopIndexChanged event, if assigned}
    procedure DoOnUserCommand(Command : Word);
      dynamic;
      {-perform notification of a user command}

    {virtual property methods}
    procedure SetItemIndex(Index : LongInt);
      virtual;
      {-change the currently selected item}
    procedure SetTopIndex(Index : LongInt);
      virtual;
      {-set the index of the first visible entry in the list}
  {.Z-}

    {protected properties}
    property AutoRowHeight : Boolean
      read FAutoRowHeight
      write SetAutoRowHeight
      default DefAutoRowHeight;

    property BorderStyle : TBorderStyle
      read FBorderStyle
      write SetBorderStyle
      default DefBorderStyle;

    property Columns : Byte
      read FColumns
      write FColumns
      default DefColumns;

    property Header : string
      read FHeader
      write SetHeader;

    property HeaderColor : TOvcColors
      read FHeaderColor
      write FHeaderColor;

    property IntegralHeight : Boolean
      read FIntegralHeight
      write SetIntegralHeight
      default DefIntegralHeight;

    property MultiSelect : Boolean
      read FMultiSelect
      write SetMultiSelect
      default DefMultiSelect;

    property NumItems : LongInt
      read FNumItems
      write SetNumItems
      default DefNumItems;

    property OwnerDraw : Boolean
      read FOwnerDraw
      write FOwnerDraw
      default DefOwnerDraw;

    property ProtectColor : TOvcColors
      read FProtectColor
      write FProtectColor;

    property RowHeight : Integer
      read FRowHeight
      write SetRowHeight
      default DefRowHeight;

    property ScrollBars : TScrollStyle
       read FScrollBars
       write SetScrollBars
       default DefScrollBars;

    property SelectColor : TOvcColors
      read FSelectColor
      write FSelectColor;

    property ShowHeader : Boolean
      read FShowHeader
      write SetShowHeader
      default DefShowHeader;

    property UseTabStops : Boolean
      read FUseTabStops
      write FUseTabStops
      default DefUseTabStops;

    {protected events}
    property OnCharToItem : TCharToItemEvent
      read FOnCharToItem
      write FOnCharToItem;

    property OnClickHeader : THeaderClickEvent
      read FOnClickHeader
      write FOnClickHeader;

    property OnDrawItem : TDrawItemEvent
      read FOnDrawItem
      write FOnDrawItem;

    property OnGetItem : TGetItemEvent
      read FOnGetItem
      write FOnGetItem;

    property OnGetItemColor : TGetItemColorEvent
      read FOnGetItemColor
      write FOnGetItemColor;

    property OnGetItemStatus : TGetItemStatusEvent
      read FOnGetItemStatus
      write FOnGetItemStatus;

    property OnIsSelected : TIsSelectedEvent
      read FOnIsSelected
      write FOnIsSelected;

    property OnSelect : TSelectEvent
      read FOnSelect
      write FOnSelect;

    property OnTopIndexChanged : TTopIndexChanged
      read FOnTopIndexChanged
      write FOnTopIndexChanged;

    property OnUserCommand : TUserCommandEvent
      read FOnUserCommand
      write FOnUserCommand;

  public
    constructor Create(AOwner : TComponent);
      override;
    destructor  Destroy;
      override;

    procedure BeginUpdate;
      {-user is updating the list items--don't paint}
    procedure DrawItem(Index : LongInt);
      {-invalidate and update the area for this item}
    procedure EndUpdate;
      {-user is done updating the list items--force repaint}
    procedure InvalidateItem(Index : LongInt);
      {-invalidate the area for this item}
    function ItemAtPos(Pos : TPoint; Existing : Boolean) : LongInt;
      {-return the index of the cell that contains the point Pos}
    procedure SetTabStops(Tabs : array of Integer);
      {-set tab stop positions}

    {public properties}
    property Canvas;

    property ItemIndex : LongInt
      read FItemIndex
      write SetItemIndex;

    property TopIndex : LongInt
      read FTopIndex
      write SetTopIndex;

  published
  end;

  TOvcVirtualListbox = class(TOvcCustomVirtualListBox)
  published
    property AutoRowHeight;
    property BorderStyle;
    property Columns;
    property Header;
    property HeaderColor;
    property IntegralHeight;
    property MultiSelect;
    property NumItems;
    property OwnerDraw;
    property ProtectColor;
    property RowHeight;
    property ScrollBars;
    property SelectColor;
    property ShowHeader;
    property UseTabStops;

    property OnCharToItem;
    property OnClickHeader;
    property OnDrawItem;
    property OnGetItem;
    property OnGetItemColor;
    property OnGetItemStatus;
    property OnIsSelected;
    property OnSelect;
    property OnTopIndexChanged;
    property OnUserCommand;

    {inherited properties}
    property Align;
    property Color;
    property Controller;
    property Ctl3D;
    property DragCursor;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;

    {inherited events}
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    {$IFDEF Win32}
    property OnStartDrag;
    {$ENDIF}
  end;

implementation
