ffiles.pas

Delphi编写的一个支持语法高亮显示和很多语言的文本编辑器

{$Q-}
{$RANGECHECKS OFF}
unit fFiles;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ShellApi, DockPanel, fMain,ExtCtrls, ComCtrls,FileCtrl, StrUtils,
  ShellCtrls, ShlObj, ElTree, uDialogSettings, ElXPThemedControl, uMyReg,
  ShellTree, ItemProp;

type
  TFrmFiles = class(TDockableForm)
    splitFiles: TSplitter;
    lvFiles: TListView;
    tvDirs: TShellTree;
    procedure dBoxChange(Sender: TObject);
    procedure lvFilesDblClick(Sender: TObject);
    procedure tvDirsClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure lvFilesKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure lvFilesMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    selIndex: Integer;
    ItemDraw: Integer;
    selDir: String;
    FMessageHandle : HWnd;    
    { Private declarations }
    procedure FillFiles(sDir: String);
    procedure FillDirs(sDir: String);
    procedure AddSubs(Path: string; Node: TElTreeItem);
    procedure PopupSystemContextMenu(Node : TListItem; Point : TPoint);
  public
    strStart: String;
    { Public declarations }
  end;


implementation

uses  uOptVars, dMain;

{$R *.DFM}

var
Drives     : Set of 0..25; //80^


procedure TfrmFiles.FillDirs(sDir: String);
var
  ADrive: integer;
  DriveLetter: char;
  DriveString: string;
  DrvName: string;
  Sfi: TSHFileInfo;
  Root: TElTreeItem;
  p: PChar;
  s: String;
  idRoot: PItemIDList;
begin
  Root := nil;
  tvDirs.Items.BeginUpdate;
  tvDirs.Items.Clear;
  if SHGetSpecialFolderLocation(Handle, CSIDL_DRIVES, idRoot) = NOERROR then
    if SHGetFileInfo(PChar(idRoot), 0, Sfi, SizeOf(TSHFileInfo), SHGFI_PIDL
      or SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_DISPLAYNAME) <> 0 then
    begin
//      Root := tvDirs.items.AddFirst(nil, Sfi.szDisplayName);
      Root.ImageIndex := Sfi.iIcon;
    end;
  Integer(Drives) := GetLogicalDrives;
  for ADrive := 0 to 25 do
  begin
    if (ADrive in Drives) then
    begin
      DriveLetter := Chr(ADrive + ord('A'));
      DriveString := DriveLetter + ':\';
      SHGetFileInfo(PChar(DriveString), 0, Sfi, SizeOf(Sfi),
        SHGFI_DISPLAYNAME);
      DrvName := Copy(Sfi.szDisplayName, 1, (Pos('(', Sfi.szDisplayName) - 1));
      with tvDirs.Items do
      begin
//        AddChild(Root, ' (' + DriveLetter + ':)  ' + DrvName);
        Item[Count - 1].ImageIndex := GetNormalIcon(DriveString);
//        Item[Count - 1].StateImageIndex := GetSelectedIcon(DriveString);
//        Item[Count-1].ForceButtons := True;
        s := DriveString;
        GetMem(p,Length(s) + 1);
        StrPCopy(p, s);
        Item[Count - 1].Data := p;
        if s = 'C:\' then selIndex := Count-1;
      end;
    end;
  end;
  tvDirs.Items.EndUpdate;
end;

procedure TfrmFiles.AddSubs(Path: string; Node: TElTreeItem);
var
  ANode: TElTreeItem;
  APath: string;
  hFindFile: THandle;
  Win32FD: TWin32FindData;
  s: String;
  p: PChar;

  function IsDirectory(dWin32FD: TWin32FindData): Boolean;
  var
    FName: string;
  begin
    FName := StrPas(dWin32FD.cFileName);
    with dWin32FD do
      Result := (dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY =
        FILE_ATTRIBUTE_DIRECTORY) and (FName <> '.') and (FName <> '..');
  end; {IsDirectory}

  function HasSubs(sPath: string): Boolean;
  var
    sAPath: string;
    shFindFile: THandle;
    sWin32FD: TWin32FindData;
  begin
    Result := False;
    sAPath := sPath;
    sAPath := AddSlash(sAPath);
    shFindFile := FindFirstFile(PChar(sAPath + '*.*'), sWin32FD);
    if shFindFile <> INVALID_HANDLE_VALUE then
    try
      repeat
        if IsDirectory(sWin32FD) then
        begin
          Result := True;
          Break;
        end;
      until not FindNextFile(shFindFile, sWin32FD);
    finally
      Windows.FindClose(shFindFile);
    end;
  end; {HasSubs}

begin
  APath := Path;
  APath := AddSlash(APath);
  hFindFile := FindFirstFile(PChar(APath + '*.*'), Win32FD);

  With tvDirs do begin
  if hFindFile <> INVALID_HANDLE_VALUE then
  try                                                      
    repeat
      if IsDirectory(Win32FD) then
      begin
//        ANode := Items.AddChild(Node, Win32FD.cFileName);
        ANode.ImageIndex := GetNormalIcon(APath + Win32FD.cFileName);
        ANode.StateImageIndex := GetSelectedIcon(APath + Win32FD.cFileName);
        ANode.ForceButtons := True;
        s := APath + Win32FD.cFilename;
        GetMem(p,Length(s) + 1);
        StrPCopy(p, s);
        ANode.Data := p;

      end;
    until not FindNextFile(hFindFile, Win32FD);
  finally
    Windows.FindClose(hFindFile);
  end;
  end;
end; {AddSubs}


procedure TfrmFiles.FillFiles(sDir: String);
var
  rec: TSearchRec;
  Icon: TIcon;
  b: Boolean;
  x: Integer;
begin
  if RightStr(sDir, 1) <> '\' then
    sDir := sDir + '\';
  lvFiles.Clear;
  LockWindowUpdate(lvFiles.Handle);
  b := (FindFirst(sDir + '*.*', faAnyFile, Rec)=0);
  Icon := TIcon.Create;
  While b do begin
    if (faDirectory and Rec.Attr) = 0 then begin
      With lvFiles.Items.Add do begin
        Caption := Rec.Name;
        SubItems.Add(IntToStr(Rec.Size));
        SubItems.Add(DateToStr(FileDateToDateTime(Rec.Time)));
        SubItems.Add(TimeToStr(FileDateToDateTime(Rec.Time)));
        subItems.Add(IntToStr(Rec.Attr));
        x := GetIconIndexFromFile(Rec.Name, True);
        dmMain.imlShellIcon.GetIcon(x, Icon);
        ImageIndex := GetNormalIcon(sDir + Rec.Name);
      end;
    end;
    b := (FindNext(Rec)=0);
  end;
  LockWindowUpdate(0);
end;

procedure TFrmFiles.dBoxChange(Sender: TObject);
begin
//  FillFiles(dBox.Directory);
end;

procedure TFrmFiles.lvFilesDblClick(Sender: TObject);
var
  sDir: String;
begin
  if lvFiles.Selected <> nil then begin
    sDir := tvDirs.Path;
    if sDir[Length(sDir)] <> '\' then SDir := sDir + '\';
    sDir := sDir + lvFiles.Selected.Caption;
    dmMain.NewDoc(sDir);
  end;
end;

procedure TFrmFiles.tvDirsClick(Sender: TObject);
begin
  selDir := tvDirs.Path;
  FillFiles(tvDirs.Path);
end;

procedure TFrmFiles.FormDestroy(Sender: TObject);
var
  reg: TMyReg;

begin
  reg := tMyReg.Create;
  reg.OpenKey('Software\cEdit\Files', true);
  reg.WriteReg('DefaultFolder', selDir);
  reg.Free;
  SaveOpts(Self);
end;

procedure TFrmFiles.FormShow(Sender: TObject);
var reg: TMyReg;
begin
//  tvDirs
  reg := tMyReg.Create;
  reg.OpenKey('Software\cEdit\Files', true);
  seldir := reg.ReadReg('DefaultFolder', tvDirs.Path);
  tvDirs.Path := selDir;
  LoadOpts(Self);
  FillFiles(tvDirs.Path);
  reg.free;

end;

procedure TFrmFiles.lvFilesKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  sDir: String;
begin
  if key = 13 then
    if lvFiles.Selected <> nil then begin
      sDir := tvDirs.Path;
      if sDir[Length(sDir)] <> '\' then SDir := sDir + '\';
      sDir := sDir + lvFiles.Selected.Caption;
      dmMain.NewDoc(sDir);
    end;
end;

procedure TfrmFiles.PopupSystemContextMenu(Node : TlistItem; Point : TPoint);
Var
  PISF : IShellFolder;
  Pidl : PItemIdList;
begin
  IF NOT Assigned(Node) then exit;
//  PISF:=Node.ParentShellFolder;
//  IF NOT Assigned(PISF) Then exit;
//  Pidl:=Node.RelativeIDL;
//  ItemProp.DisplayContextMenu(string(PISF),Pidl,0,FMessageHandle,Point,1);
  ItemProp.DisplayContextMenuPIDL(PISF,Pidl,0,
    Pointer(FMessageHandle), Point, 1);
end;

procedure TFrmFiles.lvFilesMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  sDir: String;
begin
  if button <> mbLeft then exit;
  if bSingleClick then
    if lvFiles.Selected <> nil then begin
      sDir := tvDirs.Path;
      if sDir[Length(sDir)] <> '\' then SDir := sDir + '\';
      sDir := sDir + lvFiles.Selected.Caption;
      dmMain.NewDoc(sDir);
    end;
end;

end.