For...To...Do    &   function (Unterprogramm)

Unterprogramme sind Programmeinheiten, mit deren Hilfe die Konstruktion eines Programms vereinfacht werden kann.

Die Funktion besitzt genau ein Ausgangsgröße (Funktionswert; Variablenparameter)).
Es sind beliebig viele Eingangsgrößen möglich ( Werteparameter).
Funktionsnamen sollten aussagekräftig gewählt werden.

Eine Funktion besteht aus einem Funktions-Block.
Sie besitzt folgenden prinzipiellen Aufbau: 

  FUNCTION name ( parameterliste ) : datentyp;       	{ Funktionskopf}
    deklarationen               			{ bei Bedarf }      
  BEGIN                                             	{ Funktionskörper}
    ausführbare Anweisungen                          
    name := ... ;                                   
  END;


unit quadr_funkt;


interface


uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, Mask;


type
  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button1: TButton;
    Label5: TLabel;
    Label6: TLabel;
    Button3: TButton;
    Button2: TButton;
    StringGrid1: TStringGrid;
    Label7: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    
  private
    { Private-Deklarationen }
  
  public
    { Public-Deklarationen }
  end;


var
  Form1: TForm1;
  a,b,c,d,x1,x2  : real;



implementation


{$R *.dfm}


function diskr(a,b,c:real):real;
begin
  diskr:=b*b-4*a*c;
end;


procedure TForm1.Button1Click(Sender: TObject);
var x,i : integer;
begin
  a:=strtofloat(edit1.text);
  b:=strtofloat(edit2.Text);
  c:=strtofloat(edit3.text);


  d:=diskr(a,b,c);
  if d<0 then
    begin
      label5.caption:='Keine Lösung'
    end;


  if d=0 then
    begin
      label5.Caption:='Genau eine Lösung';
      x1 := -b/ (2*a);
      label6.Caption:=floatTOstrF(x1,FFFixed,3,4);
    end;


  if d>0 then
    begin
       x1:=(-b+sqrt(d))/(2*a);
       x2:=(-b+sqrt(d))/(2*a);
        label5.Caption:='x1=  '+ floatTOstrF(x1,FFFixed,3,4);
        label6.Caption:='x2=  '+ floatTOstrF(x2,FFFixed,3,4);
    end;
  x := -6;
   for i := 1 to 11 do
         begin
              StringGrid1.Cells[i,1] := floatTostrF((a*(x+i)*(x+i) + b*(x+i) + c),ffFixed,10,2);
         end;
end;



procedure TForm1.Button2Click(Sender: TObject);
var i :integer;
begin
  edit1.Text:='';
  edit2.Text:='';
  edit3.Text:='';
  label5.Caption:='';
  label6.Caption:='';


   for i := 1 to 11 do
         begin
              StringGrid1.Cells[i,1] := '';
         end;



end;


procedure TForm1.FormCreate(Sender: TObject);
var i : integer;
begin
      StringGrid1.Cells[0,0] := 'x';
      StringGrid1.Cells[0,1] := 'y';
      for i := 1 to 11 do
         begin
              StringGrid1.Cells[i,0] := intTostr(-6+i);


         end;
end;


procedure TForm1.Button3Click(Sender: TObject);
begin
	close;
end;


end.

Temperatur     IF...THEN....RadioButton(Auswahl)
 
Version 2 Quadratische Funktion mit Grafischer Darstellung




Quelltextauszug
Strecke berechnen Zeichnen der Funktion 
procedure TForm1.strecke(x1,y1,x2,y2:real);
var breite,hoehe:real;
begin
  breite:=image1.ClientWidth;
  hoehe:=image1.ClientHeight;
  with image1.canvas do
   begin
    pen.Color:=clred;
    moveto(round((breite/2)+(breite/10)*x1),round((hoehe/2)- (hoehe/10)*y1));
    lineto(round((breite/2)+(breite/10)*x2),round((hoehe/2)-(hoehe/10)*y2));
  end;
end;
 
x1:=-5;
while x1<5 do
begin
  	x2:=x1+0.05;
  	y1:=a*x1*x1+b*x1+c;
  	y2:=a*x2*x2+b*x2+c;
  	canvas.pen.Color:=clblack;
  	strecke(x1,y1,x2,y2);
  	x1:=x1+0.05;
end;