GIF problem. 
Author Message
 GIF problem.

I'm still having this problem I posted before and didn't get any
reaction so far. Please help me if you can. I'm already sitting five
days on this problem.

Now. The BASIC exports a corrupt GIF file. Why?

Here it comes:

DEFINT A-Z

SHARED OutBuffer$, OStartAddress, OAddress, OEndAddress, Oseg
SHARED CodeSize, CurrentBit, Charac???, BlockLength
DIM ShiftTbl(7) AS SHARED LONG
SHARED x, y, Mnx, MnY, MxX, MxY, Klaar, GIFFile, LastLoc&, TableSize

reg 1, &H13
call interrupt &H10

dac$=""
for i=1 to 768: dac$=dac$+chr$(int(rnd*254)): next i
a$=""
for i=1 to 640: a$=a$+chr$(int(rnd*254)): next i
for y=0 to 199 step 2
def seg=&HA000
poke$ y*320,a$
def seg
next y
y=0: x=0

MakeGif "mkfile1.gif", dac$, 10

SUB BufferWrite (A) ' STATIC
    IF OAddress = 5000 THEN
        PUT GIFFile, , OutBuffer$
        OAddress = 1
    END IF
    MID$(OutBuffer$, OAddress, 1) = CHR$(a)
    incr OAddress
END SUB

FUNCTION GetByte STATIC
    def seg=&HA000
    GetByte=peek(y*320+x)
    if x>-1 and x<320 and y>-1 and y<200 then poke y*320+x, 0 else beep
    def seg
    incr x
    if x>319 then
    x=0
    incr y
    if y>199 then Klaar=-1
    end if
END FUNCTION

SUB MakeGIF (A$, DAC$, dely??)
    TableSize = 7177

    SHARED Pref(), Suff(), Cod()
    DIM Pref(0 TO TableSize - 1), Suff(0 TO TableSize - 1), Cod(0 TO
TableSize - 1)

    ShiftTbl(0)=1 : ShiftTbl(1)=2
    ShiftTbl(2)=4 : ShiftTbl(3)=8
    ShiftTbl(4)=16: ShiftTbl(5)=32
    ShiftTbl(6)=64: ShiftTbl(7)=128

        ScreenX=320: ScreenY=200
        XStart=0   : YStart=0
        Xend=319   : Yend=199
        NumColors=256
        Mnx = 0  : MnY = 0
        MxX = 319: MxY = 199

    GIFFile = FREEFILE
'    kill a$
    OPEN A$ FOR BINARY AS GIFFile

    OutBuffer$ = STRING$(5000, 32)
    OAddress = 1
    OEndAddress = 5000
    OStartAddress = OAddress
    DEF SEG = Oseg

    BitsPixel = 8
    StartSize = 9
    StartCode = 256
    StartMx = 512

    ColorBits = 6

'    Header$="GIF89a"+mkwrd$(320)+mkwrd$(200)+chr$(&H07,0,0)
'    Commen$="!"+chr$(&HFE,67)+"This GIF-file is created with GIFCreator
v1.1 Beta on "+date$+"."+chr$(&H0D, &H0A, 0)
'    Aplica$="!"+chr$(&HFF,11)+"NETSCAPE2.0"+chr$(3,1,&HE8,3,0)
'    put GIFFile,,Header$
'    put GIFFile,,Commen$
'    put GIFFile,,Aplica$
' ---
'    Grapex$="!"+chr$(&HF9,4,0)+mkwrd$(dely??)+chr$(0,0)
'    Imaged$=","+mkwrd$(0)+mkwrd$(0)+mkwrd$(320)+mkwrd$(200)+chr$(&H87)
'    put GIFFile,,Grapex$
'    put GIFFile,,Imaged$
'    put GIFFile,,Dac$

    Heade1$="GIF87a"+mkwrd$(320)+mkwrd$(200)+chr$(&HD7,0,0)
    Image1$=","+mkwrd$(0)+mkwrd$(0)+mkwrd$(320)+mkwrd$(200)+chr$(&H07)
    put GIFFile,,Heade1$
    put GIFFile,,DAC$
    put GIFFile,,Image1$

    A$ = CHR$(StartSize - 1)
    PUT GIFFile, , A$

    CurrentBit = 0: Charac??? = 0

    MxCode = StartMx
    CodeSize = StartSize
    ClearCode = StartCode
    EOFCode = StartCode + 1
    StartCode = StartCode + 2
    NextCode = StartCode

    GOSUB ClearTree
    PutCode ClearCode

    x = Xstart: y = YStart
    Prefix = GetByte
    Klaar = 0

    DO

        DO

            IF Klaar=-1 THEN

                PutCode Prefix
                PutCode EOFCode

                IF CurrentBit <> 0 THEN PutCode 0
                PutByte 0

                OutBuffer$ = LEFT$(OutBuffer$, OAddress - 1)
                PUT GIFFile, , OutBuffer$

                a# = seek(GIFFile)

                A$ = ";" + string$(8,&H1A)
                PUT GIFFile,, A$

                A$ = CHR$(255 - BlockLength)
                PUT GIFFile, LastLoc&, A$

                CLOSE GIFFile
                EXIT SUB
            ELSE
                Suffix = GetByte
                GOSUB Hash
                IF Found = -1 THEN Prefix = Cod(Index)
            END IF
        LOOP WHILE Found

        PutCode Prefix

        Pref(Index) = Prefix
        Suff(Index) = Suffix
        Cod(Index) = NextCode

        Prefix = Suffix

        incr NextCode
        IF NextCode = MxCode + 1 THEN

            MxCode = MxCode * 2

            IF CodeSize = 12 THEN
                PutCode ClearCode
                GOSUB ClearTree
                NextCode = StartCode
                CodeSize = StartSize
                MxCode = StartMx

            ELSE
                incr CodeSize
            END IF
        END IF

    LOOP
ClearTree:
    FOR A = 0 TO TableSize - 1
        Pref(A) = -1
        Suff(A) = -1
        Cod(A) = -1
    NEXT
RETURN

Hash:
    Indx## = ((Prefix * 256) XOR Suffix)
    while Indx##>TableSize
        Indx##=Indx##-TableSize
        wend
    Index=Indx##

    IF Index = 0 THEN Offst = 1 ELSE Offst = TableSize - Index

    DO
        IF Cod(Index) = -1 THEN Found = 0: RETURN
        IF Pref(Index) = Prefix AND Suff(Index) = Suffix THEN Found = -1:
RETURN
        Index = Index - Offst
        IF Index < 0 THEN Index = Index + TableSize
    LOOP
END SUB

SUB PutByte (A) STATIC
    BlockLength = BlockLength - 1
    IF BlockLength <= 0 THEN
        BlockLength = 255
        LastLoc& = loc(1) + (OAddress - 1)
        BufferWrite 255
    END IF
    BufferWrite A
END SUB

SUB PutCode (A) STATIC
    Charac??? = Charac??? + A * ShiftTbl(CurrentBit)
    CurrentBit = CurrentBit + CodeSize
    DO WHILE CurrentBit > 7
        PutByte Charac??? AND 255
'        Charac??? = Charac??? \ 256
        SHIFT RIGHT Charac???, 8
        CurrentBit = CurrentBit - 8
    LOOP
END SUB

Seems okay, doesn't it? CShow doesn't share my opinion. HELP!
--
Sincerily:

     _____    _               ____
    / ____|  | |        ___  |  __|  ___  _   _____
   | |____   | |__     / _ \ | |_   /   \| | |  __ \
    \____ \  |  __|   |  __/ |  _| |  /\   | | |  | |
     ____| | | |____  | |_de Bruijn   \/   | | |  | |
    |_____/   \_____|  \___| |_|    \___/|_| |_|  |_|

                http://www.*-*-*.com/
                   The Main Programming Page



Mon, 16 Oct 2000 03:00:00 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. ****** Anyone knows about GIF problems with VB4 ?? **************

2. animated gif problem.

3. pick color of gif file at mouse cursor and replace color in gif

4. Convert GIF/Save PictureBox as GIF

5. Save to GIF file from resource GIF file

6. Problem storing gif generated on fly on the web server

7. Problems with GIF/JPG-Graphics with the Access-JetEngine in VB5.0

8. Gif loader problem (QB)

9. Problems with GIF/JPG-Graphics with the Access-JetEngine in VB5.0

10. Problem loading gif

11. Problem with PictureBox and transparent GIF's

12. GIF-picture problem

 

 
Powered by phpBB® Forum Software