⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frminfo.pas

📁 一个基于Socket的在线更新程序
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit frmInfo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, RzButton, ExtCtrls, RzPanel, RzBtnEdt, StdCtrls, Mask, RzEdit,
  RzLabel, ActnList, FileCtrl, ComCtrls, RzTreeVw, RzSplit, RzListVw,
  ImgList, Menus, hxSysUtils, hxFileRes, hxClasses, hxUpdate, RzSpnEdt, ShellApi,
  hxVersion;

type
  TInfoForm = class(TForm)
    ActionList1: TActionList;
    actOK: TAction;
    actCancel: TAction;
    RzPanel3: TRzPanel;
    RzLabel4: TRzLabel;
    edtProjectName: TRzEdit;
    edtRootDir: TRzButtonEdit;
    RzLabel2: TRzLabel;
    lvFiles: TRzListView;
    RzSizePanel1: TRzSizePanel;
    tvDirectory: TRzTreeView;
    ImageList1: TImageList;
    actSelectRoot: TAction;
    actAddFile: TAction;
    pmnuDirectory: TPopupMenu;
    N1: TMenuItem;
    RzPanel2: TRzPanel;
    RzLabel3: TRzLabel;
    actDeleteDirectory: TAction;
    N3: TMenuItem;
    pmnuFiles: TPopupMenu;
    N4: TMenuItem;
    N2: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    actDeleteFile: TAction;
    actRefreshFiles: TAction;
    actRefreshDirectory: TAction;
    N7: TMenuItem;
    N8: TMenuItem;
    RzPanel1: TRzPanel;
    RzButton1: TRzButton;
    RzButton2: TRzButton;
    dlgOpen: TOpenDialog;
    ImageList2: TImageList;
    actIncVersion: TAction;
    actDecVersion: TAction;
    N9: TMenuItem;
    N10: TMenuItem;
    actAddDirectory: TAction;
    A1: TMenuItem;
    N11: TMenuItem;
    edtDescription: TRzEdit;
    edtFloat: TRzEdit;
    actBrowseFiles: TAction;
    B1: TMenuItem;
    actRefreshVersion: TAction;
    N12: TMenuItem;
    procedure actOKExecute(Sender: TObject);
    procedure actCancelExecute(Sender: TObject);
    procedure lvFilesSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure edtPathKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edtRootDirButtonClick(Sender: TObject);
    procedure actSelectRootExecute(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure actDeleteDirectoryExecute(Sender: TObject);
    procedure actRefreshFilesExecute(Sender: TObject);
    procedure tvDirectoryChange(Sender: TObject; TreeNode: TTreeNode);
    procedure actRefreshDirectoryExecute(Sender: TObject);
    procedure actDeleteFileExecute(Sender: TObject);
    procedure actDeleteFileUpdate(Sender: TObject);
    procedure actAddFileExecute(Sender: TObject);
    procedure actAddFileUpdate(Sender: TObject);
    procedure edtFloatKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure lvFilesClick(Sender: TObject);
    procedure lvFilesGetImageIndex(Sender: TObject; Item: TListItem);
    procedure actDeleteDirectoryUpdate(Sender: TObject);
    procedure lvFilesColumnClick(Sender: TObject; Column: TListColumn);
    procedure lvFilesCompare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure actAddDirectoryExecute(Sender: TObject);
    procedure actAddDirectoryUpdate(Sender: TObject);
    procedure actBrowseFilesUpdate(Sender: TObject);
    procedure actBrowseFilesExecute(Sender: TObject);
    procedure actRefreshVersionExecute(Sender: TObject);
    procedure actRefreshVersionUpdate(Sender: TObject);
  private
    FResTree: TResTree;
    FSortIndex: Integer;
    FSortAsc: Integer;
    FDescription: string;
    FProjectName: string;
    FRootDir: string;
    function GetTreeNodeByResNode(ResNode: TResNode): TTreeNode;
    procedure RefreshTreeView(TreeNodes: TTreeNodes);
    procedure AddFileToListView(TreeNode: TTreeNode; FileName: string);
    procedure AddNodeToListView(ResNode: TResNode);
    procedure RefreshListView(ParentNode: TResNode);
    procedure SetDescription(const Value: string);
    procedure SetProjectName(const Value: string);
    procedure SetRootDir(const Value: string);
    function GetDescription: string;
    function GetProjectName: string;
    function GetRootDir: string;
  protected
    procedure DropFiles(var Msg: TMessage); message WM_DROPFILES;
  public
    constructor Create(AOwner: TComponent; AProjectItem: TProjectItem); reintroduce;
    destructor Destroy; override;
    property ProjectName: string read GetProjectName write SetProjectName;
    property RootDir: string read GetRootDir write SetRootDir;
    property Description: string read GetDescription write SetDescription;
    property ResTree: TResTree read FResTree;
  end;

  function ShowInfoForm(var AProjectName, ARootDir, ADescription: string): Boolean;

implementation

uses Math;

{$R *.dfm}

function ShowInfoForm(var AProjectName, ARootDir, ADescription: string): Boolean;
var
  Index: Integer;
  ProjectItem: TProjectItem;
begin
  Index:= GetProjectCollection.IndexOf(AProjectName);
  if Index <> -1 then // 修改
    ProjectItem:= GetProjectCollection.Items[Index]
  else  // 添加
    ProjectItem:= GetProjectCollection.Add('', '', '');

  with TInfoForm.Create(nil, ProjectItem) do
  try
    Result:= (ShowModal = mrOk);
    if Result then
    begin
      ProjectItem.RemoveResTree;
      ProjectItem.ProjectName:= ProjectName;
      ProjectItem.RootDir:= RootDir;
      ProjectItem.Description:= Description;
      ProjectItem.ResTree.Assign(ResTree);
      ProjectItem.SaveResTree;

      AProjectName:= ProjectName;
      ARootDir:= RootDir;
      ADescription:= Description;
    end
    else
    begin
      Index:= GetProjectCollection.IndexOf('');
      if Index <> -1 then GetProjectCollection.Delete(Index);
    end;
  finally
    Free;
  end;
end;

procedure TInfoForm.actOKExecute(Sender: TObject);
begin
  ModalResult:= mrOk;
end;

procedure TInfoForm.actCancelExecute(Sender: TObject);
begin
  ModalResult:= mrCancel;
end;

procedure TInfoForm.lvFilesSelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  if Selected then
  begin
    with lvFiles do
    begin
      edtFloat.Left:= Left + Column[0].Width + Column[1].Width + Item.Left;
      edtFloat.Top:= lvFiles.Top + Item.Top;
      edtFloat.Width:= lvFiles.Column[2].Width;
      edtFloat.Height:= 16;
      edtFloat.Text:= Item.SubItems[1];
    end;
    edtFloat.Visible:= True;
  end
  else
    edtFloat.Visible:= False;
end;

procedure TInfoForm.edtPathKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then
  begin
    lvFiles.Selected.SubItems[1]:= edtFloat.Text;
    edtFloat.Visible:= False;
  end;
end;

procedure TInfoForm.edtRootDirButtonClick(Sender: TObject);
begin
  actSelectRoot.Execute;
end;

procedure TInfoForm.actSelectRootExecute(Sender: TObject);
var
  szDir: string;
begin
  if SelectDirectory('选择目录', '', szDir) then
  begin
    RootDir:= szDir;
    FResTree.LoadFiles(szDir);
    RefreshTreeView(tvDirectory.Items);
  end;
end;

procedure TInfoForm.RefreshTreeView(TreeNodes: TTreeNodes);

  procedure TravelTree(ResNode: TResNode; TreeNode: TTreeNode);
  var
    I: Integer;
  begin
    Assert(ResNode <> nil);
    if PResInfo(ResNode.Data)^.ResType = rtDirectory then
    begin
      TreeNode:= TreeNodes.AddChild(TreeNode, ResNode.Text);
      TreeNode.Data:= ResNode;
    end;
    for I:= 0 to ResNode.Count - 1 do
      TravelTree(TResNode(ResNode.Children[I]), TreeNode);
  end;

var
  I: Integer;
  RootNode: TResNode;
  TreeNode: TTreeNode;
begin
  TreeNodes.BeginUpdate;
  try
    TreeNodes.Clear;
    RootNode:= TResNode(FResTree.RootNode);
    TreeNode:= TreeNodes.AddChild(nil, RootNode.Text);
    TreeNode.Data:= RootNode;
    for I:= 0 to RootNode.Count - 1 do
      TravelTree(TResNode(RootNode.Children[I]), TreeNode);
  finally
    TreeNodes.EndUpdate;
  end;
end;

procedure TInfoForm.actDeleteDirectoryExecute(Sender: TObject);
begin
  if tvDirectory.Selected <> nil then
  begin
    FResTree.RemoveNode(TResNode(tvDirectory.Selected.Data));
    tvDirectory.Items.Delete(tvDirectory.Selected);
  end;
end;

procedure TInfoForm.RefreshListView(ParentNode: TResNode);
var
  I: Integer;
  ResNode: TResNode;
begin
  lvFiles.Clear;
  if ParentNode = nil then Exit;
  for I:= 0 to ParentNode.Count - 1 do
  begin
    ResNode:= TResNode(ParentNode.Children[I]);
    if ResNode.Data = nil then Continue;
    AddNodeToListView(ResNode);
  end;
end;

procedure TInfoForm.actRefreshFilesExecute(Sender: TObject);
begin
  RefreshListView(TResNode(tvDirectory.Selected.Data));
end;

procedure TInfoForm.tvDirectoryChange(Sender: TObject; TreeNode: TTreeNode);
begin
  RefreshListView(TResNode(TreeNode.Data));

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -