@David からの入力に基づいて、投稿を編集してより多くのコード (メイン プロシージャと 2 つの関数) を含めました。問題は同じままです。
値の配列にアルファ文字 (無効になる) が含まれているかどうかを確認したいので、値を というCheckForAlphaInArray別の関数から関数に渡しますGetYValues。英字が見つかった場合CheckForAlphaInArrayは、無効な文字であることをユーザーに警告し、アプリケーションを中止して最後に終了し、ユーザーがエラーを修正できるようにします。次のコードは、アプリケーションを閉じないことを除いてすべてを実行します。代わりに、コードの次の行に移動します。閉まらないのはなぜ？なども使っCloseてみfrmMain.Closeました。動作しませんでした。
ありがとう。
procedure TfrmMain.actRunExecute(Sender: TObject);
//Run the program using the user-input options in the Analysis Options form
var
I, K, NumValues, PercentResponse, ConfPercent, PredPercent: integer;
Header, EstimatedValues, CIHeader_L, CIHeader_U,
PIHeader_L, PIHeader_U: string;
C: char;
EC, HS, SumSqDevX, SumSqDevY, SumCrossProds,
SumSqDev_YX, MnSumSqDev_YX,
InputConsMinValue,
InputConsMaxValue: double;
InputFile: TStringList;
X_Array, Y_Array, YHat_Array, SqDevX_Array, SqDevY_Array,
CrossProds_Array, SD_YX_Array, CILL_Array,
CIUL_Array, SENewY_Array, PILL_Array, PIUL_Array: TVal_Array;
MyFile: TextFile;
const Letters = ['A'..'Z', 'a'..'z', ',', ' '];
const Numeric = ['0'..'9', ',', ' '];
begin
ProgressLabel.Caption := '';
if not (FormSaved = 'Form Saved') then //if user has saved options form
MessageDlgPos('Please enter and save analysis options first.',
mtError, [mbOK], 0, 300, 300)
else
begin
Memo1.Clear;
Gauge1.Progress := 0;
InputFile := TStringList.Create;
OutputFile := TStringList.Create;;
try
InputFile.LoadFromFile(OpenDialog1.FileName);
{if data contains a header row, K = 1, else K = 0 }
//initialize K to an absurd number
K := 9999;
Header := InputFile[0];
for I := 1 to Length(Header) do
begin
C := Header[I];
if CharInSet(C, Letters) then K := 1
else if CharInSet(C, Numeric) then K := 0;
end;
//call error if K has not changed to either 0 or 1
if (K = 9999) then
MessageDlgPos('There is an illegal character in the first' +
'row of your data. Please fix it.', mtError,
[mbOK], 0, 300, 300);
//initialize X and Y arrays
SetLength(X_Array, InputFile.Count - K);
SetLength(Y_Array, InputFile.Count - K);
//Get X and Y values
X_Array := GetXValues(K, InputFile);
Gauge1.Progress := 10;
Y_Array := GetYValues(K, InputFile);
if (AlphaCharFlag = False) then//from GetYValues function
begin
Dialogs.MessageDlg('Exiting the application.', mtInformation,
[mbOk], 0, mbOk);
Close;
Exit;
end;
NumValues := Length(X_Array);
Gauge1.Progress := 20;
//obtain min and max values for constraints in equation
InputConsMinValue := -1;
InputConsMaxValue := -1;
if (ConstraintsYesNo = 'No') then//from analysis options unit
begin
InputConsMinValue := InputConstraintMinValue; //from other unit
InputConsMaxValue := InputConstraintMaxValue; //from other unit
end
else if (ConstraintsYesNo = 'Yes') then
begin
InputConsMinValue := MinValue(Y_Array);
InputConsMaxValue := MaxValue(Y_Array);
end;
//obtain iteration range for EC
EC_Low := -1;
EC_High := -1;
if (ECRangeFromData = 'No') then//from analysis options unit
begin
EC_Low := IterationRangeMinValue; //from other unit
EC_High := IterationRangeMaxValue; //from other unit
end
else if (ECRangeFromData = 'Yes') then
begin
EC_Low := MinValue(X_Array);
EC_High := MaxValue(X_Array);
end;
{Obtain the estimated values of EC and HS as a
single comma-delimited string }
EstimatedValues := Estimate(NumValues, InputConsMinValue,
InputConsMaxValue, EC_Low, EC_High,
X_Array, Y_Array);
Gauge1.Progress := 50;
{get the two parameters from the comma delimited string
result of the Estimate function }
EC := GetFirstValue(EstimatedValues);
HS := GetSecondValue(EstimatedValues);
Gauge1.Progress := 90;
//Obtain y-hat values
SetLength(YHat_Array, NumValues);
YHat_Array := Regress(NumValues, K, X_Array, EC, HS);
//compute array of SumSq dev from mean for X and Y
SetLength(SqDevX_Array, NumValues);
SqDevX_Array := GetSqDevVals(NumValues, X_Array);
SumSqDevX := Sum(SqDevX_Array);
SetLength(SqDevY_Array, NumValues);
SqDevY_Array := GetSqDevVals(NumValues, Y_Array);
SumSqDevY := Sum(SqDevY_Array);
//Compute array of sum of products
SetLength(CrossProds_Array, NumValues);
CrossProds_Array := GetCrossProds(NumValues, X_Array, Y_Array);
SumCrossProds := Sum(CrossProds_Array);
//Compute SumSqDev_YX or Sum(d2_YX) in S&C
SumSqDev_YX := SumSqDevY - Power(SumCrossProds, 2)/SumSqDevX;
//Compute Mean SumSqDev_YX (s2_YX in S&C)
MnSumSqDev_YX := SumSqDev_YX/(NumValues - 2);
//Compute ResMnSq of predicted population regr line
SetLength(SD_YX_Array, NumValues);
SD_YX_Array := GetSD_YX(NumValues, MnSumSqDev_YX,
SumSqDevX, SqDevX_Array);
//Get Confidence Limits
SetLength(CILL_Array, NumValues);
CILL_Array := GetConfLL(NumValues, CIPercent,
YHat_Array, SD_YX_Array);
SetLength(CIUL_Array, NumValues);
CIUL_Array := GetConfUL(NumValues, CIPercent,
YHat_Array, SD_YX_Array);
//Compute SE of new Y value
SetLength(SENewY_Array, NumValues);
SENewY_Array := GetSENewY(NumValues, MnSumSqDev_YX,
SumSqDevX, SqDevX_Array);
//Get Prediction Limits
SetLength(PILL_Array, NumValues);
PILL_Array := GetPredLL(NumValues, PIPercent,
YHat_Array, SENewY_Array);
SetLength(PIUL_Array, NumValues);
PIUL_Array := GetPredUL(NumValues, PIPercent,
YHat_Array, SENewY_Array);
Gauge1.Progress := 100;
//write output file
OutputFile.Add('EC = ' + FloatToStr(EC));
OutputFile.Add('HS = ' + FloatToStr(HS));
OutputFile.Add('');
//change headers for CI and PI depending on percent chosen by user
CIHeader_L := '';
CIHeader_U := '';
PIheader_L := '';
PIheader_U := '';
if (CIPercent = 90) then
begin
CIHeader_L := '90% CI_LL';
CIHeader_U := '90% CI_UL'
end
else if (CIPercent = 95) then
begin
CIHeader_L := '95% CI_LL';
CIHeader_U := '95% CI_UL'
end
else if (CIPercent = 99) then
begin
CIHeader_L := '99% CI_LL';
CIHeader_U := '99% CI_UL'
end;
if (PIPercent = 90) then
begin
PIHeader_L := '90% PI_LL';
PIHeader_U := '90% PI_UL'
end
else if (PIPercent = 95) then
begin
PIHeader_L := '95% PI_LL';
PIHeader_U := '95% PI_UL'
end
else if (PIPercent = 99) then
begin
PIHeader_L := '99% PI_LL';
PIHeader_U := '99% PI_UL'
end;
OutputFile.Add('X ' + ', ' + 'Y ' + ', ' + 'Y-Hat ' + ', ' +
CIHeader_L + ', ' + CIHeader_U + ', ' +
PIHeader_L + ', ' + PIHeader_U);
for I := 0 to NumValues - 1 do
OutputFile.Add(FloatToStr(X_Array[I]) + ', ' +
FloatToStr(Y_Array[I]) + ', ' +
FloatToStr(YHat_Array[I]) + ', ' +
FloatToStr(CILL_Array[I]) + ', ' +
FloatToStr(CIUL_Array[I]) + ', ' +
FloatToStr(PILL_Array[I]) + ', ' +
FloatToStr(PIUL_Array[I]));
//display results in Memo field
Memo1.Clear;
Application.ProcessMessages;
for I := 0 to OutputFile.Count - 1 do
Memo1.Lines.Add(OutputFile[I]);
mmuFileSave.Enabled := True;
finally
InputFile.Free;
MessageDlgPos('Done!', mtInformation, [mbOK], 0, 300, 300);
end;
end;
end;
//Get Y values in the form of an array
function TfrmMain.GetYValues(K: integer;
InputFile: TStringList): TVal_Array;
var
I,J, Posit: integer;
RowData, Y_Str: string;
Y_Array: TVal_Array;
ValidData: Boolean;
const Letters = ['A'..'Z', 'a'..'z'];
begin
AlphaCharFlag := True;
try
SetLength(Y_Array, InputFile.Count - K);
try
//value of K depends on presence/abssence of headers in input file
for I := K to InputFile.Count-1 do
begin
RowData := Trim(InputFile[I]);
Posit := Pos(',', RowData) - 1;//excluding the comma
Y_Str := '';
for J := (Posit+2) to Length(RowData) do Y_Str := Y_Str + RowData[J];
Y_Str := Trim(Y_Str);
//check if there are any non-numerical data (letters) in the values
if not (CheckForAlphaInArray(I, Y_Str)) then
begin
AlphaCharFlag := False;
Exit;
end;
// CheckForAlphaInArray(I, Y_Str);
if (K = 0) then //that is, no header
begin
if not TryStrToFloat(Y_Str, Y_Array[I]) then Exit;
end
else if (K = 1) then
begin
if not TryStrToFloat(Y_Str, Y_Array[I-1]) then Exit;
end;
end;
Result := Y_Array;
except
on E: Exception do
MessageDlgPos('An unexpected error occurred while ' +
'extracting the Y values from the file. ' +
E.message, mtError, [mbOK], 0, 300, 300);
end;
finally
Y_Array := nil;
end;
end;
function TfrmHillSlopeRegr.CheckForAlphaInArray(I: integer; S: string): boolean;
var
J: integer;
Chr: char;
const Numeric = ['0'..'9', '.'];
begin
for J := 1 to Length(S) do
begin
Chr := S[J];
//if Chr in Numeric then continue else
if CharInSet(Chr, Numeric) then continue else
begin
MessageDlg('Error! Your file has non-numerical data in row #' +
IntToStr(I) + '!', mtError, [mbAbort], 0, mbAbort);
Result := False;
Exit;
end;
end;
Result := True;
end;
興味深いことに、スタンドアロン アプリケーションの場合、次のコード (Delphi のドキュメントから入手したもの) を使用すると問題なく動作します。
procedure TForm1.Button1Click(Sender: TObject);
begin
if Dialogs.MessageDlg('Welcome to my Delphi application. Exit now?',
mtConfirmation, [mbYes, mbNo], 0, mbYes) = mrYes then
begin
Dialogs.MessageDlg('Exiting the Delphi application.', mtInformation,
[mbOk], 0, mbOk);
Close;
end;
end;