Смекни!
smekni.com
География

Обделка вертикальных стволов (стр. 8 из 9)

-(PLines[isP2,1]/PLines[isP0,1]),PLines[isP2,1]);

DrawLine(PLines[isP0,2],

-(PLines[isP2,2]/PLines[isP0,2]),PLines[isP2,2]);

DrawLine(0,1,0);

DrawLine(PLines[isP0,4],

-(PLines[isP2,4]/PLines[isP0,4]),PLines[isP2,4]);

DrawLine(PLines[isP0,5],

-(PLines[isP2,5]/PLines[isP0,5]),PLines[isP2,5]);

Canvas.Brush.Color := clGreen;

Canvas.FloodFill(Round((((PointMax-PointMin)/2)*Kx)+R.Left+60),

R.Bottom-55, clBlack, fsBorder);

Canvas.Brush.Color := clBtnFace;

Canvas.TextOut(R.Right-80, R.Bottom-50, 'P0, TC/M*2');

Canvas.TextOut(R.Left+20, R.Top+10, 'P2, TC/M*2');

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 = class(TForm)

Panel1: TPanel;

rxDBLookupCombo1: TrxDBLookupCombo;

TableSTUFF: TTable;

DataSourceSTUFF: TDataSource;

DBGrid1: TDBGrid;

DataSourceDATA: TDataSource;

TableDATA: TTable;

TableDATAMass: TFloatField;

TableDATAR_press: TFloatField;

TableDATAR_stretch: TFloatField;

TableDATAPuasson: TFloatField;

TableDATAR1: TFloatField;

TableDATARb: TFloatField;

TableDATAR: TFloatField;

TableDATAA: TFloatField;

TableDATAB: TFloatField;

rxDBFilter1: TrxDBFilter;

TableDATAStuff: TSmallintField;

DBNavigator1: TDBNavigator;

procedure rxDBLookupCombo1Change(Sender: TObject);

procedure DBNavigator1Click(Sender: TObject; Button:

TNavigateBtn);

procedure DBGrid1DblClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

EditDataForm: TEditDataForm;

implementation

{$R *.DFM}

uses

EditForm;

procedure TEditDataForm.rxDBLookupCombo1Change(Sender: TObject);

var

S: String;

begin

rxDBFilter1.Deactivate;

rxDBFilter1.Filter.Clear;

s:='Stuff = '+TableSTUFF.FieldByName('Code').AsString;

rxDBFilter1.Filter.Add(S);

rxDBFilter1.Activate;

end;

procedure TEditDataForm.DBNavigator1Click(Sender: TObject; Button:

TNavigateBtn);

begin

case Button of

nbInsert:

begin

EditDataTub(TableDATA, True,

TableSTUFF.FieldByName('Code').AsInteger);

end;

nbEdit:

begin

EditDataTub(TableDATA, False,

TableSTUFF.FieldByName('Code').AsInteger);

end;

end;

end;

procedure TEditDataForm.DBGrid1DblClick(Sender: TObject);

begin

EditDataTub(TableDATA, False,

TableSTUFF.FieldByName('Code').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 = class(TForm)

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 FormCreate(Sender: TObject);

public

FCode: Integer;

function EditTub( Table: TTable; IsNew: Boolean; Code: Integer):

Boolean;

end;

var

EdTubForm: TEdTubForm;

function EditDataTub(Table: TTable; IsNew: Boolean; Code: Integer):

Boolean;

implementation

{$R *.DFM}

function EditDataTub(Table: TTable; IsNew: Boolean; Code: Integer):

Boolean;

begin

Result := False;

with TEdTubForm.Create(Application) do

try

FCode := Code;

Result := EditTub(Table, IsNew, Code);

finally

Free;

end;

end;

function TEdTubForm.EditTub(Table: 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.FieldByName('Stuff').AsInteger := Code;

end

else DataSource1.DataSet.Edit;

Result := ShowModal = mrOk;

if Result then

DataSource1.DataSet.Post

else

DataSource1.DataSet.Cancel;

end;

procedure TEdTubForm.FormCreate(Sender: TObject);

begin

Query1.Active := False;

Query1.ParamByName('St').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 = class(TForm)

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 OKBtnClick(Sender: TObject);

procedure CancelBtnClick(Sender: TObject);

procedure FormHide(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

function EditUser(const UserName: string; Table: TTable; IsNew:

Boolean): Boolean;

end;

var

EditUserDialog: TEditUserDialog;

function EditUserData(const UserName: string; Table: TTable;

IsNew: Boolean): Boolean;

implementation

uses

Global, Crypt;

{$R *.DFM}

const

SNotFound = 'Записей не обнаружено';

SNoConfirmPassword = 'Вы ввели разные пароли. Проверьте

правильность ввода';

function EditUserData(const 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.Create(Application) do

try

Result := EditUser(SUName, Table, IsNew);

finally

Free;

end;

end;

{ TEditUserDialog }

function TEditUserDialog.EditUser(const 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.FindKey([UserName]) then

raise Exception.Create(SNotFound);

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.OKBtnClick(Sender: TObject);

begin

if PasswordEdit.Text <> ConfirmPassword.Text then

raise Exception.Create(SNoConfirmPassword);

dsUsers.DataSet.Post;

ModalResult := mrOk;

end;

procedure TEditUserDialog.CancelBtnClick(Sender: TObject);

begin

dsUsers.DataSet.Cancel;

ModalResult := mrCancel;

end;

procedure TEditUserDialog.FormHide(Sender: 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 cUserLevel(Code: Longint): TUserLevel;

implementation

function cUserLevel(Code: Longint): TUserLevel;

begin

Result := ulInvalid;

if (Code in [Integer(Low(TUserLevel))..Integer(High(TUserLevel))]) then

Result := TUserLevel(Code);

end;

end.

unit Global;

interface

type

TUserLevel = (ulInvalid, ulOperator, ulManager, ulAdministrator);

const

InvalidID = 0;

glUserLevel: TUserLevel = ulInvalid;

glUserName: string = '';

glUserID: Longint = InvalidID;

function cUserLevel(Code: Longint): TUserLevel;

implementation

function cUserLevel(Code: Longint): TUserLevel;

begin

Result := ulInvalid;

if (Code in [Integer(Low(TUserLevel))..Integer(High(TUserLevel))]) then

Result := TUserLevel(Code);

end;

end.

unit Main;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,

Controls, Forms, Dialogs, SpeedBar, Menus, ExtCtrls, Placemnt, DB,

DBSecur, DBTables;

type

TStaftForm = class(TForm)

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 ArrangeAllMenuItemClick(Sender: TObject);

procedure TileMenuItemClick(Sender: TObject);

procedure CascadeMenuItemClick(Sender: TObject);

procedure MinimizeAllMenuItemClick(Sender: TObject);

procedure AboutMenuItemClick(Sender: TObject);

procedure PrinterSetupMenuItemClick(Sender: TObject);

procedure ExitMenuItemClick(Sender: TObject);

procedure FormStorageRestorePlacement(Sender: TObject);

procedure FormStorageSavePlacement(Sender: TObject);

function DBSecurity1CheckUser(UsersTable: TTable;

const

Password: String): Boolean;

procedure UserMenuItemClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure InsuranceMenuItemClick(Sender: TObject);

procedure ShowHint(Sender: TObject);

procedure EditItemClick(Sender: TObject);

private

procedure SetUserLevel;

procedure UpdateMenuItems(Sender: TObject);

function ShowForm(FormClass: 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.TileMenuItemClick(Sender: TObject);

begin

Tile;

end;

procedure TStaftForm.CascadeMenuItemClick(Sender: TObject);

begin

Cascade;

end;

procedure TStaftForm.MinimizeAllMenuItemClick(Sender: TObject);

var

I: Integer;

begin

for I := MDIChildCount - 1 downto 0 do

MDIChildren[I].WindowState := wsMinimized;

end;

procedure TStaftForm.ArrangeAllMenuItemClick(Sender: TObject);

begin

ArrangeIcons;

end;

procedure TStaftForm.AboutMenuItemClick(Sender: TObject);

begin

ShowAboutDialog('Расчет тюбинговой обделки', 'Королев А.В.',

'МГГУ', nil, 1, 0, 1996);

end;

procedure TStaftForm.PrinterSetupMenuItemClick(Sender: TObject);

begin

PrinterSetup.Execute;

end;

procedure TStaftForm.ExitMenuItemClick(Sender: TObject);

begin

Close;

end;

function TStaftForm.ShowForm(FormClass: TFormClass): TForm;

var

Form: TForm;

begin

Result := nil;

StartWait;

try

Form := FindForm(FormClass);

if Form = nil then

Application.CreateForm(FormClass, Form);

with Form do begin

if WindowState = wsMinimized then WindowState := wsNormal;

Show;

end;

Result := Form;

finally

StopWait;

end;

end;

procedure TStaftForm.FormStorageRestorePlacement(Sender: TObject);

var

IniFile: TrxIniFile;

List: TStrings;

I: Integer;

FormClass: TFormClass;

Form: TForm;

begin

StartWait;

try

SpeedBar.Visible := True;

IniFile := TrxIniFile.Create(FormPlacement.IniFileName);

try

if (glUserLevel in [ulManager, ulAdministrator]) then begin

List := TStringList.Create;

try

IniFile.ReadList(siMDIChilds, List);

for I := 0 to List.Count - 1 do begin

FormClass := TFormClass(GetClass(List[I]));

if FormClass <> nil then ShowForm(FormClass);

end;

finally

List.Free;

end;

end;

finally

IniFile.Free;

end;

finally

StopWait;

end;

end;

procedure TStaftForm.FormStorageSavePlacement(Sender: TObject);

var

IniFile: TrxIniFile;

List: TStrings;

I: Integer;

begin

IniFile := TrxIniFile.Create(FormPlacement.IniFileName);

try

IniFile.EraseSection(siMDIChilds);

List := TStringList.Create;

try

for I := MDIChildCount - 1 downto 0 do

List.Add(MDIChildren[I].ClassName);

if List.Count > 0 then

IniFile.WriteList(siMDIChilds, List);

finally

List.Free;

end;

finally

IniFile.Free;

end;

end;

function TStaftForm.DBSecurity1CheckUser(UsersTable: TTable;

const

Password: String): Boolean;

begin

Result := (Password = UsersTable.FieldByName('Password').AsString);

if Result then begin

glUserName := UsersTable.FieldByName('UserName').AsString;

glUserID := UsersTable.FieldByName('ID').AsInteger;

glUserLevel :=cUserLevel(UsersTable.FieldByName('UserLevel')

.AsInteger);

Result := (glUserLevel <> ulInvalid);

end;

if Result then SetUserLevel;

end;

procedure TStaftForm.UserMenuItemClick(Sender: TObject);

begin

ShowForm(TUserListForm);

end;

procedure TStaftForm.ShowHint(Sender: TObject);

begin

HintPanel.Caption := Application.Hint;

end;

procedure TStaftForm.UpdateMenuItems(Sender: 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.FormCreate(Sender: TObject);

begin

Application.OnHint := ShowHint;

Screen.OnActiveFormChange := UpdateMenuItems;

SetAutoSubClass(True);

{ set wait cursor to SQL }

 
назад
читать дальше
1
2
3
4
5
6
7
8
9
НАПИШИТЕ НАМ
Copyright © Smekni.com. All rigths reserved.