Від програм аналогічного призначення вона відрізняється зручним і гнучким інтерфейсом, що дозволяє користувачу змінювати відображення даних, як на екрані комп'ютера, так і у твердих копіях звітів.

Програма повинна працювати так, щоб користувач міг без зусиль користуватися важливою інформацією для його роботи, бачив зрозуміле представлення данних у програмі, міг з легкістю знайти інформацію, якої він потребує в данний момент часу.

2.2 Опис програми

Програма МПК «Оцінювача» призначена для ведення банка даних укрупнених показників вартості відтворення об'єктів аналогів для оцінки малоповерхових будинків, будівель та споруд на підприємствах України на основі існуючого законодавства та діючих інструкцій (“Інструкції про порядок проведення технічної інвентаризації об'єктів нерухомого майна”, “Зміни до Інструкції про порядок проведення технічної інвентаризації об'єктів нерухомого майна, наказом Держбуду України від 24.05.2001 N 127 та зареєстрованої в Мін'юсті України 10.07.2001 за N 582/5773” та ін.).

Від програм аналогічного призначення вона відрізняється зручним і гнучким інтерфейсом, що дозволяє користувачу змінювати відображення даних, як на екрані комп'ютера, так і у твердих копіях звітів. Форми звітів є відкритими, тобто користувач може задавати їх самостійно, в межах діючого законодавства. Для відображення і друку звітів використовується зовнішня програма Microsoft Excel, що входить до складу Microsoft Office версії 97 (SP2) або вище.

Програма працює в режимі “клієнт-сервер”, що дає змогу підтримувати єдину інформаційну базу в межах підприємства, а також працювати кільком користувачам одночасно з різних робочих місць в одній локальні мережі.

Схема даних:

Рис. 2.2.1 - Схема даних БД

МПК «Оцінювача» створена для персональних комп'ютерів класу IBM PC і функціонує під управлінням операційної системі Windows версій 9x, МЕ або NT 4.0 або вище. Основним алгоритмом в програмі являється алгоритм доступу до БД і вибірка даних. Так як підключення до бази даних відбувається автоматично за допомогою компоненти FibConection, то основна дія - вибірка даних. Вибірка данних відбувається за допомогою компоненти CxGrid з бібліотеки DevExpress, який являється також таблицею, в якій наглядно представляються данні з таблиць бази.

Рис. 2.2.2 Схема даних БД

Рис. 2.2.3 Схема даних БД

2.3 Алгоритм програми

Після запуску програми на екрані висвічується форма «МПК Оцінка».

Рис. 2.3.1 Форма «МПК Оцінка»

За допомогою кнопки підключаємось до бази даних. Відкривається форма «Опції підключення до сервера `МПК Оцінка'», де ми повинні ввести опції пудулючення та шлях до бази даних.

Рис. 2.3.2 Форма «Опції підключення до сервера `МПК Оцінка'»

Размещено на http://www.allbest.ru/

За допомогою кнопок вводяться логін і пароль за замовчуванням. При натисненні кнопки пропонується виконати шлях до бази данних. Кнопка «Тест» перевіряє правильність введених вами данних та видає інформацію про поточний стан підключення.

Після того як ми підключилися:

Рис. 2.3.3 Форма «МПК Оцінка»

Ми бачимо вкладку «База об'ектів аналогів», де можемо бачити всю необхідні об'єкти у верхній частині вікна та їх властивості у нижній. Щоб обрати об'єкт, потрібно вибрати потрібний розділ та клацнути на ньому, відкриється випадаючий список. Виділивши елемент, у нижній частині вікна буде знаходитися інформація про виділений вами об'єкт, подивитися яку можна за аналогією.



Рис. 2.3.4 Вкладка«База об'ектів аналогів» на формі «МПК Оцінка»

На вкладці «Довідники та класифікатори» ми можемо подивитися всі умовні позначення, що використовуються в базі.

Рис. 2.3.5 Вкладка«Довідники та класифікатори» на формі «МПК Оцінка»

При натисненні на кнопку відключаємося від бази. Інструкція по експлуатації

При запуску програми на екрані з'явиться вікно «МПК Оцінки». Виконайте інструкції :

- Натисніть кнопку і підключіться до БД;

- При необхідності введіть настройки підключення до БД;

- Виберіть потрібний елемент;

- Продивіться необхідну інформацію;

- При необхідності відкрийте вкладку по довідникам та продивіться шифри інформації.

Висновки

Для розробки проекту використала Delphi 6. Це зручний інструмент для розробки програм, дозволяє створити зручний продукт як для користувача, так і для програміста.

Програма має зручний інтерфейс, займає не багато місця на жорсткому диску, працює на будь-якому комп'ютері, який підтримує роботу з Delphi 6.

Список використаних джерел

1. Абрамов С.А., Зима Є.В. “Начала информатики”.- М.:Наука, 1989._256 с.

2. Агеев М.И., Алик В.П., Марков Ю.И “Библиотека алгоритмов”

101 б - 150 б; Справочное пособие вик.3. - М.:Сов радіо, 1978, 120 с.

3. Бартків А.Б., Гринчишін Я.Т. та ін.

TURBO Pascal:

Додаток 1

Дизайн для головної форми frmMain:

unit main;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, dxStatusBar, cxGraphics, cxControls, cxLookAndFeels,

cxLookAndFeelPainters, ActnList, ActnMan, ActnMenus, ImgList, ToolWin,

ActnCtrls, ComCtrls, Menus, cxPC, cxContainer, cxEdit, cxSplitter,

cxGroupBox, cxStyles, cxCustomData, cxFilter, cxData, cxDataStorage, DB,

cxDBData, cxGridLevel, cxClasses, cxGridCustomView,

cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGrid,

uBaseObjectElements, uObjectElementsNDI, cxGridCardView,

cxGridBandedTableView, cxGridDBBandedTableView, cxTextEdit,

cxPropertiesStore;

type

TfrmMain = class(TForm)

dxStatusBar1: TdxStatusBar;

ImageList: TImageList;

ActionManagerNDI: TActionManager;

actConnect: TAction;

actDisconnect: TAction;

actSettings: TAction;

actAbout: TAction;

mainTlbBr: TToolBar;

tlbConnect: TToolButton;

tlbDisconnect: TToolButton;

ToolButton3: TToolButton;

tblSettings: TToolButton;

ToolButton5: TToolButton;

tlbAbout: TToolButton;

MainMenu: TMainMenu;

cxPageCtrlMain: TcxPageControl;

cxTabSheetAnalogs: TcxTabSheet;

cxTabSheetDict: TcxTabSheet;

cxGB_Analogs: TcxGroupBox;

cxSpltAnalogs: TcxSplitter;

cxGrdAnalogs: TcxGrid;

cxPageCtrlMain_Adds: TcxPageControl;

cxTabSheet_NDI_Constr: TcxTabSheet;

cxTabSheet_NDI_Vols: TcxTabSheet;

cxTabSheet_NDI_Prices: TcxTabSheet;

frmObjectElementsNDI: TfrmObjectElementsNDI;

cxGridDictLevel1: TcxGridLevel;

cxGridDict: TcxGrid;

cxGridDictLevel2: TcxGridLevel;

cxGridDictLevel3: TcxGridLevel;

cxGridDictLevel4: TcxGridLevel;

cxGridDictLevel5: TcxGridLevel;

cxGridDictLevel6: TcxGridLevel;

cxGridDictLevel7: TcxGridLevel;

cxGridDictLevel8: TcxGridLevel;

cxGridDictLevel9: TcxGridLevel;

cxGridDictLevel10: TcxGridLevel;

cxGridDictLevel11: TcxGridLevel;

cxGridViewRepositoryDictionary: TcxGridViewRepository;

cxGridViewRepositoryDictionaryDBBandedConstrElements:

cxPropertiesStoreNDIstatic: TcxPropertiesStore;

GridCollapse: TAction;

GridExpand: TAction;

PopupMenu: TPopupMenu;

N10: TMenuItem;

N11: TMenuItem;

procedure FormCreate(Sender: TObject);

procedure actConnectExecute(Sender: TObject);

procedure actDisconnectExecute(Sender: TObject);

procedure actSettingsExecute(Sender: TObject);

procedure actAboutExecute(Sender: TObject);

procedure cxGridViewRepositoryDictionaryDBBandedConstrElementsNAME_LEVEL_UA_0GetDisplayText(

Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord;

var AText: String);

procedure cxGrid_NDI_DBTableView_NDI_VCustomDrawCell(

Sender: TcxCustomGridTableView; ACanvas: TcxCanvas;

AViewInfo: TcxGridTableDataCellViewInfo; var ADone: Boolean);

procedure actChangeGridToBigExecute(Sender: TObject);

procedure actChangeGridToSmallExecute(Sender: TObject);

procedure cxPageCtrlMainChange(Sender: TObject);

procedure AfterMainScroll(Sender : TDataSet);

procedure cxGridViewRepositoryDictionaryDBBandedConstrElementsCustomDrawGroupCell(

Sender: TcxCustomGridTableView; ACanvas: TcxCanvas;

AViewInfo: TcxGridTableCellViewInfo; var ADone: Boolean);

procedure GridCollapseExecute(Sender: TObject);

procedure GridExpandExecute(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

frmMain: TfrmMain;

implementation

{$R *.dfm}

uses uTools, uDataModule, uSetupConnect, uAbout, uDataModuleNDI;

//------------------------------------------------------------------------------

procedure TfrmMain.FormCreate(Sender: TObject);

begin

Caption := AppName;

end;

//------------------------------------------------------------------------------

procedure TfrmMain.actConnectExecute(Sender: TObject);

begin

if frmDataModuleNDI.OpenBase(Sender) then

begin

actConnect.Enabled := false;

actDisconnect.Enabled := true;

actSettings.Enabled := false;

cxPageCtrlMain.ActivePage := cxTabSheetAnalogs;

cxPageCtrlMain.Visible := True;

cxPageCtrlMain_Adds.ActivePageIndex := 0;

cxPageCtrlMain.OnChange(nil);

end;

end;

//------------------------------------------------------------------------------

procedure TfrmMain.actDisconnectExecute(Sender: TObject);

begin

frmDataModuleNDI.CloseBase(Sender);

actConnect.Enabled := true;

actDisconnect.Enabled := false;

actSettings.Enabled := true;

cxPageCtrlMain.Visible := False;

end;

//------------------------------------------------------------------------------

procedure TfrmMain.actSettingsExecute(Sender: TObject);

begin

fSetupConnect.ShowModal(frmDataModule.pDataBaseNDI,reg_key_mpk_30,' (підключення до 3.0.3.0)');

end;

//------------------------------------------------------------------------------

procedure TfrmMain.actAboutExecute(Sender: TObject);

begin

frmAboutBox.ShowModal;

end;

//------------------------------------------------------------------------------

procedure TfrmMain.cxGrid_NDI_DBTableView_NDI_VCustomDrawCell(Sender: TcxCustomGridTableView; ACanvas: TcxCanvas;

AViewInfo: TcxGridTableDataCellViewInfo; var ADone: Boolean);

var poz_col, poz_row : integer;

begin

poz_row := AViewInfo.GridRecord.RecordIndex;

poz_col := AViewInfo.Item.Index;

ACanvas.Font.Color := clBlack;

if (poz_row = 0) or (poz_col = 0) then // caption

begin

ACanvas.FillRect(AViewInfo.RealBounds,cl3DLight);

ACanvas.Font.Style := [fsBold];

end else

begin // data

ACanvas.Font.Style := [];

if Sender.VisibleItemCount = 17 then // large

begin

if (poz_row in [1..12]) and (poz_col in [1..8]) or

(poz_row in [13..24]) and (poz_col in [9..16]) then ACanvas.FillRect(AViewInfo.RealBounds,clBtnFace)

else ACanvas.FillRect(AViewInfo.RealBounds,clWhite);

if (Sender.tag = 2) and (frmDataModuleNDI.fdsNDI_Gold_DSet.RecordCount = 1) then // gold square

begin

if (25 - poz_row in [frmDataModuleNDI.fdsNDI_Gold_DSet.FieldByRelName('X1').AsInteger..

frmDataModuleNDI.fdsNDI_Gold_DSet.FieldByRelName('X2').AsInteger]) and

(poz_col in [frmDataModuleNDI.fdsNDI_Gold_DSet.FieldByRelName('Y1').AsInteger..

frmDataModuleNDI.fdsNDI_Gold_DSet.FieldByRelName('Y2').AsInteger]) then ACanvas.Font.Style := [fsBold];

end;

end else ACanvas.FillRect(AViewInfo.RealBounds,clWhite);

end;

if not VarIsNull(AViewInfo.Value) then ACanvas.DrawTexT( VarToStr(AViewInfo.Value), AViewInfo.TextAreaBounds, cxAlignCenter);

ADone := true;

end;

//------------------------------------------------------------------------------

procedure TfrmMain.actChangeGridToBigExecute(Sender: TObject);

begin

cxGrid_NDI_DBTableView_NDI_VVAL_13.Visible := true;

cxGrid_NDI_DBTableView_NDI_VVAL_14.Visible := true;

cxGrid_NDI_DBTableView_NDI_VVAL_15.Visible := true;

cxGrid_NDI_DBTableView_NDI_VVAL_16.Visible := true;

cxGrid_NDI_DBTableView_NDI_PVAL_13.Visible := true;

cxGrid_NDI_DBTableView_NDI_PVAL_14.Visible := true;

cxGrid_NDI_DBTableView_NDI_PVAL_15.Visible := true;

cxGrid_NDI_DBTableView_NDI_PVAL_16.Visible := true;

end;

//------------------------------------------------------------------------------

procedure TfrmMain.actChangeGridToSmallExecute(Sender: TObject);

begin

cxGrid_NDI_DBTableView_NDI_VVAL_13.Visible := false;

cxGrid_NDI_DBTableView_NDI_VVAL_14.Visible := false;

cxGrid_NDI_DBTableView_NDI_VVAL_15.Visible := false;

cxGrid_NDI_DBTableView_NDI_VVAL_16.Visible := false;

cxGrid_NDI_DBTableView_NDI_PVAL_13.Visible := false;

cxGrid_NDI_DBTableView_NDI_PVAL_14.Visible := false;

cxGrid_NDI_DBTableView_NDI_PVAL_15.Visible := false;

cxGrid_NDI_DBTableView_NDI_PVAL_16.Visible := false;

end;

//------------------------------------------------------------------------------

procedure TfrmMain.AfterMainScroll(Sender : TDataSet);

begin

if (frmDataModuleNDI.fdsNDI_V_Type_DSet.FieldByRelName('VAL_14').IsNull) and cxGrid_NDI_DBTableView_NDI_VVAL_13.Visible then actChangeGridToSmall.Execute;

if (not frmDataModuleNDI.fdsNDI_V_Type_DSet.FieldByRelName('VAL_14').IsNull) and not cxGrid_NDI_DBTableView_NDI_VVAL_13.Visible then actChangeGridToBig.Execute;

end;

//------------------------------------------------------------------------------

procedure TfrmMain.cxPageCtrlMainChange(Sender: TObject);

begin

if (cxGrdAnalogsDBBandedAnalogs.DataController.DataSource.DataSet.Active) and (cxPageCtrlMain.ActivePage = cxTabSheetAnalogs) then

begin

cxPageCtrlMain_Adds.ActivePageIndex := 0;

cxGrdAnalogsDBBandedAnalogs.DataController.DataSource.DataSet.AfterScroll := AfterMainScroll;

cxGrdAnalogsDBBandedAnalogs.DataController.DataSource.DataSet.AfterScroll(nil);

end else cxGrdAnalogsDBBandedAnalogs.DataController.DataSource.DataSet.AfterScroll := nil;

end;

//------------------------------------------------------------------------------

procedure TfrmMain.cxGridViewRepositoryDictionaryDBBandedConstrElementsCustomDrawGroupCell(

Sender: TcxCustomGridTableView; ACanvas: TcxCanvas;

AViewInfo: TcxGridTableCellViewInfo; var ADone: Boolean);

begin

end;

//------------------------------------------------------------------------------

procedure TfrmMain.cxGridViewRepositoryDictionaryDBBandedConstrElementsNAME_LEVEL_UA_0GetDisplayText(Sender: TcxCustomGridTableItem;

ARecord: TcxCustomGridRecord; var AText: String);

begin

AText := VarToStr(ARecord.ViewData.DataController.Values[ARecord.RecordIndex, Sender.Tag]);

end;

//------------------------------------------------------------------------------

procedure TfrmMain.GridCollapseExecute(Sender: TObject);

begin

cxGridViewRepositoryDictionaryDBBandedConstrElements.ViewData.Collapse(true);

end;

procedure TfrmMain.GridExpandExecute(Sender: TObject);

begin

cxGridViewRepositoryDictionaryDBBandedConstrElements.ViewData.Expand(true);

end;

end.

Додаток 2

Реалізація для не візуальної форми підключення до БД DataModule:

unit uDataModule;

interface

uses

SysUtils, Classes, FIBDatabase, pFIBDatabase, DB, FIBDataSet, pFIBDataSet;

type

TfrmDataModule = class(TDataModule)

pDataBaseNDI: TpFIBDatabase;

pTransactionNDI: TpFIBTransaction;

procedure DataModuleCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

frmDataModule: TfrmDataModule;

implementation

{$R *.dfm}

uses uSetupConnect, uTools;

//------------------------------------------------------------------------------

procedure TfrmDataModule.DataModuleCreate(Sender: TObject);

begin

if pDataBaseNDI.TestConnected then

begin

pDataBaseNDI.CloseDataSets;

pDataBaseNDI.Close;

end;

end;

//------------------------------------------------------------------------------

end.

Додаток 3

Реалізація для форми підключення до БД fSetupConnect:

unit uSetupConnect;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, cxGraphics, cxControls, cxLookAndFeels, cxLookAndFeelPainters,

cxContainer, cxEdit, cxGroupBox, Menus, cxLabel, cxTextEdit, StdCtrls,

cxButtons, cxMaskEdit, cxButtonEdit, cxRadioGroup, Registry, pFIBDatabase;

type

TBaseInfo = record

NameHost : AnsiString;

UserName : AnsiString;

UserPass : AnsiString;

PathToBase : AnsiString;

Lang : AnsiString;

end;

TfSetupConnect = class(TForm)

cxRG_SelectTypeServer: TcxRadioGroup;

cxBE_PathBase: TcxButtonEdit;

cxTE_NameSrv: TcxTextEdit;

cxL_NameServ: TcxLabel;

cxBtn_Ok: TcxButton;

cxBt_Cancel: TcxButton;

cxBtn_Help: TcxButton;

cxBtn_Test: TcxButton;

cxL_PathBase: TcxLabel;

cxLb_UserName: TcxLabel;

cxButEdt_UserName: TcxButtonEdit;

cxLb_UserPass: TcxLabel;

cxButEdt_UserPass: TcxButtonEdit;

OpenDialog: TOpenDialog;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure cxRG_SelectTypeServerPropertiesChange(Sender: TObject);

procedure cxBtn_TestClick(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure cxBt_CancelClick(Sender: TObject);

procedure cxBtn_OkClick(Sender: TObject);

procedure cxBE_PathBasePropertiesButtonClick(Sender: TObject;

AButtonIndex: Integer);

procedure cxButEdt_UserNamePropertiesButtonClick(Sender: TObject;

AButtonIndex: Integer);

procedure cxButEdt_UserPassPropertiesButtonClick(Sender: TObject;

AButtonIndex: Integer);

private { Private declarations }

key_str : string;

BaseInfo : TBaseInfo;

BaseInfoBkp : TBaseInfo;

ParamsConnectToServer : TRegistry;

db_Base : TpFIBDatabase;

function ReadDateFromRegistry : boolean;

function SaveDateToRegistry : boolean;

procedure InitData;

procedure SetParamsDB;

procedure SaveBkpSettingsDb;

procedure RestoreBkpSettingsDb;

procedure SetSettingsDB(Value : TBaseInfo);

function CheckInputData : boolean;

procedure GetControlConnectData;

public { Public declarations }

function ShowModal(db : TpFIBDatabase; const s : AnsiString = ''; const AddCaption : AnsiString = ''): Integer; reintroduce;

function GetStringPathName(db : TpFIBDatabase; const s : AnsiString = '') : AnsiString;

function SetParamsDBConnect(srcDB : TpFIBDatabase; const s : AnsiString = '') : boolean;

end;

var

fSetupConnect: TfSetupConnect;

implementation

{$R *.dfm}

uses uTools, StrUtils;

//------------------------------------------------------------------------------

function TfSetupConnect.SetParamsDBConnect(srcDB : TpFIBDatabase; const s : AnsiString = '') : boolean;

begin

Result := false;

if Length(s) > 0 then key_str := s else key_str := reg_key_mpk_30;

//---

if srcDB.TestConnected then

begin

srcDB.CloseDataSets;

srcDB.Close;

end;

if not ReadDateFromRegistry then exit;

with srcDB.DBParams do

begin

Clear;

add(format('user_name=%s',[BaseInfo.UserName]));

add(format('password=%s' ,[BaseInfo.UserPass]));

add(format('lc_ctype=%s', [BaseInfo.Lang]));

end;

if Length(BaseInfo.NameHost) > 0 then

srcDB.DBName := BaseInfo.NameHost + ':' + BaseInfo.PathToBase

else srcDB.DBName := BaseInfo.PathToBase;

Result := true;

end;

//------------------------------------------------------------------------------

function TfSetupConnect.GetStringPathName(db : TpFIBDatabase; const s : AnsiString = '') : AnsiString;

begin

Result := '';

if Length(s) > 0 then key_str := s else key_str := reg_key_mpk;

db_Base := db;

if db_Base.Connected then db_Base.Close;

if not ReadDateFromRegistry then exit;

SetSettingsDB(BaseInfo);

db_Base.Open(false);

if db_Base.TestConnected then

begin

if Length(BaseInfo.NameHost) > 0 then Result := BaseInfo.NameHost + ':' + BaseInfo.PathToBase

else Result := BaseInfo.PathToBase;

db_Base.Close;

end;

end;

//------------------------------------------------------------------------------

function TfSetupConnect.CheckInputData : boolean;

const ErrStr : array[1..4] of AnsiString = ('сервер', 'шлях до бази даних','користувач','пароль');

var NumErr : integer;

begin

NumErr := 0;

if length(cxBE_PathBase.Text) = 0 then NumErr := 2;

if (length(cxButEdt_UserName.Text) = 0) and (NumErr = 0) then NumErr := 3;

if (length(cxButEdt_UserPass.Text) = 0) and (NumErr = 0) then NumErr := 4;

if (cxRG_SelectTypeServer.ItemIndex = 1) then if (length(cxTE_NameSrv.Text) = 0) and (NumErr = 0) then NumErr := 1;

if NumErr > 0 then MsgError(format('Не вказаний %s.',[ErrStr[NumErr]]));

Result := (NumErr = 0);

end;

//------------------------------------------------------------------------------

function TfSetupConnect.ShowModal(db : TpFIBDatabase; const s : AnsiString = ''; const AddCaption : AnsiString = ''): Integer;

begin

if Length(s) > 0 then key_str := s else key_str := reg_key_mpk;

Caption := 'Опції підключення до сервера ' + QuotedStr(AppName);

if Length(AddCaption) > 0 Then Caption := Caption + AddCaption;

db_Base := db;

if db_Base.Connected then db_Base.Close;

result := inherited ShowModal;

end;

//------------------------------------------------------------------------------

procedure TfSetupConnect.SetSettingsDB(Value : TBaseInfo);

begin

with db_Base.DBParams do

begin

Clear;

add(format('user_name=%s',[Value.UserName]));

add(format('password=%s' ,[Value.UserPass]));

add(format('lc_ctype=%s',[Value.Lang]));

end;

if Length(Value.NameHost) > 0 then

db_Base.DBName := Value.NameHost + ':' + Value.PathToBase

else db_Base.DBName := Value.PathToBase;

end;

//------------------------------------------------------------------------------

procedure TfSetupConnect.RestoreBkpSettingsDb;

begin

if db_Base.Connected then db_Base.Close;

SetSettingsDB(BaseInfoBkp);

end;

//------------------------------------------------------------------------------

procedure TfSetupConnect.SaveBkpSettingsDb;

var i : integer;

begin

if db_Base.Connected then db_Base.Close;

with BaseInfoBkp do

begin

if pos(':',db_Base.DBName) > 2 then

begin

PathToBase := db_Base.DBName;

NameHost := '';

end else

begin

NameHost := copy(db_Base.DBName,1,pos(':',db_Base.DBName) + 1);

PathToBase := AnsiReplaceStr(db_Base.DBName,NameHost,'');

end;

for i := 0 to db_Base.DBParams.Count-1 do

begin

if AnsiStartsStr('user_name=',db_Base.DBParams[i]) then

begin

UserName := copy(db_Base.DBParams[i],Length('user_name='),

Length(db_Base.DBParams[i])-Length('user_name=')+1);

end else

begin

if AnsiStartsStr('password=',db_Base.DBParams[i]) then

begin

UserPass := copy(db_Base.DBParams[i],Length('password='),

Length(db_Base.DBParams[i])-Length('password=')+1);

end else

begin

if AnsiStartsStr('lc_ctype==',db_Base.DBParams[i]) then

begin

Lang := copy(db_Base.DBParams[i],Length('lc_ctype='),

Length(db_Base.DBParams[i])-Length('lc_ctype=')+1);

end;

end;

end;

end;

if Lang = '' then Lang := 'WIN1251';

end;

end;

//------------------------------------------------------------------------------

procedure TfSetupConnect.SetParamsDB;

begin

if db_Base.Connected then db_Base.Close;

SetSettingsDB(BaseInfo);

end;

//------------------------------------------------------------------------------

function TfSetupConnect.ReadDateFromRegistry : boolean;

begin

with ParamsConnectToServer do if OpenKey(key_str,true) then

begin

BaseInfo.NameHost := '';

BaseInfo.UserName := '';

BaseInfo.UserPass := '';

BaseInfo.Lang := '';

BaseInfo.NameHost := ReadString('ServerName');

BaseInfo.UserName := ReadString('UserName');

BaseInfo.UserPass := ReadString('Password');

BaseInfo.PathToBase := ReadString('PathToBase');

BaseInfo.Lang := ReadString('Lang');

if Length(BaseInfo.Lang) = 0 then BaseInfo.Lang := 'WIN1251';

CloseKey;

Result := true;

end else Result := false;

end;

//------------------------------------------------------------------------------

function TfSetupConnect.SaveDateToRegistry : boolean;

begin

Result := true;

ParamsConnectToServer.Access := KEY_ALL_ACCESS;

try

with ParamsConnectToServer do if OpenKey(key_str,true) then

begin

WriteString('ServerName',BaseInfo.NameHost);

WriteString('UserName',BaseInfo.UserName);

WriteString('Password',BaseInfo.UserPass);

WriteString('PathToBase',BaseInfo.PathToBase);

WriteString('Lang',BaseInfo.Lang);

CloseKey;

end;

except

Result := false;

end;

end;

//------------------------------------------------------------------------------

procedure TfSetupConnect.GetControlConnectData;

begin

with BaseInfo do

begin

PathToBase := cxBE_PathBase.Text;

if cxRG_SelectTypeServer.ItemIndex = 1 then NameHost := cxTE_NameSrv.Text else NameHost := '';

UserName := cxButEdt_UserName.Text;

BaseInfo.UserPass := cxButEdt_UserPass.Text;

end;

end;

//------------------------------------------------------------------------------

procedure TfSetupConnect.InitData;

var isRemoteHost : boolean;

begin

if not ReadDateFromRegistry then

begin

MsgError('Помилка читання налаштувань з реєстру.'#13#10'Зверніться до системного адміністратора.');

abort;

end;

isRemoteHost := Length(BaseInfo.NameHost)>0;

cxRG_SelectTypeServer.ItemIndex := Integer(isRemoteHost);

cxTE_NameSrv.Text := BaseInfo.NameHost;

cxBE_PathBase.Text := BaseInfo.PathToBase;

cxButEdt_UserName.Text := BaseInfo.UserName;

cxButEdt_UserPass.Text := BaseInfo.UserPass;

cxRG_SelectTypeServerPropertiesChange(self);

end;

//------------------------------------------------------------------------------

procedure TfSetupConnect.FormCreate(Sender: TObject);

begin

self.Caption := 'Опції підключення до сервера ' + QuotedStr(AppName);

with BaseInfo do

begin

NameHost := ''; UserName := ''; UserPass := ''; PathToBase := ''; Lang := '';

end;

with BaseInfoBkp do

begin

NameHost := ''; UserName := ''; UserPass := ''; PathToBase := ''; Lang := '';

end;

ParamsConnectToServer := TRegistry.Create;

ParamsConnectToServer.Access := KEY_READ;

ParamsConnectToServer.RootKey := HKey_Local_Machine;

end;

//------------------------------------------------------------------------------

procedure TfSetupConnect.FormDestroy(Sender: TObject);

begin

ParamsConnectToServer.Free;

end;

//------------------------------------------------------------------------------

procedure TfSetupConnect.FormActivate(Sender: TObject);

begin

InitData;

cxRG_SelectTypeServerPropertiesChange(Sender);

SaveBkpSettingsDb;

end;

//------------------------------------------------------------------------------

procedure TfSetupConnect.cxRG_SelectTypeServerPropertiesChange(Sender: TObject);

begin

cxTE_NameSrv.Enabled := (cxRG_SelectTypeServer.ItemIndex = 1);

cxBE_PathBase.Properties.Buttons[0].Enabled := not cxTE_NameSrv.Enabled;

end;

//------------------------------------------------------------------------------

procedure TfSetupConnect.cxBtn_TestClick(Sender: TObject);

begin

if CheckInputData then

begin

SaveBkpSettingsDb;

GetControlConnectData;

SetParamsDB;

db_Base.Open(false);

if db_Base.TestConnected then

begin

MsgInfo('Тестове підключення до серверу встановлено.');

db_Base.Close;

end else MsgError('Помилка підключення до серверу.');

RestoreBkpSettingsDb;

end;

end;

//------------------------------------------------------------------------------

procedure TfSetupConnect.FormClose(Sender: TObject; var Action: TCloseAction);

begin

if db_Base.Connected then db_Base.Close;

end;

//------------------------------------------------------------------------------

procedure TfSetupConnect.cxBt_CancelClick(Sender: TObject);

begin

if db_Base.Connected then db_Base.Close;

RestoreBkpSettingsDb;

end;

//------------------------------------------------------------------------------

procedure TfSetupConnect.cxBtn_OkClick(Sender: TObject);

begin

if db_Base.Connected then db_Base.Close;

if CheckInputData then

begin

SaveBkpSettingsDb;

GetControlConnectData;

SetParamsDB;

db_Base.Open(false);

if db_Base.TestConnected then

begin

db_Base.Close;

if not SaveDateToRegistry then

begin

MsgError('Помилка збереження налаштувань до реєстру.'#13#10'Зверніться до системного адміністратора');

RestoreBkpSettingsDb;

ModalResult := mrNone;

end;

end else begin

MsgError('Помилка підключення до серверу.');

RestoreBkpSettingsDb;

ModalResult := mrNone;

end;

end else ModalResult := mrNone;

end;

//------------------------------------------------------------------------------

procedure TfSetupConnect.cxBE_PathBasePropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);

begin

if OpenDialog.Execute then cxBE_PathBase.Text := OpenDialog.FileName;

end;

//------------------------------------------------------------------------------

procedure TfSetupConnect.cxButEdt_UserNamePropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);

begin

cxButEdt_UserName.Text := 'sysdba';

end;

//------------------------------------------------------------------------------

procedure TfSetupConnect.cxButEdt_UserPassPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);

begin

cxButEdt_UserPass.Text := 'masterkey';

end;

//------------------------------------------------------------------------------

end.

Размещено на Allbest.ru