Code-Beispiel

TGA-Bilder anzeigen und speichern ohne Bibliothek

Lizenz:	Erster Autor:	Letzte Bearbeitung:
k. A.	Sebastian	15.10.2010

Mit den Funktionen im folgenden Quelltext lassen sich unkomprimierte TGA-Bilder mit einer Farbtiefe von 24 Bit anzeigen bzw. in einen Grafikpuffer einlesen sowie speichern. Eine Bibliothek muss dazu nicht eingebunden werden.

Hinweis: Die Routinen können jedoch nur TGA-Bilder laden, die die soeben genannten Bedingungen erfüllen (unkomprimiert + 24-Bit). Wer eine universellere, dafür aber komplexere, Lösung sucht, findet hier alternative Routinen:

TGA-Bilder einfach laden und speichern

'

'  TGA loader

'  Use and abuse

'

'  Autor:  wolfman775 (freebasic.net/forum/)

'  Quelle: http://www.freebasic.net/forum/viewtopic.php?t=16642

'

'  Ueberarbeitet und mit deutschen Kommentaren versehen von

'  FreeBASIC-Portal.de (15.10.2010)

'

'  Getestet mit FreeBASIC 0.22.0 Win32 SVN 12.10.2010

'



enum tga_colormaptype

    TGA_COLORMAP_NONE = 0

    TGA_COLORMAP_PRESENT = 1

    TGA_COLORMAP_RESERVED = 2

    TGA_COLORMAP_DEVELOPER = 128

end enum



enum tga_imagetype

    TGA_NO_IMAGE = 0

    TGA_UNCOMPRESSED_COLORMAP = 1

    TGA_UNCOMPRESSED_TRUECOLOR = 2

    TGA_UNCOMPRESSED_BLACKANDWHITE = 3

    TGA_RLE_COLORMAPPED = 9

    TGA_RLE_TRUECOLOR = 10

    TGA_RLE_BLACKANDWHITE = 11

end enum



type TARGA_HEADER Field = 1

    ' Main header

    IDLen           As Byte

    ColorMapType    As Byte

    ImageType       As Byte



    ' Color table (Pallete) spec

    FirstIndex          As Short

    ColorMapLen         As Short

    ColorMapEntryLen    As Byte



    ' Image Spec

    XOrig           As Short

    YOrig           As Short

    ImageWidth      As Short

    ImageHeight     As Short

    PixelDepth      As Byte

    ImageDescriptor As Byte

end type



union pixel

    c As UlongInt

    type

        r As uByte

        g As uByte

        b As uByte

        a As uByte

    end type

end union



enum TLoadErrors

    TGA_LOADERROR_BADIMAGETYPE = 0

    TGA_LOADERROR_BADCOLORMAP = 1

    TGA_LOADERROR_BADIMAGEDESCRIPTOR = 2

    TGA_LOADERROR_BADIMAGESIZE = 3

    TGA_LOADERROR_BADIMAGEDEPTH = 4

    TGA_LOADERROR_NONE = 5

end enum





Declare Function TargaXRes (ByVal fname As String) As Integer

Declare Function TargaYRes (ByVal fname As String) As Integer

Declare Function TLoad (ByVal fname As String, ByVal t As Any Ptr = 0) As Integer

Declare Sub TSave (ByVal fname As String)







' ==========================================================================

' ---> Ab hier beginnt ein Beispiel-Code, der die Verwendung der Routinen

'     demonstriert. Er gehoert nicht zu den eigentlichen TGA-Funktionen.



Const FileName = "edersee.tga"



'Pruefung vorab, ob die Bilddatei heruntergeladen und im Arbeitsverzeichnis

'gespeichert wurde

If Dir(ExePath & "\" & FileName) = "" Then

    Print "Fehler!"

    Print

    Print "Die Bilddatei " & FileName & " wurde nicht im Verzeichnis"

    Print "  " & ExePath

    Print "gefunden."

    Print

    Print "Bitte laden Sie die Datei von der Code-Beispiel-Seite des FreeBASIC-Portals"

    Print "herunter. Sie finden das Beispiel-Bild " & chr(34) & "edersee.tga" & chr(34);

    Print " am Ende der Seite bei"

    Print "den Dateianhaengen."

    Sleep

    End 1

End If



Dim As Integer result, imgWidth, imgHeight

Dim As Any Ptr buffer



ScreenRes 640,480,24

width 80,30



color rgb(240,120,0) 'Orangene Schriftfarbe

Print "TGA-Bild anzeigen"



imgWidth = TargaXRes (FileName)

imgHeight = TargaYRes (FileName)



color &HFFFFFF 'Weisse Schrift. Dieses Mal wurde die Farbe als Hexadezimalzahl angegeben.

print " -> " & FileName & " ist " & imgWidth & "x" & imgHeight & " Pixel gross."



buffer = ImageCreate(imgWidth,imgHeight)

result = TLoad (FileName, buffer)



If result = TGA_LOADERROR_NONE Then

    Print " -> Bild erfolgreich in einen Puffer geladen."

    Put (100,140), buffer 'Bild an Stelle (x,y)=(100,140) anzeigen

    Print " -> Bild auf Bildschirm ausgegeben. "

Else

    Print " -> Fehler! Bild konnte nicht geladen werden!"

End If



color rgb(80,80,80) 'Graue Schriftfarbe

print " -> Beliebige Taste zum Beenden druecken."



'Den gesamten Bildschirminhalt zum Schluss noch als TGA speichern

'  -> Screenshot im TGA-Format

TSave (ExePath & "\screenshot.tga")



sleep

end 0



' --> Hier endet der Beispiel-Code. Es folgen ab jetzt die Funktionen, die

'     Sie zum Laden von TGA-Bildern benoetigen.

' ==========================================================================







'Breite (in Pixeln) eines TGA-Bildes ermitteln

'(Dateiname als String-Parameter uebergeben.)

Function TargaXRes (ByVal fname As String) As Integer

    Dim hdr As TARGA_HEADER

    Dim hdl As Integer = FreeFile



    Open fname For Binary As hdl

    Get #hdl, 1, hdr

    Close #hdl



    Return hdr.ImageWidth

End Function





'Hoehe (in Pixeln) eines TGA-Bildes ermitteln

'(Dateiname als String-Parameter uebergeben.)

Function TargaYRes (ByVal fname As String) As Integer

    Dim hdr As TARGA_HEADER

    Dim hdl As Integer = FreeFile



    Open fname For Binary As hdl

    Get #hdl, 1, hdr

    Close #hdl



    Return hdr.ImageHeight

End Function





'TGA-Bild entweder ...

'  - direkt auf den Bildschirm (SCREEN) zeichnen, wenn der Parameter t=0

'    ist oder ausgelassen wurde      -- oder --

'  - in einen Buffer speichern, der zuvor mit IMAGECREATE angelegt werden

'    muss und spaeter beliebig weiterverwendet werden kann.

Function TLoad (ByVal fname As String, ByVal t As Any Ptr = 0) As Integer

    Dim hndl As Integer = FreeFile

    Dim P As Pixel

    Dim hdr As TARGA_HEADER



    Open fname for Binary as #hndl



    Get #hndl,1,hdr



    If hdr.ImageType <> TGA_UNCOMPRESSED_TRUECOLOR Then

        return TGA_LOADERROR_BADIMAGETYPE  'Fehlercode zurueckgeben

    ElseIf hdr.ImageWidth < 1 or hdr.ImageHeight < 1 Then

        return TGA_LOADERROR_BADIMAGESIZE

    ElseIf hdr.PixelDepth < 24 Then

        return TGA_LOADERROR_BADIMAGEDEPTH

    ElseIf hdr.ImageDescriptor <> 0 Then

        return TGA_LOADERROR_BADIMAGEDESCRIPTOR

    Endif



    For y As Integer = hdr.ImageHeight to 1 step -1

        For x As Integer = 1 to hdr.ImageWidth

            Get #hndl,,p.r

            Get #hndl,,p.g

            Get #hndl,,p.b



            If hdr.PixelDepth = 32 Then

                Get #hndl,,p.a

            Endif



            PSet t,(x-1,y-1), p.c

        Next

    Next



    Close #hndl



    return TGA_LOADERROR_NONE

End Function





'Gesamten Bildschirm als TGA speichern

Sub TSave (ByVal fname As String)

    Dim As Integer hndl = FreeFile

    Dim As Integer xres,yres

    Dim P As Pixel

    Dim hdr As TARGA_HEADER



    'Abmessungen des Grafikfensters ermitteln (z.B. 640,480)

    ScreenInfo xres,yres



    'Header fuer die TGA-Datei definieren

    hdr.IDLen = 0

    hdr.ColorMapType = TGA_COLORMAP_NONE

    hdr.ImageType = TGA_UNCOMPRESSED_TRUECOLOR



    hdr.XOrig = 0

    hdr.YOrig = 0



    hdr.ImageWidth = xres

    hdr.ImageHeight = yres



    hdr.PixelDepth = 24

    hdr.ImageDescriptor = 0



    Open fname for Binary as #hndl

    Put #hndl,1,hdr 'Header speichern



    'Grafikfenster Pixel für Pixel mit der POINT-Funktion einlesen und

    'anschliessend die R-, G- und B-Komponenten jedes Pixels speichern.

    For y As Integer = yres-1 to 0 step -1

        For x As Integer = 0 to xres-1

            P.c = point(x,y)

            Put #hndl,,p.r

            Put #hndl,,p.g

            Put #hndl,,p.b

        Next

    Next



    Close #hndl

End Sub

Attachments zum Code-Beispiel

edersee.tga

Beispielbild edersee.tga

Sebastian

15.10.10

Zusätzliche Informationen und Funktionen

Das Code-Beispiel wurde am 15.10.2010 von Sebastian angelegt.
Die aktuellste Version wurde am 15.10.2010 von Sebastian gespeichert.

Bearbeiten

Versionen