PureBoard

Verfasst: **29.04.2005 19:05**

Hallo,

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

Für Verbesserungsvorschläge und Tips bin ich offen

Viel Spaß damit

MFG Lukaso

Verfasst: **29.04.2005 19:10**

Sieht gut aus das bild.

Verfasst: **29.04.2005 20:15**

Code: Alles auswählen

Would you Save the Created Image?

"Würden sie das erstellte Bild speichern?"

Verfasst: **29.04.2005 20:46**

wow

cooler code.
echt nützlich
sieht gut aus

weiter so

Verfasst: **29.04.2005 21:45**

Mal eine frage nach welchen bedinungen wählt das programm die buchstaben? könntest du vieleicht einbauen das man auch noch einen text einfügen kann?

Verfasst: **29.04.2005 22:16**

@zigapeda:

zigapeda hat geschrieben:Mal eine frage nach welchen bedinungen wählt das programm die buchstaben?...

Code: Alles auswählen

 new.s = Chr(Random(25) + 65)

Also zufällig irgendein Großbuchstabe (ASCII-Code 65 bis 90).

@lukaso:

Nettes Prog. Ich mag ASCII-Art

Verfasst: **29.04.2005 22:19**

zigapeda hat geschrieben:Mal eine frage nach welchen bedinungen wählt das programm die buchstaben? könntest du vieleicht einbauen das man auch noch einen text einfügen kann?

So werden die Buchstaben ausgewählt:

Code: Alles auswählen

new.s = Chr(Random(25) + 65)

Habe den Source geupdatet, kannst jetzt eigenen Text auswählen

MFG Lukaso

Edit: benny war schneller

Danke

Verfasst: **29.04.2005 22:55**

Code: Alles auswählen

new.s = Chr(Random(25) + 65)

ups hab ich nicht gesehen, hab nur den unteren teil etwas überflogen.

Verfasst: **30.04.2005 11:17**

Leo hat geschrieben:
Code: Alles auswählen
Would you Save the Created Image?
"Würden sie das erstellte Bild speichern?"

LOL, das finde ich auch komisch.
Und dann wird noch Save und Created und Image groß geschrieben

Das mit dem Would hat er zumindest geändert. Und dann dieses Denglisch ^^. Entweder Deutsch oder Englisch.

>>Want you Save the Created Image?
In Englisch:
Do you want to save the created image?
In Deutsch:
Wollen Sie das erstellte Bild speichern?

Wenn ich das Programm mit dem Debugger starte und ein Bild auswähle kommt ein Debugger Error:
Zeile 53: UseImage(image) - image object not found

Hmm... habs nochmal getestet nun gehts. Ich würde allerdings für jede Farbe einen anderen Buchstaben nehmen und nicht nur zufällig generierte.

Trotzdem ein schönes Program.

Verfasst: **30.04.2005 11:36**

DarkDragon hat geschrieben:In Englisch:
Do you want to save the created image?

"Save the created image?" würde ja reichen: "Generiertes Bild speichern?"

Er wollte bestimmt schreiben: 'Would you like to save the created image?".

DarkDragon hat geschrieben:LOL, das finde ich auch komisch.
Und dann wird noch Save und Created und Image groß geschrieben

Gibt schlimmeres. Über solche Kleinigkeiten muß man sich nicht
unbedingt auslassen - ein freundlicher Hinweis genügt doch.

PureBoard

ASCII Bildgenerator

ASCII Bildgenerator

Geil