dxdatasetqbe.pas

Well known and usefull component for delphi 7

unit DXDataSetQBE;

interface

uses
   DB,
{$IFDEF LINUX}
   QDBCtrls,
{$ELSE}
   DBCtrls,
   Windows,
{$ENDIF}
   DXDataSetMemoryStream,
   Messages,
   SysUtils,
   Classes,
   Graphics,
   Controls,
   Forms,
   Dialogs;

type
   PDXDataSetQBEOriginalColor = ^TDXDataSetQBEOriginalColor;
   TDXDataSetQBEOriginalColor = record
      Name: string;
      Color: TColor;
      FontColor: TColor;
      WasEnabled: Boolean;
      WasVisible: Boolean;
      OldDataField: string;
   end;

   TDXDataSetQBE = class(TComponent)
   private
      { Private declarations }
      fParent: TForm;
      fDataSource: TDataSource;
      fSQLSkeleton: TStringList;
      fIgnoreComponentClasses: TStringList;
      fQueryDataSet: TDXDataSetMemoryStream;
      fInternalDataSource: TDataSource;
      fSQLStringQuotationChar: Char;
      fAssumeWildCard: Boolean;
      fReturnOnlyWhere: Boolean;
      fQuoteDates: Boolean;
      fOracleSyntax: Boolean;
      fOldColors: TList;
      fInQBEAlready: Boolean;
      WherePart, WhereOnly: string;
      // 1.5
      fTablePrefix: string;
      fTableSuffix: string;
      // 1.6
      fResumeLastQuery: Boolean;
      // 1.7
      fSearchModeColor: TColor;
      fSearchModeFontColor: TColor;
   protected
      { Protected declarations }
      procedure SetfSQLSkeleton(Value: TStringList);
      procedure SetfIgnoreComponentClasses(Value: TStringList);
   public
      { Public declarations }
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
      procedure QBEMode(Enabled: Boolean);
      function  Execute: Boolean;
      function  BuiltSQL: string;
      procedure PreviewSQL;
      procedure OverrideParent(tParent:TComponent);
      function  ExecuteEx: Boolean;
      procedure QBEModeEx(Enabled:Boolean;Canvas:TCanvas;Parent:TComponent);
   published
      { Published declarations }
      property AssumeWildCard: Boolean read fAssumeWildCard
         write fAssumeWildCard;
      property ReturnOnlyWhere: Boolean read fReturnOnlyWhere
         write fReturnOnlyWhere;
      property QuoteDates: Boolean read fQuoteDates
         write fQuoteDates;
      property OracleSyntax: Boolean read fOracleSyntax
         write fOracleSyntax;
      property DataSource: TDataSource read fDataSource
         write fDataSource;
      property SQLSkeleton: TStringList read fSQLSkeleton
         write SetfSQLSkeleton;
      property SQLStringQuotationChar: Char read fSQLStringQuotationChar
         write fSQLStringQuotationChar;
      property IgnoreComponentClasses: TStringList read fIgnoreComponentClasses
         write SetfIgnoreComponentClasses;
      property TablePrefix: string read fTablePrefix
         write fTablePrefix;
      property TableSuffix: string read fTableSuffix
         write fTableSuffix;
      property ResumeLastQuery: Boolean read fResumeLastQuery
         write fResumeLastQuery;
      property SearchModeColor: TColor read fSearchModeColor
         write fSearchModeColor;
      property SearchModeFontColor: TColor read fSearchModeFontColor
         write fSearchModeFontColor;
      property IsInQBEAlready:Boolean read fInQBEAlready;
   end;

procedure Register;

implementation

uses
   DXString,
   TypInfo;

procedure Register;
begin
   RegisterComponents('BPDX Dataset', [TDXDataSetQBE]);
end;

constructor TDXDataSetQBE.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   fAssumeWildCard := True;
   fReturnOnlyWhere := false;
   fQuoteDates := False;
   fOracleSyntax := True;
   fSQLSkeleton := TStringList.Create;
   fSQLSkeleton.Add('select * from table');
   fSQLSkeleton.Add('where @QBE@');
   fIgnoreComponentClasses := TStringList.Create;
   fIgnoreComponentClasses.Sorted := True;
   fIgnoreComponentClasses.Add('TDBImage');
   fIgnoreComponentClasses.Add('TDBGrid');
   fIgnoreComponentClasses.Add('TDBNavigator');
   fIgnoreComponentClasses.Add('TDBText');
   fIgnoreComponentClasses.Add('TDataSource');
   fIgnoreComponentClasses.Add('TTabel');
   fIgnoreComponentClasses.Add('TQuery');
   fIgnoreComponentClasses.Add('TStoredProc');
   fIgnoreComponentClasses.Add('TDatabase');
   fIgnoreComponentClasses.Add('TSession');
   fIgnoreComponentClasses.Add('TBatchMove');
   fIgnoreComponentClasses.Add('TUpdateSQL');
   fIgnoreComponentClasses.Add('TNestedTable');
   fIgnoreComponentClasses.Add('TDBLookupListBox');
   fIgnoreComponentClasses.Add('TDBLookupComboBox');
   fIgnoreComponentClasses.Add('TDBCtrlGrid');
   fIgnoreComponentClasses.Add('TDBChart');
   fParent := TForm(AOwner);
   fSQLStringQuotationChar := #39;
   fQueryDataSet := TDXDataSetMemoryStream.Create(nil);
   WherePart := '';
   WhereOnly := '';
   fOldColors := TList.Create;
   fInternalDataSource := TDataSource.Create(nil);
   fInQBEAlready := False;
   fResumeLastQuery := False;
   fSearchModeColor := clAqua;
   fSearchModeFontColor := clBlack;
end;

destructor TDXDataSetQBE.Destroy;
var
   DXDataSetQBEOriginalColor: PDXDataSetQBEOriginalColor;

begin
   fSQLSkeleton.Free;
   fIgnoreComponentClasses.Free;
   fQueryDataSet.Free;
   while fOldColors.Count > 0 do begin
      DXDataSetQBEOriginalColor := fOldColors[0];
      Dispose(DXDataSetQBEOriginalColor);
      fOldColors.Delete(0);
   end;
   fOldColors.Free;
   fInternalDataSource.Free;
   inherited Destroy;
end;

procedure TDXDataSetQBE.QBEMode(Enabled: Boolean);
Begin
   QBEModeEx(Enabled,fParent.Canvas,fParent);
End;

procedure TDXDataSetQBE.QBEModeEx(Enabled:Boolean;
   Canvas:TCanvas;
   Parent:TComponent);
var
   fWantedDataSource: string;
   Loop, Loop2: Integer;
   AlreadyExists: Boolean;
   PropInfo: PPropInfo;
   TmpDataSource: TDataSource;
   //   TmpDataSource2:TDataSource;
   TmpFieldName: string;
   TmpField: TField;
   DXDataSetQBEOriginalColor: PDXDataSetQBEOriginalColor;

begin
   if fInQBEAlready = Enabled then Exit;
   fInQBEAlready := Enabled;
   if Enabled then begin
      if not fResumeLastQuery then begin
         fQueryDataSet.Close;
         fQueryDataSet.FieldDefs.Clear;
      end
      else begin
         if fQueryDataSet.RecordCount > 0 then
            fQueryDataSet.Edit
         else
            fQueryDataSet.Insert;
      end;
   end
   else begin
      //      fQueryDataSet.Close;
      //      fQueryDataSet.FieldDefs.Clear;
   end;
   fWantedDataSource := lowercase(fDataSource.Name);
   case Enabled of
      True: begin
            fInternalDataSource.DataSet := nil;
            while fOldColors.Count > 0 do begin
               DXDataSetQBEOriginalColor := fOldColors[0];
               Dispose(DXDataSetQBEOriginalColor);
               fOldColors.Delete(0);
            end;
            Canvas.Lock;
            for Loop := 0 to Parent.ComponentCount - 1 do begin
               PropInfo := GetPropInfo(Parent.Components[Loop], 'Datasource');
               if PropInfo <> nil then begin
                  if IgnoreComponentClasses.IndexOf(Parent.Components[Loop].ClassType.ClassName) = -1 then begin
                     TmpDataSource := TDataSource(GetObjectProp(Parent.Components[Loop], 'DataSource'));
                     if TmpDataSource = nil then continue;
                     if lowercase(TmpDataSource.Name) = fWantedDataSource then begin
                        if Parent.Components[Loop].ClassType.ClassName = 'TJfDbLookupComboBox' then begin
                           Propinfo := GetPropInfo(Parent.Components[Loop], 'DataFields');
                           if PropInfo = nil then
                              Continue
                           else
                              TmpFieldName := GetStrProp(Parent.Components[Loop], 'DataFields');
                        end
                        else begin
                           PropInfo := GetPropInfo(Parent.Components[Loop], 'DataField');
                           if PropInfo = nil then
                              Continue
                           else
                              TmpFieldName := GetStrProp(Parent.Components[Loop], 'DataField');
                        end;
                        if TmpFieldName <> '' then begin
                           TmpField := TmpDataSource.DataSet.FindField(TmpFieldName);
                           if TmpField = nil then continue;
                           if (not TmpField.Calculated) and (not TmpField.IsBlob) then begin
                              Loop2 := 0;
                              AlreadyExists := False;
                              if fResumeLastQuery then AlreadyExists := True;
                              while (Loop2 < fQueryDataSet.FieldDefs.Count) and (not AlreadyExists) do begin
                                 AlreadyExists := fQueryDataSet.FieldDefs.Items[Loop2].Name = TmpField.FieldName;
                                 Inc(Loop2);
                              end;
                              if not AlreadyExists then begin
                                 case TmpField.DataType of
                                    ftString: fQueryDataSet.FieldDefs.Add(TmpField.FieldName, TmpField.DataType, TmpField.DataSize);
                                 else
                                    fQueryDataSet.FieldDefs.Add(TmpField.FieldName, TmpField.DataType, 0);
                                 end;
                              end;
                              New(DXDataSetQBEOriginalColor);
                              DXDataSetQBEOriginalColor.Name := Parent.Components[Loop].Name;
                              DXDataSetQBEOriginalColor.Color := TDBEdit(Parent.Components[Loop]).Color;
                              DXDataSetQBEOriginalColor.FontColor := TDBEdit(Parent.Components[Loop]).Font.Color;
                              fOldColors.Add(DXDataSetQBEOriginalColor);
                              TDBEdit(Parent.Components[Loop]).Color := fSearchModeColor;
                              TDBEdit(Parent.Components[Loop]).Font.Color := fSearchModeFontColor;
                              PropInfo := GetPropInfo(Parent.Components[Loop], 'Datasource');
                              SetObjectProp(Parent.Components[Loop], PropInfo, fInternalDataSource);
                           end;
                        end;
                     end;
                  end
                  else begin // if it has a datasource, and is the one we want, but we are blocking it
                     // then flag is as enabled:=false;
                     TmpDataSource := TDataSource(GetObjectProp(Parent.Components[Loop], 'DataSource'));
                     if TmpDataSource = nil then continue;
                     New(DXDataSetQBEOriginalColor);
                     DXDataSetQBEOriginalColor.Name := Parent.Components[Loop].Name;
                     DXDataSetQBEOriginalColor.WasEnabled := TDBEdit(Parent.Components[Loop]).Enabled;
                     DXDataSetQBEOriginalColor.WasVisible := TDBEdit(Parent.Components[Loop]).Visible;