Компилируется, но работать отказывается! - Общие вопросы Delphi

kta87 · 30.10.2011, 22:55

В общем программа пока тока умеет работать с отображением частоты процессора! Пытаюсь научить ее работать еще и с загрузкой того же CPU, но что то не получается. Подскажите что не так сделал? Код внизу:

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, ExtCtrls, ComCtrls, AdCpuUsage, WinSock, Gauges;

type
  TCPUInspector = class(TForm)
    Panel1: TPanel;
    Inspector1: TMainMenu;
    N1: TMenuItem;
    CPUStart1: TMenuItem;
    CPUStop1: TMenuItem;
    Label1: TLabel;
    CPUFrequency: TLabel;
    Label2: TLabel;
    Timer1: TTimer;
    StatusBar1: TStatusBar;
    procedure CPUStart1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CPUStop1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  Stop: Boolean;
  public
    { Public declarations }
  end;

var
  CPUInspector: TCPUInspector;
  CPU: Integer;

implementation

{$R *.dfm}
// Функция определения скорости процессора
function GetCPUSpeed: Double;
 const
   DelayTime = 500;
var
   TimerHi, TimerLo: DWORD;
   PriorityClass, Priority: Integer;
begin
 PriorityClass := GetPriorityClass(GetCurrentProcess);
 Priority := GetThreadPriority(GetCurrentThread);

 SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
 SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

 Sleep(10);

 asm
  dw 310Fh
  mov TimerLo, eax
  mov TimerHi, edx
 end;

 Sleep(DelayTime);

 asm
  dw 310Fh
  sub eax, TimerLo
  sbb edx, TimerHi
  mov TimerLo, eax
  mov TimerHi, edx
 end;

 SetThreadPriority(GetCurrentThread, Priority);
 SetPriorityClass(GetCurrentProcess, PriorityClass);

 Result := TimerLo / (1000.0 * DelayTime);
end;
// При запуке программы
procedure TCPUInspector.FormCreate(Sender: TObject);
begin
 CPUStop1.Enabled:= False;
end;

// Включение инспектора слежения CPU(При нажатии CPU Start)
procedure TCPUInspector.CPUStart1Click(Sender: TObject);
var
  GInitData: TWSAData;
  i: Integer;
  Gauge: TGauge;
begin
// Частота CPU
 CPUStart1.Enabled:= False;
 CPUStop1.Enabled:= True;
 Stop:= False;
 while not Stop do
  begin
   CPUFrequency.Caption:= FloatToStr(GetCPUSpeed)+ ' MHz';
   Application.ProcessMessages;
  end;
 CPUStart1.Enabled:= True;
 CPUStop1.Enabled:= False;

// Загрузка CPU
begin
  for i:= 1 to GetCPUCount -1 do
   begin
    try
     Gauge:=TGauge.Create(CPUInspector);
     Gauge.Name:=Format('Gauge%d',[i]);
      with TGauge(FindComponent(Format('Gauge%d',[i]))) do
       begin
        Parent:= StatusBar1;
        Top:=2;
        Width:=100;
        Height:=18;
        Left:=((i-1)*Width);
        MinValue:=0;
        MaxValue:=100;
        ForeColor:=StatusBar1.Color;
   end;
   except
  end;
 end;
end;
end;

// Выключение инспектора слежения CPU(При нажатии CPU Stop)
procedure TCPUInspector.CPUStop1Click(Sender: TObject);
begin
 Stop:= True;
end;

//Настройка Timer1
procedure TCPUInspector.Timer1Timer(Sender: TObject);
var
 j: Integer;
begin
 CollectCPUData;
 for j:= 1 to GetCPUCount -1 do
  begin
   TGauge(FindComponent('Gauge'+IntToStr(j))).Progress:=StrToInt(Format('%0.0f%',[GetCPUUsage(j)*100]));
   CPU:=StrToInt(Format('%0.0f%',[GetCPUUsage(j)*100]));
  end;
end;

end.

P.S. Проблема как мне кажется находится тут:

Код:

procedure TCPUInspector.Timer1Timer(Sender: TObject);
var
 j: Integer;
begin
 CollectCPUData;
 for j:= 1 to GetCPUCount -1 do
  begin
   TGauge(FindComponent('Gauge'+IntToStr(j))).Progress:=StrToInt(Format('%0.0f%',[GetCPUUsage(j)*100]));
   CPU:=StrToInt(Format('%0.0f%',[GetCPUUsage(j)*100]));
  end;
end;

, так как если таймер закоментить то все работает, ну тока без загрузки конечно!

mihali4 · 31.10.2011, 00:19

А в procedure TCPUInspector.Timer1Timer добавить

Код:

Application.ProcessMessages;

не попробовали ? После строки

Код:

CPU:=StrToInt(Format('%0.0f%',[GetCPUUsage(j)*100]));

kta87 · 31.10.2011, 06:58

Добавил как советовал,

Код:

procedure TCPUInspector.Timer1Timer(Sender: TObject);
var
 j: Integer;
begin
 CollectCPUData;
 for j:= 1 to GetCPUCount -1 do
  begin
   TGauge(FindComponent('Gauge'+IntToStr(j))).Progress:=StrToInt(Format('%0.0f%',[GetCPUUsage(j)*100]));
   CPU:=StrToInt(Format('%0.0f%',[GetCPUUsage(j)*100]));
   Application.ProcessMessages;
  end;
end;

частота работает, загрузка нет, при этом после нескольких раз запуска + остановки программа вылетает с ошибкой:
"Project Project1.exe raised exception class EComponentError with message 'A Component named Gauge1 already exist'. Process stoped. Use Stip or Run to Continue." Смысл типа что компонент Gauge1 уже существует!
Выделяется строка

Код:

with TGauge(FindComponent(Format('Gauge%d',[i]))) do

А вот рабочий вариант кода по загрузке CPU

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,AdCpuUsage, ExtCtrls, ComCtrls, WinSock, Gauges, StdCtrls;

type
  TForm1 = class(TForm)
    StatusBar: TStatusBar;
    Timer1: TTimer;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1 : TForm1;
  CPU   : Integer;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  GInitData          : TWSAData;
  i                  : Integer;
  Gauge              : TGauge;
begin
         for i:=1 to GetCPUCount-1 do
          begin
            try
            Gauge:=TGauge.Create(Form1);
            Gauge.Name:=Format('Gauge%d',[i]);
              with TGauge(FindComponent(Format('Gauge%d',[i]))) do
                begin
                  Parent:=StatusBar;
                  Top:=2;
                  Width:=100;
                  Height:=18;
                  Left:=((i-1)*Width);
                  MinValue:=0;
                  MaxValue:=100;
                  ForeColor:=StatusBar.Color;
              end;
            except
            end;
      end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
n:Integer;
begin
    CollectCPUData;
    for n:=1 to GetCPUCount-1 do
      begin
        TGauge(FindComponent('Gauge'+IntToStr(n))).Progress:=StrToInt(Format('%0.0f%',[GetCPUUsage(n)*100]));
        CPU:=StrToInt(Format('%0.0f%',[GetCPUUsage(n)*100]));
      end;
end;

end.

ZuBy · 31.10.2011, 07:44

а почему не использовать массив из TGauge?

Код:

var
  gauges: array of TGauge;

при create

Код:

c:= GetCPUCount-1;
setlength(gauges, c);
for i:=0 to c do
          begin
            Gauges[i]:=TGauge.Create(Form1);
            Gauges[i].Name:=Format('Gauge%d',[i]);
              with gauges[i] do
                begin
                  Parent:=StatusBar;
                  Top:=2;
                  Width:=100;
                  Height:=18;
                  Left:=((i-1)*Width);
                  MinValue:=0;
                  MaxValue:=100;
                  ForeColor:=StatusBar.Color;
              end;

Код:

for n:=0 to c do
  gauges[n].position := StrToInt(Format('%0.0f%',[GetCPUUsage(n+1)*100]))

так удобней кажется

kta87 · 31.10.2011, 15:40

Спасибо! Попробую и отпишусь о результатах!
Ну и как обещал отписываюсь о положительном результате...

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, ExtCtrls, ComCtrls, AdCpuUsage, WinSock, Gauges;

type
  TCPUInspector = class(TForm)
    Panel1: TPanel;
    Inspector1: TMainMenu;
    N1: TMenuItem;
    CPUStart1: TMenuItem;
    CPUStop1: TMenuItem;
    Label1: TLabel;
    CPUFrequency: TLabel;
    Timer1: TTimer;
    Panel2: TPanel;
    Label2: TLabel;
    StatusBar1: TStatusBar;
    procedure CPUStart1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CPUStop1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  Stop: Boolean;
  public
    { Public declarations }
  end;

var
  CPUInspector: TCPUInspector;
  CPU: Integer;

implementation

{$R *.dfm}
// Функция определения скорости процессора
function GetCPUSpeed: Double;
 const
   DelayTime = 500;
var
   TimerHi, TimerLo: DWORD;
   PriorityClass, Priority: Integer;
begin
 PriorityClass := GetPriorityClass(GetCurrentProcess);
 Priority := GetThreadPriority(GetCurrentThread);

 SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
 SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

 Sleep(10);

 asm
  dw 310Fh
  mov TimerLo, eax
  mov TimerHi, edx
 end;

 Sleep(DelayTime);

 asm
  dw 310Fh
  sub eax, TimerLo
  sbb edx, TimerHi
  mov TimerLo, eax
  mov TimerHi, edx
 end;

 SetThreadPriority(GetCurrentThread, Priority);
 SetPriorityClass(GetCurrentProcess, PriorityClass);

 Result := TimerLo / (1000.0 * DelayTime);
end;
// При запуке программы
procedure TCPUInspector.FormCreate(Sender: TObject);
var
GInitData: TWSAData;
i: Integer;
Gauge: TGauge;
begin
 CPUStop1.Enabled:= False;
 for i:= 1 to GetCPUCount -1 do
  begin
    try
      Gauge:= TGauge.Create(CPUInspector);
      Gauge.Name:= Format('Gauge%d', [i]);
      with TGauge(FindComponent(Format('Gauge%d', [i]))) do
       begin
         Parent:= StatusBar1;
         Top:=2;
         Width:=100;
         Height:=18;
         Left:=((i-1)*Width);
         MinValue:=0;
         MaxValue:=100;
         ForeColor:= StatusBar1.Color;
       end;
      except
  end;
 end;
end;
// Настройка таймера загрузки CPU
procedure TCPUInspector.Timer1Timer(Sender: TObject);
var
  n: Integer;
begin
 CollectCPUData;
    for n:=1 to GetCPUCount-1 do
      begin
        TGauge(FindComponent('Gauge'+IntToStr(n))).Progress:=StrToInt(Format('%0.0f%',[GetCPUUsage(n)*100]));
        CPU:=StrToInt(Format('%0.0f%',[GetCPUUsage(n)*100]));
      end;
end;

// Включение инспектора слежения CPU(При нажатии CPU Start)
procedure TCPUInspector.CPUStart1Click(Sender: TObject);
begin
// Частота CPU
 CPUStart1.Enabled:= False;
 CPUStop1.Enabled:= True;
 Stop:= False;
 while not Stop do
  begin
   CPUFrequency.Caption:= FloatToStr(GetCPUSpeed)+ ' MHz';
   Application.ProcessMessages;
  end;
 CPUStart1.Enabled:= True;
 CPUStop1.Enabled:= False;
end;

// Выключение инспектора слежения CPU(При нажатии CPU Stop)
procedure TCPUInspector.CPUStop1Click(Sender: TObject);
begin
 Stop:= True;
end;

end.

31.10.2011, 00:19	#2
mihali4 * Старожил Регистрация: 22.11.2006 Сообщений: 9,201	А в procedure TCPUInspector.Timer1Timer добавить Код: `Application.ProcessMessages;` не попробовали ? После строки Код: `CPU:=StrToInt(Format('%0.0f%',[GetCPUUsage(j)*100]));`

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
PHP функция - отказывается правильно работать	S-HaCK XORitY	PHP	4	24.09.2011 05:31
JQuery Corner отказывается работать	Linel	JavaScript, Ajax	5	05.07.2010 10:07
Pascal программа отказывается работать	vOvA vO	Помощь студентам	4	30.05.2010 12:51
setTimeout отказывается работать	Deight	JavaScript, Ajax	17	29.01.2009 20:29
Программа отлично работает при событии Button1Click, и отказывается работать в FormCreate	xTANATOSx	Общие вопросы Delphi	3	19.09.2007 08:02