Freelog 11/Freelog011.iso/BestOf/PhoenixMail/Source/comps/ComboBoxEx.pas

Pascal/Delphi Source File | 1998-12-07 | 5KB | 190 lines

{*****************************************************************************
 *
 *  ComboBoxEx.pas - TComboBoxEx Component
 *
 *  Copyright (c) 1998-99 Michael Haller
 *
 *  Author:     Michael Haller
 *  E-mail:     [e-mail]
 *  Homepage:   http://www.discountdrive.com/sunrise/
 *
 *  This program is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU General Public License
 *  as published by the Free Software Foundation;
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
 *
 *----------------------------------------------------------------------------
 *
 *  Revision history:
 *
 *     DATE     REV                 DESCRIPTION
 *  ----------- --- ----------------------------------------------------------
 *
 *****************************************************************************}

unit ComboBoxEx;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TComboBoxEx = class(TCustomComboBox)
  private
    FValues: TStringList;
    FImgIndexes: TStringList;
    FImages: TImageList;
    FShowImages: Boolean;
    procedure SetShowImages(B: Boolean);
    procedure SetImages(IL: TImageList);
    procedure SetImgIndexes(SL: TStringList);
    procedure SetValues(SL: TStringList);
    procedure SetValue(S: String);
    function GetValue: String;
  protected
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Value: String read GetValue write SetValue;
  published
    property Values: TStringlist read FValues write SetValues;
    property ImgIndexes: TStringList read FImgIndexes write SetImgIndexes;
    property Images: TImageList read FImages write SetImages;
    property ShowImages: Boolean read FShowImages write SetShowImages;
    property Color;
    property Ctl3D;
    property DragMode;
    property DragCursor;
    property DropDownCount;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property ItemHeight;
    property Items;
    property MaxLength;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnStartDrag;
  end;

procedure Register;

implementation

constructor TComboBoxEx.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FValues := TStringList.Create;
  FImgIndexes := TStringList.Create;
  FShowImages := False;
  Style := csOwnerDrawFixed;
  DropDownCount := 10;
end;

destructor TComboBoxEx.Destroy;
begin
  Values.Free;
  FImgIndexes.Free;
  inherited Destroy;
end;

procedure TComboBoxEx.SetShowImages(B: Boolean);
begin
  if FShowImages = B then Exit;
  FShowImages := B;
  Invalidate;
end;

procedure TComboBoxEx.SetImages(IL: TImageList);
begin
  FImages := IL;
end;

procedure TComboBoxEx.SetValues(SL: TStringList);
begin
  FValues.Assign(SL);
end;

procedure TComboBoxEx.SetImgIndexes(SL: TStringList);
begin
  FImgIndexes.Assign(SL);
end;

procedure TComboBoxEx.SetValue(S: String);
var
  I, E: Integer;
begin
  E := -1;
  for I := 0 to Values.Count-1 do
    if Values[I] = S then E := I;
  ItemIndex := E;
end;

function TComboBoxEx.GetValue: String;
begin
  Result := '';
  if Values.Count > ItemIndex then
    Result := Values[ItemIndex];
end;

procedure TComboBoxEx.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  I: Integer;
begin
  if (ShowImages = False) or (Assigned(Images) = False) then begin
    inherited DrawItem(Index, Rect, State);
    Exit;
  end;
  with Canvas do begin
    Brush.Color := clWindow;
    if odSelected in State then Brush.Color := clActiveCaption;
    FillRect(Rect);
    if ImgIndexes.Count > Index then I := StrToInt(ImgIndexes.Strings[Index]) else I := 0;
    Images.Draw(Canvas, Rect.Left+2, Rect.Top+0, I);
    Font.Color := clWindowText;
    if odSelected in State then Font.Color := clCaptionText;
    TextOut(Rect.Left+23, Rect.Top+2, Items[Index]);
  end;
end;

procedure Register;
begin
  RegisterComponents('Michael Haller', [TComboBoxEx]);
end;

end.