Benutzer-Passwort

Abgründiges bei

CPU-Eater

CPU-Eater-Tutorial von Daniel Schwamm (10.06.2009 - 12.06.2009)

Aus "Heimat des Dilettantismus"
http://www.daniel-schwamm.de/index.php?pg=delphi-tutorials/cpu-eater

Inhalt

1. Einleitung oder: Der Wert der Langsamheit

Die Ereignissteuerung von Windows macht es einem Programmierer nicht leicht, exakt zu erfassen, was welche Aktion bewirkt. Ein einfacher Klick auf einen Button bewirkt unter Umständen eine Kaskade weiterer Ereignisse, die ihrerseits weitere Komponenten beeinflussen, die daraufhin ihrerseits neue Ereignisse ins System schicken, die bei weiteren Komponenten landen usw.

Windows jagt in jeder Sekunde CPU-Zeit Tausende von Ereignissen von Programm zu Programm, von Prozess zu Prozess und Thread zu Thread. Es geht nur viel zu schnell, als das wir davon etwas sehen könnten.

Doch so manches Ereignis ist gar nicht nötig. Oder wird mehrfach ausgelöst, obwohl eine einmalige Aussendung genügen würde. Oder stört gar das konkrete Ziel eines Prozesses.

Um Windows bei dieser Arbeit leichter auf die Finger zu schauen, basteln wir uns heute ein kleines Progrämmchen in Delphi zusammen, welches nichts weiter macht, als CPU-Zeit zu verschwenden.

Um das Tool wenigstens optisch etwas aufzuwerten, entwickeln wir zusätzlich eine eigene Komponente, die die aktuelle CPU-Auslastung grafisch anzeigt - ähnlich wie der Taskmanager.

CPU-Eater - Ein Tools zum Abremsen des PC

"CPU-Eater": Ein kleines Programm, um hochgezüchtete PCs künstlich zu verlangsamen.

Warnung vorweg: Die Verlangsamung des PCs gelingt mit diesem Tool keinewegs immer! Möglicherweise klappt es sogar nur in den seltensten Fällen - ich habe das nicht auf breiter Front geprüft. Erwartet also nicht zu viel!

2. Mein CPU-Eater - der simpelste Totschläger aller Zeiten

CPU-Eater - Die CPU-Zeit wird gefressen

2.1. Ablauf

Die Kern-Routine von "CP_Eater" wird nach einem Klick auf einen Button "Start" gestartet. Ein weitere Klick auf demselben Button beendet alles wieder.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020

procedure Thauptf.startbClick(Sender: TObject);
var
  i:int64;
begin
  if startb.caption='Start' then begin
    startb.caption:='STOPP';
    i:=0;
    while(true) do begin
      inc(i);
      if i>100000 then begin
        if startb.caption<>'STOPP' then break;
        application.processmessages;
        i:=0;
      end;
    end;
    startb.caption:='Start';
  end
  else begin
    startb.caption:='Start';
  end;

Und das ist auch schon alles :-)

Zuerst prüfen wir anhand der Button-Caption, ob die CPU-Fresserei gerade aktiv ist. Falls ja, ändern wir die Caption und der Prozess endet. Ansonsten starten wir eine Ewigschleife, die einen Zähler "i" hochzählt. Hat "i" einen gewissen Wert erreicht, arbeiten wir die inzwischen angefallen Nachrichten von Windows mit dem Aufruf von "application.processmessages" ab. Das verhindert, dass Windows völlig "einfriert" und noch auf unsere Mausereignisse reagieren kann.

Komisch eigentlich, dass ich keine fertige EXE im Web fand, die genau dies auch macht, nämlich schlicht Zeit durch sinnfreies Hochzählen eines Integerwertes zu verschwenden, um damit den ultra-schnellen PC etwas abzubremsen.

2.2. Wissen aus dem Web: CPU-Beschäftigung in Prozent

Den folgenden Source von Thomas Stutz fand ich dagegen fertig im Web. Er wurde für unsere Zwecke leicht modifiziert, insbesondere in die Komponente "TCPUUsageP" eingebunden.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110

//********************************************************************
//Autor: Thomas Stutz
//URL: http://www.swissdelphicenter.ch/de/showcode.php?id=969
//...die CPU Auslastung unter Windows NT/2000/XP ermitteln?
//********************************************************************

type
  TPDWord=^DWORD;
  TSystem_Basic_Information=packed record
    dwUnknown1: DWORD;
    uKeMaximumIncrement: ULONG;
    uPageSize: ULONG;
    uMmNumberOfPhysicalPages: ULONG;
    uMmLowestPhysicalPage: ULONG;
    uMmHighestPhysicalPage: ULONG;
    uAllocationGranularity: ULONG;
    pLowestUserAddress: Pointer;
    pMmHighestUserAddress: Pointer;
    uKeActiveProcessors: ULONG;
    bKeNumberProcessors: byte;
    bUnknown2: byte;
    wUnknown3: word;
  end;

  TSystem_Performance_Information = packed record
    liIdleTime: LARGE_INTEGER;
    dwSpare: array [0..75] of DWORD;
  end;

  TSystem_Time_Information = packed record
    liKeBootTime: LARGE_INTEGER;
    liKeSystemTime: LARGE_INTEGER;
    liExpTimeZoneBias: LARGE_INTEGER;
    uCurrentTimeZoneId: ULONG;
    dwReserved: DWORD;
  end;

//-------------------------------------------------------
function TCpuUsageP.GetCPUUsage:double;
const
  _SystemBasicInformation=0;
  _SystemPerformanceInformation=2;
  _SystemTimeInformation=3;
var
  SysBaseInfo:TSystem_Basic_Information;
  SysPerfInfo:TSystem_Performance_Information;
  SysTimeInfo:TSystem_Time_Information;
  status:Longint;
  dbSystemTime:Double;
  dbIdleTime:Double;

  function Li2Double(x:LARGE_INTEGER):Double;
  begin
    Result:=x.HighPart*4.294967296E9+x.LowPart;
  end;

begin
  result:=0;
  if @NtQuerySystemInformation=nil then begin
    NtQuerySystemInformation:=GetProcAddress(
      GetModuleHandle('ntdll.dll'),
      'NtQuerySystemInformation'
    );
  end;

  // get number of processors in the system
  status:=NtQuerySystemInformation(
    _SystemBasicInformation,
    @SysBaseInfo,SizeOf(SysBaseInfo),nil
  );
  if status<>0 then Exit;

  // get new system time
  status:=NtQuerySystemInformation(
    _SystemTimeInformation,
    @SysTimeInfo,SizeOf(SysTimeInfo),nil
  );
  if status<>0 then Exit;

  // get new CPU's idle time
  status:=NtQuerySystemInformation(
    _SystemPerformanceInformation,
    @SysPerfInfo,SizeOf(SysPerfInfo),nil
  );
  if status<>0 then Exit;

  // if it's a first call - skip it
  if(liOldIdleTime.QuadPart<>0) then begin
    // CurrentValue = NewValue - OldValue
    dbIdleTime:=Li2Double(SysPerfInfo.liIdleTime)-
                Li2Double(liOldIdleTime);
    dbSystemTime:=Li2Double(SysTimeInfo.liKeSystemTime)-
                  Li2Double(liOldSystemTime);

    // CurrentCpuIdle = IdleTime / SystemTime
    dbIdleTime:=dbIdleTime/dbSystemTime;

    // CurrentCpuUsage%=100-(CurrentCpuIdle*100)/NumberOfProcessors
    dbIdleTime:=100.0-
                dbIdleTime*100.0/SysBaseInfo.bKeNumberProcessors+
                0.5;

    // Show Percentage
    result:=dbIdleTime;
    if result>100 then result:=100
  end;
  // store new CPU's idle and system time
  liOldIdleTime:=SysPerfInfo.liIdleTime;
  liOldSystemTime:=SysTimeInfo.liKeSystemTime;
end;

Quelle: Swiss Delphi Center

Offenbar holt man sich hier zunächst die Einsprungadresse zur exportierten Funktion "NtQuerySystemInformation" der System-DLL "ntdll.dll".

Diese füllt uns anschliessend nacheinander die zuvor definierten Strukturen der Typen "TSystem_Basic_Information", "TSystem_Performance_Information" und "TSystem_Time_Information" mit Daten auf.

Die Werte in den Strukturen werden schliesslich verwendet, um die aktuelle Auslastung der CPU zu berechnen. Wie das genau abläuft, braucht uns hier nicht weiter zu interessieren.

2.3. Eine eigene Delphi-Kopmponente: "TCPUUsageP"

2.3.1. Deklaration

Um nicht alles zu klauen und das Projekt etwas aufzuwerten, verwenden wir bei "CPU_Eater" eine eigene Komponente, die die aktuelle CPU-Auslastung grafisch anzeigt. Dazu programmieren wir eine neue Klasse namens "TCPUUsageP", die von "TCumstomPanel" abgeleitet wird.

TCpuUsageP=class(TCustomPanel)
private
  fyline:integer;
  fspeed:integer;
  [...]

  NtQuerySystemInformation: function(
    infoClass: DWORD; buffer: Pointer; bufSize:
    DWORD; returnSize: TPDWord
  ):DWORD;stdcall;
  liOldIdleTime:LARGE_INTEGER;
  liOldSystemTime:LARGE_INTEGER;

  procedure pic2backbmp;
  procedure backpicChanged(Sender: TObject);
  procedure dotimer(sender:tobject);
  procedure mkgraf;

  procedure setyline(v:integer);
  procedure setspeed(v:integer);
  [...]

public
  constructor create(aowner:tcomponent);override;
  destructor destroy;override;
  procedure paint;override;
  procedure resize;override;

  procedure start;
  procedure stopp;
  function GetCPUUsage:double;
published
  property CUP_BackColor:tcolor read fbackcolor write setbackcolor;
  property CUP_YLine:integer read fyline write setyline;
  property CUP_PenColor:tcolor read fpencolor write setpencolor;
  property CUP_PenWidth:integer read fpenwidth write setpenwidth;
  property CUP_Speed:integer read fspeed write setspeed;
  property CUP_XMax:integer read fxmax write setxmax;
  property CUP_Pic:tpicture read fbackpic write setpic;
  property CUP_Usage:integer read fusage;
  property CUP_Style:TCupStyle read fstyle write setstyle;
  property CUP_GitterStepX:integer read fgitterstepx write setgitterstepx;
  property CUP_GitterStepY:integer read fgitterstepy write setgitterstepy;
  property CUP_GitterColor:Tcolor read fgittercolor write setgittercolor;

  property OnCUP_Usage:TNotifyEvent read FCUP_OnUsage write FCUP_OnUsage;

  property Align;
  property PopupMenu;
  [...]
end;

Klassischerweise beginnen "private"-Elemente innerhalb von Klassen mit dem Prefix "f". Diese Variablen lassen sich nur innerhalb der Klasse nutzen. Um sie zu modifizieren, werden die zugehörigen "set"-Funktionen verwendet. Diese sind ebenfalls "private", können also vom Benutzer nicht direkt aufgerufen werden. Dies geschieht vielmehr über die "published"-Properties, die im Objektinspektor im Register "Eigenschaften" aufgelistet werden.

CPU-Eater - Die Eigenschaften der Komponente TCPUUsageP

Eigenschaften: Alle neuen "published" Eigenschaften von "TCPUUsageP" beginnen einheitlich mit dem Prefix "CUP", um sie leicher identifizieren zu können. Die meisten "regulären" Eigenschaften von "TPanel" stehen dem Anwender auch weiterhin zur Verfügung.

Ändern wir etwa das property "CUP_Speed", bewirkt dies den Aufruf der Funktion "setspeed", innerhalb der dann nach Prüfung der Eingabe die interne Variable "fspeed" direkt gesetzt wird. Damit wird sichergestellt, dass diese nur gültige Werte entgegennimmt.

Auch die privaten Funktionen lassen sich nur innerhalb der Klasse aufrufen. Wie man sieht, befindet sich darunter auch der Funktionszeiger namens "NtQuerySystemInformation", den wir weiter oben in der "GetCPUUsage"-Funktion eingesetzt haben.

Eine Erwähnung wert ist auch das Propery "OnCUP_Usage", welches - wie alle "on"-Properties - im Register "Ereignisse" des Objektinspektors auftaucht. Es ist vom Typ "TNotifyEvent". Dadurch wird die zugehörige Windows-Botschaft vom System automatisch "abgefeuert", so wie die verknüpfte, innere Variable "fusage" ihren Wert ändert.

CPU-Eater - Die Ereignisse der Komponente TCPUUsageP

Ereignisse: Die Komponente "TCPUUsageP" besitzt genau ein Ereignis mehr als "TPanel", nämlich "OnCUP_Usage". Dieses wird immer dann automatisch ausgelöst, wenn die Komponente einen neuen Wert der CPU-Auslastung ermittelt hat.

Im Übrigen stehen alle als "public" deklarierten Funktionen dem Benutzer der Klasse "TCpuUsageP" direkt zur Verfügung.

2.3.2. Registrierung

Um eine Komponente in die Komponenten-Liste von Delphi aufzunehmen, muss sie registriert und einem bestimmten Register zugewiesen werden (bei mir ist das "DAN"). Dies geschieht durch:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010

procedure register;

implementation

{$R cpuusagep.res}

procedure register;
begin
RegisterComponents('DAN',[TCPUUsageP]);
end;

CPU-Eater - Registrierung von TCPUUsageP in der Komponenten-Liste von Delphi, register DAN

Registrierung: Durch die Registrierung wird die neue Komponente "TCPUUSageP" in die Komponenten-Liste von Delphi aufgenommen. Hier wurde das Register "DAN" als Zielort gewählt. Das Icon der Komponente wurde zuvor mit dem Bild-Editor von Delphi erstellt und als Ressource eingebunden.

Hinweis: Wer Zeit und Muse hat, kann mal versuchen, eine Delphi-Komponente zu registrieren, bei der die Prozedur-Deklaration statt "procedure register;" kleingeschrieben ist, also "procedure Register;" heisst. Delphi kompiliert dann nach wie vor problemlos, schmeisst die Komponente aber aus der Palette heraus bzw. nimmt sie dort erst gar nicht auf!

Dies ist tatsächlich der einzige Fall, den mir bekannt ist, bei dem Delphi zwischen Gross- und Kleinschreibung unterscheidet. Und diese simple Erkenntnis hat mich vor einiger Zeit zwei Stunden meines Lebens gekostet ...

2.3.3. Erzeugung und Zerstörung

Kommen wir zum Konstruktor und dem Destruktor unserer neuen Komponente "TCpuUsageP":

constructor TCpuUsageP.create(aowner:tcomponent);
var
  r:integer;
begin
  inherited;

  fyline:=2;
  fspeed:integer;
  [...]

  fbmp:=tbitmap.create;
  fbmp.PixelFormat:=pf24bit;
  fbmp.width:=width;
  fbmp.Height:=height;
  fbmp.Canvas.Brush.color:=fbackcolor;
  fbmp.canvas.pen.color:=fpencolor;

  fbackbmp:=tbitmap.create;
  fbackbmp.PixelFormat:=pf24bit;
  fbackbmp.width:=width;
  fbackbmp.Height:=height;

  fbackpic:=tpicture.Create;
  fbackpic.OnChange:=backpicChanged;

  ftm:=ttimer.Create(self);
  ftm.OnTimer:=dotimer;
  ftm.Interval:=fspeed;
  ftm.Enabled:=false;

  for r:=0 to _fxmax do
    fpa[r]:=point(0,fbmp.height-cup_yline);
end;

destructor TCpuUsageP.destroy;
begin
  ftm.Enabled:=false;
  ftm.Free;
  fbmp.Free;
  fbackbmp.Free;
  fbackpic.free;
  inherited;
end;

Mittels "inherited" sorgen wir dafür, dass das Panel "standarmässig" initialisiert wird. Anschliessend füllen wir die privaten Elemente der Klasse, die wir neu dazugepackt haben.

Wir erzeugen u.a. zwei Bitmaps: Eine ("fbackbmp"), die die aktuelle Hintergrund-Grafik puffert, die andere ("fbmp"), die den aktuellen Graph enthält. Zusätzlich wird ein TImage "fbackpic" (für ein Hintergrundbild) und ein Timer "ftm" (zur periodischen Abfrage der CPU-Auslastung) erstellt.

Zuletzt füllen wir das array "fpa" mit "Null-Linien"-Werten. Hier werden später nach und nach die ermittelten CPU-Auslastungs-Werte gesichert.

2.3.4. Hintergründiges

Über die "set"-Funktionen wird ein Wert an die zugehörige innere Variable durchgereicht. Mit folgender "setpic"-Funktion etwa wird ein Hintergrund-Bild an die "TImage"-Instanz "fbackpic" überwiesen:

00001
00002
00003
00004
00005
00006
00007
00008
00009

procedure TCpuUsageP.setpic(v:tpicture);
begin
  try
    fbackpic.assign(v);
    pic2backbmp;
  except
    fbackpic.graphic:=nil;
  end;
end;

Im Fehlerfall wird das TImage "fbackimg" geleert, im Erfolgsfall folgt der Aufruf der Prozedur "pic2backbmp". Hier wird das Bild "fbackpic" auf die Hintergrund-Bitmap "fbackbmp" kopiert - je nach Grösse eventuell auch mehrfach:

procedure TCpuUsageP.pic2backbmp;
var
  b:tbitmap;
  x,y,l,t,w,h:integer;
begin
  if fbackpic.graphic=nil then begin
    mkgraf;
    exit;
  end;

  try
    b:=tbitmap.create;
    b.PixelFormat:=pf24bit;

    try
      b.assign(fbackpic.Graphic);

      fbackbmp.width:=screen.width;
      fbackbmp.height:=screen.height;

      w:=b.width;
      h:=b.Height;

      t:=0;
      for y:=0 to trunc(screen.width/h) do begin
        l:=0;
        for x:=0 to trunc(screen.width/w) do begin
          bitblt(
            fbackbmp.Canvas.Handle,l,t,w,h,
            b.Canvas.Handle,0,0,
            srccopy
          );
          l:=l+w;
        end;
        t:=t+h;
      end;
    finally
      b.Free;
    end;

  except
    fbackpic.graphic:=nil;
  end;
  mkgraf;
end;

Das TImage "fbackpic" wird zuerst auf die temporäre Bitmap "b" kopiert.

Anschliessend durchlaufen wir zwei verschachtelte Schleifen, über die "b" auf die innere Bitmap "fbackbmp", welches Screen-Dimension hat, so oft nebeneinander und untereinander kopiert wird wie möglich.

Egal, wie gross der Benutzer die Komponente "TCPUUsageP" nun generieren mag, das Hintergrundbild deckt stets den gesamten sichtbaren Bereich ab.

CPU-Eater - Verschiedene Hintergruende für die Komponente TCPUUsageP

Hintergrund-Bilder: Über das property "CUP_Img" kann der Komponente "TCPUUsageP" ein beliebiges Hintergrundbild zugewesen werden. Ist es es kleiner als die angezeigte Fläche, wird es entsprechend dupliziert. Im Beispiel liegt oben rechts keine Hintergrund vor. Oben links strahlt uns Catherine Bell ganz alleine an. Und unten wurde Collien Fernandes mehrfach reproduziert, um die gesamte Komponente abzudecken.

Um dem Graphen das neue neue Hintergrund-Bild mitzuteilen, wird zum Abschluss die Prozedur "mkgraf" aufgerufen.

procedure TCpuUsageP.mkgraf;
var
  y,r,t,l,w,h:integer;
  dy:double;
begin
  fbmp.width:=width;
  fbmp.height:=height;
  fbmp.canvas.brush.color:=fbackcolor;
  fbmp.Canvas.Pen.color:=fpencolor;
  fbmp.Canvas.Pen.width:=fpenwidth;

  if(fstyle=cupnone)or(fbackpic.graphic=nil) then begin
    fbmp.Canvas.FillRect(rect(0,0,fbmp.width,fbmp.height));
  end
  else begin
    try
      bitblt(
        fbmp.canvas.handle,0,0,width,height,
        fbackbmp.canvas.Handle,0,0,
        srccopy
      );
    except
    end;
  end;

  //gitter
  fbmp.Canvas.Pen.color:=fgittercolor;
  fbmp.Canvas.Pen.width:=1;

  //y-gitter
  if fgitterstepy>0 then begin
    dy:=height/fgitterstepy;
    for y:=1 to fgitterstepy-1 do begin
      fbmp.Canvas.moveto(0,round(dy*y));
      fbmp.Canvas.lineto(width,round(dy*y));
    end;
  end;

  //x-gitter
  if fgitterstepx>0 then begin
    for r:=0 to fxmax-1 do begin
      if (r mod fgitterstepx)<>fxgitter then continue;
      fbmp.Canvas.moveto(fpa[r].x,0);
      fbmp.Canvas.lineto(fpa[r].x,height);
    end;
    dec(fxgitter);if fxgitter<0 then fxgitter:=fgitterstepx-1;
  end;

  fbmp.Canvas.Pen.color:=fpencolor;
  fbmp.Canvas.Pen.width:=fpenwidth;

  //graf
  if fstyle=cuppolyline then fbmp.canvas.Polyline(Slice(fpa,fxmax))
  else if fstyle=cupline then begin
    h:=height;
    for r:=0 to fxmax-1 do begin
      t:=fpa[r].y;
      l:=fpa[r].X;
      fbmp.canvas.moveto(l,t);
      fbmp.canvas.LineTo(l,h);
    end;
  end
  else if fstyle=cuprectangle then begin
    fbmp.Canvas.Pen.width:=1;
    w:=fpenwidth;
    h:=height-fyline;
    for r:=0 to fxmax-1 do begin
      t:=fpa[r].y;
      l:=fpa[r].X;
      fbmp.Canvas.Rectangle(l,t,l+w,h);
    end;
  end
  else if fstyle=cuppyramid then begin
    fbmp.Canvas.Pen.width:=1;
    w:=fpenwidth;
    h:=height;
    for r:=0 to fxmax-1 do begin
      t:=fpa[r].y;
      l:=fpa[r].X;
      fbmp.canvas.moveto(l,h);
      fbmp.canvas.lineto(l+(w div 2),t);
      fbmp.canvas.LineTo(l+w,h);
    end;
  end;

  paint;
end;

Zuerst wird die innere Arbeits-Bitmap "fbmp" vorbereitet, u.a. korrekt dimensioniert.

Anschliessend wird "fbmp" entweder einheitlich eingefärbt oder aber mit dem zuvor generierte Hintergrundbild "fbackbmp" übermalt.

Es folgt das Zeichnen des Gitternetzes des Graphen. Zuerst die waagrechten "y"-Linien, die sich im Laufe der Zeit in ihrer Position nicht weiter verändern.

Anders die senkrechten "x"-Linien, die mit jeder "Zeiteinheit" immer weiter von rechts nach links über die Grafik wandern. Dieser Prozess wird über die innere Variable "fxgitter" gesteuert, die bei jedem Durchgang passend dekrementiert wird.

Erst jetzt wird der eigentliche Graph auf die Bitmap übertragen, der die CPU-Auslastung im Laufe eines Zeitabschnitts wiedergibt. "TCPUUsageP" kennt dabei 5 verschiedene Graph-Typen, die der Benutzer vorgeben kann: Keine Grafik, Linien, Striche, Rechtecke und Pyramiden.

00001
00002

type
tcupstyle=(cupnone,cuppolyline,cupline,cuprectangle,cuppyramid);

Stets wird dazu das innere array "fpa" vom Typ "TPoint" durchlaufen und ausgelesen, denn dort werden die ermittelten Werte der CPU-Auslastung gespeichert. Je nach "cup"-Typ werden die Punkte zu Graph-Grafiken umgerechnet, die dann auf "fbmp" übertragen werden.

Zuletzt sorgt der Aufruf von "paint" dafür, dass das Ergebnis auf dem Bildschirm angezeigt wird.

CPU-Eater - Die Komponente TCPUUsageP kennt mehrere Graphen-Stile

Graph-Styles: Die Komponente "TCPUUSageP" kennt mehre Styles, die über das Property "CUP_Style" vorgegeben werden können. Dadurch wird die Darstellung des Graphen beeinflusst.

2.3.5. Überschriebene Ereignisse

Einige Standard-Funktion von "TPanel" müssen überschrieben werden, damit sie sich in unserer Komponente korrekt verhalten. Das haben wir bereits bei Konstruktor und Destruktor von "TCPUUsageP" gesehen.

Zwei weitere Kandiaten sind "paint" und "resize". Schauen wir uns zuerst die "paint"-Prozedur an:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011

procedure TCpuUsageP.paint;
begin
  try
    bitblt(
      canvas.handle,0,0,width,height,
      fbmp.canvas.Handle,0,0,
      srccopy
    );
  except
  end;
end;

Wann immer unsere Komponente neugezeichnet werden muss - etwa, wenn sie von einem anderem Fenster überdeckt und dann wieder freigeben wird -, feuert Windows automatisch eine entsprechende Botschaft ab, die letztlich bei der "paint"-Prozedur von "TCPUUsageP" endet.

Wie wir oben sehen können, machen wir hier nichts weiter, als unsere Graphen-Bitmap "fbmp" auf den Canvas von "TCpuUsageP"-Panels zu kopieren.

Wird dagegen die Grösse unserer Komponente geändert, feuert Windows ebenfalls eine Botschaft ab, die diesmal aber erst zur Prozedur "resize" führt.

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021

procedure tCpuUsageP.resize;
var
  h,r:integer;
  p:tpoint;
  dx:double;
begin
  //punkte anpassen an neue höhe/breite
  dx:=width/fxmax;
  for r:=0 to fxmax-1 do begin
    if r=fxmax-1 then p.x:=width else p.x:=round(dx*r);
    //h/hold=hh/height
    h:=fhold-fyline-fpa[r].y;
    p.Y:=round((h*height)/fhold);
    p.y:=height-fyline-p.Y;
    fpa[r]:=p;
  end;
  mkgraf;

  //merke alte höhe
  fhold:=height;if fhold<2 then fhold:=2;
end;

Wir berechnen die array-Werte von "pfa" anhand der neuen Dimension um, basierend auf dem Wert der inneren Variable "fhold", die die vorherige Höhe der Grafik beinhaltet. Ist z.B. "fhold" kleiner "height", dann ist die Komponente grösser geworden, die Punkte des Graphen müssen entsprechend weiter verteilt (gestreckt) werden, um den gleichen Verlauf wiederzugeben.

Anschliessend rufen wir die Prozedur "mkgraf" auf, welche, wie wir gesehen haben, wiederum "paint" aufruft - der Graph wird angepasst an die neuen Grössenverhältnisse auf dem Bildschirm ausgegeben.

CPU-Eater - Die Komponente TCPUUsageP reagiert auf das RESIZE-Ereignis

Grössenänderung: Die Komponente "TCPUUSageP" reagiert auf Grössenänderungen, indem die Punkte des Graphen neu berechnet werden. Dadurch wird die Kurve der CPU-Auslastung entsprechend gestreckt oder gestaucht.

2.3.6. Starten und Stoppen

Platzieren wir ein "TCPUUsageP" auf einer Delphi-Form, passiert zunächst weiter nichts, ausser das die Komponente gemäss den Vorgaben wie ein gewöhnliches Panel angezeigt wird.

Erst nach Aufruf der "public"-Prozedur "start" erwacht die Komponente zum Leben:

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016

procedure tCpuUsageP.start;
var
  p:tpoint;
  r:integer;
  dx:double;
begin
  //setze graf auf fyline/nulllinie
  dx:=width/fxmax;
  for r:=0 to fxmax-1 do begin
    if r=fxmax-1 then p.x:=width else p.x:=round(dx*r);
    p.y:=height-fyline;
    fpa[r]:=p;
  end;
  fxgitter:=0;
  ftm.enabled:=true;
end;

Das array "fpa" (mit den Werten der CPU-Auslastung über einen gewissen Zeitraum hinweg) wird (wieder) auf "Null-Linie" gebracht. Anschliessend folgt die Aktivierung des innere Timers "ftm", wodurch in periodischen Abständen die Prozedur "dotimer" aufgerufen wird:

procedure TCpuUsageP.dotimer(sender:tobject);
var
  p:tpoint;
  r,hd,li:integer;
  dx:double;
begin
  if not visible then exit;

  try
    hd:=fbmp.height-fyline-5;if hd<=0 then hd:=0;
    dx:=fbmp.width/fxmax;

    //punkte verschieben
    for r:=1 to fxmax-1 do begin
      fpa[r-1].x:=round((r-1)*dx);
      fpa[r-1].y:=fpa[r].y;
    end;

    //neuen punkt: cpu auslastung
    li:=round(getcpuusage);
    hint:='CPU-Auslastung: '+inttostr(li)+'%';
    fusage:=li;

    //unötig, weil notify event
    //if assigned(FOnCUP_Usage) then FOnCUP_Usage(Self);

    p.x:=width;
    hd:=round((hd*li)/100);
    p.y:=fbmp.height-hd-fyline;
    fpa[fxmax-1]:=p;

  except
  end;
  mkgraf;
end;

Ist die Komponente nicht sichtbar, gibt es keinen Graphen und wir verlassen die Prozedur gleich wieder.

In "hd" berechnen wir die maximale Höhe der aktuellen Graph-Grafik: Diese ergibt sich aus der Höhe des Graphen ("fbmp.height") abzüglich der Höhe der Null-Linie ("fyline") abzüglich 5 Pixel Toleranz.

Die Anzahl der CPU-Werte, die wir uns maximal merken müssen, ist mit "fxmax" vorgegeben. Geteilt durch die Breite des Graphen erhalten wir das Delta "dx" - so viel Breite steht jedem einzelnen CPU-Wert grafisch zur Verfügung.

Da die CPU-Werte von rechts nach links wandern sollen, durchlaufen wir eine Schleife und verschieben die Werte im array "fpa" entsprechend, Dabei geht der am weitesten links stehende Punkt verloren, wird aber ganz rechts durch einen neuen Wert ersetzt, den wir direkt im Anschluss ermitteln.

Die aktuell vorliegende CPU-Auslastung erhalten wir von der weiter oben erläuterten Funktion "getcpuusage". Das Ergebnis wird gemäss der Graph-Dimensionen umgerechnet und im "fpa"-array gesichert.

Die innere Variable "fusage" ist mit dem property "OnCUP_Usage" verknüpft, welches vom Typ "TNotifyEvent" ist. Nimmt nun "fusage" einen neuen Wert an, wird automatisch ein Ereignis ausgelöst, wodurch der Benutzer der Komponente über diese Änderung informiert wird.

Will man die Wiedergabe des Graphen beenden, bietet sich die "public"-Prozedur "Stopp" an. Hier wird einfach der innere Timer "ftm" deaktiviert.

00001
00002
00003
00004

procedure tCpuUsageP.stopp;
begin
ftm.enabled:=false;
end;

2.4. Noch einmal zum Haupt-Programm

Schauen wir uns jetzt noch kurz an, wie die Komponente "TCPUUsageP" eigentlich genau in das "CPU-Eater"-Programm eingebunden wird. Anders als sonst meist üblich, wird hier nämlich die Komponente in der Prozedur "FormCreate" dynamisch erzeugt, statt sie einfach direkt auf das Formular abzulegen (wobei das natürlich auch möglich wäre).

00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013

procedure Thauptf.FormCreate(Sender: TObject);
begin
  cpu:=tcpuusagep.create(self);
  cpu.Align:=alclient;
  cpu.Parent:=hauptf;
  cpu.CUP_YLine:=3;
  cpu.OnCUP_Usage:=cpuusage;
  cpu.CUP_Pic:=backimg.Picture;
  cpu.CUP_PenColor:=clteal;
  cpu.CUP_GitterColor:=cllime;
  //u.CUP_Style:=cuprectangle;
  cpu.start;
end;

Das hat eigentlich nur den einen Grund: Die Komponente wurde parallel zum Haupt-Programm entwickelt. Durch die dynamische Generierung erspart man es sich, nach jeder kleinen Änderung an der Komponente diese neu ins Delphi-System installieren zu müssen. Auch so eine Sache, die ich erst eine ganze Weile später lernte ...

CPU-Eater - Hauptform von CPU-Eater ohne TCPUUsageP-Komponente

Hauptform von "CPU-Eater": Die Komponente "TCPUUSageP" wird nicht auf der Hauptform abgelegt, sondern erst nach Programmstart dynamisch erzeugt. Das verwendete Hintergrundbild wird aber bereits im Vorfeld in einer "TImage"-Komponente eingelagert.

3. Epilog

"CPU-Eater" ist ein Beispiel für ein Dirty-Prog, dessen Kern sehr klein und dessen "Schmückwerk" dagegen recht umfangreich ausfällt. Mag ich ja eigentlich nicht so.

Der Nutzen eines Tools, dessen einziger Zweck es ist, den eigenen Rechner auszubremsen, kann zudem natürlich infrage gestellt werden. Er erschliesst sich vermutlich auch eher anderen Programmierern als dem "Normal-Anwendern".

Aber ich denke, es war eine gute Gelegenheit, einmal die Entwicklung einer eigenen, kleinen Komponente in Delphi zu veranschaulichen. Darüber findet man nämlich vergleichsweise wenig Informationen im Web. Und wie man hoffentlich gesehen hat: Es ist nicht auffällig schwieriger als die Arbeit am gewöhnlichen Programm-Code.

Wie fast immer bei meinen Progrämmchen taugt auch der "CPU-Eater" nur bedingt dazu, seinen eigentlichen Job zu erledigen. So greift er etwa auf meinem Geschäfts-PC brav wie erwünscht 100% der CPU-Zeit ab, wodurch alle anderen Prozesse quälend langsam ablaufen. Auf meinem Rechner zu Hause klappt das jedoch seltsamerweise überhaupt nicht. Auch hier zeigt die CPU-Auslastung 100% an, doch werden den anderen Programmen offenbar sofort neue CPU-Zeiten zugeordnet, so wie diese aktiv werden; hier verlangsamt sich praktisch gar nichts. Der PC, der clevere, trickst den CPU-Fresser aus!

So etwas verdirbt mir jedenfalls nicht den Spass an meinem Proggy. Ist halt nichts 100%iges. But who cares?

4. Download

"CPU-Eater" wurde in Delphi 7 programmiert. Im ZIP-File enthalten ist der vollständige Source-Code (Hauptprogramm und Komponente), sowie die EXE-Datei. Das Paket, etwa 270 kB, gibt es hier:

CPU-Eater.zip

Es wurde auf die Verwendung von Fremd-Komponenten verzichtet. Auch werden keine speziellen DLLs benötigt. Der Source-Code lässt sich sicher leicht auf andere Delphi-Versionen anpassen. Das ausführbare Programm ist mit 500 kB recht anspruchslos. Ausserdem nimmt es keinerlei Änderungen an der Registry vor.

Have fun!