disqlite3_drive_catalog_form_main.pas

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

end;

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

procedure TfrmMain.OpenDatabase(const AFileName: WideString);
var
  NewFocusedNode: PVirtualNode;
begin
  CloseDatabase;
  FDb.DatabaseName := AFileName;
  FDb.Open;

  BeginUpdate;
  try
    FolderTree_AddVolumes;
    NewFocusedNode := FolderTree.GetFirst;
    if Assigned(NewFocusedNode) then
      begin
        FolderTree.Selected[NewFocusedNode] := True;
        FolderTree.FocusedNode := NewFocusedNode;
      end;
  finally
    EndUpdate;
  end;
end;

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

procedure TfrmMain.UpdateStatusBar;
var
  i: Integer;
  Tree: TVirtualStringTree;
begin
  { FolderTree. }

  i := FolderTree.SelectedCount;
  if i = 0 then
    StatusBar.Panels[0].Text := ''
  else
    StatusBar.Panels[0].Text := {$IFDEF COMPILER_9_UP}WideFormat{$ELSE}Tnt_WideFormat{$ENDIF}('%d selected', [i]);

  { FileTree or SearchResultTree. }

  if PageControl.ActivePage = tabFiles then
    Tree := FileTree
  else
    Tree := SearchResultTree;

  i := Tree.SelectedCount;
  if i = 0 then
    StatusBar.Panels[1].Text := {$IFDEF COMPILER_9_UP}WideFormat{$ELSE}Tnt_WideFormat{$ENDIF}('%d objects', [Tree.RootNodeCount])
  else
    StatusBar.Panels[1].Text := {$IFDEF COMPILER_9_UP}WideFormat{$ELSE}Tnt_WideFormat{$ENDIF}('%d objects, %d selected', [Tree.RootNodeCount, i]);
end;

//------------------------------------------------------------------------------
// All trees related.
//------------------------------------------------------------------------------

{ Implements an incremental search with no case sensitivity. }
procedure TfrmMain.Tree_IncrementalSearch(
  Sender: TBaseVirtualTree;
  Node: PVirtualNode;
  const SearchText: WideString;
  var Result: Integer);
begin
  with Sender as TVirtualStringTree do
    if Pos(WideUpperCase(SearchText), WideUpperCase(Text[Node, FocusedColumn])) <> 1 then
      Result := 1;
end;

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

procedure TfrmMain.Tree_PaintText(
  Sender: TBaseVirtualTree;
  const TargetCanvas: TCanvas;
  Node: PVirtualNode;
  Column: TColumnIndex;
  TextType: TVSTTextType);
var
  NodeData: PNodeData;
  FileData: PFileData;
begin
  if Column = 0 then
    begin
      NodeData := Sender.GetNodeData(Node);
      FileData := FDb.GetFileData(NodeData^.ID);
      if FileData^.Attri and FILE_ATTRIBUTE_COMPRESSED <> 0 then
        TargetCanvas.Font.Color := clBlue;
    end;
end;

//------------------------------------------------------------------------------
// FolderTree related.
//------------------------------------------------------------------------------

procedure TfrmMain.FolderTree_AddVolume(const AID: Int64);
var
  Stmt, Stmt_HasSubfolders: TDISQLite3Statement;
  Node: PVirtualNode;
  NodeData: PNodeData;
begin
  BeginUpdate;
  try
    Stmt := FDb.Prepare(
      'SELECT "ID" FROM "Files" WHERE "ID"=? AND "Type"=2;');
    Stmt_HasSubfolders := FDb.Prepare(
      'SELECT "ID" FROM "Files" WHERE "Parent"=? AND "Type"=1;');
    try
      Stmt.bind_Int64(1, AID);

      if Stmt.Step = SQLITE_ROW then
        begin
          Node := FolderTree.AddChild(nil);
          NodeData := FolderTree.GetNodeData(Node);
          NodeData^.ID := Stmt.column_int64(0);

          { Check if the folder has subfolders. }
          Stmt_HasSubfolders.bind_Int64(1, NodeData^.ID);
          if Stmt_HasSubfolders.Step = SQLITE_ROW then
            FolderTree.HasChildren[Node] := True;
          Stmt_HasSubfolders.Reset;
          FolderTree.Sort(nil, 0, sdAscending, False);
        end;
    finally
      Stmt_HasSubfolders.Free;
      Stmt.Free;
    end;
  finally
    EndUpdate;
  end;
end;

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

function TfrmMain.FolderTree_AddVolumes(const AParentNode: PVirtualNode = nil): Cardinal;
var
  Stmt, Stmt_HasSubfolders: TDISQLite3Statement;
  Node: PVirtualNode;
  NodeData: PNodeData;
begin
  BeginUpdate;
  Result := 0;
  try
    { Include both "Parent"=0 AND "Type"=2 into the WHERE clause to make it
      compatible to the index. "Parent"=0 is not actually necessary to ensure
      correct results, but it enables the index search which is drastically
      faster than without "Parent"=0. }
    Stmt := FDb.Prepare(
      'SELECT "ID" FROM "Files" WHERE "Parent"=0 AND "Type"=2 ORDER BY Name COLLATE NOCASE;');
    Stmt_HasSubfolders := FDb.Prepare(
      'SELECT "ID" FROM "Files" WHERE "Parent"=? AND "Type"=1;');
    try
      while Stmt.Step = SQLITE_ROW do
        begin
          Node := FolderTree.AddChild(AParentNode);
          NodeData := FolderTree.GetNodeData(Node);
          NodeData^.ID := Stmt.column_int64(0);

          { Check if the folder has subfolders. }
          Stmt_HasSubfolders.bind_Int64(1, NodeData^.ID);
          if Stmt_HasSubfolders.Step = SQLITE_ROW then
            FolderTree.HasChildren[Node] := True;
          Stmt_HasSubfolders.Reset;

          Inc(Result);
        end;
    finally
      Stmt_HasSubfolders.Free;
      Stmt.Free;
    end;
  finally
    EndUpdate;
  end;
end;

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

function TfrmMain.FolderTree_AddFolders(
  const AParentNode: PVirtualNode;
  const AParentID: Int64): Cardinal;
var
  Stmt, Stmt_HasSubfolders: TDISQLite3Statement;
  Node: PVirtualNode;
  NodeData: PNodeData;
begin
  BeginUpdate;
  Result := 0;
  try
    Stmt := FDb.Prepare(
      'SELECT "ID" FROM "Files" WHERE "Parent"=? AND "Type"=1 ORDER BY Name COLLATE NOCASE;');
    Stmt_HasSubfolders := FDb.Prepare(
      'SELECT "ID" FROM "Files" WHERE "Parent"=? AND "Type"=1;');
    try
      Stmt.bind_Int64(1, AParentID);

      while Stmt.Step = SQLITE_ROW do
        begin
          Node := FolderTree.AddChild(AParentNode);
          NodeData := FolderTree.GetNodeData(Node);
          NodeData^.ID := Stmt.column_int64(0);

          { Check if the folder has subfolders. }
          Stmt_HasSubfolders.bind_Int64(1, NodeData^.ID);
          if Stmt_HasSubfolders.Step = SQLITE_ROW then
            FolderTree.HasChildren[Node] := True;
          Stmt_HasSubfolders.Reset;

          Inc(Result);
        end;
    finally
      Stmt_HasSubfolders.Free;
      Stmt.Free;
    end;
  finally
    EndUpdate;
  end;
end;

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

procedure TfrmMain.FolderTree_Change(Sender: TBaseVirtualTree; Node: PVirtualNode);
begin
  UpdateStatusBar;
end;

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

procedure TfrmMain.FolderTree_Collapsed(Sender: TBaseVirtualTree; Node: PVirtualNode);
begin
  if Sender.HasAsParent(Sender.FocusedNode, Node) then
    FolderTree_SelectAndFocus(Node);
end;

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

procedure TfrmMain.FolderTree_CompareNodes(
  Sender: TBaseVirtualTree;
  Node1, Node2: PVirtualNode;
  Column: TColumnIndex;
  var Result: Integer);
var
  NodeData1, NodeData2: PNodeData;
  FileData1, FileData2: PFileData;
begin
  NodeData1 := FolderTree.GetNodeData(Node1);
  FileData1 := FDb.GetFileData(NodeData1^.ID);
  NodeData2 := FolderTree.GetNodeData(Node2);
  FileData2 := FDb.GetFileData(NodeData2^.ID);
  Result := WideCompareText(FileData1^.Name, FileData2^.Name);
end;

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

procedure TfrmMain.FolderTree_Edited(
  Sender: TBaseVirtualTree;
  Node: PVirtualNode;
  Column: TColumnIndex);
begin
  case Column of
    0: // Name
      with FolderTree do
        begin
          Sort(NodeParent[Node], Column, sdAscending, False);
          ScrollIntoView(Node, False);
          FolderTree_Change(FolderTree, FolderTree.FocusedNode);
        end;
  end;
end;

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

procedure TfrmMain.FolderTree_Editing(
  Sender: TBaseVirtualTree;
  Node: PVirtualNode;
  Column: TColumnIndex;
  var Allowed: Boolean);
begin
  Allowed := Column = 0;
end;

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

procedure TfrmMain.FolderTree_FocusChanged(
  Sender: TBaseVirtualTree;
  Node: PVirtualNode;
  Column: TColumnIndex);
var
  NodeData: PNodeData;
  Volume, FullPath: WideString;
begin
  if Assigned(Node) then
    begin
      NodeData := Sender.GetNodeData(Node);
      if FDb.GetVolumeFullPath(NodeData^.ID, Volume, FullPath) then
        Caption := Volume + ' - ' + FullPath;
      FileTree_ShowFiles(NodeData^.ID);
      PageControl.ActivePage := tabFiles;
    end
  else
    begin
      Caption := APP_TITLE;
      FileTree.Clear;
    end;
  UpdateStatusBar;
end;

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

procedure TfrmMain.FolderTree_GetImageIndexEx(
  Sender: TBaseVirtualTree;
  Node: PVirtualNode;
  Kind: TVTImageKind;
  Column: TColumnIndex;
  var Ghosted: Boolean;
  var ImageIndex: Integer;
  var ImageList: TCustomImageList);
var
  NodeData: PNodeData;
  FileData: PFileData;
begin
  case Kind of
    ikNormal, ikSelected:
      if Column = FolderTree.Header.MainColumn then
        begin
          NodeData := Sender.GetNodeData(Node);
          FileData := FDb.GetFileData(NodeData^.ID);
          if FileData^.Attri = FILE_ATTRIBUTE_VOLUME then
            begin
              ImageIndex := 0;
              ImageList := Self.ImageList;
            end
          else // If not a volume, node must be a folder
            if (Sender.FocusedNode = Node) or Sender.Expanded[Node] then
              ImageIndex := FOpenFolderIconIndex
            else
              ImageIndex := FNormalFolderIconIndex;
        end;
  end;
end;

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

{ This is a callback for the function following below. }
procedure TfrmMain.FolderTree_CompareNodeID(
  Sender: TBaseVirtualTree;
  Node: PVirtualNode;
  Data: Pointer;
  var Abort: Boolean);
var
  NodeData: PNodeData;
begin
  NodeData := Sender.GetNodeData(Node);
  if NodeData^.ID = PInt64(Data)^ then
    Abort := True;
end;

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

function TfrmMain.FolderTree_GetNodeFromID(const AID: Int64; const AParentNode: PVirtualNode = nil): PVirtualNode;
begin
  Result := FolderTree.IterateSubtree(AParentNode, FolderTree_CompareNodeID, @AID);
end;

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

function TfrmMain.FolderTree_GetNodeFromPath(const AIdPath: TInt64DynArray): PVirtualNode;
var
  i: Integer;
  NodeData: PNodeData;
begin
  Result := nil;
  for i := Low(AIdPath) to High(AIdPath) do
    begin
      Result := FolderTree.GetFirstChild(Result);
      while Assigned(Result) do
        begin
          NodeData := FolderTree.GetNodeData(Result);
          if NodeData^.ID = AIdPath[i] then
            Break;
          Result := FolderTree.GetNextSibling(Result)
        end;
      if not Assigned(Result) then
        Break;
    end;
end;

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

procedure TfrmMain.FolderTree_GetText(
  Sender: TBaseVirtualTree;
  Node: PVirtualNode;
  Column: TColumnIndex;
  TextType: TVSTTextType;
  var CellText: WideString);
var
  d: Double;
  NodeData: PNodeData;
  FileData: PFileData;
begin
  NodeData := FolderTree.GetNodeData(Node);
  FileData := FDb.GetFileData(NodeData^.ID);
  case Column of
    0: CellText := FileData^.Name;
    1: if FileData^.Size >= 0 then