main.pas

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

{*******************************************************}
{                                                       }
{     Delphi VCL Extensions (RX) demo program           }
{                                                       }
{     Copyright (c) 1996 AO ROSNO                       }
{                                                       }
{*******************************************************}

unit Main;

interface

uses WinTypes, WinProcs, SysUtils, Classes, Graphics, Forms, Controls, Menus,
  StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, Gauges, DbPrgrss, Placemnt,
  DB, DBTables, DBCtrls, SpeedBar, RXDBCtrl, DBSecur, AppEvent, MRUList,
  RXCtrls, RXSplit;

type
  TDBExplorerMainForm = class(TForm)
    SQLFontContainer: TLabel;
    FormPlacement: TFormStorage;
    Panel1: TPanel;
    StatusLine: TPanel;
    Panel2: TPanel;
    DBGauge: TGauge;
    Panel4: 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;
    Panel3: TPanel;
    DBNavigator: TDBNavigator;
    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;
    DBProgress1: TDBProgress;
    N4: TMenuItem;
    BdePropsItem: TMenuItem;
    AppEvents: TAppEvents;
    Flatspeedbarbuttons1: TMenuItem;
    ClosedDatabases: TMRUManager;
    ReopenMenu: TMenuItem;
    HelpList: TMRUManager;
    UserHelpItem: TMenuItem;
    ToolSplitter: TRxSplitter;
    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 CheckPXAllClick(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 BdePropsItemClick(Sender: TObject);
    procedure AppActivate(Sender: TObject);
    procedure SpeedBarApplyAlign(Sender: TObject; Align: TAlign;
      var Apply: Boolean);
    procedure Flatspeedbarbuttons1Click(Sender: TObject);
    procedure ClosedDatabasesClick(Sender: TObject; const RecentName,
      Caption: String; UserData: Longint);
    procedure ShowHint(Sender: TObject);
    procedure UserHelpItemClick(Sender: TObject);
    procedure HelpListClick(Sender: TObject; const RecentName,
      Caption: String; UserData: Longint);
    procedure DBRecordNoDblClick(Sender: TObject);
  private
    { Private declarations }
    procedure CreateMDIChild(const AName: string);
    procedure DatabaseLogin(Database: TDatabase; LoginParams: TStrings);
  protected
    procedure CreateWnd; override;
  public
    { Public declarations }
    procedure ApplyOptions;
    procedure UpdateMenus;
  end;

var
  DBExplorerMainForm: TDBExplorerMainForm;

implementation

{$R *.DFM}

uses {$IFDEF WIN32} DBInpReq, {$ENDIF} VCLUtils, ChildWin, OpenDlg, AppUtils,
  IniFiles, RxShell, LoginDlg, DbUtils, BdeUtils, About, Options, OptDlg,
  BdeProp, UserHelp;

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?';

{ TMainForm }

procedure TDBExplorerMainForm.CreateWnd;
begin
  inherited CreateWnd;
{$IFDEF WIN32}
  ShowMDIClientEdge(ClientHandle, True);
{$ENDIF}
end;

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

procedure TDBExplorerMainForm.FormCreate(Sender: TObject);
begin
  Screen.OnActiveFormChange := UpdateMenuItems;
  Caption := Application.Title + ' ' + SDbxVersion;
{$IFDEF VER100}
  {DBNavigator.Flat := True;}
{$ENDIF}
end;

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

procedure TDBExplorerMainForm.CreateMDIChild(const AName: string);
{$IFDEF WIN32}
const
  SQuerySession = '_Query_';
var
  SName: string;
  I: Integer;
{$ENDIF}
var
  TempDatabase, QueryDatabase: TDatabase;
  ChildForm: TMDIChild;
begin
{$IFDEF WIN32}
  Session.Open;
  Sessions.CurrentSession := Session;
{$ENDIF}
  TempDatabase := Session.FindDatabase(AName);
  if TempDatabase = nil then begin
    TempDatabase := TDatabase.Create(Session);
    TempDatabase.DatabaseName := AName;
    TempDatabase.OnLogin := DatabaseLogin;
    TempDatabase.Temporary := True;
    TempDatabase.KeepConnection := Session.KeepConnections;
{$IFDEF WIN32}
    TempDatabase.SessionName := Session.SessionName;
{$ENDIF}
  end;
{$IFDEF WIN32}
  TempDatabase.Session.OpenDatabase(TempDatabase.DatabaseName);
{$ELSE}
  Session.OpenDatabase(TempDatabase.DatabaseName);
{$ENDIF}
  ChildForm := TMDIChild.Create(Application);
  with ChildForm do begin
    SQLMemo.Font := SQLFontContainer.Font;
    DatabaseName := AName;
{$IFDEF WIN32}
    I := 0;
    repeat
      SName := SQuerySession + IntToStr(I);
      Inc(I);
    until Sessions.FindSession(SName) = nil;
    with TSession.Create(ChildForm) do begin
      SessionName := SName;
      Active := True;
    end;
    QueryDatabase := TDatabase.Create(ChildForm);
    with QueryDatabase do
    try
      SessionName := SName;
      DatabaseName := AName;
      Params.Assign(TempDatabase.Params);
      LoginPrompt := False;
      Connected := True;
    except
      Free;
      raise;
    end;
    QueryDB := QueryDatabase;
    Query1.SessionName := SName;
    Query1.DatabaseName := QueryDB.DatabaseName;
{$ENDIF}
  end;
{$IFDEF WIN32}
  Sessions.CurrentSession := Session;
{$ENDIF}
  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 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;