Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)

Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить

Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)

gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).

Ответов - 300, стр: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 All

Andrey: Убрал из примера HB_FUNC( DESTROYICON) - модуль demos_util.prg Теперь в checkres.txt следующее: [pre2]C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,84219576,COLUMN_TSB(136)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,84219576,COLUMN_TSB(136)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,117774005,COLUMN_TSB(136)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,84219576,COLUMN_TSB(136)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,117774005,COLUMN_TSB(136)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,67442359,COLUMN_TSB(136)->MAIN(91) .... и т.д. C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,67442359,COLUMN_TSB(136)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,50665150,COLUMN_TSB(140)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,33887935,COLUMN_TSB(140)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,33887936,COLUMN_TSB(140)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,33887937,COLUMN_TSB(140)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,33887938,COLUMN_TSB(140)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,33887939,COLUMN_TSB(140)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,33887940,TSBROWSE:NEW(1560)->_DEFINETBROWSE(314)->_TBROWSE(559)->MAIN(102) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BRUSH,1242568359,TSBROWSE:SETCOLOR(13377)->TSBROWSE:NEW(1660)->_DEFINETBROWSE(314)->_TBROWSE(559)->MAIN(102) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BRUSH,1024464538,_TBROWSE(559)->MAIN(102) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,17110726,(b)MAIN(96)->_TBROWSE(572)->MAIN(102) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BRUSH,1997543076,(b)MAIN(98)->_TBROWSE(579)->MAIN(102)[/pre2] Размер checkres.txt - 11158 байт И как его сокращать/убирать утечку памяти ? Вот у себя в коде нашёл незакрытый хендл [pre2] FOR nI := 1 TO LEN(aImg) hIco := LoadIconByName( aImg[nI], nHImg, nHImg ) hBmp := BmpFromIcon( hIco ) // вернет хендл bmp cFile := cPath + aImg[nI] + ".png" HMG_SaveImage( hBmp, cFile, "png" ) ....[/pre2] Как его убить ? А что делать с этим ? [pre2] BMP,33887940,TSBROWSE:NEW(1560)->_DEFINETBROWSE(314)->_TBROWSE(559)->MAIN(102)[/pre2]

SergKis: Andrey пишет Как его убить ? DeleteObject( hBmp )

Andrey: Размер checkres.txt уменьшился до 11285 (было 11158) байт Остались тоже самое:[pre2] C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,-234549685,COLUMN_TSB(136)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,-234549685,COLUMN_TSB(136)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,1627723450,COLUMN_TSB(136)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,-234549685,COLUMN_TSB(136)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,1627723450,COLUMN_TSB(136)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,2080708307,COLUMN_TSB(136)->MAIN(91) ... C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,-184215828,COLUMN_TSB(140)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,486872819,TSBROWSE:NEW(1560)->_DEFINETBROWSE(314)->_TBROWSE(559)->MAIN(102) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BRUSH,1511003877,TSBROWSE:SETCOLOR(13377)->TSBROWSE:NEW(1660)->_DEFINETBROWSE(314)->_TBROWSE(559)->MAIN(102) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BRUSH,890246898,_TBROWSE(559)->MAIN(102) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,1308956330,(b)MAIN(96)->_TBROWSE(572)->MAIN(102) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BRUSH,1343231766,(b)MAIN(98)->_TBROWSE(579)->MAIN(102)[/pre2] Ну и как дальше бороться с утечкой памяти ?

Andrey: [pre2]C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,-184215828,COLUMN_TSB(140)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,486872819,TSBROWSE:NEW(1560)->_DEFINETBROWSE(314)->_TBROWSE(559)->MAIN(102) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BRUSH,1511003877,TSBROWSE:SETCOLOR(13377)->TSBROWSE:NEW(1660)->_DEFINETBROWSE(314)->_TBROWSE(559)->MAIN(102) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BRUSH,890246898,_TBROWSE(559)->MAIN(102) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,1308956330,(b)MAIN(96)->_TBROWSE(572)->MAIN(102) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BRUSH,1343231766,(b)MAIN(98)->_TBROWSE(579)->MAIN(102)[/pre2] У меня большая система, чистку памяти делаю ври входе и выходе в TBROWSE, но всё равно прога ПЕРИОДИЧЕСКИ падает после 4-5 часов работы. Юзер постоянно открывает, то одну/другую/третью/четвертую таблицу. Связано ли это с утечкой памяти в TBROWSE ? Очистку от хендов иконок сделал уже.

gfilatov2002: Andrey пишет: C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,-184215828,COLUMN_TSB(140)->MAIN(91) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,486872819,TSBROWSE:NEW(1560)->_DEFINETBROWSE(314)->_TBROWSE(559)->MAIN(102) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BRUSH,1511003877,TSBROWSE:SETCOLOR(13377)->TSBROWSE:NEW(1660)->_DEFINETBROWSE(314)->_TBROWSE(559)->MAIN(102) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BRUSH,890246898,_TBROWSE(559)->MAIN(102) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BMP,1308956330,(b)MAIN(96)->_TBROWSE(572)->MAIN(102) C:\MiniGUI_24.05\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BRUSH,1343231766,(b)MAIN(98)->_TBROWSE(579)->MAIN(102) Эти ресурсы должны очищаться с помощью метода Destroy() в классе TSBROWSE. Но этот метод НЕ срабатывает, поскольку TBROWSE не получает от системы сообщение WM_DESTROY. Я попытался сделать этот метод деструктором класса, но он все равно НЕ отрабатывает. Сейчас ищу другой способ запустить этот метод на выполнение призакрытии окна, которое содержит элемент управления TBROWSE.

SergKis: gfilatov2002 пишет Сейчас ищу другой способ запустить этот метод на выполнение призакрытии окна, которое содержит элемент управления TBROWSE. Так должен срабатывать цикл WM_DESTROY окна, т.е.[pre2] **************************************************************************** CASE WM_DESTROY **************************************************************************** i := AScan ( _HMG_aFormHandles , hWnd ) IF i > 0 #ifndef __XHARBOUR__ // Remove All HMG_* Properties IF Len( EnumProps( hWnd ) ) > 0 EnumPropsEx( hWnd, {|hWnd, cPropName, hHandle| HB_SYMBOL_UNUSED( hHandle ), ; iif( hb_LeftEqI( cPropName, "HMG_" ), RemoveProp( hWnd, cPropName ), Nil ), .T. } ) ENDIF #endif // Remove Child Controls FOR EACH r IN _HMG_aControlParentHandles IF r == hWnd x := hb_enumindex ( r ) IF _HMG_aControlType [x] == "MESSAGEBAR" _ReleaseControl ( "StatusBar" , GetParentFormName( x ) ) ELSE _EraseControl ( x , i ) ENDIF ENDIF NEXT ... _HMG_aControlType[ k ] := "TBROWSE" _HMG_aControlNames[ k ] := ControlName _HMG_aControlHandles[ k ] := ControlHandle _HMG_aControlParenthandles[ k ] := ParentFormHandle _HMG_aControlIds[ k ] := oBrw ... имеем, значит имеем и _HMG_aControlIds[ k ]:Destroy() PS. Добавить в _EraseControl ( i, p ) обработку CASE t == 'TBROWSE' [/pre2]

gfilatov2002: SergKis пишет: Добавить в _EraseControl ( i, p ) обработку CASE t == 'TBROWSE' Да, так получилось сделать Уже намного лучше. Но осталось удалить BRUSH, который создается в методе SetColor() класса TControl

SergKis: gfilatov2002 Но осталось удалить BRUSH, который создается в методе SetColor() класса TControl FUNCTION _DefineTBrowse добавил [pre2] IF HB_ISARRAY( aBrush ) .AND. Len( aBrush ) > 2 IF oBrw:hBrush != NIL DeleteObject( oBrw:hBrush ) ENDIF oBrw:hBrush := CreateSolidBrush( aBrush[ 1 ], aBrush[ 2 ], aBrush[ 3 ] ) ENDIF /* BK end */ ... METHOD Enabled( lEnab ) CLASS TSBrowse ... DeleteObject( ::hBrush ) ::hBrush := CreateSolidBrush( GetRed( ::nClrPane ), GetGreen( ::nClrPane ), GetBlue( ::nClrPane ) ) IF ::lSelector .AND. ::lDrawSpecHd ::nClrSpcHdBack := ::nCLR_HGRAY ENDIF ELSE ... но с ::hBrush не все понятно, т.к. есть места TControl.prg без DeleteObject( ::hBrush ) как пример METHOD Colors( hDC ) CLASS TControl DEFAULT ::nClrText := GetTextColor( hDC ), ; ::nClrPane := GetBkColor( hDC ), ; ::hBrush := CreateSolidBrush( GetRed( ::nClrPane ), GetGreen( ::nClrPane ), GetBlue( ::nClrPane ) ) SetTextColor( hDC, ::nClrText ) SetBkColor( hDC, ::nClrPane ) RETURN ::hBrush Если поискать "CreateSolidBrush" в prg, то есть и др. места ... PS. Если взять простой вариант окна MDI, то тоже остается BRUSH не освобожденный DEFINE WINDOW &cForm AT nY, nX WIDTH nW HEIGHT nH TITLE om:cTitle ; MINWIDTH nWm MINHEIGHT nHm ; MAIN MDI TOPMOST ; BACKCOLOR cBClr ; ON INIT _wPost( 0) ; ON RELEASE _wSend(90) ; ON INTERACTIVECLOSE ( _wSend(98), This.Cargo:lClose ) This.Cargo := oHmgData() ; oMain := This.Object This.Cargo:lClose := .T. ... END WINDOW IF lCenter ; CENTER WINDOW &cForm ENDIF ACTIVATE WINDOW &cForm RETURN NIL [/pre2]

gfilatov2002: SergKis пишет: FUNCTION _DefineTBrowse добавил Спасибо за помощь! Сейчас остался не удаленным только один BRUSH c:\minigui\SAMPLES\Advanced\Tsb_oHmgData\demo.exe -- BRUSH,-904917253,_TBROWSE(559)->MAIN(102)

SergKis: gfilatov2002 пишет Сейчас остался не удаленным только один BRUSH С ним, пока и не понятно, т.к. _TBROWSE(559) -> DEFINE TBROWSE &cBrw OBJ oBrw AT nY, nX WIDTH nW HEIGHT nH CELL ; ... BRUSH aBrush ; ... т.е. это FUNCTION _DefineTBrowse( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight, ; ... и дальше параметр aBrush смотрим

Andrey: Вопрос по теме удаления хендлов. Если я делаю так [pre2] LOCAL oBrw, oTsb .... // построение таблицы oTsb := oHmgData() ... oTsb:aBmp1 := { {"bMinus32", "bZero32", "bPlus32"} ,; { LoadImage("bMinus32"), LoadImage("bMinus32"), LoadImage("bMinus32")} ,; , {||блок кода смены картинки}, ... } .... // --------- хранилище картинок, удаляется после закрытия объекта автоматом ------ :aBitMaps := { Nil, LoadImage("bRecDel16") } :aColumns[2]:aBitMaps := oTsb:aBmp1[2] :aColumns[2]:uBmpCell := oTsb:aBmp1[3] // там далее смена картинки по алгоритму в myLoadBmpTsb(...) ....[/pre2] То нафига НУЖНО удалять хендлы из oTsb:aBmp1 если эта переменная LOCAL и после закрытия этой функции переменная oTsb удалиться ????? Или я чего то не знаю ?

Andrey: gfilatov2002 пишет: Сейчас остался не удаленным только один BRUSH Как успехи ? У меня в примере в файле checkres.txt (695 байт) остался BRUSH. А внешней командой можно удалить BRUSH при закрытии окна ?

SergKis: gfilatov2002 hmg-24.05 Исправил (строки //!!!) [pre2] TControl.prg ------------ ... METHOD SetColor( nClrFore, nClrBack, hBrush ) CLASS TControl ::nClrText = nClrFore ::nClrPane = nClrBack If ::hBrush != nil DeleteObject( ::hBrush ) // Alen Uzelac 13.09.2012 ::hBrush := NIL //!!! DoEvents() //!!! EndIf if hBrush != nil ::hBrush := hBrush else ::hBrush := CreateSolidBrush( GetRed( nClrBack ), GetGreen( nClrBack ), GetBlue( nClrBack ) ) endif return nil ... h_TBrowse.prg ------------- ... FUNCTION _DefineTBrowse( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight, ; ... IF HB_ISARRAY( aBrush ) .AND. Len( aBrush ) > 2 IF oBrw:hBrush != NIL //!!! DeleteObject( oBrw:hBrush ) //!!! oBrw:hBrush := NIL //!!! ENDIF //!!! oBrw:hBrush := CreateSolidBrush( aBrush[ 1 ], aBrush[ 2 ], aBrush[ 3 ] ) ENDIF /* BK end */ ControlHandle := oBrw:hWnd ... METHOD Enabled( lEnab ) CLASS TSBrowse ... ::lEnabled := .F. ::SetColor( { 2 }, { ::nCLR_HGRAY } ) ::SetColor( { 3, 4 }, { ::nCLR_GRAY, ::nCLR_HGRAY } ) ::SetColor( { 9, 10 }, { ::nCLR_GRAY, ::nCLR_HGRAY } ) ::SetColor( { 16, 17 }, { ::nCLR_GRAY, ::nCLR_HGRAY } ) ::SetColor( { 18, 19 }, { ::nCLR_GRAY, ::nCLR_HGRAY } ) ::nClrPane := ::nCLR_HGRAY ::nClrLine := ::nCLR_Lines DeleteObject( ::hBrush ) //!!! ::hBrush := NIL //!!! ::hBrush := CreateSolidBrush( GetRed( ::nClrPane ), GetGreen( ::nClrPane ), GetBlue( ::nClrPane ) ) ELSE ... h_events.prg ------------ **************************************************************************** CASE WM_DESTROY **************************************************************************** ... // Remove Child Controls FOR EACH r IN _HMG_aControlParentHandles IF r == hWnd x := hb_enumindex ( r ) IF _HMG_aControlType [x] == "MESSAGEBAR" _ReleaseControl ( "StatusBar" , GetParentFormName( x ) ) ELSEIF _HMG_aControlType [x] == "TBROWSE" //!!! _HMG_aControlIds [x]:Destroy() //!!! ELSE _EraseControl ( x , i ) ENDIF ENDIF NEXT ... [/pre2] Сборка примера Advanced\Tsb_oHmgData\demo.prg дает (OBJ удалил)[pre2] Harbour 3.2.0dev (r2402161723) Copyright (c) 1999-2021, https://harbour.github.io/ Borland Resource Compiler Version 5.40 Copyright (c) 1990, 1999 Inprise Corporation. All rights reserved. OBJ\demo.c: OBJ\Column_TSB.c: OBJ\demo_tsb.c: OBJ\demo_menu.c: OBJ\demo_menu_find.c: OBJ\demo_print.c: OBJ\demos_util.c: OBJ\demos_about.c: OBJ\demos_use.c: OBJ\demo2_tsb_func.c: OBJ\util_button.c: OBJ\util_keychar.c: OBJ\cell_edit_memo.c: OBJ\_hbmkaut_demo.c: Turbo Incremental Link 5.69 Copyright (c) 1997-2005 Borland Error: Unresolved external '_HB_FUN__ADDNEWGLOBAL' referenced from C:\MINIGUIBCC58\LIB\MINIGUI.LIB|h_ini Error: Unresolved external '_HB_FUN__SETGETGLOBAL' referenced from C:\MINIGUIBCC58\LIB\MINIGUI.LIB|h_ini Error: Unresolved external '_HB_FUN_HMG_GET' referenced from C:\MINIGUIBCC58\LIB\MINIGUI.LIB|h_getbox Error: Unresolved external '_HB_FUN_CHECKSTATIC' referenced from C:\MINIGUIBCC58\LIB\MINIGUI.LIB|h_windows Error: Unresolved external '_HB_FUN__SETGETNAMESLIST' referenced from C:\MINIGUIBCC58\LIB\MINIGUI.LIB|h_pubfunc Error: Unresolved external '_HB_FUN_ALERTSTOP' referenced from C:\MINIGUIBCC58\LIB\MINIGUI.LIB|errorsys Error: Unresolved external '_HB_FUN_ALERTINFO' referenced from C:\MINIGUIBCC58\SAMPLES\_TEST\_TSB_OHMGDATA9\OBJ\DEMO2_TSB_FUNC.OBJ Error: Unresolved external '_HB_FUN_ALERTYESNO' referenced from C:\MINIGUIBCC58\SAMPLES\_TEST\_TSB_OHMGDATA9\OBJ\DEMO_TSB.OBJ Error: Unresolved external '_HB_FUN_ALERTOKCANCEL' referenced from C:\MINIGUIBCC58\SAMPLES\_TEST\_TSB_OHMGDATA9\OBJ\DEMO_MENU.OBJ hbmk2[demo]: Error: Running linker. 2 [/pre2] Беру версию hmg-24.04, повторяю правки, пересобираю примеры Advanced\Tsb_oHmgData -> все OK!

gfilatov2002: SergKis пишет: hmg-24.05 Исправил Большое спасибо! Я уже исправил эту утечку ресурсов похожим кодом. Заодно поправил код в классе TGetBox, чтобы освобождались ресурсы при выходе из режима редактирования полей. Не очень понятна необходимость присваивать ::hBrush := NIL //!!! если в следующей строке кода мы снова назначаем ::hBrush := CreateSolidBrush( GetRed( ::nClrPane ), GetGreen( ::nClrPane ), GetBlue( ::nClrPane ) ) У меня происходит освобождение ресурсов и без этой строки ::hBrush := NIL //!!!

SergKis: gfilatov2002 пишет У меня происходит освобождение ресурсов и без этой строки [pre2] If ::hBrush != nil DeleteObject( ::hBrush ) // Alen Uzelac 13.09.2012 ::hBrush := NIL //!!! DoEvents() //!!! EndIf [/pre2] Без выделенной строки сообщение BRUSH из txt файла не уходило, сделав DoEvents(), условную задержку, все стало работать. Поставил везде ::hBrush := NIL, как вариант принудительного сброса адреса и выполненных доп. команд.

SergKis: gfilatov2002 Поправил в тсб [pre2] METHOD New( cControlName, nRow, nCol, nWidth, nHeight, bLine, aHeaders, aColSizes, cParentWnd, ; bChange, bLDblClick, bRClick, cFont, nFontSize, ; hCursor, aColors, aImages, cMsg, lUpdate, uAlias, ; bWhen, nValue, lCellBrw, nStyle, bLClick, aLine, ; aActions, nLineStyle, lRePaint, lDelete, aJust, ; lLock, lAppend, lEnum, lAutoSearch, uUserSearch, lAutoFilter, uUserFilter, aPicture, ; lTransparent, uSelector, lEditable, lAutoCol, aColSel, cTooltip ) CLASS TSBrowse LOCAL aSuperHeaders, ParentHandle, ; aTmpColor := Array( 20 ), ; cAlias := "", ; lSuperHeader := .F., ; hFont, aClr IF HB_ISARRAY( aHeaders ) .AND. Len( aHeaders ) > 0 .AND. aHeaders[ 1 ] == NIL aHeaders := NIL ENDIF IF HB_ISARRAY( aColSel ) .AND. Len( aColSel ) > 0 .AND. aColSel[ 1 ] == NIL aColSel := NIL ENDIF DEFAULT nRow := 0, ; nCol := 0, ; nHeight := 100, ; nWidth := 100, ; nLineStyle := LINES_ALL, ; aLine := {}, ; aImages := {}, ; cFont := _HMG_ActiveFontName, ; nFontSize := _HMG_ActiveFontSize, ; nValue := 0, ; lDelete := .F., ; lAutoFilter := .F., ; lRepaint := .T., ; lAppend := .F., ; lLock := .F., ; lEnum := .F., ; lAutoSearch := .F., ; lTransparent := .F., ; lEditable := .F. IF _HMG_BeginWindowActive cParentWnd := _HMG_ActiveFormName ENDIF aTmpColor[ 1 ] := GetSysColor( COLOR_WINDOWTEXT ) // nClrText aTmpColor[ 2 ] := GetSysColor( COLOR_WINDOW ) // nClrPane aTmpColor[ 3 ] := GetSysColor( COLOR_BTNTEXT ) // nClrHeadFore aTmpColor[ 4 ] := GetSysColor( COLOR_BTNFACE ) // nClrHeadBack aTmpColor[ 5 ] := GetSysColor( COLOR_CAPTIONTEXT ) // nClrForeFocu aTmpColor[ 6 ] := GetSysColor( COLOR_ACTIVECAPTION ) // nClrFocuBack aTmpColor[ 7 ] := GetSysColor( COLOR_WINDOWTEXT ) // nClrEditFore aTmpColor[ 8 ] := GetSysColor( COLOR_WINDOW ) // nClrEditBack aTmpColor[ 9 ] := GetSysColor( COLOR_BTNTEXT ) // nClrFootFore aTmpColor[ 10 ] := GetSysColor( COLOR_BTNFACE ) // nClrFootBack aTmpColor[ 11 ] := CLR_HGRAY // nClrSeleFore inactive focused aTmpColor[ 12 ] := CLR_GRAY // nClrSeleBack inactive focused aTmpColor[ 13 ] := GetSysColor( COLOR_BTNTEXT ) // nClrOrdeFore aTmpColor[ 14 ] := GetSysColor( COLOR_BTNFACE ) // nClrOrdeBack aTmpColor[ 15 ] := GetSysColor( COLOR_BTNSHADOW ) // nClrLine aTmpColor[ 16 ] := GetSysColor( COLOR_BTNTEXT ) // nClrSupHeadFore aTmpColor[ 17 ] := GetSysColor( COLOR_BTNFACE ) // nClrSupHeadBack aTmpColor[ 18 ] := GetSysColor( COLOR_BTNTEXT ) // nClrSpecHeadFore aTmpColor[ 19 ] := GetSysColor( COLOR_BTNFACE ) // nClrSpecHeadBack aTmpColor[ 20 ] := CLR_HRED // nClrSpecHeadActive IF lAutoFilter aTmpColor[ 19 ] := GetSysColor( COLOR_INACTCAPTEXT ) ELSEIF lAutoSearch aTmpColor[ 19 ] := GetSysColor( COLOR_INFOBK ) ENDIF IF HB_ISARRAY( aColors ) .AND. Len( aColors ) > 0 IF HB_ISARRAY( aColors[ 1 ] ) FOR EACH aClr IN aColors IF HB_ISNUMERIC( aClr[ 1 ] ) .AND. aClr[ 1 ] > 0 .AND. aClr[ 1 ] <= Len( aTmpColor ) aTmpColor[ aClr[ 1 ] ] := aClr[ 2 ] ENDIF NEXT ELSE AEval( aColors, {| bColor, nEle | aTmpColor[ nEle ] := bColor } ) ENDIF ENDIF ... [/pre2]

gfilatov2002: SergKis пишет: Поправил в тсб Идея понятна, но после этих изменений начались проблемы с цветом заголовков и подвала - везде черный цвет. Вернул старый файл обратно - все стало нормально...

SergKis: gfilatov2002 пишет начались проблемы с цветом заголовков и подвала - везде черный цвет. 1. добавить проверку входного массива [pre2] IF HB_ISARRAY( aColors ) .AND. Len( aColors ) > 0 IF HB_ISARRAY( aColors[ 1 ] ) FOR EACH aClr IN aColors IF HB_ISNUMERIC( aClr[ 1 ] ) .AND. aClr[ 1 ] > 0 .AND. aClr[ 1 ] <= Len( aTmpColor ) IF aClr[ 2 ] != NIL aTmpColor[ aClr[ 1 ] ] := aClr[ 2 ] ENDIF ENDIF NEXT ELSE AEval( aColors, {| bColor, nEle | iif( bColor != NIL, aTmpColor[ nEle ] := bColor, )} ) //AEval( aColors, {| bColor, nEle | aTmpColor[ nEle ] := bColor } ) ENDIF ENDIF 2. входной массив формировать FUNCTION _DefineTBrowse( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight, ; ... LOCAL aTmpColor := Array( 0 ), aClr ... IF Type( '_TSB_aControlhWnd' ) != 'A' PUBLIC _TSB_aControlhWnd := {}, _TSB_aControlObjects := {}, _TSB_aClientMDIhWnd := {} ENDIF IF HB_ISARRAY( aColors ) .AND. Len( aColors ) > 0 /* IF HB_ISARRAY( aColors[ 1 ] ) FOR EACH aClr IN aColors IF HB_ISNUMERIC( aClr[ 1 ] ) .AND. aClr[ 1 ] > 0 .AND. aClr[ 1 ] <= Len( aTmpColor ) aTmpColor[ aClr[ 1 ] ] := aClr[ 2 ] ENDIF NEXT ELSE AEval( aColors, {| bColor, nEle | aTmpColor[ nEle ] := bColor } ) ENDIF */ aTmpColor := aColors ENDIF IF ValType( fontcolor ) != "U" AAdd( aTmpColor, {{ 1, RGB( fontcolor[ 1 ], fontcolor[ 2 ], fontcolor[ 3 ] ) }} ) //aTmpColor[ 1 ] := RGB( fontcolor[ 1 ], fontcolor[ 2 ], fontcolor[ 3 ] ) ENDIF IF ValType( backcolor ) != "U" AAdd( aTmpColor, {{ 2, RGB( backcolor[ 1 ], backcolor[ 2 ], backcolor[ 3 ] ) }} ) //aTmpColor[ 2 ] := RGB( backcolor[ 1 ], backcolor[ 2 ], backcolor[ 3 ] ) ENDIF IF Empty( aTmpColor ) ; aTmpColor := NIL ENDIF ... [/pre2] Сейчас задание цветов входным параметром массива надо подправлять методом :SetColor()

gfilatov2002: SergKis пишет: добавить проверку входного массива Пошел по этому пути, вроде отрабатывает нормально. Благодарю за помощь

gfilatov2002: Завершена подготовка новой сборки 24.06, которая будет опубликована на следующей неделе. Что нового: - исправление обнаруженных ошибок; - добавлена новая функция HMG_GetUniqueName( [<NamePrefix>] ) и идентификатор пустого имени NUL для создания элемента управления без необходимости указания его имени (удобно, например, для безымянных меток Label); - важное обновление библиотеки TSBrowse (спасибо, Сергей!) - обновлены Харбор, библиотеки SqlRdd, PdfPrinter и Sqlite3; - добавлены новые и обновлены старые примеры для демонстрации новых возможностей библиотеки. Желаю всем хорошего дня

полная версия страницы