XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Grafik: Farbverläufe mit der Grafik.inc erstellen
Von Timo Schnitzer
Erstellen von Farbverläufen
Befehle : Message,DrawColorsSlow,AddColors,DrawColors,DeleteColors
Message:              Bei Fehlern ist GError% = 1
1. Par              : Bei Fehlern Messagebox (0 = Nein,Ja voreingestellt)
DrawColorsSlow
1.Par               : Bei 0 wird der Farbverlauf erst aufgebaut, und dann gezeigt. Wenn der 1. Par ungleich 0 ist gibt er an, wieviele Millisekunden pro Pixel gewartet wird (1 voreingestellt).
AddColor
1. Par              : Hinzuzufügende Farbe (max. 21 aufeinmal)
DrawColors
1. Par              : Fenster auf das gezeichnet wird
2. Par - 5. Par     : Koordinaten und Länge des Rechtecks, in dem gezeichnet wird
EditColors
1. Par              : Bei 1 wird bei DrawColors noch nicht sofort gezeichnet, sondern kann bearbeitet werden. Dabei hat das Bild die in DrawColors angegebene Länge, und befindet sich an Position 0,0. Wenn dieser Befehl wieder mit 0 ausgeführt wird, wird das Ergebnis gezeichnet. Dieser Befehle kann nur mit DrawColorsSlow 0 eingesetzt werden.
SetColorsTransp
1. Par              : Bei 1 wird Transparent gezeichnet. Dieser Befehle kann nur mit DrawColorsSlow 0 eingesetzt werden.
DeleteColors
0 Par               : Löscht die eingegebenen Farben
Def Deg2Rad(1) (Pi() * !(1)) / 180
 $I Grafik.inc
WindowStyle 56 + 504
Windowtitle Farbverläufe mit der Grafik.inc von Timo Schnitzer
Window 0,0 - 700,525
Cls
AddColor Rgb(255,255,255)
AddColor Rgb(255,255,0)
AddColor Rgb(0,255,255)
AddColor Rgb(255,0,255)
AddColor Rgb(0,255,0)
AddColor Rgb(0,0,255)
AddColor Rgb(255,0,0)
AddColor Rgb(0,0,0)
DrawColorsSlow 0
DrawColors %HWnd,0,0,Width(%HWnd),Height(%HWnd)
DeleteColors
AddColor Rgb(0,0,0)
AddColor Rgb(255,0,0)
AddColor Rgb(0,0,255)
AddColor Rgb(0,255,0)
AddColor Rgb(255,0,255)
AddColor Rgb(0,255,255)
AddColor Rgb(255,255,0)
AddColor Rgb(255,255,255)
DrawColorsSlow 20
DrawColors %HWnd,10,10,100,100
DrawColorsSlow 10
DrawColors %HWnd,120,10,100,200
DrawColorsSlow 1
DrawColors %HWnd,240,10,400,400
DeleteColors
SetText %HWnd,GetText$(%HWnd) +  - Please make an input!

PROC Draw5Eck

    Parameters aaa&,bbb&,ccc&,ddd&,eee&,fff&,ggg&,hhh&
    EditColors 1
    DrawColors %HWnd,eee&,fff&,ggg&,hhh&
    Declare x1&,y1&,x2&,y2&,x3&,y3&,Grad!
    x1& = aaa&
    y1& = bbb&
    x2& = ccc&
    y2& = ddd&
    x3& = (x2&-x1&) / 2
    y3& = (y2&-y1&) / 2
    declare x&[4],y&[4]
    UsePen 0,1,Rgb(255,255,255)
    Grad! = 72*0+90
    x&[0] = Int(x1& + x3& + (x3& * Cos(Deg2Rad(-Grad!))))
    y&[0] = Int(y1& + y3& + (y3& * Sin(Deg2Rad(-Grad!))))
    Grad! = 72*1+90
    x&[1] = Int(x1& + x3& + (x3& * Cos(Deg2Rad(-Grad!))))
    y&[1] = Int(y1& + y3& + (y3& * Sin(Deg2Rad(-Grad!))))
    Grad! = 72*2+90
    x&[2] = Int(x1& + x3& + (x3& * Cos(Deg2Rad(-Grad!))))
    y&[2] = Int(y1& + y3& + (y3& * Sin(Deg2Rad(-Grad!))))
    Grad! = 72*3+90
    x&[3] = Int(x1& + x3& + (x3& * Cos(Deg2Rad(-Grad!))))
    y&[3] = Int(y1& + y3& + (y3& * Sin(Deg2Rad(-Grad!))))
    Grad! = 72*4+90
    x&[4] = Int(x1& + x3& + (x3& * Cos(Deg2Rad(-Grad!))))
    y&[4] = Int(y1& + y3& + (y3& * Sin(Deg2Rad(-Grad!))))
    Grad! = if(hhh& < 201,0.389,0.3855)
    Grad! = if(hhh& = 100,0.395,Grad!)
    Line x&[0],y&[0] - (x&[0] + (x&[2]-x&[0]) * Grad!),y&[0] + (y&[2]-y&[0]) * Grad!
    Line x&[2],y&[2] - (x&[2] - (x&[2]-x&[0]) * Grad!),y&[2] - (y&[2]-y&[0]) * Grad!
    Line x&[2],y&[2] - (x&[2] - (x&[2]-x&[4]) * Grad!),y&[2] - (y&[2]-y&[4]) * Grad!
    Line x&[4],y&[4] - (x&[4] + (x&[2]-x&[4]) * Grad!),y&[4] + (y&[2]-y&[4]) * Grad!
    Line x&[4],y&[4] - (x&[4] + (x&[1]-x&[4]) * Grad!),y&[4] + (y&[1]-y&[4]) * Grad!
    Line x&[1],y&[1] - (x&[1] - (x&[1]-x&[4]) * Grad!),y&[1] - (y&[1]-y&[4]) * Grad!
    Line x&[1],y&[1] - (x&[1] - (x&[1]-x&[3]) * Grad!),y&[1] - (y&[1]-y&[3]) * Grad!
    Line x&[3],y&[3] - (x&[3] + (x&[1]-x&[3]) * Grad!),y&[3] + (y&[1]-y&[3]) * Grad!
    Line x&[3],y&[3] - (x&[3] + (x&[0]-x&[3]) * Grad!),y&[3] + (y&[0]-y&[3]) * Grad!
    Line x&[0],y&[0] - (x&[0] - (x&[0]-x&[3]) * Grad!),y&[0] - (y&[0]-y&[3]) * Grad!
    UseBrush 1,Rgb(255,255,255)
    Fill 3,3,Rgb(255,255,255)
    EditColors 0

ENDPROC

Waitinput
SetFocus(%HWnd)
SetText %HWnd,Left$(GetText$(%HWnd),Len(GetText$(%HWnd)) - Len( - Please make an input!))
Cls
SetColorsTransp 1
AddColor Rgb(255,255,255)
AddColor Rgb(255,255,0)
AddColor Rgb(0,255,255)
AddColor Rgb(255,0,255)
AddColor Rgb(0,255,0)
AddColor Rgb(0,0,255)
AddColor Rgb(255,0,0)
AddColor Rgb(0,0,0)
DrawColorsSlow 0
EditColors 1
DrawColors %HWnd,170,0,500,500
UsePen 0,1,Rgb(255,255,255)
UseBrush 0,Rgb(255,255,255)
Ellipse 0,0 - 500,500
UseBrush 1,Rgb(255,255,255)
Fill 3,3,Rgb(255,255,255)
Fill 3,499,Rgb(255,255,255)
Fill 499,3,Rgb(255,255,255)
Fill 499,499,Rgb(255,255,255)
EditColors 0
Draw5Eck 0,30,500,500,170,0  ,500,500
Draw5Eck 0,25,400,400,220,50 ,400,400
Draw5Eck 0,20,300,300,270,100,300,300
Draw5Eck 0,15,200,200,320,150,200,200
Draw5Eck 0,10,100,100,370,200,100,100
DeleteColors
SetColorsTransp 0
MCls 150,50
StartPaint -1
UsePen 0,1,0
UseFont Ms Sans Serif,29,12,1,1,1
SetPixel 0,49,0
DrawText 30,5,Hallo!
SaveBmp $TempDir + JKGSIAUFFD.hjf,0,0,150,50
EndPaint
AddColor Rgb(0,255,0)
AddColor Rgb(0,0,255)
EditColors 1
DrawColors %HWnd,0,0,150,50
LoadBMP $TempDir + JKGSIAUFFD.hjf,0,0;(-1)
SetPixel 0,49,Rgb(255,255,255)
EditColors 0
DeleteColors
MCls 150,500
StartPaint -1
Cls
UsePen 0,1,0
UseFont Ms Sans Serif,29,12,1,1,0
SetPixel 0,499,0
TextColor 0,-1
DrawGText Ich bin
ein Text,
der
sehr sehr
oft
die Farbe
wechselt.
und deshalb
bin ich
der aller,
aller,
stolzeste
Text, auf
der ganzen
Welt!!!,0,2,150,500,OM
DrawGText Ich bin
ein Text,
der
sehr sehr
oft
die Farbe
wechselt.
und deshalb
bin ich
der aller,
aller,
stolzeste
Text, auf
der ganzen
Welt!!!,0,1,150,500,OM
DrawGText Ich bin
ein Text,
der
sehr sehr
oft
die Farbe
wechselt.
und deshalb
bin ich
der aller,
aller,
stolzeste
Text, auf
der ganzen
Welt!!!,0,0,150,500,OM
SaveBmp $TempDir + JKGSIAUFFD.hjf,0,0,150,500
EndPaint
AddColor Rgb(255,255,255)
AddColor Rgb(255,255,0)
AddColor Rgb(0,255,255)
AddColor Rgb(255,0,255)
AddColor Rgb(0,255,0)
AddColor Rgb(0,0,255)
AddColor Rgb(255,0,0)
AddColor Rgb(0,0,0)
EditColors 1
DrawColors %HWnd,0,50,150,500
LoadBMP $TempDir + JKGSIAUFFD.hjf,0,0;(-1)
SetPixel 0,499,Rgb(255,255,255)
EditColors 0
DeleteColors
DrawColorsSlow 0
SetColorsTransp 1
AddColor Rgb(0,221,255)
AddColor Rgb(0,50,255)
EditColors 1
DrawColors %HWnd,600,475,87,18
UseFont Times New Roman,15,6,1,0,0
TextColor Rgb(10,10,150),-1
DrawText 18,2,Beenden
SetPixel 0,0,Rgb(255,255,255)
SetPixel 0,17,Rgb(255,255,255)
SetPixel 86,0,Rgb(255,255,255)
SetPixel 86,17,Rgb(255,255,255)
SaveBmp $TempDir + JKGSIAUFFD.hjf,0,0,87,18
Cls
EditColors 0
DeleteColors
AddColor Rgb(0,50,255)
AddColor Rgb(0,221,255)
EditColors 1
DrawColors %HWnd,600,475,87,18
UseFont Times New Roman,15,6,1,0,0
TextColor Rgb(10,10,150),-1
DrawText 18,2,Beenden
SetPixel 0,0,Rgb(255,255,255)
SetPixel 0,17,Rgb(255,255,255)
SetPixel 86,0,Rgb(255,255,255)
SetPixel 86,17,Rgb(255,255,255)
SaveBmp $TempDir + JKGSIAUFFD2.hjf,0,0,87,18
Cls
EditColors 0
DeleteColors
AddColor Rgb(0,245,255)
AddColor Rgb(0,100,255)
EditColors 1
DrawColors %HWnd,600,475,87,18
UseFont Times New Roman,15,6,1,0,0
TextColor Rgb(10,10,150),-1
DrawText 18,2,Beenden
SetPixel 0,0,Rgb(255,255,255)
SetPixel 0,17,Rgb(255,255,255)
SetPixel 86,0,Rgb(255,255,255)
SetPixel 86,17,Rgb(255,255,255)
SaveBmp $TempDir + JKGSIAUFFD3.hjf,0,0,87,18
Cls
EditColors 0
declare UButton&
SetUserButOption Rgb(0,0,150),0,1
UButton& = UserButton(%HWnd,%Maxx + 600,475,87,18,$TempDir + JKGSIAUFFD.hjf,$TempDir + JKGSIAUFFD2.hjf,$TempDir + JKGSIAUFFD3.hjf)
Sleep 100
SetWindowPos UButton& = 600,470 - 87,18;0
declare f%

Whilenot GetFocus(UButton&)

    Waitinput

Wend

DestroyWindow(UButton&)
Assign #1,$TempDir + JKGSIAUFFD.hjf
Erase #1
Assign #1,$TempDir + JKGSIAUFFD2.hjf
Erase #1
Assign #1,$TempDir + JKGSIAUFFD3.hjf
Erase #1
end