home *** CD-ROM | disk | FTP | other *** search
/ PC Format Collection 48 / SENT14D.ISO / tech / delphi / disk15 / filmanex.pak / FMXWIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-08-24  |  7.9 KB  |  264 lines
  1. unit FMXWin;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, StdCtrls, FileCtrl, Grids, Outline, DirOutln, Tabs, Menus, Dialogs,
  8.   FAttrDlg, FChngDlg, FMXUtils, ExtCtrls;
  9.  
  10. type
  11.   TFMForm = class(TForm)
  12.     StatusBar: TPanel;
  13.     DirectoryPanel: TPanel;
  14.     FilePanel: TPanel;
  15.     DriveTabSet: TTabSet;
  16.     DirectoryOutline: TDirectoryOutline;
  17.     FileList: TFileListBox;
  18.     MainMenu1: TMainMenu;
  19.     File1: TMenuItem;
  20.     Open1: TMenuItem;
  21.     Move1: TMenuItem;
  22.     Copy1: TMenuItem;
  23.     Delete1: TMenuItem;
  24.     Rename1: TMenuItem;
  25.     Properties1: TMenuItem;
  26.     N1: TMenuItem;
  27.     Exit1: TMenuItem;
  28.     Floppy: TImage;
  29.     Fixed: TImage;
  30.     Network: TImage;
  31.     procedure Exit1Click(Sender: TObject);
  32.     procedure FormCreate(Sender: TObject);
  33.     procedure DriveTabSetClick(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.   private
  53.     { Private declarations }
  54.     procedure ConfirmChange(const ACaption, FromFile, ToFile: string);
  55.   public
  56.     { Public declarations }
  57.   end;
  58.  
  59. var
  60.   FMForm: TFMForm;
  61.  
  62. implementation
  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, AddedIndex: Integer;
  74.   DriveLetter: Char;
  75. begin
  76.   for Drive := 0 to 25 do
  77.   begin
  78.     DriveLetter := Chr(Drive + ord('a'));
  79.     case GetDriveType(Drive) of
  80.       DRIVE_REMOVABLE:
  81.         AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Floppy.Picture.Graphic);
  82.       DRIVE_FIXED:
  83.         AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Fixed.Picture.Graphic);
  84.       DRIVE_REMOTE:
  85.         AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Network.Picture.Graphic);
  86.     end;
  87.     if UpCase(DriveLetter) = UpCase(FileList.Drive) then
  88.       DriveTabSet.TAbIndex := AddedIndex;
  89.   end;
  90. end;
  91.  
  92. procedure TFMForm.DriveTabSetClick(Sender: TObject);
  93. begin
  94.   with DriveTabSet do
  95.     DirectoryOutline.Drive := Tabs[TabIndex][1];
  96. end;
  97.  
  98. procedure TFMForm.DirectoryOutlineChange(Sender: TObject);
  99. begin
  100.   FileList.Directory := DirectoryOutline.Directory;
  101.   DirectoryPanel.Caption := DirectoryOutline.Directory;
  102. end;
  103.  
  104. procedure TFMForm.FileListChange(Sender: TObject);
  105. var
  106.   TheFileName: string;
  107. begin
  108.   with FileList do
  109.   begin
  110.     if ItemIndex >= 0 then
  111.     begin
  112.       TheFileName := FileName;
  113.       FilePanel.Caption := Format('%s, %d bytes', [TheFileName, GetFileSize(TheFileName)]);
  114.     end
  115.     else FilePanel.Caption := '';
  116.   end;
  117. end;
  118.  
  119. procedure TFMForm.DriveTabSetMeasureTab(Sender: TObject; Index: Integer;
  120.   var TabWidth: Integer);
  121. var
  122.   BitmapWidth: Integer;
  123. begin
  124.   BitmapWidth := TBitmap(DriveTabSet.Tabs.Objects[Index]).Width;
  125.   Inc(TabWidth, 2 + BitmapWidth);
  126. end;
  127.  
  128. procedure TFMForm.DriveTabSetDrawTab(Sender: TObject; TabCanvas: TCanvas;
  129.   R: TRect; Index: Integer; Selected: Boolean);
  130. var
  131.   Bitmap: TBitmap;
  132. begin
  133.   Bitmap := TBitmap(DriveTabSet.Tabs.Objects[Index]);
  134.   with TabCanvas do
  135.   begin
  136.     Draw(R.Left, R.Top + 4, Bitmap);
  137.     TextOut(R.Left + 2 + Bitmap.Width, R.Top + 2, DriveTabSet.Tabs[Index]);
  138.   end;
  139. end;
  140.  
  141. procedure TFMForm.File1Click(Sender: TObject);
  142. var
  143.   FileSelected: Boolean;
  144. begin
  145.   FileSelected := FileList.ItemIndex >= 0;
  146.   Open1.Enabled := FileSelected;
  147.   Delete1.Enabled := FileSelected;
  148.   Copy1.Enabled := FileSelected;
  149.   Move1.Enabled := FileSelected;
  150.   Rename1.Enabled := FileSelected;
  151.   Properties1.Enabled := FileSelected;
  152. end;
  153.  
  154. procedure TFMForm.Delete1Click(Sender: TObject);
  155. begin
  156.   with FileList do
  157.     if MessageDlg('Delete ' + FileName  + '?', mtConfirmation,
  158.       [mbYes, mbNo], 0) = idYes then
  159.       if DeleteFile(FileName) then Update;
  160. end;
  161.  
  162. procedure TFMForm.Properties1Click(Sender: TObject);
  163. var
  164.   Attributes, NewAttributes: Word;
  165. begin
  166.   with FileAttrForm do
  167.   begin
  168.     FileName.Caption := FileList.FileName;
  169.     FilePath.Caption := FileList.Directory;
  170.     ChangeDate.Caption := DateTimeToStr(FileDateTime(FileList.FileName));
  171.     Attributes := FileGetAttr(FileList.FileName);
  172.     ReadOnly.Checked := (Attributes and faReadOnly) = faReadOnly;
  173.     Archive.Checked := (Attributes and faArchive) = faArchive;
  174.     System.Checked := (Attributes and faSysFile) = faSysFile;
  175.     Hidden.Checked := (Attributes and faHidden) = faHidden;
  176.     if ShowModal <> idCancel then
  177.     begin
  178.       NewAttributes := Attributes;
  179.       if ReadOnly.Checked then NewAttributes := NewAttributes or faReadOnly
  180.       else NewAttributes := NewAttributes and not faReadOnly;
  181.       if Archive.Checked then NewAttributes := NewAttributes or faArchive
  182.       else NewAttributes := NewAttributes and not faArchive;
  183.       if System.Checked then NewAttributes := NewAttributes or faSysFile
  184.       else NewAttributes := NewAttributes and not faSysFile;
  185.       if Hidden.Checked then NewAttributes := NewAttributes or faHidden
  186.       else NewAttributes := NewAttributes and not faHidden;
  187.       if NewAttributes <> Attributes then
  188.         FileSetAttr(FileList.FileName, NewAttributes);
  189.     end;
  190.   end;
  191. end;
  192.  
  193. procedure TFMForm.ConfirmChange(const ACaption, FromFile, ToFile: string);
  194. begin
  195.   if MessageDlg(Format('%s %s to %s', [ACaption, FromFile, ToFile]),
  196.     mtConfirmation, [mbYes, mbNo], 0) = idYes then
  197.   begin
  198.     if ACaption = 'Move' then
  199.       MoveFile(FromFile, ToFile)
  200.     else if ACaption = 'Copy' then
  201.       CopyFile(FromFile, ToFile)
  202.     else if ACaption = 'Rename' then
  203.       RenameFile(FromFile, ToFile);
  204.     FileList.Update;
  205.   end;
  206. end;
  207.  
  208. procedure TFMForm.FileChange(Sender: TObject);
  209. begin
  210.   with ChangeForm do
  211.   begin
  212.     if Sender = Move1 then Caption := 'Move'
  213.     else if Sender = Copy1 then Caption := 'Copy'
  214.     else if Sender = Rename1 then Caption := 'Rename'
  215.     else Exit;
  216.     CurrentDir.Caption := FileList.Directory;
  217.     FromFileName.Text := FileList.FileName;
  218.     ToFileName.Text := '';
  219.     if (ShowModal <> idCancel) and (ToFileName.Text <> '') then
  220.       ConfirmChange(Caption, FromFileName.Text, ToFileName.Text);
  221.   end;
  222. end;
  223.  
  224. procedure TFMForm.Open1Click(Sender: TObject);
  225. begin
  226.   with FileList do
  227.     ExecuteFile(FileName, '', Directory, SW_SHOW);
  228. end;
  229.  
  230. procedure TFMForm.FileListMouseDown(Sender: TObject; Button: TMouseButton;
  231.   Shift: TShiftState; X, Y: Integer);
  232. begin
  233.   if Button = mbLeft then
  234.     with Sender as TFileListBox do
  235.     begin
  236.       if ItemAtPos(Point(X, Y), True) >= 0 then
  237.         BeginDrag(False);
  238.     end;
  239. end;
  240.  
  241. procedure TFMForm.DirectoryOutlineDragOver(Sender, Source: TObject; X,
  242.   Y: Integer; State: TDragState; var Accept: Boolean);
  243. begin
  244.   if Source is TFileListBox then
  245.     Accept := True;
  246. end;
  247.  
  248. procedure TFMForm.DirectoryOutlineDragDrop(Sender, Source: TObject; X,
  249.   Y: Integer);
  250. begin
  251.   if Source is TFileListBox then
  252.     with DirectoryOutline do
  253.     begin
  254.       ConfirmChange('Move', FileList.FileName, Items[GetItem(X, Y)].FullPath);
  255.     end;
  256. end;
  257.  
  258. procedure TFMForm.FileListEndDrag(Sender, Target: TObject; X, Y: Integer);
  259. begin
  260.   if Target <> nil then FileList.Update;
  261. end;
  262.  
  263. end.
  264.