Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
capTcha
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 28.05.2008 14:52:58 |
FUNCTION xblender ( BYVAL src AS UINTEGER, BYVAL dst AS UINTEGER, BYVAL parameter AS ANY PTR) AS UINTEGER
If dst = rgb(255, 255, 255) Then
Return src
else: return dst
end if
end function
Dim XSW as UInteger = 600
Dim XSH as UInteger = 150
screenres XSW, XSH, 24
Dim XFontSize as UInteger = 98
Dim Font50 as UByte Ptr = ImageCreate(XFontSize * 26 * 2, XFontSize, 8)
Dim TFont as UByte Ptr = ImageCreate(XFontSize, XFontSize, 8)
BLoad "font.bmp", Font50
If Font50 = 0 Then Screen 0: Print "Fehler beim laden des Bildes!": End -1
Dim PColorC as UInteger = 13
Dim PColor(PColorC) as UInteger
Dim XText(7) as UByte
Dim TColor() as UInteger
Dim XFieldID as UInteger
Dim T as Integer
Dim X as UInteger
Dim Y as UInteger
Dim XLen as UInteger
Dim ZY as Integer
Dim ZX as Integer
Dim TY as Integer
Dim TX as Integer
Dim XDir as UByte
Dim ExitApp as UByte
Dim XNum as UInteger
Dim FID as UInteger
Dim XX as Uinteger
Randomize Timer
Do
PColor(1) = RGB(255, 0, 0)
PColor(2) = RGB(0, 255, 0)
PColor(3) = RGB(255, 255, 0)
PColor(4) = RGB(0, 0, 255)
PColor(5) = RGB(255, 0, 255)
PColor(6) = RGB(0, 255, 255)
PColor(7) = RGB(200, 0, 0)
PColor(8) = RGB(0, 200, 0)
PColor(9) = RGB(200, 200, 0)
PColor(10) = RGB(0, 0, 200)
PColor(11) = RGB(200, 0, 200)
PColor(12) = RGB(0, 200, 200)
PColor(13) = RGB(200, 200, 200)
Line (0, 0)-(XSW, XSH), 0, BF
XLen = 3 + int((rnd * 3) + 1)
XFieldID = Int((rnd * XLen) + 1)
X = 0
Do
T = Int((Rnd * 255) + 1)
Select Case T
Case asc("a") to asc("z"): X += 1: XText(X) = T - 97
Case asc("A") to asc("Z"): X += 1: XText(X) = T - 39
End Select
If X >= XLen Then Exit Do
Loop
Redim TColor(XLen * 2) as UInteger
For X = 1 to XLen * 2
Do
T = Int((Rnd * PColorC) + 1)
If PColor(T) <> RGB(255, 255, 255) Then
TColor(X) = PColor(T)
PColor(T) = RGB(255, 255, 255)
Exit Do
End If
Loop
Next
For X = 1 to 300
T = Int(Rnd * XLen * 2)
TX = Int((Rnd * XSW) + 1)
TY = Int((Rnd * XSH) + 1)
For ZX = TX to TX + 12
For ZY = TY to TY + 12
PSet (ZX + Int((Rnd * 2) + 1), ZY + Int((Rnd * 2) + 1)), TColor(T)
Next
Next
Next
For X = 1 to XLen
FID = XText(X)
Line TFont, (0, 0)-(XFontSize, XFontSize), TColor(X), BF 'alles farbe
If XFieldID <> X Then
XDir = Int(Rnd * 2)
ZY = XFontSize / 4 + Int((Rnd * XFontSize / 4) + 1)
For ZX = 1 to XFontSize
If XDir = 0 Then
Line TFont, (ZX, ZY)-(ZX, XFontSize), TColor(XLen + X)
Else: Line TFont, (ZX, ZY)-(ZX, 0), TColor(XLen + X)
End If
ZY += Int(Rnd * 3) - 1
Next
End If
Put TFont, (0, 0), font50, (FID * XFontSize, 0)-((FID + 1) * XFontSize, XFontSize), AND
Put ((X - 1) * 80, 10), font50, (FID * XFontSize, 0)-((FID + 1) * XFontSize, XFontSize), or
Put ((X - 1) * 80, 10), TFont, (0, 0)-(XFontSize, XFontSize), custom, @xblender
Next
For X = 1 to 5000
T = Int(Rnd * XLen * 2)
PSet (Int((Rnd * XSW) + 1), Int((Rnd * XSH) + 1)), TColor(T)
Next
XNum += 1
If Dir("cap/", -1) = "" Then MKDir("cap/")
BSave "cap/" & Str(XNum) & ".bmp", 0
Do
sleep 100, 1
Select Case InKey()
Case ""
Case Chr(27): ExitApp = 1: Exit Do
Case else: Exit Do
End Select
Loop
If ExitApp = 1 Then Exit Do
Loop until inkey() = Chr(27)
ImageDestroy(Font50)
ImageDestroy(TFont)
screen 0
end