childwin2.pas

jvcl driver development envionment

{******************************************************************

                       JEDI-VCL Demo

 Copyright (C) 2002 Project JEDI

 Original author:

 Contributor(s):

 You may retrieve the latest version of this file at the JEDI-JVCL
 home page, located at http://jvcl.sourceforge.net

 The contents of this file are used with permission, subject to
 the Mozilla Public License Version 1.1 (the "License"); you may
 not use this file except in compliance with the License. You may
 obtain a copy of the License at
 http://www.mozilla.org/MPL/MPL-1_1Final.html

 Software distributed under the License is distributed on an
 "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 implied. See the License for the specific language governing
 rights and limitations under the License.

******************************************************************}

{*******************************************************}
{                                                       }
{     Delphi VCL Extensions (RX) demo program           }
{                                                       }
{     Copyright (c) 1996 AO ROSNO                       }
{     Copyright (c) 1997, 1998 Master-Bank              }
{                                                       }
{*******************************************************}

{$I jvcl.inc}

{$IFNDEF COMPILER3_UP}
  { use Visual Query Builder in Delphi 2.x & C++Builder 1.x only }
  {$DEFINE USE_VQB}
{$ENDIF}

{.$DEFINE USE_QR2}  { use QuickReport 2.x }
{$IFDEF COMPILER3_UP}
  {$IFNDEF BCB}
    {$DEFINE USE_QR2}
  {$ENDIF}
{$ENDIF}

{$IFDEF COMPILER4_UP}
  {$UNDEF USE_QR2}
{$ENDIF}

unit ChildWin2;

interface

uses WinTypes, WinProcs, Messages, Classes, Graphics, Forms, Controls, DB,
  Tabs, ExtCtrls, JvSplit, DBTables, Grids, DBGrids, 
  StdCtrls, Buttons, Menus, Dialogs,
  ComCtrls, JvComponent, JvFormPlacement, JvBDEQuery,
  {$IFDEF USE_QR2}
  QuickRpt, QRPrntr, QRExtra, QRPrev, Printers, QRCtrls,
  {$ENDIF USE_QR2}
  JvBDEProgress, JvPicClip, JvBDELists, JvAnimatedImage, JvSpeedButton,
  JvBDEIndex, JvDBControls, JvDBGrid, JvExControls, JvExStdCtrls,
  JvExExtCtrls, JvExDBGrids;

type
  TTransOperation = (teStart, teCommit, teRollback);
  TTransSession = (tsTables, tsQuery);

  TMDIChild = class(TForm)
    TableList: TJvDatabaseItems ;
    DataSource1: TDataSource;
    TablesGrid: TJvDBGrid;
    rxSplitter1: TJvxSplitter ;
    Panel1: TPanel;
    Notebook1: TNotebook;
    FieldList1: TJvTableItems ;
    DataSource2: TDataSource;
    Table1: TTable;
    rxDBGrid2: TJvDBGrid ;
    Panel2: TPanel;
    SQLMemo: TMemo;
    Panel3: TPanel;
    RunSQL: TJvSpeedButton ;
    Panel4: TPanel;
    Label1: TLabel;
    Panel5: TPanel;
    rxDBGrid3: TJvDBGrid ;
    Query1: TJvQuery ;
    TableListTABNAME: TStringField;
    TableListEXTENSION: TStringField;
    TableListTYPE: TStringField;
    FieldList1TYPE: TWordField;
    FieldList1SUBTYPE: TWordField;
    FieldList1UNITS1: TWordField;
    FieldList1UNITS2: TWordField;
    FieldList1LENGTH: TWordField;
    FieldList1TypeName: TStringField;
    FieldList1SubTypeName: TStringField;
    TableListPict: TBooleanField;
    FieldList1NAME: TStringField;
    FormStorage: TJvFormStorage ;
    rxSplitter2: TJvxSplitter ;
    Panel6: TPanel;
    Panel7: TPanel;
    DBIndexCombo1: TJvDBIndexCombo ;
    Label2: TLabel;
    PopupTablesMenu: TPopupMenu;
    FilterItem: TMenuItem;
    N1: TMenuItem;
    CloseItem: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    AbortQueryMenu: TPopupMenu;
    CancelItem: TMenuItem;
    TableListVIEW: TBooleanField;
    PriorSQL: TJvSpeedButton ;
    NextSQL: TJvSpeedButton ;
    PopupSQLMenu: TPopupMenu;
    Undo1: TMenuItem;
    N2: TMenuItem;
    Cut1: TMenuItem;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    N3: TMenuItem;
    SelectAll1: TMenuItem;
    N4: TMenuItem;
    Saveas1: TMenuItem;
    Load1: TMenuItem;
    PriorSQLItem: TMenuItem;
    NextSQLItem: TMenuItem;
    Runquery1: TMenuItem;
    RefIntList: TJvTableItems ;
    RefIntListNAME: TStringField;
    RefIntListOTHERTABLE: TStringField;
    FieldList1Required: TBooleanField;
    CloseTableItem: TMenuItem;
    DBQueryProgress: TJvDBProgress ;
    RefIntListTYPE: TIntegerField;
    TableListNAME: TStringField;
    QuerySession: TSession;
    QueryDB: TDatabase;
    IndexList1: TJvTableItems ;
    IndexList1NAME: TStringField;
    IndexList1TAGNAME: TStringField;
    IndexList1UNIQUE: TBooleanField;
    TableListSYNONYM: TBooleanField;
    DbImages: TJvPicClip ;
    TableListDELETED: TBooleanField;
    Panel9: TPanel;
    TabSet1: TTabSet;
    QueryAnimation: TJvAnimatedImage ;
    Querybuilder1: TMenuItem;
    N5: TMenuItem;
    ShowDeletedItem: TMenuItem;
    OpenTableItem: TMenuItem;
    RefIntListFIELDCOUNT: TWordField;
    IndexList1FORMAT: TStringField;
    IndexList1PRIMARY: TBooleanField;
    FieldList1FIELDNUM: TWordField;
    QueryParamItem: TMenuItem;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure DataSource1DataChange(Sender: TObject; Field: TField);
    procedure TabSet1Change(Sender: TObject; NewTab: Integer;
      var AllowChange: Boolean);
    procedure TableListCalcFields(DataSet: TDataset);
    procedure RunSQLClick(Sender: TObject);
    procedure FieldListCalcFields(DataSet: TDataset);
    procedure TablesGridDrawDataCell(Sender: TObject; const Rect: TRect;
      Field: TField; State: TGridDrawState);
    procedure OpenTableClick(Sender: TObject);
    procedure TablesGridKeyPress(Sender: TObject; var Key: Char);
    procedure GridDblClick(Sender: TObject);
    procedure AfterPost(DataSet: TDataset);
    procedure CloseItemClick(Sender: TObject);
    procedure FilterItemClick(Sender: TObject);
    procedure PopupSQLMenuClick(Sender: TObject);
    procedure PopupSQLMenuPopup(Sender: TObject);
    procedure SQLMemoChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CancelQueryClick(Sender: TObject);
    procedure AfterOpen(DataSet: TDataset);
    procedure NavigateSQLClick(Sender: TObject);
    procedure FormStorageRestorePlacement(Sender: TObject);
    procedure FormStorageSavePlacement(Sender: TObject);
    procedure DataSource2StateChange(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure CloseTableItemClick(Sender: TObject);
    procedure QueryAborting(DataSet: TDataSet; var AbortQuery: Boolean);
    procedure DBQueryProgressTrace(Sender: TObject; Flag: TTraceFlag;
      const Msg: string);
    procedure GridCheckButton(Sender: TObject; ACol: Longint;
      Field: TField; var Enabled: Boolean);
    procedure GridTitleBtnClick(Sender: TObject; ACol: Longint;
      Field: TField);
    procedure GridGetBtnParams(Sender: TObject; Field: TField;
      AFont: TFont; var Background: TColor; var SortMarker: TSortMarker;
      IsDown: Boolean);
    procedure ShowDeletedItemClick(Sender: TObject);
    procedure PopupTablesMenuPopup(Sender: TObject);
    procedure TabAfterClose(DataSet: TDataSet);
    procedure GridGetCellParams(Sender: TObject; Field: TField;
      AFont: TFont; var Background: TColor; Highlight: Boolean);
    procedure TableChange(Sender: TObject; Field: TField);
    procedure FormActivate(Sender: TObject);
    procedure TabBeforeDelete(DataSet: TDataSet);
    procedure RefIntListTYPEGetText(Sender: TField; var Text: string;
      DisplayText: Boolean);
    procedure DBQryProgress(Sender: TObject; var Abort: Boolean);
    procedure BeforeClose(DataSet: TDataSet);
  private
    { Private declarations }
    FSQLHistoryIndex: Integer;
    FSQLHistory: TStrings;
    FQueryRunning: Boolean;
    FQueryStartTime: Longint;
    FAbortQuery: Boolean;
    FDeletedList: TStrings;
    FShowDeleted: Boolean;
    FCurDeleted: Boolean;
    FTryOpenTable: Boolean; { for TUTIL32.DLL }
{$IFDEF USE_QR2}
    procedure PreviewReport(Sender: TObject);
{$ENDIF}
    function GetDatabaseName: string;
    function GetActiveDataSource: TDataSource;
    procedure SetDatabaseName(const Value: string);
    procedure CloseCurrent;
    procedure InternalOpenCurrent(const TabName: string);
    procedure UpdateFieldFormats(DataSet: TDataSet);
    procedure UpdateSQLHistory;
    procedure EnableSQLHistoryItems;
    procedure ExecSQL;
    procedure StartWatch;
    procedure StopWatch;
    procedure QueryThreadDone(Sender: TObject);
    procedure RunQueryBuilder;
  public
    { Public declarations }
    procedure CloseDatabase;
    procedure SetTrace(Value: Boolean);
    function CheckStandard: Boolean;
    procedure UpdateSystemTables;
    procedure UpdateDataFieldFormats;
    procedure UpdateThreadOptions;
    procedure SetToCurrentTable;
    procedure PackCurrentTable;
    procedure CheckAndRepairParadoxTable(AllTables: Boolean);
    procedure ExportCurrentTable;
    procedure PrintCurrentTable;
    procedure ImportToCurrentTable;
    procedure ReindexTable;
    function CurrentTable: TTable;
    procedure MarkAsDeleted(const TabName: string);
    function SessionDB(ASession: TTransSession): TDatabase;
    function TransOperEnabled(ASession: TTransSession;
      Operation: TTransOperation): Boolean;
    procedure StartTransaction(ASession: TTransSession);
    procedure Commit(ASession: TTransSession);
    procedure Rollback(ASession: TTransSession);
    procedure RefreshData;
    property DatabaseName: string read GetDatabaseName write SetDatabaseName;
    property DataSource: TDataSource read GetActiveDataSource;
  end;

implementation

{$B-}
{$R *.DFM}

uses SysUtils, Clipbrd, DBConsts, TUtil, JvJVCLUtils, JvJCLUtils, Options,
  {$IFDEF USE_VQB} Qbe, {$ENDIF} Bde, SqlMon, EditStr,
  EditPict, ViewBlob, JvDBUtils, JvBdeUtils, JvDBQueryParamsForm, Main, FiltDlg, DestTab, SrcTab,
  BdeInfo;

const
  SQuerySuccess = 'Query successfully executed.';
  STimeElapsed = 'Time elapsed:';
  SNoRows = 'No rows selected.';
  SDatabase = 'Database: %s';
  SCommited = 'Changes successfully commited to a database.';
  SSqlDatabase = 'Cannot perform this operation on a SQL database';
  SCheckComplete = 'Verification complete.';
  STabCreated = 'Table %s successfully created.';
  SQueryRunning = 'You cannot close database while query is running.';
  SUndeleteConfirm = 'Undelete current record?';
  SCommitConfirm = 'You have uncommited changes in %s session. Commit changes to a database?';
  SMainSession = 'main';
  SQuerySession = 'query';
  SQueryHint = '%s: query running...|';
  SQueryAborting = '%s: query aborting...|';
{$IFDEF USE_VQB}
  SVqbNotLoaded = 'Could not load Visual Query Builder. Make sure that all required libraries are available';
{$ENDIF}
{$IFDEF USE_QR2}
  SPreview = 'Preview report';
  SClosePreview = 'You must close preview window before closing database.';
{$ENDIF}

{$WARNINGS OFF}

{ TQueryThread }

type
  TQueryThread = class(TThread)
  private
    FQuery: TJvQuery ;
    FExcept: Exception;
    procedure DoExcept;
  protected
    procedure Execute; override;
  public
    constructor Create(Query: TJvQuery );
  end;

constructor TQueryThread.Create(Query: TJvQuery );
begin
  inherited Create(False);
  FQuery := Query;
  FreeOnTerminate := True;
end;

procedure TQueryThread.DoExcept;
begin
  if not (FExcept is EAbort) then
    if Assigned(Application.OnException) then
      Application.OnException(FQuery, FExcept)
    else Application.ShowException(FExcept);
end;

procedure TQueryThread.Execute;
begin
  try
    FQuery.OpenOrExec(True);
  except
    on E: Exception do begin
      FExcept := E;
      Synchronize(DoExcept);
    end;
  end;
end;

{$IFDEF USE_QR2}

type
  TQRDataSetBuilder = class(TQRBuilder)
  private
    FDataSet : TDataSet;
  protected
    procedure SetActive(Value: Boolean); override;
    procedure BuildList;
  public
    property DataSet: TDataSet read FDataSet write FDataSet;
  end;

procedure TQRDataSetBuilder.SetActive(Value: Boolean);
begin
  if Value <> Active then begin
    if Value and Assigned(FDataSet) then begin
      inherited SetActive(True);
      BuildList;
    end
    else inherited SetActive(False);
  end;
end;

procedure TQRDataSetBuilder.BuildList;
var
  I: Integer;
  AField: TField;
  AData: TQRDBText;
  ALabel: TQRLabel;
  AHeight: Integer;
  HadDetail: Boolean;
  HadColHead: Boolean;

  procedure AddField(AField: TField);
  begin
    ALabel := TQRLabel(Report.Bands.ColumnHeaderBand.AddPrintable(TQRLabel));
    AHeight := ALabel.Height;
    ALabel.AutoSize := True;
    ALabel.Font.Style := [fsBold];
    ALabel.Caption := MakeStr('X', AField.DisplayWidth);
    ALabel.AutoSize := False;
    ALabel.Caption := AField.DisplayLabel;
    ALabel.Frame.DrawBottom := True;
    AData := TQRDBText(Report.Bands.DetailBand.AddPrintable(TQRDBText));
    AData.AutoSize := False;
    AData.DataSet := DataSet;
    AData.DataField := AField.FieldName;
    AData.Left := ALabel.Left;
    AData.Width := ALabel.Width;
    AData.Alignment := AField.Alignment;
    if (AData.Left + AData.Width > Report.Bands.DetailBand.Width) and
      (Orientation = poPortrait) then Orientation := poLandscape;
    if AData.Left + AData.Width > Report.Bands.DetailBand.Width then begin
      ALabel.Free;
      AData.Free;
    end;
  end;

begin
  HadDetail := Report.Bands.HasDetail;
  HadColHead := Report.Bands.HasColumnHeader;
  if not HadColHead then Report.Bands.HasColumnHeader := True;
  if not HadDetail then Report.Bands.HasDetail := True;
  AHeight := Round(Report.Bands.DetailBand.Height / 1.5);
  Report.DataSet := Self.DataSet;
  if DataSet <> nil then begin
    for I := 0 to DataSet.FieldCount - 1 do begin
      AField := DataSet.Fields[I];
      if AField.Visible and not (AField.DataType in
        [ftUnknown, ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic,
        ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary]) then
        AddField(AField);
    end;
  end;
  if not HadDetail then
    Report.Bands.DetailBand.Height := Round(AHeight * 1.5);
  if not HadColHead then
    Report.Bands.ColumnHeaderBand.Height := Round(AHeight * 1.5);
  RenameObjects;
end;

{$ENDIF USE_QR2}

{ TMDIChild }

function TMDIChild.GetDatabaseName: string;
begin
  Result := TableList.DatabaseName;
end;

procedure TMDIChild.SetDatabaseName(const Value: string);
begin
  if Self.DatabaseName <> Value then begin
    TableList.Close;
    try
      TableList.DatabaseName := Value;
      TableList.SystemItems := SystemTables;
      Table1.DatabaseName := Value;
      Query1.DatabaseName := Value;
      FieldList1.DatabaseName := Value;
      IndexList1.DatabaseName := Value;
      RefIntList.DatabaseName := Value;
      TableList.Open;
      if Value <> '' then Caption := Format(SDatabase, [Value]);
    except
      Close;
      raise;
    end;
  end;
end;

procedure TMDIChild.RefreshData;
begin
  TableList.Close;
  try
    TableList.Open;
  except
    Close;
    raise;
  end;
end;

function TMDIChild.GetActiveDataSource: TDataSource;
begin
  Result := DataSource2;
end;

procedure TMDIChild.UpdateDataFieldFormats;
begin
  UpdateFieldFormats(Table1);
  UpdateFieldFormats(Query1);
  rxDBGrid2.Refresh;
  rxDBGrid3.Refresh;
end;

procedure TMDIChild.UpdateThreadOptions;
begin
  if QueryInThreads then begin
    if Query1.SessionName <> QuerySession.SessionName then begin
      Query1.Close;
      Query1.SessionName := QuerySession.SessionName;
      Query1.DatabaseName := QueryDB.DatabaseName;
    end;
  end
  else begin
    if Query1.SessionName = QuerySession.SessionName then begin
      Query1.Close;
      Query1.SessionName := ''; { default session }
      Query1.DatabaseName := Table1.DatabaseName;
    end;
  end;
end;

procedure TMDIChild.UpdateFieldFormats(DataSet: TDataSet);
var
  I: Integer;
begin
  for I := 0 to DataSet.FieldCount - 1 do begin
    case DataSet.Fields[I].DataType of
      ftFloat, ftCurrency, ftBCD:
        begin
          TNumericField(DataSet.Fields[I]).DisplayFormat := defFloatFormat;
          TNumericField(DataSet.Fields[I]).EditFormat := '#.##';
        end;
      ftDate: TDateTimeField(DataSet.Fields[I]).DisplayFormat := defDateFormat;
      ftTime: TDateTimeField(DataSet.Fields[I]).DisplayFormat := defTimeFormat;
      ftDateTime: TDateTimeField(DataSet.Fields[I]).DisplayFormat := defDateTimeFormat;
    end;
  end;
end;

procedure TMDIChild.UpdateSystemTables;
begin
  TableList.SystemItems := SystemTables;
end;