disqlite3_drive_catalog_form_main.pas

来自「DELPHI 访问SQLITE3 数据库的VCL控件」· PAS 代码 · 共 2,023 行 · 第 1/5 页

{ This is an advanced demo to show some of the powers of DISQLite3.

  It implements a Drive Catalog application for indexing fixed and removable
  media for offline browsing and searching. It is fully Unicode compatible and
  maintains up to hundreds of thousand files and folders. This demo compiles
  with Delphi 6 or later.

  For data display, this project uses conrtols from the following Open Source
  libraries:

    * VirtualTrees - this powerful treeview component is used to display the
      folder tree and the file grids. It is more flexible, uses less memory,
      and is much faster than the standard TTreeView.

        http://www.soft-gems.net

    * Tnt Delphi Unicode Controls - all controls in this collection are Unicode
      aware on WinNT and later and also work on Win9x. They replace the standard
      Delphi controls like edits, checkboxes, and menus.

        http://www.tntware.com/delphicontrols/unicode/

  Visit the DISQLite3 Internet site for latest information and updates:

    http://www.yunqa.de/delphi/

  Copyright (c) 2005-2007 Ralf Junker, The Delphi Inspiration <[e-mail]>

------------------------------------------------------------------------------ }

unit DISQLite3_Drive_Catalog_Form_Main;

{$I DI.inc}
{$I DISQLite3.inc}

interface

uses
  Types, Classes, Graphics, ImgList, Controls, Forms, StdCtrls, ComCtrls,
  ExtCtrls, ActnList, Menus,
  TntForms, TntStdCtrls, TntComCtrls, TntActnList, TntMenus, // On error, read comment on top.
  VirtualTrees, // On compile error, comment on top.
  DISQLite3_Drive_Catalog_DB;

type

  //------------------------------------------------------------------------------
  // Main Form
  //------------------------------------------------------------------------------

  TfrmMain = class(TtntForm)
    Splitter1: TSplitter;
    mnuMain: TTntMainMenu;
    mnuFile: TTntMenuItem;
    mnuFile_OpenDatabase: TTntMenuItem;
    mnuFile_CloseDatabase: TTntMenuItem;
    ActionList: TTntActionList;
    mnuEdit: TTntMenuItem;
    AddDriveFolder1: TTntMenuItem;
    RemoveSelected1: TTntMenuItem;
    ImageList: TImageList;
    StatusBar: TTntStatusBar;
    NewDatabase1: TTntMenuItem;
    pnlLeft: TPanel;
    pnlLeftTop: TPanel;
    pnlSearchOptions: TPanel;
    pnlFind: TPanel;
    FolderTree: TVirtualStringTree;
    edtSearch: TTntEdit;
    btnSearch: TTntButton;
    mnuView: TTntMenuItem;
    mnuView_SearchOptions: TTntMenuItem;
    PageControl: TTntPageControl;
    tabFiles: TTntTabSheet;
    FileTree: TVirtualStringTree;
    tabSearchResult: TTntTabSheet;
    SearchResultTree: TVirtualStringTree;
    lblReport: TLabel;
    CollapseTree1: TTntMenuItem;
    actView_CollapseTree: TTntAction;
    actSearch: TTntAction;
    actView_SearchOptions: TTntAction;
    actFile_NewDatabase: TTntAction;
    actEdit_RemoveSelected: TTntAction;
    actEdit_AddDrive: TTntAction;
    actFile_CloseDatabase: TTntAction;
    actFile_OpenDatabase: TTntAction;
    actView_ClearSearchResult: TTntAction;
    mnuView_ClearSearchResult: TTntMenuItem;
    procedure Form_Create(Sender: TObject);
    procedure Form_Destroy(Sender: TObject);
    procedure FolderTree_GetText(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure FolderTree_InitChildren(Sender: TBaseVirtualTree;
      Node: PVirtualNode; var ChildCount: Cardinal);
    procedure FolderTree_FocusChanged(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex);
    procedure FileTree_GetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure FileTree_GetImageIndex(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
      var Ghosted: Boolean; var ImageIndex: Integer);
    procedure actFile_OpenDatabase_Execute(Sender: TObject);
    procedure actFile_CloseDatabase_Execute(Sender: TObject);
    procedure act_DatabaseIsOpen(Sender: TObject);
    procedure actEdit_AddDrive_Execute(Sender: TObject);
    procedure actEdit_RemoveSelected_Update(Sender: TObject);
    procedure actEdit_RemoveSelected_Execute(Sender: TObject);
    procedure FolderTree_GetImageIndexEx(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
      var Ghosted: Boolean; var ImageIndex: Integer;
      var ImageList: TCustomImageList);
    procedure FolderTree_Resize(Sender: TObject);
    procedure FolderTree_Change(Sender: TBaseVirtualTree;
      Node: PVirtualNode);
    procedure FileTree_Change(Sender: TBaseVirtualTree; Node: PVirtualNode);
    procedure FolderTree_CompareNodes(Sender: TBaseVirtualTree; Node1,
      Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
    procedure actFile_NewDatabase_Execute(Sender: TObject);
    procedure FolderTree_Editing(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
    procedure FolderTree_NewText(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; NewText: WideString);
    procedure FileTree_NewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; NewText: WideString);
    procedure FileTree_Editing(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; var Allowed: Boolean);
    procedure FileTree_Edited(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex);
    procedure FileTree_CompareNodes(Sender: TBaseVirtualTree; Node1,
      Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
    procedure FolderTree_Edited(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex);
    procedure FileTree_HeaderClick(Sender: TVTHeader; Column: TColumnIndex;
      Button: TMouseButton; Shift: TShiftState; x, y: Integer);
    procedure actView_SearchOptions_Execute(Sender: TObject);
    procedure actView_SearchOptions_Update(Sender: TObject);
    procedure FileTree_DblClick(Sender: TObject);
    procedure SearchResultTree_GetText(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure SearchResultTree_GetImageIndex(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
      var Ghosted: Boolean; var ImageIndex: Integer);
    procedure actSearch_Execute(Sender: TObject);
    procedure Tree_IncrementalSearch(Sender: TBaseVirtualTree;
      Node: PVirtualNode; const SearchText: WideString;
      var Result: Integer);
    procedure edtSearch_KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SearchResultTree_Change(Sender: TBaseVirtualTree;
      Node: PVirtualNode);
    procedure SearchResultTree_DblClick(Sender: TObject);
    procedure PageControl_Change(Sender: TObject);
    procedure SearchResultTree_CompareNodes(Sender: TBaseVirtualTree; Node1,
      Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
    procedure SearchResultTree_HeaderClick(Sender: TVTHeader;
      Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; x,
      y: Integer);
    procedure lblReport_MouseEnter(Sender: TObject);
    procedure lblReport_MouseLeave(Sender: TObject);
    procedure lblReport_Click(Sender: TObject);
    procedure actView_CollapseTree_Execute(Sender: TObject);
    procedure actView_CollapseTree_Update(Sender: TObject);
    procedure FolderTree_Collapsed(Sender: TBaseVirtualTree;
      Node: PVirtualNode);
    procedure Tree_PaintText(Sender: TBaseVirtualTree;
      const TargetCanvas: TCanvas; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType);
    procedure FileTree_KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SearchResultTree_KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure actView_ClearSearchResult_Execute(Sender: TObject);
    procedure actView_ClearSearchResult_Update(Sender: TObject);
  private
    FDb: TDriveCatalogDB;
    FImageList: TImageList;
    FNormalFolderIconIndex: Integer;
    FOpenFolderIconIndex: Integer;
    FFileTreeParentID: Int64;

    procedure FileTree_FocusID(const AID: Int64);

    function FileTree_GetNodeFromID(
      const AID: Int64): PVirtualNode;

    { Shows files in FileTree. Returns number of files added. }
    function FileTree_ShowFiles(
      const AParentID: Int64): Cardinal;

    { Optimized sorting routine. }
    procedure FileTree_Sort;

    { Adds folders to FolderTree. Returns number of folders added. }
    function FolderTree_AddFolders(
      const AParentNode: PVirtualNode;
      const AParentID: Int64): Cardinal;

    { Shows the folder which contains the file with ID. }
    procedure FolderTree_FocusID(
      const AID: Int64);

    procedure FolderTree_UpdateIdPath(
      const AFolderID: Int64);

    procedure FolderTree_CompareNodeID(
      Sender: TBaseVirtualTree;
      Node: PVirtualNode;
      Data: Pointer;
      var Abort: Boolean);

    procedure UpdateStatusBar;

  protected

    { Performs the node's action if the node has been double-clicked
      or the return key has been pressed. }
    procedure FileTree_NodeAction(const ANode: PVirtualNode);

    { Adds all volumes in the catalog databse to the FolderTree.
      Returns the number of volumes / nodes added. }
    function FolderTree_AddVolumes(const AParentNode: PVirtualNode = nil): Cardinal;

    { Returns the with the given ID. }
    function FolderTree_GetNodeFromID(
      const AID: Int64;
      const AParentNode: PVirtualNode = nil): PVirtualNode;

    { Returns the node corresponding to the path of IDs. }
    function FolderTree_GetNodeFromPath(
      const AIdPath: TInt64DynArray): PVirtualNode;

    { Removes the FolderTree's selected volumes and / or folders
      from the catalog database. }
    procedure FolderTree_RemoveSelected;

    { Selects a single node only and makes it the focused node.
      Returns True if the focuse changed to another node. }
    function FolderTree_SelectAndFocus(
      const ANode: PVirtualNode): Boolean;

    { Updates the node and its parents by requerying the database. }
    procedure FolderTree_UpdateNodePath(
      Node: PVirtualNode);

    { Removes nodes representing deleted records from the tree. }
    procedure FileTree_Purge;

    { Removes the FileTree's selected files from the catalog database. }
    procedure FileTree_RemoveSelected;

    { Performs the node's action if the node has been double-clicked
      or the return key has been pressed. }
    procedure SearchResultTree_NodeAction(
      const ANode: PVirtualNode);

    { Removes nodes representing deleted records from the tree. }
    procedure SearchResultTree_Purge;

    { Removes the SearchResult's selected files from the catalog database. }
    procedure SearchResultTree_RemoveSelected;

  public

    { Adds a single volumen / drive to the FolderTree. This is used to update
      the FolderTree after a new volume has been scanned. }
    procedure FolderTree_AddVolume(const AID: Int64);

    procedure BeginUpdate;

    { Closes the database. }
    procedure CloseDatabase;

    { Creates a new database. }
    procedure CreateDatabase(const AFileName: WideString);

    procedure EndUpdate;

    { Opens an existing database. }
    procedure OpenDatabase(const AFileName: WideString);
  end;

const
  APP_TITLE = 'DISQLite3' + {$IFDEF DISQLite3_Personal} ' Personal' + {$ENDIF} ': Drive Catalog';

var
  frmMain: TfrmMain;

implementation

uses
  Windows, ShellAPI, SysUtils, Dialogs,
  TntWindows, TntSystem, TntSysUtils, TntDialogs,
  DISQLite3Api, DISQLite3Database, {$IFNDEF DISQLite3_Personal}DISQLite3Collations, {$ENDIF}
  DISQLite3_Drive_Catalog_Form_Add;

{$R *.dfm}

type
  { The data type associated with each node of the tree and grid.
    It stores a RowID to reference the node's record in the database. }
  TNodeData = record
    ID: Int64
  end;
  PNodeData = ^TNodeData;

  //------------------------------------------------------------------------------
  // Form related.
  //------------------------------------------------------------------------------

procedure TfrmMain.Form_Create(Sender: TObject);
var
  Info: TShFileInfo;
  FN: WideString;
begin
  Caption := APP_TITLE;

  FImageList := TImageList.Create(Self);
  FImageList.ShareImages := True;
  { pszPath = '' is required. pszPath = nil does not work with WinNT 4.0. }
  FImageList.Handle := ShGetFileInfo('', 0, Info, SizeOf(Info), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);

  { pszPath = '*' is required. pszPath = nil returns incorrect icons when
    the application is located from a LAN. }
  if ShGetFileInfo('*', FILE_ATTRIBUTE_DIRECTORY, Info, SizeOf(Info), SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX or SHGFI_SMALLICON) <> 0 then
    FNormalFolderIconIndex := Info.iIcon
  else
    FNormalFolderIconIndex := -1;

  if ShGetFileInfo('*', FILE_ATTRIBUTE_DIRECTORY, Info, SizeOf(Info), SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_OPENICON) <> 0 then
    FOpenFolderIconIndex := Info.iIcon
  else
    FOpenFolderIconIndex := -1;

  FolderTree.Images := FImageList;
  FolderTree.NodeDataSize := SizeOf(TNodeData);

  FileTree.Images := FImageList;
  FileTree.NodeDataSize := SizeOf(TNodeData);

  SearchResultTree.Images := FImageList;
  SearchResultTree.NodeDataSize := SizeOf(TNodeData);

  FDb := TDriveCatalogDB.Create(nil);

  { Handle command line parameters. }
  FN := WideParamStr(1);
  if FN <> '' then
    OpenDatabase(FN);
end;

//------------------------------------------------------------------------------

procedure TfrmMain.Form_Destroy(Sender: TObject);
begin
  CloseDatabase;
  FDb.Free;
  FImageList.Free;
end;

//------------------------------------------------------------------------------

procedure TfrmMain.BeginUpdate;
begin
  FolderTree.BeginUpdate;
  FileTree.BeginUpdate;
end;

//------------------------------------------------------------------------------

procedure TfrmMain.CloseDatabase;
begin
  BeginUpdate;
  try
    FolderTree.Clear;
    FileTree.Clear;
    SearchResultTree.Clear;

    Caption := APP_TITLE;

    FDb.Close;
  finally
    EndUpdate;
  end;
end;

//------------------------------------------------------------------------------

procedure TfrmMain.CreateDatabase(const AFileName: WideString);
begin
  CloseDatabase;
  FDb.DatabaseName := AFileName;
  FDb.CreateDatabase;
  actEdit_AddDrive.Execute;
end;

//------------------------------------------------------------------------------

procedure TfrmMain.EndUpdate;
begin
  FolderTree.EndUpdate;
  FileTree.EndUpdate;