(************************************************************************
*    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 AHMTFileCtrls;

interface
{$I AHM.INC}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,StdCtrls,FileCtrl,
  AHMStdClass;
type
  TAHMFileCombo = class(TCustomComboBox)
  private
    FAboutStr : TAHMAboutSControlStr;
    FDirectory: string;
    FMask: string;
    FFileType: TFileType;
    FFileEdit: TCustomEdit;
    FFilterCombo: TFilterComboBox;
    FOnChange: TNotifyEvent;
    FLastSel: Integer;
    function GetDrive: char;
    function GetFileName: string;
    function IsMaskStored: Boolean;
    procedure SetDrive(Value: char);
    procedure SetFileEdit(Value: TCustomEdit);
    procedure SetDirectory(const NewDirectory: string);
    procedure SetFileType(NewFileType: TFileType);
    procedure SetMask(const NewMask: string);
    procedure SetFileName(const NewFile: string);
  protected
    procedure CreateWnd; override;
    procedure Click; override;
    procedure Change; override;
    procedure ReadFileNames; virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function GetFilePath: string; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Loaded; override;
    destructor Destroy; override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure SetFilePath (const EditText: string); virtual;
    property Drive: char read GetDrive write SetDrive;
    property FileName: string read GetFilePath write SetFilePath;
  published
    property Align;
    {$IFDEF AHMONLY4}
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    {$ENDIF}
    property About : TAHMAboutSControlStr read FAboutStr write FAboutStr;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Directory: string read FDirectory write SetFilePath;
    property FileEdit: TCustomEdit read FFileEdit write SetFileEdit;
    property FileType: TFileType read FFileType write SetFileType default [ftNormal];
    property Font;
    property ItemHeight;
    property Mask: string read FMask write SetMask stored IsMaskStored;
    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;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;
  TAHMFolderListbox = class(TDirectoryListBox)
  private
    FAboutStr : TAHMAboutSControlStr;
  protected
    procedure ReadBitmaps; override;
  public
 published
    property About : TAHMAboutSControlStr read FAboutStr write FAboutStr;
  end;
  TAHMDriveCombo = class(TDriveComboBox)
  private
    FAboutStr : TAHMAboutSControlStr;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property About : TAHMAboutSControlStr read FAboutStr write FAboutStr;
  end;

{$R ahmtfilectrls.res}
implementation

uses Consts,ShellApi;

const
  DefaultMask = '*.*';
  Slashes: array [False..True] of PChar = ('','\');

function SlashSeperator(const Path, S: String): String;
begin
  Result := Format('%s%s%s',[Path, Slashes[Path[Length(Path)] <> '\'], S]);
end;

constructor TAHMDriveCombo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Floppybmp.Free;
  {$IFDEF AHMINPRISE3}
  Floppybmp := TBitmap.Create;
  {$ELSE}
  Floppybmp := TFolderBitmap.Create;
  {$ENDIF}
  Floppybmp.Handle := LoadBitmap(HInstance, 'AHMFLOPPY');
  Fixedbmp.Free;
  {$IFDEF AHMINPRISE3}
  Fixedbmp := TBitmap.Create;
  {$ELSE}
  Fixedbmp := TFolderBitmap.Create;
  {$ENDIF}
  Fixedbmp.Handle := LoadBitmap(HInstance, 'AHMFIXED');
  Networkbmp.Free;
  {$IFDEF AHMINPRISE3}
  Networkbmp := TBitmap.Create;
  {$ELSE}
  Networkbmp := TFolderBitmap.Create;
  {$ENDIF}
  Networkbmp.Handle := LoadBitmap(HInstance, 'AHMNETWORK');
  CDROMbmp.Free;
  {$IFDEF AHMINPRISE3}
  CDROMbmp := TBitmap.Create;
  {$ELSE}
  CDROMbmp := TFolderBitmap.Create;
  {$ENDIF}
  CDROMbmp.Handle := LoadBitmap(HInstance, 'AHMCDROM');
  RAMbmp.Free;
  {$IFDEF AHMINPRISE3}
  RAMbmp := TBitmap.Create;
  {$ELSE}
  RAMbmp := TFolderBitmap.Create;
  {$ENDIF}
  RAMbmp.Handle := LoadBitmap(HInstance, 'AHMFLOPPY');
  Perform(CM_FONTCHANGED, 0, 0);
end;

procedure TAHMFolderListbox.ReadBitmaps;
var IconInfo : TSHFileInfo;
    PathName  : array [0..MAX_PATH] of char;
begin
  GetWindowsDirectory(PathName,MAX_PATH);
  {$IFDEF AHMINPRISE3}
  OpenedBMP := TBitmap.Create;
  ClosedBMP := TBitmap.Create;
  CurrentBMP := TBitmap.Create;
  {$ELSE}
  OpenedBMP := TFolderBitmap.Create;
  ClosedBMP := TFolderBitmap.Create;
  CurrentBMP := TFolderBitmap.Create;
  {$ENDIF}
  with TImageList.Create(self) do
  try
    Handle:=SHGetFileInfo(PathName,0,IconInfo,SizeOf(TSHFileInfo),SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_OPENICON );
    ShareImages:=True;
    OpenedBmp.Width:=16;
    OpenedBmp.Height:=16;
    Draw(OpenedBmp.Canvas,0,0,IconInfo.iIcon);
    CurrentBmp.Width:=16;
    CurrentBmp.Height:=16;
    Draw(CurrentBmp.Canvas,0,0,IconInfo.iIcon);
    Handle:=SHGetFileInfo(PathName,0,IconInfo,SizeOf(TSHFileInfo),SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
    ShareImages:=True;
    ClosedBMP.width:=16;
    ClosedBmp.Height:=16;
    Draw(ClosedBmp.Canvas,0,0,IconInfo.iIcon);
  finally
    Free;
  end;
end;

constructor TAHMFileCombo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Style := csOwnerDrawFixed;
  Width := 145;
  FFileType := [ftNormal];
  GetDir(0, FDirectory);
  FMask := DefaultMask;
  FLastSel := -1;
  Sorted := True;
end;

destructor TAHMFileCombo.Destroy;
begin
  inherited Destroy;
end;

procedure TAHMFileCombo.Loaded;
begin
  inherited Loaded;
end;

procedure TAHMFileCombo.CreateWnd;
begin
  inherited CreateWnd;
  ReadFileNames;
end;

function TAHMFileCombo.IsMaskStored: Boolean;
begin
  Result := DefaultMask <> FMask;
end;

function TAHMFileCombo.GetDrive: char;
begin
  Result := FDirectory[1];
end;

procedure TAHMFileCombo.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var Info : TSHFileInfo;
    xFileName : String;
begin
  if FDirectory[Length(FDirectory)]<>'\' then xFilename:=FDirectory+'\'+Items[Index]
                                         else xFilename:=FDirectory+Items[Index];
  with Canvas do
  begin
    FillRect(Rect);
    FillChar(Info,SizeOF(TSHFileInfo),0);
    with TImageList.Create(self) do
    try
     Handle:=SHGetFileInfo(PChar(xFilename),0,Info,
        SizeOf(TSHFileInfo),SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_OPENICON);
        ShareImages:=True;
        Draw(Canvas,Rect.Left,Rect.Top,Info.iIcon);
    finally
       Free;
    end;
    TextOut(Rect.Left+ 18, Rect.Top, Items[Index]);
  end;
end;


procedure TAHMFileCombo.ReadFileNames;
var AttrIndex: TFileAttr;
    I : Integer;
    FileExt : string;
    MaskPtr : PChar;
    Ptr : PChar;
    AttrWord : Word;
    FileInfo : TSearchRec;
    SaveCursor : TCursor;
const Attributes: array[TFileAttr] of Word = (faReadOnly, faHidden, faSysFile,
                  faVolumeID, faDirectory, faArchive, 0);
begin
  AttrWord := DDL_READWRITE;
  if HandleAllocated then
  begin
    for AttrIndex := ftReadOnly to ftArchive do if AttrIndex in FileType then
        AttrWord := AttrWord or Attributes[AttrIndex];
    ChDir(FDirectory);
    Clear;
    I := 0;
    SaveCursor := Screen.Cursor;
    try
      MaskPtr := PChar(FMask);
      while MaskPtr <> nil do
      begin
        Ptr := StrScan (MaskPtr, ';');
        if Ptr <> nil then Ptr^ := #0;
        if FindFirst(MaskPtr, AttrWord, FileInfo) = 0 then
        begin
          repeat
            if (ftNormal in FileType) or (FileInfo.Attr and AttrWord <> 0) then
              if FileInfo.Attr and faDirectory <> 0 then
              begin
                I := Items.Add(Format('[%s]',[FileInfo.Name]));
              end
              else
              begin
                FileExt := AnsiLowerCase(ExtractFileExt(FileInfo.Name));
                I := Items.Add(FileInfo.Name);
              end;
            if I = 100 then
              Screen.Cursor := crHourGlass;
          until FindNext(FileInfo) <> 0;
          FindClose(FileInfo);
        end;
        if Ptr <> nil then
        begin
          Ptr^ := ';';
          Inc (Ptr);
        end;
        MaskPtr := Ptr;
      end;
    finally
      Screen.Cursor := SaveCursor;
    end;
    Change;
  end;
  if itemindex=-1 then 
  if (Items.count>-1) then ItemIndex:=0;
end;

procedure TAHMFileCombo.Click;
begin
  inherited Click;
  if FLastSel <> ItemIndex then Change;
end;

procedure TAHMFileCombo.Change;
begin
  FLastSel := ItemIndex;
  if FFileEdit <> nil then
  begin
    if Length(GetFileName) = 0 then FileEdit.Text := Mask
                               else FileEdit.Text := GetFileName;
    FileEdit.SelectAll;
  end;
  if Assigned(FOnChange) then FOnChange(Self);
end;

function TAHMFileCombo.GetFileName: string;
var idx: Integer;
begin
  idx  := ItemIndex;
  Result  := Items[idx];
end;

procedure TAHMFileCombo.SetFileName(const NewFile: string);
begin
  if AnsiCompareText(NewFile, GetFileName) <> 0 then
  begin
    ItemIndex := SendMessage(Handle, LB_FindStringExact, 0,Longint(PChar(NewFile)));
    Change;
  end;
end;

procedure TAHMFileCombo.SetFileEdit(Value: TCustomEdit);
begin
  FFileEdit := Value;
  if FFileEdit <> nil then
  begin
    FFileEdit.FreeNotification(Self);
    if GetFileName <> '' then FFileEdit.Text := GetFileName
                         else FFileEdit.Text := Mask;
  end;
end;

procedure TAHMFileCombo.SetDrive(Value: char);
begin
  if (UpCase(Value) <> UpCase(FDirectory[1])) then
    SetFilePath (Format ('%s:', [Value]));
end;

procedure TAHMFileCombo.SetDirectory(const NewDirectory: string);
begin
  if AnsiCompareText(NewDirectory, FDirectory) <> 0 then
  begin
    ChDir(FDirectory);
    ChDir(NewDirectory);
    GetDir(0, FDirectory);
    ReadFileNames;
  end;
end;

procedure TAHMFileCombo.SetFileType(NewFileType: TFileType);
begin
  if NewFileType <> FFileType then
  begin
    FFileType := NewFileType;
    ReadFileNames;
  end;
end;

procedure TAHMFileCombo.SetMask(const NewMask: string);
begin
  if FMask <> NewMask then
  begin
    FMask := NewMask;
    ReadFileNames;
  end;
end;

procedure TAHMFileCombo.SetFilePath(const EditText: string);
var DirPart: string;
    FilePart: string;
    NewDrive: Char;
begin
  if AnsiCompareText(FileName, EditText) = 0 then Exit;
  if Length (EditText) = 0 then Exit;
  ProcessPath (EditText, NewDrive, DirPart, FilePart);
  SetDirectory(Format('%s:%s', [NewDrive, DirPart]));
  if (Pos('*', FilePart) > 0) or (Pos('?', FilePart) > 0) then SetMask (FilePart)
                 else if Length(FilePart) > 0 then
  begin
    SetFileName (FilePart);
    if FileExists (FilePart) then
    begin
      if GetFileName = '' then
      begin
        SetMask(FilePart);
        SetFileName (FilePart);
      end;
    end else raise EInvalidOperation.CreateResFmt(0, [EditText]);
  end;
end;

function TAHMFileCombo.GetFilePath: string;
begin
  Result := '';
  if GetFileName <> '' then
    Result := SlashSeperator(FDirectory, GetFileName);
end;

procedure TAHMFileCombo.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then
  begin
    if (AComponent = FFileEdit) then FFileEdit := nil
    else if (AComponent = FFilterCombo) then FFilterCombo := nil;
  end;
end;

end.
