home *** CD-ROM | disk | FTP | other *** search
/ PC Expert 29 / Pce29cd.iso / RUNIMAGE / DELPHI40 / DEMOS / DOC / FILMANEX / FMXWIN.PAS < prev    next >
Pascal/Delphi Source File  |  1998-06-16  |  9KB  |  288 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.     else
  93.       AddedIndex := 0;
  94.     end;
  95.     if UpCase(Drive) = FileList.Drive then
  96.       DriveTabSet.TabIndex := AddedIndex;
  97.   end;
  98. end;
  99.  
  100. procedure TFMForm.DriveTabSetChange(Sender: TObject; NewTab: Integer;
  101.   var AllowChange: Boolean);
  102. begin
  103.   if not (csDesigning in ComponentState) then
  104.   begin
  105.     AllowChange := True;
  106.     try
  107.       with DriveTabSet do
  108.         DirectoryOutline.Drive := Tabs[NewTab][1];
  109.     except
  110.       on EInOutError do
  111.       begin
  112.         AllowChange := False;
  113.         with DriveTabSet do
  114.           DirectoryOutline.Drive := Tabs[TabIndex][1];
  115.         raise;
  116.       end;
  117.     end;
  118.   end;
  119. end;
  120.  
  121. procedure TFMForm.DirectoryOutlineChange(Sender: TObject);
  122. begin
  123.   FileList.Directory := DirectoryOutline.Directory;
  124.   DirectoryPanel.Caption := DirectoryOutline.Directory;
  125. end;
  126.  
  127. procedure TFMForm.FileListChange(Sender: TObject);
  128. var
  129.   TheFileName: string;
  130. begin
  131.   with FileList do
  132.   begin
  133.     if ItemIndex >= 0 then
  134.     begin
  135.       TheFileName := Items[ItemIndex];
  136.       FilePanel.Caption := Format('%s, %d bytes', [TheFileName, GetFileSize(TheFileName)]);
  137.     end
  138.     else FilePanel.Caption := '';
  139.   end;
  140. end;
  141.  
  142. procedure TFMForm.DriveTabSetMeasureTab(Sender: TObject; Index: Integer;
  143.   var TabWidth: Integer);
  144. var
  145.   BitmapWidth: Integer;
  146. begin
  147.   BitmapWidth := TBitmap(DriveTabSet.Tabs.Objects[Index]).Width;
  148.   Inc(TabWidth, 2 + BitmapWidth);
  149. end;
  150.  
  151. procedure TFMForm.DriveTabSetDrawTab(Sender: TObject; TabCanvas: TCanvas;
  152.   R: TRect; Index: Integer; Selected: Boolean);
  153. var
  154.   Bitmap: TBitmap;
  155. begin
  156.   Bitmap := TBitmap(DriveTabSet.Tabs.Objects[Index]);
  157.   with TabCanvas do
  158.   begin
  159.     Draw(R.Left, R.Top + 4, Bitmap);
  160.     TextOut(R.Left + 2 + Bitmap.Width, R.Top + 2, DriveTabSet.Tabs[Index]);
  161.   end;
  162. end;
  163.  
  164. procedure TFMForm.File1Click(Sender: TObject);
  165. var
  166.   FileSelected: Boolean;
  167. begin
  168.   FileSelected := FileList.ItemIndex >= 0;
  169.   Open1.Enabled := FileSelected;
  170.   Delete1.Enabled := FileSelected;
  171.   Copy1.Enabled := FileSelected;
  172.   Move1.Enabled := FileSelected;
  173.   Rename1.Enabled := FileSelected;
  174.   Properties1.Enabled := FileSelected;
  175. end;
  176.  
  177. procedure TFMForm.Delete1Click(Sender: TObject);
  178. begin
  179.   with FileList do
  180.     if MessageDlg('Delete ' + FileName + '?', mtConfirmation,
  181.       [mbYes, mbNo], 0) = mrYes then
  182.       if DeleteFile(FileName) then Update;
  183. end;
  184.  
  185. procedure TFMForm.Properties1Click(Sender: TObject);
  186. var
  187.   Attributes, NewAttributes: Word;
  188. begin
  189.   with FileAttrForm do
  190.   begin
  191.     FileDirName.Caption := FileList.Items[FileList.ItemIndex];
  192.     FilePathName.Caption := FileList.Directory;
  193.     ChangeDate.Caption := DateTimeToStr(FileDateTime(FileList.FileName));
  194.     Attributes := FileGetAttr(FileDirName.Caption);
  195.     ReadOnly.Checked := (Attributes and faReadOnly) = faReadOnly;
  196.     Archive.Checked := (Attributes and faArchive) = faArchive;
  197.     System.Checked := (Attributes and faSysFile) = faSysFile;
  198.     Hidden.Checked := (Attributes and faHidden) = faHidden;
  199.     if ShowModal <> mrCancel then
  200.     begin
  201.       NewAttributes := Attributes;
  202.       if ReadOnly.Checked then NewAttributes := NewAttributes or faReadOnly
  203.       else NewAttributes := NewAttributes and not faReadOnly;
  204.       if Archive.Checked then NewAttributes := NewAttributes or faArchive
  205.       else NewAttributes := NewAttributes and not faArchive;
  206.       if System.Checked then NewAttributes := NewAttributes or faSysFile
  207.       else NewAttributes := NewAttributes and not faSysFile;
  208.       if Hidden.Checked then NewAttributes := NewAttributes or faHidden
  209.       else NewAttributes := NewAttributes and not faHidden;
  210.       if NewAttributes <> Attributes then
  211.         FileSetAttr(FileDirName.Caption, NewAttributes);
  212.     end;
  213.   end;
  214. end;
  215.  
  216. procedure TFMForm.ConfirmChange(const ACaption, FromFile, ToFile: string);
  217. begin
  218.   if MessageDlg(Format('%s %s to %s?', [ACaption, FromFile, ToFile]),
  219.     mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  220.   begin
  221.     if ACaption = 'Move' then
  222.       MoveFile(FromFile, ToFile)
  223.     else if ACaption = 'Copy' then
  224.       CopyFile(FromFile, ToFile)
  225.     else if ACaption = 'Rename' then
  226.       RenameFile(FromFile, ToFile);
  227.     FileList.Update;
  228.   end;
  229. end;
  230.  
  231. procedure TFMForm.FileChange(Sender: TObject);
  232. begin
  233.   with ChangeDlg do
  234.   begin
  235.     if Sender = Move1 then Caption := 'Move'
  236.     else if Sender = Copy1 then Caption := 'Copy'
  237.     else if Sender = Rename1 then Caption := 'Rename'
  238.     else Exit;
  239.     CurrentDir.Caption := DirectoryOutline.Directory;
  240.     FromFileName.Text := FileList.FileName;
  241.     ToFileName.Text := '';
  242.     if (ShowModal <> mrCancel) and (ToFileName.Text <> '') then
  243.       ConfirmChange(Caption, FromFileName.Text, ToFileName.Text);
  244.   end;
  245. end;
  246.  
  247. procedure TFMForm.Open1Click(Sender: TObject);
  248. begin
  249.   with FileList do
  250.   begin
  251.     if HasAttr(FileName, faDirectory) then
  252.       DirectoryOutline.Directory := FileName
  253.     else ExecuteFile(FileName, '', Directory, SW_SHOW);
  254.   end;
  255. end;
  256.  
  257. procedure TFMForm.FileListMouseDown(Sender: TObject; Button: TMouseButton;
  258.   Shift: TShiftState; X, Y: Integer);
  259. begin
  260.   if Button = mbLeft then
  261.   with Sender as TFileListBox do
  262.   begin
  263.     if ItemAtPos(Point(X, Y), True) >= 0 then
  264.       BeginDrag(False);
  265.   end;
  266. end;
  267.  
  268. procedure TFMForm.DirectoryOutlineDragOver(Sender, Source: TObject; X,
  269.   Y: Integer; State: TDragState; var Accept: Boolean);
  270. begin
  271.   Accept := (Source is TFileListBox) and (DirectoryOutline.GetItem(X, Y) > 0);
  272. end;
  273.  
  274. procedure TFMForm.DirectoryOutlineDragDrop(Sender, Source: TObject; X,
  275.   Y: Integer);
  276. begin
  277.   if Source is TFileListBox then
  278.     with DirectoryOutline do
  279.       ConfirmChange('Move', FileList.FileName, Items[GetItem(X, Y)].FullPath);
  280. end;
  281.  
  282. procedure TFMForm.FileListEndDrag(Sender, Target: TObject; X, Y: Integer);
  283. begin
  284.   if Target <> nil then FileList.Update;
  285. end;
  286.  
  287. end.
  288.