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

*** empty log message ***

Browse Source
This commit is contained in:
Lorenzo Fiorini
2007-04-10 09:43:16 +00:00
parent 5e0fc083ac
commit c08aa80635
15 changed files with 1400 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

95
harbour/contrib/gd/tests/animgif.prg Normal file
View File

@@ -0,0 +1,95 @@
/*
* $Id$
*/
/*
* Copyright 2004-2005 Francesco Saverio Giudice <info@fsgiudice.com>
*
* GD API anim gif test file - from GD official documantation, adapted to porting
*
* This test shows how handle either file handle than file name
*/
#include "gd.ch"
#include "common.ch"
#define IMAGES_IN "images_in/"
#define IMAGES_OUT "images_out/"
PROCEDURE Main()
LOCAL im, im2, im3
LOCAL black, white, trans
LOCAL hFile
// Check output directory
IF !ISDirectory( IMAGES_OUT )
DirMake( IMAGES_OUT )
ENDIF
/* Create the image */
im = gdImageCreate(100, 100)
/* Allocate background */
white = gdImageColorAllocate(im, 255, 255, 255)
/* Allocate drawing color */
black = gdImageColorAllocate(im, 0, 0, 0)
/* Allocate transparent color for animation compression */
trans = gdImageColorAllocate(im, 1, 1, 1)
/* Draw rectangle */
gdImageRectangle(im, 0, 0, 10, 10, black)
/* Open output file in binary mode */
hFile := FCreate( IMAGES_OUT + "anim1.gif" )
/* Write GIF header. Use global color map. Loop a few times */
gdImageGifAnimBegin(im, hFile, 1, 3)
gdImageGifAnimBegin(im, IMAGES_OUT + "anim2.gif", 1, 3)
/* Write the first frame. No local color map. Delay = 1s */
gdImageGifAnimAdd(im, hFile, 0, 0, 0, 100, 1, NIL)
gdImageGifAnimAdd(im, IMAGES_OUT + "anim2.gif", 0, 0, 0, 100, 1, NIL)
/* construct the second frame */
im2 = gdImageCreate(100, 100)
/* Allocate background to make it white */
gdImageColorAllocate(im2, 255, 255, 255)
/* Make sure the palette is identical */
gdImagePaletteCopy (im2, im)
/* Draw something */
gdImageRectangle(im2, 0, 0, 15, 15, black)
/* Allow animation compression with transparent pixels */
gdImageColorTransparent (im2, trans)
/* Add the second frame */
gdImageGifAnimAdd(im2, hFile, 0, 0, 0, 100, 1, im)
gdImageGifAnimAdd(im2, IMAGES_OUT + "anim2.gif", 0, 0, 0, 100, 1, im)
/* construct the second frame */
im3 = gdImageCreate(100, 100)
/* Allocate background to make it white */
gdImageColorAllocate(im3, 255, 255, 255)
/* Make sure the palette is identical */
gdImagePaletteCopy (im3, im)
/* Draw something */
gdImageRectangle(im3, 0, 0, 15, 20, black)
/* Allow animation compression with transparent pixels */
gdImageColorTransparent (im3, trans)
/* Add the third frame, compressing against the second one */
gdImageGifAnimAdd(im3, hFile, 0, 0, 0, 100, 1, im2)
gdImageGifAnimAdd(im3, IMAGES_OUT + "anim2.gif", 0, 0, 0, 100, 1, im2)
/* Write the end marker */
/* gdImageGifAnimEnd(out); is the same as the following: */
//putc (';', out);
gdImageGifAnimEnd( hFile )
gdImageGifAnimEnd( IMAGES_OUT + "anim2.gif" )
/* Close file */
FClose( hFile )
/* Destroy images */
gdImageDestroy(im)
gdImageDestroy(im2)
gdImageDestroy(im3)
?
? "Look at " + IMAGES_OUT + " folder for output images"
?
RETURN

99
harbour/contrib/gd/tests/antialiased.prg Normal file
View File

@@ -0,0 +1,99 @@
/*
* $Id$
*/
/*
* Copyright 2004-2005 Francesco Saverio Giudice <info@fsgiudice.com>
*
* GD API test file
*/
#include "gd.ch"
#include "common.ch"
#define IMAGES_IN "images_in/"
#define IMAGES_OUT "images_out/"
PROCEDURE Main()
LOCAL im
LOCAL white, blue, black
// Check output directory
IF !ISDirectory( IMAGES_OUT )
DirMake( IMAGES_OUT )
ENDIF
/*
This sample shows differences on use of antiliased command between a
palette based image and a true color image.
Normally antialias works better with a true color image.
From GD official documentation:
Antialiased lines can be drawn on both truecolor and palette-based images.
However, attempts to draw antialiased lines on highly complex palette-based backgrounds
may not give satisfactory results, due to the limited number of colors available in the
palette. Antialiased line-drawing on simple backgrounds should work well with palette-based
images; otherwise create or fetch a truecolor image instead.
*/
/* ***** DRAW A LINE IN A PALETTE BASED IMAGE ***** */
/* First we create a true color image */
im := gdImageCreatePalette(100, 100) // alias of gdImageCreate()
/* First allocate color is Background color */
black := gdImageColorAllocate(im, 0, 0, 0)
/* set foreground color */
blue := gdImageColorAllocate(im, 0, 0, 255)
/* Now we draw an aliased line */
gdImageLine(im, 0, 0, 99, 40, blue)
/* Then we set anti-alias color */
gdImageSetAntiAliased(im, blue)
/* and re-draw the line in antialiased mode */
gdImageLine(im, 0, 40, 99, 80, gdAntiAliased)
/* saving the image */
gdImageJpeg(im, IMAGES_OUT + "antialiasedpal.jpg")
/* Destroy it */
gdImageDestroy(im)
/* ***** DRAW A LINE IN A TRUE COLOR IMAGE ***** */
/* First we create a true color image */
im := gdImageCreateTrueColor(100, 100)
/* Background color (true color comes with black background, we have to fill it) */
white := gdTrueColor( 255, 255, 255 )
gdImageFilledRectangle(im, 0, 0, 100, 100, white)
/* set foreground color */
blue := gdImageColorAllocate(im, 0, 0, 255)
/* Now we draw an aliased line */
gdImageLine(im, 0, 0, 99, 40, blue)
/* Then we set anti-alias color */
gdImageSetAntiAliased(im, blue)
/* and re-draw the line in antialiased mode */
gdImageLine(im, 0, 40, 99, 80, gdAntiAliased)
/* saving the image */
gdImageJpeg(im, IMAGES_OUT + "antialiasedtrue.jpg")
/* Destroy it */
gdImageDestroy(im)
?
? "Look at " + IMAGES_OUT + " folder for output images"
?
RETURN

90
harbour/contrib/gd/tests/barms.prg Normal file
View File

@@ -0,0 +1,90 @@
Function Main()
local bar
// // Creating some Color (arguments are R, G, B)
local black := {0,0,0}
local white := {255,255,255}
local blue := {0,0,255}
local yellon := {255,255,128}
local red := {255,0,0}
local ccode13 := "P48WBQ7BX3M73X8V3WRT7F9JW"
local ccode8 := "P48WBQ7BX3M73X8V3WRT7F9JW"
local ccode128 := "P48WBQ7BX3M73X8V3WRT7F9JW"
local nlower := 1 , nhight := 50
/* here is the list of arguments
1- Barcode Type 13,8 and 128
*/
bar := TCode():New(13)
/* Here is the list of the arguments
1 - Thickness
2 - Color of bars
3 - Color of spaces
4 - Resolution
5 - Text Font (0-5)
*/
bar:Configure( 70 , black, white, 2, 1 )
/* Here is the list of the arguments
1 - Width
2 - Height
3 - Filename (empty : display on screen)
4 - Background color */
bar:CreateBar( 205, 105,,white)
// 1 - code bar
bar:Draw13(ccode13)
// Build image
bar:Finish(2)
// EAN8
bar:= TCode():New(8)
bar:Configure( 70 , black, white, 2 , 1 )
bar:CreateBar( 154, 100,,white)
bar:Draw8(ccode8)
bar:Finish(8)
bar:ResizeImage()
// EAN128
bar:= TCode():New(128)
bar:Configure( 50 , black, white, 2 , 1 )
// output image
bar:out_img := "image/"
bar:CreateBar( 559, 88,"Bar128",white)
// 1- code bar
// 2- barcode types A/B/C
// A- Alphanumeric characters uppercase
// B- Alphanumeric characters upper and lowercase
// C- Numeric pairs of integer
bar:Draw128(cCode128,"A")
bar:Finish(8)
// BRAZIL-FEBRABAN
bar:= TCode():New(25)
bar:Configure( 25 , black, white, 1 , 1, , .T. )
// output image
bar:out_img := "febraban/"
bar:CreateBar( 560 ,60, "febraban", white )
bar:DrawI25("P48WBQ7BX3M73X8V3WRT7F9JW")
bar:Finish(8)
RETURN NIL

87
harbour/contrib/gd/tests/bartest.prg Normal file
View File

@@ -0,0 +1,87 @@
Function Main()
local bar
// // Creating some Color (arguments are R, G, B)
local black := {0,0,0}
local white := {255,255,255}
local blue := {0,0,255}
local yellon := {255,255,128}
local red := {255,0,0}
local ccode13 := "789136043666"
local ccode8 := "0421000"
// local ccode128 := "00011005100000000"
local ccode128 := "Code 128"
local nlower := 1 , nhight := 50
/* here is the list of arguments
1- Barcode Type 13,8 and 128
*/
bar := TCode():New(13)
/* Here is the list of the arguments
1 - Thickness
2 - Color of bars
3 - Color of spaces
4 - Resolution
5 - Text Font (0-5)
*/
bar:Configure( 70 , black, white, 2, 1 )
/* Here is the list of the arguments
1 - Width
2 - Height
3 - Filename (empty : display on screen)
4 - Background color */
bar:CreateBar( 205, 105,,white)
// 1 - code bar
bar:Draw13(ccode13)
// Build image
bar:Finish(2)
// EAN8
bar:= TCode():New(8)
bar:Configure( 70 , black, white, 2 , 1 )
bar:CreateBar( 154, 100,,white)
bar:Draw8(ccode8)
bar:Finish(8)
bar:ResizeImage()
// EAN128
bar:= TCode():New(128)
bar:Configure( 50 , black, white, 2 , 1 )
bar:CreateBar( 300, 400,"Bar128",white)
// 1- code bar
// 2- barcode types A/B/C
// A- Alphanumeric characters uppercase
// B- Alphanumeric characters upper and lowercase
// C- Numeric pairs of integer
bar:Draw128(cCode128,"B")
bar:Finish(2)
// BRAZIL-FEBRABAN
bar:= TCode():New(25)
bar:Configure( 25 , black, white, 1 , 1, , .T. )
bar:CreateBar( 560 ,60, "febraban", white )
bar:DrawI25("104995628545723070285700000008218000")
bar:Finish(8)
RETURN NIL

141
harbour/contrib/gd/tests/counter.prg Normal file
View File

@@ -0,0 +1,141 @@
/*
* $Id$
*/
/*
* Copyright 2004-2005 Francesco Saverio Giudice <info@fsgiudice.com>
*
* Counter sample
* usage:
* counter <number to show>
* i.e.: counter 34524
*/
#include "gd.ch"
#include "common.ch"
#define IMAGES_IN "digits/"
#define IMAGES_OUT "images_out/"
#define DISPLAY_NUM 10
PROCEDURE Main( cValue, cBaseImage )
LOCAL oI, oIDigits, nWidth, nHeight, nDigits, nNumWidth, oTemp
//LOCAL black, white, blue, red, green, cyan, gray
LOCAL white
LOCAL aNumberImages := {}
LOCAL n, nValue
// A value if not passed
DEFAULT cValue TO Str( hb_RandomInt( 1, 10^DISPLAY_NUM ), DISPLAY_NUM )
DEFAULT cBaseImage TO "57chevy.gif"
IF !File( IMAGES_IN + cBaseImage )
? "ERROR: Base Image File '" + IMAGES_IN + cBaseImage + "' not found"
QUIT
ENDIF
nValue := Val( cValue )
// Fix num lenght
IF nValue > 10^DISPLAY_NUM
nValue := 10^DISPLAY_NUM
ENDIF
cValue := StrZero( nValue, DISPLAY_NUM )
Tracelog( "Value", cValue )
// To set fonts run this command:
// for windows: SET GDFONTPATH=c:\windows\fonts
// per linux : export GDFONTPATH=/usr/share/fonts/default/TrueType
// SET GDFONTPATH=c:\windows\fonts
//IF GetEnv( "GDFONTPATH" ) == ""
// ? "Please set GDFONTPATH"
// ? "On Windows: SET GDFONTPATH=c:\windows\fonts"
// ? "On Linux : export GDFONTPATH=/usr/share/fonts/default/TrueType"
// ?
//ENDIF
// Check output directory
IF !ISDirectory( IMAGES_OUT )
DirMake( IMAGES_OUT )
ENDIF
/* Load a digits image in memory from file */
oIDigits := GDImage():LoadFromGif( IMAGES_IN + cBaseImage )
/* Get single number images */
// Get dimensions
nWidth := oIDigits:Width()
nHeight := oIDigits:Height()
// Check base digits image
DO CASE
CASE nWidth % 10 == 0 // 0..9 digits
nDigits := 10
CASE nWidth % 11 == 0 // 0..9 :
nDigits := 11
CASE nWidth % 13 == 0 // 0..9 : am pm
nDigits := 13
OTHERWISE
? "Error on digits image"
ENDCASE
nNumWidth := nWidth / nDigits
Tracelog( "nNumWidth, nWidth, nHeight, nDigits", nNumWidth, nWidth, nHeight, nDigits )
/* extracts single digits */
FOR n := 1 TO nDigits
oTemp := oIDigits:Copy( (n - 1) * nNumWidth, 0, nNumWidth, nHeight )
oTemp:SaveGif( IMAGES_OUT + StrZero( n-1, 2 ) + ".gif" )
// Here I have to clone the image, otherwise on var destruction I loose
// the image in memory
aAdd( aNumberImages, oTemp:Clone() )
NEXT
/* Create counter image in memory */
oI := GDImage( nNumWidth * DISPLAY_NUM, nHeight ) // the counter
Tracelog( "Image dimensions: ", oI:Width(), oI:Height() )
/* Allocate background */
white := oI:SetColor( 255, 255, 255 )
/* Allocate drawing color */
//black := oI:SetColor( 0, 0, 0 )
//blue := oI:SetColor( 0, 0, 255 )
//red := oI:SetColor( 255, 0, 0 )
//green := oI:SetColor( 0, 255, 0 )
//cyan := oI:SetColor( 0, 255, 255 )
/* Draw rectangle */
//oI:Rectangle( 0, 0, 200, 30, , blue )
/* Draw Digits */
FOR n := 1 TO Len( cValue )
// Retrieve the number from array in memory
oTemp := aNumberImages[ Val( cValue[ n ] ) + 1 ]:Clone()
// Save it to show the number for a position
oTemp:SaveGif( IMAGES_OUT + "Pos_" + StrZero( n, 2 ) + ".gif" )
// Set the digit as tile that I have to use to fill position in counter
oI:SetTile( oTemp )
// Fill the position with the image digit
oI:Rectangle( (n - 1) * nNumWidth, 0, (n - 1) * nNumWidth + nNumWidth, nHeight, TRUE, gdTiled )
NEXT
/* Write Final Counter Image */
oI:SaveGif( IMAGES_OUT + "counter.gif" )
/* Destroy images in memory */
// Class does it automatically
?
? "Look at " + IMAGES_OUT + " folder for output images"
?
RETURN

122
harbour/contrib/gd/tests/gdtest.prg Normal file
View File

@@ -0,0 +1,122 @@
/*
* $Id$
*/
/*
* Copyright 2004-2005 Francesco Saverio Giudice <info@fsgiudice.com>
*
* GD API test file
*/
#include "gd.ch"
#include "common.ch"
#define IMAGES_IN "images_in/"
#define IMAGES_OUT "images_out/"
PROCEDURE Main()
LOCAL im, im2
LOCAL black, white, blue, red, green, cyan
LOCAL aClip, color, font, aRect
// SET GDFONTPATH=c:\windows\fonts
IF GetEnv( "GDFONTPATH" ) == ""
? "Please set GDFONTPATH"
? "On Windows: SET GDFONTPATH=c:\windows\fonts"
? "On Linux : export GDFONTPATH=/usr/share/fonts/default/TrueType"
?
ENDIF
/*
// Check output directory
IF !ISDirectory( IMAGES_OUT )
DirMake( IMAGES_OUT )
ENDIF
*/
? gdVersion()
/* Create an image in memory */
im = gdImageCreate(200, 200)
/* Load an image in memory from file */
im2 = gdImageCreateFromJpeg( IMAGES_IN + "conv_test.jpeg")
/* Now work on first empty image */
/* Allocate background */
white = gdImageColorAllocate(im, 255, 255, 255)
/* Allocate drawing color */
black = gdImageColorAllocate(im, 0, 0, 0)
blue = gdImageColorAllocate(im, 0, 0, 255)
red = gdImageColorAllocate(im, 255, 0, 0)
green = gdImageColorAllocate(im, 0, 255, 0)
cyan = gdImageColorAllocate(im, 0, 255, 255)
/* Draw rectangle */
gdImageFilledRectangle(im, 0, 0, 199, 199, cyan)
gdImageRectangle(im, 0, 0, 199, 199, black)
/* Draw pixel */
gdImageSetPixel(im, 50, 5, blue)
gdImageSetPixel(im, 50, 15, blue)
/* Draw lines */
gdImageLine(im, 0, 0, 199, 199, blue)
gdImageDashedLine(im, 0, 199, 199, 0, blue)
/* Draw polygons */
gdImagePolygon(im, { { 10, 10 }, { 70, 10 }, { 80, 60 } }, red)
gdImageFilledPolygon(im, { { 160, 180 }, { 170, 110 }, { 150, 160 } }, green)
/* Draw an arc */
gdImageArc(im, 50, 50, 40, 40, 30, 190, red )
gdImageFilledCircle(im, 50, 150, 45, green )
gdImageEllipse(im, 120, 120, 50, 20, blue )
/* Draw some characters */
font := gdFontGetLarge()
gdImageString(im, font, 0, 0, 'Test', black)
gdImageString(im, font, 0, 15, 'P', black)
gdImageChar(im, font, 0, 30, 'W', black)
gdImageStringUp(im, font, 70, 90, 'Test', black)
gdImageStringUp(im, font, 70, 15, 'P', black)
gdImageCharUp(im, font, 70, 30, 'W', black)
gdImageStringFt(im, blue, "arial", 20, 30, 20, 90, 'Test')
? gdImageStringFTCircle(im, 120, 120, 50, 25, 0.8, "arial", 24, "Up", /*"Down"*/, red)
/* Set Clip Rectangle */
gdImageSetClip(im, 25, 25, 75, 75)
/* Retrieve Clipping rectangle */
aClip := gdImageGetClip(im)
// ? "Clipping rectangle values"
// ? hb_DumpVar( aClip )
/* Query functions */
color := gdImageGetPixel(im, gdImageSX(im) / 2, gdImageSY(im) / 2)
? "Pixel Color is: ", color
? "RGB Values: ", gdImageRed(im,color), gdImageGreen(im,color), gdImageBlue(im,color)
? "Alpha Value: ", gdImageAlpha(im,color)
/* Write Images on files */
gdImagePng(im, IMAGES_OUT + "rect.png")
gdImagePng(im2, IMAGES_OUT + "conv_test.png")
gdImageJpeg(im2, IMAGES_OUT + "conv_test.jpg")
/* Destroy images in memory */
gdImageDestroy(im)
gdImageDestroy(im2)
?
? "Look at " + IMAGES_OUT + " folder for output images"
?
RETURN

334
harbour/contrib/gd/tests/gdtestcls.prg Normal file
View File

@@ -0,0 +1,334 @@
/*
* $Id$
*/
/*
* Copyright 2004-2005 Francesco Saverio Giudice <info@fsgiudice.com>
*
* GD Class test file
*/
#include "gd.ch"
#include "common.ch"
#define IMAGES_IN "images_in/"
#define IMAGES_OUT "images_out/"
PROCEDURE Main()
LOCAL im, im2
LOCAL black, white, blue, red, green, cyan, gray
LOCAL aClip, color, font, aRect
LOCAL oI, oI2, oI3, oI4, nThick, n, nSecs
LOCAL oI5
LOCAL oB
// To set fonts run this command:
// for windows: SET GDFONTPATH=c:\windows\fonts
// per linux : export GDFONTPATH=/usr/share/fonts/default/TrueType
// SET GDFONTPATH=c:\windows\fonts
IF GetEnv( "GDFONTPATH" ) == ""
? "Please set GDFONTPATH"
? "On Windows: SET GDFONTPATH=c:\windows\fonts"
? "On Linux : export GDFONTPATH=/usr/share/fonts/default/TrueType"
?
ENDIF
/*
// Check output directory
IF !ISDirectory( IMAGES_OUT )
DirMake( IMAGES_OUT )
ENDIF
*/
/* Create an image in memory */
oI := GDImage():Create( 200, 200 )
/* Load an image in memory from file */
oI2 := GDImage():LoadFromJpeg( IMAGES_IN + "conv_test.jpeg" )
oI5 := GDImage():LoadFromJpeg( IMAGES_IN + "conv_test.jpeg" )
/* Now work on first empty image */
/* Allocate background */
white := oI:SetColor( 255, 255, 255 )
/* Allocate drawing color */
black := oI:SetColor( 0, 0, 0 )
blue := oI:SetColor( 0, 0, 255 )
red := oI:SetColor( 255, 0, 0 )
green := oI:SetColor( 0, 255, 0 )
cyan := oI:SetColor( 0, 255, 255 )
/* Draw rectangle */
oI:Rectangle( 0, 0, 199, 199, .T., cyan )
oI:Rectangle( 0, 0, 199, 199,, black)
oI:SetColor( blue )
/* Draw pixel */
oI:SetPixel( 50, 5 )
/* Draw lines */
oI:Line( 0, 0, 199, 199, blue )
oI:DashedLine(0, 199, 199, 0, blue)
nThick := oI:SetThickness( 5 )
oI:Line( 50, 150, 100, 150 )
oI:SetThickness( nThick )
oI:AddStyle( red )
oI:AddStyle( red )
oI:AddStyle( red )
oI:AddStyle( gdTransparent )
oI:AddStyle( gdTransparent )
oI:AddStyle( gdTransparent )
oI:SetStyle()
oI:Line( 50, 180, 100, 180, gdStyled )
oI:ResetStyles()
oI:AddStyle( black )
oI:AddStyle( gdTransparent )
oI:SetStyle()
oI:Line( 50, 185, 100, 185, gdStyled )
/* Draw polygons */
oI:AddPoint( 10, 10 )
oI:AddPoint( 70, 10 )
oI:AddPoint( 80, 60 )
oI:Polygon()
oI:ResetPoints()
oI:AddPoint( 160, 180 )
oI:AddPoint( 170, 110 )
oI:AddPoint( 150, 160 )
oI:Polygon(,.T., green)
/* Draw an arc */
oI:Arc(50, 50, 40, 40, 30, 190,, red )
oI:Circle(50, 150, 45, .t., green )
oI:Ellipse(120, 120, 50, 20, , green )
/* Draw a character. */
oI:SetFontLarge()
? "Font Dims", oI:GetFontWidth(), oI:GetFontHeight()
oI:SetColor( black )
//__OutDebug( "Font", font )
oI:Say( 0, 0, 'Test')
oI:Say( 0, 15, 'P')
oI:Say( 0, 30, 'W')
oI:SayVertical( 70, 90, 'Test')
oI:SayVertical( 70, 15, 'P')
oI:SayVertical( 70, 30, 'W')
oI:SayFreeType( 20, 30, "Test", "arial", 24, 15 )
oI:SayFreeType( 40, 70, "Test2" )
/* Set Clip Rectangle */
oI:SetClippingArea(25, 25, 75, 75)
/* Retrieve Clipping rectangle */
aClip := oI:GetClippingArea()
? "Clipping rectangle values"
// ? hb_DumpVar( aClip )
/* Query functions */
color := oI:GetPixel( oI:Width() / 2, oI:Height() / 2)
? "Pixel Color is: ", color
? "RGB Values: ", oI:Red(color), oI:Green(color), oI:Blue(color)
? "Alpha Value: ", oI:Alpha(color)
/* Write Images on files */
oI:SavePng( IMAGES_OUT + "rect.png" )
oI2:SavePng( IMAGES_OUT + "test.png" )
oI2:SaveJpeg( IMAGES_OUT + "test.jpg" )
oI2:SaveGif( IMAGES_OUT + "test.gif" )
//oI2:SaveWBmp( IMAGES_OUT + "vale1.bmp", black )
/* test copy functions */
//oI3 := GDImage():CreateTrueColor( oI2:Width * 2, oI2:Height * 2 )
//oI2:CopyResampled( 0, 0, oI2:Width, oI2:Height, 0, 0, oI3:Width, oI3:Height, oI3 )
//oI3:SaveJpeg("vale2.jpg")
nSecs := Seconds()
? "start copy zoomed"
oI3 := oI2:CopyZoomed( 150 )
? "end", Seconds() - nSecs
nSecs := Seconds()
? "start save"
oI3:SaveJpeg( IMAGES_OUT + "zoom.jpg" )
? "end", Seconds() - nSecs
nSecs := Seconds()
? "start clone & zoom"
oI4:= oI2:Clone():Zoom( 200 )
? "end", Seconds() - nSecs
nSecs := Seconds()
? "start clone"
oI4:= oI5:Clone()
? "end", Seconds() - nSecs
nSecs := Seconds()
? "start zoom"
oI4:Zoom( 200 )
? "end", Seconds() - nSecs
//__OutDebug( oI2:pImage )
//oI4:SetFontGiant()
gray := oI4:SetColor(30, 30, 30)
blue := oI4:SetColor(0, 0, 200)
//oI4:SetColor( black )
//oI4:Say( 100, 10, "Valentina" )
IF OS() = "Linux"
oI4:SayFreeType( oI4:CenterWidth(), oI4:CenterHeight(), "GD power", "arib____", 40, 45 )
ELSE
nSecs := Seconds()
? "start write"
FOR n := 0 TO 350 STEP 10
oI4:SayFreeType( oI4:CenterWidth(), oI4:CenterHeight(), " GD Font Power", "arial", 20, n )
NEXT
? "end", Seconds() - nSecs
oI4:SetTransparent( blue )
oI4:SayFreeType( oI4:CenterWidth()-4, oI4:CenterHeight()+4, "xHarbour", "verdana", 70, n, gray )
oI4:SayFreeType( oI4:CenterWidth(), oI4:CenterHeight(), "xHarbour", "verdana", 70, n, blue )
ENDIF
oI4:SaveJpeg( IMAGES_OUT + "writing.jpg" )
//oI4 := __ObjClone( oI2 )
oI4 := oI2:Clone()
nSecs := Seconds()
? "start rotate outside"
oI2:Rotate( 45 )
? "end", Seconds() - nSecs
oI2:SaveJpeg( IMAGES_OUT + "rotateout.jpg" )
nSecs := Seconds()
? "start rotate inside"
oI4:RotateInside( 45 )
? "end", Seconds() - nSecs
//oI2:CopyRotated( , , , , , , 90, oI4 )
oI4:SaveJpeg( IMAGES_OUT + "rotatein.jpg" )
oI5:Zoom( 40 )
//oI5:Rotate( 90 )
blue := oI5:SetColor(0, 0, 200)
oI5:SayFreeType( oI5:CenterWidth(), oI5:CenterHeight(), "xHarbour", "verdana", 20, 0, blue )
oI5:SaveJpeg( IMAGES_OUT + "xh_zoom.jpg" )
oI5 := GDChart( 400, 400 )
// Set background
white := oI5:SetColor(255, 255, 255)
// Define piece colors
blue := oI5:SetColor(0, 0, 200)
gray := oI5:SetColor(30, 30, 30)
green := oI5:SetColor(0, 250, 0)
red := oI5:SetColor(250, 0, 0)
// Load an image as brush
oB := GDImage():LoadFromGif( IMAGES_IN + "italia.gif" )
oB:Zoom(15)
//oI5:Circle( 200, 200, oI5:Width() )
//oI5:Line( 0, 200, 200, 200 )
oI5:AddDef( "FONTPITCH", "GIANT" )
oI5:SetData( { ;
{ "LABEL" => "One" , "VALUE" => 10, "COLOR" => blue , "FILLED" => TRUE, "EXTRUDE" => 40/*, "TILE" => oB*/ },;
{ "LABEL" => "Two" , "VALUE" => 35, "COLOR" => gray , "FILLED" => TRUE, "FONT" => { "NAME" => "Verdana", "PITCH" => 12, "ANGLE" => 0, "COLOR" => red } },;
{ "LABEL" => "Three", "VALUE" => 55, "COLOR" => green, "FILLED" => TRUE }, ;
{ "LABEL" => "Four" , "VALUE" => 55, "FILLED" => TRUE , "TILE" => oB }, ;
{ "LABEL" => "Five" , "VALUE" => 55, "COLOR" => red , "FILLED" => TRUE, "EXTRUDE" => 20}, ;
{ "LABEL" => "Six" , "VALUE" => 55, "FILLED" => TRUE , "TILE" => oB }, ;
{ "LABEL" => "Seven", "VALUE" => 55, "FILLED" => TRUE , "COLOR" => green } ;
} )
//oI5:VerticalBarChart()
oI5:PieChart()
oI5:SaveJpeg( IMAGES_OUT + "pie.jpg" )
oI5 := GDChart( 640, 480 )
// Set background
white := oI5:SetColor(255, 255, 255)
// Define piece colors
blue := oI5:SetColor(0, 0, 200)
gray := oI5:SetColor(30, 30, 30)
green := oI5:SetColor(0, 250, 0)
red := oI5:SetColor(250, 0, 0)
// Load an image as brush
oB := GDImage():LoadFromJpeg( IMAGES_IN + "fsg.jpg" )
oB:Zoom(15)
// oI5:AddDef( "MAXVALUE", 150 )
oI5:AddDef( "AXISPICT", "@E 999999" )
oI5:AddDef( "FONTPITCH", "GIANT" )
oI5:AddDef( "COLOR", blue )
//oI5:AddSeries( "LABEL" => "Primo",;
// "VALUES" => { 10, 23, 54, 11, 32, 25 }, ;
// "COLOR" => blue )
/*
oI5:SetData( { ;
{ "LABEL" => "One", "VALUE" => 1000, "COLOR" => blue, "FILLED" => TRUE, "EXTRUDE" => 40 },;
{ "LABEL" => "Two", "VALUE" => 3500, "COLOR" => gray, "FILLED" => TRUE, "FONT" => { "NAME" => "Verdana", "PITCH" => 12, "ANGLE" => 0, "COLOR" => red } },;
{ "LABEL" => "Three", "VALUE" => 5500, "COLOR" => green, "FILLED" => TRUE }, ;
{ "LABEL" => "Four", "VALUE" => 6500, "FILLED" => TRUE, "TILE" => oB }, ;
{ "LABEL" => "Five", "VALUE" => 3400, "FILLED" => TRUE, "COLOR" => green }, ;
{ "LABEL" => "Six", "VALUE" => 10000 }, ;
{ "LABEL" => "Seven", "VALUE" => 0, "FILLED" => TRUE, "COLOR" => red }, ;
{ "LABEL" => "Eight", "VALUE" => -2200 }, ;
{ "LABEL" => "Nine", "VALUE" => -3600, "COLOR" => blue, "FILLED" => TRUE } ;
} )
*/
oI5:SetData( { ;
{ "LABEL" => "One", "VALUE" => 10, "COLOR" => blue, "FILLED" => TRUE, "EXTRUDE" => 40/*, "TILE" => oB*/ },;
{ "LABEL" => "Two", "VALUE" => 35, "COLOR" => gray, "FILLED" => TRUE, "FONT" => { "NAME" => "Verdana", "PITCH" => 12, "ANGLE" => 0, "COLOR" => red } },;
{ "LABEL" => "Three", "VALUE" => 55, "COLOR" => green, "FILLED" => TRUE }, ;
{ "LABEL" => "Four", "VALUE" => 65, "FILLED" => TRUE, "TILE" => oB }, ;
{ "LABEL" => "Five", "VALUE" => 34, "FILLED" => TRUE, "COLOR" => green }, ;
{ "LABEL" => "Six", "VALUE" => 100 }, ;
{ "LABEL" => "Seven", "VALUE" => 0, "FILLED" => TRUE, "COLOR" => red }, ;
{ "LABEL" => "Eight", "VALUE" => -0 }, ;
{ "LABEL" => "Nine", "VALUE" => -0, "COLOR" => blue, "FILLED" => TRUE } ;
} )
//oI5:VerticalBarChart()
//oI5:HorizontalBarChart()
oI5:LineChart()
oI5:SaveJpeg( IMAGES_OUT + "hystogram1.jpg" )
//oI5:LineChart()
//oI5:SaveJpeg( IMAGES_OUT + "hystogram.jpg" )
//oI4 := GDImage():CreateTrueColor( oI2:Width * 2, oI2:Height * 2 )
//oI2:CopyResampled( 0, 0, oI2:Width, oI2:Height, 0, 0, oI2:Width, oI2:Height, oI4 )
//oI2:CopyResampled( 0, 0, oI2:Width, oI2:Height, oI4:CenterWidth(), oI4:CenterHeight(), oI2:Width, oI2:Height, oI4 )
//oI4:SaveJpeg("vale3.jpg")
/* Destroy images in memory */
// Class does it auto
?
? "Look at " + IMAGES_OUT + " folder for output images"
?
RETURN

BIN
harbour/contrib/gd/tests/images_in/conv_test.jpeg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.3 KiB

0
harbour/contrib/gd/tests/images_in/empty.jpeg Normal file
View File

BIN
harbour/contrib/gd/tests/images_in/gdlogobig.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 7.6 KiB

BIN
harbour/contrib/gd/tests/images_in/theclipper.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 6.1 KiB

0
harbour/contrib/gd/tests/images_out/EMPTY Normal file
View File

345
harbour/contrib/gd/tests/test_out.prg Normal file
View File

@@ -0,0 +1,345 @@
/*
* $Id$
*/
/*
* Copyright 2004-2005 Francesco Saverio Giudice <info@fsgiudice.com>
*
* Windows CGI test application
*/
#include "gd.ch"
#include "common.ch"
#command WRITE <c> => FWrite( 1, <c> + CHR(13)+CHR(10) )
#command OutHTML <c> => WRITE <c>
PROCEDURE Main(...)
LOCAL cPar
LOCAL aParams := hb_aParams()
LOCAL cQuery := GetEnv( "QUERY_STRING" )
LOCAL hParams := Hash()
LOCAL cText, cImg, nPt, nSize, nWidth, nHeight, cPhoto
IF Empty( aParams )
IF !Empty( cQuery )
hParams := GetVars( cQuery )
ENDIF
ELSE
hParams := GetParams( aParams )
ENDIF
//-----------------------------------------------------------------------------------------
// Gestione parametri
IF !Empty( hParams )
FOR EACH cPar IN hParams:Keys
do case
case cPar == "txt"
cText := hGet( hParams, cPar )
case cPar == "img"
cImg := hGet( hParams, cPar )
case cPar == "photo"
cPhoto := hGet( hParams, cPar )
case cPar == "width"
nWidth := Val( hGet( hParams, cPar ) )
case cPar == "height"
nHeight := Val( hGet( hParams, cPar ) )
case cPar == "pt"
nPt := Val( hGet( hParams, cPar ) )
endcase
NEXT
ENDIF
//__OutDebug( cQuery, ValToPrg( hParams ) )
//-----------------------------------------------------------------------------------------
//DEFAULT cText TO "Testo di Prova"
DEFAULT nPt TO 30
IF cImg <> NIL
//OutJpg( cImg, nPt )
OutPhoto( cImg, nWidth, nHeight )
ELSEIF cPhoto <> NIL
StartHTML()
//OutHTML ValToPrg( hParams ) + "<br>"
//OutHTML ValToPrg( cParams ) + "<br>"
//OutHTML ValToPrg( cQuery ) + "<br>"
//OutHTML "<img src='test_out.exe?img=" + cPhoto + "&width=" + AllTrim( Str( nWidth ) ) + "&height=" + AllTrim( Str( nHeight ) ) + "'>" + "<br>"
OutHTML "<table border=1>"
OutHTML "<tr><td align='center'>"
OutHTML "<img src='test_out.exe?img=" + cPhoto + "'>" + "<br>"
OutHTML "</td></tr>"
OutHTML "<tr><td align='center'>"
OutHTML "<img src='test_out.exe?img=" + cPhoto + ;
IIF( nWidth <> NIL , "&width=" + AllTrim( Str( nWidth ) ) , "" ) + ;
IIF( nHeight <> NIL, "&height=" + AllTrim( Str( nHeight ) ), "" ) + ;
"'>" + "<br>"
OutHTML "</td></tr>"
OutHTML "<tr><td align='center'>"
OutHTML cPhoto
OutHTML "</td></tr>"
OutHTML "</table>"
OutHTML "<br>"
//OutHTML "<img src='test_out.exe?img=" + cText + "_2&pt=" + AllTrim( Str( nPt ) ) + "'>" + "<br>"
//OutHTML OS() + "<br>"
//OutHTML IIF( OS_ISWINNT(), "WIN NT", "NON WIN NT" ) + "<br>"
EndHTML()
ELSE
StartHTML()
EndHTML()
ENDIF
RETURN
PROCEDURE StartHTML( cTitle )
DEFAULT cTitle TO ""
WRITE 'content-type: text/html'
WRITE 'Pragma: no-cache'
WRITE CHR(13)+CHR(10)
WRITE "<html>"
WRITE "<head>"
WRITE "<title>" + cTitle + "</title>"
WRITE "</head>"
WRITE "<body>"
RETURN
PROCEDURE EndHTML( cTitle )
WRITE "</body>"
WRITE "</html>"
RETURN
// per windows: SET GDFONTPATH=c:\windows\fonts
// per linux : export GDFONTPATH=/usr/share/fonts/default/TrueType
PROCEDURE OutPhoto( cPhoto, nWidth, nHeight )
LOCAL cType
LOCAL oImage := GDImage():LoadFromFile( cPhoto )
IF nWidth <> NIL .AND. nHeight <> NIL
oImage:Resize( nWidth, nHeight )
ELSEIF nWidth <> NIL .AND. nHeight == NIL
nHeight := oImage:Height() * ( nWidth / oImage:Width() )
oImage:Resize( nWidth, nHeight )
ELSEIF nWidth == NIL .AND. nHeight <> NIL
nWidth := oImage:Width() * ( nHeight / oImage:Height() )
oImage:Resize( nWidth, nHeight )
ENDIF
//__OutDebug( hb_dumpvar( oImage ) )
WRITE 'content-type: ' + oImage:cMime + CHR(13)+CHR(10)
cType := oImage:cType
DO CASE
CASE cType == "jpeg"
oImage:OutputJpeg()
CASE cType == "gif"
oImage:OutputGif()
CASE cType == "png"
oImage:OutputPng()
ENDCASE
oImage := NIL
RETURN
PROCEDURE OutJpg( cText, nPitch )
LOCAL cOS := OS()
LOCAL cPath := IIF( Left( cOS, 10 ) == "Windows NT", "c:\winnt\fonts\", "c:\windows\fonts\" )
LOCAL oI, cyan, blue
LOCAL aSize, nWidth, nHeight, nX, nY
LOCAL cFont := cPath + "verdana.ttf"
DEFAULT cText TO "Sample TEXT"
DEFAULT nPitch TO 30
/* Create an image in memory */
oI := GDImage( 400, 100 )
/* Allocate background */
cyan := oI:SetColor(0, 255, 255)
/* Allocate drawing color */
blue := oI:SetColor(0, 0, 200)
//oI:SetTransparent( blue )
oI:SetFontName( cFont )
oI:SetFontPitch( nPitch )
//__OutDebug( oI:GetFTFontHeight() )
aSize := oI:GetFTStringSize( cText )
nWidth := aSize[1]
nHeight := aSize[2]
nX := aSize[3]
nY := aSize[4]
oI:Resize( nWidth, nHeight )
/* Allocate drawing color */
blue := oI:SetColor(0, 0, 200)
oI:SetFontName( cPath + "verdana.ttf" )
oI:SetFontPitch( nPitch )
oI:SayFreeType( 0 - nX, 0 + nHeight - nY, cText, , , 0, blue )
//oI:SayFreeType( 0, 0, cText, , , 0, blue )
//oI:Resize( nWidth, nHeight )
//__OutDebug( "prima", oI:Width(), oI:Height() )
//oI:Resize( 60, 40 )
//__OutDebug( "dopo", oI:Width(), oI:Height() )
//oI:SetFontLarge()
//oI:SetColor( blue )
//oI:Say( 0, 0, cText )
WRITE 'content-type: image/jpeg' + CHR(13)+CHR(10)
oI:OutputJpeg()
RETURN
FUNCTION GetVars( cFields, cSeparator )
LOCAL hHashVars := Hash()
LOCAL aField, cField, aFields
LOCAL cName, xValue
DEFAULT cSeparator TO "&"
aFields := HB_RegExSplit( cSeparator, cFields )
FOR EACH cField in aFields
aField := HB_RegexSplit( "=", cField, 2 )
IF Len( aField ) != 2
LOOP
ENDIF
cName := LTrim( aField[1] )
xValue := UrlDecode( aField[2] )
// Tracelog( "cName, xValue", cName, xValue )
// is it an array entry?
IF Substr( cName, Len( cName ) - 1 ) == "[]"
cName := Substr( cName, 1, Len( cName ) - 2 )
hHashVars[ cName ] := { xValue }
ELSE
hHashVars[ cName ] := xValue
ENDIF
//Tracelog( "hHashVars, cName, xValue", DumpValue( hHashVars ), cName, xValue )
NEXT
//__OutDebug( hHashVars )
RETURN hHashVars
FUNCTION GetParams( aParams )
LOCAL hHashVars := Hash()
LOCAL aField, cField, aFields
LOCAL cName, xValue
aFields := aParams
FOR EACH cField in aFields
aField := HB_RegexSplit( "=", cField, 2 )
IF Len( aField ) != 2
LOOP
ENDIF
cName := LTrim( aField[1] )
xValue := UrlDecode( aField[2] )
// Tracelog( "cName, xValue", cName, xValue )
// is it an array entry?
IF Substr( cName, Len( cName ) - 1 ) == "[]"
cName := Substr( cName, 1, Len( cName ) - 2 )
hHashVars[ cName ] := { xValue }
ELSE
hHashVars[ cName ] := xValue
ENDIF
//Tracelog( "hHashVars, cName, xValue", DumpValue( hHashVars ), cName, xValue )
NEXT
//__OutDebug( hHashVars )
RETURN hHashVars
************************************************************
* Decoding URL
* Can return both a string or a number
*
FUNCTION URLDecode( cStr )
LOCAL cRet := "", i, cCar
LOCAL lNumeric := .T.
FOR i := 1 TO Len( cStr )
cCar := cStr[i]
DO CASE
CASE cCar == "+"
cRet += " "
CASE cCar == "%"
i ++
cRet += Chr( HexToNum( SubStr( cStr, i, 2 ) ) )
i ++
OTHERWISE
cRet += cCar
ENDCASE
IF (cRet[i] > "9" .or. cRet[i] < "0") .and. cRet[i] != "."
lNumeric := .F.
ENDIF
NEXT
*IF lNumeric
* cRet := Val( cRet )
*ENDIF
RETURN cRet
FUNCTION URLEncode( cStr )
LOCAL cRet := "", i, nVal, cCar
FOR i := 1 TO Len( cStr )
cCar := cStr[i]
DO CASE
CASE cCar == " "
cRet += "+"
CASE cCar >= "A" .and. cCar <= "Z"
cRet += cCar
CASE cCar >= "a" .and. cCar <= "z"
cRet += cCar
CASE cCar >= "0" .and. cCar <= "9"
cRet += cCar
OTHERWISE
nVal := Asc( cCar )
cRet += "%" + NumToHex( nVal )
ENDCASE
NEXT
RETURN cRet

39
harbour/contrib/gd/tests/testdpi.prg Normal file
View File

@@ -0,0 +1,39 @@
/*
* GD graphic library.
* graphic font DPI demo
*
* Copyright 2005 Francesco Saverio Giudice <info@fsgiudice.com>
*/
#include "gd.ch"
#include "common.ch"
#define IMAGES_IN "images_in/"
#define IMAGES_OUT "images_out/"
PROCEDURE Main()
oI := GDImage:Create( 600, 300 )
white := oI:SetColor( 255, 255, 255 )
black := oI:SetColor( 0, 0, 0 )
oI:SetColor( black )
oI:SetFontName("c:\windows\fonts\arial.ttf")
oI:SetFontPitch( 10 )
// Resolution = 96 dpi, default
oI:SayFreeType( 10, 100, "GD_RESOLUTION: 96 dpi" )
// Resolution = 150 dpi, using parameter 12
oI:SayFreeType( 10, 150, "GD_RESOLUTION: 150 dpi",,,,,,,, 150 )
// Resolution = 300 dpi, using parameter 12
oI:SayFreeType( 10, 200, "GD_RESOLUTION: 300 dpi",,,,,,,, 300 )
oI:SavePng( IMAGES_OUT + "testdpi.png" )
oI:SaveJpeg( IMAGES_OUT + "testdpi.jpg" )
oI:SaveGif( IMAGES_OUT + "testdpi.gif" )
RETURN

48
harbour/contrib/gd/tests/tostring.prg Normal file
View File

@@ -0,0 +1,48 @@
/*
* $Id$
*/
/*
* Copyright 2004-2005 Francesco Saverio Giudice <info@fsgiudice.com>
*
* GD Class test file: tostring() demo
*/
#include "gd.ch"
#include "common.ch"
#define IMAGES_IN "images_in/"
#define IMAGES_OUT "images_out/"
PROCEDURE Main()
LOCAL im, im2
LOCAL black, white, blue, red, green, cyan, gray
LOCAL aClip, color, font, aRect
LOCAL oI, oI2, oI3, oI4, nThick, n, nSecs
LOCAL oI5
LOCAL oB
// Check output directory
IF !ISDirectory( IMAGES_OUT )
DirMake( IMAGES_OUT )
ENDIF
/* Load an image from file */
oI := GDImage():LoadFromFile( IMAGES_IN + "xharbour.jpg" )
oI:SaveJpeg( IMAGES_OUT + "testfile.jpg" )
//Tracelog( oI:ToString() )
MemoWrit( IMAGES_OUT + "teststring.jpg", oI:ToString() )
oI:SaveToFile( IMAGES_OUT + "testtofile" )
?
? "Look at " + IMAGES_OUT + " folder for output images"
?
RETURN