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

Pascal/Delphi Source File | 2001-04-27 | 8KB | 294 lines

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

unit TDSuperListBox;

interface

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

type
  TTDStyle=(csDropDown, csDropDownList);

  TTDSuperListBox = class(TCustomListBox)
  private
    FImageList: TimageList;
    FOddBackground: TColor;
    FEvenBackground: TColor;
    FOddFont: TFont;
    FEvenFont: TFont;
    FHideItems: TStringList;
    FValue: String;
  //FSuperStyle: TTDStyle;
    FImageIndex: integer;
    { 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);
  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 Align;
    property Anchors;
    property BiDiMode;
    property BorderStyle;
    property Columns;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property ExtendedSelect;
    property Font;
    property ImeMode;
    property ImeName;
    property IntegralHeight;
    property ItemHeight;
    property Items;
    property MultiSelect;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    //property Sorted;
    //property Style;
    property TabOrder;
    property TabStop;
    property TabWidth;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    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;
  end;

{.$R *.DCR}
procedure Register;

implementation

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

{ TTDSuperListBox }

constructor TTDSuperListBox.Create(AOwner: TComponent);
begin
  inherited;
  FEvenFont:=TFont.create;
  FEvenFont.Color:=clBlack;
  Sorted:=False;
  FOddFont:=TFont.create;
  FOddFont.Color:=clBlack;

  FEvenBackGround:=clWhite;
  FOddBackGround:=clYellow;

  HideItems:=TStringList.Create;

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

procedure TTDSuperListBox.CreateParams(var Params: TCreateParams);
begin
  inherited;
//  Params.Style:=Params.Style or WS_CHILD or WS_HSCROLL
//                or LBS_OWNERDRAWVARIABLE and (not LBS_OWNERDRAWFIXED)
//                and (not LBS_SORT);
  Params.Style:=Params.Style or WS_CHILD or WS_HSCROLL
                or LBS_OWNERDRAWVARIABLE
                and (not LBS_SORT);
                //and (not CBS_SORT);

 {
  case FSuperStyle of
    csDropDown:
      Params.Style:=Params.Style or LBS_DROPDOWN;
    csDropDownList:
      Params.Style:=Params.Style or LBS_DROPDOWNLIST;
  end;
 }

end;

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

procedure TTDSuperListBox.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 TCustomListBox).canvas do
    begin
      if Odd(Index) then
      begin
        Brush.color:=FOddBackground;
        (Control as TCustomListBox).Canvas.Font:=FOddFont;
      end
      else
      begin
        Brush.Color:=FEvenBackground;
        (Control as TCustomListBox).Canvas.Font:=FEvenFont;
      end;

      //if Index=ItemIndex then Brush.Color:=clRed;

      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;

  //InvalidateRect(Handle,@ClientRect,True);
end;

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

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

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

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

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

{
procedure TTDSuperListBox.SetSuperStyle(const Value: TTDStyle);
begin
  FSuperStyle := Value;
  RecreateWnd;
end;
}
procedure TTDSuperListBox.SetValue(const Value: String);
begin
  FValue := Value;
  ItemIndex:=HideItems.indexOf(Value);
end;

end.