FiveTech Support Forums

REQUEST HB_CODEPAGE_PTISO

#include "inkey.ch"

PROCEDURE Main()

   Set( _SET_CODEPAGE, "PTISO" )

   fw_SetTruePixel( .T. )

   RunModuleAsThread( { || test_Module() } )
   RunModuleAsThread( { || test_Module() } )

   hb_ThreadWaitForAll()

RETURN

FUNCTION Test_Module()

   LOCAL aCodeList := Array(5), GetList := {}, nCode

   Afill( aCodeList, 0 )

   // aqui eu aciono uma TELA DO FIVEWIN FOR WINDOWS.
   SET KEY K_F9 TO test_browse

   @ 0, 0 SAY ""

   FOR EACH nCode IN aCodeList
      @ Row() + 1, 1 SAY "Code:" GET nCode PICTURE "99999"
   NEXT

   READ

RETURN Nil

PROCEDURE HB_GTSYS

   REQUEST HB_GT_WVG_DEFAULT

RETURN

PROCEDURE Main()

   Set( _SET_CODEPAGE, "PTISO" )
   SET EXCLUSIVE OFF
   fw_SetTruePixel( .T. )
   RunModuleAsThread( { || test_Module() } )
   RunModuleAsThread( { || test_Module() } )
   RunModuleAsThread( { || Test_MBrowse() }, .F. )
   RunModuleAsThread( { || Test_MBrowse() }, .F. )
   RunModuleAsThread( { || Test_MBrowse() }, .F. )
   hb_ThreadWaitForAll()

   RETURN

#include "fivewin.ch"

PROCEDURE Test_MBrowse

   USE dbproduct
   BROWSE()
   CLOSE DATABASES

   RETURN

FUNCTION RunModuleAsThread( bCode, lIsWVG )

   LOCAL pThread

   pThread := hb_ThreadStart( { || RunModule( bCode, lIsWVG ) } )

   RETURN pThread

FUNCTION RunModule( bCode, lIsWVG )

   hb_Default( @lIsWVG, .T. )
   hb_gtReload( "WVG" )
   IF lIsWVG
      SetMode(25,80)
      CLS
   ENDIF
   Eval( bCode )

   RETURN Nil

CLOSE DATABASES

#include "fivewin.ch"

PROCEDURE Test_MBrowse

   USE dbproduct
   BROWSE()
   CLOSE DATABASES

   RETURN

METHOD GridSelection( nType ) CLASS JPCADASTROClass

   LOCAL oTBrowse, cnSQL := ADOLocal()

   hb_Default( @nType, 0 )

   WITH OBJECT cnSQL
      :cSQL := "SELECT IDCADASTRO, CDNOME, CDVENDEDOR, CDAPELIDO, CDUF, CDCIDADE, CDMAPA, CDENDERECO, " + ;
         " CDNUMERO, CDCOMPL, CDCNPJ, JPTABCADSTA.CADSTABLOQUEIO AS STATUS,"  + ;
         " CONCAT_WS( ' ', CDNOME, CDCIDADE, CDENDERECO, CDAPELIDO, CDCNPJ ) AS TEXTOFILTRO" + ;
         " FROM JPCADASTRO " + ;
         " LEFT JOIN JPTABCADSTA ON JPTABCADSTA.IDCADSTA = JPCADASTRO.CDSTATUS "
      IF nType == 2
         :cSQL += " INNER JOIN JPPRECO ON IDCADASTRO=PCCADASTRO"
      ELSEIF nType == 3
         :cSQL += " LEFT JOIN JPPRECOFIL AS MATRIZ ON IDCADASTRO=MATRIZ.PFCADMATRIZ" + ;
            " LEFT JOIN JPPRECOFIL AS FILIAL ON IDCADASTRO=FILIAL.PFCADFILIAL"
      ENDIF
      :cSQL += " WHERE 1=1"
      IF AppUserLevel() > 1 .AND. ! Empty( ::cDataFilter )
         :cSQL += " AND " + ::cDataFilter
      ENDIF
      IF nType == 3
         :cSQL += " AND MATRIZ.PFCADMATRIZ IS NULL" + ;
            " AND FILIAL.PFCADFILIAL IS NULL"
      ENDIF
      :cSQL += " ORDER BY CDNOME"
      :Execute()
      oTBrowse := { ;
         { " ", { || iif( ! cnSQL:String( "STATUS", 1 ) $ "01", " ", Chr(2) ) }, ;
            { || iif( cnSQL:String( "STATUS", 1 ) == "0", { 7,1 }, ;
            iif( cnSQL:String( "STATUS", 1 ) == "1", { 8,1 }, { 9, 1 } ) ) }, ;
         ;
         ; // { || iif( cnSQL:String( "STATUS", 1 ) == "0", ">>", ;
         ; //   iif( cnSQL:String( "STATUS", 1 ) == "1", ">", " " ) ) } }, ;
         ;
         { ||  iif( ! cnSQL:String( "STATUS", 1 ) == "0", 0, ;
         iif( cnSQL:String( "STATUS", 1 ) == "1", 4, 5 ) ) }, ;
         { "icoball1", "icoball2", "icoball3", "icoball4", "icoball5" } }, ;
         { "NOME",        { || cnSQL:String( "CDNOME", 40 ) } }, ;
         { "APELIDO",     { || cnSQL:String( "CDAPELIDO", 20 ) } }, ;
         { "CÓDIGO",      { || Str( cnSQL:Number( "IDCADASTRO" ), 6 ) } }, ;
         { "UF",          { || cnSQL:String( "CDUF", 2 ) } }, ;
         { "CIDADE",      { || cnSQL:String( "CDCIDADE", 21 ) } }, ;
         { "REF.MAPA",    { || cnSQL:String( "CDMAPA", 30 ) } }, ;
         { "ENDEREÇO",    { || cnSQL:String( "CDENDERECO", 40 ) } }, ;
         { "NÚMERO",      { || cnSQL:String( "CDNUMERO", 10 ) } }, ;
         { "COMPLEMENTO", { || cnSQL:String( "CDCOMPL", 20 ) } }, ;
         { "CNPJ",        { || cnSQL:String( "CDCNPJ", 18 ) } } }
      BrowseADO( @cnSQL, oTBrowse, "TEXTOFILTRO", { || StrZero( cnSQL:Number( "IDCADASTRO" ), 6 ) }, , 1, { "STATUS <> '0'", "" } )
      :CloseRecordset()
   ENDWITH

   RETURN Nil

FUNCTION BrowseADO( cnSQL, oTBrowse, cFilterKey, bKeyboard, bUserFunction, nFixToCol, aADOFilterList, aBtnList )

   LOCAL nTop := 5, nLeft := 0, nBottom, nRight, cColorAnt := SetColor()
   LOCAL oFrm, cKeyboard, cOption, pThread, x

   x := xFrmName

   IF AppUserLevel() == 0
      pThread := ;
         hb_ThreadStart( { || ;
            hb_gtReload( "WVG" ), ;
            CreatePubMT( x ), ;
            cKeyboard := FWBrowseADO( @cnSQL, @oTBrowse, cFilterKey, bKeyboard, bUserFunction, ;
               nFixToCol, aAdoFilterList, aBtnList ), ;
            PostQuitMessage(0) } )
      DO WHILE hb_ThreadWait( pThread, 0.1, .T. ) != 1
         Inkey(0.3)
         //SysWait(0.3)
      ENDDO
      IF ! Empty( cKeyboard )
         KEYBOARD cKeyboard + Chr(13)
      ENDIF
      RETURN Nil
   ENDIF
   IF aADOFilterList == Nil
      aADOFilterList := { "" }
   ELSEIF ValType( aADOFilterList ) == "C"
      aADOFilterList := { "", aADOFilterList }
   ENDIF
...

#include "frm_class.ch"
#include "fivewin.ch"
#include "colors.ch"
#include "inkey.ch"

MEMVAR xFrmName

FUNCTION fwBrowseADO( cnSQL, oTbrowse, cFilterKey, bKeyboard, bUserFunction, nFixToCol, ;
   aADOFilterList, aBtnList )

   LOCAL xDlg, xControl, aItem, oCol, cFilter := "", nADOFilterPos := 1
   LOCAL xBtnExit, xBtnFilter, cKeyboard
   LOCAL xLabel, nCol := 10, cIcon, lWithIcon := .F.
   LOCAL nDlgWidth, nDlgHeight

   nDlgWidth  := AppWindowRect()[3]
   nDlgHeight := AppWindowRect()[4]
   IF aADOFilterList == Nil
      aADOFilterList := { "" }
   ELSEIF ValType( aADOFilterList ) == "C"
      aADOFilterList := { "", aADOFilterList }
   ENDIF
   IF aBtnList == Nil
      aBtnList := {}
   ENDIF
   IF Len( aADOFilterList ) != 0
      ADOFilter( cnSQL, cFilterkey, cFilter, aADOFilterList, nADOFilterPos )
   ENDIF
   DEFINE DIALOG xDlg FROM 0, 0 TO nDlgHeight, nDlgWidth PIXEL ;
      TITLE "browse" COLOR COLOR_LIGHTGRAY

   @ 70, 10 XBROWSE xControl ;
      ARRAY Array(10) ;
      SIZE nDlgWidth - 24, nDlgHeight - 80 PIXEL ;
      OF xDlg ;
      ON DBLCLICK ( (nRow), (nCol), (nFlags), FWBrowseENTER( xDlg, xControl, cnSQL, bKeyboard, @cKeyboard ) )

   WITH OBJECT xControl
      :xUserData  := cnSQL
      :xUserValue := :xUserData:RecordCount()
      :nArrayAt   := 1
   ENDWITH
   FOR EACH aItem IN oTBrowse
      oCol := xControl:AddCol()
      IF Len( aItem ) > 4
         lWithIcon := .T.
         FOR EACH cIcon IN aItem[ 5 ]
            oCol:AddResource( cIcon )
         NEXT
      ENDIF
      oCol:cHeader := aItem[ 1 ]
      IF Len( aItem ) < 4
         oCol:bStrData := aItem[ 2 ]
      ELSEIF Len( aItem ) == 4
         oCol:bStrData := aItem[ 4 ]
      ELSE
         oCol:bBmpData      := aItem[ 4 ]
         oCol:nWidth        := 16
      ENDIF
   NEXT
   WITH OBJECT xControl
      IF lWithIcon
         :nRowHeight := 16
      ENDIF
      :bOnSkip        := { || xControl:xUserData:Move( xControl:nArrayAt - 1, 1 ) }
      :SetArray( Array( xControl:xUserData:RecordCount() ) )
      :lFitGridHeight := .T. // adjust extra space to header/footer
      :bClrStd        := { || { CLR_BLACK, iif( Mod( cnSQL:AbsolutePosition, 2 ) == 0, CLR_WHITE, RGB(179,207,231) ) } }
      :bClrSel                 := {|| { CLR_WHITE, RGB(30,144,255) } } //cor da barra de seleção sem foco
      :bClrSelFocus            := {|| { CLR_WHITE, CLR_HBLUE } }       //cor da barra de seleção com foco
      :nMarqueeStyle  := 8
      //:lRecordSelector         := .f.                             //mostrar seta da posição da linha
      :CreateFromCode()
      :bKeyDown := { | nKey | FWBrowseKey( xDlg, xControl, nKey, cnSQL, ;
         @cFilter, @cFilterKey, @aADOFilterList, @nADOFilterPos, xLabel, bKeyboard, @cKeyboard ) }
   ENDWITH
   IF Len( aADOFilterList ) != 0
      ADOFilter( cnSQL, cFilterkey, cFilter, aADOFilterList, nADOFilterPos )
      IF Len( aADOFilterList ) > 1
         @ 10, nCol BUTTONBMP xBtnFilter PROMPT "Filtro" OF xDlg ;
            SIZE 50, 50 PIXEL RESOURCE "icoFilter" TOP ;
               ACTION FilterClick( xControl, xControl:xUserData, cFilterKey, @cFilter, aADOFilterList, @nADOFilterPos )
         nCol += 55
      ENDIF
   ENDIF
   @ 10, nCol BUTTONBMP xBtnExit PROMPT "Sair" OF xDlg ;
      SIZE 50, 50 PIXEL RESOURCE "IcoDoor" TOP ACTION xDlg:End()
   nCol += 55

   @ 10, nCol SAY xLabel VAR cFilter OF xDlg PIXEL ;
      SIZE 500, 25 COLOR CLR_BLUE TRANSPARENT BORDER

   ACTIVATE DIALOG xDlg CENTERED

   (oCol); (xBtnExit); (xBtnFilter); (bKeyboard); (bUserFunction); (nFixToCol)

   RETURN cKeyboard

STATIC FUNCTION FilterClick( xControl, cnSQL, cFilterKey, cFilter, aADOFilterList, nADOFilterPos )

   IF nADOFilterPos < Len( aADOFilterList )
      nADOFilterPos += 1
   ELSE
      nADOFilterPos := 1
   ENDIF
   ADOFilter( cnSQL, cFilterKey, cFilter, aADOFilterList, nADOFilterPos )
   xControl:SetArray( Array( cnSQL:RecordCount() ) )
   xControl:Refresh()
   xControl:SetFocus()

   RETURN Nil

FUNCTION FWBrowseEnter( xDlg, xControl, cnSQL, bKeyboard, cKeyboard )

   IF bKeyBoard != Nil
      cKeyboard := Eval( bKeyboard )
   ENDIF
   xDlg:End()
   (xControl); (cnSQL)

   RETURN Nil

FUNCTION FWBrowseKey( xDlg, xControl, nKey, cnSQL, cFilter, cFilterKey, aADOFilterList, ;
   nADOFilterPos, xLabel, bKeyboard, cKeyboard )

   DO CASE
   CASE nKey == VK_RETURN
      IF bKeyboard != Nil
         cKeyboard := Eval( bKeyboard )
      ENDIF
      xDlg:End()
   CASE nKey == K_BS .AND. cFilterKey != NIL
      IF Len( cFilter ) < 2
         cFilter := ""
         ADOFilter( cnSQL, cFilterKey, cFilter, aADOFilterList, nADOFilterPos )
      ELSE
         cFilter := iif( Len( cFilter ) == 0, "", Left( cFilter, Len( cFilter ) - 1 ) )
         ADOFilter( cnSQL, cFilterkey, cFilter, aADOFilterList, nADOFilterPos )
      ENDIF
      xControl:SetArray( Array( cnSQL:RecordCount() ) )
      xLabel:Varput( cFilter )
      xLabel:Refresh()
      xControl:Refresh()
   CASE IsRange( nKey, 32, 127 ) .AND. cFilterKey != NIL .AND. cnSQL:RecordCount() != 0
      IF Chr( nKey ) $ ['/*]
         nKey := 32
      ENDIF
      cFilter += Upper( Chr( nKey ) )
      IF ! ADOFilter( cnSQL, cFilterKey, cFilter, aADOFilterList, nADOFilterPos )
         cFilter := Left( cFilter, Len( cFilter ) - 1 )
         IF Len( cFilter ) == 0
            cnSQL:Filter( "" )
         ELSE
            ADOFilter( cnSQL, cFilterKey, cFilter, aADOFilterList, nADOFilterPos )
         ENDIF
      ENDIF
      xControl:SetArray( Array( cnSQL:RecordCount() ) )
      xLabel:Varput( cFilter )
      xLabel:Refresh()
      xControl:Refresh()
   ENDCASE

   RETURN Nil

STATIC FUNCTION ADOFilter( cnSQL, cFilterKey, cFilter, aADOFilterList, nADOFilterPos )

   cnSQL:Filter( ADOStringFilter( cFilterKey, cFilter, aADOFilterList, nADOFilterPos ) )

   RETURN ! cnSQL:Eof()

         MenuOption( "Testes Aplicativo" )
            MenuDrop()
            MenuOption( "Manual Imprimir",  "ZE_HELPPRINT" )
            MenuOption( "Mensagem balloon", "PTESBALLOON" )
            MenuOption( "dlgautofivewin", "DLGAUTOFIVEWIN", { || dlgauto() } )
            MenuOption( "dlgautohwgui", "DLGAUTOHWGUI", { || dlgauto() } )
            //MenuOption( "dlgautohmge", "DLGAUTOHMGE", { || dlgauto() } )
            //MenuOption( "dlgautoHMG3", "DLGAUTOHMG3", { || dlgauto() } )
            //MenuOption( "dlgautoOOHG", "DLGAUTOOOHG", { || dlgauto() } )
            MenuUnDrop()

FUNCTION DoPrg( cModule, cTitulo, p1, p2, p3 ) // tem módulo que utiliza p1

   LOCAL mHrInic, nGT
   PRIVATE xFrmName

   xFrmName := cModule
   IF Upper( Left( xFrmName, 7 ) ) == "DLGAUTO"
      xFrmName := Upper( xFrmName )
      hb_gtReload( "WVG" )
      AppInitSets(0) // sem tela
      DO CASE
      CASE xFrmName == "DLGAUTOFIVEWIN" ; oGui := FIVEWINClass():New()
      CASE xFrmName == "DLGAUTOHWGUI" ;   oGUI := HWGUIClass():New()
      //CASE xFrmName == "DLGAUTOHMGE" ;    oGUI := HMGECLASS():New()
      //CASE xFrmName == "DLGAUTOHMG3" ;    oGUI := HMG3Class():New()
      //CASE xFrmName == "DLGAUTOOOHG" ;    oGUI := OOHGClass():New()
      ENDCASE
      Do( "DLGAUTO", P1, P2, P3 )
      PostQuitMessage(0)
      RETURN Nil
   ENDIF

   nGT := hb_gtReload( "WVG" ) // hb_gtInfo( HB_GTI_VERSION )
   //HB_GtInfo( HB_GTI_WINTITLE, cTitulo )
   AppInitSets()
   // oStatusbar := wvgStatusBar():New( wvgSetAppWindow(), , , { -2, -2 } , , .T. ):Create()
   SetColor( SetColorNormal() )
   CLS
   SayTitulo( cTitulo )
   @ MaxRow() - 2, 0 TO MaxRow() - 2, MaxCol() COLOR SetColorTraco()
   mHrInic := Time()
   Do( cModule, p1, p2, p3 )
   LogDeUso( mHrInic, cModule )
   // exit procedure of wvg
   (nGt)
   nGT := Nil
   (nGT)
   wvgSetAppWindow():Destroy()
   //  HB_SYMBOL_UNUSED( oStatusbar )
   IF AppIsMultithread()
      PostQuitMessage(0)
   ENDIF

   RETURN Nil

PATH=d:\harbour\bin;d:\harbour\comp\mingw32\bin;d:\tools\util

mt=yes
gui=yes
strip=yes
fullstatic=yes
PRGFLAGS=-m -n -w3 -es2 -ge1 -DMT_EXPERIMENTAL -DHB_NO_GTGUI=YES
libpaths=d:/fontes/integra/libjpa
libpaths=d:/fontes/integra/boletoclass
libpaths=d:/fontes/integra/sefazclass
libpaths=d:/github/rmchartclass
libpaths=d:/github/wvgtest
libpaths=d:/github/hwgui
libpaths=d:/github/oohg
libpaths=d:/github/hmge
libpaths=d:/github/hmg3
libpaths=d:/github/fivewin
#harbour 3.4 only
#autohbcs=fivewin.ch:fivewin.hbc
#autohbcs=hwgui.ch:hwgui.hbc
#autohbcs=oohg.ch:oohg.hbc
#autohbcs=gtwvg.ch:gtwvg.hbc

incpaths=include

libpaths=lib
{mingw}libs=dummy
{mingw}libs=fivehg
{mingw}libs=fivehgc

{mingw}libs=user32 winspool kernel32 comctl32 comdlg32 gdi32 gdiplus ole32
{mingw}libs=oleaut32 psapi oledlg mfcuia32 msimg32 win32k stdc++ version
{mingw}libs=uuid winmm vfw32 wsock32
{mingw}libs=uxtheme

libs=hbwin.hbc
libs=xhb.hbc
libs=hbct.hbc
libs=hbmzip.hbc
libs=hbziparc.hbc

*.prg
libjpa/prg/*.prg
#d:\github\fivewin\source\winapi\instance.c
#PostQuitMessage(0) on errorsys
jpa.rc
topnfe/*.prg

-ojpa

#force harbour debug
-lforcedebug

## force libjpa
-Llibjpa
libjpa.hbc
-llibjpa

-DDLGAUTO_AS_LIB
-DDLGAUTO_AS_SQL
-Id:\github\dlgauto\source

d:\github\dlgauto\source\frm*.prg
d:\github\dlgauto\source\test.prg
d:\github\dlgauto\source\test_loadsetup.prg

d:\github\dlgauto\source\lib_hwgui.prg
hwgui.hbc

d:\github\dlgauto\source\lib_fivewin.prg
d:\github\fivewin\source\classes\xbrowse.prg
d:\github\fivewin\source\function\checkres.prg
fivewin.hbc

#d:\github\dlgauto\source\lib_hmge.prg
#hmge.hbc

#d:\github\dlgauto\source\lib_hmg3.prg
#hmg3.hbc

#d:\github\dlgauto\source\lib_oohg.prg
#oohg.hbc

-i.
-i..\build

boletoclass.hbc
rmchartclass.hbc
sefazclass.hbc
wvgtest.hbc
gtwvg.hbc

hbct.hbc

-workdir=c:/temp
-m -n -w3 -es2 -q -ge1
-quiet
-inc
-strip
-mt
-gui
-compr

   LOCAL cnSQL := ADOClass():New( AppConexao() )
...
CREATE CLASS ADOClass

   VAR cn
   VAR rs
   ...
   METHOD New( oConnection )           INLINE ::cn := oConnection, Self
   METHOD RecordCount()                INLINE iif( ::Rs == Nil, 0, ::Rs:RecordCount() )
   METHOD MoveFirst()                  INLINE iif( ::RecordCount() == 0, Nil, ::Rs:MoveFirst() )
   METHOD Date( xField )
   METHOD Value( xField )
   METHOD String( xField, nLen )
   METHOD Number( xField, nLen, nDec )
   ...