Применение Borland Delphi для создания программного продукта, включающего в себя решение обратной угловой засечки двух определяемых пунктов по четырем исходным, работу с текстовыми и типизированными файлами, работу в графическом режиме

ПриложениеМ – Листингмодулярасчета uLocationDeviation.pasunit uLocationDeviation;interfaceuses SysUtils, Math;type TInput = record mBeta: double; C: double; b12: double; b34: double; Beta: array[1..4] of double; K: array[1..4] of double; S: array[1..4] of double; end; TOutput = record mP1: double; mP2: double; end;function OutputToStr(o: TOutput): string;function Calculate(n: TInput): TOutput;implementationfunction OutputToStr(o: TOutput): string;var f: string;begin f := '(mP1; mP2)=(%1.3f; %1.3f)'; result := Format(f, [o.mP1, o.mP2]);end;function Calculate(n: TInput): TOutput;var o: TOutput;begin o.mP1 := n.mBeta / n.C * sqrt( power(n.K[1] * n.S[2], 2) + power(n.K[2] * n.S[1], 2) + power(n.b12, 2) * ( power(n.S[3] * sin(n.Beta[4]), 2) + power(n.S[4] * sin(n.Beta[3]), 2) ) ); o.mP2 := n.mBeta / n.C * sqrt( power(n.K[3] * n.S[4], 2) + power(n.K[4] * n.S[3], 2) + power(n.b34, 2) * ( power(n.S[1] * sin(n.Beta[2]), 2) + power(n.S[2] * sin(n.Beta[1]), 2)) );result := o;end;end.ПриложениеН – Листингмодуляпостроения изображенияuImage.pasunit uImage;interfaceuses Graphics, Math, SysUtils, Types, uProblem;procedure Draw(bmp: TBitmap; n: uProblem.TInput; o: uProblem.TOutput);implementationprocedure Draw(bmp: TBitmap; n: uProblem.TInput; o: uProblem.TOutput);var cnv: TCanvas; bmpAreaLeft, bmpAreaTop: integer; bmpAreaWidth, bmpAreaHeight: integer; drwWidth, drwHeight: double; drwTranslateX, drwTranslateY: double; drwScaleCoeff: double;const knownPointTriangleHeight: integer = 16; knownPointTrianglePenColor: TColor = $00B517BA; knownPointTrianglePenWidth: integer = 4; problemPointCircleRadius: integer = 10; problemPointCirclePenColor: TColor = $00FFE033; problemPointCirclePenWidth: integer = 4; problemPointsLinePenWidth: integer = 6; problemPointsLinePenColor: TColor = $0075BA17; knownToProblemPointLinePenWidth: integer = 3; knownToProblemPointLinePenColor: TColor = $0017BAB3; pointNameOffset: integer = 20; pointNameOffsetStep: integer = 5; function TxDrwToBmp(x: double): integer; begin result := bmpAreaLeft + Round((drwTranslateX + x) * drwScaleCoeff); result := result + Round((bmpAreaWidth - drwWidth * drwScaleCoeff) / 2); end; function TyDrwToBmp(y: double): integer; begin result := bmpAreaTop + Round((drwTranslateY + y) * drwScaleCoeff); result := result + Round((bmpAreaHeight - drwHeight * drwScaleCoeff) / 2); end; function GetMax(arr: array of double): double; var i: integer; begin result := arr[0]; for i := 1 to length(arr) - 1 do begin if arr[i] > result then result := arr[i]; end; end; function GetMin(arr: array of double): double; var i: integer; begin result := arr[0]; for i := 1 to length(arr) - 1 do begin if arr[i] < result then result := arr[i]; end; end; procedure CalcDrwScale(); var arrX, arrY: array[1..6] of double; minX, minY, maxX, maxY: double; scaleCoeffX, scaleCoeffY: double; begin arrX[1] := n.X1; arrX[3] := n.X2; arrX[2] := n.X3; arrX[4] := n.X4; arrX[5] := o.ProblemPointsLocation.Xp1; arrX[6] := o.ProblemPointsLocation.Xp2; arrY[1] := n.Y1; arrY[2] := n.Y2; arrY[3] := n.Y3; arrY[4] := n.Y4; arrY[5] := o.ProblemPointsLocation.Yp1; arrY[6] := o.ProblemPointsLocation.Yp2; minX := GetMin(arrX); maxX := GetMax(arrX); minY := GetMin(arrY); maxY := GetMax(arrY); drwTranslateX := -1 * minX; drwTranslateY := -1 * minY; drwWidth := maxX - minX; drwHeight := maxY - minY; scaleCoeffX := bmpAreaWidth / drwWidth; scaleCoeffY := bmpAreaHeight / drwHeight; drwScaleCoeff := Min(scaleCoeffX, scaleCoeffY); end; procedure AddToBmpAreaTop(dy: integer); begin bmpAreaTop := bmpAreaTop + dy; bmpAreaHeight := bmpAreaHeight - dy; end; function GetTextHeight(text: string): integer; begintext := 'Схема расчета обобщенной двойной обратной засечки';result := cnv.TextExtent(text).cy; end; procedure AddToBmpAreaTopTextHeight(text: string); var textHeight: integer; begin textHeight := GetTextHeight(text); AddToBmpAreaTop(textHeight); end; procedure DrawHeader(text: string; bmpTop: integer); var textSize: TSize; textX: integer; begin textSize := cnv.TextExtent(text); textX := Round((bmp.Width - textSize.cx) / 2); cnv.TextOut(textX, bmpTop, text); end; procedure DrawMainHeader(); var text: string; begintext := 'Схема расчета обобщенной двойной обратной засечки';AddToBmpAreaTopTextHeight(text); DrawHeader(text, bmpAreaTop); AddToBmpAreaTopTextHeight(text); end; procedure DrawPointName(cnv: TCanvas; x, y: integer; pointName: string); var textSize: TSize; prevBrushColor: TColor; prevBrushStyle: TBrushStyle; begin textSize := cnv.TextExtent(pointName); x := x + pointNameOffset; y := y + pointNameOffset; while (x + textSize.cx > bmpAreaLeft + bmpAreaWidth) and (x > bmpAreaLeft) do x := x - pointNameOffsetStep; while (x < bmpAreaLeft) and (x + textSize.cx > bmpAreaLeft + bmpAreaWidth) do x := x + pointNameOffsetStep; while (y + textSize.cy > bmpAreaTop + bmpAreaHeight) and (y > bmpAreaTop) do y := y - pointNameOffsetStep; while (y < bmpAreaTop) and (y + textSize.cy > bmpAreaTop + bmpAreaHeight) do y := y + pointNameOffsetStep; prevBrushColor := cnv.Brush.Color; prevBrushStyle := cnv.Brush.Style; cnv.Brush.Style := bsSolid; cnv.Brush.Color := $0000FFD8; cnv.FillRect(Rect(x, y, x + textSize.cx, y + textSize.cy)); cnv.TextOut(x, y, pointName); cnv.Brush.Color := prevBrushColor; cnv.Brush.Style := prevBrushStyle; end; procedure DeflateAreaForPercent(percent: double); var drwMarginWidth, drwMarginHeight: integer; begin drwMarginWidth := Abs(Round(bmpAreaWidth * percent / 100)); drwMarginHeight := Abs(Round(bmpAreaHeight * percent / 100)); bmpAreaLeft := bmpAreaLeft + drwMarginWidth; bmpAreaTop := bmpAreaTop + drwMarginHeight; bmpAreaWidth := bmpAreaWidth - 2 * drwMarginWidth; bmpAreaHeight := bmpAreaHeight - 2 * drwMarginHeight; end; procedure ShortenLineForPixels(var x1: integer; var y1: integer; var x2: integer; var y2: integer; np: integer); var dx, dy: integer; tg: double; begin dx := x2 - x1; dy := y2 - y1; if dx = 0 then begin if dy <> 0 then begin y1 := y1 - Round(np * dy / Abs(dy)); y2 := y2 + Round(np * dy / Abs(dy)); end; end else begin if dx <> 0 then begin tg := dy / dx; x1 := x1 + Round(np * cos(arctan(tg))); y1 := y1 + Round(np * sin(arctan(tg))); x2 := x2 - Round(np * cos(arctan(tg))); y2 := y2 - Round(np * sin(arctan(tg))); end; end; end; procedure DrawAreaBorder(); var x1, y1, x2, y2: integer; begin cnv.Pen.Color := clGray; cnv.Pen.Width := 2; x1 := bmpAreaLeft; y1 := bmpAreaTop; x2 := bmpAreaLeft + bmpAreaWidth; y2 := bmpAreaTop + bmpAreaHeight; cnv.Rectangle(x1, y1, x2, y2); end; procedure DrawKnownPoint(drwX, drwY: double; pointName: string); var x, y: integer; h: integer; xt1, yt1: integer; xt2, yt2: integer; xt3, yt3: integer; prevPenColor: TColor; prevPenWidth: integer; begin x := TxDrwToBmp(drwX); y := TyDrwToBmp(drwY); h := knownPointTriangleHeight; xt1 := Round(x - h * 0.5); yt1 := Round(y + h * 1 / 3); xt2 := x; yt2 := Round(y - h * 2 / 3); xt3 := Round(x + h * 0.5); yt3 := Round(y + h * 1 / 3); prevPenColor := cnv.Pen.Color; prevPenWidth := cnv.Pen.Width; cnv.Pen.Color := knownPointTrianglePenColor; cnv.Pen.Width := knownPointTrianglePenWidth; cnv.MoveTo(xt1, yt1); cnv.LineTo(xt2, yt2); cnv.LineTo(xt3, yt3); cnv.LineTo(xt1, yt1); cnv.Pen.Color := prevPenColor; cnv.Pen.Width := prevPenWidth; DrawPointName(cnv, x, y, pointName); end; procedure DrawKnownPoints(); begin DrawKnownPoint(n.X1, n.Y1, 'т. 1'); DrawKnownPoint(n.X2, n.Y2, 'т. 2'); DrawKnownPoint(n.X3, n.Y3, 'т. 3'); DrawKnownPoint(n.X4, n.Y4, 'т. 4'); end; procedure DrawProblemPoint(drwX, drwY: double; pointName: string); var x, y: integer; r: integer; prevPenColor: TColor; prevPenWidth: integer; begin x := TxDrwToBmp(drwX); y := TyDrwToBmp(drwY); r := problemPointCircleRadius; prevPenColor := cnv.Pen.Color; prevPenWidth := cnv.Pen.Width; cnv.Pen.Color := problemPointCirclePenColor; cnv.Pen.Width := problemPointCirclePenWidth; cnv.Ellipse(x - r, y - r, x + r, y + r); cnv.Pen.Color := prevPenColor; cnv.Pen.Width := prevPenWidth; DrawPointName(cnv, x, y, pointName); end; procedure DrawProblemPoints(); var xp1, yp1, xp2, yp2: double; begin xp1 := o.ProblemPointsLocation.Xp1; yp1 := o.ProblemPointsLocation.Yp1; xp2 := o.ProblemPointsLocation.Xp2; yp2 := o.ProblemPointsLocation.Yp2; DrawProblemPoint(xp1, yp1, 'P1'); DrawProblemPoint(xp2, yp2, 'P2'); end; procedure DrawProblemPointsLine(); var rxp1, ryp1, rxp2, ryp2: double; bxp1, byp1, bxp2, byp2: integer; prevPenColor: TColor; prevPenWidth: integer; begin rxp1 := o.ProblemPointsLocation.Xp1; ryp1 := o.ProblemPointsLocation.Yp1; rxp2 := o.ProblemPointsLocation.Xp2; ryp2 := o.ProblemPointsLocation.Yp2; bxp1 := TxDrwToBmp(rxp1); byp1 := TyDrwToBmp(ryp1); bxp2 := TxDrwToBmp(rxp2); byp2 := TyDrwToBmp(ryp2); ShortenLineForPixels(bxp1, byp1, bxp2, byp2, problemPointCircleRadius); prevPenColor := cnv.Pen.Color; prevPenWidth := cnv.Pen.Width; cnv.Pen.Color := problemPointsLinePenColor; cnv.Pen.Width := problemPointsLinePenWidth; cnv.MoveTo(bxp1, byp1); cnv.LineTo(bxp2, byp2); cnv.Pen.Color := prevPenColor; cnv.Pen.Width := prevPenWidth; end; procedure DrawKnownToProblemPointLine(drwX, drwY, drwXp, drwYp: double); var x, y, xp, yp: integer; prevPenColor: TColor; prevPenWidth: integer; begin x := TxDrwToBmp(drwX); y := TyDrwToBmp(drwY); xp := TxDrwToBmp(drwXp); yp := TyDrwToBmp(drwYp); prevPenColor := cnv.Pen.Color; prevPenWidth := cnv.Pen.Width; cnv.Pen.Color := knownToProblemPointLinePenColor; cnv.Pen.Width := knownToProblemPointLinePenWidth; cnv.MoveTo(x, y); cnv.LineTo(xp, yp); cnv.Pen.Color := prevPenColor; cnv.Pen.Width := prevPenWidth; end; procedure DrawKnownToProblemPointLines(); var xp, yp: double; begin xp := o.ProblemPointsLocation.Xp1; yp := o.ProblemPointsLocation.Yp1; DrawKnownToProblemPointLine(n.X1, n.Y1, xp, yp); DrawKnownToProblemPointLine(n.X2, n.Y2, xp, yp); xp := o.ProblemPointsLocation.Xp2; yp := o.ProblemPointsLocation.Yp2; DrawKnownToProblemPointLine(n.X3, n.Y3, xp, yp); DrawKnownToProblemPointLine(n.X4, n.Y4, xp, yp); end; procedure InitDrawing(); var scaleHeaderTextFormat: string; scaleHeaderText: string; scaleHeaderBmpAreaTop: integer; begin DrawMainHeader; scaleHeaderTextFormat := '(масштаб 1 пиксель = %1.3f м)'; scaleHeaderText := Format(scaleHeaderTextFormat, [1 / drwScaleCoeff]); scaleHeaderBmpAreaTop := bmpAreaTop; AddToBmpAreaTopTextHeight(scaleHeaderText); DeflateAreaForPercent(5); DrawAreaBorder; DeflateAreaForPercent(5); CalcDrwScale; scaleHeaderText := Format(scaleHeaderTextFormat, [1 / drwScaleCoeff]); DrawHeader(scaleHeaderText, scaleHeaderBmpAreaTop); end;begin bmp.Width := 800; bmp.Height := 600; bmpAreaLeft := 0; bmpAreaTop := 0; bmpAreaWidth := bmp.Width; bmpAreaHeight := bmp.Height; cnv := bmp.Canvas; cnv.Font.Size := 8; cnv.Font.Name := 'Arial'; cnv.Brush.Style := bsClear; InitDrawing(); DrawProblemPointsLine; DrawKnownToProblemPointLines; DrawKnownPoints; DrawProblemPoints;end;end.ПриложениеО – Листингвспомогательного модуляперевода между градусами, минутами, секунд (DMS) и радианами uHelper.pasunit uHelper;interfaceuses SysUtils, Math;type TDMS = record Degrees: integer; Minutes: integer; Seconds: integer; end; TDMSS = record Degrees: string; Minutes: string; Seconds: string; end;function DMStoRAD(dms: TDMS): double; overload;function DMStoRAD(d, m, s: integer): double; overload;function RADtoDMS(radians: double): TDMS;function DMSToStr(dms: TDMS): string; overload;function DMSToStr(dms: TDMS; dmss: TDMSS): string; overload;function RADToDMSStr(value: double): string; overload;function RADToDMSStr(value: double; dmss: TDMSS): string; overload;function TryStrToDMS(str: string; var dms: TDMS): boolean;function BoolToStr(value: boolean): string;var DefaultDMSS: TDMSS = (Degrees: '#248'; Minutes: ''''; Seconds: '"');implementationfunction BoolToStr(value: boolean): string;begin if value then result := 'True' else result := 'False';end;function DMStoRAD(dms: TDMS): double; overload;begin result := Math.DEGtoRAD(dms.Degrees + dms.Minutes / 60 + dms.Seconds / 3600);end;function DMStoRAD(d, m, s: integer): double; overload;var dms: TDMS;begin dms.Degrees := d; dms.Minutes := m; dms.Seconds := s; result := DMStoRAD(dms);end;function RADtoDMS(radians: double): TDMS;var d, m, s: double;begin d := Math.RADtoDEG(radians); m := frac(d) * 60; s := frac(m) * 60; result.Degrees := trunc(d); result.Minutes := trunc(m); result.Seconds := round(s);end;function DMSToStr(dms: TDMS): string; overload;begin result := DMSToStr(dms, DefaultDMSS);end;function DMSToStr(dms: TDMS; dmss: TDMSS): string; overload;var f: string;begin f := '%d' + dmss.Degrees + '%d' + dmss.Minutes + '%d' + dmss.Seconds; result := Format(f, [ dms.Degrees, dms.Minutes, dms.Seconds ]);end;function TryStrToDMS(str: string; var dms: TDMS): boolean;var dPos, mPos, sPos: integer; dStr, mStr, sStr: string; d, m, s: integer;begin result := false; dPos := Pos(#248, str); if dPos = 0 then dPos := Pos('o', str); if dPos = 0 then exit; mPos := Pos('''', str); if mPos = 0 then mPos := Pos('`', str); if mPos = 0 then exit; sPos := Pos('''''', str); if sPos = 0 then sPos := Pos('"', str); if sPos = 0 then sPos := Pos('``', str); dStr := Copy(str, 0, dPos - 1); mStr := Copy(str, dPos + 1, mPos - dPos - 1); sStr := Copy(str, mPos + 1, sPos - mPos - 1); if not TryStrToInt(dStr, d) then exit; if not TryStrToInt(mStr, m) then exit; if not TryStrToInt(sStr, s) then exit; dms.Degrees := d; dms.Minutes := m; dms.Seconds := s; result := true;end;function RADToDMSStr(value: double): string; overload;begin result := DMSToStr(RADtoDMS(value));end;function RADToDMSStr(value: double; dmss: TDMSS): string; overload;begin result := DMSToStr(RADtoDMS(value), dmss);end;end.ПриложениеП – Листингмодулярабочей формыfrmCalc.pasunit frmCalc;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, ExtCtrls, Forms, Dialogs, Menus, StdCtrls, uProblem, uHelper, uImage, ActnList, Buttons;type TFormCalc = class(TForm) muMain: TMainMenu; miFile: TMenuItem; miFileNew: TMenuItem; miFileBr1: TMenuItem; miFileOpen: TMenuItem; miFileSave: TMenuItem; miFileSaveInput: TMenuItem; miFileSaveInputTxt: TMenuItem; miFileSaveInputBin: TMenuItem; miFileSaveOutput: TMenuItem; miFileSaveOutputBin: TMenuItem; miFileSaveOutputTxt: TMenuItem; miFileSaveBr1: TMenuItem; miFileSaveImg: TMenuItem; miFileBr2: TMenuItem; miFileExit: TMenuItem; miWindows: TMenuItem; miHelp: TMenuItem; miHelpDebug: TMenuItem; miHelpFill: TMenuItem; miHelpFillTest1: TMenuItem; miHelpFillTest2: TMenuItem; miHelpProgram: TMenuItem; btnHelpDebug: TSpeedButton; lblX1: TLabel; lblX2: TLabel; lblX3: TLabel; lblX4: TLabel; edtX1: TEdit; edtX2: TEdit; edtX3: TEdit; edtX4: TEdit; lblY1: TLabel; lblY2: TLabel; lblY3: TLabel; lblY4: TLabel; edtY1: TEdit; edtY2: TEdit; edtY3: TEdit; edtY4: TEdit; lblBeta1: TLabel; lblBeta2: TLabel; lblBeta3: TLabel; lblBeta4: TLabel; edtBeta1D: TEdit; edtBeta1M: TEdit; edtBeta1S: TEdit; edtBeta2D: TEdit; edtBeta2M: TEdit; edtBeta2S: TEdit; edtBeta3D: TEdit; edtBeta3M: TEdit; edtBeta3S: TEdit; edtBeta4D: TEdit; edtBeta4M: TEdit; edtBeta4S: TEdit; lblMBeta: TLabel; lblMBetaD: TLabel; lblMBetaM: TLabel; lblMBetaS: TLabel; edtMBetaS: TEdit; lblBeta1D: TLabel; lblBeta1M: TLabel; lblBeta1S: TLabel; lblBeta2D: TLabel; lblBeta2M: TLabel; lblBeta2S: TLabel; lblBeta3D: TLabel; lblBeta3M: TLabel; lblBeta3S: TLabel; lblBeta4D: TLabel; lblBeta4M: TLabel; lblBeta4S: TLabel; lblXP1: TLabel; lblXP2: TLabel; edtXP1: TEdit; edtXP2: TEdit; lblYP1: TLabel; lblYP2: TLabel; edtYP1: TEdit; edtYP2: TEdit; lblMP1: TLabel; lblMP2: TLabel; edtMP1: TEdit; edtMP2: TEdit; lblMAlpha: TLabel; edtMAlphaD: TEdit; edtMAlphaM: TEdit; edtMAlphaS: TEdit; edtError: TEdit; edtErrorEx: TEdit; edtLog: TMemo; pnlDraw: TPanel; pnlDrawTop: TPanel; ckbImageScale: TCheckBox; scbDraw: TScrollBox; imgDraw: TImage; miHelpFillTest3: TMenuItem; procedure miFileNewClick(Sender: TObject); procedure miWindowClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure miHelpDebugClick(Sender: TObject); procedure miHelpFillTest1Click(Sender: TObject); procedure miHelpFillTest2Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure edtXYKeyPress(Sender: TObject; var Key: Char); procedure edtBetaDKeyPress(Sender: TObject; var Key: Char); procedure edtXYChange(Sender: TObject); procedure edtBetaMChange(Sender: TObject); procedure edtBetaDChange(Sender: TObject); procedure edtBetaSChange(Sender: TObject); procedure miFileSaveInputBinClick(Sender: TObject); procedure miFileSaveInputTxtClick(Sender: TObject); procedure miFileSaveOutputBinClick(Sender: TObject); procedure miFileSaveOutputTxtClick(Sender: TObject); procedure miFileSaveImgClick(Sender: TObject); function LoadProblemInputFromBin(filePath: string): uProblem.TInput; function LoadProblemInputFromTxt(filePath: string): uProblem.TInput; function CheckOpenModified(): boolean; procedure miFileOpenClick(Sender: TObject); procedure FormResize(Sender: TObject); procedure ckbImageScaleClick(Sender: TObject); procedure miHelpFillTest3Click(Sender: TObject); protected procedure CreateParams(var Params: TCreateParams); override; private fFormIndex: integer; fProblemInput: uProblem.TInput; fProblemOutput: uProblem.TOutput; fLoading: boolean; fModified: boolean; procedure UpdateWindowsMenuForForm(frm: TFormCalc); procedure UpdateWindowsMenuForAllForms(); procedure UpdateCaption(); procedure UpdateProblemInput(); procedure FillProblemInput(); procedure UpdateImage(); procedure ClearError(); procedure SetError(text: string; textEx: string); function IsError(): boolean; function CheckSaveWithError(): boolean; procedure SetModified(modified: boolean); procedure Calculate(); end;function New(): TFormCalc;var CalcForms: array of TFormCalc;implementation{$R *.dfm}procedure TFormCalc.miFileNewClick(Sender: TObject);begin New();end;procedure TFormCalc.miWindowClick(Sender: TObject);var miWindow: TMenuItem;begin miWindow := TMenuItem(Sender); CalcForms[miWindow.Tag].Show;end;procedure TFormCalc.FormClose(Sender: TObject; var Action: TCloseAction);var i, n: integer;begin n := Length(CalcForms); if n = 1 then Application.Terminate; for i := fFormIndex to n - 1 do CalcForms[i] := CalcForms[i + 1]; SetLength(CalcForms, n - 1); UpdateWindowsMenuForAllForms();end;procedure TFormCalc.miHelpDebugClick(Sender: TObject);begin miHelpDebug.Checked := not miHelpDebug.Checked; btnHelpDebug.Down := miHelpDebug.Checked; edtLog.Visible := miHelpDebug.Checked;end;procedure TFormCalc.miHelpFillTest1Click(Sender: TObject);var n: uProblem.TInput;begin n.X1 := 200.002; n.Y1 := 900.004; n.Beta1 := uHelper.DMStoRAD(135, 00, 45); n.X2 := 200.005; n.Y2 := 800.001; n.Beta2 := uHelper.DMStoRAD(225, 00, 40); n.X3 := 399.998; n.Y3 := 800.004; n.Beta3 := uHelper.DMStoRAD(134, 59, 51); n.X4 := 400.001; n.Y4 := 899.996; n.Beta4 := uHelper.DMStoRAD(224, 59, 37); n.mBeta := uHelper.DMStoRAD(0, 0, 30); fProblemInput := n; UpdateProblemInput();end;procedure TFormCalc.miHelpFillTest2Click(Sender: TObject);var n: uProblem.TInput;begin n.X1 := 2000.002; n.Y1 := 9000.004; n.Beta1 := uHelper.DMStoRAD(136, 00, 25); n.X2 := 2000.005; n.Y2 := 8000.001; n.Beta2 := uHelper.DMStoRAD(224, 48, 20); n.X3 := 3099.998; n.Y3 := 7500.004; n.Beta3 := uHelper.DMStoRAD(135, 29, 21); n.X4 := 4000.001; n.Y4 := 8099.996; n.Beta4 := uHelper.DMStoRAD(226, 29, 27); n.mBeta := uHelper.DMStoRAD(0, 0, 30); fProblemInput := n; UpdateProblemInput();end;procedure TFormCalc.miHelpFillTest3Click(Sender: TObject);var n: uProblem.TInput;begin n.X1 := 85; n.Y1 := 215; n.Beta1 := uHelper.DMStoRAD(135, 00, 00); n.X2 := 85; n.Y2 := 185; n.Beta2 := uHelper.DMStoRAD(225, 00, 00); n.X3 := 144; n.Y3 := 176; n.Beta3 := uHelper.DMStoRAD(135, 00, 00); n.X4 := 144; n.Y4 := 224; n.Beta4 := uHelper.DMStoRAD(225, 00, 00); n.mBeta := uHelper.DMStoRAD(0, 0, 30); fProblemInput := n; UpdateProblemInput();end;procedure TFormCalc.FormCreate(Sender: TObject);begin Calculate(); SetModified(false);end;procedure TFormCalc.edtXYKeyPress(Sender: TObject; var Key: Char);begin if not (Key in ['0'..'9', '-', #8, DecimalSeparator]) then Key := #0; with Sender as TEdit do begin if Key = '-' then if Pos('-', Text) <> 0 then Key := #0; if Key = DecimalSeparator then if Pos(DecimalSeparator , Text) <> 0 then Key := #0; end;end;procedure TFormCalc.edtBetaDKeyPress(Sender: TObject; var Key: Char);begin if not (Key in ['0'..'9',#8]) then Key := #0;end;procedure TFormCalc.edtXYChange(Sender: TObject);var s: string;begin with Sender as TEdit do begin if Pos('-', Text) <> 0 then begin if Pos('-', Text) <> 1 then begin s := Text; delete(s, Pos('-', s), 1); insert('-', s, 1); Text := s; end; end; Text := StringReplace(Text, '.', DecimalSeparator, [rfReplaceAll]); Text := StringReplace(Text, ',', DecimalSeparator, [rfReplaceAll]); end; if not fLoading then Calculate();end;procedure TFormCalc.edtBetaDChange(Sender: TObject);var s: string; i: integer;begin with sender as TEdit do begin s := Text; if s = '' then Exit; i := StrToInt(s); if i >=360 then begin i := SelStart; delete(s, Length(s), 1); Text := s; SelStart := i; end; end; if not fLoading then Calculate();end;procedure TFormCalc.edtBetaMChange(Sender: TObject);var s: string; i: integer;begin with Sender as TEdit do begin s := Text; if s = '' then Exit; i := StrToInt(s); if i >=60 then begin i := SelStart; delete(s, Length(s), 1); Text := s; SelStart := i; end; end; if not fLoading then Calculate();end;procedure TFormCalc.edtBetaSChange(Sender: TObject);begin if not fLoading then Calculate();end;procedure TFormCalc.miFileSaveInputBinClick(Sender: TObject);var saveDialog: TSaveDialog; f: file of uProblem.TInput;begin if not CheckSaveWithError() then exit; FillProblemInput(); saveDialog := TSaveDialog.Create(Self); saveDialog.DefaultExt := 'dat'; if not saveDialog.Execute then exit; AssignFile(f, saveDialog.FileName); Rewrite(f); Write(f, fProblemInput); CloseFile(f); SetModified(false);end;procedure TFormCalc.miFileSaveInputTxtClick(Sender: TObject);var saveDialog: TSaveDialog; f: TextFile;begin if not CheckSaveWithError() then exit; FillProblemInput(); saveDialog := TSaveDialog.Create(Self); saveDialog.DefaultExt := 'txt'; if not saveDialog.Execute then exit; AssignFile(f, saveDialog.FileName); Rewrite(f); Write(f, uProblem.InputToIniStr(fProblemInput)); CloseFile(f); SetModified(false);end;procedure TFormCalc.miFileSaveOutputBinClick(Sender: TObject);var saveDialog: TSaveDialog; f: file of uProblem.TOutput;begin if IsError() then exit; saveDialog := TSaveDialog.Create(Self); saveDialog.DefaultExt := 'o.dat'; if not saveDialog.Execute then exit; AssignFile(f, saveDialog.FileName); Rewrite(f); Write(f, fProblemOutput); CloseFile(f);end;procedure TFormCalc.miFileSaveOutputTxtClick(Sender: TObject);var saveDialog: TSaveDialog; f: TextFile;begin if IsError() then exit; saveDialog := TSaveDialog.Create(Self); saveDialog.DefaultExt := 'o.txt'; if not saveDialog.Execute then exit; AssignFile(f, saveDialog.FileName); Rewrite(f); Write(f, uProblem.OutputToStr(fProblemOutput)); CloseFile(f);end;procedure TFormCalc.miFileSaveImgClick(Sender: TObject);var saveDialog: TSaveDialog; bmp: TBitmap;begin if IsError() then exit; saveDialog := TSaveDialog.Create(Self); saveDialog.DefaultExt := 'bmp'; if not saveDialog.Execute then exit; bmp := TBitmap.Create; uImage.Draw(bmp, fProblemInput, fProblemOutput); bmp.SaveToFile(saveDialog.FileName);end;function TFormCalc.LoadProblemInputFromBin(filePath: string): uProblem.TInput;var f: file of uProblem.TInput;begin AssignFile(f, filePath); Reset(f); Read(f, result); CloseFile(f);end;function TFormCalc.LoadProblemInputFromTxt(filePath: string): uProblem.TInput;var f: TextFile; n: uProblem.TInput; ln: string;begin AssignFile(f, filePath); Reset(f); while not EOF(f) do begin ReadLn(f, ln); uProblem.InputFromIniLine(ln, n); end; CloseFile(f); Result := n;end;function TFormCalc.CheckOpenModified(): boolean;begin Result := not fModified or (mrYes = MessageDlg('Данные в форме были модифицированы. Уверены, что хотите загрузить в ' + 'форму данные из файла?',mtWarning, [mbYes, mbNo], 0));end;procedure TFormCalc.miFileOpenClick(Sender: TObject);var openDialog: TOpenDialog;begin if not CheckOpenModified() then exit; openDialog := TOpenDialog.Create(Self); if not openDialog.Execute then exit; if ExtractFileExt(openDialog.FileName) = '.txt' then fProblemInput := LoadProblemInputFromTxt(openDialog.FileName) else fProblemInput := LoadProblemInputFromBin(openDialog.FileName); UpdateProblemInput(); SetModified(false);end;procedure TFormCalc.FormResize(Sender: TObject);begin UpdateImage();end;procedure TFormCalc.ckbImageScaleClick(Sender: TObject);begin UpdateImage();end;procedure TFormCalc.CreateParams(var Params: TCreateParams);begin inherited; Params.ExStyle := Params.ExStyle OR WS_EX_APPWINDOW;end;procedure TFormCalc.UpdateWindowsMenuForForm(frm: TFormCalc);var i: integer; mi: TMenuItem;begin frm.miWindows.Clear(); for i := 0 to Length(CalcForms) - 1 do begin; mi := TMenuItem.Create(frm.muMain); mi.Caption := Format('Расчет №%d', [i + 1]); mi.Tag := i; mi.OnClick := frm.miWindowClick; frm.miWindows.Add(mi); end;end;procedure TFormCalc.UpdateWindowsMenuForAllForms();var i: integer;begin for i := 0 to Length(CalcForms) - 1 do UpdateWindowsMenuForForm(CalcForms[i]);end;procedure TFormCalc.UpdateCaption();begin Caption := Format('[%d] Обобщенная двойная обратная засечка', [fFormIndex + 1]); if fModified then Caption := '*' + Caption;end;procedure TFormCalc.UpdateProblemInput();var n: uProblem.TInput; dmsBeta1: TDMS; dmsBeta2: TDMS; dmsBeta3: TDMS; dmsBeta4: TDMS;begin n := fProblemInput; fLoading := true; dmsBeta1 := uHelper.RADtoDMS(n.Beta1); dmsBeta2 := uHelper.RADtoDMS(n.Beta2); dmsBeta3 := uHelper.RADtoDMS(n.Beta3); dmsBeta4 := uHelper.RADtoDMS(n.Beta4); edtX1.Text := FloatToStrF(n.X1, ffFixed, 7, 3); edtX2.Text := FloatToStrF(n.X2, ffFixed, 7, 3); edtX3.Text := FloatToStrF(n.X3, ffFixed, 7, 3); edtX4.Text := FloatToStrF(n.X4, ffFixed, 7, 3); edtY1.Text := FloatToStrF(n.Y1, ffFixed, 7, 3); edtY2.Text := FloatToStrF(n.Y2, ffFixed, 7, 3); edtY3.Text := FloatToStrF(n.Y3, ffFixed, 7, 3); edtY4.Text := FloatToStrF(n.Y4, ffFixed, 7, 3); edtBeta1d.Text := IntToStr(dmsBeta1.Degrees); edtBeta1m.Text := IntToStr(dmsBeta1.Minutes); edtBeta1s.Text := IntToStr(dmsBeta1.Seconds); edtBeta2d.Text := IntToStr(dmsBeta2.Degrees); edtBeta2m.Text := IntToStr(dmsBeta2.Minutes); edtBeta2s.Text := IntToStr(dmsBeta2.Seconds); edtBeta3d.Text := IntToStr(dmsBeta3.Degrees); edtBeta3m.Text := IntToStr(dmsBeta3.Minutes); edtBeta3s.Text := IntToStr(dmsBeta3.Seconds); edtBeta4d.Text := IntToStr(dmsBeta4.Degrees); edtBeta4m.Text := IntToStr(dmsBeta4.Minutes); edtBeta4s.Text := IntToStr(dmsBeta4.Seconds); fLoading := false; Calculate();end;procedure TFormCalc.FillProblemInput();var n: uProblem.TInput; beta1d, beta1m, beta1s: integer; beta2d, beta2m, beta2s: integer; beta3d, beta3m, beta3s: integer; beta4d, beta4m, beta4s: integer; mBetaS: integer; f: string;begin SetModified(true); ClearError();f := 'Введены некорректные данные';n.mBeta := uHelper.DMStoRAD(0, 0, mBetaS); if not TryStrToFloat(edtX1.Text, n.X1) then SetError(f, 'X1'); if not TryStrToFloat(edtX2.Text, n.X2) then SetError(f, 'X2'); if not TryStrToFloat(edtX3.Text, n.X3) then SetError(f, 'X3'); if not TryStrToFloat(edtX4.Text, n.X4) then SetError(f, 'X4'); if not TryStrToFloat(edtY1.Text, n.Y1) then SetError(f, 'Y1'); if not TryStrToFloat(edtY2.Text, n.Y2) then SetError(f, 'Y2'); if not TryStrToFloat(edtY3.Text, n.Y3) then SetError(f, 'Y3'); if not TryStrToFloat(edtY4.Text, n.Y4) then SetError(f, 'Y4'); if not TryStrToInt(edtBeta1d.Text, beta1d) then SetError(f, 'в1o'); if not TryStrToInt(edtBeta1m.Text, beta1m) then SetError(f, 'в1'''); if not TryStrToInt(edtBeta1s.Text, beta1s) then SetError(f, 'в1'''''); if not TryStrToInt(edtBeta2d.Text, beta2d) then SetError(f, 'в2o'); if not TryStrToInt(edtBeta2m.Text, beta2m) then SetError(f, 'в2'''); if not TryStrToInt(edtBeta2s.Text, beta2s) then SetError(f, 'в2'''''); if not TryStrToInt(edtBeta3d.Text, beta3d) then SetError(f, 'в3o'); if not TryStrToInt(edtBeta3m.Text, beta3m) then SetError(f, 'в3'''); if not TryStrToInt(edtBeta3s.Text, beta3s) then SetError(f, 'в3'''''); if not TryStrToInt(edtBeta4d.Text, beta4d) then SetError(f, 'в4o'); if not TryStrToInt(edtBeta4m.Text, beta4m) then SetError(f, 'в4'''); if not TryStrToInt(edtBeta4s.Text, beta4s) then SetError(f, 'в4'''''); n.Beta1 := uHelper.DMStoRAD(beta1d, beta1m, beta1s); n.Beta2 := uHelper.DMStoRAD(beta2d, beta2m, beta2s); n.Beta3 := uHelper.DMStoRAD(beta3d, beta3m, beta3s); n.Beta4 := uHelper.DMStoRAD(beta4d, beta4m, beta4s); if not TryStrToInt(edtMBetaS.Text, mBetaS) then SetError(f, 'mв4'''''); n.mBeta := uHelper.DMStoRAD(0, 0, mBetaS); fProblemInput := n;end;procedure TFormCalc.UpdateImage();var drawingBmp: TBitmap; displayBmp: TBitmap;begin drawingBmp := TBitmap.Create; displayBmp := TBitmap.Create; displayBmp.Width := imgDraw.Width; displayBmp.Height := imgDraw.Height; if not IsError() then begin uImage.Draw(drawingBmp, fProblemInput, fProblemOutput); if ckbImageScale.Checked then begin imgDraw.Align := alClient; displayBmp.Width := imgDraw.Width; displayBmp.Height := imgDraw.Height; displayBmp.Canvas.StretchDraw(Rect(0, 0, imgDraw.Width, imgDraw.Height), drawingBmp); drawingBmp.Free; end else begin imgDraw.Align := alNone; imgDraw.Width := drawingBmp.Width; imgDraw.Height := drawingBmp.Height; displayBmp.Free; displayBmp := drawingBmp; end; end; imgDraw.Picture.Bitmap.Assign(displayBmp); displayBmp.Free; Self.Refresh();end;procedure TFormCalc.ClearError();begin; edtError.Text := ''; edtErrorEx.Text := ''; edtError.Visible := false; edtErrorEx.Visible := false;end;procedure TFormCalc.SetError(text: string; textEx: string);begin; if IsError() then exit; edtError.Text := text; edtErrorEx.Text := textEx; edtError.Visible := IsError(); edtErrorEx.Visible := edtError.Visible;end;function TFormCalc.IsError(): boolean;begin result := (edtError.Text <> '') or (edtErrorEx.Text <> '');end;function TFormCalc.CheckSaveWithError(): boolean;begin Result := not IsError() or (mrYes = MessageDlg('Данные сейчас некорректны. Уверены, что хотите сохранить некорректные данные?',mtWarning, [mbYes, mbNo], 0));end;procedure TFormCalc.SetModified(modified: boolean);begin fModified := modified; UpdateCaption();end;procedure TFormCalc.Calculate();var mAlphaDms: uHelper.TDMS;begin FillProblemInput(); if not IsError() then begin edtLog.Lines.Clear(); edtLog.Lines.Add(DateTimeToStr(Now)); fProblemOutput := uProblem.Calculate(fProblemInput); edtLog.Lines.Add(uProblem.OutputToStr(fProblemOutput)); edtXP1.Text := FloatToStrF(fProblemOutput.ProblemPointsLocation.Xp1, ffFixed, 7, 3); edtYP1.Text := FloatToStrF(fProblemOutput.ProblemPointsLocation.Yp1, ffFixed, 7, 3); edtXP2.Text := FloatToStrF(fProblemOutput.ProblemPointsLocation.Xp2, ffFixed, 7, 3); edtYP2.Text := FloatToStrF(fProblemOutput.ProblemPointsLocation.Yp2, ffFixed, 7, 3); edtMP1.Text := FloatToStrF(fProblemOutput.LocationDeviation.mP1, ffFixed, 7, 3); edtMP2.Text := FloatToStrF(fProblemOutput.LocationDeviation.mP2, ffFixed, 7, 3); edtMP2.Text := FloatToStrF(fProblemOutput.LocationDeviation.mP2, ffFixed, 7, 3); mAlphaDms := RADtoDMS(fProblemOutput.AngleDeviation.mAlpha); edtMAlphaD.Text := IntToStr(mAlphaDms.Degrees); edtMAlphaM.Text := IntToStr(mAlphaDms.Minutes); edtMAlphaS.Text := IntToStr(mAlphaDms.Seconds); if fProblemOutput.IsError then SetError('Ошибка при выполнении расчета', ''); end; miFileSaveOutputBin.Enabled := not IsError(); miFileSaveOutputTxt.Enabled := not IsError(); miFileSaveImg.Enabled := not IsError(); UpdateImage();end;function New(): TFormCalc;var frm: TFormCalc; n: integer;begin frm := TFormCalc.Create(nil); n := Length(CalcForms); SetLength(CalcForms, n + 1); CalcForms[n] := frm; frm.fFormIndex := n; frm.UpdateWindowsMenuForAllForms(); frm.UpdateCaption(); frm.Show; Result := frm;end;end.Приложение Р – Лист замечаний