Chip 2002 June/Chip_2002-06_cd1.bin/zkuste/delphi/nastroje/d23456/PRODEL.ZIP/PROFONLC.PAS

Pascal/Delphi Source File | 2002-04-03 | 4.8 KB | 222 lines

//PROFILE-NO
unit Profonlc;
interface

uses
  Windows,
  QForms, QControls, QStdCtrls,
  Classes,
  SysUtils, QTypes, QExtCtrls, QComCtrls;
{$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;
    Panel1: TPanel;
    CycBut: TCheckBox;
    MinLab: TLabel;
    FrequAnz: TTrackBar;
    Label6: TLabel;
    CycTimer: TTimer;
    procedure StarteMessung(Sender: TObject);
    procedure StoppeMessung(Sender: TObject);
    procedure Anhaengen(Sender: TObject);
    procedure Erzeugen(Sender: TObject);
    procedure ResultatLoeschen(Sender: TObject);
    procedure Zerstoeren(Sender: TObject);
    procedure TickChange(Sender: TObject);
    procedure ActDeact(Sender: TObject);
    procedure CycAppend(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure ButtonOnOff;
  public
    { Public-Deklarationen }
    IstAktiv : Boolean;
  end;

var
  OnlineProform: TOnlineProform;

{$R *.xfm}

IMPLEMENTATION
USES
  IniFiles,
  Profint;

FUNCTION  GetMHZ95     : Integer; external 'PROFMEAS.DLL';
FUNCTION  ProfIstAktiv : Boolean; external 'PROFMEAS.DLL';
PROCEDURE ProfResultatLoeschen;   external 'PROFMEAS.DLL';


VAR
  winxpos : Integer;
  winypos : Integer;
  toppos  : Integer;

PROCEDURE ProfOnlineOperation;
VAR
  hs : String;
BEGIN
  Application.CreateForm(TOnlineProForm, OnlineProForm);
  OnLineProForm.Caption := 'ProDelphi - online operation';
  Str(GetMHz95,hs);
  OnlineProForm.Edit1.text := 'CPU performs with ' + hs + ' MHz';
END;

FUNCTION GetIniFile : String;
BEGIN
  Result := ExtractFilePath(ParamStr(0)) + '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;
  IF TopPos <> 0 THEN
    FormStyle := fsStayOnTop;
  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 IntWritePrivateProfileString( CONST absch, key, wert, pf : String );
VAR
  Ini : TIniFile;
BEGIN
  Ini := TIniFile.Create( pf );
  Ini.WriteString(absch, key, wert);
  Ini.UpdateFile;
  Ini.Free;
END;

procedure TOnlineProform.Zerstoeren(Sender: TObject);
VAR
  xp, yp : String;
begin
  Str(top, yp);
  Str(left, xp);
  IntWritePrivateProfileString('PROFILER', 'SCREEN-X' ,xp, GetIniFile);
  IntWritePrivateProfileString('PROFILER', 'SCREEN-Y' ,xp, GetIniFile);
END;

PROCEDURE IntGetPrivateProfileString(CONST absch, key, VB : String;
                                     VAR   Buffer : String;
                                     CONST pf     : String );
var
  Ini : TIniFile;
begin
  Ini    := TIniFile.Create(pf);
  buffer := Ini.ReadString(absch, key, vb);
  Ini.Free;
END;

PROCEDURE InitUnit;
VAR
  buff    : String;
  anzeige : Integer;
BEGIN
  IntGetPrivateProfileString('PROFILER','SCREEN-X', '-1', buff, GetIniFile);
  VAL(buff, winxpos, anzeige);
  IF anzeige <> 0 THEN
    Winxpos := -1;
  IntGetPrivateProfileString('PROFILER','SCREEN-Y', '-1', buff, GetIniFile);
  VAL(buff, winypos, anzeige);
  IF anzeige <> 0 THEN
    Winypos := -1;
  IntGetPrivateProfileString('PROFILER', 'ONTOP', '0', buff, GetIniFile);
  VAL(buff, toppos, anzeige);
END;

procedure TOnlineProform.TickChange(Sender: TObject);
VAR
  hs : String;
begin
  CycTimer.Enabled := FALSE;
  Str(FrequAnz.Position, hs);
  MinLab.Caption := hs;
  CycTimer.Interval := FrequAnz.Position * 60000;
  IF CycBut.Checked = TRUE THEN
    CycTimer.Enabled := TRUE;
end;

procedure TOnlineProform.ActDeact(Sender: TObject);
begin
  IF CycBut.Checked = TRUE THEN BEGIN
    CycTimer.Enabled := TRUE;
    FrequAnz.Visible := FALSE;
    END
  ELSE BEGIN
    CycTimer.Enabled := FALSE;
    FrequAnz.Visible := TRUE;
  END;
end;

procedure TOnlineProform.CycAppend(Sender: TObject);
BEGIN
  Edit1.Text := DateTimeToStr(Now);
  Anhaengen(Sender);
end;

INITIALIZATION
  InitUnit;
END.