disqlite3_richedit_fmain.pas

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

procedure TfrmMain.RefreshData;
var
  i: Integer;
  RowID: Integer;
  Stmt: TDISQLite3StatementHandle;
begin
  LVItems.Items.BeginUpdate;
  FReading := True;
  try
    ListView_ClearSelection(LVItems);
    FData.Clear;

    if Assigned(FDb) then
      begin
        sqlite3_check(sqlite3_prepare_v2(
          FDb, // Database handle.
          'SELECT "RowID" FROM "Items" ORDER BY "Name" COLLATE NOCASE;',
          -1, // Length of SQL or -1 if #0-terminated.
          @Stmt, // Pointer to variable holding the prepared statement.
          nil) // If assigned, receives end of SQL statement.
          , FDb);

        if Assigned(Stmt) then
          try
            while sqlite3_check(sqlite3_step(Stmt), FDb) = SQLITE_ROW do
              begin
                RowID := sqlite3_column_int(Stmt, 0);
                FData.Add(Pointer(RowID));
              end;
          finally
            sqlite3_check(sqlite3_finalize(Stmt), FDb);
          end;
      end;

    { Initialize the virtual listview with the number of items. }
    i := FData.Count;
    LVItems.Items.Count := i;
    if i > 0 then
      begin
        LVItems.Items[0].Selected := True;
        LVItems.Items[0].Focused := True;
      end;
    LVItems.Refresh;
    EnableControls(i > 0);
  finally
    FReading := False;
    LVItems.Items.EndUpdate;
  end;
end;

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

{ Writes a full item directly from the controls to the database. }
procedure TfrmMain.WriteItemToDB;
var
  ItemName: AnsiString;
  ItemRtf: TMemoryStream;
begin
  if not FItemChanged then Exit;

  ItemName := edtItemName.Text;

  ItemRtf := TMemoryStream.Create;
  try
    edtItemRtf.Lines.SaveToStream(ItemRtf);

    // Bind the Item's Name
    sqlite3_check(sqlite3_bind_str(FStmt_UpdateNameRTF, 1, ItemName), FDb);

    // Bind the Item's RTF
    sqlite3_check(sqlite3_bind_blob(
      FStmt_UpdateNameRTF, // The prepared statement to execute.
      2, // The parameter index.
      ItemRtf.Memory, // Pointer to the BLOB's memory.
      ItemRtf.Size, // Size of the BLOB's memory.
      SQLITE_STATIC), // Memory is static and does not change until commited.
      FDb);

    // Bind the Item's RowID
    sqlite3_check(sqlite3_bind_int(FStmt_UpdateNameRTF, 3, FItemIdx), FDb);

    try
      // Execute the statement ...
      sqlite3_check(sqlite3_step(FStmt_UpdateNameRTF), FDb);
    finally
      // ... and reset.
      sqlite3_check(sqlite3_reset(FStmt_UpdateNameRTF), FDb);
    end;

    FItemChanged := False;
  finally
    ItemRtf.Free;
  end;
  LVItems.Refresh;
end;

//------------------------------------------------------------------------------
// Form Events
//------------------------------------------------------------------------------

procedure TfrmMain.btnAlignCenter_Click(Sender: TObject);
begin
  edtItemRtf.Paragraph.Alignment := taCenter;
end;

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

procedure TfrmMain.btnAlignLeft_Click(Sender: TObject);
begin
  edtItemRtf.Paragraph.Alignment := taLeftJustify;
end;

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

procedure TfrmMain.btnAlignRight_Click(Sender: TObject);
begin
  edtItemRtf.Paragraph.Alignment := taRightJustify;
end;

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

procedure TfrmMain.btnBold_Click(Sender: TObject);
begin
  with edtItemRtf.SelAttributes do
    if btnBold.Down then
      Style := Style + [fsBold]
    else
      Style := Style - [fsBold];
end;

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

procedure TfrmMain.btnBullets_Click(Sender: TObject);
begin
  with edtItemRtf.Paragraph do
    if btnBullets.Down then
      Numbering := nsBullet
    else
      Numbering := nsNone;
end;

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

procedure TfrmMain.btnColor_Click(Sender: TObject);
begin
  with TColorDialog.Create(nil) do
    try
      Color := edtItemRtf.SelAttributes.Color;
      Options := [cdAnyColor, cdFullOpen];
      if Execute then
        edtItemRtf.SelAttributes.Color := Color;
    finally
      Free;
    end;
end;

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

procedure TfrmMain.btnItalic_Click(Sender: TObject);
begin
  with edtItemRtf.SelAttributes do
    if btnItalic.Down then
      Style := Style + [fsItalic]
    else
      Style := Style - [fsItalic];
end;

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

procedure TfrmMain.btnUnderline_Click(Sender: TObject);
begin
  with edtItemRtf.SelAttributes do
    if btnUnderline.Down then
      Style := Style + [fsUnderline]
    else
      Style := Style - [fsUnderline];
end;

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

procedure TfrmMain.cbxFontName_Change(Sender: TObject);
begin
  edtItemRtf.SelAttributes.Name := cbxFontName.Text;
end;

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

procedure TfrmMain.edtFontSize_Change(Sender: TObject);
var
  i: Integer;
begin
  i := StrToIntDef(edtFontSize.Text, 0);
  if i > 0 then
    edtItemRtf.SelAttributes.Size := i;
end;

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

procedure TfrmMain.edtItemName_Change(Sender: TObject);
begin
  if not FReading then
    FItemChanged := True;
end;

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

procedure TfrmMain.edtItemRtf_Change(Sender: TObject);
begin
  if not FReading then
    FItemChanged := True;
end;

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

procedure TfrmMain.edtItemRtf_SelectionChange(Sender: TObject);
begin
  with edtItemRtf.SelAttributes do
    begin
      cbxFontName.ItemIndex := cbxFontName.Items.IndexOf(Name);
      edtFontSize.Text := IntToStr(Size);

      btnBold.Indeterminate := not (caBold in ConsistentAttributes);
      if not btnBold.Indeterminate then
        btnBold.Down := fsBold in Style;

      btnItalic.Indeterminate := not (caItalic in ConsistentAttributes);
      if not btnItalic.Indeterminate then
        btnItalic.Down := fsItalic in Style;

      btnUnderline.Indeterminate := not (caUnderline in ConsistentAttributes);
      if not btnUnderline.Indeterminate then
        btnUnderline.Down := fsUnderline in Style;
    end;

  case edtItemRtf.Paragraph.Alignment of
    taLeftJustify: btnAlignLeft.Down := True;
    taRightJustify: btnAlignRight.Down := True;
    taCenter: btnAlignCenter.Down := True;
  end;

  btnBullets.Down := edtItemRtf.Paragraph.Numbering <> nsNone;
end;

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

procedure TfrmMain.lvItems_Change(Sender: TObject; Item: TListItem; Change: TItemChange);
var
  Idx: Integer;
begin
  case Change of
    ctState:
      // Is this the focued Item?
      if Assigned(Item) and Item.Focused then
        begin
          Idx := Integer(FData[Item.Index]);
          if Idx <> FItemIdx then
            begin
              WriteItemToDB;
              ReadItemFromDB(Idx);
            end;
        end;
  end;
end;

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

procedure TfrmMain.lvItems_Data(Sender: TObject; Item: TListItem);
var
  Idx: Integer;
  NewCaption: AnsiString;
begin
  if not Assigned(Item) then Exit;
  Idx := Integer(FData[Item.Index]);
  if ReadNameFromDB(Idx, NewCaption) then
    Item.Caption := NewCaption;
end;

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

procedure TfrmMain.lvItems_Resize(Sender: TObject);
begin
  LVItems.Columns[0].Width := LVItems.ClientWidth;
end;

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

procedure TfrmMain.mnuData_Click(Sender: TObject);
begin
  mnuData_Save.Enabled := Assigned(FDb) and (FItemIdx > 0) and FItemChanged;
  mnuData_New.Enabled := Assigned(FDb);
  mnuData_Delete.Enabled := Assigned(FDb) and (FItemIdx > 0);
  mnuData_Reload.Enabled := Assigned(FDb);
  mnuData_Vacuum.Enabled := Assigned(FDb);
end;

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

procedure TfrmMain.mnuData_Delete_Click(Sender: TObject);
begin
  DeleteSelected;
end;

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

procedure TfrmMain.mnuData_New_Click(Sender: TObject);
var
  NewRowID: Integer;
  i: Integer;
begin
  sqlite3_exec_fast(FDb, 'INSERT INTO "Items"("Name")VALUES(''New Item'');');
  NewRowID := sqlite3_last_insert_rowid(FDb);
  i := FData.Add(Pointer(NewRowID));

  ListView_ClearSelection(LVItems);
  with LVItems.Items do
    begin
      Count := FData.Count;
      with Item[i] do
        begin
          Selected := True;
          Focused := True;
          MakeVisible(False);
        end;
    end;
  EnableControls(True);
  edtItemName.SetFocus;
end;

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

procedure TfrmMain.mnuData_Reload_Click(Sender: TObject);
begin
  RefreshData;
end;

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

procedure TfrmMain.mnuData_SaveNow_Click(Sender: TObject);
begin
  WriteItemToDB;
end;

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

procedure TfrmMain.mnuData_Vacuum_Click(Sender: TObject);
begin
  {$IFDEF DISQLite3_Personal}
  ShowMessage('Hint: "VACUUM" has no effect in DISQLite3 Personal.');
  {$ENDIF DISQLite3_Personal}
  LVItems.Items.BeginUpdate;
  FinalizeStatements;
  try
    sqlite3_exec_fast(FDb, 'VACUUM;');
  finally
    PrepareStatements;
    LVItems.Items.EndUpdate;
  end;
end;

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

procedure TfrmMain.mnuFile_Click(Sender: TObject);
begin
  mnuFile_CloseDatabase.Enabled := Assigned(FDb);
end;

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

procedure TfrmMain.mnuFile_CloseDatabase_Click(Sender: TObject);
begin
  InternalCloseDatabase;
end;

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

procedure TfrmMain.mnuFile_LoadRtf_Click(Sender: TObject);
begin
  with TOpenDialog.Create(nil) do
    try
      DefaultExt := DIALOG_RTF_DEFAULTEXT;
      Filter := DIALOG_RTF_FILTER;
      Options := OPEN_DIALOG_OPTIONS;
      if Execute then
        edtItemRtf.Lines.LoadFromFile(FileName);
    finally
      Free;
    end;
end;

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

procedure TfrmMain.mnuFile_NewDatabase_Click(Sender: TObject);
begin
  with TSaveDialog.Create(nil) do
    try
      DefaultExt := DIALOG_DATABASE_DEFAULTEXT;
      Filter := DIALOG_DATABASE_FILTER;
      Options := SAVE_DIALOG_OPTIONS;
      if Execute then
        InternalOpenDatabase(FileName, True);
    finally
      Free;
    end;
end;

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

procedure TfrmMain.mnuFile_OpenDatabase_Click(Sender: TObject);
begin
  with TOpenDialog.Create(nil) do
    try
      DefaultExt := DIALOG_DATABASE_DEFAULTEXT;
      Filter := DIALOG_DATABASE_FILTER;
      Options := OPEN_DIALOG_OPTIONS;
      if Execute then
        InternalOpenDatabase(FileName);
    finally
      Free;
    end;
end;

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

procedure TfrmMain.mnuFile_SaveRtf_Click(Sender: TObject);
begin
  with TSaveDialog.Create(nil) do
    try
      DefaultExt := DIALOG_RTF_DEFAULTEXT;
      Filter := DIALOG_RTF_FILTER;
      Options := SAVE_DIALOG_OPTIONS;
      if Execute then
        edtItemRtf.Lines.SaveToFile(FileName);
    finally
      Free;
    end;
end;

end.