How do get libhqx-1.dll to work? (Solved)

General FreeBASIC programming questions.
lassar
Posts: 288
Joined: Jan 17, 2006 1:35
Contact:

How do get libhqx-1.dll to work? (Solved)

Postby lassar » Jul 13, 2018 15:55

I have been trying to use libhqx-1.dll in a program. but all I get is the compiler
can't find libhqx-1.dll .

libhqx-1.dll is in the same directory as the program.

How do I fix this?
Last edited by lassar on Jul 20, 2018 21:31, edited 1 time in total.
St_W
Posts: 1352
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

Re: How do get libhqx-1.dll to work?

Postby St_W » Jul 13, 2018 22:47

Are you sure that you use a compatible DLL (same system architecture) and that you are referring it by the correct name (note that "lib" prefix and ".dll" suffix are not specified)?
How are you using the DLL from FreeBasic?
srvaldez
Posts: 1629
Joined: Sep 25, 2005 21:54

Re: How do get libhqx-1.dll to work?

Postby srvaldez » Jul 13, 2018 22:51

you need to place the import lib in the lib folder
btw, you can get the hqx files from https://github.com/lrq3000/hqx/releases
however I could not get a valid bmp as output

Code: Select all

#pragma once

#include once "crt/stdint.bi"

#ifdef __FB_WIN32__
   extern "Windows"
#else
   extern "C"
#endif

#define __HQX_H_

#ifdef __FB_WIN32__
   #define HQX_CALLCONV __stdcall
   #define HQX_API __declspec(dllimport)
#else
   #define HQX_CALLCONV
   #define HQX_API
#endif

declare sub hqxInit()
declare sub hq2x_32(byval src as ulong ptr, byval dest as ulong ptr, byval width_ as long, byval height as long)
declare sub hq3x_32(byval src as ulong ptr, byval dest as ulong ptr, byval width_ as long, byval height as long)
declare sub hq4x_32(byval src as ulong ptr, byval dest as ulong ptr, byval width_ as long, byval height as long)
declare sub hq2x_32_rb(byval src as ulong ptr, byval src_rowBytes as ulong, byval dest as ulong ptr, byval dest_rowBytes as ulong, byval width_ as long, byval height as long)
declare sub hq3x_32_rb(byval src as ulong ptr, byval src_rowBytes as ulong, byval dest as ulong ptr, byval dest_rowBytes as ulong, byval width_ as long, byval height as long)
declare sub hq4x_32_rb(byval src as ulong ptr, byval src_rowBytes as ulong, byval dest as ulong ptr, byval dest_rowBytes as ulong, byval width_ as long, byval height as long)

end extern

#inclib "hqx"

dim shared width_ as uinteger
dim shared height as uinteger

dim shared dest as ulong ptr
'dest = cptr(ulong ptr, callocate((((width_ * 4) * height) * 4) * sizeof(ulong)))

Const NULL As Any Ptr = 0

Function bmp_load( ByRef filename As Const String, byref w as uinteger,  byref h as uinteger ) As Any Ptr

    Dim As Long filenum, bmpwidth, bmpheight
    Dim As Any Ptr img

    '' open BMP file
    filenum = FreeFile()
    If Open( filename For Binary Access Read As #filenum ) <> 0 Then Return NULL

        '' retrieve BMP dimensions
        Get #filenum, 19, bmpwidth
        Get #filenum, 23, bmpheight
      w = bmpwidth
      h = bmpheight
    Close #filenum

    '' create image with BMP dimensions
    img = ImageCreate( bmpwidth, Abs(bmpheight) )

    If img = NULL Then Return NULL

    '' load BMP file into image buffer
    If BLoad( filename, img ) <> 0 Then ImageDestroy( img ): Return NULL

    Return img

End Function



Dim As Any Ptr img

ScreenRes 1280, 960, 32

img = bmp_load( "fblogo.bmp", width_, height)

If img = NULL Then
    Print "bmp_load failed"

Else
   hqxInit()
   dest = ImageCreate( width_*4, height*4 )
   if dest > 0 then
      hq4x_32(img, dest, width_, height)
      bsave("fblogo4.bmp",dest)
   end if
    Put (10, 10), img

    ImageDestroy( img )
   if dest > 0 then
      ImageDestroy( dest )
   end if
End If
sleep
lassar
Posts: 288
Joined: Jan 17, 2006 1:35
Contact:

Re: How do get libhqx-1.dll to work?

Postby lassar » Jul 14, 2018 1:48

On a related note, I have been trying to convert a program to a dll.

Trying to create a JPEG loader dll.

When I include the jpeg code in the program it displays the jpeg.

But when I make a dll out of it, It won't display the jpeg.

It looks like freebasic does not support graphics in dll's !

Tried createimage in the dll code, and it returned 999, meaning
it could not createimage.

Print "Hello" in the DLL would not even display !

Here is my code

Code: Select all


#LANG "fblite"
#include once "fbgfx.bi"


'#include "jpeg4fb.bas"

'declare sub jpeg2screen LIB "jpeg4fb.dll" (byval jpg_file As String,JpegBuffer AS ANY PTR)

declare FUNCTION jpeg2screen(byval jpg_file As String,JpegBuffer AS ANY PTR) AS INTEGER
declare sub Hello LIB "jpeg4fb.dll" ()
declare function AddNumbers LIB "jpeg4fb.dll" ( byval a as integer, byval b as integer) as integer

DIM JpegImg AS ANY PTR

SCREENRES 640,480,32,1,1

JpegError% = jpeg2screen("Dish.jpg",JpegImg)
PUT (0,0),JpegImg
PRINT "3 + 5 = "; AddNumbers( 3, 5)
PRINT JpegError%
SLEEP
END




And here is the dll code.


Code: Select all



'--------------------------------------------------------------------------
'JPEG loader by Antoni Gual   12/1999    antonigual@eic.ictnet.es
'commented version            10/2003
'Ported to FB                  5/2005
'Adapted to FB0.17 by Luke Landriaut 11/2006
'removed multikey,floating point,unneeded byref parameters
'--------------------------------------------------------------------------
' to do
' make it a library
' better header parsing
' add support for progresive jpeg
' make it smaller
'SUB DECLARES----------------------------------------------------------------

#include once "fbgfx.bi"

#define jpg_center &h10000000

'renders from file to screen
DECLARE SUB Hello()
   
declare FUNCTION jpeg2screen(byval jpg_file As String,JpegBuffer AS ANY PTR) AS INTEGER

'prints a string from the error number returned from the renderer
declare FUNCTION printerror as string

declare function AddNumbers( byval a as integer, byval b as integer) as integer


'reads the frame size from a jpeg file *****

'error codes
#define err_ok        0
#define err_escpress  100 
#define err_nogfxlib  101
#define err_palmode   102
#define err_nofile    103
#define err_fnotfound 104
#define err_fnotexist 105
#define err_fnojpeg   106
#define err_fnoframe  107
#define err_progframe 108
#define err_diffframe 109
#define err_arithcode 110
#define err_quantprec 111
#define err_mt2huff   112
#define err_soimispl  113
#define err_smplsz    114
#define err_mt3comp   115
#define err_notalltbl 116
#define err_mt2qtbl   117
#define err_a0notjfif 118
#define err_markunk   119
#define err_putbuff   120
#define err_scrbuff   121
#define err_getoutl   122

common shared jpegerr as integer ',errtxt as string


'DEFINT A-Z

'Const dc = 0, AC = 1              'indexs to huffman and quant tables


'JPEG markers
'start of frames
Const mk_sof0 = &HFFC0&
Const mk_sof1 = &HFFC1&, mk_sof2 = &HFFC2&, mk_sof3 = &HFFC3&
Const mk_sof5 = &HFFC5&, mk_sof6 = &HFFC6&, mk_sof7 = &HFFC7&
Const mk_rsrvd = &HFFC8&
Const mk_sof9 = &HFFC9&, mk_sofa = &HFFCA&, mk_sofb = &HFFCB&
Const mk_sofd = &HFFCD&, mk_sofe = &HFFCE&, mk_soff = &HFFCF&

'tables and miscelaneous
Const mk_tblhuff = &HFFC4&, mk_tblari = &HFFCC&
Const mk_tblquan = &HFFDB&, mk_tbldri = &HFFDD&
Const mk_com = &HFFFE&
Const mk_app0 = &HFFE0&, mk_app1 = &HFFE1&, mk_app2 = &HFFE2, mk_app3 = &HFFE3
Const mk_app4 = &HFFE4, mk_app5 = &HFFE5, mk_app6 = &HFFE6, mk_app7 = &HFFE7
Const mk_app8 = &HFFE8, mk_app9 = &HFFE9, mk_appa = &HFFEA, mk_appb = &HFFEB
Const mk_appc = &HFFEB, mk_appd = &HFFED, mk_appe = &HFFEE, mk_appf = &HFFEF&

'restarts
Const mk_rst0 = &HFFD0&, mk_rst1 = &HFFD1, mk_rst2 = &HFFD2, mk_rst3 = &HFFD3
Const mk_rst4 = &HFFD4, mk_rst5 = &HFFD5, mk_rst6 = &HFFD6, mk_rst7 = &HFFD7&

'headers
Const mk_soi = &HFFD8&, mk_eoi = &HFFD9&
Const mk_SOS = &HFFDA&, mk_dnl = &HFFDC&
Const mk_dhp = &HFFDF6, mk_exp = &HFFDF&
Const mk_dri = &HFFDD&
'reserved
Const mk_jpg0 = &HFFF0, mk_jpg1 = &HFFF1, mk_jpg2 = &HFFF2, mk_jpg3 = &HFFF3
Const mk_jpg4 = &HFFF4, mk_jpg5 = &HFFF5, mk_jpg6 = &HFFF6, mk_jpg7 = &HFFF7
Const mk_jpg8 = &HFFF8, mk_jpg9 = &HFFF9, mk_jpga = &HFFFA, mk_jpgb = &HFFFB
Const mk_jpgc = &HFFFB, mk_jpgd = &HFFFD

#define IS_A_SOF mk_sof0 to mk_sof3,mk_sof5 to mk_sof7,mk_sof9 to mk_sofb,mk_sofd to mk_soff
#define IS_A_APPn mk_app0 to mk_appF


'stores  the JPEG image parmeters
Type JpegType
  jfifmajor     As Integer   'version
  jfifMinor     As Integer
  densunits     As Integer        'density units and values (not used)
  Xdens         As Integer
  ydens         As Integer
  ThWidth       As Integer   'thumbnail size
  Theigth       As Integer
  pendbytes     As Integer
  rows          As Integer      'jpeg height
  cols          As Integer      'jpeg width
  samplesyx     As Integer      'sampling ratios
  samplesyy     As Integer      'sampling ratios
  samplescbcrx  As Integer
  samplescbcry  As Integer
  qty           As Integer      'number of quantization tables
  qtcbr         As Integer
  HDCTY         As Integer      'number of huffman tables (DC and AC)
  HDCTCBR       As Integer
  HaCTY         As Integer
  HaCTcbr       As Integer
  numcomp       As Integer      'number of components
  restart       As Integer      'blocks between restart marks
  size          As Long         'FILE SIZE
End Type

Type vesatype
  xres          As Integer
  yres          As Integer
  depth         As Integer
End Type

'------------------------------------------------------------------------


'SHARED VARIABLES.

'simple vars
Dim Shared As Integer jfile                     'file vars

Dim Shared As Uinteger jpegmem
Dim Shared As Ubyte Ptr jpegmem_ptr
Dim Shared As Integer buf2_ptr
Dim Shared As Uinteger buf2           'pointer to Huffman decoder secondary buffer

Dim Shared pbuff As Ubyte Ptr: Const bsize=1023
Redim  Shared buff(0) As Ubyte

'UDT


Dim Shared vport As vesatype
Dim Shared As Integer inscan
Dim Shared jpeg As JpegType

'JPEG tables

' quantization
Redim Shared As Integer quant(0, 0)
'huffman decoding
Dim Shared huffstart(15) As Integer
Const hufftblsize=761
Redim Shared As Integer Hufftree(0) 'AS Huffmantreeentry

'dim shared buffer as any ptr

Dim Shared As Integer zz(0 To 63) => {_
0,  1,  8, 16,  9,  2,  3, 10,_
17, 24, 32, 25, 18, 11,  4,  5,_
12, 19, 26, 33, 40, 48, 41, 34,_
27, 20, 13,  6,  7, 14, 21, 28,_
35, 42, 49, 56, 57, 50, 43, 36,_
29, 22, 15, 23, 30, 37, 44, 51,_
58, 59, 52, 45, 38, 31, 39, 46,_
53, 60, 61, 54, 47, 55, 62, 63}         


'dim shared imgcomment
'dim shared marker, email

'used in huffman decoder
Dim Shared As Uinteger Ptr p1stbit,pmaskbits
Dim Shared As Integer indx,mxind


'START------------------------------------------------------------------
Private Function GFxlibOn As Integer
  If Screenptr =0 Then Return err_nogfxlib
  Screeninfo vport.xres,vport.yres,vport.depth
  If vport.depth<15 Then Return err_palmode
End Function
'
'---------------------------------------------------------------------------
Function JPEGGetByte As Integer
  'used when decoding the headers (not critical), inscan turns on an off
  'detection of pairs FF00 and it's conversion of FF
  Static As Ubyte lb,b
 
  lb=b
  If jfile <> 0 Then
    Get #jfile,,b
  Else
    b = jpegmem_ptr[ jpegmem ]
    jpegmem += 1
  End If
  If inscan Then
    If lb=255 And b=0 Then
      If jfile <> 0 Then
        Get #jfile,,b
      Else
        b = jpegmem_ptr[ jpegmem ]
        jpegmem += 1
      End If
    End If
  End If
  jpeg.pendbytes -=1
  Function=lb
 
End Function
'
'----------------------------------------------------------------------------
Function GetByteBuffered As Integer
  'using in decoding image scans (a speed critical part)
  'detection of pairs FF00 and it's conversion of FF is made when bufferis filled 
  Static As Integer i,j
  Dim As Integer k
  If indx>mxind Then
    If jfile <> 0 Then
      Get #jfile,,buff()
    Else
      For k = Lbound(buff) To Ubound(buff)
        buff(k) = jpegmem_ptr[ jpegmem ]
        jpegmem += 1
      Next k
    End If
    indx=0
    mxind=bsize
    If pbuff[mxind]=&hff Then
      mxind-=1
      If jfile <> 0 Then
        Seek jfile,Seek(jfile)-1
      Else
        jpegmem -= 1
      End If
    End If
    i=0
   
    Do
      If pbuff[i]=&hFF Then
        If pbuff[i+1]=0 Then
          For j=i+1 To mxind-1
            pbuff[j]=pbuff[j+1]
          Next
          mxind-=1
        End If
      End If
      i+=1
    Loop Until i>=mxind
   
  End If 
  Function=pbuff[indx]:indx+=1
End Function

'
'---------------------------------------------------------------------------
Function JPEGGetHuff (posini As Integer) As Integer
  'Called by JpegGet8x8
  'Gets bits from file until they match a Huffman table entry. When match
  ' found it returns the associated code.
  'The table is in the form of a binary tree
  Dim As Integer h_ptr =Any ,i = Any
  'shared Huftree(),buf2,buf2_ptr
  'init pointer to tree array
  h_ptr = huffstart(posini)
 
  'gather bits until we match a huffman pattern and read Huff code from tree
  Do
    'prepare mask the next bit in input buffer   
    If buf2_ptr=0 Then buf2=getbytebuffered:buf2_ptr=8
    buf2_ptr -=1
    i=1 Shl (buf2_ptr)
   
    'select side depending of next bit
    If buf2 And i Then h_ptr+=1
    'read value in that side
    h_ptr = Hufftree(h_ptr)
   
    'if h_ptr<1 we have reached a tree leaf
  Loop Until h_ptr<1
  'return the code we read in the leaf
  Function = -h_ptr
End Function
'
'---------------------------------------------------------------------------
Function JPEGGetNBits (nbits As Integer) As Integer
  'Called by JpegGet8x8
  'Fetches nbits bits from the file, if first bit off it performs the "negation"
  'required by Jpeg specs.
  '#define bit3(x) (1 shl (x))-1
  Dim As Integer GetNBits =Any
  'fillbitbuffer
  While buf2_ptr < nbits
    buf2 = (buf2 Shl 8) Or  GetBytebuffered 
    buf2_ptr += 8
  Wend
 
  'get n bits.
  buf2_ptr = buf2_ptr - nbits
  GetNBits = buf2 Shr buf2_ptr
 
  'clip left ,then if msb is 0 negate and make negative (jpeg spec)
  If GetNBits And p1stbit[nbits] Then
    Function = GetNBits And pmaskbits[nbits]
  Else
    Function = -(Not GetNBits And pmaskbits[nbits])
  End If
End Function


'---------------------------------------------------------------------------
Sub JPEGGet8x8 (vector As Integer Ptr, comp As Integer, Byref dcCoef As Integer)
  ' Reads enough bits from JPEG file so Huffman decoder can build an 8X8 block
  ' Then reorders block based on zigzafg table, dequantizaes and IDCT
  ' transforms the block so the returned block is an ordered 8x8 Y, Cb or Cr
  ' component block
  '
  ' Decoding of progressive jpegs would need saving all 8x8 blocks at the output
  '  of the huffman decoder so they could be updated with the data from several
  '  scans before zigzag-dequant-idct-display-ing them
 
  ' vector Returns a block
  ' comp tells us if it's a luminance(Y) or a chrominance component, as differnt
  '  dequant-huffman tables must be used
  ' In dccoef we receive the dc component  from last block and return
  '  the dc component of this block (dc component is coded incrementally)
 
 
  'HUFFMAN DECODER-----------------------------------------------------------
  ' Reads enough bits from JPEG file to build an 8X8 block and de-zigzags it
  ' A block's coefficient is encoded as two variable length values:
  '   an entry to a huffman table and the actual value.
  ' The entry to Huff table indexes a code made of 2 nibbles
  '   codes 0 and 3270 have special meanings; for the rest
  '   high nibble is an offset from the present position in the block
  '   low nibble is nr of bits to retrieve for the value
  '--------------------------------------------------------------------------
  'select correct  Huffman and dequant tables
  Dim As Integer tx=Any,dekode=Any,nbits=Any,k=Any,thebits=Any
  'dim p as any ptr=any
 
  Select Case As Const comp
  Case 1
    tx = 0
  Case 2
    tx = 2
   
  Case Else
 
  End Select

  'preset the complete vector to zeros
  For k=0 To 63:vector[k]=0:Next
 
  'The DC coefficient is incremental
  nbits = JPEGGetHuff(tx)
  dcCoef += JPEGGetNBits(nbits)
  vector[0] = dcCoef
 
  'AC Coefficients are calculated from scratch
  k = 1
  Do
    dekode = JPEGGetHuff(tx + 1)
    Select Case As Const dekode And &hff
    Case 0 'EndOfBlock.Rest of vector is already padded with 0's
     
      '    print #1, dekode, "eob"
      Exit Do
    Case 240 'ZeroRunLength encountered  240=15*16+0
      '   print #1, dekode, "zrl"
      k = k + 16
    Case Else 'a true coefficient follows
      'first nibble: index increment
      k += dekode Shr 4
      'second nibble:nr of bits to fetch
      vector[zz(k)] =JPEGGetNBits(dekode And 15)
      k+=  1
    End Select
  Loop Until k > 63
End Sub
'
'----------------------------------------------------------------------------
Sub IDCT(vector As Integer Ptr,comp As Integer)
 
  'Dequantization and IDCT routines-----------------------------------------------
 
  'The true IDCT is as follows:
  'The 4 dimensional IDCT coefficients matrix
  'DIM dct!(X,Y,U,V)
  'FOR x = 0 TO 7           'Initialize our cosine table
  ' FOR y = 0 TO 7
  '    FOR u = 0 TO 7
  '     FOR v = 0 TO 7
  '        t! = COS((2 * x + 1) * u * .1963495) * COS((2 * y + 1) * v * .1963495)
  '        IF u = 0 THEN t! = t! * .707107
  '        IF v = 0 THEN t! = t! * .707107
  '        dct!(x, y, u, v) = t!
  '     NEXT v
  '    NEXT u
  ' NEXT y
  'NEXT x
  '
  'IDCT calculation for a given vector: output in array2
  'FOR x = 0 TO 7
  '    FOR y = 0 TO 7
  '        sum! = 0
  '        FOR v = 0 TO 7
  '            FOR u = 0 TO 7
  '                temp! = vector(u, v)
  '                IF temp! THEN temp! = temp! * dct!(x, y, u, v)
  '                sum! = sum! + temp!
  '            NEXT u
  '        NEXT v
  '        array2!(x, y) = sum!+128!
  '   NEXT y
  'NEXT x
  '
  'The actual method used there is ported from the C source examples by the
  'independant JPEG group.It reduces greatly the number of operations needed
 
  'temporals for the IDCT routines
  Dim z1 As Long, z2 As Long, z3 As Long, z4 As Long, z5 As Long
  Dim z10 As Long, z11 As Long, z12 As Long, z13 As Long
  Dim tmp0 As Long, tmp1 As Long, tmp2 As Long, tmp3 As Long
  Dim tmp10 As Long, tmp11 As Long, tmp12 As Long, tmp13 As Long
  Dim As Integer u,v,quantnum
 
  Dim As Integer Ptr ptr1,pqnt
 
  'Inverse Discrete Cosinus Transform & dequantization using fixed point
  'Loeffler,Ligtenberg and Moschytz algorythm 
 
  #define descale12(a) ((a)+(1 Shl 11)) Shr 12
  #define descale17(a) ((a)+(1 Shl 16)) Shr 17
 
  Const fix029 = 2446&
  Const FIX039 = -3196&
  Const FIX054 = 4433&
  Const FIX076 = 6270&
  Const FIX089 = -7373&
  Const FIX117 = 9633&
  Const fix150 = 12299&
  Const FIX184 = -15137&
  Const FIX196 = -16069&
  Const fix205 = 16819&
  Const FIX256 = -20995&
  Const fix307 = 25172&
 
  Const idctw=8
 
  Select Case comp
  Case 1
    quantnum = jpeg.qty
  Case 2
    quantnum = jpeg.qtcbr
  End Select
 
  'row calc
  pqnt=@quant(quantnum,0)
 
  ptr1=vector
  'print pqnt
  'print ptr1
 
  For u = 0 To 7
    'if all row zeros, short circuit row calc
    If (ptr1[idctw*1] Or ptr1[idctw*2] Or ptr1[idctw*3] Or ptr1[idctw*4] Or ptr1[idctw*5] _
    Or ptr1[idctw*6] Or ptr1[idctw*7]) = 0 Then
    tmp0 = ptr1[idctw*0] * pqnt[idctw*0] Shl 1
    ptr1[idctw*0] = tmp0
    ptr1[idctw*1] = tmp0
    ptr1[idctw*2] = tmp0
    ptr1[idctw*3] = tmp0
    ptr1[idctw*4] = tmp0
    ptr1[idctw*5] = tmp0
    ptr1[idctw*6] = tmp0
    ptr1[idctw*7] = tmp0
  Else
    z2 = ptr1[idctw*2] * pqnt[idctw*2]
    z3 = ptr1[idctw*6] * pqnt[idctw*6]
    z1 = (z2 + z3) * FIX054
    tmp2 = z1 + (z3 * FIX184)
    tmp3 = z1 + (z2 * FIX076)
    z2 = ptr1[idctw*0] * pqnt[idctw*0]
    z3 = ptr1[idctw*4] * pqnt[idctw*4]
    tmp0 =  (z2 + z3) Shl 13
    tmp1 =  (z2 - z3) Shl 13
    tmp10 = tmp0 + tmp3
    tmp13 = tmp0 - tmp3
    tmp11 = tmp1 + tmp2
    tmp12 = tmp1 - tmp2
    tmp0 = ptr1[idctw*7] * pqnt[idctw*7]
    tmp1 = ptr1[idctw*5] * pqnt[idctw*5]
    tmp2 = ptr1[idctw*3] * pqnt[idctw*3]
    tmp3 = ptr1[idctw*1] * pqnt[idctw*1]
    z1 = tmp0 + tmp3
    z2 = tmp1 + tmp2
    z3 = tmp0 + tmp2
    z4 = tmp1 + tmp3
    z5 = (z3 + z4) * FIX117
    tmp0 *= fix029
    tmp1 *= fix205
    tmp2 *= fix307
    tmp3 *= fix150
    z1 *= FIX089
    z2 *= FIX256
    z3 *= FIX196
    z4 *= FIX039
    z3 += z5
    z4 += z5
    tmp0 += z1 + z3
    tmp1 += z2 + z4
    tmp2 += z2 + z3
    tmp3 += z1 + z4
    ptr1[idctw*0] = descale12(tmp10 + tmp3)
    ptr1[idctw*7] = descale12(tmp10 - tmp3)
    ptr1[idctw*1] = descale12(tmp11 + tmp2)
    ptr1[idctw*6] = descale12(tmp11 - tmp2)
    ptr1[idctw*2] = descale12(tmp12 + tmp1)
    ptr1[idctw*5] = descale12(tmp12 - tmp1)
    ptr1[idctw*3] = descale12(tmp13 + tmp0)
    ptr1[idctw*4] = descale12(tmp13 - tmp0)
   
  End If
  ptr1+=1
  pqnt+=1
 
Next

ptr1=vector
'column calcs
For v = 0 To 7
  z2 = ptr1[ 2]
  z3 = ptr1[ 6]
  z1 = (z2 + z3) * FIX054
  tmp2 = z1 + (z3 * FIX184)
  tmp3 = z1 + (z2 * FIX076)
  tmp0 = (ptr1[ 0] + ptr1[ 4])Shl 13
  tmp1 = (ptr1[ 0] - ptr1[ 4])Shl 13
  tmp10 = tmp0 + tmp3
  tmp13 = tmp0 - tmp3
  tmp11 = tmp1 + tmp2
  tmp12 = tmp1 - tmp2
  tmp0 = ptr1[ 7]
  tmp1 = ptr1[ 5]
  tmp2 = ptr1[ 3]
  tmp3 = ptr1[ 1]
  z1 = tmp0 + tmp3
  z2 = tmp1 + tmp2
  z3 = tmp0 + tmp2
  z4 = tmp1 + tmp3
  z5 = (z3 + z4) * FIX117
  tmp0 *= fix029
  tmp1 *= fix205
  tmp2 *= fix307
  tmp3 *= fix150
  z1 *= FIX089
  z2 *= FIX256
  z3 *= FIX196
  z4 *= FIX039
  z3 +=  z5
  z4 +=  z5
  tmp0 += z1 + z3
  tmp1 += z2 + z4
  tmp2 += z2 + z3
  tmp3 += z1 + z4
  ptr1[ 0] = descale17(tmp10 + tmp3)
  ptr1[ 7] = descale17(tmp10 - tmp3)
  ptr1[ 1] = descale17(tmp11 + tmp2)
  ptr1[ 6] = descale17(tmp11 - tmp2)
  ptr1[ 2] = descale17(tmp12 + tmp1)
  ptr1[ 5] = descale17(tmp12 - tmp1)
  ptr1[ 3] = descale17(tmp13 + tmp0)
  ptr1[ 4] = descale17(tmp13 - tmp0)
 
  ptr1+=8 
 
Next

End Sub
'
'---------------------------------------------------------------------------
Function JPEGgetstr (num As Integer) As String
'gets an array of bytes from a JPEG file and returns them as a string
If num=0 Then Function="":Exit Function
Dim As String a
Dim As Integer i
'print num
a = Space(num)
'I can't do a single GET as i'm using a buffered file access

For i = 0 To num-1
  a[i] = JPEGGetByte
Next

Function=a

End Function
'
'---------------------------------------------------------------------------
Function JPEGGetWord As Long
'gets a big endian word from the current position in file
Dim As Integer temp
temp = JPEGGetByte
Function =  (temp  Shl 8) + JPEGGetByte
End Function
'
'---------------------------------------------------------------------------
Sub JPEGMakeHuffTree(Byref Actables As Integer,Byref Dctables As Integer,Byref tni As Integer,Byref tindx As Integer)
'Called by JpegGetParams whenever it founds a Huffman table marker
'It reads Huffman table and converts it into a binary tree 
'the tree is formed by pairs of integers. The even element corresponds to
'a zero in the code, the right maps to a 1. If an element is negative it is
'an index to a branch. If the element is positive, it is a leaf and the value
'is a code.

Dim As Integer l0,c0,tc,th,i,s,x,_ptr,nxt,temp0,nxtfree,bitt
Dim As Long curnum
'chunk size, counter
jpeg.pendbytes = JPEGGetWord&-2
'number of coefficients for each size
Redim As Integer huffamount(1 To 16)

Do
  'read a table
  temp0 = JPEGGetByte
  tc = temp0 Shr 4
  th = temp0 And 15
 
  'read number of entries for each size
  For i = 1 To 16
    huffamount(i) = JPEGGetByte
    'print huffamount (i),
  Next i
  'create huffman tree in a single array
 
  'save start of this tree
  huffstart(th * 2 + tc) = tni
  nxtfree = tni+2
  curnum = 0
 
  For s = 1 To 16               'for each length
    For x = 1 To huffamount(s)   'for each tree entry   
      _ptr=tni
      'for each bit in entry
      For bitt =  (s - 1) To 1 Step -1
        'if bitt is 1
        If curnum And (1 Shl bitt) Then _ptr+=1
        nxt = Hufftree(_ptr)
        'next exists
        If nxt>1 Then
          _ptr = nxt
          'don't exist, create it
        Elseif nxt=1 Then
          Hufftree(_ptr) = nxtfree
          _ptr = nxtfree: nxtfree = nxtfree + 2
        Else
          Print #1, "Huff tree redundancy"
          Sleep
          Stop
        End If
       
      Next bitt
      If (curnum And 1) Then
        Hufftree(_ptr+1) = jpeggetbyte * -1
      Else
        Hufftree(_ptr) = jpeggetbyte * -1
      End If
      curnum = curnum + 1
    Next x
    curnum = curnum * 2
  Next s
  If tc Then ACTAbles = ACTAbles + 1 Else DCtables = DCtables + 1
 
  tni = nxtfree
  tindx=tindx+1
Loop Until jpeg.pendbytes=0   'for each table
Redim  huffamount(0)

End Sub

'
'---------------------------------------------------------------------------

Sub JPEGGetParms (jpegsize As Uinteger)
'
'Scans a JPEG to see if we are able to display it. If we are, get Huffman
'and quantization coefs
'When the first baseline start of frame is found, routine is exited
'
'This routine is very tolerant, it accept the different blocks in any order
' In fact a precise sequence should be enforced...
'
'Markers:----------------------------------------------------------------
'FFD8 Start of Image /FFD9 End Of image /FFDA Start of Scan
'
'START OF FRAME      DCT SINGLE   DCT DIFFE   ARITHMETICAL  ARITHMETICAL
'                     FRAME        RENTIAL    SINGLE FRAME  DIFFERENTIAL
'Baseline              FFC0               
'Extended sequential   FFC1         FFC5        FFC9          FFCD
'Progressive           FFC2         FFc6        FFCA          FFCE
'Lossless sequential   FFC3         FFC7        FFCB          FFCF
'
'FFC4 Huffman table  /FFCC Aritmetical table  /FFDB Dequantization table
'FFDC Define Nr of lines /FFDF Expand ref Components /FFDE Define hierarchical
'FFE0 - FFEF App segment /FFF0-FFFD Jpeg extension /FF01 to FFBF Reserved
'FFFE -Comment /  FF00 ==  byte FF
'FFDD -Define restart interval /FFD0 - FFD7 Restart marks 
'---------------------------------------------------------------------------
Dim As Integer e,i,temp4,temp0,temp1,temp2,id,ncomp,getsos,l0,c0
Dim As String imgcomment,marker,d
Dim As Integer tni,tindx,ACTAbles, DCtables,qtables
Redim As Integer hufftree(0 To hufftblsize)
For i=0 To hufftblsize:hufftree(i)=1:Next
  Redim quant(0 To 1,0 To 63) '2 quantization tables (Y, CbCr)
  inscan=1
  tni=0
  tindx = 0:tni=0
  If jfile <> 0 Then
    jpeg.size = Lof(jfile)
  Else
    jpeg.size = jpegsize
  End If
  qtables = 0                            'Initialize some checkpoint variables
  ACTAbles = 0
  DCtables = 0
  jpeg.restart = 0
 
  marker = ""
  Do                                      'Primary control loop for markers
    If JPEGGetByte = 255 Then             'Marker Found
      e = JPEGGetByte
     
      '   marker = marker + CHR(d)
      '? "marker ";hex(d)
      Select Case As Const e                        'which one is it?
     
      Case &HC0, &HC1                      'SOF0-1: Frame marker.Only baseline..
        'get frame attributes
        jpeg.pendbytes = JPEGGetWord&-2     'Length of segment
        temp0 = JPEGGetByte                 'Data precision
        If temp0 <> 8 Then Return
        jpeg.rows = JPEGGetWord&
        jpeg.cols = JPEGGetWord&
        ncomp = JPEGGetByte         'Number of components
        'get data for each image component (Y-CB-CR)
        For i = 1 To ncomp
          id = JPEGGetByte
          Select Case As Const id
          Case 1
            temp1 = JPEGGetByte
            jpeg.samplesyx = temp1 \ 16
            jpeg.samplesyy = temp1 And 15
            jpeg.qty = JPEGGetByte
          Case 2, 3
            temp1 = JPEGGetByte
            jpeg.samplescbcrx = temp1 \ 16
            jpeg.samplescbcry = temp1 And 15
            jpeg.qtcbr = JPEGGetByte%
          Case Else
            jpegerr=err_mt3comp:Exit Sub
          End Select
        Next i
       
      Case &HC2:jpegerr= err_progframe:Exit Sub
     
      Case &HC5 To &HC7:jpegerr= err_diffframe:Exit Sub
     
      Case &HC9 To &HCF:jpegerr= err_arithcode:Exit Sub
     
      Case &HC4                             'DHT:  Huffman tables
        If ACTAbles < 2 Or DCtables < 2 Then
          JPEGMakeHuffTree (Actables,Dctables,tni,tindx)
        Else
          jpegerr= err_mt2huff:Exit Sub
        End If
       
      Case &HD8 'SOI                        'Start of image.Should not be here
        jpegerr=err_soimispl:Exit Sub
       
      Case &HD9 'EOI                        'END of image.(Should be the EOF)
        jpegerr=err_fnoframe:Exit Sub
      Case &HDA 'SOS                        'start of scan.The true image
        'get scan header parameters
        'print "scan header found"                             
        jpeg.pendbytes = JPEGGetWord&-2
        temp0 = JPEGGetByte
        If temp0 <> 1 And temp0 <> 3 Then jpegerr= err_mt3comp:Exit Sub
        jpeg.numcomp = temp0
        For i = 1 To temp0
          temp1 = JPEGGetByte
          Select Case As Const temp1
          Case 1
            temp2 = JPEGGetByte
            jpeg.HaCTY = temp2 And 15
            jpeg.HDCTY = temp2 \ 16
          Case 2, 3
            temp2 = JPEGGetByte
            jpeg.HaCTcbr = temp2 And 15
            jpeg.HDCTCBR = temp2 \ 16
          Case Else
            jpegerr= err_mt3comp:Exit Sub
          End Select
        Next i
       
        d = JPEGgetstr(3)
       
        If (DCtables = 2 And ACTAbles = 2 And qtables = 2) Or jpeg.numcomp = 1 Then
          'If we have all tables needed, exit and start displaying the image
          Exit Do
        Else
          jpegerr=err_notalltbl:Exit Sub
         
        End If
       
      Case &HDD                          'DRI: Define restart interval
        jpeg.pendbytes = JPEGGetWord&-2                  'some images have synch marks embedded..
        jpeg.restart = JPEGGetWord&           'we must skip them
       
      Case &HDB                          'DQT: A quantization table. Read it
        If qtables < 2 Then
          jpeg.pendbytes = JPEGGetWord&-2
          c0 = 2
          Do
            temp0 = JPEGGetByte
            If temp0 And &HF0 Then jpegerr= err_quantprec:Exit Sub
            temp0 = temp0 And 15
            For i = 0 To 63
              quant(temp0, zz(i)) = JPEGGetByte
            Next i
            qtables = qtables + 1
          Loop Until jpeg.pendbytes=0
        Else
          jpegerr=err_mt2qtbl:Exit Sub
        End If
      Case &HE0                          'APP0- application specific data
        jpeg.pendbytes = JPEGGetWord& -2   'We are only interested in JFIF block
        If Left(JPEGgetstr(5),4) <> ("JFIF") Then jpegerr= err_a0notjfif:Exit Sub
       
        'jpeggetbyte
        jpeg.jfifmajor = JPEGGetByte
        jpeg.jfifMinor = JPEGGetByte
        jpeg.densunits = JPEGGetByte
        jpeg.Xdens = JPEGGetWord&
        jpeg.ydens = JPEGGetWord&
        jpeg.ThWidth = JPEGGetByte
        jpeg.Theigth = JPEGGetByte
       
      Case &HFE                          'COM a comment. Just read it
        imgcomment = JPEGgetstr(JPEGGetWord& - 2)
       
      Case &HE1 To &HEF                  'APP1 to AP15  marker. Just skip it
        inscan=0
        d = JPEGgetstr(JPEGGetWord& - 2)
        inscan=1
      Case Else
        jpegerr=err_markunk:Exit Sub
      End Select
    End If
    'IF multikey(1) THEN jpegerr=err_escpress:exit sub
   
  Loop
 
  'return 1 if succesful
 
 
End Sub
'
'---------------------------------------------------------------------------

Function YCrCb2RGB(Y As Integer,cr As Integer,cb As Integer) As Integer
  'convert Y-CR-Cb to rgb
  Static As Integer i,yy, r_g_b(2)
  yy=1000*y
  r_g_b(0)= (yy+1402*Cr)\1000
  r_g_b(1)= (yy-344*cb-714*cr)\1000
  r_g_b(2)= (yy+1772*cb)\1000
 
  For i = 0 To 2
   
    If r_g_b(i)>255 Then
      r_g_b(i)=255
    Elseif r_g_b(i)<0 Then
      r_g_b(i)=0
    End If
   
  Next i
  Return Rgb(r_g_b(0), r_g_b(1), r_g_b(2))
End Function
'
'---------------------------------------------------------------------------
Function JPEGRenderColor (x0 As Integer, y0 As Integer,JpgImg AS ANY PTR) As Integer
  'JPEGGetParams exits when  a SOF marker is found.Then the main loop sets a
  ' SVGA mode and this routine (or the mono one) is called.
 
  'JPEGRenderColor calls decoder for each block, combines them and sends pixels to
  ' screen. It skips Restart markers,checks for screen boundaries,selects
  ' svga banks and draw pixels.
  ' If an image mcu is outside the top, left or right boundaries of the
  ' screen, its blocks are just Huffman decoded, IDCT is skipped. viw flag
  ' controls it. When the bottom of the screen is reached, decoding is just
  ' stopped.
 
  'shared vport AS vportblock
  'shared buf2_ptr AS INTEGER, viw AS INTEGER
  'shared jpeg AS JpegType
 
  'shared rcrv(), gcbv(), gcrv(), bcbv()
  'shared _rgb() AS INTEGER
 
 
  'vectors save the 8x8 blocks returned bu JPEGGet8x8, to be combined in an
  ' image mcu
  DIM y AS INTEGER, y1 AS INTEGER, Y2 AS INTEGER
  Dim As Integer dcY,dcCb,dcCr,xindex,yindex,mcu,xinc,yinc,nsy,xrend,yrend,xi0,yi,ylim
  Dim As Integer xi,xlim,j2,yyy,viw,yput
  Dim prgb As Uinteger Ptr
  Dim As Integer Ptr vector, yvector,cbvector,crvector
 
  yvector=Allocate (64*4*4)                     
  cbvector=Allocate (64*4)
  crvector=Allocate (64*4) 
 
  'We initialize the dc coefficients for each component
  'at start and at each restart mark: they are cumulative
 
  dcY = 0: dcCb = 0: dcCr = 0
  'indexes to the image
  xindex = 0: yindex = 0
  'huffman decoder buffer _ptr
  buf2_ptr = 0
  'mcu counter. Used only if restart marks present
  mcu = 0
  'print x0,y0
  'set parameters for 2x2. 2x1, 1x2 ,1x1 files
  xinc=jpeg.samplesyx*8
  yinc=jpeg.samplesyy*8
  nsy=jpeg.samplesyx*jpeg.samplesyy
 
  'prepere an output buffer
  'prgb=ImageCreate(16,16,,32)
  prgb=Allocate(8*8*4+4)
  prgb[0]=(8 Shl 3) Or (8 Shl 16) 'we will pset in 16x16 blocks
 
  'rendering loop
  Do                                     'for each mcu
    'check if present mcu  is fully off screen limits,set viw flag
    'if so we will only partially decode it and will not try to display it
    viw = -1
    xi0 = xindex + x0
    If (xi0 >= vport.xres) Or (xi0+8 < 0) Or((yindex + y0+8) < 0) Then viw=0
   
    'get next blocks from decoder
    vector=yvector 
    For y = 1 To nsy
      JPEGGet8x8 Vector, 1, dcY
      vector+=64
    Next
   
    JPEGGet8x8 CbVector, 2, dcCb
    JPEGGet8x8 CrVector, 2, dcCr
   
   
    If viw Then 'display the image mcu
      'perform idct's     
      vector=yvector
      For y = 1 To nsy
        idct Vector, 1
        vector+=64
      Next
      idct Cbvector,2
      idct Crvector,2
     
      'combine components, do colorspace transform write to PUT buffer, then PUT it to out buffer
      Dim As Integer xii,yii,xc,yc
      vector=yvector
      xi=x0+xindex
      yi=y0+yindex
      For x As Integer=0 To jpeg.samplesyy-1
        yii=8*(x)
        For x1 As Integer =0 To jpeg.samplesyx-1
          xii=8*(x1)   
         
          For y1 = 0 To 7
            For y2 = 0 To 7
              yc= y1\jpeg.samplesyx+xii\2+8*(y2\jpeg.samplesyy+yii\2)
              y = y1+8*y2
              prgb[y+1]=YCrCb2RGB(vector[y]+128,crvector[yc],cbvector[yc])
            Next
          Next
          Put JpgImg,(xi+xii,yi+yii),prgb,Pset
          vector+=64
        Next
      Next
     
    End If                             'if mcu must be displayed
   
    'if image has restart marks, keep counting nr of elements (mcu)
    If jpeg.restart Then
      mcu = mcu + 1
      'if restart interval reached skip restart mark and reset DC components
      If jpeg.restart = mcu Then
        buf2_ptr = 0:getbytebuffered:getbytebuffered
        dcY = 0: dcCb = 0: dcCr = 0: mcu = 0
      End If
    End If
   
    'move right the graphics cursor to next mcu
    xindex = xindex + xinc
    If jpeg.cols - xindex < xinc Then
      xrend = jpeg.cols - xindex - 1
    Else
      xrend = xinc - 1
    End If
    '
    'if right side of image reached, go for next mcu row of mcu's
    If xindex >= jpeg.cols Then
      xindex = 0: xrend = xinc - 1
      yindex = yindex + yinc
      If jpeg.rows - yindex < yinc Then
        yrend = jpeg.rows - yindex - 1
      Else
        yrend = yinc - 1
      End If
     
    End If
   
    'stop if no more mcu's or bottom of  screen reached
  Loop Until yindex >= jpeg.rows Or yindex + y0 >= vport.yres
 
  'kindly free memory for other uses
  Deallocate (yvector)
  Deallocate (crvector)
  Deallocate (cbvector)
  Deallocate (prgb)
  Return 0
End Function
'
'---------------------------------------------------------------------------
Function JPEGRenderMono (x0 As Integer, y0 As Integer,JpgImg AS ANY PTR) As Integer
 
  'monochrome jpeg. This is easy, we have only the Y component, Image elements
  'are 8X8, the same as blocks
 
  'vectors save the 8x8 blocks returned bu JPEGGet8x8, to be combined in an
  ' image mcu
 
  Dim As Integer dcy,xindex,yindex,xi0,y,x,xj,yi,yyy,xlim,ylim,xrend,yrend,viw,mcu,yput
  Dim As Uinteger Ptr prgb
  Dim As Integer Ptr Yvector1
  yvector1=Allocate (64*4)
 
  'We initialize the dc coefficients for each component
  'at start and at each restart mark: they are cumulative
 
  prgb=Allocate(64*4+4):prgb[0]=(8 Shl 3) Or (8 Shl 16)
  dcY = 0
  xindex = 0: yindex = 0
  buf2_ptr = 0
  mcu = 0
  xlim = vport.xres - x0
  ylim = vport.yres - y0
  xrend = 7: yrend = 7
  Do
    'check if present mcu  is fully off screen limits,set viw flag
    'if so we will only partially decode it and will not try to display it
    viw = -1
    xi0 = xindex + x0
    If (xi0 >= vport.xres) Or (xi0 < 0) Or((yindex + y0) < 0) Then viw=0
   
    'go decode a block
    JPEGGet8x8 YVector1, 1, dcY
   
   
    'If block must be viewed, display it
    If viw Then
      idct yvector1,1 
      'for each line
      For y = 0 To 63
        yyy=yvector1[y]+128
        'clamp the value   
        If yyy < 0 Then
          yyy = 0
        Elseif y > 255 Then
          yyy = 255
        End If
        prgb[y+1] =(yyy Shl 16) Or  (yyy Shl 8) Or yyy
      Next y    'next line
      'display mcu
      Put JpgImg,(xindex+x0,yindex+y0),prgb,Pset   
     
    End If      'mcu was to be displayed
   
    'if image has restart marks, keep counting nr of elements
    'if restart interval reached skip restart mark and reset DC components
    If jpeg.restart Then
      mcu = mcu + 1:
      If jpeg.restart = mcu Then
        buf2_ptr = 0:getbytebuffered:getbytebuffered
        dcY = 0: mcu = 0
      End If
    End If
   
    'move right the graphics cursor to next mcu
    xindex = xindex + 8
    If jpeg.cols - xindex < 8 Then
      xrend = jpeg.cols - xindex - 1
    Else
      xrend = 7
    End If
    'if right side of image reached, go for next mcu row of mcu's
    If xindex >= jpeg.cols Then
      xindex = 0: xrend = 7
      yindex = yindex + 8
      If jpeg.rows - yindex < 8 Then
        yrend = jpeg.rows - yindex - 1
      Else
        yrend = 7
      End If
      'return -1 if escaped
      'IF multikey(1) THEN
      ' JPEGRenderMono = -1
      ' EXIT DO
      'end if
    End If
    'if at bottom of the image or screen, stop decoding
  Loop Until yindex >= jpeg.rows Or yindex + y0 >= vport.yres
  'be kind and free memory for other uses
 
  'ERASE YVector1
  Deallocate (prgb):Deallocate (yvector1)
  Return 0
End Function
'
'------------------------------------------------------------------------
Sub renderjpeg(x0 As Integer,y0 As Integer,JpgImg AS ANY PTR)
  'decodes a scan and displays the image
  indx=mxind+1
  'init fast buffered file reading and aux bit buffer
  buf2_ptr = -1
  Redim  buff(bsize) As Ubyte
  pbuff=@buff(0)
  'undo the byte pre-fetch used in Getparams
  If jfile <> 0 Then
    Seek jfile,Seek(jfile)-1
  Else
    jpegmem -= 1
  End If
 
  'init tables for GetNbits
  Dim As Integer i,temp
  p1stbit=Allocate(16*4)
  pmaskbits=Allocate(16*4)
  For i = 0 To 15:
    temp = 1 Shl i
    pmaskbits[i] = temp - 1
    p1stbit[i] = temp Shr 1
  Next
  '
  'go for it...................
  Select Case As Const jpeg.numcomp
  Case 3: JPEGRenderColor( x0, y0,JpgImg)
  Case 1: JPEGRenderMono( x0, y0,JpgImg)
  End Select
 
  Redim Hufftree(0), buff(0),quant(0,0)
  Deallocate (p1stbit)
  Deallocate(pmaskbits)
End Sub
'
'-----------------------------------------------------------------------
Function printerror() As String
  Select Case As Const jpegerr
  Case err_ok       : Function="File succesfully read"
  Case err_escpress : Function="Escape pressed while decoding"
  Case err_nogfxlib : Function="You Need to set a  SCREEN mod in GfxLib before using jpeg4fb"
  Case err_palmode  : Function="Can't work in paletted modes...yet"
  Case err_nofile   : Function="Requires a jpeg file name"
  'case err_nofile   : function="Could not open file"
  Case err_fnotexist: Function="File does not exist"
  Case err_fnojpeg  : Function="Not a jpeg file"
  Case err_fnoframe : Function="Can't find a frame in the file"   
  Case err_progframe: Function="Can't decode a progressive frame"
  Case err_diffframe: Function="Can't decode a differential frame"
  Case err_arithcode: Function="Can't read arithmetical encoded jpegs"
  Case err_quantprec: Function="Quantization table is not 8 bit precission"
  Case err_mt2huff  : Function="More than 2 huffman tables per component"
  Case err_soimispl : Function="Misplaced start of image marker"
  Case err_smplsz   : Function="Sample size is not 8 x 8"
  '  case err_smplsz   : function="More than 3 components"
  Case err_notalltbl: Function="Not all tables read before first scan"
  Case err_mt2qtbl  : Function="Can't handle more than 2 quantization tables"
  Case err_a0notjfif: Function="Incorrect jfif header"
  Case err_markunk  : Function="Unknown marker found"
  Case err_putbuff  : Function="Can't create the put buffer"
  Case err_scrbuff  : Function="Can't get the screen buffer"
  Case Else         : Function="Unknown error "+Str(jpegerr)
  End Select
End Function
'
'
'---------------------------------------------------------------------------------

Private Function openfile(jpg_file As String) As Integer 'opens file and checks for the jpeg header
  If jpg_file="" Then Return err_nofile
  If Asc(jpg_file)=34 Then jpg_file=Mid(jpg_file,2,Len(jpg_file)-2)
  jfile = Freefile
  If Open (jpg_file For Binary As #jfile) Then Return err_fnotfound
  If Lof(jfile)=0 Then Close jfile:Kill jpg_file:Return err_fnotexist
  jpeggetbyte      'to feed the read-ahead buffer
  'check for JPEG SOI marker at start
  If JPEGGetWord <> &HFFD8& Then Return err_fnojpeg
End Function
'
'-------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' *****
FUNCTION jpeg2screen(byval jpg_file As String,JpegBuffer AS ANY PTR) AS INTEGER export

  jpegerr=0
  gfxlibon:If jpegerr Then Exit FUNCTION
  openfile(jpg_file):If jpegerr Then Exit FUNCTION
 
  JPEGGetParms(0): If jpegerr Then Close #jfile:Exit FUNCTION
'  JpegBuffer = ImageCreate( vport.xres,vport.yres,vport.depth)
  DIM JpegImg AS ANY ptr
  JpegImg = ImageCreate(640,480,32)
 
  if JpegImg = 0 then FUNCTION = 999:exit FUNCTION
 
  if JpegBuffer = 0 then FUNCTION=err_scrbuff:exit FUNCTION
 
  Screenlock
  renderjpeg(0,0,JpegBuffer)
  Screenunlock   
  'print jfile,vport.xres,vport.yres,jpeg.cols,jpeg.rows
  If jpegerr Then Close #jfile:Exit FUNCTION
  Close #jfile

End FUNCTION
'

SUB Hello() EXPORT
SCREENSET 1,1
PRINT "Hello There"
END SUB

function AddNumbers( byval a as integer, byval b as integer) as integer export
   function = a + b
end function

fxm
Posts: 8301
Joined: Apr 22, 2009 12:46
Location: Paris (suburb), FRANCE

Re: How do get libhqx-1.dll to work?

Postby fxm » Jul 14, 2018 5:04

A graphic screen must also be declared in the dll before printing or drawing. This will induce a second graphic screen only dedicated to the dll executed code.
lassar
Posts: 288
Joined: Jan 17, 2006 1:35
Contact:

Re: How do get libhqx-1.dll to work?

Postby lassar » Jul 14, 2018 7:31

You are right about the graphics screen, but it hangs.

When it comes to leaving the subroutine it hangs.

No way to leave the dll.
fxm
Posts: 8301
Joined: Apr 22, 2009 12:46
Location: Paris (suburb), FRANCE

Re: How do get libhqx-1.dll to work?

Postby fxm » Jul 14, 2018 7:44

Weird !
Look at viewtopic.php?f=2&t=21716 and the contained other links.
jj2007
Posts: 767
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: How do get libhqx-1.dll to work?

Postby jj2007 » Jul 14, 2018 8:16

Have you tried AllocConsole, printf(), FreeConsole? I have no testbed right now, but it could work.
lassar
Posts: 288
Joined: Jan 17, 2006 1:35
Contact:

Re: How do get libhqx-1.dll to work?

Postby lassar » Jul 17, 2018 17:06

I used DyLibLoad to load libhqx-1.dll , and change the parameters to by value.

Now it doesn't crash the program, but it still doesn't do anything.

For now I am giving up on this dll.

Maybe someone else can get it work.
lassar
Posts: 288
Joined: Jan 17, 2006 1:35
Contact:

Re: How do get libhqx-1.dll to work?

Postby lassar » Jul 20, 2018 20:33

Finally got the dll to work, but am a little disappointed with it.

Doesn't seem to look as good as other hq2x programs that I have seen.


Code: Select all


#LANG "fblite"

#include once "fbgfx.bi"
'DEFINT A-Z

Declare function dylibsymbol ( byval libhandle as integer, symbol as string ) as any ptr


DIM DllPTR AS ANY PTR

'DIM SHARED hqxInit As FUNCTION stdcall() AS LONG
DIM SHARED hq2x_32 As FUNCTION stdcall( BYVAL Org AS any ptr, BYVAL Dest AS any ptr, BYVAL width AS INTEGER, BYVAL height AS INTEGER) AS LONG   
DIM SHARED hqxInit As FUNCTION stdcall() AS LONG   

DllPTR = DyLibLoad("libhqx-1.dll")
If DllPTR = 0 Then
  Print "Unable to load libhqx-1.dll"
  SLEEP
  END
END IF


hqxInit = DyLibSymbol ( DllPTR, "hqxInit" )
hq2x_32 = DyLibSymbol ( DllPTR, "hq2x_32" )

dim shared ScrPtr as any ptr

ScreenRes(1280, 960, 32,, 1)  ' full screen mode

Dim IMG AS ANY PTR

IMG = ImageCreate(640, 480,,32)

BLOAD "Radtutor.bmp", IMG

result% = ImageInfo( IMG,,,,, ScrPtr)

cls
SCREENLOCK
Dummy% = hqxInit()
Dummy% = hq2x_32(ScrPtr, Screenptr, 640, 480)
SCREENUNLOCK
sleep
END


Return to “General”

Who is online

Users browsing this forum: No registered users and 2 guests