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;

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;

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;

end;

procedure TfmMain.FormActivate(Sender: TObject);

begin

if NeedPass=0

then begin

fmPass.ShowModal;

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

end;

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;

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;

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;