home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1997 August / VPR9708A.ISO / D3TRIAL / INSTALL / DATA.Z / FMXWIN.PAS < prev    next >
Pascal/Delphi Source File  |  1997-05-08  |  9KB  |  286 lines
  1. unit FMXWin;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, FileCtrl, Grids, Outline, DirOutln, Tabs, ExtCtrls, Menus;
  8.  
  9. type
  10.   TFMForm = class(TForm)
  11.     StatusBar: TPanel;
  12.     DirectoryPanel: TPanel;
  13.     FilePanel: TPanel;
  14.     DriveTabSet: TTabSet;
  15.     DirectoryOutline: TDirectoryOutline;
  16.     FileList: TFileListBox;
  17.     MainMenu1: TMainMenu;
  18.     File1: TMenuItem;
  19.     Open1: TMenuItem;
  20.     Move1: TMenuItem;
  21.     Copy1: TMenuItem;
  22.     Delete1: TMenuItem;
  23.     Rename1: TMenuItem;
  24.     Properties1: TMenuItem;
  25.     N1: TMenuItem;
  26.     Exit1: TMenuItem;
  27.     Floppy: TImage;
  28.     Fixed: TImage;
  29.     Network: TImage;
  30.     CDRom: TImage;
  31.     RamDisk: TImage;
  32.     procedure Exit1Click(Sender: TObject);
  33.     procedure FormCreate(Sender: TObject);
  34.     procedure DirectoryOutlineChange(Sender: TObject);
  35.     procedure FileListChange(Sender: TObject);
  36.     procedure DriveTabSetMeasureTab(Sender: TObject; Index: Integer;
  37.       var TabWidth: Integer);
  38.     procedure DriveTabSetDrawTab(Sender: TObject; TabCanvas: TCanvas;
  39.       R: TRect; Index: Integer; Selected: Boolean);
  40.     procedure File1Click(Sender: TObject);
  41.     procedure Delete1Click(Sender: TObject);
  42.     procedure Properties1Click(Sender: TObject);
  43.     procedure FileChange(Sender: TObject);
  44.     procedure Open1Click(Sender: TObject);
  45.     procedure FileListMouseDown(Sender: TObject; Button: TMouseButton;
  46.       Shift: TShiftState; X, Y: Integer);
  47.     procedure DirectoryOutlineDragOver(Sender, Source: TObject; X,
  48.       Y: Integer; State: TDragState; var Accept: Boolean);
  49.     procedure DirectoryOutlineDragDrop(Sender, Source: TObject; X,
  50.       Y: Integer);
  51.     procedure FileListEndDrag(Sender, Target: TObject; X, Y: Integer);
  52.     procedure DriveTabSetChange(Sender: TObject; NewTab: Integer;
  53.       var AllowChange: Boolean);
  54.   private
  55.     procedure ConfirmChange(const ACaption, FromFile, ToFile: string);
  56.   public
  57.     { Public declarations }
  58.   end;
  59.  
  60. var
  61.   FMForm: TFMForm;
  62.  
  63. implementation
  64.  
  65. uses FmxUtils, FAttrDlg, FChngDlg;
  66.  
  67. {$R *.DFM}
  68.  
  69. procedure TFMForm.Exit1Click(Sender: TObject);
  70. begin
  71.   Close;
  72. end;
  73.  
  74. procedure TFMForm.FormCreate(Sender: TObject);
  75. var
  76.   Drive: Char;
  77.   AddedIndex: Integer;
  78. begin
  79.   for Drive := 'a' to 'z' do
  80.   begin
  81.     case GetDriveType(PChar(Drive + ':\')) of
  82.       DRIVE_REMOVABLE:
  83.         AddedIndex := DriveTabSet.Tabs.AddObject(Drive, Floppy.Picture.Graphic);
  84.       DRIVE_FIXED:
  85.         AddedIndex := DriveTabSet.Tabs.AddObject(Drive, Fixed.Picture.Graphic);
  86.       DRIVE_CDROM:
  87.         AddedIndex := DriveTabSet.Tabs.AddObject(Drive, CDRom.Picture.Graphic);
  88.       DRIVE_RAMDISK:
  89.         AddedIndex := DriveTabSet.Tabs.AddObject(Drive, RamDisk.Picture.Graphic);
  90.       DRIVE_REMOTE:
  91.         AddedIndex := DriveTabSet.Tabs.AddObject(Drive, Network.Picture.Graphic);
  92.     end;
  93.     if UpCase(Drive) = FileList.Drive then
  94.       DriveTabSet.TabIndex := AddedIndex;
  95.   end;
  96. end;
  97.  
  98. procedure TFMForm.DriveTabSetChange(Sender: TObject; NewTab: Integer;
  99.   var AllowChange: Boolean);
  100. begin
  101.   if not (csDesigning in ComponentState) then
  102.   begin
  103.     AllowChange := True;
  104.     try
  105.       with DriveTabSet do
  106.         DirectoryOutline.Drive := Tabs[NewTab][1];
  107.     except
  108.       on EInOutError do
  109.       begin
  110.         AllowChange := False;
  111.         with DriveTabSet do
  112.           DirectoryOutline.Drive := Tabs[TabIndex][1];
  113.         raise;
  114.       end;
  115.     end;
  116.   end;
  117. end;
  118.  
  119. procedure TFMForm.DirectoryOutlineChange(Sender: TObject);
  120. begin
  121.   FileList.Directory := DirectoryOutline.Directory;
  122.   DirectoryPanel.Caption := DirectoryOutline.Directory;
  123. end;
  124.  
  125. procedure TFMForm.FileListChange(Sender: TObject);
  126. var
  127.   TheFileName: string;
  128. begin
  129.   with FileList do
  130.   begin
  131.     if ItemIndex >= 0 then
  132.     begin
  133.       TheFileName := Items[ItemIndex];
  134.       FilePanel.Caption := Format('%s, %d bytes', [TheFileName, GetFileSize(TheFileName)]);
  135.     end
  136.     else FilePanel.Caption := '';
  137.   end;
  138. end;
  139.  
  140. procedure TFMForm.DriveTabSetMeasureTab(Sender: TObject; Index: Integer;
  141.   var TabWidth: Integer);
  142. var
  143.   BitmapWidth: Integer;
  144. begin
  145.   BitmapWidth := TBitmap(DriveTabSet.Tabs.Objects[Index]).Width;
  146.   Inc(TabWidth, 2 + BitmapWidth);
  147. end;
  148.  
  149. procedure TFMForm.DriveTabSetDrawTab(Sender: TObject; TabCanvas: TCanvas;
  150.   R: TRect; Index: Integer; Selected: Boolean);
  151. var
  152.   Bitmap: TBitmap;
  153. begin
  154.   Bitmap := TBitmap(DriveTabSet.Tabs.Objects[Index]);
  155.   with TabCanvas do
  156.   begin
  157.     Draw(R.Left, R.Top + 4, Bitmap);
  158.     TextOut(R.Left + 2 + Bitmap.Width, R.Top + 2, DriveTabSet.Tabs[Index]);
  159.   end;
  160. end;
  161.  
  162. procedure TFMForm.File1Click(Sender: TObject);
  163. var
  164.   FileSelected: Boolean;
  165. begin
  166.   FileSelected := FileList.ItemIndex >= 0;
  167.   Open1.Enabled := FileSelected;
  168.   Delete1.Enabled := FileSelected;
  169.   Copy1.Enabled := FileSelected;
  170.   Move1.Enabled := FileSelected;
  171.   Rename1.Enabled := FileSelected;
  172.   Properties1.Enabled := FileSelected;
  173. end;
  174.  
  175. procedure TFMForm.Delete1Click(Sender: TObject);
  176. begin
  177.   with FileList do
  178.     if MessageDlg('Delete ' + FileName + '?', mtConfirmation,
  179.       [mbYes, mbNo], 0) = mrYes then
  180.       if DeleteFile(FileName) then Update;
  181. end;
  182.  
  183. procedure TFMForm.Properties1Click(Sender: TObject);
  184. var
  185.   Attributes, NewAttributes: Word;
  186. begin
  187.   with FileAttrForm do
  188.   begin
  189.     FileDirName.Caption := FileList.Items[FileList.ItemIndex];
  190.     FilePathName.Caption := FileList.Directory;
  191.     ChangeDate.Caption := DateTimeToStr(FileDateTime(FileList.FileName));
  192.     Attributes := FileGetAttr(FileDirName.Caption);
  193.     ReadOnly.Checked := (Attributes and faReadOnly) = faReadOnly;
  194.     Archive.Checked := (Attributes and faArchive) = faArchive;
  195.     System.Checked := (Attributes and faSysFile) = faSysFile;
  196.     Hidden.Checked := (Attributes and faHidden) = faHidden;
  197.     if ShowModal <> mrCancel then
  198.     begin
  199.       NewAttributes := Attributes;
  200.       if ReadOnly.Checked then NewAttributes := NewAttributes or faReadOnly
  201.       else NewAttributes := NewAttributes and not faReadOnly;
  202.       if Archive.Checked then NewAttributes := NewAttributes or faArchive
  203.       else NewAttributes := NewAttributes and not faArchive;
  204.       if System.Checked then NewAttributes := NewAttributes or faSysFile
  205.       else NewAttributes := NewAttributes and not faSysFile;
  206.       if Hidden.Checked then NewAttributes := NewAttributes or faHidden
  207.       else NewAttributes := NewAttributes and not faHidden;
  208.       if NewAttributes <> Attributes then
  209.         FileSetAttr(FileDirName.Caption, NewAttributes);
  210.     end;
  211.   end;
  212. end;
  213.  
  214. procedure TFMForm.ConfirmChange(const ACaption, FromFile, ToFile: string);
  215. begin
  216.   if MessageDlg(Format('%s %s to %s?', [ACaption, FromFile, ToFile]),
  217.     mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  218.   begin
  219.     if ACaption = 'Move' then
  220.       MoveFile(FromFile, ToFile)
  221.     else if ACaption = 'Copy' then
  222.       CopyFile(FromFile, ToFile)
  223.     else if ACaption = 'Rename' then
  224.       RenameFile(FromFile, ToFile);
  225.     FileList.Update;
  226.   end;
  227. end;
  228.  
  229. procedure TFMForm.FileChange(Sender: TObject);
  230. begin
  231.   with ChangeDlg do
  232.   begin
  233.     if Sender = Move1 then Caption := 'Move'
  234.     else if Sender = Copy1 then Caption := 'Copy'
  235.     else if Sender = Rename1 then Caption := 'Rename'
  236.     else Exit;
  237.     CurrentDir.Caption := DirectoryOutline.Directory;
  238.     FromFileName.Text := FileList.FileName;
  239.     ToFileName.Text := '';
  240.     if (ShowModal <> mrCancel) and (ToFileName.Text <> '') then
  241.       ConfirmChange(Caption, FromFileName.Text, ToFileName.Text);
  242.   end;
  243. end;
  244.  
  245. procedure TFMForm.Open1Click(Sender: TObject);
  246. begin
  247.   with FileList do
  248.   begin
  249.     if HasAttr(FileName, faDirectory) then
  250.       DirectoryOutline.Directory := FileName
  251.     else ExecuteFile(FileName, '', Directory, SW_SHOW);
  252.   end;
  253. end;
  254.  
  255. procedure TFMForm.FileListMouseDown(Sender: TObject; Button: TMouseButton;
  256.   Shift: TShiftState; X, Y: Integer);
  257. begin
  258.   if Button = mbLeft then
  259.   with Sender as TFileListBox do
  260.   begin
  261.     if ItemAtPos(Point(X, Y), True) >= 0 then
  262.       BeginDrag(False);
  263.   end;
  264. end;
  265.  
  266. procedure TFMForm.DirectoryOutlineDragOver(Sender, Source: TObject; X,
  267.   Y: Integer; State: TDragState; var Accept: Boolean);
  268. begin
  269.   Accept := (Source is TFileListBox) and (DirectoryOutline.GetItem(X, Y) > 0);
  270. end;
  271.  
  272. procedure TFMForm.DirectoryOutlineDragDrop(Sender, Source: TObject; X,
  273.   Y: Integer);
  274. begin
  275.   if Source is TFileListBox then
  276.     with DirectoryOutline do
  277.       ConfirmChange('Move', FileList.FileName, Items[GetItem(X, Y)].FullPath);
  278. end;
  279.  
  280. procedure TFMForm.FileListEndDrag(Sender, Target: TObject; X, Y: Integer);
  281. begin
  282.   if Target <> nil then FileList.Update;
  283. end;
  284.  
  285. end.
  286.