xbrowse No existe el metodo: LREADONLY

xbrowse No existe el metodo: LREADONLY

Postby albeiroval » Fri Mar 01, 2024 4:20 pm

Buenos dias.

Estoy usando un xbrowse en un dialogo modal para mostrar un array que genero desde "C" y actualizar
los datos con un boton "Cargar".

Cuando hago click al boton "Cargar" me trae los datos y los muestra, pero cuando hago click en "Salir" o en el Boton "Cargar" nuevamente, me genera un GPF.

Dejo aqui los archivos error.log y hb_out.log y el codigo PRG que uso, tambien dejo la funcion que crea el array desde "C".

Archivo error.log
Code: Select all  Expand view  RUN

Application
===========
   Path and name: E:\Biometrico\WinFS84.exe (32 bits)
   Size: 6,490,112 bytes
   Compiler version: Harbour 3.2.0dev (r2104281802)
   FiveWin  version: FWH 23.07
   C compiler version: Borland/Embarcadero C++ 7.6 (32-bit)
   Windows 11 64 Bits, version: 6.2, Build 9200

   Time from start: 0 hours 0 mins 9 secs
   Error occurred at: 29/02/2024, 17:55:07
   Error description: Error BASE/1004  No existe el m‚todo: LREADONLY
   Args:
     [   1] = U  

Stack Calls
===========
   Called from:  => LREADONLY( 0 )
   Called from: .\source\classes\XBROWSE.PRG => TXBRWCOLUMN:VALUE( 13576 )
   Called from: .\source\classes\XBROWSE.PRG => (b)TXBRWCOLUMN( 12914 )
   Called from: .\source\classes\XBROWSE.PRG => TXBRWCOLUMN:CEDITPICTURE( 0 )
   Called from: .\source\classes\XBROWSE.PRG => TXBRWCOLUMN:ADJUST( 13291 )
   Called from: E:\Proyectos\Lib\harbour\Source\prg\class_extensions.prg => TXBROWSE:ADJUST( 0 )
   Called from: .\source\classes\XBROWSE.PRG => TXBROWSE:SETARRAY( 6348 )
   Called from: E:\Proyectos\Software\Futronic_FS84\source\prg\tfutronic.prg => GETUSUARIOS_FS84( 501 )
   Called from: E:\Proyectos\Software\Futronic_FS84\source\prg\tfutronic.prg => (b)TFUTRONIC_DLGLISTAUSER( 354 )
   Called from: .\source\classes\BTNBMP.PRG => TBTNBMP:CLICK( 792 )
   Called from: .\source\classes\BTNBMP.PRG => TBTNBMP:LBUTTONUP( 1083 )
   Called from: .\source\classes\CONTROL.PRG => TCONTROL:HANDLEEVENT( 1847 )
   Called from: .\source\classes\BTNBMP.PRG => TBTNBMP:HANDLEEVENT( 2135 )
   Called from: .\source\classes\WINDOW.PRG => _FWH( 3693 )
   Called from:  => DIALOGBOX( 0 )
   Called from: .\source\classes\DIALOG.PRG => TDIALOG:ACTIVATE( 307 )
   Called from: E:\Proyectos\Software\Futronic_FS84\source\prg\tfutronic.prg => TFUTRONIC:DLGLISTAUSER( 383 )
   Called from: E:\Proyectos\Software\Futronic_FS84\source\prg\testfs84.prg => (b)TFAMTEST_TESTFAM_FS84( 156 )
   Called from: .\source\classes\BTNBMP.PRG => TBTNBMP:CLICK( 792 )
   Called from: .\source\classes\BTNBMP.PRG => TBTNBMP:LBUTTONUP( 1083 )
   Called from: .\source\classes\CONTROL.PRG => TCONTROL:HANDLEEVENT( 1847 )
   Called from: .\source\classes\BTNBMP.PRG => TBTNBMP:HANDLEEVENT( 2135 )
   Called from: .\source\classes\WINDOW.PRG => _FWH( 3693 )
   Called from:  => DIALOGBOX( 0 )
   Called from: .\source\classes\DIALOG.PRG => TDIALOG:ACTIVATE( 307 )
   Called from: E:\Proyectos\Software\Futronic_FS84\source\prg\testfs84.prg => TFAMTEST:TESTFAM_FS84( 190 )
   Called from: E:\Proyectos\Software\Futronic_FS84\source\prg\testfs84.prg => TFAMTEST:NEW( 58 )
   Called from: E:\Proyectos\Software\Futronic_FS84\source\prg\taplication.prg => TAPLICATION:TESTFAMFUTRONIC( 628 )
   Called from: E:\Proyectos\Software\Futronic_FS84\source\prg\mainfgr.prg => (b)CREATEBUTTONBAR( 287 )
   Called from: .\source\classes\BTNBMP.PRG => TBTNBMP:CLICK( 792 )
   Called from: .\source\classes\BTNBMP.PRG => TBTNBMP:LBUTTONUP( 1083 )
   Called from: .\source\classes\CONTROL.PRG => TCONTROL:HANDLEEVENT( 1847 )
   Called from: .\source\classes\BTNBMP.PRG => TBTNBMP:HANDLEEVENT( 2135 )
   Called from: .\source\classes\WINDOW.PRG => _FWH( 3693 )
   Called from:  => WINRUN( 0 )
   Called from: .\source\classes\WINDOW.PRG => TWINDOW:ACTIVATE( 1118 )
   Called from: E:\Proyectos\Software\Futronic_FS84\source\prg\mainfgr.prg => BUTTONBARMAIN( 172 )
   Called from: E:\Proyectos\Software\Futronic_FS84\source\prg\mainfgr.prg => MAIN( 135 )

System
======
   CPU type: Intel(R) Core(TM) i5-7440HQ CPU @ 2.80GHz 2808 Mhz
   Hardware memory: 16266 megs

   Free System resources: 90 %
        GDI    resources: 90 %
        User   resources: 90 %

   Windows total applications running: 6
      1 , C:\WINDOWS\WinSxS\x86_microsoft.windows.common-controls_6595b64144ccf1df_6.0.22000.120_none_e541a94
      2 , E:\Biometrico\FTRAPI.DLL                                                                            
      3 , E:\Biometrico\WinFS84.exe                                                                          
      4 DDE Server Window, C:\WINDOWS\System32\OLE32.DLL                                                                      
      5 DPM,                                                                                                    
      6 GDI+ Window (WinFS84.exe), C:\WINDOWS\WinSxS\x86_microsoft.windows.gdiplus_6595b64144ccf1df_1.1.22000.2003_none_93fcfb98d9f105

Variables in use
================
   Procedure     Type   Value
   ==========================
   LREADONLY
     Param   1:    O    Class: ERROR
   TXBRWCOLUMN:VALUE
     Local   1:    U    
     Local   2:    U    
   (b)TXBRWCOLUMN
     Local   1:    U    
     Local   2:    U    
     Local   3:    N    1
   TXBRWCOLUMN:CEDITPICTURE
     Param   1:    O    Class: TXBRWCOLUMN
     Local   1:    S    @XEVAL()
     Local   2:    U    
     Local   3:    B    {|| ... }
   TXBRWCOLUMN:ADJUST
   TXBROWSE:ADJUST
     Local   1:    O    Class: TXBRWCOLUMN
     Local   2:    U    
     Local   3:    U    
     Local   4:    U    
     Local   5:    U    
   TXBROWSE:SETARRAY
     Local   1:    O    Class: TXBROWSE
     Local   2:    N    5
     Local   3:    N    7
     Local   4:    N    0
     Local   5:    U    
     Local   6:    U    
     Local   7:    U    
     Local   8:    U    
   GETUSUARIOS_FS84
     Param   1:    A    Len:    2
     Local   1:    L    .F.
     Local   2:    U    
     Local   3:    U    
     Local   4:    U    
     Local   5:    O    Class: TXBROWSE
     Local   6:    U    
     Local   7:    C    "0"
     Local   8:    U    
     Local   9:    U    
     Local  10:    L    .F.
     Local  11:    U    
     Local  12:    U    
     Local  13:    U    
     Local  14:    U    
     Local  15:    U    
     Local  16:    U    
     Local  17:    L    .T.
   (b)TFUTRONIC_DLGLISTAUSER
     Param   1:    A    Len:    2
     Param   2:    O    Class: TXBROWSE
     Local   1:    N    3
     Local   2:    N    2
   TBTNBMP:CLICK
     Param   1:    O    Class: TBTNBMP
   TBTNBMP:LBUTTONUP
   TCONTROL:HANDLEEVENT
     Param   1:    N    8
     Param   2:    N    39
     Param   3:    N    0
     Local   1:    L    .T.
     Local   2:    N    0
     Local   3:    S    @CLICK()
   TBTNBMP:HANDLEEVENT
     Param   1:    N    514
     Param   2:    N    0
     Param   3:    N    524327
     Local   1:    U    
   _FWH
     Param   1:    N    514
     Param   2:    N    0
     Param   3:    N    524327
   DIALOGBOX
     Param   1:    N    524327
     Param   2:    N    514
     Param   3:    N    0
     Param   4:    N    524327
     Param   5:    N    54
     Local   1:    O    Class: TBTNBMP
   TDIALOG:ACTIVATE
     Param   1:    N    4194304
     Param   2:    C    "LISTA_USERS"
     Param   3:    N    921024
     Param   4:    O    Class: TDIALOG
   TFUTRONIC:DLGLISTAUSER
     Param   1:    U    
     Param   2:    U    
     Param   3:    U    
     Param   4:    L    .T.
     Param   5:    B    {|| ... }
     Param   6:    L    .T.
     Param   7:    U    
     Param   8:    U    
     Param   9:    U    
     Param  10:    U    
     Param  11:    U    
     Param  12:    L    .F.
     Param  13:    O    Class: TDIALOG
     Param  14:    U    
     Local   1:    N    921024
     Local   2:    S    @_NRESULT()
     Local   3:    O    Class: TDIALOG
   (b)TFAMTEST_TESTFAM_FS84
     Local   1:    L    .F.
     Local   2:    O    Class: TDIALOG
     Local   3:    O    Class: TXBROWSE
     Local   4:    O    Class: TFONT
     Local   5:    A    Len:    7
     Local   6:    O    Class: TSAY
     Local   7:    A    Len:    2
     Local   8:    A    Len:    3
     Local   9:    L    .F.
   TBTNBMP:CLICK
     Param   1:    O    Class: TBTNBMP
   TBTNBMP:LBUTTONUP
   TCONTROL:HANDLEEVENT
     Param   1:    N    15
     Param   2:    N    45
     Param   3:    N    0
     Local   1:    L    .T.
     Local   2:    N    0
     Local   3:    S    @CLICK()
   TBTNBMP:HANDLEEVENT
     Param   1:    N    514
     Param   2:    N    0
     Param   3:    N    983085
     Local   1:    U    
   _FWH
     Param   1:    N    514
     Param   2:    N    0
     Param   3:    N    983085
   DIALOGBOX
     Param   1:    N    983085
     Param   2:    N    514
     Param   3:    N    0
     Param   4:    N    983085
     Param   5:    N    31
     Local   1:    O    Class: TBTNBMP
   TDIALOG:ACTIVATE
     Param   1:    N    4194304
     Param   2:    C    "PRUEBAS_FS84"
     Param   3:    N    2362664
     Param   4:    O    Class: TDIALOG
   TFAMTEST:TESTFAM_FS84
     Param   1:    U    
     Param   2:    U    
     Param   3:    U    
     Param   4:    L    .T.
     Param   5:    B    {|| ... }
     Param   6:    L    .T.
     Param   7:    B    {|| ... }
     Param   8:    U    
     Param   9:    U    
     Param  10:    U    
     Param  11:    U    
     Param  12:    L    .F.
     Param  13:    O    Class: TDIALOG
     Param  14:    U    
     Local   1:    N    2362664
     Local   2:    S    @_NRESULT()
     Local   3:    O    Class: TDIALOG
   TFAMTEST:NEW
     Local   1:    O    Class: TDIALOG
     Local   2:    O    Class: TFAMTEST
     Local   3:    A    Len:   16
     Local   4:    L    .F.
   TAPLICATION:TESTFAMFUTRONIC
     Local   1:    O    Class: TFAMTEST
   (b)CREATEBUTTONBAR
     Local   1:    S    @_OFINGER()
     Local   2:    O    Class: TAPLICATION
   TBTNBMP:CLICK
     Param   1:    O    Class: TBTNBMP
   TBTNBMP:LBUTTONUP
   TCONTROL:HANDLEEVENT
     Param   1:    N    55
     Param   2:    N    60
     Param   3:    N    0
     Local   1:    L    .T.
     Local   2:    N    0
     Local   3:    S    @CLICK()
   TBTNBMP:HANDLEEVENT
     Param   1:    N    514
     Param   2:    N    0
     Param   3:    N    3604540
     Local   1:    U    
   _FWH
     Param   1:    N    514
     Param   2:    N    0
     Param   3:    N    3604540
   WINRUN
     Param   1:    N    3604540
     Param   2:    N    514
     Param   3:    N    0
     Param   4:    N    3604540
     Param   5:    N    15
     Local   1:    O    Class: TBTNBMP
   TWINDOW:ACTIVATE
     Param   1:    N    2362664
   BUTTONBARMAIN
     Param   1:    C    "MAXIMIZED"
     Param   2:    U    
     Param   3:    U    
     Param   4:    U    
     Param   5:    U    
     Param   6:    U    
     Param   7:    B    {|| ... }
     Param   8:    B    {|| ... }
     Param   9:    U    
     Param  10:    U    
     Param  11:    U    
     Param  12:    U    
     Param  13:    U    
     Param  14:    U    
     Param  15:    U    
     Param  16:    U    
     Param  17:    U    
     Param  18:    U    
     Param  19:    U    
     Param  20:    L    .F.
     Local   1:    O    Class: TWINDOW
     Local   2:    U    
     Local   3:    U    
   MAIN
     Param   1:    O    Class: TAPLICATION
     Local   1:    O    Class: TFONT
     Local   2:    U    
     Local   3:    A    Len:   14

Linked RDDs
===========
   DBF
   DBFFPT
   DBFBLOB
   DBFCDX
   DBFNTX

DataBases in use
================

Classes in use:
===============
     1 ERROR
     2 HBCLASS
     3 HBOBJECT
     4 TDOLPHINQRY
     5 TWINDOW
     6 TCONTROL
     7 TXBROWSE
     8 TXBRWCOLUMN
     9 TCOMBOBOX
    10 TMULTIGET
    11 TGET
    12 TAPLICATION
    13 TINI
    14 TMYSQLSERVER
    15 TBRUSH
    16 TDIALOG
    17 TFONT
    18 TREG32
    19 TRECT
    20 TDOLPHINSRV
    21 TUSUARIOS
    22 TICON
    23 TMSGBAR
    24 TMSGITEM
    25 TTIMER
    26 TBAR
    27 TBTNBMP
    28 TXIMAGE
    29 TCLIPBOARD
    30 TFAMTEST
    31 TFUTRONIC
    32 TSAY
    33 TSCROLLBAR
    34 TSTRUCT

Memory Analysis
===============
      889 Static variables

   Dynamic memory consume:
      Actual  Value:    2490368 bytes
      Highest Value:    2490368 bytes

 


Archivo hb_out.log
Code: Select all  Expand view  RUN

Application Internal Error - E:\Biometrico\WinFS84.exe
Terminated at: 2024-02-29 16:42:20
Error irrecuperable 6005: Exception error:

    Exception Code:C0000005 ACCESS_VIOLATION
    Exception Address:005AC747
    EAX:0562ADFC  EBX:00060000  ECX:03DB035C  EDX:00983148
    ESI:0562ADFC  EDI:00983150  EBP:0019E56C
    CS:EIP:0023:005AC747  SS:ESP:002B:0019E568
    DS:002B  ES:002B  FS:0053  GS:002B
    Flags:00210202
    Exception Parameters: 00000001 00060004
    CS:EIP: 89 4B 04 3B 02 75 0C 8B CB 89 0A 3B C1 75 04 33
    SS:ESP: 01255AE4 0019E588 005ACCE1 00983148 0562ADFC 00750CD5 00000000 009ECB3C 0019E5AC 005ACE39 00000001 00594FF4 0000008D 00000000 01255FAC 00000000

    C stack:
    EIP:     EBP:       Frame: OldEBP, RetAddr, Params...
    005AC747 0019E56C   0019E588 005ACCE1 00983148 0562ADFC 00750CD5 00000000 009ECB3C
    005ACCE1 0019E588   0019E5AC 005ACE39 00000001 00594FF4 0000008D 00000000 01255FAC 00000000 00000000
    005ACE39 0019E5AC   0019E6C0 0058ED7B 00000000 006A4935 00000000 006A4670 002F0B68 0019E5F4 767C7CD2 002F0B68
    0058ED7B 0019E6C0   0019E6D0 004C6260 00750C52 0074D284
    004C6260 0019E6D0   0019E6F0 005951B1 009ECB3C 0000008A 00000000 01255FAC 019B0010 00000301
    005951B1 0019E6F0   0019E804 0058EEBC 00000000 009ECB3C FFFFFFFE 01254814 00000000 00000215 00000000 0019E728
    0058EEBC 0019E804   0019E83C 0059536D 006A4927 006A3F40 0071D27F 00000000 00719360 005951B1 009ECB3C 00000088
    0059536D 0019E83C   0019E950 0058EEBC 00000001 0071DDD4 00000000 00719D50 002F0B68 80006010 01201348 00000000
    0058EEBC 0019E950   0019E960 004C3A00 0071D224 00718F60
    004C3A00 0019E960   0019E980 005951B1 009ECB3C 00000080 00000000 02A37D2C 0247001B 00000318
    005951B1 0019E980   0019EA94 0058EEBC 00000000 0073820B 00000000 00733638 0019E9AC 02ADB2B4 03E05BDC 03E05BDC
    0058EEBC 0019EA94   0019EAA4 004C3AD8 0071DB62 00718F60
    004C3AD8 0019EAA4   0019EAC4 005951B1 009ECB3C 0000007A 00000000 02A37D2C 0130001B 0000043B
    005951B1 0019EAC4   0019EBD8 0058EEBC 00000003 007204E7 00000000 0071A9B0 0019EB30 02A4EA04 03E05BDC 03E05BDC
    0058EEBC 0019EBD8   0019EBE8 004C51DC 00738038 00732958
    004C51DC 0019EBE8   0019EC08 005951B1 009ECB3C 00000075 00000000 02A37D2C 01240006 00000737
    005951B1 0019EC08   0019ED1C 0058EEBC 00000003 00911C79 00000000 009081BC 0019EC74 009ECB4C 00000002 056101EC
    0058EEBC 0019ED1C   0019ED2C 004C3CB8 0072043E 00718F60
    004C3CB8 0019ED2C   0019ED4C 005951B1 009ECB3C 0000006D 00000000 02A37D2C 0124001B 00000857
    005951B1 0019ED4C   0019EE60 0058EEBC 00000003 00000000 00140083 009081AC 766FF858 00C04680 00000020 0019EDB0


Modules:
00400000 00643000 E:\Biometrico\WinFS84.exe
77C40000 001AA000 C:\WINDOWS\SYSTEM32\ntdll.dll
76330000 000F0000 C:\WINDOWS\System32\KERNEL32.DLL
75A10000 00261000 C:\WINDOWS\System32\KERNELBASE.dll
6E4E0000 000A2000 C:\WINDOWS\SYSTEM32\apphelp.dll
75EA0000 0007C000 C:\WINDOWS\System32\ADVAPI32.DLL
76BE0000 000C2000 C:\WINDOWS\System32\msvcrt.dll
75990000 0007A000 C:\WINDOWS\System32\sechost.dll
10000000 00026000 E:\Biometrico\FTRAPI.DLL
56CF0000 003BF000 E:\Biometrico\LIBMYSQL.DLL
56640000 006A5000 E:\Biometrico\FTRSCANAPI.DLL
76070000 000BC000 C:\WINDOWS\System32\RPCRT4.dll
75CE0000 000BF000 C:\WINDOWS\System32\COMDLG32.DLL
76780000 001AC000 C:\WINDOWS\System32\USER32.dll
769F0000 00112000 C:\WINDOWS\System32\ucrtbase.dll
77340000 0028A000 C:\WINDOWS\System32\combase.dll
761C0000 0001A000 C:\WINDOWS\System32\win32u.dll
766B0000 00023000 C:\WINDOWS\System32\GDI32.dll
76420000 00064000 C:\WINDOWS\System32\WS2_32.dll
76B10000 000C1000 C:\WINDOWS\System32\shcore.dll
77250000 000E9000 C:\WINDOWS\System32\gdi32full.dll
764C0000 0007B000 C:\WINDOWS\System32\msvcp_win.dll
76E10000 00440000 C:\WINDOWS\System32\SETUPAPI.dll
769A0000 0004A000 C:\WINDOWS\System32\SHLWAPI.dll
70A20000 00019000 C:\WINDOWS\SYSTEM32\MPR.DLL
775F0000 00616000 C:\WINDOWS\System32\SHELL32.dll
75830000 00008000 C:\WINDOWS\SYSTEM32\VERSION.DLL
70180000 00079000 C:\WINDOWS\SYSTEM32\WINSPOOL.DRV
5EE60000 00090000 C:\WINDOWS\WinSxS\x86_microsoft.windows.common-controls_6595b64144ccf1df_5.82.22000.2003_none_127786c22a430968\COMCTL32.DLL
75F20000 0014E000 C:\WINDOWS\System32\OLE32.DLL
766E0000 0009C000 C:\WINDOWS\System32\OLEAUT32.DLL
71320000 00006000 C:\WINDOWS\SYSTEM32\SHFOLDER.DLL
75860000 00031000 C:\WINDOWS\SYSTEM32\WINMM.DLL
70280000 0016B000 C:\WINDOWS\WinSxS\x86_microsoft.windows.gdiplus_6595b64144ccf1df_1.1.22000.2003_none_93fcfb98d9f1057f\GDIPLUS.DLL
6D580000 0002E000 C:\WINDOWS\SYSTEM32\OLEDLG.DLL
73010000 00024000 C:\WINDOWS\SYSTEM32\IPHLPAPI.DLL
70200000 00006000 C:\WINDOWS\SYSTEM32\MSIMG32.DLL
76490000 00025000 C:\WINDOWS\System32\IMM32.DLL
6E8C0000 00082000 C:\WINDOWS\system32\uxtheme.dll
761F0000 000DA000 C:\WINDOWS\System32\MSCTF.dll
75840000 00012000 C:\WINDOWS\SYSTEM32\kernel.appcore.dll
76D10000 00064000 C:\WINDOWS\System32\bcryptPrimitives.dll
6BB50000 000E2000 C:\WINDOWS\SYSTEM32\textinputframework.dll
6A0C0000 000CB000 C:\WINDOWS\SYSTEM32\CoreMessaging.dll
69E20000 00293000 C:\WINDOWS\SYSTEM32\CoreUIComponents.dll
747B0000 000EB000 C:\WINDOWS\SYSTEM32\wintypes.dll
708D0000 0000B000 C:\WINDOWS\SYSTEM32\CRYPTBASE.DLL
70010000 00012000 C:\WINDOWS\system32\napinsp.dll
6FFF0000 00016000 C:\WINDOWS\system32\pnrpnsp.dll
70750000 00050000 C:\WINDOWS\System32\mswsock.dll
70630000 000AF000 C:\WINDOWS\SYSTEM32\DNSAPI.dll
77C10000 00007000 C:\WINDOWS\System32\NSI.dll
6FFE0000 0000E000 C:\WINDOWS\System32\winrnr.dll
6FFC0000 00011000 C:\WINDOWS\system32\wshbth.dll
6FFA0000 00019000 C:\WINDOWS\system32\nlansp_c.dll
6FF30000 00008000 C:\Windows\System32\rasadhlp.dll
6AFC0000 00096000 C:\WINDOWS\SYSTEM32\TextShaping.dll
6DD60000 00160000 C:\WINDOWS\SYSTEM32\WindowsCodecs.dll
70400000 00223000 C:\WINDOWS\WinSxS\x86_microsoft.windows.common-controls_6595b64144ccf1df_6.0.22000.120_none_e541a94fcce8ed6d\comctl32.DLL

Called from HB_GCALL(0)
Called from TDIALOG:END(769) in .\source\classes\DIALOG.PRG
Called from (b)TFUTRONIC_DLGLISTAUSER(370) in E:\Proyectos\Software\Futronic_FS84\source\prg\tfutronic.prg
Called from TBTNBMP:CLICK(792) in .\source\classes\BTNBMP.PRG
Called from TBTNBMP:LBUTTONUP(1083) in .\source\classes\BTNBMP.PRG
Called from TCONTROL:HANDLEEVENT(1847) in .\source\classes\CONTROL.PRG
Called from TBTNBMP:HANDLEEVENT(2135) in .\source\classes\BTNBMP.PRG
Called from _FWH(3693) in .\source\classes\WINDOW.PRG
Called from DIALOGBOX(0)
Called from TDIALOG:ACTIVATE(307) in .\source\classes\DIALOG.PRG
Called from TFAMTEST:TESTFAM_FS84(190) in E:\Proyectos\Software\Futronic_FS84\source\prg\testfs84.prg
Called from TFAMTEST:NEW(58) in E:\Proyectos\Software\Futronic_FS84\source\prg\testfs84.prg
Called from TAPLICATION:TESTFAMFUTRONIC(628) in E:\Proyectos\Software\Futronic_FS84\source\prg\taplication.prg
Called from (b)CREATEBUTTONBAR(287) in E:\Proyectos\Software\Futronic_FS84\source\prg\mainfgr.prg
Called from TBTNBMP:CLICK(792) in .\source\classes\BTNBMP.PRG
Called from TBTNBMP:LBUTTONUP(1083) in .\source\classes\BTNBMP.PRG
Called from TCONTROL:HANDLEEVENT(1847) in .\source\classes\CONTROL.PRG
Called from TBTNBMP:HANDLEEVENT(2135) in .\source\classes\BTNBMP.PRG
Called from _FWH(3693) in .\source\classes\WINDOW.PRG
Called from WINRUN(0)
Called from TWINDOW:ACTIVATE(1118) in .\source\classes\WINDOW.PRG
Called from BUTTONBARMAIN(172) in E:\Proyectos\Software\Futronic_FS84\source\prg\mainfgr.prg
Called from MAIN(135) in E:\Proyectos\Software\Futronic_FS84\source\prg\mainfgr.prg
------------------------------------------------------------------------
Application Internal Error - E:\Biometrico\WinFS84.exe
Terminated at: 2024-02-29 17:55:09
Error irrecuperable 9001: Fallo en recuperaci¢n de error
------------------------------------------------------------------------

 


Codigo prg y C :
Code: Select all  Expand view  RUN

METHOD DlgListaUser( lDelete ) CLASS TFutronic
  Local oDlg, oWnd
  Local oBrw, oFont
  Local aCols
  Local oSay  
  Local aArray := {}
  Local oBtn   := Array(3)
  Local lExit  := .F.
   
  DEFAULT lDelete := FALSE
                       
  aCols := {;
    { 1, "Group",     Nil,  45, AL_RIGHT },;
    { 2, "User ID",   Nil,  60, AL_RIGHT },;
    { 3, "Name User", Nil, 300, AL_LEFT },;
    { 4, "Finger ID", Nil,  60, AL_RIGHT },;
    { 5, "User Type", Nil,  80, AL_RIGHT },;
    { 6, "Status",    Nil,  80, AL_RIGHT },;
    { 7, "Sec.Level", Nil,  40, AL_RIGHT };
  }                    
   
  DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-12 BOLD                                          
                                       
    DEFINE DIALOG oDlg RESOURCE "LISTA_USERS";
      TITLE "BIOMETRICO LISTA DE USUARIOS";
        ICON "ICONFINGER" FONT oFont
   
  REDEFINE XBROWSE oBrw LINES ID 200 OF oDlg;
    DATASOURCE aArray;
    COLUMNS aCols
 
  WITH OBJECT oBrw  
    :MyConfig()
  END
     
  REDEFINE SAY oSay ID 100 OF oDlg PROMPT ""
         
  REDEFINE BTNBMP oBtn[1] ID 300 OF oDlg;
    2007;
    CENTER;
    NOROUND;
    PROMPT "Eliminar";
    ACTION DeleteUser( oBrw, @lExit, oDlg );
    GRADIENT BtnGradGreen();
    WHEN lDelete
   
  REDEFINE BTNBMP oBtn[2] ID 301 OF oDlg;
    2007;
    CENTER;
    NOROUND;
    PROMPT "Cargar";
    GRADIENT BtnGradGreen()
    oBtn[2]:bAction = <||
                        oSay:SetText("Leyendo del Biometrico, Espere ...!!" )
                        cursorwait()
                        aArray := Fam_ArrayUsers()  // Carga Usuarios desde FS84
                        if ValType(aArray) <> "U" .and. Len(aArray) > 0
                          oSay:SetText("Total Usuarios = " + Str(Len(aArray),6) )
                              GetUsuarios_FS84( aArray, oBrw )
                            else
                                        oSay:SetText("No se Encontraron Usuarios !" )
                            endif  
                            Return Nil
                            >  
 
  REDEFINE BTNBMP oBtn[3] ID 302 OF oDlg;
    2007;
    CENTER;
    NOROUND;
    PROMPT "Salir";
    GRADIENT BtnGradRed()
    oBtn[3]:bAction = <||
                         lExit := .T.
                         oDlg:End()
                         SysRefresh()
                         hb_gcAll(.T.)
                         Return Nil
                      >  
     
  oDlg:bInit = <||
                        DisablesysmenuDlg(oDlg)
                        oSay:SetText("Haga Click en Boton Cargar, para la lista de Usuarios !!!")
                        Return Nil
                    >   
         
  ACTIVATE DIALOG oDlg;
    VALID lExit;
    CENTER
   
  RELEASE FONT oFont   
                 
Return Nil

static function GetUsuarios_FS84( aArray, oBrw )
    Local i
    Local nLen := Len(aArray)
       
  for i:=1 TO nLen
      aArray[i,3] := GetName_IDEmpleado( aArray[i,2] )  // Agrega Nombre al Array
    next i
   
    oBrw:SetArray( aArray )
  oBrw:SetFocus()
   
Return Nil

//---------------------------------------------------   

HB_FUNC( FAM_ARRAYUSERS )
{
    PHB_ITEM pArray  = hb_itemArrayNew( 0 );
    PHB_ITEM itemRow = hb_itemNew( NULL );
   
    CFamUserList userList;
       
    if( userList.GetListDatabase() )
    {          
        UINT i;
        UINT m_nLength   = userList.GetLenDatabase();
        UINT nTotalUser  = m_nLength / 12;
       
        userList.GetArrayDatabase();
                                           
        for( i=0; i<nTotalUser; i++ )
        {
            hb_arrayNew( itemRow, 7 );
                                   
            hb_arraySetC ( itemRow, 1, userList.m_ArrayUsers[i].GroupID );
            hb_arraySetC ( itemRow, 2, userList.m_ArrayUsers[i].UserID );
            hb_arraySetC ( itemRow, 3, " " );
            hb_arraySetC ( itemRow, 4, userList.m_ArrayUsers[i].FingerID );
            hb_arraySetC ( itemRow, 5, userList.m_ArrayUsers[i].UserType );
            hb_arraySetC ( itemRow, 6, userList.m_ArrayUsers[i].Status );
            hb_arraySetC ( itemRow, 7, userList.m_ArrayUsers[i].SL );
                                                                       
        hb_arrayAddForward( pArray, itemRow );
               
    }
   
    if ( userList.m_ArrayUsers )
         hb_xfree( userList.m_ArrayUsers );
             
  }
   
  hb_itemRelease( itemRow );  
  hb_itemReturnRelease( pArray );
   
}   

 
Last edited by albeiroval on Fri Mar 01, 2024 4:56 pm, edited 1 time in total.
Saludos,
Regards,

Albeiro Valencia
www.avcsistemas.com
User avatar
albeiroval
 
Posts: 378
Joined: Tue Oct 16, 2007 5:51 pm
Location: Barquisimeto - Venezuela

Re: xbrowse No existe el metodo: LREADONLY

Postby cmsoft » Fri Mar 01, 2024 4:32 pm

Que hace la funcion GetUsuarios ?
User avatar
cmsoft
 
Posts: 1291
Joined: Wed Nov 16, 2005 9:14 pm
Location: Mercedes - Bs As. Argentina

Re: xbrowse No existe el metodo: LREADONLY

Postby albeiroval » Fri Mar 01, 2024 4:57 pm

Hola Cesar.

cmsoft wrote:Que hace la funcion GetUsuarios ?


Code: Select all  Expand view  RUN

static function GetUsuarios_FS84( aArray, oBrw )
    Local i
    Local nLen := Len(aArray)
       
  for i:=1 TO nLen
      aArray[i,3] := GetName_IDEmpleado( aArray[i,2] )  // Agrega Nombre al Array
    next i
   
    oBrw:SetArray( aArray )
  oBrw:SetFocus()
   
Return Nil

 
Saludos,
Regards,

Albeiro Valencia
www.avcsistemas.com
User avatar
albeiroval
 
Posts: 378
Joined: Tue Oct 16, 2007 5:51 pm
Location: Barquisimeto - Venezuela

Re: xbrowse No existe el metodo: LREADONLY

Postby JESUS MARIN » Fri Mar 01, 2024 7:08 pm

Buenas tardes

En esta función ....
Code: Select all  Expand view  RUN
static function GetUsuarios_FS84( aArray, oBrw )
    Local i
    Local nLen := Len(aArray)
       
  for i:=1 TO nLen
      aArray[i,3] := GetName_IDEmpleado( aArray[i,2] )  // Agrega Nombre al Array
    next i
   
    oBrw:SetArray( aArray )
  oBrw:SetFocus()
   
Return Nil


estas modificando aArray, pero como está definido como variable local y no lo devuelves a la función que lo llama, es posible que te dé un error.

Además, yo no asignaría de nuevo el array, si no que lo actualizaría

Code: Select all  Expand view  RUN

*** oBrw:SetArray( aArray)  <------------ no volver a asignar

oBrw:aArrayData = aArray   <------------ actualiza datos y refresca
oBrw:Refresh()

 


Prueba y nos cuentas
Jesús Marín
JESUS MARIN
 
Posts: 176
Joined: Wed Jan 02, 2019 8:36 am

Re: xbrowse No existe el metodo: LREADONLY

Postby albeiroval » Fri Mar 01, 2024 7:47 pm

Hola Jesus.
JESUS MARIN wrote:estas modificando aArray, pero como está definido como variable local y no lo devuelves a la función que lo llama, es posible que te dé un error.


Como vez estoy pasando el parametro oBrw a la funcion y le asigno el valor del array en SetArray por lo tanto no es necesario devolver el array modificado ni tampoco usar aArrayData ya que el method SetArray lo hace.

De todas maneras la funcion GetUsuarios_FS84( aArray, oBrw ), trabaja bien (tambien habia probado retornando el array modificado y asignandolo a la DATA aArrayData). El problema esta en el GPF que genera al tratar de salir del dialogo o al hacer click en mas de 4 veces al boton. Si vez los archivos de error veraz donde casca el error.
Saludos,
Regards,

Albeiro Valencia
www.avcsistemas.com
User avatar
albeiroval
 
Posts: 378
Joined: Tue Oct 16, 2007 5:51 pm
Location: Barquisimeto - Venezuela

Re: xbrowse No existe el metodo: LREADONLY

Postby karinha » Fri Mar 01, 2024 7:53 pm

Muestre el BOTTON de salida por favor. És un BUTTONBMP?

Gracias.

Regards, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7831
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: xbrowse No existe el metodo: LREADONLY

Postby albeiroval » Sat Mar 02, 2024 4:33 am

Karina.

REDEFINE BTNBMP oBtn[3] ID 302 OF oDlg;
2007;
CENTER;
NOROUND;
PROMPT "Salir";
GRADIENT BtnGradRed()
oBtn[3]:bAction = <||
lExit := .T.
oDlg:End()
SysRefresh()
hb_gcAll(.T.)
Return Nil
>
Saludos,
Regards,

Albeiro Valencia
www.avcsistemas.com
User avatar
albeiroval
 
Posts: 378
Joined: Tue Oct 16, 2007 5:51 pm
Location: Barquisimeto - Venezuela

Re: xbrowse No existe el metodo: LREADONLY

Postby karinha » Sat Mar 02, 2024 1:00 pm

albeiroval wrote:Karina.

REDEFINE BTNBMP oBtn[3] ID 302 OF oDlg;
2007;
CENTER;
NOROUND;
PROMPT "Salir";
GRADIENT BtnGradRed()
oBtn[3]:bAction = <||
lExit := .T.
oDlg:End()
SysRefresh()
hb_gcAll(.T.)
Return Nil
>


Albeiroval, intenta asi por favor:

Code: Select all  Expand view  RUN

#Define aPubGrad {| lInvert | If( lInvert, ;
                 { { 1 / 3, nRGB( 255, 253, 222 ), nRGB( 255, 231, 151 ) }, ;
                 { 2 / 3, nRGB( 255, 215,  84 ), nRGB( 255, 233, 162 ) }    ;
                 },                                                         ;
                 { { 1 / 2, nRGB( 219, 230, 244 ), nRGB( 207 - 50, 221 - 25, 255 ) }, ;
                 { 1 / 2, nRGB( 201 - 50, 217 - 25, 255 ), nRGB( 231, 242, 255 ) }    ;
                 } ) }

FUNCTION Tu_Function()

   hb_gcAll( .F. )

   /*
   REDEFINE BTNBMP oBtn[ 3 ] ID 302 OF oDlg;
      2007;
      CENTER;
      NOROUND;
      PROMPT "Salir";
      GRADIENT BtnGradRed()
      oBtn[ 3 ]:bAction = < ||
      lExit := .T.
      oDlg:End()
      SysRefresh()
       hb_gcAll( .T. )

      RETURN NIL
      >
   */


   // Bien mejor asi:

   REDEFINE BTNBMP oBtn[ 3 ] RESOURCE "TU_RESOURCE" PROMPT "&Salir"          ;
      OF oDlg FONT oFont FLAT 2007 COLOR CLR_HBLUE, CLR_BLACK                ;
      UPDATE ACTION ( lExit := .T., oDlg:End() )                             ;
      MESSAGE "Administração da Área Albeiroval"                             ;
      TOOLTIP { "Administração da Área Albeiroval",                          ;
                "Administração da Área Albeiroval", 1, CLR_WHITE, CLR_GREEN } GDIPLUS

   oBtn[ 3 ]:bClrGrad := aPubGrad

   WITH OBJECT oBtn[ 3 ]
      oBtn[ 3 ]:nClrBorder := CLR_BLACK //  border color
      oBtn[ 3 ]:bColorMap  := { || { { CLR_YELLOW, CLR_BLACK } } }  // image color
   END

   // oBtn[ 3 ]:oCursor := oHand

   oBtn[ 3 ]:lCancel := .T.   // aqui, mui importante para BTNBMP.

   ACTIVATE DIALOG oDlg... VALID, etc...

   hb_gcAll( .T. )

RETURN NIL

// FIN / END - kapiabafwh@gmail.com
 


Regards, saludos
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7831
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: xbrowse No existe el metodo: LREADONLY

Postby nageswaragunupudi » Sat Mar 02, 2024 2:16 pm

Both TXbrowe and TXBrwColumn classes do have the DATA lReadOnly.

This error:
Code: Select all  Expand view  RUN
Called from:  => LREADONLY( 0 )
Called from: .\source\classes\XBROWSE.PRG => TXBRWCOLUMN:VALUE( 13576 )

indicates that the object is NIL.

Are you sure you are using XBrowse without any modifications?

Is it possible to have simple reduced sample, which we can try at our end?

Code:
*** oBrw:SetArray( aArray) <------------ no volver a asignar

oBrw:aArrayData = aArray <------------ actualiza datos y refresca
oBrw:Refresh()


This is what I suggest too.
Regards

G. N. Rao.
Hyderabad, India
User avatar
nageswaragunupudi
 
Posts: 10646
Joined: Sun Nov 19, 2006 5:22 am
Location: India

Re: xbrowse No existe el metodo: LREADONLY

Postby albeiroval » Sat Mar 02, 2024 3:13 pm

Hi Mr. Rao.

Are you sure you are using XBrowse without any modifications?


Yes, I use a modified xBrowse method to use incremental seek with Tdolphin, here is the code I use

Code: Select all  Expand view  RUN

// EXTENSIONES DE CLASS

#include "FiveWin.ch"
#include "hbclass.ch"
#include "reportexcel.ch"

#ifndef __XHARBOUR__
    #include "xhbcls.ch"
#endif

#include "wcolors.ch"

//--------------------------------------------------

#define COL_EXTRAWIDTH        6
#define ROW_EXTRAHEIGHT       4
#define COL_SEPARATOR         2
#define BMP_EXTRAWIDTH        5

#define NULL_BRUSH    5
#define HOLLOW_BRUSH  NULL_BRUSH

//--------------------------------------------------

static aSortBitmap

//--------------------------------------------------

static lExcelInstl, lCalcInstl
static tmp
static nxlLangID, cxlTrue := "=(1=1)", cxlFalse := "=(1=0)", cxlSum, lxlEnglish := .f., hLib
static lLocked := .F.

//--------------------------------------------------

Procedure OverrideAndExtend()
 
  EXTEND CLASS TDolphinQry WITH DATA cAlias
 
  EXTEND CLASS TDolphinQry WITH METHOD ValueField
 
    EXTEND CLASS TXBrowse WITH DATA OldCol
    EXTEND CLASS TXBrowse WITH DATA lValueFilter
   
    EXTEND CLASS TXBrowse WITH METHOD lCreateFilter
    EXTEND CLASS TXBrowse WITH METHOD SetFilterQuery
    EXTEND CLASS TXBrowse WITH METHOD MyConfig
  EXTEND CLASS TXBrowse WITH METHOD MyMerge
  EXTEND CLASS TXBrowse WITH METHOD bClrHeaderFooter
  EXTEND CLASS TXBrowse WITH METHOD ShowNumRow
  EXTEND CLASS TXBrowse WITH METHOD ReportExcel
  EXTEND CLASS TXBrowse WITH METHOD MyToExcel
  EXTEND CLASS TXBrowse WITH METHOD SetBitmapSort
  EXTEND CLASS TXBrowse WITH METHOD ToArray
       
    OVERRIDE METHOD Adjust   IN CLASS TXBrowse      WITH MyAdjust
    OVERRIDE METHOD SetOrder IN CLASS TXBrwColumn WITH MySetOrder
           
Return

//--------------------------------------------------

Function ValueField( cnField )
  Local uValue
  Local Self := HB_QSelf()
   
  if ::FieldType( cnField ) = "C"
     uValue := PadR(::FieldGet(cnField), ::FieldLen(cnField), " ")
  else
       uValue := ::FieldGet( cnField )  
    endif
   
Return uValue   

//--------------------------------------------------

Function lCreateFilter()
    Local Self := HB_QSelf()
   
    if ::lValueFilter == Nil
     ::lValueFilter = .F.
  endif
   
Return ::lValueFilter

//--------------------------------------------------

Function SetFilterQuery()
  Local oQry
    Local cQuery
    Local aTables
    Local Self := HB_QSelf()
 
  if ::lCreateFilter()
     Return Nil
  else
     ::lValueFilter = .T.  
  endif    
   
  oQry    := ::oMySql  
  cQuery  := oQry:cQuery  
  aTables := aTablesQuery(cQuery)
     
  if Len(aTables) == 0
     MsgStop("falta FROM en la consulta", "Error")
     Return Nil
  endif
     
  if "ORDER BY" $ Upper( cQuery )
     cQuery := SubStr( cQuery, 1, At("ORDER BY", Upper(cQuery))+8 )
  endif
 
  if hb_isObject( oQry )
     if oQry:IsKindOf( "TDOLPHINQRY" )
          oQry:aTables      = aTables
          oQry:bOnNewFilter = bSetNewFilterQuery( cQuery, oQry, Self )
     else
            MsgStop("No existe el objeto TDOLPHINQRY", "Error")
            Return Nil
     endif
  else
     MsgStop("Falta objeto oQry", "Error")
     Return Nil
  endif
 
Return Nil  

//--------------------------------------------------

#define NOT_CHAR Chr(10)+Chr(13)+Chr(9)+Chr(32)

static Function aTablesQuery( cQuery )
    Local cChar
    Local cSelect
    Local cTable
    Local nPos
    Local i
    Local aTables := {}
   
    WHILE .T.
       
        nPos := AT("FROM", cQuery)
       
      if nPos > 0
             cQuery := SubStr(cQuery, nPos+5)
             cTable := ""
             FOR EACH cChar IN cQuery
               if !( cChar $ NOT_CHAR )
                 cTable += cChar
             else
               exit 
             endif   
           NEXT
           AAdd( aTables, cTable )
        else
           exit  
        endif        
       
    ENDDO
                     
Return aTables

//--------------------------------------------------

static Function bSetNewFilterQuery( cQuery, oQry, oBrw )
Return {|oSelf, nType| oSelf:cQuery := GetNewQuery( cQuery, oSelf:cOrder, oBrw ), .F. }     

//--------------------------------------------------

static Function GetNewQuery( cQuery, cOrder, oBrw )
 
  if !("ORDER BY" $ Upper( cQuery ))
     cQuery += " ORDER BY "
  endif  
 
  cOrder := SubStr( cOrder, At(".", cOrder)+1 )
  cQuery += cOrder
 
  if oBrw:oSeek != nil
     oBrw:oSeek:SetText("")
  endif
   
Return cQuery

//--------------------------------------------------

Function MyConfig( lStretchCol, lFilter, lMoveColumns )
    Local Self := HB_QSelf()
   
    DEFAULT lStretchCol  := .T.
    DEFAULT lFilter          := .T.
    DEFAULT lMoveColumns := .F.
   
    if ::oMySql <> Nil .and. lFilter
         ::SetFilterQuery()  
    endif   
   
    ::SetBitmapSort()   // Bitmaps order
   
    // ::nMarqueeStyle          = MARQSTYLE_HIGHLCELL   <--- Habilita el Resize Height del Row
    ::nMarqueeStyle = MARQSTYLE_HIGHLROW  // MARQSTYLE_HIGHLWIN7
   
    ::bClrGrad      = {|| { { 0.5, RGB(161,164,164), RGB(193,199,199) }, { 0.5, RGB(193,199,199), RGB(161,164,164) } } }
    ::bClrStd           = {|| { CLR_BLACK, RGB(182,226,252)} }
    // ::bClrStd            = {|| { CLR_BLACK, RGB(250,219,216)} }
   
    ::bClrHeader        = {|| { nRGB(140,0,0), nRGB(102,255,255) } }
    ::bClrFooter        = {|| { nRGB(140,0,0), nRGB(102,255,255) } }
   
    ::bClrSelFocus  = {|| { CLR_WHITE, RGB(5,82,194) } }
    ::bClrRowFocus  = {|| { CLR_WHITE, RGB(91,140,216) } }
       
    // viewtopic.php?f=3&t=32593&start=15
    ::nHeaderHeight   = 30
  ::nRowHeight      = 25
  ::lRecordSelector = .T.
  ::lAllowRowSizing = .F. // prevent row sizing
    ::lAllowSizings   = .F. // prent resizing of all columns.
   
    // oCol:lAllowSizing := .f. // prevent col resizing of a particular column
     
  ::lAllowColSwapping = lMoveColumns  // Habilita/Deshabilita Mover las columnas
 
  if lStretchCol
     ::nStretchCol = STRETCHCOL_LAST // STRETCHCOL_WIDEST //  <nCol>
  endif 
 
  ::bToolTips = {|oBrw,r,c,f,oMouseCol,nMouseRow| MyColToolTip( oBrw, r, c, f, oMouseCol, nMouseRow )}
 
Return Nil  

//--------------------------------------------------

Function ShowNumRow( cHeader, nWidth )
    Local Self := HB_QSelf()
   
    DEFAULT cHeader := "Nr.",;
                    nWidth  := 50
   
    ::bRecSelData       = {|brw| brw:KeyNo }
    ::bRecSelHeader     = {|brw| cHeader }    
    ::bRecSelFooter     = {|brw| brw:nLen }
    ::nRecSelWidth      = nWidth
   
Return Nil 

//--------------------------------------------------

Function bClrHeaderFooter()
Return {|| Nil}

/*
Function bClrHeaderFooter()
    Local Self := HB_QSelf()
   
    ::lColChangeNotify = .t.
   
    AEval( ::aCols, {|o| o:bClrGrad := bColClrGrad(o)} )  
   
Return {|| if(::SelectedCol() == ::OldCol,;
              Nil,;
              (::RefreshHeaders(), ::RefreshFooters(), ::OldCol := ::SelectedCol()))}
*/


//--------------------------------------------------

static Function bColClrGrad( oCol )
Return {|lInvert| If( lInvert, Eval( oCol:oBrw:bClrGrad, .t. ), ;
                                                     If( oCol == oCol:oBrw:SelectedCol(), ;
                                                         { { 1/3, nRGB( 248, 195,  34 ), nRGB( 252, 232, 171 ) }, ;
                                                         { 2/3, nRGB( 252, 232, 171 ), nRGB( 248, 195,  34 ) } },;
                                                     Eval( oCol:oBrw:bClrGrad, .f. ) ) ) }
//--------------------------------------------------
                                                     
// aData := oBrw:ToArray( aCols )
Function ToArray( aCols )
    local Self  := HB_QSelf()
  local aData := {}
  local nRows := ::nLen
  local nRow, bm

  if nRows > 0
     if aCols == nil
        aCols   := ::GetVisibleCols()
     else
        aCols   := { |o,i| aCols[ i ] := ::oCol( i ) }
     endif

     aData  := Array( nRows, Len( aCols ) )

     bm         := ::BookMark
     Eval( ::bGoTop, Self )

     for nRow := 1 to nRows
        AEval( aCols, { |o,i| aData[ nRow, i ] := o:Value } )
        Eval( ::bSkip, 1 )
     next

     ::BookMark  := bm

  endif

return aData                                                     
 
//--------------------------------------------------

Function MyColToolTip( oBrw, r, c, f, oMouseCol, nMouseRow )
    Local uBm, uVal

  if nMouseRow != oBrw:nRowSel
     uBm   := oBrw:BookMark
     Eval( oBrw:bSkip, nMouseRow - oBrw:nRowSel )  
     uVal  := oMouseCol:Value
     oBrw:BookMark := uBm
  else
     uVal  := oMouseCol:Value
  endif

return cValToChar( uVal )

//--------------------------------------------------

Function MyMerge()
    Local Self := HB_QSelf()
   
    ::bClrStd       = {|| If(::KeyNo()%2==0, { CLR_BLACK, RGB(198, 255, 198) }, { CLR_BLACK, RGB(232, 255, 232) } ) }
  ::bClrSel       = {|| { CLR_WHITE, RGB(51, 102, 204) } }
  ::bClrSelFocus  = {|| { CLR_WHITE, RGB(255, 98, 98) } }
  ::bClrRowFocus  = {|| { CLR_WHITE, RGB(106, 106, 255)} }  
 
  ::bClrHeader   = {|| { RGB(140,  0,  0), RGB(102, 255, 255) } } // Texto Header, Color Bordes  
    ::bClrFooter   = {|| { RGB(140,  0,  0), RGB(102, 255, 255) } } // Texto Header, Color Bordes  
 
  ::lRecordSelector = .T.
   
Return Nil  

//--------------------------------------------------

Function ColPenColor( oCol, nColor )

   if oCol:hColPen != nil
      DeleteObject( oCol:hColPen )
   endif

   oCol:hColPen := CreatePen( PS_SOLID, 1, nColor )
   oCol:oBrw:Refresh()

Return nil

//--------------------------------------------------

Function MySetOrder( lSort )
     LOCAL   Self := HB_QSelf()
   LOCAL   lSorted   := .F.
   LOCAL   n, cSort, uVal, c, nSecs
   LOCAL   lDolphin  := .f.
   LOCAL   cOrdBag   := If( ValType( ::cOrdBag ) == 'B', Eval( ::cOrdBag ), ::cOrdBag )

   if !Empty( ::oBrw:aFilter )
      return .f.
   endif

   if ::cOrder == 'A' .and. ! ::oBrw:lSortDescend
      return .f.
   endif
   
   DEFAULT lSort  := ::oBrw:lAutoSort

   if lSort .and. ::cSortOrder != nil

      nSecs    := SECONDS()

      if ValType( ::cSortOrder ) == "B"
         uVal  := Eval( ::cSortOrder, Self )
         lSorted := ( ValType( uVal ) == 'C' .and. Upper( uVal ) $ 'AD' )
         if lSorted
            ::oBrw:cOrders := " "
            ::cOrder       := Upper( uVal )
         endif

      elseif ::oBrw:nDataType == DATATYPE_ARRAY
         lSorted := ::SortArrayData()
         
            elseif lAnd( ::oBrw:nDataType, DATATYPE_EAGLE ) .and. ::oBrw:oMySql != nil
         c  := ::cOrder == "A"
         ::oBrw:cOrders  := " "
         ::oBrw:oMySql:SetOrderBy( ::cSortOrder, c, .t. )
         ::cOrder  := If( c, "D", "A" )
         lSorted     := .t.
   
      elseif lAnd( ::oBrw:nDataType, DATATYPE_ADO ) .and. ::oBrw:oRs != nil

         n       := If( ::oBrw:oRs:RecordCount > 0, ::oBrw:oRs:BookMark, nil )
         cSort   := Upper( ::oBrw:oRs:Sort )
         cSort   := TRIM( StrTran( StrTran( cSort, ' DESC', '' ), ' ASC', '' ) )
         if EQ( CharRem( "[]", cSort ), CharRem( "[]", ::cSortOrder ) )
            ::cOrder       := If( ::cOrder == 'D', 'A', 'D' )
         else
            ::oBrw:cOrders := ' '
            ::cOrder       := 'A'
         endif
/*
         lSorted           := .t.
         ::oBrw:oRs:Sort   := ::cSortOrder + If( ::cOrder == 'D', ' DESC', '' )
         if lSorted .and. n != nil
            ::oBrw:oRs:BookMark  := n
         endif
*/

         TRY
            ::oBrw:oRs:Sort   := ::cSortOrder + If( ::cOrder == 'D', ' DESC', '' )
            lSorted           := .t.
         CATCH
            ::cSortOrder      := nil
            ::cOrder          := ' '
         END
         if lSorted .and. n != nil
            ::oBrw:oRs:BookMark  := n
         endif

      elseif lAnd( ::oBrw:nDataType, DATATYPE_MYSQL ) .and. ::oBrw:oMysql != nil
         n                 := 0
         lDolphin          := ::oBrw:oMysql:IsKindOf( 'TDOLPHINQRY' )
         if lDolphin
            cSort   := Lower( ::oBrw:oMysql:cOrder )
         else
            cSort   := Lower( ::oBrw:oMysql:cSort )
         endif
         cSort   := AllTrim( StrTran( StrTran( cSort, ' desc', '' ), ' asc', '' ) )
         if EQ( cSort, ::cSortOrder ) // already sorted on this column
            ::cOrder    := If( ::cOrder == 'D', 'A', 'D' )
            n           := ::oBrw:oMySql:LastRec() - ::oBrw:oMySql:RecNo() + 1
         else
            ::oBrw:cOrders       := " "
            ::cOrder             := 'A'
         endif
         lSorted     := .t.
         cSort       := ::cSortOrder + If( ::cOrder == 'D', " DESC", "" )
         if lDolphin
            uVal     := ::Value
            ::oBrw:oMySql:lInverted := ( ::cOrder == 'D' )
            ::oBrw:oMySql:SetOrder( cSort )
            if n > 0
               ::oBrw:oMySql:GoTo( n )
            else
               // ::oBrw:oMySql:Seek( uVal, Token( ::cSortOrder, nil, 1 ), 1, ::oBrw:oMySql:LastRec(), .t., .t. )
               ::oBrw:oMySql:Seek( uVal, Token( SubStr( ::cSortOrder, At( ".", ::cSortOrder)+1 ), Nil, 1 ), 1, ::oBrw:oMySql:LastRec(), .t., .t. )  // Adicion Albeiro Valencia
            endif
            // note: seek is not working in the descending order
         else
            ::oBrw:oMysql:cSort := cSort
         endif

      elseif lAnd( ::oBrw:nDataType, DATATYPE_ODBF ) .and. ValType( ::cSortOrder ) == 'C'

         if ::oBrw:oDbf:IsKindOf( "TDATABASE" )

            DEFAULT cOrdBag   := ::oBrw:oDbf:IndexBagName()

            if ValType( cOrdBag ) == 'C'
               cOrdBag        := Upper( cOrdBag )
            endif

            if ::oBrw:oDbf:SetOrder() == Upper( ::cSortOrder )
               if !Empty( ::cOrder ) .and. ;
                  If( ValType( c := ::oBrw:oDbf:IndexBagName() ) == "C", ;
                     Upper( c ) == cOrdBag, c == cOrdBag )

                  ::oBrw:oDbf:OrdDescend( nil, nil, ::cOrder == 'A' )
                  ::cOrder       := If( ::cOrder == 'A', 'D', 'A' )
                  lSorted        := .t.
               else
                  ::oBrw:oDbf:SetOrder( ::cSortOrder, cOrdBag )
                  lSorted        := .t.
                  ::oBrw:cOrders := ' '
                  ::cOrder       := 'A'
               endif
            else
               ::oBrw:oDbf:SetOrder( ::cSortOrder, cOrdBag )
               lSorted  := .t.
               ::oBrw:cOrders     := " "
               ::cOrder           := 'A'
            endif
         elseif ::oBrw:oDbf:IsKindOf( "TPQQUERY" )
            uVal     := FWPG_QuerySetOrder( ::oBrw:oDbf, ::cSortOrder, ::cOrder == "A" )
            lSorted  := ( uVal == "A" .or. uVal == "D" )
            if lSorted
               ::oBrw:cOrders := " "
               ::cOrder    := uVal
            endif
         else
            if __ObjHasMethod( ::oBrw:oDbf, 'ORDDESCEND' ) .and. ;
               ( ::cOrder == 'A' .or. ::cOrder == 'D' )
               ::oBrw:oDbf:OrdDescend( nil, nil, ::cOrder == 'A' )
               ::cOrder          := If( ::cOrder == 'A', 'D', 'A' )
               lSorted           := .t.

            elseif ! Eq( ::oBrw:oDbf:SetOrder(), ::cSortOrder )
               ::oBrw:oDbf:SetOrder( ::cSortOrder, cOrdBag )
               lSorted  := .t.
               ::oBrw:cOrders     := ' '
               ::cOrder           := 'A'
            endif
         endif
      elseif ValType( ::oBrw:cAlias ) == 'C' .and. ValType( ::cSortOrder ) == 'C'

         cSort         := ( ::oBrw:cAlias )->( OrdSetFocus() )   // Save the present value

         DEFAULT cOrdBag := ( ::oBrw:cAlias )->( OrdBagName() )

         if (::oBrw:cAlias)->( OrdSetFocus() ) == Upper( ::cSortOrder )
            if !Empty( ::cOrder ) .and. Upper( cOrdBag ) == Upper( ( ::oBrw:cAlias )->( OrdBagName() ) )
               (::oBrw:cAlias)->( OrdDescend( , , ! OrdDescend() ) )
/*
               if ::oBrw:lSQLRDD
                  M->u__bm       := ::oBrw:BookMark
                  ::oBrw:GoTop()
                  ::oBrw:BookMark   := M->u__bm
               endif
*/

               ::cOrder          := If( ( ::oBrw:cAlias )->( OrdDescend() ), 'D', 'A' )
            else
               (::oBrw:cAlias)->( OrdSetFocus( ::cSortOrder, cOrdBag ) )
               ::cOrder          := 'A'
            endif
            lSorted              := .t.

         else

            (::oBrw:cAlias)->( OrdSetFocus( ::cSortOrder, cOrdBag ) )
            lSorted   := .T.
            ::oBrw:cOrders     := ' '
            ::cOrder           := If( ( ::oBrw:cAlias )->( OrdDescend() ), 'D', 'A' )

         endif

      endif

      ::oBrw:nSortSecs  := SECONDS() - nSecs
      if ::oBrw:lProfiler
         FWLOG ::oBrw:cTitle, ::oBrw:nLen, ::oBrw:nSortSecs
      endif
   endif

   if lSorted
      if ::oBrw:lMergeVert
         AEval( ::oBrw:aCols, { |o| If( o:lMergeVert, o:WorkMergeData(), nil ) } )
      endif
      ::oBrw:Seek()
      if ::oBrw:lSQLRDD
         if ::oBrw:SQLRDD_hState[ "indexord" ] == ( ::oBrw:cAlias )->( IndexOrd() )
            if ::oBrw:SQLRDD_hState[ "descend" ] != ( ::oBrw:cAlias )->( OrdDescend() )
               //
               ::oBrw:SQLRDD_hState[ "nkeyno" ] := ;
               ::oBrw:SQLRDD_nKeyNo := ::oBrw:nLen - ::oBrw:SQLRDD_hState[ "nkeyno" ] + 1
               ::oBrw:SQLRDD_hState[ "descend" ] := ( ::oBrw:cAlias )->( OrdDescend() )
            endif
         else
            ::oBrw:GoTop()
         endif
      endif
      if ::oBrw:oSortCbx != nil
         ::oBrw:oSortCbx:Refresh()
      endif
      if ::oBrw:bOnSort != nil
         Eval( ::oBrw:bOnSort, ::oBrw, Self )
      endif
   endif

return lSorted
                 
//--------------------------------------------------

static function EQ( uFirst, uSecond, lExact, lCaseSensitive )

   Local   c, lRet := .f.

   DEFAULT lExact := .t., lCaseSensitive := .f.

   TRY
      uFirst   := xEval( uFirst )
   CATCH
   END

   TRY
      uSecond  := xEval( uSecond )
   CATCH
   END

   if ( C := valtype( uFirst ) ) == valtype( uSecond )
      if c == 'C'
         if lExact
            if lCaseSensitive
               lRet     := ( AllTrim( uFirst ) == AllTrim( uSecond ) )
            else
               lRet     := ( Upper( AllTrim( uFirst ) ) == Upper( AllTrim( uSecond ) ) )
            endif
         else
            lRet        := Upper( AllTrim( uFirst ) ) = Upper( AllTrim( uSecond ) )
         endif
      else
         lRet  := ( uFirst == uSecond )
      endif
   endif

return lRet

//--------------------------------------------------

Function xBrSetBitmapSort( aPngFiles )

    aSortBitmap := aPngFiles
   
return Nil 

//--------------------------------------------------

static Function SetBitmapSort()
    Local hBmp, oBmp
    Local Self := HB_QSelf()
       
    if ValType( aSortBitmap ) == "A"
   
     /*
     We recommend using FW_ReadImage( nil, cAnyImageSource, [aSize], [lGDIP] ) --> aImage

         Elements of aImage:
         { hBitmap, hPalette, nBmpWidth, nBmpHeight, lAlpha, cName, lResource, cType, nZeroClr }
         
         Destroy with
       PalBmpFree( aImage )
         */

         
         ::aSortBmp = {}
         
         if File( aSortBitmap[1] ) .and. File( aSortBitmap[2] )
           
            ::aSortBmp = {}
     
            hBmp := FW_ReadImage( nil, aSortBitmap[1] )[1]
            AAdd( ::aSortBmp, { hBmp, 0, nBmpWidth( hBmp ), nBmpHeight( hBmp ), nil, .F. } )
    
            hBmp := FW_ReadImage( nil, aSortBitmap[2] )[1]
            AAdd( ::aSortBmp, { hBmp, 0, nBmpWidth( hBmp ), nBmpHeight( hBmp ), nil, .F. } )    
           
     endif     
    
    endif
           
return Nil 

//--------------------------------------------------

Function MyToExcel( bProgress, nGroupBy, aCols, lShow, cPDF, bPrePDF )

     Local Self   := HB_QSelf()
   local oExcel, oBook, oSheet, oWin
   local nCol, nXCol, oCol, cType, uValue, nAt, cFormula
   local uBookMark, nRow
   local nDataRows
   local cText, nPasteRow, nStep, cFormat
   local aTotals  := {}, lAnyTotals := .f.
   local aWidths  := {}
   local lContinue   := .t.
   // locals used for group header export
   local n, nGrpStart := 0, nGrpLast, cGrpHdr, cPrvHdr, oRange

   if ::bToExcel != nil
      return Eval( ::bToExcel, Self, bProgress, nGroupBy, aCols, lShow, cPDF, bPrePDF )
   endif

   DEFAULT lShow  := .t.

   if lExcelInstl == .f.
      // already checked and found excel not installed
      if lCalcInstl == .f.
         // already checked and found Open Office Calc also is not installed
         return Self
      else
         return ::ToCalc( bProgress, nGroupBy,,, aCols )
      endif
   endif

   nDataRows   := EVAL( ::bKeyCount )
   if nDataRows == 0
      return Self
   endif

   DEFAULT aCols         := ::GetVisibleCols()

   if Empty( aCols )
      return Self
   endif

   if ( oExcel := ExcelObj() ) == nil
      lExcelInstl := .f.
      if lCalcInstl == .f.
         MsgAlert( FWString( "Excel not installed" ), FWString( "Alert" ) )
         return Self
      else
         return ::ToCalc( bProgress, nGroupBy, , , aCols )
      endif
   endif
   lExcelInstl    := .t.

   if nxlLangID == nil
      SetExcelLanguage( oExcel )
   endif

   oExcel:ScreenUpdating := .f.
   oBook   := oExcel:WorkBooks:Add()
   oSheet   := oExcel:ActiveSheet

   uBookMark   := EVAL( ::bBookMark )

   nRow     := 1
   nCol     := 0
   aWidths  := Array( Len( aCols ) )

   for nXCol := 1 TO Len( aCols )
      oCol   := aCols[ nXCol ]

      nCol ++

      oSheet:Cells( nRow, nCol ):Value   := oCol:cHeader
      cType      := oCol:cDataType

      if ::nDataType != DATATYPE_ARRAY
         DO CASE
         CASE Empty( cType )
            // no action
         CASE cType == 'N'
            cFormat     := Dbf2ExcelNumFormat( oCol:cEditPicture )
            oSheet:Columns( nCol ):NumberFormat := cFormat
            oSheet:Columns( nCol ):HorizontalAlignment := - 4152 //xlRight

         CASE cType == 'D'
            if lxlEnglish
              if ValType( oCol:cEditPicture ) == 'C' .and. Left( oCol:cEditPicture, 1 ) != '@'
                 oSheet:Columns( nCol ):NumberFormat := Lower( oCol:cEditPicture )
              else
                 oSheet:Columns( nCol ):NumberFormat := Lower( Set( _SET_DATEFORMAT ) )
              endif
              oSheet:Columns( nCol ):HorizontalAlignment := - 4152 //xlRight
            endif
         CASE cType $ "T=@"
            oSheet:Columns( nCol ):NumberFormat := Lower( Set( _SET_DATEFORMAT ) ) + " hh:mm:ss"
         CASE cType $ 'LPFM'
            // leave as general format
         OTHERWISE
            if ::nDataType != DATATYPE_ARRAY
               oSheet:Columns( nCol ):NumberFormat := "@"
               if ! Empty( oCol:nDataStrAlign )
                  oSheet:Columns( nCol ):HorizontalAlignment := If( lAnd( oCol:nDataStrAlign, AL_CENTER ), -4108, -4152 )
               endif
            endif
         ENDCASE
      endif

      if cType != nil .and. cType $ 'PFM' // Picture or memo
         aWidths[ nCol ]                     := oCol:nWidth / 7.5
         oSheet:Columns( nCol ):ColumnWidth  := aWidths[ nCol ]
         oSheet:Rows( "2:" + LTrim(Str( ::nLen + 1 )) ):RowHeight := ::nRowHeight
         if cType == 'M'
            oSheet:Columns( nCol ):WrapText  := .t.
         endif
      endif

   next nXCol

   oSheet:Range( oSheet:Cells( 1, 1 ), oSheet:Cells( 1, Len( aCols ) ) ):Select()
   // xlEdgeBottom = 9, xlEdgeTop = 8, xlEdgeLeft = 8, xlEdgeRight = 10
   oExcel:Selection:Borders(9):LineStyle := 1   // xlContinuous = 1
   oExcel:Selection:Borders(9):Weight    := -4138   // xlThin = 2, xlHairLine = 1, xlThick = 4, xlMedium = -4138

   if Empty( ::aSelected ) .or. Len( ::aSelected ) == 1

      Eval( ::bGoTop )
      if ::oRs != nil .AND. Len( aCols ) == ::oRs:Fields:Count()
            ::oRs:MoveFirst()
            nRow   := oSheet:Cells( 2, 1 ):CopyFromRecordSet( ::oRs )
            ::oRs:MoveFirst()
         nRow   += 2
      else

         if bProgress == nil
            if ::oWnd:oMsgBar == nil
               bProgress := { || nil }
            else
               bProgress := { | n, t | ::oWnd:SetMsg( FWString( "To Excel" ) + ;
                              " : " + Ltrim( Str( n ) ) + "/" + Ltrim( Str( t ) ) ) }
            endif
         endif

         nRow      := 2
         nStep     := Max( 1, Min( 100, Int( nDataRows / 100 ) ) )

         if ::lExcelCellWise
            do while nRow <= ( nDataRows + 1 ) .and. lContinue

               nCol        := 0
               for nxCol   := 1 to Len( aCols )
                  oCol     := aCols[ nXCol ]
                  nCol++
                  oCol:ToExcel( oSheet, nRow, nCol )
               next nCol

               lContinue := ( ::Skip( 1 ) == 1 )
               nRow ++
               If ( nRow - 2 ) % nStep == 0
                  if Eval( bProgress, nRow - 2, nDataRows ) == .f.
                     Exit
                  endif
                  SysRefresh()
               endif

            enddo
         else

            nPasteRow := 2
            cText     := ""
            if ::oClp:Open()

               Eval( bProgress, 0, nDataRows )

               do while nRow <= ( nDataRows + 1 ) .and. lContinue
                  if ! Empty( cText )
                     cText += CRLF
                  endif
                  cText    += ::ClpRow( .t., aCols )

//                  lContinue := ( ::Skip( 1 ) == 1 )
                  lContinue := nRow < ( nDataRows + 1 ) .and. ( ::Skip( 1 ) == 1 )
                  nRow ++

                  if Len( cText ) > 16000
                     ::oClp:SetText( cText )
                     oSheet:Cells( nPasteRow, 1 ):Select()
                     oSheet:Paste()
                     ::oClp:Clear()
                     cText       := ""
                     nPasteRow   := nRow
                  endif

                  If ( nRow - 2 ) % nStep == 0
                     if Eval( bProgress, nRow - 2, nDataRows ) == .f.
                        Exit
                     endif
                     SysRefresh()
                  endif

               enddo
               if ! Empty( cText )
                  ::oClp:SetText( cText )
                  oSheet:Cells( nPasteRow, 1 ):Select()
                  oSheet:Paste()
                  ::oClp:Clear()
                  cText    := ""
               endif

               Eval( bProgress, nDataRows, nDataRows )
               SysRefresh()

            endif
         endif // ::lExcelCellWise
      endif
   else
      ::Copy()
      oSheet:Cells( 2, 1 ):Select()
      oSheet:Paste()
      nRow := Len( ::aSelected ) + 2
   endif
   oSheet:Cells( 1, 1 ):Select()

   // Totals, if needed

   oSheet:Rows(    1 ):Font:Bold   := .T.
   oSheet:Rows( nRow ):Font:Bold   := .T.

   if ValType( nGroupBy ) == 'N'
      for nxCol := 1 TO Len( aCols )
         if aCols[ nxCol ]:lTotal
            AAdd( aTotals, nxCol )
         endif
      next
      if ! Empty( aTotals )
         oSheet:Activate()
         oExcel:Selection:Subtotal( nGroupBy , -4157,  ;    // xlSum = -4157
                                    aTotals, ;
                                    .t., ;    // Replace .t. or .f.
                                    .f., ;    // PageBreaks
                                    .t. )       // SummaryBelowData

      endif
   else
      nCol   := 0
      oSheet:Range( oSheet:Cells( nRow, 1 ), oSheet:Cells( nRow, Len( aCols ) ) ):Select()
      // xlEdgeBottom = 9, xlEdgeTop = 8, xlEdgeLeft = 8, xlEdgeRight = 10
      oExcel:Selection:Borders(8):LineStyle := 1   // xlContinuous = 1
      oExcel:Selection:Borders(8):Weight    := -4138   // xlThin = 2, xlHairLine = 1, xlThick = 4, xlMedium = -4138

      for nXCol := 1 TO Len ( aCols )
         oCol   := aCols[ nXCol ]
         nCol ++
         if oCol:lTotal
            cFormula:= "SUBTOTAL(" + ;
                        LTrim( Str( FW_DeCode( IfNil( oCol:nFooterType, 0 ), AGGR_SUM, 9, AGGR_MAX, 4, AGGR_MIN, 5, ;
                        AGGR_COUNT, 3, AGGR_AVG, 1, AGGR_STDEV, 7, AGGR_STDEVP, 8, 9 ) ) ) + ;
                        "," + ;
                        oSheet:Range( oSheet:Cells( 2, nCol ), ;
                                      oSheet:Cells( nRow - 1, nCol ) ):Address( .f., .f. ) + ;
                        ")"
            oSheet:Cells( nRow, nCol ):Formula := '=' + ExcelTranslate( cFormula )
            lAnyTotals := .t.
         endif
      next nXCol
      if lAnyTotals
        oExcel:Selection:Borders(9):LineStyle := 1   // xlContinuous = 1
        oExcel:Selection:Borders(9):Weight    := 4   // xlThin = 2, xlHairLine = 1, xlThick = 4, xlMedium = -4138
      endif
   endif

   for nCol := 1 to Len( aCols )
      if aWidths[ nCol ] == nil
         oSheet:Columns( nCol ):AutoFit()
      endif
      oSheet:Columns( nCol ):VerticalAlignment := -4108  // xlCenter
   next

   oSheet:Cells(1,1):Select()
   oWin   := oExcel:ActiveWindow
   oWin:SplitRow := 1
   oWin:FreezePanes := .t.

   if ::lGrpHeader == .t.

      nGrpStart   := 0

      WITH OBJECT oSheet:Rows( "1:1" )
         :Insert()
         :Font:Bold := .t.
      END
      for n := 1 to Len( ::aCols )
         cGrpHdr     := ::aCols[ n ]:cGrpHdr
         if Empty( cGrpHdr )
            cPrvHdr     := nil
            if nGrpStart > 0
               oRange   := oSheet:Range( oSheet:Cells( 1, nGrpStart ), oSheet:Cells( 1, nGrpLast ) )
               oRange:MergeCells := .t.
               oRange:HorizontalAlignment := -4108
            endif
            nGrpStart   := 0
            nGrpLast    := 0
            oRange   := oSheet:Range( oSheet:Cells( 1, n ), oSheet:Cells( 2, n ) )
            oRange:MergeCells := .t.
         else
            if cGrpHdr == cPrvHdr
               nGrpLast    := n
            else
               oSheet:Cells( 1, n ):Value := cGrpHdr
               cPrvHdr     := cGrpHdr
               if nGrpStart > 0
                  oRange   := oSheet:Range( oSheet:Cells( 1, nGrpStart ), oSheet:Cells( 1, nGrpLast ) )
                  oRange:MergeCells := .t.
                  oRange:HorizontalAlignment := -4108
               endif
               nGrpStart   := n
               nGrpLast    := n
            endif
         endif
      next

   endif
/*
   oSheet:Cells(1,1):Select()
   oWin   := oExcel:ActiveWindow
   oWin:SplitRow := 1
   oWin:FreezePanes := .t.
*/


//   oWin:DisplayZeros := .f.

   Eval( ::bBookMark, uBookMark )
   ::Refresh()
   ::SetFocus()

   if ValType( cPDF ) == 'C'

      cPdf        := cFileSetExt( cPDF, "pdf" )
      cPdf        := TrueName( cPDF )
      if bPrePDF != nil
         Eval( bPrePDF, oSheet, Self )
      endif
      oSheet:Parent:ExportAsFixedFormat( 0, cpdf, AdoDefault(), AdoDefault(), ;
                 AdoDefault(), AdoDefault(), AdoDefault(), lShow )

      SysRefresh()

   elseif lShow
      oExcel:ScreenUpdating   := .t.
      oExcel:visible          := .T.
      ShowWindow( oExcel:hWnd, 3 )
      BringWindowToTop( oExcel:hWnd )
     
      SysRefresh()  // Albeiro Valencia 01-09-2019

#ifndef __XHARBOUR__
   else
      //
      SysRefresh()
      //
      // This requires explanation.
      // With xHarbour there is no problem. Problem is with Harbour only
      // return value of this function is oSheet which is an Object. xHarbour returns as object
      // If SysRefresh() is called here, Harbour returns oSheet as an object
      // if not it returns an Array of two numeric elements.
      // I am unable to understand this phenomenon.
      // Till we understand what is happening, keep SysRefresh() here for
      // Harbour build.
      // 2015-06-02
#endif
   endif

return oSheet

//--------------------------------------------------

static function SetExcelLanguage( oExcel )

   if nxlLangID == nil
      nxlLangID   := ExcelLangID()
      cxlTrue     := ExcelTranslate( "TRUE" )
      cxlFalse    := ExcelTranslate( "FALSE" )
      lxlEnglish  := ( ExcelLang() == 'en' )
   endif

return nil

//--------------------------------------------------

Function ReportExcel( bHeader, bFooter, nGroupBy, aCols, lShow, cPDF, bPrePDF )
    Local bMeter
    Local Self := HB_QSelf()
 
  bMeter := <| oMeter, oText, oDlg, lEnd |
 
              Export2Excel( Self, oMeter, oText, oDlg, @lEnd,;
                                        bHeader, bFooter,;
                            nGroupBy, aCols, lShow, cPDF, bPrePDF )
             
              Return Nil
             
            >
 
    MsgMeter( bMeter, Nil, "Creando Reporte Excel" )
   
    ::SetFocus()
                       
Return Nil
                     
//--------------------------------------------------

static Function Export2Excel( oBrw, oMeter, oText, oDlg, lEnd,;
                                                            bHeader, bFooter,;
                              nGroupBy, aCols, lShow, cPDF, bPrePDF )
  Local oSheet
  Local bMeter
 
  bMeter := <|n, t|
 
             oMeter:nTotal = t
             oMeter:Set( n )
             oText:SetText( "Exportando " + LTrim(Str(n)) + " / " + LTrim(Str(t)) + " Filas" )
             oDlg:Update()
             
             Return .T.
             
            >
             
   oSheet := oBrw:ToExcel( bMeter, nGroupBy, aCols, lShow, cPDF, bPrePDF )
   
   if bHeader != Nil
        Eval( bHeader, oBrw, oSheet )
        sysrefresh()
     endif
   
     if bFooter != Nil
        Eval( bFooter, oBrw, oSheet )
        sysrefresh()
     endif
              
Return Nil

//----------------------------------------------------//

Function ExcelGetlLastRow( oSheet )
  Local nRows
   
  // nRows := oSheet:UsedRange:Rows:Count()
    nRows = oSheet:Cells:Find("*", oSheet:Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious):Row
Return nRows

//----------------------------------------------------//

Function ExcelGetlLastCol( oSheet )
    Local nCols
   
    // nCols := oSheet:UsedRange:Columns:Count()
    nCols = oSheet:Cells:Find("*", oSheet:Cells(1, 1), xlFormulas, xlPart, xlByColumns, xlPrevious):Column
Return nCols

//--------------------------------------------------

Function MyAdjust()
    Local Self := HB_QSelf()
  Local nFor, nLen, nHeight, nStyle, nTemp, oCol, h

   if ::nMarqueeStyle == MARQSTYLE_HIGHLWIN7
      if ValType( Eval( ::bClrSelFocus )[ 2 ] ) != 'A'
         ::bClrSelFocus := { || { CLR_BLACK, { { 1, RGB( 220, 235, 252 ), ;
                                                    RGB( 193, 219, 252 ) } } } }
      endif
      if ValType( Eval( ::bClrSel )[ 2 ] ) != 'A'
         ::bClrSel := ::bClrSelFocus
      endif
   endif

   if ValType( ::nRecSelWidth ) == 'C'
      ::nRecSelWidth := CalcTextWH( Self, ::nRecSelWidth, IfNil( ::oRecSelFont, ::oFont ) )[ 1 ] + ;
         6 + 5 + nBmpWidth( ::hBmpRecSel ) + 6
   endif

   if ::nRecSelHeadBmpNo != nil .and. ValType( ::nRecSelHeadBmpNo ) != 'N'
      ::nRecSelHeadBmpNo   := ::AddBitmap( ::nRecSelHeadBmpNo )
   endif

   if ::nRecSelBarBmpNo != nil .and. ValType( ::nRecSelBarBmpNo ) != 'N'
      ::nRecSelBarBmpNo   := ::AddBitmap( ::nRecSelBarBmpNo )
   endif

/*
   if ::lFlatStyle
      ::l2007  := .f.
   endif
*/

   ::CheckSize()

   nLen    := Len( ::aCols )
   nHeight := 0

   if ! Empty( ::nHeader )    // Backward Compatibility with earlier GroupHeader logic
      nTemp      := 0
      for nFor := 1 to nLen
         WITH OBJECT ::aCols[ nFor ]
            if :nHeaderType > 0  //.and. :nHeaderType != 3 //( uncomment for full compat with Mr. Silvio's earlier code,
                                                           //  but inconsitent with documentation )
               if :nHeaderType == 2 .or. :nHeaderType == 4  // type 4 was undocumented, but used in earlier samples
                  nTemp++
               endif
               if nTemp <= Len( ::aHeaderTop )
                  :cGrpHdr   := ::aHeaderTop[ nTemp ]
               endif
            endif
         END
      next
   endif  // End backward compatibility

   ::GetDC()

   for nFor := 1 to nLen
      ::aCols[ nFor ]:Adjust()
   next

   ::ReleaseDC()

   ::CalcHdrHeight()
    DEFAULT ::nGetBarHeight   := FontHeight( Self, IfNil( ::oFont, ::oWnd:oFont ) ) + 8

   if ::lFooter .and. ::nFooterHeight == nil
      nHeight := 0
      for nFor := 1 to nLen
         nHeight := Max( nHeight, ::aCols[ nFor ]:FooterHeight() )
      next
      ::nFooterHeight := ( nHeight * ::nFooterLines ) + ROW_EXTRAHEIGHT + 3 // lines to give 3d look
   endif

   for each oCol in ::aCols
      if ! Empty( oCol:aRows )
         AEval( oCol:aRows, { |o| oCol:nWidth := Max( oCol:nWidth, o:nWidth ) } )
         AEval( oCol:aRows, { |o| o:nWidth := oCol:nWidth } )
      endif
   next oCol

   if ::nRowHeight == nil
      nHeight := 0
      for nFor := 1 to nLen
         nHeight := Max( nHeight, ::aCols[ nFor ]:DataHeight() )
      next
      // if some columns have multiple rows
      for each oCol in ::aCols
         if ! Empty( oCol:aRows )
            h  := 0
            AEval( oCol:aRows, { |o| h += o:nCellHeight } )
//            nHeight  := Max( nHeight, Ceiling( h / ::nDataLines ) )
            nHeight  := Max( nHeight, h )
         endif
      next oCol

//      ::nRowHeight := ( nHeight * ::nDataLines ) + ROW_EXTRAHEIGHT //+ 2 // lines to give 3d look
      ::nRowHeight := nHeight + ROW_EXTRAHEIGHT //+ 2 // lines to give 3d look
      if ::nRowDividerStyle != LINESTYLE_NOLINES
         ::nRowHeight++
      endif
      if ::nRowDividerStyle >= LINESTYLE_INSET
         ::nRowHeight++
      endif
   endif

   DEFAULT ::hBtnShadowPen := CreatePen( PS_SOLID, 1, GetSysColor( COLOR_BTNSHADOW ) ),;
           ::hWhitePen     := CreatePen( PS_SOLID, 1, GetSysColor( COLOR_BTNHIGHLIGHT ) )

   if ::hColPen != nil
      DeleteObject( ::hColPen )
      ::hColPen := nil
   endif

   nStyle := ::nColDividerStyle

   do case
   case nStyle == LINESTYLE_BLACK .or. nStyle == LINESTYLE_RAISED .or. nStyle == LINESTYLE_INSET
      ::hColPen := CreatePen( If( ::nColorPen == nil, PS_NULL, PS_SOLID ), ::nSizePen, ::nColorPen )
   case nStyle == LINESTYLE_DARKGRAY
      ::hColPen := CreatePen( PS_SOLID, ::nSizePen, CLR_GRAY )
   case nStyle == LINESTYLE_FORECOLOR
      ::hColPen := CreatePen( PS_SOLID, ::nSizePen, ::nClrText )
   case nStyle == LINESTYLE_LIGHTGRAY
      ::hColPen := CreatePen( PS_SOLID, ::nSizePen, CLR_LIGHTGRAY )

   end case
   
   // http://forums.fivetechsupport.com/viewt ... 72#p234672
   // XBROWSE memory leak - SOLVED
     if ::hRowPen != nil
          DeleteObject( ::hRowPen )
          ::hRowPen := nil
     endif
   
   nStyle := ::nRowDividerStyle

   do case
   case nStyle == LINESTYLE_BLACK .or. nStyle == LINESTYLE_RAISED .or. nStyle == LINESTYLE_INSET
      ::hRowPen := CreatePen( If( ::nColorPen == nil, PS_NULL, PS_SOLID ), ::nSizePen, ::nColorPen )
   case nStyle == LINESTYLE_DARKGRAY
      ::hRowPen := CreatePen( PS_SOLID, ::nSizePen, CLR_GRAY )
   case nStyle == LINESTYLE_FORECOLOR
      ::hRowPen := CreatePen( PS_SOLID, ::nSizePen, ::nClrText )
   case nStyle == LINESTYLE_LIGHTGRAY
      ::hRowPen := CreatePen( PS_SOLID, ::nSizePen, CLR_LIGHTGRAY )

   end case

   if ::nRecSelColor == nil
      ::nRecSelColor := If( ::l2000, nRGB( 231, 242, 255 ), Eval( ::bClrHeader )[ 2 ] )
   endif

   if ::hBrushRecSel != nil
      DeleteObject( ::hBrushRecSel )
   endif
   ::hBrushRecSel = CreateColorBrush( ::nRecSelColor )

   ::GetDisplayCols()

   ::KeyCount()

   if ::lMultiSelect   // ::nMarqueeStyle == MARQSTYLE_HIGHLROWMS .or. ::nMarqueeStyle == MARQSTYLE_HIGHLWIN7
      ::Select(1)
   endif

   if ::oVScroll != nil
      ::VSetRange( 1, ::nLen )
      ::VUpdatePos()
   endif

   ::lAdjusted    := .t.

   AEval( ::abOnAdjust, { |b| Eval( b ) } )

   ::ColStretch()

   if ::lLockFreeze
      ::nColSel   := ::nFreeze + 1
   endif

   ::lScreenUpdating := .t.
   DEFINE CLIPBOARD ::oClp OF Self

return nil

//--------------------------------------------------

static function FontHeight( oBrw, oFont )

   local hDC
   local nHeight

   hDC := oBrw:GetDC()
   oFont:Activate( hDC )
   nHeight := GetTextHeight( oBrw:hWnd, hDC )
   oBrw:ReleaseDC()

return nHeight

//--------------------------------------------------

static function CreateColorBrush( uClr )

   if ValType( uClr ) == 'A'
      uClr     := uClr[ 1 ][ 2 ]
   endif

   if uClr == nil
      return GetStockObject( NULL_BRUSH )
   endif

return CreateSolidBrush( uClr )

//--------------------------------------------------

Function HazC5ToolTip( oCtrl, cMessage )
    Local oTip
    Local oWnd:= WndMain()
   
    default cMessage := "Informacion ToolTip"  
       
    if hb_isObject(oCtrl)
       
        //New( nTop, nLeft, nWidth, nHeight, oWnd, lDisenio, nClrPane, nClrPane2, nClrText, nWRadio, nHRadio ) CLASS TC5ToolTip
        oTip := TC5ToolTip():New( 0,0 , 200, 150, oWnd, , CLR_HGRAY, CLR_HGRAY, CLR_BLUE, 0 , 0 )

        oTip:nTimer       := -1 //15000  
        oTip:lLineHeader  := .T.
        oTip:cHeader      := "WinAdmin"
        oTip:cBmpHeader   := "AVCSIS_16" // "d:\fwh\bitmaps\16edit.bmp"

        oTip:cHeader2     := "Header 2"

        oTip:lLineFoot    := .T.
        oTip:cFoot        := "(c)(R) Albeiro Valencia"
        oTip:cBmpFoot     := "d:\fwh\bitmaps\16object.bmp"

        oTip:lSplitHdr    := .T.
        oTip:lLeft        := .T.
        oTip:cBmpLeft     := "d:\fwh\bitmaps\16code.bmp"

        oTip:lRightAlignBody  := .T.
        oTip:cBody            := cMessage  //Memoread( "tooltip.prg")

        oTip:lBtnClose    := .F.   //.T.
        oTip:lBorder      := .F.

        // oTip:lBalloon     := .T.

        oCtrl:oToolTip    := oTip
   
    else
   
      oTip := cMessage
   
    endif   
   
Return oTip

// FINAL
 
Saludos,
Regards,

Albeiro Valencia
www.avcsistemas.com
User avatar
albeiroval
 
Posts: 378
Joined: Tue Oct 16, 2007 5:51 pm
Location: Barquisimeto - Venezuela

Re: xbrowse No existe el metodo: LREADONLY

Postby nageswaragunupudi » Sun Mar 03, 2024 3:19 am

It is difficult for us to support modified classes.
Please try your sample with xbrowse as released by FWH without any modifications and see if you get any error.
If you still get error, then please provide a small sample which we can test at our end.
Regards

G. N. Rao.
Hyderabad, India
User avatar
nageswaragunupudi
 
Posts: 10646
Joined: Sun Nov 19, 2006 5:22 am
Location: India

Re: xbrowse No existe el metodo: LREADONLY

Postby JoseAlvarez » Sun Mar 03, 2024 8:26 am

albeiroval wrote:Hola Jesus.
JESUS MARIN wrote:estas modificando aArray, pero como está definido como variable local y no lo devuelves a la función que lo llama, es posible que te dé un error.


Como vez estoy pasando el parametro oBrw a la funcion y le asigno el valor del array en SetArray por lo tanto no es necesario devolver el array modificado ni tampoco usar aArrayData ya que el method SetArray lo hace.

De todas maneras la funcion GetUsuarios_FS84( aArray, oBrw ), trabaja bien (tambien habia probado retornando el array modificado y asignandolo a la DATA aArrayData). El problema esta en el GPF que genera al tratar de salir del dialogo o al hacer click en mas de 4 veces al boton. Si vez los archivos de error veraz donde casca el error.


Creo que al momento de llamar la funcion y enviar los parametros, estas obviando el simbolo " @ "

Code: Select all  Expand view  RUN
GetUsuarios_FS84( @aArray, @oBrw )


al enviarlos sin @ estas enviando una copia, no el original.

Otra solución sería que declares las variables aArray y oBrw de tipo Static al inicio del PRG, asi serán reconocidas en todo el prg y sus funciones y no será necesarrio pasarlas como parametros.

prueba...
"Los errores en programación, siempre están entre la silla y el teclado..."

Fwh 19.06 32 bits + Harbour 3.2 + Borland 7.4 + MariaDB + TDolphin

Carora, Estado Lara, Venezuela.
User avatar
JoseAlvarez
 
Posts: 797
Joined: Sun Nov 09, 2014 5:01 pm

Re: xbrowse No existe el metodo: LREADONLY

Postby albeiroval » Sun Mar 03, 2024 7:50 pm

Mr Rao.
nageswaragunupudi wrote:It is difficult for us to support modified classes.
Please try your sample with xbrowse as released by FWH without any modifications and see if you get any error.
If you still get error, then please provide a small sample which we can test at our end.


I stopped using my modified xbrowse class for the example, it no longer gives an error when loading data, but sometimes it generates gpf when clicking on the exit button, for now I am going to use it like this, the example that asks me does not I can do it, it uses a TCP/IP biometric device. If it is not connected, the example works correctly
Saludos,
Regards,

Albeiro Valencia
www.avcsistemas.com
User avatar
albeiroval
 
Posts: 378
Joined: Tue Oct 16, 2007 5:51 pm
Location: Barquisimeto - Venezuela

Re: xbrowse No existe el metodo: LREADONLY

Postby Antonio Linares » Mon Mar 04, 2024 5:19 am

Estimado Albeiro,

Prueba a comentar estas dos líneas para solucionar los GPFs:
// if ( userList.m_ArrayUsers )
// hb_xfree( userList.m_ArrayUsers );

No se ve que llames a hb_xgrab() en tu código, luego esa llamada a hb_xfree() está de más.
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42118
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: xbrowse No existe el metodo: LREADONLY

Postby albeiroval » Mon Mar 04, 2024 3:36 pm

Hola Antonio.

Antonio Linares wrote:Estimado Albeiro,

Prueba a comentar estas dos líneas para solucionar los GPFs:
// if ( userList.m_ArrayUsers )
// hb_xfree( userList.m_ArrayUsers );

No se ve que llames a hb_xgrab() en tu código, luego esa llamada a hb_xfree() está de más.


Voy a hacer lo que me cometas. Igual voy a postear el codigo porque en la clase CFamUserList.cpp yo llamo a
hb_xgrab para asignar memoria en la variable "m_ArrayUsers", pero no si esta bien liberarla en la funcion y no en la clase.

Yo hize un wrapper en "C" del sdk que proporciona el fabricante. Te anexo el codigo de la clase "CFamUserList", y el
codigo que uso para invocar esta clase. A lo mejor hay alguna variable de memoria que no libero. Si puedes revisarlo
seria estupendo.

Gracias

CFamUserList.cpp
Code: Select all  Expand view  RUN

#include <windows.h>
#include <hbapi.h>
#include <hbapiitm.h>

#include "FamDefs.h"
#include "FamUserList.h"

//---------------------------------------------------   

PBYTE pUserList;

void Msg( LPCTSTR cMsg );

//---------------------------------------------------   

CFamUserList::CFamUserList()
{
    m_nID_L = 0;
    m_nID_H = 0;
    m_nUType = 0;
    m_ArrayUsers = NULL;
    pUserList = NULL;
}

//---------------------------------------------------   

CFamUserList::~CFamUserList()
{      
}

//---------------------------------------------------   

BOOL CFamUserList::DeleteUser( UINT nIDL, UINT nIDH )
{
    BOOL bResult;
    BYTE m_nErrorCode;
       
    if( famComm.PrepareConnection() != 0 )
    {
        famComm.PrintErrorMessage();
        return false;
    }
   
    m_nErrorCode = famComm.FamDeleteOneUser( nIDL, nIDH );
    if( m_nErrorCode == 0 )
    {
        Msg("FAM User is deleted.");
        bResult = true;
    }
    else
    {   
        famComm.PrintErrorMessage();
        bResult = false;
    }   

    famComm.CloseConnection();
   
    return bResult;
}
   
//---------------------------------------------------      

UINT CFamUserList::GetLenDatabase()
{
    UINT nListLength = 0;
       
    if( famComm.PrepareConnection() != 0 )
    {
        famComm.PrintErrorMessage();
    }
 
    m_nErrorCode = famComm.FamGetUserListLength( &nListLength );
    if( m_nErrorCode != 0 )
    {
        famComm.PrintErrorMessage();
    }   
 
  famComm.CloseConnection();
 
  if( nListLength == 0 )
    {
      Msg("Empty database in FAM!");
    }
           
    return nListLength;
}          

//---------------------------------------------------   

BOOL CFamUserList::GetListDatabase()
{
    UINT m_nLength   = GetLenDatabase();
    UINT nListLength = m_nLength / 12;
                   
    if( nListLength != 0 )
    {
        if( famComm.PrepareConnection() != 0 )
        {
            famComm.PrintErrorMessage();
            return false;
        }
         
      pUserList = (PBYTE) hb_xgrab( nListLength );
       
        if( !famComm.FamGetUserList( pUserList ) )
        {
            Msg("Failed to get the user's list!");
            famComm.CloseConnection();
            return false;
        }
        else
        {
            famComm.CloseConnection();  
            return true;
        }   
                       
    }
   
    return false;
       
}   
   
//---------------------------------------------------   

void CFamUserList::GetArrayDatabase()
{
    UINT m_nLength  = GetLenDatabase();
    UINT nTotalUser = m_nLength / 12;
    PFAMUSER pUser;
    UINT nIDL, nIDH;
           
    pUser = (PFAMUSER) hb_xgrab( nTotalUser * sizeof(FAMUSER) );
           
  UINT i, j;
  for( i=0; i<nTotalUser; i++ )
    {
        nIDH = 0;
        memcpy(&nIDL, pUserList+i*12, 4);
        memcpy(&nIDH, pUserList+i*12+4, 2);
        pUser[i].FingerID = pUserList[i*12+6];
        pUser[i].GroupID = pUserList[i*12+7];
        pUser[i].UserType = pUserList[i*12+8];
        pUser[i].UserID= nIDL + nIDH*0x100000000I64;
        // pUser[i].UserID= nIDL + nIDH*0x100000000;
    }
           
    // sort the user list
    FAMUSER tmpUser;
    for( i=0; i<nTotalUser-1; i++ )
    {
        for( j=i+1; j<nTotalUser; j++ )
        {
            if( pUser[i].UserID > pUser[j].UserID )
            {
                tmpUser.GroupID = pUser[i].GroupID;
                tmpUser.FingerID = pUser[i].FingerID;
                tmpUser.UserID = pUser[i].UserID;
                tmpUser.UserType = pUser[i].UserType;
                pUser[i].GroupID = pUser[j].GroupID;
                pUser[i].FingerID = pUser[j].FingerID;
                pUser[i].UserID = pUser[j].UserID;
                pUser[i].UserType = pUser[j].UserType;
                pUser[j].GroupID = tmpUser.GroupID;
                pUser[j].FingerID = tmpUser.FingerID;
                pUser[j].UserID = tmpUser.UserID;
                pUser[j].UserType = tmpUser.UserType;
            }
        }
    }
               
    m_ArrayUsers = (PRECORD) hb_xgrab( nTotalUser * sizeof(RECORD) );   <--------- AQUI ASIGNO MEMORIA
       
  char strGID[10];
  char strUID[10];
  char strFID[10];
  char strUType[10];
  char strStatus[10];
  char strSL[10];
  BYTE nType;  
 
  for( i=0; i<nTotalUser; i++ )
    {
        wsprintf( strGID, "%d", pUser[i].GroupID );
        wsprintf( strUID, "%I64u", pUser[i].UserID );
        wsprintf( strFID, "%d", pUser[i].FingerID );
                       
        nType = pUser[i].UserType;
        if( nType & 0x04 )
            strcpy( strUType, "VIP" );
        else
            strcpy( strUType, "Ordinary");
           
        if( nType & 0x08 )
            strcpy( strStatus, "Suspend" );
        else
            strcpy( strStatus, "Active" );
                       
        nType = nType & 0x03;
        wsprintf( strSL, "%d",nType );     
       
        strcpy( m_ArrayUsers[i].GroupID,    strGID );
        strcpy( m_ArrayUsers[i].UserID,     strUID );
        strcpy( m_ArrayUsers[i].FingerID, strFID );
        strcpy( m_ArrayUsers[i].UserType, strUType );
        strcpy( m_ArrayUsers[i].Status,     strStatus );
        strcpy( m_ArrayUsers[i].SL,             strSL );
               
    }
                       
    hb_xfree(pUser);                   
                       
}

//---------------------------------------------------   

void Msg( LPCTSTR cMsg )
{
    MessageBox( 0, cMsg, "Informacion", MB_OK | MB_ICONINFORMATION );
}

 


FamUsers.cpp
Code: Select all  Expand view  RUN

#include <windows.h>
#include <hbapi.h>
#include <hbapiitm.h>
#include <hbapierr.h>

#include "famUserList.h"

//---------------------------------------------------   

void Msg( LPCTSTR cMsg );

//---------------------------------------------------   

HB_FUNC( FAM_GETLENDATABASE )
{
    UINT m_nLength;
    CFamUserList userList;
   
    m_nLength = userList.GetLenDatabase();
   
    int nLength = (int) m_nLength / 12;
    hb_retni( nLength );
}   

//---------------------------------------------------   

HB_FUNC( FAM_ARRAYUSERS )
{
    PHB_ITEM pArray  = hb_itemArrayNew( 0 );
    PHB_ITEM itemRow = hb_itemNew( NULL );
   
    CFamUserList userList;
       
    if( userList.GetListDatabase() )
    {          
        UINT i;
        UINT m_nLength   = userList.GetLenDatabase();
        UINT nTotalUser  = m_nLength / 12;
       
        userList.GetArrayDatabase();
                                           
        for( i=0; i<nTotalUser; i++ )
        {
            hb_arrayNew( itemRow, 7 );
                                   
            hb_arraySetC ( itemRow, 1, userList.m_ArrayUsers[i].GroupID );
            hb_arraySetC ( itemRow, 2, userList.m_ArrayUsers[i].UserID );
            hb_arraySetC ( itemRow, 3, " " );
            hb_arraySetC ( itemRow, 4, userList.m_ArrayUsers[i].FingerID );
            hb_arraySetC ( itemRow, 5, userList.m_ArrayUsers[i].UserType );
            hb_arraySetC ( itemRow, 6, userList.m_ArrayUsers[i].Status );
            hb_arraySetC ( itemRow, 7, userList.m_ArrayUsers[i].SL );
                                                                       
        hb_arrayAddForward( pArray, itemRow );
               
    }
   
    if ( userList.m_ArrayUsers )
         hb_xfree( userList.m_ArrayUsers );   [b]<------- AQUI LIBERO MEMORIA[/b]
             
  }
  else
  {
        hb_arrayNew( itemRow, 7 );
                                   
            hb_arraySetC ( itemRow, 1, " " );
            hb_arraySetC ( itemRow, 2, " " );
            hb_arraySetC ( itemRow, 3, " " );
            hb_arraySetC ( itemRow, 4, " " );
            hb_arraySetC ( itemRow, 5, " " );
            hb_arraySetC ( itemRow, 6, " " );
            hb_arraySetC ( itemRow, 7, " " );
                                                                       
        hb_arrayAddForward( pArray, itemRow );
  }
   
  hb_itemRelease( itemRow );  
  hb_itemReturnRelease( pArray );
   
}   

//---------------------------------------------------   

HB_FUNC( FAM_DELETEALLUSER )
{
  CFamComm famComm;
  BYTE m_nErrorCode;
 
    if( famComm.PrepareConnection() != 0 )
    {
        famComm.PrintErrorMessage();
        return;
    }
   
    m_nErrorCode = famComm.FamDeleteAllUser();
    if( m_nErrorCode == 0 )
        Msg( "Se Borraron Todos Los Usuarios" );
    else
        famComm.PrintErrorMessage();
       
    famComm.CloseConnection();
}

//---------------------------------------------------   

HB_FUNC( FAM_DELETESINGLE )
{
    unsigned __int64 nUserID = (unsigned __int64) hb_parni(1);
    BYTE nGroupID = (BYTE) hb_parni(2);
    BYTE nFingerID = (BYTE) hb_parni(3);
   
  UINT nIDL = (UINT) nUserID;
    // UINT nIDH = (UINT) ( nUserID / 0x100000000 );  
    UINT nIDH = (UINT) ( nUserID / 0x100000000I64 );
    nIDH += nGroupID << 24;
    nIDH += nFingerID << 16;
 
  CFamUserList userList;
   
  if( hb_pcount() == 0 )
  {
    Msg( "Faltan Parametros" );
    hb_retl( false );
  } 
   
  hb_retl( userList.DeleteUser( nIDL, nIDH ) );
}

 
Saludos,
Regards,

Albeiro Valencia
www.avcsistemas.com
User avatar
albeiroval
 
Posts: 378
Joined: Tue Oct 16, 2007 5:51 pm
Location: Barquisimeto - Venezuela

Next

Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: Google [Bot] and 85 guests