Back
{Display Form)
author: Nikolai Shokhirev )
created: (June 6, 2002)
last modified: August 8, 2003)
ŠNikolai V. Shokhirev, 2002-2003 }
{
         RowNum Names  Vector
        +------+------+------+------+------+
ColNum  |      |      |      |  1   |  2   |
        +------+------+------+------+------+
Headers |      |      |      |  H1  |  H2  |
        +------+------+------+------+------+
Values  |      |      |      |  E1  |  E2  |
        +------+------+------+------+------+
        |   1  |  N1  |  V1  | M11  | M12  |
        +------+------+------+------+------+
        |   2  |  N2  |  V2  | M21  | M22  |
        +------+------+------+------+------+
        |   3  |  N3  |  V3  | M31  | M32  |
        +------+------+------+------+------+

N: IBArr1D;  // Column of strings
V: IFArr1D; // Column-vector
H: IBArr1D;  // Row of strings
E: IFArr1D; // Row-vector
M: IFArr2D;

Any combinations of [diMatrix, diNames, diRowNum, diColNum, diValues, diVector,diHeaders]
are valid under the condition that at least one of [diMatrix, diValues, diVector] is presented. 

The button "M" (for Editing = true) is used for recordung modification to arrays.


Display format
  Width      - total length of a number for Matrix, Vector and Values
  Decimals   - number of decimal digits for Matrix
  V-Decimals - number of decimal digits for Vector and Values
  The numbers are displayed in the Scientific notation if Decimals < 0

Default values for Width and Decimals can be set before call for ShowModal:

  seW.Value := 8;
  seD.Value := 4;
  seDV.Value := 5;

All othe form properties can be set as well:

  Caption := ' Vector';
  Width := 300;
  Height := 200;
}
unit fDisplay;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, StdCtrls, Spin, Buttons, ExtCtrls, uMatTypes, uDynArrays;

type
  TDisplayItem =
         (diMatrix, diNames, diRowNum, diColNum, diValues, diVector, diHeaders);
  TDisplaySet = set of TDisplayItem;

  TFormDisplay = class(TForm)
    PanelTop: TPanel;
    LabelW: TLabel;
    LabelD: TLabel;
    ButtonMem: TSpeedButton;
    seD: TSpinEdit;
    seW: TSpinEdit;
    PanelBottom: TPanel;
    SG: TStringGrid;
    seDV: TSpinEdit;
    LabelDV: TLabel;
    procedure FormResize(Sender: TObject);
    procedure seWChange(Sender: TObject);
    procedure seDChange(Sender: TObject);
    procedure seDVChange(Sender: TObject);
    procedure ButtonMemClick(Sender: TObject);
  private
    { Private declarations }
    fNames: ISArr1D;
    fHeaders: ISArr1D;
    fVector: IFArr1D;
    fValues: IFArr1D;
    fMatrix: IFArr2D;
    fImMatrix: IFArr2D;
    ds: TDisplaySet;
    fDim1, fDim2: TInt;
    fLo1, fLo2: TInt;
    VecIdx: TInt;
    ValIdx: TInt;
    fCMatrix: boolean;
    procedure SetNames(const  NewNames: ISArr1D);
    procedure SetHeaders(const NewHeaders: ISArr1D);
    procedure SetVector(const NewVector: IFArr1D);
    procedure SetValues(const NewValues: IFArr1D);
    procedure SetMatrix(const NewMatrix: IFArr2D);
    procedure FixSG;
    procedure CheckDim;
    function GetDisplSet: TDisplaySet;
    procedure SetDisplSet(const Value: TDisplaySet);
    procedure SetEditing(const Value: boolean);
    function GetEditing: boolean;
    procedure SetImMatrix(const NewImMatrix: IFArr2D);
  public
    { Public declarations }
    procedure Display;
    property Editing: boolean read GetEditing write SetEditing;
    property DisplSet: TDisplaySet read GetDisplSet write SetDisplSet;
    property Names: ISArr1D write SetNames;
    property Headers: ISArr1D write SetHeaders;
    property Vector: IFArr1D write SetVector;
    property Values: IFArr1D write SetValues;
    property Matrix: IFArr2D write SetMatrix;
    property ImMatrix: IFArr2D write SetImMatrix;
    property CMatrix: boolean read fCMatrix write fCMatrix;
  end;

var
  FormDisplay: TFormDisplay;

implementation

uses
  math, uDisplay;

{$R *.DFM}

{ TFormDisplay }

procedure TFormDisplay.SetMatrix(const NewMatrix: IFArr2D);
begin
  fMatrix := NewMatrix;
end;

procedure TFormDisplay.SetImMatrix(const NewImMatrix: IFArr2D);
begin
  fImMatrix := NewImMatrix;
end;

procedure TFormDisplay.SetNames(const NewNames: ISArr1D);
begin
  fNames := NewNames;
end;

procedure TFormDisplay.SetHeaders(const NewHeaders: ISArr1D);
begin
  fHeaders := NewHeaders;
end;

procedure TFormDisplay.SetVector(const NewVector: IFArr1D);
begin
  fVector := NewVector;
end;

procedure TFormDisplay.SetValues(const NewValues: IFArr1D);
begin
  fValues := NewValues;
end;

procedure TFormDisplay.FixSG;
begin
  FixStringGrid(SG);
end;

procedure TFormDisplay.FormResize(Sender: TObject);
begin
  FixSG;
end;

procedure TFormDisplay.seWChange(Sender: TObject);
begin
  if seW.Value < 2 then seW.Value := 2;
  if seW.Value < seD.Value+2 then seD.Value := seW.Value-2;
  if seW.Value < seDV.Value+2 then seDV.Value := seW.Value-2;
  Display;
end;

procedure TFormDisplay.seDChange(Sender: TObject);
begin
  if seD.Value > seW.Value-2 then seW.Value := seD.Value+2;
  Display;
end;

procedure TFormDisplay.seDVChange(Sender: TObject);
begin
  if seDV.Value > seW.Value-2 then seW.Value := seDV.Value+2;
  Display;
end;

procedure TFormDisplay.CheckDim;
var
  nr, mr, mc, vc, hc, vr, fc, fr, rr, cc: TInt;
begin
  if not(diMatrix in ds) and not(diVector in ds) and not(diValues in ds) then
    raise Exception.Create('Matrix and/or Vector and/or Values must be included');

  nr := 0;  mr := 0;  vr := 0;  rr := 0;
  mc := 0;  vc := 0;  hc := 0;  cc := 0;

  if (diNames in ds) then
    if not Assigned(fNames) then
      raise Exception.Create('Names are not assigned')
    else
    begin
      nr := fNames.Dim1;    rr := max(rr, nr);
    end;

  if (diMatrix in ds) then
  begin
    if not Assigned(fMatrix) then
    raise Exception.Create('Matrix is not assigned');
    if fCMatrix and (not Assigned(fImMatrix)) then
    raise Exception.Create('Im Matrix is not assigned');
    mr := fMatrix.Dim1;    rr := max(rr, mr);
    mc := fMatrix.Dim2;    cc := max(cc, mc);
    fLo1 := fMatrix.Lo1;
    fLo2 := fMatrix.Lo2;
  end;

  if (diValues in ds) then
    if not Assigned(fValues) then
      raise Exception.Create('Values are not assigned')
    else
    begin
      vc := fValues.Dim1;    cc := max(cc, vc);
    end;

  seDV.Enabled := ((diValues in ds) or (diVector in ds));

  if (diHeaders in ds) then
    if not Assigned(fHeaders) then
      raise Exception.Create('Headers are not assigned')
    else
    begin
      hc := fHeaders.Dim1;    cc := max(cc, vc);
    end;

 if (diVector in ds) then
    if not Assigned(fVector) then
      raise Exception.Create('Vector is not assigned')
    else
    begin
      vr := fVector.Dim1;    rr := max(rr, vr);
  //    vc := max(vc, 1);      cc := max(cc, vc);
    end;

  if ((nr <> 0) and (nr <> rr)) or ((mr <> 0) and (mr <> rr)) or
     ((vr <> 0) and (vr <> rr)) then
    raise Exception.Create('Row dimensions are different');

  if ((vc <> 0) and (vc <> cc)) or ((mc <> 0) and (mc <> cc)) or
     ((hc <> 0) and (hc <> cc)) then
    raise Exception.Create('Col dimensions are different');

  fc := 0;
  if diRowNum in ds then fc := fc + 1;
  if diNames in ds then fc := fc + 1;
  if (diVector in ds) then
    if (diMatrix in ds) then fc := fc + 1 else cc := cc + 1;

  fr := 0;
  if diColNum in ds then fr := fr+1;
  if diHeaders in ds then fr := fr+1;
  if diValues in ds then
    if (diMatrix in ds) then fr := fr + 1 else rr := rr + 1;

  fDim1 := rr;
  fDim2 := cc;
  SG.FixedCols := fc;
  SG.FixedRows := fr;
  SG.ColCount := cc + fc;
  SG.RowCount := rr + fr;
end;

procedure TFormDisplay.Display;
var
  c, r, r1, c1, r0, c0 : TInt;
begin

  with SG do
  begin
    r0 := 0;
    if (diColNum in ds) then
    begin
      c1 := FixedCols;
      for c := 1 to fDim2 do
      begin
        Cells[c1,r0] := IntgToStr(c, 3);
        inc(c1);
      end;
      inc(r0);
    end;

    if (diHeaders in ds) then
    begin
      c1 := FixedCols;
      for c := 1 to fDim2 do
      begin
        Cells[c1,r0] := fHeaders[c];
        inc(c1);
      end;
      inc(r0);
    end;

    if (diValues in ds) then
    begin
      c1 := FixedCols;
      for c := 1 to fDim2 do
      begin
        Cells[c1,r0] := RealToStr(fValues[fValues.Lo1+c-1], seW.Value, seDV.Value);
        inc(c1);
      end;
      ValIdx := r0;
      inc(r0);
    end;

    c0 := 0;
    if (diRowNum in ds) then
    begin
      r1 := FixedRows;
      for r := 1 to fDim1 do
      begin
        Cells[c0,r1] := IntgToStr(r, 3);
        inc(r1);
      end;
      inc(c0);
    end;

    if (diNames in ds) then
    begin
      r1 := FixedRows;
      for r := 1 to fDim1 do
      begin
        Cells[c0,r1] := fNames[fNames.Lo1+r-1];
        inc(r1);
      end;
      inc(c0);
    end;

    if (diVector in ds) then
    begin
      r1 := FixedRows;
      for r := 1 to fDim1 do
      begin
        Cells[c0,r1] := RealToStr(fVector[fVector.Lo1+r-1], seW.Value, seDV.Value);
        inc(r1);
      end;
      VecIdx := c0;
      inc(c0);
    end;

    if (diMatrix in ds) then
    begin
      r1 := FixedRows;
      for r := 1 to fDim1 do
      begin
        c1 := FixedCols;
        for c := 1 to fDim2 do
        begin
          if CMatrix then
            Cells[c1,r1] := CplxToStr(fMatrix[fLo1+r-1,fLo2+c-1],
                              fImMatrix[fLo1+r-1,fLo2+c-1], seW.Value, seD.Value)
          else
            Cells[c1,r1] := RealToStr(fMatrix[fLo1+r-1,fLo2+c-1], seW.Value,
                                                                  seD.Value);
          inc(c1);
        end;
        inc(r1);
      end;
    end;
  end;
  FixSG;
end;

function TFormDisplay.GetDisplSet: TDisplaySet;
begin
  result := ds;
end;

procedure TFormDisplay.SetDisplSet(const Value: TDisplaySet);
begin
  ds := Value;
  CheckDim;
end;

procedure TFormDisplay.SetEditing(const Value: boolean);
begin
  if Value then SG.Options := SG.Options + [goEditing]
           else SG.Options := SG.Options - [goEditing];
  ButtonMem.Visible := Editing;
end;

function TFormDisplay.GetEditing: boolean;
begin
  result := goEditing in SG.Options;
end;

procedure TFormDisplay.ButtonMemClick(Sender: TObject);
var
  c, r, r1, c1: TInt;
  x, y: TFloat;
begin
  with SG do
  begin
    if (diMatrix in ds) then
    begin
      r1 := FixedRows;
      for r := 1 to fDim1 do
      begin
        c1 := FixedCols;
        for c := 1 to fDim2 do
        begin
          if CMatrix then
          begin
            StrToCplx(Cells[c1,r1], x, y);
            fMatrix[fLo1+r-1,fLo2+c-1] := x;
            fImMatrix[fLo1+r-1,fLo2+c-1] := y;
          end else
            fMatrix[fLo1+r-1,fLo2+c-1] := StrToFloat(Cells[c1,r1]);
          inc(c1);
        end;
        inc(r1);
      end;
    end;

    if (diVector in ds) then
    begin
      r1 := FixedRows;
      for r := 1 to fDim1 do
      begin
        fVector[fVector.Lo1+r-1] := StrToFloat(Cells[VecIdx,r1]);
        inc(r1);
      end;
    end;

    if (diValues in ds) then
    begin
      c1 := FixedCols;
      for c := 1 to fDim2 do
      begin
        fValues[fValues.Lo1+c-1] := StrToFloat(Cells[c1,ValIdx]);
        inc(c1);
      end;
    end;

  end;
end;

end.
Top

Generated by Lore's Source to HTML Converter(http://www.newty.de/lsc/index.html)