main.pas

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

procedure TDBExplorerMainForm.WindowMinimizeItemClick(Sender: TObject);
var
  I: Integer;
begin
  { Must be done backwards through the MDIChildren array }
  for I := MDIChildCount - 1 downto 0 do
    MDIChildren[I].WindowState := wsMinimized;
end;

procedure TDBExplorerMainForm.UpdateMenuItems(Sender: TObject);
var
  TabEnable: Boolean;
begin
  TabEnable := (MDIChildCount > 0) and (ActiveMDIChild <> nil)
    and (ActiveMDIChild is TMDIChild);
  ImportDataItem.Enabled := TabEnable;
  ImportBtn.Enabled := TabEnable;
  ExportTableItem.Enabled := TabEnable;
  ExportBtn.Enabled := TabEnable;
  PrintDataItem.Enabled := TabEnable;
  PrintBtn.Enabled := TabEnable;
  ReindexItem.Enabled := TabEnable;
  PackTableItem.Enabled := TabEnable;
  PackBtn.Enabled := TabEnable;
  DeleteTableItem.Enabled := TabEnable;
  DeleteBtn.Enabled := TabEnable;
  EmptyTableItem.Enabled := TabEnable;
  EmptyBtn.Enabled := TabEnable;
  RenameTableItem.Enabled := TabEnable;
  RenameBtn.Enabled := TabEnable;
  DBNavigator.Enabled := TabEnable;
  if TabEnable then begin
    DBNavigator.DataSource := (ActiveMDIChild as TMDIChild).DataSource;
    DBStatusLabel.DataSource := (ActiveMDIChild as TMDIChild).DataSource;
    DBRecordNo.DataSource := (ActiveMDIChild as TMDIChild).DataSource;
  end
  else begin
    DBNavigator.DataSource := nil;
    DBStatusLabel.DataSource := nil;
    DBRecordNo.DataSource := nil;
  end;
  { Check and repair commands }
  CheckPXItem.Enabled := TabEnable;
  RepairBtn.Enabled := TabEnable;
  CheckPXAllItem.Enabled := TabEnable;
  CheckPXSubMenu.Enabled := TabEnable;
  { Database commands }
  FileCloseItem.Enabled := TabEnable;
  CloseButton.Enabled := TabEnable;
  { Tables transactions }
  StartTransItem.Enabled := TabEnable and
    (ActiveMDIChild as TMDIChild).TransOperEnabled(tsTables, teStart);
  CommitItem.Enabled := TabEnable and
    (ActiveMDIChild as TMDIChild).TransOperEnabled(tsTables, teCommit);
  RollbackItem.Enabled := TabEnable and
    (ActiveMDIChild as TMDIChild).TransOperEnabled(tsTables, teRollback);
  TablesSessionMenu.Enabled := True;
  { Query transactions }
  StartTransQueryItem.Enabled := TabEnable and
    (ActiveMDIChild as TMDIChild).TransOperEnabled(tsQuery, teStart);
  CommitQueryItem.Enabled := TabEnable and
    (ActiveMDIChild as TMDIChild).TransOperEnabled(tsQuery, teCommit);
  RollbackQueryItem.Enabled := TabEnable and
    (ActiveMDIChild as TMDIChild).TransOperEnabled(tsQuery, teRollback);
  QuerySessionMenu.Enabled := TabEnable and
    (ActiveMDIChild as TMDIChild).QuerySession.Active;
  QryPasswordItem.Enabled := QuerySessionMenu.Enabled;
  { Window commands }
  WindowCascadeItem.Enabled := MDIChildCount > 0;
  WindowTileItem.Enabled := MDIChildCount > 0;
  WindowTileVerticalItem.Enabled := MDIChildCount > 0;
  WindowArrangeItem.Enabled := MDIChildCount > 0;
  WindowMinimizeItem.Enabled := MDIChildCount > 0;
end;

procedure TDBExplorerMainForm.UpdateMenus;
begin
  UpdateMenuItems(nil);
end;

procedure TDBExplorerMainForm.FormDestroy(Sender: TObject);
begin
  Screen.OnActiveFormChange := nil;
end;

procedure TDBExplorerMainForm.HelpAboutItemClick(Sender: TObject);
begin
  ShowAbout;
end;

procedure TDBExplorerMainForm.FormPlacementSavePlacement(Sender: TObject);
begin
  SaveOptions(FormPlacement.IniFile);
end;

procedure TDBExplorerMainForm.FormPlacementRestorePlacement(Sender: TObject);
begin
  LoadOptions(FormPlacement.IniFile);
  ApplyOptions;
end;

procedure TDBExplorerMainForm.CustomizeToolbarItemClick(Sender: TObject);
begin
  Speedbar.Customize(0);
end;

procedure TDBExplorerMainForm.AutoActivateItemClick(Sender: TObject);
begin
  AutoActivate := not AutoActivate;
  ApplyOptions;
end;

procedure TDBExplorerMainForm.SystemTablesItemClick(Sender: TObject);
begin
  SystemTables := not SystemTables;
  ApplyOptions;
end;

function TDBExplorerMainForm.DBStatusLabelGetDataName(
  Sender: TObject): string;
begin
  Result := '';
end;

procedure TDBExplorerMainForm.DBRecordNoGetRecordCount(Sender: TObject;
  DataSet: TDataSet; var Value: Longint);
begin
  if SQLCalcCount or ((DataSet is TDBDataSet) and not 
    TDBDataSet(DataSet).Database.IsSQLBased) then
    Value := DataSetRecordCount(TBDEDataSet(DataSet));
end;

procedure TDBExplorerMainForm.DBRecordNoDblClick(Sender: TObject);
begin
  SQLCalcCount := not SQLCalcCount;
  DBRecordNo.CalcRecCount := SQLCalcCount;
end;

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

procedure TDBExplorerMainForm.DeleteTableClick(Sender: TObject);
var
  Tab: TTable;
begin
  if (ActiveMDIChild <> nil) and (ActiveMDIChild is TMDIChild) then
  begin
    Tab := (ActiveMDIChild as TMDIChild).CurrentTable;
    if Tab <> nil then begin
      if MessageDlg(Format(SDeleteWarning, [Tab.TableName]), mtWarning,
        [mbYes, mbNo], 0) = mrYes then
      begin
        Tab.DisableControls;
        try
          if Tab.Active then Tab.Close;
          Tab.DeleteTable;
          (ActiveMDIChild as TMDIChild).MarkAsDeleted(Tab.TableName);
        finally
          Tab.EnableControls;
        end;
      end;
    end;
  end;
end;

procedure TDBExplorerMainForm.EmptyTableClick(Sender: TObject);
var
  Tab: TTable;
begin
  if (ActiveMDIChild <> nil) and (ActiveMDIChild is TMDIChild) then
  begin
    Tab := (ActiveMDIChild as TMDIChild).CurrentTable;
    if Tab <> nil then begin
      if MessageDlg(Format(SEmptyWarning, [Tab.TableName]), mtWarning,
        [mbYes, mbNo], 0) = mrYes then
      begin
        Tab.DisableControls;
        StartWait;
        try
          if Tab.Active then Tab.Close;
          Tab.EmptyTable;
          Tab.Open;
        finally
          StopWait;
          Tab.EnableControls;
        end;
      end;
    end;
  end;
end;

procedure TDBExplorerMainForm.RenameTableClick(Sender: TObject);
var
  Tab: TTable;
  NewName: string;
begin
  if (ActiveMDIChild <> nil) and (ActiveMDIChild is TMDIChild) then
  begin
    if not (ActiveMDIChild as TMDIChild).CheckStandard then
      DatabaseError(SSqlDatabase);
    Tab := (ActiveMDIChild as TMDIChild).CurrentTable;
    if Tab <> nil then begin
      if RenameTableDialog(Tab.TableName,
        (ActiveMDIChild as TMDIChild).SessionDB(tsTables).Directory, NewName) then
      begin
        Tab.DisableControls;
        try
          if Tab.Active then Tab.Close;
          Tab.RenameTable(NewName);
          with (ActiveMDIChild as TMDIChild) do begin
            RefreshData;
            SetToCurrentTable;
          end;
        finally
          Tab.EnableControls;
        end;
      end;
    end;
  end;
end;

procedure TDBExplorerMainForm.CheckPXItemClick(Sender: TObject);
begin
  if (ActiveMDIChild <> nil) and (ActiveMDIChild is TMDIChild) then
    (ActiveMDIChild as TMDIChild).CheckAndRepairParadoxTable(
      Sender = CheckPXAllItem);
end;

procedure TDBExplorerMainForm.DatabaseLogin(Database: TDatabase;
  LoginParams: TStrings);
var
  DBase: TDatabase;
begin
  DBase := Session.FindDatabase(Database.DatabaseName);
  if (DBase <> nil) and DBase.Connected and
    (Database.Session <> Session) then
    LoginParams.Assign(DBase.Params)
  else OnLoginDialog(Database, LoginParams, 3, True);
  Database.Params.Values['USER NAME'] := LoginParams.Values['USER NAME'];
  Database.Params.Values['PASSWORD'] := LoginParams.Values['PASSWORD'];
end;

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

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

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

procedure TDBExplorerMainForm.OptionsClick(Sender: TObject);
begin
  ShowDialog(TOptionsDialog);
end;

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

procedure TDBExplorerMainForm.KeepConnectionsItemClick(Sender: TObject);
begin
  SetKeepConnections(not Session.KeepConnections);
  KeepConnectionsItem.Checked := Session.KeepConnections;
  KeepConnectionsSpd.Down := Session.KeepConnections;
end;

procedure TDBExplorerMainForm.StartTransItemClick(Sender: TObject);
begin
  if (ActiveMDIChild <> nil) and (ActiveMDIChild is TMDIChild) then
    (ActiveMDIChild as TMDIChild).StartTransaction(TTransSession(
    Sender = StartTransQueryItem));
end;

procedure TDBExplorerMainForm.CommitItemClick(Sender: TObject);
begin
  if (ActiveMDIChild <> nil) and (ActiveMDIChild is TMDIChild) then
    (ActiveMDIChild as TMDIChild).Commit(TTransSession(
    Sender = CommitQueryItem));
end;

procedure TDBExplorerMainForm.RollbackItemClick(Sender: TObject);
begin
  if (ActiveMDIChild <> nil) and (ActiveMDIChild is TMDIChild) then
    (ActiveMDIChild as TMDIChild).Rollback(TTransSession(
    Sender = RollbackQueryItem));
end;

procedure TDBExplorerMainForm.SQLMonitorItemClick(Sender: TObject);
begin
  FindShowForm(TTraceSQL, '');
end;

procedure TDBExplorerMainForm.SetSQLTrace(Value: Boolean);
var
  I: Integer;
begin
  if Value <> DBProgress.Trace then begin
    DBProgress.TraceFlags := SQLTraceFlags;
    DBProgress.Trace := Value;
    for I := MDIChildCount - 1 downto 0 do
      if (MDIChildren[I] is TMDIChild) then
        (MDIChildren[I] as TMDIChild).SetTrace(Value);
  end;
end;

procedure TDBExplorerMainForm.TraceSQLItemClick(Sender: TObject);
begin
  SetSQLTrace(not DBProgress.Trace);
  TraceSQLItem.Checked := DBProgress.Trace;
end;

procedure TDBExplorerMainForm.DBProgressTrace(Sender: TObject;
  Flag: TTraceFlag; const Msg: string);
begin
  BufAddLine(Msg);
end;

procedure TDBExplorerMainForm.ClearTraceItemClick(Sender: TObject);
begin
  BufClear(True);
end;

procedure TDBExplorerMainForm.PasswordItemClick(Sender: TObject);
begin
  if Sender = QryPasswordItem then
    (ActiveMDIChild as TMDIChild).QuerySession.GetPassword
  else Session.GetPassword;
end;

procedure TDBExplorerMainForm.SpeedBarApplyAlign(Sender: TObject;
  Align: TAlign; var Apply: Boolean);
begin
  Apply := Align in [alTop, alBottom];
end;

procedure TDBExplorerMainForm.SpeedBarResize(Sender: TObject);
begin
  DBNavigator.Left := Speedbar.Width - DBNavigator.Width - 8;
end;

procedure TDBExplorerMainForm.BdePropsItemClick(Sender: TObject);
begin
  ShowDialog(TBdePropertyDlg);
end;

procedure TDBExplorerMainForm.FlatButtonsItemClick(Sender: TObject);
begin
  if sbFlatBtns in Speedbar.Options then
    Speedbar.Options := Speedbar.Options - [sbFlatBtns]
  else
    Speedbar.Options := Speedbar.Options + [sbFlatBtns];
  FlatButtonsItem.Checked := sbFlatBtns in Speedbar.Options;
end;

procedure TDBExplorerMainForm.ClosedDatabasesClick(Sender: TObject;
  const RecentName, Caption: string; UserData: Longint);
begin
  Screen.OnActiveFormChange := nil;
  try
    CreateMDIChild(RecentName);
  finally
    Screen.OnActiveFormChange := UpdateMenuItems;
  end;
end;

procedure TDBExplorerMainForm.UserHelpItemClick(Sender: TObject);
begin
  CustomizeHelp(HelpList.Strings);
end;

procedure TDBExplorerMainForm.HelpListClick(Sender: TObject;
  const RecentName, Caption: string; UserData: Longint);
begin
  if GetLongHint(RecentName) <> '' then begin
    FileExecute(GetLongHint(RecentName), '', '', esNormal);
  end;
end;

procedure TDBExplorerMainForm.SpeedBarPosChanged(Sender: TObject);
begin
  if NewStyleControls then
    with SpeedBar do begin
      if Align = alTop then BoundLines := [blTop]
      else BoundLines := [];
    end;
end;

end.