disqlite3_drive_catalog_form_main.pas

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

        if Column = SortColumn then
          if SortDirection = sdAscending then
            SortDirection := sdDescending
          else
            SortDirection := sdAscending
        else
          begin
            SortColumn := NoColumn; // Disable sorting when to prevent sorting twice.
            SortDirection := sdAscending;
            SortColumn := Column;
          end;
        Sort(nil, SortColumn, SortDirection);
        ScrollIntoView(FocusedNode, False);
      end;
end;

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

procedure TfrmMain.SearchResultTree_KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_RETURN:
      SearchResultTree_NodeAction(SearchResultTree.FocusedNode);
  end;
end;

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

procedure TfrmMain.SearchResultTree_NodeAction(const ANode: PVirtualNode);
var
  NodeData: PNodeData;
  FileData: PFileData;
begin
  if Assigned(ANode) then
    begin
      NodeData := SearchResultTree.GetNodeData(ANode);
      FileData := FDb.GetFileData(NodeData^.ID);
      if Assigned(FileData) then
        begin
          FolderTree_FocusID(FileData^.Parent);
          FileTree_FocusID(NodeData^.ID);
          PageControl.ActivePage := tabFiles;
        end;
    end;
end;

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

procedure TfrmMain.SearchResultTree_Purge;
var
  Node, NextNode, NewFocusedNode: PVirtualNode;
  NodeData: PNodeData;
  Stmt: TDISQLite3Statement;
begin
  SearchResultTree.BeginUpdate;
  try
    Node := SearchResultTree.GetFirst;
    if Assigned(Node) then
      begin
        Stmt := FDb.Prepare('SELECT "ID" FROM "Files" WHERE "ID"=?;');
        try
          NewFocusedNode := SearchResultTree.FocusedNode;
          repeat
            NodeData := SearchResultTree.GetNodeData(Node);
            Stmt.bind_Int64(1, NodeData^.ID);
            if not Stmt.Step = SQLITE_ROW then
              begin
                { If node is not in the DB anymore, find a new focused node
                  and delete the node. }
                if NewFocusedNode = Node then
                  begin
                    NewFocusedNode := SearchResultTree.GetNextSibling(Node);
                    if not Assigned(NewFocusedNode) then
                      NewFocusedNode := SearchResultTree.GetPreviousSibling(Node);
                  end;
                NextNode := SearchResultTree.GetNextSibling(Node);
                SearchResultTree.DeleteNode(Node);
                Node := NextNode;
              end
            else
              Node := SearchResultTree.GetNextSibling(Node);
            Stmt.Reset;
          until not Assigned(Node);

          if NewFocusedNode <> SearchResultTree.FocusedNode then
            begin
              SearchResultTree.ClearSelection;
              SearchResultTree.Selected[NewFocusedNode] := True;
              SearchResultTree.FocusedNode := NewFocusedNode;
            end;
        finally
          Stmt.Free;
        end;
      end;
  finally
    SearchResultTree.EndUpdate;
  end;
end;

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

procedure TfrmMain.SearchResultTree_RemoveSelected;
var
  Node, NewFocusedNode: PVirtualNode;
  NodeData: PNodeData;
  ParentID: Int64;
begin
  BeginUpdate;
  try
    Node := SearchResultTree.GetFirstSelected;
    if Assigned(Node) then
      begin
        FDb.StartTransaction;
        try
          { Delete selected nodes from DB. }
          NewFocusedNode := SearchResultTree.FocusedNode;
          repeat
            NodeData := SearchResultTree.GetNodeData(Node);
            ParentID := FDb.Delete(NodeData^.ID);
            if NewFocusedNode = Node then
              begin
                NewFocusedNode := SearchResultTree.GetNextSibling(Node);
                if not Assigned(NewFocusedNode) then
                  NewFocusedNode := SearchResultTree.GetPreviousSibling(Node);
              end;
            FolderTree_UpdateIdPath(ParentID);
            Node := SearchResultTree.GetNextSelected(Node);
          until not Assigned(Node);
          FDb.Commit;

          { Delete selected nodes from tree, set new focus and selection. }
          SearchResultTree.DeleteSelectedNodes;
          if NewFocusedNode <> FileTree.FocusedNode then
            begin
              SearchResultTree.Selected[NewFocusedNode] := True;
              SearchResultTree.FocusedNode := NewFocusedNode;
            end;
          FileTree_Purge;

          FDb.Invalidate;
        except
          FDb.Rollback;
          raise;
        end;
      end;
  finally
    EndUpdate;
  end;
end;

//------------------------------------------------------------------------------
// Action events
//------------------------------------------------------------------------------

procedure TfrmMain.act_DatabaseIsOpen(Sender: TObject);
begin
  (Sender as TAction).Enabled := FDb.Connected;
end;

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

procedure TfrmMain.actFile_NewDatabase_Execute(Sender: TObject);
begin
  with TTntSaveDialog.Create(nil) do
    try
      DefaultExt := DIALOG_DATABASE_DEFAULTEXT;
      Filter := DIALOG_DATABASE_FILTER;
      Options := [ofDontAddToRecent, ofEnableSizing, ofFileMustExist, ofOverwritePrompt];
      if Execute then
        CreateDatabase(FileName);
    finally
      Free;
    end;
end;

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

procedure TfrmMain.actFile_OpenDatabase_Execute(Sender: TObject);
begin
  with TtntOpenDialog.Create(nil) do
    try
      DefaultExt := DIALOG_DATABASE_DEFAULTEXT;
      Filter := DIALOG_DATABASE_FILTER;
      Options := [ofDontAddToRecent, ofEnableSizing, ofFileMustExist];
      if Execute then
        OpenDatabase(FileName);
    finally
      Free;
    end;
end;

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

procedure TfrmMain.actFile_CloseDatabase_Execute(Sender: TObject);
begin
  CloseDatabase;
end;

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

procedure TfrmMain.actEdit_AddDrive_Execute(Sender: TObject);
var
  DriveChar: AnsiChar;
  DriveString: AnsiString;
  FirstDrive: AnsiString;
begin
  with TfrmAdd.Create(Self) do
    try
      DB := FDb;

      { Find first CD-ROM or fixed drive. }
      FirstDrive := '';
      for DriveChar := 'A' to 'Z' do
        begin
          DriveString := DriveChar + ':\';
          case GetDriveType(Pointer(DriveString)) of
            DRIVE_FIXED:
              begin
                if FirstDrive = '' then
                  FirstDrive := DriveString;
              end;
            DRIVE_CDROM:
              begin
                FirstDrive := DriveString;
                Break;
              end;
          end;
        end;

      edtRootFolder.Text := FirstDrive;
      ShowModal;
    finally
      Free;
    end;
end;

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

procedure TfrmMain.actEdit_RemoveSelected_Execute(Sender: TObject);
begin
  if ActiveControl = FolderTree then
    FolderTree_RemoveSelected
  else
    if ActiveControl = FileTree then
      FileTree_RemoveSelected
    else
      if ActiveControl = SearchResultTree then
        SearchResultTree_RemoveSelected;
end;

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

procedure TfrmMain.actEdit_RemoveSelected_Update(Sender: TObject);
begin
  actEdit_RemoveSelected.Enabled :=
    FDb.Connected and (
    ((ActiveControl = FolderTree) and (FolderTree.SelectedCount > 0)) or
    ((ActiveControl = FileTree) and (FileTree.SelectedCount > 0)) or
    ((ActiveControl = SearchResultTree) and (SearchResultTree.SelectedCount > 0)));
end;

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

procedure TfrmMain.actView_ClearSearchResult_Update(Sender: TObject);
begin
  actView_ClearSearchResult.Enabled := SearchResultTree.RootNodeCount > 0;
end;

procedure TfrmMain.actView_ClearSearchResult_Execute(Sender: TObject);
begin
  SearchResultTree.Clear;
end;

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

procedure TfrmMain.actView_SearchOptions_Execute(Sender: TObject);
begin
  pnlSearchOptions.Visible := not pnlSearchOptions.Visible;
end;

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

procedure TfrmMain.actView_SearchOptions_Update(Sender: TObject);
begin
  (Sender as TAction).Checked := pnlSearchOptions.Visible;
end;

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

procedure TfrmMain.actView_CollapseTree_Execute(Sender: TObject);
begin
  FolderTree.FullCollapse;
end;

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

procedure TfrmMain.actView_CollapseTree_Update(Sender: TObject);
begin
  (Sender as TAction).Enabled := FolderTree.VisibleCount > 0;
end;

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

procedure TfrmMain.actSearch_Execute(Sender: TObject);
const
  ESCAPE_CHAR = '\';
  SQL = 'SELECT "ID" FROM "Files" WHERE ("Type"=0 OR "Type"=1) AND "Name" LIKE ? ESCAPE ''' + ESCAPE_CHAR + ''';';
var
  Node: PVirtualNode;
  NodeData: PNodeData;
  s: WideString;
  Stmt: TDISQLite3Statement;
begin
  s := edtSearch.Text;
  if s = '' then Exit;

  SearchResultTree.BeginUpdate;
  try
    SearchResultTree.Clear;
    SearchResultTree.Header.SortColumn := NoColumn; // Disable sorting.
    PageControl.ActivePage := tabSearchResult;

    // SQL := 'SELECT "ID" FROM "Files" WHERE "Type" IN (0,1) AND "Name" LIKE ? ESCAPE ''' + ESCAPE_CHAR + ''';';
    Stmt := FDb.Prepare(SQL);
    try
      { Bind the file name search string. }

      { For filename searching, we apply the LIKE() SQL-function which is build
        into DISQLite3. Since LIKE() uses % and _ wildcards instead of the
        * and ?, we need to convert them first. }

      { Escape '%' and '_'. }
      s := Tnt_WideStringReplace(s, '%', ESCAPE_CHAR + '%', [rfReplaceAll]);
      s := Tnt_WideStringReplace(s, '_', ESCAPE_CHAR + '_', [rfReplaceAll]);

      { Convert DOS wildcards to LIKE wildcards. }
      s := Tnt_WideStringReplace(s, '?', '_', [rfReplaceAll]);
      if Pos('*', s) > 0 then
        s := Tnt_WideStringReplace(s, '*', '%', [rfReplaceAll])
      else
        s := '%' + s + '%';

      Stmt.bind_Str16(1, s);

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

      { Focus on search results, if available. }
      if SearchResultTree.VisibleCount > 0 then
        ActiveControl := SearchResultTree;
      UpdateStatusBar;
    finally
      Stmt.Free;
    end;
  finally
    SearchResultTree.EndUpdate;
  end;
end;

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

procedure TfrmMain.edtSearch_KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_RETURN: actSearch.Execute;
  end;
end;

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

procedure TfrmMain.PageControl_Change(Sender: TObject);
begin
  UpdateStatusBar;
end;

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

procedure TfrmMain.lblReport_MouseEnter(Sender: TObject);
begin
  lblReport.Font.Color := clBlue;
end;

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

procedure TfrmMain.lblReport_MouseLeave(Sender: TObject);
begin
  lblReport.Font.Color := clWindowText;
end;

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

procedure TfrmMain.lblReport_Click(Sender: TObject);
begin
  ShellExecute(0, 'open', 'mailto:[e-mail]?subject=[Drive Catalog]', nil, '', SW_SHOWNORMAL);
end;

end.