Nadesłany przez Andrzej Borucki, 30 listopada 2012 12:34
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.Pobierz pełne rozwiązanie.
Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.
GaussUnit.pas:
(*********************************** * Pezykład demonstrujący * * Eliminację Gaussa * * www.algorytm.org * * Andrzej Borucki * * Kontakt: * * borucki_andrzej (małpka) wp.pl * ************************************) {$J+} // Assignable typed constants unit GaussUnit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, Grids, ComCtrls, Spin, Menus, Recording; const WM_CALLRECORDING = WM_USER + 1; type TRestoreKind = (rkNone, rkCell, rkTwoRows, rkTwoColumns); TRestore = class Kind: TRestoreKind; Col, Row: integer; WholeRow1, WholeRow2: integer; WholeCol1, WholeCol2: integer; end; TGaussForm = class(TForm) StringGrid: TStringGrid; Memo: TMemo; PageControl1: TPageControl; TabSheet1: TTabSheet; Label3: TLabel; Label1: TLabel; btnCalculate: TButton; spinSize: TSpinEdit; btnClear: TButton; btnGenerate: TButton; btnInteresting: TButton; TabSheet2: TTabSheet; btnPrior: TBitBtn; btnNext: TBitBtn; btnLast: TBitBtn; TrackBar1: TTrackBar; spinCommand: TSpinEdit; MainMenu1: TMainMenu; Goto1: TMenuItem; miFirst: TMenuItem; miPrior: TMenuItem; miNext: TMenuItem; miLast: TMenuItem; comboMode: TComboBox; TabSheet3: TTabSheet; btnBreak: TButton; ProgressBar1: TProgressBar; Label2: TLabel; btnFirst: TBitBtn; cbAutoShiftBack: TCheckBox; miOptions: TMenuItem; Label5: TLabel; edMemory: TEdit; btnNumberEqAsInit: TSpeedButton; btnModeAsInit: TSpeedButton; miAbout: TMenuItem; procedure btnCalculateClick(Sender: TObject); procedure btnGenerateClick(Sender: TObject); procedure StringGridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure btnClearClick(Sender: TObject); procedure StringGridSetEditText(Sender: TObject; ACol, ARow: integer; const Value: String); procedure ListView1Edited(Sender: TObject; Item: TListItem; var S: String); procedure btnInterestingClick(Sender: TObject); procedure TabSheet2Resize(Sender: TObject); procedure comboModeChange(Sender: TObject); procedure btnPriorClick(Sender: TObject); procedure btnNextClick(Sender: TObject); procedure miPriorClick(Sender: TObject); procedure miNextClick(Sender: TObject); procedure TabSheet2Show(Sender: TObject); procedure TrackBar1Change(Sender: TObject); procedure spinCommandChange(Sender: TObject); procedure spinCommandKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure btnFirstClick(Sender: TObject); procedure miFirstClick(Sender: TObject); procedure miLastClick(Sender: TObject); procedure btnLastClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure StringGridDrawCell(Sender: TObject; ACol, ARow: integer; Rect: TRect; State: TGridDrawState); procedure FormDestroy(Sender: TObject); procedure spinSizeChange(Sender: TObject); procedure spinSizeKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure TabSheet1Show(Sender: TObject); procedure spinSizeExit(Sender: TObject); procedure spinCommandExit(Sender: TObject); procedure miOptionsClick(Sender: TObject); procedure cbAutoShiftBackClick(Sender: TObject); procedure btnBreakClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure spinCommandKeyPress(Sender: TObject; var Key: Char); procedure spinSizeKeyPress(Sender: TObject; var Key: Char); procedure btnNumberEqAsInitClick(Sender: TObject); procedure btnModeAsInitClick(Sender: TObject); procedure miAboutClick(Sender: TObject); private computation_time: real; spinCommandKey: Word; spinCommandSav: integer; spinDimKey: Word; spinSizeSav: integer; TrackBarSav: integer; LastComboIndex: integer; Restore: TRestore; procedure WMCallRecording(var Message: TMessage); message WM_CALLRECORDING; procedure time_measurement(mode: TCalcMode); procedure print_results(mode: TCalcMode); procedure EnableDisableCommands; function trackStride: integer; procedure UpdateTrack; procedure RealChangeSpinCommand; procedure UpdateSpin; procedure CallRecording; procedure Colorize; procedure CheckBigEps(); public bBreak: boolean; procedure SetGridSize; procedure ArraysToGrid; procedure GridToArrays; procedure Calculate(mode: TCalcMode); procedure CalculateAndRecord(mode: TCalcMode); end; var GaussForm: TGaussForm; implementation uses Math, {$IFDEF FPC} JwaPsApi, JwaTlHelp32, {$ELSE} PsAPI, TlHelp32, {$ENDIF} listUnit, addUnit, OptionsUnit, AboutUnit; {$R *.dfm} procedure TGaussForm.GridToArrays; var i, j: integer; begin with model do for i := 0 to Size - 1 do for j := 0 to Size - 1 do A[i, j] := StrToFloatDef(pdsep(StringGrid.Cells[j + 1, i + 1]), 0); with model do for i := 0 to Size - 1 do b[i] := StrToFloatDef(pdsep(StringGrid.Cells[Size + 1, i + 1]), 0); end; procedure swap_rows(first, second: integer); var tmp: float; i: integer; begin with model do begin for i := 0 to Size - 1 do begin tmp := A[first, i]; A[first, i] := A[second, i]; A[second, i] := tmp; end; tmp := b[first]; b[first] := b[second]; b[second] := tmp; end; end; procedure swap_columns(first, second: integer); var tmp: float; i: integer; begin with model do for i := 0 to Size - 1 do begin tmp := A[i, first]; A[i, first] := A[i, second]; A[i, second] := tmp; end; end; function CheckRank(model: TModel): boolean; var i: integer; begin result := true; for i := model.Size - 1 downto 0 do if Abs(model.A[model.Size - 1, i]) > Opt.Eps then exit; result := false; model.isRankLess := not result; end; procedure TGaussForm.Calculate(mode: TCalcMode); var r, S: integer; i, j: integer; start: integer; found: boolean; l: float; k: integer; sum: float; AbsV, Max_i1, Max_ij: float; begin model.otherException := false; model.isRankLess := false; model.isSingular := false; model.hasZeroOnDiagonal := false; model.Results.is_calculated := false; with model do for start := 0 to Size - 2 do begin S := start; r := start; found := false; case mode of cmSimple: found := A[start, start] <> 0; cmZero: for r := start to Size - 1 do if A[r, start] <> 0 then begin found := true; break; end; cmEps: for r := start to Size - 1 do if Abs(A[r, start]) > Opt.Eps then begin found := true; break; end; cmPartialPivot: begin Max_i1 := NegInfinity; for i := start to Size - 1 do begin AbsV := Abs(A[i, start]); if AbsV > Max_i1 then begin Max_i1 := AbsV; r := i; end; end; if Max_i1 > Opt.Eps then found := true; end; cmCompletePivot: begin Max_ij := NegInfinity; for i := start to Size - 1 do for j := start to Size - 1 do begin AbsV := Abs(A[i, j]); if AbsV > Max_ij then begin Max_ij := AbsV; r := i; S := j; end; end; if Max_ij > Opt.Eps then found := true; end; end; if not found then begin if mode = cmSimple then hasZeroOnDiagonal := true else isSingular := true; exit; end; if r <> start then swap_rows(start, r); if S <> start then begin swap_columns(start, S); Assert(model.Results.swaps[start] = 0); model.Results.swaps[start] := S; end; // it is called n-1 times for i := start + 1 to Size - 1 do begin // it is called n(n-1)/2 times l := A[i, start] / A[start, start]; for j := start to Size - 1 do begin // it is called n(n*n-1)/3 times A[i, j] := A[i, j] - l * A[start, j]; end; b[i] := b[i] - l * b[start]; end; end; { results calculation } if not CheckRank(model) then exit; try with model, model.Results do for i := Size - 1 downto 0 do begin sum := 0; for k := i + 1 to Size - 1 do sum := sum + A[i, k] * calculated[k]; calculated[i] := (b[i] - sum) / A[i, i]; end; except model.otherException := true; end; model.Results.is_calculated := true; end; function GetCurrentProcessMemory: Dword; var PMC: _PROCESS_MEMORY_COUNTERS; begin PMC.cb := sizeof(PMC); if not GetProcessMemoryInfo(GetCurrentProcess, {$IFNDEF FPC}@ {$ENDIF} PMC, sizeof(PMC)) then raise Exception.Create('Error GetProcessMemoryInfo'); result := PMC.WorkingSetSize; end; procedure TGaussForm.CalculateAndRecord(mode: TCalcMode); var start: integer; r, S: integer; i, j: integer; l: float; found: boolean; AbsV, Max_i1, Max_ij: float; counter: integer; CountAll: int64; ticks, prevticks: Dword; begin edMemory.Text := Format('%.2n', [GetCurrentProcessMemory() / (1024 * 1024)]); prevticks := GetTickCount(); counter := 0; model.CommandProcessor.Clear; CountAll := model.Size * (model.Size * model.Size - 1) div 3; ProgressBar1.Max := CountAll div (256 * 256); with model do for start := 0 to Size - 2 do begin S := start; r := start; found := false; case mode of cmSimple: found := A[start, start] <> 0; cmZero: for r := start to Size - 1 do if A[r, start] <> 0 then begin found := true; break; end; cmEps: for r := start to Size - 1 do if Abs(A[r, start]) > Opt.Eps then begin found := true; break; end; cmPartialPivot: begin Max_i1 := NegInfinity; for i := start to Size - 1 do begin AbsV := Abs(A[i, start]); if AbsV > Max_i1 then begin Max_i1 := AbsV; r := i; end; end; if Max_i1 > Opt.Eps then found := true; end; cmCompletePivot: begin Max_ij := NegInfinity; for i := start to Size - 1 do for j := start to Size - 1 do begin AbsV := Abs(A[i, j]); if AbsV > Max_ij then begin Max_ij := AbsV; r := i; S := j; end; end; if Max_ij > Opt.Eps then found := true; end; end; if not found then begin if mode = cmSimple then hasZeroOnDiagonal := true else isSingular := true; exit; end; if r <> start then CommandProcessor.Execute(TSwapRows.Create(model, start, r)); if S <> start then CommandProcessor.Execute(TSwapColumns.Create(model, start, S)); for i := start + 1 to Size - 1 do begin l := A[i, start] / A[start, start]; for j := start to Size - 1 do begin inc(counter); if counter and (256 * 256 - 1) = 0 then begin ticks := GetTickCount(); if ticks - prevticks >= 100 then begin edMemory.Text := Format ('%.2n', [GetCurrentProcessMemory() / (1024 * 1024)]); edMemory.Repaint(); ProgressBar1.Position := counter div (256 * 256); Application.ProcessMessages(); if bBreak then exit; prevticks := ticks; end; end; // model.FA[i,j]:=model.FA[i,j]-l*model.FA[start,j]; CommandProcessor.Execute (TSetA.Create(model, i, j, A[i, j] - l * A[start, j])); end; // model.Fb[i]:=model.Fb[i]-l*model.Fb[start]; CommandProcessor.Execute(TSetB.Create(model, i, b[i] - l * b[start])); end; end; end; procedure TGaussForm.SetGridSize; var i, j: integer; begin StringGrid.ColCount := model.Size + 2; StringGrid.RowCount := model.Size + 1; StringGrid.Col := 1; StringGrid.Row := 1; for j := 0 to model.Size - 1 do StringGrid.Cells[j + 1, 0] := 'x' + IntToStr(j); for i := 0 to model.Size - 1 do StringGrid.Cells[0, i + 1] := 'equation ' + IntToStr(i); StringGrid.Cells[model.Size + 1, 0] := 'b'; end; procedure TGaussForm.btnNumberEqAsInitClick(Sender: TObject); begin Opt.InitSize := spinSize.Value; btnNumberEqAsInit.Enabled := false; end; procedure TGaussForm.btnModeAsInitClick(Sender: TObject); begin Opt.InitMode := comboMode.ItemIndex+1; btnModeAsInit.Enabled := false; end; procedure TGaussForm.RealChangeSpinCommand; begin spinCommand.OnChange := nil; if spinCommand.Value < spinCommand.MinValue then spinCommand.Value := spinCommand.MinValue; if spinCommand.Value > spinCommand.MaxValue then spinCommand.Value := spinCommand.MaxValue; model.CommandProcessor.Seek(spinCommand.Value - 1); ArraysToGrid; Memo.Lines.Add(model.CommandProcessor.Describe()); EnableDisableCommands; UpdateTrack; spinCommand.OnChange := spinCommandChange; end; procedure TGaussForm.spinCommandChange(Sender: TObject); var n: integer; begin if not TryStrToInt(spinCommand.Text, n) then exit; if (spinCommandKey = 0) and (Abs(spinCommandSav - spinCommand.Value) = 1) then RealChangeSpinCommand; spinCommandSav := spinCommand.Value; spinCommandKey := 0; end; procedure TGaussForm.spinCommandExit(Sender: TObject); begin RealChangeSpinCommand; end; // I want to distinguish between click up/down and edit // is not perfect if select text procedure TGaussForm.spinCommandKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = 13 then begin Key := 0; RealChangeSpinCommand; spinCommandKey := 0; end else spinCommandKey := Key; end; procedure TGaussForm.spinCommandKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then Key := #0; end; procedure TGaussForm.spinSizeChange(Sender: TObject); var n: integer; begin if not TryStrToInt(spinSize.Text, n) then exit; if (spinDimKey = 0) and (Abs(spinSizeSav - spinSize.Value) = 1) then btnClearClick(Sender); spinSizeSav := spinSize.Value; spinDimKey := 0; end; procedure TGaussForm.spinSizeExit(Sender: TObject); begin btnClearClick(Sender); end; procedure TGaussForm.spinSizeKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = 13 then begin Key := 0; btnClearClick(Sender); spinDimKey := 0; end else spinDimKey := Key; end; procedure TGaussForm.spinSizeKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then Key := #0; end; procedure TGaussForm.CallRecording; var count: integer; begin TabSheet2.OnShow := nil; if model.Changed then model.Save; TabSheet3.Enabled := true; PageControl1.ActivePageIndex := 2; TabSheet1.Enabled := false; TabSheet2.Enabled := false; StringGrid.Enabled := false; try model.Reset; bBreak := false; CalculateAndRecord(TCalcMode(comboMode.ItemIndex)); finally StringGrid.Enabled := true; TabSheet1.Enabled := true; TabSheet2.Enabled := true; PageControl1.ActivePageIndex := 1; TabSheet3.Enabled := false; end; count := model.CommandProcessor.CommandCount; Label2.Caption := Format('/%d', [count]); spinCommand.MaxValue := count; if cbAutoShiftBack.Checked then model.CommandProcessor.Seek(-1); ArraysToGrid; Memo.Lines.Add(model.CommandProcessor.Describe()); EnableDisableCommands; UpdateSpin; UpdateTrack; TabSheet2.OnShow := TabSheet2Show; end; procedure TGaussForm.cbAutoShiftBackClick(Sender: TObject); begin Opt.AutoShiftBack := cbAutoShiftBack.Checked; end; procedure TGaussForm.Colorize; var idx1, idx2: integer; val1, val2: float; CommandClass: TClass; i: integer; begin if Restore.Kind = rkCell then StringGrid.Objects[Restore.Col, Restore.Row] := TObject(0) else if Restore.Kind = rkTwoRows then for i := 0 to StringGrid.ColCount - 1 do begin StringGrid.Objects[i, Restore.WholeRow1] := TObject(0); StringGrid.Objects[i, Restore.WholeRow2] := TObject(0); end else if Restore.Kind = rkTwoColumns then for i := 0 to StringGrid.RowCount - 1 do begin StringGrid.Objects[Restore.WholeCol1, i] := TObject(0); StringGrid.Objects[Restore.WholeCol2, i] := TObject(0); end; CommandClass := model.CommandProcessor.GetPosition(idx1, idx2); if CommandClass = nil then exit; if CommandClass = TSetA then begin Restore.Kind := rkCell; Restore.Col := idx2 + 1; Restore.Row := idx1 + 1; end else if CommandClass = TSetB then begin Restore.Kind := rkCell; Restore.Col := model.Size + 1; Restore.Row := idx1 + 1; end else if CommandClass = TSwapRows then begin Restore.Kind := rkTwoRows; Restore.WholeRow1 := idx1 + 1; Restore.WholeRow2 := idx2 + 1; end else if CommandClass = TSwapColumns then begin Restore.Kind := rkTwoColumns; Restore.WholeCol1 := idx1 + 1; Restore.WholeCol2 := idx2 + 1; end; if (CommandClass = TSetA) or (CommandClass = TSetB) then begin model.CommandProcessor.GetValues(val1, val2); if Abs(val2 - val1) > Opt.Eps then StringGrid.Objects[Restore.Col, Restore.Row] := TObject(1) else StringGrid.Objects[Restore.Col, Restore.Row] := TObject(2); end else if CommandClass = TSwapRows then for i := 0 to StringGrid.ColCount - 1 do begin StringGrid.Objects[i, Restore.WholeRow1] := TObject(3); StringGrid.Objects[i, Restore.WholeRow2] := TObject(3); end else if CommandClass = TSwapColumns then for i := 0 to StringGrid.RowCount - 1 do begin StringGrid.Objects[Restore.WholeCol1, i] := TObject(4); StringGrid.Objects[Restore.WholeCol2, i] := TObject(4); end end; procedure TGaussForm.comboModeChange(Sender: TObject); begin if (model.Size>0) and ((comboMode.ItemIndex <> LastComboIndex) or model.Changed) then CallRecording; LastComboIndex := comboMode.ItemIndex; end; procedure TGaussForm.btnClearClick(Sender: TObject); var i, j: integer; begin model.Size := StrToInt(spinSize.Text); spinSize.Text := IntToStr(model.Size); spinSize.Value := model.Size; try btnClear.Enabled := false; btnClear.Repaint; btnGenerate.Enabled := false; btnGenerate.Repaint; btnInteresting.Enabled := false; btnInteresting.Repaint; SetGridSize; StringGrid.SetFocus; model.Clear; with model do for i := 1 to Size do for j := 1 to Size + 1 do StringGrid.Cells[j, i] := ''; with model do for i := 0 to Size do for j := 0 to Size + 1 do StringGrid.Objects[j, i] := nil; finally btnClear.Enabled := true; btnGenerate.Enabled := true; btnInteresting.Enabled := true; end; btnNumberEqAsInit.Enabled := spinSize.Value <> Opt.InitSize; end; procedure TGaussForm.CheckBigEps(); function NumberVisible: boolean; var i, j: integer; rowVisible, colVisible: integer; H, W: integer; begin H := 0; rowVisible := 0; while rowVisible < StringGrid.RowCount do begin inc(H, StringGrid.RowHeights[rowVisible] + 1); inc(rowVisible); if H >= StringGrid.Height then begin if rowVisible > 2 then dec(rowVisible); break; end; end; W := 0; colVisible := 0; while colVisible < StringGrid.ColCount do begin inc(W, StringGrid.ColWidths[colVisible] + 1); inc(colVisible); if W >= StringGrid.Height then begin if colVisible > 2 then dec(colVisible); break; end; end; result := true; for i := 1 to rowVisible - 1 do for j := 1 to colVisible - 1 do if StringGrid.Cells[j, i] <> '' then exit; result := false; end; begin if (Opt.Eps >= 0.01) and Opt.HideZero and Opt.AlsoEps and not NumberVisible() then begin MessageDlg('Cells empty because hide elems<=Eps; Eps=' + FloatToStr(Opt.Eps) , mtWarning, [mbOK], 0); OptionsForm.ShowModal; end; end; procedure TGaussForm.btnGenerateClick(Sender: TObject); var i, j: integer; begin btnGenerate.Enabled := false; try model.Size := StrToInt(spinSize.Text); SetGridSize; StringGrid.SetFocus; model.Generate(); ArraysToGrid; with model do for i := 0 to Size do for j := 0 to Size + 1 do StringGrid.Objects[j, i] := nil; CheckBigEps(); finally btnGenerate.Enabled := true; end; end; procedure TGaussForm.btnFirstClick(Sender: TObject); begin model.CommandProcessor.Seek(-1); Colorize(); ArraysToGrid; Memo.Lines.Add(model.CommandProcessor.Describe()); EnableDisableCommands; UpdateSpin; UpdateTrack; end; function MeanSquareError(): real; var i: integer; begin result := 0; for i := 0 to model.Size - 1 do result := result + Sqr(model.Results.calculated[i] - model.Results.exact[i] ); result := sqrt(result / model.Size); end; function format_computation_time(computation_time: real): string; begin if computation_time < 0.001 then result := Format('czas= %.4g us', [computation_time * 1E6]) else if computation_time < 1 then result := Format('czas= %.4g ms', [computation_time * 1000]) else result := Format('czas= %.4g s', [computation_time]) end; procedure TGaussForm.print_results(mode: TCalcMode); var i: integer; begin model.Results.RestoreOrder; if (mode = cmSimple) and model.hasZeroOnDiagonal then begin Memo.Lines.Add('Matrix has a zero on diagonal - no results'); Memo.Lines.Add('mean squared error = ???'); end else if model.isSingular then begin Memo.Lines.Add('Matrix is singular - no results'); Memo.Lines.Add('mean squared error = ???'); end else if model.isRankLess then begin Memo.Lines.Add('Matrix rank is < n - no results'); Memo.Lines.Add('mean squared error = ???'); end else if model.otherException then begin Memo.Lines.Add('Other exception during computing results'); Memo.Lines.Add('mean squared error = ???'); end else begin for i := 0 to model.Size - 1 do Memo.Lines.Add(Format('%d: %g', [i, model.Results.calculated[i]])); if model.Results.existsExact then Memo.Lines.Add(Format('mean squared error = %g', [MeanSquareError()])) end; Memo.Lines.Add(format_computation_time(computation_time)); end; procedure TGaussForm.miPriorClick(Sender: TObject); begin btnPriorClick(Sender); end; procedure TGaussForm.time_measurement(mode: TCalcMode); procedure Reset; var i: integer; begin model.Reset; FillChar(model.Results.swaps[0], Length(model.Results.swaps) * sizeof (model.Results.swaps[0]), 0) end; var i64a, i64b, i64f: int64; queryTime, time: int64; i, ilosc_petli: integer; begin QueryPerformanceCounter(i64a); Reset; QueryPerformanceCounter(i64b); queryTime := i64b - i64a; QueryPerformanceCounter(i64a); Reset; Calculate(mode); QueryPerformanceCounter(i64b); time := i64b - i64a - queryTime; if time < 10 * 1000 then begin ilosc_petli := 10 * 1000 div Max(time, 1); QueryPerformanceCounter(i64a); for i := 1 to ilosc_petli do Reset; QueryPerformanceCounter(i64b); queryTime := i64b - i64a; QueryPerformanceCounter(i64a); for i := 1 to ilosc_petli do begin Reset; Calculate(mode); end; QueryPerformanceCounter(i64b); time := i64b - i64a - queryTime; end else ilosc_petli := 1; QueryPerformanceFrequency(i64f); computation_time := time / i64f / ilosc_petli; end; procedure TGaussForm.btnBreakClick(Sender: TObject); begin bBreak := true; end; procedure TGaussForm.btnCalculateClick(Sender: TObject); var tryb: TCalcMode; begin if Length(model.A) = 0 then exit; if model.Changed then model.Save; Memo.Clear; for tryb := cmSimple to cmCompletePivot do begin case tryb of cmSimple: Memo.Lines.Add('mode: without exchange lines'); cmZero: Memo.Lines.Add('mode: exchange when zero'); cmEps: Memo.Lines.Add('mode: exchange when <=eps'); cmPartialPivot: Memo.Lines.Add('partial pivoting'); cmCompletePivot: Memo.Lines.Add('complete pivoting'); end; time_measurement(tryb); print_results(tryb); Memo.Lines.Add(''); end; if AddForm.EmptyResults then AddForm.FillGrid(model.Size, model.Results.calculated); end; procedure TGaussForm.ArraysToGrid; var i, j: integer; EpsZero: float; begin if Opt.AlsoEps then EpsZero := Opt.Eps else EpsZero := 0; with model do for i := 0 to Size - 1 do for j := 0 to Size - 1 do if Opt.HideZero and (Abs(A[i, j]) <= EpsZero) then StringGrid.Cells[j + 1, i + 1] := '' else StringGrid.Cells[j + 1, i + 1] := Format(Opt.FormatStr, [A[i, j]]); with model do for i := 0 to Size - 1 do if Opt.HideZero and (Abs(b[i]) <= EpsZero) then StringGrid.Cells[Size + 1, i + 1] := '' else StringGrid.Cells[Size + 1, i + 1] := Format(Opt.FormatStr, [b[i]]); end; procedure TGaussForm.StringGridDrawCell(Sender: TObject; ACol, ARow: integer; Rect: TRect; State: TGridDrawState); begin with (Sender as TStringGrid) do with Canvas do begin if gdFixed in State then begin case integer(StringGrid.Objects[ACol, ARow]) of 0, 1, 2: Brush.Color := clBtnFace; 3: Brush.Color := TColor($9090D0); 4: Brush.Color := TColor($90D0D0); end; end else case integer(StringGrid.Objects[ACol, ARow]) of 0: Brush.Color := clWindow; 1: Brush.Color := clLime; 2: Brush.Color := clAqua; 3: Brush.Color := TColor($A0A0FF); 4: Brush.Color := TColor($90FFFF); end; FillRect(Rect); if gdFocused in State then Rectangle(Rect); Font.Color := clWindowText; TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Cells[ACol, ARow]); end; end; procedure TGaussForm.StringGridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_ESCAPE then spinSize.SetFocus; end; procedure TGaussForm.StringGridSetEditText (Sender: TObject; ACol, ARow: integer; const Value: String); begin model.Results.existsExact := false; model.Results.is_calculated := false; GridToArrays(); model.Change(); end; function TGaussForm.trackStride: integer; begin result := Max(8 * model.CommandProcessor.CommandCount div TrackBar1.Width, 1); end; procedure TGaussForm.UpdateTrack; var t: integer; begin t := trackStride(); TrackBar1.OnChange := nil; TrackBar1.Max := (model.CommandProcessor.CommandCount + t - 1) div t; TrackBar1.Position := (model.CommandProcessor.CurrentCommand + t - 1) div t + 1; TrackBarSav := TrackBar1.Position; TrackBar1.OnChange := TrackBar1Change; end; procedure TGaussForm.WMCallRecording(var Message: TMessage); begin CallRecording; end; procedure TGaussForm.UpdateSpin; begin spinCommand.OnChange := nil; spinCommand.Value := model.CommandProcessor.CurrentCommand + 1; spinCommand.OnChange := spinCommandChange; end; procedure TGaussForm.TrackBar1Change(Sender: TObject); var CommandPos: integer; begin if TrackBar1.Position = TrackBarSav then exit; TrackBarSav := TrackBar1.Position; CommandPos := Min(TrackBar1.Position * trackStride(), model.CommandProcessor.CommandCount) - 1; model.CommandProcessor.Seek(CommandPos); Memo.Lines.Add(model.CommandProcessor.Describe()); ArraysToGrid; EnableDisableCommands; UpdateSpin; end; procedure TGaussForm.TabSheet1Show(Sender: TObject); begin if spinSizeSav = 0 then begin spinSizeSav := spinSize.Value; btnClearClick(Sender); end; end; procedure TGaussForm.TabSheet2Resize(Sender: TObject); begin UpdateTrack; end; procedure TGaussForm.TabSheet2Show(Sender: TObject); begin spinCommandSav := spinCommand.Value; if (comboMode.ItemIndex >= 0) and ((comboMode.ItemIndex <> LastComboIndex) or model.Changed) then PostMessage(Handle, WM_CALLRECORDING, 0, 0); UpdateTrack; end; procedure TGaussForm.ListView1Edited(Sender: TObject; Item: TListItem; var S: String); var equation: TEquation; begin Assert(Item.Data <> nil); equation := Item.Data; equation.Title := S; end; procedure TGaussForm.miFirstClick(Sender: TObject); begin btnFirstClick(Sender); end; procedure TGaussForm.miLastClick(Sender: TObject); begin btnLastClick(Sender); end; procedure TGaussForm.miNextClick(Sender: TObject); begin btnNextClick(Sender); end; procedure TGaussForm.miOptionsClick(Sender: TObject); begin OptionsForm.ShowModal; end; procedure TGaussForm.btnInterestingClick(Sender: TObject); begin ListForm.Show; if not ListForm.Loaded then ListForm.btnLoadClick(Sender); end; procedure TGaussForm.btnLastClick(Sender: TObject); begin model.CommandProcessor.Seek(model.CommandProcessor.CommandCount - 1); Colorize(); ArraysToGrid; Memo.Lines.Add(model.CommandProcessor.Describe()); EnableDisableCommands; UpdateSpin; UpdateTrack; end; procedure TGaussForm.EnableDisableCommands; begin btnPrior.Enabled := model.CommandProcessor.CanUndo; miPrior.Enabled := btnPrior.Enabled; btnFirst.Enabled := miPrior.Enabled; miFirst.Enabled := btnFirst.Enabled; btnNext.Enabled := model.CommandProcessor.CanRedo; miNext.Enabled := btnNext.Enabled; btnLast.Enabled := btnNext.Enabled; miLast.Enabled := btnLast.Enabled; end; procedure TGaussForm.FormActivate(Sender: TObject); const Activated: boolean = false; begin if not Activated then spinSize.Value := Opt.InitSize; Activated := true; comboMode.ItemIndex := Opt.InitMode-1; end; procedure TGaussForm.FormCreate(Sender: TObject); begin LastComboIndex := -1; Restore := TRestore.Create; end; procedure TGaussForm.FormDestroy(Sender: TObject); begin Restore.Free; end; procedure TGaussForm.btnNextClick(Sender: TObject); begin model.CommandProcessor.Redo(); Memo.Lines.Add(model.CommandProcessor.Describe()); Colorize(); ArraysToGrid; EnableDisableCommands; UpdateSpin; UpdateTrack; end; procedure TGaussForm.btnPriorClick(Sender: TObject); begin model.CommandProcessor.Undo(); Colorize(); ArraysToGrid; Memo.Lines.Add(model.CommandProcessor.Describe()); EnableDisableCommands; UpdateSpin; UpdateTrack; end; procedure TGaussForm.miAboutClick(Sender: TObject); begin AboutForm.ShowModal; end; end.