home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 July / Chip_2000-07_cd.bin / sharewar / prodelph / PROFONLI.PAS < prev    next >
Pascal/Delphi Source File  |  2000-05-02  |  4KB  |  175 lines
  1. //PROFILE-NO
  2. unit ProfOnli;
  3. interface
  4.  
  5. uses
  6.   Forms, Controls, Classes, StdCtrls, Windows, SysUtils;
  7. {$H-}
  8. {$V-}
  9. {$O-}
  10. {$D-}
  11. {$B-}
  12. {$Q-}
  13. {$I-}               
  14. {$R-}       
  15. {$A+}
  16. {$W+}
  17. {$J+}
  18. {$T+}
  19. {$X+}
  20.  
  21. PROCEDURE ProfOnlineOperation;
  22.  
  23. TYPE
  24.   TOnlineProform = class(TForm)
  25.     Button1: TButton;
  26.     Button2: TButton;
  27.     Button3: TButton;
  28.     Edit1: TEdit;
  29.     GroupBox1: TGroupBox;
  30.     Button4: TButton;
  31.     procedure StarteMessung(Sender: TObject);
  32.     procedure StoppeMessung(Sender: TObject);
  33.     procedure Anhaengen(Sender: TObject);
  34.     procedure Erzeugen(Sender: TObject);
  35.     procedure ResultatLoeschen(Sender: TObject);
  36.     procedure Zerstoeren(Sender: TObject);
  37.   private
  38.     { Private-Deklarationen }
  39.     procedure ButtonOnOff;
  40.   public
  41.     { Public-Deklarationen }
  42.     IstAktiv : Boolean;
  43.   end;
  44.  
  45. var
  46.   OnlineProform: TOnlineProform;
  47.  
  48. {$R *.DFM}
  49.  
  50. IMPLEMENTATION
  51. USES
  52.   ProfInt;
  53.   
  54. TYPE
  55.   TObjProzedur = PROCEDURE OF Object;
  56.  
  57. FUNCTION  GetMHZ80     : Integer; external 'PROFMEAS.DLL';
  58. FUNCTION  ProfIstAktiv : Boolean; external 'PROFMEAS.DLL';
  59. PROCEDURE RegisterApplication ( zeigerpm,
  60.                                 zeigerhm : TObjProzedur); external 'PROFMEAS.DLL';
  61. PROCEDURE ProfResultatLoeschen;   external 'PROFMEAS.DLL';
  62. FUNCTION  GetPDVersion : PChar;   external 'PROFMEAS.DLL';
  63.  
  64.  
  65. VAR
  66.   winxpos : Integer;
  67.   winypos : Integer;
  68.  
  69. PROCEDURE ProfOnlineOperation;
  70. VAR
  71.   hs : String;
  72. BEGIN
  73.   Application.CreateForm(TOnlineProForm, OnlineProForm);
  74.   hs := StrPas(GetPDVersion);
  75.   OnLineProForm.Caption := 'ProDelphi - online operation (' + hs + ' Version)';
  76.   Str(GetMHz80,hs);
  77.   OnlineProForm.Edit1.text := 'CPU performs with ' + hs + ' MHz';
  78. END;
  79.  
  80. FUNCTION GetIniFile : String;
  81. VAR
  82.   hs : String;
  83. BEGIN
  84.   hs     := UpperCase(ExtractFilePath(ParamStr(0)));
  85.   Result := hs + 'PROFILE.INI';
  86. END;
  87.  
  88. procedure TOnlineProform.StarteMessung(Sender: TObject);
  89. begin
  90.   ProfActivate;
  91.   ButtonOnOff;
  92. end;
  93.  
  94. procedure TOnlineProform.StoppeMessung(Sender: TObject);
  95. begin
  96.   ProfDeactivate;
  97.   ButtonOnOff;
  98. end;
  99.  
  100. procedure TOnlineProform.Anhaengen(Sender: TObject);
  101. VAR
  102.   txt : Array[0..255] OF Char;
  103. begin
  104.   StrPLCopy(txt, OnlineProForm.Edit1.Text, 255);
  105.   ProfSetComment(txt);
  106.   ProfAppendResults(FALSE);
  107. end;
  108.  
  109. procedure TOnlineProform.Erzeugen(Sender: TObject);
  110. begin
  111.   IF winxpos <> -1 THEN BEGIN
  112.     Left := winxpos;
  113.     Top  := Winypos;
  114.   END;
  115.   ButtonOnOff;
  116. end;
  117.  
  118. procedure TOnlineProform.ButtonOnOff;
  119. begin
  120.   IF ProfIstAktiv = TRUE THEN BEGIN
  121.     Button1.Enabled := FALSE;
  122.     Button2.Enabled := TRUE;
  123.     END
  124.   ELSE BEGIN
  125.     Button2.Enabled := FALSE;
  126.     Button1.Enabled := TRUE;
  127.   END;
  128. end;
  129.  
  130. procedure TOnlineProform.ResultatLoeschen(Sender: TObject);
  131. BEGIN
  132.   ProfResultatLoeschen;
  133. end;
  134.  
  135. procedure TOnlineProform.Zerstoeren(Sender: TObject);
  136. VAR
  137.   rect   : TRect;
  138.   xp, yp : Array[0..24] OF Char;
  139.   namec  : Array[0..255] OF Char;
  140. begin
  141.   StrPCopy(namec, GetIniFile);
  142.   GetWindowRect(handle, rect);
  143.   Str(rect.top, yp);
  144.   Str(rect.left, xp);
  145.   WritePrivateProfileString('SCREEN','X',xp,namec);
  146.   WritePrivateProfileString('SCREEN','Y',yp,namec);
  147. END;
  148.  
  149. PROCEDURE InitUnit;
  150. VAR
  151.   namec   : Array[0..255] OF Char;
  152.   tmpbuff : Array[0..255] OF Char;
  153.   anzeige : Integer;
  154. BEGIN
  155.   StrPCopy(namec, GetIniFile);
  156.   GetPrivateProfileString('SCREEN','X','-1',tmpbuff,SizeOf(tmpbuff)-1,namec);
  157.   VAL(tmpbuff, winxpos, anzeige);
  158.   IF anzeige <> 0 THEN
  159.     Winxpos := -1;
  160.   GetPrivateProfileString('SCREEN','Y','-1',tmpbuff,SizeOf(tmpbuff)-1,namec);
  161.   VAL(tmpbuff, winypos, anzeige);
  162.   IF anzeige <> 0 THEN
  163.     Winypos := -1;
  164. (*
  165.   winxpos := GetPrivateProfileInt('SCREEN','X',Word(-1),namec);
  166.   winypos := GetPrivateProfileInt('SCREEN','Y',Word(-1),namec);
  167. *)
  168.   RegisterApplication(Application.ProcessMessages, Application.HandleMessage);
  169.   RegisterMessageBox(Application.MessageBox);
  170. END;
  171.  
  172. INITIALIZATION
  173.   InitUnit;
  174. END.
  175.