Chip 2001 October/Chip_2001-10_cd1.bin/zkuste/delphi/kolekce/d56/TDSOFT.ZIP/TDSuperComboBox.pas

Pascal/Delphi Source File | 2001-07-09 | 8.8 KB | 321 lines

{*******************************************************}
{                                                       }
{       TDSoft Visual Component Library                 }
{                                                       }
{       Copyright (c) 2001 Daniele Teti                 }
{                                                       }
{-------------------------------------------------------}
{       For suggest, request, bug or only for sport:    }
{       [e-mail]                        }
{-------------------------------------------------------}
{                                                       }
{                                                       }
{*******************************************************}

unit TDSuperComboBox;

interface

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

type
  TTDStyle=(csDropDown, csDropDownList);

  TTDSuperComboBox = class(TCustomComboBox)
  private
    FImageList: TimageList;
    FOddBackground: TColor;
    FEvenBackground: TColor;
    FOddFont: TFont;
    FEvenFont: TFont;
    FHideItems: TStringList;
    FValue: String;
    FSuperStyle: TTDStyle;
    FImageIndex: integer;
    FToRightWinControl: TWinControl;
    FToLeftWinControl: TWinControl;
    FUseArrowNavigation: Boolean;
    { Private declarations }
    Procedure MeasureItems(Control: TWinControl; Index: Integer; var Height: Integer);
    Procedure DrawItems(Control: TWinControl; Index: Integer; RectArea: TRect; State: TOwnerDrawState);
    procedure SetValue(const Value: String);
    function GetValue: String;
    procedure SetSuperStyle(const Value: TTDStyle);
    procedure SetEvenFont(const Value: TFont);
    procedure SetOddFont(const Value: TFont);
    procedure SetToLeftWinControl(const Value: TWinControl);
    procedure SetToRightWinControl(const Value: TWinControl);
    procedure WMKEYDOWN (var Msg: TMessage); message WM_KEYDOWN;
  protected
    { Protected declarations }
    procedure CreateParams(var Params: TCreateParams); override;
    property Color;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Populate(const HideString,Visible: String);
    property Value: String read GetValue write SetValue;
  published
    //property Style; {Must be published before Items}
    property Anchors;
    property BiDiMode;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property DropDownCount;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property ItemHeight;
    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 OnContextPopup;
    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;
    property Items; { Must be published after OnMeasureItem }
    property HideItems: TStringList read FHideItems write FHideItems;
    //Aggiunte da me
    property ImageList: TimageList read FImageList write FImageList;
    property EvenBackground: TColor read FEvenBackground write FEvenBackground;
    property OddBackground: TColor read FOddBackground write FOddBackground;
    property EvenFont: TFont read FEvenFont write SetEvenFont;
    property OddFont: TFont read FOddFont write SetOddFont;
    property SuperStyle: TTDStyle read FSuperStyle write SetSuperStyle;
    property ImageIndex: integer read FImageIndex write FImageIndex;
    property ToLeftControl: TWinControl read FToLeftWinControl write SetToLeftWinControl;
    property ToRightControl: TWinControl read FToRightWinControl write SetToRightWinControl;
    property UseArrowNavigation: Boolean read FUseArrowNavigation write FUseArrowNavigation;
  end;

{.$R *.DCR}
procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('TDSoft', [TTDSuperComboBox]);
end;

{ TTDSuperComboBox }

constructor TTDSuperComboBox.Create(AOwner: TComponent);
begin
  inherited;
  FEvenFont:=TFont.create;
  FEvenFont.Color:=clBlack;

  FOddFont:=TFont.create;
  FOddFont.Color:=clBlack;

  FEvenBackGround:=clWhite;
  FOddBackGround:=clYellow;

  HideItems:=TStringList.Create;

  Color:=FEvenBackGround;
  Style:=csOwnerDrawVariable;
  OnMeasureItem:=MeasureItems;
  OnDrawItem:=DrawItems;
  FImageIndex:=-1;

  FUseArrowNavigation:=True;
end;

procedure TTDSuperComboBox.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.Style:=Params.Style or WS_CHILD
                or CBS_OWNERDRAWVARIABLE and (not CBS_OWNERDRAWFIXED);
  case FSuperStyle of
    csDropDown:
      Params.Style:=Params.Style or CBS_DROPDOWN or CBS_SIMPLE and (not CBS_DROPDOWNLIST);
    csDropDownList:
      Params.Style:=Params.Style or CBS_DROPDOWNLIST and (not CBS_DROPDOWN) and (not CBS_SIMPLE);
  end;

end;

destructor TTDSuperComboBox.Destroy;
begin
  FEvenFont.free;
  FOddFont.free;
  FHideItems.Free;
  inherited;
end;

procedure TTDSuperComboBox.DrawItems(Control: TWinControl; Index: Integer; RectArea: TRect;
  State: TOwnerDrawState);
var
  bmp: TBitmap;
  ImageOrizOffSet: cardinal;
  IndexOfImage: integer;
begin
  inherited;
  bmp:=TBitmap.create;
  try
    with (Control as TCustomComboBox).canvas do
    begin
      if Odd(Index) then
      begin
        Brush.color:=FOddBackground;
        (Control as TCustomComboBox).Canvas.Font:=FOddFont;
      end
      else
      begin
        Brush.Color:=FEvenBackground;
        (Control as TCustomComboBox).Canvas.Font:=FEvenFont;
      end;

      if Assigned(FImageList) then
      begin
        if FImageIndex>-1 then
          IndexOfImage:=FImageIndex
        else
          IndexOfImage:=Index;

        if IndexOfImage < FImageList.Count then
        begin
          FImageList.GetBitmap(IndexOfImage,bmp);
          ImageOrizOffSet:=bmp.width;
        end
        else
        begin
          bmp:=nil;
          ImageOrizOffSet:=0;
        end;

        //Draw a Bitmap
        if bmp<>nil then Draw(RectArea.left,RectArea.top,bmp);
      end
      else
        ImageOrizOffSet:=0;



      {$WARNINGS OFF}
      FillRect(Rect(RectArea.left + ImageOrizOffSet,RectArea.top,RectArea.right,RectArea.bottom));
      {$WARNINGS ON}

      //Draw Text Item
      {$WARNINGS OFF}
      TextOut(RectArea.left + ImageOrizOffSet + GetSystemMetrics(SM_CXEDGE),
              RectArea.top + (itemheight div 2) - (TextHeight('I') div 2),
              items[index]);
      {$WARNINGS ON}

    end;

  finally
    bmp.free;
  end;
end;

function TTDSuperComboBox.GetValue: String;
begin
  Result:=HideItems[ItemIndex];
end;

procedure TTDSuperComboBox.MeasureItems(Control: TWinControl;
  Index: Integer; var Height: Integer);
begin
  Height:=ItemHeight;
end;

procedure TTDSuperComboBox.Populate(const HideString, Visible: String);
begin
  items.Add(Visible);
  HideItems.Add(HideString);
end;

procedure TTDSuperComboBox.SetEvenFont(const Value: TFont);
begin
  FEvenFont.Assign(Value);
end;

procedure TTDSuperComboBox.SetOddFont(const Value: TFont);
begin
  FOddFont.assign(Value);
end;

procedure TTDSuperComboBox.SetSuperStyle(const Value: TTDStyle);
begin
  FSuperStyle := Value;
  RecreateWnd;
end;

procedure TTDSuperComboBox.SetToLeftWinControl(const Value: TWinControl);
begin
  FToLeftWinControl := Value;
end;

procedure TTDSuperComboBox.SetToRightWinControl(const Value: TWinControl);
begin
  FToRightWinControl := Value;
end;

procedure TTDSuperComboBox.SetValue(const Value: String);
begin
  FValue := Value;
  ItemIndex:=HideItems.indexOf(Value);
end;

procedure TTDSuperComboBox.WMKEYDOWN(var Msg: TMessage);
begin
    case Msg.wParam of
      VK_LEFT:
            if FUseArrowNavigation then
              if Assigned(ToLeftControl) then
            begin
                ToLeftControl.SetFocus;
              Exit;
            end;

      VK_RIGHT:
            if FUseArrowNavigation then
              if Assigned(ToRightControl) then
            begin
                            ToRightControl.SetFocus;
              Exit;
            end;
  end;
  inherited;


end;

end.