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