fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2007-11-16 01:25 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
+ contrib/freeimage
   + contrib/freeimage/Makefile
   + contrib/freeimage/make_b32.bat
   + contrib/freeimage/make_vc.bat
   + contrib/freeimage/common.mak
   + contrib/freeimage/freeimage.ch
   + contrib/freeimage/fi_winfu.c
   + contrib/freeimage/fi_wrp.c
   + contrib/freeimage/readme.txt
   + contrib/freeimage/test
   + contrib/freeimage/test/bld_b32.bat
   + contrib/freeimage/test/fitest.prg
   + contrib/freeimage/test/sample1.jpg
   + contrib/freeimage/test/italia.gif
   + contrib/freeimage/test/fsg.jpg
   + contrib/freeimage/test/images_out
     + Added FreeImage OSS library Harbour interface.
     ! Some minor fixes and file rearrangements made.
     + Added std make files.
     ; TOFIX: There is still a potentially dangerous 
              warning to be fixed in FI_GETBACKGROUNDCOLOR()
     ; Borrowed from xhb.
     ; NOTE: The lib made some features available through the xhb 
             specific C struct functionality. Since such functionality 
             is not implemented in Harbour, the library would need 
             to be extened with some more wrappers to make C level 
             vars accessible from Harbour code. But even without 
             this functionality, the lib seems quite useful.
     ; NOTE: The lib also has some Windows specific 

   + contrib/xhb/hbfast.h
     + Added this file to enhance C interface code compatibility 
       with xhb.

   * contrib/firebird/*
     ! Fixed SVN properties.
This commit is contained in:
Viktor Szakats
2007-11-16 00:38:52 +00:00
parent 9d2bf591e4
commit 882b41f195
28 changed files with 6815 additions and 2726 deletions
Download Patch File Download Diff File Expand all files Collapse all files

38
harbour/ChangeLog
View File

@@ -8,6 +8,44 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2007-11-16 01:25 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
+ contrib/freeimage
+ contrib/freeimage/Makefile
+ contrib/freeimage/make_b32.bat
+ contrib/freeimage/make_vc.bat
+ contrib/freeimage/common.mak
+ contrib/freeimage/freeimage.ch
+ contrib/freeimage/fi_winfu.c
+ contrib/freeimage/fi_wrp.c
+ contrib/freeimage/readme.txt
+ contrib/freeimage/test
+ contrib/freeimage/test/bld_b32.bat
+ contrib/freeimage/test/fitest.prg
+ contrib/freeimage/test/sample1.jpg
+ contrib/freeimage/test/italia.gif
+ contrib/freeimage/test/fsg.jpg
+ contrib/freeimage/test/images_out
+ Added FreeImage OSS library Harbour interface.
! Some minor fixes and file rearrangements made.
+ Added std make files.
; TOFIX: There is still a potentially dangerous
warning to be fixed in FI_GETBACKGROUNDCOLOR()
; Borrowed from xhb.
; NOTE: The lib made some features available through the xhb
specific C struct functionality. Since such functionality
is not implemented in Harbour, the library would need
to be extened with some more wrappers to make C level
vars accessible from Harbour code. But even without
this functionality, the lib seems quite useful.
; NOTE: The lib also has some Windows specific
+ contrib/xhb/hbfast.h
+ Added this file to enhance C interface code compatibility
with xhb.
* contrib/firebird/*
! Fixed SVN properties.
2007-11-15 20:44 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
+ contrib/firebird
+ contrib/firebird/Makefile

34
harbour/contrib/firebird/Makefile
View File

@@ -1,17 +1,17 @@
#
# $Id: Makefile 4853 2001-12-25 16:51:58Z lculik $
#
ROOT = ../../
CFLAGS += -I/opt/firebird/include
C_SOURCES=\
firebird.c \
PRG_SOURCES=\
tfirebird.prg \
LIBNAME=firebird
include $(TOP)$(ROOT)config/lib.cf
#
# $Id$
#
ROOT = ../../
CFLAGS += -I/opt/firebird/include
C_SOURCES=\
firebird.c \
PRG_SOURCES=\
tfirebird.prg \
LIBNAME=firebird
include $(TOP)$(ROOT)config/lib.cf

36
harbour/contrib/firebird/common.mak
View File

@@ -1,18 +1,18 @@
#
# $Id: common.mak 7935 2007-11-10 11:31:17Z vszakats $
#
LIBNAME = firebird
LIB_PATH = $(LIB_DIR)\$(LIBNAME)$(LIBEXT)
#
# LIB rules
#
LIB_OBJS = \
$(OBJ_DIR)\firebird$(OBJEXT) \
$(OBJ_DIR)\tfirebird$(OBJEXT) \
all: \
$(LIB_PATH) \
#
# $Id$
#
LIBNAME = firebird
LIB_PATH = $(LIB_DIR)\$(LIBNAME)$(LIBEXT)
#
# LIB rules
#
LIB_OBJS = \
$(OBJ_DIR)\firebird$(OBJEXT) \
$(OBJ_DIR)\tfirebird$(OBJEXT) \
all: \
$(LIB_PATH) \

1474
harbour/contrib/firebird/firebird.c
View File

File diff suppressed because it is too large Load Diff

2
harbour/contrib/firebird/make_b32.bat
View File

@@ -1,6 +1,6 @@
@echo off
rem
rem $Id: make_b32.bat 7974 2007-11-14 23:24:27Z vszakats $
rem $Id$
rem
rem ---------------------------------------------------------------

2
harbour/contrib/firebird/make_vc.bat
View File

@@ -1,6 +1,6 @@
@echo off
rem
rem $Id: make_vc.bat 7974 2007-11-14 23:24:27Z vszakats $
rem $Id$
rem
rem ---------------------------------------------------------------

108
harbour/contrib/firebird/readme.txt
View File

@@ -1,55 +1,55 @@
README 23/12/2003 - Harbour Low Level api for Firebird and Interbase RDBMS
This work is not finished yet. It's to be seem like Harbour TMysql routines.
To use with bcc, you need import library, ex: implib fbclient.lib fbclient.dll or implib gds32.lib gds32.dll.
On Linux you will need link fbclient.so, this can be found usually at /usr/lib.
For full firebird documentation look at:
Firebird home: http://firebird.sourceforge.net/index.php
Api: http://www.ibphoenix.com/downloads/60ApiGuide.zip
Data Definition: http://www.ibphoenix.com/downloads/60DataDef.zip
Language Reference: http://www.ibphoenix.com/downloads/60LangRef.zip
Developers guide: http://www.ibphoenix.com/downloads/60DevGuide.zip
The Class implementation has no all implementation like TMysql has, because Firebird it's diferent.
For example, you can't navigate in records like Mysql do, ex: Getrow( number of row ), in firebird you can
just go forward.
You will need ibase.h, it can be found at firebird/include
FILES:
firebird.c - Low level api
TFirebird.prg - Class implementation, it's to be seems like TMysql.
tests\simple.prg - Simple test class
tests\stress.prg - Stress test class
tests\test.prg - Testing using only low level api
tests\test.c - Pure C code to test firebird access.
TODO:
Full implementation of blob control. For now, we have only partial control, only for text blobs (sybtype 1).
Improve Insert and Update commands using DSQL.
Implements to do:
FBOpenBlob( blob_id )
FBReadBlob(blob_id, string, segment_size)
FBCreateBlob()
FBPutBlob(blob_id, string, segment_size)
FBCloseBlob( blob_id )
BUGS:
Fix a few windows gpf and linux segment fault. I Need some help to find what's going on here.
That's all folks and sorry my poor english
README 23/12/2003 - Harbour Low Level api for Firebird and Interbase RDBMS
This work is not finished yet. It's to be seem like Harbour TMysql routines.
To use with bcc, you need import library, ex: implib fbclient.lib fbclient.dll or implib gds32.lib gds32.dll.
On Linux you will need link fbclient.so, this can be found usually at /usr/lib.
For full firebird documentation look at:
Firebird home: http://firebird.sourceforge.net/index.php
Api: http://www.ibphoenix.com/downloads/60ApiGuide.zip
Data Definition: http://www.ibphoenix.com/downloads/60DataDef.zip
Language Reference: http://www.ibphoenix.com/downloads/60LangRef.zip
Developers guide: http://www.ibphoenix.com/downloads/60DevGuide.zip
The Class implementation has no all implementation like TMysql has, because Firebird it's diferent.
For example, you can't navigate in records like Mysql do, ex: Getrow( number of row ), in firebird you can
just go forward.
You will need ibase.h, it can be found at firebird/include
FILES:
firebird.c - Low level api
TFirebird.prg - Class implementation, it's to be seems like TMysql.
tests\simple.prg - Simple test class
tests\stress.prg - Stress test class
tests\test.prg - Testing using only low level api
tests\test.c - Pure C code to test firebird access.
TODO:
Full implementation of blob control. For now, we have only partial control, only for text blobs (sybtype 1).
Improve Insert and Update commands using DSQL.
Implements to do:
FBOpenBlob( blob_id )
FBReadBlob(blob_id, string, segment_size)
FBCreateBlob()
FBPutBlob(blob_id, string, segment_size)
FBCloseBlob( blob_id )
BUGS:
Fix a few windows gpf and linux segment fault. I Need some help to find what's going on here.
That's all folks and sorry my poor english
Rodrigo Moreno - rodrigo_moreno@yahoo.com

64
harbour/contrib/firebird/test/Makefile
View File

@@ -1,32 +1,32 @@
#
# $Id: Makefile,v 1.1 2003/12/31 00:24:35 lculik Exp $
#
ifeq ($(HB_MAIN),)
HB_MAIN = std
endif
ROOT = ../../../
CONTRIBS=\
firebird \
PRG_SOURCES=\
simple.prg \
PRG_MAIN=\
simple.prg
LIBS=\
debug \
vm \
rtl \
lang \
rdd \
rtl \
vm \
macro \
common \
fbclient \
include $(TOP)$(ROOT)config/bin.cf
#
# $Id$
#
ifeq ($(HB_MAIN),)
HB_MAIN = std
endif
ROOT = ../../../
CONTRIBS=\
firebird \
PRG_SOURCES=\
simple.prg \
PRG_MAIN=\
simple.prg
LIBS=\
debug \
vm \
rtl \
lang \
rdd \
rtl \
vm \
macro \
common \
fbclient \
include $(TOP)$(ROOT)config/bin.cf

2
harbour/contrib/firebird/test/bld_b32.bat
View File

@@ -1,6 +1,6 @@
@echo off
rem
rem $Id: bld_b32.bat 7941 2007-11-11 01:42:42Z vszakats $
rem $Id$
rem
if A%1 == A GOTO :SYNTAX

376
harbour/contrib/firebird/test/simple.prg
View File

@@ -1,188 +1,188 @@
/*
* $Id: atrepl.c 7583 2007-07-06 21:17:36Z druzus $
*/
#include "common.ch"
Function main()
Local oServer, oQuery, oRow, i, x, aTables, aStruct, aKey
Local cServer := '192.168.1.33:D:\firebird\test\test.gdb'
Local cUser := 'sysdba'
Local cPass := 'masterkey'
Local nDialect := 1
Local cQuery
if File('test.gdb')
FErase('test.gdb')
end
? FBCreateDB('test.gdb', cuser, cpass, 1024, 'ASCII', nDialect )
? "Connecting..."
oServer := TFBServer():New(cServer, cUser, cPass, nDialect)
if oServer:NetErr()
? oServer:Error()
quit
end
? 'Tables...'
For x := 1 to 1
aTables := oServer:ListTables()
For i := 1 to Len(aTables)
? aTables[i]
next
Next
? 'Using implicit transaction...'
if oServer:TableExists('TEST')
oServer:Execute('DROP TABLE Test')
oServer:Execute('DROP DOMAIN boolean_field')
end
? 'Creating domain for boolean fields...'
oServer:Execute('create domain boolean_field as smallint default 0 not null check (value in (0,1))')
oServer:StartTransaction()
? 'Creating test table...'
cQuery := 'CREATE TABLE test('
cQuery += ' Code SmallInt not null primary key, '
cQuery += ' dept Integer, '
cQuery += ' Name Varchar(40), '
cQuery += ' Sales boolean_field, '
cQuery += ' Tax Float, '
cQuery += ' Salary Double Precision, '
cQuery += ' Budget Numeric(12,2), '
cQuery += ' Discount Decimal(5,2), '
cQuery += ' Creation Date, '
cQuery += ' Description blob sub_type 1 segment size 40 ) '
oServer:Execute(cQuery)
if oServer:neterr()
? oServer:Error()
end
oServer:Commit()
oQuery := oServer:Query('SELECT code, dept, name, sales, salary, creation FROM test')
wait
? 'Structure of test table'
aStruct := oServer:TableStruct('test')
For i := 1 to Len(aStruct)
?
For x := 1 to Len(aStruct[i])
?? aStruct[i,x]
Next
next
? 'Inserting, declared transaction control '
oServer:StartTransaction()
For i := 1 to 100
cQuery := 'INSERT INTO test(code, dept, name, sales, tax, salary, budget, Discount, Creation, Description) '
cQuery += 'VALUES( ' + str(i) + ', 2, "TEST", 1, 5, 3000, 1500.2, 7.5, "12-22-2003", "Short Description about what ? ")'
oServer:Execute(cQuery)
if oServer:neterr()
? oServer:error()
end
Next
oServer:Commit()
oQuery := oServer:Query('SELECT code, name, description, sales FROM test')
aStruct := oQuery:Struct()
For i := 1 to Len(aStruct)
? aStruct[i,1], aStruct[i,2], aStruct[i,3], aStruct[i,4]
Next
aKey := oQuery:GetKeyField()
? "Fields: ", oQuery:Fcount(), "Primary Key: ", aKey[1]
oRow := oQuery:Blank()
? oRow:FCount(), ;
oRow:Fieldpos('code'), ;
oRow:Fieldget(1), ;
oRow:Fieldname(1), ;
oRow:Fieldtype(1), ;
oRow:Fielddec(1), ;
oRow:Fieldlen(1), ;
len(oRow:Getkeyfield())
oRow:Fieldput(1, 150)
oRow:Fieldput(2, 'MY TEST')
? oRow:Fieldget(1), oRow:Fieldget(2)
? oServer:Append(oRow)
? oServer:Delete(oQuery:blank(), 'code = 200')
? oServer:Execute('error caused intentionaly')
DO WHILE ! oQuery:Eof()
oQuery:Skip()
? oQuery:Fieldget(oQuery:Fieldpos('code')), ;
oQuery:Fieldget(4), ;
oQuery:Fieldget(2), ;
oQuery:Fieldname(1),;
oQuery:Fieldtype(1), ;
oQuery:Fielddec(1), ;
oQuery:Fieldlen(1),;
oQuery:Fieldget(3)
if oQuery:Recno() == 50
oRow := oQuery:getrow()
oRow:Fieldput(2, 'My Second test')
? 'Update: ', oServer:Update(oRow)
end
if oQuery:Recno() == 60
oRow := oQuery:getrow()
? 'Delete: ', oServer:Delete(oRow)
end
END
? 'Delete: ', oServer:Delete(oQuery:Blank(), 'code = 70')
oQuery:Refresh()
DO WHILE oQuery:Fetch()
oRow := oQuery:getrow()
? oRow:Fieldget(oRow:Fieldpos('code')), ;
oRow:Fieldget(4), ;
oRow:Fieldget(2), ;
oRow:Fieldname(1),;
oRow:Fieldtype(1), ;
oRow:Fielddec(1), ;
oRow:Fieldlen(1),;
oRow:Fieldget(3)
END
oQuery:Destroy()
oServer:Destroy()
? "Closing..."
return nil
/*
* $Id$
*/
#include "common.ch"
Function main()
Local oServer, oQuery, oRow, i, x, aTables, aStruct, aKey
Local cServer := '192.168.1.33:D:\firebird\test\test.gdb'
Local cUser := 'sysdba'
Local cPass := 'masterkey'
Local nDialect := 1
Local cQuery
if File('test.gdb')
FErase('test.gdb')
end
? FBCreateDB('test.gdb', cuser, cpass, 1024, 'ASCII', nDialect )
? "Connecting..."
oServer := TFBServer():New(cServer, cUser, cPass, nDialect)
if oServer:NetErr()
? oServer:Error()
quit
end
? 'Tables...'
For x := 1 to 1
aTables := oServer:ListTables()
For i := 1 to Len(aTables)
? aTables[i]
next
Next
? 'Using implicit transaction...'
if oServer:TableExists('TEST')
oServer:Execute('DROP TABLE Test')
oServer:Execute('DROP DOMAIN boolean_field')
end
? 'Creating domain for boolean fields...'
oServer:Execute('create domain boolean_field as smallint default 0 not null check (value in (0,1))')
oServer:StartTransaction()
? 'Creating test table...'
cQuery := 'CREATE TABLE test('
cQuery += ' Code SmallInt not null primary key, '
cQuery += ' dept Integer, '
cQuery += ' Name Varchar(40), '
cQuery += ' Sales boolean_field, '
cQuery += ' Tax Float, '
cQuery += ' Salary Double Precision, '
cQuery += ' Budget Numeric(12,2), '
cQuery += ' Discount Decimal(5,2), '
cQuery += ' Creation Date, '
cQuery += ' Description blob sub_type 1 segment size 40 ) '
oServer:Execute(cQuery)
if oServer:neterr()
? oServer:Error()
end
oServer:Commit()
oQuery := oServer:Query('SELECT code, dept, name, sales, salary, creation FROM test')
wait
? 'Structure of test table'
aStruct := oServer:TableStruct('test')
For i := 1 to Len(aStruct)
?
For x := 1 to Len(aStruct[i])
?? aStruct[i,x]
Next
next
? 'Inserting, declared transaction control '
oServer:StartTransaction()
For i := 1 to 100
cQuery := 'INSERT INTO test(code, dept, name, sales, tax, salary, budget, Discount, Creation, Description) '
cQuery += 'VALUES( ' + str(i) + ', 2, "TEST", 1, 5, 3000, 1500.2, 7.5, "12-22-2003", "Short Description about what ? ")'
oServer:Execute(cQuery)
if oServer:neterr()
? oServer:error()
end
Next
oServer:Commit()
oQuery := oServer:Query('SELECT code, name, description, sales FROM test')
aStruct := oQuery:Struct()
For i := 1 to Len(aStruct)
? aStruct[i,1], aStruct[i,2], aStruct[i,3], aStruct[i,4]
Next
aKey := oQuery:GetKeyField()
? "Fields: ", oQuery:Fcount(), "Primary Key: ", aKey[1]
oRow := oQuery:Blank()
? oRow:FCount(), ;
oRow:Fieldpos('code'), ;
oRow:Fieldget(1), ;
oRow:Fieldname(1), ;
oRow:Fieldtype(1), ;
oRow:Fielddec(1), ;
oRow:Fieldlen(1), ;
len(oRow:Getkeyfield())
oRow:Fieldput(1, 150)
oRow:Fieldput(2, 'MY TEST')
? oRow:Fieldget(1), oRow:Fieldget(2)
? oServer:Append(oRow)
? oServer:Delete(oQuery:blank(), 'code = 200')
? oServer:Execute('error caused intentionaly')
DO WHILE ! oQuery:Eof()
oQuery:Skip()
? oQuery:Fieldget(oQuery:Fieldpos('code')), ;
oQuery:Fieldget(4), ;
oQuery:Fieldget(2), ;
oQuery:Fieldname(1),;
oQuery:Fieldtype(1), ;
oQuery:Fielddec(1), ;
oQuery:Fieldlen(1),;
oQuery:Fieldget(3)
if oQuery:Recno() == 50
oRow := oQuery:getrow()
oRow:Fieldput(2, 'My Second test')
? 'Update: ', oServer:Update(oRow)
end
if oQuery:Recno() == 60
oRow := oQuery:getrow()
? 'Delete: ', oServer:Delete(oRow)
end
END
? 'Delete: ', oServer:Delete(oQuery:Blank(), 'code = 70')
oQuery:Refresh()
DO WHILE oQuery:Fetch()
oRow := oQuery:getrow()
? oRow:Fieldget(oRow:Fieldpos('code')), ;
oRow:Fieldget(4), ;
oRow:Fieldget(2), ;
oRow:Fieldname(1),;
oRow:Fieldtype(1), ;
oRow:Fielddec(1), ;
oRow:Fieldlen(1),;
oRow:Fieldget(3)
END
oQuery:Destroy()
oServer:Destroy()
? "Closing..."
return nil

268
harbour/contrib/firebird/test/stress.prg
View File

@@ -1,134 +1,134 @@
/*
* $Id: atrepl.c 7583 2007-07-06 21:17:36Z druzus $
*/
/* VERY IMPORTANT: Don't use this querys as sample, they are used for stress tests !!! */
Function Main()
Local oServer, oQuery, oRow, i, x
Local cServer := '192.168.1.33:D:\firebird\test\test2.gdb'
Local cUser := 'sysdba'
Local cPass := 'masterkey'
Local nDialect := 1
Local cQuery
CLEAR SCREEN
if ! File('test2.gdb') .and. .F.
? FBCreateDB('test2.gdb', cuser, cpass, 1024, 'WIN1251', nDialect )
end
? "Connecting..."
oServer := TFBServer():New(cServer, cUser, cPass, nDialect)
if oServer:NetErr()
? oServer:Error()
quit
end
if oServer:TableExists('test')
? oServer:Execute('DROP TABLE Test')
? oServer:Execute('DROP DOMAIN boolean_field')
end
? 'Creating domain for boolean fields...'
? oServer:Execute('create domain boolean_field as smallint default 0 not null check (value in (0,1))')
? 'Creating test table...'
cQuery := 'CREATE TABLE test('
cQuery += ' Code SmallInt not null primary key, '
cQuery += ' dept Integer, '
cQuery += ' Name Varchar(40), '
cQuery += ' Sales boolean_field, '
cQuery += ' Tax Float, '
cQuery += ' Salary Double Precision, '
cQuery += ' Budget Numeric(12,2), '
cQuery += ' Discount Decimal(5,2), '
cQuery += ' Creation Date, '
cQuery += ' Description blob sub_type 1 segment size 40 ) '
? oServer:Execute(cQuery)
quit
oQuery := oServer:Query('SELECT code, dept, name, sales, salary, creation FROM test')
oServer:StartTransaction()
For i := 1 to 10000
@ 15,0 say 'Inserting values....' + str(i)
oRow := oQuery:Blank()
oRow:Fieldput(1, i)
oRow:Fieldput(2, i+1)
oRow:Fieldput(3, 'DEPARTMENT NAME ' + strzero(i) )
oRow:Fieldput(4, (mod(i,10) == 0) )
oRow:Fieldput(5, 3000 + i )
oRow:fieldput(6, Date() )
oServer:Append(oRow)
if mod(i,100) == 0
oServer:Commit()
oServer:StartTransaction()
end
Next
For i := 5000 to 7000
@ 16,0 say 'Deleting values....' + str(i)
oRow := oQuery:Blank()
oServer:Delete(oRow, 'code = ' + str(i))
if mod(i,100) == 0
oServer:Commit()
oServer:StartTransaction()
end
Next
For i := 2000 to 3000
@ 17,0 say 'Updating values....' + str(i)
oRow := oQuery:Blank()
oRow:Fieldput(5, 4000+i)
oServer:update(oRow, 'code = ' + str(i))
if mod(i,100) == 0
oServer:Commit()
oServer:StartTransaction()
end
Next
oQuery := oServer:Query('SELECT sum(salary) sum_salary FROM test WHERE code between 1 and 4000')
if ! oQuery:Neterr()
oQuery:Fetch()
@ 18,0 say 'Sum values....' + Str(oQuery:Fieldget(1))
oQuery:Destroy()
end
x := 0
For i := 1 to 4000
oQuery := oServer:Query('SELECT * FROM test WHERE code = ' + str(i))
if ! oQuery:Neterr()
oQuery:Fetch()
oRow := oQuery:getrow()
oQuery:destroy()
x += oRow:fieldget(oRow:fieldpos('salary'))
@ 19,0 say 'Sum values....' + str(x)
end
Next
oServer:Destroy()
? "Closing..."
return nil
/*
* $Id$
*/
/* VERY IMPORTANT: Don't use this querys as sample, they are used for stress tests !!! */
Function Main()
Local oServer, oQuery, oRow, i, x
Local cServer := '192.168.1.33:D:\firebird\test\test2.gdb'
Local cUser := 'sysdba'
Local cPass := 'masterkey'
Local nDialect := 1
Local cQuery
CLEAR SCREEN
if ! File('test2.gdb') .and. .F.
? FBCreateDB('test2.gdb', cuser, cpass, 1024, 'WIN1251', nDialect )
end
? "Connecting..."
oServer := TFBServer():New(cServer, cUser, cPass, nDialect)
if oServer:NetErr()
? oServer:Error()
quit
end
if oServer:TableExists('test')
? oServer:Execute('DROP TABLE Test')
? oServer:Execute('DROP DOMAIN boolean_field')
end
? 'Creating domain for boolean fields...'
? oServer:Execute('create domain boolean_field as smallint default 0 not null check (value in (0,1))')
? 'Creating test table...'
cQuery := 'CREATE TABLE test('
cQuery += ' Code SmallInt not null primary key, '
cQuery += ' dept Integer, '
cQuery += ' Name Varchar(40), '
cQuery += ' Sales boolean_field, '
cQuery += ' Tax Float, '
cQuery += ' Salary Double Precision, '
cQuery += ' Budget Numeric(12,2), '
cQuery += ' Discount Decimal(5,2), '
cQuery += ' Creation Date, '
cQuery += ' Description blob sub_type 1 segment size 40 ) '
? oServer:Execute(cQuery)
quit
oQuery := oServer:Query('SELECT code, dept, name, sales, salary, creation FROM test')
oServer:StartTransaction()
For i := 1 to 10000
@ 15,0 say 'Inserting values....' + str(i)
oRow := oQuery:Blank()
oRow:Fieldput(1, i)
oRow:Fieldput(2, i+1)
oRow:Fieldput(3, 'DEPARTMENT NAME ' + strzero(i) )
oRow:Fieldput(4, (mod(i,10) == 0) )
oRow:Fieldput(5, 3000 + i )
oRow:fieldput(6, Date() )
oServer:Append(oRow)
if mod(i,100) == 0
oServer:Commit()
oServer:StartTransaction()
end
Next
For i := 5000 to 7000
@ 16,0 say 'Deleting values....' + str(i)
oRow := oQuery:Blank()
oServer:Delete(oRow, 'code = ' + str(i))
if mod(i,100) == 0
oServer:Commit()
oServer:StartTransaction()
end
Next
For i := 2000 to 3000
@ 17,0 say 'Updating values....' + str(i)
oRow := oQuery:Blank()
oRow:Fieldput(5, 4000+i)
oServer:update(oRow, 'code = ' + str(i))
if mod(i,100) == 0
oServer:Commit()
oServer:StartTransaction()
end
Next
oQuery := oServer:Query('SELECT sum(salary) sum_salary FROM test WHERE code between 1 and 4000')
if ! oQuery:Neterr()
oQuery:Fetch()
@ 18,0 say 'Sum values....' + Str(oQuery:Fieldget(1))
oQuery:Destroy()
end
x := 0
For i := 1 to 4000
oQuery := oServer:Query('SELECT * FROM test WHERE code = ' + str(i))
if ! oQuery:Neterr()
oQuery:Fetch()
oRow := oQuery:getrow()
oQuery:destroy()
x += oRow:fieldget(oRow:fieldpos('salary'))
@ 19,0 say 'Sum values....' + str(x)
end
Next
oServer:Destroy()
? "Closing..."
return nil

154
harbour/contrib/firebird/test/test.prg
View File

@@ -1,77 +1,77 @@
/*
* $Id: atrepl.c 7583 2007-07-06 21:17:36Z druzus $
*/
#include "common.ch"
Function Main()
nDialect := 1
if File('test.gdb')
FErase('test.gdb')
end
? FBCreateDB('test.gdb','sysdba', 'masterkey', 1024, 'ASCII', nDialect )
/* Connect rdbms */
db := FBConnect("127.0.0.1:d:\firebird\test\test.gdb", "sysdba", "masterkey")
if ISNUMBER(db)
? 'Error'
quit
end
? FBExecute(db, 'sldjfs;ldjs;djf', dialect)
? FBClose(db)
trans := FBStartTransaction(db)
qry := FBQuery(db, 'create table teste (code smallint)', dialect, trans)
FBCommit(trans)
? "Status Execute: ", FBExecute( db, 'insert into customer(customer) values ("test 1")', dialect, trans)
? "Status no Rollback: ", FBRollback(trans)
trans := FBStartTransaction(db)
? "Status Execute: ", FBExecute( db, 'insert into customer(customer) values ("test 2")', dialect, trans )
? "Status commit: ", FBCommit(trans)
? "Status Execute: ", FBExecute( db, 'insert into customer(customer) values ("test 3")', dialect )
// FIX WINDOWS GPF BELOW
qry := FBQuery(db, "SELECT * FROM sales", dialect)
num_cols := qry[4]
columns := qry[6]
For x := 1 to num_cols
? x, "> "
For y := 1 to len(columns[x])
?? columns[x,y], ' '
Next
Next
? '---'
do while (fetch_stat := FBFetch(qry)) == 0
? fetch_stat
for x := 1 to num_cols
?? FBGetData(qry,x), ', '
next
end
? 'Fetch code:', fetch_stat
? "Status Free sql: ", FBFree(qry)
/* Close connection with rdbms */
? "Status Fechar Database: ", FBClose(db)
Return Nil
/*
* $Id$
*/
#include "common.ch"
Function Main()
nDialect := 1
if File('test.gdb')
FErase('test.gdb')
end
? FBCreateDB('test.gdb','sysdba', 'masterkey', 1024, 'ASCII', nDialect )
/* Connect rdbms */
db := FBConnect("127.0.0.1:d:\firebird\test\test.gdb", "sysdba", "masterkey")
if ISNUMBER(db)
? 'Error'
quit
end
? FBExecute(db, 'sldjfs;ldjs;djf', dialect)
? FBClose(db)
trans := FBStartTransaction(db)
qry := FBQuery(db, 'create table teste (code smallint)', dialect, trans)
FBCommit(trans)
? "Status Execute: ", FBExecute( db, 'insert into customer(customer) values ("test 1")', dialect, trans)
? "Status no Rollback: ", FBRollback(trans)
trans := FBStartTransaction(db)
? "Status Execute: ", FBExecute( db, 'insert into customer(customer) values ("test 2")', dialect, trans )
? "Status commit: ", FBCommit(trans)
? "Status Execute: ", FBExecute( db, 'insert into customer(customer) values ("test 3")', dialect )
// FIX WINDOWS GPF BELOW
qry := FBQuery(db, "SELECT * FROM sales", dialect)
num_cols := qry[4]
columns := qry[6]
For x := 1 to num_cols
? x, "> "
For y := 1 to len(columns[x])
?? columns[x,y], ' '
Next
Next
? '---'
do while (fetch_stat := FBFetch(qry)) == 0
? fetch_stat
for x := 1 to num_cols
?? FBGetData(qry,x), ', '
next
end
? 'Fetch code:', fetch_stat
? "Status Free sql: ", FBFree(qry)
/* Close connection with rdbms */
? "Status Fechar Database: ", FBClose(db)
Return Nil

806
harbour/contrib/firebird/test/testapi.c
View File

@@ -1,403 +1,403 @@
/*
* $Id: atrepl.c 7583 2007-07-06 21:17:36Z druzus $
*/
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#include <time.h>
#include <ibase.h>
#include <iberror.h>
#ifndef ISC_INT64_FORMAT
#if (defined(_MSC_VER) && defined(WIN32)) || (defined(__BORLANDC__) && defined(__WIN32__))
#define ISC_INT64_FORMAT "I64"
#else
#define ISC_INT64_FORMAT "ll"
#endif
#endif
#define USER "sysdba"
#define PASSWORD "masterkey"
#define DATABASE "192.168.1.33:d:\\fontes\\lixo\\test.gdb"
#define ERREXIT(status, rc) {isc_print_status(status); return rc;}
#define MAX_BUFFER 1024
int execute( char *exec_str );
int query( char *sel_str );
int fetch( void );
int qclose( void );
char *getdata(int pos);
isc_db_handle db = NULL;
int dialect = 1;
XSQLDA ISC_FAR * sqlda;
isc_stmt_handle stmt = NULL;
isc_tr_handle trans = NULL;
int main ()
{
char dpb[48];
int i = 0, len;
long status[20];
dpb[i++] = isc_dpb_version1;
dpb[i++] = isc_dpb_user_name;
len = strlen(USER);
dpb[i++] = (char) len;
strncpy(&(dpb[i]), USER, len);
i += len;
dpb[i++] = isc_dpb_password;
len = strlen (PASSWORD);
dpb[i++] = len;
strncpy(&(dpb[i]), PASSWORD, len);
i += len;
if (isc_attach_database(status, 0, DATABASE, &db, i, dpb))
ERREXIT(status, 1);
execute("DROP TABLE TESTE");
execute("CREATE TABLE TESTE (code smallint)");
execute("INSERT INTO TESTE (code) VALUES (100)");
query("SELECT * FROM TESTE");
while (fetch() == 0)
printf("%s\n", getdata(0));
qclose();
if (isc_detach_database(status, &db))
ERREXIT(status, 1);
return 1;
}
int execute( char *exec_str )
{
isc_tr_handle trans = NULL;
long status[20];
if (isc_start_transaction(status, &trans, 1, &db, 0, NULL))
ERREXIT(status, 1);
if (isc_dsql_execute_immediate(status, &db, &trans, 0, exec_str, dialect, NULL))
ERREXIT(status, 1);
if (isc_commit_transaction(status, &trans))
ERREXIT(status, 1);
return 1;
}
int query( char *sel_str )
{
ISC_STATUS status[20];
XSQLVAR *var;
int n, i, dtype;
if ( isc_start_transaction ( status, &trans, 1, &db, 0, NULL ) )
ERREXIT(status, 1);
// Allocate an output SQLDA. Just to check number of columns
sqlda = ( XSQLDA * ) malloc( XSQLDA_LENGTH ( 1 ) );
sqlda->sqln = 1;
sqlda->version = 1;
// Allocate a statement
if (isc_dsql_allocate_statement(status, &db, &stmt))
ERREXIT(status, 1);
// Prepare the statement.
if (isc_dsql_prepare(status, &trans, &stmt, 0, sel_str, dialect, sqlda))
ERREXIT(status, 1);
// Describe sql contents
if (isc_dsql_describe(status, &stmt, dialect, sqlda))
ERREXIT(status, 1);
// Relocate necessary number of columns
if ( sqlda->sqld > sqlda->sqln ) {
free( sqlda );
n = sqlda->sqld;
sqlda = ( XSQLDA * ) malloc( XSQLDA_LENGTH ( n ) );
sqlda->sqln = n;
sqlda->version = 1;
if (isc_dsql_describe(status, &stmt, dialect, sqlda))
ERREXIT(status, 1);
}
for ( i = 0, var = sqlda->sqlvar; i < sqlda->sqld; i++, var++ ) {
dtype = ( var->sqltype & ~1 );
switch ( dtype ) {
case SQL_VARYING:
var->sqltype = SQL_TEXT;
var->sqldata = ( char * ) malloc( sizeof ( char ) * var->sqllen + 2 );
break;
case SQL_TEXT:
var->sqldata = ( char * ) malloc( sizeof ( char ) * var->sqllen + 2 );
break;
case SQL_LONG:
var->sqltype = SQL_LONG;
var->sqldata = ( char * ) malloc( sizeof ( long ) );
break;
default:
var->sqldata = ( char * ) malloc( sizeof ( char ) * var->sqllen );
break;
}
if ( var->sqltype & 1 ) {
var->sqlind = ( short * ) malloc( sizeof ( short ) );
}
}
if ( !sqlda->sqld ) {
// Execute and commit non-select querys
if ( isc_dsql_execute ( status, &trans, &stmt, dialect, NULL ) )
ERREXIT(status, 1);
if (isc_commit_transaction(status, &trans))
ERREXIT(status, 1);
trans = NULL;
} else {
if ( isc_dsql_execute ( status, &trans, &stmt, dialect, sqlda ) )
ERREXIT(status, 1);
}
return 1;
}
int fetch( void )
{
long fetch_stat;
long status[20];
fetch_stat = isc_dsql_fetch(status, &stmt, dialect, sqlda);
if (fetch_stat != 100L)
ERREXIT(status, 1);
return fetch_stat;
}
int qclose( void )
{
long status[20];
if (isc_dsql_free_statement(status, &stmt, DSQL_drop))
ERREXIT(status, 1);
if (trans)
if (isc_commit_transaction(status, &trans))
ERREXIT(status, 1);
if ( sqlda )
free( sqlda );
return 1;
}
char *getdata(int pos)
{
short dtype;
char data[MAX_BUFFER], *p;
char blob_s[20], date_s[25];
short len;
long status[20];
struct tm times;
ISC_QUAD bid;
XSQLVAR *var;
if ( ( pos + 1 ) > sqlda->sqln )
return "error";
var = sqlda->sqlvar;
var += pos;
dtype = var->sqltype & ~1;
p = data;
if ( ( var->sqltype & 1 ) && ( *var->sqlind < 0 ) ) {
switch ( dtype ) {
case SQL_TEXT:
case SQL_VARYING:
len = var->sqllen;
break;
case SQL_SHORT:
len = 6;
if ( var->sqlscale > 0 )
len += var->sqlscale;
break;
case SQL_LONG:
len = 11;
if ( var->sqlscale > 0 )
len += var->sqlscale;
break;
case SQL_INT64:
len = 21;
if ( var->sqlscale > 0 )
len += var->sqlscale;
break;
case SQL_FLOAT:
len = 15;
break;
case SQL_DOUBLE:
len = 24;
break;
case SQL_TIMESTAMP:
len = 24;
break;
case SQL_TYPE_DATE:
len = 10;
break;
case SQL_TYPE_TIME:
len = 13;
break;
case SQL_BLOB:
case SQL_ARRAY:
default:
len = 17;
break;
}
if ( ( dtype == SQL_TEXT ) || ( dtype == SQL_VARYING ) )
sprintf ( p, "%-*s ", len, "NULL" );
else
sprintf ( p, "%*s ", len, "NULL" );
} else {
switch ( dtype ) {
case SQL_TEXT:
sprintf ( p, "%.*s ", var->sqllen, var->sqldata );
break;
case SQL_VARYING:
sprintf ( p, "%.*s ", var->sqllen, var->sqldata );
break;
case SQL_SHORT:
case SQL_LONG:
case SQL_INT64:
{
ISC_INT64 value = 0;
short field_width = 0;
short dscale;
switch ( dtype ) {
case SQL_SHORT:
value = ( ISC_INT64 ) * ( short ISC_FAR * ) var->sqldata;
field_width = 6;
break;
case SQL_LONG:
value = ( ISC_INT64 ) * ( long ISC_FAR * ) var->sqldata;
field_width = 11;
break;
case SQL_INT64:
value = ( ISC_INT64 ) * ( ISC_INT64 ISC_FAR * ) var->sqldata;
field_width = 21;
break;
}
dscale = var->sqlscale;
if ( dscale < 0 ) {
ISC_INT64 tens;
short i;
tens = 1;
for ( i = 0; i > dscale; i-- ) {
tens *= 10;
if ( value >= 0 ) {
sprintf ( p,
"%*" ISC_INT64_FORMAT "d.%0*"
ISC_INT64_FORMAT "d",
field_width - 1 + dscale,
( ISC_INT64 ) ( value / tens ), -dscale,
( ISC_INT64 ) ( value % tens ) );
} else if ( ( value / tens ) != 0 ) {
sprintf ( p,
"%*" ISC_INT64_FORMAT "d.%0*"
ISC_INT64_FORMAT "d",
field_width - 1 + dscale,
( ISC_INT64 ) ( value / tens ), -dscale,
( ISC_INT64 ) - ( value % tens ) );
} else {
sprintf ( p, "%*s.%0*" ISC_INT64_FORMAT "d",
field_width - 1 + dscale,
"-0", -dscale,
( ISC_INT64 ) - ( value % tens ) );
}
}
} else if ( dscale ) {
sprintf ( p, "%*" ISC_INT64_FORMAT "d%0*d",
field_width, ( ISC_INT64 ) value, dscale, 0 );
} else {
sprintf ( p, "%*" ISC_INT64_FORMAT "d",
field_width, ( ISC_INT64 ) value );
}
};
break;
case SQL_FLOAT:
sprintf ( p, "%15g ", *( float ISC_FAR * ) ( var->sqldata ) );
break;
case SQL_DOUBLE:
sprintf ( p, "%24f ", *( double ISC_FAR * ) ( var->sqldata ) );
break;
case SQL_TIMESTAMP:
isc_decode_timestamp ( ( ISC_TIMESTAMP ISC_FAR * ) var->sqldata, &times );
sprintf ( date_s, "%04d-%02d-%02d %02d:%02d:%02d.%04lui",
times.tm_year + 1900,
times.tm_mon + 1,
times.tm_mday,
times.tm_hour,
times.tm_min,
times.tm_sec,
( ( ISC_TIMESTAMP * ) var->sqldata )->timestamp_time % 10000 );
sprintf ( p, "%*s ", 24, date_s );
break;
case SQL_TYPE_DATE:
isc_decode_sql_date ( ( ISC_DATE ISC_FAR * ) var->sqldata, &times );
sprintf ( date_s, "%04d-%02d-%02d",
times.tm_year + 1900, times.tm_mon + 1, times.tm_mday );
sprintf ( p, "%*s ", 10, date_s );
break;
case SQL_TYPE_TIME:
isc_decode_sql_time ( ( ISC_TIME ISC_FAR * ) var->sqldata, &times );
sprintf ( date_s, "%02d:%02d:%02d.%04lui",
times.tm_hour,
times.tm_min,
times.tm_sec, ( *( ( ISC_TIME * ) var->sqldata ) ) % 10000 );
sprintf ( p, "%*s ", 13, date_s );
break;
case SQL_BLOB:
case SQL_ARRAY:
/* Print the blob id on blobs or arrays */
bid = *( ISC_QUAD ISC_FAR * ) var->sqldata;
sprintf ( blob_s, "%08x:%08x", ( unsigned int ) bid.gds_quad_high,
( unsigned int ) bid.gds_quad_low );
sprintf ( p, "%17s ", blob_s );
break;
default:
break;
}
}
return ( p );
}
/*
* $Id$
*/
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#include <time.h>
#include <ibase.h>
#include <iberror.h>
#ifndef ISC_INT64_FORMAT
#if (defined(_MSC_VER) && defined(WIN32)) || (defined(__BORLANDC__) && defined(__WIN32__))
#define ISC_INT64_FORMAT "I64"
#else
#define ISC_INT64_FORMAT "ll"
#endif
#endif
#define USER "sysdba"
#define PASSWORD "masterkey"
#define DATABASE "192.168.1.33:d:\\fontes\\lixo\\test.gdb"
#define ERREXIT(status, rc) {isc_print_status(status); return rc;}
#define MAX_BUFFER 1024
int execute( char *exec_str );
int query( char *sel_str );
int fetch( void );
int qclose( void );
char *getdata(int pos);
isc_db_handle db = NULL;
int dialect = 1;
XSQLDA ISC_FAR * sqlda;
isc_stmt_handle stmt = NULL;
isc_tr_handle trans = NULL;
int main ()
{
char dpb[48];
int i = 0, len;
long status[20];
dpb[i++] = isc_dpb_version1;
dpb[i++] = isc_dpb_user_name;
len = strlen(USER);
dpb[i++] = (char) len;
strncpy(&(dpb[i]), USER, len);
i += len;
dpb[i++] = isc_dpb_password;
len = strlen (PASSWORD);
dpb[i++] = len;
strncpy(&(dpb[i]), PASSWORD, len);
i += len;
if (isc_attach_database(status, 0, DATABASE, &db, i, dpb))
ERREXIT(status, 1);
execute("DROP TABLE TESTE");
execute("CREATE TABLE TESTE (code smallint)");
execute("INSERT INTO TESTE (code) VALUES (100)");
query("SELECT * FROM TESTE");
while (fetch() == 0)
printf("%s\n", getdata(0));
qclose();
if (isc_detach_database(status, &db))
ERREXIT(status, 1);
return 1;
}
int execute( char *exec_str )
{
isc_tr_handle trans = NULL;
long status[20];
if (isc_start_transaction(status, &trans, 1, &db, 0, NULL))
ERREXIT(status, 1);
if (isc_dsql_execute_immediate(status, &db, &trans, 0, exec_str, dialect, NULL))
ERREXIT(status, 1);
if (isc_commit_transaction(status, &trans))
ERREXIT(status, 1);
return 1;
}
int query( char *sel_str )
{
ISC_STATUS status[20];
XSQLVAR *var;
int n, i, dtype;
if ( isc_start_transaction ( status, &trans, 1, &db, 0, NULL ) )
ERREXIT(status, 1);
// Allocate an output SQLDA. Just to check number of columns
sqlda = ( XSQLDA * ) malloc( XSQLDA_LENGTH ( 1 ) );
sqlda->sqln = 1;
sqlda->version = 1;
// Allocate a statement
if (isc_dsql_allocate_statement(status, &db, &stmt))
ERREXIT(status, 1);
// Prepare the statement.
if (isc_dsql_prepare(status, &trans, &stmt, 0, sel_str, dialect, sqlda))
ERREXIT(status, 1);
// Describe sql contents
if (isc_dsql_describe(status, &stmt, dialect, sqlda))
ERREXIT(status, 1);
// Relocate necessary number of columns
if ( sqlda->sqld > sqlda->sqln ) {
free( sqlda );
n = sqlda->sqld;
sqlda = ( XSQLDA * ) malloc( XSQLDA_LENGTH ( n ) );
sqlda->sqln = n;
sqlda->version = 1;
if (isc_dsql_describe(status, &stmt, dialect, sqlda))
ERREXIT(status, 1);
}
for ( i = 0, var = sqlda->sqlvar; i < sqlda->sqld; i++, var++ ) {
dtype = ( var->sqltype & ~1 );
switch ( dtype ) {
case SQL_VARYING:
var->sqltype = SQL_TEXT;
var->sqldata = ( char * ) malloc( sizeof ( char ) * var->sqllen + 2 );
break;
case SQL_TEXT:
var->sqldata = ( char * ) malloc( sizeof ( char ) * var->sqllen + 2 );
break;
case SQL_LONG:
var->sqltype = SQL_LONG;
var->sqldata = ( char * ) malloc( sizeof ( long ) );
break;
default:
var->sqldata = ( char * ) malloc( sizeof ( char ) * var->sqllen );
break;
}
if ( var->sqltype & 1 ) {
var->sqlind = ( short * ) malloc( sizeof ( short ) );
}
}
if ( !sqlda->sqld ) {
// Execute and commit non-select querys
if ( isc_dsql_execute ( status, &trans, &stmt, dialect, NULL ) )
ERREXIT(status, 1);
if (isc_commit_transaction(status, &trans))
ERREXIT(status, 1);
trans = NULL;
} else {
if ( isc_dsql_execute ( status, &trans, &stmt, dialect, sqlda ) )
ERREXIT(status, 1);
}
return 1;
}
int fetch( void )
{
long fetch_stat;
long status[20];
fetch_stat = isc_dsql_fetch(status, &stmt, dialect, sqlda);
if (fetch_stat != 100L)
ERREXIT(status, 1);
return fetch_stat;
}
int qclose( void )
{
long status[20];
if (isc_dsql_free_statement(status, &stmt, DSQL_drop))
ERREXIT(status, 1);
if (trans)
if (isc_commit_transaction(status, &trans))
ERREXIT(status, 1);
if ( sqlda )
free( sqlda );
return 1;
}
char *getdata(int pos)
{
short dtype;
char data[MAX_BUFFER], *p;
char blob_s[20], date_s[25];
short len;
long status[20];
struct tm times;
ISC_QUAD bid;
XSQLVAR *var;
if ( ( pos + 1 ) > sqlda->sqln )
return "error";
var = sqlda->sqlvar;
var += pos;
dtype = var->sqltype & ~1;
p = data;
if ( ( var->sqltype & 1 ) && ( *var->sqlind < 0 ) ) {
switch ( dtype ) {
case SQL_TEXT:
case SQL_VARYING:
len = var->sqllen;
break;
case SQL_SHORT:
len = 6;
if ( var->sqlscale > 0 )
len += var->sqlscale;
break;
case SQL_LONG:
len = 11;
if ( var->sqlscale > 0 )
len += var->sqlscale;
break;
case SQL_INT64:
len = 21;
if ( var->sqlscale > 0 )
len += var->sqlscale;
break;
case SQL_FLOAT:
len = 15;
break;
case SQL_DOUBLE:
len = 24;
break;
case SQL_TIMESTAMP:
len = 24;
break;
case SQL_TYPE_DATE:
len = 10;
break;
case SQL_TYPE_TIME:
len = 13;
break;
case SQL_BLOB:
case SQL_ARRAY:
default:
len = 17;
break;
}
if ( ( dtype == SQL_TEXT ) || ( dtype == SQL_VARYING ) )
sprintf ( p, "%-*s ", len, "NULL" );
else
sprintf ( p, "%*s ", len, "NULL" );
} else {
switch ( dtype ) {
case SQL_TEXT:
sprintf ( p, "%.*s ", var->sqllen, var->sqldata );
break;
case SQL_VARYING:
sprintf ( p, "%.*s ", var->sqllen, var->sqldata );
break;
case SQL_SHORT:
case SQL_LONG:
case SQL_INT64:
{
ISC_INT64 value = 0;
short field_width = 0;
short dscale;
switch ( dtype ) {
case SQL_SHORT:
value = ( ISC_INT64 ) * ( short ISC_FAR * ) var->sqldata;
field_width = 6;
break;
case SQL_LONG:
value = ( ISC_INT64 ) * ( long ISC_FAR * ) var->sqldata;
field_width = 11;
break;
case SQL_INT64:
value = ( ISC_INT64 ) * ( ISC_INT64 ISC_FAR * ) var->sqldata;
field_width = 21;
break;
}
dscale = var->sqlscale;
if ( dscale < 0 ) {
ISC_INT64 tens;
short i;
tens = 1;
for ( i = 0; i > dscale; i-- ) {
tens *= 10;
if ( value >= 0 ) {
sprintf ( p,
"%*" ISC_INT64_FORMAT "d.%0*"
ISC_INT64_FORMAT "d",
field_width - 1 + dscale,
( ISC_INT64 ) ( value / tens ), -dscale,
( ISC_INT64 ) ( value % tens ) );
} else if ( ( value / tens ) != 0 ) {
sprintf ( p,
"%*" ISC_INT64_FORMAT "d.%0*"
ISC_INT64_FORMAT "d",
field_width - 1 + dscale,
( ISC_INT64 ) ( value / tens ), -dscale,
( ISC_INT64 ) - ( value % tens ) );
} else {
sprintf ( p, "%*s.%0*" ISC_INT64_FORMAT "d",
field_width - 1 + dscale,
"-0", -dscale,
( ISC_INT64 ) - ( value % tens ) );
}
}
} else if ( dscale ) {
sprintf ( p, "%*" ISC_INT64_FORMAT "d%0*d",
field_width, ( ISC_INT64 ) value, dscale, 0 );
} else {
sprintf ( p, "%*" ISC_INT64_FORMAT "d",
field_width, ( ISC_INT64 ) value );
}
};
break;
case SQL_FLOAT:
sprintf ( p, "%15g ", *( float ISC_FAR * ) ( var->sqldata ) );
break;
case SQL_DOUBLE:
sprintf ( p, "%24f ", *( double ISC_FAR * ) ( var->sqldata ) );
break;
case SQL_TIMESTAMP:
isc_decode_timestamp ( ( ISC_TIMESTAMP ISC_FAR * ) var->sqldata, &times );
sprintf ( date_s, "%04d-%02d-%02d %02d:%02d:%02d.%04lui",
times.tm_year + 1900,
times.tm_mon + 1,
times.tm_mday,
times.tm_hour,
times.tm_min,
times.tm_sec,
( ( ISC_TIMESTAMP * ) var->sqldata )->timestamp_time % 10000 );
sprintf ( p, "%*s ", 24, date_s );
break;
case SQL_TYPE_DATE:
isc_decode_sql_date ( ( ISC_DATE ISC_FAR * ) var->sqldata, &times );
sprintf ( date_s, "%04d-%02d-%02d",
times.tm_year + 1900, times.tm_mon + 1, times.tm_mday );
sprintf ( p, "%*s ", 10, date_s );
break;
case SQL_TYPE_TIME:
isc_decode_sql_time ( ( ISC_TIME ISC_FAR * ) var->sqldata, &times );
sprintf ( date_s, "%02d:%02d:%02d.%04lui",
times.tm_hour,
times.tm_min,
times.tm_sec, ( *( ( ISC_TIME * ) var->sqldata ) ) % 10000 );
sprintf ( p, "%*s ", 13, date_s );
break;
case SQL_BLOB:
case SQL_ARRAY:
/* Print the blob id on blobs or arrays */
bid = *( ISC_QUAD ISC_FAR * ) var->sqldata;
sprintf ( blob_s, "%08x:%08x", ( unsigned int ) bid.gds_quad_high,
( unsigned int ) bid.gds_quad_low );
sprintf ( p, "%17s ", blob_s );
break;
default:
break;
}
}
return ( p );
}

2126
harbour/contrib/firebird/tfirebird.prg
View File

File diff suppressed because it is too large Load Diff

15
harbour/contrib/freeimage/Makefile Normal file
View File

@@ -0,0 +1,15 @@
#
# $Id$
#
ROOT = ../../
C_SOURCES = \
fi_winfu.c \
fi_wrp.c \
PRG_SOURCES= \
LIBNAME=fi_lib
include $(TOP)$(ROOT)config/lib.cf

18
harbour/contrib/freeimage/common.mak Normal file
View File

@@ -0,0 +1,18 @@
#
# $Id$
#
LIBNAME = fi_lib
LIB_PATH = $(LIB_DIR)\$(LIBNAME)$(LIBEXT)
#
# LIB rules
#
LIB_OBJS = \
$(OBJ_DIR)\fi_winfu$(OBJEXT) \
$(OBJ_DIR)\fi_wrp$(OBJEXT) \
all: \
$(LIB_PATH) \

245
harbour/contrib/freeimage/fi_winfu.c Normal file
View File

@@ -0,0 +1,245 @@
/*
* $Id$
*/
/*
* xHarbour Project source code:
* FreeImage windows specific functions.
*
* Copyright 2005 Francesco Saverio Giudice <info@fsgiudice.com>
* www - http://www.xharbour.org http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
/*
*
* See doc/license files for licensing terms.
*
*/
/* NOTE: we need this to prevent base types redefinition */
#define _CLIPDEFS_H
#if defined(HB_OS_WIN_32_USED)
#include <windows.h>
#endif
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbstack.h"
#include "hbapierr.h"
#include "hbapifs.h"
//#include "hrbdll.h"
#include "hbvm.h"
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include <stdio.h>
#include <math.h>
#include <stdlib.h>
#include "FreeImage.h"
// --------------------------------------------------------------------------
// Convert from FreeImage to HBITMAP ----------------------------------------
// --------------------------------------------------------------------------
#if ( defined(HB_OS_WIN_32) || defined(__WIN32__) )
// implementation: HBITMAP bitmap = FI_FiToBitmap( FIBITMAP *dib );
HB_FUNC( FI_FITOBITMAP )
{
if ( hb_pcount() == 1 &&
hb_parinfo( 1 ) & HB_IT_POINTER
)
{
FIBITMAP *dib;
HBITMAP bitmap;
HDC hDC;
/* Retrieve parameters */
dib = hb_parptr( 1 );
/* run function */
hDC = GetDC( NULL );
bitmap = CreateDIBitmap(hDC, FreeImage_GetInfoHeader(dib),
CBM_INIT, FreeImage_GetBits(dib),
FreeImage_GetInfo(dib), DIB_RGB_COLORS);
ReleaseDC( NULL, hDC );
/* return value */
if ( bitmap != NULL )
{
hb_retnl( (LONG) bitmap );
}
}
else
{
// Parameter error
{
hb_errRT_BASE_SubstR( EG_ARG, 0, NULL,
"FI_FITOBITMAP", 1,
hb_paramError( 1 ) );
return;
}
}
}
// --------------------------------------------------------------------------
// --------------------------------------------------------------------------
// Convert from HBITMAP to FreeImage ----------------------------------------
// --------------------------------------------------------------------------
// implementation: FIBITMAP *dib = FI_BitmapToFi( HBITMAP bitmap );
HB_FUNC( FI_BITMAPTOFI )
{
if ( hb_pcount() == 1 &&
hb_parinfo( 1 ) & HB_IT_POINTER
)
{
FIBITMAP *dib;
HBITMAP bitmap;
/* Retrieve parameters */
bitmap = (HBITMAP) hb_parnl( 1 );
/* run function */
dib = NULL;
if( bitmap ) {
BITMAP bm;
HDC hDC;
int Success;
GetObject( bitmap, sizeof(BITMAP), (LPSTR) &bm );
dib = FreeImage_Allocate(bm.bmWidth, bm.bmHeight, bm.bmBitsPixel, 0, 0, 0);
hDC = GetDC( NULL );
Success = GetDIBits( hDC, bitmap, 0, FreeImage_GetHeight(dib),
FreeImage_GetBits(dib), FreeImage_GetInfo(dib), DIB_RGB_COLORS);
ReleaseDC( NULL, hDC );
HB_SYMBOL_UNUSED( Success );
}
/* return value */
if ( dib != NULL )
{
hb_retptr( dib );
}
}
else
{
// Parameter error
{
hb_errRT_BASE_SubstR( EG_ARG, 0, NULL,
"FI_BITMAPTOFI", 1,
hb_paramError( 1 ) );
return;
}
}
}
// --------------------------------------------------------------------------
// --------------------------------------------------------------------------
// Draw an image in a window Box --------------------------------------------
// --------------------------------------------------------------------------
// implementation: int scanlines = FI_WinDraw( FIBITMAP *dib, HDC hDC, nTop, nLeft, nBottom, nRight );
HB_FUNC( FI_WINDRAW )
{
if ( hb_pcount() == 6 &&
hb_parinfo( 1 ) & HB_IT_POINTER &&
hb_parinfo( 2 ) & HB_IT_NUMERIC &&
hb_parinfo( 3 ) & HB_IT_NUMERIC &&
hb_parinfo( 4 ) & HB_IT_NUMERIC &&
hb_parinfo( 5 ) & HB_IT_NUMERIC &&
hb_parinfo( 6 ) & HB_IT_NUMERIC
)
{
FIBITMAP *dib;
HDC hDC;
RECT rcDest;
int scanlines;
/* Retrieve parameters */
dib = hb_parptr( 1 );
hDC = (HDC) hb_parnl( 2 );
rcDest.top = hb_parni( 3 );
rcDest.left = hb_parni( 4 );
rcDest.bottom = hb_parni( 5 );
rcDest.right = hb_parni( 6 );
/* run function */
SetStretchBltMode(hDC, COLORONCOLOR);
scanlines = StretchDIBits(hDC, rcDest.left,
rcDest.top,
rcDest.right-rcDest.left,
rcDest.bottom-rcDest.top,
0, 0, FreeImage_GetWidth(dib), FreeImage_GetHeight(dib),
FreeImage_GetBits(dib), FreeImage_GetInfo(dib),
DIB_RGB_COLORS, SRCCOPY);
/* return value */
hb_retni( scanlines );
}
else
{
// Parameter error
{
hb_errRT_BASE_SubstR( EG_ARG, 0, NULL,
"FI_WINDRAW", 6,
hb_paramError( 1 ), hb_paramError( 2 ), hb_paramError( 3 ),
hb_paramError( 4 ), hb_paramError( 5 ), hb_paramError( 6 )
);
return;
}
}
}
// --------------------------------------------------------------------------
#endif // ( defined(HB_OS_WIN_32) || defined(__WIN32__) )

2877
harbour/contrib/freeimage/fi_wrp.c Normal file
View File

File diff suppressed because it is too large Load Diff

337
harbour/contrib/freeimage/freeimage.ch Normal file
View File

@@ -0,0 +1,337 @@
/*
* $Id$
*/
/*
* xHarbour Project source code:
* FreeImage graphic library header file.
*
* Copyright 2005 Francesco Saverio Giudice <info@fsgiudice.com>
* www - http://www.xharbour.org http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#ifndef FREEIMAGE_CH
#define FREEIMAGE_CH
/* ----------------------------------------------------------------------- */
#ifndef FREEIMAGE_BIGENDIAN
// Little Endian (x86 / MS Windows, Linux) : BGR(A) order
#define FI_RGBA_RED 2
#define FI_RGBA_GREEN 1
#define FI_RGBA_BLUE 0
#define FI_RGBA_ALPHA 3
#define FI_RGBA_RED_MASK 0x00FF0000
#define FI_RGBA_GREEN_MASK 0x0000FF00
#define FI_RGBA_BLUE_MASK 0x000000FF
#define FI_RGBA_ALPHA_MASK 0xFF000000
#define FI_RGBA_RED_SHIFT 16
#define FI_RGBA_GREEN_SHIFT 8
#define FI_RGBA_BLUE_SHIFT 0
#define FI_RGBA_ALPHA_SHIFT 24
#else
// Big Endian (PPC / Linux, MaxOSX) : RGB(A) order
#define FI_RGBA_RED 0
#define FI_RGBA_GREEN 1
#define FI_RGBA_BLUE 2
#define FI_RGBA_ALPHA 3
#define FI_RGBA_RED_MASK 0xFF000000
#define FI_RGBA_GREEN_MASK 0x00FF0000
#define FI_RGBA_BLUE_MASK 0x0000FF00
#define FI_RGBA_ALPHA_MASK 0x000000FF
#define FI_RGBA_RED_SHIFT 24
#define FI_RGBA_GREEN_SHIFT 16
#define FI_RGBA_BLUE_SHIFT 8
#define FI_RGBA_ALPHA_SHIFT 0
#endif // FREEIMAGE_BIGENDIAN
#define FI_RGBA_RGB_MASK (FI_RGBA_RED_MASK|FI_RGBA_GREEN_MASK|FI_RGBA_BLUE_MASK)
// The 16bit macros only include masks and shifts, since each color element is not byte aligned
#define FI16_555_RED_MASK 0x7C00
#define FI16_555_GREEN_MASK 0x03E0
#define FI16_555_BLUE_MASK 0x001F
#define FI16_555_RED_SHIFT 10
#define FI16_555_GREEN_SHIFT 5
#define FI16_555_BLUE_SHIFT 0
#define FI16_565_RED_MASK 0xF800
#define FI16_565_GREEN_MASK 0x07E0
#define FI16_565_BLUE_MASK 0x001F
#define FI16_565_RED_SHIFT 11
#define FI16_565_GREEN_SHIFT 5
#define FI16_565_BLUE_SHIFT 0
// ICC profile support ------------------------------------------------------
#define FIICC_DEFAULT 0x00
#define FIICC_COLOR_IS_CMYK 0x01
/** I/O image format identifiers.
*/
//FREE_IMAGE_FORMAT
#define FIF_UNKNOWN -1
#define FIF_BMP 0
#define FIF_ICO 1
#define FIF_JPEG 2
#define FIF_JNG 3
#define FIF_KOALA 4
#define FIF_LBM 5
#define FIF_IFF FIF_LBM
#define FIF_MNG 6
#define FIF_PBM 7
#define FIF_PBMRAW 8
#define FIF_PCD 9
#define FIF_PCX 10
#define FIF_PGM 11
#define FIF_PGMRAW 12
#define FIF_PNG 13
#define FIF_PPM 14
#define FIF_PPMRAW 15
#define FIF_RAS 16
#define FIF_TARGA 17
#define FIF_TIFF 18
#define FIF_WBMP 19
#define FIF_PSD 20
#define FIF_CUT 21
#define FIF_XBM 22
#define FIF_XPM 23
#define FIF_DDS 24
#define FIF_GIF 25
#define FIF_HDR 26
/** Image type used in FreeImage.
*/
//FREE_IMAGE_TYPE
#define FIT_UNKNOWN 0 // unknown type
#define FIT_BITMAP 1 // standard image : 1-, 4-, 8-, 16-, 24-, 32-bit
#define FIT_UINT16 2 // array of unsigned short : unsigned 16-bit
#define FIT_INT16 3 // array of short : signed 16-bit
#define FIT_UINT32 4 // array of unsigned long : unsigned 32-bit
#define FIT_INT32 5 // array of long : signed 32-bit
#define FIT_FLOAT 6 // array of float : 32-bit IEEE floating point
#define FIT_DOUBLE 7 // array of double : 64-bit IEEE floating point
#define FIT_COMPLEX 8 // array of FICOMPLEX : 2 x 64-bit IEEE floating point
#define FIT_RGB16 9 // 48-bit RGB image : 3 x 16-bit
#define FIT_RGBA16 10 // 64-bit RGBA image : 4 x 16-bit
#define FIT_RGBF 11 // 96-bit RGB float image : 3 x 32-bit IEEE floating point
#define FIT_RGBAF 12 // 128-bit RGBA float image : 4 x 32-bit IEEE floating point
/** Image color type used in FreeImage.
*/
//FREE_IMAGE_COLOR_TYPE
#define FIC_MINISWHITE 0 // min value is white
#define FIC_MINISBLACK 1 // min value is black
#define FIC_RGB 2 // RGB color model
#define FIC_PALETTE 3 // color map indexed
#define FIC_RGBALPHA 4 // RGB color model with alpha channel
#define FIC_CMYK 5 // CMYK color model
/** Color quantization algorithms.
Constants used in FreeImage_ColorQuantize.
*/
//FREE_IMAGE_QUANTIZE
#define FIQ_WUQUANT 0 // Xiaolin Wu color quantization algorithm
#define FIQ_NNQUANT 1 // NeuQuant neural-net quantization algorithm by Anthony Dekker
/** Dithering algorithms.
Constants used in FreeImage_Dither.
*/
//FREE_IMAGE_DITHER
#define FID_FS 0 // Floyd & Steinberg error diffusion
#define FID_BAYER4x4 1 // Bayer ordered dispersed dot dithering (order 2 dithering matrix)
#define FID_BAYER8x8 2 // Bayer ordered dispersed dot dithering (order 3 dithering matrix)
#define FID_CLUSTER6x6 3 // Ordered clustered dot dithering (order 3 - 6x6 matrix)
#define FID_CLUSTER8x8 4 // Ordered clustered dot dithering (order 4 - 8x8 matrix)
#define FID_CLUSTER16x16 5 // Ordered clustered dot dithering (order 8 - 16x16 matrix)
/** Lossless JPEG transformations
Constants used in FreeImage_JPEGTransform
*/
//FREE_IMAGE_JPEG_OPERATION
#define FIJPEG_OP_NONE 0 // no transformation
#define FIJPEG_OP_FLIP_H 1 // horizontal flip
#define FIJPEG_OP_FLIP_V 2 // vertical flip
#define FIJPEG_OP_TRANSPOSE 3 // transpose across UL-to-LR axis
#define FIJPEG_OP_TRANSVERSE 4 // transpose across UR-to-LL axis
#define FIJPEG_OP_ROTATE_90 5 // 90-degree clockwise rotation
#define FIJPEG_OP_ROTATE_180 6 // 180-degree rotation
#define FIJPEG_OP_ROTATE_270 7 // 270-degree clockwise (or 90 ccw)
/** Tone mapping operators.
Constants used in FreeImage_ToneMapping.
*/
//FREE_IMAGE_TMO
#define FITMO_DRAGO03 0 // Adaptive logarithmic mapping (F. Drago, 2003)
#define FITMO_REINHARD05 1 // Dynamic range reduction inspired by photoreceptor physiology (E. Reinhard, 2005)
/** Upsampling / downsampling filters.
Constants used in FreeImage_Rescale.
*/
//FREE_IMAGE_FILTER
#define FILTER_BOX 0 // Box, pulse, Fourier window, 1st order (constant) b-spline
#define FILTER_BICUBIC 1 // Mitchell & Netravali's two-param cubic filter
#define FILTER_BILINEAR 2 // Bilinear filter
#define FILTER_BSPLINE 3 // 4th order (cubic) b-spline
#define FILTER_CATMULLROM 4 // Catmull-Rom spline, Overhauser spline
#define FILTER_LANCZOS3 5 // Lanczos3 filter
/** Color channels.
Constants used in color manipulation routines.
*/
//FREE_IMAGE_COLOR_CHANNEL
#define FICC_RGB 0 // Use red, green and blue channels
#define FICC_RED 1 // Use red channel
#define FICC_GREEN 2 // Use green channel
#define FICC_BLUE 3 // Use blue channel
#define FICC_ALPHA 4 // Use alpha channel
#define FICC_BLACK 5 // Use black channel
#define FICC_REAL 6 // Complex images: use real part
#define FICC_IMAG 7 // Complex images: use imaginary part
#define FICC_MAG 8 // Complex images: use magnitude
#define FICC_PHASE 9 // Complex images: use phase
// Metadata support ---------------------------------------------------------
/**
Tag data type information (based on TIFF specifications)
Note: RATIONALs are the ratio of two 32-bit integer values.
*/
//FREE_IMAGE_MDTYPE
#define FIDT_NOTYPE 0 // placeholder
#define FIDT_BYTE 1 // 8-bit unsigned integer
#define FIDT_ASCII 2 // 8-bit bytes w/ last byte null
#define FIDT_SHORT 3 // 16-bit unsigned integer
#define FIDT_LONG 4 // 32-bit unsigned integer
#define FIDT_RATIONAL 5 // 64-bit unsigned fraction
#define FIDT_SBYTE 6 // 8-bit signed integer
#define FIDT_UNDEFINED 7 // 8-bit untyped data
#define FIDT_SSHORT 8 // 16-bit signed integer
#define FIDT_SLONG 9 // 32-bit signed integer
#define FIDT_SRATIONAL 10 // 64-bit signed fraction
#define FIDT_FLOAT 11 // 32-bit IEEE floating point
#define FIDT_DOUBLE 12 // 64-bit IEEE floating point
#define FIDT_IFD 13 // 32-bit unsigned integer (offset)
#define FIDT_PALETTE 14 // 32-bit RGBQUAD
/**
Metadata models supported by FreeImage
*/
//FREE_IMAGE_MDMODEL
#define FIMD_NODATA -1
#define FIMD_COMMENTS 0 // single comment or keywords
#define FIMD_EXIF_MAIN 1 // Exif-TIFF metadata
#define FIMD_EXIF_EXIF 2 // Exif-specific metadata
#define FIMD_EXIF_GPS 3 // Exif GPS metadata
#define FIMD_EXIF_MAKERNOTE 4 // Exif maker note metadata
#define FIMD_EXIF_INTEROP 5 // Exif interoperability metadata
#define FIMD_IPTC 6 // IPTC/NAA metadata
#define FIMD_XMP 7 // Abobe XMP metadata
#define FIMD_GEOTIFF 8 // GeoTIFF metadata
#define FIMD_ANIMATION 9 // Animation metadata
#define FIMD_CUSTOM 10 // Used to attach other metadata types to a dib
// Load / Save flag constants -----------------------------------------------
#define BMP_DEFAULT 0
#define BMP_SAVE_RLE 1
#define CUT_DEFAULT 0
#define DDS_DEFAULT 0
#define GIF_DEFAULT 0
#define GIF_LOAD256 1 // Load the image as a 256 color image with ununsed palette entries, if it's 16 or 2 color
#define GIF_PLAYBACK 2 // 'Play' the GIF to generate each frame (as 32bpp) instead of returning raw frame data when loading
#define HDR_DEFAULT 0
#define ICO_DEFAULT 0
#define ICO_MAKEALPHA 1 // convert to 32bpp and create an alpha channel from the AND-mask when loading
#define IFF_DEFAULT 0
#define JPEG_DEFAULT 0
#define JPEG_FAST 1
#define JPEG_ACCURATE 2
#define JPEG_QUALITYSUPERB 0x80
#define JPEG_QUALITYGOOD 0x100
#define JPEG_QUALITYNORMAL 0x200
#define JPEG_QUALITYAVERAGE 0x400
#define JPEG_QUALITYBAD 0x800
#define JPEG_CMYK 0x1000 // load separated CMYK "as is" (use | to combine with other flags)
#define KOALA_DEFAULT 0
#define LBM_DEFAULT 0
#define MNG_DEFAULT 0
#define PCD_DEFAULT 0
#define PCD_BASE 1 // load the bitmap sized 768 x 512
#define PCD_BASEDIV4 2 // load the bitmap sized 384 x 256
#define PCD_BASEDIV16 3 // load the bitmap sized 192 x 128
#define PCX_DEFAULT 0
#define PNG_DEFAULT 0
#define PNG_IGNOREGAMMA 1 // avoid gamma correction
#define PNM_DEFAULT 0
#define PNM_SAVE_RAW 0 // If set the writer saves in RAW format (i.e. P4, P5 or P6)
#define PNM_SAVE_ASCII 1 // If set the writer saves in ASCII format (i.e. P1, P2 or P3)
#define PSD_DEFAULT 0
#define RAS_DEFAULT 0
#define TARGA_DEFAULT 0
#define TARGA_LOAD_RGB888 1 // If set the loader converts RGB555 and ARGB8888 -> RGB888.
#define TIFF_DEFAULT 0
#define TIFF_CMYK 0x0001 // reads/stores tags for separated CMYK (use | to combine with compression flags)
#define TIFF_PACKBITS 0x0100 // save using PACKBITS compression
#define TIFF_DEFLATE 0x0200 // save using DEFLATE compression (a.k.a. ZLIB compression)
#define TIFF_ADOBE_DEFLATE 0x0400 // save using ADOBE DEFLATE compression
#define TIFF_NONE 0x0800 // save without any compression
#define TIFF_CCITTFAX3 0x1000 // save using CCITT Group 3 fax encoding
#define TIFF_CCITTFAX4 0x2000 // save using CCITT Group 4 fax encoding
#define TIFF_LZW 0x4000 // save using LZW compression
#define TIFF_JPEG 0x8000 // save using JPEG compression
#define WBMP_DEFAULT 0
#define XBM_DEFAULT 0
#define XPM_DEFAULT 0
#endif // FREEIMAGE_CH

79
harbour/contrib/freeimage/make_b32.bat Normal file
View File

@@ -0,0 +1,79 @@
@echo off
rem
rem $Id$
rem
rem ---------------------------------------------------------------
rem IMPORTANT: You'll need Freeimage headers and binary from here:
rem http://freeimage.sourceforge.net/download.html
rem and this envvar to be set to successfully build this library:
rem set FREEIMAGE_DIR=C:\FreeImage
rem ---------------------------------------------------------------
rem ---------------------------------------------------------------
rem This is a generic template file, if it doesn't fit your own needs
rem please DON'T MODIFY IT.
rem
rem Instead, make a local copy and modify that one, or make a call to
rem this batch file from your customized one. [vszakats]
rem
rem Set any of the below settings to customize your build process:
rem set HB_MAKE_PROGRAM=
rem set HB_MAKE_FLAGS=
rem ---------------------------------------------------------------
if "%HB_DLL_DIR%" == "" set HB_DLL_DIR=%SystemRoot%\system32
if "%HB_CC_NAME%" == "" set HB_CC_NAME=b32
if "%HB_MAKE_PROGRAM%" == "" set HB_MAKE_PROGRAM=make.exe
set HB_MAKEFILE=..\mtpl_%HB_CC_NAME%.mak
set C_USR=%C_USR% -I%FREEIMAGE_DIR%\source -DHB_OS_WIN_32_USED
rem ---------------------------------------------------------------
rem Save the user value, force silent file overwrite with COPY
rem (not all Windows versions support the COPY /Y flag)
set HB_ORGENV_COPYCMD=%COPYCMD%
set COPYCMD=/Y
rem ---------------------------------------------------------------
if "%1" == "clean" goto CLEAN
if "%1" == "CLEAN" goto CLEAN
if "%1" == "install" goto INSTALL
if "%1" == "INSTALL" goto INSTALL
:BUILD
implib ..\..\lib\%HB_CC_NAME%\FreeImage.lib %FREEIMAGE_DIR%\Dist\FreeImage.dll
%HB_MAKE_PROGRAM% %HB_MAKE_FLAGS% -f %HB_MAKEFILE% %1 %2 %3 > make_%HB_CC_NAME%.log
if errorlevel 1 notepad make_%HB_CC_NAME%.log
goto EXIT
:CLEAN
%HB_MAKE_PROGRAM% %HB_MAKE_FLAGS% -f %HB_MAKEFILE% CLEAN > make_%HB_CC_NAME%.log
if exist make_%HB_CC_NAME%.log del make_%HB_CC_NAME%.log > nul
if exist inst_%HB_CC_NAME%.log del inst_%HB_CC_NAME%.log > nul
goto EXIT
:INSTALL
set _HB_INSTALL_PREFIX=%HB_INSTALL_PREFIX%
if "%_HB_INSTALL_PREFIX%" == "" set _HB_INSTALL_PREFIX=..\..
set _HB_LIB_INSTALL=%HB_LIB_INSTALL%
if "%_HB_LIB_INSTALL%" == "" set _HB_LIB_INSTALL=%_HB_INSTALL_PREFIX%\lib
copy ..\..\lib\%HB_CC_NAME%\FreeImage.lib %_HB_LIB_INSTALL%
%HB_MAKE_PROGRAM% %HB_MAKE_FLAGS% -f %HB_MAKEFILE% INSTALL > nul
goto EXIT
:EXIT
rem ---------------------------------------------------------------
rem Restore user value
set COPYCMD=%HB_ORGENV_COPYCMD%

95
harbour/contrib/freeimage/make_vc.bat Normal file
View File

@@ -0,0 +1,95 @@
@echo off
rem
rem $Id$
rem
rem ---------------------------------------------------------------
rem IMPORTANT: You'll need Freeimage headers and binary from here:
rem http://freeimage.sourceforge.net/download.html
rem and this envvar to be set to successfully build this library:
rem set FREEIMAGE_DIR=C:\FreeImage
rem ---------------------------------------------------------------
rem ---------------------------------------------------------------
rem This is a generic template file, if it doesn't fit your own needs
rem please DON'T MODIFY IT.
rem
rem Instead, make a local copy and modify that one, or make a call to
rem this batch file from your customized one. [vszakats]
rem
rem Set any of the below settings to customize your build process:
rem set HB_MAKE_PROGRAM=
rem set HB_MAKE_FLAGS=
rem ---------------------------------------------------------------
if "%HB_DLL_DIR%" == "" set HB_DLL_DIR=%SystemRoot%\system32
if "%HB_CC_NAME%" == "" set HB_CC_NAME=vc
if "%HB_MAKE_PROGRAM%" == "" set HB_MAKE_PROGRAM=nmake.exe
set HB_MAKEFILE=..\mtpl_%HB_CC_NAME%.mak
set C_USR=%C_USR% -I%FREEIMAGE_DIR%\source -DHB_OS_WIN_32_USED
rem ---------------------------------------------------------------
rem Save the user value, force silent file overwrite with COPY
rem (not all Windows versions support the COPY /Y flag)
set HB_ORGENV_COPYCMD=%COPYCMD%
set COPYCMD=/Y
rem ---------------------------------------------------------------
if "%1" == "clean" goto CLEAN
if "%1" == "CLEAN" goto CLEAN
if "%1" == "install" goto INSTALL
if "%1" == "INSTALL" goto INSTALL
:BUILD
rem ---------------------------------------------------------------
rem This .dll to .lib conversion needs GNU sed.exe in the path
rem ---------------------------------------------------------------
echo./[ \t]*ordinal hint/,/^^[ \t]*Summary/{> _temp.sed
echo. /^^[ \t]\+[0-9]\+/{>> _temp.sed
echo. s/^^[ \t]\+[0-9]\+[ \t]\+[0-9A-Fa-f]\+[ \t]\+[0-9A-Fa-f]\+[ \t]\+\(.*\)/\1/p>> _temp.sed
echo. }>> _temp.sed
echo.}>> _temp.sed
DUMPBIN /EXPORTS %FREEIMAGE_DIR%\Dist\FreeImage.dll > _dump.tmp
echo.LIBRARY %FREEIMAGE_DIR%\Dist\FreeImage.dll > _temp.def
echo.EXPORTS >> _temp.def
sed -nf _temp.sed < _dump.tmp >> _temp.def
LIB /MACHINE:X86 /DEF:_temp.def /OUT:..\..\lib\%HB_CC_NAME%\FreeImage.lib
del _dump.tmp
del _temp.def
del _temp.sed
rem ---------------------------------------------------------------
%HB_MAKE_PROGRAM% %HB_MAKE_FLAGS% -f %HB_MAKEFILE% %1 %2 %3 > make_%HB_CC_NAME%.log
if errorlevel 1 notepad make_%HB_CC_NAME%.log
goto EXIT
:CLEAN
%HB_MAKE_PROGRAM% %HB_MAKE_FLAGS% -f %HB_MAKEFILE% CLEAN > make_%HB_CC_NAME%.log
if exist make_%HB_CC_NAME%.log del make_%HB_CC_NAME%.log > nul
if exist inst_%HB_CC_NAME%.log del inst_%HB_CC_NAME%.log > nul
goto EXIT
:INSTALL
set _HB_INSTALL_PREFIX=%HB_INSTALL_PREFIX%
if "%_HB_INSTALL_PREFIX%" == "" set _HB_INSTALL_PREFIX=..\..
set _HB_LIB_INSTALL=%HB_LIB_INSTALL%
if "%_HB_LIB_INSTALL%" == "" set _HB_LIB_INSTALL=%_HB_INSTALL_PREFIX%\lib
copy ..\..\lib\%HB_CC_NAME%\FreeImage.lib %_HB_LIB_INSTALL%
%HB_MAKE_PROGRAM% %HB_MAKE_FLAGS% -f %HB_MAKEFILE% INSTALL > nul
goto EXIT
:EXIT
rem ---------------------------------------------------------------
rem Restore user value
set COPYCMD=%HB_ORGENV_COPYCMD%

58
harbour/contrib/freeimage/readme.txt Normal file
View File

@@ -0,0 +1,58 @@
/*
* $Id$
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.xharbour.org http://www.harbour-project.org
*
* Copyright 2005 Francesco Saverio Giudice <info@fsgiudice.com>
* README file explaining howto compile FreeImage library
*
* See doc/license.txt for licensing terms.
*
*/
FreeImage Library is a porting to xHarbour of famous FreeImage Project library.
Actually based on FreeImage version 3.8.0
FreeImage Project's web site is http://freeimage.sourceforge.net/
COMPILING
=========
Actually platforms supported are:
- Win32 / BCC32
- GNU systems / GCC
to build library on Win32 with BCC use:
make_b32.bat
on GNU system use:
make install
WARNING: not actually tested
** requirements: to build FreeImage library: gcc-c++, libstdc++-devel
DOCUMENTATION
=============
Look at doc folder for help files.
Last FreeImage pdf manual is downloadable from http://freeimage.sourceforge.net/download.html
SAMPLES
=======
For samples look at tests dir.
fitest.prg is an API test application.
NOTES
=====
WARNING: if you are using Windows platform, download the
FreeImage.dll in tests before use it.
At this time (28/10/2005 CET) it builds on Windows with last CVS.
Not tested on GNU system, but it have to run correctly.

80
harbour/contrib/freeimage/test/bld_b32.bat Normal file
View File

@@ -0,0 +1,80 @@
@echo off
rem
rem $Id$
rem
if A%1 == A GOTO :SYNTAX
if NOT EXIST %1.prg GOTO :NOEXIST
ECHO Build: Compiling...
set hdir=..\..\..
%hdir%\bin\harbour %1 /w /n /i..\include;%hdir%\include %2 %3 > bld_b32.log
type bld_b32.log
IF ERRORLEVEL 1 PAUSE
IF ERRORLEVEL 1 GOTO EXIT
echo -O2 -e%1.exe -I%hdir%\include %1.c > bld_b32.mak
bcc32 -M -c @bld_b32.mak
:ENDCOMPILE
echo c0w32.obj + > bld_b32.mak
echo %1.obj, + >> bld_b32.mak
echo %1.exe, + >> bld_b32.mak
echo %1.map, + >> bld_b32.mak
echo %hdir%\lib\rtl.lib + >> bld_b32.mak
echo %hdir%\lib\vm.lib + >> bld_b32.mak
echo %hdir%\lib\gtwin.lib + >> bld_b32.mak
echo %hdir%\lib\lang.lib + >> bld_b32.mak
echo %hdir%\lib\macro.lib + >> bld_b32.mak
echo %hdir%\lib\rdd.lib + >> bld_b32.mak
echo %hdir%\lib\dbfntx.lib + >> bld_b32.mak
echo %hdir%\lib\dbfcdx.lib + >> bld_b32.mak
echo %hdir%\lib\debug.lib + >> bld_b32.mak
echo %hdir%\lib\common.lib + >> bld_b32.mak
echo %hdir%\lib\pp.lib + >> bld_b32.mak
echo %hdir%\lib\hbsix.lib + >> bld_b32.mak
echo %hdir%\lib\dbffpt.lib + >> bld_b32.mak
echo %hdir%\lib\fi_lib.lib + >> bld_b32.mak
echo %hdir%\lib\freeimage.lib + >> bld_b32.mak
rem Uncomment these two lines to use Advantage RDD
rem echo %hdir%\lib\rddads.lib + >> bld_b32.mak
rem echo %hdir%\lib\ace32.lib + >> bld_b32.mak
echo cw32.lib + >> bld_b32.mak
echo import32.lib, >> bld_b32.mak
ECHO Build: Linking...
rem Use these flags to avoid the console window creation
rem ilink32 -Gn -aa -Tpe -s @bld_b32.mak
ilink32 -Gn -Tpe -s @bld_b32.mak
rem delete temporary files
del %1.c
del %1.obj
if exist %1.map del %1.map
if exist %1.tds del %1.tds
del bld_b32.mak
del bld_b32.log
IF ERRORLEVEL 1 GOTO LINKERROR
ECHO Build: Done.
%1
GOTO EXIT
ECHO
:LINKERROR
rem if exist meminfo.txt notepad meminfo.txt
rem PAUSE * Linking errors *
GOTO EXIT
:SYNTAX
ECHO SYNTAX: bld_b32 [Program] {-- Don't specify .prg extension
GOTO EXIT
:NOEXIST
ECHO Build: The specified %1.prg does not exist
:EXIT

242
harbour/contrib/freeimage/test/fitest.prg Normal file
View File

@@ -0,0 +1,242 @@
/*
* $Id$
*/
/*
* Copyright 2005 Francesco Saverio Giudice <info@fsgiudice.com>
*
* FreeImage API test file
*/
#include "FreeImage.ch"
#include "common.ch"
#define IMAGES_IN ""
#define IMAGES_OUT "images_out/"
PROCEDURE Main()
LOCAL im, clone, rotated, rotatedEx, rescale, im2, im3
LOCAL centerX, centerY, width, height, appo
LOCAL bmpinfoheader
LOCAL bmpinfo
LOCAL bkcolor
LOCAL iccprofile
LOCAL x
//? "Press Alt-D + Enter to activate debug"
//AltD( .T. )
//Inkey(0)
altd()
// Check output directory
IF !hb_DirExists( IMAGES_OUT )
#ifdef HB_COMPAT_C53
MakeDir( IMAGES_OUT )
#endif
ENDIF
? "Initialise"
fi_Initialise()
//---------------------------//
? "Set Error Message:", fi_SetOutPutMessage( fi_Error() )
//? "Set Error Message:", fi_SetOutPutMessage( NIL )
? "Version :", fi_GetVersion()
? "Copyright :", fi_GetCopyrightMessage()
? "File type :", fi_GetFileType( IMAGES_IN + "sample1.jpg" )
? "Load JPEG"
im := fi_Load( FIF_JPEG, IMAGES_IN + "sample1.jpg", JPEG_DEFAULT )
? "Clone image"
clone := fi_Clone( im )
? "Pointer :", ValToPrg( im )
? "Image Type :", fi_GetImageType( im )
? "Color Used :", fi_GetColorsUsed( im )
? "Pixel size :", fi_GetBPP( im )
? "Width :", fi_GetWidth( im )
? "Height :", fi_GetHeight( im )
? "Byte Size :", fi_GetLine( im )
? "Pitch :", fi_GetPitch( im )
? "DIB Size :", fi_GetDIBSize( im )
? "Dots per Meter X :", fi_GetDotsPerMeterX( im )
? "Dots per Meter Y :", fi_GetDotsPerMeterY( im )
? "Color Type :", fi_GetColorType( im )
? "Red Mask :", fi_GetRedMask( im )
? "Green Mask :", fi_GetGreenMask( im )
? "Blue Mask :", fi_GetBlueMask( im )
? "Transp. Count :", fi_GetTransparencyCount( im )
? "Is Transparent ? :", fi_IsTransparent( im )
?
? "Save BMP ? :", fi_Save( FIF_BMP , im, IMAGES_OUT + "sample1.bmp", BMP_DEFAULT )
? "Save JPG ? :", fi_Save( FIF_JPEG, im, IMAGES_OUT + "sample1.jpg", JPEG_DEFAULT )
? "Save PNG ? :", fi_Save( FIF_PNG , im, IMAGES_OUT + "sample1.png", PNG_DEFAULT )
? "Save TIFF ? :", fi_Save( FIF_TIFF, clone, IMAGES_OUT + "sample1.tif", TIFF_DEFAULT )
? "Flip Horizontal ?:", fi_FlipHorizontal( clone )
? "Save JPG ? :", fi_Save( FIF_JPEG, clone, IMAGES_OUT + "horizontal.jpg", JPEG_DEFAULT )
? "Flip Vertical ? :", fi_FlipVertical( clone )
? "Save JPG ? :", fi_Save( FIF_JPEG, clone, IMAGES_OUT + "vertical.jpg", JPEG_DEFAULT )
? "Rotate Classic :", ValToPrg( rotated := fi_RotateClassic( clone, 90 ) )
? "Save JPG ? :", fi_Save( FIF_JPEG, rotated, IMAGES_OUT + "rotate.jpg", JPEG_DEFAULT )
fi_Unload( rotated )
centerx := fi_GetWidth( clone ) / 2
centery := fi_GetHeight( clone ) / 2
? "Rotate Ex :", ValToPrg( rotatedEx := fi_RotateEx( clone, 15, 0, 0, centerx, centery, TRUE ) )
? "Save JPG ? :", fi_Save( FIF_JPEG, rotatedEx, IMAGES_OUT + "rotateEx.jpg", JPEG_DEFAULT )
fi_Unload( rotatedEx )
width := fi_GetWidth( im )
height := fi_GetHeight( im )
? "Rescale :", ValToPrg( rescale := fi_Rescale( im, width / 2, height / 2, FILTER_BICUBIC ) )
? "Save JPG ? :", fi_Save( FIF_JPEG, rescale, IMAGES_OUT + "rescale.jpg", JPEG_DEFAULT )
fi_Unload( rescale )
im2 := fi_Clone( im )
? "Adjust Gamma ? :", fi_AdjustGamma( im2, 3.0 )
? "Save JPG ? :", fi_Save( FIF_JPEG, im2, IMAGES_OUT + "adjgamma.jpg", JPEG_DEFAULT )
fi_Unload( im2 )
im2 := fi_Clone( im )
? "Adjust Brightness:", fi_AdjustBrightness( im2, -30 )
? "Save JPG ? :", fi_Save( FIF_JPEG, im2, IMAGES_OUT + "adjbright.jpg", JPEG_DEFAULT )
fi_Unload( im2 )
im2 := fi_Clone( im )
? "Adjust Contrast ?:", fi_AdjustContrast( im2, -30 )
? "Save JPG ? :", fi_Save( FIF_JPEG, im2, IMAGES_OUT + "adjcontrast.jpg", JPEG_DEFAULT )
fi_Unload( im2 )
im2 := fi_Clone( im )
? "Invert ? :", fi_Invert( im2 )
? "Save JPG ? :", fi_Save( FIF_JPEG, im2, IMAGES_OUT + "invert.jpg", JPEG_DEFAULT )
fi_Unload( im2 )
? "Red Channel :", ValToPrg( im2 := fi_GetChannel( im, FICC_RED ) )
? "Save JPG ? :", fi_Save( FIF_JPEG, im2, IMAGES_OUT + "red.jpg", JPEG_DEFAULT )
fi_Unload( im2 )
? "Green Channel :", ValToPrg( im2 := fi_GetChannel( im, FICC_GREEN ) )
? "Save JPG ? :", fi_Save( FIF_JPEG, im2, IMAGES_OUT + "green.jpg", JPEG_DEFAULT )
fi_Unload( im2 )
? "Blue Channel :", ValToPrg( im2 := fi_GetChannel( im, FICC_BLUE ) )
? "Save JPG ? :", fi_Save( FIF_JPEG, im2, IMAGES_OUT + "blue.jpg", JPEG_DEFAULT )
fi_Unload( im2 )
? "Copy :", ValToPrg( im2 := fi_Copy( im, 300, 100, 800, 200 ) )
? "Save JPG ? :", fi_Save( FIF_JPEG, im2, IMAGES_OUT + "copy.jpg", JPEG_DEFAULT )
im3 := fi_Clone( im )
? "Paste ? :", fi_Paste( im3, im2, 10, 10, 70 )
? "Save JPG ? :", fi_Save( FIF_JPEG, im3, IMAGES_OUT + "paste.jpg", JPEG_DEFAULT )
fi_Unload( im2 )
fi_Unload( im3 )
? "Allocate Bitmap :", ValToPrg( im3 := fi_AllocateT( FIT_BITMAP, 320, 200, 32 ) )
? "Save JPG ? :", fi_Save( FIF_JPEG, im3, IMAGES_OUT + "allocate.jpg", JPEG_DEFAULT )
fi_Unload( im3 )
? "Create ERROR :"
? "Save GIF ? :", fi_Save( FIF_GIF, im, IMAGES_OUT + "wrong.gif", 0 )
//? ValToPrg( fi_GetInfoHeader( im ) )
//bmpinfoheader:Buffer( fi_GetInfoHeader( im ), TRUE )
//bmpinfoheader:Pointer( fi_GetInfoHeader( im ) )
//? "Header :", ValToPrg( bmpinfoheader )
//? bmpinfoheader:SayMembers(" ", .t., .t.)
//bmpinfo:Pointer( fi_GetInfo( im ) )
? "Info :", ValToPrg( bmpinfo )
//? bmpinfo:SayMembers(" ", .t., .t.)
? "-----------------------------------------------------"
//? ValType( bmpinfo:Devalue() )
//Tracelog( "bmpinfoheader", ValToPrg( bmpinfoheader ), ;
// bmpinfoheader:SayMembers(, .t.), bmpinfoheader:Value(), bmpinfoheader:DeValue(), hb_dumpvar( bmpinfoheader:Array() ), hb_dumpvar( bmpinfoheader:acMembers ) )
//appo := bkcolor:Value()
//? bkcolor:Pointer( fi_GetBackgroundColor( im ) )
//? fi_GetBackgroundColor( im, @bkcolor:Value() )
//bkcolor:Buffer( appo )
//? bkcolor:SayMembers(" ", .t., .t.)
//bkcolor:rgbBlue := 205
//? fi_SetBackgroundColor( im, hb_String2Pointer( bkcolor:Value() ) )
Tracelog("linha 168")
//? fi_SetBackgroundColor( im, bkcolor:Value() )
Tracelog("linha 170")
//? bkcolor:SayMembers(" ", .t., .t.)
Tracelog("linha 162")
// ? bkcolor:Pointer( fi_GetBackgroundColor( im ) )
//? fi_GetBackgroundColor( im, @bkcolor:Value() )
//bkcolor:Buffer( appo )
Tracelog("linha 176")
//? bkcolor:SayMembers(" ", .t., .t.)
Tracelog("linha 179")
//iccprofile:Pointer( fi_GetICCProfile( im ) )
Tracelog("linha 181")
//? "Header :", ValToPrg( iccprofile )
Tracelog("linha 183")
//? iccprofile:SayMembers(" ", .t., .t.)
//bmpinfoheader:Reset()
//appo := NIL
//bmpinfoheader := NIL
//hb_GCAll( .T. )
? "Unload images from memory"
fi_Unload( im )
fi_Unload( clone )
//---------------------------//
? "DeInitialise"
fi_Deinitialise()
?
? "Look at " + IMAGES_OUT + " folder for output images"
?
RETURN
PROCEDURE fi_Error( cFormat, cMessage )
? "ERROR!..."
? "Format : ", cFormat
? "Message : ", cMessage
RETURN
PROCEDURE TraceLog( c )
HB_SYMBOL_UNUSED( c )
RETURN
FUNCTION ValToPrg( xValue )
LOCAL cType := ValType( xValue )
DO CASE
CASE cType == "C"
xValue := StrTran( xValue, Chr(0), '"+Chr(0)+"' )
xValue := StrTran( xValue, Chr(9), '"+Chr(9)+"' )
xValue := StrTran( xValue, Chr(10), '"+Chr(10)+"' )
xValue := StrTran( xValue, Chr(13), '"+Chr(13)+"' )
xValue := StrTran( xValue, Chr(26), '"+Chr(26)+"' )
RETURN '"' + xValue + '"'
CASE cType == "N" ; RETURN LTrim( Str( xValue ) )
CASE cType == "D" ; RETURN 'HB_SToD("' + DToS( xValue ) + '")'
CASE cType == "L" ; RETURN iif( xValue, ".T.", ".F." )
CASE cType == "O" ; RETURN xValue:className() + " Object"
CASE cType == "U" ; RETURN "NIL"
CASE cType == "B" ; RETURN '{||...}'
CASE cType == "A" ; RETURN '{.[' + LTrim( Str( Len( xValue ) ) ) + '].}'
CASE cType == "M" ; RETURN 'M:"' + xValue + '"'
ENDCASE
RETURN ""

BIN
harbour/contrib/freeimage/test/fsg.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.7 KiB

BIN
harbour/contrib/freeimage/test/italia.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 21 KiB

BIN
harbour/contrib/freeimage/test/sample1.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 62 KiB

5
harbour/contrib/xhb/hbfast.h Normal file
View File

@@ -0,0 +1,5 @@
/*
* $Id$
*/
#include "hbapi.h"