Bild Rasterer

Übersicht

BlitzBasic

Codearchiv

	Kabelbinder Sieger des WM-Contest 2006 Betreff: Bild Rasterer	Mo, Feb 07, 2005 19:40 Antworten mit Zitat
Ich weiß nicht, ob es sowas hier schon gibt. Ich habe mal ein Prgramm gemacht, das in Bildern jeden Zweiten Pixel auf druchsichtig setzt, dadurch sehen die Bilder halb durchsichtig aus. Im Fenstermodus wirk das ziemlich realistisch, im Vollbildmodus mit 640,480 allerdings.... Naja. Code: [AUSKLAPPEN] [EINKLAPPEN] AppTitle "Bild Rasterer" Graphics 640,480,16,2 ClsColor 255,100,50 Cls path$ = Input("Name des Bildes : ") bild = LoadImage(path$ +".bmp") If bild = 0 Then Cls Locate 0,0 Print "Das Bild konnte leider nicht geladen werden :-( ." WaitKey End EndIf MaskImage bild,255,0,255 MidHandle bild breit = ImageWidth(bild) hoch = ImageHeight(bild) DrawImage bild,320,240 WaitKey() raster = CopyImage(bild) SetBuffer ImageBuffer(raster) Color 255,0,255 For i = 0 To breit Step 2 For j = 0 To hoch If j Mod 2 = 0 Then Plot i,j Else Plot i+1,j EndIf Next Next Color 0,0,0 SetBuffer FrontBuffer() Cls DrawBlock raster,320,240 WaitKey Cls DrawImage raster,320,240 WaitKey Repeat Cls Locate 0,0 out$ = Input("Speichern? [j/n] : ") Until out$ = "j" Or out$ = "n" If out = "j" Then save = SaveImage(raster,path$ + "_r.bmp") Cls Locate 0,0 If save = 1 Then Print "Bild erfolgreich gespeichert!" Else Print "Bild konnte aus unerfindlichen Gründen nicht gespeichert werden." EndIf WaitKey End
<Wing Avenger Download> ◊◊◊ <Macrophage Download>

Kabelbinder

Sieger des WM-Contest 2006

Betreff: Bild Rasterer

Mo, Feb 07, 2005 19:40
Antworten mit Zitat

Ich weiß nicht, ob es sowas hier schon gibt. Ich habe mal ein Prgramm gemacht, das in Bildern jeden Zweiten Pixel auf druchsichtig setzt, dadurch sehen die Bilder halb durchsichtig aus. Im Fenstermodus wirk das ziemlich realistisch, im Vollbildmodus mit 640,480 allerdings.... Naja.

Code: [AUSKLAPPEN]

AppTitle "Bild Rasterer"
Graphics 640,480,16,2
ClsColor 255,100,50
Cls

path$ = Input("Name des Bildes : ")
bild = LoadImage(path$ +".bmp")

If bild = 0 Then
Cls
Locate 0,0
Print "Das Bild konnte leider nicht geladen werden :-( ."
WaitKey
End
EndIf

MaskImage bild,255,0,255
MidHandle bild

breit = ImageWidth(bild)
hoch = ImageHeight(bild)

DrawImage bild,320,240

WaitKey()
raster = CopyImage(bild)
SetBuffer ImageBuffer(raster)
Color 255,0,255
For i = 0 To breit Step 2
For j = 0 To hoch
If j Mod 2 = 0 Then
Plot i,j
Else
Plot i+1,j
EndIf
Next
Next

Color 0,0,0
SetBuffer FrontBuffer()
Cls
DrawBlock raster,320,240
WaitKey
Cls
DrawImage raster,320,240
WaitKey
Repeat
Cls
Locate 0,0
out$ = Input("Speichern? [j/n] : ")
Until out$ = "j" Or out$ = "n"

If out = "j" Then save = SaveImage(raster,path$ + "_r.bmp")

Cls
Locate 0,0
If save = 1 Then
Print "Bild erfolgreich gespeichert!"
Else
Print "Bild konnte aus unerfindlichen Gründen nicht gespeichert werden."
EndIf

WaitKey
End