How do get libhqx-1.dll to work? (Solved)
How do get libhqx-1.dll to work? (Solved)
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?
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.
Re: How do get libhqx-1.dll to work?
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?
How are you using the DLL from FreeBasic?
Re: How do get libhqx-1.dll to work?
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
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
Re: How do get libhqx-1.dll to work?
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
And here is the dll code.
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
Re: How do get libhqx-1.dll to work?
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.
Re: How do get libhqx-1.dll to work?
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.
When it comes to leaving the subroutine it hangs.
No way to leave the dll.
Re: How do get libhqx-1.dll to work?
Weird !
Look at viewtopic.php?f=2&t=21716 and the contained other links.
Look at viewtopic.php?f=2&t=21716 and the contained other links.
Re: How do get libhqx-1.dll to work?
Have you tried AllocConsole, printf(), FreeConsole? I have no testbed right now, but it could work.
Re: How do get libhqx-1.dll to work?
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.
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.
Re: How do get libhqx-1.dll to work?
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.
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