childwin.pas

RxRich很有用的文字图像显示控件,这是它的Demo

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

{$I RX.INC}

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

{.$DEFINE USE_QR2}  { use QuickReport 2.x or higher }
{$IFDEF RX_D3}
  {$IFNDEF CBUILDER}
    {$DEFINE USE_QR2}
{$IFDEF RX_D4}
    {$DEFINE USE_QR3}
{$ENDIF}
  {$ENDIF}
{$ENDIF}

unit ChildWin;

interface

uses WinTypes, WinProcs, Messages, Classes, Graphics, Forms, Controls, DB,
  DBLists, Tabs, ExtCtrls, RXSplit, DBTables, Grids, DBGrids, RXDBCtrl,
  RXQuery, StdCtrls, Buttons, Placemnt, DBIndex, DBSecur, Menus, Dialogs,
  RXShell, DBPrgrss, PicClip, ComCtrls, Animate, RXCtrls
  {$IFDEF USE_QR2}, QuickRpt, QRPrntr, QRExtra, QRPrev, Printers,
  QRCtrls {$ENDIF USE_QR2};

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

  TMDIChild = class(TForm)
    TableList: TDatabaseItems;
    DataSource1: TDataSource;
    TablesGrid: TrxDBGrid;
    rxSplitter1: TrxSplitter;
    Panel1: TPanel;
    Notebook1: TNotebook;
    FieldList1: TTableItems;
    DataSource2: TDataSource;
    Table1: TTable;
    rxDBGrid2: TrxDBGrid;
    Panel2: TPanel;
    SQLMemo: TMemo;
    Panel3: TPanel;
    RunSQL: TRxSpeedButton;
    Panel4: TPanel;
    Label1: TLabel;
    Panel5: TPanel;
    rxDBGrid3: TrxDBGrid;
    Query1: TrxQuery;
    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: TFormStorage;
    rxSplitter2: TrxSplitter;
    Panel6: TPanel;
    Panel7: TPanel;
    DBIndexCombo1: TDBIndexCombo;
    Label2: TLabel;
    PopupTablesMenu: TPopupMenu;
    FilterItem: TMenuItem;
    N1: TMenuItem;
    CloseItem: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    AbortQueryMenu: TPopupMenu;
    CancelItem: TMenuItem;
    TableListVIEW: TBooleanField;
    PriorSQL: TRxSpeedButton;
    NextSQL: TRxSpeedButton;
    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: TTableItems;
    RefIntListNAME: TStringField;
    RefIntListOTHERTABLE: TStringField;
    FieldList1Required: TBooleanField;
    CloseTableItem: TMenuItem;
    DBQueryProgress: TDBProgress;
    RefIntListTYPE: TIntegerField;
    TableListNAME: TStringField;
    QuerySession: TSession;
    QueryDB: TDatabase;
    IndexList1: TTableItems;
    IndexList1NAME: TStringField;
    IndexList1TAGNAME: TStringField;
    IndexList1UNIQUE: TBooleanField;
    TableListSYNONYM: TBooleanField;
    DbImages: TPicClip;
    TableListDELETED: TBooleanField;
    Panel9: TPanel;
    TabSet1: TTabSet;
    QueryAnimation: TAnimatedImage;
    Querybuilder1: TMenuItem;
    N5: TMenuItem;
    ShowDeletedItem: TMenuItem;
    OpenTableItem: TMenuItem;
    RefIntListFIELDCOUNT: TWordField;
    IndexList1FORMAT: TStringField;
    IndexList1PRIMARY: TBooleanField;
    FieldList1FIELDNUM: TWordField;
    QueryParamItem: TMenuItem;
    DataSource3: TDataSource;
    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);
    procedure DataSource3StateChange(Sender: TObject);
    procedure Notebook1PageChanged(Sender: TObject);
  private
    { Private declarations }
    FSQLHistoryIndex: Integer;
    FSQLHistory: TStrings;
    FQueryRunning: Boolean;
    FQueryStartTime: Longint;
    FAbortQuery: Boolean;
    FDeletedList: TStrings;
    FShowDeleted: Boolean;
    FCurDeleted: Boolean;
    FTryOpenTable: Boolean; { for TUTIL32.DLL }
    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, VCLUtils, ObjStr, Options, StrUtils,
  {$IFDEF USE_VQB} Qbe, {$ENDIF} Bde, SqlMon, FileUtil, AppUtils, EditStr,
  EditPict, ViewBlob, DbUtils, BdeUtils, Main, FiltDlg, DestTab, SrcTab,
  QBndDlg, 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}
  SClosePreview = 'You must close preview window before closing database.';
{$ENDIF}

{$WARNINGS OFF}

{$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);
  TQuickRep(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 ftNonTextTypes +
        [ftUnknown]) 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
  if Notebook1.PageIndex = 0 then
    Result := DataSource2
  else { SQL }
    Result := DataSource3;
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;

procedure TMDIChild.MarkAsDeleted(const TabName: string);
begin { mark current table as deleted }
  if TabName <> '' then begin
    if FDeletedList.IndexOf(TabName) < 0 then FDeletedList.Add(TabName);
    if TableList.Active then begin
      TableList.UpdateCursorPos;
      TableList.Resync([rmExact]);
    end;
  end;
end;

function TMDIChild.CurrentTable: TTable;
var
  Val: string;
begin
  if not TableList.Active then begin
    Result := nil;
    Exit;
  end;
  Val := TableListTABNAME.AsString;
  if Table1.Active then begin
    if Table1.TableName <> Val then SetToCurrentTable;
  end
  else begin
    Table1.TableName := Val;
  end;
  Result := Table1;
end;

function TMDIChild.CheckStandard: Boolean;
begin
  Result := False;
  if TableList.Database <> nil then
    Result := not TableList.Database.IsSQLBased;
end;

function TMDIChild.SessionDB(ASession: TTransSession): TDatabase;
begin
  case ASession of
    tsTables: Result := TableList.Database;
    tsQuery: Result := QueryDB;
  end;
end;

function TMDIChild.TransOperEnabled(ASession: TTransSession;
  Operation: TTransOperation): Boolean;
var
  InTransNow: Boolean;