znalazłem jeden z kodów do delphi, do odczytu % użycia CPU i pokazania na LCD:
unit fmTest;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, adCpuUsage, ExtCtrls, Spin;
type
TTestForm = class(TForm)
Timer: TTimer;
Timer1: TTimer;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
SpinEdit1: TSpinEdit;
Label1: TLabel;
procedure TimerTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CzasNaZnak(Sender: TObject);
procedure set278(Sender: TObject);
procedure set378(Sender: TObject);
procedure buf_change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
TestForm: TTestForm;
buffer: string;
akt,LPT,bufl: integer;
implementation
{$R *.DFM}
uses shellapi;
procedure prt(portn: word; val: byte);
begin
asm
mov al,val
mov dx,portn
out dx,al
end;
end;
procedure write_LPT(a: byte; sterowanie:boolean);
begin
if sterowanie=TRUE then {RS=strobe=LSB}
begin
prt(LPT+$02,$08); { RS=1, E=0 }
prt(LPT+$02,$09); { RS=0, E=0 }
prt(LPT+$00,a); {dana}
prt(LPT+$02,$01); { RS=0, E=1 }
prt(LPT+$02,$09); { RS=0, E=0 }
end else
begin
prt(LPT+$02,$09); { RS=0, E=0 }
prt(LPT+$02,$08); { RS=1, E=0 }
prt(LPT+$00,a); {dana}
prt(LPT+$02,$00); { RS=1, E=1 }
prt(LPT+$02,$08); { RS=1, E=0 }
end;
end;
procedure lcd_init;
begin
sleep(10);
write_LPT(32+16+8,TRUE);
sleep(10);
write_LPT(16+4,TRUE);
sleep(10);
write_LPT(8+4,TRUE);
sleep(10);
write_LPT(4+2,TRUE);
sleep(10);
write_LPT(1,TRUE);
sleep(10);
end;
procedure lcd_clear;
begin
write_LPT(1,TRUE);
end;
procedure lcd_home;
begin
write_LPT(2,TRUE);
end;
procedure lcd_shift;
begin
write_LPT(16+8+4+1,TRUE);
end;
procedure lcd_string(s:string);
var i:byte;
begin
for i:=1 to length(s) do write_LPT(ord(s[i]),FALSE);
end;
procedure lcd_define(d0,d1,d2,d3,d4,d5,d6,d7:byte);
begin
sleep(10);
write_LPT(d0,FALSE);
sleep(10);
write_LPT(d1,FALSE);
sleep(10);
write_LPT(d2,FALSE);
sleep(10);
write_LPT(d3,FALSE);
sleep(10);
write_LPT(d4,FALSE);
sleep(10);
write_LPT(d5,FALSE);
sleep(10);
write_LPT(d6,FALSE);
sleep(10);
write_LPT(d7,FALSE);
sleep(10);
end;
procedure TTestForm.TimerTimer(Sender: TObject);
var i: Integer;
j: Double;
s:string;
begin
CollectCPUData;
j:=GetCPUUsage(0)*100;
s:=Format('%1.0f%% ',[j]);
TestForm.Caption:='CPU Usage = '+s;
Application.Title:='CPU Usage = '+s;
for i:=1 to 4 do buffer[i]:=s[i];
for i:=bufl+6 downto 6 do buffer[i]:=buffer[i-1];
buffer[5]:=chr(trunc(j/13)+8);
lcd_home;
sleep(10);
akt:=1;
end;
procedure TTestForm.FormCreate(Sender: TObject);
var i: Integer;
begin
akt:=0;
LPT:=$378;
lcd_init;
sleep(1000);
write_LPT(64,TRUE);
sleep(10);
bufl:=SpinEdit1.Value;
lcd_define(0 ,0 ,0 ,0 ,0 ,0 ,0 ,31);
lcd_define(0 ,0 ,0 ,0 ,0 ,0 ,31,31);
lcd_define(0 ,0 ,0 ,0 ,0 ,31,31,31);
lcd_define(0 ,0 ,0 ,0 ,31,31,31,31);
lcd_define(0 ,0 ,0 ,31,31,31,31,31);
lcd_define(0 ,0 ,31,31,31,31,31,31);
lcd_define(0 ,31,31,31,31,31,31,31);
lcd_define(31,31,31,31,31,31,31,31);
buffer:=' ';
end;
procedure TTestForm.CzasNaZnak(Sender: TObject);
begin
if (akt<bufl+6) then
begin
write_LPT(ord(buffer[akt]),FALSE);
akt:=akt+1;
end;
end;
procedure TTestForm.set278(Sender: TObject);
begin
LPT:=$278;
end;
procedure TTestForm.set378(Sender: TObject);
begin
LPT:=$378;
end;
procedure TTestForm.buf_change(Sender: TObject);
begin
bufl:=SpinEdit1.Value;
end;
end.
tylko przy wykonaniu wstawki asemblerowej, pojawia się błąd w XP "Privileged Instruction", przy:
asm
mov al,val
mov dx,portn
out dx,al
end;
można to jakoś ominąć ?
pozdro