Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit WriteUnit;
- interface
- uses
- System.SysUtils, ListUnit, ReadUnit, StartUnit;
- procedure clearFile();
- procedure write(TelephoneNumber: TTelephoneNumber; Surname: TSurname;
- Name: TName; FatherName: TPatronymic;
- City: TCity; DateOfPay: TDateOfPay); overload;
- procedure write(SubscriberIndex: TNumber; TelephoneNumber: TTelephoneNumber;
- Surname: TSurname; Name: TName; FatherName: TPatronymic;
- City: TCity; DateOfPay: TDateOfPay); overload;
- function toTelephoneNumber(Data: string): TTelephoneNumber;
- function toSurname(Data: string): TSurname;
- function toName(Data: string): TName;
- function toPatronymic(Data: string): TPatronymic;
- function toCity(Data: string): TCity;
- function toDateOfPay(StartDate: TDate; Data: integer): TDateOfPay;
- procedure deleteSubscriber(NumberOfSubscriber: TNumber);
- procedure removeDeleters();
- implementation
- uses
- DateUtils, Math;
- procedure clearFile();
- var
- SourceFile: TBinaryFile;
- begin
- assign(SourceFile, getCurrentDir + '\' + FILE_NAME);
- rewrite(SourceFile);
- closeFile(SourceFile);
- end;
- procedure removeDeleters();
- const
- TEMP_FILE_NAME = 'TempFile.bin';
- var
- SourceFile, TempFile: TBinaryFile;
- OneByte: ansichar;
- BufferArray: Array[1..ONLY_DATA_SIZE] of ansichar;
- offset: integer;
- Number: longWord;
- begin
- assign(SourceFile, GetCurrentDir + '\' + FILE_NAME);
- assign(TempFile, GetCurrentDir + '\' + TEMP_FILE_NAME);
- Number := 0;
- rewrite(TempFile);
- reset(SourceFile);
- offset := START_SUBSCRIBER_OFFSET;
- while not EOF(SourceFile) do
- begin
- blockRead(SourceFile, OneByte, 1);
- if (OneByte <> DELETER) then
- begin
- Seek(SourceFile, Offset + 4);
- blockRead(SourceFile, BufferArray, ONLY_DATA_SIZE);
- blockWrite(TempFile, Number, 4);
- blockWrite(TempFile, BufferArray, ONLY_DATA_SIZE);
- inc(Number);
- end;
- Offset := Offset + RECORD_SIZE;
- seek(SourceFile, Offset);
- end;
- closeFile(SourceFile);
- closeFile(TempFile);
- deleteFile(GetCurrentDir + '\' + FILE_NAME);
- RenameFile(GetCurrentDir + '\' + TEMP_FILE_NAME, GetCurrentDir + '\' + FILE_NAME);
- end;
- procedure write(TelephoneNumber: TTelephoneNumber; Surname: TSurname;
- Name: TName; FatherName: TPatronymic;
- City: TCity; DateOfPay: TDateOfPay);
- const
- MAX_SUBSCRIBER_NUMBER = 9999999;
- var
- SourceFile: TBinaryFile;
- SizeOfFile: integer;
- NumberOfRecord: LongWord;
- ArrayOfRecordNumber: TNumber;
- begin
- assign(SourceFile, getCurrentDir + '\' + FILE_NAME);
- reset(SourceFile);
- SizeOfFile := fileSize(SourceFile) - START_SUBSCRIBER_OFFSET;
- NumberOfRecord := SizeOfFile div RECORD_SIZE;
- if NumberOfRecord < MAX_SUBSCRIBER_NUMBER then
- begin
- Seek(SourceFile, SizeOfFile);
- blockWrite(SourceFile, NumberOfRecord, NUMBER_LENGTH);
- blockWrite(SourceFile, TelephoneNumber, TELEPHONE_NUMBER_LENGTH);
- blockWrite(SourceFile, Surname, SURNAME_LENGTH);
- blockWrite(SourceFile, Name, NAME_LENGTH);
- blockWrite(SourceFile, FatherName, PATRONYMIC_LENGTH);
- blockWrite(SourceFile, City, CITY_LENGTH);
- blockWrite(SourceFile, DateOfPay, DATE_OF_PAY_LENGTH);
- end;
- closeFile(SourceFile);
- end;
- procedure write(SubscriberIndex: TNumber; TelephoneNumber: TTelephoneNumber;
- Surname: TSurname; Name: TName; FatherName: TPatronymic;
- City: TCity; DateOfPay: TDateOfPay);
- var
- SourceFile: TBinaryFile;
- ArrayOfRecordNumber: TNumber;
- begin
- assign(SourceFile, getCurrentDir + '\' + FILE_NAME);
- reset(SourceFile);
- seek(SourceFile, START_SUBSCRIBER_OFFSET + SubscriberIndex * RECORD_SIZE);
- blockWrite(SourceFile, SubscriberIndex, NUMBER_LENGTH);
- blockWrite(SourceFile, TelephoneNumber, TELEPHONE_NUMBER_LENGTH);
- blockWrite(SourceFile, Surname, SURNAME_LENGTH);
- blockWrite(SourceFile, Name, NAME_LENGTH);
- blockWrite(SourceFile, Fathername, PATRONYMIC_LENGTH);
- blockWrite(SourceFile, City, CITY_LENGTH);
- blockWrite(SourceFile, DateofPay, DATE_OF_PAY_LENGTH);
- closeFile(SourceFile);
- end;
- procedure deleteSubscriber(NumberOfSubscriber: TNumber);
- const
- DELETER: ansichar = '/';
- var
- SourceFile: TBinaryFile;
- Offset: integer;
- NumberOfRecord: LongWord;
- ArrayOfRecordNumber: TNumber;
- DeleterArray: array[1..RECORD_SIZE] of ansichar;
- begin
- fillchar(DeleterArray, RECORD_SIZE, DELETER);
- assign(SourceFile, getCurrentDir + '\' + FILE_NAME);
- reset(SourceFile);
- Offset := NumberOfSubscriber * RECORD_SIZE;
- seek(SourceFile, Offset);
- blockWrite(SourceFile, DeleterArray, RECORD_SIZE);
- closeFile(SourceFile);
- end;
- function toTelephoneNumber(Data: string): TTelephoneNumber;
- var
- ResultArray: TTelephoneNumber;
- i: integer;
- begin
- i := 1;
- while i <= length(Data) do
- begin
- ResultArray[i] := ansichar(Data[i]);
- inc(i);
- end;
- while i <= TELEPHONE_NUMBER_LENGTH do
- begin
- ResultArray[i] := ' ';
- inc(i);
- end;
- Result := ResultArray;
- end;
- function toSurname(Data: string): TSurname;
- var
- ResultArray: TSurname;
- i: integer;
- begin
- i := 1;
- while i <= length(Data) do
- begin
- ResultArray[i] := ansichar(Data[i]);
- inc(i);
- end;
- while i <= SURNAME_LENGTH do
- begin
- ResultArray[i] := ' ';
- inc(i);
- end;
- Result := ResultArray;
- end;
- function toName(Data: string): TName;
- var
- ResultArray: TName;
- i: integer;
- begin
- i := 1;
- while i <= length(Data) do
- begin
- ResultArray[i] := AnsiChar(Data[i]);
- inc(i);
- end;
- while i <= NAME_LENGTH do
- begin
- ResultArray[i] := ' ';
- inc(i);
- end;
- Result := ResultArray;
- end;
- function toPatronymic(Data: string): TPatronymic;
- var
- ResultArray: TPatronymic;
- i: integer;
- begin
- i := 1;
- while i <= length(Data) do
- begin
- ResultArray[i] := AnsiChar(Data[i]);
- inc(i);
- end;
- while i <= PATRONYMIC_LENGTH do
- begin
- ResultArray[i] := ' ';
- inc(i);
- end;
- Result := ResultArray;
- end;
- function toCity(Data: string): TCity;
- var
- ResultArray: TCity;
- i: integer;
- begin
- i := 1;
- while i <= length(Data) do
- begin
- ResultArray[i] := AnsiChar(Data[i]);
- inc(i);
- end;
- while i <= CITY_LENGTH do
- begin
- ResultArray[i] := ' ';
- inc(i);
- end;
- Result := ResultArray;
- end;
- function toDateOfPay(StartDate: TDate; Data: integer): TDateOfPay;
- const
- FIRST_DOT = 3;
- SECOND_DOT = 6;
- MAX_DATE_STR = '23.11.9999';
- var
- ResultArray: TDateOfPay;
- i, j: integer;
- NewDate: TDate;
- NewDateString: string;
- MaxDate: TDate;
- begin
- MaxDate := strToDate(MAX_DATE_STR);
- NewDate := incDay(StartDate, Round(Data/(ServiceCost / 30 )));
- NewDateString := dateToStr(NewDate);
- j := 1;
- if (CompareDate(NewDate, MaxDate) = 1) then
- NewDateString := dateToStr(StartDate);
- for i := 1 to (DATE_OF_PAY_LENGTH + 2) do
- begin
- if (i <> FIRST_DOT) and (i <> SECOND_DOT) then
- begin
- ResultArray[j] := ansichar(NewDateString[i]);
- inc(j)
- end
- else
- ResultArray[i] := ansichar(0);
- end;
- Result := ResultArray;
- end;
- end.
- unit ListUnit;
- interface
- uses
- System.SysUtils, Vcl.ExtCtrls;
- const
- TELEPHONE_NUMBER_LENGTH = 13;
- SURNAME_LENGTH = 14;
- NAME_LENGTH = 11;
- PATRONYMIC_LENGTH = 14;
- CITY_LENGTH = 11;
- DATE_OF_PAY_LENGTH = 8;
- NUMBER_LENGTH = 4;
- RECORD_SIZE = TELEPHONE_NUMBER_LENGTH + SURNAME_LENGTH + NAME_LENGTH +
- PATRONYMIC_LENGTH + CITY_LENGTH + DATE_OF_PAY_LENGTH + NUMBER_LENGTH;
- ONLY_DATA_SIZE = TELEPHONE_NUMBER_LENGTH + SURNAME_LENGTH + NAME_LENGTH +
- PATRONYMIC_LENGTH + CITY_LENGTH + DATE_OF_PAY_LENGTH;
- type
- TTelephoneNumber = array[1..TELEPHONE_NUMBER_LENGTH] of AnsiChar;
- TSurname = array[1..SURNAME_LENGTH] of AnsiChar;
- TName = array[1..NAME_LENGTH] of AnsiChar;
- TPatronymic = array[1..PATRONYMIC_LENGTH] of AnsiChar;
- TCity = array[1..CITY_LENGTH] of AnsiChar;
- TDateOfPay = array[1..DATE_OF_PAY_LENGTH] of AnsiChar;
- TNumberOfDays = integer;
- TNumber = longWord;
- TSubscriberPointer = ^TSubscriber;
- TCompareMethod = function(Previous, Next: TSubscriberPointer): boolean of object;
- TSubscriber = record
- next: TSubscriberPointer;
- telephoneNumber: TTelephoneNumber;
- surname: TSurname;
- name: TName;
- patronymic: TPatronymic;
- city: TCity;
- numberOfDays: TNumberOfDays;
- number: TNumber;
- end;
- TRequiredSubscriber = record
- telephoneNumber, surname, name, patronymic, city: string;
- numberOfDays: TNumberOfDays;
- number: TNumber;
- end;
- TSubscriberList = class
- private
- Header: TSubscriberPointer;
- public
- function getHeader(): TSubscriberPointer;
- constructor NewSubscriberList();
- procedure add(CurrentTelephoneNumber: TTelephoneNumber;
- CurrentSurname: TSurname; CurrentName: TName;
- CurrentFatherName: TPatronymic; CurrentCity: TCity;
- CurrentNumberOfDays: TNumberOfDays; CurrentNumber: TNumber);
- procedure deleteList();
- function length(): integer;
- function IsEmpty(): boolean;
- function getLastPosition(): TSubscriberPointer;
- procedure sort(CompareMethod: TCompareMethod);
- class function compareByTelephoneNumber(Previous,
- Next: TSubscriberPointer): boolean;
- class function compareBySurname(Previous,
- Next: TSubscriberPointer): boolean;
- class function compareByName(Previous,
- Next: TSubscriberPointer): boolean;
- class function compareByPatronymic(Previous,
- Next: TSubscriberPointer): boolean;
- class function compareByCity(Previous,
- Next: TSubscriberPointer): boolean;
- class function compareByDate(Previous,
- Next: TSubscriberPointer): boolean;
- class procedure QuckSort(var headRef: TSubscriberPointer; CompareMethod: TCompareMethod);
- class function getTail(Node: TSubscriberPointer): TSubscriberPointer;
- class function quickSortRecur(head: TSubscriberPointer;
- fin: TSubscriberPointer; CompareMethod: TCompareMethod): TSubscriberPointer;
- class function partition(head: TSubscriberPointer; Fin: TSubscriberPointer;
- var NewHead: TSubscriberPointer;
- var NewTail: TSubscriberPointer; CompareMethod: TCompareMethod): TSubscriberPointer;
- end;
- implementation
- uses
- EditUnit, ReadUnit;
- constructor TSubscriberList.NewSubscriberList();
- begin
- new(Header);
- Header^.next := nil;
- end;
- function TSubscriberList.IsEmpty(): Boolean;
- begin
- Result := (Header^.next = nil);
- end;
- function TSubscriberList.getHeader(): TSubscriberPointer;
- begin
- Result := Self.Header;
- end;
- function TSubscriberList.length(): integer;
- var
- ListLength: integer;
- PTemp: TSubscriberPointer;
- begin
- PTemp := getHeader();
- ListLength := 0;
- while (PTemp^.next <> nil) do
- begin
- PTemp := PTemp^.next;
- inc(ListLength);
- end;
- Result := ListLength;
- end;
- function TSubscriberList.getLastPosition(): TSubscriberPointer;
- var
- PTemp: TSubscriberPointer;
- begin
- PTemp := getHeader();
- while (PTemp^.next <> nil) do
- PTemp := PTemp^.next;
- Result := PTemp;
- end;
- procedure TSubscriberList.add(CurrentTelephoneNumber: TTelephoneNumber; CurrentSurname: TSurname;
- CurrentName: TName; CurrentFatherName: TPatronymic; CurrentCity: TCity;
- CurrentNumberOfDays: TNumberOfDays; CurrentNumber: TNumber);
- var
- PLastSubscriber: TSubscriberPointer;
- begin
- PLastSubscriber := getLastPosition();
- new(PLastSubscriber^.next);
- PLastSubscriber := PLastSubscriber^.next;
- PLastSubscriber^.number := CurrentNumber;
- PLastSubscriber^.telephoneNumber := CurrentTelephoneNumber;
- PLastSubscriber^.surname := CurrentSurname;
- PLastSubscriber^.name := CurrentName;
- PLastSubscriber^.patronymic := CurrentFatherName;
- PLastSubscriber^.city := CurrentCity;
- PLastSubscriber^.numberOfDays := CurrentNumberOfDays;
- PLastSubscriber^.next := nil;
- end;
- procedure TSubscriberList.deleteList();
- var
- PDeleter: TSubscriberPointer;
- PTemp: TSubscriberPointer;
- begin
- PTemp := Header^.next;;
- while PTemp <> nil do
- begin
- PDeleter := PTemp;
- PTemp := PTemp^.next;
- dispose(PDeleter);
- end;
- Header^.next := nil;
- end;
- class function TSubscriberList.compareByTelephoneNumber(Previous, Next: TSubscriberPointer): boolean;
- begin
- Result := (Previous^.telephoneNumber > Next^.telephoneNumber);
- end;
- class function TSubscriberList.compareBySurname(Previous, Next: TSubscriberPointer): boolean;
- begin
- Result := (Previous^.surname > Next^.surname);
- end;
- class function TSubscriberList.compareByName(Previous, Next: TSubscriberPointer): boolean;
- begin
- Result := (Previous^.name > Next^.name);
- end;
- class function TSubscriberList.compareByPatronymic(Previous, Next: TSubscriberPointer): boolean;
- begin
- Result := (Previous^.patronymic > Next^.patronymic);
- end;
- class function TSubscriberList.compareByCity(Previous, Next: TSubscriberPointer): boolean;
- begin
- Result := (Previous^.city > Next^.city);
- end;
- class function TSubscriberList.compareByDate(Previous, Next: TSubscriberPointer): boolean;
- begin
- Result := (Previous^.numberOfDays > Next^.numberOfDays);
- end;
- class function TSubscriberList.getTail(Node: TSubscriberPointer): TSubscriberPointer;
- begin
- while (Node <> nil) and (Node^.next <> nil) do
- Node := Node^.next;
- Result := Node;
- end;
- class function TSubscriberList.partition(head: TSubscriberPointer; Fin: TSubscriberPointer;
- var NewHead: TSubscriberPointer;
- var NewTail: TSubscriberPointer; CompareMethod: TCompareMethod): TSubscriberPointer;
- var
- Pivot: TSubscriberPointer;
- Previous: TSubscriberPointer;
- Current: TSubscriberPointer;
- Tail: TSubscriberPointer;
- Temp: TSubscriberPointer;
- begin
- Pivot := Fin;
- Previous := nil;
- Current := head;
- Tail := Pivot;
- while (Current <> Pivot) do
- begin
- if CompareMethod(Pivot, Current) then
- begin
- if (newHead = nil) then
- newHead := Current;
- Previous := Current;
- Current := Current^.next;
- end
- else
- begin
- if (Previous <> nil) then
- Previous^.next := Current^.next;
- Temp := Current^.next;
- Current^.next := nil;
- Tail^.next := Current;
- Tail := Current;
- Current := Temp;
- end;
- end;
- if (NewHead = nil) then
- NewHead := Pivot;
- NewTail := Tail;
- Result := Pivot;
- end;
- class function TSubscriberList.quickSortRecur(head: TSubscriberPointer;
- fin: TSubscriberPointer; CompareMethod: TCompareMethod): TSubscriberPointer;
- var
- NewHead: TSubscriberPointer;
- NewEnd: TSubscriberPointer;
- tmp: TSubscriberPointer;
- pivot: TSubscriberPointer;
- begin
- // base condition
- if ((not (head <> nil)) or (head = fin)) then
- Result := head
- else
- begin
- newHead := nil;
- newEnd := nil;
- // Partition the list, newHead and newEnd will be
- // updated by the partition function
- pivot := partition(head, fin, newHead, newEnd, CompareMethod);
- // If pivot is the smallest element - no need to recur
- // for the left part.
- if (newHead <> pivot) then
- begin
- // Set the node before the pivot node as nullptr
- tmp := newHead;
- while (tmp^.next <> pivot) do
- tmp := tmp^.next;
- tmp^.next := nil;
- newHead := quickSortRecur(newHead, tmp,CompareMethod);
- tmp := getTail(newHead);
- tmp^.next := pivot;
- end;
- pivot^.next := quickSortRecur(pivot^.next, newEnd, CompareMethod);
- Result := newHead;
- end;
- end;
- procedure TSubscriberList.Sort(CompareMethod: TCompareMethod);
- begin
- QuckSort(Self.getHeader^.next, CompareMethod);
- end;
- class procedure TSubscriberList.QuckSort(var headRef: TSubscriberPointer; CompareMethod: TCompareMethod);
- var
- Tail: TSubscriberPointer;
- begin
- Tail := getTail(headRef);
- headRef := quickSortRecur(headRef, Tail, CompareMethod);
- end;
- end.
- unit ReadUnit;
- interface
- uses
- System.SysUtils, ListUnit, EditUnit, DateUtils;
- const
- PathToFile = 'C:\t\SubscribersFile.bin';
- FILE_NAME = 'SubscribersFile.bin';
- DELETER: ansichar = '/';
- START_SUBSCRIBER_OFFSET: LongWord = 0;
- type
- TBinaryFile = file of byte;
- procedure readSubscribers(var RequiredSubscriber: TRequiredSubscriber);
- function getSubscriber(Index: longWord; var DateString: string): TSubscriber;
- function isEqual(RequiredString: string; var CurrentArray: array of AnsiChar): boolean;
- function isExist(var RequiredSubscriber: TRequiredSubscriber; var SameSubscriberIndex: integer): Boolean;
- function isFileEmpty(): Boolean;
- function dateArrayToString(var DateOfPayArray: TDateOfPay): string;
- function dateToNumber(var DateOfPayArray: TDateOfPay): TNumberOfdays;
- function isRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var TelephoneNumberArray: TTelephoneNumber): boolean; overload;
- function isRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var SurnameArray: TSurname): boolean; overload;
- function isRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var NameArray: TName): boolean; overload;
- function isRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var FathernameArray: TPatronymic): boolean; overload;
- function isRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var CityArray: TCity): boolean; overload;
- function isRequiredSubscriber(var SourceFile: TBinaryFile; var TelephoneNumberArray: TTelephoneNumber;
- var SurnameArray: TSurname; var NameArray: TName;
- var PatromynicArray: TPatronymic; var CityArray: TCity;
- var RequiredSubscriber: TRequiredSubscriber): boolean;
- implementation
- function dateArrayToString(var DateOfPayArray: TDateOfPay): string;
- begin
- Result := copy(DateOfPayArray, 1, 2) + '.' + copy(DateOfPayArray, 3, 2) + '.' + copy(DateOfPayArray, 5, 4);
- end;
- function dateToNumber(var DateOfPayArray: TDateOfPay): TNumberOfdays;
- var
- NumberOfDaysLeft: integer;
- WritenTime, NowTime: TDateTime;
- StringTime: string;
- Difference: TNumberOfDays;
- DayDifferece: TNumberOfDays;
- ComparisonResult: integer;
- begin
- StringTime := dateArrayToString(DateOfPayArray);
- WritenTime := strToDate(StringTime);
- NowTime := Now();
- ComparisonResult := compareDate(WritenTime, NowTime);
- DayDifferece := daysBetween(WritenTime, NowTime);
- Difference := DayDifferece * ComparisonResult;
- Result := Difference;
- end;
- procedure readSubscribers(var RequiredSubscriber: TRequiredSubscriber);
- var
- SourceFile: TBinaryFile;
- TelephoneNumberArray: TTelephoneNumber;
- SurnameArray: TSurname;
- NameArray: TName;
- PatromynicArray: TPatronymic;
- CityArray: TCity;
- DateofPayArray: TDateOfPay;
- Number: TNumber;
- CurrentOffset, Offset: integer;
- OneByte: ansichar;
- NumberOfDays: longWord;
- begin
- assign(SourceFile, getCurrentDir + '\' + FILE_NAME);
- reset(SourceFile);
- Offset := START_SUBSCRIBER_OFFSET;
- Seek(SourceFile, Offset);
- while not EOF(SourceFile) do
- begin
- blockRead(SourceFile, OneByte, 1);
- if OneByte <> DELETER then
- begin
- Seek(SourceFile, Offset);
- blockRead(SourceFile, Number, NUMBER_LENGTH);
- if isRequiredSubscriber(SourceFile, TelephoneNumberArray,
- SurnameArray, NameArray, PatromynicArray, CityArray,
- RequiredSubscriber) then
- begin
- blockRead(SourceFile, DateOfPayArray, DATE_OF_PAY_LENGTH);
- NumberOfDays := dateToNumber(DateOfPayArray);
- SubscriberList.add(TelephoneNumberArray, SurnameArray,
- NameArray, PatromynicArray, CityArray, NumberOfDays, Number);
- end;
- end;
- Offset := Offset + RECORD_SIZE;
- Seek(SourceFile, Offset);
- end;
- close(SourceFile);
- end;
- function getSubscriber(Index: longWord; var DateString: string): TSubscriber;
- var
- SourceFile: TBinaryFile;
- Offset: integer;
- CurrentSubscriber: TSubscriber;
- DateOfPayArray: TDateOfPay;
- NumberOfDays: longWord;
- begin
- assign(SourceFile, getCurrentDir + '\' + FILE_NAME);
- reset(SourceFile);
- Offset := START_SUBSCRIBER_OFFSET + RECORD_SIZE * Index + NUMBER_LENGTH;
- Seek(SourceFile, Offset);
- blockRead(SourceFile, CurrentSubscriber.telephoneNumber, TELEPHONE_NUMBER_LENGTH);
- blockRead(SourceFile, CurrentSubscriber.surname, SURNAME_LENGTH);
- blockRead(SourceFile, CurrentSubscriber.name, NAME_LENGTH);
- blockRead(SourceFile, CurrentSubscriber.patronymic, PATRONYMIC_LENGTH);
- blockRead(SourceFile, CurrentSubscriber.city, CITY_LENGTH);
- blockRead(SourceFile, DateOfPayArray, DATE_OF_PAY_LENGTH);
- DateString := dateArrayToString(DateOfPayArray);
- close(SourceFile);
- Result := CurrentSubscriber;
- end;
- function isExist(var RequiredSubscriber: TRequiredSubscriber; var SameSubscriberIndex: integer): boolean;
- var
- IsExist: boolean;
- SourceFile: TBinaryFile;
- TelephoneNumberArray: TTelephoneNumber;
- SurnameArray: TSurname;
- NameArray: TName;
- PatromynicArray: TPatronymic;
- CityArray: TCity;
- DateofPayArray: TDateOfPay;
- Number: TNumber;
- CurrentOffset, Offset: integer;
- OneByte: ansichar;
- begin
- assign(SourceFile, getCurrentDir + '\' + FILE_NAME);
- reset(SourceFile);
- Offset := START_SUBSCRIBER_OFFSET;
- Seek(SourceFile, Offset);
- IsExist := false;
- while (not EOF(SourceFile)) and (not IsExist) do
- begin
- blockRead(SourceFile, OneByte, 1);
- if OneByte <> DELETER then
- begin
- Seek(SourceFile, Offset);
- blockRead(SourceFile, Number, NUMBER_LENGTH);
- if isRequiredSubscriber(SourceFile, TelephoneNumberArray,
- SurnameArray, NameArray, PatromynicArray, CityArray, RequiredSubscriber) then
- begin
- IsExist := true;
- SameSubscriberIndex := Number;
- end;
- end;
- Offset := Offset + RECORD_SIZE;
- Seek(SourceFile, Offset);
- end;
- close(SourceFile);
- Result := IsExist;
- end;
- function isRequiredSubscriber(var SourceFile: TBinaryFile; var TelephoneNumberArray: TTelephoneNumber;
- var SurnameArray: TSurname; var NameArray: TName;
- var PatromynicArray: TPatronymic; var CityArray: TCity;
- var RequiredSubscriber: TRequiredSubscriber): boolean;
- begin
- Result := isRequiredData(SourceFile, RequiredSubscriber.telephoneNumber, TelephoneNumberArray)
- and isRequiredData(SourceFile, RequiredSubscriber.surname, SurnameArray)
- and isRequiredData(SourceFile, RequiredSubscriber.name, NameArray)
- and isRequiredData(SourceFile, RequiredSubscriber.patronymic, PatromynicArray)
- and isRequiredData(SourceFile, RequiredSubscriber.city, CityArray);
- end;
- function isFileEmpty(): Boolean;
- var
- SourceFile: TBinaryFile;
- IsEmpty: boolean;
- SizeOfFile: integer;
- begin
- assign(SourceFile, getCurrentDir + '\' + FILE_NAME);
- Reset(SourceFile);
- SizeOfFile := FileSize(SourceFile);
- close(SourceFile);
- Result := (SizeOfFile = 0);
- end;
- function isEqual(RequiredString: string; var CurrentArray: array of AnsiChar): Boolean;
- var
- IsSame: boolean;
- i: integer;
- begin
- IsSame := true;
- i := 1;
- while IsSame and (i <= length(RequiredString)) do
- if (RequiredString[i] <> char(CurrentArray[i - 1])) then
- IsSame := false
- else
- inc(i);
- Result := IsSame;
- end;
- function IsRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var TelephoneNumberArray: TTelephoneNumber): boolean;
- var
- IsRequiredData: boolean;
- begin
- blockRead(SourceFile, TelephoneNumberArray, TELEPHONE_NUMBER_LENGTH);
- Result := isEqual(RequiredString, TelephoneNumberArray);
- end;
- function IsRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var SurnameArray: TSurname): boolean;
- var
- IsRequiredData: boolean;
- begin
- blockRead(SourceFile, SurnameArray, SURNAME_LENGTH);
- Result := isEqual(RequiredString, SurnameArray);
- end;
- function IsRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var NameArray: TName): boolean;
- var
- IsRequiredData: boolean;
- begin
- blockRead(SourceFile, NameArray, NAME_LENGTH);
- Result := isEqual(RequiredString, NameArray);
- end;
- function IsRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var FathernameArray: TPatronymic): boolean;
- var
- IsRequiredData: boolean;
- begin
- blockRead(SourceFile, FathernameArray, PATRONYMIC_LENGTH);
- Result := isEqual(RequiredString, FathernameArray);
- end;
- function IsRequiredData(var SourceFile: TBinaryFile; var RequiredString: string;
- var CityArray: TCity): boolean;
- var
- IsRequiredData: boolean;
- begin
- blockRead(SourceFile, CityArray, CITY_LENGTH);
- Result := isEqual(RequiredString, CityArray);
- end;
- end.
- unit CorrectUnit;
- interface
- uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Menus, Vcl.Samples.Spin, DateUtils, AddUnit, EditUnit;
- type
- TCorrectForm = class(TForm)
- NameLabel: TLabel;
- SurnameLabel: TLabel;
- PatronumicLabel: TLabel;
- CityLabel: TLabel;
- TelephoneLabel: TLabel;
- TelephoneEdit: TEdit;
- NameEdit: TEdit;
- SurnameEdit: TEdit;
- PatronymicEdit: TEdit;
- CItyEdit: TEdit;
- TaskLabel: TLabel;
- SaveButton: TButton;
- MainMenu: TMainMenu;
- InstructionMenu: TMenuItem;
- PayLabel: TLabel;
- ResetButton: TButton;
- DateLabel: TLabel;
- DateOfPayLabel: TLabel;
- PaySpinEdit: TSpinEdit;
- SuccessLabel: TLabel;
- WrongDataLabel: TLabel;
- UpdateMenu: TMenuItem;
- SubscriberExistsLabel: TLabel;
- procedure ResetButtonClick(Sender: TObject);
- procedure TurnLabelsOff();
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure FormShow(Sender: TObject);
- procedure SaveButtonClick(Sender: TObject);
- procedure showSavedInfo();
- procedure UpdateMenuClick(Sender: TObject);
- procedure deleteSpaces();
- procedure InstructionMenuClick(Sender: TObject);
- procedure TelephoneEditKeyPress(Sender: TObject; var Key: Char);
- procedure FormKeyPress(Sender: TObject; var Key: Char);
- procedure TextEditKeyPress(Sender: TObject; var Key: Char);
- function areEditsCorrect(): boolean;
- procedure SomeEditChange(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- var
- CorrectForm: TCorrectForm;
- implementation
- {$R *.dfm}
- uses
- ReadUnit, WriteUnit, ListUnit;
- procedure TCorrectForm.ResetButtonClick(Sender: TObject);
- var
- TelephoneNumber: TTelephoneNumber;
- Surname: TSurname;
- Name: TName;
- Patronymic: TPatronymic;
- City: TCity;
- DateofPay: TDateOfPay;
- begin
- DateOfPayLabel.caption := dateToStr(Now);
- PaySpinEdit.Value := 0;
- turnLabelsOff();
- end;
- function TCorrectForm.areEditsCorrect(): boolean;
- begin
- Result := (EditForm.IsCorrectNumberData(TelephoneEdit) and EditForm.IsCorrectTextData(SurnameEdit) and
- EditForm.IsCorrectTextData(NameEdit) and EditForm.IsCorrectTextData(PatronymicEdit) and
- EditForm.IsCorrectTextData(CityEdit) and
- AddForm.areEditsFilled(TelephoneEdit, SurnameEdit, NameEdit, PatronymicEdit, CityEdit));
- end;
- procedure TCorrectForm.SaveButtonClick(Sender: TObject);
- var
- TelephoneNumber: TTelephoneNumber;
- Surname: TSurname;
- Name: TName;
- Patronymic: TPatronymic;
- City: TCity;
- DateofPay: TDateOfPay;
- SameSubscriberIndex: integer;
- RequiredSubscriber: TRequiredSubscriber;
- begin
- SameSubscriberIndex := -1;
- TelephoneNumber := toTelephoneNumber(TelephoneEdit.text);
- Surname := toSurname(SurnameEdit.Text);
- Name := toName(NameEdit.Text);
- Patronymic := toPatronymic(PatronymicEdit.Text);
- City := toCity(CityEdit.Text);
- DateOfPay := toDateOfPay(strToDate(DateOfPayLabel.Caption), PaySpinEdit.Value);
- PaySpinEdit.Value := 0;
- EditForm.getRequiredSubscriber(RequiredSubscriber, TelephoneEdit.text, SurnameEdit.text, NameEdit.text,
- PatronymicEdit.text, CityEdit.text);
- if isExist(RequiredSubscriber, SameSubscriberIndex)
- and (not(SubscriberIndex = SameSubscriberIndex)) then
- SubscriberExistsLabel.Visible := true
- else
- begin
- if (not areEditsCorrect()) then
- WrongDataLabel.Visible := true
- else
- begin
- write(SubscriberIndex, TelephoneNumber, Surname, Name, Patronymic, City,
- DateofPay);
- showSavedInfo();
- SuccessLabel.Visible := true;
- end;
- end;
- end;
- procedure TCorrectForm.FormClose(Sender: TObject; var Action: TCloseAction);
- begin
- EditForm.enabled := true;
- PaySpinEdit.value := 0;
- end;
- procedure TCorrectForm.FormKeyPress(Sender: TObject; var Key: Char);
- begin
- if key = #27 then
- AddForm.Close()
- else
- if Key = #13 then
- SaveButtonClick(Sender);
- end;
- procedure TCorrectForm.FormShow(Sender: TObject);
- begin
- showSavedInfo();
- end;
- procedure TCorrectForm.InstructionMenuClick(Sender: TObject);
- begin
- MessageDlg('This is the correction window. Here you can change current subscriber''s data.'
- + #13#10 + 'After clicking "Save" you will see label with result:'
- + #13#10 + '1. "Changes saved" - you succesfully changed.'
- + #13#10 + '2. "Subscriber exists" - subscriber with this data already exists.'
- + #13#10 + '3. "Wront input" - some fileds are filled incorrectly.' + #13#10 +
- 'Right input:' + #13#10 +
- 'a) Telephone number field: first char - "+" or digit and next are digits; length = 13;'
- + #13#10 + 'b) Text fields: first char - big letter and next are small letters. Length:'
- + #13#10 + 'City -11, Surname - 14, Name - 11, Patronymic - 14.' + #13#10
- + #13#10 + 'Field can not be empty.' + #13#10
- + #13#10 + 'In the field "Payment" you should input the amount of money paid'
- + #13#10 + 'Use menu button "Update" or press "ctrl + r" to show saved data;'
- + #13#10 + 'Use button "Reset payment" to change payment day for today''s date;'
- + #13#10 + #13#10 + 'Press "ctrl + i" to open instruction;'
- + #13#10 + 'Press "enter" to save changes;' +
- #13#10 + 'Press "esc" to go back to edit widnow.', MtInformation, [mbOk], 0);
- end;
- procedure TCorrectForm.deleteSpaces();
- var
- Edit: TEdit;
- i: integer;
- BufferString: string;
- begin
- for Edit in [SurnameEdit, NameEdit, PatronymicEdit, TelephoneEdit, CityEdit] do
- begin
- BufferString := Edit.text;
- Edit.text := '';
- for i := 1 to length(BufferString) do
- if BufferString[i] <> ' ' then
- Edit.text := Edit.text + BufferString[i];
- end;
- end;
- procedure TCorrectForm.showSavedInfo();
- var
- CurrentSubscriber: TSubscriber;
- DateString: string;
- begin
- CurrentSubscriber := getSubscriber(SubscriberIndex, DateString);
- TelephoneEdit.text := CurrentSubscriber.telephoneNumber;
- SurnameEdit.text := CurrentSubscriber.surname;
- NameEdit.text := CurrentSubscriber.name;
- PatronymicEdit.text := CurrentSubscriber.patronymic;
- CityEdit.text := CurrentSubscriber.city;
- deleteSpaces;
- DateOfPayLabel.caption := DateString;
- PaySpinEdit.Value := 0;
- turnLabelsOff();
- end;
- procedure TCorrectForm.TextEditKeyPress(Sender: TObject; var Key: Char);
- begin
- AddForm.TextEditKeyPress(Sender, Key);
- end;
- procedure TCorrectForm.SomeEditChange(Sender: TObject);
- begin
- turnLabelsOff();
- end;
- procedure TCorrectForm.TelephoneEditKeyPress(Sender: TObject; var Key: Char);
- begin
- AddForm.TelephoneKeyPress(Sender, Key);
- end;
- procedure TCorrectForm.TurnLabelsOff();
- begin
- SuccessLabel.visible := false;
- WrongDataLabel.visible := false;
- SubscriberExistsLabel.visible := false;
- end;
- procedure TCorrectForm.UpdateMenuClick(Sender: TObject);
- begin
- showSavedInfo();
- end;
- end.
- unit AddUnit;
- interface
- uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Menus, Vcl.Samples.Spin, EditUnit;
- type
- TAddForm = class(TForm)
- NameLabel: TLabel;
- SurnameLabel: TLabel;
- PatronymicLabel: TLabel;
- CityLabel: TLabel;
- DateLabel: TLabel;
- TelephoneLabel: TLabel;
- TelephoneEdit: TEdit;
- NameEdit: TEdit;
- SurnameEdit: TEdit;
- PatronymicEdit: TEdit;
- CItyEdit: TEdit;
- TaskLabel: TLabel;
- AddButton: TButton;
- MainMenu: TMainMenu;
- InstructionMenu: TMenuItem;
- SubscriberAddedLabel: TLabel;
- PaymentEdit: TSpinEdit;
- WrongDataLabel: TLabel;
- SubscriberExistsLabel: TLabel;
- procedure AddButtonClick(Sender: TObject);
- procedure SomeEditChange(Sender: TObject);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure turnLabelsOff();
- procedure InstructionMenuClick(Sender: TObject);
- procedure TextEditKeyPress(Sender: TObject; var Key: Char);
- procedure TelephoneKeyPress(Sender: TObject; var Key: Char);
- procedure FormKeyPress(Sender: TObject; var Key: Char);
- procedure FormShow(Sender: TObject);
- function areEditsFilled(TelephoneEdit, SurnameEdit, NameEdit, FathernameEdit, CityEdit: TEdit): boolean;
- function areEditsCorrect(): boolean;
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- var
- AddForm: TAddForm;
- implementation
- {$R *.dfm}
- uses
- ReadUnit, WriteUnit, ListUnit, StartUnit;
- const
- BIG_LETTERS = ['A'..'Z'];
- SMALL_LETTERS = ['a'..'z'];
- DIGITS = ['0'..'9'];
- procedure TAddForm.AddButtonClick(Sender: TObject);
- var
- TelephoneNumber: TTelephoneNumber;
- Surname: TSurname;
- Name: TName;
- Patronymic: TPatronymic;
- City: TCity;
- DateofPay: TDateOfPay;
- Buff: integer;
- SameSubscriberIndex: integer;
- RequiredSubscriber: TRequiredSubscriber;
- begin
- TelephoneNumber := toTelephoneNumber(TelephoneEdit.text);
- Surname := toSurname(SurnameEdit.Text);
- Name := toName(NameEdit.Text);
- Patronymic := toPatronymic(PatronymicEdit.Text);
- City := toCity(CityEdit.Text);
- buff := PaymentEdit.value;
- DateOfPay := toDateOfPay(Now, PaymentEdit.value);
- TurnLabelsOff();
- EditForm.getRequiredSubscriber(RequiredSubscriber, TelephoneEdit.text, SurnameEdit.text, NameEdit.text,
- PatronymicEdit.text, CityEdit.text);
- if isExist(RequiredSubscriber, SameSubscriberIndex) then
- SubscriberExistsLabel.Visible := true
- else
- begin
- if not areEditsCorrect() then
- WrongDataLabel.Visible := true
- else
- begin
- write(TelephoneNumber, Surname, Name, Patronymic, City, DateofPay);
- SubscriberAddedLabel.Visible := true;
- end;
- end;
- end;
- function TAddForm.areEditsFilled(TelephoneEdit, SurnameEdit, NameEdit, FathernameEdit, CityEdit: TEdit): boolean;
- begin
- Result := ((TelephoneEdit.text <> '') and (SurnameEdit.text <> '') and (FathernameEdit.text <> '')
- and (NameEdit.text <> '') and (CityEdit.text <> ''));
- end;
- function TAddForm.areEditsCorrect(): boolean;
- begin
- Result := (EditForm.IsCorrectNumberData(TelephoneEdit) and EditForm.IsCorrectTextData(SurnameEdit) and
- EditForm.IsCorrectTextData(NameEdit) and EditForm.IsCorrectTextData(PatronymicEdit) and
- EditForm.IsCorrectTextData(CityEdit) and
- areEditsFilled(TelephoneEdit, SurnameEdit, NameEdit, PatronymicEdit, CityEdit));
- end;
- procedure TAddForm.FormClose(Sender: TObject; var Action: TCloseAction);
- var
- Edit: TEdit;
- begin
- EditForm.enabled := true;
- TurnLabelsOff();
- for Edit in [SurnameEdit, NameEdit, PatronymicEdit, TelephoneEdit, CityEdit] do
- Edit.text := '';
- PaymentEdit.value := 0;
- end;
- procedure TAddForm.FormKeyPress(Sender: TObject; var Key: Char);
- begin
- if key = #27 then
- AddForm.Close()
- else
- if Key = #13 then
- AddButtonClick(Sender);
- end;
- procedure TAddForm.FormShow(Sender: TObject);
- var
- Edit: TEdit;
- begin
- for Edit in [SurnameEdit, NameEdit, PatronymicEdit, TelephoneEdit, CityEdit] do
- Edit.text := '';
- end;
- procedure TAddForm.InstructionMenuClick(Sender: TObject);
- begin
- MessageDlg('This is the add window. Here you can add a new subscriber to database.' + #13#10
- + #13#10 + 'After clicking "add" you will see label with result:'
- + #13#10 + '1. "Subscriber added" - you succesfully added a new person.'
- + #13#10 + '2. "Subscriber exists" - subscriber with this data already exists.'
- + #13#10 + '3. "Wront input" - some fileds are filled incorrectly.' + #13#10
- + 'Right input:' + #13#10 +
- 'a) Telephone number field: first char - "+" or digit and next are digits; length = 13;'
- + #13#10 + 'b) Text fields: first char - big letter and next are small letters. Length:'
- + #13#10 + 'City - 11, Surname - 14, Name - 11, Patronymic - 14.'
- + #13#10 + 'Field can not be empty.' + #13#10
- + #13#10 + 'In the field "Payment" you should input the amount of money paid'
- + #13#10 + #13#10 + 'Press "ctrl + i" to open instruction;'
- + #13#10 + 'Press "enter" to add subscriber;'
- + #13#10 + 'Press "esc" to go back to edit widnow.', MtInformation, [mbOk], 0);
- end;
- procedure TAddForm.SomeEditChange(Sender: TObject);
- begin
- turnLabelsOff();
- end;
- procedure TAddForm.TextEditKeyPress(Sender: TObject; var Key: Char);
- begin
- if (Key <> #08) then
- begin
- if length((Sender as TEdit).text) = 0 then
- begin
- if not (Key in BIG_LETTERS) then
- Key := #0
- end
- else if not(Key in SMALL_LETTERS) then
- Key := #0;
- end;
- end;
- procedure TAddForm.TelephoneKeyPress(Sender: TObject; var Key: Char);
- begin
- if (Key <> #08) then
- begin
- if length((Sender as TEdit).text) = 0 then
- begin
- if ((not(Key in DIGITS)) and (Key <> '+')) then
- Key := #0
- end
- else if not(Key in DIGITS) then
- Key := #0;
- end;
- end;
- procedure TAddForm.TurnLabelsOff();
- begin
- SubscriberAddedLabel.Visible := false;
- SubscriberExistsLabel.Visible := false;
- WrongDataLabel.Visible := false;
- end;
- end.
- unit AddUnit;
- interface
- uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Menus, Vcl.Samples.Spin, EditUnit;
- type
- TAddForm = class(TForm)
- NameLabel: TLabel;
- SurnameLabel: TLabel;
- PatronymicLabel: TLabel;
- CityLabel: TLabel;
- DateLabel: TLabel;
- TelephoneLabel: TLabel;
- TelephoneEdit: TEdit;
- NameEdit: TEdit;
- SurnameEdit: TEdit;
- PatronymicEdit: TEdit;
- CItyEdit: TEdit;
- TaskLabel: TLabel;
- AddButton: TButton;
- MainMenu: TMainMenu;
- InstructionMenu: TMenuItem;
- SubscriberAddedLabel: TLabel;
- PaymentEdit: TSpinEdit;
- WrongDataLabel: TLabel;
- SubscriberExistsLabel: TLabel;
- procedure AddButtonClick(Sender: TObject);
- procedure SomeEditChange(Sender: TObject);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure turnLabelsOff();
- procedure InstructionMenuClick(Sender: TObject);
- procedure TextEditKeyPress(Sender: TObject; var Key: Char);
- procedure TelephoneKeyPress(Sender: TObject; var Key: Char);
- procedure FormKeyPress(Sender: TObject; var Key: Char);
- procedure FormShow(Sender: TObject);
- function areEditsFilled(TelephoneEdit, SurnameEdit, NameEdit, FathernameEdit, CityEdit: TEdit): boolean;
- function areEditsCorrect(): boolean;
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- var
- AddForm: TAddForm;
- implementation
- {$R *.dfm}
- uses
- ReadUnit, WriteUnit, ListUnit, StartUnit;
- const
- BIG_LETTERS = ['A'..'Z'];
- SMALL_LETTERS = ['a'..'z'];
- DIGITS = ['0'..'9'];
- procedure TAddForm.AddButtonClick(Sender: TObject);
- var
- TelephoneNumber: TTelephoneNumber;
- Surname: TSurname;
- Name: TName;
- Patronymic: TPatronymic;
- City: TCity;
- DateofPay: TDateOfPay;
- Buff: integer;
- SameSubscriberIndex: integer;
- RequiredSubscriber: TRequiredSubscriber;
- begin
- TelephoneNumber := toTelephoneNumber(TelephoneEdit.text);
- Surname := toSurname(SurnameEdit.Text);
- Name := toName(NameEdit.Text);
- Patronymic := toPatronymic(PatronymicEdit.Text);
- City := toCity(CityEdit.Text);
- buff := PaymentEdit.value;
- DateOfPay := toDateOfPay(Now, PaymentEdit.value);
- TurnLabelsOff();
- EditForm.getRequiredSubscriber(RequiredSubscriber, TelephoneEdit.text, SurnameEdit.text, NameEdit.text,
- PatronymicEdit.text, CityEdit.text);
- if isExist(RequiredSubscriber, SameSubscriberIndex) then
- SubscriberExistsLabel.Visible := true
- else
- begin
- if not areEditsCorrect() then
- WrongDataLabel.Visible := true
- else
- begin
- write(TelephoneNumber, Surname, Name, Patronymic, City, DateofPay);
- SubscriberAddedLabel.Visible := true;
- end;
- end;
- end;
- function TAddForm.areEditsFilled(TelephoneEdit, SurnameEdit, NameEdit, FathernameEdit, CityEdit: TEdit): boolean;
- begin
- Result := ((TelephoneEdit.text <> '') and (SurnameEdit.text <> '') and (FathernameEdit.text <> '')
- and (NameEdit.text <> '') and (CityEdit.text <> ''));
- end;
- function TAddForm.areEditsCorrect(): boolean;
- begin
- Result := (EditForm.IsCorrectNumberData(TelephoneEdit) and EditForm.IsCorrectTextData(SurnameEdit) and
- EditForm.IsCorrectTextData(NameEdit) and EditForm.IsCorrectTextData(PatronymicEdit) and
- EditForm.IsCorrectTextData(CityEdit) and
- areEditsFilled(TelephoneEdit, SurnameEdit, NameEdit, PatronymicEdit, CityEdit));
- end;
- procedure TAddForm.FormClose(Sender: TObject; var Action: TCloseAction);
- var
- Edit: TEdit;
- begin
- EditForm.enabled := true;
- TurnLabelsOff();
- for Edit in [SurnameEdit, NameEdit, PatronymicEdit, TelephoneEdit, CityEdit] do
- Edit.text := '';
- PaymentEdit.value := 0;
- end;
- procedure TAddForm.FormKeyPress(Sender: TObject; var Key: Char);
- begin
- if key = #27 then
- AddForm.Close()
- else
- if Key = #13 then
- AddButtonClick(Sender);
- end;
- procedure TAddForm.FormShow(Sender: TObject);
- var
- Edit: TEdit;
- begin
- for Edit in [SurnameEdit, NameEdit, PatronymicEdit, TelephoneEdit, CityEdit] do
- Edit.text := '';
- end;
- procedure TAddForm.InstructionMenuClick(Sender: TObject);
- begin
- MessageDlg('This is the add window. Here you can add a new subscriber to database.' + #13#10
- + #13#10 + 'After clicking "add" you will see label with result:'
- + #13#10 + '1. "Subscriber added" - you succesfully added a new person.'
- + #13#10 + '2. "Subscriber exists" - subscriber with this data already exists.'
- + #13#10 + '3. "Wront input" - some fileds are filled incorrectly.' + #13#10
- + 'Right input:' + #13#10 +
- 'a) Telephone number field: first char - "+" or digit and next are digits; length = 13;'
- + #13#10 + 'b) Text fields: first char - big letter and next are small letters. Length:'
- + #13#10 + 'City - 11, Surname - 14, Name - 11, Patronymic - 14.'
- + #13#10 + 'Field can not be empty.' + #13#10
- + #13#10 + 'In the field "Payment" you should input the amount of money paid'
- + #13#10 + #13#10 + 'Press "ctrl + i" to open instruction;'
- + #13#10 + 'Press "enter" to add subscriber;'
- + #13#10 + 'Press "esc" to go back to edit widnow.', MtInformation, [mbOk], 0);
- end;
- procedure TAddForm.SomeEditChange(Sender: TObject);
- begin
- turnLabelsOff();
- end;
- procedure TAddForm.TextEditKeyPress(Sender: TObject; var Key: Char);
- begin
- if (Key <> #08) then
- begin
- if length((Sender as TEdit).text) = 0 then
- begin
- if not (Key in BIG_LETTERS) then
- Key := #0
- end
- else if not(Key in SMALL_LETTERS) then
- Key := #0;
- end;
- end;
- procedure TAddForm.TelephoneKeyPress(Sender: TObject; var Key: Char);
- begin
- if (Key <> #08) then
- begin
- if length((Sender as TEdit).text) = 0 then
- begin
- if ((not(Key in DIGITS)) and (Key <> '+')) then
- Key := #0
- end
- else if not(Key in DIGITS) then
- Key := #0;
- end;
- end;
- procedure TAddForm.TurnLabelsOff();
- begin
- SubscriberAddedLabel.Visible := false;
- SubscriberExistsLabel.Visible := false;
- WrongDataLabel.Visible := false;
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement