Also wer will:
Hier ist mal der Sourcecode für das englische Program:
Mir ist klar dass man es noch optimieren usw.. kann ,war eher mal zu Testzwecken gedacht:
Code: Alles auswählen
UseJPEGImageDecoder()
UsePNGImageDecoder()
Structure Buchstaben
P.b[104]
EndStructure
Dim A.Buchstaben(255)
LoadFont(20,"Lucida Console",10)
Enumeration
#Window_0
EndEnumeration
;
Enumeration
#ProgressBar_0
#Button_0
#Image_0
#TrackBar_0
#Text_0
#Text_1
#Text_2
#Text_3
#Button_1
#Button_2
#Button_3
#Button_5
EndEnumeration
Procedure.s GetCurDirectory()
DefType.l ptrBuffer, lngLen
ptrBuffer = AllocateMemory(#MAX_PATH)
lngLen = GetCurrentDirectory_(#MAX_PATH, ptrBuffer)
If Right(PeekS(ptrBuffer, lngLen), 1) <> "\"
PokeS(ptrBuffer+lngLen, "\"): lngLen+1
EndIf
ProcedureReturn PeekS(ptrBuffer, lngLen)
EndProcedure
Procedure InitLetters()
CreateImage(5,8,13)
StartDrawing(ImageOutput())
For i = 1 To 255
Box(0,0,8,13,RGB(255,255,255))
DrawingFont(UseFont(20))
Locate(0,0)
DrawText(Chr(i))
For s=0 To 103
x=s%8
y=Round(s/8,0)
If Point(x,y)=0
A(i)\P[s]=1
Else
A(i)\P[s]=0
EndIf
Next
;CallDebugger
Next
StopDrawing()
EndProcedure
Procedure.s MakeAscii(ImageID,Tolleranz)
UseImage(ImageID)
W=ImageWidth()
H=ImageHeight()
Ende=W*H/103
;MessageRequester("Durchgänge","Es werden um die "+Str()+" Durchgänge benötigt")
Start=ElapsedMilliseconds()
B.Buchstaben
StartDrawing(ImageOutput())
For y1 = 0 To H Step 13
For x1= 0 To W Step 8
For s=0 To 103
x=s%8
y=Round(s/8,0)
Col=Point(x+x1,y+y1)
If Red(Col)+Green(Col)+Blue(Col)>Tolleranz
B\P[s]=0 ;weiß
Else
B\P[s]=1 ;schwarz
EndIf
Next
AltSame=-1
Char=0
For k = 1 To 255
Same=0
For u=0 To 103
If B\P[u]=A(k)\P[u]
Same+1
EndIf
Next
If Same > AltSame
AltSame=Same
Char=k
EndIf
Next
String.s+Chr(Char)
Durch+1
If Durch%20 = 5
SetGadgetState(#ProgressBar_0,Round((Durch/Ende)*100,0))
SetGadgetText(#Text_3,Str(Durch)+" of "+Str(Ende)+" loops "+Str(Round((Durch/Ende)*100,0))+" %")
WindowEvent()
EndIf
Next
String.s+Chr(13)+Chr(10)
Next
StopDrawing()
Beep_(100,100)
SetGadgetState(#ProgressBar_0,Ende/Durch*100)
SetGadgetText(#Text_3,"Finished")
ProcedureReturn String.s
EndProcedure
Procedure Window()
If OpenWindow(#Window_0, 542, 196, 382, 423, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar , "Image-ASCII Converter")
If CreateGadgetList(WindowID())
ProgressBarGadget(#ProgressBar_0, 3, 393, 279, 24, 0, 100)
TextGadget(#Text_3, 3, 312, 279, 13, "0%",#PB_Text_Center)
ButtonGadget(#Button_0, 291, 393, 84, 24, "Create ASCII")
CreateImage(7,285, 273)
StartDrawing(ImageOutput())
Box(0,0,285,273,$FFFFFF)
Locate(285/2-TextLength("Please load an image...")/2,120)
DrawText("Please load an image...")
StopDrawing()
ImageGadget(#Image_0, 3, 30, 285, 273, UseImage(7), #PB_Image_Border )
TrackBarGadget(#TrackBar_0, 297, 21, 30, 294, 0, 733, #PB_TrackBar_Vertical)
SetGadgetState(#TrackBar_0,733/2)
TextGadget(#Text_0, 327, 27, 51, 27, "dark")
TextGadget(#Text_1, 327, 294, 54, 21, "light")
TextGadget(#Text_2, 3, 3, 372, 18, "Here you can chance the black and white intesity")
ButtonGadget(#Button_1, 6, 360, 87, 27, "Load image")
ButtonGadget(#Button_2, 99, 360, 87, 27, "Save ASCII")
ButtonGadget(#Button_3, 192, 360, 87, 27, "Show ASCII")
ButtonGadget(#Button_5, 6, 330, 273, 27, "black-white-image preview")
EndIf
EndIf
EndProcedure
Procedure MakeImageBAW(Image,Tolleranz)
UseImage(Image)
w=ImageWidth()-1
h=ImageHeight()-1
StartDrawing(ImageOutput())
For x = 0 To w
For y = 0 To h
Col=Point(x,y)
If Red(Col)+Green(Col)+Blue(Col)>Tolleranz
Plot(x,y,$FFFFFF) ;weiß
Else
Plot(x,y,0) ;schwarz
EndIf
Next
Next
StopDrawing()
EndProcedure
Procedure LoadBild()
Para.s=ProgramParameter()
If Para.s
Req.s=Para.s
Else
Req.s=OpenFileRequester("Choose an image","D:\Bilder\Schöne Frauen\","Image |*.bmp;*.png;*.jpg",0)
EndIf
If Req<>""
If IsImage(6)
FreeImage(6)
EndIf
If LoadImage(6,Req.s)=0
MessageRequester("Error","The program wasn't able to load the image"+Chr(10)+"Name: "+Req.s)
ProcedureReturn 0
EndIf
Else
ProcedureReturn 0
EndIf
ProcedureReturn 1
EndProcedure
Procedure SaveASCII(String.s,Pfad.s)
If CreateFile(17,Pfad.s)=0
MessageRequester("Error","It wasn't possible to create a Cout-File."+Chr(10)+Pfad.s)
ProcedureReturn
EndIf
WriteString(String.s)
CloseFile(17)
EndProcedure
Procedure Eventloop()
Repeat ; Start of the event loop
Event = WaitWindowEvent() ; This line waits until an event is received from Windows
WindowID = EventWindowID() ; The Window where the event is generated, can be used in the gadget procedures
GadgetID = EventGadgetID() ; Is it a gadget event?
EventType = EventType() ; The event type
;You can place code here, and use the result as parameters for the procedures
If Event = #PB_EventGadget
If GadgetID = #ProgressBar_0
ElseIf GadgetID = #Button_0;erstellen
If IsImage(6)
String.s=MakeAscii(6,GetGadgetState(#TrackBar_0))
Else
MessageRequester("Error","You have to load an image first.")
EndIf
;MessageRequester("",String.s)
ElseIf GadgetID = #Button_1;laden
If LoadBild()
UseImage(7)
StartDrawing(ImageOutput())
DrawImage(UseImage(6),0,0,285, 273)
StopDrawing()
MakeImageBAW(7,GetGadgetState(#TrackBar_0))
SetGadgetState(#Image_0,UseImage(7))
EndIf
ElseIf GadgetID = #Button_5
If IsImage(6)=0
MessageRequester("Error","You have to load an image first.")
Else
UseImage(7)
StartDrawing(ImageOutput())
DrawImage(UseImage(6),0,0,285, 273)
StopDrawing()
MakeImageBAW(7,GetGadgetState(#TrackBar_0))
SetGadgetState(#Image_0,UseImage(7))
EndIf
ElseIf GadgetID = #Button_2;speichern
If String.s=""
MessageRequester("Error","You have to create ASCII first.")
Else
Wo.s=SaveFileRequester("Saverequester",GetCurDirectory(),"Text|*.txt",0)
If Wo.s
SaveASCII(String.s,Wo.s)
EndIf
EndIf
ElseIf GadgetID = #Button_3;sehen
If String.s=""
MessageRequester("Error","You have to create ASCII first.")
Else
Name.s=GetCurDirectory()+"Ascii-Cout.txt"
SaveASCII(String.s,Name.s)
RunProgram("notepad.exe",Name.s,"")
EndIf
EndIf
EndIf
Until Event = #PB_Event_CloseWindow ; End of the event loop
End
EndProcedure
InitLetters()
Window()
Eventloop()