2012-06-08 02:52 UTC+0200 Viktor Szakats (harbour syenar.net)

* contrib/hbgd/gdbar.prg
  * contrib/hbgd/gdbarcod.prg
  * contrib/hbgd/gdchart.prg
  * contrib/hbgd/gdimage.prg
    * formatting
    % using HB_DEFAULT() instead of DEFAULT TO and local DEFAULT() macro
      (it means that in these places, type checking is more thourough
      than before). I left DEFAULT TO in places where the default expression
      is complex.
    ! fixed TCODE():New() to not use Alert(), use ::DrawError() instead
    % HGetValue(): use HB_HGETDEF() instead of equivalent local logic
    % use HB_ISHASH() instead of ValType()
    % use hb_ntos() instead of LTrim( Str() )
    ; build tested only, pls review
This commit is contained in:
Viktor Szakats
2012-06-08 00:52:31 +00:00
parent 0536e7526e
commit 82ae26c290
5 changed files with 540 additions and 483 deletions

View File

@@ -16,6 +16,22 @@
The license applies to all entries newer than 2009-04-28.
*/
2012-06-08 02:52 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/hbgd/gdbar.prg
* contrib/hbgd/gdbarcod.prg
* contrib/hbgd/gdchart.prg
* contrib/hbgd/gdimage.prg
* formatting
% using HB_DEFAULT() instead of DEFAULT TO and local DEFAULT() macro
(it means that in these places, type checking is more thourough
than before). I left DEFAULT TO in places where the default expression
is complex.
! fixed TCODE():New() to not use Alert(), use ::DrawError() instead
% HGetValue(): use HB_HGETDEF() instead of equivalent local logic
% use HB_ISHASH() instead of ValType()
% use hb_ntos() instead of LTrim( Str() )
; build tested only, pls review
2012-06-07 16:44 UTC-0800 Pritpal Bedi (bedipritpal@hotmail.com)
* contrib/hbide/hbqtoolbar.prg
* contrib/hbide/ideedit.prg

View File

@@ -128,7 +128,7 @@ METHOD CreateBar( sx, sy, filename, ccolor ) CLASS TBarCode
::positionY := 0
::imWidth := sx
IF !Empty( filename )
IF ! Empty( filename )
::filename := filename
ENDIF
@@ -138,11 +138,11 @@ METHOD CreateBar( sx, sy, filename, ccolor ) CLASS TBarCode
::Setfont( "Arial" )
// configures Fontes
If ::textfont == 1 ; ::SetFontSmall()
ElseIf ::textfont == 2 ; ::SetFontLarge()
ElseIf ::textfont == 3 ; ::SetFontMediumBold()
ElseIf ::textfont == 4 ; ::SetFontGiant()
ElseIf ::textfont == 5 ; ::SetFontTiny()
IF ::textfont == 1 ; ::SetFontSmall()
ELSEIF ::textfont == 2 ; ::SetFontLarge()
ELSEIF ::textfont == 3 ; ::SetFontMediumBold()
ELSEIF ::textfont == 4 ; ::SetFontGiant()
ELSEIF ::textfont == 5 ; ::SetFontTiny()
ENDIF
::SetFontPitch( ::textfont )
@@ -226,19 +226,19 @@ METHOD DrawSingleI25( pcode ) CLASS TBarCode
::positionX := 10
For j := 1 TO Len( pcode )
FOR j := 1 TO Len( pcode )
imgBar := iif( j % 2 == 0, ::FillColor, ::BackColor )
imgWid := iif( SubStr( pcode,j,1 ) == "0" , widthSlimBar, widthFatBar )
end_y := ::maxHeight
For qw := 1 TO imgWid
FOR qw := 1 TO imgWid
::Line( ::positionX, 1, ::positionX, end_y, imgBar )
::nextX( .T. )
Next
NEXT
Next
NEXT
RETURN NIL
@@ -292,12 +292,12 @@ METHOD CheckCode() CLASS TBarCode
LOCAL lRet := .T.
LOCAL i
For i := 1 TO Len( ::text )
FOR i := 1 TO Len( ::text )
IF HB_ISSTRING( ::CheckValInArray( SubStr( ::text, i, 1 ) ) )
::DrawError( "Character " + SubStr( ::text, i, 1 ) + " not allowed ." )
lRet := .F.
ENDIF
Next
NEXT
RETURN lRet

View File

@@ -65,146 +65,151 @@ CREATE CLASS TCode FROM TBarCode
DATA nType
// EAN-13 ISBN
METHOD New( nTypeCode ) 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(value)
METHOD MixCode( value )
METHOD Findcode( uval )
ENDCLASS
METHOD New( nTypeCode ) CLASS TCode
Local ii
LOCAL ii
If ( nTypeCode == 13 .OR.;
nTypeCode == 8 )
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'}
::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
ELSEIF nTypeCode == 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";
}
::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)
::KeysModeC := Array( 99 )
For ii := 1 TO 99
::KeysmodeC[ii] := StrZero(ii,2)
Next
FOR ii := 1 TO 99
::KeysmodeC[ ii ] := StrZero( ii, 2 )
NEXT
ElseIf nTypeCode == 25
ELSEIF nTypeCode == 25
::keys := {'1','2','3','4','5','6','7','8','9','0'}
::keys := { "1", "2", "3", "4", "5", "6", "7", "8", "9", "0" }
::aCode := Array(12)
::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
::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
ELSE
Alert(" Invalid type to barcode !")
::DrawError( "Invalid type to barcode." )
Return NIL
RETURN NIL
EndIf
ENDIF
::nType := nTypeCode
Return SELF
RETURN Self
METHOD Draw( cText ) CLASS TCode
if ::nType == 13
IF ::nType == 13
::Draw13( cText )
elseif ::nType == 8
ELSEIF ::nType == 8
::Draw8( cText )
elseif ::nType == 128
ELSEIF ::nType == 128
::Draw128( cText )
elseif ::nType == 25
ELSEIF ::nType == 25
::DrawI25( cText )
endif
ENDIF
Return NIL
RETURN NIL
METHOD Draw13(cText) CLASS TCode
METHOD Draw13( cText ) CLASS TCode
LOCAL lerror := .f.
LOCAL nchkSum :=0
LOCAL nChk :=0
LOCAL ii,jj
LOCAL lerror := .F.
LOCAL nchkSum := 0
LOCAL nChk := 0
LOCAL ii, jj
LOCAL xParity
::Settext( ctext )
// Valid characters
If !::CheckCode()
IF ! ::CheckCode()
lerror := .T.
EndIf
ENDIF
If !lerror
IF !lerror
If ::book .AND. Len( ::text) != 10
::DrawError("Must contains 10 chars if ISBN is true.")
IF ::book .AND. Len( ::text ) != 10
::DrawError( "Must contains 10 chars if ISBN is true." )
lerror := .T.
EndIf
ENDIF
// book, we changed the code to the right
If ( ::book .And. Len( ::text )==10 )
::text := "978"+substr(::text,1, Len( ::text )-1 )
EndIF
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
// 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 !lerror
// If we have to write text, we moved the barcode to the right to have space to put digit
::positionX := iif( ::textfont == 0 , 0, 10 )
@@ -214,99 +219,100 @@ METHOD Draw13(cText) CLASS TCode
// First Bar
::positionX := 10
::maxHeight := ::maxHeight + 9
::DrawSingleBar("101")
::DrawSingleBar( "101" )
// start code
::maxHeight := ::maxHeight - 9
For ii := 1 To Len( ::text )
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
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
// ANow, the bar of the middle
IF ii == 8
::positionX += 1
::maxHeight := ::maxHeight + 9
::DrawSingleBar("101")
::DrawSingleBar( "101" )
::maxHeight := ::maxHeight - 9
::positionX += 1
EndIf
ENDIF
jj := Val( SubStr( ::text, ii, 1) )
jj := Val( SubStr( ::text, ii, 1 ) )
If jj == 0
IF jj == 0
jj := 10
EndIf
ENDIF
If ii > 1 .And. ii < 8
IF ii > 1 .AND. ii < 8
::DrawSingleBar( iif( Substr(xParity, ii - 1, 1) == "E",;
::LeftHand_Even[jj],;
::LeftHand_Odd[jj] ) )
ElseIf ii > 1 .And. ii >= 8
::DrawSingleBar( iif( SubStr(xParity, ii - 1, 1 ) == "E",;
::LeftHand_Even[ jj ], ;
::LeftHand_Odd[ jj ] ) )
ELSEIF ii > 1 .AND. ii >= 8
::DrawSingleBar( ::Right_Hand[jj] )
::DrawSingleBar( ::Right_Hand[ jj ] )
EndIf
ENDIF
Next
NEXT
jj := Mod( nchkSum, 10 )
If jj != 0
IF jj != 0
nChk := 10 - jj
EndIf
ENDIF
If nChk == 0
IF nChk == 0
nChk := 10
EndIf
ENDIF
::DrawSingleBar( ::Right_Hand[nChk] )
::DrawSingleBar( ::Right_Hand[ nChk ] )
// Now, finish bar
::maxHeight := ::maxHeight + 9
::DrawSingleBar("101")
::DrawSingleBar( "101" )
::lastX := ::positionX
::lastX := ::positionX
::lastY := ::maxHeight
ctext+=AllTrim( Str( nChk,1 ) )
ctext += AllTrim( Str( nChk, 1 ) )
// Draw Text
If ::lDrawValue
IF ::lDrawValue
::Settext( ctext )
::DrawText13()
EndIf
ENDIF
EndIf
ENDIF
EndIf
ENDIF
Return NIL
RETURN NIL
METHOD DrawText13() CLASS TCode
if ::textfont != 0
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)
::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
ENDIF
::lastY := ::maxHeight + ::GetFontHeight()
Return NIL
RETURN NIL
METHOD Draw8( cText ) CLASS TCode
LOCAL lerror := .f.
LOCAL ii,jj
LOCAL lerror := .F.
LOCAL ii, jj
//LOCAL xParity
LOCAL nchkSum := 0
LOCAL nChk := 0
@@ -314,89 +320,89 @@ METHOD Draw8( cText ) CLASS TCode
::Settext( ctext )
// Valid characters
If !::CheckCode()
IF !::CheckCode()
lerror := .T.
EndIf
ENDIF
If !lerror
IF !lerror
::positionX := iif( ::textfont == 0 , 0, 10 )
//xParity := ::Parity[ 7 ]
// First Bar
// First Bar
::positionX := 10
::maxHeight := ::maxHeight + 9
::DrawSingleBar("101")
::DrawSingleBar( "101" )
// Start Code
::maxHeight := ::maxHeight - 9
For ii := 1 To Len(::text)
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 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
IF ii == 5
::positionX += 1
::maxHeight := ::maxHeight + 9
::DrawSingleBar("01010")
::DrawSingleBar( "01010" )
::maxHeight := ::maxHeight - 9
::positionX += 1
EndIf
ENDIF
jj := Val( SubStr( ::text, ii, 1) )
jj := Val( SubStr( ::text, ii, 1 ) )
If jj == 0
IF jj == 0
jj := 10
EndIf
ENDIF
If ii < 5
::DrawSingleBar( ::LeftHand_Odd[jj] )
ElseIf ii >= 5
::DrawSingleBar( ::Right_Hand[jj] )
EndIf
IF ii < 5
::DrawSingleBar( ::LeftHand_Odd[ jj ] )
ELSEIF ii >= 5
::DrawSingleBar( ::Right_Hand[ jj ] )
ENDIF
Next
NEXT
jj := Mod( nchkSum, 10 )
If jj != 0
IF jj != 0
nChk := 10 - jj
EndIf
ENDIF
::DrawSingleBar(::Right_Hand[nChk])
::DrawSingleBar( ::Right_Hand[ nChk ] )
// Now, finish bar
::maxHeight := ::maxHeight + 9
::DrawSingleBar("101")
::DrawSingleBar( "101" )
::lastX := ::positionX
::lastY := ::maxHeight
ctext+=AllTrim( Str( nChk,1 ) )
ctext += AllTrim( Str( nChk, 1 ) )
// Draw text
If ::lDrawValue
// Draw text
IF ::lDrawValue
::Settext( ctext )
::DrawText8()
EndIf
ENDIF
EndIf
ENDIF
Return NIL
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)
::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()
::lastY := ::maxHeight + ::GetFontHeight()
Return NIL
RETURN NIL
METHOD FindCharCode( cstring, cchar ) CLASS TCode
@@ -406,191 +412,192 @@ METHOD FindCharCode( cstring, cchar ) CLASS TCode
FOR i := 1 TO Len( cstring )
If SubStr( cstring, i, 1 ) == cchar
IF SubStr( cstring, i, 1 ) == cchar
++nC
nRet := nC
EXIT
EndIf
ENDIF
++nC
NEXT
Return nret
RETURN nret
METHOD Draw128( cText, cModeCode ) CLASS TCode
Local cchar, nvalchar, n, i
LOCAL cchar, nvalchar, n, i
Local nSum := 0
Local nC := 0
LOCAL nSum := 0
LOCAL nC := 0
LOCAL npos
//LOCAL value_test := 0
Local lTypeCodeC := .F.
Local lTypeCodeA := .F.
LOCAL lTypeCodeC := .F.
LOCAL lTypeCodeA := .F.
LOCAL lerror := .F.
Local cBarCode := ""
Local cconc := ""
LOCAL cBarCode := ""
LOCAL cconc := ""
hb_default( @cModeCode, "B" )
::settext( cText )
If !Empty( cModeCode )
If HB_ISSTRING( cModeCode ) .and. Upper(cModeCode) $'ABC'
cModeCode := Upper(cModeCode)
Else
::DrawError("Code 128 Modes are A,B o C. Character values.")
IF ! Empty( cModeCode )
IF HB_ISSTRING( cModeCode ) .AND. Upper( cModeCode ) $ "ABC"
cModeCode := Upper( cModeCode )
ELSE
::DrawError( "Code 128 Modes are A,B o C. Character values." )
lerror := .T.
EndIf
EndIf
ENDIF
ENDIF
// Checking if all chars are allowed
For i := 1 TO Len( ::text )
FOR i := 1 TO Len( ::text )
If cModeCode == "C"
IF cModeCode == "C"
npos := AsCAn( ::KeysmodeC, {| x | x == SubStr( ::Text, i, 1 ) + SubStr( ::Text, i+1, 1 ) } )
npos := AScan( ::KeysmodeC, {| x | x == SubStr( ::Text, i, 1 ) + SubStr( ::Text, i + 1, 1 ) } )
If npos == 0
::DrawError("With Code C, you must provide always pair of two integers. Char "+SubStr( ::text, i, 1 )+SubStr( ::text, i+1, 1 )+" not allowed." )
IF npos == 0
::DrawError( "With Code C, you must provide always pair of two integers. Char " + SubStr( ::text, i, 1 ) + SubStr( ::text, i + 1, 1 ) + " not allowed." )
lerror := .T.
EndIf
ENDIF
ElseIf cModeCode == "B"
ELSEIF cModeCode == "B"
If ::FindCharCode( ::KeysmodeB, SubStr( ::Text, i, 1 ) ) == 0
::DrawError('Char '+ SubStr( ::text, i, 1 )+" not allowed.")
IF ::FindCharCode( ::KeysmodeB, SubStr( ::Text, i, 1 ) ) == 0
::DrawError( "Char " + SubStr( ::text, i, 1 ) + " not allowed." )
lerror := .T.
EndIf
ENDIF
ElseiF cModeCode == "A"
ELSEIF cModeCode == "A"
If ::FindCharCode( ::KeysmodeA, SubStr( ::text, i, 1 ) ) == 0
::DrawError('Char '+ SubStr( ::text, i, 1 ) +" not allowed.")
IF ::FindCharCode( ::KeysmodeA, SubStr( ::text, i, 1 ) ) == 0
::DrawError( "Char " + SubStr( ::text, i, 1 ) + " not allowed." )
lerror := .T.
EndIf
ENDIF
EndIf
ENDIF
Next
NEXT
If !lerror
IF !lerror
If Empty( cModeCode )
IF Empty( cModeCode )
If Str( Val( ::text ), Len( ::text ) ) == ::text
IF Str( Val( ::text ), Len( ::text ) ) == ::text
lTypeCodeC := .T.
cconc := ::aCode[ STARTC ]
nSum := STARTB
Else
ELSE
For n := 1 TO Len( ::text )
nC += iif( substr( ::text, n, 1 ) > 31, 1, 0 )
Next
FOR n := 1 TO Len( ::text )
nC += iif( SubStr( ::text, n, 1 ) > 31, 1, 0 )
NEXT
If nC < Len( ::text ) / 2
lTypeCodeA:= .t.
IF nC < Len( ::text ) / 2
lTypeCodeA := .T.
cconc := ::aCode[ STARTA ]
nSum := FNC1
Else
ELSE
cconc := ::aCode[ STARTB ]
nSum := STARTA
EndIf
ENDIF
EndIf
ENDIF
Else
ELSE
If cModeCode == 'C'
IF cModeCode == "C"
lTypeCodeC := .T.
cconc := ::aCode[ STARTC ]
nSum := STARTB
lTypeCodeC := .T.
cconc := ::aCode[ STARTC ]
nSum := STARTB
Elseif cModeCode =='A'
ELSEIF cModeCode == "A"
lTypeCodeA := .t.
cconc := ::aCode[ STARTB ]
nSum := FNC1
lTypeCodeA := .T.
cconc := ::aCode[ STARTB ]
nSum := FNC1
Else
ELSE
cconc := ::aCode[ STARTB ]
nSum := STARTA
cconc := ::aCode[ STARTB ]
nSum := STARTA
EndIf
ENDIF
EndIf
ENDIF
nC := 0
For n := 1 To Len( ::text )
FOR n := 1 TO Len( ::text )
nC ++
++nC
cchar := Substr( ::text, n, 1 )
cchar := SubStr( ::text, n, 1 )
if lTypeCodeC
IF lTypeCodeC
If Len( ::TEXT ) == n
IF Len( ::TEXT ) == n
cconc += ::aCode[ 101 ]
nvalchar := Asc( cchar )-31
Else
nvalchar := Val( Substr( ::text, n, 2 ) ) + 1
n++
EndIf
nvalchar := Asc( cchar ) - 31
ELSE
nvalchar := Val( SubStr( ::text, n, 2 ) ) + 1
++n
ENDIF
Elseif lTypeCodeA
ELSEIF lTypeCodeA
If cchar > '_'
IF cchar > "_"
cconc += ::aCode[ 101 ]
nvalchar := Asc( cchar ) - 31
Elseif cchar <= ' '
ELSEIF cchar <= " "
nvalchar := Asc( cchar ) + 64
Else
ELSE
nvalchar := Asc( cchar ) - 31
Endif
ENDIF
Else
ELSE
If cchar < ' '
IF cchar < " "
cconc += ::aCode[ CODEA ]
nvalchar := Asc( cchar ) + 64
Else
ELSE
nvalchar := Asc( cchar ) - 31
EndIf
ENDIF
Endif
ENDIF
nSum += ( nvalchar - 1 ) * nC
cconc := cconc +::aCode[ nvalchar ]
cconc := cconc + ::aCode[ nvalchar ]
next
NEXT
nSum := nSum % 103 + 1
cconc := cconc + ::aCode[ nSum ] +::aCode[ 107 ]
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
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
// Draw Text
IF ::lDrawValue
::Settext( ctext )
::DrawText()
EndIf
ENDIF
EndIf
ENDIF
Return NIL
RETURN NIL
METHOD DrawI25( cText ) CLASS TCode
@@ -598,22 +605,23 @@ METHOD DrawI25( cText ) CLASS TCode
::GenCodei25()
Return NIL
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")
IF ( Len( ::text ) % 2 ) != 0
::DrawError( "Invalid barcode lenght" )
lError := .T.
Endif
ENDIF
If !lError
IF !lError
bc_string := upper( ::text )
bc_string := Upper( ::text )
// encode itemId to I25 barcode standard. //////////////////////////////////////
@@ -626,21 +634,22 @@ METHOD GenCodei25() CLASS TCode
::lastY := ::maxHeight
// Draw Text
If ::lDrawValue
// Draw Text
IF ::lDrawValue
::DrawText( .T. )
EndIf
ENDIF
EndIf
ENDIF
Return NIL
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 l, i, k
LOCAL s
LOCAL bar_string := ""
LOCAL cfirst
@@ -648,14 +657,14 @@ METHOD MixCode( value ) CLASS TCode
l := Len( value )
If ( l % 2 ) != 0
::DrawError("Code cannot be intercalated: Invalid length (mix)")
Else
IF ( l % 2 ) != 0
::DrawError( "Code cannot be intercalated: Invalid length (mix)" )
ELSE
i := 1
s := ""
i := 1
s := ""
DO While i < l
DO WHILE i < l
cFirst := ::Findcode( value[ i ] )
cnext := ::Findcode( value[ i + 1 ] )
@@ -663,19 +672,19 @@ METHOD MixCode( value ) CLASS TCode
// Mix of the codes
// NNNNWNNWWW
// N N N W W
For k := 1 TO 5
s += cFirst[ k ] + cnext[ k ]
Next
FOR k := 1 TO 5
s += cFirst[ k ] + cnext[ k ]
NEXT
i += 2
EndDo
ENDDO
bar_string := s
EndIf
ENDIF
Return bar_string
RETURN bar_string
METHOD Findcode( uval ) CLASS TCode
@@ -685,4 +694,4 @@ METHOD Findcode( uval ) CLASS TCode
npos := AScan( ::keys, {| x | x[ 1 ] == uval } )
cretc := ::acode[ npos ]
Return cretc
RETURN cretc

View File

@@ -54,8 +54,6 @@
#include "hbclass.ch"
#include "gd.ch"
#define DEFAULT( x, y ) IIF( x == NIL, x := y, )
CLASS GDChart FROM GDImage
DATA cTitle
@@ -97,32 +95,33 @@ METHOD New( sx, sy ) CLASS GDChart
::cTitle := "Chart"
::aSeries := {}
::hDefs := {=>}
::hDefs := { => }
::aDataOfHashes := {}
::Create( sx, sy )
RETURN Self
RETURN Self
METHOD AddData( hData ) CLASS GDChart
IF ValType( hData ) == "H"
IF HB_ISHASH( hData )
aAdd( ::aDataOfHashes, hData )
ENDIF
RETURN Self
RETURN Self
METHOD SetData( aData ) CLASS GDChart
IF HB_ISARRAY( aData )
::aDataOfHashes := aData
ENDIF
RETURN Self
RETURN Self
METHOD AddDef( cDefKey, xDefVal ) CLASS GDChart
IF HB_ISSTRING( cDefKey )
HB_hSet( ::hDefs, Upper( cDefKey ), xDefVal )
hb_HSet( ::hDefs, Upper( cDefKey ), xDefVal )
ENDIF
RETURN Self
RETURN Self
METHOD SetDefs( hDefs ) CLASS GDChart
IF ValType( hDefs ) == "H"
IF HB_ISHASH( hDefs )
::hDefs := hDefs
ENDIF
RETURN Self
@@ -142,10 +141,10 @@ METHOD PieChart() CLASS GDChart
aPieDataOfHash := ::aDataOfHashes
hDefs := ::hDefs
x := HGetValue( hDefs, "POSX" )
y := HGetValue( hDefs, "POSY" )
nWidth := HGetValue( hDefs, "WIDTH" )
cFontPitch := HGetValue( hDefs, "FONTPITCH" )
x := __HGetValue( hDefs, "POSX" )
y := __HGetValue( hDefs, "POSY" )
nWidth := __HGetValue( hDefs, "WIDTH" )
cFontPitch := __HGetValue( hDefs, "FONTPITCH" )
DEFAULT x TO ::CenterWidth()
DEFAULT y TO ::CenterHeight()
@@ -171,9 +170,9 @@ METHOD PieChart() CLASS GDChart
// Before sum of values to determine perentual
FOR EACH hElement IN aPieDataOfHash
nTot += hElement["VALUE"]
nTot += hElement[ "VALUE" ]
// Check extrution
IF ( nExtrude := HGetValue( hElement, "EXTRUDE" ) ) != NIL
IF ( nExtrude := __HGetValue( hElement, "EXTRUDE" ) ) != NIL
nTotExtr := Max( nTotExtr, nExtrude )
ENDIF
NEXT
@@ -182,24 +181,24 @@ METHOD PieChart() CLASS GDChart
// Second,
FOR EACH hElement IN aPieDataOfHash
cLabel := HGetValue( hElement, "LABEL" )
lFilled := HGetValue( hElement, "FILLED" )
nExtrude := HGetValue( hElement, "EXTRUDE" )
pTile := HGetValue( hElement, "TILE" )
cLabel := __HGetValue( hElement, "LABEL" )
lFilled := __HGetValue( hElement, "FILLED" )
nExtrude := __HGetValue( hElement, "EXTRUDE" )
pTile := __HGetValue( hElement, "TILE" )
IF nExtrude != NIL
lExtruded := .T.
ELSE
lExtruded := .F.
ENDIF
colorp := HGetValue( hElement, "COLOR" )
nVal := hElement["VALUE"]
colorp := __HGetValue( hElement, "COLOR" )
nVal := hElement[ "VALUE" ]
nDim := 360 * ( ( nVal / nTot ) * 100 ) / 100
DEFAULT lFilled TO .F.
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 ))
nPosX := x + nExtrude * Cos( ::Radians( nDegree + nDim / 2 ) )
nPosY := y + nExtrude * Sin( ::Radians( nDegree + nDim / 2 ) )
ELSE
nPosX := x
nPosY := y
@@ -218,7 +217,7 @@ METHOD PieChart() CLASS GDChart
::Arc( nPosX, nPosY, nWidth, nWidth, nDegree, nDegree + nDim, .T., colorp, gdNoFill + gdEdged )
ENDIF
IF cLabel != NIL
hFont := HGetValue( hElement, "FONT" )
hFont := __HGetValue( hElement, "FONT" )
IF hFont == NIL
::SetFontMediumBold()
cFontName := NIL
@@ -226,21 +225,21 @@ METHOD PieChart() CLASS GDChart
nAngle := NIL
textcolor := NIL
ELSE
cFontName := HGetValue( hFont, "NAME" )
nPitch := HGetValue( hFont, "PITCH" )
nAngle := HGetValue( hFont, "ANGLE" )
textcolor := HGetValue( hFont, "COLOR" )
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 ))
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 ) )
//cTitle := hb_ntos( nVal )
IF hFont == NIL
::Say( nPosX, nPosY, cLabel, textcolor, gdAlignCenter )
ELSE
@@ -280,16 +279,16 @@ METHOD VerticalBarChart() CLASS GDChart
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" )
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
@@ -327,17 +326,17 @@ METHOD VerticalBarChart() CLASS GDChart
nMax := 0
FOR EACH hElement IN aDataOfHash
IF hElement:__enumIndex() == 1
nMax := hElement["VALUE"]
nMax := hElement[ "VALUE" ]
ELSE
nMax := Max( nMax, hElement["VALUE"] )
nMax := Max( nMax, hElement[ "VALUE" ] )
ENDIF
cLabel := HGetValue( hElement, "LABEL" )
nMaxLabel := Max( nMaxLabel, Len( IIF( cLabel != NIL, cLabel, "" ) ) )
nTot += hElement["VALUE"]
cLabel := __HGetValue( hElement, "LABEL" )
nMaxLabel := Max( nMaxLabel, Len( iif( cLabel != NIL, cLabel, "" ) ) )
nTot += hElement[ "VALUE" ]
NEXT
DEFAULT nLeftLabelSpace TO nBorder + Len( LTrim( Transform( nMax, cAxisPict ) ) ) * ::GetFontWidth() + nBorder
DEFAULT nRightLabelSpace TO nLeftLabelSpace //nBorder + Len( LTrim( Str( nMax ) ) ) * ::GetFontWidth() + nBorder
DEFAULT nRightLabelSpace TO nLeftLabelSpace //nBorder + Len( hb_ntos( nMax ) ) * ::GetFontWidth() + nBorder
DEFAULT nBottomLabelSpace TO nBorder + nMaxLabel * ::GetFontWidth() + nBorder
DEFAULT nMaxValue TO nMax
@@ -399,17 +398,17 @@ METHOD VerticalBarChart() CLASS GDChart
// Second,
FOR EACH hElement IN aDataOfHash
cLabel := HGetValue( hElement, "LABEL" )
lFilled := HGetValue( hElement, "FILLED" )
//nExtrude := HGetValue( hElement, "EXTRUDE" )
pTile := HGetValue( hElement, "TILE" )
cLabel := __HGetValue( hElement, "LABEL" )
lFilled := __HGetValue( hElement, "FILLED" )
//nExtrude := __HGetValue( hElement, "EXTRUDE" )
pTile := __HGetValue( hElement, "TILE" )
//IF nExtrude != NIL
// lExtruded := .T.
//ELSE
// lExtruded := .F.
//ENDIF
colorp := HGetValue( hElement, "COLOR" )
nVal := hElement["VALUE"]
colorp := __HGetValue( hElement, "COLOR" )
nVal := hElement[ "VALUE" ]
nDim := ( nVal / nMaxValue ) * nHeight
DEFAULT lFilled TO .F.
@@ -465,16 +464,16 @@ METHOD HorizontalBarChart() CLASS GDChart
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" )
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
@@ -510,13 +509,13 @@ METHOD HorizontalBarChart() CLASS GDChart
nMax := 0
FOR EACH hElement IN aDataOfHash
IF hElement:__enumIndex() == 1
nMax := hElement["VALUE"]
nMax := hElement[ "VALUE" ]
ELSE
nMax := Max( nMax, hElement["VALUE"] )
nMax := Max( nMax, hElement[ "VALUE" ] )
ENDIF
cLabel := HGetValue( hElement, "LABEL" )
nMaxLabel := Max( nMaxLabel, Len( IIF( cLabel != NIL, cLabel, "" ) ) )
nTot += hElement["VALUE"]
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 )
@@ -582,17 +581,17 @@ METHOD HorizontalBarChart() CLASS GDChart
// Second,
FOR EACH hElement IN aDataOfHash
cLabel := HGetValue( hElement, "LABEL" )
lFilled := HGetValue( hElement, "FILLED" )
//nExtrude := HGetValue( hElement, "EXTRUDE" )
pTile := HGetValue( hElement, "TILE" )
cLabel := __HGetValue( hElement, "LABEL" )
lFilled := __HGetValue( hElement, "FILLED" )
//nExtrude := __HGetValue( hElement, "EXTRUDE" )
pTile := __HGetValue( hElement, "TILE" )
//IF nExtrude != NIL
// lExtruded := .T.
//ELSE
// lExtruded := .F.
//ENDIF
colorp := HGetValue( hElement, "COLOR" )
nVal := hElement["VALUE"]
colorp := __HGetValue( hElement, "COLOR" )
nVal := hElement[ "VALUE" ]
nDim := ( nVal / nMaxValue ) * nWidth
DEFAULT lFilled TO .F.
//DEFAULT nExtrude TO 0
@@ -649,17 +648,17 @@ METHOD LineChart() CLASS GDChart
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" )
colorp := HGetValue( hDefs, "COLOR" )
lShowAxis := HGetValue( hDefs, "SHOWAXIS" )
lShowGrid := HGetValue( hDefs, "SHOWGRID" )
cAxisPict := HGetValue( hDefs, "AXISPICT" )
cFontPitch := HGetValue( hDefs, "FONTPITCH" )
x := __HGetValue( hDefs, "POSX" )
y := __HGetValue( hDefs, "POSY" )
nWidth := __HGetValue( hDefs, "WIDTH" )
nHeight := __HGetValue( hDefs, "HEIGHT" )
nMaxValue := __HGetValue( hDefs, "MAXVALUE" )
nMinValue := __HGetValue( hDefs, "MINVALUE" )
colorp := __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
@@ -695,12 +694,12 @@ METHOD LineChart() CLASS GDChart
nMax := 0
FOR EACH hElement IN aDataOfHash
IF hElement:__enumIndex() == 1
nMax := hElement["VALUE"]
nMax := hElement[ "VALUE" ]
ELSE
nMax := Max( nMax, hElement["VALUE"] )
nMax := Max( nMax, hElement[ "VALUE" ] )
ENDIF
cLabel := HGetValue( hElement, "LABEL" )
nMaxLabel := Max( nMaxLabel, Len( IIF( cLabel != NIL, cLabel, "" ) ) )
cLabel := __HGetValue( hElement, "LABEL" )
nMaxLabel := Max( nMaxLabel, Len( iif( cLabel != NIL, cLabel, "" ) ) )
NEXT
// Before sum of values to determine percentual
@@ -708,12 +707,12 @@ METHOD LineChart() CLASS GDChart
nMin := 0
FOR EACH hElement IN aDataOfHash
IF hElement:__enumIndex() == 1
nMin := hElement["VALUE"]
nMin := hElement[ "VALUE" ]
ELSE
nMin := Min( nMin, hElement["VALUE"] )
nMin := Min( nMin, hElement[ "VALUE" ] )
ENDIF
cLabel := HGetValue( hElement, "LABEL" )
nMinLabel := Max( nMinLabel, Len( IIF( cLabel != NIL, cLabel, "" ) ) )
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
@@ -807,17 +806,17 @@ METHOD LineChart() CLASS GDChart
// Second,
aPoints := {}
FOR EACH hElement IN aDataOfHash
cLabel := HGetValue( hElement, "LABEL" )
//lFilled := HGetValue( hElement, "FILLED" )
//nExtrude := HGetValue( hElement, "EXTRUDE" )
pTile := HGetValue( hElement, "TILE" )
cLabel := __HGetValue( hElement, "LABEL" )
//lFilled := __HGetValue( hElement, "FILLED" )
//nExtrude := __HGetValue( hElement, "EXTRUDE" )
pTile := __HGetValue( hElement, "TILE" )
//IF nExtrude != NIL
// lExtruded := .T.
//ELSE
// lExtruded := .F.
//ENDIF
colorp := HGetValue( hElement, "COLOR" )
nVal := hElement["VALUE"]
colorp := __HGetValue( hElement, "COLOR" )
nVal := hElement[ "VALUE" ]
nDim := ( ( nVal + abs( nMinValue ) ) / nTotRange ) * nHeight
//DEFAULT lFilled TO .F.
@@ -831,7 +830,7 @@ METHOD LineChart() CLASS GDChart
colorp := gdTiled
ELSE
if HB_ISARRAY( colorp )
colorp := ::SetColor( colorp[1], colorp[2], colorp[3] )
colorp := ::SetColor( colorp[ 1 ], colorp[ 2 ], colorp[ 3 ] )
endif
ENDIF
//::Rectangle( nPosX + nBorder, ::Height() - ( nPosY + nDim ), nPosX + nSize - nBorder, ::Height() - nPosY, lFilled, colorp )
@@ -908,15 +907,10 @@ METHOD CloneDataFrom( oSrc )
::aSeries := AClone( oSrc:aSeries )
::aDataOfHashes := AClone( oSrc:aDataOfHashes )
::hDefs := HB_HClone( oSrc:hDefs )
::hDefs := hb_HClone( oSrc:hDefs )
RETURN Self
STATIC FUNCTION HGetValue( hHash, cKey )
LOCAL nPos
LOCAL xVal
IF hHash != NIL
xVal := IIF( ( nPos := HB_HPos( hHash, cKey )) == 0, NIL, HB_HValueAt( hHash, nPos) )
ENDIF
RETURN xVal
STATIC FUNCTION __HGetValue( hHash, cKey )
RETURN iif( HB_ISHASH( hHash ), hb_HGetDef( hHash, cKey ), NIL )

View File

@@ -50,12 +50,9 @@
*
*/
#include "common.ch"
#include "hbclass.ch"
#include "gd.ch"
#define DEFAULT( x, y ) iif( x == NIL, x := y, )
CREATE CLASS GDImage
PROTECTED:
@@ -143,9 +140,9 @@ CREATE CLASS GDImage
/* 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 )
METHOD SetPixel( x, y, color ) INLINE hb_default( @color, ::pColor ), gdImageSetPixel( ::pImage, x, y, color )
METHOD Line( x1, y1, x2, y2, color ) INLINE hb_default( @color, ::pColor ), gdImageLine( ::pImage, x1, y1, x2, y2, color )
METHOD DashedLine( x1, y1, x2, y2, color ) INLINE hb_default( @color, ::pColor ), gdImageDashedLine( ::pImage, x1, y1, x2, y2, color )
// Functions usefull for polygons
METHOD Polygon( aPoints, lFilled, color )
@@ -161,18 +158,18 @@ CREATE CLASS GDImage
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 Fill( x, y, color ) INLINE hb_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 )
INLINE hb_default( @color, ::pColor ), gdImageFillToBorder( ::pImage, x, y, border, color )
METHOD SetAntiAliased( color ) INLINE hb_default( @color, ::pColor ), gdImageSetAntiAliased( ::pImage, color )
METHOD SetAntiAliasedDontBlend( lDontBlend, color ) ;
INLINE DEFAULT( color, ::pColor ), gdImageSetAntiAliasedDontBlend( ::pImage, color, lDontBlend )
INLINE hb_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 SetStyle( aStyle ) INLINE hb_default( @aStyle, ::aStyles ), gdImageSetStyle( ::pImage, aStyle )
METHOD AddStyle( pColor ) INLINE aAdd( ::aStyles, pColor )
METHOD ResetStyles() INLINE ::aStyles := {}
METHOD StyleLenght() INLINE Len( ::aStyles )
@@ -184,10 +181,10 @@ CREATE CLASS GDImage
/* 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 Alpha( color ) INLINE hb_default( @color, ::pColor ), gdImageAlpha( ::pImage, color )
METHOD Red( color ) INLINE hb_default( @color, ::pColor ), gdImageRed( ::pImage, color )
METHOD Green( color ) INLINE hb_default( @color, ::pColor ), gdImageGreen( ::pImage, color )
METHOD Blue( color ) INLINE hb_default( @color, ::pColor ), gdImageBlue( ::pImage, color )
METHOD Width() INLINE gdImageSx( ::pImage )
METHOD Height() INLINE gdImageSy( ::pImage )
METHOD CenterWidth() INLINE ::Width() / 2
@@ -217,7 +214,7 @@ CREATE CLASS GDImage
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 SayVertical( x, y, cString, color ) INLINE hb_default( @color, ::pColor ), gdImageStringUp( ::pImage, ::pFont, x, y, cString, color )
METHOD SetFontName( cFontName ) INLINE ::cFontName := cFontName
METHOD SetFontPitch( nPitch ) INLINE ::nFontPitch := nPitch
@@ -226,23 +223,23 @@ CREATE CLASS GDImage
nLineSpacing, nCharMap, nResolution )
METHOD SayFreeTypeCircle( x, y, cStringTop, cStringBottom, color, nRadius, nTextRadius, nFillPortion, cFontName, nPitch ) ;
INLINE DEFAULT( color, ::pColor ), gdImageStringFTCircle( ::pImage, x, y, nRadius, ;
INLINE hb_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 GetFontWidth( pFont ) INLINE hb_default( @pFont, ::pFont ), gdFontGetWidth( pFont )
METHOD GetFontHeight( pFont ) INLINE hb_default( @pFont, ::pFont ), gdFontGetHeight( pFont )
METHOD GetFTFontWidth( cFontName, nPitch ) INLINE DEFAULT( cFontName, ::cFontName ), ;
DEFAULT( nPitch, ::nFontPitch ) , ;
METHOD GetFTFontWidth( cFontName, nPitch ) INLINE hb_default( @cFontName, ::cFontName ), ;
hb_default( @nPitch, ::nFontPitch ) , ;
gdImageFTWidth( cFontName, nPitch )
METHOD GetFTFontHeight( cFontName, nPitch ) INLINE DEFAULT( cFontName, ::cFontName ), ;
DEFAULT( nPitch, ::nFontPitch ) , ;
METHOD GetFTFontHeight( cFontName, nPitch ) INLINE hb_default( @cFontName, ::cFontName ), ;
hb_default( @nPitch, ::nFontPitch ) , ;
gdImageFTHeight( cFontName, nPitch )
METHOD GetFTStringSize( cString, cFontName, nPitch ) INLINE DEFAULT( cFontName, ::cFontName ), ;
DEFAULT( nPitch, ::nFontPitch ) , ;
METHOD GetFTStringSize( cString, cFontName, nPitch ) INLINE hb_default( @cFontName, ::cFontName ), ;
hb_default( @nPitch, ::nFontPitch ) , ;
gdImageFTSize( cString, cFontName, nPitch )
/* COLOR HANDLING FUNCTIONS */
@@ -289,70 +286,91 @@ CREATE CLASS GDImage
METHOD Version() INLINE gdVersion()
PROTECTED:
METHOD CloneDataFrom( oSrc )
ENDCLASS
METHOD New( sx, sy ) CLASS GDImage
::Create( sx, sy )
RETURN Self
METHOD PROCEDURE Destruct() CLASS GDImage
IF ::lDestroy
::Destroy()
ENDIF
RETURN
METHOD Polygon( aPoints, lFilled, color ) CLASS GDImage
DEFAULT aPoints TO ::aPoints
DEFAULT lFilled TO .F.
DEFAULT color TO ::pColor
hb_default( @aPoints, ::aPoints )
hb_default( @lFilled, .F. )
hb_default( @color, ::pColor )
IF lFilled
gdImageFilledPolygon( ::pImage, aPoints, color )
ELSE
gdImagePolygon( ::pImage, aPoints, color )
ENDIF
RETURN Self
METHOD OpenPolygon( aPoints, color ) CLASS GDImage
DEFAULT aPoints TO ::aPoints
DEFAULT color TO ::pColor
hb_default( @aPoints, ::aPoints )
hb_default( @color, ::pColor )
gdImageOpenPolygon( ::pImage, aPoints, color )
RETURN Self
METHOD Rectangle( x1, y1, x2, y2, lFilled, color ) CLASS GDImage
DEFAULT lFilled TO .F.
DEFAULT color TO ::pColor
hb_default( @lFilled, .F. )
hb_default( @color, ::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 .F.
DEFAULT color TO ::pColor
DEFAULT nStyle TO gdArc
hb_default( @lFilled, .F. )
hb_default( @color, ::pColor )
hb_default( @nStyle, 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 .F.
DEFAULT color TO ::pColor
hb_default( @lFilled, .F. )
hb_default( @color, ::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()
@@ -364,16 +382,17 @@ METHOD LoadFromFile( cFile ) CLASS GDImage
::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
hb_default( @nSrcX , 0 )
hb_default( @nSrcY , 0 )
hb_default( @nWidth , ::Width() )
hb_default( @nHeight , ::Height() )
hb_default( @nDstX , 0 )
hb_default( @nDstY , 0 )
IF oDestImage == NIL
IF ::IsTrueColor()
@@ -382,18 +401,21 @@ METHOD Copy( nSrcX, nSrcY, nWidth, nHeight, nDstX, nDstY, oDestImage ) CLASS GDI
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()
hb_default( @nSrcX , 0 )
hb_default( @nSrcY , 0 )
hb_default( @nSrcWidth , ::Width() )
hb_default( @nSrcHeight, ::Height() )
hb_default( @nDstX , 0 )
hb_default( @nDstY , 0 )
hb_default( @nDstWidth , ::Width() )
hb_default( @nDstHeight, ::Height() )
IF oDestImage == NIL
IF ::IsTrueColor()
@@ -402,18 +424,21 @@ METHOD CopyResized( nSrcX, nSrcY, nSrcWidth, nSrcHeight, nDstX, nDstY, nDstWidth
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()
hb_default( @nSrcX , 0 )
hb_default( @nSrcY , 0 )
hb_default( @nSrcWidth , ::Width() )
hb_default( @nSrcHeight , ::Height() )
hb_default( @nDstX , 0 )
hb_default( @nDstY , 0 )
hb_default( @nDstWidth , ::Width() )
hb_default( @nDstHeight , ::Height() )
IF oDestImage == NIL
IF ::IsTrueColor()
@@ -422,17 +447,20 @@ METHOD CopyResampled( nSrcX, nSrcY, nSrcWidth, nSrcHeight, nDstX, nDstY, nDstWid
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
hb_default( @nSrcX , 0 )
hb_default( @nSrcY , 0 )
hb_default( @nWidth , ::Width )
hb_default( @nHeight , ::Height )
hb_default( @nDstX , nWidth / 2 )
hb_default( @nDstY , nHeight / 2 )
hb_default( @nAngle , 90 )
IF oDestImage == NIL
IF ::IsTrueColor()
@@ -441,17 +469,20 @@ METHOD CopyRotated( nSrcX, nSrcY, nWidth, nHeight, nDstX, nDstY, nAngle, oDestIm
oDestImage := GDImage():Create( nWidth, nHeight )
ENDIF
ENDIF
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
hb_default( @nSrcX , 0 )
hb_default( @nSrcY , 0 )
hb_default( @nWidth , ::Width )
hb_default( @nHeight , ::Height )
hb_default( @nDstX , 0 )
hb_default( @nDstY , 0 )
hb_default( @nPerc , 100 )
IF oDestImage == NIL
IF ::IsTrueColor()
@@ -460,17 +491,20 @@ METHOD CopyMerge( nSrcX, nSrcY, nWidth, nHeight, nDstX, nDstY, nPerc, oDestImage
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
hb_default( @nSrcX , 0 )
hb_default( @nSrcY , 0 )
hb_default( @nWidth , ::Width )
hb_default( @nHeight , ::Height )
hb_default( @nDstX , 0 )
hb_default( @nDstY , 0 )
hb_default( @nPerc , 100 )
IF oDestImage == NIL
IF ::IsTrueColor()
@@ -479,18 +513,20 @@ METHOD CopyMergeGray( nSrcX, nSrcY, nWidth, nHeight, nDstX, nDstY, nPerc, oDestI
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()
hb_default( @nPerc , 100 )
hb_default( @nSrcX , 0 )
hb_default( @nSrcY , 0 )
hb_default( @nSrcWidth , ::Width() )
hb_default( @nSrcHeight , ::Height() )
IF nPerc < 0
nPerc := 100
@@ -506,6 +542,7 @@ METHOD CopyZoomed( nPerc, nSrcX, nSrcY, nSrcWidth, nSrcHeight ) CLASS GDImage
ELSE
oDestImage := GDImage():Create( nDstWidth, nDstHeight )
ENDIF
gdImageCopyResampled( oDestImage:pImage, ::pImage, nDstX, nDstY, nSrcX, nSrcY, nDstWidth, nDstHeight, nSrcWidth, nSrcHeight )
RETURN oDestImage
@@ -515,7 +552,7 @@ METHOD Rotate( nAngle, lInside ) CLASS GDImage
LOCAL nWidth, nHeight
LOCAL nAngRad := nAngle * PI() / 180
DEFAULT lInside TO .F.
hb_default( @lInside, .F. )
IF !lInside
nWidth := ::Width * cos( nAngRad ) + ::Height * sin( nAngRad )
@@ -620,8 +657,8 @@ METHOD Say( x, y, cString, color, nAlign ) CLASS GDImage
LOCAL nWidth, nLen
LOCAL nPosX
DEFAULT color TO ::pColor
DEFAULT nAlign TO gdAlignLeft
hb_default( @color , ::pColor )
hb_default( @nAlign, gdAlignLeft )
IF nAlign == gdAlignCenter
nWidth := ::GetFontWidth()
@@ -636,6 +673,7 @@ METHOD Say( x, y, cString, color, nAlign ) CLASS GDImage
ENDIF
gdImageString( ::pImage, ::pFont, nPosX, y, cString, color )
RETURN Self
METHOD SayFreeType( x, y, cString, cFontName, nPitch, nAngle, color, nAlign, ;
@@ -643,11 +681,11 @@ METHOD SayFreeType( x, y, cString, cFontName, nPitch, nAngle, color, nAlign, ;
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
hb_default( @nAlign , gdAlignLeft )
hb_default( @color , ::pColor )
hb_default( @cFontName , ::cFontName )
hb_default( @nPitch , ::nFontPitch )
hb_default( @nAngle , ::nFontAngle )
IF nAlign == gdAlignCenter
nWidth := nPitch //gdImageFTWidth( cFontName, nPitch )//, ::Radians( nAngle ) ) //::GetFontWidth()