XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Säulendiagramme erstellen
Von Timo Schnitzer
Erstellen von Säulendiagrammen
Befehle : Message,Init,Erstelle,Next,Zeige,Achse,UuseGFont,Deinit
Message:              Bei Fehlern ist GError% = 1
1. Par              : Bei Fehlern Messagebox (0 = Nein,Ja voreingestellt)
Achse:
1. Par              : Bei jeweils wieviel Prozent eine Markierung
2. Par              : Zahl die jeweils an die Höhe der Markierung angepasst wird
3. Par              : String der Hinten angehangen wird
UseGFont:
1. Par              : FontName
2. Par              : Zeichenhöhe   (Keine 0)
3. Par              : Zeichenbreite (Keine 0)
4. Par              : Fett?
5. Par              : Kursiv?
6. Par              : Unterstrichen?
Init:
1. Par              : X Wert des Koordinatenursprungs
2. Par              : Y Wert des Koordinatenursprungs
3. Par              : Länge der X-Achse
4. Par              : Höhe der Y-Achse
5. Par              : Länge des 3D Bereichs
6. Par              : AbStand der Seulen
7. Par              : Abstand oben  (z.B. Saülen über 100%)
8. Par              : Abstand links (z.B. Achsenbeschriftung)
Erstelle:
1. Par              : Höhe der Seule im Verhältnis zu Y-Achse (in Prozent)
2. Par              : Beginn der Seule von Boden aus, kann auch als Feinjustierung der Seule genutzt werden
3. Par              : Länge  der Seule
4. Par              : Farbe  der Seule (Achtung, nie pures Schwarz, sondern nur z.B. Rgb(1,0,0)
5. Par              : Transparenz (1 = Ja)
6. Par              : Schrift in der Seule
Next:
0 Par
Zeige:
1. Par              : Handle des Fenster auf dem gezeichnet werden soll
2. Par              : KopierModus
Deinit:
0  Par
 $I Grafik.inc
WindowStyle 24
Windowtitle Säulendiagramme mit der Grafik.inc von Timo Schnitzer
Window 0,0 - 600,400

Whileloop 30

    INIT Säulendiagramm,50,250,450,110,30,50,100,50
    ACHSE 20,20,%
    ERSTELLE 40 - &Loop ,0,15        ,Rgb(255,0,0)      ,1,H
    ERSTELLE 30         ,0,15        ,Rgb(0,255,0)      ,0,C
    ERSTELLE 15 + &Loop ,0,15        ,Rgb(0,0,255)      ,1,I
    NEXT
    ERSTELLE 25         ,0,35+&Loop/4,Rgb(0,0,255)      ,1,E
    ERSTELLE 25         ,0,35        ,Rgb(0,0,255)      ,1,G
    ERSTELLE 25         ,0,35-&Loop/4,Rgb(0,0,255)      ,1,A
    ERSTELLE 15         ,0,35-&Loop/2,Rgb(0,0,255)      ,1,S
    NEXT
    NEXT
    NEXT
    ERSTELLE 25         ,0,50        ,Rgb(0,255,0)      ,0,Hallo
    ERSTELLE 50         ,0,50        ,Rgb(0,255,&Loop*7),0,Hallo
    ERSTELLE 25         ,0,50        ,Rgb(0,255,0)      ,0,Hallo
    NEXT
    NEXT
    ERSTELLE 130 - &Loop,0,20        ,Rgb(0,255,0)      ,0,!!
    !!
    !!
    !!
    ZEIGE %HWnd,0
    DEINIT

Wend

Whileloop 30,0,-1

    INIT Säulendiagramm,50,250,450,110,&Loop,50,0,50
    ACHSE 20,20,%
    ERSTELLE 40 - &Loop,0,15        ,Rgb(255,0,0)      ,1,H
    ERSTELLE 30        ,0,15        ,Rgb(0,255,0)      ,0,C
    ERSTELLE 15 + &Loop,0,15        ,Rgb(0,0,255)      ,1,I
    NEXT
    ERSTELLE 25        ,0,35+&Loop/4,Rgb(0,0,255)      ,1,E
    ERSTELLE 25        ,0,35        ,Rgb(0,0,255)      ,1,G
    ERSTELLE 25        ,0,35-&Loop/4,Rgb(0,0,255)      ,1,A
    ERSTELLE 15        ,0,35-&Loop/2,Rgb(0,0,255)      ,1,S
    NEXT
    NEXT
    NEXT
    ERSTELLE 25        ,0,50        ,Rgb(0,255,0)      ,0,Hallo
    ERSTELLE 50        ,0,50        ,Rgb(0,255,&Loop*7),0,Hallo
    ERSTELLE 25        ,0,50        ,Rgb(0,255,0)      ,0,Hallo
    NEXT
    NEXT
    ERSTELLE 100       ,0,20        ,Rgb(0,255,0)      ,0,!!
    !!
    !!
    !!
    ZEIGE %HWnd,0
    DEINIT

Wend

Whileloop 50

    INIT Säulendiagramm,50,250,450,110,0,50,0,50
    ACHSE 20,20,%
    ERSTELLE 40  - &Loop/1.25  ,0,15,Rgb(255,0,0)      ,1,
    ERSTELLE 30  - &Loop/(5/3) ,0,15,Rgb(0,255,0)      ,0,
    ERSTELLE 15  - &Loop/(10/3),0,15,Rgb(0,0,255)      ,1,
    NEXT
    ERSTELLE 25  - &Loop/2     ,0,35,Rgb(0,0,255)      ,1,
    ERSTELLE 25  - &Loop/2     ,0,35,Rgb(0,0,255)      ,1,
    ERSTELLE 25  - &Loop/2     ,0,35,Rgb(0,0,255)      ,1,
    ERSTELLE 15  - &Loop/(10/3),0,35,Rgb(0,0,255)      ,1,
    NEXT
    NEXT
    NEXT
    ERSTELLE 25  - &Loop/2     ,0,50,Rgb(0,255,0)      ,0,
    ERSTELLE 50  - &Loop       ,0,50,Rgb(0,255,&Loop*7),0,
    ERSTELLE 25  - &Loop/2     ,0,50,Rgb(0,255,0)      ,0,
    NEXT
    NEXT
    ERSTELLE 100 - &Loop*2     ,0,20,Rgb(0,255,0)      ,0,
    ZEIGE %HWnd,0
    DEINIT

Wend

Cls

Whileloop 30

    INIT Säulendiagramm,50-&Loop*(4/3),250,450+&Loop*(8/3),110 + &Loop*2,&Loop,50,20,30 Zum überdecken des Alten
    ZEIGE %HWnd,0
    DEINIT

Wend

DrawText 5,0,Please Click!

Whileloop 50

    INIT Säulendiagramm,10,250,570,170,30,50,5,0
    NEXT
    ERSTELLE &Loop/5     ,0          ,375,Rgb(122,255,255)  ,0,
    ERSTELLE &Loop/1.8   ,(375-295)/2,295,Rgb(255,0,0)      ,1,
    ERSTELLE &Loop/(8/3) ,(295-245)/2,245,Rgb(0,255,0)      ,0,
    ERSTELLE &Loop/(10/3),(245-175)/2,175,Rgb(0,0,255)      ,1,
    ERSTELLE &Loop/(5/3) ,(175-101)/2,101,Rgb(0,0,255)      ,1,
    ZEIGE %HWnd,0
    DEINIT
    Waitinput

Wend

DrawText 5,0,MkStr$( ,100)
declare A1%,A2%,A3%,A4%,R1%,R2%,R3%,R4%,Bew%,Bew2%
USEGFONT Courier,18,7,1,1,1

While 1

    INIT Säulendiagramm,10,250,570,170,30,50,5,0
    NEXT
    ERSTELLE 10       ,0                ,375,Rgb(122,255,255)  ,0,LO!
    ERSTELLE 50/1.8   ,(375-295)/2 + A1%,295,Rgb(255,0,0)      ,1,LL
    ERSTELLE 50/(8/3) ,(295-245)/2 + A2%,245,Rgb(0,255,0)      ,0,AL
    ERSTELLE 50/(10/3),(245-175)/2 + A3%,175,Rgb(0,0,255)      ,1,HA
    ERSTELLE 50/(5/3) ,(175-101)/2 + A4%,101,Rgb(0,0,255)      ,1,H
    ZEIGE %HWnd,0
    DEINIT
    Case    R1% : inc A1%
    Case    R2% : inc A2%
    Case    R3% : inc A3%
    Case    R4% : inc A4%
    Casenot R1% : dec A1%
    Casenot R2% : dec A2%
    Casenot R3% : dec A3%
    Casenot R4% : dec A4%
    Case (375-295)/2 + A1% = 0 : R1% = 1
    Case (295-245)/2 + A2% = 0 : R2% = 1
    Case (245-175)/2 + A3% = 0 : R3% = 1
    Case (175-101)/2 + A4% = 0 : R4% = 1
    Case (375-295)/2 = A1%     : R1% = 0
    Case (295-245)/2 = A2%     : R2% = 0
    Case (245-175)/2 = A3%     : R3% = 0
    Case (175-101)/2 = A4%     : R4% = 0

Wend

Waitinput
end