winscp/source/packages/filemng/IEComboBox.pas

unit IEComboBox;

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

 Components TIECustomCombobox  /  Version 1.4  / January 2000
            TIEComboBox
            TIEDriveBox
 ==================================================================


    Description:
    ============
    TIECustomComboBox is a combobox with variable width of the dropdown list and
    provides the additional event OnCloseUp.

    TIEComboBox publishes the properties of the class TIECustomComboBox including
    the property Align wich might be was forgotten by Borland.

    TIEDriveComboBox realizes a selection control for the aviable drives of
    the system with icons. The drive icons are taken from the system image
    list.


    Author:
    =======
    (c) Ingo Eckel 1999
    Sodener Weg 38
    65812 Bad Soden
    Germany

    For detailed documentation and history see the documentation in TIEDriveComboBox.htm.

    V1.3:
    - Property DisplayStyle changed.


{==================================================================}

{Required compiler options:}
{$A+,B-,X+,H+,P+}

interface

uses
  StdCtrls, Controls, Messages, Types, Classes, Graphics;

const
  IconWidth = 16;

type
  TIECloseUpEvent = procedure (Sender: TObject; Canceled: Boolean) of object;

// =======================================================================
// Class TIECustomComboBox
// =======================================================================
  TIECustomComboBox = class(TCustomComboBox)
  private
    FDropDownFixedWidth: Integer;
    FOnCloseUp: TIECloseUpEvent;
    FCanceled: Boolean;

    function GetTopIndex: Integer;
    procedure SetTopIndex(Value: Integer);
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;

  protected
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    function GetItemImage(Index: Integer): Integer; virtual;
    function GetItemIndent(Index: Integer): Integer; virtual;
    function GetItemText(Index: Integer): string;
    function GetItemTextEx(Index: Integer; ForList: Boolean): string; virtual;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure DoCloseUp(Canceled: Boolean); virtual;
    procedure DropDown; override;
    function GetMaxItemWidth: Integer;
    procedure ResetItemHeight;

  public
    constructor Create(AOwner: TComponent); override;
    function GetTextWidth(Str: string): Integer;
    procedure DoPreloadImages;

    property ItemImage[Index: Integer]: Integer read GetItemImage;
    property ItemIndent[Index: Integer]: Integer read GetItemIndent;
    property ItemText[Index: Integer]: string read GetItemText;
    property TopIndex: Integer read GetTopIndex write SetTopIndex;
    property DropDownFixedWidth: Integer read FDropDownFixedWidth write FDropDownFixedWidth default 0;
    property OnCloseUp: TIECloseUpEvent read FOnCloseUp write FOnCloseUp;
  published
  end;


// =======================================================================
// Class TIEComboBox
// =======================================================================
  TIEComboBox = class(TIECustomComboBox)
  published
    property DropDownFixedWidth;
    property OnCloseUp;

    property Style; {Must be published before Items}
    property Align;
    property Anchors;
    property BiDiMode;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property DropDownCount;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property ItemHeight;
    property Items;
    property MaxLength;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnStartDock;
    property OnStartDrag;
  end;

function  GetItemHeight(Font: TFont): Integer;

procedure Register;

implementation

uses
  SysUtils, Forms, Dialogs, Imglist, ShellAPI, CommCtrl, Math, Windows, PasTools;

procedure Register;
begin
  RegisterComponents('DriveDir', [TIEComboBox]);
end;

// =======================================================================
// Class TIECustomComboBox
// =======================================================================

constructor TIECustomComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanceled := True;
end; {TIECustomComboBox.Create}

procedure TIECustomComboBox.CMFontChanged(var Message: TMessage);
begin
  inherited;

  ResetItemHeight;
  RecreateWnd;
end; {CMFontChanged}

procedure TIECustomComboBox.DoCloseUp(Canceled: Boolean);
begin
  if Assigned(FOnCloseUp) then
    FOnCloseUp(Self, Canceled);
end; { DoCloseUp }

procedure TIECustomComboBox.DropDown;
var
  ItemWidth: Integer;
begin
  {Check to see if DropDownFixed Width > 0. Then just set the
   width of the list box. Otherwise, loop through the items
   and set the width of the list box to 8 pixels > than the
   widest string to buffer the right side. Anything less than
   8 for some reason touches the end of the item on high-res
   monitor settings.}
  if (FDropDownFixedWidth > 0) then
      Self.Perform(CB_SETDROPPEDWIDTH, FDropDownFixedWidth, 0)
    else
  begin
    // The same code is in THistoryComboBox.DropDown
    ItemWidth := GetMaxItemWidth + ScaleByPixelsPerInch(8, Self);
    if Items.Count > DropDownCount then
      Inc(ItemWidth, GetSystemMetricsForControl(Self, SM_CXVSCROLL));
    Self.Perform(CB_SETDROPPEDWIDTH, ItemWidth, 0);
  end;

  inherited DropDown;
end; {TIECustomComboBox.DropDown}

function TIECustomComboBox.GetTextWidth(Str: string): Integer;
var
  DC: HDC;
  SaveFont: HFont;
  Size: TSize;
begin
  DC := GetDC(0);
  try
    SaveFont := SelectObject(DC, Font.Handle);
    GetTextExtentPoint32(DC, PChar(Str), Length(Str), Size);
    Result := Size.Cx;
    SelectObject(DC, SaveFont);
  finally
    ReleaseDC(0, DC);
  end;
end; {TIECustomComboBox.GetTextWidth}

function TIECustomComboBox.GetMaxItemWidth: Integer;
var
  DC: HDC;
  SaveFont: HFont;
  Size: TSize;
  Index: Integer;
begin
  Result := 0;
  DC := GetDC(0);
  try
    SaveFont := SelectObject(DC, Font.Handle);
    for Index := 0 to Items.Count - 1 do
    begin
      GetTextExtentPoint32(DC, PChar(ItemText[Index]), Length(ItemText[Index]), Size);
      Inc(Size.Cx, ItemIndent[Index]);
      if Size.Cx > Result then Result := Size.Cx;
    end;
    SelectObject(DC, SaveFont);
  finally
    ReleaseDC(0, DC);
  end;
end; {TIECustomComboBox.GetMaxItemWidth}

function TIECustomComboBox.GetTopIndex: Integer;
begin
  Result := Perform(CB_GETTOPINDEX, 0, 0);
end; {TIECustomComboBox.GetTopIndex}

{$HINTS OFF}
procedure TIECustomComboBox.DoPreloadImages;
var
  Index, Dummy: Integer;
begin
  for Index := 0 to Items.Count-1 do
    Dummy := ItemImage[Index];
end;
{$HINTS ON}

procedure TIECustomComboBox.ResetItemHeight;
var
  AHeight: Integer;
Begin
  AHeight := Max(GetItemHeight(Font), 10) + 2;
  inherited ItemHeight := AHeight;
  if HandleAllocated then
  begin
    {Set height of list items:}
    SendMessage(Handle, CB_SETITEMHEIGHT,  0, Max(AHeight, 12));
    {Set height of selection field:}
    SendMessage(Handle, CB_SETITEMHEIGHT, -1, AHeight);
    {Set height of delphi-control:}
    Height := AHeight;
  end;
end;

procedure TIECustomComboBox.SetTopIndex(Value: Integer);
begin
  if Value <> TopIndex then
    Perform(CB_SETTOPINDEX, Value, 0);
end; {TIECustomComboBox.SetTopIndex}

procedure TIECustomComboBox.CNCommand(var Message: TWMCommand);
begin
  inherited;

  case Message.NotifyCode of
    CBN_CLOSEUP:
      DoCloseUp(FCanceled);
    CBN_SELENDCANCEL:
      FCanceled := True;
    CBN_SELENDOK:
      FCanceled := False;
  end;
end; {TIECustomComboBox.CNCommand}

function GetItemHeight(Font: TFont): Integer;
var
  DC: HDC;
  SaveFont: HFont;
  Metrics: TTextMetric;
begin
  DC := GetDC(0);
  try
    SaveFont := SelectObject(DC, Font.Handle);
    GetTextMetrics(DC, Metrics);
    SelectObject(DC, SaveFont);
  finally
    ReleaseDC(0, DC);
  end;
  Result := Metrics.tmHeight;
end; {GetItemHeight}

procedure TIECustomComboBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  Text: string;
  InList: Boolean;
begin
  inherited;

  if Style = csOwnerDrawFixed then
  with Canvas do
  begin
    FillRect(Rect);
    Pen.Color := clWindowText;
    // Rect.Top = 3 when we draw selected item in component rect (not in dropdown)
    InList := (Rect.Top <> 3);
    Text := GetItemTextEx(Index, InList);

    if InList then Rect.Left := Rect.Left + ItemIndent[Index];

    Rect.Left := Rect.Left + 2;

    DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect,
      DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX));
  end;
end;

function TIECustomComboBox.GetItemImage(Index: Integer): Integer;
begin
  Result := -1;
end;

function TIECustomComboBox.GetItemIndent(Index: Integer): Integer;
begin
  Result := 0;
end;

function TIECustomComboBox.GetItemText(Index: Integer): string;
begin
  Result := GetItemTextEx(Index, True);
end;

function TIECustomComboBox.GetItemTextEx(Index: Integer; ForList: Boolean): string;
begin
  Result := Items[Index];
end;

initialization
end.