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