Главный модуль программы

unit Unit2;

{$mode objfpc}{$H+}

interface

uses

Classes, SysUtils, FileUtil, TAGraph, TASeries, Forms, Controls, Graphics,

Dialogs, Menus, StdCtrls, Grids, ExtCtrls, ComCtrls;

type

{ TForm2 }

TForm2 = class(TForm)

Button1: TButton;

Button2: TButton;

Button3: TButton;

DeleteBaton: TButton;

Chart1: TChart;

Chart1PieSeries1: TPieSeries;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Edit4: TEdit;

FontDialog1: TFontDialog;

GroupBox1: TGroupBox;

GroupBox2: TGroupBox;

ImageList1: TImageList;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

MainMenu1: TMainMenu;

MenuItem1: TMenuItem;

MenuItem11: TMenuItem;

MenuItem12: TMenuItem;

MenuItem13: TMenuItem;

MenuItem14: TMenuItem;

MenuItem15: TMenuItem;

MenuItem16: TMenuItem;

MenuItem17: TMenuItem;

MenuItem2: TMenuItem;

MenuItem4: TMenuItem;

MenuItem5: TMenuItem;

MenuItem6: TMenuItem;

MenuItem7: TMenuItem;

MenuItem8: TMenuItem;

MenuItem9: TMenuItem;

OpenDialog1: TOpenDialog;

PopupGrid: TPopupMenu;

PopupEdits: TPopupMenu;

PopupGrid2: TPopupMenu;

SaveDialog1: TSaveDialog;

StringGrid1: TStringGrid;

StringGrid2: TStringGrid;

ToolBar1: TToolBar;

ToolButton1: TToolButton;

ToolButton2: TToolButton;

ToolButton3: TToolButton;

ToolButton4: TToolButton;

ToolButton5: TToolButton;

ToolButton6: TToolButton;

ToolButton7: TToolButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure DeleteBatonClick(Sender: TObject);

procedure Edit1KeyPress(Sender: TObject; var Key: char);

procedure Edit2KeyPress(Sender: TObject; var Key: char);

procedure Edit3KeyPress(Sender: TObject; var Key: char);

procedure Edit4KeyPress(Sender: TObject; var Key: char);

procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);

procedure FormCreate(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure GroupBox1Click(Sender: TObject);

procedure MenuItem10Click(Sender: TObject);

procedure MenuItem11Click(Sender: TObject);

procedure MenuItem12Click(Sender: TObject);

procedure MenuItem13Click(Sender: TObject);

procedure MenuItem14Click(Sender: TObject);

procedure MenuItem15Click(Sender: TObject);

procedure MenuItem16Click(Sender: TObject);

procedure MenuItem17Click(Sender: TObject);

procedure MenuItem2Click(Sender: TObject);

procedure MenuItem3Click(Sender: TObject);

procedure MenuItem4Click(Sender: TObject);

procedure MenuItem6Click(Sender: TObject);

procedure MenuItem7Click(Sender: TObject);

procedure MenuItem8Click(Sender: TObject);

procedure MenuItem9Click(Sender: TObject);

procedure PopupGridPopup(Sender: TObject);

procedure StringGrid1Click(Sender: TObject);

procedure ToolButton1Click(Sender: TObject);

procedure ToolButton3Click(Sender: TObject);

procedure ToolButton5Click(Sender: TObject);

procedure ToolButton7Click(Sender: TObject);

private

{ private declarations }

public

{ public declarations }

end;

var

Form2: TForm2;

a,Nomer,MTP,balance,ostatok,k, i,j:integer;

STable1:TextFile;

s,FileLocation:string;

implementation

uses Unit3;

{$R *.lfm}

{ TForm2 }

function StringIsNumber(Data:String): Boolean;

var start, i: Integer;

res: Boolean;

begin

res:= true;

if Length(Data) = 0

then res:= false

else

begin

start:= 1;

if (Data[start] = '-')

then start:= 2;

for i:= start to Length(Data) do

begin

if not (Data[i] in ['0'..'9'])

then

begin

res:= false;

break;

end;

end;

end;

Result:= res;

end;

procedure Grafik (SG:TStringGrid; res: TPieSeries);

var neg,pos1:integer;

begin

neg:=0;

pos1:=0;

for i:=1 to SG.RowCount-1 do

if strtoint(SG.cells[3,i])<40 then

inc(neg) else

inc(pos1);

if pos1+neg>0 then

With res do

begin

Clear;

Add(pos1,'Нет долгов',clYellow);

Add(neg,'Имеется долг',clBlue);

end;

end;

procedure spisok(SG:TStringGrid);

var

row:integer;

ind,nomer,MTP,balance,ost,s:string;

begin

row:=SG.row;

ind:='Выделен абонент с номером: '+SG.cells[0,row]+#13#10+#13#10;

nomer:='Номер телефона: ' + SG.cells[0,row]+#13#10;

MTP:='Расходы на МТР: ' +SG.cells[1,row]+' р'+#13#10;

balance:='Внесённая сумма: ' +SG.cells[2,row]+' р'+#13#10;

ost:='Остаток на счёте: ' +SG.cells[3,row]+' р'+#13#10;

s:=ind+nomer+MTP+balance+ost;

ShowMessage(s);

end;

procedure AddNumber(FileName:String; NewLine:String);

var OTable1: TextFile;

begin

AssignFile(OTable1, FileName);

Append(OTable1);

Writeln(OTable1, NewLine);

CloseFile(OTable1);

end;

procedure ReplaceNumber(FileName:String; Position:Integer; NewLine:String);

var i: Integer;

OTable1: TextFile;

NewText, OldLine: String;

begin

AssignFile(OTable1, FileName);

Reset(OTable1);

i:= 0;

NewText:= '';

while not eof (OTable1) do

begin

Readln(OTable1, OldLine);

if i = Position

then NewText:= NewText + NewLine + #13#10

else NewText:= NewText + OldLine + #13#10;

inc(i);

end;

CloseFile(OTable1);

Rewrite(OTable1);

Write(OTable1, NewText);

CloseFile(OTable1);

end;

function CheckNumber(FileName:String; Phone:String): Integer;

var position, i: Integer;

OTable1: TextFile;

strTemp: String;

List: TStrings;

begin

AssignFile(OTable1, FileName);

Reset(OTable1);

i:= -1;

position:= -1;

while not eof (OTable1) do

begin

Readln(OTable1, strTemp);

List:= TStringList.Create;

ExtractStrings(['|'], [], PChar(strTemp), List);

inc(i);

if List.Count > 0

then

if List[0] = Phone

then

begin

position:= i;

break;

end;

end;

CloseFile(OTable1);

Result:= position;

end;

procedure DeleteNumber(FileName:String; Position:Integer);

var i: Integer;

OTable1: TextFile;

NewText, OldLine: String;

begin

AssignFile(OTable1, FileName);

Reset(OTable1);

i:= 0;

NewText:= '';

while not eof (OTable1) do

begin

Readln(OTable1, OldLine);

if i <> Position

then NewText:= NewText + OldLine + #13#10;

inc(i);

end;

CloseFile(OTable1);

Rewrite(OTable1);

Write(OTable1, NewText);

CloseFile(OTable1);

end;

function LoadDataInGrid(FileName:String; SG: TStringGrid): Boolean;

var i, k, t: Integer;

OTable1: TextFile;

strTemp: String;

List: TStrings;

res: Boolean;

begin

res:=true;

AssignFile(OTable1, FileName);

k:= 1;

Reset(OTable1);

while not eof (OTable1) do

begin

Readln(OTable1, strTemp);

if strTemp <> '' then

begin

List:= TStringList.Create;

ExtractStrings(['|'], [], PChar(strTemp), List);

if List.Count < 4

then res:= false

else

begin

for t:= 1 to 3 do

if not StringIsNumber(List[t])

then

begin

res:= false;

break; // конец цикла for t:= 1 to 3 do

end;

end;

if res

then

begin

if k > SG.RowCount - 1

then SG.RowCount:= k + 1;

for i:= 0 to 3 do

SG.Cells[i, k]:= List[i];

inc(k);

end

else

break; // конец цикла while not eof (OTable1) do

end;

end;

CloseFile(OTable1);

Result:= res;

end;

procedure TForm2.Button1Click(Sender: TObject);

var AddInGrid: boolean;

currentRow, i, pos: integer;

begin

if (Edit1.Text = '') or (Edit2.Text = '') or (Edit3.Text = '')

then MessageDLG('Заполните все поля!', mtWarning, [mbOK], 0)

else

begin

AddInGrid:= true;

balance:= StrToInt(Edit3.text);

MTP:= StrToInt(Edit2.Text);

ostatok:= balance - MTP;

s:= Edit1.Text + '|' + Edit2.text + '|' + Edit3.text + '|' + IntToStr(ostatok);

if FileExists(WideString(Utf8ToSys(FileLocation)))

then pos:= CheckNumber(WideString(Utf8ToSys(FileLocation)), Edit1.Text)

else pos:= -1;

if pos >= 0

then

begin

if MessageDlg('Такой номер уже есть в базе, заменить его?',mtInformation,[mbYes, mbNo],0)=mrYes

then

begin

for i:= 1 to StringGrid1.RowCount - 1 do

begin

if StringGrid1.Cells[0, i] = Edit1.text

then

begin

currentRow:=i;

break;

end;

end;

ReplaceNumber(WideString(Utf8ToSys(FileLocation)), pos, s);

Grafik(StringGrid1,Chart1PieSeries1);

end

else

AddInGrid:=false;

end

else

begin

currentRow:=StringGrid1.RowCount; StringGrid1.RowCount:=currentRow + 1;

AddNumber(WideString(Utf8ToSys(FileLocation)), s);

end;

if AddInGrid

then

begin

StringGrid1.Cells[0, currentRow]:=Edit1.text;

StringGrid1.Cells[1, currentRow]:=Edit2.text;

StringGrid1.Cells[2, currentRow]:=Edit3.text;

StringGrid1.Cells[3, currentRow]:=IntToStr(ostatok);

Edit1.Clear;

Edit1.SetFocus;

Edit2.Clear;

Edit3.Clear;

Grafik(StringGrid1,Chart1PieSeries1);

end;

end;

end;

procedure TForm2.Button2Click(Sender: TObject);

var z:integer;

begin

if (Edit4.Text = '') then

MessageDLG('Введите номер искомого абонента!',mtWarning,[mbOK],0) else

begin

z:=0;

for a:=StringGrid1.FixedRows to StringGrid1.RowCount-1 do

begin

If StringGrid1.cells[0,a] = Edit4.text then

begin

z:=z+1;

if StrToInt(StringGrid1.Cells[3,a]) < 0 then

ShowMessage(' Абонент с номером '+ StringGrid1.cells[0,a] + ' найден ' +#13#10 +#13#10 +' Номер телефона ' + StringGrid1.Cells[0,a] + #13#10 + ' MTP ' + StringGrid1.Cells[1,a] + #13#10 +' Баланс на счёте ' + StringGrid1.Cells[2,a] + #13#10 +' Остаток на счёте ' + StringGrid1.Cells[3,a] + ' - ИМЕЕТСЯ ЗАДОЛЖЕННОСТЬ! ')

else

ShowMessage(' Абонент с номером '+ StringGrid1.cells[0,a] + ' найден ' +#13#10 +#13#10 +' Номер телефона ' + StringGrid1.Cells[0,a] + #13#10 + ' MTP ' + StringGrid1.Cells[1,a] + #13#10 +' Баланс на счёте ' + StringGrid1.Cells[2,a] + #13#10 +' Остаток на счёте ' + StringGrid1.Cells[3,a] + ' - ЗАДОЛЖЕННОСТИ НЕТ');

end;

end;

If z=0 then

ShowMessage('Абонент с номером ' + Edit4.text + ' не найден');

end;

end;

procedure TForm2.Button3Click(Sender: TObject);

var da,x:integer;

begin

da:=1;

for a:=StringGrid1.FixedRows to StringGrid1.RowCount-1 do

if strtoint(stringgrid1.cells[3,a])<0 then

begin

inc(da);

StringGrid2.RowCount:=da;

end;

if da=1 then

ShowMessage('Должников нет');

x:=1;

for a:=StringGrid1.FixedRows to StringGrid1.RowCount-1 do

begin

If StringGrid1.Cells[3,a]='' then

break

else

if StrToInt(StringGrid1.Cells[3,a]) < 0 then

begin

StringGrid2.Cells[0, x]:=StringGrid1.Cells[0,a];

StringGrid2.Cells[1, x]:=StringGrid1.Cells[1,a];

StringGrid2.Cells[2, x]:=StringGrid1.Cells[2,a];

StringGrid2.Cells[3,x]:=StringGrid1.Cells[3,a];

x:=x+1;

end;

end;

end;

procedure TForm2.Button4Click(Sender: TObject);

var i,neg,pos:integer;

begin

neg:=0;

pos:=0;

for i:=1 to StringGrid1.RowCount-1 do

if strtoint(StringGrid1.cells[3,i])<0 then

inc(neg) else

inc(pos);

With Chart1PieSeries1 do

begin

Clear;

Add(pos,'Цех 1',clYellow);

Add(neg,'Цех 2',clBlue);

end;

end;

procedure TForm2.DeleteBatonClick(Sender: TObject);

var

pos:integer;

next1:boolean;

begin

if MessageDLG('Вы хотите удалить выбранного абонента?', mtConfirmation, [mbYes, mbNo], 0) = mryes then

begin

if FileExists(WideString(Utf8ToSys(FileLocation)))

then pos:= CheckNumber(WideString(Utf8ToSys(FileLocation)), StringGrid1.Cells[0, StringGrid1.Row])

else pos:= -1;

if pos >= 0

then

begin

DeleteNumber(WideString(Utf8ToSys(FileLocation)), pos);

Grafik(StringGrid1,Chart1PieSeries1);

end;

end;

StringGrid1.rowcount:=1;

stringgrid2.rowcount:=1;

next1:=true;

if FileExists(WideString(Utf8ToSys(FileLocation))) then

begin

next1:= LoadDataInGrid(WideString(Utf8ToSys(FileLocation)), StringGrid1);

Grafik(StringGrid1,Chart1PieSeries1);

end

else

next1:= false;

if not next1 then

ShowMessage('Выбран неверный файл, пожалуйста выберите другой');

end;

procedure TForm2.Edit1KeyPress(Sender: TObject; var Key: char);

begin

if not (Key in ['0'..'9',#8]) then

key:=#0;

end;

procedure TForm2.Edit2KeyPress(Sender: TObject; var Key: char);

begin

if not (Key in ['0'..'9',#8]) then

key:=#0;

end;

procedure TForm2.Edit3KeyPress(Sender: TObject; var Key: char);

begin

if not (Key in ['0'..'9',#8]) then

key:=#0;

end;

procedure TForm2.Edit4KeyPress(Sender: TObject; var Key: char);

begin

if not (Key in ['0'..'9',#8]) then

key:=#0;

end;

procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: boolean);

begin

if MessageDLG('Вы точно хотите выйти?', mtConfirmation, [mbYes, mbNo], 0) = mrNo then

CanClose:=false

else

If (Edit1.text<>'')or (Edit2.text<>'')or (Edit3.text<>'') then

begin

ShowMessage('Имеется не записанный номер');

Edit1.SetFocus;

CanClose:=false;

end;

If CanClose then

Application.Terminate; end;

procedure TForm2.FormCreate(Sender: TObject);

begin

i:=1;

j:=1;

Application.Title:='Телефонная база';

end;

procedure TForm2.FormShow(Sender: TObject);

var

next1:boolean;

begin

Chart1.visible:=true;

FileLocation:='';

if MessageDLG('Открыть файл для работы с данными?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then

begin

StringGrid1.RowCount:=1;

if OpenDialog1.Execute then

begin

FileLocation:= OpenDialog1.FileName

end

else

FileLocation:= 'Tablica1.txt';

end

else

FileLocation:= 'Tablica1.txt';

next1:= LoadDataInGrid(WideString(Utf8ToSys(FileLocation)), StringGrid1);

Grafik(StringGrid1,Chart1PieSeries1);

if not next1 then

begin

ShowMessage('Выбран неверный файл, пожалуйста выберите другой');

Chart1.visible:=false;

end;

end;

procedure TForm2.MenuItem10Click(Sender: TObject);

var next1:boolean;

begin

stringgrid2.rowcount:=1;

next1:=true;

if FileExists(WideString(Utf8ToSys(FileLocation))) then

begin

next1:= LoadDataInGrid(WideString(Utf8ToSys(FileLocation)), StringGrid1);

Grafik(StringGrid1,Chart1PieSeries1);

end

else

next1:= false;

if not next1 then

ShowMessage('Выбран неверный файл, пожалуйста выберите другой');

end;

procedure TForm2.MenuItem11Click(Sender: TObject);

var

i: Integer;

s:string;

begin

if SaveDialog1.Execute then

begin

for i:=1 to StringGrid1.RowCount-1 do

s:= s + (StringGrid1.Cells[0, i] + '|'+ StringGrid1.Cells[1, i] + '|' + StringGrid1.Cells[2, i] + '|' + StringGrid1.Cells[3, i] + #13#10);

AddNumber(WideString(Utf8ToSys(SaveDialog1.FileName)), s + #13#10);

end;

end;

procedure TForm2.MenuItem12Click(Sender: TObject);

var i,j:integer;

begin

if MessageDLG('Вы точно хотите удалить содержимое файла?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then

Chart1.visible:=false;

StringGrid1.RowCount:=1;

StringGrid2.RowCount:=1;

for i:=1 to StringGrid1.RowCount-1 do

for j:=0 to StringGrid1.ColCount-1 do

StringGrid1.cells[j,i]:='';

for i:=1 to StringGrid2.RowCount-1 do

for j:=0 to StringGrid2.ColCount-1 do

StringGrid2.cells[j,i]:='';

end;

procedure TForm2.MenuItem13Click(Sender: TObject);

begin

Edit1.SetFocus;

Edit1.clear;

Edit2.clear;

Edit3.clear;

end;

procedure TForm2.MenuItem14Click(Sender: TObject);

begin

MessageDLG('Поля служат для введения информации о пользователях',mtInformation, [mbOK], 0);

end;

procedure TForm2.MenuItem15Click(Sender: TObject);

begin

MessageDLG('Таблица выводит информацию о пользовательях АТС',mtInformation, [mbOK], 0);

end;

procedure TForm2.MenuItem16Click(Sender: TObject);

var i,j:integer;

begin

stringgrid2.rowcount:=1;

for i:=1 to StringGrid2.RowCount-1 do

for j:=0 to StringGrid2.ColCount-1 do

StringGrid2.cells[j,i]:=''

end;

procedure TForm2.MenuItem17Click(Sender: TObject);

begin

MessageDLG('Таблица показывает информацию о должниках',mtInformation, [mbOK], 0);

end;

procedure TForm2.MenuItem3Click(Sender: TObject);

var next1:boolean;

begin

stringgrid2.rowcount:=1;

next1:=true;

if FileExists(WideString(Utf8ToSys(FileLocation))) then

begin

next1:= LoadDataInGrid(WideString(Utf8ToSys(FileLocation)), StringGrid1);

Grafik(StringGrid1,Chart1PieSeries1);

end

else

next1:= false;

if not next1 then

ShowMessage('Выбран неверный файл, пожалуйста выберите другой');

end;

procedure TForm2.MenuItem2Click(Sender: TObject);

var

i: Integer;

s:string;

begin

if SaveDialog1.Execute then

begin

for i:=1 to StringGrid1.RowCount-1 do

s:= s + (StringGrid1.Cells[0, i] + '|'+ StringGrid1.Cells[1, i] + '|' + StringGrid1.Cells[2, i] + '|' + StringGrid1.Cells[3, i] + #13#10);

AddNumber(WideString(Utf8ToSys(SaveDialog1.FileName)), s + #13#10);

end;

end;

procedure TForm2.MenuItem6Click(Sender: TObject);

begin

if FontDialog1.Execute then

begin

StringGrid1.Font.Assign(FontDialog1.Font);

StringGrid2.Font.Assign(FontDialog1.Font);

end;

end;

procedure TForm2.MenuItem7Click(Sender: TObject);

var next1:boolean;

begin

Chart1.visible:=true;

FileLocation:='';

if MessageDLG('Открыть файл для работы с данными?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then

begin

StringGrid1.RowCount:=1;

StringGrid2.RowCount:=1;

if OpenDialog1.Execute then

begin

FileLocation:= OpenDialog1.FileName;

Chart1.visible:=true;

next1:= LoadDataInGrid(WideString(Utf8ToSys(FileLocation)), StringGrid1);

Grafik(StringGrid1,Chart1PieSeries1)

end

else

FileLocation:= 'Tablica1.txt';

end

else

FileLocation:= 'Tablica1.txt';

if not next1 then

begin

Chart1.visible:=false;

ShowMessage('Выбран неверный файл, пожалуйста выберите другой');

end;

end;

procedure TForm2.MenuItem8Click(Sender: TObject);

begin

MessageDLG('Программа автоматически сохраняет вносимые номера ' + #13#10,mtInformation, [mbOK], 0);

end;

procedure TForm2.MenuItem9Click(Sender: TObject);

var da,x:integer;

begin

da:=1;

for a:=StringGrid1.FixedRows to StringGrid1.RowCount-1 do

if strtoint(stringgrid1.cells[3,a])<0 then

begin

inc(da);

StringGrid2.RowCount:=da;

end;

if da=1 then

ShowMessage('Должников нет');

x:=1;

for a:=StringGrid1.FixedRows to StringGrid1.RowCount-1 do

begin

If StringGrid1.Cells[3,a]='' then

break

else

if StrToInt(StringGrid1.Cells[3,a]) < 0 then

begin

StringGrid2.Cells[0, x]:=StringGrid1.Cells[0,a];

StringGrid2.Cells[1, x]:=StringGrid1.Cells[1,a];

StringGrid2.Cells[2, x]:=StringGrid1.Cells[2,a];

StringGrid2.Cells[3,x]:=StringGrid1.Cells[3,a];

x:=x+1;

end;

end;

end;

procedure TForm2.StringGrid1Click(Sender: TObject);

begin

spisok(StringGrid1);

end;

procedure TForm2.ToolButton1Click(Sender: TObject);

var next1:boolean;

begin

Chart1.visible:=true;

FileLocation:='';

if MessageDLG('Открыть файл для работы с данными?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then

begin

StringGrid1.RowCount:=1;

StringGrid2.RowCount:=1;

if OpenDialog1.Execute then

begin

FileLocation:= OpenDialog1.FileName;

Chart1.visible:=true;

next1:= LoadDataInGrid(WideString(Utf8ToSys(FileLocation)), StringGrid1);

Grafik(StringGrid1,Chart1PieSeries1)

end

else

FileLocation:= 'Tablica1.txt';

end

else

FileLocation:= 'Tablica1.txt';

if not next1 then

begin

Chart1.visible:=false;

ShowMessage('Выбран неверный файл, пожалуйста выберите другой');

end;

end;

procedure TForm2.ToolButton3Click(Sender: TObject);

var

i: Integer;

s:string;

begin

if SaveDialog1.Execute then

begin

for i:=1 to StringGrid1.RowCount-1 do

s:= s + (StringGrid1.Cells[0, i] + '|'+ StringGrid1.Cells[1, i] + '|' + StringGrid1.Cells[2, i] + '|' + StringGrid1.Cells[3, i] + #13#10);

AddNumber(WideString(Utf8ToSys(SaveDialog1.FileName)), s + #13#10);

end;

end;

procedure TForm2.ToolButton5Click(Sender: TObject);

begin

MessageDLG('Программа автоматически сохраняет вносимые номера ' + #13#10,mtInformation, [mbOK], 0);

end;

procedure TForm2.ToolButton7Click(Sender: TObject);

begin

close;

end;

end.