Buchempfehlung
Visual Basic 6 Kochbuch
Visual Basic 6 Kochbuch
Viele praktische Tipps zum Programmieren mit Visual Basic 6, die sich oft auch auf FB übertragen lassen. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Grafik und Fonts

PPM-Bild in Array laden und anzeigen

Lizenz:Erster Autor:Letzte Bearbeitung:
GPLv3MitgliedXelaS 26.02.2011

Der Quellcode lädt ein PPM-Bild mit binären Bilddaten in ein Array und zeigt dieses an.

#include "file.bi"

declare function ppmload (filename as string) as integer
declare sub ppmdisplay ()

'Deklareaktionen fürs Bild
dim shared as ubyte colors(1 to 1024,1 to 768,3)
dim shared as integer picbreite,pichoehe,ppmthere
dim as integer bildschirmbreite, bildschirmhoehe

'Funktion zum Einlesen des PPM-Bildes in Array
function ppmload (filename as string) as integer
    print
    'Deklarationen für das Hintergrundbild
    dim as integer byt,y,x,i,f
    dim as ubyte testbyte,testbyte2,count
    dim as string pictest

    'Beim Einlesen werden binäre Bilddaten vorausgesetzt
    if FILEEXISTS(filename) then
        f=freefile
        open filename for input as #f
        input #f, pictest
        input #f, pictest
        'Wenn sich in der Datei ein Kommentar befindet (von # eingeleitet),
        'wird eine Linie übersprungen
        If mid(pictest,1,1)="#" then
            input #f, pictest
        end if

        picbreite=valint(pictest)

        'Das Puffer-Array puffert die Bilddaten einer Zeile (3 Bytes pro Pixel)
        dim as ubyte puffer(picbreite*3)

        pichoehe= valint(mid(pictest,instr(pictest," ")))
        input #f, pictest
        close #f

        'Nachdem im Input-Modus die Bildhoehe und -breite erfasst wurden, wird der Anfang der Binaerdaten festgestellt
        f=freefile
        open filename for binary as #f
        y=0
        do
            y=y+1
            get #f,y,testbyte
            get #f,y+1,testbyte2


            'falls das newline-Zeichen (10) gefunden wurde und sich danach kein Kommentar
            'befindet (Raute, 35) wird dies registriert, nach 3 richtigen Zeilen, beginnen die
            'Bilddaten
            If testbyte=10 and testbyte2<>35 then count=count+1
            If count=3 then exit do
        loop until count=3
        byt=y+1
        'byt... Nummer des 1. Bytes mit RGB-Farbinformationen
        y=0

        'die Bilddaten werden eingelesen
        locate 15
        for y=1 to pichoehe

               ' print "x=";x
               x=1
                'das Puffer-Array fasst die Bilddaten einer Zeile
                get #f,(x-1)*3+byt+(y-1)*picbreite*3,puffer()

                'Die einzelnen RGB-Werte werden dem Puffer entnommen
                for i=0 to picbreite-1
                    colors(x+i,y,0)=puffer(0+i*3)
                    colors(x+i,y,1)=puffer(1+i*3)
                    colors(x+i,y,2)=puffer(2+i*3)
                next
              '  get #f,x*3+13+(y-1)*breite*3,red,1
               ' get #f,x*3+14+(y-1)*breite*3,green,1
                'get #f,x*3+15+(y-1)*breite*3,blue,1
        next
        close #f
        return 1
    else
        'Falls kein Bild existieren sollte, wird alles auf Weiß gesetzt
        for y=1 to pichoehe
            for x=1 to picbreite
                colors(x,y,0)=255
                colors(x,y,1)=255
                colors(x,y,2)=255
            next
        next
        return 0
    end if
end function

sub ppmdisplay()
    dim as integer x,y
    for y=1 to pichoehe
        for x=1 to picbreite
            pset(x-1,y-1),RGB(colors(x,y,0),colors(x,y,1),colors(x,y,2))
        next
        if frac(y/40)=1 then sleep 40
    next
end sub

'Vollbild bei 1024*768-Auflösung
screeninfo bildschirmbreite, bildschirmhoehe,,,,,
If bildschirmbreite=1024 and bildschirmhoehe=768 then
    screen 20,32,,&H01
else
    screen 20,32
end if

if ppmload("bild.ppm") then
    print "Bild erfolgreich geladen."
    Print "Druecken Sie eine Taste zum Anzeigen des Bildes"
    sleep
    ppmdisplay
else
    Print "Kein Bild geladen."
end if
Print "Druecken Sie eine Taste zum Beenden"
sleep


Zusätzliche Informationen und Funktionen
  • Das Code-Beispiel wurde am 26.02.2011 von MitgliedXelaS angelegt.
  • Die aktuellste Version wurde am 26.02.2011 von MitgliedXelaS gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen