main.pas

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

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

unit Main;

{$I RX.INC}

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
  StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, DbPrgrss, Placemnt,
  DB, DBTables, DBCtrls, SpeedBar, RXDBCtrl, DBSecur, RXShell, AppEvent,
  MRUList, ComCtrls, RXCtrls;

type
  TDBExplorerMainForm = class(TForm)
    DBProgress: TDBProgress;
    SQLFontContainer: TLabel;
    FormPlacement: TFormStorage;
    BottomPanel: TPanel;
    StatusLine: TPanel;
    RightPanel: TPanel;
    StatusPanel: TPanel;
    DBStatusLabel: TDBStatusLabel;
    RecNoPanel: TPanel;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    FileOpenItem: TMenuItem;
    FileCloseItem: TMenuItem;
    N1: TMenuItem;
    FileExitItem: TMenuItem;
    UtilitiesMenu: TMenuItem;
    PackTableItem: TMenuItem;
    DeleteTableItem: TMenuItem;
    EmptyTableItem: TMenuItem;
    ReindexItem: TMenuItem;
    RenameTableItem: TMenuItem;
    ExportTableItem: TMenuItem;
    CheckPXSubMenu: TMenuItem;
    CheckPXItem: TMenuItem;
    CheckPXAllItem: TMenuItem;
    Options1: TMenuItem;
    AutoActivateItem: TMenuItem;
    SystemTablesItem: TMenuItem;
    KeepConnectionsItem: TMenuItem;
    N3: TMenuItem;
    OptionsItem: TMenuItem;
    CustomizeSpeedbar: TMenuItem;
    WindowMenu: TMenuItem;
    WindowCascadeItem: TMenuItem;
    WindowTileItem: TMenuItem;
    WindowArrangeItem: TMenuItem;
    WindowMinimizeItem: TMenuItem;
    Help1: TMenuItem;
    HelpAboutItem: TMenuItem;
    SpeedBar: TSpeedBar;
    SpeedItem1: TSpeedItem;
    CloseButton: TSpeedItem;
    SpeedItem3: TSpeedItem;
    PackBtn: TSpeedItem;
    DeleteBtn: TSpeedItem;
    EmptyBtn: TSpeedItem;
    RenameBtn: TSpeedItem;
    ExportBtn: TSpeedItem;
    RepairBtn: TSpeedItem;
    SpeedItem4: TSpeedItem;
    SpeedItem2: TSpeedItem;
    KeepConnectionsSpd: TSpeedItem;
    OptionsBtn: TSpeedItem;
    SpeedItem5: TSpeedItem;
    SpeedItem6: TSpeedItem;
    DBRecordNo: TDBStatusLabel;
    WindowTileVerticalItem: TMenuItem;
    N2: TMenuItem;
    ImportDataItem: TMenuItem;
    ImportBtn: TSpeedItem;
    StartTransItem: TMenuItem;
    CommitItem: TMenuItem;
    RollbackItem: TMenuItem;
    SQLMonitorItem: TMenuItem;
    N4: TMenuItem;
    TraceSQLItem: TMenuItem;
    ClearTraceItem: TMenuItem;
    TablesSessionMenu: TMenuItem;
    QuerySessionMenu: TMenuItem;
    StartTransQueryItem: TMenuItem;
    CommitQueryItem: TMenuItem;
    RollbackQueryItem: TMenuItem;
    SQLMonitorBtn: TSpeedItem;
    TabPasswordItem: TMenuItem;
    QryPasswordItem: TMenuItem;
    DBNavigator: TDBNavigator;
    N5: TMenuItem;
    BdePropsItem: TMenuItem;
    FlatButtonsItem: TMenuItem;
    ClosedDatabases: TMRUManager;
    ReopenItem: TMenuItem;
    DBGauge: TProgressBar;
    SpeedbarSection1: TSpeedbarSection;
    SpeedbarSection2: TSpeedbarSection;
    SpeedbarSection3: TSpeedbarSection;
    SpeedbarSection4: TSpeedbarSection;
    AppEvents: TAppEvents;
    HelpList: TMRUManager;
    UserHelpItem: TMenuItem;
    PrintDataItem: TMenuItem;
    PrintBtn: TSpeedItem;
    procedure FormCreate(Sender: TObject);
    procedure WindowCascadeItemClick(Sender: TObject);
    procedure UpdateMenuItems(Sender: TObject);
    procedure WindowTileItemClick(Sender: TObject);
    procedure WindowArrangeItemClick(Sender: TObject);
    procedure FileCloseItemClick(Sender: TObject);
    procedure FileOpenItemClick(Sender: TObject);
    procedure FileExitItemClick(Sender: TObject);
    procedure WindowMinimizeItemClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure HelpAboutItemClick(Sender: TObject);
    procedure FormPlacementSavePlacement(Sender: TObject);
    procedure FormPlacementRestorePlacement(Sender: TObject);
    procedure CustomizeToolbarItemClick(Sender: TObject);
    procedure AutoActivateItemClick(Sender: TObject);
    procedure SystemTablesItemClick(Sender: TObject);
    function DBStatusLabelGetDataName(Sender: TObject): string;
    procedure PackTableClick(Sender: TObject);
    procedure DeleteTableClick(Sender: TObject);
    procedure EmptyTableClick(Sender: TObject);
    procedure RenameTableClick(Sender: TObject);
    procedure CheckPXItemClick(Sender: TObject);
    procedure ReindexItemClick(Sender: TObject);
    procedure ExportClick(Sender: TObject);
    procedure OptionsClick(Sender: TObject);
    procedure KeepConnectionsItemClick(Sender: TObject);
    procedure ImportClick(Sender: TObject);
    procedure StartTransItemClick(Sender: TObject);
    procedure CommitItemClick(Sender: TObject);
    procedure RollbackItemClick(Sender: TObject);
    procedure SQLMonitorItemClick(Sender: TObject);
    procedure TraceSQLItemClick(Sender: TObject);
    procedure DBProgressTrace(Sender: TObject; Flag: TTraceFlag;
      const Msg: string);
    procedure ClearTraceItemClick(Sender: TObject);
    procedure PasswordItemClick(Sender: TObject);
    procedure SpeedBarApplyAlign(Sender: TObject; Align: TAlign;
      var Apply: Boolean);
    procedure SpeedBarResize(Sender: TObject);
    procedure BdePropsItemClick(Sender: TObject);
    procedure FlatButtonsItemClick(Sender: TObject);
    procedure ClosedDatabasesClick(Sender: TObject; const RecentName,
      Caption: string; UserData: Longint);
    procedure AppHint(Sender: TObject);
    procedure AppIdle(Sender: TObject; var Done: Boolean);
    procedure HelpListClick(Sender: TObject; const RecentName,
      Caption: string; UserData: Longint);
    procedure UserHelpItemClick(Sender: TObject);
    procedure DBRecordNoDblClick(Sender: TObject);
    procedure SpeedBarPosChanged(Sender: TObject);
    procedure DBRecordNoGetRecordCount(Sender: TObject; DataSet: TDataSet;
      var Value: Longint);
    procedure PrintDataClick(Sender: TObject);
  private
    { Private declarations }
{$IFDEF RX_D4}
    FPrevClientProc: TFarProc;
    FClientInstance: TFarProc;
    procedure ClientWndProc(var Message: TMessage);
{$ENDIF RX_D4}
    procedure CreateMDIChild(const AName: string);
    procedure DatabaseLogin(Database: TDatabase; LoginParams: TStrings);
  protected
    procedure CreateWnd; override;
  public
    { Public declarations }
    procedure ApplyOptions;
    procedure UpdateMenus;
    procedure SetSQLTrace(Value: Boolean);
    procedure ShowEdge;
  end;

var
  DBExplorerMainForm: TDBExplorerMainForm;

implementation

{$R *.DFM}

uses DBInpReq, DBCbRest, SQLMon, Bde, VCLUtils, ChildWin, OpenDlg, 
  AppUtils, DBUtils, IniFiles, LoginDlg, RenDlg, About, Options, OptDlg,
  BdeUtils, BdeProp, UserHelp, RxHints;

const
  SEmptyWarning = 'Table %s will be emptied. All data will be lost. Continue?';
  SDeleteWarning = 'Table %s will be deleted. All data will be lost. Continue?';
  SSqlDatabase = 'Cannot perform this operation on a SQL database';

{ TMainForm }

procedure TDBExplorerMainForm.ShowEdge;
begin
  ShowMDIClientEdge(ClientHandle, True);
end;

procedure TDBExplorerMainForm.CreateWnd;
begin
  inherited CreateWnd;
  ShowEdge;
{$IFDEF RX_D4}
  if ClientHandle <> 0 then begin
    FClientInstance := MakeObjectInstance(ClientWndProc);
    FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
    SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(FClientInstance));
  end;
{$ENDIF}
end;

{$IFDEF RX_D4} {!! Do not hide MDI client edge }
procedure TDBExplorerMainForm.ClientWndProc(var Message: TMessage);
  procedure Default;
  begin
    with Message do
      Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
  end;
begin
  if (Message.Msg = $3F) and (FormStyle = fsMDIForm) then begin
    SetDesigning(True);
    FormStyle := fsNormal;
    try
      Default;
    finally
      FormStyle := fsMDIForm;
      SetDesigning(False);
    end;
  end
  else Default;
end;
{$ENDIF}

procedure TDBExplorerMainForm.ApplyOptions;
var
  I: Integer;
begin
  SpeedItem4.Down := AutoActivate;
  AutoActivateItem.Checked := AutoActivate;
  SpeedItem2.Down := SystemTables;
  SystemTablesItem.Checked := SystemTables;
  KeepConnectionsSpd.Down := Session.KeepConnections;
  KeepConnectionsItem.Checked := Session.KeepConnections;
  FlatButtonsItem.Checked := sbFlatBtns in Speedbar.Options;
  DBRecordNo.CalcRecCount := SQLCalcCount;
  DBProgress.TraceFlags := SQLTraceFlags;
  BufSetSize(SQLTraceBuffer);
  for I := MDIChildCount - 1 downto 0 do begin
    if (MDIChildren[I] is TMDIChild) then begin
      if AutoActivate then
        TMDIChild(MDIChildren[I]).SetToCurrentTable;
      TMDIChild(MDIChildren[I]).UpdateSystemTables;
      TMDIChild(MDIChildren[I]).UpdateDataFieldFormats;
      TMDIChild(MDIChildren[I]).UpdateThreadOptions;
      TMDIChild(MDIChildren[I]).SQLMemo.Font := SQLFontContainer.Font;
      TMDIChild(MDIChildren[I]).SetTrace(DBProgress.Trace);
    end;
  end;
end;

procedure TDBExplorerMainForm.FormCreate(Sender: TObject);
begin
  Screen.OnActiveFormChange := UpdateMenuItems;
  Caption := Application.Title + ' ' + SDbxVersion;
  if not NewStyleControls then begin
    with Speedbar do begin
      BevelOuter := bvRaised;
      Height := 29;
      BtnOffsetVert := 3;
      BoundLines := [];
    end;
  end;
  try
    Session.PrivateDir := GetEnvVar('TEMP');
  except
    { ignore }
  end;
  DBProgress.TraceFlags := SQLTraceFlags;
  SetHintStyle(hsRectangle, 0, False, taCenter);
end;

procedure TDBExplorerMainForm.AppHint(Sender: TObject);
begin
  StatusLine.Caption := Application.Hint;
end;

procedure TDBExplorerMainForm.AppIdle(Sender: TObject;
  var Done: Boolean);
begin
{$IFDEF VER90}
  DbiUseIdleTime;
{$ELSE}
  BdeFlushBuffers;
{$ENDIF}
end;

procedure TDBExplorerMainForm.CreateMDIChild(const AName: string);
const
  SQuerySession = '_Query_';
var
  SName: string;
  I: Integer;
  TempDatabase: TDatabase;
  ChildForm: TMDIChild;
begin
  Session.Open;
  Sessions.CurrentSession := Session;
  TempDatabase := Session.FindDatabase(AName);
  if TempDatabase = nil then begin
    TempDatabase := TDatabase.Create(nil);
    with TempDatabase do begin
      DatabaseName := AName;
      Temporary := True;
      OnLogin := DatabaseLogin;
    end;
    TempDatabase.KeepConnection := Session.KeepConnections;
    TempDatabase.SessionName := Session.SessionName;
  end;
  TempDatabase.Session.OpenDatabase(TempDatabase.DatabaseName);
  ChildForm := TMDIChild.Create(Application);
  with ChildForm do begin
    SQLMemo.Font := SQLFontContainer.Font;
    DatabaseName := AName;
    I := 0;
    repeat
      if Session.IsAlias(AName) then SName := AName + SQuerySession + IntToStr(I)
      else SName := 'S' + SQuerySession + IntToStr(I);
      Inc(I);
    until Sessions.FindSession(SName) = nil;
    with QuerySession do begin
      SessionName := SName;
      Open;
    end;
    DBQueryProgress.SessionName := SName;
    DBQueryProgress.Active := True;
    if DBProgress.Trace then SetTrace(True);
    with QueryDB do begin
      SessionName := SName;
      DatabaseName := AName;
      Params.Assign(TempDatabase.Params);
      LoginPrompt := False;
      Open;
    end;
    Query1.SessionName := SName;
    Query1.DatabaseName := QueryDB.DatabaseName;
    UpdateThreadOptions;
  end;
  Sessions.CurrentSession := Session;
  ClosedDatabases.Remove(AName);
  UpdateMenus;
end;

procedure TDBExplorerMainForm.FileOpenItemClick(Sender: TObject);
var
  DBName: string;
begin
  if GetOpenDatabase(DBName) then begin
    Screen.OnActiveFormChange := nil;
    try
      CreateMDIChild(DBName);
    finally
      Screen.OnActiveFormChange := UpdateMenuItems;
    end;
  end;
end;

procedure TDBExplorerMainForm.FileCloseItemClick(Sender: TObject);
begin
  if (ActiveMDIChild <> nil) and (ActiveMDIChild is TMDIChild) then
    ActiveMDIChild.Close;
end;

procedure TDBExplorerMainForm.FileExitItemClick(Sender: TObject);
begin
  Close;
end;

procedure TDBExplorerMainForm.WindowCascadeItemClick(Sender: TObject);
begin
  Cascade;
end;

procedure TDBExplorerMainForm.WindowTileItemClick(Sender: TObject);
begin
  if Sender = WindowTileItem then { TileHorizontal } TileMode := tbHorizontal
  else if Sender = WindowTileVerticalItem then TileMode := tbVertical;
  Tile;
end;

procedure TDBExplorerMainForm.WindowArrangeItemClick(Sender: TObject);
begin
  ArrangeIcons;
end;