home *** CD-ROM | disk | FTP | other *** search
- //PROFILE-NO
- unit ProfOnli;
- interface
-
- uses
- Forms, Controls, Classes, StdCtrls, Windows, SysUtils;
- {$H-}
- {$V-}
- {$O-}
- {$D-}
- {$B-}
- {$Q-}
- {$I-}
- {$R-}
- {$A+}
- {$W+}
- {$J+}
- {$T+}
- {$X+}
-
- PROCEDURE ProfOnlineOperation;
-
- TYPE
- TOnlineProform = class(TForm)
- Button1: TButton;
- Button2: TButton;
- Button3: TButton;
- Edit1: TEdit;
- GroupBox1: TGroupBox;
- Button4: TButton;
- procedure StarteMessung(Sender: TObject);
- procedure StoppeMessung(Sender: TObject);
- procedure Anhaengen(Sender: TObject);
- procedure Erzeugen(Sender: TObject);
- procedure ResultatLoeschen(Sender: TObject);
- procedure Zerstoeren(Sender: TObject);
- private
- { Private-Deklarationen }
- procedure ButtonOnOff;
- public
- { Public-Deklarationen }
- IstAktiv : Boolean;
- end;
-
- var
- OnlineProform: TOnlineProform;
-
- {$R *.DFM}
-
- IMPLEMENTATION
- USES
- ProfInt;
-
- TYPE
- TObjProzedur = PROCEDURE OF Object;
-
- FUNCTION GetMHZ74 : Integer; external 'PROFMEAS.DLL';
- FUNCTION ProfIstAktiv : Boolean; external 'PROFMEAS.DLL';
- PROCEDURE RegisterApplication ( zeigerpm,
- zeigerhm : TObjProzedur); external 'PROFMEAS.DLL';
- PROCEDURE ProfResultatLoeschen; external 'PROFMEAS.DLL';
- FUNCTION GetPDVersion : PChar; external 'PROFMEAS.DLL';
-
-
- VAR
- winxpos : Integer;
- winypos : Integer;
-
- PROCEDURE ProfOnlineOperation;
- VAR
- hs : String;
- BEGIN
- Application.CreateForm(TOnlineProForm, OnlineProForm);
- hs := StrPas(GetPDVersion);
- OnLineProForm.Caption := 'ProDelphi - online operation (' + hs + ' Version)';
- Str(GetMHz74,hs);
- OnlineProForm.Edit1.text := 'CPU performs with ' + hs + ' MHz';
- END;
-
- FUNCTION GetIniFile : String;
- VAR
- hs : String;
- BEGIN
- hs := UpperCase(ExtractFilePath(ParamStr(0)));
- Result := hs + 'PROFILE.INI';
- END;
-
- procedure TOnlineProform.StarteMessung(Sender: TObject);
- begin
- ProfActivate;
- ButtonOnOff;
- end;
-
- procedure TOnlineProform.StoppeMessung(Sender: TObject);
- begin
- ProfDeactivate;
- ButtonOnOff;
- end;
-
- procedure TOnlineProform.Anhaengen(Sender: TObject);
- VAR
- txt : Array[0..255] OF Char;
- begin
- StrPLCopy(txt, OnlineProForm.Edit1.Text, 255);
- ProfSetComment(txt);
- ProfAppendResults(FALSE);
- end;
-
- procedure TOnlineProform.Erzeugen(Sender: TObject);
- begin
- IF winxpos <> -1 THEN BEGIN
- Left := winxpos;
- Top := Winypos;
- END;
- ButtonOnOff;
- end;
-
- procedure TOnlineProform.ButtonOnOff;
- begin
- IF ProfIstAktiv = TRUE THEN BEGIN
- Button1.Enabled := FALSE;
- Button2.Enabled := TRUE;
- END
- ELSE BEGIN
- Button2.Enabled := FALSE;
- Button1.Enabled := TRUE;
- END;
- end;
-
- procedure TOnlineProform.ResultatLoeschen(Sender: TObject);
- BEGIN
- ProfResultatLoeschen;
- end;
-
- procedure TOnlineProform.Zerstoeren(Sender: TObject);
- VAR
- rect : TRect;
- xp, yp : Array[0..24] OF Char;
- namec : Array[0..255] OF Char;
- begin
- StrPCopy(namec, GetIniFile);
- GetWindowRect(handle, rect);
- Str(rect.top, yp);
- Str(rect.left, xp);
- WritePrivateProfileString('SCREEN','X',xp,namec);
- WritePrivateProfileString('SCREEN','Y',yp,namec);
- END;
-
- PROCEDURE InitUnit;
- VAR
- namec : Array[0..255] OF Char;
- tmpbuff : Array[0..255] OF Char;
- anzeige : Integer;
- BEGIN
- StrPCopy(namec, GetIniFile);
- GetPrivateProfileString('SCREEN','X','-1',tmpbuff,SizeOf(tmpbuff)-1,namec);
- VAL(tmpbuff, winxpos, anzeige);
- IF anzeige <> 0 THEN
- Winxpos := -1;
- GetPrivateProfileString('SCREEN','Y','-1',tmpbuff,SizeOf(tmpbuff)-1,namec);
- VAL(tmpbuff, winypos, anzeige);
- IF anzeige <> 0 THEN
- Winypos := -1;
- (*
- winxpos := GetPrivateProfileInt('SCREEN','X',Word(-1),namec);
- winypos := GetPrivateProfileInt('SCREEN','Y',Word(-1),namec);
- *)
- RegisterApplication(Application.ProcessMessages, Application.HandleMessage);
- RegisterMessageBox(Application.MessageBox);
- END;
-
- INITIALIZATION
- InitUnit;
- END.
-