Добавил:

korayakov Опубликованный материал нарушает ваши авторские права? Сообщите нам.

Вуз:

Национальный исследовательский университет «МИЭТ»

Предмет:

Дипломная работа (подготовка и защита)

Файл:

Shimarik / Shimarik / Приложения.doc

Скачиваний:

Добавлен:

16.04.2013

Размер:

637.44 Кб

Скачать

☆

1 / 41 2 3 4 > Следующая >>>

Приложения. Приложение 1.

Программа “Эксперт” состоит из пятидесяти четырех модулей. Ниже я приведу листинг основных модулей.

//Модуль экранной заставки

unit pictU;

interface

uses

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

ExtCtrls;

type

TfmPicture = class(TForm)

Image1: TImage;

Timer1: TTimer;

procedure Timer1Timer(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

fmPicture: TfmPicture;

implementation

uses Expert;

{$R *.DFM}

procedure TfmPicture.Timer1Timer(Sender: TObject);

begin

//Отключение таймера. Заставка исчезает и появляется основная форма

Timer1.Enabled:=false;

fmMain.Show;

end;

end.

//Модуль “Запрос пароля”

unit pass;

interface

uses

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

StdCtrls;

type

TfmPass = class(TForm)

Label1: TLabel;

ComboBox1: TComboBox;

Label2: TLabel;

Edit1: TEdit;

Button1: TButton;

Button2: TButton;

procedure Button2Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

//процедуры шифрования и расшифрования пароля

function Encrypt(const InString:string; StartKey,MultKey,AddKey:Integer): string;

function Decrypt(const InString:string; StartKey,MultKey,AddKey:Integer): string;

end;

var

fmPass: TfmPass;

implementation

uses Expert, DatesU, pworkU, directU;

{$R *.DFM}

{$R-}

{$Q-}

{*******************************************************

* Standard Encryption algorithm - Copied from Borland *

*******************************************************}

function TfmPass.Encrypt(const InString:string; StartKey,MultKey,AddKey:Integer): string;

var

I : Byte;

begin

Result := '';

for I := 1 to Length(InString) do

begin

Result := Result + CHAR(Byte(InString[I]) xor (StartKey shr 8));

StartKey := (Byte(Result[I]) + StartKey) * MultKey + AddKey;

end;

{*******************************************************

* Standard Decryption algorithm - Copied from Borland *

*******************************************************}

function TfmPass.Decrypt(const InString:string; StartKey,MultKey,AddKey:Integer): string;

var

I : Byte;

begin

Result := '';

for I := 1 to Length(InString) do

begin

Result := Result + CHAR(Byte(InString[I]) xor (StartKey shr 8));

StartKey := (Byte(InString[I]) + StartKey) * MultKey + AddKey;

end;

{$R+}

{$Q+}

procedure TfmPass.Button2Click(Sender: TObject);

begin

fmMain.NeedPass:=3;

Close;

end;

procedure TfmPass.Button1Click(Sender: TObject);

var i:integer;

begin

i:=0;

if ((ComboBox1.Text='Директор') and (Edit1.Text=Decrypt(fmMain.Param1, 14,13,12))) then

begin

i:=1;

fmMain.NeedPass:=1;

close;

end;

if ((ComboBox1.Text='Сотрудник') and (Edit1.Text=Decrypt(fmMain.Param2, 14,13,12))) then

begin

i:=1;

fmMain.NeedPass:=1;

fmDates.DBEdit2.Enabled:=false;

fmPWork.DBEdit6.Enabled:= false;

fmDirect.RichEdit1.Enabled:= false;

fmDirect.btnAddDate.Enabled:= false;

close;

end;

if i<>1 then ShowMessage('Проверьте правильность введенных данных');

end;

end.

//Модуль главной формы

unit Expert;

interface

uses

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

StdCtrls, Grids, DBGrids, ComCtrls, Menus, Buttons,Registry,printers;

type

TfmMain = class(TForm)

PageControl1: TPageControl;

TabSheet1: TTabSheet;

TabSheet2: TTabSheet;

DBGrid1: TDBGrid;

Label1: TLabel;

edFind: TEdit;

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

mnTemi: TMenuItem;

N4: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N9: TMenuItem;

N10: TMenuItem;

N11: TMenuItem;

N12: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

DBGrid2: TDBGrid;

Label2: TLabel;

edFind2: TEdit;

btnExit: TBitBtn;

tbnFirmaAbout: TBitBtn;

btnRabotiAbout: TBitBtn;

btnBeginWork: TBitBtn;

N13: TMenuItem;

N14: TMenuItem;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

BitBtn3: TBitBtn;

N15: TMenuItem;

Excel1: TMenuItem;

N16: TMenuItem;

N17: TMenuItem;

N18: TMenuItem;

N19: TMenuItem;

N20: TMenuItem;

N21: TMenuItem;

N22: TMenuItem;

N23: TMenuItem;

N25: TMenuItem;

N26: TMenuItem;

N24: TMenuItem;

Label3: TLabel;

Label4: TLabel;

N27: TMenuItem;

N30: TMenuItem;

N31: TMenuItem;

N32: TMenuItem;

N33: TMenuItem;

N34: TMenuItem;

PrintDialog1: TPrintDialog;

N35: TMenuItem;

edtHeaderFont1: TEdit;

FontDialog1: TFontDialog;

N36: TMenuItem;

procedure mnTemiClick(Sender: TObject);

procedure edFindChange(Sender: TObject);

procedure N9Click(Sender: TObject);

procedure N12Click(Sender: TObject);

procedure N4Click(Sender: TObject);

procedure N8Click(Sender: TObject);

procedure N5Click(Sender: TObject);

procedure edFind2Change(Sender: TObject);

procedure tbnFirmaAboutClick(Sender: TObject);

procedure N2Click(Sender: TObject);

procedure btnRabotiAboutClick(Sender: TObject);

procedure btnBeginWorkClick(Sender: TObject);

procedure N13Click(Sender: TObject);

procedure BitBtn1Click(Sender: TObject);

procedure BitBtn2Click(Sender: TObject);

procedure BitBtn3Click(Sender: TObject);

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

procedure N6Click(Sender: TObject);

procedure N14Click(Sender: TObject);

procedure Excel1Click(Sender: TObject);

procedure N17Click(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure N21Click(Sender: TObject);

procedure N22Click(Sender: TObject);

procedure N25Click(Sender: TObject);

procedure N26Click(Sender: TObject);

procedure btnExitClick(Sender: TObject);

procedure N24Click(Sender: TObject);

procedure N19Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure N27Click(Sender: TObject);

procedure N31Click(Sender: TObject);

procedure N33Click(Sender: TObject);

procedure N34Click(Sender: TObject);

procedure N35Click(Sender: TObject);

procedure N36Click(Sender: TObject);

procedure N11Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

{ Keeps track of vertical space in pixels, printed on a page }

AmountPrinted: integer;

{ Private declarations }

PixelsInInchx: integer;

LineHeight: Integer;

{ Number of pixels in 1/10 of an inch. This is used for line spacing }

TenthsOfInchPixelsY: integer;

NeedPass:integer;

ShablonDirectory:string[250]; //Директория с шаблонами

ServerName:string[100]; //Почтовый сервер

RegistrationName:string[100]; //Имя регистрации на почтовом сервере

adresfrom:string; //Email адрес Эксперта

LastClientBase:string[50]; //Последняя открытая база клиентов

LastPClientBase:string[50]; //последняя открытая база постоянных клиентов

param1:string[15];

param2:string[15];

//Процедура печати строк таблицы

procedure PrintLine(Items: TStringList);

//Печать заголовка таблицы

procedure PrintHeader(head:string);

//Печать заголовков столбцов таблицы

procedure PrintColumnNames;

end;

var

fmMain: TfmMain;

implementation

uses Pclientu, pworkU, TemiU, Modal1, pcadddog, SotrudnU, AboutU, rememU,

OptionsU, MessShow, CModul, ClientU, RegZayav, dogovorU, manageU, directU,

pictU, WorkersM, alarm, lastwork, FromExcU, pcreateU, creatcl, Modul3,

searchD, compsach, pass, sechz, statist;

{$R *.DFM}

procedure TfmMain.mnTemiClick(Sender: TObject);

begin

fmTemi.ShowModal;

end;

procedure TfmMain.edFindChange(Sender: TObject);

begin

//Поиск по названию организации в базах потенциальных клиентов

Modal.taPClient.FindNearest([edFind.Text]);

EdFind2.Text:=edFind.Text;

end;

procedure TfmMain.N9Click(Sender: TObject);

begin

fmWorkersShow.ShowModal;

end;

procedure TfmMain.N12Click(Sender: TObject);

begin

fmAbout.ShowModal;

end;

procedure TfmMain.N4Click(Sender: TObject);

begin

fmRemember.ShowModal;

end;

procedure TfmMain.N8Click(Sender: TObject);

begin

fmOptions.ShowModal;

end;

procedure TfmMain.N5Click(Sender: TObject);

begin

fmMailShow.ShowModal;

end;

procedure TfmMain.edFind2Change(Sender: TObject);

begin

//Поиск по названию организации в базе постоянных клиентов

Modul.taClient.FindNearest([edFind2.Text]);

edFind.Text:=edFind2.Text;

end;

procedure TfmMain.tbnFirmaAboutClick(Sender: TObject);

begin

fmPClient.ShowModal;

end;

procedure TfmMain.N2Click(Sender: TObject);

begin

fmManage.ShowModal;

end;

procedure TfmMain.btnRabotiAboutClick(Sender: TObject);

begin

fmPwork.ShowModal;

end;

procedure TfmMain.btnBeginWorkClick(Sender: TObject);

begin

fmNewPClient.ShowModal;

end;

procedure TfmMain.N13Click(Sender: TObject);

begin

fmdirect.ShowModal;

end;

procedure TfmMain.BitBtn1Click(Sender: TObject);

begin

fmClient.ShowModal;

end;

procedure TfmMain.BitBtn2Click(Sender: TObject);

begin

fmDogovor.ShowModal;

end;

procedure TfmMain.BitBtn3Click(Sender: TObject);

begin

fmRegZayav.ShowModal;

end;

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

var Reg: TRegistry;

begin

//Сохранение параметров в реестре

Reg := TRegistry.Create;

Reg.RootKey:= HKEY_LOCAL_MACHINE;

if Reg.OpenKey('\Software\ExpertProject\EParam', false)

then begin

Reg.WriteString('SMTP сервер',ServerName);

Reg.WriteString('Имя регистрации на почтовом сервере',RegistrationName);

Reg.WriteString('Каталог шаблонов',ShablonDirectory);

Reg.WriteString('База потенциальных клиентов',LastPClientBase);

Reg.WriteString('База постоянных клиентов',LastClientBase);

Reg.WriteString('Адрес отправителя',adresfrom);

end;

Reg.Free;

//Сохранение параметров в реестре

Reg := TRegistry.Create;

Reg.RootKey:= HKEY_LOCAL_MACHINE;

if Reg.OpenKey('\Software\Microsoft\EPr\Params', false)

then begin

fmPass.Encrypt(param1,14,13,12);

fmPass.Encrypt(param2,14,13,12);

Reg.WriteString('Параметр 1',param1);

Reg.WriteString('Параметр 2',param2);

End;

Reg.Free;

fmMain.Hide;

fmPicture.Close;

end;

procedure TfmMain.N6Click(Sender: TObject);

begin

fmAlarm.ShowModal;

end;

procedure TfmMain.N14Click(Sender: TObject);

begin

fmLastWork.ShowModal;

end;

procedure TfmMain.Excel1Click(Sender: TObject);

begin

fmFromExcel.ShowModal;

end;

procedure TfmMain.N17Click(Sender: TObject);

begin

close;

end;

procedure TfmMain.FormShow(Sender: TObject);

var Reg: TRegistry;

begin

fmPicture.Visible:=false;

//Считывание параметров из реестра

Reg := TRegistry.Create;

try

Reg.RootKey:= HKEY_LOCAL_MACHINE;

if Reg.KeyExists('\Software\ExpertProject\EParam')

then begin

Reg.OpenKey('\Software\ExpertProject\EParam', True);

ServerName:=Reg.ReadString('SMTP сервер');

RegistrationName:=Reg.ReadString('Имя регистрации на почтовом сервере');

ShablonDirectory:=Reg.ReadString('Каталог шаблонов');

LastPClientBase:=Reg.ReadString('База потенциальных клиентов');

LastClientBase:=Reg.ReadString('База постоянных клиентов');

adresfrom:=Reg.ReadString('Адрес отправителя');

end;

finally

Reg.closeKey;

Reg.Free;

//Считывание параметров из реестра

Reg := TRegistry.Create;

try

Reg.RootKey:= HKEY_LOCAL_MACHINE;

if Reg.KeyExists('\Software\ExpertProject\EParam')

then begin

Reg.OpenKey('\Software\Microsoft\Epr\Params', True);

param1:=Reg.ReadString('Параметр 1');

param2:=Reg.ReadString('Параметр 2');

End;

Reg.Free;

inherited;

end;

//ПЕРЕКЛЮЧЕНИЕ НА ПОСЛЕДНЮЮ ОТКРЫТУЮ БАЗУ///////////////////////////////////

//Постоян. клиенты

Modul.taClient.Close;

Modul.taClient2.Close;

Modul.taCMailLink.Close;

Modul.taCMLink.Close;

Modul.taCMail.Close;

Modul.taCMail2.Close;

Modul.taDogovor.Close;

Modul.taAddDogovor.Close;

Modul.taCWLink.Close;

Modul.taCWLink2.Close;

Modul.taSotrudnRemem.Close;

Modul.taCRaboti.Close;

Modul.taAddCRaboti.Close;

Modul.taCRemem.Close;

Modul.taAddZayav.Close;

Modul.taZayav.Close;

Modul2.taBases.First;

while not Modul2.taBases.eof do begin

if ((Modul2.taBases.FieldByName('BaseName').AsString=LastClientBase)

and (Modul2.taBases.FieldByName('FileType').Value=11)) then begin

Modul.taClient.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modul.taClient2.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

end;

if ((Modul2.taBases.FieldByName('BaseName').AsString=LastClientBase)

and (Modul2.taBases.FieldByName('FileType').Value=12)) then begin

Modul.taCMaillink.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modul.taCMLink.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

end;

if ((Modul2.taBases.FieldByName('BaseName').AsString=LastClientBase)

and (Modul2.taBases.FieldByName('FileType').Value=13)) then begin

Modul.taCMail.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modul.taCMail2.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

end;

if ((Modul2.taBases.FieldByName('BaseName').AsString=LastClientBase)

and (Modul2.taBases.FieldByName('FileType').Value=14)) then begin

Modul.taDogovor.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modul.taAddDogovor.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

end;

if ((Modul2.taBases.FieldByName('BaseName').AsString=LastClientBase)

and (Modul2.taBases.FieldByName('FileType').Value=15)) then begin

Modul.taCWLink.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modul.taCWLink2.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modul.taSotrudnRemem.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

end;

if ((Modul2.taBases.FieldByName('BaseName').AsString=LastClientBase)

and (Modul2.taBases.FieldByName('FileType').Value=16)) then begin

Modul.taCRaboti.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modul.taCRemem.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modul.taAddCRaboti.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

end;

if ((Modul2.taBases.FieldByName('BaseName').AsString=LastClientBase)

and (Modul2.taBases.FieldByName('FileType').Value=17)) then begin

Modul.taZayav.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modul.taAddZayav.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

end;

Modul2.taBases.Next;

end;

Modul.taClient.Open;

Modul.taClient2.Open;

Modul.taCMailLink.Open;

Modul.taCMLink.Open;

Modul.taCMail.Open;

Modul.taDogovor.Open;

Modul.taAddDogovor.Open;

Modul.taCWLink.Open;

Modul.taCWLink2.Open;

Modul.taCRaboti.Open;

Modul.taAddCRaboti.Open;

Modul.taAddZayav.Open;

Modul.taZayav.Open;

//Потенц. клиенты

Modal.taPClient.Close;

Modal.taPClient2.Close;

Modal.taPDogovor.Close;

Modal.taAddDogovor.Close;

Modal.taRabota.Close;

Modal.taAddRabota.Close;

Modal.taRemem.Close;

Modal.taRemSotrudn.Close;

Modal.taWLink.Close;

Modal.taWLink2.Close;

Modal.taMail.Close;

Modal.taMail2.Close;

Modal.taMailLink.Close;

Modal.taMailLinkAdd.Close;

Modal.taMLink.Close;

Modul2.taBases.First;

while not Modul2.taBases.eof do begin

if ((Modul2.taBases.FieldByName('BaseName').AsString=LastPClientBase)

and (Modul2.taBases.FieldByName('FileType').Value=1)) then begin

Modal.taPClient.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modal.taPClient2.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

end;

if ((Modul2.taBases.FieldByName('BaseName').AsString=LastPClientBase)

and (Modul2.taBases.FieldByName('FileType').Value=2)) then begin

Modal.taMaillink.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modal.taMLink.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modal.taMaillinkAdd.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

end;

if ((Modul2.taBases.FieldByName('BaseName').AsString=LastPClientBase)

and (Modul2.taBases.FieldByName('FileType').Value=3)) then begin

Modal.taMail.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modal.taMail2.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

end;

if ((Modul2.taBases.FieldByName('BaseName').AsString=LastPClientBase)

and (Modul2.taBases.FieldByName('FileType').Value=4)) then begin

Modal.taPDogovor.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modal.taAddDogovor.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

end;

if ((Modul2.taBases.FieldByName('BaseName').AsString=LastPClientBase)

and (Modul2.taBases.FieldByName('FileType').Value=5)) then begin

Modal.taWLink.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modal.taWLink2.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modal.taRemSotrudn.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

end;

if ((Modul2.taBases.FieldByName('BaseName').AsString=LastPClientBase)

and (Modul2.taBases.FieldByName('FileType').Value=6)) then begin

Modal.taRabota.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modal.taRemem.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modal.taAddRabota.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

end;

Modul2.taBases.Next;

end;

Modal.taPClient.Open;

Modal.taPDogovor.Open;

Modal.taRabota.Open;

Modal.taAddRabota.Open;

Modal.taWLink.Open;

Modal.taWLink2.Open;

Modal.taMail.Open;

Modal.taMail2.Open;

Modal.taMailLink.Open;

Modal.taMailLinkAdd.Open;

Modal.taMLink.Open;

Label3.Caption:=LastPClientBase;

Label4.Caption:=LastClientBase;

end;

procedure TfmMain.N21Click(Sender: TObject);

begin

N21.Checked:=true;

Label1.Caption:='Поиск по названию организации';

Label2.Caption:='Поиск по названию организации';

//Переключение индексов для поиска

Modal.taPclient.IndexName:='company_ind';

Modul.taClient.IndexName:='company_ind';

edFind.clear;

edFind2.clear;

end;

procedure TfmMain.N22Click(Sender: TObject);

begin

N22.Checked:=true;

//Переключение индексов для поиска

Label1.Caption:='Поиск по имени контактного лица';

Label2.Caption:='Поиск по имени контактного лица';

Modal.taPClient.IndexName:='director_ind';

Modul.taClient.IndexName:='director_ind';

edFind.clear;

edFind2.clear;

end;

procedure TfmMain.N25Click(Sender: TObject);

begin

fmPCreateBase.ShowModal;

end;

procedure TfmMain.N26Click(Sender: TObject);

begin

fmCCreateBase.ShowModal;

end;

procedure TfmMain.btnExitClick(Sender: TObject);

begin

FormClose(Sender);

end;

procedure TfmMain.N24Click(Sender: TObject);

begin

fmSearchDog.ShowModal;

end;

procedure TfmMain.N19Click(Sender: TObject);

begin

fmCompSearch.ShowModal;

end;

procedure TfmMain.FormCreate(Sender: TObject);

begin

NeedPass:=0;

end;

procedure TfmMain.PrintLine(Items: TStringList);

var

OutRect: TRect;

Inches: double;

i: integer;

SaveFont: TFont;

begin

SaveFont := TFont.Create;

try

Savefont.Assign(Printer.Canvas.Font);

Printer.Canvas.Font.Assign(edtHeaderFont1.Font);

// First position the print rect on the print canvas

OutRect.Left := 0;

OutRect.Top := AmountPrinted;

OutRect.Bottom := OutRect.Top + LineHeight;

With Printer.Canvas do

for i := 0 to Items.Count - 1 do

begin

Inches := longint(Items.Objects[i]) * 0.1;

// Determine Right edge

OutRect.Right := OutRect.Left + round(PixelsInInchx*Inches);

if not Printer.Aborted then

// Print the line

TextRect(OutRect, OutRect.Left, OutRect.Top, Items[i]);

// Adjust right edge

OutRect.Left := OutRect.Right;

end;

{ As each line prints, AmountPrinted must increase to reflect how

much of a page has been printed on based on the line height. }

AmountPrinted := AmountPrinted + TenthsOfInchPixelsY*2;

finally

SaveFont.Free;

end;

procedure TfmMain.PrintHeader(head:string);

var

SaveFont: TFont;

begin

{ Save the current printer's font, then set a new print font based

on the selection for Edit1 }

SaveFont := TFont.Create;

try

Savefont.Assign(Printer.Canvas.Font);

Printer.Canvas.Font.Assign(edtHeaderFont1.Font);

// First print out the Header

with Printer do

begin

if not Printer.Aborted then

Canvas.TextOut((PageWidth div 2)-(Canvas.TextWidth(edtHeaderFont1.Text)

div 2),0, 'База: '+head);

// Increment AmountPrinted by the LineHeight

AmountPrinted := AmountPrinted + LineHeight+TenthsOfInchPixelsY;

end;

// Restore the old font to the Printer's Canvas property

Printer.Canvas.Font.Assign(SaveFont);

finally

SaveFont.Free;

end;

procedure TfmMain.PrintColumnNames;

var

ColNames: TStringList;

begin

{ Create a TStringList to hold the column names and the

positions where the width of each column is based on values

in the TEdit controls. }

ColNames := TStringList.Create;

try

// Print the column headers using a bold/underline style

Printer.Canvas.Font.Style := [fsBold, fsUnderline];

with ColNames do

begin

// Store the column headers and widths in the TStringList object

AddObject('N', pointer(5));

AddObject('Название организации', pointer(25));

AddObject('Телефон', pointer(15));

AddObject('Факс', pointer(15));

AddObject('Контактное лицо', pointer(25));

end;

PrintLine(ColNames);

Printer.Canvas.Font.Style := [];

finally

ColNames.Free; // Free the column name TStringList instance

end;

procedure TfmMain.FormActivate(Sender: TObject);

begin

if NeedPass=0

then begin

fmPass.ShowModal;

if NeedPass=3 then fmPicture.Close; //отмена идентификации

end;

procedure TfmMain.N27Click(Sender: TObject);

begin

fmSearchZayav.ShowModal;

end;

procedure TfmMain.N31Click(Sender: TObject);

begin

PrintDialog1.Execute;

end;

procedure TfmMain.N33Click(Sender: TObject);

var

Items: TStringList;

i:integer;

begin

{ Create a TStringList instance to hold the fields and the widths

of the columns in which they'll be drawn based on the entries in

the edit controls }

Items := TStringList.Create;

i:=1;

try

// Determine pixels per inch horizontally

PixelsInInchx := GetDeviceCaps(Printer.Handle, LOGPIXELSX);

TenthsOfInchPixelsY := GetDeviceCaps(Printer.Handle,

LOGPIXELSY) div 7;

AmountPrinted := 0;

fmMain.Enabled := false; // Disable the parent form

try

Printer.BeginDoc;

Application.ProcessMessages;

{ Calculate the line height based on text height using the

currently rendered font }

LineHeight := Printer.Canvas.TextHeight('X')+TenthsOfInchPixelsY;

PrintHeader(LastClientBase);

PrintColumnNames;

////ПЕЧАТЬ ////////////////////////////////////

Modul.taClient.First;

{ Store each field value in the TStringList as well as its

column width }

while (not Modul.taClient.Eof) or Printer.Aborted do

begin

Application.ProcessMessages;

with Items do

begin

AddObject(IntToStr(i),pointer(5));

AddObject(Modul.taClient.FieldByName('NameSearch').AsString,

pointer(25));

AddObject(Modul.taClient.FieldByName('Thone').AsString,

pointer(15));

AddObject(Modul.taClient.FieldByName('Fax').AsString,

pointer(15));

AddObject(Modul.taClient.FieldByName('Director').AsString,

pointer(25));

i:=i+1;

end; //with Items do

PrintLine(Items);

{ Force print job to begin a new page if printed output has

exceeded page height }

if AmountPrinted + LineHeight > Printer.PageHeight then

begin

AmountPrinted := 0;

if not Printer.Aborted then

Printer.NewPage;

PrintHeader(LastClientBase);

PrintColumnNames;

end; //if AmountPrinted + LineHeight > Printer.PageHeight then

Items.Clear;

Modul.taClient.Next;

end; //while (not Modul.taClient.Eof) or Printer.Aborted

///////////////////////////////////////////////////////////

if not Printer.Aborted then

Printer.EndDoc;

finally // try Printer.BeginDoc;

fmMain.Enabled := true;

end;

finally

Items.Free;

end;

procedure TfmMain.N34Click(Sender: TObject);

var

Items: TStringList;

i:integer;

begin

{ Create a TStringList instance to hold the fields and the widths

of the columns in which they'll be drawn based on the entries in

the edit controls }

Items := TStringList.Create;

try

// Determine pixels per inch horizontally

PixelsInInchx := GetDeviceCaps(Printer.Handle, LOGPIXELSX);

TenthsOfInchPixelsY := GetDeviceCaps(Printer.Handle,

LOGPIXELSY) div 7;

AmountPrinted := 0;

fmMain.Enabled := false; // Disable the parent form

try

Printer.BeginDoc;

i:=1;

Application.ProcessMessages;

{ Calculate the line height based on text height using the

currently rendered font }

LineHeight := Printer.Canvas.TextHeight('X')+TenthsOfInchPixelsY;

PrintHeader(LastPClientBase);

PrintColumnNames;

////ПЕЧАТЬ ////////////////////////////////////

Modal.taPClient.First;

{ Store each field value in the TStringList as well as its

column width }

while (not Modal.taPClient.Eof) or Printer.Aborted do

begin

Application.ProcessMessages;

with Items do

begin

AddObject(IntToStr(i),pointer(5));

AddObject(Modal.taPClient.FieldByName('NameSearch').AsString,

pointer(25));

AddObject(Modal.taPClient.FieldByName('Thone').AsString,

pointer(15));

AddObject(Modal.taPClient.FieldByName('Fax').AsString,

pointer(15));

AddObject(Modal.taPClient.FieldByName('Director').AsString,

pointer(25));

i:=i+1;

end; //with Items do

PrintLine(Items);

{ Force print job to begin a new page if printed output has

exceeded page height }

if AmountPrinted + LineHeight > Printer.PageHeight then

begin

AmountPrinted := 0;

if not Printer.Aborted then

Printer.NewPage;

PrintHeader(LastClientBase);

PrintColumnNames;

end; //if AmountPrinted + LineHeight > Printer.PageHeight then

Items.Clear;

Modal.taPClient.Next;

end; //while (not Modul.taClient.Eof) or Printer.Aborted

///////////////////////////////////////////////////////////

if not Printer.Aborted then

Printer.EndDoc;

finally // try Printer.BeginDoc;

fmMain.Enabled := true;

end;

finally

Items.Free;

end;

procedure TfmMain.N35Click(Sender: TObject);

begin

{ Assign the font selected with FontDialog1 to Edit1. }

FontDialog1.Font.Assign(edtHeaderFont1.Font);

if FontDialog1.Execute then

edtHeaderFont1.Font.Assign(FontDialog1.Font);

end;

procedure TfmMain.N36Click(Sender: TObject);

begin

fmStat.ShowModal;

end;

procedure TfmMain.N11Click(Sender: TObject);

begin

Application.HelpFile := 'Справка.hlp';

Application.HelpCommand(HELP_FINDER, 0);

end;

end.

//Модуль “Работа с потенциальными клиентами”

unit pworkU;

interface

uses

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

StdCtrls, Mask, DBCtrls, Grids, DBGrids, ExtCtrls, Menus, Buttons;

type

TfmPwork = class(TForm)

Label1: TLabel;

DBGrid1: TDBGrid;

Label2: TLabel;

DBGrid2: TDBGrid;

Label4: TLabel;

btnDotrudn: TButton;

Label6: TLabel;

DBEdit4: TDBEdit;

Label7: TLabel;

DBEdit5: TDBEdit;

DBEdit6: TDBEdit;

DBEdit7: TDBEdit;

DBNavigator1: TDBNavigator;

Edit1: TEdit;

MainMenu1: TMainMenu;

N1: TMenuItem;

mnPutDates: TMenuItem;

btnClose: TBitBtn;

btnToClient: TBitBtn;

N3: TMenuItem;

mnClose: TMenuItem;

N5: TMenuItem;

mnDel: TMenuItem;

procedure btnCloseClick(Sender: TObject);

procedure btnDotrudnClick(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure DBGrid1CellClick(Column: TColumn);

procedure DBGrid1KeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure mnPutDatesClick(Sender: TObject);

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

procedure mnCloseClick(Sender: TObject);

procedure mnDelClick(Sender: TObject);

procedure btnToClientClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

procedure WorkersDraw;

end;

var

fmPwork: TfmPwork;

implementation

uses Modal1, SotrudnU, CModul;

{$R *.DFM}

//Процедура вывода в поля вывода ответсвенных сотрудников

procedure TfmPwork.WorkersDraw;

var i:integer;

begin

Edit1.Text:=' ';

Modal.taWLink2.Open;

Modal.taWLink2.First;

for i:=1 to Modal.taWLink2.RecordCount do begin

if Edit1.Text[Pos(Modal.taWLink2.FieldByName('WorkerName').AsString, Edit1.Text)]='' then

Edit1.Text:=Edit1.Text+Modal.taWLink2.FieldByName('WorkerName').AsString+' ';

Modal.taWLink2.Next;

end;

procedure TfmPwork.btnCloseClick(Sender: TObject);

begin

Close;

end;

procedure TfmPwork.btnDotrudnClick(Sender: TObject);

begin

fmWorkers.ShowModal;

end;

procedure TfmPwork.FormShow(Sender: TObject);

begin

WorkersDraw;

fmPWork.Caption:='О работах с '+Modal.taPclient.FieldByName('CompanyName').AsString;

end;

procedure TfmPwork.DBGrid1CellClick(Column: TColumn);

begin

WorkersDraw;

end;

procedure TfmPwork.DBGrid1KeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

FormShow(Sender);

end;

//Процедура автоматической простановки дат

procedure TfmPwork.mnPutDatesClick(Sender: TObject);

var LastDate:TDate;

i:integer;

begin

for i:=Modal.taRabota.RecNo to Modal.taRabota.RecordCount-1 do begin

LastDate:= Modal.taRabota.FieldByName('DatePlan').Value;

Modal.taRabota.Next;

//Смотрим указано ли к-во дней до этой работы

Modal.taRaboti2.Open;

Modal.taRaboti2.FindKey([Modal.taRabota.FieldByName('Rabota_ID').Value]);

if Modal.taRaboti2.FieldByName('DayNumber').Value<>0

then begin

Modal.taRabota.Edit;

Modal.taRabota.FieldByName('DatePlan').Value:=LastDate+Modal.taRaboti2.FieldByName('DayNumber').Value;

Modal.taRabota.Post;

end

else break;

end;

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

begin

Modal.taRaboti2.Close;

end;

procedure TfmPwork.mnCloseClick(Sender: TObject);

begin

Close;

end;

//Каскадное удаление данных о работах из таблиц

procedure TfmPwork.mnDelClick(Sender: TObject);

begin

if Application.MessageBox('Вы действительно хотите удалить информацию о предварительной заявке?',

'Подтвердите удаление базы',MB_YESNO + MB_ICONQUESTION) = IDYES

then begin

//Удаление всех работ, назначееных исполнителям

Modal.taWLink2.First;

while not Modal.taWLink2.Eof do Modal.taWLink2.Delete;

if Modal.taWLink.Active=true then Modal.taWLink.Refresh;

if Modal.taRemSotrudn.Active=true then Modal.taRemSotrudn.Refresh;

//Удаление всех работ по предварит. заявке

Modal.taRabota.First;

while not Modal.taRabota.Eof do Modal.taRabota.Delete;

if Modal.taRemem.Active=true then Modal.taRemem.Refresh;

if Modal.taAddRabota.Active=true then Modal.taAddRabota.Refresh;

//Удаляем предв. заявку

Modal.taPDogovor.Delete;

if Modal.taPDogovor.RecordCount=0 then Edit1.Clear

else WorkersDraw;

end;

//Процедура перевода потенциального клиента в разряд постоянных

procedure TfmPwork.btnToClientClick(Sender: TObject);

begin

Modul.taClient.Insert;

Modul.taClient.FieldByName('CompanyName').Value:=Modal.taPClient.FieldByName('CompanyName').Value;

Modul.taClient.FieldByName('NameSearch').Value:=Modal.taPClient.FieldByName('NameSearch').Value;

Modul.taClient.FieldByName('Adres').Value:=Modal.taPClient.FieldByName('Adres').Value;

Modul.taClient.FieldByName('Director').Value:=Modal.taPClient.FieldByName('Director').Value;

Modul.taClient.FieldByName('EMail').Value:=Modal.taPClient.FieldByName('EMail').Value;

Modul.taClient.FieldByName('Thone').Value:=Modal.taPClient.FieldByName('Thone').Value;

Modul.taClient.FieldByName('Fax').Value:=Modal.taPClient.FieldByName('Fax').Value;

Modul.taClient.FieldByName('Type').Value:=Modal.taPClient.FieldByName('Type').Value;

Modul.taClient.FieldByName('Comments').Value:=Modal.taPClient.FieldByName('Comments').Value;

Modul.taClient.FieldByName('CManage').Value:=Modal.taPClient.FieldByName('CManage').Value;

Modul.taClient.FieldByName('Manage').Value:=Modal.taPClient.FieldByName('Manage').Value;

Modul.taClient.FieldByName('CDoljnost').Value:=Modal.taPClient.FieldByName('CDoljnost').Value;

Modul.taClient.FieldByName('Doljnost').Value:=Modal.taPClient.FieldByName('Doljnost').Value;

Modul.taClient.FieldByName('COtrasl').Value:=Modal.taPClient.FieldByName('COtrasl').Value;

Modul.taClient.FieldByName('Otrasl').Value:=Modal.taPClient.FieldByName('Otrasl').Value;

Modul.taClient.Post;

end;

end.

//Модуль “Поиск заявки”

unit sechz;

interface

uses

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

Buttons, StdCtrls;

type

TfmSearchZayav = class(TForm)

Label1: TLabel;

Edit1: TEdit;

Button3: TButton;

Label2: TLabel;

Edit2: TEdit;

BitBtn1: TBitBtn;

Button1: TButton;

procedure BitBtn1Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

ss3:string;

ss4:string;

procedure DogovorSearch(n:string;str:string);

procedure CompanySearch(m:integer; str:string;n:string);

end;

var

fmSearchZayav: TfmSearchZayav;

implementation

uses Modul3, compsach, Modal1, CModul;

{$R *.DFM}

procedure TfmSearchZayav.BitBtn1Click(Sender: TObject);

begin

close;

end;

procedure TfmSearchZayav.CompanySearch(m:integer; str:string; n:string);

begin

Modul2.taBases.First;

//Ищем нужную базу

while not Modul2.taBases.eof do begin

if str=Modul2.taBases.FieldByName('BaseName').AsString then break;

Modul2.taBases.Next;

end;

while not Modul2.taBases.eof do begin

if ((Modul2.taBases.FieldByName('FileType').AsString='1')

or (Modul2.taBases.FieldByName('FileType').AsString='11'))

then begin

Modul2.taSearch.close;

Modul2.taSearch.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modul2.taSearch.IndexName:='';

Modul2.taSearch.Open;

if ((Modul2.taSearch.FindKey([m])=true) and (str=Modul2.taBases.FieldByName('BaseName').AsString)) //организация найдена

then begin

ss4:=Modul2.taSearch.FieldByName('NameSearch').AsString;

Edit2.Text:=Edit2.Text+'\'+Modul2.taSearch.FieldByName('NameSearch').AsString+'\'+n;

Modul2.taSearch.IndexName:='';

break;

end

else Edit2.Text:='нет такой заявки';

Modul2.taSearch.Close;

end;

Modul2.taBases.Next;

end;

procedure TfmSearchZayav.DogovorSearch(n:string;str:string);

begin

Modul2.taBases.First;

//Ищем нужную базу

while not Modul2.taBases.eof do begin

if str=Modul2.taBases.FieldByName('BaseName').AsString then break;

Modul2.taBases.Next;

end;

//ищем нужный файл с договорами

while not Modul2.taBases.eof do begin

if Modul2.taBases.FieldByName('FileType').AsString='14'

then begin

Modul2.taSearch.close;

Modul2.taSearch.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modul2.taSearch.IndexName:='';

Modul2.taSearch.Open;

//ищем в нем нужный номер договора

if ((Modul2.taSearch.FindKey([n])=true) and (str=Modul2.taBases.FieldByName('BaseName').AsString)) //договор найден

then begin

ss3:=Modul2.taBases.FieldByName('BaseName').AsString;

//ищем теперь компанию

CompanySearch(Modul2.taSearch['Company_ID'],Modul2.taBases.FieldByName('BaseName').AsString,n);

break;

end;

Modul2.taSearch.Close;

end;

Modul2.taBases.Next;

end;

procedure TfmSearchZayav.Button3Click(Sender: TObject);

begin

Modul2.taSearch.close;

Modul2.taBases.First;

while not Modul2.taBases.eof do begin

if Modul2.taBases.FieldByName('FileType').AsString='17'

then begin

Modul2.taSearch.TableName:=Modul2.taBases.FieldByName('FileName').AsString;

Modul2.taSearch.IndexName:='zayav_ind';

Modul2.taSearch.Open;

if Modul2.taSearch.FindKey([Edit1.Text])=true //договор найден

then begin

//Ищем название организации

Modul2.taSearch.IndexName:=' ';

Edit2.Text:=Modul2.taBases.FieldByName('BaseName').AsString;

DogovorSearch(Modul2.taSearch['Dogovor'],Modul2.taBases.FieldByName('BaseName').AsString);

break;

end;

Modul2.taSearch.Close;

end;

Modul2.taBases.Next;

end;

ShowMessage('Поиск завершен');

end;

procedure TfmSearchZayav.Button1Click(Sender: TObject);

begin

if Edit2.Text<>'' then begin

fmCompSearch.CClientOpen(ss3);

fmCompSearch.PClientOpen(ss3);

//Поиск по названию организации в базах потенциальных клиентов

Modal.taPClient.FindNearest([ss4]);

Modul.taClient.FindNearest([ss4]);

end;

end.

1 / 41 2 3 4 > Следующая >>>

Соседние файлы в папке Shimarik

#
16.04.2013136 б13О дипломе.txt
#
16.04.201322.02 Кб16Отзыв.doc
#
16.04.201332.77 Кб14План работы на преддипломную практику.doc
#
16.04.201350.69 Кб15План работы над пояснительной запиской.doc
#
16.04.201328.16 Кб13План работы по дипломному проектированию.doc
#
16.04.2013637.44 Кб14Приложения.doc
#
16.04.201319.46 Кб15ПЭБ титул.doc
#
16.04.20131.9 Mб23Специальная часть.doc
#
16.04.201339.42 Кб15Техническое задание.doc
#
16.04.201320.99 Кб15Титульный лист.doc
#
16.04.201319.46 Кб13Экономика титул.doc