Программа для проверки несущей способности и построения паспорта прочности тюбинговых обделок вертикальных стволов метрополитенов

Программа для проверки несущей способности и построения паспорта прочности тюбинговых обделок вертикальных стволов метрополитенов. unit Calc1 interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, DBTables, DB, DBFilter, Grids, DBGrids, StdCtrls, RXLookup, ExtCtrls, Buttons type TForm1 classTForm Panel1 TPanel Panel2 TPanel rxDBLookupCombo1 TrxDBLookupCombo Edit1 TEdit Label1 TLabel Label2 TLabel Edit2 TEdit Label3 TLabel DBGrid1 TDBGrid Label4 TLabel TableSTUFF TTable DataSourceSTUFF TDataSource rxDBFilter1 TrxDBFilter DataSourceDATA TDataSource TableDATA TTable TableDATAR TFloatField TableDATAMass TFloatField TableDATARpress TFloatField TableDATARstretch TFloatField TableDATAPuasson TFloatField TableDATAR1 TFloatField TableDATARb TFloatField TableDATAA TFloatField TableDATAB TFloatField TableDATAStuff TSmallintField BitBtn1 TBitBtn RadioGroup1 TRadioGroup RadioButton1 TRadioButton RadioButton2 TRadioButton RadioButton3 TRadioButton procedure rxDBLookupCombo1ChangeSender TObject procedure DBGrid1DblClickSender TObject procedure RadioButton1ClickSender TObject procedure RadioButton2ClickSender TObject procedure RadioButton3ClickSender TObject private Private declarations public Public declarations end var Form1 TForm1 implementation uses Draw R .DFM procedure TForm1.rxDBLookupCombo1ChangeSender TObject var S String begin rxDBFilter1.Deactivate rxDBFilter1.Filter. Clear sStuff TableSTUFF.FieldByNameCode. AsString rxDBFilter1.Filter. AddS rxDBFilter1.Activate end procedure TForm1.DBGrid1DblClickSender TObject var Mass, Rpress, Rstretch, Puasson, PuassonP, R1, Rb, R, A, B Double P0, P2 Double C1, C2 Double K0, K1, K2, K3, K4 Double L, L1 Double ALFA1, ALFA2 Double BETA, BETA1, BETA2 Double DELTA1, DELTA2 Double GAMMA1, GAMMA2 Double D1, D2 Double F Double SIGMARS, SIGMARR, SIGMASS, SIGMASR Double i Integer Pkr, PkrOld Double Eo, Ep, J Double procedure Calc begin C1 R1Rb C2 RR1 F C2C2-1C1C1-1C2C2-1C1C1-1 C2C2-1C1C1-11BA D2 C2C21C2C21C2C21Puasson1 D1 C1C1-1C1C1-1Puasson1 DELTA2 C2C2C2C21 DELTA1 C2C23-C2C2 GAMMA2 C2C22C2C2C2C2C2C21 GAMMA1 C2C23C2C2 BETA 3RRbRRb3-RRbRRb BETA2 C2C2C2C2C2C21-D2FC1C11D1 BETA1 3C2C2-1-D2F3-C2C2C1C1C1C1D1 ALFA2 C2C22C2C2C2C2C2C2- D2F2C1C1C1C1C1C11D1 ALFA1 3C2C21D2FC1C13C1C1C1C1-D1 K4 ALFA2DELTA1-ALFA1DELTA2ALFA2BETA1-ALFA1B ETA2 K3 ALFA1GAMMA2-ALFA2GAMMA1ALFA2BETA1-ALFA1B ETA2 K2 BETA2DELTA1-BETA1DELTA2ALFA2BETA1-ALFA1B ETA2 K1 BETA1GAMMA2-BETA2GAMMA1ALFA2BETA1-ALFA1B ETA2 L1 4C2C2C2C21-BETA-K1BETAK2C1C11C1C11 4C2C22K3BETAK4C2C21C2C21-2 L K1BETAK2C1C11-K3BETAK4 K0 3C2C21BAC2C2-1C1C1-12C1C12C2C21 end begin with TableDATA do begin Mass FieldByNameMass. AsFloat Rpress FieldByNameRpress. AsFloat Rstretch FieldByNameRstretch.

AsFloat Puasson FieldByNamePuasson. AsFloat R1 FieldByNameR1.AsFloat Rb FieldByNameRb. AsFloat R FieldByNameR.AsFloat A FieldByNameA.AsFloat B FieldByNameB.AsFloat end if RadioButton1.Checked then begin Calc if TableDATA.FieldByNameStuff. AsInteger 0 Железо-бетон then begin PLinesisP0,1 C1C1-1MassRpress2C1C1K01BA PLinesisP2,1 C1C1-1C1C1-1 MassRpress4C1C1K01BA PLinesisP0,2 -C1C1-1MassRstretch2C1C1K01BA PLinesisP2,2 C1C1-1C1C1-1 MassRstretch4C1C1K01BA PLinesisP0,4 C2C2-1MassRpress2C2C2-K0 C2C21 PLinesisP2,4 C2C2-1C2C2-1MassRpressL1 PLinesisP0,5 -C2C2-1 MassRstretch2C2C2-K0C2C21 PLinesisP2,5 C2C2-1C2C2-1MassRstretchL1 end else begin Чугун PLinesisP0,1 C1C1-1MassRpress2C1K01BA PLinesisP2,1 C2C2-1C2C2-1 MassRpress4C1C1K01BA PLinesisP0,2 -C2C2-1MassRstretch2C1K01BA PLinesisP2,2 C1C1-1C1C1-1 MassRstretch4C1C1K01BA PLinesisP0,4 C2C2-1MassRpress2C2C2-K0 C2C21 PLinesisP2,4 C2C2-1C2C2-1MassRpressL1 PLinesisP0,5 -C2C2-1MassRstretch2C2C2-K0 C2C21 PLinesisP2,5 C2C2-1C2C2-1MassRstretchL1 end DrawForm. ShowModal end else if RadioButton2.Checked then begin Calc P0 StrToFloatEdit1.Text P2 StrToFloatEdit2.Text SIGMARS ABS2C1C1C1C1-11BAP0K02P2L C1C1-1 SIGMARR ABS2C1C1C1C1-11BAP0K0-2P2L C1C1-1 SIGMASS ABSP0C2C2-12C2C2-K0C2C21P2L1 C2C2-1C2C2-1 SIGMASR ABSP0C2C2-12C2C2-K0C2C21-P2L1 C2C2-1C2C2-1 if SIGMARS MassRpress or SIGMARR MassRstretch or SIGMASS MassRpress or SIGMASR MassRstretch then MessageDlgНесущая способность не обеспечена, mtInformation, mbOk,0 else MessageDlgНесущая способность обеспечена, mtInformation, mbOk,0 end else begin i1 PkrOld 0 repeat i i1 Pkr ii-1EoJ1-Puasson1-PuassonRRREp2 1PuassonPi1i1iii-1i-1 i-1iii13-4PuassonP if Pkr PkrOld then PkrOld Pkr else i0 until i 0 P0 StrToFloatEdit1.Text if P0 Pkr then MessageDlgУстойчивость обеспечена, mtInformation, mbOk,0 else MessageDlgУстойчивость не обеспечена, mtInformation, mbOk,0 end end procedure TForm1.RadioButton1ClickSender TObject begin Label2.Visible False Label3.Visible False Edit1.Visible False Edit2.Visible False end procedure TForm1.RadioButton2ClickSender TObject begin Label2.Visible True Label3.Visible True Edit1.Visible True Edit2.Visible True end procedure TForm1.RadioButton3ClickSender TObject begin Label2.Visible True Label3.Visible False Edit1.Visible True Edit2.Visible False end end. unit Draw interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls type TDrawForm classTForm BitBtn1 TBitBtn procedure FormActivateSender TObject private Private declarations public Public declarations end TPaintData isP0,isP2 TDiagramArray ArrayTPaintData,1 5 of Double var PLines TDiagramArray DrawForm TDrawForm implementation R .DFM procedure TDrawForm. FormActivateSender TObject var R TRect MaxX, MinX Double MaxY, MinY Double Nx, Ny Integer Kx, Ky Double i Byte PointMin, PointMax Double procedure DrawLineX0, k, bDouble begin Canvas. MoveToR.Left60RoundKxX0,R. Bottom- 30 if k 0 then Canvas. LineToR.Left60,RoundR.Bottom - 33 - Kybk10Kx else Canvas. LineToR.Right-10,RoundR.Bottom - 33 - Ky-bkR.Right-R.Left-70Kx end begin PLinesisP0,3 0 PLinesisP2,3 0 MaxX 0.0 MinX 0.0 MaxY 0.0 MinY 0.0 for i 1 to 5 do begin if PLinesisP0,i MaxX then MaxX PLinesisP0,i if PLinesisP2,i MaxY then MaxY PLinesisP2,i if PLinesisP0,i MinX then MinX PLinesisP0,i if PLinesisP2,i MinY then MinY PLinesisP2,i end if MaxX 200 then Nx 100 else Nx 10 MaxX RoundMaxXNxNxNx if MaxY 200 then Ny 100 else Ny 10 MaxY RoundMaxYNyNyNy with DrawForm do begin Canvas. Pen. Color clBlack R.Left 10 R.Top 10 R.Right Width - 15 R.Bottom Height - 70 Canvas. FrameRectR Canvas. Brush. Color clBtnFace Kx R.Right - R.Left - 80MaxX Ky R.Bottom - R.Top - 80MaxY Ось Po Canvas. MoveToR.Left10,R.Bottom-30 Canvas. LineToR.Right-10,R.Bottom-30 Ось P2 Canvas. MoveToR.Left60,R.Top30 Canvas.

LineToR.Left60,R.Bottom-30 i 0 while iNx MaxX do begin Inci Canvas. MoveToR.Left60RoundKxiNx,R.Bottom -33 Canvas. LineToR.Left60RoundKxiNx,R.Bottom -27 Canvas. TextOutR.Left50RoundKxiNx, R.Bottom-20, IntToStriNx end i 0 while iNy MaxY do begin Inci Canvas. MoveToR.Left63,R.Bottom-30-RoundK yiNy Canvas. LineToR.Left57,R.Bottom-30-RoundK yiNy Canvas. TextOutR.Left30, R.Bottom-35-RoundKyiNy, IntToStriNy end if PLinesisP0,1 PLinesisP0,4 then PointMax PLinesisP0,4 else PointMax PLinesisP0,1 if PLinesisP0,2 PLinesisP0,5 then PointMin PLinesisP0,2 else PointMin PLinesisP0,5 if PointMin 0 then PointMin 0.0 DrawLinePLinesisP0,1, -PLinesisP2,1PLinesisP0,1,PLinesisP2,1 DrawLinePLinesisP0,2, -PLinesisP2,2PLinesisP0,2,PLinesisP2,2 DrawLine0,1,0 DrawLinePLinesisP0,4, -PLinesisP2,4PLinesisP0,4,PLinesisP2,4 DrawLinePLinesisP0,5, -PLinesisP2,5PLinesisP0,5,PLinesisP2,5 Canvas. Brush. Color clGreen Canvas. FloodFillRoundPointMax-PointMin2K xR.Left60, R.Bottom-55, clBlack, fsBorder Canvas. Brush. Color clBtnFace Canvas. TextOutR.Right-80, R.Bottom-50, P0, TCM2 Canvas. TextOutR.Left20, R.Top10, P2, TCM2 end end end. unit Edittub interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, DBFilter, DB, DBTables, Grids, DBGrids, RXLookup, ExtCtrls, DBCtrls type TEditDataForm classTForm Panel1 TPanel rxDBLookupCombo1 TrxDBLookupCombo TableSTUFF TTable DataSourceSTUFF TDataSource DBGrid1 TDBGrid DataSourceDATA TDataSource TableDATA TTable TableDATAMass TFloatField TableDATARpress TFloatField TableDATARstretch TFloatField TableDATAPuasson TFloatField TableDATAR1 TFloatField TableDATARb TFloatField TableDATAR TFloatField TableDATAA TFloatField TableDATAB TFloatField rxDBFilter1 TrxDBFilter TableDATAStuff TSmallintField DBNavigator1 TDBNavigator procedure rxDBLookupCombo1ChangeSender TObject procedure DBNavigator1ClickSender TObject Button TNavigateBtn procedure DBGrid1DblClickSender TObject private Private declarations public Public declarations end var EditDataForm TEditDataForm implementation R .DFM uses EditForm procedure TEditDataForm.rxDBLookupCombo1ChangeSend er TObject var S String begin rxDBFilter1.Deactivate rxDBFilter1.Filter. Clear sStuff TableSTUFF.FieldByNameCode. AsString rxDBFilter1.Filter. AddS rxDBFilter1.Activate end procedure TEditDataForm. DBNavigator1ClickSender TObject Button TNavigateBtn begin case Button of nbInsert begin EditDataTubTableDATA, True, TableSTUFF.FieldByNameCode. AsInteger end nbEdit begin EditDataTubTableDATA, False, TableSTUFF.FieldByNameCode. AsInteger end end end procedure TEditDataForm. DBGrid1DblClickSender TObject begin EditDataTubTableDATA, False, TableSTUFF.FieldByNameCode. AsInteger end end. unit Editform interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Mask, DBCtrls, ExtCtrls, DB, DBTables, Buttons type TEdTubForm classTForm DataSource1 TDataSource Panel1 TPanel DBEdit1 TDBEdit Label1 TLabel Label2 TLabel Label3 TLabel DBEdit2 TDBEdit DBEdit3 TDBEdit Label4 TLabel Label5 TLabel Label6 TLabel DBEdit4 TDBEdit DBEdit5 TDBEdit DBEdit6 TDBEdit Label7 TLabel DBEdit7 TDBEdit Label8 TLabel Label9 TLabel Panel2 TPanel Panel3 TPanel DBEdit8 TDBEdit DBEdit9 TDBEdit BitBtn1 TBitBtn BitBtn2 TBitBtn Table1 TTable Label10 TLabel DBText1 TDBText DataSource2 TDataSource Query1 TQuery Query1Material TStringField procedure FormCreateSender TObject public FCode Integer function EditTub Table TTable IsNew Boolean Code Integer Boolean end var EdTubForm TEdTubForm function EditDataTubTable TTable IsNew Boolean Code Integer Boolean implementation R .DFM function EditDataTubTable TTable IsNew Boolean Code Integer Boolean begin Result False with TEdTubForm. CreateApplication do try FCode Code Result EditTubTable, IsNew, Code finally Free end end function TEdTubForm. EditTubTable TTable IsNew Boolean Code Integer Boolean begin if Table nil then DataSource1.DataSet Table else begin Table1.Open DataSource1.DataSet Table1 end if IsNew then begin DataSource1.DataSet. Append DataSource1.DataSet. FieldByNameStuff. AsI nteger Code end else DataSource1.DataSet. Edit Result ShowModal mrOk if Result then DataSource1.DataSet. Post else DataSource1.DataSet. Cancel end procedure TEdTubForm. FormCreateSender TObject begin Query1.Active False Query1.ParamByNameSt. AsInteger FCode Query1.Active True end end. unit EditUser interface uses SysUtils, WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons, StdCtrls, ExtCtrls, DBCtrls, Mask, DB, DBTables type TEditUserDialog classTForm OKBtn TBitBtn CancelBtn TBitBtn UsersTable TTable dsUsers TDataSource NameEdit TDBEdit FullNameEdit TDBEdit GroupBox TGroupBox PasswordEdit TDBEdit ConfirmPassword TEdit Label1 TLabel Label2 TLabel LevelGroup TDBRadioGroup procedure OKBtnClickSender TObject procedure CancelBtnClickSender TObject procedure FormHideSender TObject private Private declarations public Public declarations function EditUserconst UserName string Table TTable IsNew Boolean Boolean end var EditUserDialog TEditUserDialog function EditUserDataconst UserName string Table TTable IsNew Boolean Boolean implementation uses Global, Crypt R .DFM const SNotFound Записей не обнаружено SNoConfirmPassword Вы ввели разные пароли.

Проверьте правильность ввода function EditUserDataconst UserName string Table TTable IsNew Boolean Boolean var SUName string begin Result False SUName UserName if glUserLevel ulAdministrator then begin Table nil SUName glUserName end with TEditUserDialog. CreateApplication do try Result EditUserSUName, Table, IsNew finally Free end end TEditUserDialog function TEditUserDialog. EditUserconst UserName string Table Ttable IsNew Boolean Boolean begin NameEdit. Enabled glUserLevel ulAdministrator LevelGroup. Enabled glUserLevel ulAdministrator if Table nil then begin dsUsers. DataSet Table UsersTable. Close end else begin UsersTable. Open if UserName then begin if not UsersTable. FindKeyUserName then raise Exception. CreateSNotFound end dsUsers. DataSet UsersTable end if IsNew then dsUsers. DataSet. Append else dsUsers. DataSet. Edit ConfirmPassword. Text PasswordEdit. Text Result ShowModal mrOk end procedure TEditUserDialog. OKBtnClickSender TObject begin if PasswordEdit. Text ConfirmPassword. Text then raise Exception. CreateSNoConfirmPassword dsUsers. DataSet. Post ModalResult mrOk end procedure TEditUserDialog.

CancelBtnClickSender TObject begin dsUsers. DataSet. Cancel ModalResult mrCancel end procedure TEditUserDialog. FormHideSender TObject begin dsUsers. DataSet. Cancel UsersTable. Close end end. unit Global interface type TUserLevel ulInvalid, ulOperator, ulManager, ulAdministrator const InvalidID 0 glUserLevel TUserLevel ulInvalid glUserName string glUserID Longint InvalidID function cUserLevelCode Longint TUserLevel implementation function cUserLevelCode Longint TUserLevel begin Result ulInvalid if Code in IntegerLowTUserLevel IntegerHighTUserLevel then Result TUserLevelCode end end. unit Global interface type TUserLevel ulInvalid, ulOperator, ulManager, ulAdministrator const InvalidID 0 glUserLevel TUserLevel ulInvalid glUserName string glUserID Longint InvalidID function cUserLevelCode Longint TUserLevel implementation function cUserLevelCode Longint TUserLevel begin Result ulInvalid if Code in IntegerLowTUserLevel IntegerHighTUserLevel then Result TUserLevelCode end end. unit Main interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, SpeedBar, Menus, ExtCtrls, Placemnt, DB, DBSecur, DBTables type TStaftForm classTForm SpeedBar TSpeedBar ExitItem TSpeedItem MainMenu TMainMenu FileMenu TMenuItem InsuranceMenuItem TMenuItem FileMenuSeperator TMenuItem PrinterSetupMenuItem TMenuItem ExitMenuItem TMenuItem DictSetupMenu TMenuItem UserMenuItem TMenuItem WindowMenu TMenuItem TileMenuItem TMenuItem CascadeMenuItem TMenuItem MinimizeAllMenuItem TMenuItem ArrangeAllMenuItem TMenuItem HelpMenu TMenuItem HelpContentsMenuItem TMenuItem HelpMenuSeparator TMenuItem AboutMenuItem TMenuItem ChangePasswordItem TSpeedItem PrintSetupItem TSpeedItem CalcItem TSpeedItem PrinterSetup TPrinterSetupDialog TileWindowsItem TSpeedItem CascadeWindowsItem TSpeedItem HintPanel TPanel DBSecurity1 TDBSecurity Database1 TDatabase EditItem TMenuItem FormPlacement TFormPlacement procedure ArrangeAllMenuItemClickSender TObject procedure TileMenuItemClickSender TObject procedure CascadeMenuItemClickSender TObject procedure MinimizeAllMenuItemClickSender TObject procedure AboutMenuItemClickSender TObject procedure PrinterSetupMenuItemClickSender TObject procedure ExitMenuItemClickSender TObject procedure FormStorageRestorePlacementSender TObject procedure FormStorageSavePlacementSender TObject function DBSecurity1CheckUserUsersTable TTable const Password String Boolean procedure UserMenuItemClickSender TObject procedure FormCreateSender TObject procedure FormDestroySender TObject procedure InsuranceMenuItemClickSender TObject procedure ShowHintSender TObject procedure EditItemClickSender TObject private procedure SetUserLevel procedure UpdateMenuItemsSender TObject function ShowFormFormClass TFormClass TForm end var StaftForm TStaftForm implementation uses About, rxIni, VCLUtils, Global, AppUtils, EditUser, UserList, EditTub, Calc1 R .DFM const siMDIChilds OpenMDIChilds procedure TStaftForm. SetUserLevel begin case glUserLevel of ulOperator begin DictSetupMenu. Visible False DictSetupMenu. Enabled False UserMenuItem. Visible False UserMenuItem. Enabled False end ulManager begin DictSetupMenu. Visible True DictSetupMenu. Enabled True UserMenuItem. Visible False UserMenuItem. Enabled False end ulAdministrator begin DictSetupMenu. Visible True DictSetupMenu. Enabled True UserMenuItem. Visible True UserMenuItem. Enabled True end end end procedure TStaftForm. TileMenuItemClickSender TObject begin Tile end procedure TStaftForm. CascadeMenuItemClickSender TObject begin Cascade end procedure TStaftForm. MinimizeAllMenuItemClickSende r TObject var I Integer begin for I MDIChildCount - 1 downto 0 do MDIChildrenI.WindowState wsMinimized end procedure TStaftForm. ArrangeAllMenuItemClickSender TObject begin ArrangeIcons end procedure TStaftForm. AboutMenuItemClickSender TObject begin ShowAboutDialogРасчет тюбинговой обделки, Королев А.В МГГУ, nil, 1, 0, 1996 end procedure TStaftForm. PrinterSetupMenuItemClickSend er TObject begin PrinterSetup. Execute end procedure TStaftForm. ExitMenuItemClickSender TObject begin Close end function TStaftForm. ShowFormFormClass TFormClass TForm var Form TForm begin Result nil StartWait try Form FindFormFormClass if Form nil then Application. CreateFormFormClass, Form with Form do begin if WindowState wsMinimized then WindowState wsNormal Show end Result Form finally StopWait end end procedure TStaftForm. FormStorageRestorePlacementSe nder TObject var IniFile TrxIniFile List TStrings I Integer FormClass TFormClass Form TForm begin StartWait try SpeedBar. Visible True IniFile TrxIniFile. CreateFormPlacement.

IniFileNa me try if glUserLevel in ulManager, ulAdministrator then begin List TStringList. Create try IniFile. ReadListsiMDIChilds, List for I 0 to List. Count - 1 do begin FormClass TFormClassGetClassListI if FormClass nil then ShowFormFormClass end finally List. Free end end finally IniFile. Free end finally StopWait end end procedure TStaftForm. FormStorageSavePlacementSende r TObject var IniFile TrxIniFile List TStrings I Integer begin IniFile TrxIniFile. CreateFormPlacement. IniFileNa me try IniFile. EraseSectionsiMDIChilds List TStringList. Create try for I MDIChildCount - 1 downto 0 do List. AddMDIChildrenI. ClassName if List. Count 0 then IniFile. WriteListsiMDIChilds, List finally List. Free end finally IniFile. Free end end function TStaftForm. DBSecurity1CheckUserUsersTabl e TTable const Password String Boolean begin Result Password UsersTable. FieldByNamePassword. AsString if Result then begin glUserName UsersTable. FieldByNameUserName. AsString glUserID UsersTable. FieldByNameID.AsInteger glUserLevel cUserLevelUsersTable. FieldByNameUserLeve l. AsInteger Result glUserLevel ulInvalid end if Result then SetUserLevel end procedure TStaftForm. UserMenuItemClickSender TObject begin ShowFormTUserListForm end procedure TStaftForm. ShowHintSender TObject begin HintPanel. Caption Application. Hint end procedure TStaftForm. UpdateMenuItemsSender TObject begin Enable or disable menu items and buttons CascadeMenuItem. Enabled MDIChildCount 0 TileMenuItem. Enabled MDIChildCount 0 ArrangeAllMenuItem. Enabled MDIChildCount 0 MinimizeAllMenuItem. Enabled MDIChildCount 0 TileWindowsItem. Enabled MDIChildCount 0 CascadeWindowsItem. Enabled MDIChildCount 0 end procedure TStaftForm. FormCreateSender TObject begin Application. OnHint ShowHint Screen. OnActiveFormChange UpdateMenuItems SetAutoSubClassTrue set wait cursor to SQL WaitCursor crSQLWait register classes of MDI-child forms RegisterClassesTDictForm, TRatesForm, TItemReportForm end procedure TStaftForm. FormDestroySender TObject begin Screen. OnActiveFormChange nil Application. HelpCommandHELPQUIT,0 end procedure TStaftForm. InsuranceMenuItemClickSender TObject begin Form1.ShowModal end procedure TStaftForm. EditItemClickSender TObject begin EditDataForm. Show end end. unit UserList interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, DBCtrls, ExtCtrls, DBTables, DB, Grids, DBGrids, RXDBCtrl, Placemnt, StdCtrls, Buttons type TUserListForm classTForm UsersTable TTable dsUsers TDataSource UsersGrid TrxDBGrid UsersTablePassword TStringField Panel1 TPanel DBNavigator TDBNavigator FormPlacement TFormPlacement UsersTableID TFloatField UsersTableUserName TStringField UsersTableFullName TStringField UsersTableUserLevel TFloatField BitBtn1 TBitBtn procedure DBNavigatorClickSender TObject Button TNavigateBtn procedure UsersGridDblClickSender TObject procedure FormPlacementSavePlacementSender TObject procedure FormPlacementRestorePlacementSender TObject procedure FormCreateSender TObject procedure FormCloseSender TObject var Action TCloseAction end var UserListForm TUserListForm implementation uses EditUser, IniFiles, Global const SAccessDenied Недостаточно прав. Доступ запрещен R .DFM procedure TUserListForm. DBNavigatorClickSender TObject Button TNavigateBtn begin case Button of nbInsert begin EditUserData, UsersTable, True end nbEdit begin EditUserData, UsersTable, False end end end procedure TUserListForm. UsersGridDblClickSender TObject begin EditUserData, UsersTable, False end procedure TUserListForm. FormPlacementSavePlacement Sender TObject var IniFile TIniFile I Integer begin IniFile TIniFile. CreateFormPlacement. IniFileName try for I 0 to ComponentCount - 1 do begin if ComponentsI is TrxDBGrid then TrxDBGridComponentsI.SaveLayoutIniFile end finally IniFile. Free end end procedure TUserListForm. FormPlacementRestorePlacem entSender TObject var IniFile TIniFile I Integer begin IniFile TIniFile. CreateFormPlacement. IniFileName try for I 0 to ComponentCount - 1 do begin if ComponentsI is TrxDBGrid then TrxDBGridComponentsI.RestoreLayoutIniFil e end finally IniFile. Free end end procedure TUserListForm. FormCreateSender TObject begin if not glUserLevel in ulAdministrator then begin raise Exception. CreateSAccessDenied end UsersTable. Open end procedure TUserListForm. FormCloseSender TObject var Action TCloseAction begin Action caFree end end. program Shaft uses Forms, Main in MAIN.PAS StaftForm, Global in GLOBAL.PAS, EditUser in EDITUSER.PAS, UserList in USERLIST.PAS UserListForm, Edittub in EDITTUB.PAS EditDataForm, Editform in EDITFORM.PAS EdTubForm, Calc1 in CALC1.PAS Form1, Draw in DRAW.PAS DrawForm R .RES begin Application. CreateFormTStaftForm, StaftForm Application. CreateFormTEditDataForm, EditDataForm Application. CreateFormTEdTubForm, EdTubForm Application. CreateFormTForm1, Form1 Application. CreateFormTDrawForm, DrawForm Application. Run end. 5. Список использованной литературы. 1. Баклашов И.В Картозия Б.А. Механика подземных сооружений и конструкций крепей - М Недра, 1992, 543 с. 2. Насонов И.Д Федюкин В.А Шуплик М.Н Технология строительства подземных сооружений - М Недра, 1992, 285 с. 3. Насонов И.Д Шуплик М.Н. Закономерности формирования ледопородных ограждений при сооружении стволов шахт - М Недра, 1976, 237 с. 4. Храпов В.Г. Тоннели и метрополитены - М Транспорт, 1989, 383 с. 5. Белый В.В. Справочник инженера шахтостроителя в 2-х томах - М 1983 6. Туренский Н.Г Ледяев А.П. Строительство тоннелей и метрополитенов - М Транспорт, 1992, 264 с. 7. Богомолов Г.М Голицынский Д.М. Сеславинский С.И. Справочник инженера тоннельщика - М Транспорт, 1993, 389 с.