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

2007-04-10 11:30 UTC+0200 Lorenzo Fiorini (lorenzo.fiorini/at/gmail.com)

Browse Source 
* harbour/contrib/gd
    * added new directory
	 * harbour wrapper classes for www.libgd.prg graphic library
	 * see README and hbgd.txt for docs
This commit is contained in:
Lorenzo Fiorini
2007-04-10 09:29:42 +00:00
parent d38dbf8710
commit 5e0fc083ac
12 changed files with 9423 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
harbour/ChangeLog
View File

@@ -8,6 +8,12 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2007-04-10 11:20 UTC+0200 Lorenzo Fiorini (lorenzo.fiorini/at/gmail.com)
* harbour/contrib/gd
* added new directory
* harbour wrapper classes for www.libgd.prg graphic library
* see README and hbgd.txt for docs
2007-04-06 15:38 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
* harbour/source/rtl/persist.prg
* harbour/source/rtl/tbrowse.prg

339
harbour/contrib/gd/ChangeLog Normal file
View File

@@ -0,0 +1,339 @@
/*
* $Id$
*/
/* Use this format for the entry headers:
YYYY-MM-DD HH:MM UTC[-|+]hhmm Your Full Name <your_email@address>
For example:
2002-12-01 23:12 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2007-04-05 10:00 UTC+0200 Lorenzo Fiorini <lorenzo.fiorini/at/gmail.com>
* ported from xHarbour/contrib/gd
* changed name of the lib from gdlib to hbgd
* changed dirs and make files
* deleted some files
* changed images
* changed C and prg for Harbour
2006-03-28 14:06 UTC-0300 Laverson Espindola <laverson.espindola@newage-software.com.br>
* contrib/gd/source/gdbarcode.prg
* contrib/gd/source/gdbar.prg
+ added method to create barcode of the type 2 of 5
* contrig/gd/samples/barcode/bartest.prg
+ added sample to use barcode of the type 2 of 5
2006-03-21 00:38 UTC+0100 Francesco Saverio Giudice <info/at/fsgiudice.com>
* contrib/gd/Rules.make
* contrib/gd/make_vc.bat
* fixed make files
* contrib/gd/source/gdwrp.c
* fixed linux compilation to align to gd ver. 2.0.28
2006-03-12 23:15 UTC+0100 Francesco Saverio Giudice <info/at/fsgiudice.com>
* contrib/gd/make_b32.bat
* contrib/gd/makefile.bc
* fixed BCC compilation
2006-01-21 01:45 UTC+0100 Francesco Saverio Giudice <info@fsgiudice.com>
* contrib/gd/source/gd.prg
+ added functions:
gdImageToString( oImage ) -> cImageString
return a string containing binary image
check oImage:cType for image type: jpeg, gif or png
gdImageToFile( oImage, cFileName ) -> NIL
Create an image file (as cFileName + "." + oImage:cType)
* contrib/gd/source/gdimage.prg
+ added ToString() method, this choose right ToString*() method reading cType property
+ added ToFile( cFile ) method, this choose right ToString*() method reading cType property
and create an image file
+ contrib/gd/include/gdexternal.ch
external gd functions declaration
+ contrib/gd/tests/tostring.prg
sample for tostring() and SaveToFile() methods
2006-01-08 23:28 UTC+0100 Francesco Saverio Giudice <info@fsgiudice.com>
* contrib/gd/source/gdwrp.c
+ added save image to string
* contrib/gd/source/gdimage.prg
+ added ToString*() methods, fixed Output*() methods
/*
Now it is possible to get an image into a string using ToString*() methods.
Sample:
oImage := GDImage( 200, 200 )
....
cImage := oImage:ToStringJPeg()
*/
2006-01-08 02:47 UTC+0100 Francesco Saverio Giudice <info@fsgiudice.com>
* contrib/gd/source/gdwrp.c
* fixed error + formatting
* contrib/gd/source/gd.prg
* fixed gdImageFromFile()
2005-12-26 23:16 UTC+0100 Francesco Saverio Giudice <info@fsgiudice.com>
* contrib/gd/source/gdwrp.c
* fixed error parameters number
2005-12-26 22:58 UTC+0100 Francesco Saverio Giudice <info@fsgiudice.com>
* contrib/gd/source/gdwrp.c
* gdImageStringFTEx
+ added new parameters: linespacing (default 1.05)
charmap (default gdFTEX_Unicode)
resolution (default 96 dpi)
* contrib/gd/source/gd.prg
* changed gdImageStringFT accordling with new parameters
* contrib/gd/source/gdimage.prg
* changed SayFreeType() method accordling with new parameters
+ contrib/gd/tests/testdpi.prg
+ added sample showing dpi changes
* contrib/gd/include/gd.h
* minor formatting
/*
Added new parameters not handled before to alter dpi in string drawing
As per request of Rene Gladis
*/
2005-12-12 14:06 UTC-0300 Laverson Espindola <laverson.espindola@newage-software.com.br>
* source\gdbar.prg
! Added new parameters <cpath_img> in construtor class TCode
default "image_bar/", to output image, this suggestion from Francesco Saverio Giudice.
2005-12-09 18:30 UTC-0300 Laverson Espindola <laverson.espindola@newage-software.com.br>
* source\gdwrp.c
! Added missing castings to make MSVC happy
* make_vc.bat
* makefile.nt
+ Added MSVC building files
* makemsvcimport.bat
+ Utility to create import lib from GD DLL
* source\gdbar.prg
* source\gdbarcode.prg
+ Added barcode generation routines
* samples\barcode\bartest.prg
* samples\barcode\bldtest.bat
* samples\barcode\bldtestvc.bat
+ Added barcode sample
* README.txt
* MAKEFILE.BC
! Updated with BarCode stuff
2005-11-07 01:37 UTC+0100 Francesco Saverio Giudice <info@fsgiudice.com>
* contrib/gd/README.txt
* updated
2005-11-07 00:15 UTC+0100 Francesco Saverio Giudice <info@fsgiudice.com>
* contrib/gd/source/gdwrp.c
+ added gdImageGifAnimBegin, gdImageGifAnimAdd, gdImageGifAnimEnd
+ contrib/gd/tests/animgif.prg
+ test of gdImageGifAnim*() functions
/* Added Animated GIF functions ! */
2005-11-06 16:48 UTC+0100 Francesco Saverio Giudice <info@fsgiudice.com>
* contrib/gd/source/gdwrp.c
+ added GTIMAGECREATEPALETTE as alias of GDIMAGECREATE
+ contrib/gd/tests/antialiased.prg
+ test of gdImageSetAntiAliased() function
thanks to Jorge Mason for requesting it
2005-10-31 01:37 UTC+0100 Francesco Saverio Giudice <info@fsgiudice.com>
+ contrib/gd/Rules.make
* reverted. file needed
2005-10-31 01:20 UTC+0100 Francesco Saverio Giudice <info@fsgiudice.com>
* contrib/gd/source/gdwrp.c
* contrib/gd/source/gdimage.prg
* contrib/gd/source/gd.prg
* fixed some warnings
* contrib/gd/include/gd.h
* contrib/gd/include/gd.ch
* contrib/gd/source/gdimage.c
* contrib/gd/source/gdwrp.c
* guarded gd version.
for linux gd last version is 2.0.28 (i.e. Fedora Core 3)
for windows gd last version is 2.0.33
if your distribution is different please update header files
this is needed because some functions are missing in 2.0.28
- contrib/gd/Rules.make
- contrib/gd/test/Makefile
- contrib/gd/test/Makefile.linux
- contrib/gd/test/Makefile.mingw32
+ contrib/gd/test/bldtest.sh
+ contrib/gd/test/dll_b32.bat
+ contrib/gd/test/dll_b32.mak
+ contrib/gd/samples/counter/bldtest.sh
+ contrib/gd/samples/counter/dll_b32.bat
+ contrib/gd/samples/counter/dll_b32.mak
* contrib/gd/README.txt
* updated compilation batches for windows dll and linux
now for windows: bldtest gdtest (full static)
dll_b32 gdtest (dll version - needs harbour.dll)
for linux : . bldtest.sh gdtest
2005-10-30 02:32 UTC+0200 Francesco Saverio Giudice <info@fsgiudice.com>
* contrib/gd/source/gdwrp.c
* replaced
im = hb_itemGetPtr( hb_param( 1, HB_IT_POINTER ) );
with
im = hb_parptr( 1 );
and
im_handle = hb_itemPutPtr( NULL, ( BYTE *) im );
hb_itemReturn(im_handle);
hb_itemRelease(im_handle);
with
hb_retptr( im )
2005-10-25 18:07 UTC+0200 Francesco Saverio Giudice <info@fsgiudice.com>
* contrib/gd/MAKE_B32.BAT
* fixed bgd.dll name
(thanks to Dener)
2005-10-25 10:31 UTC+0200 Francesco Saverio Giudice <info@fsgiudice.com>
- contrib/gd/bgd.dll
+ contrib/gd/bgd.dll_download.url
* removed from bgd.dll from CVS 2.9 MB (sorry)
and added a link to gdwin32.zip from Thomas Boutell's website
to download it.
* contrib/gd/README.txt
* updated
* contrib/gd/MAKE_B32.BAT
* check if bgd.dll exists
2005-10-25 02:43 UTC+0200 Francesco Saverio Giudice <info@fsgiudice.com>
* contrib/gd/tests/gdtest.prg
* contrib/gd/tests/gdtestcls.prg
* some fixes
* contrib/gd/README.txt
* updated
+ contrib/gd/samples
+ added a samples directory
+ contrib/gd/samples/counter/bldtest.bat
+ contrib/gd/samples/counter/counter.prg
+ contrib/gd/samples/counter/digits
+ contrib/gd/samples/counter/digits/57chevy.gif
+ contrib/gd/samples/counter/digits/7seg.gif
+ contrib/gd/samples/counter/digits/brsd.gif
+ contrib/gd/samples/counter/digits/digib.gif
+ contrib/gd/samples/counter/digits/digitmania.url
+ contrib/gd/samples/counter/digits/fdb.gif
+ contrib/gd/samples/counter/digits/jelly.gif
+ contrib/gd/samples/counter/digits/odb.gif
+ contrib/gd/samples/counter/digits/odw.gif
+ contrib/gd/samples/counter/digits/pdg.gif
+ contrib/gd/samples/counter/digits/pdw.gif
+ added a counter sample
/*
A first sample: an image counter
to build: bldtest counter
to run: counter
to have a random number using 57chevy.gif as base image
or: counter 372647 odb.gif
to have a fixed number with odb.gif as base image
base images from digitmania
Enjoy!
Francesco
*/
2005-10-25 01:14 UTC+0200 Francesco Saverio Giudice <info@fsgiudice.com>
* contrib/gd/tests/bldtest.bat
* fixed build error
2005-10-25 01:02 UTC+0200 Francesco Saverio Giudice <info@fsgiudice.com>
* contrib/gd/tests/gdtest.prg
* contrib/gd/tests/gdtestcls.prg
* added output directory check and create if not exists
2005-10-24 15:10 UTC+0200 Francesco Saverio Giudice <info@fsgiudice.com>
+ contrib/gd
+ /bgd.dll
+ /Rules.make
+ /Makefile
+ /MAKE_B32.BAT
+ /MAKEFILE.BC
+ /README.txt
+ /ChangeLog
+ /doc/entities.html
+ /doc/GD Graphics Library.url
+ /doc/gd-license.txt
+ /doc/gdlib.txt
+ /doc/index.html
+ /doc/libfreetype-license.txt
+ /doc/libjpeg-license.txt
+ /doc/libpng-license.txt
+ /doc/win32-readme.txt
+ /doc/zlib-license.txt
+ /env/makeb32.env
+ /env/makelib.b32
+ /env/bccWin32.Mak
+ /include/gd.h
+ /include/gdcache.h
+ /include/gdfontg.h
+ /include/gdfontl.h
+ /include/gdfontmb.h
+ /include/gdfonts.h
+ /include/gdfontt.h
+ /include/gdfx.h
+ /include/gdhelpers.h
+ /include/gd_io.h
+ /include/jisx0208.h
+ /include/wbmp.h
+ /include/gd.ch
+ /source/gd.prg
+ /source/gdchart.prg
+ /source/Makefile
+ /source/gdwrp.c
+ /source/gdimage.prg
+ /tests/images_in
+ /tests/images_out
+ /tests/Makefile
+ /tests/Makefile.linux
+ /tests/Makefile.mingw32
+ /tests/setfont.bat
+ /tests/bldtest.bat
+ /tests/test_out.prg
+ /tests/gdtest.prg
+ /tests/gdtestcls.prg
+ /tests/images_in/xharbour.jpg
+ /tests/images_in/italia.gif
+ /tests/images_in/fsg.jpg
+ /tests/images_out/
+ first upload
/*
Please look at README.txt
*/

22
harbour/contrib/gd/Makefile Normal file
View File

@@ -0,0 +1,22 @@
ROOT = ../../
C_SOURCES=\
gdwrp.c \
PRG_SOURCES=\
gd.prg \
gdbar.prg \
gdchart.prg \
gdimage.prg \
gdbarcod.prg
LIBNAME=hbgd
include $(TOP)$(ROOT)config/lib.cf
ifeq ($(HB_COMPILER),mingw32)
CFLAGS := $(CFLAGS) -I/usr/include
else
CFLAGS := $(CFLAGS) -I/usr/include
endif

42
harbour/contrib/gd/README Normal file
View File

@@ -0,0 +1,42 @@
/*
* $Id$
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.xharbour.org http://www.harbour-project.org
*
* Copyright 2004-2005 Francesco Saverio Giudice <info@fsgiudice.com>
* README file explaining howto compile GD
*
* See doc/license.txt for licensing terms.
*
*/
hbgd library is a wrapper around www.libgd.org graphic library
COMPILING
=========
on GNU system use:
make install
** requirements: gd, gd-devel, libpng, libpng-devel, libjpeg, libjpeg-devel,
freetype, freetype-devel, zlib, zlib-devel
DOCUMENTATION
=============
Not yet finished hbgd.txt is the help file.
SAMPLES
=======
For samples look at tests dir.
gdtest.prg is an API test application
gdtestcls.prg is a GDImage/GDChart Class test application
test_out.prg is a sample of a cgi application for windows (I have to complete it).
antialiased.prg shows how apply anti-alias to lines.
animgif.prg is a sample to create an animated gif.
bartest.prg is a sample to create barcodes with GD Library.

153
harbour/contrib/gd/gd.ch Normal file
View File

@@ -0,0 +1,153 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* GD graphic library header file.
*
* Copyright 2004-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.
*
*/
#ifndef GD_CH
#define GD_CH
#if ( defined(HB_OS_WIN_32) || defined(__WIN32__) )
#define GD_VERS 2033
#else
#define GD_VERS 2028
#endif
/* The maximum number of palette entries in palette-based images.
In the wonderful new world of gd 2.0, you can of course have
many more colors when using truecolor mode. */
#define gdMaxColors 256
#define gdAlphaMax 127
#define gdAlphaOpaque 0
#define gdAlphaTransparent 127
#define gdRedMax 255
#define gdGreenMax 255
#define gdBlueMax 255
/* For backwards compatibility only. Use gdImageSetStyle()
for MUCH more flexible line drawing. Also see
gdImageSetBrush(). */
#define gdDashSize 4
/* Special colors. */
#define gdStyled (-2)
#define gdBrushed (-3)
#define gdStyledBrushed (-4)
#define gdTiled (-5)
/* NOT the same as the transparent color index.
This is used in line styles only. */
#define gdTransparent (-6)
#define gdAntiAliased (-7)
#define gdFTEX_LINESPACE 1
#define gdFTEX_CHARMAP 2
#define gdFTEX_RESOLUTION 4
/* These are NOT flags; set one in 'charmap' if you set the
gdFTEX_CHARMAP bit in 'flags'. */
#define gdFTEX_Unicode 0
#define gdFTEX_Shift_JIS 1
#define gdFTEX_Big5 2
#define gdArc 0
#define gdPie gdArc
#define gdChord 1
#define gdNoFill 2
#define gdEdged 4
#define GD2_CHUNKSIZE 128
#define GD2_CHUNKSIZE_MIN 64
#define GD2_CHUNKSIZE_MAX 4096
#define GD2_VERS 2
#define GD2_ID "gd2"
#define GD2_FMT_RAW 1
#define GD2_FMT_COMPRESSED 2
#define GD_CMP_IMAGE 1 /* Actual image IS different */
#define GD_CMP_NUM_COLORS 2 /* Number of Colours in pallette differ */
#define GD_CMP_COLOR 4 /* Image colours differ */
#define GD_CMP_SIZE_X 8 /* Image width differs */
#define GD_CMP_SIZE_Y 16 /* Image heights differ */
#define GD_CMP_TRANSPARENT 32 /* Transparent colour */
#define GD_CMP_BACKGROUND 64 /* Background colour */
#define GD_CMP_INTERLACE 128 /* Interlaced setting */
#define GD_CMP_TRUECOLOR 256 /* Truecolor vs palette differs */
/* resolution affects ttf font rendering, particularly hinting */
#define GD_RESOLUTION 96 /* pixels per inch */
/* Legal values for Disposal. gdDisposalNone is always used by
the built-in optimizer if previm is passed. */
#define gdDisposalUnknown 0
#define gdDisposalNone 1
#define gdDisposalRestoreBackground 2
#define gdDisposalRestorePrevious 3
/* FSG - text alignment */
#define gdAlignLeft 0
#define gdAlignCenter 1
#define gdAlignRight 2
#endif // GD_CH

248
harbour/contrib/gd/gd.prg Normal file
View File

@@ -0,0 +1,248 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* GD graphic library prg level (client api) interface code.
*
* Copyright 2004 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.
*
*/
#include "common.ch"
FUNCTION gdImageChar( im, font, x, y, char, color )
RETURN gdImageString( im, font, x, y, char, color )
FUNCTION gdImageCharUp( im, font, x, y, char, color )
RETURN gdImageStringUp( im, font, x, y, char, color )
FUNCTION gdImageCircle( im, cx, cy, w, color )
RETURN gdImageArc( im, cx, cy, w, w, 0, 360, color )
FUNCTION gdImageFilledCircle( im, cx, cy, w, color )
RETURN gdImageFilledEllipse( im, cx, cy, w, w, color )
FUNCTION gdImageEllipse( im, cx, cy, w, h, color )
RETURN gdImageArc( im, cx, cy, w, h, 0, 360, color )
FUNCTION gdImageFTWidth( fontname, ptsize, angle )
LOCAL nWidth := 0
LOCAL cErr
LOCAL aRect := Array(8)
DEFAULT fontname TO "Arial"
DEFAULT ptsize TO 8
DEFAULT angle TO 0
cErr := gdImageStringFTEx( , @aRect, 0, fontname, ptsize, angle, 0, 0, "M" )
//__OutDebug( "ptsize", ptsize, aRect )
IF cErr == ""
nWidth := aRect[3] - aRect[1]
ENDIF
RETURN nWidth
FUNCTION gdImageFTHeight( fontname, ptsize, angle )
LOCAL nWidth := 0
LOCAL cErr
LOCAL aRect := Array(8)
DEFAULT fontname TO "Arial"
DEFAULT ptsize TO 8
DEFAULT angle TO 0
cErr := gdImageStringFTEx( , @aRect, 0, fontname, ptsize, angle, 0, 0, "M" )
IF cErr == ""
nWidth := aRect[2] - aRect[8]
ENDIF
RETURN nWidth
FUNCTION gdImageFTSize( string, fontname, ptsize, angle )
LOCAL nWidth := 0
LOCAL nHeight := 0
LOCAL nX, nY
LOCAL cErr
LOCAL aRect := Array(8)
DEFAULT fontname TO "Arial"
DEFAULT ptsize TO 8
DEFAULT angle TO 0
cErr := gdImageStringFTEx( , @aRect, 0, fontname, ptsize, angle, 0, 0, string )
//__OutDebug( "ptsize", ptsize, aRect )
IF cErr == ""
nWidth := aRect[3] - aRect[1]
nHeight := aRect[2] - aRect[8]
nX := aRect[1]
nY := aRect[2]
ENDIF
RETURN { nWidth, nHeight, nX, nY }
FUNCTION gdImageStringFT( im, fg, fontname, ptsize, angle, x, y, string, ;
linespacing, charmap, resolution )
LOCAL cErr
LOCAL aRect := Array(8)
cErr := gdImageStringFTEx( , @aRect, fg, fontname, ptsize, angle, x, y, string, linespacing, charmap, resolution )
IF cErr == ""
cErr := gdImageStringFTEx( im, aRect, fg, fontname, ptsize, angle, x, y, string, linespacing, charmap, resolution )
ENDIF
RETURN cErr
FUNCTION gdImageFromFile( cFile )
LOCAL cPath, cName, cExt, cDrive
LOCAL cType, cMime
LOCAL hFile := {=>}
LOCAL oImage
IF File( cFile )
HB_FNameSplit( cFile, @cPath, @cName, @cExt, @cDrive )
//TraceLog( cFile, cPath, cName, cExt, cDrive )
cExt := Lower( cExt )
DO CASE
CASE cExt == ".jpg" .OR. cExt == ".jpeg"
hFile[ "file" ] := cFile
hFile[ "path" ] := cPath
hFile[ "name" ] := cName
hFile[ "ext" ] := cExt
hFile[ "drive" ] := cDrive
cType := "jpeg"
cMime := "image/jpeg"
oImage := GDImage():LoadFromJpeg( cFile )
CASE cExt == ".gif"
hFile[ "file" ] := cFile
hFile[ "path" ] := cPath
hFile[ "name" ] := cName
hFile[ "ext" ] := cExt
hFile[ "drive" ] := cDrive
cType := "gif"
cMime := "image/gif"
oImage := GDImage():LoadFromGif( cFile )
CASE cExt == ".png"
hFile[ "file" ] := cFile
hFile[ "path" ] := cPath
hFile[ "name" ] := cName
hFile[ "ext" ] := cExt
hFile[ "drive" ] := cDrive
cType := "png"
cMime := "image/png"
oImage := GDImage():LoadFromPng( cFile )
ENDCASE
ENDIF
RETURN { oImage, hFile, cType, cMime }
FUNCTION gdImageToString( oImage )
LOCAL cString
//Tracelog( "oImage, oImage:ClassName, oImage:IsDerivedFrom( 'GDIMAGE' )", ;
// oImage, oImage:ClassName, oImage:IsDerivedFrom( 'GDIMAGE' ) )
IF ValType( oImage ) == "O" .AND. ( oImage:ClassName == "GDIMAGE" .OR. oImage:IsDerivedFrom( "GDIMAGE" ) )
WITH OBJECT oImage
IF :cType <> NIL
DO CASE
CASE :cType == "jpeg"
cString := :ToStringJpeg()
CASE :cType == "gif"
cString := :ToStringGif()
CASE :cType == "png"
cString := :ToStringPng()
ENDCASE
ENDIF
END
ENDIF
RETURN cString
PROCEDURE gdImageToFile( oImage, cFile )
LOCAL cString, cExt
DEFAULT cFile TO "image"
//Tracelog( "oImage, oImage:ClassName, oImage:IsDerivedFrom( 'GDIMAGE' )", ;
// oImage, oImage:ClassName, oImage:IsDerivedFrom( 'GDIMAGE' ) )
IF ValType( oImage ) == "O" .AND. ( oImage:ClassName == "GDIMAGE" .OR. oImage:IsDerivedFrom( "GDIMAGE" ) )
WITH OBJECT oImage
IF :cType <> NIL
DO CASE
CASE :cType == "jpeg"
cString := :ToStringJpeg()
cExt := "jpg"
CASE :cType == "gif"
cString := :ToStringGif()
cExt := "gif"
CASE :cType == "png"
cString := :ToStringPng()
cExt := "png"
ENDCASE
IF cString <> NIL
MemoWrit( cFile + "." + cExt, cString )
ENDIF
ENDIF
END
ENDIF
RETURN
/*
////aRect := { 10, 40, 100, 40, 100, 20, 10, 20 } //Array(8)
//aRect := Array(8)
////TraceLog( "aRect = " + hb_dumpVar( aRect ) )
//gdImageStringFtEx( , @aRect, blue, "arial", 20, 30, 20, 90, 'Test')
////TraceLog( "aRect = " + hb_dumpVar( aRect ) )
//? "aRect = " + hb_dumpVar( aRect )
//gdImageStringFtEx(im, aRect, blue, "arial", 20, 30, 20, 90, 'Test')
////TraceLog( "aRect = " + hb_dumpVar( aRect ) )
*/

358
harbour/contrib/gd/gdbar.prg Normal file
View File

@@ -0,0 +1,358 @@
/*
* xHarbour Project source code:
* BAR engine library class
*
* Copyright 2005-2005 Laverson Espíndola <laverson.espindola@gmail.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.
*
*/
#include "gd.ch"
#include "hbclass.ch"
#include "common.ch"
#define IMG_FORMAT_PNG 1
#define IMG_FORMAT_JPEG 2
#define IMG_FORMAT_WBMP 4
#define IMG_FORMAT_GIF 8
#define IMG_QUALITY 95
#define THICKNESS_I250 0
#define THICKNESS_I251 0
CLASS TBarCode FROM GDImage
// class attributes
DATA positionX AS NUMERIC INIT 4
DATA positionY AS NUMERIC
DATA maxHeight AS NUMERIC INIT 25
DATA maxHDefa AS NUMERIC INIT 25
DATA lastX AS NUMERIC
DATA lastY AS NUMERIC
DATA error AS NUMERIC
DATA imWidth AS NUMERIC
// Barcode attributes
DATA Parity
DATA LeftHand_Even AS ARRAY
DATA Right_Hand AS ARRAY
DATA LeftHand_Odd AS ARRAY
DATA keys AS ARRAY
DATA book AS LOGICAL INIT .F.
DATA acode AS ARRAY
DATA KeysModeA AS CHARACTER
DATA KeysModeB AS CHARACTER
DATA KeysModeC AS ARRAY
// image attributes
DATA res AS NUMERIC
DATA textfont AS NUMERIC
DATA text AS CHARACTER
DATA filename AS CHARACTER
DATA color_b AS ARRAY
DATA color_f AS ARRAY
DATA FillColor AS NUMERIC
DATA BackColor AS NUMERIC
DATA lDrawValue AS LOGICAL INIT .T.
// Methods
METHOD CreateBar( sx, sy, filename, ccolor)
METHOD Configure( nmaxHeight, aFillColor, aBackColor, nres, ntextfont, lbook, lDrawValue )
METHOD Allocate()
METHOD DrawError(ptext)
METHOD DrawSingleBar(pcode )
METHOD DrawSingleI25( pcode )
METHOD DrawText()
METHOD nextX()
METHOD Finish( image_style, quality )
METHOD SetText( ptext )
METHOD ResetColor()
METHOD CheckCode()
METHOD CheckValInArray(cchar)
ENDCLASS
METHOD CreateBar( sx, sy, filename, ccolor ) CLASS TBarCode
::Create(sx, sy)
DEFAULT ccolor TO {255,255,255}
::setcolor( ccolor[1], ccolor[2], ccolor[3] )
::error := 0
::positionY := 0
::imWidth := sx
if !empty( filename )
::filename := filename
endif
::FillColor := ::setcolor( ::color_f[1] ,::color_f[2] ,::color_f[3] )
::BackColor := ::setcolor( ::color_b[1] ,::color_b[2] ,::color_b[3] )
::Setfont("Arial")
// configures Fontes
If ::textfont == 1 ; ::SetFontSmall()
ElseIf ::textfont == 2 ; ::SetFontLarge()
ElseIf ::textfont == 3 ; ::SetFontMediumBold()
ElseIf ::textfont == 4 ; ::SetFontGiant()
ElseIf ::textfont == 5 ; ::SetFontTiny()
EndIf
::SetFontPitch(::textfont)
// always restores
::maxHeight := ::maxHDefa
Return Self
METHOD Configure( nmaxHeight, aFillColor, aBackColor, nres, ntextfont, lbook, lDrawValue ) CLASS TBarCode
DEFAULT lbook TO .F.
DEFAULT lDrawValue TO .T.
DEFAULT nmaxHeight TO 25
DEFAULT ntextfont TO 2
DEFAULT nres TO 2
DEFAULT aBackColor TO {255,255,255}
DEFAULT aFillColor TO {0,0,0}
::book := lbook
::maxHeight := nmaxHeight
::res := nres
::textfont := ntextfont
::lDrawValue := lDrawValue
::color_b := aClone(aBackColor)
::color_f := aClone(aFillColor)
RETURN NIL
METHOD SetText( ptext ) CLASS TBarCode
::text := ptext
Return NIL
METHOD ResetColor() CLASS TBarCode
::FillColor := ::setcolor( ::color_f[1] ,::color_f[2] ,::color_f[3] )
::BackColor := ::setcolor( ::color_b[1] ,::color_b[2] ,::color_b[3] )
Return NIL
METHOD Allocate() CLASS TBarCode
LOCAL R := ::color_b[1]
LOCAL G := ::color_b[2]
LOCAL B := ::color_b[3]
Return ::SetColor(R,G,B)
METHOD DrawSingleBar( pcode ) CLASS TBarCode
LOCAL i := 0
LOCAL j := 0
For j := 1 To Len( pcode )
For i := 1 TO ::res
::Line( ::positionX + i , ::positionY , ::positionX + i , (::positionY+::maxHeight) ,;
If( SubStr(pcode,j,1) $ "0", ::BackColor, ::FillColor ) )
Next
::NextX()
Next
Return NIL
METHOD DrawSingleI25( pcode ) CLASS TBarCode
LOCAL i := 0
LOCAL j := 0
LOCAL widthSlimBar := 1
LOCAL widthFatBar := 3
LOCAL imgBar
LOCAL imgWid
LOCAL end_y
LOCAL qw
::positionX := 10
For j := 1 To Len( pcode )
imgBar := If( j % 2 == 0, ::FillColor, ::BackColor )
imgWid := If( SubStr(pcode,j,1) =="0" , widthSlimBar, widthFatBar )
end_y := ::maxHeight
For qw := 1 TO imgWid
::Line( ::positionX, 1, ::positionX, end_y, imgBar)
::nextX(.T.)
Next
Next
Return NIL
METHOD DrawError(ptext) CLASS TBarCode
::Say( 5, ::error*15, ptext, ::FillColor )
::error++
::lastX := If( (::GetFontWidth()*Len(ptext) ) > ::lastX , ( ::GetFontWidth()*Len(ptext)) , ::lastX )
::lastY := ::error*15
Return NIL
METHOD nextX(lI25) CLASS TBarCode
DEFAULT li25 TO .F.
If li25
::positionX ++
Else
::positionX += ::res
EndIf
Return NIL
METHOD DrawText(lIsI25) CLASS TBarCode
LOCAL xPosition
DEFAULT lIsI25 TO .F.
If lIsI25
If( ::textfont != 0 )
xPosition := 10 * ::GetFontWidth()
::say( xPosition, ::maxHeight, "*" + ::text + "*" , ::FillColor )
::lastY := ::maxHeight + ::GetFontHeight()
EndIf
Else
If( ::textfont != 0 )
xPosition := ( ::positionX / 2) - ( Len( ::text ) /2 ) * ::GetFontWidth()
::say( xPosition, ::maxHeight, ::text, ::FillColor )
::lastY := ::maxHeight + ::GetFontHeight()
EndIf
EndIf
Return .T.
METHOD CheckCode() CLASS TBarCode
LOCAL lRet := .T.
LOCAL i
For i := 1 To Len( ::text )
If( !IsInt( ::CheckValInArray( ::text[i] ) ) )
::DrawError("Character "+::text[i]+" not allowed .")
lRet := .F.
EndIf
Next
Return lRet
METHOD CheckValInArray(cchar) CLASS TBarCode
LOCAL npos
LOCAL uret
npos := ASCAN( ::keys, { |x| x[1]== cchar } )
If npos > 0
uret := npos
Else
uret := NIL
EndIf
Return uret
METHOD Finish( image_style, quality, nFG ) CLASS TBarCode
DEFAULT image_style TO IMG_FORMAT_PNG
DEFAULT quality TO 95
DEFAULT nFG TO {255,255,255}
If Empty( ::filename ) .OR. ::filename = NIL
::filename := ::text
EndIf
If image_style == IMG_FORMAT_PNG
::SavePng( ::filename )
Elseif image_style == IMG_FORMAT_JPEG
::Savejpeg( ::filename, quality )
ElseIf image_style == IMG_FORMAT_WBMP
::SaveWBmp( ::filename, nFG )
ElseIf image_style == IMG_FORMAT_GIF
::SaveGif( ::filename )
EndIf
Return .T.
FUNCTION IsInt( pvar )
If Valtype( pvar ) == "C"
Return .F.
EndIf
Return .T.

694
harbour/contrib/gd/gdbarcod.prg Normal file
View File

@@ -0,0 +1,694 @@
/*
* xHarbour Project source code:
* CodeBar engine library class
*
* Copyright 2005-2005 Laverson Espíndola <laverson.espindola@gmail.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.
*
*/
#include "hbclass.ch"
#include "common.ch"
#define CODEC 100
#define CODEB 101
#define CODEA 102
#define FNC1 103
#define STARTA 104
#define STARTB 105
#define STARTC 106
CLASS TCode FROM TBarCode
DATA nType
// EAN-13 ISBN
METHOD New( nType ) CONSTRUCTOR
METHOD Draw( cText )
METHOD Draw13( cText )
METHOD DrawText13()
// EAN-8
METHOD Draw8( cText )
METHOD DrawText8()
// EAN-128
METHOD Draw128( cText, cModeCode )
// I25
METHOD DrawI25( cText )
METHOD GenCodei25()
// Utils
METHOD FindCharCode( cstring, cchar )
METHOD MixCode(bar_string)
METHOD Findcode( uval )
ENDCLASS
METHOD New( nTypeCode ) CLASS TCode
Local ii
If ( nTypeCode == 13 .OR.;
nTypeCode == 8 )
::LeftHand_Odd := {"0011001", "0010011", "0111101", "0100011", "0110001", "0101111", "0111011", "0110111", "0001011","0001101"}
::LeftHand_Even := {"0110011", "0011011", "0100001", "0011101", "0111001", "0000101", "0010001", "0001001", "0010111","0100111"}
::Right_Hand := {"1100110", "1101100", "1000010", "1011100", "1001110", "1010000", "1000100", "1001000", "1110100","1110010"}
::Parity := {"OOEOEE", "OOEEOE", "OOEEEO", "OEOOEE", "OEEOOE", "OEEEOO", "OEOEOE", "OEOEEO", "OEEOEO","OOOOOO" }
::keys := {'1','2','3','4','5','6','7','8','9','0'}
ElseIf nTypeCode == 128 // 128
::aCode :={ "212222","222122","222221","121223","121322","131222","122213","122312","132212","221213",;
"221312","231212","112232","122132","122231","113222","123122","123221","223211","221132",;
"221231","213212","223112","312131","311222","321122","321221","312212","322112","322211",;
"212123","212321","232121","111323","131123","131321","112313","132113","132311","211313",;
"231113","231311","112133","112331","132131","113123","113321","133121","313121","211331",;
"231131","213113","213311","213131","311123","311321","331121","312113","312311","332111",;
"314111","221411","431111","111224","111422","121124","121421","141122","141221","112214",;
"112412","122114","122411","142112","142211","241211","221114","213111","241112","134111",;
"111242","121142","121241","114212","124112","124211","411212","421112","421211","212141",;
"214121","412121","111143","111341","131141","114113","114311","411113","411311","113141",;
"114131","311141","411131","211412","211214","211232","2331112";
}
::KeysmodeA := " " + [!"#$%&\()*+-.,/0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ] + "[\]^_"
::KeysmodeB := " " + [!"#$%&\()*+-.,/0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ] + "[\]^_abcdefghijklmnopqrstuvwxyz{|}~"
::KeysModeC := Array(99)
For ii := 1 TO 99
::KeysmodeC[ii] := StrZero(ii,2)
Next
ElseIf nTypeCode == 25
::keys := {'1','2','3','4','5','6','7','8','9','0'}
::aCode := Array(12)
::aCode[1] := "10001" //1 digit
::aCode[2] := "01001" //2 digit
::aCode[3] := "11000" //3 digit
::aCode[4] := "00101" //4 digit
::aCode[5] := "10100" //5 digit
::aCode[6] := "01100" //6 digit
::aCode[7] := "00011" //7 digit
::aCode[8] := "10010" //8 digit
::aCode[9] := "01010" //9 digit
::aCode[10] := "00110" //0 digit
::acode[11] := "10000" //pre-amble
::acode[12] := "100" //post-amble
Else
Alert(" Invalid type to barcode !")
Return NIL
EndIf
::nType := nTypeCode
Return SELF
METHOD Draw( cText ) CLASS TCode
if ::nType == 13
::Draw13( cText )
elseif ::nType == 8
::Draw8( cText )
elseif ::nType == 128
::Draw128( cText )
elseif ::nType == 25
::DrawI25( cText )
endif
Return NIL
METHOD Draw13(cText) CLASS TCode
LOCAL lerror := .f.
LOCAL nchkSum :=0
LOCAL nChk :=0
LOCAL ii,jj
LOCAL xParity
::Settext( ctext )
// Valid characters
If !::CheckCode()
lerror := .T.
EndIf
If !lerror
If( ::book .AND. Len( ::text) != 10 )
::DrawError("Must contains 10 chars if ISBN is true.")
lerror = .T.
EndIf
// book, we changed the code to the right
If ( ::book .And. Len( ::text )==10 )
::text := "978"+substr(::text,1, Len( ::text )-1 )
EndIF
// contain only 12 characters ?
If Len( ::text ) != 12
::DrawError( "Must contains 12 chars, the 13th digit is automatically added.")
lerror = .t.
EndIf
If !lerror
// If we have to write text, we moved the barcode to the right to have space to put digit
::positionX = If( ::textfont == 0 , 0, 10 )
xParity := ::Parity[ Val( ::text[1] ) ]
// First Bar
::positionX := 10
::maxHeight := ::maxHeight + 9
::DrawSingleBar("101")
// start code
::maxHeight := ::maxHeight - 9
For ii := 1 To Len( ::text )
// Calculate check digit
If Mod( ((Len(::text) + 1) - ii), 2 ) = 0
nchkSum := nchkSum + Int( Val( Substr(::text , ii, 1) ) )
Else
nchkSum := nchkSum + Int( Val( Substr( ::text , ii, 1) ) ) * 3
EndIf
// ANow, the bar of the middle
If ii = 8
::positionX += 1
::maxHeight := ::maxHeight + 9
::DrawSingleBar("101")
::maxHeight := ::maxHeight - 9
::positionX += 1
EndIf
jj := Val( SubStr( ::text, ii, 1) )
If jj = 0
jj := 10
EndIf
If ii > 1 .And. ii < 8
::DrawSingleBar( If( Substr(xParity, ii - 1, 1) = "E",;
::LeftHand_Even[jj],;
::LeftHand_Odd[jj] ) )
ElseIf ii > 1 .And. ii >= 8
::DrawSingleBar( ::Right_Hand[jj] )
EndIf
Next
jj := Mod( nchkSum, 10 )
If jj <> 0
nChk = 10 - jj
EndIf
If nChk == 0
nChk := 10
EndIf
::DrawSingleBar( ::Right_Hand[nChk] )
// Now, finish bar
::maxHeight := ::maxHeight + 9
::DrawSingleBar("101")
::lastX := ::positionX
::lastY := ::maxHeight
ctext+=AllTrim( Str( nChk,1 ) )
// Draw Text
If ::lDrawValue
::Settext( ctext )
::DrawText13()
EndIf
EndIf
EndIf
Return NIL
METHOD DrawText13() CLASS TCode
if ( ::textfont != 0 )
::Say( 2, ::maxHeight-( ::GetFontHeight() / 2 ),SubStr( ::text,1,1) , ::FillColor )
::Say( (10+(3*::res+48*::res)/2)-(::GetFontWidth()*(6/2)),::maxHeight+1,substr(::text,2,6), ::FillColor )
::Say( 10+46*::res+(3*::res+46*::res)/2-::GetFontWidth()*(6/2),::maxHeight+1,substr(::text,8,6),::FillColor)
EndIf
::lastY := ::maxHeight + ::GetFontHeight()
Return NIL
METHOD Draw8( cText ) CLASS TCode
LOCAL lerror := .f.
LOCAL ii,jj
LOCAL xParity
LOCAL nchkSum := 0
LOCAL nChk := 0
::Settext( ctext )
// Valid characters
If !::CheckCode()
lerror := .T.
EndIf
If !lerror
::positionX = If( ::textfont == 0 , 0, 10 )
xParity := ::Parity[ 7 ]
// First Bar
::positionX := 10
::maxHeight := ::maxHeight + 9
::DrawSingleBar("101")
// Start Code
::maxHeight := ::maxHeight - 9
For ii = 1 To Len(::text)
If Mod( ((Len(::text) + 1 ) - ii ), 2 ) = 0
nchkSum := nchkSum + Int( Val(Substr( ::text, ii, 1) ) )
Else
nchkSum := nchkSum + Int( Val(Substr( ::text, ii, 1) ) ) * 3
EndIf
If ii = 5
::positionX += 1
::maxHeight := ::maxHeight + 9
::DrawSingleBar("01010")
::maxHeight := ::maxHeight - 9
::positionX += 1
EndIf
jj := Val( SubStr( ::text, ii, 1) )
If jj == 0
jj := 10
EndIf
If ii < 5
::DrawSingleBar( ::LeftHand_Odd[jj] )
ElseIf ii >= 5
::DrawSingleBar( ::Right_Hand[jj] )
EndIf
Next
jj := Mod( nchkSum, 10 )
If jj <> 0
nChk = 10 - jj
EndIf
::DrawSingleBar(::Right_Hand[nChk])
// Now, finish bar
::maxHeight := ::maxHeight + 9
::DrawSingleBar("101")
::lastX := ::positionX
::lastY := ::maxHeight
ctext+=AllTrim( Str( nChk,1 ) )
// Draw text
If ::lDrawValue
::Settext( ctext )
::DrawText8()
EndIf
EndIf
Return NIL
METHOD DrawText8() CLASS TCode
::say( 10+( (3*::res+34*::res)/2-::GetFontWidth()*(4/2) ),::maxHeight+1, substr( ::text,1,4 ),::fillcolor)
::say(10+(32*::res+(3*::res+32*::res)/2-::GetFontWidth()*(4/2)),::maxHeight+1,substr(::text,5,4),::fillcolor)
::lastY := ::maxHeight + ::GetFontHeight()
Return NIL
METHOD FIndCharCode( cstring, cchar ) CLASS TCode
LOCAL i
LOCAL nC := 0
LOCAL nret := 0
FOR i := 1 TO Len( cstring )
If SubStr( cstring, i, 1 ) == cchar
++nC
nRet := nC
EXIT
EndIf
++nC
NEXT
Return nret
METHOD Draw128( cText, cModeCode ) CLASS TCode
Local cchar, nvalchar, n, i
Local nSum := 0
Local nC := 0
LOCAL npos := 0
LOCAL value_test := 0
Local lTypeCodeC := .F.
Local lTypeCodeA := .F.
LOCAL lerror := .F.
Local cBarCode := ""
Local cconc := ""
DEFAULT cModeCode TO "B"
::settext( cText )
If !Empty( cModeCode )
If valtype(cModeCode)='C' .and. Upper(cModeCode) $'ABC'
cModeCode := Upper(cModeCode)
Else
::DrawError("Code 128 Modes are A,B o C. Character values.")
lerror := .T.
EndIf
EndIf
// Checking if all chars are allowed
For i := 1 TO Len( ::text )
If cModeCode == "C"
npos := AsCAn( ::KeysmodeC, { |x| x ==::Text[i]+::Text[i+1] } )
If npos == 0
::DrawError("With Code C, you must provide always pair of two integers. Char "+::text[i]+::text[i+1]+" not allowed." )
lerror := .T.
EndIf
ElseIf cModeCode == "B"
If ::FIndCharCode( ::KeysmodeB, ::Text[i] ) == 0
::DrawError('Char '+::text[i]+" not allowed.")
lerror = .T.
EndIf
ElseiF cModeCode == "A"
If ::FIndCharCode( ::KeysmodeA, ::text[i] ) == 0
::DrawError('Char '+::text[i]+" not allowed.")
lerror := .T.
EndIf
EndIf
Next
If !lerror
If Empty(cModeCode)
If Str( Val( ::text ), Len( ::text ) ) = ::text
lTypeCodeC := .T.
cconc := ::aCode[ STARTC ]
nSum := STARTB
Else
For n := 1 TO Len( ::text )
nC += If( substr( ::text ,n,1 ) > 31, 1, 0 )
Next
If nC < Len( ::text ) / 2
lTypeCodeA:= .t.
cconc := ::aCode[STARTA]
nSum := FNC1
Else
cconc := ::aCode[STARTB]
nSum := STARTA
EndIf
EndIf
Else
If cModeCode =='C'
lTypeCodeC := .T.
cconc := ::aCode[STARTC]
nSum := STARTB
Elseif cModeCode =='A'
lTypeCodeA := .t.
cconc := ::aCode[STARTB]
nSum := FNC1
Else
cconc := ::aCode[STARTB]
nSum := STARTA
EndIf
EndIf
nC := 0
For n := 1 To Len( ::text )
nC ++
cchar := Substr(::text,n,1)
if lTypeCodeC
If Len( ::TEXT ) = n
cconc += ::aCode[101]
nvalchar := Asc(cchar)-31
Else
nvalchar := Val(Substr( ::text,n,2 ) ) + 1
n++
EndIf
Elseif lTypeCodeA
If cchar > '_'
cconc += ::aCode[101]
nvalchar := Asc(cchar)-31
Elseif cchar <= ' '
nvalchar := Asc(cchar)+64
Else
nvalchar := Asc(cchar)-31
Endif
Else
If cchar < ' '
cconc += ::aCode[CODEA]
nvalchar := Asc(cchar)+64
Else
nvalchar := Asc(cchar)-31
EndIf
Endif
nSum += (nvalchar-1)*nC
cconc := cconc +::aCode[nvalchar]
next
nSum := nSum%103 +1
cconc := cconc + ::aCode[ nSum ] +::aCode[107]
For n:=1 To Len(cconc) STEP 2
cBarCode +=Replicate('1', Val( Substr( cconc, n,1 ) ) )
cBarCode +=Replicate('0', Val( substr( cconc, n+1,1 ) ) )
Next
::DrawSingleBar( cBarCode )
::lastX := ::positionX
::lastY := ::maxHeight
// Draw Text
If ::lDrawValue
::Settext( ctext )
::DrawText()
EndIf
EndIf
Return NIL
METHOD DrawI25( cText ) CLASS TCode
::settext( cText )
::GenCodei25()
Return NIL
METHOD GenCodei25() CLASS TCode
LOCAL lError := .F.
LOCAL bc_string := ::text
LOCAL new_string := ""
If ( Len(::text) % 2 )!= 0
::DrawError("Invalid barcode lenght")
lError := .T.
Endif
If !lError
bc_string = upper( ::text )
// encode itemId to I25 barcode standard. //////////////////////////////////////
bc_string = ::MixCode( bc_string )
///////////////////////////////////////////////////////////////////////////////////////////////
//Adding Start and Stop Pattern
::DrawSingleI25( ::acode[11] + bc_string + ::acode[12] )
::lastY := ::maxHeight
// Draw Text
If ::lDrawValue
::DrawText(.T.)
EndIf
EndIf
Return NIL
/*
It makes mixe of the value to be codified by the Bar code I25
*/
METHOD MixCode(value) CLASS TCode
LOCAL l,i,k
LOCAL s
LOCAL bar_string := ""
LOCAL cfirst
LOCAL cnext
l := Len( value )
If ( l % 2 ) != 0
::DrawError("Code cannot be intercalated: Invalid length (mix)")
Else
i := 1
s := ""
While i < l
cFirst := ::Findcode( value[i] )
cnext := ::Findcode( value[i+1] )
// Mix of the codes
// NNNNWNNWWW
// N N N W W
For k := 1 TO 5
s += cFirst[k] + cnext[k]
Next
i += 2
EndDo
bar_string := s
EndIf
Return bar_string
METHOD Findcode( uval ) CLASS TCode
LOCAL npos
LOCAL cretc
npos := AsCan( ::keys, { |x| x[1] == uval } )
cretc := ::acode[npos]
Return cretc
/*
EOF
*/

889
harbour/contrib/gd/gdchart.prg Normal file
View File

@@ -0,0 +1,889 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* GD graphic library chart class
*
* Copyright 2004-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.
*
*/
#include "common.ch"
#include "hbclass.ch"
#include "gd.ch"
#define DEFAULT( x, y ) IIF( x == NIL, x := y, )
CLASS GDChart FROM GDImage
DATA cTitle
DATA cAxisX
DATA cAxisY
DATA nWidth
DATA nHeight
DATA nScaleX
DATA nScaleY
DATA aSeries
DATA aDataOfHashes // Hash contains graph datas
DATA hDefs
METHOD New( sx, sy ) CONSTRUCTOR
METHOD AddData()
METHOD AddDef()
METHOD SetData()
METHOD SetDefs()
METHOD PieChart()
METHOD VerticalBarChart()
METHOD HorizontalBarChart()
METHOD LineChart()
ENDCLASS
METHOD New( sx, sy ) CLASS GDChart
DEFAULT sx TO 320
DEFAULT sy TO 200
::cTitle := "Chart"
::aSeries := {}
::hDefs := Hash()
::aDataOfHashes := {}
::Create( sx, sy )
RETURN Self
METHOD AddData( hData ) CLASS GDChart
IF ValType( hData ) == "H"
aAdd( ::aDataOfHashes, hData )
ENDIF
RETURN Self
METHOD SetData( aData ) CLASS GDChart
IF ValType( aData ) == "A"
::aDataOfHashes := aData
ENDIF
RETURN Self
METHOD AddDef( cDefKey, xDefVal ) CLASS GDChart
IF ValType( cDefKey ) == "C"
hSet( ::hDefs, Upper( cDefKey ), xDefVal )
ENDIF
RETURN Self
METHOD SetDefs( hDefs ) CLASS GDChart
IF ValType( hDefs ) == "H"
::hDefs := hDefs
ENDIF
RETURN Self
METHOD PieChart() CLASS GDChart
LOCAL hElement, nTot := 0
LOCAL nDegree := 0
LOCAL lFilled, lExtruded, nExtrude, nTotExtr := 0, pTile
LOCAL colorp
LOCAL nVal, nDim
LOCAL nPosX, nPosY
LOCAL cLabel, hFont, cFontName, nPitch, nAngle, textcolor
LOCAL x, y, nWidth
LOCAL aPieDataOfHash, hDefs
LOCAL cFontPitch
aPieDataOfHash := ::aDataOfHashes
hDefs := ::hDefs
x := HGetValue( hDefs, "POSX" )
y := HGetValue( hDefs, "POSY" )
nWidth := HGetValue( hDefs, "WIDTH" )
cFontPitch := HGetValue( hDefs, "FONTPITCH" )
DEFAULT x TO ::CenterWidth()
DEFAULT y TO ::CenterHeight()
DEFAULT nWidth TO Min( ::Width(), ::Height() )
DEFAULT cFontPitch TO "TINY"
DO CASE
CASE cFontPitch == "TINY"
::SetFontTiny()
CASE cFontPitch == "SMALL"
::SetFontSmall()
CASE cFontPitch == "MEDIUM"
::SetFontMediumBold()
CASE cFontPitch == "LARGE"
::SetFontLarge()
CASE cFontPitch == "GIANT"
::SetFontGiant()
ENDCASE
//__OutDebug( "x, y, nWidth", x, y, nWidth )
/*
hData := ["TITLE"], ["VALUE"], ["FILLED"], ["COLOR"], ["TILE"], ["EXTRUDE"]
*/
// Before sum of values to determine perentual
FOR EACH hElement IN aPieDataOfHash
nTot += hElement["VALUE"]
// Check extrution
IF ( nExtrude := HGetValue( hElement, "EXTRUDE" ) ) <> NIL
nTotExtr := Max( nTotExtr, nExtrude )
ENDIF
NEXT
nWidth -= ( nTotExtr + 2 ) * 2
//__OutDebug( "nTotExtr, nWidth", nTotExtr, nWidth )
// Second,
FOR EACH hElement IN aPieDataOfHash
cLabel := HGetValue( hElement, "LABEL" )
lFilled := HGetValue( hElement, "FILLED" )
nExtrude := HGetValue( hElement, "EXTRUDE" )
pTile := HGetValue( hElement, "TILE" )
IF nExtrude <> NIL
lExtruded := TRUE
ELSE
lExtruded := FALSE
ENDIF
colorp := HGetValue( hElement, "COLOR" )
nVal := hElement["VALUE"]
nDim := 360 * ( ( nVal / nTot ) * 100 ) / 100
DEFAULT lFilled TO FALSE
DEFAULT nExtrude TO 0
DEFAULT colorp TO ::SetColor( 0, 0, 0 )
IF lExtruded
nPosX := x + nExtrude * cos(::Radians( nDegree + nDim / 2 ))
nPosY := y + nExtrude * sin(::Radians( nDegree + nDim / 2 ))
ELSE
nPosX := x
nPosY := y
ENDIF
IF pTile <> NIL
::SetTile( pTile )
colorp := gdTiled
ELSE
if ISARRAY( colorp )
colorp := ::SetColor( colorp[1], colorp[2], colorp[3] )
endif
ENDIF
IF lFilled
::Arc( nPosX, nPosY, nWidth, nWidth, nDegree, nDegree + nDim, TRUE, colorp, gdPie )
ELSE
::Arc( nPosX, nPosY, nWidth, nWidth, nDegree, nDegree + nDim, TRUE, colorp, gdNoFill + gdEdged )
ENDIF
IF cLabel <> NIL
//hFont := HGetValue( hElement, "FONT" )
//IF hFont == NIL
// ::SetFontMediumBold()
cFontName := NIL
nPitch := NIL
nAngle := NIL
textcolor := NIL
//ELSE
// cFontName := HGetValue( hFont, "NAME" )
// nPitch := HGetValue( hFont, "PITCH" )
// nAngle := HGetValue( hFont, "ANGLE" )
// textcolor := HGetValue( hFont, "COLOR" )
// DEFAULT cFontName TO "Arial"
// DEFAULT nPitch TO 8
// DEFAULT nAngle TO 0
//ENDIF
nPosX := nPosX + ( (nExtrude + nWidth) / 4 ) * cos(::Radians( nDegree + nDim / 2 ))
nPosY := nPosY + ( (nExtrude + nWidth) / 4 ) * sin(::Radians( nDegree + nDim / 2 ))
IF textcolor == NIL
colorp := ::GetPixel( nPosX, nPosY )
textcolor := ::SetColor( 255 - ::Red( colorp ), 255 - ::Green( colorp ), 255 - ::Blue( colorp ) )
ENDIF
//cTitle := LTrim( Str( nVal ) )
IF hFont == NIL
::Say( nPosX, nPosY, cLabel, textcolor, gdAlignCenter )
ELSE
::SayFreeType( nPosX, nPosY, cLabel, cFontName, nPitch, nAngle, textcolor, gdAlignCenter )
ENDIF
ENDIF
nDegree += nDim + 0.1
NEXT
RETURN Self
METHOD VerticalBarChart() CLASS GDChart
LOCAL hElement, nTot := 0
LOCAL nDegree := 0
LOCAL lFilled, lExtruded, nExtrude, pTile
LOCAL colorp
LOCAL nVal, nDim
LOCAL nPosX, nPosY
LOCAL nSize, nMax
LOCAL nBorder, nThick, n
LOCAL x, y, nWidth, nHeight, nMaxValue, color, nMaxLabel, cLabel
LOCAL lShowAxis, lShowGrid
LOCAL nLeftLabelSpace //:= 40
LOCAL nRightLabelSpace //:= 40
LOCAL nBottomLabelSpace //:= 40
LOCAL nTopLabelSpace := 40
LOCAL lShowLabelLeft := TRUE
LOCAL lShowLabelRight := TRUE //FALSE
LOCAL lShowLabelBottom := TRUE
LOCAL lShowLabelTop := FALSE
LOCAL cAxisPict
LOCAL cFontPitch
LOCAL aDataOfHash, hDefs
aDataOfHash := ::aDataOfHashes
hDefs := ::hDefs
x := HGetValue( hDefs, "POSX" )
y := HGetValue( hDefs, "POSY" )
nWidth := HGetValue( hDefs, "WIDTH" )
nHeight := HGetValue( hDefs, "HEIGHT" )
nMaxValue := HGetValue( hDefs, "MAXVALUE" )
color := HGetValue( hDefs, "COLOR" )
lShowAxis := HGetValue( hDefs, "SHOWAXIS" )
lShowGrid := HGetValue( hDefs, "SHOWGRID" )
cAxisPict := HGetValue( hDefs, "AXISPICT" )
cFontPitch := HGetValue( hDefs, "FONTPITCH" )
DEFAULT x TO 0
DEFAULT y TO 0
DEFAULT nWidth TO ::Width()
DEFAULT nHeight TO ::Height()
DEFAULT color TO ::GetColor()
DEFAULT lShowAxis TO TRUE
DEFAULT lShowGrid TO TRUE
DEFAULT cAxisPict TO "@E 9,999.99"
DEFAULT cFontPitch TO "TINY"
DEFAULT nBorder TO 4
/*
hData := ["TITLE"], ["VALUE"], ["FILLED"], ["COLOR"], ["TILE"], ["EXTRUDE"]
*/
DO CASE
CASE cFontPitch == "TINY"
::SetFontTiny()
CASE cFontPitch == "SMALL"
::SetFontSmall()
CASE cFontPitch == "MEDIUM"
::SetFontMediumBold()
CASE cFontPitch == "LARGE"
::SetFontLarge()
CASE cFontPitch == "GIANT"
::SetFontGiant()
ENDCASE
// Before sum of values to determine perentual
nMaxLabel := 0
nMax := 0
FOR EACH hElement IN aDataOfHash
IF HB_EnumIndex() == 1
nMax := hElement["VALUE"]
ELSE
nMax := Max( nMax, hElement["VALUE"] )
ENDIF
cLabel := HGetValue( hElement, "LABEL" )
nMaxLabel := Max( nMaxLabel, Len( IIF( cLabel <> NIL, cLabel, "" ) ) )
nTot += hElement["VALUE"]
NEXT
//__OutDebug( "Len( LTrim( Str( nMax ) ) )", Len( LTrim( cStr( nMax ) ) ), Str( nMax ) )
DEFAULT nLeftLabelSpace TO nBorder + Len( LTrim( Transform( nMax, cAxisPict ) ) ) * ::GetFontWidth() + nBorder
DEFAULT nRightLabelSpace TO nLeftLabelSpace //nBorder + Len( LTrim( Str( nMax ) ) ) * ::GetFontWidth() + nBorder
DEFAULT nBottomLabelSpace TO nBorder + nMaxLabel * ::GetFontWidth() + nBorder
DEFAULT nMaxValue TO nMax
IF lShowAxis
IF lShowLabelLeft
x += nLeftLabelSpace
nWidth -= nLeftLabelSpace
ENDIF
IF lShowLabelRight
nWidth -= nRightLabelSpace
ENDIF
IF lShowLabelBottom
y += nBottomLabelSpace
nHeight -= nBottomLabelSpace
ENDIF
IF lShowLabelTop
nHeight -= nTopLabelSpace
ENDIF
ENDIF
nSize := nWidth / Len( aDataOfHash )
IF lShowGrid
::Rectangle( x, ::Height() - ( y + nHeight ), x + nWidth, ::Height() - y, FALSE, color )
nThick := ::SetThickness( 1 )
::ResetStyles()
::AddStyle( color )
::AddStyle( color )
::AddStyle( color )
::AddStyle( gdTransparent )
::AddStyle( gdTransparent )
::AddStyle( gdTransparent )
::AddStyle( gdTransparent )
::AddStyle( gdTransparent )
::SetStyle()
FOR n := 10 TO 100 STEP 10
nDim := ( ( nMaxValue / 100 ) * n )
nPosY := ( nDim / nMaxValue ) * nHeight
//__OutDebug( "nDim", nDim )
::Line( x, ::Height() - ( y + nPosY), x + nWidth, ::Height() - ( y + nPosY ), gdStyled )
NEXT
::SetThickness( nThick )
ENDIF
IF lShowAxis
// Y Axis
FOR n := 10 TO 100 STEP 10
nDim := ( ( nMaxValue / 100 ) * n )
cLabel := LTrim( Transform( nDim, cAxisPict ) )
nPosY := ( nDim / nMaxValue ) * nHeight
IF lShowLabelLeft
::Say( x - nLeftLabelSpace + nBorder, ::Height() - ( y + nPosY ), PadL( cLabel, Len( LTrim( Transform( nMaxValue, cAxisPict ) ) ) ), color )
ENDIF
IF lShowLabelRight
::Say( x + nWidth + nBorder, ::Height() - ( y + nPosY ), cLabel, color )
ENDIF
NEXT
ENDIF
// Second,
FOR EACH hElement IN aDataOfHash
cLabel := HGetValue( hElement, "LABEL" )
lFilled := HGetValue( hElement, "FILLED" )
nExtrude := HGetValue( hElement, "EXTRUDE" )
pTile := HGetValue( hElement, "TILE" )
IF nExtrude <> NIL
lExtruded := TRUE
ELSE
lExtruded := FALSE
ENDIF
colorp := HGetValue( hElement, "COLOR" )
nVal := hElement["VALUE"]
nDim := ( nVal / nMaxValue ) * nHeight
DEFAULT lFilled TO FALSE
DEFAULT nExtrude TO 0
DEFAULT colorp TO ::SetColor( 0, 0, 0 )
nPosX := x + ( nSize * ( HB_EnumIndex() - 1 ) )
nPosY := y
IF pTile <> NIL
::SetTile( pTile )
colorp := gdTiled
ELSE
if ISARRAY( colorp )
colorp := ::SetColor( colorp[1], colorp[2], colorp[3] )
endif
ENDIF
::Rectangle( nPosX + nBorder, ::Height() - ( nPosY + nDim ), nPosX + nSize - nBorder, ::Height() - nPosY, lFilled, colorp )
IF lShowAxis
// Y Axis
IF lShowLabelBottom
::SayVertical( nPosX + nSize / 2 - ::GetFontHeight() / 2, ::Height() - nBorder, PadL( cLabel, nMaxLabel ), color )
ENDIF
ENDIF
NEXT
RETURN Self
METHOD HorizontalBarChart() CLASS GDChart
LOCAL hElement, nTot := 0
LOCAL nDegree := 0
LOCAL lFilled, lExtruded, nExtrude, pTile
LOCAL colorp
LOCAL nVal, nDim
LOCAL nPosX, nPosY
LOCAL nSize, nMax
LOCAL nBorder, nThick, n
LOCAL x, y, nWidth, nHeight, nMaxValue, color, nMaxLabel, cLabel
LOCAL lShowAxis, lShowGrid
LOCAL nLeftLabelSpace //:= 40
LOCAL nRightLabelSpace //:= 40
LOCAL nBottomLabelSpace //:= 40
LOCAL nTopLabelSpace //:= 40
LOCAL lShowLabelLeft := TRUE
LOCAL lShowLabelRight := TRUE
LOCAL lShowLabelBottom := TRUE
LOCAL lShowLabelTop := TRUE
LOCAL cAxisPict
LOCAL cFontPitch
LOCAL aDataOfHash, hDefs
aDataOfHash := ::aDataOfHashes
hDefs := ::hDefs
x := HGetValue( hDefs, "POSX" )
y := HGetValue( hDefs, "POSY" )
nWidth := HGetValue( hDefs, "WIDTH" )
nHeight := HGetValue( hDefs, "HEIGHT" )
nMaxValue := HGetValue( hDefs, "MAXVALUE" )
color := HGetValue( hDefs, "COLOR" )
lShowAxis := HGetValue( hDefs, "SHOWAXIS" )
lShowGrid := HGetValue( hDefs, "SHOWGRID" )
cAxisPict := HGetValue( hDefs, "AXISPICT" )
cFontPitch := HGetValue( hDefs, "FONTPITCH" )
DEFAULT x TO 0
DEFAULT y TO 0
DEFAULT nWidth TO ::Width()
DEFAULT nHeight TO ::Height()
DEFAULT color TO ::GetColor()
DEFAULT lShowAxis TO TRUE
DEFAULT lShowGrid TO TRUE
DEFAULT cAxisPict TO "@E 9,999.99"
DEFAULT cFontPitch TO "TINY"
DEFAULT nBorder TO 4
/*
hData := ["TITLE"], ["VALUE"], ["FILLED"], ["COLOR"], ["TILE"], ["EXTRUDE"]
*/
DO CASE
CASE cFontPitch == "TINY"
::SetFontTiny()
CASE cFontPitch == "SMALL"
::SetFontSmall()
CASE cFontPitch == "MEDIUM"
::SetFontMediumBold()
CASE cFontPitch == "LARGE"
::SetFontLarge()
CASE cFontPitch == "GIANT"
::SetFontGiant()
ENDCASE
// Before sum of values to determine perentual
nMaxLabel := 0
nMax := 0
FOR EACH hElement IN aDataOfHash
IF HB_EnumIndex() == 1
nMax := hElement["VALUE"]
ELSE
nMax := Max( nMax, hElement["VALUE"] )
ENDIF
cLabel := HGetValue( hElement, "LABEL" )
nMaxLabel := Max( nMaxLabel, Len( IIF( cLabel <> NIL, cLabel, "" ) ) )
nTot += hElement["VALUE"]
NEXT
DEFAULT nLeftLabelSpace TO nBorder + nMaxLabel * ::GetFontWidth() + nBorder
DEFAULT nRightLabelSpace TO nBorder + ( Len( LTrim( Transform( nMax, cAxisPict ) ) ) * ::GetFontWidth() / 2 )
DEFAULT nTopLabelSpace TO nBorder + ::GetFontHeight() + nBorder
DEFAULT nBottomLabelSpace TO nTopLabelSpace // nBorder + ::GetFontHeight() + nBorder
DEFAULT nMaxValue TO nMax
IF lShowAxis
IF lShowLabelLeft
x += nLeftLabelSpace
nWidth -= nLeftLabelSpace
ENDIF
IF lShowLabelRight
nWidth -= nRightLabelSpace
ENDIF
IF lShowLabelBottom
y += nBottomLabelSpace
nHeight -= nBottomLabelSpace
ENDIF
IF lShowLabelTop
nHeight -= nTopLabelSpace
ENDIF
ENDIF
nSize := nHeight / Len( aDataOfHash )
IF lShowGrid
::Rectangle( x, ::Height() - ( y + nHeight ), x + nWidth, ::Height() - y, FALSE, color )
nThick := ::SetThickness( 1 )
::ResetStyles()
::AddStyle( color )
::AddStyle( color )
::AddStyle( color )
::AddStyle( gdTransparent )
::AddStyle( gdTransparent )
::AddStyle( gdTransparent )
::AddStyle( gdTransparent )
::AddStyle( gdTransparent )
::SetStyle()
FOR n := 10 TO 100 STEP 10
nDim := ( ( nMaxValue / 100 ) * n )
nPosX := ( nDim / nMaxValue ) * nWidth
::Line( x + nPosX, y, x + nPosX, y + nHeight, gdStyled )
NEXT
::SetThickness( nThick )
ENDIF
IF lShowAxis
// X Axis
FOR n := 0 TO 100 STEP 10
nDim := ( ( nMaxValue / 100 ) * n )
cLabel := LTrim( Transform( nDim, cAxisPict ) )
nPosX := ( nDim / nMaxValue ) * nWidth - ( ( Len( cLabel ) / 2 ) * ::GetFontWidth() )
IF lShowLabelTop
::Say( x + nPosX, y - nTopLabelSpace + nBorder, cLabel, color )
ENDIF
IF lShowLabelBottom
::Say( x + nPosX, y + nHeight + nBorder, cLabel, color )
ENDIF
NEXT
ENDIF
// Second,
FOR EACH hElement IN aDataOfHash
cLabel := HGetValue( hElement, "LABEL" )
lFilled := HGetValue( hElement, "FILLED" )
nExtrude := HGetValue( hElement, "EXTRUDE" )
pTile := HGetValue( hElement, "TILE" )
IF nExtrude <> NIL
lExtruded := TRUE
ELSE
lExtruded := FALSE
ENDIF
colorp := HGetValue( hElement, "COLOR" )
nVal := hElement["VALUE"]
nDim := ( nVal / nMaxValue ) * nWidth
//__OutDebug( "nDim", nDim )
DEFAULT lFilled TO FALSE
DEFAULT nExtrude TO 0
DEFAULT colorp TO ::SetColor( 0, 0, 0 )
nPosX := x
nPosY := y + ( nSize * ( HB_EnumIndex() - 1 ) )
IF pTile <> NIL
::SetTile( pTile )
colorp := gdTiled
ELSE
if ISARRAY( colorp )
colorp := ::SetColor( colorp[1], colorp[2], colorp[3] )
endif
ENDIF
::Rectangle( nPosX, nPosY + nBorder, nPosX + nDim, nPosY + nSize - nBorder, lFilled, colorp )
IF lShowAxis
// Y Axis
IF lShowLabelBottom
::Say( nBorder, nPosY + nSize / 2 - ::GetFontHeight() / 2, PadL( cLabel, nMaxLabel ), color )
ENDIF
ENDIF
NEXT
RETURN Self
METHOD LineChart() CLASS GDChart
LOCAL hElement
LOCAL nDegree := 0
LOCAL lFilled, lExtruded, nExtrude, pTile
LOCAL colorp
LOCAL nVal, nDim
LOCAL nPosX, nPosY
LOCAL cLabel
LOCAL nSize, nMax, nMin, nTotRange, nCeiling
LOCAL nBorder, nThick, n
LOCAL x, y, nWidth, nHeight, nMaxValue, nMinValue, color, nMaxLabel, nMinLabel
LOCAL lShowAxis, lShowGrid
LOCAL nLeftLabelSpace //:= 40
LOCAL nRightLabelSpace //:= 40
LOCAL nBottomLabelSpace //:= 40
LOCAL nTopLabelSpace := 40
LOCAL lShowLabelLeft := TRUE
LOCAL lShowLabelRight := TRUE //FALSE
LOCAL lShowLabelBottom := TRUE
LOCAL lShowLabelTop := FALSE
LOCAL cAxisPict
LOCAL cFontPitch
LOCAL aDataOfHash, hDefs, aPoints
aDataOfHash := ::aDataOfHashes
hDefs := ::hDefs
x := HGetValue( hDefs, "POSX" )
y := HGetValue( hDefs, "POSY" )
nWidth := HGetValue( hDefs, "WIDTH" )
nHeight := HGetValue( hDefs, "HEIGHT" )
nMaxValue := HGetValue( hDefs, "MAXVALUE" )
nMinValue := HGetValue( hDefs, "MINVALUE" )
color := HGetValue( hDefs, "COLOR" )
lShowAxis := HGetValue( hDefs, "SHOWAXIS" )
lShowGrid := HGetValue( hDefs, "SHOWGRID" )
cAxisPict := HGetValue( hDefs, "AXISPICT" )
cFontPitch := HGetValue( hDefs, "FONTPITCH" )
DEFAULT x TO 0
DEFAULT y TO 0
DEFAULT nWidth TO ::Width()
DEFAULT nHeight TO ::Height()
DEFAULT color TO ::GetColor()
DEFAULT lShowAxis TO TRUE
DEFAULT lShowGrid TO TRUE
DEFAULT cAxisPict TO "@E 9,999.99"
DEFAULT cFontPitch TO "TINY"
DEFAULT nBorder TO 4
/*
hData := ["TITLE"], ["VALUE"], ["FILLED"], ["COLOR"], ["TILE"], ["EXTRUDE"]
*/
DO CASE
CASE cFontPitch == "TINY"
::SetFontTiny()
CASE cFontPitch == "SMALL"
::SetFontSmall()
CASE cFontPitch == "MEDIUM"
::SetFontMediumBold()
CASE cFontPitch == "LARGE"
::SetFontLarge()
CASE cFontPitch == "GIANT"
::SetFontGiant()
ENDCASE
// Before sum of values to determine percentual
nMaxLabel := 0
nMax := 0
FOR EACH hElement IN aDataOfHash
IF HB_EnumIndex() == 1
nMax := hElement["VALUE"]
ELSE
nMax := Max( nMax, hElement["VALUE"] )
ENDIF
cLabel := HGetValue( hElement, "LABEL" )
nMaxLabel := Max( nMaxLabel, Len( IIF( cLabel <> NIL, cLabel, "" ) ) )
NEXT
// Before sum of values to determine percentual
nMinLabel := 0
nMin := 0
FOR EACH hElement IN aDataOfHash
IF HB_EnumIndex() == 1
nMin := hElement["VALUE"]
ELSE
nMin := Min( nMin, hElement["VALUE"] )
ENDIF
cLabel := HGetValue( hElement, "LABEL" )
nMinLabel := Max( nMinLabel, Len( IIF( cLabel <> NIL, cLabel, "" ) ) )
NEXT
DEFAULT nLeftLabelSpace TO nBorder + Max( Len( LTrim( Transform( nMax, cAxisPict ) ) ), Len( LTrim( Transform( nMin, cAxisPict ) ) ) ) * ::GetFontWidth() + nBorder
DEFAULT nRightLabelSpace TO nLeftLabelSpace
DEFAULT nBottomLabelSpace TO nBorder + nMaxLabel * ::GetFontWidth() + nBorder
DEFAULT nMaxValue TO nMax
DEFAULT nMinValue TO nMin
IF lShowAxis
IF lShowLabelLeft
x += nLeftLabelSpace
nWidth -= nLeftLabelSpace
ENDIF
IF lShowLabelRight
nWidth -= nRightLabelSpace
ENDIF
IF lShowLabelBottom
y += nBottomLabelSpace
nHeight -= nBottomLabelSpace
ENDIF
IF lShowLabelTop
nHeight -= nTopLabelSpace
ENDIF
ENDIF
nSize := Len( aDataOfHash ) - 1
if nSize > 1
nSize := nWidth / nSize
else
nSize := nWidth
endif
nTotRange := nMaxValue + iif( nMinValue < 0, abs( nMinValue ), 0 )
nCeiling := 0
do while ( nTotRange / ( 10 ^ nCeiling ) ) > 100
nCeiling++
enddo
nCeiling := 10 ^ nCeiling
nMaxValue := ceiling( nMaxValue / nCeiling ) * nCeiling
nMinValue := iif( nMinValue < 0, -ceiling( abs( nMinValue ) / nCeiling ) * nCeiling, ceiling( nMinValue / nCeiling ) * nCeiling )
nTotRange := nMaxValue + iif( nMinValue < 0, abs( nMinValue ), 0 )
IF lShowGrid
::Rectangle( x, ::Height() - ( y + nHeight ), x + nWidth, ::Height() - y, FALSE, color )
nThick := ::SetThickness( 1 )
::ResetStyles()
::AddStyle( color )
::AddStyle( color )
::AddStyle( color )
::AddStyle( gdTransparent )
::AddStyle( gdTransparent )
::AddStyle( gdTransparent )
::AddStyle( gdTransparent )
::AddStyle( gdTransparent )
::SetStyle()
FOR n := 10 TO 100 STEP 10
nDim := ( ( nTotRange / 100 ) * n )
nPosY := ( nDim / nTotRange ) * nHeight
//__OutDebug( "nDim", nDim )
::Line( x, ::Height() - ( y + nPosY), x + nWidth, ::Height() - ( y + nPosY ), gdStyled )
NEXT
FOR EACH hElement IN aDataOfHash
nPosX := x + ( nSize * ( HB_EnumIndex() - 1 ) )
::Line( nPosX, ::Height() - y, nPosX, ::Height() - ( y + nHeight ), gdStyled )
NEXT
::SetThickness( nThick )
ENDIF
IF lShowAxis
// Y Axis
FOR n := 0 TO 100 STEP 10
nDim := ( ( nTotRange / 100 ) * n )
cLabel := LTrim( Transform( nMinValue + ( nTotRange / 10 ) * ( n / 10 ), cAxisPict ) )
nPosY := ( nDim / nTotRange ) * nHeight
IF lShowLabelLeft
::Say( x - nLeftLabelSpace + nBorder, ::Height() - ( y + nPosY ), cLabel, color )
ENDIF
IF lShowLabelRight
::Say( x + nWidth + nBorder, ::Height() - ( y + nPosY ), cLabel, color )
ENDIF
NEXT
ENDIF
// Second,
aPoints := {}
FOR EACH hElement IN aDataOfHash
cLabel := HGetValue( hElement, "LABEL" )
lFilled := HGetValue( hElement, "FILLED" )
nExtrude := HGetValue( hElement, "EXTRUDE" )
pTile := HGetValue( hElement, "TILE" )
IF nExtrude <> NIL
lExtruded := TRUE
ELSE
lExtruded := FALSE
ENDIF
colorp := HGetValue( hElement, "COLOR" )
nVal := hElement["VALUE"]
nDim := ( ( nVal + abs( nMinValue ) ) / nTotRange ) * nHeight
DEFAULT lFilled TO FALSE
DEFAULT nExtrude TO 0
DEFAULT colorp TO ::SetColor( 0, 0, 0 )
nPosX := x + ( nSize * ( HB_EnumIndex() - 1 ) )
nPosY := y
IF pTile <> NIL
::SetTile( pTile )
colorp := gdTiled
ELSE
if ISARRAY( colorp )
colorp := ::SetColor( colorp[1], colorp[2], colorp[3] )
endif
ENDIF
//::Rectangle( nPosX + nBorder, ::Height() - ( nPosY + nDim ), nPosX + nSize - nBorder, ::Height() - nPosY, lFilled, colorp )
aAdd( aPoints, { nPosX, ::Height() - ( nPosY + nDim ) } )
IF lShowAxis
// Y Axis
IF lShowLabelBottom
::SayVertical( nPosX - ::GetFontHeight() / 2, ::Height() - nBorder, PadL( cLabel, nMaxLabel ), color )
ENDIF
ENDIF
NEXT
// Draw lines
nThick := ::SetThickness( 3 )
//::ResetStyles()
//::AddStyle( color )
//::AddStyle( color )
//::AddStyle( color )
//::AddStyle( gdTransparent )
//::AddStyle( gdTransparent )
//::AddStyle( gdTransparent )
//::AddStyle( gdTransparent )
//::AddStyle( gdTransparent )
//::SetStyle()
FOR n := 1 TO Len( aPoints ) - 1
::Line( aPoints[ n ][ 1 ], aPoints[ n ][ 2 ], aPoints[ n + 1 ][ 1 ], aPoints[ n + 1 ][ 2 ], color )
NEXT
::SetThickness( nThick )
RETURN Self
STATIC FUNCTION HGetValue( hHash, cKey )
LOCAL nPos
LOCAL xVal
IF hHash <> NIL
xVal := IIF( ( nPos := HGetPos( hHash, cKey )) == 0, NIL, HGetValueAt( hHash, nPos) )
ENDIF
//RETURN IIF( cKey IN hHash:Keys, hHash[ cKey ], NIL )
RETURN xVal

664
harbour/contrib/gd/gdimage.prg Normal file
View File

@@ -0,0 +1,664 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* GD graphic library class
*
* Copyright 2004-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.
*
*/
#include "common.ch"
#include "hbclass.ch"
#include "gd.ch"
#define DEFAULT( x, y ) IIF( x == NIL, x := y, )
CLASS GDImage
HIDDEN:
DATA pImage
DATA pBrush
DATA pTile
DATA pFont
DATA pColor
DATA cFontName INIT "Arial"
DATA nFontPitch INIT 20
DATA nFontAngle INIT 0
DATA aPoints INIT {}
DATA aStyles INIT {}
DATA lDestroy INIT TRUE
EXPORTED:
DATA hFile
DATA cType
DATA cMime
METHOD New( sx, sy ) CONSTRUCTOR
/* IMAGE CREATION, DESTRUCTION, LOADING AND SAVING */
// Create in memory
METHOD Create( sx, sy ) INLINE ::pImage := gdImageCreate( sx, sy ), Self
METHOD CreateTrueColor( sx, sy ) INLINE ::pImage := gdImageCreateTrueColor( sx, sy ), Self
// Load From File
METHOD LoadFromPng( cFile ) INLINE ::pImage := gdImageCreateFromPng( cFile ), Self
METHOD LoadFromJpeg( cFile ) INLINE ::pImage := gdImageCreateFromJpeg( cFile ), Self
METHOD LoadFromWBmp( cFile ) INLINE ::pImage := gdImageCreateFromWBMP( cFile ), Self
METHOD LoadFromGd( cFile ) INLINE ::pImage := gdImageCreateFromGD( cFile ), Self
METHOD LoadFromGif( cFile ) INLINE ::pImage := gdImageCreateFromGif( cFile ), Self
// Load From a specific File handle
METHOD InputPng( nHandle, nSize ) INLINE ::pImage := gdImageCreateFromPng( nHandle, nSize ), Self
METHOD InputJpeg( nHandle, nSize ) INLINE ::pImage := gdImageCreateFromJpeg( nHandle, nSize ), Self
METHOD InputWBmp( nHandle, nSize ) INLINE ::pImage := gdImageCreateFromWBMP( nHandle, nSize ), Self
METHOD InputGd( nHandle, nSize ) INLINE ::pImage := gdImageCreateFromGD( nHandle, nSize ), Self
METHOD InputGif( nHandle, nSize ) INLINE ::pImage := gdImageCreateFromGif( nHandle, nSize ), Self
// Create from an image pointer in memory
METHOD CreateFromPng( pImage, nSize ) INLINE ::pImage := gdImageCreateFromPng( pImage, nSize ), Self
METHOD CreateFromJpeg( pImage, nSize ) INLINE ::pImage := gdImageCreateFromJpeg( pImage, nSize ), Self
METHOD CreateFromWBmp( pImage, nSize ) INLINE ::pImage := gdImageCreateFromWBMP( pImage, nSize ), Self
METHOD CreateFromGd( pImage, nSize ) INLINE ::pImage := gdImageCreateFromGD( pImage, nSize ), Self
METHOD CreateFromGif( pImage, nSize ) INLINE ::pImage := gdImageCreateFromGif( pImage, nSize ), Self
METHOD LoadFromFile( cFile )
// Save To File Name
METHOD SavePng( cFile, nLevel ) INLINE gdImagePng( ::pImage, cFile, nLevel )
METHOD SaveJpeg( cFile, nLevel ) INLINE gdImageJpeg( ::pImage, cFile, nLevel )
METHOD SaveWBmp( cFile, nFG ) INLINE gdImageWBmp( ::pImage, cFile, nFG )
METHOD SaveGd( cFile ) INLINE gdImageGd( ::pImage, cFile )
METHOD SaveGif( cFile ) INLINE gdImageGif( ::pImage, cFile )
METHOD SaveToFile( cFile ) INLINE gdImageToFile( Self, cFile )
// Output To a specified File handle
METHOD OutputPng( nHandle, nLevel ) INLINE IIF( nHandle == NIL, nHandle := 1, ), gdImagePng( ::pImage, nHandle, nLevel )
METHOD OutputJpeg( nHandle, nLevel ) INLINE IIF( nHandle == NIL, nHandle := 1, ), gdImageJpeg( ::pImage, nHandle, nLevel )
METHOD OutputWBmp( nHandle, nFG ) INLINE IIF( nHandle == NIL, nHandle := 1, ), gdImageWBmp( ::pImage, nHandle, nFG )
METHOD OutputGd( nHandle ) INLINE IIF( nHandle == NIL, nHandle := 1, ), gdImageGd( ::pImage, nHandle )
METHOD OutputGif( nHandle ) INLINE IIF( nHandle == NIL, nHandle := 1, ), gdImageGif( ::pImage, nHandle )
// Output To a string
METHOD ToStringPng( nLevel ) INLINE gdImagePng( ::pImage, NIL, nLevel )
METHOD ToStringJpeg( nLevel ) INLINE gdImageJpeg( ::pImage, NIL, nLevel )
METHOD ToStringWBmp( nFG ) INLINE gdImageWBmp( ::pImage, NIL, nFG )
METHOD ToStringGd() INLINE gdImageGd( ::pImage, NIL )
METHOD ToStringGif() INLINE gdImageGif( ::pImage, NIL )
METHOD ToString() INLINE gdImageToString( Self )
// Destructor
METHOD Destroy() INLINE gdImageDestroy( ::pImage )
DESTRUCTOR Destruct()
/* DRAWING FUNCTIONS */
METHOD SetPixel( x, y, color ) INLINE DEFAULT( color, ::pColor ), gdImageSetPixel( ::pImage, x, y, color )
METHOD Line( x1, y1, x2, y2, color ) INLINE DEFAULT( color, ::pColor ), gdImageLine( ::pImage, x1, y1, x2, y2, color )
METHOD DashedLine( x1, y1, x2, y2, color ) INLINE DEFAULT( color, ::pColor ), gdImageDashedLine( ::pImage, x1, y1, x2, y2, color )
// Functions usefull for polygons
METHOD Polygon( aPoints, lFilled, color )
#if ( GD_VERS >= 2033 )
METHOD OpenPolygon( aPoints, color )
#endif
METHOD AddPoint( x, y ) INLINE aAdd( ::aPoints, { x, y } )
METHOD ResetPoints() INLINE ::aPoints := {}
METHOD Points() INLINE Len( ::aPoints )
METHOD Rectangle( x1, y1, x2, y2, lFilled, color )
METHOD Arc( x, y, nWidth, nHeight, nStartDegree, nEndDegree, lFilled, nColor )
METHOD Ellipse( x, y, nWidth, nHeight, lFilled, nColor )
METHOD Circle( x, y, nRadius, lFilled, nColor ) ;
INLINE ::Ellipse( x, y, nRadius, nRadius, lFilled, nColor )
METHOD Fill( x, y, color ) INLINE DEFAULT( color, ::pColor ), gdImageFill( ::pImage, x, y, color )
METHOD FillToBorder( x, y, border, color ) ;
INLINE DEFAULT( color, ::pColor ), gdImageFillToBorder( ::pImage, x, y, border, color )
METHOD SetAntiAliased( color ) INLINE DEFAULT( color, ::pColor ), gdImageSetAntiAliased( ::pImage, color )
METHOD SetAntiAliasedDontBlend( lDontBlend, color ) ;
INLINE DEFAULT( color, ::pColor ), gdImageSetAntiAliasedDontBlend( ::pImage, color, lDontBlend )
METHOD SetBrush( pBrush ) INLINE gdImageSetBrush( ::pImage, pBrush:pImage ), ::pBrush := pBrush
METHOD SetTile( pTile ) INLINE gdImageSetTile( ::pImage, pTile:pImage ), ::pTile := pTile
// Functions usefull for style
METHOD SetStyle( aStyle ) INLINE DEFAULT( aStyle, ::aStyles ), gdImageSetStyle( ::pImage, aStyle )
METHOD AddStyle( pColor ) INLINE aAdd( ::aStyles, pColor )
METHOD ResetStyles() INLINE ::aStyles := {}
METHOD StyleLenght() INLINE Len( ::aStyles )
METHOD SetThickness( nThickness ) INLINE gdImageSetThickness( ::pImage, nThickness )
METHOD SetAlphaBlending( lAlphaBlending ) INLINE gdImageAlphaBlending( ::pImage, lAlphaBlending )
METHOD SetSaveAlpha( lSaveAlpha ) INLINE gdImageSaveAlpha( ::pImage, lSaveAlpha )
METHOD SetClippingArea( x1, y1, x2, y2 ) INLINE gdImageSetClip( ::pImage, x1, y1, x2, y2 )
/* QUERY FUNCTIONS */
METHOD ColorsTotal() INLINE gdImageColorsTotal( ::pImage )
METHOD Alpha( color ) INLINE DEFAULT( color, ::pColor ), gdImageAlpha( ::pImage, color )
METHOD Red( color ) INLINE DEFAULT( color, ::pColor ), gdImageRed( ::pImage, color )
METHOD Green( color ) INLINE DEFAULT( color, ::pColor ), gdImageGreen( ::pImage, color )
METHOD Blue( color ) INLINE DEFAULT( color, ::pColor ), gdImageBlue( ::pImage, color )
METHOD Width() INLINE gdImageSx( ::pImage )
METHOD Height() INLINE gdImageSy( ::pImage )
METHOD CenterWidth() INLINE ::Width() / 2
METHOD CenterHeight() INLINE ::Height() / 2
METHOD GetPixel( x, y ) INLINE gdImageGetPixel( ::pImage, x, y )
METHOD GetColor() INLINE ::pColor
METHOD GetImagePtr() INLINE ::pImage
METHOD GetClippingArea() INLINE gdImageGetClip( ::pImage )
METHOD IsBoundsSafe( x, y ) INLINE gdImageBoundsSafe( ::pImage, x, y )
METHOD IsInterlaced() INLINE gdImageGetInterlaced( ::pImage )
METHOD GetTransparent() INLINE gdImageGetTransparent( ::pImage )
METHOD IsTransparent() INLINE ::GetTransparent() > 0
METHOD IsTrueColor() INLINE gdImageTrueColor( ::pImage )
METHOD ConvertFromTrueColorToPalette( lDither, nColorsWanted ) ;
INLINE gdImageTrueColorToPalette ( ::pImage, lDither, nColorsWanted )
METHOD CreatePaletteFromTrueColor( lDither, nColorsWanted ) ;
INLINE gdImageCreatePaletteFromTrueColor( ::pImage, lDither, nColorsWanted )
METHOD GetPalette( x, y ) INLINE gdImagePalettePixel( ::pImage, x, y )
METHOD GetTrueColor( x, y ) INLINE gdImageTrueColorPixel( ::pImage, x, y )
METHOD GetThickness() INLINE gdImageGetThickness( ::pImage )
/* FONTS AND TEXT-HANDLING FUNCTIONS */
METHOD SetFontSmall() INLINE ::pFont := gdFontGetSmall()
METHOD SetFontLarge() INLINE ::pFont := gdFontGetLarge()
METHOD SetFontMediumBold() INLINE ::pFont := gdFontGetMediumBold()
METHOD SetFontGiant() INLINE ::pFont := gdFontGetGiant()
METHOD SetFontTiny() INLINE ::pFont := gdFontGetTiny()
METHOD Say( x, y, cString, color, nAlign )
METHOD SayVertical( x, y, cString, color ) INLINE DEFAULT( color, ::pColor ), gdImageStringUp( ::pImage, ::pFont, x, y, cString, color )
METHOD SetFontName( cFontName ) INLINE ::cFontName := cFontName
METHOD SetFontPitch( nPitch ) INLINE ::nFontPitch := nPitch
METHOD SetFontAngle( nAngle ) INLINE ::nFontAngle := nAngle
METHOD SayFreeType( x, y, cString, cFontName, nPitch, nAngle, color, nAlign, ;
nLineSpacing, nCharMap, nResolution )
METHOD SayFreeTypeCircle( x, y, cStringTop, cStringBottom, color, nRadius, nTextRadius, nFillPortion, cFontName, nPitch ) ;
INLINE DEFAULT( color, ::pColor ), gdImageStringFTCircle( ::pImage, x, y, nRadius, ;
nTextRadius, nFillPortion, cFontName, nPitch, cStringTop, cStringBottom, color )
METHOD GetFont() INLINE ::pFont
METHOD GetFontWidth( pFont ) INLINE DEFAULT( pFont, ::pFont ), gdFontGetWidth( pFont )
METHOD GetFontHeight( pFont ) INLINE DEFAULT( pFont, ::pFont ), gdFontGetHeight( pFont )
METHOD GetFTFontWidth( cFontName, nPitch ) INLINE DEFAULT( cFontName, ::cFontName ), ;
DEFAULT( nPitch, ::nFontPitch ) , ;
gdImageFTWidth( cFontName, nPitch )
METHOD GetFTFontHeight( cFontName, nPitch ) INLINE DEFAULT( cFontName, ::cFontName ), ;
DEFAULT( nPitch, ::nFontPitch ) , ;
gdImageFTHeight( cFontName, nPitch )
METHOD GetFTStringSize( cString, cFontName, nPitch ) INLINE DEFAULT( cFontName, ::cFontName ), ;
DEFAULT( nPitch, ::nFontPitch ) , ;
gdImageFTSize( cString, cFontName, nPitch )
/* COLOR HANDLING FUNCTIONS */
METHOD SetColor( r, g, b ) INLINE IIF( PCount() == 2, ::pColor := r, ::pColor := gdImageColorAllocate( ::pImage, r, g, b ) )
METHOD DelColor( pColor ) INLINE ::pColor := NIL, gdImageColorDeAllocate( ::pImage, pColor )
METHOD SetColorAlpha( r, g, b, a ) INLINE ::pColor := gdImageColorAllocateAlpha( ::pImage, r, g, b, a)
METHOD SetColorClosest( r, g, b ) INLINE ::pColor := gdImageColorClosest( ::pImage, r, g, b )
METHOD SetColorClosestAlpha( r, g, b, a ) INLINE ::pColor := gdImageColorClosestAlpha( ::pImage, r, g, b, a)
METHOD SetColorClosestHWB( r, g, b ) INLINE ::pColor := gdImageColorClosestHWB( ::pImage, r, g, b )
METHOD SetColorExact( r, g, b ) INLINE ::pColor := gdImageColorExact( ::pImage, r, g, b )
METHOD SetColorResolve( r, g, b ) INLINE ::pColor := gdImageColorResolve( ::pImage, r, g, b )
METHOD SetColorResolveAlpha( r, g, b, a ) INLINE ::pColor := gdImageColorResolveAlpha( ::pImage, r, g, b, a)
METHOD SetTransparent( pColor ) INLINE gdImageColorTransparent( ::pImage, pColor )
METHOD SetSharpen( nPerc ) INLINE gdImageSharpen( ::pImage, nPerc )
METHOD SetInterlace( lOnOff ) INLINE gdImageInterlace( ::pImage, lOnOff )
METHOD SetInterlaceOn() INLINE gdImageInterlace( ::pImage, TRUE )
METHOD SetInterlaceOff() INLINE gdImageInterlace( ::pImage, FALSE )
METHOD GetTrueColor( r, g, b ) INLINE gdTrueColor( r, g, b )
METHOD GetTrueColorAlpha( r, g, b, a ) INLINE gdTrueColorAlpha( r, g, b, a )
/* COPY AND RESIZING FUNCTIONS */
METHOD Copy()
METHOD CopyResized()
METHOD CopyResampled()
METHOD CopyRotated()
METHOD CopyMerge()
METHOD CopyMergeGray()
/* New implemented */
METHOD Clone()
METHOD CopyZoomed()
METHOD Crop()
METHOD Zoom()
METHOD Resize()
METHOD Rotate()
METHOD RotateInside( nAngle ) INLINE ::Rotate( nAngle, .T. )
METHOD PaletteCopy( oDestImage ) INLINE gdImagePaletteCopy( oDestImage:pImage, ::pImage )
METHOD SquareToCircle( nRadius ) INLINE gdImageSquareToCircle( ::pImage, nRadius )
METHOD Compare( oDestImage ) INLINE gdImageCompare( oDestImage:pImage, ::pImage )
METHOD Radians( nAngle ) INLINE PI() * nAngle / 180
METHOD Degres( nRadians ) INLINE nRadians * 180 / PI()
METHOD Version() INLINE gdVersion()
ENDCLASS
METHOD New( sx, sy ) CLASS GDImage
::Create( sx, sy )
RETURN Self
PROCEDURE Destruct() CLASS GDImage
//__OutDebug( "Destroyed" )
IF ::lDestroy
::Destroy()
ENDIF
RETURN
METHOD Polygon( aPoints, lFilled, color ) CLASS GDImage
DEFAULT aPoints TO ::aPoints
DEFAULT lFilled TO FALSE
DEFAULT color TO ::pColor
IF lFilled
gdImageFilledPolygon( ::pImage, aPoints, color )
ELSE
gdImagePolygon( ::pImage, aPoints, color )
ENDIF
RETURN Self
#if ( GD_VERS >= 2033 )
METHOD OpenPolygon( aPoints, color ) CLASS GDImage
DEFAULT aPoints TO ::aPoints
DEFAULT color TO ::pColor
gdImageOpenPolygon( ::pImage, aPoints, color )
RETURN Self
#endif
METHOD Rectangle( x1, y1, x2, y2, lFilled, color ) CLASS GDImage
DEFAULT lFilled TO FALSE
DEFAULT color TO ::pColor
IF lFilled
gdImageFilledRectangle( ::pImage, x1, y1, x2, y2, color )
ELSE
gdImageRectangle( ::pImage, x1, y1, x2, y2, color )
ENDIF
RETURN Self
METHOD Arc( x, y, nWidth, nHeight, nStartDegree, nEndDegree, lFilled, color, nStyle ) CLASS GDImage
DEFAULT lFilled TO FALSE
DEFAULT color TO ::pColor
DEFAULT nStyle TO gdArc
IF lFilled
gdImageFilledArc( ::pImage, x, y, nWidth, nHeight, nStartDegree, nEndDegree, color, nStyle )
ELSE
gdImageArc( ::pImage, x, y, nWidth, nHeight, nStartDegree, nEndDegree, color )
ENDIF
RETURN Self
METHOD Ellipse( x, y, nWidth, nHeight, lFilled, color ) CLASS GDImage
DEFAULT lFilled TO FALSE
DEFAULT color TO ::pColor
IF lFilled
gdImageFilledEllipse( ::pImage, x, y, nWidth, nHeight, color )
ELSE
gdImageEllipse( ::pImage, x, y, nWidth, nHeight, color )
ENDIF
RETURN Self
METHOD LoadFromFile( cFile ) CLASS GDImage
LOCAL aLoad
aLoad := gdImageFromFile( cFile )
Self := aLoad[1]:Clone()
::Destroy()
aLoad[1]:lDestroy := FALSE
aLoad[1] := NIL
::hFile := aLoad[2]
::cType := aLoad[3]
::cMime := aLoad[4]
RETURN Self
METHOD Copy( nSrcX, nSrcY, nWidth, nHeight, nDstX, nDstY, oDestImage ) CLASS GDImage
DEFAULT nSrcX TO 0
DEFAULT nSrcY TO 0
DEFAULT nWidth TO ::Width()
DEFAULT nHeight TO ::Height()
DEFAULT nDstX TO 0
DEFAULT nDstY TO 0
IF oDestImage == NIL
IF ::IsTrueColor()
oDestImage := GDImage():CreateTrueColor( nWidth, nHeight )
ELSE
oDestImage := GDImage():Create( nWidth, nHeight )
ENDIF
ENDIF
gdImageCopy( oDestImage:pImage, ::pImage, nDstX, nDstY, nSrcX, nSrcY, nWidth, nHeight )
RETURN oDestImage
METHOD CopyResized( nSrcX, nSrcY, nSrcWidth, nSrcHeight, nDstX, nDstY, nDstWidth, nDstHeight, oDestImage ) CLASS GDImage
DEFAULT nSrcX TO 0
DEFAULT nSrcY TO 0
DEFAULT nSrcWidth TO ::Width()
DEFAULT nSrcHeight TO ::Height()
DEFAULT nDstX TO 0
DEFAULT nDstY TO 0
DEFAULT nDstWidth TO ::Width()
DEFAULT nDstHeight TO ::Height()
IF oDestImage == NIL
IF ::IsTrueColor()
oDestImage := GDImage():CreateTrueColor( nDstWidth, nDstHeight )
ELSE
oDestImage := GDImage():Create( nDstWidth, nDstHeight )
ENDIF
ENDIF
gdImageCopyResized( oDestImage:pImage, ::pImage, nDstX, nDstY, nSrcX, nSrcY, nDstWidth, nDstHeight, nSrcWidth, nSrcHeight )
RETURN oDestImage
METHOD CopyResampled( nSrcX, nSrcY, nSrcWidth, nSrcHeight, nDstX, nDstY, nDstWidth, nDstHeight, oDestImage ) CLASS GDImage
DEFAULT nSrcX TO 0
DEFAULT nSrcY TO 0
DEFAULT nSrcWidth TO ::Width()
DEFAULT nSrcHeight TO ::Height()
DEFAULT nDstX TO 0
DEFAULT nDstY TO 0
DEFAULT nDstWidth TO ::Width()
DEFAULT nDstHeight TO ::Height()
IF oDestImage == NIL
IF ::IsTrueColor()
oDestImage := GDImage():CreateTrueColor( nDstWidth, nDstHeight )
ELSE
oDestImage := GDImage():Create( nDstWidth, nDstHeight )
ENDIF
ENDIF
gdImageCopyResampled( oDestImage:pImage, ::pImage, nDstX, nDstY, nSrcX, nSrcY, nDstWidth, nDstHeight, nSrcWidth, nSrcHeight )
RETURN oDestImage
METHOD CopyRotated( nSrcX, nSrcY, nWidth, nHeight, nDstX, nDstY, nAngle, oDestImage ) CLASS GDImage
DEFAULT nSrcX TO 0
DEFAULT nSrcY TO 0
DEFAULT nWidth TO ::Width
DEFAULT nHeight TO ::Height
DEFAULT nDstX TO nWidth / 2
DEFAULT nDstY TO nHeight / 2
DEFAULT nAngle TO 90
IF oDestImage == NIL
IF ::IsTrueColor()
oDestImage := GDImage():CreateTrueColor( nWidth, nHeight )
ELSE
oDestImage := GDImage():Create( nWidth, nHeight )
ENDIF
ENDIF
//__OutDebug( nAngle )
gdImageCopyRotated( oDestImage:pImage, ::pImage, nDstX, nDstY, nSrcX, nSrcY, nWidth, nHeight, nAngle )
RETURN oDestImage
METHOD CopyMerge( nSrcX, nSrcY, nWidth, nHeight, nDstX, nDstY, nPerc, oDestImage ) CLASS GDImage
DEFAULT nSrcX TO 0
DEFAULT nSrcY TO 0
DEFAULT nWidth TO ::Width
DEFAULT nHeight TO ::Height
DEFAULT nDstX TO 0
DEFAULT nDstY TO 0
DEFAULT nPerc TO 100
IF oDestImage == NIL
IF ::IsTrueColor()
oDestImage := GDImage():CreateTrueColor( nWidth, nHeight )
ELSE
oDestImage := GDImage():Create( nWidth, nHeight )
ENDIF
ENDIF
gdImageCopyMerge( oDestImage:pImage, ::pImage, nDstX, nDstY, nSrcX, nSrcY, nWidth, nHeight, nPerc )
RETURN oDestImage
METHOD CopyMergeGray( nSrcX, nSrcY, nWidth, nHeight, nDstX, nDstY, nPerc, oDestImage ) CLASS GDImage
DEFAULT nSrcX TO 0
DEFAULT nSrcY TO 0
DEFAULT nWidth TO ::Width
DEFAULT nHeight TO ::Height
DEFAULT nDstX TO 0
DEFAULT nDstY TO 0
DEFAULT nPerc TO 100
IF oDestImage == NIL
IF ::IsTrueColor()
oDestImage := GDImage():CreateTrueColor( nWidth, nHeight )
ELSE
oDestImage := GDImage():Create( nWidth, nHeight )
ENDIF
ENDIF
gdImageCopyMergeGray( oDestImage:pImage, ::pImage, nDstX, nDstY, nSrcX, nSrcY, nWidth, nHeight, nPerc )
RETURN oDestImage
METHOD CopyZoomed( nPerc, nSrcX, nSrcY, nSrcWidth, nSrcHeight ) CLASS GDImage
LOCAL oDestImage
LOCAL nDstX, nDstY, nDstWidth, nDstHeight
DEFAULT nPerc TO 100
DEFAULT nSrcX TO 0
DEFAULT nSrcY TO 0
DEFAULT nSrcWidth TO ::Width()
DEFAULT nSrcHeight TO ::Height()
IF nPerc < 0
nPerc := 100
ENDIF
nDstX := 0
nDstY := 0
nDstWidth := nSrcWidth * nPerc / 100
nDstHeight := nSrcHeight * nPerc / 100
IF ::IsTrueColor()
oDestImage := GDImage():CreateTrueColor( nDstWidth, nDstHeight )
ELSE
oDestImage := GDImage():Create( nDstWidth, nDstHeight )
ENDIF
gdImageCopyResampled( oDestImage:pImage, ::pImage, nDstX, nDstY, nSrcX, nSrcY, nDstWidth, nDstHeight, nSrcWidth, nSrcHeight )
RETURN oDestImage
METHOD Rotate( nAngle, lInside ) CLASS GDImage
LOCAL oDestImage
LOCAL nWidth, nHeight
LOCAL nAngRad := nAngle * PI() / 180
DEFAULT lInside TO FALSE
IF !lInside
nWidth := ::Width * cos( nAngRad ) + ::Height * sin( nAngRad )
nHeight := ::Width * sin( nAngRad ) + ::Height * cos( nAngRad )
ELSE
nWidth := ::Width
nHeight := ::Height
ENDIF
//__OutDebug( ::Width, ::Height )
//__OutDebug( nWidth, nHeight )
IF ::IsTrueColor()
oDestImage := GDImage():CreateTrueColor( nWidth, nHeight )
ELSE
oDestImage := GDImage():Create( nWidth, nHeight )
ENDIF
IF !lInside
::CopyRotated( ,,,, nWidth - nWidth/2, nHeight - nHeight/2, nAngle, oDestImage )
ELSE
::CopyRotated( ,,,,,, nAngle, oDestImage )
ENDIF
::Destroy()
Self := __ObjCLone( oDestImage )
// Move new image to existing one
// Signal that this image must not be destroyed
oDestImage:lDestroy := FALSE
oDestImage := NIL
RETURN Self
METHOD Crop( nX, nY, nWidth, nHeight ) CLASS GDImage
LOCAL oDestImage
oDestImage := ::CopyResized( nX, nY, nWidth, nHeight, 0, 0, nWidth, nHeight )
::Destroy()
Self := __ObjClone( oDestImage )
// Move new image to existing one
// Signal that this image must not be destroyed
oDestImage:lDestroy := FALSE
oDestImage := NIL
RETURN Self
METHOD Resize( nWidth, nHeight ) CLASS GDImage
LOCAL oDestImage
oDestImage := ::CopyResampled( 0, 0, NIL, NIL, 0, 0, nWidth, nHeight )
::Destroy()
Self := __ObjClone( oDestImage )
// Move new image to existing one
// Signal that this image must not be destroyed
oDestImage:lDestroy := FALSE
oDestImage := NIL
RETURN Self
METHOD Zoom( nPerc ) CLASS GDImage
LOCAL oDestImage
oDestImage := ::CopyZoomed( nPerc )
::Destroy()
Self := __ObjClone( oDestImage )
// Move new image to existing one
// Signal that this image must not be destroyed
oDestImage:lDestroy := FALSE
oDestImage := NIL
RETURN Self
METHOD Clone() CLASS GDImage
LOCAL oDestImage
IF ::IsTrueColor()
oDestImage := GDImage():CreateTrueColor( ::Width, ::Height )
ELSE
oDestImage := GDImage():Create( ::Width, ::Height )
ENDIF
::Copy( 0, 0, ::Width, ::Height, 0, 0, oDestImage )
// ::Destroy()
// Self := __ObjClone( oDestImage )
RETURN oDestImage
METHOD Say( x, y, cString, color, nAlign ) CLASS GDImage
LOCAL nWidth, nLen
LOCAL nPosX
DEFAULT color TO ::pColor
DEFAULT nAlign TO gdAlignLeft
IF nAlign == gdAlignCenter
nWidth := ::GetFontWidth()
nLen := Len( cString )
nPosX := x - ( nLen / 2 * nWidth )
ELSEIF nAlign == gdAlignRight
nWidth := ::GetFontWidth()
nLen := Len( cString )
nPosX := x - ( nLen * nWidth )
ELSE
nPosX := x
ENDIF
gdImageString( ::pImage, ::pFont, nPosX, y, cString, color )
RETURN Self
METHOD SayFreeType( x, y, cString, cFontName, nPitch, nAngle, color, nAlign, ;
nLineSpacing, nCharMap, nResolution ) CLASS GDImage
LOCAL nWidth, nLen
LOCAL nPosX
DEFAULT nAlign TO gdAlignLeft
DEFAULT color TO ::pColor
DEFAULT cFontName TO ::cFontName
DEFAULT nPitch TO ::nFontPitch
DEFAULT nAngle TO ::nFontAngle
IF nAlign == gdAlignCenter
nWidth := nPitch //gdImageFTWidth( cFontName, nPitch )//, ::Radians( nAngle ) ) //::GetFontWidth()
//__OutDebug( "nWidth", nWidth )
nLen := Len( cString )
nPosX := x - ( (nLen / 2) * nWidth )
ELSEIF nAlign == gdAlignRight
nWidth := gdImageFTWidth( cFontName, nPitch ) //, ::Radians( nAngle ) ) //::GetFontWidth()
nLen := Len( cString )
nPosX := x - ( nLen * nWidth )
ELSE
nPosX := x
ENDIF
gdImageStringFT( ::pImage, color, cFontName, nPitch, ::Radians( nAngle ), nPosX, y, ;
cString, nLineSpacing, nCharMap, nResolution )
RETURN Self

3950
harbour/contrib/gd/gdwrp.c Normal file
View File

File diff suppressed because it is too large Load Diff

2058
harbour/contrib/gd/hbgd.txt Normal file
View File

File diff suppressed because it is too large Load Diff