Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit Lab_4_2_Form;
- interface
- uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls;
- type
- TForm_4_2 = class(TForm)
- MainMenu1: TMainMenu;
- NFile: TMenuItem;
- NOpenFile: TMenuItem;
- NSaveFile: TMenuItem;
- NInstruction: TMenuItem;
- NAbout: TMenuItem;
- LabelTask: TLabel;
- LabelDeleteOperation: TLabel;
- LabelInsertOperation: TLabel;
- LabelChangeOperation: TLabel;
- ButtonOpenTask: TButton;
- EditDeleteOperation: TEdit;
- EditInsertOperation: TEdit;
- EditChangeOperation: TEdit;
- ButtonFindPrice: TButton;
- LabelFinalPrice: TLabel;
- EditFinalPrice: TEdit;
- OpenDialog1: TOpenDialog;
- SaveDialog1: TSaveDialog;
- LabelSourceString: TLabel;
- EditSourceString: TEdit;
- EditDesiredString: TEdit;
- LabelDesiredString: TLabel;
- procedure NAboutClick(Sender: TObject);
- procedure ButtonOpenTaskClick(Sender: TObject);
- procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- procedure EditDeleteOperationKeyPress(Sender: TObject; var Key: Char);
- procedure EditInsertOperationKeyPress(Sender: TObject; var Key: Char);
- procedure EditChangeOperationKeyPress(Sender: TObject; var Key: Char);
- procedure NInstructionClick(Sender: TObject);
- procedure EditDeleteOperationChange(Sender: TObject);
- procedure EditInsertOperationChange(Sender: TObject);
- procedure EditChangeOperationChange(Sender: TObject);
- procedure EditSourceStringChange(Sender: TObject);
- procedure EditDesiredStringChange(Sender: TObject);
- procedure ButtonFindPriceClick(Sender: TObject);
- procedure NOpenFileClick(Sender: TObject);
- procedure NSaveFileClick(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- var
- Form_4_2: TForm_4_2;
- implementation
- {$R *.dfm}
- uses UnitAbout, UnitError, UnitExit, UnitInstruction_4_2, UnitTask_4_2;
- const
- MAX_VALUE = 1000;
- MIN_VALUE = 0;
- MAX_STR = 200;
- MIN_STR = 1;
- function DelAndInsert(X, Y: String; I, CostDel, CostIns, Count: Integer; var Price: Integer): Integer;
- begin
- if I <= Count then
- begin
- Delete(X, I, 1);
- Insert(Y[I], X, I);
- Price := CostDel + CostIns + DelAndInsert(X, Y, (I + 1), CostDel, CostIns, Count, Price);
- end;
- DelAndInsert := Price;
- end;
- function ChangeElement(var X, Y: String; I, CostCh, Count: Integer; var Price: Integer): Integer;
- begin
- if I <= Count then
- begin
- X[I] := Y[I];
- Price := CostCh + ChangeElement(X, Y, (I + 1), CostCh, Count, Price);
- end;
- ChangeElement := Price;
- end;
- function FindInterimPrice(X, Y: String; CostDelete, CostInsert, CostChange, Count: Integer): Integer;
- var
- I, Answer: Integer;
- begin
- Answer := 0;
- if ((CostDelete + CostInsert) < CostChange) then
- FindInterimPrice := DelAndInsert(X, Y, 1, CostDelete, CostInsert, Count, Answer)
- else
- FindInterimPrice := ChangeElement(X, Y, 1, CostChange, Count, Answer);
- end;
- procedure TForm_4_2.ButtonFindPriceClick(Sender: TObject);
- var
- X, Y: String[200];
- CostInsert, CostDelete, CostChange, Count, FinalPrice: Integer;
- IsCorrect: Boolean;
- Error: String;
- begin
- //EditFinalPrice.Text := IntToStr(FindInterimPrice(X, Y, CostDelete, CostInsert, CostChange, Count));
- IsCorrect := true;
- Error := '';
- FinalPrice := 0;
- Try
- CostDelete := StrToInt(EditDeleteOperation.Text);
- if (CostDelete > MAX_VALUE) or (CostDelete < MIN_VALUE) then
- begin
- IsCorrect := false;
- Error := 'Цена удаления элемента не входит в допустимый диапазон. ';
- end;
- CostInsert := StrToInt(EditInsertOperation.Text);
- if (CostInsert > MAX_VALUE) or (CostInsert < MIN_VALUE) then
- begin
- IsCorrect := false;
- Error := Error + 'Цена вставки элемента не входит в допустимый диапазон. ';
- end;
- CostChange := StrToInt(EditChangeOperation.Text);
- if (CostChange > MAX_VALUE) or (CostChange < MIN_VALUE) then
- begin
- IsCorrect := false;
- Error := Error + 'Цена замены элемента не входит в допустимый диапазон. ';
- end;
- X := EditSourceString.Text;
- if (Length(X) > MAX_STR) or (Length(X) < MIN_STR) then
- begin
- IsCorrect := false;
- Error := 'Длина исходной строки не входит в допустимый диапазон. ';
- end;
- Y := EditDesiredString.Text;
- if (Length(Y) > MAX_STR) or (Length(Y) < MIN_STR) then
- begin
- IsCorrect := false;
- Error := 'Длина желаемой строки не входит в допустимый диапазон. ';
- end;
- Except
- IsCorrect := false;
- Error := Error + 'Некорректно введено одно из значений цены. ';
- End;
- if (IsCorrect) then
- begin
- if (Length(X) = Length(Y)) then
- begin
- Count := Length(Y);
- FinalPrice := FindInterimPrice(X, Y, CostDelete, CostInsert, CostChange, Count);
- end
- else
- begin
- if Length(X) < (Length(Y)) then
- begin
- Count := Length(X);
- FinalPrice := FindInterimPrice(X, Y, CostDelete, CostInsert, CostChange, Count);
- FinalPrice := FinalPrice + CostInsert * (Length(Y) - Length(X));
- end
- else
- begin
- Count := Length(Y);
- FinalPrice := FindInterimPrice(X, Y, CostDelete, CostInsert, CostChange, Count);
- FinalPrice := FinalPrice + CostDelete * (Length(X) - Length(Y));
- end;
- end;
- EditFinalPrice.Text := IntToStr(FinalPrice);
- NSaveFile.Enabled := true;
- end
- else
- begin
- UnitError.FormError.LabelError.Caption := 'Ошибка! ' + Error;
- UnitError.FormError.ShowModal();
- UnitError.FormError.LabelError.Caption := '';
- end;
- end;
- procedure TForm_4_2.ButtonOpenTaskClick(Sender: TObject);
- begin
- UnitTask_4_2.FormTask_4_2.ShowModal();
- end;
- procedure TForm_4_2.EditChangeOperationChange(Sender: TObject);
- begin
- if (EditDeleteOperation.Text = '') or (EditInsertOperation.Text = '')
- or (EditSourceString.Text = '') or (EditDesiredString.Text = '')
- or (EditChangeOperation.Text = '') then
- ButtonFindPrice.Enabled := false
- else
- ButtonFindPrice.Enabled := true;
- EditFinalPrice.Text := '';
- end;
- procedure TForm_4_2.EditChangeOperationKeyPress(Sender: TObject; var Key: Char);
- begin
- if not(Key in [#8, #13, '0'..'9']) then
- Key := #0;
- if (Length(EditChangeOperation.Text) = 0) and (Key in [#13, '0']) then
- Key := #0;
- if (Length(EditChangeOperation.Text) = 1) and not(EditChangeOperation.Text[1] = '1') then
- EditChangeOperation.MaxLength := 3;
- if (Length(EditChangeOperation.Text) = 3) and not(EditChangeOperation.Text = '100') then
- EditChangeOperation.MaxLength := 3
- else
- EditChangeOperation.MaxLength := 4;
- if (Length(EditChangeOperation.Text) = 3) and (EditChangeOperation.Text = '100') and not(Length(EditChangeOperation.SelText) > 0) and not(Key in ['0', #8, #13]) then
- Key := #0;
- if (Length(EditChangeOperation.SelText) > 0) and (Key = '0') then
- Key := #0;
- //if (Length(EditChangeOperation.Text) > 0) and (Key = #13) then
- // ButtonFindAnswerClick(Sender);
- end;
- procedure TForm_4_2.EditDeleteOperationChange(Sender: TObject);
- begin
- if (EditInsertOperation.Text = '') or (EditChangeOperation.Text = '')
- or (EditSourceString.Text = '') or (EditDesiredString.Text = '')
- or (EditDeleteOperation.Text = '') then
- ButtonFindPrice.Enabled := false
- else
- ButtonFindPrice.Enabled := true;
- EditFinalPrice.Text := '';
- end;
- procedure TForm_4_2.EditDeleteOperationKeyPress(Sender: TObject; var Key: Char);
- begin
- if not(Key in [#8, #13, '0'..'9']) then
- Key := #0;
- if (Length(EditDeleteOperation.Text) = 0) and (Key in [#13, '0']) then
- Key := #0;
- if (Length(EditDeleteOperation.Text) = 1) and not(EditDeleteOperation.Text[1] = '1') then
- EditDeleteOperation.MaxLength := 3;
- if (Length(EditDeleteOperation.Text) = 3) and not(EditDeleteOperation.Text = '100') then
- EditDeleteOperation.MaxLength := 3
- else
- EditDeleteOperation.MaxLength := 4;
- if (Length(EditDeleteOperation.Text) = 3) and (EditDeleteOperation.Text = '100') and not(Length(EditDeleteOperation.SelText) > 0) and not(Key in ['0', #8, #13]) then
- Key := #0;
- if (Length(EditDeleteOperation.SelText) > 0) and (Key = '0') then
- Key := #0;
- //if (Length(EditDeleteOperation.Text) > 0) and (Key = #13) then
- // ButtonFindPrice(Sender);
- end;
- procedure TForm_4_2.EditDesiredStringChange(Sender: TObject);
- begin
- if (EditDeleteOperation.Text = '') or (EditInsertOperation.Text = '')
- or (EditChangeOperation.Text = '') or (EditSourceString.Text = '')
- or (EditDesiredString.Text = '') then
- ButtonFindPrice.Enabled := false
- else
- ButtonFindPrice.Enabled := true;
- EditFinalPrice.Text := '';
- end;
- procedure TForm_4_2.EditInsertOperationChange(Sender: TObject);
- begin
- if (EditDeleteOperation.Text = '') or (EditChangeOperation.Text = '')
- or (EditSourceString.Text = '') or (EditDesiredString.Text = '')
- or (EditInsertOperation.Text = '') then
- ButtonFindPrice.Enabled := false
- else
- ButtonFindPrice.Enabled := true;
- EditFinalPrice.Text := '';
- end;
- procedure TForm_4_2.EditInsertOperationKeyPress(Sender: TObject; var Key: Char);
- begin
- if not(Key in [#8, #13, '0'..'9']) then
- Key := #0;
- if (Length(EditInsertOperation.Text) = 0) and (Key in [#13, '0']) then
- Key := #0;
- if (Length(EditInsertOperation.Text) = 1) and not(EditInsertOperation.Text[1] = '1') then
- EditInsertOperation.MaxLength := 3;
- if (Length(EditInsertOperation.Text) = 3) and not(EditInsertOperation.Text = '100') then
- EditInsertOperation.MaxLength := 3
- else
- EditInsertOperation.MaxLength := 4;
- if (Length(EditInsertOperation.Text) = 3) and (EditInsertOperation.Text = '100') and not(Length(EditInsertOperation.SelText) > 0) and not(Key in ['0', #8, #13]) then
- Key := #0;
- if (Length(EditInsertOperation.SelText) > 0) and (Key = '0') then
- Key := #0;
- //if (Length(EditInsertOperation.Text) > 0) and (Key = #13) then
- // ButtonFindAnswerClick(Sender);
- end;
- procedure TForm_4_2.EditSourceStringChange(Sender: TObject);
- begin
- if (EditDeleteOperation.Text = '') or (EditInsertOperation.Text = '')
- or (EditChangeOperation.Text = '') or (EditDesiredString.Text = '')
- or (EditSourceString.Text = '') then
- ButtonFindPrice.Enabled := false
- else
- ButtonFindPrice.Enabled := true;
- EditFinalPrice.Text := '';
- end;
- procedure TForm_4_2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- Var
- Res: Integer;
- begin
- Res := UnitExit.FormExit.ShowModal();
- If Res = mrOk Then
- CanClose := True
- Else
- CanClose := False;
- end;
- procedure TForm_4_2.NAboutClick(Sender: TObject);
- begin
- UnitAbout.FormAbout.ShowModal();
- end;
- procedure TForm_4_2.NInstructionClick(Sender: TObject);
- begin
- UnitInstruction_4_2.FormInstruction.ShowModal();
- end;
- procedure TForm_4_2.NOpenFileClick(Sender: TObject);
- var
- F: TextFile;
- Path, Error, SourceStr, DesiredStr: String;
- CostDelete, CostInsert, CostChange: Integer;
- IsCorrect: Boolean;
- begin
- IsCorrect := true;
- Error := '';
- if OpenDialog1.Execute() then
- begin
- Path := OpenDialog1.FileName;
- AssignFile(F, Path);
- try
- Reset(F);
- try
- Readln(F, CostDelete);
- if (CostDelete < MIN_VALUE) or (CostDelete > MAX_VALUE) then
- begin
- IsCorrect := false;
- Error := Error + 'Значение цены удаления элемента не входит в допустимый диапазон. ';
- end;
- if EoF(F) then
- begin
- IsCorrect := false;
- Error := 'В файле недостаточно элементов. ';
- end
- else
- Readln(F, CostInsert);
- if (CostInsert < MIN_VALUE) or (CostInsert > MAX_VALUE) then
- begin
- IsCorrect := false;
- Error := Error + 'Значение цены вставки элемента не входит в допустимый диапазон. ';
- end;
- if EoF(F) then
- begin
- IsCorrect := false;
- Error := 'В файле недостаточно элементов. ';
- end
- else
- Readln(F, CostChange);
- if (CostChange < MIN_VALUE) or (CostChange > MAX_VALUE) then
- begin
- IsCorrect := false;
- Error := Error + 'Значение цены замены элемента не входит в допустимый диапазон. ';
- end;
- if EoF(F) then
- begin
- IsCorrect := false;
- Error := 'В файле недостаточно элементов. ';
- end
- else
- Readln(F, SourceStr);
- if (length(SourceStr) < MIN_STR) or (length(SourceStr) > MAX_STR) then
- begin
- IsCorrect := false;
- Error := Error + 'Длина исходной строки не входит в диапазон допустимых значений. ';
- end;
- if EoF(F) then
- begin
- IsCorrect := false;
- Error := 'В файле недостаточно элементов. ';
- end
- else
- Readln(F, DesiredStr);
- if (length(DesiredStr) < MIN_STR) or (length(DesiredStr) > MAX_STR) then
- begin
- IsCorrect := false;
- Error := Error + 'Длина желаемой строки не входит в диапазон допустимых значений. ';
- end;
- if not(EoF(F)) then
- begin
- IsCorrect := false;
- Error := 'В файле найдены лишние элементы. ';
- end;
- except
- IsCorrect := false;
- Error := 'Найдено некорректное значение в файле. ';
- end;
- CloseFile(F);
- except
- IsCorrect := False;
- Error := Error + 'Нет доступа к файлу';
- end;
- end;
- if not(IsCorrect) then
- begin
- UnitError.FormError.LabelError.Caption := 'Ошибка считывания с файла. ' + Error;
- UnitError.FormError.ShowModal();
- UnitError.FormError.LabelError.Caption := '';
- end
- else
- begin
- EditDeleteOperation.Text := IntToStr(CostDelete);
- EditInsertOperation.Text := IntToStr(CostInsert);
- EditChangeOperation.Text := IntToStr(CostChange);
- EditSourceString.Text := SourceStr;
- EditDesiredString.Text := DesiredStr;
- end;
- end;
- procedure TForm_4_2.NSaveFileClick(Sender: TObject);
- var
- SaveFile: TextFile;
- SavePath, Error: String;
- Answer: Integer;
- IsCorrect: Boolean;
- begin
- IsCorrect := True;
- Error := '';
- if SaveDialog1.Execute() then
- begin
- SavePath := SaveDialog1.FileName;
- AssignFile(SaveFile, SavePath);
- Try
- Rewrite(SaveFile);
- Try
- Writeln(SaveFile, 'Полученная стоимость: ', EditFinalPrice.Text);
- Finally
- CloseFile(SaveFile);
- End;
- Except
- IsCorrect := False;
- Error := 'Нет доступа к файлу';
- End;
- if not(IsCorrect) then
- begin
- UnitError.FormError.LabelError.Caption := 'Ошибка считывания с файла. ' + Error;
- UnitError.FormError.ShowModal();
- UnitError.FormError.LabelError.Caption := '';
- end
- else
- NSaveFile.Enabled := false;
- end;
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement