next up previous contents
Nächste Seite: 9.11 Unit LoadSave Aufwärts: 9. Programmlisting Vorherige Seite: 9.9 Unit KoherU   Inhalt

9.10 Unit Anzeige


{-------------------------------------------------------------------}

{ Grafische Ausgabe der Messergebnisse }
unit Anzeige;

{-------------------------------------------------------------------}

interface

procedure GrafikAusgabe;
procedure LCDarstellung;

{-------------------------------------------------------------------}

implementation

uses
  ConvertU,    { Konvertierung von Plot-Daten }
  Glob,        { Globale Deklarationen }
  KoherU,      { Berechnungen Kohaerenzgrad und -laenge }
  LoadSave,    { Laden und Speichern von Dateien }
  TransU,      { Vorbereitungen zur (inversen) FFT }

  { Turbo Pascal Standard Units }
  App, Crt, Dialogs, Dos, Graph, GraphApp, MsgBox, Objects, StdDlg,
  Views;

var
  s1, s2 : string;

{-------------------------------------------------------------------}

{ Initialisierung des Grafikbildschirms }
procedure STDInitGraph;

var
  BGIPath : PString;
  GraphOk : boolean;

begin { Grafik }
  BGIPath := NewStr(FExpand('.'));
  GraphOk := GraphAppInit(0, 0, BGIPath, true);
  if not GraphOk then
    MessageBox(#3+'Kann Grafiktreiber nicht finden', nil,
      mfOKButton or mfError);
end; { STDInitGraph }

{-------------------------------------------------------------------}

{ Anlegen eines Grafikbilschirms mit festen Elementen }
procedure Grafikbildschirm;

begin
  Rectangle(0, 0, GetMaxX, GetMaxY);
  Line(0, GetMaxY - 20, GetMaxX, GetMaxY - 20);
  Line(GetMaxX - 155, GetMaxY - 20, GetMaxX - 155, GetMaxY);
  OutTextXY(15, GetMaxY - 13, s1);
  OutTextXY(GetMaxX - 140, GetMaxY - 13, s2);
end; { Grafikbildschirm }

{-------------------------------------------------------------------}

{ Zeichnen des Koordinatensystems }
procedure Koordinatenkreuz;

begin
  Line(20, GetMaxY - 40, GetMaxX - 20, GetMaxY - 40);
  Line(20, 20, 20, GetMaxY - 40);
end; { Koordinatenkreuz }

{-------------------------------------------------------------------}

{ Skalierung des Koordinatensystems fuer Ausgabe der
  Interferenzmuster und der FFT }
procedure Skalierung;

var
  i, FaktorX, FaktorY : word;

begin
  FaktorX := (GetMaxX - 39) div 10;
  FaktorY := (GetMaxY - 59) div 10;
  for i := 0 to 10 do
  begin
    Line(17, 19 + i * FaktorY, 23, 19 + i * FaktorY);
    Line(20 + i * FaktorX, GetMaxY - 37,
         20 + i * FaktorX, GetMaxY - 43);
  end;
end; { Skalierung }

{-------------------------------------------------------------------}

{ Skalierung des Koordinatensystems fuer Ausgabe der
  Kohaerenzfunktion }
procedure SkalierungLC;

var
  i, Xmax, Xskal, FaktorY : word;
  FaktorX                 : real;
  str1, str2              : string;

begin
  FaktorY := (GetMaxY - 59) div 10;
  for i := 0 to 10 do
    Line(17, 19 + i * FaktorY, 23, 19 + i * FaktorY);
  OutTextXY(8, 17, '1');
  OutTextXY(8, GetMaxY - 43, '0');
  OutTextXY(8, round(11 + 10 * (1 - exp(-1)) * FaktorY), '1');
  OutTextXY(8, round(17 + 10 * (1 - exp(-1)) * FaktorY), '-');
  OutTextXY(8, round(22 + 10 * (1 - exp(-1)) * FaktorY), 'e');
  for i := 0 to 50 do
    PutPixel(round(20 + i * (GetMaxX - 40) / 50),
             round(19 + 10 * (1 - exp(-1)) * FaktorY), white);

  Xmax := round(w[0].delta);
  for i := 1 to Anzahldelta - 1 do
    if w[i].delta > Xmax then Xmax := round(w[i].delta);
  case Xmax of
    0..10  : Xskal := 1;
    11..20 : Xskal := 2;
    21..50 : Xskal := 5;
    else Xskal := 10;
  end;
  FaktorX := (GetMaxX - 39) / XMax;
  i := 0;
  while i * XSkal <= Xmax do
  begin
    Line(round(20 + i * Xskal * FaktorX), GetMaxY - 37,
         round(20 + i * Xskal * FaktorX), GetMaxY - 43);
    str(i * Xskal, str1);
    OutTextXY(round(16 + i * Xskal * FaktorX), GetMaxY - 33, str1);
    inc(i);
  end;

  str(deltac : 3 : 1, str1);
  str(deltacSAM : 3 : 1, str2);
  if AnzahlMessung > 1 then
    str1 := 'Lc = ' + str1 + ' ' + chr(241) + ' ' + str2 + ' cm'
  else str1 := 'Lc = ' + str1 + ' cm';
  OutTextXY(GetMaxX - 180, 30, str1);
end; { SkalierungLC }

{-------------------------------------------------------------------}

{ Zeichnen einer gemessenen Intensitaetsverteilung }
procedure Intensitaetskurve;

var
  i                : word;
  FaktorX, FaktorY : real;

begin
  FaktorX := (GetMaxX - 40) / nmax;
  FaktorY := (GetMaxY - 60) / hmax;
  for i := 1 to nmax - 1 do
    Line(round((i - 1) * FaktorX + 20),
         round((hmax - 1 - Imes^[i - 1]) * FaktorY + 20),
         round(i * FaktorX + 20),
         round((hmax - 1 - Imes^[i]) * FaktorY + 20));
end; { Intensitaetskurve }

{-------------------------------------------------------------------}

{ Zeichnen einer FFT }
procedure Transformationskurve;

var
  i                      : word;
  FaktorX, FaktorY, ymax : real;

begin
  FaktorX := (GetMaxX - 40) / (nmax div 2);
  ymax := Itrans^[0];
  for i := 1 to nmax div 2 - 1 do
    if Itrans^[i] > ymax then ymax := Itrans^[i];
  FaktorY := (GetMaxY - 60) / ymax;
  for i := 1 to nmax div 2 do
    Line(round((i - 1) * FaktorX + 20),
         round((ymax - Itrans^[i - 1]) * FaktorY + 20),
         round(i * FaktorX + 20),
         round((ymax - Itrans^[i]) * FaktorY + 20));
end; { Transformationskurve }

{-------------------------------------------------------------------}

{ Zeichnen einer bereinigten Intensitaetsverteilung }
procedure Synthesekurve;

var
  i                : word;
  FaktorX, FaktorY : real;

begin
  FaktorX := (GetMaxX - 40) / nmax;
  FaktorY := (GetMaxY - 60) / hmax;
  for i := 1 to nmax - 1 do
    Line(round((i - 1) * FaktorX + 20),
         round((hmax - 1 - Itrans^[i - 1]) * FaktorY + 20),
         round(i * FaktorX + 20),
         round((hmax - 1 - Itrans^[i]) * FaktorY + 20));
end; { Synthesekurve }

{-------------------------------------------------------------------}

{ Vorbereitung zur Ausgabe einer gemessenen Intensitaetsverteilung }
procedure AusgabeMessung;

var
  Taste : char;

begin
  if not Exists(copy(FileName, 0, Length(FileName) - 3) + ExtMess)
    then Convert
  else FileName := copy(FileName, 0, Length(FileName) - 3) + ExtMess;
  LoadFileI(Imes^, FileName);
  STDInitGraph;
  if GraphicsStart then
  begin
    s1 := FileName;
    s2 := 'Weiter mit <ESC>';
    Grafikbildschirm;
    Koordinatenkreuz;
    Skalierung;
    Intensitaetskurve;
    repeat
      Taste := readkey
    until Taste in [chr(27)]; { Escape-Taste }
    GraphicsStop;
  end;
end; { Ausgabe Messung }

{-------------------------------------------------------------------}

{ Vorbereitung zur Ausgabe einer FFT }
procedure AusgabeFFT;

var
  Taste : char;

begin
  if not Exists(copy(FileName, 0, Length(FileName) - 3) + ExtFFT)
    then FFTBerechnung
  else
  begin
    FileName := copy(FileName, 0, Length(FileName) - 3) + ExtFFT;
    LoadFileR(Itrans^, FileName);
  end;
  STDInitGraph;
  if GraphicsStart then
  begin
    s1 := FileName;
    s2 := 'Weiter mit <ESC>';
    Grafikbildschirm;
    Koordinatenkreuz;
    Skalierung;
    Transformationskurve;
    repeat
      Taste := readkey
    until Taste in [chr(27)]; { Escape-Taste }
    GraphicsStop;
  end;
end; { AusgabeFFT }

{-------------------------------------------------------------------}

{ Vorbereitung zur Ausgabe einer bereinigten Intensitaetsverteilung }
procedure AusgabeSynthese;

var
  Taste : char;

begin
  if not Exists(copy(FileName, 0, Length(FileName) - 3) + ExtKor)
    then Synthese
  else
  begin
    FileName := copy(FileName, 0, Length(FileName) - 3) + ExtKor;
    LoadFileR(Itrans^, FileName);
  end;
  STDInitGraph;
  if GraphicsStart then
  begin
    s1 := FileName;
    s2 := 'Weiter mit <ESC>';
    Grafikbildschirm;
    Koordinatenkreuz;
    Skalierung;
    Synthesekurve;
    repeat
      Taste := readkey
    until Taste in [chr(27)]; { Escape-Taste }
    GraphicsStop;
  end;
end; { AusgabeSynthese }

{-------------------------------------------------------------------}

{ Dialog zur Ausgabe der Intensitaetsverteilungen und der FFT }
procedure GrafikAusgabe;

var
  R                           : TRect;
  D                           : PFileDialog;
  DD, DDD                     : PDialog;
  Bruce                       : PView;
  Command, Command1, Command2 : word;

begin
  Extens := '*.' + ExtPlot;
  repeat
    D := New(PFileDialog, Init(Extens, 'Datei oeffnen',
      '~N~ame (*.PLT,*.MES,*.FFT,*.KOR)',
      fdOpenButton, fdReplaceButton));
    Command := Desktop^.ExecView(D);
    if (Command <> cmCancel) then
    begin
      D^.GetFileName(FileName);
      if Exists(FileName) then
      repeat

        { Fenster der AusgabeSchalter }
        R.Assign(20, 5, 60, 17);
        DD := New(PDialog, Init(R, 'Ausgabe'));
        DD^.HelpCtx := hcAusgabe;
        with DD^ do
        begin
          R.Assign(7, 4, 32, 7);
          Bruce := New(PRadioButtons,Init(R,
            NewSItem('Messung',
            NewSItem('FFT',
            NewSItem('gefilterte Messung' ,nil)))));
          R.Assign(6, 2, 7 + Length(FileName), 3);
          Insert(New(PLabel,Init(R, FileName, Bruce)));
          Insert(Bruce);

          { Buttons }
          R.Assign(6, 9, 16, 11);
          Insert(New(PButton, Init(R, '~B~ild', cmOk, bfDefault)));
          R.Assign(24, 9, 34, 11);
          Insert(New(PButton, Init(R, '~C~ancel', cmCancel,
            bfNormal)));

          { Voreinstellung }
          SetData(AnzeigeSchalter);

          Command1 := DeskTop^.ExecView(DD);
          if Command1 <> cmCancel then
          begin

            { Parameter einlesen }
            GetData(AnzeigeSchalter);
            case Anzeigeschalter of
              0 : AusgabeMessung;
              1 : AusgabeFFT;
              2 : AusgabeSynthese;
            end;

            if AnzeigeSchalter <> 0 then
            begin
              { Option zum Speichern der Daten }
              R.Assign(0, 0, 45, 9);
              DDD := New(PDialog, Init(R,'Speichern ?'));
              with DDD^ do
              begin
                Options := Options or ofCentered;
                R.Grow(-1, -1);
                Dec(R.B.Y, 3);
                Insert(New(PStaticText, Init(R, #13
                  + ^C'Daten speichern ?')));
                R.Assign(9, 6, 19, 8);
                Insert(New(PButton, Init(R, '~J~a', cmYes,
                  bfDefault)));
                R.Assign(25, 6, 35, 8);
                Insert(New(PButton, Init(R, '~N~ein', cmNo,
                  bfNormal)));
              end;
              Command2 := Desktop^.ExecView(DDD);
              if (Command2 = cmYes) then
                SaveFileR(ITrans^, FileName);
              Dispose(DDD, Done);
            end;
          end;
        end;
        Dispose(DD, Done);
      until Command1 = cmCancel
      else MessageBox(#3 + 'Datei ' + FileName + ' nicht gefunden' +
        #13 + #13, nil, mfError or mfOKButton);
    end;
    Dispose(D, Done);
  until Command = cmCancel;
end; { GrafikAusgabe }

{-------------------------------------------------------------------}

{ Ausgabe einer Kohaerenzfunktion }
procedure LCDarstellung;

var
  D                : PFileDialog;
  i, Command       : word;
  FaktorX, FaktorY : real;
  Taste            : char;

begin
  Extens := '*.' + ExtDaten;
  repeat
    D := New(PFileDialog, Init(Extens, 'Protokollatei oeffnen',
      '~N~ame (*.DAT)', fdOpenButton, fdReplaceButton));
    Command := Desktop^.ExecView(D);
    if (Command <> cmCancel) then
    begin
      D^.GetFileName(FileName);
      if Exists(FileName) then
      begin
        LoadDatFile;
        FileName :=
          copy(FileName, 0, Length(FileName) - 3) + ExtGamma;
        if not Exists(FileName) then
        begin
          Abbruch := false;
          gammaBerechnung;
          if not Abbruch then
          begin
            LCBerechnung;
            SaveGammaFile;
          end;
        end
        else LoadGammaFile;
        if not Abbruch then
        begin
          STDInitGraph;
          if GraphicsStart then
          begin
            s1 := FileName;
            s2 := 'Weiter mit <ESC>';
            Grafikbildschirm;
            Koordinatenkreuz;
            SkalierungLC;
            FaktorX := w[0].delta;
            for i := 1 to Anzahldelta - 1 do
              if w[i].delta > FaktorX then FaktorX := w[i].delta;
            FaktorX := (GetMaxX - 40) / FaktorX;
            FaktorY := (GetMaxY - 60);

            for i := 0 to Anzahldelta - 1 do
            begin
              Circle(round(w[i].delta * FaktorX + 20),
                     round((1 - w[i].gamma) * FaktorY + 20), 2);
              Line(round(w[i].delta * FaktorX + 20),
                   round((1 - w[i].gamma + w[i].SAM) * FaktorY + 20),
                   round(w[i].delta * FaktorX + 20),
                   round((1 - w[i].gamma - w[i].SAM) * FaktorY
                     + 20));
              Line(round(w[i].delta * FaktorX - 2 + 20),
                   round((1 - w[i].gamma + w[i].SAM) * FaktorY + 20),
                   round(w[i].delta * FaktorX + 2 + 20),
                   round((1 - w[i].gamma + w[i].SAM) * FaktorY
                     + 20));
              Line(round(w[i].delta * FaktorX - 2 + 20),
                   round((1 - w[i].gamma - w[i].SAM) * FaktorY + 20),
                   round(w[i].delta * FaktorX + 2 + 20),
                   round((1 - w[i].gamma - w[i].SAM) * FaktorY
                     + 20));
            end;
            for i := 1 to GetMaxX - 40 do
              Line(i - 1 + 20,
                   round((1 - exp(0 - (sqr((i - 1)
                     / (FaktorX * deltac))))) * FaktorY + 20),
                   i + 20,
                   round((1 - exp(0 - (sqr(i / (FaktorX * deltac)))))
                     * FaktorY + 20));
            repeat
              Taste := readkey
            until Taste in [chr(27)]; { Escape-Taste }
            GraphicsStop;
          end;
        end;
      end
      else MessageBox(#3 + 'Datei ' + FileName + ' nicht gefunden'
        + #13 + #13, nil, mfError or mfOKButton);
    end;
    Dispose(D, Done);
  until Command = cmCancel;
end; { CMDarstellung }

{-------------------------------------------------------------------}

end. { Anzeige }

{-------------------------------------------------------------------}

next up previous contents
Nächste Seite: 9.11 Unit LoadSave Aufwärts: 9. Programmlisting Vorherige Seite: 9.9 Unit KoherU   Inhalt
Udo Becker
2000-01-02