disqlite3_buffered_grid_form_main.pas

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

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

function TfrmMain.ReadRow(const AID: Int64): PRowData;
begin
  { First try to retrieve the row from the cache. If it is already cached,
    we are done and do not need to access the database. }
  Result := FCache.GetItem(AID);
  if not Assigned(Result) then
    begin
      { If the row was not cached, add a new row to the cache. If the new count
        exceeds MaxCount, the least recently used row will automatically be
        reused for the new row. }
      Result := FCache.AddItem(AID);
      { Bind the ID to the SQL statment's WHERE clause. }
      sqlite3_check(sqlite3_bind_int64(FReadDataStmt, 1, AID), DB);
      try
        { Execute the prepared statement ... }
        if sqlite3_check(sqlite3_step(FReadDataStmt), DB) = SQLITE_ROW then
          begin
            { ... and store the data to the row in the buffer. }
            Result^.RandomText := sqlite3_column_str(FReadDataStmt, 0);
            Result^.RandomInt := sqlite3_column_str(FReadDataStmt, 1);
          end;
      finally
        { Always reset the statement immediately after using it to avoid
          conflicting database statments. }
        sqlite3_check(sqlite3_reset(FReadDataStmt), DB);
      end;
      { Report that we have accessed the database. }
      Inc(FDatabaseReads);
      StatusBar.Panels[1].Text := Format('%d reads', [FDatabaseReads]);
    end;
end;

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

procedure TfrmMain.WriteRow_Int(const AID: Int64; const AInt: Integer);
var
  Stmt: TDISQLite3StatementHandle;
begin
  sqlite3_check(sqlite3_prepare(
    DB, // Database handle.
    'UPDATE RandomTable SET RandomInt=? WHERE RowID=?;', // SQL to prepare.
    -1, // Length of SQL or -1 if null-terminated.
    @Stmt, // Pointer to store statement to.
    nil), DB);
  try
    { Invalidate this item in the cache to force the next draw to requrey the
      database and return the most recent value. }
    FCache.InvalidateItem(AID);
    sqlite3_check(sqlite3_bind_int(Stmt, 1, AInt), DB);
    sqlite3_check(sqlite3_bind_int64(Stmt, 2, AID), DB);
    sqlite3_check(sqlite3_step(Stmt), DB);
  finally
    sqlite3_check(sqlite3_finalize(Stmt), DB);
  end;
end;

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

procedure TfrmMain.WriteRow_Text(const AID: Int64; const AText: AnsiString);
var
  Stmt: TDISQLite3StatementHandle;
begin
  sqlite3_check(sqlite3_prepare(
    DB, // Database handle.
    'UPDATE RandomTable SET RandomText=? WHERE RowID=?;', // SQL to prepare.
    -1, // Length of SQL or -1 if null-terminated.
    @Stmt, // Pointer to store statement to.
    nil), DB);
  try
    { Invalidate this item in the cache to force the next draw to requrey the
      database and return the most recent value. }
    FCache.InvalidateItem(AID);
    sqlite3_check(sqlite3_bind_str(Stmt, 1, AText), DB);
    sqlite3_check(sqlite3_bind_int64(Stmt, 2, AID), DB);
    sqlite3_check(sqlite3_step(Stmt), DB);
  finally
    sqlite3_check(sqlite3_finalize(Stmt), DB);
  end;
end;

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

procedure TfrmMain.vt_BeforeCellPaint(
  Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas;
  Node: PVirtualNode;
  Column: TColumnIndex;
  CellRect: TRect);
const
  Triangle: array[0..2] of TPoint =
  ((x: 4; y: 5), (x: 8; y: 9), (x: 4; y: 13));
begin
  if Column = 0 then
    begin
      { Simulate a fixed column by filling the main column with an edge similar to that of TCustomGrid. }
      DrawEdge(TargetCanvas.Handle, CellRect, BDR_RAISEDINNER, BF_MIDDLE or BF_RECT or BF_SOFT);
      if Node = Sender.FocusedNode then
        begin
          TargetCanvas.Brush.Color := clBlack;
          TargetCanvas.Polygon(Triangle);
        end;

    end;
end;

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

procedure TfrmMain.vt_FocusChanging(
  Sender: TBaseVirtualTree;
  OldNode, NewNode: PVirtualNode;
  OldColumn, NewColumn: TColumnIndex;
  var Allowed: Boolean);
begin
  { Don't allow focus to change to the fixed RowID column. }
  Allowed := (NewColumn > NoColumn) and
    not (coFixed in vt.Header.Columns[NewColumn].Options);
end;

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

procedure TfrmMain.vt_GetText(
  Sender: TBaseVirtualTree;
  Node: PVirtualNode;
  Column: TColumnIndex;
  TextType: TVSTTextType;
  var CellText: WideString);
var
  NodeData: PNodeData;
begin
  NodeData := Sender.GetNodeData(Node);
  case Column of
    0:
      begin
        CellText := IntToStr(NodeData^);
      end;
    1:
      begin
        CellText := ReadRow(NodeData^)^.RandomText;
      end;
    2:
      begin
        CellText := ReadRow(NodeData^)^.RandomInt;
      end;
  end;
end;

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

procedure TfrmMain.vt_HeaderDragging(
  Sender: TVTHeader;
  Column: TColumnIndex;
  var Allowed: Boolean);
begin
  { Don't allow dragging the fixed RowID column. }
  Allowed := (Column > NoColumn) and
    not (coFixed in Sender.Columns[Column].Options)
end;

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

procedure TfrmMain.vt_MouseDown(
  Sender: TObject;
  Button: TMouseButton;
  Shift: TShiftState;
  x, y: Integer);
var
  HitInfo: THitInfo;
begin
  if tsLeftButtonDown in vt.TreeStates then
    begin
      vt.GetHitTestInfoAt(x, y, True, HitInfo);
      if Assigned(HitInfo.HitNode) and
        (HitInfo.HitColumn >= 0) and
        (coFixed in vt.Header.Columns[HitInfo.HitColumn].Options) then
        vt.FocusedNode := HitInfo.HitNode;
    end;
end;

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

procedure TfrmMain.vt_NewText(
  Sender: TBaseVirtualTree;
  Node: PVirtualNode;
  Column: TColumnIndex;
  NewText: WideString);
var
  NodeData: PNodeData;
  RowData: TRowData;
  i: Integer;
begin
  { A record has been edited. Write the new text to the database. }
  NodeData := Sender.GetNodeData(Node);
  RowData := ReadRow(NodeData^)^;
  case Column of
    1:
      WriteRow_Text(NodeData^, NewText);
    2:
      try
        i := StrToInt(NewText);
        WriteRow_Int(NodeData^, i);
      except
        on e: Exception do
          ShowMessage(e.Message);
      end;
  else
    Exit;
  end;

end;

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

procedure TfrmMain.btnAdd_Click(Sender: TObject);
var
  NewID: Int64;
  NewNode: PVirtualNode;
  newnodedata: PNodeData;
begin
  NewID := AddRow;
  NewNode := vt.AddChild(nil);
  newnodedata := vt.GetNodeData(NewNode);
  newnodedata^ := NewID;
  vt.EditNode(NewNode, 1);
end;

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

procedure TfrmMain.btnDelete_Click(Sender: TObject);
var
  FN: PVirtualNode;
  NodeData: PNodeData;
begin
  FN := vt.FocusedNode;
  if Assigned(FN) then
    begin
      NodeData := vt.GetNodeData(FN);
      DeleteRow(NodeData^);
      vt.DeleteNode(FN, False);
    end
  else
    ShowMessage('Please select a record to delete.');
end;

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

procedure TfrmMain.btnEdit_Click(Sender: TObject);
var
  FN: PVirtualNode;
begin
  FN := vt.FocusedNode;
  if Assigned(FN) then
    vt.EditNode(FN, vt.FocusedColumn)
  else
    ShowMessage('Please select a cell to edit.');
end;

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

procedure TfrmMain.btnReload_Click(Sender: TObject);
begin
  LoadTable;
end;

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

procedure TfrmMain.cbxMemory_Click(Sender: TObject);
begin
  timer.Enabled := cbxMemory.Checked;
  if timer.Enabled then
    Timer_Timer(nil)
  else
    StatusBar.Panels[2].Text := '';
end;

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

procedure TfrmMain.Timer_Timer(Sender: TObject);
begin
  StatusBar.Panels[2].Text :=
    Format('%d KB memory used', [(GetHeapStatus.TotalAllocated + 1) div 1024]);
end;

//------------------------------------------------------------------------------
// TOurCache
//------------------------------------------------------------------------------

procedure TOurCache.DoFinalizeItem(const AItem: Pointer);
begin
  Finalize(PRowData(AItem)^);
end;

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

procedure TOurCache.DoInitializeItem(const AItem: Pointer);
begin
  FillChar(AItem^, ItemSize, 0);
end;

end.