main.pas

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

  Tile;
end;

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

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);
  ImportDataItem.Enabled := TabEnable;
  ImportBtn.Enabled := TabEnable;
  ExportTableItem.Enabled := TabEnable;
  ExportBtn.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 {and (ActiveMDIChild as TMDIChild).CheckStandard};
  RepairBtn.Enabled := TabEnable {and (ActiveMDIChild as TMDIChild).CheckStandard};
  CheckPXAllItem.Enabled := TabEnable;
  { Window commands }
  FileCloseItem.Enabled := MDIChildCount > 0;
  CloseButton.Enabled := MDIChildCount > 0;
  StartTransItem.Enabled := TabEnable and
    (ActiveMDIChild as TMDIChild).TransOperEnabled(teStart);
  CommitItem.Enabled := TabEnable and
    (ActiveMDIChild as TMDIChild).TransOperEnabled(teCommit);
  RollbackItem.Enabled := TabEnable and
    (ActiveMDIChild as TMDIChild).TransOperEnabled(teRollback);
  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;
{$IFNDEF WIN32}
  AppTaskbarIcons(True);
{$ENDIF}
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.DBRecordNoDblClick(Sender: TObject);
begin
  SQLCalcCount := not SQLCalcCount;
  DBRecordNo.CalcRecCount := SQLCalcCount;
end;

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

procedure TDBExplorerMainForm.DeleteTableClick(Sender: TObject);
var
  Tab: TTable;
begin
  if ActiveMDIChild <> nil 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).RefreshData;
        finally
          Tab.EnableControls;
        end;
      end;
    end;
  end;
end;

procedure TDBExplorerMainForm.EmptyTableClick(Sender: TObject);
var
  Tab: TTable;
begin
  if ActiveMDIChild <> nil 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;
        try
          if Tab.Active then Tab.Close;
          Tab.EmptyTable;
          Tab.Open;
        finally
          Tab.EnableControls;
        end;
      end;
    end;
  end;
end;

procedure TDBExplorerMainForm.RenameTableClick(Sender: TObject);
begin
  NotImplemented;
end;

procedure TDBExplorerMainForm.CheckPXAllClick(Sender: TObject);
begin
  if ActiveMDIChild <> nil then begin
    (ActiveMDIChild as TMDIChild).CheckAndRepairParadoxTable(True);
  end;
end;

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

procedure TDBExplorerMainForm.DatabaseLogin(Database: TDatabase;
  LoginParams: TStrings);
var
  DBase: TDatabase;
begin
  DBase := Session.FindDatabase(Database.DatabaseName);
  if (DBase <> nil) and DBase.Connected
{$IFDEF WIN32}
    and (Database.Session <> Session)
{$ENDIF}
  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 then
    (ActiveMDIChild as TMDIChild).ExportCurrentTable;
end;

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

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

procedure TDBExplorerMainForm.ReindexItemClick(Sender: TObject);
begin
  if ActiveMDIChild <> nil then begin
    (ActiveMDIChild as TMDIChild).ReindexTable;
  end;
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 then
    (ActiveMDIChild as TMDIChild).StartTransaction;
end;

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

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

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

procedure TDBExplorerMainForm.AppActivate(Sender: TObject);
begin
  if Screen.ActiveForm <> nil then Screen.ActiveForm.BringToFront;
end;

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

procedure TDBExplorerMainForm.Flatspeedbarbuttons1Click(Sender: TObject);
begin
  if sbFlatBtns in Speedbar.Options then
    Speedbar.Options := Speedbar.Options - [sbFlatBtns]
  else
    Speedbar.Options := Speedbar.Options + [sbFlatBtns];
  Flatspeedbarbuttons1.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;

end.