home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1999 February / DPPCPRO0299.ISO / February / Delphi / Runimage / DELPHI20 / SOURCE / VCL / FILECTRL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-08  |  49.8 KB  |  1,944 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,96 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit FileCtrl;
  11.  
  12. {$R-}
  13.  
  14. interface
  15.  
  16. uses Windows, Messages, SysUtils, Classes, Controls, Graphics, Forms,
  17.   Menus, StdCtrls, Buttons;
  18.  
  19. type
  20.   TFileAttr = (ftReadOnly, ftHidden, ftSystem, ftVolumeID, ftDirectory,
  21.     ftArchive, ftNormal);
  22.   TFileType = set of TFileAttr;
  23.  
  24.   TDriveType = (dtUnknown, dtNoDrive, dtFloppy, dtFixed, dtNetwork, dtCDROM,
  25.     dtRAM);
  26.  
  27.   TDirectoryListBox = class;
  28.   TFilterComboBox = class;
  29.   TDriveComboBox = class;
  30.  
  31. { TFileListBox }
  32.  
  33.   TFileListBox = class(TCustomListBox)
  34.   private
  35.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  36.     function GetDrive: char;
  37.     function GetFileName: string;
  38.     function IsMaskStored: Boolean;
  39.     procedure SetDrive(Value: char);
  40.     procedure SetFileEdit(Value: TEdit);
  41.     procedure SetDirectory(const NewDirectory: string);
  42.     procedure SetFileType(NewFileType: TFileType);
  43.     procedure SetMask(const NewMask: string);
  44.     procedure SetFileName(const NewFile: string);
  45.     procedure SetShowGlyphs (Value: Boolean);
  46.     procedure ResetItemHeight;
  47.   protected
  48.     FDirectory: string;
  49.     FMask: string;
  50.     FFileType: TFileType;
  51.     FFileEdit: TEdit;
  52.     FDirList: TDirectoryListBox;
  53.     FFilterCombo: TFilterComboBox;
  54.     ExeBMP, DirBMP, UnknownBMP: TBitmap;
  55.     FOnChange: TNotifyEvent;
  56.     FLastSel: Integer;
  57.     FShowGlyphs: Boolean;
  58.     procedure CreateWnd; override;
  59.     procedure ReadBitmaps; virtual;
  60.     procedure Click; override;
  61.     procedure Change; virtual;
  62.     procedure ReadFileNames; virtual;
  63.     procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);  override;
  64.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  65.     function GetFilePath: string; virtual;
  66.   public
  67.     constructor Create(AOwner: TComponent); override;
  68.     destructor Destroy; override;
  69.     procedure Update;
  70.     procedure ApplyFilePath (const EditText: string); virtual;
  71.     property Drive: char read GetDrive write SetDrive;
  72.     property Directory: string read FDirectory write ApplyFilePath;
  73.     property FileName: string read GetFilePath write ApplyFilePath;
  74.   published
  75.     property Align;
  76.     property Color;
  77.     property Ctl3D;
  78.     property DragCursor;
  79.     property DragMode;
  80.     property Enabled;
  81.     property ExtendedSelect;
  82.     property FileEdit: TEdit read FFileEdit write SetFileEdit;
  83.     property FileType: TFileType read FFileType write SetFileType default [ftNormal];
  84.     property Font;
  85.     property IntegralHeight;
  86.     property ItemHeight;
  87.     property Mask: string read FMask write SetMask stored IsMaskStored;
  88.     property MultiSelect;
  89.     property ParentColor;
  90.     property ParentCtl3D;
  91.     property ParentFont;
  92.     property ParentShowHint;
  93.     property PopupMenu;
  94.     property ShowGlyphs: Boolean read FShowGlyphs write SetShowGlyphs default False;
  95.     property ShowHint;
  96.     property TabOrder;
  97.     property TabStop;
  98.     property Visible;
  99.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  100.     property OnClick;
  101.     property OnDblClick;
  102.     property OnDragDrop;
  103.     property OnDragOver;
  104.     property OnEndDrag;
  105.     property OnEnter;
  106.     property OnExit;
  107.     property OnKeyDown;
  108.     property OnKeyPress;
  109.     property OnKeyUp;
  110.     property OnMouseDown;
  111.     property OnMouseMove;
  112.     property OnMouseUp;
  113.     property OnStartDrag;
  114.   end;
  115.  
  116. { TDirectoryListBox }
  117.  
  118.   TFolderBitmap = class(TBitmap)
  119.   public
  120.     constructor Create;
  121.   end;
  122.  
  123.   TDirectoryListBox = class(TCustomListBox)
  124.   private
  125.     FFileList: TFileListBox;
  126.     FDriveCombo: TDriveComboBox;
  127.     FDirLabel: TLabel;
  128.     FInSetDir: Boolean;
  129.     FPreserveCase: Boolean;
  130.     FCaseSensitive: Boolean;
  131.     function GetDrive: char;
  132.     procedure SetFileListBox(Value: TFileListBox);
  133.     procedure SetDirLabel(Value: TLabel);
  134.     procedure SetDirLabelCaption;
  135.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  136.     procedure SetDrive(Value: char);
  137.     procedure DriveChange(NewDrive: Char);
  138.     procedure SetDir(const NewDirectory: string);
  139.     procedure SetDirectory(const NewDirectory: string); virtual;
  140.     procedure ResetItemHeight;
  141.   protected
  142.     ClosedBMP, OpenedBMP, CurrentBMP: TFolderBitmap;
  143.     FDirectory: string;
  144.     FOnChange: TNotifyEvent;
  145.     procedure Change; virtual;
  146.     procedure DblClick; override;
  147.     procedure ReadBitmaps; virtual;
  148.     procedure CreateWnd; override;
  149.     procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
  150.     function  ReadDirectoryNames(const ParentDirectory: string;
  151.       DirectoryList: TStringList): Integer;
  152.     procedure BuildList; virtual;
  153.     procedure KeyPress(var Key: Char); override;
  154.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  155.   public
  156.     constructor Create(AOwner: TComponent); override;
  157.     destructor Destroy; override;
  158.     function  DisplayCase(const S: String): String;
  159.     function  FileCompareText(const A, B: String): Integer;
  160.     function GetItemPath(Index: Integer): string;
  161.     procedure OpenCurrent;
  162.     procedure Update;
  163.     property Drive: Char read GetDrive write SetDrive;
  164.     property Directory: string read FDirectory write SetDirectory;
  165.     property PreserveCase: Boolean read FPreserveCase;
  166.     property CaseSensitive: Boolean read FCaseSensitive;
  167.   published
  168.     property Align;
  169.     property Color;
  170.     property Columns;
  171.     property Ctl3D;
  172.     property DirLabel: TLabel read FDirLabel write SetDirLabel;
  173.     property DragCursor;
  174.     property DragMode;
  175.     property Enabled;
  176.     property FileList: TFileListBox read FFileList write SetFileListBox;
  177.     property Font;
  178.     property IntegralHeight;
  179.     property ItemHeight;
  180.     property ParentColor;
  181.     property ParentCtl3D;
  182.     property ParentFont;
  183.     property ParentShowHint;
  184.     property PopupMenu;
  185.     property ShowHint;
  186.     property TabOrder;
  187.     property TabStop;
  188.     property Visible;
  189.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  190.     property OnClick;
  191.     property OnDblClick;
  192.     property OnDragDrop;
  193.     property OnDragOver;
  194.     property OnEndDrag;
  195.     property OnEnter;
  196.     property OnExit;
  197.     property OnKeyDown;
  198.     property OnKeyPress;
  199.     property OnKeyUp;
  200.     property OnMouseDown;
  201.     property OnMouseMove;
  202.     property OnMouseUp;
  203.     property OnStartDrag;
  204.   end;
  205.  
  206. { TDriveComboBox }
  207.  
  208.   TTextCase = (tcLowerCase, tcUpperCase);
  209.  
  210.   TDriveComboBox = class(TCustomComboBox)
  211.   private
  212.     FDirList: TDirectoryListBox;
  213.     FDrive: Char;
  214.     FTextCase: TTextCase;
  215.     procedure SetDirListBox (Value: TDirectoryListBox);
  216.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  217.     procedure SetDrive(NewDrive: Char);
  218.     procedure SetTextCase(NewTextCase: TTextCase);
  219.     procedure ReadBitmaps;
  220.     procedure ResetItemHeight;
  221.   protected
  222.     FloppyBMP, FixedBMP, NetworkBMP, CDROMBMP, RAMBMP: TBitmap;
  223.     FOnChange: TNotifyEvent;
  224.     procedure CreateWnd; override;
  225.     procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
  226.     procedure Click; override;
  227.     procedure BuildList; virtual;
  228.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  229.     procedure Change; dynamic;
  230.   public
  231.     constructor Create(AOwner: TComponent); override;
  232.     destructor Destroy; override;
  233.     property Text;
  234.     property Drive: Char read FDrive write SetDrive;
  235.   published
  236.     property Color;
  237.     property Ctl3D;
  238.     property DirList: TDirectoryListBox read FDirList write SetDirListBox;
  239.     property DragMode;
  240.     property DragCursor;
  241.     property Enabled;
  242.     property Font;
  243.     property ParentColor;
  244.     property ParentCtl3D;
  245.     property ParentFont;
  246.     property ParentShowHint;
  247.     property PopupMenu;
  248.     property ShowHint;
  249.     property TabOrder;
  250.     property TabStop;
  251.     property TextCase: TTextCase read FTextCase write SetTextCase default tcLowerCase;
  252.     property Visible;
  253.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  254.     property OnClick;
  255.     property OnDblClick;
  256.     property OnDragDrop;
  257.     property OnDragOver;
  258.     property OnDropDown;
  259.     property OnEndDrag;
  260.     property OnEnter;
  261.     property OnExit;
  262.     property OnKeyDown;
  263.     property OnKeyPress;
  264.     property OnKeyUp;
  265.     property OnStartDrag;
  266.   end;
  267.  
  268. { TFilterComboBox }
  269.  
  270.   TFilterComboBox = class(TCustomComboBox)
  271.   private
  272.     FFilter: string;
  273.     FFileList: TFileListBox;
  274.     MaskList: TStringList;
  275.     function IsFilterStored: Boolean;
  276.     function GetMask: string;
  277.     procedure SetFilter(const NewFilter: string);
  278.     procedure SetFileListBox (Value: TFileListBox);
  279.   protected
  280.     FOnChange: TNotifyEvent;
  281.     procedure CreateWnd; override;
  282.     procedure Click; override;
  283.     procedure BuildList;
  284.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  285.     procedure Change; dynamic;
  286.   public
  287.     constructor Create(AOwner: TComponent); override;
  288.     destructor Destroy; override;
  289.     property Mask: string read GetMask;
  290.     property Text;
  291.   published
  292.     property Color;
  293.     property Ctl3D;
  294.     property DragMode;
  295.     property DragCursor;
  296.     property Enabled;
  297.     property FileList: TFileListBox read FFileList write SetFileListBox;
  298.     property Filter: string read FFilter write SetFilter stored IsFilterStored;
  299.     property Font;
  300.     property ParentColor;
  301.     property ParentCtl3D;
  302.     property ParentFont;
  303.     property ParentShowHint;
  304.     property PopupMenu;
  305.     property ShowHint;
  306.     property TabOrder;
  307.     property TabStop;
  308.     property Visible;
  309.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  310.     property OnClick;
  311.     property OnDblClick;
  312.     property OnDragDrop;
  313.     property OnDragOver;
  314.     property OnDropDown;
  315.     property OnEndDrag;
  316.     property OnEnter;
  317.     property OnExit;
  318.     property OnKeyDown;
  319.     property OnKeyPress;
  320.     property OnKeyUp;
  321.     property OnStartDrag;
  322.   end;
  323.  
  324. procedure ProcessPath (const EditText: string; var Drive: Char;
  325.   var DirPart: string; var FilePart: string);
  326.  
  327. function MinimizeName(const Filename: TFileName; Canvas: TCanvas;
  328.   MaxLen: Integer): TFileName;
  329.  
  330. const
  331.   WNTYPE_DRIVE = 1;  { from WINNET.H, WFW 3.1 SDK }
  332.  
  333. type
  334.   TSelectDirOpt = (sdAllowCreate, sdPerformCreate, sdPrompt);
  335.   TSelectDirOpts = set of TSelectDirOpt;
  336.  
  337. function SelectDirectory(var Directory: string;
  338.   Options: TSelectDirOpts; HelpCtx: Longint): Boolean;
  339. function DirectoryExists(const Name: string): Boolean;
  340. procedure ForceDirectories(Dir: string);
  341.  
  342. implementation
  343.  
  344. uses Consts, Dialogs;
  345.  
  346. {$R FileCtrl}
  347.  
  348. type
  349.  
  350.   TPathLabel = class(TCustomLabel)
  351.   protected
  352.     procedure Paint; override;
  353.   public
  354.     constructor Create(AnOwner: TComponent); override;
  355.   published
  356.     property Alignment;
  357.     property Transparent;
  358.   end;
  359.  
  360. { TSelectDirDlg }
  361.   TSelectDirDlg = class(TForm)
  362.     DirList: TDirectoryListBox;
  363.     DirEdit: TEdit;
  364.     DriveList: TDriveComboBox;
  365.     DirLabel: TPathLabel;
  366.     OKButton: TButton;
  367.     Button2: TButton;
  368.     NetButton: TButton;
  369.     FileList: TFileListBox;
  370.     BitBtn1: TBitBtn;
  371.     procedure DirListChange(Sender: TObject);
  372.     procedure FormCreate(Sender: TObject);
  373.     procedure DriveListChange(Sender: TObject);
  374.     procedure NetClick(Sender: TObject);
  375.     procedure OKClick(Sender: TObject);
  376.     procedure HelpButtonClick(Sender: TObject);
  377.   private
  378.     { Private declarations }
  379.     FAllowCreate: Boolean;
  380.     FPrompt: Boolean;
  381.     WNetConnectDialog: function (WndParent: HWND; IType: Longint): Longint;
  382.     procedure SetAllowCreate(Value: Boolean);
  383.     procedure SetDirectory(const Value: string);
  384.     function GetDirectory: string;
  385.   public
  386.     { Public declarations }
  387.     constructor Create(AOwner: TComponent);
  388.     property Directory: string read GetDirectory write SetDirectory;
  389.     property AllowCreate: Boolean read FAllowCreate write SetAllowCreate default False;
  390.     property Prompt: Boolean read FPrompt write FPrompt default False;
  391.   end;
  392.  
  393. const
  394.   Slashes: array [False..True] of PChar = ('','\');
  395.  
  396. function SlashSep(const Path, S: String): String;
  397. begin
  398.   Result := Format('%s%s%s',[Path, Slashes[Path[Length(Path)] <> '\'], S]);
  399. end;
  400.  
  401. { TPathLabel }
  402.  
  403. constructor TPathLabel.Create(AnOwner: TComponent);
  404. begin
  405.   inherited Create(AnOwner);
  406.   WordWrap := False;
  407.   AutoSize := False;
  408.   ShowAccelChar := False;
  409. end;
  410.  
  411. procedure TPathLabel.Paint;
  412. const
  413.   Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  414. var
  415.   Rect: TRect;
  416.   Temp: String;
  417. begin
  418.   with Canvas do
  419.   begin
  420.     Rect := ClientRect;
  421.     if not Transparent then
  422.     begin
  423.       Brush.Color := Self.Color;
  424.       Brush.Style := bsSolid;
  425.       FillRect(Rect);
  426.     end;
  427.     Brush.Style := bsClear;
  428.     Temp := MinimizeName(Caption, Canvas, Rect.Right - Rect.Left);
  429.     DrawText(Canvas.Handle, PChar(Temp), Length(Temp), Rect,
  430.       DT_NOPREFIX or Alignments[Alignment]);
  431.   end;
  432. end;
  433.  
  434. { TDriveComboBox }
  435.  
  436. procedure CutFirstDirectory(var S: TFileName);
  437. var
  438.   Root: Boolean;
  439.   P: Integer;
  440. begin
  441.   if S = '\' then
  442.     S := ''
  443.   else
  444.   begin
  445.     if S[1] = '\' then
  446.     begin
  447.       Root := True;
  448.       Delete(S, 1, 1);
  449.     end
  450.     else
  451.       Root := False;
  452.     if S[1] = '.' then
  453.       Delete(S, 1, 4);
  454.     P := Pos('\',S);
  455.     if P <> 0 then
  456.     begin
  457.       Delete(S, 1, P);
  458.       S := '...\' + S;
  459.     end
  460.     else
  461.       S := '';
  462.     if Root then
  463.       S := '\' + S;
  464.   end;
  465. end;
  466.  
  467. function MinimizeName(const Filename: TFileName; Canvas: TCanvas;
  468.   MaxLen: Integer): TFileName;
  469. var
  470.   Drive: TFileName;
  471.   Dir: TFileName;
  472.   Name: TFileName;
  473. begin
  474.   Result := FileName;
  475.   Dir := ExtractFilePath(Result);
  476.   Name := ExtractFileName(Result);
  477.  
  478.   if (Length(Dir) >= 2) and (Dir[2] = ':') then
  479.   begin
  480.     Drive := Copy(Dir, 1, 2);
  481.     Delete(Dir, 1, 2);
  482.   end
  483.   else
  484.     Drive := '';
  485.   while ((Dir <> '') or (Drive <> '')) and (Canvas.TextWidth(Result) > MaxLen) do
  486.   begin
  487.     if Dir = '\...\' then
  488.     begin
  489.       Drive := '';
  490.       Dir := '...\';
  491.     end
  492.     else if Dir = '' then
  493.       Drive := ''
  494.     else
  495.       CutFirstDirectory(Dir);
  496.     Result := Drive + Dir + Name;
  497.   end;
  498. end;
  499.  
  500. function VolumeID(DriveChar: Char): string;
  501. var
  502.   OldErrorMode: Integer;
  503.   NotUsed, VolFlags: Integer;
  504.   Buf: array [0..MAX_PATH] of Char;
  505. begin
  506.   OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  507.   try
  508.     GetVolumeInformation(PChar(DriveChar + ':\'), Buf, sizeof(Buf),
  509.       nil, NotUsed, VolFlags, nil, 0);
  510.     SetString(Result, Buf, StrLen(Buf));
  511.     if DriveChar < 'a' then
  512.       Result := AnsiUpperCase(Result)
  513.     else
  514.       Result := AnsiLowerCase(Result);
  515.     Result := Format('[%s]',[Result]);
  516.   finally
  517.     SetErrorMode(OldErrorMode);
  518.   end;
  519. end;
  520.  
  521. function NetworkVolume(DriveChar: Char): string;
  522. var
  523.   Buf: Array [0..MAX_PATH] of Char;
  524.   DriveStr: array [0..3] of Char;
  525.   BufferSize: Integer;
  526. begin
  527.   BufferSize := sizeof(Buf);
  528.   DriveStr[0] := DriveChar;
  529.   DriveStr[1] := ':';
  530.   DriveStr[2] := #0;
  531.   if WNetGetConnection(DriveStr, Buf, BufferSize) = WN_SUCCESS then
  532.   begin
  533.     SetString(Result, Buf, BufferSize);
  534.     if DriveChar < 'a' then
  535.       Result := AnsiUpperCase(Result)
  536.     else
  537.       Result := AnsiLowerCase(Result);
  538.   end
  539.   else
  540.     Result := VolumeID(DriveChar);
  541. end;
  542.  
  543. procedure ProcessPath (const EditText: string; var Drive: Char;
  544.   var DirPart: string; var FilePart: string);
  545. var
  546.   SaveDir: string;
  547.   Root: String;
  548. begin
  549.   GetDir(0, SaveDir);
  550.   Drive := SaveDir[1];
  551.   DirPart := EditText;
  552.   if (DirPart[1] = '[') and (DirPart[Length(DirPart)] = ']') then
  553.     DirPart := Copy(DirPart, 2, Length(DirPart) - 2)
  554.   else
  555.   begin
  556.     Root := ExtractFileDrive(DirPart);
  557.     if Length(Root) = 0 then
  558.       Root := ExtractFileDrive(SaveDir)
  559.     else
  560.       Delete(DirPart, 1, Length(Root));
  561.     if (Length(Root) >= 2) and (Root[2] = ':') then
  562.       Drive := Root[1]
  563.     else
  564.       Drive := #0;
  565.   end;
  566.  
  567.   try
  568.     ChDir(Root);
  569.     FilePart := ExtractFileName (DirPart);
  570.     if Length(DirPart) = (Length(FilePart) + 1) then
  571.       DirPart := '\'
  572.     else if Length(DirPart) > Length(FilePart) then
  573.       SetLength(DirPart, Length(DirPart) - Length(FilePart) - 1)
  574.     else
  575.     begin
  576.       GetDir(0, DirPart);
  577.       Delete(DirPart, 1, Length(ExtractFileDrive(DirPart)));
  578.       if Length(DirPart) = 0 then
  579.         DirPart := '\';
  580.     end;
  581.     if Length(DirPart) > 0 then
  582.       ChDir (DirPart);  {first go to our new directory}
  583.     if (Length(FilePart) > 0) and not
  584.        (((Pos('*', FilePart) > 0) or (Pos('?', FilePart) > 0)) or
  585.        FileExists(FilePart)) then
  586.     begin
  587.       ChDir(FilePart);
  588.       if Length(DirPart) = 1 then
  589.         DirPart := '\' + FilePart
  590.       else
  591.         DirPart := DirPart + '\' + FilePart;
  592.       FilePart := '';
  593.     end;
  594.     if Drive = #0 then
  595.       DirPart := Root + DirPart;
  596.   finally
  597.     ChDir(SaveDir);  { restore original directory }
  598.   end;
  599. end;
  600.  
  601. function GetItemHeight(Font: TFont): Integer;
  602. var
  603.   DC: HDC;
  604.   SaveFont: HFont;
  605.   Metrics: TTextMetric;
  606. begin
  607.   DC := GetDC(0);
  608.   SaveFont := SelectObject(DC, Font.Handle);
  609.   GetTextMetrics(DC, Metrics);
  610.   SelectObject(DC, SaveFont);
  611.   ReleaseDC(0, DC);
  612.   Result := Metrics.tmHeight;
  613. end;
  614.  
  615. { TDriveComboBox }
  616.  
  617. constructor TDriveComboBox.Create(AOwner: TComponent);
  618. var
  619.   Temp: ShortString;
  620. begin
  621.   inherited Create(AOwner);
  622.   Style := csOwnerDrawFixed;
  623.   ReadBitmaps;
  624.   GetDir(0, Temp);
  625.   FDrive := Temp[1]; { make default drive selected }
  626.   if FDrive = '\' then FDrive := #0;
  627.   ResetItemHeight;
  628. end;
  629.  
  630. destructor TDriveComboBox.Destroy;
  631. begin
  632.   FloppyBMP.Free;
  633.   FixedBMP.Free;
  634.   NetworkBMP.Free;
  635.   CDROMBMP.Free;
  636.   RAMBMP.Free;
  637.   inherited Destroy;
  638. end;
  639.  
  640. procedure TDriveComboBox.BuildList;
  641. var
  642.   DriveNum: Integer;
  643.   DriveChar: Char;
  644.   DriveType: TDriveType;
  645.   DriveBits: set of 0..25;
  646.  
  647.   procedure AddDrive(const VolName: string; Obj: TObject);
  648.   begin
  649.     Items.AddObject(Format('%s: %s',[DriveChar, VolName]), Obj);
  650.   end;
  651.  
  652. begin
  653.   { fill list }
  654.   Clear;
  655.   Integer(DriveBits) := GetLogicalDrives;
  656.   for DriveNum := 0 to 25 do
  657.   begin
  658.     if not (DriveNum in DriveBits) then Continue;
  659.     DriveChar := Char(DriveNum + Ord('a'));
  660.     DriveType := TDriveType(GetDriveType(PChar(DriveChar + ':\')));
  661.     if TextCase = tcUpperCase then
  662.       DriveChar := Upcase(DriveChar);
  663.  
  664.     case DriveType of
  665.       dtFloppy:   Items.AddObject(DriveChar + ':', FloppyBMP);
  666.       dtFixed:    AddDrive(VolumeID(DriveChar), FixedBMP);
  667.       dtNetwork:  AddDrive(NetworkVolume(DriveChar), NetworkBMP);
  668.       dtCDROM:    AddDrive(VolumeID(DriveChar), CDROMBMP);
  669.       dtRAM:      AddDrive(VolumeID(DriveChar), RAMBMP);
  670.     end;
  671.   end;
  672. end;
  673.  
  674. procedure TDriveComboBox.SetDrive(NewDrive: Char);
  675. var
  676.   Item: Integer;
  677.   drv: string;
  678. begin
  679.   if (ItemIndex < 0) or (UpCase(NewDrive) <> UpCase(FDrive)) then
  680.   begin
  681.     if NewDrive = #0 then
  682.     begin
  683.       FDrive := NewDrive;
  684.       ItemIndex := -1;
  685.     end
  686.     else
  687.     begin
  688.       if TextCase = tcUpperCase then
  689.         FDrive := UpCase(NewDrive)
  690.       else
  691.         FDrive := Chr(ord(UpCase(NewDrive)) + 32);
  692.  
  693.       { change selected item }
  694.       for Item := 0 to Items.Count - 1 do
  695.       begin
  696.         drv := Items[Item];
  697.         if (UpCase(drv[1]) = UpCase(FDrive)) and (drv[2] = ':') then
  698.         begin
  699.           ItemIndex := Item;
  700.           break;
  701.         end;
  702.       end;
  703.     end;
  704.     if FDirList <> nil then FDirList.DriveChange(Drive);
  705.     Change;
  706.   end;
  707. end;
  708.  
  709. procedure TDriveComboBox.SetTextCase(NewTextCase: TTextCase);
  710. var
  711.   OldDrive: Char;
  712. begin
  713.   FTextCase := NewTextCase;
  714.   OldDrive := FDrive;
  715.   BuildList;
  716.   SetDrive (OldDrive);
  717. end;
  718.  
  719. procedure TDriveComboBox.SetDirListBox (Value: TDirectoryListBox);
  720. begin
  721.   if FDirList <> nil then FDirList.FDriveCombo := nil;
  722.   FDirList := Value;
  723.   if FDirList <> nil then
  724.   begin
  725.     FDirList.FDriveCombo := Self;
  726.     FDirList.FreeNotification(Self);
  727.   end;
  728. end;
  729.  
  730. procedure TDriveComboBox.CreateWnd;
  731. begin
  732.   inherited CreateWnd;
  733.   BuildList;
  734.   SetDrive (FDrive);
  735. end;
  736.  
  737. procedure TDriveComboBox.DrawItem(Index: Integer; Rect: TRect;
  738.   State: TOwnerDrawState);
  739. var
  740.   Bitmap: TBitmap;
  741.   bmpWidth: Integer;
  742. begin
  743.   with Canvas do
  744.   begin
  745.     FillRect(Rect);
  746.     bmpWidth  := 16;
  747.     Bitmap := TBitmap(Items.Objects[Index]);
  748.     if Bitmap <> nil then
  749.     begin
  750.       bmpWidth := Bitmap.Width;
  751.       BrushCopy(Bounds(Rect.Left + 2,
  752.                (Rect.Top + Rect.Bottom - Bitmap.Height) div 2,
  753.                Bitmap.Width, Bitmap.Height),
  754.                Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height),
  755.                Bitmap.Canvas.Pixels[0, Bitmap.Height - 1]);
  756.     end;
  757.      { uses DrawText instead of TextOut in order to get clipping against
  758.        the combo box button   }
  759.     Rect.Left := Rect.Left + bmpWidth + 6;
  760.     DrawText(Canvas.Handle, PChar(Items[Index]), -1, Rect,
  761.              DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
  762.   end;
  763. end;
  764.  
  765. procedure TDriveComboBox.Click;
  766. begin
  767.   inherited Click;
  768.   if ItemIndex >= 0 then
  769.     Drive := Items[ItemIndex][1];
  770. end;
  771.  
  772. procedure TDriveComboBox.CMFontChanged(var Message: TMessage);
  773. begin
  774.   inherited;
  775.   ResetItemHeight;
  776.   RecreateWnd;
  777. end;
  778.  
  779. procedure TDriveComboBox.ResetItemHeight;
  780. var
  781.   nuHeight: Integer;
  782. begin
  783.   nuHeight :=  GetItemHeight(Font);
  784.   if nuHeight < (FloppyBMP.Height) then nuHeight := FloppyBmp.Height;
  785.   ItemHeight := nuHeight;
  786. end;
  787.  
  788. procedure TDriveComboBox.ReadBitmaps;
  789. begin
  790.   { assign bitmap glyphs }
  791.   FloppyBMP := TBitmap.Create;
  792.   FloppyBMP.Handle := LoadBitmap(HInstance, 'FLOPPY');
  793.   FixedBMP := TBitmap.Create;
  794.   FixedBMP.Handle := LoadBitmap(HInstance, 'HARD');
  795.   NetworkBMP := TBitmap.Create;
  796.   NetworkBMP.Handle := LoadBitmap(HInstance, 'NETWORK');
  797.   CDROMBMP := TBitmap.Create;
  798.   CDROMBMP.Handle := LoadBitmap(HInstance, 'CDROM');
  799.   RAMBMP := TBitmap.Create;
  800.   RAMBMP.Handle := LoadBitmap(HInstance, 'RAM');
  801. end;
  802.  
  803. procedure TDriveComboBox.Notification(AComponent: TComponent;
  804.   Operation: TOperation);
  805. begin
  806.   inherited Notification(AComponent, Operation);
  807.   if (Operation = opRemove) and (AComponent = FDirList) then
  808.     FDirList := nil;
  809. end;
  810.  
  811. procedure TDriveComboBox.Change;
  812. begin
  813.   if Assigned(FOnChange) then FOnChange(Self);
  814. end;
  815.  
  816. { TDirectoryListBox }
  817.  
  818. function DirLevel(const PathName: string): Integer;  { counts '\' in path }
  819. var
  820.   I: Integer;
  821. begin
  822.   Result := 0;
  823.   for I := 1 to Length(PathName) do
  824.     if PathName[I] = '\' then Inc (Result);
  825. end;
  826.  
  827. constructor TFolderBitmap.Create;
  828. begin
  829.   inherited Create;
  830.   Width := 16;
  831.   Height := 16;
  832. end;
  833.  
  834. constructor TDirectoryListBox.Create(AOwner: TComponent);
  835. begin
  836.   inherited Create(AOwner);
  837.   Width := 145;
  838.   Style := lbOwnerDrawFixed;
  839.   Sorted := False;
  840.   ReadBitmaps;
  841.   GetDir(0, FDirectory); { initially use current dir on default drive }
  842.   ResetItemHeight;
  843. end;
  844.  
  845. destructor TDirectoryListBox.Destroy;
  846. begin
  847.   ClosedBMP.Free;
  848.   OpenedBMP.Free;
  849.   CurrentBMP.Free;
  850.   inherited Destroy;
  851. end;
  852.  
  853. procedure TDirectoryListBox.DriveChange(NewDrive: Char);
  854. begin
  855.   if (UpCase(NewDrive) <> UpCase(Drive)) then
  856.   begin
  857.     if NewDrive <> #0 then
  858.     begin
  859.       ChDir(NewDrive + ':');
  860.       GetDir(0, FDirectory);  { store correct directory name }
  861.     end;
  862.     if not FInSetDir then
  863.     begin
  864.       BuildList;
  865.       Change;
  866.     end;
  867.   end;
  868. end;
  869.  
  870. procedure TDirectoryListBox.SetFileListBox (Value: TFileListBox);
  871. begin
  872.   if FFileList <> nil then FFileList.FDirList := nil;
  873.   FFileList := Value;
  874.   if FFileList <> nil then
  875.   begin
  876.     FFileList.FDirList := Self;
  877.     FFileList.FreeNotification(Self);
  878.   end;
  879. end;
  880.  
  881. procedure TDirectoryListBox.SetDirLabel (Value: TLabel);
  882. begin
  883.   FDirLabel := Value;
  884.   if Value <> nil then Value.FreeNotification(Self);
  885.   SetDirLabelCaption;
  886. end;
  887.  
  888. procedure TDirectoryListBox.SetDir(const NewDirectory: string);
  889. begin
  890.      { go to old directory first, in case of incomplete pathname
  891.        and curdir changed - probably not necessary }
  892.   {$I-}  // ignore errors
  893.   ChDir(FDirectory);
  894.   {$I+}
  895.   if IOResult = 0 then ;
  896.  
  897.   ChDir(NewDirectory);     { exception raised if invalid dir }
  898.   GetDir(0, FDirectory);   { store correct directory name }
  899.   BuildList;
  900.   Change;
  901. end;
  902.  
  903. procedure TDirectoryListBox.OpenCurrent;
  904. begin
  905.   Directory := GetItemPath(ItemIndex);
  906. end;
  907.  
  908. procedure TDirectoryListBox.Update;
  909. begin
  910.   BuildList;
  911.   Change;
  912. end;
  913.  
  914. function TDirectoryListBox.DisplayCase(const S: String): String;
  915. begin
  916.   if FPreserveCase or FCaseSensitive then
  917.     Result := S
  918.   else
  919.     Result := AnsiLowerCase(S);
  920. end;
  921.  
  922. function TDirectoryListBox.FileCompareText(const A,B: String): Integer;
  923. begin
  924.   if FCaseSensitive then
  925.     Result := AnsiCompareStr(A,B)
  926.   else
  927.     Result := AnsiCompareText(A,B);
  928. end;
  929.  
  930.   {
  931.     Reads all directories in ParentDirectory, adds their paths to
  932.     DirectoryList,and returns the number added
  933.   }
  934. function TDirectoryListbox.ReadDirectoryNames(const ParentDirectory: string;
  935.   DirectoryList: TStringList): Integer;
  936. var
  937.   Status: Integer;
  938.   SearchRec: TSearchRec;
  939. begin
  940.   Result := 0;
  941.   Status := FindFirst(SlashSep(ParentDirectory, '*.*'), faDirectory, SearchRec);
  942.   try
  943.     while Status = 0 do
  944.     begin
  945.       if (SearchRec.Attr and faDirectory = faDirectory) then
  946.       begin
  947.         if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
  948.         begin
  949.           DirectoryList.Add(SearchRec.Name);
  950.           Inc(Result);
  951.         end;
  952.       end;
  953.       Status := FindNext(SearchRec);
  954.     end;
  955.   finally
  956.     FindClose(SearchRec);
  957.   end;
  958. end;
  959.  
  960. procedure TDirectoryListBox.BuildList;
  961. var
  962.   TempPath: string;
  963.   DirName: string;
  964.   IndentLevel, BackSlashPos, i, VolFlags: Integer;
  965.   Siblings: TStringList;
  966.   NewSelect: Integer;
  967.   Root: String;
  968. begin
  969.   try
  970.     Items.BeginUpdate;
  971.     Items.Clear;
  972.     IndentLevel := 0;
  973.     Root := ExtractFileDrive(Directory)+'\';
  974.     GetVolumeInformation(PChar(Root), nil, 0, nil, i, VolFlags, nil, 0);
  975.     FPreserveCase := VolFlags and (FS_CASE_IS_PRESERVED or FS_CASE_SENSITIVE) <> 0;
  976.     FCaseSensitive := (VolFlags and FS_CASE_SENSITIVE) <> 0;
  977.     if (Length(Root) >= 2) and (Root[2] = '\') then
  978.     begin
  979.       Items.AddObject(Root, OpenedBMP);
  980.       Inc(IndentLevel);
  981.       TempPath := Copy(Directory, Length(Root)+1, Length(Directory));
  982.     end
  983.     else
  984.       TempPath := Directory;
  985.     if (Length(TempPath) > 0) then
  986.     begin
  987.       if TempPath[Length(TempPath)] <> '\' then
  988.       begin
  989.         BackSlashPos := Pos('\', TempPath);
  990.         while BackSlashPos <> 0 do
  991.         begin
  992.           DirName := Copy(TempPath, 1, BackSlashPos - 1);
  993.           if IndentLevel = 0 then DirName := DirName + '\';
  994.           Delete(TempPath, 1, BackSlashPos);
  995.           Items.AddObject(DirName, OpenedBMP);
  996.           Inc(IndentLevel);
  997.           BackSlashPos := Pos('\', TempPath);
  998.         end;
  999.       end;
  1000.       Items.AddObject(TempPath, CurrentBMP);
  1001.     end;
  1002.     NewSelect := Items.Count - 1;
  1003.     Siblings := TStringList.Create;
  1004.     try
  1005.       Siblings.Sorted := True;
  1006.         { read all the dir names into Siblings }
  1007.       ReadDirectoryNames(Directory, Siblings);
  1008.       for i := 0 to Siblings.Count - 1 do
  1009.         Items.AddObject(Siblings[i], ClosedBMP);
  1010.     finally
  1011.       Siblings.Free;
  1012.     end;
  1013.   finally
  1014.     Items.EndUpdate;
  1015.   end;
  1016.   if HandleAllocated then
  1017.     ItemIndex := NewSelect;
  1018. end;
  1019.  
  1020. procedure TDirectoryListBox.ReadBitmaps;
  1021. begin
  1022.   OpenedBMP := TFolderBitmap.Create;
  1023.   OpenedBMP.Handle := LoadBitmap(HInstance, 'OPENFOLDER');
  1024.   ClosedBMP := TFolderBitmap.Create;
  1025.   ClosedBMP.Handle := LoadBitmap(HInstance, 'CLOSEDFOLDER');
  1026.   CurrentBMP := TFolderBitmap.Create;
  1027.   CurrentBMP.Handle := LoadBitmap(HInstance, 'CURRENTFOLDER');
  1028. end;
  1029.  
  1030. procedure TDirectoryListBox.DblClick;
  1031. begin
  1032.   inherited DblClick;
  1033.   OpenCurrent;
  1034. end;
  1035.  
  1036. procedure TDirectoryListBox.Change;
  1037. begin
  1038.   if FFileList <> nil then FFileList.SetDirectory(Directory);
  1039.   SetDirLabelCaption;
  1040.   if Assigned(FOnChange) then FOnChange(Self);
  1041. end;
  1042.  
  1043. procedure TDirectoryListBox.DrawItem(Index: Integer; Rect: TRect;
  1044.   State: TOwnerDrawState);
  1045. var
  1046.   Bitmap: TBitmap;
  1047.   bmpWidth: Integer;
  1048.   dirOffset: Integer;
  1049. begin
  1050.   with Canvas do
  1051.   begin
  1052.     FillRect(Rect);
  1053.     bmpWidth  := 16;
  1054.     dirOffset := Index * 4 + 2;    {add 2 for spacing}
  1055.  
  1056.     Bitmap := TBitmap(Items.Objects[Index]);
  1057.     if Bitmap <> nil then
  1058.     begin
  1059.       if Bitmap = ClosedBMP then
  1060.         dirOffset := (DirLevel (Directory) + 1) * 4 + 2;
  1061.  
  1062.       bmpWidth := Bitmap.Width;
  1063.       BrushCopy(Bounds(Rect.Left + dirOffset,
  1064.                (Rect.Top + Rect.Bottom - Bitmap.Height) div 2,
  1065.                Bitmap.Width, Bitmap.Height),
  1066.                Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height),
  1067.                Bitmap.Canvas.Pixels[0, Bitmap.Height - 1]);
  1068.     end;
  1069.     TextOut(Rect.Left + bmpWidth + dirOffset + 4, Rect.Top, DisplayCase(Items[Index]))
  1070.   end;
  1071. end;
  1072.  
  1073. function TDirectoryListBox.GetItemPath (Index: Integer): string;
  1074. var
  1075.   CurDir: string;
  1076.   i, j: Integer;
  1077.   Bitmap: TBitmap;
  1078. begin
  1079.   Result := '';
  1080.   if Index < Items.Count then
  1081.   begin
  1082.     CurDir := Directory;
  1083.     Bitmap := TBitmap(Items.Objects[Index]);
  1084.     if Index = 0 then
  1085.       Result := ExtractFileDrive(CurDir)+'\'
  1086.     else if Bitmap = ClosedBMP then
  1087.       Result := SlashSep(CurDir,Items[Index])
  1088.     else if Bitmap = CurrentBMP then
  1089.       Result := CurDir
  1090.     else
  1091.     begin
  1092.       i   := 0;
  1093.       j   := 0;
  1094.       Delete(CurDir, 1, Length(ExtractFileDrive(CurDir)));
  1095.       while j <> (Index + 1) do
  1096.       begin
  1097.         Inc(i);
  1098.         if i > Length (CurDir) then
  1099.            break;
  1100.         if CurDir[i] = '\' then
  1101.            Inc(j);
  1102.       end;
  1103.       Result := Copy(CurDir, 1, i - 1);
  1104.     end;
  1105.   end;
  1106. end;
  1107.  
  1108. procedure TDirectoryListBox.CreateWnd;
  1109. begin
  1110.   inherited CreateWnd;
  1111.   BuildList;
  1112.   ItemIndex := DirLevel (Directory);
  1113. end;
  1114.  
  1115. procedure TDirectoryListBox.CMFontChanged(var Message: TMessage);
  1116. begin
  1117.   inherited;
  1118.   ResetItemHeight;
  1119. end;
  1120.  
  1121. procedure TDirectoryListBox.ResetItemHeight;
  1122. var
  1123.   nuHeight: Integer;
  1124. begin
  1125.   nuHeight :=  GetItemHeight(Font);
  1126.   if nuHeight < (OpenedBMP.Height + 1) then nuHeight := OpenedBmp.Height + 1;
  1127.   ItemHeight := nuHeight;
  1128. end;
  1129.  
  1130. function TDirectoryListBox.GetDrive: char;
  1131. begin
  1132.   Result := FDirectory[1];
  1133. end;
  1134.  
  1135. procedure TDirectoryListBox.SetDrive(Value: char);
  1136. begin
  1137.   if (UpCase(Value) <> UpCase(Drive)) then
  1138.     SetDirectory (Format ('%s:', [Value]));
  1139. end;
  1140.  
  1141. procedure TDirectoryListBox.SetDirectory(const NewDirectory: string);
  1142. var
  1143.   DirPart: string;
  1144.   FilePart: string;
  1145.   NewDrive: Char;
  1146. begin
  1147.   if Length (NewDirectory) = 0 then Exit;
  1148.   if (FileCompareText(NewDirectory, Directory) = 0) then Exit;
  1149.   ProcessPath (NewDirectory, NewDrive, DirPart, FilePart);
  1150.   try
  1151.     if Drive <> NewDrive then
  1152.     begin
  1153.       FInSetDir := True;
  1154.       if (FDriveCombo <> nil) then
  1155.         FDriveCombo.Drive := NewDrive
  1156.       else
  1157.         DriveChange(NewDrive);
  1158.     end;
  1159.   finally
  1160.     FInSetDir := False;
  1161.   end;
  1162.   SetDir(DirPart);
  1163. end;
  1164.  
  1165. procedure TDirectoryListBox.KeyPress(var Key: Char);
  1166. begin
  1167.   inherited KeyPress(Key);
  1168.   if (Word(Key) = VK_RETURN) then
  1169.     OpenCurrent;
  1170. end;
  1171.  
  1172. procedure TDirectoryListBox.Notification(AComponent: TComponent;
  1173.   Operation: TOperation);
  1174. begin
  1175.   inherited Notification(AComponent, Operation);
  1176.   if (Operation = opRemove) then
  1177.   begin
  1178.     if (AComponent = FFileList) then FFileList := nil
  1179.     else if (AComponent = FDriveCombo) then FDriveCombo := nil
  1180.     else if (AComponent = FDirLabel) then FDirLabel := nil;
  1181.   end;
  1182. end;
  1183.  
  1184. procedure TDirectoryListBox.SetDirLabelCaption;
  1185. var
  1186.   DirWidth: Integer;
  1187. begin
  1188.   if FDirLabel <> nil then
  1189.   begin
  1190.     DirWidth := Width;
  1191.     if not FDirLabel.AutoSize then DirWidth := FDirLabel.Width;
  1192.     FDirLabel.Caption := MinimizeName(Directory, FDirLabel.Canvas, DirWidth);
  1193.   end;
  1194. end;
  1195.  
  1196. { TFileListBox }
  1197.  
  1198. const
  1199.   DefaultMask = '*.*';
  1200.  
  1201. constructor TFileListBox.Create(AOwner: TComponent);
  1202. begin
  1203.   inherited Create(AOwner);
  1204.   Width := 145;
  1205. {  IntegralHeight := True; }
  1206.   FFileType := [ftNormal]; { show only normal files by default }
  1207.   GetDir(0, FDirectory); { initially use current dir on default drive }
  1208.  
  1209.   FMask := DefaultMask;  { default file mask is all }
  1210.   MultiSelect := False;    { default is not multi-select }
  1211.   FLastSel := -1;
  1212.   ReadBitmaps;
  1213.   Sorted := True;
  1214.   Style := lbOwnerDrawFixed;
  1215.   ResetItemHeight;
  1216. end;
  1217.  
  1218. destructor TFileListBox.Destroy;
  1219. begin
  1220.   ExeBMP.Free;
  1221.   DirBMP.Free;
  1222.   UnknownBMP.Free;
  1223.   inherited Destroy;
  1224. end;
  1225.  
  1226. procedure TFileListBox.Update;
  1227. begin
  1228.   ReadFileNames;
  1229. end;
  1230.  
  1231. procedure TFileListBox.CreateWnd;
  1232. begin
  1233.   inherited CreateWnd;
  1234.   ReadFileNames;
  1235. end;
  1236.  
  1237. function TFileListBox.IsMaskStored: Boolean;
  1238. begin
  1239.   Result := DefaultMask <> FMask;
  1240. end;
  1241.  
  1242. function TFileListBox.GetDrive: char;
  1243. begin
  1244.   Result := FDirectory[1];
  1245. end;
  1246.  
  1247. procedure TFileListBox.ReadBitmaps;
  1248. begin
  1249.   ExeBMP := TBitmap.Create;
  1250.   ExeBMP.Handle := LoadBitmap(HInstance, 'EXECUTABLE');
  1251.   DirBMP := TBitmap.Create;
  1252.   DirBMP.Handle := LoadBitmap(HInstance, 'CLOSEDFOLDER');
  1253.   UnknownBMP := TBitmap.Create;
  1254.   UnknownBMP.Handle := LoadBitmap(HInstance, 'UNKNOWNFILE');
  1255. end;
  1256.  
  1257. procedure TFileListBox.ReadFileNames;
  1258. var
  1259.   AttrIndex: TFileAttr;
  1260.   I: Integer;
  1261.   FileExt: string;
  1262.   MaskPtr: PChar;
  1263.   Ptr: PChar;
  1264.   AttrWord: Word;
  1265.   FileInfo: TSearchRec;
  1266.   SaveCursor: TCursor;
  1267.   Glyph: TBitmap;
  1268. const
  1269.    Attributes: array[TFileAttr] of Word = (faReadOnly, faHidden, faSysFile,
  1270.      faVolumeID, faDirectory, faArchive, 0);
  1271. begin
  1272.       { if no handle allocated yet, this call will force
  1273.         one to be allocated incorrectly (i.e. at the wrong time.
  1274.         In due time, one will be allocated appropriately.  }
  1275.   AttrWord := DDL_READWRITE;
  1276.   if HandleAllocated then
  1277.   begin
  1278.     { Set attribute flags based on values in FileType }
  1279.     for AttrIndex := ftReadOnly to ftArchive do
  1280.       if AttrIndex in FileType then
  1281.         AttrWord := AttrWord or Attributes[AttrIndex];
  1282.  
  1283.     ChDir(FDirectory); { go to the directory we want }
  1284.     Clear; { clear the list }
  1285.  
  1286.     I := 0;
  1287.     SaveCursor := Screen.Cursor;
  1288.     try
  1289.       MaskPtr := PChar(FMask);
  1290.       while MaskPtr <> nil do
  1291.       begin
  1292.         Ptr := StrScan (MaskPtr, ';');
  1293.         if Ptr <> nil then
  1294.           Ptr^ := #0;
  1295.         if FindFirst(MaskPtr, AttrWord, FileInfo) = 0 then
  1296.         begin
  1297.           repeat            { exclude normal files if ftNormal not set }
  1298.             if (ftNormal in FileType) or (FileInfo.Attr and AttrWord <> 0) then
  1299.               if FileInfo.Attr and faDirectory <> 0 then
  1300.               begin
  1301.                 I := Items.Add(Format('[%s]',[FileInfo.Name]));
  1302.                 if ShowGlyphs then
  1303.                   Items.Objects[I] := DirBMP;
  1304.               end
  1305.               else
  1306.               begin
  1307.                 FileExt := AnsiLowerCase(ExtractFileExt(FileInfo.Name));
  1308.                 Glyph := UnknownBMP;
  1309.                 if (FileExt = '.exe') or (FileExt = '.com') or
  1310.                   (FileExt = '.bat') or (FileExt = '.pif') then
  1311.                   Glyph := ExeBMP;
  1312.                 I := Items.AddObject(FileInfo.Name, Glyph);
  1313.               end;
  1314.             if I = 100 then
  1315.               Screen.Cursor := crHourGlass;
  1316.           until FindNext(FileInfo) <> 0;
  1317.           FindClose(FileInfo);
  1318.         end;
  1319.         if Ptr <> nil then
  1320.         begin
  1321.           Ptr^ := ';';
  1322.           Inc (Ptr);
  1323.         end;
  1324.         MaskPtr := Ptr;
  1325.       end;
  1326.     finally
  1327.       Screen.Cursor := SaveCursor;
  1328.     end;
  1329.     Change;
  1330.   end;
  1331. end;
  1332.  
  1333. procedure TFileListBox.Click;
  1334. begin
  1335.   inherited Click;
  1336.   if FLastSel <> ItemIndex then
  1337.      Change;
  1338. end;
  1339.  
  1340. procedure TFileListBox.Change;
  1341. begin
  1342.   FLastSel := ItemIndex;
  1343.   if FFileEdit <> nil then
  1344.   begin
  1345.     if Length(GetFileName) = 0 then
  1346.       FileEdit.Text := Mask
  1347.     else
  1348.       FileEdit.Text := GetFileName;
  1349.     FileEdit.SelectAll;
  1350.   end;
  1351.   if Assigned(FOnChange) then FOnChange(Self);
  1352. end;
  1353.  
  1354. procedure TFileListBox.SetShowGlyphs(Value: Boolean);
  1355. begin
  1356.   if FShowGlyphs <> Value then
  1357.   begin
  1358.     FShowGlyphs := Value;
  1359.     if (FShowGlyphs = True) and (ItemHeight < (ExeBMP.Height + 1)) then
  1360.       ResetItemHeight;
  1361.     Invalidate;
  1362.   end;
  1363. end;
  1364.  
  1365. function TFileListBox.GetFileName: string;
  1366. var
  1367.   idx: Integer;
  1368. begin
  1369.       { if multi-select is turned on, then using ItemIndex
  1370.         returns a bogus value if nothing is selected   }
  1371.   idx  := ItemIndex;
  1372.   if (idx < 0)  or  (Items.Count = 0)  or  (Selected[idx] = FALSE)  then
  1373.     Result  := ''
  1374.   else
  1375.     Result  := Items[idx];
  1376. end;
  1377.  
  1378. procedure TFileListBox.SetFileName(const NewFile: string);
  1379. begin
  1380.   if AnsiCompareText(NewFile, GetFileName) <> 0 then
  1381.   begin
  1382.     ItemIndex := SendMessage(Handle, LB_FindStringExact, 0,
  1383.       Longint(PChar(NewFile)));
  1384.     Change;
  1385.   end;
  1386. end;
  1387.  
  1388. procedure TFileListBox.SetFileEdit(Value: TEdit);
  1389. begin
  1390.   FFileEdit := Value;
  1391.   if FFileEdit <> nil then
  1392.   begin
  1393.     FFileEdit.FreeNotification(Self);
  1394.     if GetFileName <> '' then
  1395.       FFileEdit.Text := GetFileName
  1396.     else
  1397.       FFileEdit.Text := Mask;
  1398.   end;
  1399. end;
  1400.  
  1401. procedure TFileListBox.DrawItem(Index: Integer; Rect: TRect;
  1402.   State: TOwnerDrawState);
  1403. var
  1404.   Bitmap: TBitmap;
  1405.   offset: Integer;
  1406. begin
  1407.   with Canvas do
  1408.   begin
  1409.     FillRect(Rect);
  1410.     offset := 2;
  1411.     if ShowGlyphs then
  1412.     begin
  1413.       Bitmap := TBitmap(Items.Objects[Index]);
  1414.       if Assigned(Bitmap) then
  1415.       begin
  1416.         BrushCopy(Bounds(Rect.Left + 2,
  1417.                   (Rect.Top + Rect.Bottom - Bitmap.Height) div 2,
  1418.                   Bitmap.Width, Bitmap.Height),
  1419.                   Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height),
  1420.                   Bitmap.Canvas.Pixels[0, Bitmap.Height - 1]);
  1421.         offset := Bitmap.width + 6;
  1422.       end;
  1423.     end;
  1424.     TextOut(Rect.Left + offset, Rect.Top, Items[Index])
  1425.   end;
  1426. end;
  1427.  
  1428. procedure TFileListBox.SetDrive(Value: char);
  1429. begin
  1430.   if (UpCase(Value) <> UpCase(FDirectory[1])) then
  1431.     ApplyFilePath (Format ('%s:', [Value]));
  1432. end;
  1433.  
  1434. procedure TFileListBox.SetDirectory(const NewDirectory: string);
  1435. begin
  1436.   if AnsiCompareText(NewDirectory, FDirectory) <> 0 then
  1437.   begin
  1438.        { go to old directory first, in case not complete pathname
  1439.          and curdir changed - probably not necessary }
  1440.     ChDir(FDirectory);
  1441.     ChDir(NewDirectory);     { exception raised if invalid dir }
  1442.     GetDir(0, FDirectory);   { store correct directory name }
  1443.     ReadFileNames;
  1444.   end;
  1445. end;
  1446.  
  1447. procedure TFileListBox.SetFileType(NewFileType: TFileType);
  1448. begin
  1449.   if NewFileType <> FFileType then
  1450.   begin
  1451.     FFileType := NewFileType;
  1452.     ReadFileNames;
  1453.   end;
  1454. end;
  1455.  
  1456. procedure TFileListBox.SetMask(const NewMask: string);
  1457. begin
  1458.   if FMask <> NewMask then
  1459.   begin
  1460.     FMask := NewMask;
  1461.     ReadFileNames;
  1462.   end;
  1463. end;
  1464.  
  1465. procedure TFileListBox.CMFontChanged(var Message: TMessage);
  1466. begin
  1467.   inherited;
  1468.   ResetItemHeight;
  1469. end;
  1470.  
  1471. procedure TFileListBox.ResetItemHeight;
  1472. var
  1473.   nuHeight: Integer;
  1474. begin
  1475.   nuHeight :=  GetItemHeight(Font);
  1476.   if (FShowGlyphs = True) and (nuHeight < (ExeBMP.Height + 1)) then
  1477.     nuHeight := ExeBmp.Height + 1;
  1478.   ItemHeight := nuHeight;
  1479. end;
  1480.  
  1481. procedure TFileListBox.ApplyFilePath(const EditText: string);
  1482. var
  1483.   DirPart: string;
  1484.   FilePart: string;
  1485.   NewDrive: Char;
  1486. begin
  1487.   if AnsiCompareText(FileName, EditText) = 0 then Exit;
  1488.   if Length (EditText) = 0 then Exit;
  1489.   ProcessPath (EditText, NewDrive, DirPart, FilePart);
  1490.   if FDirList <> nil then
  1491.     FDirList.Directory := EditText
  1492.   else
  1493.     SetDirectory(Format('%s:%s', [NewDrive, DirPart]));
  1494.   if (Pos('*', FilePart) > 0) or (Pos('?', FilePart) > 0) then
  1495.     SetMask (FilePart)
  1496.   else if Length(FilePart) > 0 then
  1497.   begin
  1498.     SetFileName (FilePart);
  1499.     if FileExists (FilePart) then
  1500.     begin
  1501.       if GetFileName = '' then
  1502.       begin
  1503.         SetMask(FilePart);
  1504.         SetFileName (FilePart);
  1505.       end;
  1506.     end
  1507.     else
  1508.       raise EInvalidOperation.CreateResFmt(SInvalidFileName, [EditText]);
  1509.   end;
  1510. end;
  1511.  
  1512. function TFileListBox.GetFilePath: string;
  1513. begin
  1514.   Result := '';
  1515.   if GetFileName <> '' then
  1516.     Result := SlashSep(FDirectory, GetFileName);
  1517. end;
  1518.  
  1519. procedure TFileListBox.Notification(AComponent: TComponent;
  1520.   Operation: TOperation);
  1521. begin
  1522.   inherited Notification(AComponent, Operation);
  1523.   if (Operation = opRemove) then
  1524.   begin
  1525.     if (AComponent = FFileEdit) then FFileEdit := nil
  1526.     else if (AComponent = FDirList) then FDirList := nil
  1527.     else if (AComponent = FFilterCombo) then FFilterCombo := nil;
  1528.   end;
  1529. end;
  1530.  
  1531. { TFilterComboBox }
  1532.  
  1533. constructor TFilterComboBox.Create(AOwner: TComponent);
  1534. begin
  1535.   inherited Create(AOwner);
  1536.   Style := csDropDownList;
  1537.   FFilter := LoadStr (SDefaultFilter);
  1538.   MaskList := TStringList.Create;
  1539. end;
  1540.  
  1541. destructor TFilterComboBox.Destroy;
  1542. begin
  1543.   MaskList.Free;
  1544.   inherited Destroy;
  1545. end;
  1546.  
  1547. procedure TFilterComboBox.CreateWnd;
  1548. begin
  1549.   inherited CreateWnd;
  1550.   BuildList;
  1551. end;
  1552.  
  1553. function TFilterComboBox.IsFilterStored: Boolean;
  1554. begin
  1555.   Result := LoadStr(SDefaultFilter) <> FFilter;
  1556. end;
  1557.  
  1558. procedure TFilterComboBox.SetFilter(const NewFilter: string);
  1559. begin
  1560.   if AnsiCompareText(NewFilter, FFilter) <> 0 then
  1561.   begin
  1562.     FFilter := NewFilter;
  1563.     BuildList;
  1564.     Change;
  1565.   end;
  1566. end;
  1567.  
  1568. procedure TFilterComboBox.SetFileListBox (Value: TFileListBox);
  1569. begin
  1570.   if FFileList <> nil then FFileList.FFilterCombo := nil;
  1571.   FFileList := Value;
  1572.   if FFileList <> nil then
  1573.   begin
  1574.     FFileList.FreeNotification(Self);
  1575.     FFileList.FFilterCombo := Self;
  1576.   end;
  1577. end;
  1578.  
  1579. procedure TFilterComboBox.Click;
  1580. begin
  1581.   inherited Click;
  1582.   Change;
  1583. end;
  1584.  
  1585. function TFilterComboBox.GetMask: string;
  1586. begin
  1587.   if ItemIndex < 0 then
  1588.     ItemIndex := Items.Count - 1;
  1589.  
  1590.   if ItemIndex >= 0 then
  1591.   begin
  1592.      Result := MaskList[ItemIndex];
  1593.   end
  1594.   else
  1595.      Result := '*.*';
  1596. end;
  1597.  
  1598. procedure TFilterComboBox.BuildList;
  1599. var
  1600.   AFilter, MaskName, Mask: string;
  1601.   BarPos: Integer;
  1602. begin
  1603.   Clear;
  1604.   MaskList.Clear;
  1605.   AFilter := Filter;
  1606.   BarPos := Pos('|', AFilter);
  1607.   while BarPos <> 0 do
  1608.   begin
  1609.     MaskName := Copy(AFilter, 1, BarPos - 1);
  1610.     Delete(AFilter, 1, BarPos);
  1611.     BarPos := Pos('|', AFilter);
  1612.     if BarPos > 0 then
  1613.     begin
  1614.       Mask := Copy(AFilter, 1, BarPos - 1);
  1615.       Delete(AFilter, 1, BarPos);
  1616.     end
  1617.     else
  1618.     begin
  1619.       Mask := AFilter;
  1620.       AFilter := '';
  1621.     end;
  1622.     Items.Add(MaskName);
  1623.     MaskList.Add(Mask);
  1624.     BarPos := Pos('|', AFilter);
  1625.   end;
  1626.   ItemIndex := 0;
  1627. end;
  1628.  
  1629. procedure TFilterComboBox.Notification(AComponent: TComponent;
  1630.   Operation: TOperation);
  1631. begin
  1632.   inherited Notification(AComponent, Operation);
  1633.   if (Operation = opRemove) and (AComponent = FFileList) then
  1634.     FFileList := nil;
  1635. end;
  1636.  
  1637. procedure TFilterComboBox.Change;
  1638. begin
  1639.   if FFileList <> nil then FFileList.Mask := Mask;
  1640.   if Assigned(FOnChange) then FOnChange(Self);
  1641. end;
  1642.  
  1643. { TSelectDirDlg }
  1644. constructor TSelectDirDlg.Create(AOwner: TComponent);
  1645. begin
  1646.   inherited CreateNew(AOwner);
  1647.   Caption := LoadStr(SSelectDirCap);
  1648.   BorderStyle := bsDialog;
  1649.   ClientWidth := 424;
  1650.   ClientHeight := 255;
  1651.   Font.Name := 'MS Sans Serif';
  1652.   Font.Size := 8;
  1653.   Position := poScreenCenter;
  1654.  
  1655.   DirEdit := TEdit.Create(Self);
  1656.   with DirEdit do
  1657.   begin
  1658.     Parent := Self;
  1659.     SetBounds(8, 24, 313, 20);
  1660.     Visible := False;
  1661.     TabOrder := 1;
  1662.   end;
  1663.  
  1664.   with TLabel.Create(Self) do
  1665.   begin
  1666.     Parent := Self;
  1667.     SetBounds(8, 8, 92, 13);
  1668.     FocusControl := DirEdit;
  1669.     Caption := LoadStr(SDirNameCap);
  1670.   end;
  1671.  
  1672.   DriveList := TDriveComboBox.Create(Self);
  1673.   with DriveList do
  1674.   begin
  1675.     Parent := Self;
  1676.     SetBounds(232, 192, 185, 19);
  1677.     TabOrder := 2;
  1678.     OnChange := DriveListChange;
  1679.   end;
  1680.  
  1681.   with TLabel.Create(Self) do
  1682.   begin
  1683.     Parent := Self;
  1684.     SetBounds(232, 176, 41, 13);
  1685.     Caption := LoadStr(SDrivesCap);
  1686.     FocusControl := DriveList;
  1687.   end;
  1688.  
  1689.   DirLabel := TPathLabel.Create(Self);
  1690.   with DirLabel do
  1691.   begin
  1692.     Parent := Self;
  1693.     SetBounds(120, 8, 213, 13);
  1694.   end;
  1695.  
  1696.   DirList := TDirectoryListBox.Create(Self);
  1697.   with DirList do
  1698.   begin
  1699.     Parent := Self;
  1700.     SetBounds(8, 72, 213, 138);
  1701.     TabOrder := 0;
  1702.     TabStop := True;
  1703.     ItemHeight := 17;
  1704.     IntegralHeight := True;
  1705.     OnChange := DirListChange;
  1706.   end;
  1707.  
  1708.   with TLabel.Create(Self) do
  1709.   begin
  1710.     Parent := Self;
  1711.     SetBounds(8, 56, 66, 13);
  1712.     Caption := LoadStr(SDirsCap);
  1713.     FocusControl := DirList;
  1714.   end;
  1715.  
  1716.   FileList := TFileListBox.Create(Self);
  1717.   with FileList do
  1718.   begin
  1719.     Parent := Self;
  1720.     SetBounds(232, 72, 185, 93);
  1721.     TabOrder := 6;
  1722.     TabStop := True;
  1723.     FileType := [ftNormal];
  1724.     Mask := '*.*';
  1725.     Font.Color := clGrayText;
  1726.     ItemHeight := 13;
  1727.   end;
  1728.  
  1729.   with TLabel.Create(Self) do
  1730.   begin
  1731.     Parent := Self;
  1732.     SetBounds(232, 56, 57, 13);
  1733.     Caption := LoadStr(SFilesCap);
  1734.     FocusControl := FileList;
  1735.   end;
  1736.  
  1737.   NetButton := TButton.Create(Self);
  1738.   with NetButton do
  1739.   begin
  1740.     Parent := Self;
  1741.     SetBounds(8, 224, 77, 27);
  1742.     Visible := False;
  1743.     TabOrder := 3;
  1744.     Caption := LoadStr(SNetworkCap);
  1745.     OnClick := NetClick;
  1746.   end;
  1747.  
  1748.   OKButton := TButton.Create(Self);
  1749.   with OKButton do
  1750.   begin
  1751.     Parent := Self;
  1752.     SetBounds(172, 224, 77, 27);
  1753.     TabOrder := 4;
  1754.     OnClick := OKClick;
  1755.     Caption := LoadStr(SOKButton);
  1756.     ModalResult := 1;
  1757.     Default := True;
  1758.   end;
  1759.  
  1760.   with TButton.Create(Self) do
  1761.   begin
  1762.     Parent := Self;
  1763.     SetBounds(256, 224, 77, 27);
  1764.     TabOrder := 5;
  1765.     Cancel := True;
  1766.     Caption := LoadStr(SCancelButton);
  1767.     ModalResult := 2;
  1768.   end;
  1769.  
  1770.   with TButton.Create(Self) do
  1771.   begin
  1772.     Parent := Self;
  1773.     SetBounds(340, 224, 77, 27);
  1774.     TabOrder := 7;
  1775.     Caption := LoadStr(SHelpButton);
  1776.     OnClick := HelpButtonClick;
  1777.   end;
  1778.  
  1779.   FormCreate(Self);
  1780.   ActiveControl := DirList;
  1781. end;
  1782.  
  1783. procedure TSelectDirDlg.HelpButtonClick(Sender: TObject);
  1784. begin
  1785.   Application.HelpContext(HelpContext);
  1786. end;
  1787.  
  1788. procedure TSelectDirDlg.DirListChange(Sender: TObject);
  1789. begin
  1790.   DirLabel.Caption := DirList.Directory;
  1791.   FileList.Directory := DirList.Directory;
  1792.   DirEdit.Text := DirLabel.Caption;
  1793.   DirEdit.SelectAll;
  1794. end;
  1795.  
  1796. procedure TSelectDirDlg.FormCreate(Sender: TObject);
  1797. const
  1798.   User = 'USER32.DLL';
  1799. var
  1800.   UserHandle: THandle;
  1801.   NetDriver: THandle;
  1802.   WNetGetCaps: function (Flags: Word): Word;
  1803. begin
  1804.   { is network access enabled? }
  1805.   UserHandle := GetModuleHandle(User);
  1806.   @WNetGetCaps := GetProcAddress(UserHandle, 'WNETGETCAPS');
  1807.   if @WNetGetCaps <> nil then
  1808.   begin
  1809.     NetDriver := WNetGetCaps(Word(-1));
  1810.     if NetDriver <> 0 then
  1811.     begin
  1812.       @WNetConnectDialog := GetProcAddress(NetDriver, 'WNETCONNECTDIALOG');
  1813.       NetButton.Visible := @WNetConnectDialog <> nil;
  1814.     end;
  1815.   end;
  1816.  
  1817.   FAllowCreate := False;
  1818.   DirLabel.BoundsRect := DirEdit.BoundsRect;
  1819.   DirListChange(Self);
  1820. end;
  1821.  
  1822. procedure TSelectDirDlg.DriveListChange(Sender: TObject);
  1823. begin
  1824.   DirList.Drive := DriveList.Drive;
  1825. end;
  1826.  
  1827. procedure TSelectDirDlg.SetAllowCreate(Value: Boolean);
  1828. begin
  1829.   if Value <> FAllowCreate then
  1830.   begin
  1831.     FAllowCreate := Value;
  1832.     DirLabel.Visible := not FAllowCreate;
  1833.     DirEdit.Visible := FAllowCreate;
  1834.   end;
  1835. end;
  1836.  
  1837. procedure TSelectDirDlg.SetDirectory(const Value: string);
  1838. var
  1839.   Temp: string;
  1840. begin
  1841.   if Value <> '' then
  1842.   begin
  1843.     Temp := ExpandFileName(SlashSep(Value,'*.*'));
  1844.     if (Length(Temp) >= 3) and (Temp[2] = ':') then
  1845.     begin
  1846.       DriveList.Drive := Temp[1];
  1847.       Temp := ExtractFilePath(Temp);
  1848.       try
  1849.         DirList.Directory := Copy(Temp, 1, Length(Temp) - 1);
  1850.       except
  1851.         on EInOutError do
  1852.         begin
  1853.           GetDir(0, Temp);
  1854.           DriveList.Drive := Temp[1];
  1855.           DirList.Directory := Temp;
  1856.         end;
  1857.       end;
  1858.     end;
  1859.   end;
  1860. end;
  1861.  
  1862. function TSelectDirDlg.GetDirectory: string;
  1863. begin
  1864.   if FAllowCreate then
  1865.     Result := DirEdit.Text
  1866.   else
  1867.     Result := DirLabel.Caption;
  1868. end;
  1869.  
  1870. procedure TSelectDirDlg.NetClick(Sender: TObject);
  1871. begin
  1872.   if Assigned(WNetConnectDialog) then
  1873.     WNetConnectDialog(Handle, WNTYPE_DRIVE);
  1874. end;
  1875.  
  1876. procedure TSelectDirDlg.OKClick(Sender: TObject);
  1877. begin
  1878.   if AllowCreate and Prompt and (not DirectoryExists(Directory)) and
  1879.     (MessageDlg(LoadStr(SConfirmCreateDir), mtConfirmation, [mbYes, mbNo],
  1880.       0) <> mrYes) then
  1881.     ModalResult := 0;
  1882. end;
  1883.  
  1884. function SelectDirectory(var Directory: string;
  1885.   Options: TSelectDirOpts; HelpCtx: Longint): Boolean;
  1886. var
  1887.   D: TSelectDirDlg;
  1888. begin
  1889.   D := TSelectDirDlg.Create(Application);
  1890.   try
  1891.     D.Directory := Directory;
  1892.     D.AllowCreate := sdAllowCreate in Options;
  1893.     D.Prompt := sdPrompt in Options;
  1894.  
  1895.     { scale to screen res }
  1896.     if Screen.PixelsPerInch <> 96 then
  1897.     begin
  1898.       D.ScaleBy(Screen.PixelsPerInch, 96);
  1899.  
  1900.       { The ScaleBy method does not scale the font well, so set the
  1901.         font back to the original info. }
  1902.       D.FileList.ParentFont := True;
  1903.       D.Font.Name := 'MS Sans Serif';
  1904.       D.Font.Size := 8;
  1905.       D.Font.Style := [fsBold];
  1906.       D.Left := (Screen.Width div 2) - (D.Width div 2);
  1907.       D.Top := (Screen.Height div 2) - (D.Height div 2);
  1908.       D.FileList.Font.Color := clGrayText;
  1909.     end;
  1910.  
  1911.     D.HelpContext := HelpCtx;
  1912.  
  1913.     Result := D.ShowModal = mrOK;
  1914.     if Result then
  1915.     begin
  1916.       Directory := D.Directory;
  1917.       if sdPerformCreate in Options then
  1918.         ForceDirectories(Directory);
  1919.     end;
  1920.   finally
  1921.     D.Free;
  1922.   end;
  1923. end;
  1924.  
  1925. function DirectoryExists(const Name: string): Boolean;
  1926. var
  1927.   Code: Integer;
  1928. begin
  1929.   Code := GetFileAttributes(PChar(Name));
  1930.   Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
  1931. end;
  1932.  
  1933. procedure ForceDirectories(Dir: string);
  1934. begin
  1935.   if Dir[Length(Dir)] = '\' then
  1936.     SetLength(Dir, Length(Dir)-1);
  1937.   if (Length(Dir) < 3) or DirectoryExists(Dir) then Exit;
  1938.   ForceDirectories(ExtractFilePath(Dir));
  1939.   CreateDir(Dir);
  1940. end;
  1941.  
  1942. end.
  1943.  
  1944.