(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTIconCtrls;

interface

uses Windows,SysUtils,Forms,Controls, Classes, Graphics, StdCtrls, Menus,
     ShellApi, AHMStdClass,Dialogs;

type
  TAHMIconCombo = class(TCustomComboBox)
  private
    FAboutStr : TAHMAboutSControlStr;
    FFileName: String;
    FIcon : TIcon;
    FNumberOfIcons: integer;
    FOnFileChange: TNotifyEvent;
    procedure SetIconDetails;
    Procedure SetIcon(Value : TIcon);
    Function GetIcon : TIcon;
    Function GetIconIndex : Integer;
    Procedure SetIconIndex(Value : Integer);
  protected
    procedure SetFileName(Value: String);
    procedure MeasureItem(Index: Integer; var Height: Integer); override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Loaded; override;
    destructor Destroy; override;
  published
    property About : TAHMAboutSControlStr read FAboutStr write FAboutStr;
    property IconIndex : Integer read GetIconIndex write SetIconIndex;
    property Icon : TIcon read GetIcon write SetIcon stored False;
    property FileName: string read FFileName write SetFileName;
    property NumberOfIcons: integer read FNumberOfIcons default -1;
    property OnFileChange: TNotifyEvent read FOnFileChange write FOnFileChange;
    property Color;
    property Ctl3D;
    property DragMode;
    property DragCursor;
    property DropDownCount default 5;
    property Enabled;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
  end;
  TAHMIconListbox = class(TCustomListBox)
  private
    FAboutStr : TAHMAboutSControlStr;
    FFileName: String;
    FLock: boolean;
    FNumberOfIcons: integer;
    FItemWidth: integer;
    FXIcons: integer;
    FYIcons: integer;
    FOnChange: TNotifyEvent;
    FOnFileChange: TNotifyEvent;
    FIcon : TIcon;
    procedure SetIconDetails;
    procedure ResetSize;
    Procedure SetIcon(Value : TIcon);
    Function GetIcon : TIcon;
    Function GetIconIndex : Integer;
    Procedure SetIconIndex(Value : Integer);
  protected
    procedure SetFileName(Value: String);
    procedure SetXIcons(Value: integer);
    procedure SetYIcons(Value: integer);
    procedure MeasureItem(Index: Integer; var Height: Integer);              override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Loaded; override;
    destructor Destroy; override;
  published
    property IconIndex : Integer read GetIconIndex write SetIconIndex;
    property Icon : TIcon read GetIcon write SetIcon stored False;
    property About : TAHMAboutSControlStr read FAboutStr write FAboutStr;
    property FileName: string read FFileName write SetFileName;
    property NumberOfIcons: integer read FNumberOfIcons default -1;
    property XIcons: integer read FXIcons write SetXIcons default 4;
    property YIcons: integer read FYIcons write SetYIcons default 1;
    property OnFileChange: TNotifyEvent read FOnFileChange write FOnFileChange;
    property Align;
    property Color;
    property Ctl3D;
    property DragMode;
    property DragCursor;
    property Enabled;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
  end;

implementation

Function GetWinDir : String;
var PathArray : array [0..255] of char;
begin
  FillChar(PathArray, SizeOf(PathArray), #0);
  GetWindowsDirectory(PathArray,255);
  result:=Format('%s',[PathArray]);
end;

constructor TAHMIconCombo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIcon:=TIcon.Create;
  FFilename:=GetWindir+'\Explorer.exe';
  FNumberOfIcons := -1;
  DropDownCount := 5;
  Style := csOwnerDrawFixed;
  ItemHeight := GetSystemMetrics(SM_CYICON) + 9;
  Height := ItemHeight;
  Width :=  GetSystemMetrics(SM_CXVSCROLL)+GetSystemMetrics(SM_CXICON) + 13;
end;

procedure TAHMIconCombo.Loaded;
begin
  inherited Loaded;
end;

procedure TAHMIconCombo.CreateWnd;
begin
  inherited CreateWnd;
  SetIconDetails;
end;

procedure TAHMIconCombo.CreateParams;
begin
  inherited CreateParams(Params);
  with Params do ExStyle:=ExStyle or ws_ex_clientedge or ws_ex_staticedge;
end;

Function TAHMIconCombo.GetIconIndex : Integer;
begin
  result:=ItemIndex;
end;

Procedure TAHMIconCombo.SetIconIndex(Value : Integer);
begin
  ItemIndex:=Value;
end;


destructor TAHMIconCombo.Destroy;
begin
  FIcon.Free;
  inherited Destroy;
end;

Procedure TAHMIconCombo.SetIcon(Value : TIcon);
begin
  {this is only provided to allow extracting of Icons in Design}
end;

procedure TAHMIconCombo.SetIconDetails;
var x: integer;
    Buff: array[0..255] of char;
begin
  FNumberOfIcons:=-1;
  Clear;
  if FileExists(FFileName) then
  begin
    FNumberOfIcons := ExtractIcon(hInstance, StrPCopy(Buff, FFileName),FNumberOfIcons);
    for x := 0 to NumberOfIcons - 1 do Items.Add(Format('%d',[x]));
    IconIndex := 0;
  end;
end;

procedure TAHMIconCombo.SetFileName(Value: String);
begin
  FFileName := Value;
  SetIconDetails;
  if assigned(FOnFileChange) then FOnFileChange(Self);
end;

function TAHMIconCombo.GetIcon : TIcon;
var Buff: array[0..255] of char;
begin
  if IconIndex>-1 then
  begin
    FIcon.Handle := ExtractIcon(hInstance, StrPCopy(Buff, FFileName), IconIndex);
    result :=FIcon;
  end else result:=nil;
end;

procedure TAHMIconCombo.MeasureItem(Index: Integer; var Height: Integer);
begin
  Height := GetSystemMetrics(SM_CYICON) + 3;
end;

procedure TAHMIconCombo.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var Icon: TIcon;
    Buff: array[0..255] of char;
begin
  with Canvas do
  begin
    try
      FillRect(Rect);
      Icon := TIcon.Create;
      Icon.Handle:=ExtractIcon(hInstance, StrPCopy(Buff, FFileName), Index);
      with Rect do Draw(Left + (Right - Left - Icon.Width) div 2,
                          Top + (Bottom - Top - Icon.Width) div 2, Icon);
      Icon.Free;
    except
      {};
    end;
  end;
end;

constructor TAHMIconListbox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Style := lbOwnerDrawFixed;
  ItemHeight := GetSystemMetrics(SM_CYICON) + 6;
  FItemWidth := GetSystemMetrics(SM_CXICON) + 6;
  FFilename:=GetWinDir+'\Explorer.exe';
  FIcon:=TIcon.Create;
  FLock := TRUE;
  FNumberOfIcons := -1;
  FYIcons := 1;
  XIcons := 4;
end;

procedure TAHMIconListbox.Loaded;
begin
  inherited Loaded;
end;

destructor TAHMIconListbox.Destroy;
begin
  FIcon.Free;
  inherited Destroy;
end;

Procedure TAHMIconListbox.SetIcon(Value : TIcon);
begin
  {this is only provided to allow extracting of Icons in Design}
end;

procedure TAHMIconListBox.CreateWnd;
begin
  inherited CreateWnd;
  SetIconDetails;
end;

procedure TAHMIconListbox.SetIconDetails;
var x: integer;
    Buff: array[0..255] of char;
begin
  FNumberOfIcons:=-1;
  Clear;
  if FileExists(FFileName) then
  begin
    FNumberOfIcons := ExtractIcon(hInstance, StrPCopy(Buff, FFileName), FNumberOfIcons);
    for x := 0 to NumberOfIcons - 1 do Items.Add(Format('%d',[x]));
    IconIndex := 0;
  end;
end;

procedure TAHMIconListbox.CreateParams;
begin
  inherited CreateParams(Params);
  with Params do Style:=Style or ws_dlgframe;
end;

Function TAHMIconListBox.GetIconIndex : Integer;
begin
  result:=ItemIndex;
end;

Procedure TAHMIconListbox.SetIconIndex(Value : Integer);
begin
  ItemIndex:=Value;
end;

procedure TAHMIconListbox.ResetSize;
begin
  Height := ItemHeight * YIcons + GetSystemMetrics(SM_CYHSCROLL) + 1;
  Width := FItemWidth * XIcons + 2;
  Columns := XIcons;
end;

procedure TAHMIconListbox.SetFileName(Value: String);
begin
  FFileName := Value;
  SetIconDetails;
  if assigned(FOnFileChange) then FOnFileChange(Self);
end;

procedure TAHMIconListbox.SetXIcons(Value: integer);
begin
  if (Value = FXIcons) or (Value < 1) then exit;
  FXIcons:= Value;
  ResetSize;
end;

procedure TAHMIconListbox.SetYIcons(Value: integer);
begin
  if (Value = FYIcons) or (Value < 1) then exit;
  FYIcons := Value;
  ResetSize;
end;

function TAHMIconListbox.GetIcon : TIcon;
var Buff: array[0..255] of char;
begin
  if IconIndex>-1 then
  begin
    FIcon.Handle := ExtractIcon(hInstance, StrPCopy(Buff, FFileName), IconIndex);
    result :=FIcon;
  end else result:=nil;
end;

procedure TAHMIconListbox.MeasureItem(Index: Integer; var Height: Integer);
begin
  Height := GetSystemMetrics(SM_CYICON);
end;

procedure TAHMIconListbox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var Icon: TIcon;
    Buff: array[0..255] of char;
begin
  with Canvas do
  begin
    try
      FillRect(Rect);
      Icon := TIcon.Create;
      Icon.Handle:=ExtractIcon(hInstance, StrPCopy(Buff, FFileName), Index);
      with Rect do Draw(Left + (Right - Left - Icon.Width) div 2,
                          Top + (Bottom - Top - Icon.Width) div 2, Icon);
      Icon.Free;
    except;
      {};
    end;
  end;
end;

end.
