The Unofficial Newsletter of Delphi Users - by Robert Vivrette

Sneaking A Peek at Data-Access Components

by Jaffar Sulemani - jaffarsulemani@usa.net

Have you ever had to take a peek at what was going on in a particular table or query? The idea behind this component was to have a debug form which will give a peep hole into the data-access components which a programmer may have dropped on their forms or datamodules. This form can be shown at any time with a procedure:

procedure.DataAccessDebugBox1.DisplayDebug(FComponent : TComponent);

This procedure will accept paramater which will be either 'Self' or the 'form/Datamodule' name for which dataaccess components have to be browsed.

Let me know if any new features a programmer would like to have on the component.

See u for now...

Download Files for this project.
 

unit DebugBox;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DB, Menus, ExtCtrls, StdCtrls, Mask, DBCtrls,
  Grids, DBGrids,  ComCtrls, DBTables;

type
  TPositions = (poTopLeft,poBottomLeft,poTopRight,poBottomRight);

  TDataAccessDebugBox = class(TComponent)
  private
    FPosition : TPositions;
    FWidth    : Integer;
    FHeight   : Integer;
    DebugForm : TForm;
    FClassname : TComponent;
    procedure SetPosition(A: TPositions);
    procedure SetWidth(A: Integer);
    procedure SetHeight(A: Integer);
    function  ReadFClassName : TComponent;
    procedure WriteFClassName(FComponent : TComponent);
    property  DAComponentsOn : TComponent Read ReadFClassName write WriteFClassName default nil;
  public
    constructor Create(AOwner: TComponent); override;
    procedure DisplayDebug(FComponent : TComponent);
  published
    property Position: TPositions read FPosition write SetPosition default poTopRight;
    property Width: Integer read FWidth write SetWidth default 550;
    property Height: Integer read FHeight write SetHeight default 200;
  end;

procedure Register;

implementation

uses DisplayDebug;

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

constructor TDataAccessDebugBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPosition := poTopRight;
  FWidth := 250;
  FHeight := 200;
  if not (csDesigning in ComponentState) then
    begin
      DebugForm := TFormMDIDisplayDebug.Create(Application);
      with DebugForm do
        begin
          Visible  := False;
          FormStyle := fsStayOnTop;
          BorderStyle := bsSizeable;
          BorderIcons := [biSystemMenu];
        end;
    end;
end;

procedure TDataAccessDebugBox.SetPosition(A: TPositions);

begin
  FPosition := A;
  if not (csDesigning in ComponentState) then with DebugForm do
    case A of
      poTopLeft     : SetBounds(0,0,Width,Height);
      poBottomLeft  : SetBounds(0,Screen.Height-Height,Width,Height);
      poTopRight    : SetBounds(Screen.Width-Width,0,Width,Height);
      poBottomRight : SetBounds(Screen.Width-Width,Screen.Height-Height,Width,Height);
    end;
end;

procedure TDataAccessDebugBox.DisplayDebug(FComponent : TComponent);
begin
  if not (csDesigning in ComponentState) then
    begin
      if FComponent <> nil then
        DAComponentsOn := FComponent
      else
        DAComponentsOn := Owner;
      DebugForm.Hide;
      Width := Self.Width;
      Height := Self.Height;
      SetPosition(FPosition);
      DebugForm.Caption := ' Data Access Components on ' + TComponent(DAComponentsOn).Name;
      DebugForm.Visible := True;
      DebugForm.Show;
      TFormMDIDisplayDebug(DebugForm).ReadPara(DAComponentsOn);
    end;
end;

procedure TDataAccessDebugBox.SetWidth(A: Integer);
begin
  FWidth := A;
  if not (csDesigning in ComponentState) then
    begin
      DebugForm.Width := FWidth;
      SetPosition(FPosition);
    end;
end;

procedure TDataAccessDebugBox.SetHeight(A: Integer);
begin
  FHeight := A;
  if not (csDesigning in ComponentState) then
    begin
      DebugForm.Height := FHeight;
      SetPosition(FPosition);
    end;
end;

function TDataAccessDebugBox.ReadFClassName : TComponent;
begin
  Result := FClassName;
end;
procedure TDataAccessDebugBox.WriteFClassName(FComponent : TComponent);
begin
  FClassName := FComponent;
end;

end.

unit displaydebug;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, DBGrids, ExtCtrls,db, dbtables, Menus;

type
  TFormMDIDisplayDebug = class(TForm)
    Panel2: TPanel;
    Panel1: TPanel;
    ListBox1: TListBox;
    DS: TDataSource;
    DSC1: TDataSource;
    ScrollBox1: TScrollBox;
    Memo1: TMemo;
    DBGrid1: TDBGrid;
    MainMenu1: TMainMenu;
    MNUFile: TMenuItem;
    MNUClose: TMenuItem;
    MNURefresh: TMenuItem;
    AssignSQL1: TMenuItem;
    Filter1: TMenuItem;
    FilterList1: TMenuItem;
    TTable1: TMenuItem;
    TQuery1: TMenuItem;
    All1: TMenuItem;
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure MNURefreshClick(Sender: TObject);
    procedure MNUCloseClick(Sender: TObject);
    procedure AssignSQL1Click(Sender: TObject);
    procedure Filter1Click(Sender: TObject);
    procedure TTable1Click(Sender: TObject);
    procedure TQuery1Click(Sender: TObject);
    procedure All1Click(Sender: TObject);
  private
    function SelectObjectFromList(intItemIndex :Integer) : TDataset;
    procedure ReadParameters(AllTableQuery : Integer) ;
    { Private declarations }
  public
    fquery : tquery;
    ftable : ttable;
    DModule : TfORM;
    ObjList : TComponent;
    procedure ReadPara(FComponentName : TComponent);
    procedure MemoUpdate(DATASET : TDATASET);
  published
    { Public declarations }
  end;

var
  FormMDIDisplayDebug: TFormMDIDisplayDebug;

implementation

uses DebugBox;
{$R *.DFM}

procedure TFormMDIDisplayDebug.ReadParameters(AllTableQuery : Integer) ;
var
  i : integer;
begin
  if objList = nil then exit;
  ListBox1.Items.Clear;
  with objList do
    begin
      for i := 0 to ComponentCount - 1 do
        case AllTableQuery of
          1 : if Components[i] is TDataset then
                ListBox1.Items.Add(TDataset(components[i]).Name);
          2 : if Components[i] is TTable then
                ListBox1.Items.Add(TTable(components[i]).Name);
          3 : if Components[i] is TQuery then
                ListBox1.Items.Add(TQuery(components[i]).Name);
        end;
    end;
  if ListBox1.Items.Count = 0 then DS.Dataset := nil;
end;

procedure TFormMDIDisplayDebug.ListBox1Click(Sender: TObject);
begin
  if ((ListBox1.Items.Count <> 0) and (ListBox1.ItemIndex  = -1)) then
    ListBox1.ItemIndex := 0;
  DS.DataSet := SelectObjectFromList(ListBox1.ItemIndex);
  try MemoUpdate(DS.Dataset); except end;
end;

procedure TFormMDIDisplayDebug.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  inherited;
  if (Key=VK_ESCAPE) then
    if MessageDlg('Close Form, ?', mtInformation, [mbYes, mbNo],0) = mrYes then;
      close;
end;

procedure TFormMDIDisplayDebug.MemoUpdate(DATASET : TDATASET);
begin
  if DATASET = nil then exit;
  Memo1.Lines.Clear;
  if DATASET is Tquery then
    with TQuery(DATASET) do
      if Active then
        begin
          Memo1.Lines.Add(' DataBaseName : ' + DataBaseName);
          Memo1.Lines.Add(' ');
          Memo1.Lines.Add(Text);
          Memo1.Lines.Add('');
          Memo1.Lines.Add('Record Count : ' + IntToStr(RecordCount));
          if Filtered then Memo1.Lines.Add('Filter String : ' + Filter);
          if RequestLive then
            Memo1.Lines.Add('Request Live  : TRUE ')
          else
            Memo1.Lines.Add('Request Live  : FALSE ');
        end
      else
        Memo1.Lines.Add('In active Dataset ')
  else
    with TTable(DATASET) do
      if Active then
        begin
          Memo1.Lines.Add(' DataBaseName : ' + DataBaseName);
          Memo1.Lines.Add(' ');
          Memo1.Lines.Add('Record Count : ' + IntToStr(RecordCount));
          if Filtered then Memo1.Lines.Add('Filter String : ' + Filter);
        end
      else
        Memo1.Lines.Add(' InActive Dataset');
end;

procedure TFormMDIDisplayDebug.FormShow(Sender: TObject);
begin
  Readparameters(1);
  ListBox1Click(Sender);
end;

procedure TFormMDIDisplayDebug.ReadPara(FComponentName : TComponent);
begin
  if FComponentName = nil then exit;
  ObjList := FComponentName;
  ReadParameters(1);
end;

procedure TFormMDIDisplayDebug.MNURefreshClick(Sender: TObject);
begin
  if objList <> nil then ListBox1Click(Sender);
end;

procedure TFormMDIDisplayDebug.MNUCloseClick(Sender: TObject);
begin
  close;
end;

procedure TFormMDIDisplayDebug.AssignSQL1Click(Sender: TObject);
var
  strDatabaseName, prvDatabaseName, prvSQL,strSQL : string;
begin
  if (SelectObjectFromList(ListBox1.ItemIndex) is TQuery) then with TQuery(DS.DataSet) do
    if MessageDLG(' Do want to assign a New SQL Statement for this Query',mtInformation,[mbYes,mbNo],0) = mrYES then
      begin
        InputQuery('New SQL','Enter Databasename',strDatabaseName);
        InputQuery('New SQL','Enter New SQL Statement',strSQL);
        if (strDatabaseName <> '') and (strSQL <> '') then
          begin
            prvSQL := Text;
            prvDatabaseName := DatabaseName;
            Active := False;
            SQL.Clear;
            DatabaseName := strDatabaseName;
            SQL.Add(strSQL);
            Active := True;
          end;
      end;
end;

procedure TFormMDIDisplayDebug.Filter1Click(Sender: TObject);
var
  strprvfilterstring, nwfilterstring  : string;
  boolfiltered   : Boolean;
begin
  if DS.Dataset = nil then exit;
  with SelectObjectFromList(ListBox1.ItemIndex) do
    begin
      strprvfilterstring := Filter;
      boolfiltered := Filtered;
      InputQuery('Enter Filter String', '',nwfilterstring);
      try
        filter := nwfilterstring;
        if not boolfiltered then Filtered := true;
      except
        if boolfiltered then Filter := strprvfilterstring;
      end;
    end;
end;

function TFormMDIDisplayDebug.SelectObjectFromList(intItemIndex :Integer): TDataset;
var
  i : Integer;
begin
  Result := nil;
  if intItemIndex = -1 then exit;
  with objList do
    begin
      for i := 0 to ComponentCount -1 do
        if ListBox1.Items[intItemIndex] = Components[i].Name then
          Result := TDataset(Components[i]);
    end;
end;

procedure TFormMDIDisplayDebug.TTable1Click(Sender: TObject);
begin
  ReadParameters(2);
end;

procedure TFormMDIDisplayDebug.TQuery1Click(Sender: TObject);
begin
  ReadParameters(3);
end;

procedure TFormMDIDisplayDebug.All1Click(Sender: TObject);
begin
  ReadParameters(1);
end;

end.