home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 December / Chip_2002-12_cd1.bin / zkuste / delphi / nastroje / d23456 / PRODEL.ZIP / PROFONLI.PAS < prev    next >
Pascal/Delphi Source File  |  2002-07-23  |  5KB  |  222 lines
  1. //PROFILE-NO
  2. unit Profonli;
  3. interface
  4.  
  5. uses
  6.   Windows,
  7.   Forms, Controls, StdCtrls,
  8.   Classes,
  9.   SysUtils, ComCtrls, ExtCtrls;
  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 *.dfm}
  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.     SetWindowPos(handle, HWND_TOPMOST, 0, 0, 0, 0,
  135.                  SWP_NOSIZE OR SWP_NOMOVE OR SWP_SHOWWINDOW);
  136.   ButtonOnOff;
  137. END;
  138.  
  139. procedure TOnlineProform.ButtonOnOff;
  140. BEGIN
  141.   IF ProfIstAktiv = TRUE THEN BEGIN
  142.     Button1.Enabled := FALSE;
  143.     Button2.Enabled := TRUE;
  144.     END
  145.   ELSE BEGIN
  146.     Button2.Enabled := FALSE;
  147.     Button1.Enabled := TRUE;
  148.   END;
  149. END;
  150.  
  151. procedure TOnlineProform.ResultatLoeschen(Sender: TObject);
  152. BEGIN
  153.   ProfResultatLoeschen;
  154. END;
  155.  
  156. procedure TOnlineProform.Zerstoeren(Sender: TObject);
  157. VAR
  158.   rect   : TRect;
  159.   xp, yp : Array[0..24] OF Char;
  160.   namec  : Array[0..255] OF Char;
  161. BEGIN
  162.   StrPCopy(namec, GetIniFile);
  163.   GetWindowRect(handle, rect);
  164.   Str(rect.top, yp);
  165.   Str(rect.left, xp);
  166.   WritePrivateProfileString('PROFILER','SCREEN-X',xp,namec);
  167.   WritePrivateProfileString('PROFILER','SCREEN-Y',yp,namec);
  168. END;
  169.  
  170. PROCEDURE InitUnit;
  171. VAR
  172.   namec   : Array[0..255] OF Char;
  173.   tmpbuff : Array[0..255] OF Char;
  174.   anzeige : Integer;
  175. BEGIN
  176.   StrPCopy(namec, GetIniFile);
  177.   GetPrivateProfileString('PROFILER','SCREEN-X','-1',tmpbuff,SizeOf(tmpbuff)-1,namec);
  178.   VAL(tmpbuff, winxpos, anzeige);
  179.   IF anzeige <> 0 THEN
  180.     Winxpos := -1;
  181.   GetPrivateProfileString('PROFILER','SCREEN-Y','-1',tmpbuff,SizeOf(tmpbuff)-1,namec);
  182.   VAL(tmpbuff, winypos, anzeige);
  183.   IF anzeige <> 0 THEN
  184.     Winypos := -1;
  185.   GetPrivateProfileString('PROFILER','ONTOP','0',tmpbuff,SizeOf(tmpbuff)-1,namec);
  186.   VAL(tmpbuff, toppos, anzeige);
  187. END;
  188.  
  189. procedure TOnlineProform.TickChange(Sender: TObject);
  190. VAR
  191.   hs : String;
  192. begin
  193.   CycTimer.Enabled := FALSE;
  194.   Str(FrequAnz.Position, hs);
  195.   MinLab.Caption := hs;
  196.   CycTimer.Interval := FrequAnz.Position * 60000;
  197.   IF CycBut.Checked = TRUE THEN
  198.     CycTimer.Enabled := TRUE;
  199. end;
  200.  
  201. procedure TOnlineProform.ActDeact(Sender: TObject);
  202. begin
  203.   IF CycBut.Checked = TRUE THEN BEGIN
  204.     CycTimer.Enabled := TRUE;
  205.     FrequAnz.Visible := FALSE;
  206.     END
  207.   ELSE BEGIN
  208.     CycTimer.Enabled := FALSE;
  209.     FrequAnz.Visible := TRUE;
  210.   END;
  211. end;
  212.  
  213. procedure TOnlineProform.CycAppend(Sender: TObject);
  214. BEGIN
  215.   Edit1.Text := DateTimeToStr(Now);
  216.   Anhaengen(Sender);
  217. end;
  218.  
  219. INITIALIZATION
  220.   InitUnit;
  221. END.
  222.