frmsqlite.~pas

delphi sqlite示例,对于学习sqlite的新手很有帮助

unit frmSQLite;

{
 demonstrates the use of the TSQLite Class.
  (c) 2002 by [e-mail]
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, SQLite,
  StdCtrls, ComCtrls, Grids;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    Memo1: TMemo;
    Button2: TButton;
    ListView1: TListView;
    Button3: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    StringGrid1: TStringGrid;
    Button4: TButton;
    Label4: TLabel;
    edSQL: TEdit;
    Label5: TLabel;
    ListBox2: TListBox;
    Button5: TButton;
    procedure SQLComplete(Sender: TObject);
    procedure SQLOnData(Sender: TObject; Columns: Integer; ColumnNames, ColumnValues: String);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MySQL: TSQLite;
  EditCol, EditRow: integer;

implementation

{$R *.DFM}

Procedure TStringsToStringGrid(LstIn: TStrings; LstOut: TStringGrid);
var
  n: integer;
  i: integer;
  lTmp: TStringList;
begin
  if (LstIn <> nil) and (LstOut <> nil) then
  begin
    lTmp := TStringList.Create;
    lTmp.CommaText := LstIn.Strings[0];
    lstOut.ColCount := Ltmp.Count;
    lstout.RowCount := 1;
    lstout.FixedCols := 1;
    lstout.Rows[0] := ltmp;
    i := 1;
    for n := 1 to LstIn.Count - 1 do
    begin
      inc(i);
      lTmp.CommaText := LstIn.Strings[n];
      lstOut.RowCount := i;
      lstOut.Rows[i-1] := ltmp;
    end;
    lstOut.FixedRows := 1;
    lTmp.Free;
  end;
end;

Procedure TStringsToListView(LstIn: TStrings; LstOut: TListView);
var
  n: integer;
  lTmp: TStringList;
begin
  lTmp := TStringList.Create;
  lTmp.CommaText := LstIn.Strings[0];
  LstOut.Items.Clear;
  LstOut.Columns.Clear;
  for n := 0 to lTmp.Count - 1 do
    with LstOut.Columns.Add do
    begin
      Caption := lTmp.Strings[n];
      AutoSize := True;
      Width := -1;
    end;
  for n := 1 to LstIn.Count - 1 do
  begin
    lTmp.CommaText := LstIn.Strings[n];
    with LstOut.Items.Add do
    begin
      Caption := lTmp.Strings[0];
      lTmp.Delete(0);
      SubItems.Text := lTmp.Text;
    end;
  end;

end;

procedure TForm1.SQLComplete(Sender: TObject);
begin
  MessageBox(Form1.Handle, PChar(MySQL.ErrorMessage(0)), 'Query Complete', MB_OK or MB_ICONINFORMATION or MB_SETFOREGROUND);
  Listbox1.Items.Append('---------------');
end;

procedure TForm1.SQLOnData(Sender: TObject; Columns: Integer; ColumnNames, ColumnValues: String);
begin
  if ListBox1.Items.Count = 0 then
    ListBox1.Items.Append(ColumnNames);
  ListBox1.Items.Append(ColumnValues);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if MySQL = nil then MySQL := TSQLite.Create('test.db');
  MySQL.OnData := SQLOnData;
  MySQL.OnQueryComplete := SQLComplete;
  MySQL.Query(edSQL.Text, Memo1.Lines);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if MySQL = nil then MySQL := TSQLite.Create('test.db');
  MySQL.DatabaseDetails(Memo1.Lines);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  TStringsToListView(memo1.Lines, ListView1);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  TStringsToStringGrid(memo1.Lines, StringGrid1);
  if StringGrid1.ColCount > 2 then
  begin
    StringGrid1.ColWidths[0] := 36;
    StringGrid1.ColWidths[1] := 120;
    StringGrid1.ColWidths[2] := 120;
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  i: integer;
begin
  i := memo1.CaretPos.Y;
  if i = 0 then
    inc(i);
  if i > memo1.Lines.Count - 1 then
    dec(i);
  ValueList(memo1.lines.strings[0], memo1.lines.strings[i], ListBox2.items);
end;

procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol,
  ARow: Integer; const Value: String);
begin
  EditRow := ARow;
  EditCol := ACol;
  StringGrid1.Tag := ARow;
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
var
  sql: String;
  rowid: string;
  Colname: string;
  OldOnComplete: TOnQueryComplete;
begin
  if StringGrid1.Tag > 0 then
  begin
    if MessageBox(GetActiveWindow(), 'Update Record? ', 'Data Change', MB_YESNO or MB_ICONQUESTION or MB_SETFOREGROUND) = IDYES then
    begin
      Rowid := StringGrid1.Cells[0, EditRow];
      ColName := StringGrid1.Cells[EditCol, 0];
      sql := 'UPDATE Simpsons SET ' + ColName + '=' + Pas2SQLStr(StringGrid1.Cells[EditCol, EditRow]) + ' WHERE ROWID = ' + Rowid + ';';
      OldOnComplete := MySQL.OnQueryComplete;
      MySQL.OnQueryComplete := nil;
      MySql.Query(sql, nil);
      MessageBox(GetActiveWindow(), PChar('Modified ' + IntToStr(MySQL.ChangeCount) + 'Record(s).'), 'Update complete', MB_OK or MB_ICONINFORMATION or MB_SETFOREGROUND);
      MySQL.OnQueryComplete := OldOnComplete;
    end;
  end;
  StringGrid1.Tag := 0;
end;

end.