Chip: Shareware for Win 95/Chip-Shareware-Win95.bin/ostatni/delphi/delphi2/datetime.exe/32BIT/STDCOMPS.PAS

Pascal/Delphi Source File | 1996-10-14 | 24.6 KB | 893 lines

unit StdComps;

interface

uses
  SysUtils, WinTypes, WinProcs, Classes, Graphics, Controls, Messages, Spin,
  Dialogs, Forms, Buttons, ExtCtrls, StdCtrls, DsgnIntf, DB, DBTables;

type
  {TComponentButton}
  TComponentButton = class (TWinControl)
  private
    FButton: TTimerSpeedButton;
    FFocusControl: TWinControl;
    FOnClick: TNotifyEvent;
    FOnMouseDown: TMouseEvent;
    FAllowTimer: Boolean;
    {The name of the button in the resource}
    FTimeBtnState: TTimeBtnState;
    function GetGlyph: TBitmap;
    procedure SetGlyph(Value: TBitmap);
    function GetNumGlyphs: Integer;
    procedure SetNumGlyphs(Value: Integer);
    procedure SetAllowTimer(Value: Boolean);
    procedure BtnClick(Sender: TObject);
    procedure BtnMouseDown(Sender: TObject; Button: TMouseButton;
                      Shift: TShiftState; X, Y: Integer);
    procedure AdjustSize (var W: Integer; var H: Integer);
    procedure WMSize(var Message: TWMSize);  message WM_SIZE;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    function GetTimeBtnState: TTimeBtnState;
    procedure SetTimeBtnState(Value: TTimeBtnState);
    function GetCaption: string;
    procedure SetCaption(Value: string);
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent; HintStr: String);
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    property TimeBtnState: TTimeBtnState read GetTimeBtnState
                                         write SetTimeBtnState;
  published
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property NumGlyphs: Integer read GetNumGlyphs write SetNumGlyphs;
    property FocusControl: TWinControl read FFocusControl write FFocusControl;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
    property AllowTimer: Boolean read FAllowTimer write SetAllowTimer;
    property BtnCaption: String read GetCaption write SetCaption;
  end;

  {TJoins}
  TJoins = class(TPersistent)
  private
    FLeftList: TStringList;
    FRightList: TStringList;
    FLeftSelectedJoins: TStringList;
    FRightSelectedJoins: TStringList;
    FCanSelect: Boolean;
    FDuplicateNames: Boolean;
    FLeftText, FRightText: String;
    {The test above each list box on the form}
  public
    constructor create;
    destructor destroy;
    procedure clear;
    procedure Assign(J: TJoins);
  published
    property LeftList: TStringList read FLeftList write FLeftList;
    property RightList: TStringList read FRightList write FRightList;
    property LeftSelectedJoins: TStringList read FLeftSelectedJoins
                                            write FLeftSelectedJoins;
    property RightSelectedJoins: TStringList read FRightSelectedJoins
                                             write FRightSelectedJoins;
    property CanSelect: Boolean read FCanSelect write FCanSelect;
    property DuplicateNames: Boolean read FDuplicateNames write FDuplicateNames;
    property LeftText: string read FLeftText write FLeftText;
    property RightText: string read FRightText write FRightText;
  end;

  {TFormSelJoins}
  TFormSelJoins = class(TForm)
    BtnOK: TBitBtn;
    BtnCancel: TBitBtn;
    Bevel1: TBevel;
    LabelLeft: TLabel;
    LabelRight: TLabel;
    LBJoined: TListBox;
    LabelJoined: TLabel;
    BtnAdd: TBitBtn;
    BtnClear: TBitBtn;
    BtnDelete: TBitBtn;
    LBLeft: TListBox;
    LBRight: TListBox;
    procedure BtnAddClick(Sender: TObject);
    procedure BtnDeleteClick(Sender: TObject);
    procedure BtnClearClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    LeftStrings: TStringList;
    {The strings in the left list Box}
    RightStrings: TStringList;
    {The strings in the right list Box}
    LeftJoins:  TStringList;
    {The strings on the left side of the joins}
    RightJoins:  TStringList;
    {The strings on the right side of the joins}
    DuplicateNames: Boolean;
    {Indicates if joins can include the same name on both sides.}
    function CheckRecursive(LeftSelected, RightSelected: Integer): Boolean;
    {Returns false if the proposed join is recursive}
    procedure AddJoin(LeftSelected, RightSelected: Integer);
    {Adds a Join}
    Procedure DeleteJoin(Join: Integer);
    {Deletes a Join}
    function FindIndex(Fld: String; LB: TListBox): Integer;
    {Returns the index of Fld in LB}
    procedure AddJoins;
  public
    procedure SetStrings(J: TJoins);
    procedure GetJoins(J: TJoins);
    procedure Clear;
    {Clears strings and joins}
    procedure SetCaptions(LeftCaption, RightCaption: String);
  end;

  {TJoinsProperty}
  TJoinsProperty = class(TClassProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

 {TAbout}
  TAbout = Class(TComponent)
  private
    DummyData: Integer;
  end;

  {TAbout Property}
  TAboutProperty = class(TClassProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

  {TAboutBox}
  TAboutBox = class(TForm)
    Panel1: TPanel;
    OKButton: TBitBtn;
    Comments: TLabel;
    Label1: TLabel;
    NBComponent: TNotebook;
    ProgramIcon: TImage;
    Shape1: TShape;
    ProductName: TLabel;
    Version: TLabel;
    Copyright: TLabel;
    Shape2: TShape;
    Image1: TImage;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Shape3: TShape;
    Image2: TImage;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Shape4: TShape;
    Image3: TImage;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Shape5: TShape;
    Image4: TImage;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
  private
  public
  end;

  {SQl functions}
  TSQLClause = (sqlFields, sqlTables, sqlWhere, sqlOrder);

  procedure GetStrPos(S: TStringList; Str: String; var StrLine, StrPos: Integer);
  {Returns the line and position of the word Str in S
   returns zero if not found}

  procedure GetFields(DS: TDataSet; var Fields: TStringList);
  {returns the fields in a stringlist}

  procedure GetSQLClause(DS: TDataset; ClauseType: TSQLClause;
              var Clause: TStringList);
  {returns the from part of an SQl statement if the dataset is a query,
   or the table name if the dataset is a table.
   Queries must be in the form:
   Select <Fields> from <tables> where <where clause> order by <fields>
   <Where Clause> and <Fields> are optional}

  function getDelimeted(SL:TStringList):String;
  {Returns the items in the string list as a string}

  procedure Register;

implementation
{$R about.dfm}

procedure Register;
begin
  RegisterPropertyEditor(TypeInfo(TAbout), nil, '', TAboutProperty);
  RegisterPropertyEditor(TypeInfo(TJoins), nil, '', TJoinsProperty);
end;

{********************}
{* TComponentButton *}
{********************}
constructor TComponentButton.Create(AOwner: TComponent; HintStr: String);
var
  BmpName: ARRAY[0..50] of Char;
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption] +
    [csFramed, csOpaque];

  FButton := TTimerSpeedButton.Create (Self);
  with FButton do
  begin
    OnClick := BtnClick;
    OnMouseDown := BtnMouseDown;
    Visible := True;
    Enabled := True;
    TimeBtnState := [tbAllowTimer];
    Parent := Self;
    If Length(HintStr) > 0
    then begin
      ShowHint := True;
      Hint := HintStr;
    end;
  end;

  Glyph := nil;
  Width := 20;
  Height := 25;
end;

procedure TComponentButton.AdjustSize (var W: Integer; var H: Integer);
var
  Y: Integer;
begin
  if (FButton = nil) or (csLoading in ComponentState) then Exit;
{  if W < 15 then W := 15;}
  FButton.SetBounds (0, 0, W, H);
end;

procedure TComponentButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  W, H: Integer;
begin
  W := AWidth;
  H := AHeight;
  AdjustSize (W, H);
  inherited SetBounds (ALeft, ATop, W, H);
end;

procedure TComponentButton.WMSize(var Message: TWMSize);
var
  W, H: Integer;
begin
  inherited;
  { check for minimum size }
  W := Width;
  H := Height;
  AdjustSize (W, H);
  if (W <> Width) or (H <> Height) then
    inherited SetBounds(Left, Top, W, H);
  Message.Result := 0;
end;

procedure TComponentButton.WMSetFocus(var Message: TWMSetFocus);
begin
  FButton.TimeBtnState := FButton.TimeBtnState + [tbFocusRect];
  FButton.Invalidate;
end;

procedure TComponentButton.WMKillFocus(var Message: TWMKillFocus);
begin
  FButton.TimeBtnState := FButton.TimeBtnState - [tbFocusRect];
  FButton.Invalidate;
end;

procedure TComponentButton.BtnClick(Sender: TObject);
begin
  if Assigned(FOnClick) then FOnClick(Self);
end;

procedure TComponentButton.BtnMouseDown(Sender: TObject; Button: TMouseButton;
                      Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X, Y);
end;

procedure TComponentButton.Loaded;
var
  W, H: Integer;
begin
  inherited Loaded;
  W := Width;
  H := Height;
  AdjustSize (W, H);
  if (W <> Width) or (H <> Height) then
    inherited SetBounds (Left, Top, W, H);
end;

function TComponentButton.GetGlyph: TBitmap;
begin
  Result := FButton.Glyph;
end;

procedure TComponentButton.SetGlyph(Value: TBitmap);
begin
  FButton.Glyph := Value;
end;

function TComponentButton.GetNumGlyphs: Integer;
begin
  Result := FButton.NumGlyphs;
end;

procedure TComponentButton.SetNumGlyphs(Value: Integer);
begin
  FButton.NumGlyphs := Value;
end;

procedure TComponentButton.SetAllowTimer(Value: Boolean);
begin
  FAllowTimer := Value;
  If FAllowTimer
  then FButton.TimeBtnState := FButton.TimeBtnState + [tbAllowTimer]
  else FButton.TimeBtnState := FButton.TimeBtnState - [tbAllowTimer];
end;

function TComponentButton.GetTimeBtnState: TTimeBtnState;
begin
  Result := FButton.TimeBtnState;
end;

procedure TComponentButton.SetTimeBtnState(Value: TTimeBtnState);
begin
  FButton.TimeBtnState := Value;
end;

procedure TComponentButton.SetCaption(Value: string);
begin
  FButton.Caption := Value;
end;

function TComponentButton.GetCaption: string;
begin
  Result := FButton.Caption;
end;

{*******************}
{*      About      *}
{*******************}

{TAboutProperty Implementation}
procedure TAboutProperty.Edit;
var
  Comp: TComponent;
  DummyAbout: TAbout;
begin
  Comp := GetComponent(0);
  with TAboutBox.Create(Application) do
  try
    NBComponent.ActivePage := Comp.ClassName;
    ShowModal;
  finally
    Free;
  end;
end;

function TAboutProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly];
end;

{********************}
{* Joins Components *}
{********************}

{TJoins Implementation}
constructor TJoins.create;
begin
  FLeftList := TStringList.Create;
  FRightList := TStringList.Create;
  FLeftSelectedJoins := TStringList.Create;
  FRightSelectedJoins := TStringList.Create;
end;

destructor TJoins.destroy;
begin
  FLeftList.Free;
  FRightList.Free;
  FLeftSelectedJoins.Free;
  FRightSelectedJoins.Free;
end;

procedure TJoins.clear;
begin
  FLeftList.Clear;
  FRightList.Clear;
  FLeftSelectedJoins.Clear;
  FRightSelectedJoins.Clear;
end;

procedure TJoins.Assign(J: TJoins);
begin
  FLeftList.Assign(J.LeftList);
  FRightList.Assign(J.RightList);
  FLeftSelectedJoins.Assign(J.LeftSelectedJoins);
  FRightSelectedJoins.Assign(J.RightSelectedJoins);
end;

{TFormSelJoins Implementation}
procedure TFormSelJoins.FormCreate(Sender: TObject);
begin
  LeftStrings := TStringList.Create;
  RightStrings := TStringList.Create;
  LeftJoins := TStringList.Create;
  RightJoins := TStringList.Create;
end;

procedure TFormSelJoins.FormDestroy(Sender: TObject);
begin
  LeftStrings.Free;
  RightStrings.Free;
  LeftJoins.Free;
  RightJoins.Free;
end;

procedure TFormSelJoins.AddJoin(LeftSelected, RightSelected: Integer);
var
  LeftField, RightField: String;
begin
  LeftField := LBLeft.Items.Strings[LeftSelected];
  RightField := LBRight.Items.Strings[RightSelected];
  LBJoined.Items.Add(LeftField+' -> '+RightField);
  {Delete from source list boxes}
  LBLeft.Items.Delete(LeftSelected);
  LBRight.Items.Delete(RightSelected);
  if DuplicateNames
  then begin
    LBRight.Items.Delete(LeftSelected);
    LBLeft.Items.Delete(RightSelected);
  end;
end;

function TFormSelJoins.CheckRecursive(LeftSelected, RightSelected: Integer): Boolean;
{Returns true if not recursive}
var
  LeftField, RightField: String;
  FieldIndex: Integer;
  LeftRecursive, RightRecursive: Boolean;
begin
  LeftField := LBLeft.Items.Strings[LeftSelected];
  RightField := LBRight.Items.Strings[RightSelected];
  {Check Left Recursion}
  LeftRecursive := False;
  For FieldIndex := 0 to RightJoins.Count -1 do
    If LeftField = RightJoins.Strings[FieldIndex]
        then LeftRecursive := True;
  {Check Parent Recursion}
  RightRecursive := False;
  For FieldIndex := 0 to LeftJoins.Count -1 do
    If RightField = LeftJoins.Strings[FieldIndex]
        then RightRecursive := True;

  Result := NOT (LeftRecursive OR RightRecursive);
end;

Procedure TFormSelJoins.BtnAddClick(Sender: TObject);
var
  SelIndex, LeftSelected, RightSelected: Integer;
begin
  LeftSelected := -1;
  RightSelected := -1;
  For SelIndex := 0 to LBLeft.Items.Count - 1 do
    If LBLeft.Selected[SelIndex] then LeftSelected := SelIndex;
  For SelIndex := 0 to LBRight.Items.Count - 1 do
    If LBRight.Selected[SelIndex] then RightSelected := SelIndex;
  If (LeftSelected > -1) and (RightSelected > -1)
  then begin
    if (LBLeft.Items.Strings[LeftSelected] =
       LBRight.Items.Strings[RightSelected])
       and not DuplicateNames
    then begin
      MessageDlg('Cannot Join a field onto itself', mtWarning, [mbOK], 0);
      exit;
    end;
    {if recursive or duplicate names allowed}
    if CheckRecursive(LeftSelected, RightSelected) or DuplicateNames
    then begin
      {Add to Join lists}
      LeftJoins.Add(LBLeft.Items.Strings[LeftSelected]);
      RightJoins.Add(LBRight.Items.Strings[RightSelected]);
      AddJoin(LeftSelected, RightSelected)
    end
    else MessageDlg('Recursive relationships not allowed', mtWarning, [mbOK], 0);
  end
  else MessageDlg('Select a field from either side first', mtWarning, [mbOK], 0);
end;

Procedure TFormSelJoins.DeleteJoin(Join: Integer);
begin
  LBLeft.Items.Add(LeftJoins[Join]);
  LBRight.Items.Add(RightJoins[Join]);
  LeftJoins.Delete(Join);
  RightJoins.Delete(Join);
  LBJoined.Items.Delete(Join);
end;

procedure TFormSelJoins.BtnDeleteClick(Sender: TObject);
var
  JoinSelected, SelIndex: Integer;
begin
  {Find ID of Join}
  JoinSelected := -1;
  For SelIndex := 0 to LBJoined.Items.Count - 1 do
    If LBJoined.Selected[SelIndex] then JoinSelected := SelIndex;

  {If a join was selected}
  If JoinSelected > -1
  then DeleteJoin(JoinSelected)
  else MessageDlg('Select Join to delete', mtWarning, [mbOK], 0);
end;

procedure TFormSelJoins.BtnClearClick(Sender: TObject);
var
  JoinCounter: Integer;
begin
  If MessageDlg('Delete all Joins ?', mtConfirmation, [mbYes, mbNO], 0) = mrYes then
    For JoinCounter := 0 to LBJoined.Items.Count - 1 do
      DeleteJoin(0);
end;

function TFormSelJoins.FindIndex(Fld: String; LB: TListBox): Integer;
var
  LBCounter: Integer;
begin
  Result := -1;
  For LBCounter := 0 to LB.Items.Count-1 do
    If Fld = LB.Items.Strings[LBCounter]
    then Result := LBCounter;
end;

procedure TFormSelJoins.AddJoins;
var
  JoinCounter, MinJoins, LeftIndex, RightIndex: Integer;
begin
  {Add Links}
  If LeftJoins.Count > RightJoins.Count
  then MinJoins := RightJoins.Count
  else MinJoins := LeftJoins.Count;
  For JoinCounter := 0 to MinJoins-1 do
  begin
     {Get indexes of keys in list boxes}
     LeftIndex := FindIndex(LeftJoins.Strings[JoinCounter], LBLeft);
     RightIndex := FindIndex(RightJoins.Strings[JoinCounter], LBRight);
     {if found, then join}
     If (LeftIndex > -1) and (RightIndex > -1)
     then AddJoin(LeftIndex, RightIndex)
     else MessageDlg('You have changed fields, reselect StdParentChildJoins',
                     mtError, [mbOK], 0);
  end;
end;

procedure TFormSelJoins.SetStrings(J: TJoins);
var
  AList: TStringList;
begin
  LeftStrings.Assign(J.LeftList);
  RightStrings.Assign(J.RightList);
  LBLeft.Items.Assign(LeftStrings);
  LBRight.Items.Assign(RightStrings);
  LeftJoins.Assign(J.LeftSelectedJoins);
  RightJoins.Assign(J.RightSelectedJoins);
  AddJoins;
  DuplicateNames := J.DuplicateNames;
end;

procedure TFormSelJoins.GetJoins(J: TJoins);
begin
  J.LeftSelectedJoins.Assign(LeftJoins);
  J.RightSelectedJoins.Assign(RightJoins);
end;

procedure TFormSelJoins.Clear;
begin
  LeftStrings.Clear;
  RightStrings.Clear;
  LeftJoins.Clear;
  RightJoins.Clear;
end;

procedure TFormSelJoins.SetCaptions(LeftCaption, RightCaption: String);
begin
  LabelLeft.Caption := LeftCaption;
  LabelRight.Caption := RightCaption;
end;

{TJoinsProperty}
procedure TJoinsProperty.Edit;
var
  FormSelJoins: TFormSelJoins;
  AJoins: TJoins;
begin
  AJoins := TJoins(GetOrdValue);

  if AJoins.CanSelect
  then begin
    FormSelJoins := TFormSelJoins.Create(Application);
    with FormSelJoins do
    begin
      SetStrings(AJoins);
      SetCaptions(AJoins.LeftText, AJoins.RightText);
      ShowModal;
      if ModalResult = mrOK
      then GetJoins(AJoins);
      Free;
    end;
    SetOrdValue(LongInt(AJoins));
  end;
end;

function TJoinsProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly];
end;


{*****************}
{* SQL functions *}
{*****************}

{Error capture routines}
function StrListInit(SL: TStringList): Boolean;
{Returns true is dataset is initialised}
begin
  If SL = nil
  then begin
    MessageDlg('StringList not initialised', mtError, [mbOK], 0);
    Result := False;
  end
  else Result := True;
end;

function DSInit(DS: TDataSet): Boolean;
{Returns true is dataset is initialised}
begin
  If DS = nil
  then begin
    MessageDlg('DataSet not initialised', mtError, [mbOK], 0);
    Result := False
  end
  else Result := True;
end;

function DSTableOrQuery(DS: TDataSet): Boolean;
{Retuns true if dataset is a table or query }
begin
  If (DS is TTable) or (DS is TQuery)
  then Result := True
  else begin
    MessageDlg('DataSet must be a table or query', mtError, [mbOK], 0);
    Result := False;
  end;
end;

{general procedures}
procedure GetQStrPos(Q: TQuery; Str: String; var StrLine, StrPos: Integer);
{Returns the line and position of the word Str in the sql of a query
 returns zero if not found}
var
  L, P: Integer;
begin
  Str := Uppercase(Str);
  StrLine := 0;
  StrPos := 0;
  L := 0;
  While (L < Q.SQL.Count) and (StrLine = 0) do
  begin
    P := Pos(Str, Uppercase(Q.SQL[L]));
    If P > 0
    then begin
      StrLine := L;
      StrPos := P;
    end;
    L := L + 1;
  end;
end;

procedure GetBtwLines(Q: TQuery; FromLine, FromPos,
                  ToLine, ToPos: Integer; var Lines: TStringList);
{Returns lines between from line and pos to to line and pos}
var
  LineIndex: Integer;
  S: string;
begin
  if not StrListInit(Lines) then exit;

  If ToLine = FromLine
  then S := Copy(Q.SQL[FromLine], FromPos-1, ToPos-FromPos)
  else S := Copy(Q.SQL[FromLine], FromPos-1,
                 length(Q.SQL[FromLine])-FromPos+2);
  If Length(S) > 0 then Lines.Add(S);

  For LineIndex := FromLine+1 to ToLine-1 do
    if Length(Q.SQL[LineIndex]) > 0 then Lines.Add(Q.SQL[LineIndex]);

  if ToLine > FromLine
  then begin
    S := Copy(Q.SQL[ToLine], 0, ToPos-1);
    If Length(S) > 0 then Lines.Add(S);
  end;
end;

function ReplaceStr(var S: String; r: string; b: string): String;
{Returns orderStr with all occurences of r replaced by b}
var
  Finished: Boolean;
  P: Integer;
begin
  Finished := False;
  Result := S;
  While not finished do
  begin
    P := Pos(r, Result);
    if P = 0
    then Finished := True
    else Result := Copy(Result, 0, P-1) + b +
                   Copy(Result, P+Length(r), Length(S));
  end;
end;

{Public Methods}

procedure GetStrPos(S: TStringList; Str: String; var StrLine, StrPos: Integer);
{Returns the line and position of the word Str in S
 returns zero if not found}
var
  L, P: Integer;
begin
  Str := Uppercase(Str);
  StrLine := 0;
  StrPos := 0;
  L := 0;
  While (L < S.Count) and (StrLine = 0) do
  begin
    P := Pos(Str, Uppercase(S[L]));
    If P > 0
    then begin
      StrLine := L;
      StrPos := P;
    end;
    L := L + 1;
  end;
end;

procedure GetFields(DS: TDataSet; var Fields: TStringList);
{returns the fields in a stringlist}
var
  FieldIndex: Integer;
begin
  if not StrListInit(Fields) then exit;
  if not DSInit(DS) then exit;
  If DS.FieldCount = 0 then exit;
  For FieldIndex := 0 to DS.FieldCount-2 do
    Fields.add(DS.Fields[FieldIndex].FieldName+',');
  Fields.add(DS.Fields[DS.FieldCount-1].FieldName);
end;

procedure GetSQLClause(DS: TDataset; ClauseType: TSQLClause;
                  var Clause: TStringList);
{returns the ClauseType part of an SQl statement if the dataset is a query,
 or the table name if the dataset is a table

 Queries must be in the form:
 Select <Fields> from <tables> where <where clause> order by <fields>
 }
var
  SelectLine, SelectPos, WhereLine, WherePos,
  OrderLine, OrderPos, EndLine, EndPos: Integer;
  OrderStr, TableNameStr: String;
  DotPos: Integer;
Begin
  if not StrListInit(Clause) then exit;
  if not DSInit(DS) then exit;
  if not DSTableOrQuery(DS) then exit;
  Clause.Clear;

  If (DS is TTable)
  then
    case ClauseType of
     sqlFields: GetFields(DS, Clause);
     sqlTables:
       begin
         TableNameStr := (DS as TTable).TableName;
         {if non-sql table then return table name}
         DotPos := Pos('.', TableNameStr);
         if DotPos > 0
         then TableNameStr := Copy(TableNameStr, 1, DotPos-1);
         Clause.Add(TableNameStr);
       end;
     sqlOrder:
       begin
         OrderStr := (DS as TTable).IndexFieldNames;
         If Length(OrderStr) > 0
         then Clause.Add(ReplaceStr(OrderStr, ';', ','));
       end;
    end
  else
    {TQuery}
    Case ClauseType of
     sqlFields: GetFields(DS, Clause);
     sqlTables:
     begin
       GetQStrPos((DS as TQuery), 'FROM', SelectLine, SelectPos);
       GetQStrPos((DS as TQuery), 'WHERE', WhereLine, WherePos);
       If WherePos = 0
       then begin
         GetQStrPos((DS as TQuery), 'ORDER BY', OrderLine, OrderPos);
         if OrderPos = 0
         then begin
           EndLine := (DS as TQuery).SQL.Count-1;
           EndPos := length((DS as TQuery).SQL[(DS as TQuery).SQL.Count-1])+2;
           GetBtwLines((DS as TQuery), SelectLine, SelectPos+6,
                           EndLine, EndPos, Clause);
         end
         else GetBtwLines((DS as TQuery), SelectLine, SelectPos+6,
                           OrderLine, OrderPos, Clause);
       end;
       GetBtwLines((DS as TQuery), SelectLine, SelectPos+6,
                           WhereLine, WherePos, Clause);
     end;
     sqlWhere:
     begin
       GetQStrPos((DS as TQuery), 'WHERE', WhereLine, WherePos);
       GetQStrPos((DS as TQuery), 'ORDER BY', OrderLine, OrderPos);
       If WherePos = 0 then exit
       else begin
         if OrderPos = 0
         then begin
           EndLine := (DS as TQuery).SQL.Count-1;
           EndPos := length((DS as TQuery).SQL[(DS as TQuery).SQL.Count-1])+2;
           GetBtwLines((DS as TQuery), WhereLine, WherePos+7,
                           EndLine, EndPos, Clause);
         end
         else GetBtwLines((DS as TQuery), WhereLine, WherePos+7,
                           OrderLine, OrderPos, Clause);
       end;
     end;
     sqlOrder:
     begin
       GetQStrPos((DS as TQuery), 'ORDER BY', OrderLine, OrderPos);
       If OrderPos > 0
       then begin
         EndLine := (DS as TQuery).SQL.Count-1;
         EndPos := length((DS as TQuery).SQL[(DS as TQuery).SQL.Count-1])+2;
         GetBtwLines((DS as TQuery), OrderLine, OrderPos+10,
                           EndLine, EndPos, Clause);
       end;
     end;
  end;
end;

function getDelimeted(SL:TStringList):String;
{Returns the items in the string list as a string}
var
  I: Integer;
begin
  Result := '';
  For I := 0 to SL.Count-1 do
  begin
    Result := Result + SL[I];
    If I < SL.count-1 then Result := Result+', ';
  end;
end;

end.