qbuilder.pas

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

{*******************************************************}
{                                                       }
{       Delphi Visual Component Library                 }
{       Open QBuilder Dialog component                  }
{                                                       }
{       Copyright (c) 1996-99 Sergey Orlik              }
{                                                       }
{     Written by:                                       }
{       Sergey Orlik and Alfonso Moreno                 }
{       product manager                                 }
{       Russia, C.I.S. and Baltic States (former USSR)  }
{       Inprise Moscow office                           }
{       Internet:  [e-mail]                    }
{       www.geocities.com/SiliconValley/Way/9006/       }
{                                                       }
{*******************************************************}

{$HINTS OFF}

{$R QBButton.res}
unit QBuilder;

{$I xq_flag.inc}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, ExtCtrls, StdCtrls, ComCtrls, ToolWin, Menus, CheckLst, Grids,
  DB, DBGrids, SyntaxHi, xqmiscel;

type
  TOQBbutton = (bOpenDialog, bSaveDialog, bRunQuery);
  TOQBbuttons = set of TOQBbutton;

  TOQBEngine = class;

  TOQBuilderDialog = class(TComponent)
  private
    FOQBForm : TForm;
    FSQL : TStrings;
    FOQBEngine: TOQBEngine;
    FShowButtons: TOQBbuttons;
    procedure SetOQBEngine(const Value: TOQBEngine);
    procedure SetShowButtons(const Value: TOQBbuttons);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean; virtual;
    property SQL: TStrings read FSQL;
  published
    property OQBEngine: TOQBEngine read FOQBEngine write SetOQBEngine;
    property ShowButtons: TOQBbuttons read FShowButtons write SetShowButtons
      default [bOpenDialog, bSaveDialog, bRunQuery];
    property OQBForm : TForm read FOQBForm;
  end;

  TOQBEngine = class(TComponent)
  private
    FDatabaseName: string;
    FUserName: string;
    FPassword: string;
    FTableList : TStringList;
    FAliasList : TStringList;
    FFieldList : TStringList;
    FSQL: TStringList;
    FSQLcolumns: TStringList;
    FSQLcolumns_table: TStringList;
    FSQLcolumns_func: TStringList;
    FSQLfrom: TStringList;
    FSQLwhere: TStringList;
    FSQLgroupby: TStringList;
    FSQLorderby: TStringList;
    FUseTableAliases: boolean;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetDatabaseName(const Value: string); virtual;
    procedure SetUserName(const Value: string); virtual;
    procedure SetPassword(const Value: string); virtual;
    procedure SetQuerySQL(Value: string); virtual; abstract;
    procedure GenerateAliases;
    procedure ReadTableList; virtual; abstract;
    procedure ReadFieldList(ATableName: string); virtual; abstract;
  public
    FOQBDialog : TOQBuilderDialog;
    TableName : string;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function  SelectDatabase: boolean; virtual; abstract;
    function  GenerateSQL : string; virtual; // is not abstract !!!
    procedure ClearQuerySQL; virtual; abstract;
    function  ResultQuery : TDataSet; virtual; abstract;
    procedure OpenResultQuery; virtual; abstract;
    procedure CloseResultQuery; virtual; abstract;
    procedure SaveResultQueryData; virtual; abstract;
    property  TableList : TStringList read FTableList;
    property  AliasList : TStringList read FAliasList;
    property  FieldList : TStringList read FFieldList;
    property  SQL : TStringList read FSQL;
    property  SQLcolumns : TStringList read FSQLcolumns;
    property  SQLcolumns_table : TStringList read FSQLcolumns_table;
    property  SQLcolumns_func : TStringList read FSQLcolumns_func;
    property  SQLfrom : TStringList read FSQLfrom;
    property  SQLwhere : TStringList read FSQLwhere;
    property  SQLgroupby : TStringList read FSQLgroupby;
    property  SQLorderby : TStringList read FSQLorderby;

    property UseTableAliases : boolean read FUseTableAliases write FUseTableAliases default true;
  end;

type
  TArr = array [0..0] of integer;
  PArr = ^TArr;

  TOQBLbx = class(TCheckListBox)
  private
    FArrBold : PArr;
    FLoading : boolean;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DrawItem;
    procedure WMLButtonDown(var Message: TWMLButtonDblClk); message WM_LButtonDown;
    procedure WMRButtonDown(var Message: TWMRButtonDblClk); message WM_RButtonDown;
    function  GetCheckW: Integer;
    procedure AllocArrBold;
    procedure SelectItemBold(Item:integer);
    procedure UnSelectItemBold(Item:integer);
    function  GetItemY(Item:integer):integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ClickCheck; override;
  end;

  TOQBTable = class(TPanel)
  private
    ScreenDC : HDC;
    OldX,
    OldY,
    OldLeft,
    OldTop   : Integer;
    ClipRgn  : HRGN;
    ClipRect,
    MoveRect : TRect;
    Moving   : Boolean;
    FCloseBtn,
    FUnlinkBtn : TSpeedButton;
    FLbx : TOQBLbx;
    FTableName : string;
    FTableAlias : string;
    PopMenu : TPopupMenu;
    procedure WMRButtonDown(var Message: TWMRButtonDblClk); message WM_RButtonDown;
    function  Activate(const ATableName:string; X,Y:Integer):boolean;
    function  GetRowY(FldN:integer):integer;
    procedure _CloseBtn(Sender: TObject);
    procedure _UnlinkBtn(Sender: TObject);
    procedure _SelectAll(Sender: TObject);
    procedure _UnSelectAll(Sender: TObject);
    procedure _DragOver(Sender, Source: TObject; X, Y: Integer;
                            State: TDragState; var Accept: Boolean);
    procedure _DragDrop(Sender, Source: TObject; X, Y: Integer);
  protected
    procedure SetParent(AParent: TWinControl); override;
    procedure MouseDown(Button:TMouseButton; Shift:TShiftState; X,Y:Integer); override;
    procedure MouseMove(Shift:TShiftState; X,Y:Integer); override;
    procedure MouseUp(Button:TMouseButton; Shift:TShiftState; X,Y:Integer); override;
    property Align;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  end;

  TOQBLink = class(TShape)
  private
    Tbl1,
    Tbl2 : TOQBTable;
    FldN1,
    FldN2 : integer;
    FldNam1,
    FldNam2 : string;
    FLinkOpt,
    FLinkType : integer;
    LnkX,
    LnkY : byte;
    Rgn  : HRgn;
    PopMenu : TPopupMenu;
    procedure _Click(X,Y:integer);
    procedure CMHitTest(var Message: TCMHitTest); message CM_HitTest;
    function  ControlAtPos(const Pos: TPoint): TControl;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure WndProc(var Message: TMessage); override;
    procedure Paint; override;
  end;

  TOQBArea = class(TScrollBox)
  public
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetOptions(Sender: TObject);
    procedure InsertTable(X,Y: Integer);
    function  InsertLink(_tbl1,_tbl2: TOQBTable; _fldN1,_fldN2: Integer):TOQBLink;
    function  FindTable(TableName:string):TOQBTable;
    function  FindLink(Link:TOQBLink):boolean;
    function  FindOtherLink(Link:TOQBLink;Tbl:TOQBTable;FldN:integer):boolean;
    procedure ReboundLink(Link:TOQBLink);
    procedure ReboundLinks4Table(ATable:TOQBTable);
    procedure Unlink(Sender: TObject);
    procedure UnlinkTable(ATable:TOQBTable);
    procedure _DragOver(Sender, Source: TObject; X, Y: Integer;
                                State: TDragState; var Accept: Boolean);
    procedure _DragDrop(Sender, Source: TObject; X, Y: Integer);
  end;

  { definitions for the field in every column }
  TOQBSortType = (stNone,
                  stAsc,
                  stDesc);

  TOQBFilterAction = ( faIsEqualTo,
                       faIsBetween,
                       faIsGreaterThan,
                       faIsGreaterEqualTo,
                       faIsLessThan,
                       faIsLessEqualTo,
                       faIsLike,
                       faIsNotEqualTo,
                       faIsNotBetween,
                       faIsNotLike );

  TOQBShowAction = ( saShow,
                     saGroup,
                     saHide,
                     saSum,
                     saCount,
                     saAverage,
                     saMinimum,
                     saMaximum );

  TOQBFilterList = class;

  TOQBFilter = class
  private
     FFilterList   : TOQBFilterList;
     FFilterAction : TOQBFilterAction;
     FCustomExpres : String;       { custom expression }
     FData         : array[1..5] of String;
     function GetData(Index: Integer): String;
     procedure SetData(Index: Integer; const Value: String);
  public
     constructor Create(FilterList : TOQBFilterList);
     function FilterVerb: String;
     function IsFilterEmpty(Index: Integer): Boolean;

     property FilterAction: TOQBFilterAction read FFilterAction write FFilterAction;
     property CustomExpres: String read FCustomExpres write FCustomExpres;
     property Data[Index: Integer]: String read GetData write SetData;
  end;

  TOQBFilterList = class
     FItems: TList;
     function GetCount: Integer;
     function GetItem(Index: Integer): TOQBFilter;
  public
     constructor Create;
     destructor Destroy; override;
     function Add: TOQBFilter;
     procedure Clear;
     procedure Delete(Index: Integer);
     property Count: Integer read GetCount;
     property Items[Index: Integer]: TOQBFilter read GetItem; default;
  end;

  TOQBFieldList = class;

  TOQBField = class
  private
     FFieldList  : TOQBFieldList;
     FTable      : String;         { the Table }
     FTableAlias : string;
     FFieldName  : String;         { The FieldName }
     FAlias      : String;         { the Alias }
     FSortType   : TOQBSortType;   { the sort for the column }
     FShowAction : TOQBShowAction; { show actioin for the column }
     FFilters    : TOQBFilterList; { the filters }
  public
     constructor Create(FieldList : TOQBFieldList);
     destructor Destroy; override;
     procedure Assign(Source: TOQBField);
     procedure SaveToStream(Stream: TStream);
     procedure LoadFromStream(Stream: TStream);

     property Table : String read FTable write FTable;
     property TableAlias : String read FTableAlias write FTableAlias;
     property FieldName: String read FFieldName write FFieldName;
     property Alias : String read FAlias write FAlias;
     property SortType : TOQBSortType read FSortType write FSortType;
     property ShowAction : TOQBShowAction read FShowAction write FShowAction;
     property Filters : TOQBFilterList read FFilters write FFilters;
  end;

  TOQBFieldList = class
     FItems: TList;
     function GetCount: Integer;
     function GetItem(Index: Integer): TOQBField;
  public
     constructor Create;
     destructor Destroy; override;
     function Add: TOQBField;
     function Insert(Index: Integer): TOQBField;
     procedure ColumnMoved(FromIndex,ToIndex: Integer);
     procedure Exchange(FromIndex,ToIndex: Integer);
     procedure Clear;
     procedure Delete(Index: Integer);
     procedure SaveToStream(Stream: TStream);
     procedure LoadFromStream(Stream: TStream);

     property Count: Integer read GetCount;
     property Items[Index: Integer]: TOQBField read GetItem; default;
  end;

  TOQBGrid = class(TDrawGrid)
  private
    FFieldList : TOQBFieldList;
    procedure _ColumnMoved(Sender: TObject; FromIndex,ToIndex: Integer);
  protected
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    CurrCol    : integer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateParams(var Params: TCreateParams); override;
    function IsEmpty: Boolean;
    procedure WndProc(var Message: TMessage); override;
    function  MaxSW(const s1,s2:string):integer;
    procedure Insert(aCol:integer;const aField,aTable,aTableAlias:string);
    function  FindColumn(const sCol:string):integer;
    function  FindSameColumn(aCol:integer):boolean;
    procedure RemoveColumn(aCol:integer);
    procedure RemoveColumn4Tbl(const Tbl:string);
    procedure ClickCell(X,Y:integer);
    procedure DblClickCell(X,Y:integer);
    procedure ResetWidths;
    //function  SelectCell(ACol, ARow: integer):boolean; override;
    procedure _DragOver(Sender,Source:TObject;X,Y:integer;State:TDragState;var Accept:boolean);
    procedure _DragDrop(Sender,Source:TObject;X,Y:integer);

    property FieldList: TOQBFieldList read FFieldList;
  end;

  TOQBForm = class(TForm)
    mnuTbl: TPopupMenu;
    Remove1: TMenuItem;
    ResDataSource: TDataSource;
    DlgSave: TSaveDialog;
    DlgOpen: TOpenDialog;
    Panel2: TPanel;
    btnNew: TSpeedButton;
    btnOpen: TSpeedButton;
    btnSave: TSpeedButton;
    Bevel1: TBevel;
    btnSQL: TSpeedButton;
    btnResults: TSpeedButton;
    Pages: TPageControl;
    TabColumns: TTabSheet;
    TabSQL: TTabSheet;
    MemoSQL: TRichEdit;
    TabResults: TTabSheet;
    ResDBGrid: TDBGrid;
    Panel3: TPanel;
    QBTables: TListBox;
    HSplitter: TSplitter;
    VSplitter: TSplitter;
    Bevel3: TBevel;
    btnColorSet: TSpeedButton;
    Panel1: TPanel;
    Bevel2: TBevel;
    btnExport: TSpeedButton;
    SaveDialog1: TSaveDialog;
    SyntaxHighlighter1: TSyntaxHighlighter;
    Button1: TButton;
    Button2: TButton;
    procedure mnuRemoveClick(Sender: TObject);
    procedure btnNewClick(Sender: TObject);
    procedure btnOpenClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnSQLClick(Sender: TObject);
    procedure btnResultsClick(Sender: TObject);
    procedure btnColorSetClick(Sender: TObject);
    procedure btnExportClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  protected
    QBDialog : TOQBuilderDialog;
    QBArea   : TOQBArea;
    QBGrid   : TOQBGrid;

    procedure ClearAll;
    procedure OpenDatabase;
  public
    procedure CreateParams(var Params: TCreateParams); override;
  end;

implementation

uses
  QBLnkFrm, xqconsts, QBEdFrm;

{$R *.DFM}

resourcestring
  sMainCaption = 'Query Builder';
  sNotValidTableParent = 'Parent must be TScrollBox or its descendant.';
  sLinkHint = 'Click here for options';

const

  sRows : array[0..8] of string =
     ( 'Field',
       'Table',
       'Show',
       'Sort',
       'Filter 1',
       'Filter 2',
       'Filter 3',
       'Filter 4',
       'Filter 5' );

  sShow : array[TOQBShowAction] of string =
     ( 'Show',
       'Group',
       'Hide',
       'Sum',
       'Count',
       'Average',
       'Minimum',
       'Maximum');

  sAggregate : array[TOQBShowAction] of string =
     ( '',
       '',
       '',
       'SUM',
       'COUNT',
       'AVG',
       'MIN',
       'MAX');

  sFilterAction : array[TOQBFilterAction] of string =
     ( '=',
       'BETWEEN',
       '>',
       '>=',
       '<',
       '<=',
       'LIKE',
       '<>',
       'BETWEEN',
       'LIKE'
       );

  sFilterActionVerb : array[TOQBFilterAction] of string =
     ( ' Is Equal To ',
       ' Is Between ',
       ' Is Greater Than ',
       ' Is Greater Than Or Equal To ',
       ' Is Less Than ',
       ' Is Less Than Or Equal To ',
       ' Is Like ',
       ' Is Not Equal To ',
       ' Is Not Between ',
       ' is Not Like '
       );

  sSort  : array [TOQBSortType] of string =
    ( '',
      'Asc',
      'Desc' );

  sLinkOpt : array [0..5] of string =
    ('=',