// Der Code bildet (von der Anzeige her) etwa den "Verlauf der CPU-Auslastung" 
// des "Task-Manager" nach. Zunächst wird mit "maxi" und "mini" der größte 
// bzw. kleinste zu erwartende Wert festgelegt. Danach werden mittels der 
// Prozedur "setwert()" Double-Werte übergeben, welche dann entsprechend 
// des Taktes zur Kurve gebildet werden. Sie müssen ein TImage und einen 
// TTimer auf die Form setzen und durch Doppelklick auf den Timer die 
// Prozedur "procedure TForm1.Timer1Timer(Sender: TObject);" erzeugen. 
// Zum Testen wird hier eine TTrackbar genommen, deren Position 
// über "setwert(Trackbar1.position)" den Kurvenverlauf bestimmt. 

 
unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
  StdCtrls, ExtCtrls, Dialogs, ComCtrls; 
 
type 
  TForm1 = class(TForm) 
    Image1: TImage; 
    Timer1: TTimer; 
    // -----------  nur zum Testen ---------------- 
    Label1: TLabel; 
    Button1: TButton; 
    Button2: TButton; 
    Button3: TButton; 
    Button4: TButton; 
    Button5: TButton; 
    Button6: TButton; 
    Trackbar1: TTrackBar; 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure Button3Click(Sender: TObject); 
    procedure Button4Click(Sender: TObject); 
    procedure Button5Click(Sender: TObject); 
    procedure Button6Click(Sender: TObject); 
    procedure TrackBar1Change(Sender: TObject); 
    //---------------------------------------------- 
    procedure FormCreate(Sender: TObject); 
    procedure Timer1Timer(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    Untergrund, Gitter, Kurve: TColor; 
    offset, wert, hoch: integer; 
    bereich: double; 
    Takt: Cardinal; 
    bewegung, kasten, Saeulen, stop: boolean; 
    procedure einrichten; 
    procedure leeren; 
    procedure linie; 
    procedure schieben; 
    procedure setwert(d: double); 
    procedure resetkurve; 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
const 
  fachgroesse = 12; 
  waagerecht = 20; 
  senkrecht = 5; 
  schritt = 3; // >= 2 <= fachgroesse div 2 
  mass = (fachgroesse div schritt) * schritt; 
 
var 
  pkt: array[0..(mass * waagerecht) div schritt] of TPoint; 
 
  mini: double = 0.0; 
  maxi: double = 100.0; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  if (schritt > fachgroesse div 2) 
    or (schritt < 2) 
    then begin 
    Timer1.enabled := false; 
    showmessage('Falsche Parameter'); 
  end else begin 
    Takt := 500; 
    Timer1.interval := Takt; 
    randomize; 
    doublebuffered := true; 
    image1.autosize := true; 
    image1.left := 20; // z.B. 
    image1.top := 20; // z.B. 
 
    untergrund := clBlack; 
    Gitter := clgreen; 
    Kurve := clyellow; 
 
    Saeulen := false; 
    stop := false; 
    offset := 0; 
    bewegung := true; 
    kasten := true; 
    einrichten; 
    setwert(mini); 
    leeren; 
 
    // zum Testen ---------------------------------- 
    Trackbar1.min := round(mini); 
    Trackbar1.max := round(maxi); 
    Trackbar1.position := Trackbar1.min; 
    label1.caption := inttostr(Trackbar1.position); 
    // ---------------------------------------------- 
  end; 
end; 
 
procedure TForm1.leeren; 
var 
  x: integer; 
begin 
  for x := 0 to high(pkt) do begin 
    pkt[x].x := x * schritt; 
    pkt[x].y := hoch + 2; 
  end; 
end; 
 
procedure TForm1.resetKurve; 
begin 
  Timer1.interval := 0; 
  offset := 0; 
  einrichten; 
  setwert(mini); 
  leeren; 
  image1.refresh; 
  Timer1.interval := Takt; 
end; 
 
procedure TForm1.einrichten; 
var 
  x: integer; 
  hlp: double; 
begin 
  if mini > maxi then begin 
    hlp := mini; 
    mini := maxi; 
    maxi := hlp; 
  end; 
  bereich := maxi - mini; 
  hoch := senkrecht * mass - 2; 
  with image1.picture.bitmap, canvas do begin 
    width := pred(mass * waagerecht); 
    height := pred(mass * senkrecht); 
    brush.color := Untergrund; 
    fillrect(cliprect); 
    if kasten then begin 
      pen.color := Gitter; 
      for x := 1 to waagerecht do begin 
        moveto(x * mass - offset, 0); 
        lineto(x * mass - offset, height); 
      end; 
      for x := 1 to pred(senkrecht) do begin 
        moveto(0, x * mass); 
        lineto(width, x * mass); 
      end; 
    end; 
    pen.Color := kurve; 
  end; 
end; 
 
procedure TForm1.linie; 
var 
  x: integer; 
begin 
  with image1.picture.bitmap.canvas do begin 
    moveto(pkt[0].x, pkt[0].y); 
    for x := ord(not Saeulen) to high(pkt) do begin 
      if Saeulen then begin 
        brush.color := kurve; 
        fillrect(rect(pkt[x].x, pkt[x].y, pkt[x].x + pred(schritt), hoch + 1)); 
        brush.color := untergrund; 
      end else 
        lineto(pkt[x].x, pkt[x].y); 
    end; 
  end; 
end; 
 
procedure TForm1.schieben; 
var 
  x: integer; 
begin 
  for x := 0 to pred(high(pkt)) do 
    pkt[x].y := pkt[x + 1].y; 
  pkt[high(pkt)].y := hoch - wert; 
end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
  if stop or (mass < 1) then exit; 
  if bewegung then 
    inc(offset, schritt); 
  if offset = mass then offset := 0; 
  einrichten; 
  schieben; 
  linie; 
end; 
 
procedure TForm1.setwert(d: double); 
begin 
  if bereich = 0 then wert := 0 else 
    wert := round(((d - mini) * hoch) / bereich); 
end; 
 
// zum Testen 
 
procedure TForm1.TrackBar1Change(Sender: TObject); 
begin 
  label1.caption := inttostr(Trackbar1.position); 
  setwert(Trackbar1.position); 
end; 
 
// Beispielaufrufe 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  mini := -100.25; 
  maxi := 222.2; 
  kurve := cllime; 
  gitter := $666666; 
  resetKurve; 
  Trackbar1.min := round(mini); 
  Trackbar1.max := round(maxi); 
  Trackbar1.position := Trackbar1.min; 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  Takt := Takt xor 400; 
  Timer1.interval := Takt; 
end; 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  bewegung := not bewegung; 
  offset := 0; 
  einrichten; 
  linie; 
  Takt := 55; 
  Timer1.interval := Takt; 
end; 
 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
  kasten := not kasten; 
  einrichten; 
  linie; 
end; 
 
procedure TForm1.Button5Click(Sender: TObject); 
begin 
  Saeulen := not Saeulen; 
  einrichten; 
  linie; 
end; 
 
procedure TForm1.Button6Click(Sender: TObject); 
begin 
  stop := not stop; 
end; 
 
end.