poste mal wieder nen kleines OpenSource Programm von mir. Hab das vor nem halben Jahr als ich noch so ein ziemlicher PB anfänger war angefangen zu Programmieren, allerdings hab ich es damals nicht geschafft. Als ich heute meine alten Sources angschaut habe und das nicht fertige Prog gefunden habe, musste ich es einfach fertigprogrammieren.
Also das Programm lädt ein Bild und füllt es mit kleinen Buchstaben die der Farbe entsprechen. Daraus entsteht ein schöner Effekt.
Am besten schauts auf großen Bildern aus.
Hier ein Beispiel: http://lukaso.org/ascii-pic.jpg
Hier der Source:
Code: Alles auswählen
; ######################################
; # Name: ASCII-Pic Generator #
; # Author: Lukas 'Lukaso' Niewalda #
; # Website: http://www.lukaso.org #
; # Kontakt: lukaso@lukaso.org #
; ######################################
; ### Options #########################
#CutomTextMode = #False ; Eigener Text ?
CustomText.s = "PUREBASIC RULZ! " ; Hier kommt der eigene Text hin
Offset = 2 ; Zwischenabstand verringern
FontID = LoadFont(1, "Arial", 6, #PB_Font_Bold) ; Schriftart und Größe
BackgroundColor = $000000 ; Hintergrundfarbe in Hex
; #####################################
Global CustomTextLength, Offset, FontID, BackgroundColor
If #CutomTextMode = #True
CustomTextLength = Len(CustomText)
Dim Text.s(CustomTextLength - 1)
For i = 1 To CustomTextLength
Text(i-1) = Mid(CustomText, i, 1)
Next
EndIf
Procedure GetColorArea(image, startx, endx, starty, endy)
For X2 = 1 To endx - startx
For y2 = 1 To endy - starty
clr = Point(startx + X2, starty + y2)
num + 1
red + Red(clr)
green + Green(clr)
blue + Blue(clr)
Next
Next
red = red / num
green = green / num
blue = blue / num
FrontColor(red, green, blue)
EndProcedure
Procedure GetTextHeight(hdc) ; <-- Procedure by GPI
tm.textmetric
PrevMapMode = SetMapMode_(hdc, #mm_text)
gettextmetrics_(hdc, tm)
If prevmapmode
setmapmode_(hdc, prevmapmode)
EndIf
ProcedureReturn tm\tmHeight
EndProcedure
Procedure ASCII_Filter(image)
If IsImage(image)
UseImage(image)
Width = ImageWidth()
Height = ImageHeight()
CreateImage(2, Width, Height)
hdc = StartDrawing(ImageOutput())
BackColor(Red(BackgroundColor), Green(BackgroundColor), Blue(BackgroundColor))
DrawingFont(FontID)
space = GetTextHeight(hdc) - Offset
DrawImage(UseImage(image), 0, 0)
Repeat
text.s = ""
Repeat
If #CutomTextMode = #True
If TextPosition > CustomTextLength - 1
TextPosition = 0
EndIf
new.s = Text(TextPosition)
TextPosition + 1
Else
new.s = Chr(Random(25) + 65)
EndIf
GetColorArea(1, TextLength(text), TextLength(text) + TextLength(new), y * space, y * space + space)
Locate(TextLength(text), y * space - 2)
DrawText(new)
text = text + new
Until TextLength(text) >= Width
y + 1
If #CutomTextMode = #True
TextPosition = Random(CustomTextLength - 1)
EndIf
Until y * space >= Height
StopDrawing()
HideGadget(0, 1)
ResizeWindow(Width, Height)
HideGadget(1, 0)
SetGadgetState(1, UseImage(2))
Delay(1000)
Select MessageRequester("Save Image", "Do you want to save the created image?", #MB_YESNO)
Case #IDYES
savefile$ = SaveFileRequester("Save image","ascii-pic.bmp","Bitmap|*.bmp", 0)
If savefile$
If Mid(savefile$, Len(savefile$) - 3, 4) <> ".bmp"
savefile$ = savefile$ + ".bmp"
EndIf
If FileSize(savefile$) > 0
DeleteFile(savefile$)
EndIf
SaveImage(2, savefile$, #PB_ImagePlugin_BMP)
EndIf
EndSelect
Else
MessageRequester("Error", "Image not loaded successful!")
End
EndIf
EndProcedure
UseJPEGImageDecoder()
UsePNGImageDecoder()
FileName$ = OpenFileRequester("Open image","","Images|*.bmp;*.jpg;*.jpeg;*.png", 0)
If FileName$
LoadImage(1, FileName$)
If OpenWindow(0, 0, 0, 200, 19, #PB_Window_SystemMenu | #PB_Window_TitleBar , "|ASCII-Pic Generator| by Lukaso")
If CreateGadgetList(WindowID())
TextGadget(0, 2, 2, 196, 15, "Generating image")
ImageGadget(1, 0, 0, 0, 0, 0)
HideGadget(1, 1)
EndIf
EndIf
CreateThread(@ASCII_Filter(), 1)
Repeat
Delay(20)
Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
End
Viel Spaß damit
MFG Lukaso
