FiveTech Software tech support forums

by **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: 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: 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: 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 ); }

by **cmsoft** » Fri Mar 01, 2024 4:32 pm

Que hace la funcion GetUsuarios ?

by **albeiroval** » Fri Mar 01, 2024 4:57 pm

Hola Cesar.

cmsoft wrote:Que hace la funcion GetUsuarios ?

Code: Select all Expand view: 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

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

Buenas tardes

En esta función ....

Code: Select all Expand view: 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: *** oBrw:SetArray( aArray) <------------ no volver a asignar oBrw:aArrayData = aArray <------------ actualiza datos y refresca oBrw:Refresh()

Prueba y nos cuentas

by **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.

by **karinha** » Fri Mar 01, 2024 7:53 pm

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

Gracias.

Regards, saludos.

by **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
>

by **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: #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

by **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: 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.

by **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: // 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

by **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.

by **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: 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...

by **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

by **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.

by **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: #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: #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 ) ); }

FiveTech Software tech support forums

xbrowse No existe el metodo: LREADONLY

xbrowse No existe el metodo: LREADONLY

Re: xbrowse No existe el metodo: LREADONLY

Re: xbrowse No existe el metodo: LREADONLY

Re: xbrowse No existe el metodo: LREADONLY

Re: xbrowse No existe el metodo: LREADONLY

Re: xbrowse No existe el metodo: LREADONLY

Re: xbrowse No existe el metodo: LREADONLY

Re: xbrowse No existe el metodo: LREADONLY

Re: xbrowse No existe el metodo: LREADONLY

Re: xbrowse No existe el metodo: LREADONLY

Re: xbrowse No existe el metodo: LREADONLY

Re: xbrowse No existe el metodo: LREADONLY

Re: xbrowse No existe el metodo: LREADONLY

Re: xbrowse No existe el metodo: LREADONLY

Re: xbrowse No existe el metodo: LREADONLY

Who is online