unit XSDBGrid;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, Grids, DBGrids, DBTables, DB, StdCtrls;

const
  DWIDTH=200;
  DHEIGHT=80;

type
  TMyStringGrid=class(TStringGrid)
  protected
    procedure SelectCell(Sender: TObject;
              Col, Row: Longint; var CanSelect: Boolean);
    procedure TopLeftChanged; override;
    procedure KeyDown(var AKey: word; AShift: TShiftState); override;
    procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
    procedure MouseDown(Button: TMouseButton; Shift:
              TShiftState; X, Y: Integer); override;
    procedure ColWidthsChanged; override;
    procedure MouseUp(Button: TMouseButton; Shift:
              TShiftState; X, Y: Integer); override;
  Public
    constructor Create(AOwner: TComponent); override;
  end;

  TMyDBGrid=class(TDBGrid)
  protected
    procedure ColEnter; override;
    procedure TopLeftChanged; override;
    procedure KeyDown(var AKey: word; AShift: TShiftState); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TXSearchDBGrid=class;
  TonFieldSelectEvent=procedure(Sender: TXsearchDBGrid;
                                field: TField; var fieldname: string;
                                var select: boolean) of object;
  TonFieldFilterEvent=procedure(Sender: TXsearchDBGrid;
                                var field: TField; var condition: string;
                                var doconversion: boolean) of object;
  TonFieldOrderEvent=procedure(Sender: TXsearchDBGrid;
                                var field: TField;
                                var doorder: boolean) of object;
  TOnGetSQLEvent=procedure(Sender: TXsearchDBGrid;
                           var line: string) of object;
  TXSearchDBGrid=class(TPanel)
  private
    FStringGrid: TMyStringGrid;
    FDBGrid: TMyDBGrid;
    FFilter: TStringList;
    FSQLFilter: boolean;
    FOnGetFrom: TOnGetSQLEvent;
    FOnGetWhere: TOnGetSQLEvent;
    FOnGetSelect: TOnGetSQLEvent;
    FOnGetOrder: TOnGetSQLEvent;
    FonFieldSelect: TonFieldSelectEvent;
    FOnFieldFilter: TOnFieldFilterEvent;
    FonFieldOrder: TonFieldOrderEvent;
    function GetDataSource: TDataSource;
    procedure SetDataSource(AValue: TDataSource);
    function GetFilter: TStringList;
  protected
    procedure Paint; override;
    procedure Loaded; override;
    procedure DoEnter; override;
    procedure CreateParams(var ACreateParams: TCreateParams); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ClearFilter;

  published
    property Filter: TStringList read GetFilter;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property SQLFilter: boolean read FSQLFilter write FSQLFilter;
    property OnFieldSelect: TOnFieldSelectEvent
             read FonFieldSelect write FonFieldSelect;
    property OnFieldFilter: TOnFieldFilterEvent
             read FonFieldFilter write FonFieldFilter;
    property OnFieldOrder: TOnFieldOrderEvent
             read FonFieldOrder write FonFieldOrder;
    property OnGetSelect: TOnGetSQLEvent read FOnGetSelect write FOnGetSelect;
    property OnGetFrom: TOnGetSQLEvent read FOnGetFrom write FOnGetFrom;
    property OnGetWhere: TOnGetSQLEvent read FOnGetWhere write FOnGetWhere;
    property OnGetOrder: TOnGetSQLEvent read FOnGetOrder write FOnGetOrder;
  end;

procedure Register;

implementation

constructor TMyStringGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  RowCount:=3;
  ColCount:=2;
  ColWidths[0]:=10;
  ScrollBars:=ssNone;
  Options:=Options+[goEditing, goColSizing, goColMoving];
  Parent:=AOwner as TWinControl;
  OnSelectCell:=SelectCell;
  Align:=alTop;
end;

procedure TMyStringGrid.SelectCell(Sender: TObject;
              Col, Row: Longint; var CanSelect: Boolean);
begin
     CanSelect:=true;
     (Parent as TXSearchDBGrid).FDBGrid.Col:=col;
end;

procedure TMyStringGrid.TopLeftChanged;
begin
  inherited TopLeftChanged;
  (Parent as TXSearchDBGrid).FDBGrid.LeftCol:=LeftCol;
end;

procedure TMyStringGrid.KeyDown(var AKey: word; AShift: TShiftState);
begin
  if (AKey=VK_DOWN) or (AKey=VK_NEXT) then
     (Parent as TXSearchDBGrid).FDBGrid.SetFocus
  else if (((AKey=VK_LEFT) or (AKey=VK_RIGHT)) and not(AShift=[]))
       or (AKey=VK_UP) or (AKey=VK_PRIOR)
       then (Parent as TXSearchDBGrid).FDBGrid.KeyDown(Akey, AShift)
  else inherited KeyDown(AKey, AShift);
end;

procedure TMyStringGrid.ColumnMoved(FromIndex, ToIndex: Longint);
var l: longint;
begin
  inherited ColumnMoved(FromIndex, ToIndex);
  Tag:=0;
  (Parent as TXSearchDBGrid).FDBGrid.Fields[FromIndex-1].index:=ToIndex-1;
end;

procedure TMyStringGrid.MouseDown(Button: TMouseButton; Shift:
          TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, x, Y);
  Tag:=1;
end;

procedure TMyStringGrid.ColWidthsChanged;
begin
     inherited ColWidthsChanged;
     if Tag>0 then Tag:=-Tag;
end;

procedure TMyStringGrid.MouseUp(Button: TMouseButton; Shift:
          TShiftState; X, Y: Integer);
var b, b2: integer;
begin
  inherited MouseUp(Button, Shift, x, Y);
  if Tag=0 then exit;
  Tag:=0;
  if y>rowheights[0] then exit;
  b2:=colcount-1;
  if LeftCol+VisibleColCount-FixedCols+1<b2 then
     b2:=LeftCol+VisibleColCount-FixedCols+1;
  for b:=leftCol to b2 do begin
      (Parent as TXSearchDBGrid).FDBGrid.ColWidths[b]:=ColWidths[b];
      ColWidths[b]:=(Parent as TXSearchDBGrid).FDBGrid.ColWidths[b];
  end;
end;

constructor TMyDBGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ReadOnly:=True;
  Parent:=AOwner as TWinControl;
  Options:=Options-[dgTitles,dgEditing]+[dgAlwaysShowSelection];
  Align:=alClient;
end;

procedure TMyDBGrid.TopLeftChanged;
begin
  inherited TopLeftChanged;
 (Parent as TXSearchDBGrid).FStringGrid.LeftCol:=LeftCol;
end;

procedure TMyDBGrid.ColEnter;
begin
  inherited ColEnter;
  (Parent as TXSearchDBGrid).FStringGrid.Col:=Col;
end;

procedure TMyDBGrid.KeyDown(var AKey: word; AShift: TShiftState);
var actcol, newcol: byte;
    w: word;
    s: string;
begin
  actcol:=(Parent as TXSearchDBGrid).FStringGrid.Col;
  if (Row=FixedRows) and ((AKey=VK_UP) or (AKey=VK_PRIOR)) then
     (Parent as TXSearchDBGrid).FStringGrid.SetFocus;
  if (ssShift in AShift) and
      (((AKey=VK_LEFT) and (actcol>FixedCols)) or
      ((AKey=VK_RIGHT) and (actcol<ColCount-1))) then begin
      newcol:=actcol;
      if AKey=VK_LEFT then Dec(newcol)
                      else Inc(newcol);
      with (Parent as TXSearchDBGrid).FStringGrid do begin
           w:=ColWidths[newcol];
           ColWidths[newcol]:=ColWidths[actcol];
           ColWidths[actcol]:=w;
           s:=cells[newcol,1];
           cells[newcol,1]:=cells[actcol,1];
           cells[actcol,1]:=s;
           ColumnMoved(actcol,newcol);
           col:=newcol;
      end;
  end
  else if (ssCtrl in AShift) and
      ((AKey=VK_LEFT) or (AKey=VK_RIGHT)) then begin
      w:=ColWidths[actcol];
      if not ((w<20) and (AKey=VK_LEFT)) then begin
         if AKey=VK_LEFT then Dec(w, 10)
                         else Inc(w, 10);
      colwidths[actcol]:=w;
      (Parent as TXSearchDBGrid).FStringGrid.ColWidths[actcol]:=
              colwidths[actcol];
    end;
  end
  else inherited KeyDown(AKey, AShift);
end;

constructor TXSearchDBGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width:=DWIDTH;
  Height:=DHEIGHT;
  FFilter:=TStringList.Create;
  FDBGrid:=TMyDBGrid.Create(Self);
  FStringGrid:=TMyStringGrid.Create(Self);
end;

destructor TXSearchDBGrid.Destroy;
begin
  FFilter.Free;
  FDBGrid.Free;
  FStringGrid.Free;
  inherited Destroy;
end;

procedure TXSearchDBGrid.Paint;
var b, b2: integer;
begin
  FStringGrid.tag:=0;
  FStringGrid.ColCount:=FDBGrid.ColCount;
  FStringGrid.RowCount:=2;
  FStringGrid.Height:=FStringGrid.RowHeights[0]+FStringGrid.RowHeights[1];
  for b:=0 to FDBGrid.ColCount-1 do begin
      FStringGrid.ColWidths[b]:=FDBGrid.ColWidths[b];
      FStringGrid.Cells[b,0]:='';
  end;
  if FDBGrid.FieldCount+FDBGrid.FixedCols<FDBGrid.ColCount then b2:=FDBGrid.FieldCount+FDBGrid.FixedCols
  else b2:=FDBGrid.ColCount;
  for b:=FDBGrid.FixedCols to b2-1 do
      FStringGrid.Cells[b,0]:=FDBGrid.Fields[b-FDBGrid.FixedCols].DisplayLabel;
  inherited Paint;
end;

procedure TXSearchDBGrid.Loaded;
begin
  inherited Loaded;
  Refresh;
end;

procedure TXSearchDBGrid.DoEnter;
begin
  inherited DoEnter;
  Refresh;
end;

procedure TXSearchDBGrid.CreateParams(var ACreateParams: TCreateParams);
begin
  inherited CreateParams(ACreateParams);
  ACreateParams.Caption:='';
end;

function TXSearchDBGrid.GetDataSource: TDataSource;
begin
  Result:=FDBGrid.DataSource;
end;

procedure TXSearchDBGrid.SetDataSource(AValue: TDataSource);
begin
  FDBGrid.DataSource:=AValue;
  refresh;
end;

procedure TXSearchDBGrid.ClearFilter;
begin
     FStringGrid.Rows[1].Clear;
end;

function TXSearchDBGrid.GetFilter: TStringList;
const delimiters=[' ',','];
var vesszo: boolean;
    acts:string;
    ende: boolean;
    linecount: byte;
          function readsql: string;
          begin
            result:='';
            vesszo:=false;
            if ende then exit;
            while acts='' do begin
                  if linecount=(datasource.dataset as TQuery).SQL.Count then begin
                     ende:=true;
                     exit;
                  end;
                  acts:=(datasource.dataset as TQuery).SQL[linecount];
                  inc(linecount);
                  while (acts<>'') and (acts[1] in delimiters) do
                        delete(acts,1,1);
            end;
            while (acts<>'') and not(acts[1] in delimiters) do begin
                  result:=result+lowercase(acts[1]);
                  delete(acts,1,1);
            end;
            while (acts<>'') and (acts[1] in delimiters) do begin
                  if acts[1]=',' then vesszo:=true;
                  delete(acts,1,1);
            end;
            while acts='' do begin
                  if linecount=(datasource.dataset as TQuery).SQL.Count then begin
                     ende:=true;
                     exit;
                  end;
                  acts:=(datasource.dataset as TQuery).SQL[linecount];
                  inc(linecount);
                  while (acts<>'') and (acts[1] in delimiters) do begin
                        if acts[1]=',' then vesszo:=true;
                        delete(acts,1,1);
                  end;
            end;
          end;
var s, s2, ss:string;
    i: integer;
    b, b2, b3: boolean;
    field: TField;
begin
  Result:=FFilter;
  FFilter.clear;
  if (DataSource=nil) or (DataSource.DataSet=nil) then exit;
  if DataSource.DataSet is TQuery then begin
     ende:=false;
     acts:='';
     linecount:=0;
     s:=readsql;
     if s<>'select' then exit;
     s:=readsql;
     s2:='';
     ss:='';
     while (s<>'') and (s<>'from') do begin
           s2:=s2+s+' ';
           if vesszo then begin
              FFilter.add(s+'='+s2);
              s2:='';
           end;
           ss:=s;
           s:=readsql;
     end;
     if (s<>'from') or (ss='') then begin
        FFilter.clear;
        exit;
     end;
     FFilter.add(ss+'='+s2);
     s:='select';
     b2:=true;
     if Assigned(FOnGetSelect) then
        while s<>'' do begin
              FFilter.add(s);
              FOnGetSelect(self, s);
              if s<>'' then b2:=false;
     end else
         FFilter.add('select');
     with DataSource.DataSet do
     for i:=0 to fieldcount-1 do begin
         b:=fields[i].visible and not(fields[i].calculated);
         s:=FFilter.values[fields[i].fieldname];
         ss:=s;
         if s='' then s:=fields[i].fieldname;
         if Assigned(FOnFieldSelect) then
            FOnFieldSelect(self, fields[i], s, b);
         if ss='' then FFilter.insert(0, fields[i].fieldname+'='+s)
         else FFilter.values[fields[i].fieldname]:=s;
         if b then begin
            if b2 then b2:=false
            else s:=','+s;
            FFilter.add(s);
         end;
     end;
     s:='from';
     if Assigned(FOnGetFrom) then
        while s<>'' do begin
              FFilter.add(s);
              FOnGetFrom(self, s);
     end else
         while (s<>'') and (s<>'where') and (s<>'order')
               and (s<>'group') do begin
               FFilter.add(s);
               s:=readsql;
     end;
     b2:=true;
     b3:=true;
     s:='where';
     if Assigned(FOnGetWhere) then
        while s<>'' do begin
              FFilter.add(s);
              FOnGetWhere(self, s);
              b2:=false;
              if s<>'' then b3:=false;
     end;
     for i:=0 to FDBGrid.FieldCount-1 do begin
         field:=FDBGrid.Fields[i];
         s:=FStringGrid.cells[i+FStringGrid.FixedCols,1];
         b:=true;
         if assigned(FOnFieldFilter) then
            FOnFieldFilter(self, field, s, b);
         if s<>'' then begin
            if b2 then begin
               FFilter.add('where');
               b2:=false;
            end;
            s2:=FFilter.values[field.fieldname];
            if s2='' then s2:=field.fieldname
            else if pos(' as ', s2)>0 then
                 s2:=copy(s2, 1,pos(' as ',s2));
            s:=s2+s;
            if b3 then b3:=false
            else s:='and '+s;
            FFilter.add(s);
         end;
     end;
     b2:=true;
     b3:=true;
     s:='order by';
     if Assigned(FOnGetOrder) then
        while s<>'' do begin
              FFilter.add(s);
              FOnGetorder(self, s);
              b2:=false;
              if s<>'' then b3:=false;
     end;
     for i:=0 to FDBGrid.FieldCount-1 do begin
         field:=FDBGrid.Fields[i];
         b:=not(field.calculated);
         if assigned(FOnFieldOrder) then
            FOnFieldOrder(self, field, b);
         if b then begin
            if b2 then begin
               FFilter.add('order by');
               b2:=false;
            end;
            s:=field.fieldname;
            if b3 then b3:=false
            else s:=','+s;
            FFilter.add(s);
         end;
     end;
     while (FFilter.count>0) and (FFilter.strings[0]<>'select') do FFilter.delete(0);
  end;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TXSearchDBGrid]);
end;

end.