1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:

unit UNT_wahl;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons;

type
  TFRM_wahlergebnis = class(TForm)
    BTN_anzeigen: TBitBtn;
    BTN_close: TBitBtn;
    IMG_anzeige: TImage;
    procedure BTN_closeClick(Sender: TObject);
    procedure BTN_anzeigenClick(Sender: TObject);
    procedure closeabfrage(Sender: TObject; var CanClose: Boolean);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  FRM_wahlergebnis: TFRM_wahlergebnis;

implementation

{$R *.dfm}

procedure parallelogramm(x,y,a,b,alpha,kipp: integer; farbe: TColor);
var hb,p,q,ha : integer;
begin
  with FRM_wahlergebnis.IMG_anzeige.Canvas do
    begin
      hb := round(b*sin(pi*(alpha+kipp)/180));
      p := round(sqrt(sqr(b)-sqr(hb)));
      ha := round(a*sin(pi*kipp/180));
      q := round(sqrt(sqr(a)-sqr(ha)));
      brush.Color := farbe;
      Polygon([Point(x,y),Point(x+p,y-hb),Point(x+p+q,y-hb-ha),Point(x+q,y-ha)]);
      //moveto(x,y);
      //lineto(x+p,y-hb);
      //lineto(x+p+q,y-hb-ha);
      //lineto(x+q,y-ha);
      //lineto(x,y);
    end;
end;

procedure saeule(x,y,breite,hoehe,tiefe,alpha:integer; farbe:TColor);
begin
  with FRM_wahlergebnis.IMG_anzeige.Canvas do
    begin
      parallelogramm(x,y,breite,hoehe,90,0,farbe);
      parallelogramm(x,y-hoehe,breite,tiefe,alpha,0,farbe);
      parallelogramm(x+breite,y,tiefe,hoehe,90-alpha,alpha,farbe);
    end;
end;

procedure delay(msec : integer);
var merke : longint;
begin
  merke := gettickcount;
  repeat
    application.ProcessMessages
  until (gettickcount - merke)>msec;
end;


procedure wsaeule(x,y,breite,hoehe,tiefe,alpha,verz:integer;farbe:TColor);
var counter : integer;
begin
  with FRM_wahlergebnis.IMG_anzeige.Canvas do
    begin
      for counter := 1 to hoehe div 2 do
        begin
          pen.Color := clblack;
          saeule(x,y,breite,counter*2,tiefe,alpha,farbe);
          delay(verz);
          pen.Color := clwhite;
          saeule(x,y,breite,counter*2,tiefe,alpha,clwhite);
        end;
      pen.Color := clblack;
      saeule(x,y,breite,counter*2,tiefe,alpha,farbe);
    end;
end;

procedure TFRM_wahlergebnis.BTN_closeClick(Sender: TObject);
begin
  close;
end;

procedure TFRM_wahlergebnis.BTN_anzeigenClick(Sender: TObject);
var i : integer;
begin
  with IMG_anzeige.Canvas do
    begin
       parallelogramm(10,550,900,50,60,0,clblue);
       for i := 0 to 7 do
         begin
           wsaeule(20+i*115,550,70,random(300),50,60,1,clred);
         end;

    end;
end;

procedure TFRM_wahlergebnis.closeabfrage(Sender: TObject; var CanClose: Boolean);
begin
 if MessageDlg('beenden wurde gedrückt, Programm fährt runter', mtConfirmation, [mbYes, mbNo], 0) = IDNo
    then CanClose := false;
end;

end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:

 procedure TFRM_wahlergebnis.BTN_anzeigenClick(Sender: TObject);
var i, anzahldersaeule : integer;
begin
  with IMG_anzeige.Canvas do
    begin
       anzahldersaeule := 7;
       parallelogramm(10,550,900,50,60,0,clblue);
       for i := 0 to anzahldersaeule do
         begin
           wsaeule(20+i*115,550,70,random(300),50,60,1,clred);
           PRB_laden.Position := PRB_laden.Position + 10;
         {Bei jeder Zeichnung der wsaeule also 8mal wird die progressBar um 10
         {erhöt - progressBar.max ist auf 80 damit es bei Zeichenende fetig
         {geladen ist}
         end;

    end;
end;