Chip 2001 September/Chip_2001-09_cd1.bin/zkuste/delphi/kolekce/d123456/DFS.ZIP/IconCtls.pas

Pascal/Delphi Source File | 2001-06-28 | 29.3 KB | 833 lines

{$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.