fmain.pas

来自「DELPHI 访问SQLITE3 数据库的VCL控件」· PAS 代码 · 共 514 行

{ DISQLite3 demo using the SQL-engine as a mathematical expression evaluator.

  Visit the DISQLite3 Internet site for latest information and updates:

    http://www.yunqa.de/delphi/

  Copyright (c) 2005-2007 Ralf Junker, The Delphi Inspiration <[e-mail]>

------------------------------------------------------------------------------ }

unit fMain;

{$I DI.inc}
{$I DISQLite3.inc}

{$IFDEF DISQLite3_Personal}
!!! This project requires functionality unavailable in DISQLite3 Personal. !!!
!!! To compile, download DISQLite3 Pro from www.yunqa.de/delphi/           !!!
{$ENDIF DISQLite3_Personal}

interface

uses
  Classes, Controls, StdCtrls, Forms, Grids, ExtCtrls, ComCtrls,
  DISQLite3Database;

type
  TfrmMain = class(TForm)
    SplitterLeft: TSplitter;
    PageControl: TPageControl;
    tabFunctions: TTabSheet;
    sbxFunctions: TScrollBox;
    tabVariables: TTabSheet;
    sbxVariables: TScrollBox;
    pnlExpression: TPanel;
    lblExpressions: TLabel;
    lblExpression: TLabel;
    memoExpression: TMemo;
    cbxExpressions: TComboBox;
    MemoResult: TMemo;
    EnterButton: TButton;
    memoUsage: TMemo;
    StatusBar: TStatusBar;
    lblResult: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure btnEvaluate_Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure sbxVariables_Resize(Sender: TObject);
    procedure sbxFunctions_Resize(Sender: TObject);
    procedure memoExpression_KeyPress(Sender: TObject; var Key: Char);
    procedure cbxExpressions_Change(Sender: TObject);
  private
    DB: TDISQLite3Database;
    VarControls: array[0..23] of record
      Button: TButton;
      Edit: TEdit;
      Combo: TComboBox;
    end;
    procedure btnFunction_Click(Sender: TObject);
    procedure btnVariable_Click(Sender: TObject);
    procedure edtVariable_KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  public
    procedure EvaluateExpression(const UpdateDropDown: Boolean = True);
  end;

const
  APP_TITLE = 'DISQLite3 Demo: Mathematical Expression Evaluator';

var
  frmMain: TfrmMain;

implementation

{$R *.DFM}

uses
  Windows, SysUtils, SysConst,
  DISQLite3Api, DISQLite3Functions;

const
  FUNCTIONS: array[0..37] of AnsiString = (
    'abs(x)',
    'acos(x)',
    'asin(x)',
    'atan(x)',
    'atan(x)',
    'atan2(x)',
    'ceil(x)',
    'ceiling(x)',
    'coalesce(x,y,...)',
    'cos(x)',
    'cot(x)',
    'degrees(x)',
    'exp(x)',
    'floor(x)',
    'length(x)',
    'ln(x)',
    'log(x)',
    'log(x)',
    'log2(x)',
    'log10(x)',
    'lower(x)',
    'max(x,y,...)',
    'mix(x,y,...)',
    'mod(x)',
    'pi()',
    'pow(x)',
    'quote(x)',
    'radians(x)',
    'random()',
    'round(x[,y])',
    'sign(x)',
    'sin(x)',
    'soundex(x)',
    'sqrt(x)',
    'substr(x,y,z)',
    'tan(x)',
    'typeof(x)',
    'upper(x)');

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

procedure TfrmMain.FormCreate(Sender: TObject);
var
  Button: TButton;
  c: WideChar;
  Combo: TComboBox;
  Edit: TEdit;
  i, t, w: Integer;
  s: WideString;
begin
  Caption := APP_TITLE;

  { Create a database to use as the expression evaluator. }
  DB := TDISQLite3Database.Create(nil);
  DB.DatabaseName := ':memory:';
  DB.Open;
  sqlite3_create_math_functions(DB.Handle);

  { Create table to store user variables. }
  s := 'CREATE TABLE Variables(';
  for c := 'A' to 'Z' do
    begin
      if c <> 'A' then
        s := s + ',';
      s := s + c;
    end;
  s := s + ');';
  DB.Execute16(s);
  { Insert a single row to hold the variable values. }
  DB.Execute16('INSERT INTO Variables (A) VALUES (NULL);');

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

  { Add some expression to the dropdown. }

  with cbxExpressions, Items do
    begin
      Add('cos (pi())');
      Add('sqrt (2)');
      Add('14 * 8');
      Add('log(1.2e42)');
      Add('pow (1.3, 4.3)');
      Add('max (sin(1), sin(2), sin(3), sin(4))');
      Add('degrees (pi())');
      Add('quote (''The'' || ''Delphi'' || ''Inspiration'')');
      Add('substr (''OneTwoThree'', 4, 3)');
      Add('random()');
      ItemIndex := 0;
    end;

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

  { Populate variable controls. }
  sbxVariables.VertScrollBar.Tracking := True;
  for i := Low(VarControls) to High(VarControls) do
    begin
      Button := TButton.Create(Self);
      Button.Caption := AnsiChar(i + Ord('A'));
      Button.OnClick := btnVariable_Click;
      Button.Tag := i;
      Button.Parent := sbxVariables;
      VarControls[i].Button := Button;

      Edit := TEdit.Create(Self);
      Edit.OnKeyDown := edtVariable_KeyDown;
      Edit.Tag := i;
      Edit.Parent := sbxVariables;
      VarControls[i].Edit := Edit;

      Combo := TComboBox.Create(Self);
      Combo.Style := csDropDownList;
      Combo.Tag := i;
      Combo.Parent := sbxVariables;
      Combo.Items.AddObject('float', TObject(SQLITE_FLOAT));
      Combo.Items.AddObject('integer', TObject(SQLITE_INTEGER));
      Combo.Items.AddObject('text', TObject(SQLITE_TEXT));
      Combo.Items.AddObject('null', TObject(SQLITE_NULL));
      Combo.ItemIndex := 0;
      VarControls[i].Combo := Combo;
    end;
  sbxVariables_Resize(nil);

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

  { Populate function controls. }
  sbxFunctions.VertScrollBar.Tracking := True;
  t := sbxFunctions.ClientRect.Top;
  w := sbxFunctions.ClientWidth - GetSystemMetrics(SM_CXVSCROLL);
  for i := Low(FUNCTIONS) to High(FUNCTIONS) do
    begin
      Button := TButton.Create(Self);
      Button.Caption := FUNCTIONS[i];
      Button.OnClick := btnFunction_Click;
      Button.SetBounds(0, t, w, 21);
      Button.Tag := i;
      Button.Parent := sbxFunctions;
      Inc(t, Button.Height);
    end;

  memoUsage.Text := 'USAGE: Enter a valid SQL expression and press Evaluate. ' +
    'You can use any of the functions available to DISQLite3, many of which are ' +
    'listed on the left.' + #13#10#13#10 +

  'HINT: In SQL, FLOAT numbers and INTEGER numbers behave differently. Numbers with a ' +
    '''.'' decimal separator are floats, all others are integers.' + #13#10#13#10 +

  'Only float numbers are subject to floating point arithmetic, integers can cause ' +
    'integer divisions, for example 5 / 2 = 2, but 5.0 / 2 = 2.5.';

  cbxExpressions_Change(nil);
end;

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

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  DB.Free;
end;

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

procedure TfrmMain.EvaluateExpression(const UpdateDropDown: Boolean = True);
var
  c: WideChar;
  e: Extended;
  i: Integer;
  expr, w: WideString;
  s: AnsiString;
  Stmt: TDISQLite3Statement;
  Combo: TComboBox;
begin
  MemoResult.Text := '';
  StatusBar.SimpleText := '';

  expr := Trim(memoExpression.Text);
  if expr = '' then
    begin
      StatusBar.SimpleText := 'Expression is empty.';
      Exit;
    end;

  { Update user variables. }
  w := 'UPDATE Variables SET ';
  for c := 'A' to 'Z' do
    begin
      if c <> 'A' then
        w := w + ',';
      w := w + c + '=?';
    end;
  Stmt := DB.Prepare16(w);
  try
    Stmt.Clear_Bindings;
    for i := Low(VarControls) to High(VarControls) do
      begin
        s := Trim(VarControls[i].Edit.Text);
        try
          Combo := VarControls[i].Combo;
          case Integer(Combo.Items.Objects[Combo.ItemIndex]) of
            SQLITE_TEXT:
              begin
                Stmt.bind_Str16(i + 1, s);
              end;

            SQLITE_FLOAT:
              begin
                if s <> '' then
                  if SqlStrToFloat(s, e) = Length(s) then
                    Stmt.Bind_Double(i + 1, e)
                  else
                    raise EConvertError.CreateFmt(SInvalidFloat, [s]);
              end;

            SQLITE_INTEGER:
              begin
                if s <> '' then
                  Stmt.Bind_Int(i + 1, StrToInt(s));
              end;
          end;
        except
          on e: Exception do
            begin
              StatusBar.SimpleText := 'Variable ' + AnsiChar(i + Ord('A')) + ': ' + e.Message;
              Exit;
            end;
        end;
      end;
    Stmt.Step;
  finally
    Stmt.Free;
  end;

  { Execute the expression. }
  w := 'SELECT (' + expr + ') FROM Variables;';
  try
    Stmt := DB.Prepare16(w);
    try
      if (Stmt.Step = SQLITE_ROW) and (Stmt.Column_Count > 0) then
        if Stmt.Column_Type(0) = SQLITE_NULL then
          MemoResult.Text := 'NULL'
        else
          MemoResult.Text := Stmt.Column_Str16(0)
      else
        raise Exception.Create('Error evaluating expression');

      { If expression evaluated gracefully, add it to the dropdown list. }
      if UpdateDropDown then
        with cbxExpressions.Items do
          begin
            i := IndexOf(expr);
            if i >= 0 then
              Move(i, 0)
            else
              begin
                while Count > 20 do
                  Delete(Count - 1);
                Insert(0, expr);
              end;
            if Count > 0 then
              cbxExpressions.ItemIndex := 0;
          end;

    finally
      Stmt.Free;
    end;
  except
    on e: Exception do
      begin
        StatusBar.SimpleText := e.Message;
        Exit;
      end;
  end;
end;

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

procedure TfrmMain.btnEvaluate_Click(Sender: TObject);
begin
  EvaluateExpression;
end;

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

procedure TfrmMain.btnFunction_Click(Sender: TObject);
var
  Btn: TButton;
  SelStart, SelLength: Integer;
  s, SelText: AnsiString;
  i: Integer;
begin
  Btn := Sender as TButton;

  s := FUNCTIONS[Btn.Tag];
  i := Pos('(', s);
  if i > 0 then
    SetLength(s, i - 1);

  SelStart := memoExpression.SelStart;
  SelText := memoExpression.SelText;
  if SelText = '' then
    begin
      SelText := s + '()';
      Inc(SelStart, Length(SelText) - 1);
      SelLength := 0;
    end
  else
    begin
      SelText := s + '(' + SelText + ')';
      SelLength := Length(SelText);
    end;

  memoExpression.SelText := SelText;
  memoExpression.SelStart := SelStart;
  memoExpression.SelLength := SelLength;
  memoExpression.SetFocus;
end;

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

procedure TfrmMain.btnVariable_Click(Sender: TObject);
var
  Btn: TButton;
  SelStart: Integer;
  SelText: AnsiString;
begin
  Btn := Sender as TButton;

  SelStart := memoExpression.SelStart;
  SelText := Btn.Caption;
  Inc(SelStart, Length(SelText));

  memoExpression.SelText := SelText;
  memoExpression.SelStart := SelStart;
  memoExpression.SelLength := 0;
  memoExpression.SetFocus;
end;

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

procedure TfrmMain.sbxVariables_Resize(Sender: TObject);
var
  Button: TButton;
  Combo: TComboBox;
  Edit: TEdit;
  i, t, w: Integer;
begin
  sbxVariables.DisableAutoRange;
  try
    t := 0;
    w := sbxVariables.Width - GetSystemMetrics(SM_CXVSCROLL);
    for i := Low(VarControls) to High(VarControls) do
      begin
        Button := VarControls[i].Button;
        Edit := VarControls[i].Edit;
        Combo := VarControls[i].Combo;
        if Assigned(Button) and Assigned(Edit) and Assigned(Combo) then
          begin
            Button.SetBounds(0, t, 23, 23);
            Edit.SetBounds(Button.BoundsRect.Right + 2, t + 1, w - Button.Width - 54, Button.Height - 2);
            Combo.SetBounds(w - 50, t + 1, 50, Button.Height - 2);
            Inc(t, Button.Height);
          end;
      end;
  finally
    sbxVariables.EnableAutoRange;
  end;
end;

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

procedure TfrmMain.sbxFunctions_Resize(Sender: TObject);
var
  i, w: Integer;
begin
  sbxFunctions.DisableAutoRange;
  try
    w := sbxFunctions.Width - GetSystemMetrics(SM_CXVSCROLL);
    for i := 0 to sbxFunctions.ControlCount - 1 do
      begin
        sbxFunctions.Controls[i].Width := w;
      end;
  finally
    sbxFunctions.EnableAutoRange;
  end;
end;

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

procedure TfrmMain.memoExpression_KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    begin
      EvaluateExpression;
      Key := #0;
    end;
end;

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

procedure TfrmMain.cbxExpressions_Change(Sender: TObject);
begin
  with cbxExpressions do
    if ItemIndex >= 0 then
      begin
        memoExpression.Text := Items[ItemIndex];
        EvaluateExpression(False);
      end;
end;

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

procedure TfrmMain.edtVariable_KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  i: Integer;
begin
  case Key of
    VK_DOWN:
      begin
        i := (Sender as TEdit).Tag;
        if i < High(VarControls) then
          VarControls[i + 1].Edit.SetFocus;
      end;
    VK_UP:
      begin
        i := (Sender as TEdit).Tag;
        if i > Low(VarControls) then
          VarControls[i - 1].Edit.SetFocus;
      end;
  end;
end;

end.