rmd_qrydesigner.pas

这是一个功能强大

{*****************************************}
{                                         }
{ Report Machine v2.0 - Data storage      }
{            Query properties             }
{                                         }
{*****************************************}

unit RMD_QryDesigner;

interface

{$I RM.inc}

uses
  Windows, CommCtrl, SysUtils, Controls, ComCtrls, Classes, Graphics, ExtCtrls, Menus,
  Messages, StdCtrls, Forms, CheckLst, DB, Dialogs, Buttons, RMD_DBWrap, RM_Designer,
  ImgList
  {$IFDEF USE_SYNEDIT}, SynHighlighterSQL{$ENDIF};

type
  TRMListColumnEvent = procedure(aListView: TListView; aColumn: TListColumn) of object;

  { TRMListView }
  TRMListView = class(TListView)
  private
    FOnColumnResize: TRMListColumnEvent;
    FOnVerticalScroll: TNotifyEvent;
    FOnHorizontalScroll: TNotifyEvent;
    FOnScroll: TNotifyEvent;
    procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
    procedure WMVScroll(var Message: TWMHScroll); message WM_VSCROLL;
    procedure WMHScroll(var Message: TWMVScroll); message WM_HSCROLL;
  protected
    procedure DoColumnResize(aColumn: TListColumn); virtual;
    procedure DoVerticalScroll; virtual;
    procedure DoHorizontalScroll; virtual;
    procedure DoScroll; virtual;
  public
    property OnColumnResize: TRMListColumnEvent read FOnColumnResize write FOnColumnResize;
    property OnVerticalScroll: TNotifyEvent read FOnVerticalScroll write FOnVerticalScroll;
    property OnHorizontalScroll: TNotifyEvent read FOnHorizontalScroll write FOnHorizontalScroll;
    property OnScroll: TNotifyEvent read FOnScroll write FOnScroll;
  end;

  { TRMQBListView }
  TRMQBListView = class(TRMListView)
  private
  protected
    procedure DisplayEditControls(aVisible: Boolean); virtual;
    procedure SelectedSelectItemEvent(Sender: TObject; Item: TListItem; Selected: Boolean); virtual;
    procedure SelectedResizeEvent(Sender: TObject); virtual;
    procedure SelectedDblClickEvent(Sender: TObject); virtual;

    procedure SelectedScrollEvent(Sender: TObject);
    procedure SelectedColumnResizeEvent(aListView: TListView; aColumn: TListColumn);
    procedure SelectedClickEvent(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
  end;

  { TRMQBFieldsListView }
  TRMQBFieldListView = class(TRMQBListView)
  private
    procedure _AddItem(Sender: TObject; aItemIndex: integer);
    procedure DeleteItem(Sender: TObject; aItemIndex: integer);
    procedure _DoDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure _DoDragDrop(Sender, Source: TObject; X, Y: Integer);
  protected
  public
    constructor Create(AOwner: TComponent); override;
  end;

  { TRMQBCalcListView }
  TRMQBCalcListView = class(TRMQBListView)
  private
    procedure _AddItem(Sender: TObject; aItemIndex: integer);
    procedure _DoDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure _DoDragDrop(Sender, Source: TObject; X, Y: Integer);
  protected
    procedure DisplayEditControls(aVisible: Boolean); override;
    procedure SelectedSelectItemEvent(Sender: TObject; Item: TListItem; Selected: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  { TRMQBLbx }
  TRMQBLbx = class(TCheckListBox)
  private
    FLoading: Boolean;
    function GetItemY(Item: integer): integer;
  public
    constructor Create(AOwner: TComponent); override;
    procedure ClickCheck; override;
  end;

  { TRMQBTable }
  TRMQBTable = class(TPanel)
  private
    FCapturing: Boolean;
    FMouseDownSpot: TPoint;
    FLbx: TRMQBLbx;
    FTableName: string;
    FTableAlias: string;
    FEdtTableAlias: TEdit;
    FPopupMenu: TPopupMenu;

    procedure Activate(const ATableName: string; X, Y: Integer);
    function GetRowY(FldN: integer): integer;
    procedure _UnlinkBtn(Sender: TObject);
    procedure _DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure _DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure _CloseBtn(Sender: TObject);
    procedure _EditTableAlias(Sender: TObject);
    procedure _AfterEditTableAlias(Sender: TObject);
    procedure _EditTableAliasKeyPress(Sender: TObject; var Key: Char);
    procedure _MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure _MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure _MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure _Resize(Sender: TObject);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  { TRMQBLink }
  TRMQBLink = class(TShape)
  private
    Tbl1, Tbl2: TRMQBTable;
    FldN1, FldN2: integer;
    FldNam1, FldNam2: string;
    FLinkOpt, FLinkType: integer;
    LnkX, LnkY: byte;
    Rgn: HRgn;
    FPopMenu: 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;

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

  { TRMDQueryDesignerForm }
  TRMDQueryDesignerForm = class(TForm)
    pnlButtons: TPanel;
    Panel1: TPanel;
    pgcDesigner: TPageControl;
    TabSheetFields: TTabSheet;
    TabSheetCalc: TTabSheet;
    TabSheetSQL: TTabSheet;
    VSplitter: TSplitter;
    Image1: TImage;
    ImageList1: TImageList;
    cmbCalc: TComboBox;
    Panel3: TPanel;
    FieldsB: TSpeedButton;
    ParamsB: TSpeedButton;
    TabSheetGroup: TTabSheet;
    TabSheetSort: TTabSheet;
    edtExpr: TEdit;
    Panel5: TPanel;
    btnAddGroup: TSpeedButton;
    btnDeleteGroup: TSpeedButton;
    pnlGroupLeft: TPanel;
    Panel6: TPanel;
    Panel7: TPanel;
    lstGroupLeft: TListBox;
    lstGroupRight: TListBox;
    pnlSortLeft: TPanel;
    Panel9: TPanel;
    lstSortLeft: TListBox;
    Panel10: TPanel;
    btnAddSort: TSpeedButton;
    btnDeleteSort: TSpeedButton;
    Panel11: TPanel;
    Panel12: TPanel;
    btnSortAsc: TSpeedButton;
    btnSortDec: TSpeedButton;
    Panel4: TPanel;
    Panel13: TPanel;
    Label7: TLabel;
    Panel14: TPanel;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    lsvSortRight: TListView;
    Panel8: TPanel;
    Panel15: TPanel;
    Panel17: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    pmnSQLMemo: TPopupMenu;
    padModifySQL: TMenuItem;
    Bevel2: TBevel;
    Bevel1: TBevel;
    btnOK: TSpeedButton;
    btnCancel: TSpeedButton;
    btnNew: TSpeedButton;
    btnLoadFromFile: TSpeedButton;
    btnSaveToFile: TSpeedButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Panel16: TPanel;
    lsbTables: TListBox;
    Panel18: TPanel;
    cmbDatabase: TComboBox;
    Splitter1: TSplitter;
    Panel2: TPanel;
    btnModifySQL: TSpeedButton;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure FieldsBClick(Sender: TObject);
    procedure ParamsBClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure lsbTablesDrawItem(Control: TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState);
    procedure cmbCalcChange(Sender: TObject);
    procedure edtExprKeyPress(Sender: TObject; var Key: Char);
    procedure edtExprExit(Sender: TObject);
    procedure pgcDesignerChange(Sender: TObject);
    procedure TabSheetGroupResize(Sender: TObject);
    procedure TabSheetSortResize(Sender: TObject);
    procedure lstGroupLeftDblClick(Sender: TObject);
    procedure lstGroupRightDblClick(Sender: TObject);
    procedure lstSortLeftDblClick(Sender: TObject);
    procedure lsvSortRightDblClick(Sender: TObject);
    procedure btnSortAscClick(Sender: TObject);
    procedure btnSortDecClick(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure padModifySQLClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnLoadFromFileClick(Sender: TObject);
    procedure btnSaveToFileClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure Panel18Resize(Sender: TObject);
    procedure lsbTablesDblClick(Sender: TObject);
    procedure cmbDatabaseChange(Sender: TObject);
    procedure btnNewClick(Sender: TObject);
  private
    { Private declarations }
    FQuery: TRMDQuery;
    FSaveSQL: string;
    FSaveEditSQLAsText: Boolean;
    FSaveVisualSQL: TStringList;
    FSaveDatabase: string;
    SQLMemo: TRMSynEditor;
    {$IFDEF USE_SYNEDIT}
    FSynSQLSyn: TSynSQLSyn;
    {$ENDIF}

    FFieldListView: TRMQBFieldListView;
    FCalcListView: TRMQBCalcListView;

    procedure ApplySettings;
    procedure ClearAll;
    procedure SetQuery(Value: TRMDQuery);
    procedure DecodeVisualSQL;
    procedure SaveVisualSQL;
    procedure SetEditSQLAsText;
    procedure Localize;
  protected
    QBArea: TRMQBArea;
  public
    { Public declarations }
    property Query: TRMDQuery read FQuery write SetQuery;
  end;

implementation

uses RM_Class, RMD_QueryParm, RMD_EditorField, RM_Const, RM_Utils, RMD_Qblnk;

{$R *.DFM}

var
  FForm: TRMDQueryDesignerForm;

const
  Hand = 15;
  Hand2 = 12;

  //  sSort: array[0..2] of string = ('', 'Asc', 'Desc');
  //  sSort_1: array[0..2] of string = ('不排序', '升序', '降序');
  sFunc: array[0..5] of string = ('Sum', 'Count', 'Avg', 'Max', 'Min', '');
  sFunc_1: array[0..5] of string = ('Sum', 'Count', 'Avg', 'Max', 'Min', 'Expression');
  sLinkOpt: array[0..5] of string = ('=', '<', '>', '=<', '=>', '<>');
  sOuterJoin: array[1..3] of string = (' LEFT OUTER JOIN ', ' RIGHT OUTER JOIN ',
    ' FULL OUTER JOIN ');

type

  { TRMSQL }
  TRMSQL = class
  private
    FTables: TStringList;
    FTableAlias: TStringList;
    FColumns: TStringList;
    FGroups: TStringList;
    FSorts: TStringList;
    FWheres: TStringList;
    procedure geTables;
    procedure geColumns;
    procedure geGroups;
    procedure geSorts;
    procedure geWheres;
    function MakeFieldAlias(const str: string): string;
  protected
  public
    constructor Create;
    destructor Destroy; override;
    procedure Encode;
  end;

  {------------------------------------------------------------------------------}
  {------------------------------------------------------------------------------}
  {TRMSQL}

constructor TRMSQL.Create;
begin
  inherited Create;
  FTables := TStringList.Create;
  FTableAlias := TStringList.Create;
  FColumns := TStringList.Create;
  FGroups := TStringList.Create;
  FSorts := TStringList.Create;
  FWheres := TStringList.Create;
end;

destructor TRMSQL.Destroy;
begin
  FTables.Free;
  FTableAlias.Free;
  FColumns.Free;
  FGroups.Free;
  FSorts.Free;
  FWheres.Free;
  inherited Destroy;
end;

const
  ReservedWords: array[0..4] of string = ('size', 'option', 'position', 'level', 'date');

function TRMSQL.MakeFieldAlias(const str: string): string;
var
  aPos: integer;

  function isResrvedWord: Boolean;
  var
    aStr: string;
    i: integer;
  begin
    aStr := Copy(str, Pos('.', str) + 1, 99999);
    for i := 0 to High(ReservedWords) do
    begin
      if AnsiCompareText(aStr, ReservedWords[i]) = 0 then
      begin
        Result := TRUE;
        Exit;
      end;
    end;
    Result := FALSE;
  end;

begin
  if (FTables.Count = 1) and (Pos(' ', str) = 0) and (not isResrvedWord) then
    Result := Copy(str, Pos('.', str) + 1, 99999)
  else
  begin
    aPos := Pos('.', str);
    if Copy(str, aPos + 1, 99999) = '*' then
      Result := Copy(str, 1, aPos) + Copy(str, aPos + 1, 99999)
    else
      Result := Copy(str, 1, aPos) + '"' + Copy(str, aPos + 1, 99999) + '"';
  end;
end;

procedure TRMSQL.Encode;
var
  s: string;
  i: integer;
begin
  geTables;
  geColumns;
  geGroups;
  geSorts;
  geWheres;

  FForm.SQLMemo.Lines.Clear;
  for i := 0 to FColumns.Count - 1 do // SELECT
  begin
    if i = 0 then
      s := 'SELECT '
    else
      s := s + ', ';
    s := s + FColumns[i];
    if (length(s) > 60) or (i = FColumns.Count - 1) then
    begin
      FForm.SQLMemo.Lines.Add(s);
      s := '    ';
    end;
  end;

  for i := 0 to FTables.Count - 1 do // FROM
  begin
    if i = 0 then
      s := 'FROM '
    else
      s := s + ', ';
    if Length(FTableAlias[i]) > 0 then
    begin
      if Pos(' ', FTables[i]) > 0 then
        s := s + Format('"%s" %s', [FTables[i], FTableAlias[i]])
      else
        s := s + Format('%s %s', [FTables[i], FTableAlias[i]]);
    end
    else
      s := s + FTables[i];

    if (length(s) > 60) or (i = FTables.Count - 1) then
    begin
      FForm.SQLMemo.Lines.Add(s);
      s := '    ';
    end;
  end;

  for i := 0 to FWheres.Count - 1 do // WHERE
  begin
    if i = 0 then
      s := 'WHERE '
    else
      s := s + ' AND ';