ex1u.pas

TxQuery is an SQL engine implemented in a TDataSet descendant component, that can parse SQL syntax,

  Table3.Open;
  Table4.Open;
  Table5.Open;

End;

Procedure TfrmTest.About1Click(Sender: TObject);
Begin
  With TFrmAbout.Create(Application) Do Begin
    Try
      ShowModal;
    Finally
      Free;
    End;
  End;
End;

Procedure TfrmTest.Howtobuy1Click(Sender: TObject);
Begin
  With TfrmRegister.Create(Application) Do Begin
    Try
      ShowModal;
    Finally
      Free;
    End;
  End;
End;

Procedure TfrmTest.FormDestroy(Sender: TObject);
Begin
  if Assigned(fAnalizer) then fAnalizer.Free;
  Application.HelpCommand(HELP_QUIT, 0);
End;

Procedure TfrmTest.Exit1Click(Sender: TObject);
Begin
  Close;
End;

Procedure TfrmTest.PageControl1Change(Sender: TObject);
Begin
  If PageControl1.ActivePage = TabSheet2 Then Begin
  End Else If PageControl1.ActivePage = TabSheet1 Then SyntaxHighlighter1.Editor := RichEdit1
  Else If PageControl1.ActivePage = TabSheet3 Then SyntaxHighlighter1.Editor := RichEdit2
  Else If PageControl1.ActivePage = TabSheet4 Then SyntaxHighlighter1.Editor := RichEdit3
  Else If PageControl1.ActivePage = TabSheet5 Then SyntaxHighlighter1.Editor := RichEdit4;
  If Not (PageControl1.ActivePage = TabSheet5) Then XQuery4.Close;
End;

Procedure TfrmTest.SyntaxHighlighter1PosChange(Sender: TObject;
  Row, Col: Integer);
Begin
  StatusBar1.SimpleText := Format('Row: %d Col: %d', [Row, Col]);
End;

Procedure TfrmTest.Button2Click(Sender: TObject);
Begin
  SyntaxHighlighter1.EditColorSet;
End;

Procedure TfrmTest.Button5Click(Sender: TObject);
Var
  TmpPt: TPoint;
  Item: TMenuItem;
  ColorElement: PColorElement;
  I: Integer;
  g: TElementGroup;
Begin
  TmpPt := PanelSideButtons.ClientToScreen(Point(Button5.Left, Button5.Top + Button5.Height));
  For I := 0 To PopupMenu2.Items.Count - 1 Do PopupMenu2.Items.Delete(0);

  For g := Low(TElementGroup) To High(TElementGroup) Do Begin
    For I := 0 To SyntaxHighlighter1.ColorConfig.ColorSettings.Count - 1 Do Begin
      ColorElement := PColorElement(SyntaxHighlighter1.ColorConfig.ColorSettings[I]);
      If ColorElement^.Group = g Then
      Begin
        Item := TMenuItem.Create(Self);
        {$IFNDEF LEVEL3}
        Item.OnDrawItem := PopupDrawItem; // Delphi 3 cannot owner draw in menus
        Item.OnMeasureItem := PopupMeasureItem;
        {$ENDIF}
        Item.Tag := I;
        Case ColorElement^.Group Of
          IdWhiteSpace: Item.Caption := 'WhiteSpace';
          IdComment: Item.Caption := 'Comment';
          IdReservedWord: Item.Caption := 'ReservedWord';
          IdIdentifier: Item.Caption := 'Identifier';
          IdTable: Item.Caption := 'Dataset';
          IdField: Item.Caption := 'Field';
          IdString: Item.Caption := 'String';
          IdNumber: Item.Caption := 'Number';
          IdComma: Item.Caption := 'Comma';
          IdParenthesis: Item.Caption := 'Parenthesis';
          IdOperator: Item.Caption := 'Operator';
          IdSemicolon: Item.Caption := 'Semicolon';
          IdPeriod: Item.Caption := 'Period';
        End;
        PopupMenu2.Items.Add(Item);
      End;
    End;
  End;
  PopupMenu2.Popup(TmpPt.X, TmpPt.Y);
End;

{$IFNDEF LEVEL3}

Procedure TfrmTest.PopupDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
Var
  S: String;
  TmpRect: TRect;
  ColorElement: PColorElement;
Begin
  With ACanvas Do Begin
    FillRect(ARect);
    S := (Sender As TMenuItem).Caption;
    ReplaceString(S, '&', '');
    TmpRect := ARect;
    TmpRect.Left := TextWidth('X') * 2;
    //TextOut(TmpRect.Left, TmpRect.Top, (Sender as TMenuItem).Caption);
    DrawText(Handle, PChar(S), -1, TmpRect, DT_SINGLELINE Or DT_LEFT Or DT_VCENTER);
    ColorElement := PColorElement(SyntaxHighlighter1.ColorConfig.ColorSettings[(Sender As TMenuItem).Tag]);
    TmpRect := ARect;
    TmpRect.Right := TextWidth('X') * 2 - 1;
    InflateRect(TmpRect, -2, -2);
    Brush.Color := ColorElement^.ForeColor;
    FillRect(TmpRect);
  End;
End;

Procedure TfrmTest.PopupMeasureItem(Sender: TObject;
  ACanvas: TCanvas; Var Width, Height: Integer);
Begin
  With ACanvas Do Begin
    Height := TextHeight('0') + 2;
    Width := TextWidth('X') * 13 + 2;
  End;
End;
{$ENDIF}

Procedure TfrmTest.Button6Click(Sender: TObject);
Begin
  XQuery1.Find(Edit1.Text);
End;

Procedure TfrmTest.Button7Click(Sender: TObject);
Begin
  If XQuery3.ParamCount = 0 Then
  Begin
    XQuery3.Params.CreateParam(FtInteger, 'LOWRANGE', PtUnknown);
    XQuery3.Params.CreateParam(FtInteger, 'HIGHRANGE', PtUnknown);
  End;
  XQuery3.Close;
  XQuery3.ParamByName('LOWRANGE').AsInteger := StrToInt(Edit2.Text);
  XQuery3.ParamByName('HIGHRANGE').AsInteger := StrToInt(Edit3.Text);
  XQuery3.Open;
End;

Procedure TfrmTest.Button8Click(Sender: TObject);
Begin
  If xQuery4.ParamCount = 0 Then
    xQuery4.Params.CreateParam(FtFloat, 'CustNo', PtUnknown);
  xQuery4.Close;
  xQuery4.Open;
End;

Procedure TfrmTest.XQuery1CreateIndex(Sender: TObject; Unique, Descending: Boolean; Const TableName, IndexName: String; ColumnExprList: TStringList);
Var
  S, TempS: String;
  I: Integer;
Begin
  S := 'Requested to create an index on table : ' + TableName + CRLF + 'Index name on this table : ' + IndexName + CRLF;
  If Unique Then TempS := 'Index Unique ' Else TempS := 'Duplicates allowed ';

  S := S + TempS + CRLF;
  If Descending Then TempS := 'Sort descending ' Else TempS := 'Sort ascending';

  S := S + TempS + CRLF + 'Columns expressions to index on :' + CRLF;

  For I := 0 To ColumnExprList.Count - 1 Do S := S + ColumnExprList[I] + CRLF;
  ShowMessage(S);
End;

Procedure TfrmTest.XQuery1DropTable(Sender: TObject; Const TableName: String);
Begin
  ShowMessage('Requested to drop table ' + TableName);
End;

Procedure TfrmTest.XQuery1DropIndex(Sender: TObject; Const TableName, IndexName: String);
Begin
  ShowMessage('Requested to drop index ' + IndexName + ' on table ' + TableName);
End;

Procedure TfrmTest.XQuery1CreateTable(Sender: TObject;
  CreateTable: TCreateTableItem);
Var
  S, BlobType: String;
  I: Integer;
  {$IFDEF USE_DBF_ENGINE}
  FieldList: TStringList;
  FileName, FieldName, IndexFileName: String;
  FieldType: Char;
  FieldSize, FieldDec: Integer;
  Halc: THalcyonDataSet;
  {$ENDIF}
Begin
  S := 'SQL statement issued:' + CRLF + XQuery1.Sql.Text + CRLF;
  ShowMessage(S);

  S := 'Analisis of CREATE TABLE statement:' + CRLF + Format('CREATE TABLE requested on table "%s"', [CreateTable.TableName]) + CRLF + Format('Number of fields to create : %d', [CreateTable.FieldCount]) + CRLF;

  For I := 0 To CreateTable.FieldCount - 1 Do Begin
    S := S + Format('"%s" ', [CreateTable.Fields[I].FieldName]);
    Case CreateTable.Fields[I].FieldType Of // list of possible types accepted in TxQuery parser
      RW_CHAR: S := S + Format('type CHAR of Length %d', [CreateTable.Fields[I].Size]) + CRLF; // use Size property here
      RW_INTEGER: S := S + 'type INTEGER' + CRLF;
      RW_SMALLINT: S := S + 'type SMALLINT' + CRLF;
      RW_BOOLEAN: S := S + 'type BOOLEAN' + CRLF;
      RW_DATE: S := S + 'type DATE' + CRLF;
      RW_TIME: S := S + 'type TIME' + CRLF;
      RW_DATETIME: S := S + 'type DATETIME' + CRLF;
      RW_MONEY: S := S + 'type MONEY' + CRLF;
      RW_FLOAT: S := S + Format('type FLOAT Scale %d Precision %d', [CreateTable.Fields[I].Scale, CreateTable.Fields[I].Precision]) + CRLF; // use Scale and Precision properties here
      RW_AUTOINC: S := S + 'type AUTOINC' + CRLF;
      RW_BLOB: Begin // use BlobType property here
          Case CreateTable.Fields[I].BlobType Of
            1: BlobType := 'Memo';
            2: BlobType := 'Binary';
            3: BlobType := 'Formatted Memo';
            4: BlobType := 'OLE';
            5: BlobType := 'Graphic/Binary';
          End;
          S := S + Format('is a BLOB of type %s', [BlobType]) + CRLF;
        End;
    End;
  End;

  S := S + CRLF + 'SORT ORDER:' + CRLF;

  If CreateTable.PrimaryKey.Count = 0 Then S := S + 'NONE'
  Else Begin
    For I := 0 To CreateTable.PrimaryKey.Count - 1 Do S := S + CreateTable.PrimaryKey[I] + CRLF;
  End;

  ShowMessage(S);

  {$IFDEF USE_DBF_ENGINE} // A working example with Halcyon
  FieldList := TStringList.Create;
  Try
    For I := 0 To CreateTable.FieldCount - 1 Do Begin
      FieldName := CreateTable.Fields[I].FieldName;
      Case CreateTable.Fields[I].FieldType Of // list of possible types accepted in TxQuery parser
        RW_CHAR: Begin
            FieldType := 'C';
            FieldSize := CreateTable.Fields[I].Size;
            FieldDec := 0;
          End;
        RW_INTEGER, RW_AUTOINC: Begin
            FieldType := 'N';
            FieldSize := 11;
            FieldDec := 0;
          End;
        RW_SMALLINT: Begin
            FieldType := 'N';
            FieldSize := 6;
            FieldDec := 0;
          End;
        RW_BOOLEAN: Begin
            FieldType := 'L';
            FieldSize := 1;
            FieldDec := 0;
          End;
        RW_DATE, RW_TIME, RW_DATETIME: Begin
            FieldType := 'D';
            FieldSize := 10;
            FieldDec := 0;
          End;
        RW_MONEY, RW_FLOAT: Begin
            FieldType := 'N';
            If CreateTable.Fields[I].Scale = 0 Then Begin
              FieldSize := 20;
              FieldDec := 4;
            End Else Begin
              FieldSize := CreateTable.Fields[I].Scale;
              FieldDec := CreateTable.Fields[I].Precision;
            End;
          End;
        RW_BLOB: Begin // use BlobType property here
            Case CreateTable.Fields[I].BlobType Of
              1, 3: FieldType := 'M'; // Memo, Formatted Memo
              2, 4: FieldType := 'B'; // Binary, OLE
              5: FieldType := 'G'; // Graphic/Binary
            End;
            FieldSize := 8;
            FieldDec := 0;
          End;
      End;
      FieldList.Add(Format('%s;%s;%d;%d', [FieldName, FieldType, FieldSize, FieldDec]));
    End;
    FileName := CreateTable.TableName;
    gs6_shel.CreateDBF(FileName, '', FoxPro2, FieldList); // change FoxPro2 to your choice
    If CreateTable.PrimaryKey.Count > 0 Then Begin
      S := CreateTable.PrimaryKey[0];
      For I := 1 To CreateTable.PrimaryKey.Count - 1 Do S := S + '+' + CreateTable.PrimaryKey[I];
      Halc := THalcyonDataSet.Create(Nil);
      Try
        Halc.DataBaseName := ExtractFilePath(FileName);
        Halc.TableName := ExtractFileName(FileName);
        Halc.Open;
        IndexFileName := ChangeFileExt(FileName, '.cdx');
        Halc.IndexOn(IndexFileName, 'PRIMARY', S, '.NOT.DELETED()', Halcn6DB.Unique, Halcn6DB.Ascending); // optionl
      Finally
        Halc.Free;
      End;
    End;
    ShowMessage(Format('Table %s was successful created', [FileName]));
  Finally
    FieldList.Free;
  End;
  {$ENDIF}
End;

Procedure TfrmTest.XQuery1SyntaxError(Sender: TObject; Const ErrorMsg, OffendingText: String; LineNum, ColNum, TextLen: Integer);
Var
  I, NumChars: Integer;
Begin
  ShowMessage(ErrorMsg + ' at or before ' + OffendingText + Format(' Line %d, Column %d', [LineNum, ColNum]));
  { Will not show or use ErrorMsg parameter }
  NumChars := 0;
  I := 0;
  While I < LineNum - 1 Do Begin
    Inc(NumChars, Length(RichEdit1.Lines[I]) + 2);
    Inc(I);
  End;
  PageControlSQLExamples.ActivePage := TabSheetSQLString;
  RichEdit1.SelStart := NumChars + ColNum;
  RichEdit1.SelLength := TextLen;
  RichEdit1.SetFocus;
End;

Procedure TfrmTest.Button12Click(Sender: TObject);
Begin
  If Not XQuery1.Active Then Exit;
End;

Procedure TfrmTest.BtnQBuilderClick(Sender: TObject);
Begin
  {$IFDEF QUERYBUILDER}
  If Not Assigned(FOQBDialog) Then Begin
    FOQBDialog := TOQBuilderDialog.Create(Self);
    FOQBxQuery := TOQBEnginexQry.Create(Self);
    FOQBxQuery.XQuery := XQuery1;
    FOQBxQuery.UseTableAliases := True;
    FOQBDialog.OQBEngine := FOQBxQuery;
  End;
  If FOQBDialog.Execute Then RichEdit1.Lines.Text := FOQBDialog.Sql.Text;
  {$ELSE}
  ShowMessage('If you want to use the query builder option,' + CRLF +
    'You must download the software from this URL : ' + CRLF +
    'http://www.geocities.com/SiliconValley/Way/9006/index.html' + CRLF +
    'After downloading see help file for details searching for:' + CRLF +
    '"Query builder"' + CRLF +
    'After that, enable optional compilation switch QUERYBUILDER on' + CRLF +
    'top of this form');
  {$ENDIF}
End;

Procedure TfrmTest.Saveresultsetastext1Click(Sender: TObject);
Var
  FieldNames: TStringList;
Begin
  If Not XQuery1.Active Or Not SaveDialog1.Execute Then Exit;
  FieldNames := TStringList.Create;
  Try
    XQuery1.WriteToTextFile(SaveDialog1.FileName, // save to this file
      '"', // field delim character
      ',', // text separator
      False, // true = CSV format, false = text only
      FieldNames); // empty = all fields
  Finally
    FieldNames.Free;
  End;
End;

Procedure TfrmTest.PageControlSQLExamplesChange(Sender: TObject);
Begin
  ButtonRunSQL.Enabled := (PageControlSQLExamples.ActivePage = TabSheetSQLString) And (Trim(RichEdit1.Text) <> '');
End;

procedure TfrmTest.SpeedButton1Click(Sender: TObject);
var