www.pudn.com > dfs.zip > IconCtls.pas, change:2001-06-28,size:29971b


{$I DFS.INC}  { Standard defines for all Delphi Free Stuff components } 
 
{------------------------------------------------------------------------------} 
{ TdfsIconComboBox and TdfsIconListBox v1.16                                   } 
{------------------------------------------------------------------------------} 
{ A Caching Icon ComboBox and ListBox component for Delphi.                    } 
{                                                                              } 
{ Copyright 1996-2001, Brad Stowers.  All Rights Reserved.                     } 
{                                                                              } 
{ Copyright:                                                                   } 
{ All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        } 
{ Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      } 
{ property of the author.                                                      } 
{                                                                              } 
{ Distribution Rights:                                                         } 
{ You are granted a non-exlusive, royalty-free right to produce and distribute } 
{ compiled binary files (executables, DLLs, etc.) that are built with any of   } 
{ the DFS source code unless specifically stated otherwise.                    } 
{ You are further granted permission to redistribute any of the DFS source     } 
{ code in source code form, provided that the original archive as found on the } 
{ DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For } 
{ example, if you create a descendant of TDFSColorButton, you must include in  } 
{ the distribution package the colorbtn.zip file in the exact form that you    } 
{ downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   } 
{                                                                              } 
{ Restrictions:                                                                } 
{ Without the express written consent of the author, you may not:              } 
{   * Distribute modified versions of any DFS source code by itself. You must  } 
{     include the original archive as you found it at the DFS site.            } 
{   * Sell or lease any portion of DFS source code. You are, of course, free   } 
{     to sell any of your own original code that works with, enhances, etc.    } 
{     DFS source code.                                                         } 
{   * Distribute DFS source code for profit.                                   } 
{                                                                              } 
{ Warranty:                                                                    } 
{ There is absolutely no warranty of any kind whatsoever with any of the DFS   } 
{ source code (hereafter "software"). The software is provided to you "AS-IS", } 
{ and all risks and losses associated with it's use are assumed by you. In no  } 
{ event shall the author of the softare, Bradley D. Stowers, be held           } 
{ accountable for any damages or losses that may occur from use or misuse of   } 
{ the software.                                                                } 
{                                                                              } 
{ Support:                                                                     } 
{ Support is provided via the DFS Support Forum, which is a web-based message  } 
{ system.  You can find it at http://www.delphifreestuff.com/discus/           } 
{ All DFS source code is provided free of charge. As such, I can not guarantee } 
{ any support whatsoever. While I do try to answer all questions that I        } 
{ receive, and address all problems that are reported to me, you must          } 
{ understand that I simply can not guarantee that this will always be so.      } 
{                                                                              } 
{ Clarifications:                                                              } 
{ If you need any further information, please feel free to contact me directly.} 
{ This agreement can be found online at my site in the "Miscellaneous" section.} 
{------------------------------------------------------------------------------} 
{ The lateset version of my components are always available on the web at:     } 
{   http://www.delphifreestuff.com/                                            } 
{ See IconCtls.txt for notes, known issues, and revision history.              } 
{------------------------------------------------------------------------------} 
{ Date last modified:  June 28, 2001                                           } 
{------------------------------------------------------------------------------} 
 
unit IconCtls; 
 
interface 
 
uses 
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 
  Forms, Dialogs, StdCtrls, Menus; 
 
const 
  DFS_COMBO_VERSION = 'TdfsIconComboBox v1.16'; 
  DFS_LIST_VERSION  = 'TdfsIconListBox v1.16'; 
 
type 
  TdfsIconComboBox = class(TCustomComboBox) 
  private 
    { Variables for properties } 
    FFileName: String; 
    FAutoDisable: boolean; 
    FEnableCaching: boolean; 
    FNumberOfIcons: integer; 
    FRecreating: boolean; 
    FOnFileChange: TNotifyEvent; 
 
    { Routines that should only be used internally by component } 
    procedure LoadIcons; 
    procedure FreeIcons; 
    procedure UpdateEnabledState; 
 
    {$IFDEF DFS_COMPILER_3_UP} 
    procedure CMRecreateWnd(var Message: TMessage); message CM_RECREATEWND; 
    {$ENDIF} 
    procedure WMDeleteItem(var Msg: TWMDeleteItem); message WM_DELETEITEM; 
  protected 
    { Routines for setting property values and updating affected items } 
    procedure SetFileName(Value: String); 
    procedure SetAutoDisable(Value: boolean); 
    procedure SetEnableCaching(Value: boolean); 
    function GetVersion: string; 
    procedure SetVersion(const Val: string); 
 
    { Icon service routines } 
    function  ReadIcon(const Index: integer): TIcon; 
    function  GeTdfsIcon(Index: integer): TIcon; 
 
    { Owner drawing routines } 
    procedure MeasureItem(Index: Integer; var Height: Integer);              override; 
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override; 
  public 
    constructor Create(AOwner: TComponent); override; 
 
    { Returns a specific TIcon in the list.  The TIcon is owned by the 
      component, so you should NEVER free it. } 
    property Icon[Index: integer]: TIcon 
       read GeTdfsIcon; 
  published 
    property Version: string 
       read GetVersion 
       write SetVersion 
       stored FALSE; 
    { Name of icon file to display } 
    property FileName: string 
       read FFileName 
       write SetFileName; 
    { If true, the combobox will be disabled when FileName does not exist } 
    property AutoDisable: boolean 
       read FAutoDisable 
       write SetAutoDisable 
       default TRUE; 
    { If true, icons will be loaded as needed, instead of all at once } 
    property EnableCaching: boolean 
       read FEnableCaching 
       write SetEnableCaching 
       default TRUE; 
    { The number of icons in the file.  -1 if FileName is not valid.  } 
    property NumberOfIcons: integer 
       read FNumberOfIcons 
       default -1; 
 
    { Useful if you have statics the reflect the number of icons, etc. } 
    property OnFileChange: TNotifyEvent 
       read FOnFileChange 
       write FOnFileChange; 
 
    { Protected properties in parent that we will make available to everyone } 
    property Color; 
    property Ctl3D; 
    property DragMode; 
    property DragCursor; 
    property DropDownCount default 5; 
    property Enabled; 
    property ItemIndex; 
    property ParentColor; 
    property ParentCtl3D; 
    property ParentFont; 
    property ParentShowHint; 
    property PopupMenu; 
    property ShowHint; 
    property TabOrder; 
    property TabStop; 
    property Visible; 
    property OnChange; 
    property OnClick; 
    property OnDblClick; 
    property OnDragDrop; 
    property OnDragOver; 
    property OnDropDown; 
    property OnEndDrag; 
    property OnEnter; 
    property OnExit; 
    property OnKeyDown; 
    property OnKeyPress; 
    property OnKeyUp; 
  end; 
 
  TOrientation = (lbHorizontal, lbVertical); 
 
  TdfsIconListBox = class(TCustomListBox) 
  private 
    { Private declarations } 
    FFileName: String; 
    FAutoDisable: boolean; 
    FEnableCaching: boolean; 
    FNumberOfIcons: integer; 
    FMargin: integer; 
    FRecreating: boolean; 
    FOnFileChange: TNotifyEvent; 
 
    { Routines that should only be used internally by component } 
    procedure LoadIcons; 
    procedure FreeIcons; 
    procedure UpdateEnabledState; 
 
    procedure CNDeleteItem(var Msg: TWMDeleteItem); message CN_DELETEITEM; 
    {$IFDEF DFS_COMPILER_3_UP} 
    procedure CMRecreateWnd(var Message: TMessage); message CM_RECREATEWND; 
    {$ENDIF} 
  protected 
    procedure CreateParams(var Params: TCreateParams);                       override; 
    procedure CreateWnd; override; 
    { Routines for setting property values and updating affected items } 
    procedure SetFileName(Value: String); 
    procedure SetAutoDisable(Value: boolean); 
    procedure SetMargin(const Value: integer); 
    procedure SetEnableCaching(Value: boolean); 
    function GetVersion: string; 
    procedure SetVersion(const Val: string); 
 
    { Icon service routines } 
    function  ReadIcon(const Index: integer): TIcon; 
    function  GeTdfsIcon(Index: integer): TIcon; 
 
    { Owner drawing routines } 
{    procedure MeasureItem(Index: Integer; var Height: Integer);              override;} 
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override; 
  public 
    constructor Create(AOwner: TComponent); override; 
 
    { Returns a specific TIcon in the list.  The TIcon is owned by the 
      component, so you should NEVER free it. } 
    property Icon[Index: integer]: TIcon 
       read GeTdfsIcon; 
  published 
    property Version: string 
       read GetVersion 
       write SetVersion 
       stored FALSE; 
    { Name of icon file to display } 
    property FileName: string 
       read FFileName 
       write SetFileName; 
    { If true, the combobox will be disabled when FileName does not exist } 
    property AutoDisable: boolean 
       read FAutoDisable 
       write SetAutoDisable 
       default TRUE; 
    { If true, icons will be loaded as needed, instead of all at once } 
    property EnableCaching: boolean 
       read FEnableCaching 
       write SetEnableCaching 
       default TRUE; 
    { Number of pixels of white space to add around the icons for padding } 
    property Margin: integer 
       read FMargin 
       write SetMargin 
       default 5; 
    { The number of icons in the file.  -1 if FileName is not valid.  } 
    property NumberOfIcons: integer 
       read FNumberOfIcons 
       default -1; 
 
    { Useful if you have statics the reflect the number of icons, etc. } 
    property OnFileChange: TNotifyEvent 
       read FOnFileChange 
       write FOnFileChange; 
 
    { Protected properties in parent that we will make available to everyone } 
    property Align; 
    property Color; 
    property Ctl3D; 
    property DragMode; 
    property DragCursor; 
    property Enabled; 
    property ItemIndex; 
    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 OnEndDrag; 
    property OnEnter; 
    property OnExit; 
    property OnKeyDown; 
    property OnKeyPress; 
    property OnKeyUp; 
  end; 
 
implementation 
 
uses 
  ShellAPI; 
 
 
{ TdfsIconComboBox Component } 
constructor TdfsIconComboBox.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner); 
  FRecreating := FALSE; 
  { Set default values } 
  FileName := ''; 
  AutoDisable := TRUE; 
  EnableCaching := TRUE; 
  FNumberOfIcons := -1; 
  DropDownCount := 5; 
  Style := csOwnerDrawFixed; 
  ItemHeight := GetSystemMetrics(SM_CYICON) + 6; 
  Height := ItemHeight; 
  Font.Name := 'Arial'; 
  Font.Height := ItemHeight; 
  Width := GetSystemMetrics(SM_CXICON) + GetSystemMetrics(SM_CXVSCROLL) + 10; 
end; 
 
{$IFDEF DFS_COMPILER_3_UP} 
procedure TdfsIconComboBox.CMRecreateWnd(var Message: TMessage); 
begin 
  FRecreating := TRUE; 
  try 
    inherited; 
  finally 
    FRecreating := FALSE; 
  end; 
end; 
{$ENDIF} 
 
procedure TdfsIconComboBox.WMDeleteItem(var Msg: TWMDeleteItem); 
var 
  Icon: TIcon; 
begin 
  if FRecreating then exit; 
 
  { Don't use GeTdfsIcon here! } 
  Icon := TIcon(Items.Objects[Msg.DeleteItemStruct^.itemID]); 
  { Free it.  If it is NIL, Free ignores it, so it is safe } 
  Icon.Free; 
  { Zero out the TIcon we just freed } 
  Items.Objects[Msg.DeleteItemStruct^.itemID] := NIL; 
end; 
 
{ Initialize the icon handles, which are stored in the Objects property } 
procedure TdfsIconComboBox.LoadIcons; 
var 
  x: integer; 
  Icon: TIcon; 
  Buff: array[0..255] of char; 
  OldCursor: TCursor; 
begin 
  { Clear any old icon handles } 
  FreeIcons; 
  { Reset the contents of the combobox } 
  Clear; 
  { Update the enabled state of the control } 
  UpdateEnabledState; 
  { If we have a valid file then setup the combobox. } 
  if FileExists(FileName) then begin 
    { If we are not loading on demand, set the cursor to an hourglass } 
    OldCursor := Screen.Cursor; 
    if not EnableCaching then 
      Screen.Cursor := crHourGlass; 
    { Find out how many icons are in the file } 
      FNumberOfIcons := ExtractIcon(hInstance, StrPCopy(Buff, FileName), 
         {$IFDEF DFS_WIN32} UINT(-1)); {$ELSE} word(-1)); {$ENDIF} 
    { Loop for every icon in the file } 
    for x := 0 to NumberOfIcons - 1 do begin 
      { If we are not loading on demand... } 
      if not EnableCaching then begin 
        { Create a TIcon object... } 
        Icon := TIcon.Create; 
        { and assign the icon to it. } 
        Icon.Handle := ExtractIcon(hInstance, Buff, x); 
        { Add the icon and a dummy string to the combobox } 
        Items.AddObject(Format('%d',[x]), Icon); 
      end else 
        { We're loading on demand, so just add a dummy string } 
        Items.AddObject(Format('%d',[x]), NIL); 
    end; 
    { Reset the index to the first item. } 
    ItemIndex := 0; 
    { if not loading on demand, restore the cursor } 
    if not EnableCaching then 
      Screen.Cursor := OldCursor; 
  end; 
end; 
 
{ Free the icon resources we created. } 
procedure TdfsIconComboBox.FreeIcons; 
var 
  x: integer; 
  Icon: TIcon; 
begin 
  { Loop for every icon } 
  for x := 0 to Items.Count-1 do begin 
    { Get the icon object } 
    Icon := TIcon(Items.Objects[x]);  { Don't use GeTdfsIcon here! } 
    { Free it.  If it is NIL, Free ignores it, so it is safe } 
    Icon.Free; 
    { Zero out the TIcon we just freed } 
    Items.Objects[x] := NIL; 
  end; 
  { Reset the number of Icons to reflect that we have no file. } 
  FNumberOfIcons := -1; 
end; 
 
{ Disable the control if we don't have a valid filename, and option is enabled } 
procedure TdfsIconComboBox.UpdateEnabledState; 
begin 
  if AutoDisable then 
    Enabled := FileExists(FileName) 
  else 
    Enabled := TRUE; 
  { This could be compressed into one statement, but I don't think it } 
  { is nearly as readable/understandable this way.  Looks like C.     } 
{ Enabled := (AutoDisable and FileExists(FileName)) or (not AutoDisable); } 
end; 
 
{ Update the filename of the icon file. } 
procedure TdfsIconComboBox.SetFileName(Value: String); 
begin 
  { If new value is same as old, don't reload icons.  That's silly. } 
  if FFileName = Value then exit; 
  FFileName := Value; 
  { Initialize icon handles from new icon file. } 
  LoadIcons; 
  { Call user event handler, if one exists } 
  if assigned(FOnFileChange) then 
    FOnFileChange(Self); 
end; 
 
{ Update the AutoDisable property } 
procedure TdfsIconComboBox.SetAutoDisable(Value: boolean); 
begin 
  { If it's the same, we don't need to do anything } 
  if Value = FAutoDisable then exit; 
  FAutoDisable := Value; 
  { Update the enabled state of control based on new AutoDisable setting } 
  UpdateEnabledState; 
end; 
 
{ Update the EnableCaching property } 
procedure TdfsIconComboBox.SetEnableCaching(Value: boolean); 
begin 
  { If it's the same, we don't need to do anything } 
  if Value = FEnableCaching then exit; 
  FEnableCaching := Value; 
  { If load on demand is not enabled, we need to load all the icons. } 
  if not FEnableCaching then 
    LoadIcons; 
end; 
 
{ Used to extract icons from files and assign them to a TIcon object } 
function TdfsIconComboBox.ReadIcon(const Index: integer): TIcon; 
var 
  Buff: array[0..255] of char; 
begin 
  { Create the new icon } 
  Result := TIcon.Create; 
  { Assign it the icon handle } 
  Result.Handle := ExtractIcon(hInstance, StrPCopy(Buff, FileName), Index); 
end; 
 
{ Returns the icon for a given combobox index } 
function TdfsIconComboBox.GeTdfsIcon(Index: integer): TIcon; 
begin 
  { If load on demand is enabled... } 
  if EnableCaching then 
    { Has the icon been loaded yet? } 
    if Items.Objects[Index] = NIL then 
      { No, we must get the icon and add it to Objects } 
      Items.Objects[Index] := ReadIcon(Index); 
  { Return the requested icon } 
  Result := TIcon(Items.Objects[Index]); 
end; 
 
{ Return the size of the item we are drawing } 
procedure TdfsIconComboBox.MeasureItem(Index: Integer; var Height: Integer); 
begin 
  { Ask Windows how tall icons are } 
  Height := GetSystemMetrics(SM_CYICON); 
end; 
 
{ Draw the item requested in the given rectangle.  Because of the parent's default } 
{ behavior, we needn't worry about the State.  That's very nice.                   } 
procedure TdfsIconComboBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); 
var 
  Icon: TIcon; 
begin 
  { Use the controls canvas for drawing... } 
  with Canvas do begin 
    try 
      { Fill in the rectangle.  The proper brush has already been set up for us,   } 
      { so we needn't use State to set it ourselves.                               } 
      FillRect(Rect); 
      { Get the icon to be drawn } 
      Icon := GeTdfsIcon(Index); 
      { If nothing has gone wrong, draw the icon.  Theoretically, it should never  } 
      { be NIL, but why take the chance?                                           } 
      if Icon <> nil then 
        { Using the given rectangle, draw the icon on the control's canvas,        } 
        { centering it within the rectangle.                                       } 
        with Rect do Draw(Left + (Right - Left - Icon.Width) div 2, 
                          Top + (Bottom - Top - Icon.Width) div 2, Icon); 
    except 
      { If anything went wrong, we fall down to here.  You may want to add some    } 
      { sort of user notification.  No clean up is necessary since we did not      } 
      { create anything.  We'll just ignore the problem and hope it goes away. :)  } 
      {!}; 
    end; 
  end; 
end; 
 
function TdfsIconComboBox.GetVersion: string; 
begin 
  Result := DFS_COMBO_VERSION; 
end; 
 
procedure TdfsIconComboBox.SetVersion(const Val: string); 
begin 
  { empty write method, just needed to get it to show up in Object Inspector } 
end; 
 
 
 
{ TdfsIconListBox Component } 
 
constructor TdfsIconListBox.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner); 
  FRecreating := FALSE; 
  { Set default values } 
  FMargin := 5; 
  ItemHeight := GetSystemMetrics(SM_CYICON) + FMargin;{ + 6;} 
  Style := lbOwnerDrawFixed; 
  Font.Name := 'Arial'; 
  Font.Height := ItemHeight; 
  FileName := ''; 
  FAutoDisable := TRUE; 
  FEnableCaching := TRUE; 
  FNumberOfIcons := -1; 
end; 
 
procedure TdfsIconListBox.CreateParams(var Params: TCreateParams); 
begin 
  inherited CreateParams(Params); 
  Params.Style := Params.Style or LBS_MULTICOLUMN; 
{  if Orientation = lbVertical then 
    Params.Style := Params.Style or LBS_DISABLENOSCROLL or WS_VSCROLL and (not WS_HSCROLL) 
  else 
    Params.Style := Params.Style or LBS_DISABLENOSCROLL or WS_HSCROLL and (not WS_VSCROLL);} 
end; 
 
procedure TdfsIconListBox.CNDeleteItem(var Msg: TWMDeleteItem); 
var 
  Icon: TIcon; 
begin 
  if FRecreating then exit; 
 
  { Don't use GeTdfsIcon here! } 
  Icon := TIcon(Items.Objects[Msg.DeleteItemStruct^.itemID]); 
  { Free it.  If it is NIL, Free ignores it, so it is safe } 
  Icon.Free; 
  { Zero out the TIcon we just freed } 
  Items.Objects[Msg.DeleteItemStruct^.itemID] := NIL; 
end; 
 
 
{ Initialize the icon handles, which are stored in the Objects property } 
procedure TdfsIconListBox.LoadIcons; 
  function CounTdfsIcons(Inst: THandle; Filename: PChar): integer; 
  var 
    TmpIcon: HICON; 
  begin 
    Result := 0; 
    TmpIcon := ExtractIcon(Inst, Filename, Result); 
    while (TmpIcon <> 0) do begin 
      inc(Result); 
      DestroyIcon(TmpIcon); 
      TmpIcon := ExtractIcon(Inst, Filename, Result); 
    end; 
  end; 
var 
  x: integer; 
  Icon: TIcon; 
  Buff: array[0..255] of char; 
  OldCursor: TCursor; 
begin 
  { Clear any old icon handles } 
  FreeIcons; 
  { Reset the contents of the listbox } 
  Clear; 
  { Update the enabled state of the control } 
  UpdateEnabledState; 
  { If we have a valid file then setup the combobox. } 
  if FileExists(FileName) then begin 
    { If we are not loading on demand, set the cursor to an hourglass } 
    OldCursor := Screen.Cursor; 
    if not EnableCaching then 
      Screen.Cursor := crHourGlass; 
    { Find out how many icons are in the file } 
      FNumberOfIcons := ExtractIcon(hInstance, StrPCopy(Buff, FileName), 
         {$IFDEF DFS_WIN32} UINT(-1)); {$ELSE} word(-1)); {$ENDIF} 
    { Loop for every icon in the file } 
    for x := 0 to NumberOfIcons - 1 do begin 
      { If we are not loading on demand... } 
      if not EnableCaching then begin 
        { Create a TIcon object... } 
        Icon := TIcon.Create; 
        { and assign the icon to it. } 
        Icon.Handle := ExtractIcon(hInstance, Buff, x); 
        { Add the icon and a dummy string to the combobox } 
        Items.AddObject(Format('%d',[x]), Icon); 
      end else 
        { We're loading on demand, so just add a dummy string } 
        Items.AddObject(Format('%d',[x]), NIL); 
    end; 
    { Reset the index to the first item. } 
    ItemIndex := 0; 
    { if not loading on demand, restore the cursor } 
    if not EnableCaching then 
      Screen.Cursor := OldCursor; 
  end; 
end; 
 
{ Free the icon resources we created. } 
procedure TdfsIconListBox.FreeIcons; 
var 
  x: integer; 
  Icon: TIcon; 
begin 
  { Loop for every icon } 
  for x := 0 to Items.Count-1 do begin 
    { Get the icon object } 
    Icon := TIcon(Items.Objects[x]);  { Don't use GeTdfsIcon here! } 
    { Free it.  If it is NIL, Free ignores it, so it is safe } 
    Icon.Free; 
    { Zero out the TIcon we just freed } 
    Items.Objects[x] := NIL; 
  end; 
  { Reset the number of Icons to reflect that we have no file. } 
  FNumberOfIcons := -1; 
end; 
 
{ Disable the control if we don't have a valid filename, and option is enabled } 
procedure TdfsIconListBox.UpdateEnabledState; 
begin 
  if AutoDisable then 
    Enabled := FileExists(FileName) 
  else 
    Enabled := TRUE; 
end; 
 
(* 
{ Reset the size of the listbox to reflect changes in orientation and IconsDisplayed } 
procedure TdfsIconListBox.ResetSize; 
var 
  NewWidth, NewHeight: integer; 
  Multiplier: integer; 
begin 
  NewWidth := FItemWidth * XIcons + 2; 
  NewHeight := ItemHeight * YIcons + GetSystemMetrics(SM_CYHSCROLL) + 4; 
  SetBounds(Left, Top, NewWidth+3, NewHeight); 
  // Stupid scrollbar 
  Multiplier := NumberOfIcons div YIcons; 
  if NumberOfIcons mod YIcons > 0 then 
    inc(Multiplier); 
  if NewWidth >= FItemWidth * Multiplier + 2 then 
    SetBounds(Left, Top, NewWidth+3, NewHeight - GetSystemMetrics(SM_CYHSCROLL)); 
  { I've had nothing but trouble with Delphi's Columns property.  I'll just do 
    it myself, thank you very much. } 
  {  Columns := XIcons;} 
  { Delphi 4 (maybe other versions, too) screws up in SetColumnWidth.  Things 
    get out of whack as the width grows larger. Fix it up after Columns set. } 
  if HandleAllocated then 
//    SendMessage(Handle, LB_SETCOLUMNWIDTH, FItemWidth, 0); 
    SendMessage(Handle, LB_SETCOLUMNWIDTH, NewWidth div XIcons, 0); 
 
{ 
  if Width < FItemWidth * XIcons + 2 then 
    Height := ItemHeight * YIcons + GetSystemMetrics(SM_CYHSCROLL) + 1 
  else 
    Height := ItemHeight * YIcons + 3; 
  Width := FItemWidth * XIcons + 2; 
  Columns := XIcons; 
} 
*) 
(*  if Orientation = lbVertical then begin 
    { Set height to hold the desired number of icons } 
    Height := ItemHeight * IconsDisplayed + 2; 
    { Set width to an icon plus a scrollbar } 
    Width := FItemWidth + GetSystemMetrics(SM_CXVSCROLL) + 10; 
    { Make sure we don't have any columns. } 
    Columns := 0; 
  end else begin 
    { Set height to an icon plus a scrollbar } 
    Height := ItemHeight + GetSystemMetrics(SM_CYHSCROLL) + 1; 
    { Set width to hold the desired number of icons } 
    Width := FItemWidth * IconsDisplayed + 2; 
    { Set number of columns in the listbox to the desired number of icons } 
    Columns := IconsDisplayed; 
  end; 
end;  *) 
 
{ Update the filename of the icon file. } 
procedure TdfsIconListBox.SetFileName(Value: String); 
begin 
  { If new value is same as old, don't reload icons.  That's silly. } 
  if FFileName = Value then exit; 
  FFileName := Value; 
  { Initialize icon handles from new icon file. } 
  LoadIcons; 
  { Call user event handler, if one exists } 
  if assigned(FOnFileChange) then 
    FOnFileChange(Self); 
end; 
 
{ Update the AutoDisable property } 
procedure TdfsIconListBox.SetAutoDisable(Value: boolean); 
begin 
  { If it's the same, we don't need to do anything } 
  if Value = FAutoDisable then exit; 
  FAutoDisable := Value; 
  { Update the enabled state of control based on new AutoDisable setting } 
  UpdateEnabledState; 
end; 
 
{ Update the EnableCaching property } 
procedure TdfsIconListBox.SetEnableCaching(Value: boolean); 
begin 
  { If it's the same, we don't need to do anything } 
  if Value = FEnableCaching then exit; 
  FEnableCaching := Value; 
  { If load on demand is not enabled, we need to load all the icons. } 
  if not FEnableCaching then 
    LoadIcons; 
end; 
 
{ Used to extract icons from files and assign them to a TIcon object } 
function TdfsIconListBox.ReadIcon(const Index: integer): TIcon; 
var 
  Buff: array[0..255] of char; 
begin 
  { Create the new icon } 
  Result := TIcon.Create; 
  { Assign it the icon handle } 
  Result.Handle := ExtractIcon(hInstance, StrPCopy(Buff, FileName), Index); 
end; 
 
{ Returns the icon for a given combobox index } 
function TdfsIconListBox.GeTdfsIcon(Index: integer): TIcon; 
begin 
  { If load on demand is enabled... } 
  if EnableCaching then 
    { Has the icon been loaded yet? } 
    if Items.Objects[Index] = NIL then 
      { No, we must get the icon and add it to Objects } 
      Items.Objects[Index] := ReadIcon(Index); 
  { Return the requested icon } 
  Result := TIcon(Items.Objects[Index]); 
end; 
 
 
{ Draw the item requested in the given rectangle.  Because of the parent's default } 
{ behavior, we needn't worry about the State.  That's very nice.                   } 
procedure TdfsIconListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); 
var 
  Icon: TIcon; 
begin 
  { Use the controls canvas for drawing... } 
  with Canvas do begin 
    try 
      { Fill in the rectangle.  The proper brush has already been set up for us,   } 
      { so we needn't use State to set it ourselves.                               } 
      FillRect(Rect); 
      { Get the icon to be drawn } 
      Icon := GeTdfsIcon(Index); 
      { If nothing has gone wrong, draw the icon.  Theoretically, it should never  } 
      { be NIL, but why take the chance?                                           } 
      if Icon <> nil then 
        { Using the given rectangle, draw the icon on the control's canvas,        } 
        { centering it within the rectangle.                                       } 
        with Rect do Draw(Left + (Right - Left - Icon.Width) div 2, 
                          Top + (Bottom - Top - Icon.Width) div 2, Icon); 
    except 
      { If anything went wrong, we fall down to here.  You may want to add some    } 
      { sort of user notification.  No clean up is necessary since we did not      } 
      { create anything.  We'll just ignore the problem and hope it goes away. :)  } 
      {!}; 
    end; 
  end; 
end; 
 
procedure TdfsIconListBox.SetMargin(const Value: integer); 
begin 
  if Value <> FMargin then 
  begin 
    FMargin := Value; 
    if HandleAllocated then 
      SendMessage(Handle, LB_SETCOLUMNWIDTH, GetSystemMetrics(SM_CXICON) + 
         FMargin, 0); 
    ItemHeight := GetSystemMetrics(SM_CYICON) + FMargin; 
 
{    Invalidate;} 
  end; 
end; 
 
function TdfsIconListBox.GetVersion: string; 
begin 
  Result := DFS_LIST_VERSION; 
end; 
 
procedure TdfsIconListBox.SetVersion(const Val: string); 
begin 
  { empty write method, just needed to get it to show up in Object Inspector } 
end; 
 
procedure TdfsIconListBox.CreateWnd; 
begin 
  inherited CreateWnd; 
  SendMessage(Handle, LB_SETCOLUMNWIDTH, GetSystemMetrics(SM_CXICON) + FMargin, 
     0); 
end; 
 
{$IFDEF DFS_COMPILER_3_UP} 
procedure TdfsIconListBox.CMRecreateWnd(var Message: TMessage); 
begin 
  FRecreating := TRUE; 
  try 
    inherited; 
  finally 
    FRecreating := FALSE; 
  end; 
end; 
{$ENDIF} 
 
end.