fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
Bitmaploader für 24-Bit-Bitmaps [veraltet!]

Uploader:	Sebastian
Datum/Zeit:	12.01.2008 16:16:38
OPTION EXPLICIT



DECLARE FUNCTION Fill(stringvar AS STRING) AS STRING



'Bitmaploader für 24 Bit Bitmaps

'Von Sebastian Steiner, sebastian_steiner[ätt]gmx[punkt]de (17.09.2005)

'Basiert auf dem Wikipedia-Artikel zum Thema Windows-BMP

'Zu benutzen mit der FreeBasic-Version, die im September 2005 aktuell war ;-)



TYPE BMPHeaderType

fileSize AS LONG

beginOffset AS LONG

biSize AS LONG '

biWidth AS LONG '

biHeight AS LONG '

biBottomUp AS INTEGER

biPlanes AS SHORT

biBitCount AS SHORT

biCompression AS LONG

biSizeImage AS LONG

biXPixelsPerMeter AS LONG

biYPixelsPerMeter AS LONG

biClrUsed AS LONG

biClrImportant AS LONG

END TYPE



DIM Header AS BMPHeaderType

DIM Signatur AS STRING

DIM file AS STRING

DIM l AS LONG

DIM dummy AS STRING

DIM zeile AS STRING

DIM linelen AS LONG

DIM hv AS STRING

DIM y AS INTEGER

DIM x AS INTEGER

DIM xp AS INTEGER

DIM xPosition AS INTEGER

DIM yPosition AS INTEGER



Signatur=SPACE$(2)



'Bildposition auf dem Bildschirm

xPosition=0

yPosition=0



DIM red AS INTEGER

DIM green AS INTEGER

DIM blue AS INTEGER



CLS

file="winxp2.bmp"



OPEN file FOR BINARY ACCESS READ AS #1: l=LOF(1): CLOSE #1



If l<1 THEN

    PRINT "Datei ist leer oder existiert nicht.": SLEEP: END

    KILL file

END IF



OPEN file FOR BINARY ACCESS READ AS #1



GET #1,,Signatur

IF UCASE$(Signatur)<>"BM" THEN

    PRINT "BMP ungültig!"

    CLOSE:SLEEP:END

END IF



dummy=SPACE$(4)

GET #1,,Header.fileSize

GET #1,,dummy

GET #1,,Header.beginOffset

GET #1,,Header.biSize

GET #1,,Header.biWidth

GET #1,,Header.biHeight



PRINT "Aufbaurichtung: ";

IF Header.biHeight<0 THEN

    Header.biHeight=Header.biHeight*(-1)

    Header.biBottomUp = 0

    PRINT "Von oben nach unten aufbauen!"

Else

    Header.biBottomUp=1

    PRINT "Von unten nach oben aufbauen!"

End if



PRINT "Bildhöhe: "; LTRIM$(STR$(Header.biHeight))

PRINT "Bildbreite: "; LTRIM$(STR$(Header.biWidth))



GET #1,,Header.biPlanes

GET #1,,Header.biBitCount

Get #1,,Header.biCompression

GET #1,,Header.biSizeImage

GET #1,,Header.biXPixelsPerMeter

GET #1,,Header.biYPixelsPerMeter

GET #1,,Header.biClrUsed

GET #1,,Header.biClrImportant

PRINT ""

SLEEP



IF Header.biCompression>0 THEN

    PRINT "Fehler: BMP ist komprimiert. (";LTRIM$(STR$(Header.biCompression)); ")"

    CLOSE: SLEEP: END

END IF



IF Header.biBitCount <> 24 Then

    PRINT "Fehler: Kein 24Bit BMP... ("; LTRIM$(STR$(Header.biBitCount)); " Bits)"

    CLOSE: SLEEP: END

End if



screenres 640,480,32



If Header.biBottomUp=0 Then

PRINT "Unterstützung für UpDown BMPs noch nicht eingebaut..."

SLEEP:CLOSE:END

END IF



Zeile = SPACE$(Header.biWidth * 3)

IF (4 - ((Header.biWidth * 3) MOD 4)) <> 4 THEN

  Zeile = Zeile + SPACE$(4 - ((Header.biWidth * 3) MOD 4))

END IF

LineLen = LEN(Zeile)



FOR y=yPosition+Header.biHeight-1 TO yPosition STEP -1

    Zeile=SPACE$(LineLen)

    GET #1,Header.beginOffset+((Header.biHeight-y-yPosition-1)*LineLen)-1,Zeile

    FOR x=xPosition+Header.biWidth-1 TO xPosition+1 STEP -1

        xp=x*3

        blue=ASC(MID$(Zeile,xp,1))

        green=ASC(MID$(Zeile,xp+1,1))

        red=ASC(MID$(Zeile,xp+2,1))

        'hv="&H"+Fill(HEX$(red))+Fill(HEX$(green))+Fill(HEX$(blue))

        PSET (x-1,y),RGB(red, green, blue) 'VAL(hv)

    NEXT x

    IF EOF(1) THEN EXIT FOR

NEXT y



CLOSE #1



SLEEP



END





FUNCTION Fill(stringvar AS STRING) AS STRING

    If LEN(stringvar)<2 THEN

        Fill="0"+stringvar

    else

        Fill=stringvar

    End if

END FUNCTION