home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 December / Chip_2002-12_cd1.bin / zkuste / delphi / nastroje / d23456 / PRODEL.ZIP / PROFONLC.PAS < prev    next >
Pascal/Delphi Source File  |  2002-07-23  |  5KB  |  219 lines
  1. //PROFILE-NO
  2. unit Profonlc;
  3. interface
  4.  
  5. uses
  6.   Windows,
  7.   QForms, QControls, QStdCtrls,
  8.   Classes,
  9.   SysUtils, QTypes, QExtCtrls, QComCtrls;
  10. {$H-}
  11. {$V-}
  12. {$O-}                  
  13. {$D-}
  14. {$B-}
  15. {$Q-}
  16. {$I-}               
  17. {$R-}       
  18. {$A+}
  19. {$W+}
  20. {$J+}
  21. {$T+}
  22. {$X+}
  23. {$WARNINGS OFF}
  24.  
  25. PROCEDURE ProfOnlineOperation;
  26.  
  27. TYPE
  28.   TOnlineProform = class(TForm)
  29.     Button1: TButton;
  30.     Button2: TButton;
  31.     Button3: TButton;
  32.     Button4: TButton;
  33.     Panel1: TPanel;
  34.     CycBut: TCheckBox;
  35.     MinLab: TLabel;
  36.     FrequAnz: TTrackBar;
  37.     Label6: TLabel;
  38.     CycTimer: TTimer;
  39.     Panel2: TPanel;
  40.     RunId: TLabel;
  41.     Label5: TLabel;
  42.     Label1: TLabel;
  43.     CPUFrequenz: TLabel;
  44.     Label3: TLabel;
  45.     GroupBox2: TGroupBox;
  46.     Edit1: TEdit;
  47.     procedure StarteMessung(Sender: TObject);
  48.     procedure StoppeMessung(Sender: TObject);
  49.     procedure Anhaengen(Sender: TObject);
  50.     procedure Erzeugen(Sender: TObject);
  51.     procedure ResultatLoeschen(Sender: TObject);
  52.     procedure Zerstoeren(Sender: TObject);
  53.     procedure TickChange(Sender: TObject);
  54.     procedure ActDeact(Sender: TObject);
  55.     procedure CycAppend(Sender: TObject);
  56.   private
  57.     { Private-Deklarationen }
  58.     procedure ButtonOnOff;
  59.   public
  60.     { Public-Deklarationen }
  61.     IstAktiv : Boolean;
  62.     RunNr    : Integer;
  63.   end;
  64.  
  65. var
  66.   OnlineProform: TOnlineProform;
  67.  
  68. {$R *.xfm}
  69.  
  70. IMPLEMENTATION
  71. USES
  72.   Profint;
  73.  
  74. FUNCTION  GetMHZ100    : Integer; external 'PROFMEAS.DLL';
  75. FUNCTION  ProfIstAktiv : Boolean; external 'PROFMEAS.DLL';
  76. PROCEDURE ProfResultatLoeschen;   external 'PROFMEAS.DLL';
  77.  
  78.  
  79. VAR
  80.   winxpos : Integer;
  81.   winypos : Integer;
  82.   toppos  : Integer;
  83.  
  84. PROCEDURE ProfOnlineOperation;
  85. VAR
  86.   hs : String;
  87. BEGIN
  88.   Application.CreateForm(TOnlineProForm, OnlineProForm);
  89.   OnLineProForm.Caption := 'ProDelphi - online operation';
  90.   Str(GetMHz100,hs);
  91.   OnlineProForm.CPUFrequenz.Caption := hs;
  92. //  OnlineProForm.Edit1.text := 'CPU performs with ' + hs + ' MHz';
  93. END;
  94.  
  95. FUNCTION GetIniFile : String;
  96. BEGIN
  97.   Result := ExtractFilePath(ParamStr(0)) + 'profile.ini';
  98. END;
  99.  
  100. procedure TOnlineProform.StarteMessung(Sender: TObject);
  101. begin
  102.   ProfActivate;
  103.   ButtonOnOff;
  104. end;
  105.  
  106. procedure TOnlineProform.StoppeMessung(Sender: TObject);
  107. begin
  108.   ProfDeactivate;
  109.   ButtonOnOff;
  110. END;
  111.  
  112. procedure TOnlineProform.Anhaengen(Sender: TObject);
  113. VAR
  114.   txt : Array[0..255] OF Char;
  115.   Run : String;
  116. BEGIN
  117.   StrPLCopy(txt, OnlineProForm.Edit1.Text +
  118.                  ' (Run: ' + RunId.Caption + ')', 255);
  119.   ProfSetComment(txt);
  120.   ProfAppendResults(FALSE);
  121.   INC(RunNr);
  122.   Str(RunNr, Run);
  123.   RunId.Caption := Run;
  124. END;
  125.  
  126. procedure TOnlineProform.Erzeugen(Sender: TObject);
  127. BEGIN
  128.   RunNr := 1;
  129.   IF winxpos <> -1 THEN BEGIN
  130.     Left := winxpos;
  131.     Top  := Winypos;
  132.   END;
  133.   IF TopPos <> 0 THEN
  134.     FormStyle := fsStayOnTop;
  135.   ButtonOnOff;
  136. END;
  137.  
  138. procedure TOnlineProform.ButtonOnOff;
  139. BEGIN
  140.   IF ProfIstAktiv = TRUE THEN BEGIN
  141.     Button1.Enabled := FALSE;
  142.     Button2.Enabled := TRUE;
  143.     END
  144.   ELSE BEGIN
  145.     Button2.Enabled := FALSE;
  146.     Button1.Enabled := TRUE;
  147.   END;
  148. END;
  149.  
  150. procedure TOnlineProform.ResultatLoeschen(Sender: TObject);
  151. BEGIN
  152.   ProfResultatLoeschen;
  153. END;
  154.  
  155. procedure TOnlineProform.Zerstoeren(Sender: TObject);
  156. VAR
  157.   xp, yp : Array[0..24] OF Char;
  158.   namec  : Array[0..255] OF Char;
  159. BEGIN
  160.   StrPCopy(namec, GetIniFile);
  161.   Str(top, yp);
  162.   Str(left, xp);
  163.   WritePrivateProfileString('PROFILER','SCREEN-X',xp,namec);
  164.   WritePrivateProfileString('PROFILER','SCREEN-Y',yp,namec);
  165. END;
  166.  
  167. PROCEDURE InitUnit;
  168. VAR
  169.   namec   : Array[0..255] OF Char;
  170.   tmpbuff : Array[0..255] OF Char;
  171.   anzeige : Integer;
  172. BEGIN
  173.   StrPCopy(namec, GetIniFile);
  174.   GetPrivateProfileString('PROFILER','SCREEN-X','-1',tmpbuff,SizeOf(tmpbuff)-1,namec);
  175.   VAL(tmpbuff, winxpos, anzeige);
  176.   IF anzeige <> 0 THEN
  177.     Winxpos := -1;
  178.   GetPrivateProfileString('PROFILER','SCREEN-Y','-1',tmpbuff,SizeOf(tmpbuff)-1,namec);
  179.   VAL(tmpbuff, winypos, anzeige);
  180.   IF anzeige <> 0 THEN
  181.     Winypos := -1;
  182.   GetPrivateProfileString('PROFILER','ONTOP','0',tmpbuff,SizeOf(tmpbuff)-1,namec);
  183.   VAL(tmpbuff, toppos, anzeige);
  184. END;
  185.  
  186. procedure TOnlineProform.TickChange(Sender: TObject);
  187. VAR
  188.   hs : String;
  189. begin
  190.   CycTimer.Enabled := FALSE;
  191.   Str(FrequAnz.Position, hs);
  192.   MinLab.Caption := hs;
  193.   CycTimer.Interval := FrequAnz.Position * 60000;
  194.   IF CycBut.Checked = TRUE THEN
  195.     CycTimer.Enabled := TRUE;
  196. end;
  197.  
  198. procedure TOnlineProform.ActDeact(Sender: TObject);
  199. begin
  200.   IF CycBut.Checked = TRUE THEN BEGIN
  201.     CycTimer.Enabled := TRUE;
  202.     FrequAnz.Visible := FALSE;
  203.     END
  204.   ELSE BEGIN
  205.     CycTimer.Enabled := FALSE;
  206.     FrequAnz.Visible := TRUE;
  207.   END;
  208. end;
  209.  
  210. procedure TOnlineProform.CycAppend(Sender: TObject);
  211. BEGIN
  212.   Edit1.Text := DateTimeToStr(Now);
  213.   Anhaengen(Sender);
  214. end;
  215.  
  216. INITIALIZATION
  217.   InitUnit;
  218. END.
  219.