Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить
Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
gfilatov2002: SergKis пишет: Сделал др. вариант SBrowse, привязал размеры к размеру фонта Да, этот вариант понравился своим лаконичным примером Принято. Благодарю за помощь
gfilatov2002: SergKis пишет: надо добавить MODAL окно Да, согласен, в противном случае карточка 'Record View' прячется под основное окно Остановился на таком варианте (с использованием переменной lRec): [pre2]FUNCTION SBrowse( uAlias, cTitle, bSetUp, aCols, nWidth, nHeight, lSql ) // idea from xBrowse LOCAL cFormName, oBrw, nSaveSelect, cDbf, cAlias, lEdit, cTable LOCAL lbSetUp := !Empty( bSetUp ), lRec, nY, nX, bAfter, lCellBrw := .F. LOCAL oApp := oDlu4Font( _HMG_DefaultFontSize ) LOCAL nGw := oApp:GapsWidth LOCAL nGh := oApp:GapsHeight IF HB_ISLOGICAL( bSetUp ) lCellBrw := bSetUp bSetUp := NIL ENDIF DEFAULT uAlias := Alias(), ; cTitle := iif( ValType( uAlias ) == "C", uAlias, "SBrowse" ), ; bSetUp := {|| .F. }, ; aCols := {}, ; nWidth := GetSysMetrics( 0 ) * .75, ; nHeight := GetSysMetrics( 1 ) / 2, ; lSql := .F. IF HB_ISARRAY( bSetUp ) bAfter := bSetUp[2] bSetUp := bSetUp[1] ENDIF IF ValType( uAlias ) == 'C' .AND. Select( uAlias ) == 0 nSaveSelect := Select() IF lSql cTable := GetUniqueName( "SqlTable" ) dbUseArea( .T.,, "SELECT * FROM " + uAlias, cTable,,, "UTF8" ) SELECT &cTable cAlias := cTable uAlias := cAlias ELSE cDbf := uAlias cAlias := uAlias TRY dbUseArea( .T., NIL, cDbf, cAlias, .T. ) uAlias := cAlias CATCH uAlias := { { uAlias } } END ENDIF ELSEIF ValType( uAlias ) == 'N' If ! Empty( Alias( uAlias ) ) uAlias := Alias( uAlias ) ELSE uAlias := { { uAlias } } ENDIF ELSEIF ValType( uAlias ) $ 'BDLP' uAlias := { { uAlias } } #ifdef __XHARBOUR__ ELSEIF ValType( uAlias ) == "H" uAlias := aHash2Array( uAlias ) #endif ENDIF cFormName := GetUniqueName( "SBrowse" ) lRec := HB_ISARRAY( uAlias ) .and. ; Len( uAlias[1] ) == 2 .and. Len( aCols ) == 2 .and. ; aCols[1] == "Key" .and. aCols[2] == "Value" IF lRec DEFINE WINDOW &cFormName AT 0, 0 WIDTH nWidth * .67 HEIGHT nHeight TITLE cTitle ; MODAL ; BACKCOLOR RGB( 191, 219, 255 ) ELSE DEFINE WINDOW &cFormName AT 0, 0 WIDTH nWidth HEIGHT nHeight TITLE cTitle ; CHILD TOPMOST ; BACKCOLOR RGB( 191, 219, 255 ) ; ON INIT {|| This.Topmost := .F. } ENDIF nY := nGh nX := nGw nWidth := This.ClientWidth - nX * 2 nHeight := This.ClientHeight - nY * 2 - oApp:H1 - nGh DEFINE TBROWSE oBrw AT nY, nX Alias ( uAlias ) WIDTH nWidth HEIGHT nHeight HEADER aCols ; AUTOCOLS SELECTOR 20 lEdit := Eval( bSetUp, oBrw ) lEdit := iif( ValType( lEdit ) == "L", lEdit, .F. ) WITH OBJECT oBrw :lEditable := lEdit :lCellBrw := lEdit .or. lCellBrw :nClrLine := COLOR_GRID :nClrHeadBack := { CLR_WHITE, COLOR_GRID } :lUpdate := .T. :bRClicked := {|| SBrowse_Record( oBrw ) } IF lEdit AEval( :aColumns, {| o | o:lEdit := .T. } ) ENDIF IF lRec :lNoHScroll := .T. ENDIF END WITH END TBROWSE nY := This.ClientHeight - nGh - oApp:H1 nX := nGw @ nY, nX BUTTON Btn_1 CAPTION oBrw:aMsg[ 44 ] WIDTH oApp:W1 HEIGHT oApp:H1 ; ACTION {|| oBrw:Report( cTitle,,,, .T. ), oBrw:GoTop() } nX += oApp:W1 + nGw @ nY, nX BUTTON Btn_2 CAPTION "Excel" WIDTH oApp:W1 HEIGHT oApp:H1 ; ACTION oBrw:ExcelOle() nX := This.ClientWidth - ( oApp:W1 + nGw ) @ nY, nX BUTTON Btn_3 CAPTION oBrw:aMsg[ 45 ] WIDTH oApp:W1 HEIGHT oApp:H1 ; ACTION ThisWindow.RELEASE ON KEY ESCAPE ACTION {|| iif( oBrw:IsEdit, oBrw:SetFocus(), ThisWindow.RELEASE ) } IF lRec oBrw:aColumns[2]:nWidth += 50 oBrw:aColumns[2]:lEdit := .F. oBrw:aColumns[3]:lEdit := .T. oBrw:AdjColumns( 3 ) ENDIF IF ! lbSetUp oBrw:SetNoHoles() oBrw:SetFocus() ENDIF IF HB_ISBLOCK( bAfter ) ; EVal( bAfter, oBrw, .T. ) ELSE ; Eval( bSetUp, oBrw, .T. ) ENDIF END WINDOW CENTER WINDOW &cFormName ACTIVATE WINDOW &cFormName If ! Empty( cAlias ) ( cAlias )->( dbCloseArea() ) ENDIF If ! Empty( nSaveSelect ) Select( nSaveSelect ) ENDIF RETURN NIL // --------------------------------------------------------------------------------------------------------------------// FUNCTION SBrowse_Record( oBrw, cTitle, bSetUp, aHead, nWidth, nHeight, lNoCrLf ) LOCAL oCol, aArr := {}, cHdr DEFAULT cTitle := "Record View", bSetUp := .T., aHead := { "Key", "Value" }, lNoCrLf := .F. FOR EACH oCol IN oBrw:aColumns IF oCol:cName == "SELECTOR" ; LOOP ENDIF cHdr := oCol:cHeading IF lNoCrLf .and. CRLF $ cHdr cHdr := StrTran( cHdr, CRLF, " " ) ENDIF AAdd( aArr, { cHdr, oBrw:GetValue( oCol ) } ) NEXT SBrowse( aArr, cTitle, bSetUp, aHead, nWidth, nHeight ) RETURN NIL [/pre2] Благодарю за помощь
SergKis: gfilatov2002 пишет Остановился на таком варианте Для MODAL окна надо задействовать _hmg_InplaceParentHandle , иначе родителем modal будет MAIN окно, что не есть хорошо. Надо поправить еще [pre2] LOCAL nGh := oApp:GapsHeight IF HB_ISARRAY( bSetUp ) bAfter := bSetUp[2] bSetUp := bSetUp[1] ENDIF IF HB_ISLOGICAL( bSetUp ) lCellBrw := bSetUp bSetUp := NIL ENDIF DEFAULT uAlias := Alias(), ; cTitle := iif( ValType( uAlias ) == "C", uAlias, "SBrowse" ), ; bSetUp := {|| .F. }, ; aCols := {}, ; nWidth := GetSysMetrics( 0 ) * .75, ; nHeight := GetSysMetrics( 1 ) / 2, ; lSql := .F. IF HB_ISARRAY( bSetUp ) bAfter := bSetUp[2] bSetUp := bSetUp[1] ENDIF [/pre2]
gfilatov2002: SergKis пишет: Для MODAL окна надо задействовать _hmg_InplaceParentHandle Добавил присвоение этой переменной перед объявлением модального окна таким образом _HMG_InplaceParentHandle := GetActiveWindow() SergKis пишет: Надо поправить еще Сделал, конечно.
SergKis: gfilatov2002 Еще поправить в SBrowse()[pre2] :bRClicked := {|| SBrowse_Record( oBrw ) } :lRecLockArea := .T. IF lEdit AEval( :aColumns, {| o | o:lEdit := ! o:cFieldTyp $ "+=^" } ) ENDIF IF lRec [/pre2]
gfilatov2002: SergKis пишет: Еще поправить в SBrowse() Ok
SergKis: gfilatov2002 Такая правка, решила проблему цвета в header, footer колонки "SELECTOR" [pre2] METHOD DrawHeaders( lFooters, lDrawCell ) CLASS TSBrowse ... IF ::lFooting .AND. ::lDrawFooters ... If !( nJ == 1 .AND. ::lSelector ) // JP nClrBack := iif( oColumn:nClrFootBack != NIL, oColumn:nClrFootBack, nClrFootBack ) ELSEIF ::nClrSelectorHdBack != NIL nClrBack := ::nClrSelectorHdBack ELSE nClrBack := ATail( ::aColumns ):nClrFootBack ENDIF nClrBack := ::GetValProp( nClrBack, nClrBack, nJ ) ... Еще добавка, для определения, есть ли реально колонка в тсб METHOD nColumn( cName, lPos ) INLINE _nColumn( Self, cName, !Empty( lPos ) ) FUNCTION _nColumn( oBrw, cName, lPos ) LOCAL nPos := AScan( oBrw:aColumns, {| oCol | Upper( oCol:cName ) == Upper( cName ) } ) RETURN iif( Empty( lPos ), Max( nPos, 1 ), nPos ) т.е. IF oBrw:nColumn("ORDKEYNO", .T.) > 0 ... ENDIF тогда поправить _TBrowse() ... DEFAULT bEnd := {|ob,op| Local aCol, nI, nK // SELECTOR и ORDKEYNO не меняем width IF op:uSelector != NIL .and. op:lAdjust == NIL .and. ob:lNoHScroll nK := Max( ob:nColumn("SELECTOR", .T.), ob:nColumn("ORDKEYNO", .T.) ) IF nK > 0 aCol := {} FOR nI := nK TO Len( ob:aColumns ) IF ob:aColumns[ nI ]:lVisible AAdd( aCol, nI ) ENDIF NEXT ENDIF ob:AdjColumns( aCol ) ENDIF // нет горизонтального HScroll и есть SELECTOR IF ob:nLen > ob:nRowCount() // нужен VScroll ob:ResetVScroll( .T. ) ENDIF ob:SetNoHoles() ob:SetFocus() Return Nil } [/pre2] Тогда задаем oTsb:aNumber := { 1, 70 } oTsb:uSelector := 20
SergKis: gfilatov2002 пишет Остановился на таком варианте (с использованием переменной lRec) Может надо добавить (с обработкой _hmg_InplaceParentHandle) [pre2] FUNCTION SBrowse( uAlias, cTitle, bSetUp, aCols, nWidth, nHeight, lSql, lModal ) // idea from xBrowse ... DEFAULT lModal := .F. ... IF lRec .or. lModal IF lRec nWidth *= .67 ENDIF DEFINE WINDOW &cFormName AT 0, 0 WIDTH nWidth HEIGHT nHeight TITLE cTitle ; MODAL ; BACKCOLOR RGB( 191, 219, 255 ) ELSE ... [/pre2]
gfilatov2002: SergKis пишет: Такая правка, решила проблему SergKis пишет: Еще добавка SergKis пишет: надо добавить (с обработкой _hmg_InplaceParentHandle) Большое спасибо за предложения! Проверю и отпишусь
SergKis: gfilatov2002 Правка _TBrowse() [pre2] ... DEFAULT oParam:bSpecHdEnum := {|ob,op,cChar| // нумерация SpecHd колонок, можно исп. в своем коде вызов Local oCol, cCnt, nCnt := 0 // renumbering SpecHeader IF ob:lDrawSpecHd DEFAULT cChar := op:cSpecHdChar DEFAULT cChar := "." FOR EACH oCol IN ob:aColumns IF oCol:cName == "SELECTOR" ; LOOP ENDIF cCnt := cChar IF oCol:cName != "ORDKEYNO" .and. oCol:lVisible cCnt := hb_ntos( ++nCnt ) ENDIF oCol:cSpcHeading := cCnt NEXT ENDIF Return Nil } DEFAULT oParam:bAdjColumns := {|ob| // "растягивание" колонок в пределах окна тсб Local aCol, nI, nK // SELECTOR and ORDKEYNO не меняем width nK := Max( ob:nColumn("SELECTOR", .T.), ob:nColumn("ORDKEYNO", .T.) ) IF nK > 0 aCol := {} FOR nI := nK TO Len( ob:aColumns ) IF ob:aColumns[ nI ]:lVisible AAdd( aCol, nI ) ENDIF NEXT ENDIF ob:AdjColumns( aCol ) Return Nil } DEFAULT bEnd := {|ob,op| // нет горизонтального HScroll и есть SELECTOR IF op:uSelector != NIL .and. op:lAdjust == NIL .and. ob:lNoHScroll IF HB_ISBLOCK( op:bAdjColumns ) EVal( op:bAdjColumns, ob, op ) // :AdjColumns(...) ENDIF ENDIF IF ob:nLen > ob:nRowCount() // нужен VScroll ob:ResetVScroll( .T. ) ENDIF ob:SetNoHoles() ob:SetFocus() Return Nil } ... IF ( :GetAllColsWidth() - 1 ) > ( _GetClientRect( :hWnd )[3] ) :lNoHScroll := .F. :lMoreFields := ( :nColCount() > 30 ) ELSEIF oParam:uSelector == NIL .and. oParam:lAdjust == NIL IF HB_ISBLOCK( oParam:bAdjColumns ) EVal( oParam:bAdjColumns, oBrw, oParam ) // :AdjColumns(...) ENDIF ENDIF ... IF HB_ISBLOCK( bEnd ) ; EVal( bEnd, oBrw, oParam ) ENDIF DO EVENTS RETURN oBrw [/pre2]
gfilatov2002: SergKis пишет: Правка _TBrowse() Все изменения приняты Благодарю за помощь
SergKis: gfilatov2002 Предложение по передаче внешних параметров для обработки в блоке кода ф-ии SBrowse[pre2] FUNCTION SBrowse( uAlias, cTitle, bSetUp, aCols, nWidth, nHeight, lSql ) // idea from xBrowse ... LOCAL uParam, bRecord IF HB_ISARRAY( cTitle ) uParam := cTitle[2] cTitle := cTitle[1] ENDIF IF HB_ISARRAY( bSetUp ) bRecord := iif( Len(bSetUp) > 2, bSetUp[3], NIL ) bAfter := bSetUp[2] bSetUp := bSetUp[1] ENDIF ... тут DEFINE WINDOW .... для окон ... This.Cargo := uParam nY := nGh nX := nGw ... :lUpdate := .T. :bRClicked := {|| _SetThisFormInfo( oBrw:cParentWnd ), SBrowse_Record( oBrw, , bRecord ), _SetThisFormInfo() } ... FUNCTION SBrowse_Record( oBrw, cTitle, bSetUp, aHead, nWidth, nHeight, lNoCrLf ) ... SBrowse( aArr, {"Record View", oBrw}, bSetUp, { "Key", "Value" }, nWidth, nHeight ) RETURN NIL [/pre2]
gfilatov2002: SergKis пишет: Предложение по передаче внешних параметров Принято Так выглядит сейчас функция SBrowse_Record() - для проверки: [pre2]FUNCTION SBrowse_Record( oBrw, cTitle, bSetUp, aHead, nWidth, nHeight, lNoCrLf ) LOCAL oCol, aArr := {}, cHdr DEFAULT cTitle := { "Record View", oBrw }, bSetUp := .T., aHead := { "Key", "Value" }, lNoCrLf := .F. FOR EACH oCol IN oBrw:aColumns IF oCol:cName == "SELECTOR" ; LOOP ENDIF cHdr := oCol:cHeading IF lNoCrLf .and. CRLF $ cHdr cHdr := StrTran( cHdr, CRLF, " " ) ENDIF AAdd( aArr, { cHdr, oBrw:GetValue( oCol ) } ) NEXT SBrowse( aArr, cTitle, bSetUp, aHead, nWidth, nHeight ) RETURN NIL [/pre2]
SergKis: gfilatov2002 пишет Так выглядит В этом варианте, если задать cTitle := "My test record", то oBrw не попадет в ф-ю, лучше DEFAULT cTitle := "Record View", ... SBrowse( aArr, {cTitle, oBrw}, bSetUp, aHead, nWidth, nHeight ) PS Можно продублировать на oBrw параметр :lUpdate := .T. :Cargo := uParam :bRClicked := {|| _SetThisFormInfo( oBrw:cParentWnd ), SBrowse_Record( oBrw, , bRecord ), _SetThisFormInfo() } Добавить параметр lModal. Для проверки вариант[pre2] FUNCTION SBrowse_Record( oBrw, cTitle, bSetUp, aHead, nWidth, nHeight, lNoCrLf, lModal ) LOCAL oCol, aArr := {}, cHdr DEFAULT cTitle := "Record View", bSetUp := .T., aHead := { "Key", "Value" }, lNoCrLf := .F. FOR EACH oCol IN oBrw:aColumns IF oCol:cName == "SELECTOR" ; LOOP ENDIF cHdr := oCol:cHeading IF lNoCrLf .and. CRLF $ cHdr cHdr := StrTran( cHdr, CRLF, " " ) ENDIF AAdd( aArr, { cHdr, oBrw:GetValue( oCol ) } ) NEXT SBrowse( aArr, {cTitle, oBrw}, bSetUp, aHead, nWidth, nHeight, , lModal ) RETURN NIL [/pre2]
gfilatov2002: SergKis пишет: DEFAULT cTitle := "Record View", ... SBrowse( aArr, {cTitle, oBrw}, bSetUp, aHead, nWidth, nHeight ) Понял, спасибо SergKis пишет: продублировать на oBrw параметр Ok
SergKis: gfilatov2002 Одновременно ответили, поправил, пред. пост, посмотрите. lModal для отдельного запуска с др. aHead
gfilatov2002: SergKis пишет: lModal для отдельного запуска Принято
SergKis: gfilatov2002 Предложение выделить создание колонки # (номер по порядку) в отд. ф-ю, для исп. в др. тсб, т.е. Назвать, может быть, ф-ю как то иначе ? [pre2] FUNCTION _TBrowse_ColNumber( oBrw, nWidth ) LOCAL oCol nWidth := hb_defaultValue( nWidth, 80 ) IF oBrw:lIsDbf DEFINE COLUMN oCol DATA 'hb_ntos(iif( IndexOrd() > 0, ORDKEYNO(), RecNo() ))' ; HEADER '#' ; FOOTER ' ' ; ALIGN 1, 1, 1 ; WIDTH nWidth ; PICTURE '9999999' ; MOVE 0 ; DBLCURSOR ; NAME ORDKEYNO oCol:lEdit := .F. oCol:cAlias := oBrw:cAlias oCol:cFooting := {| nc, ob | nc := ob:nLen, iif( Empty( nc ), '', hb_ntos( nc ) ) } #ifndef __XHARBOUR__ oCol:cData := 'hb_macroblock("' + oCol:cField + '")' oCol:bData := hb_macroBlock( oCol:cField ) #else oCol:cData := '{|| ' + oCol:cField + '}' oCol:bData := &( '{|| ' + oCol:cField + '}' ) #endif ELSEIF oBrw:lIsArr DEFINE COLUMN oCol DATA {|| NIL } ; HEADER '#' ; FOOTER ' ' ; ALIGN 1, 1, 1 ; WIDTH nWidth ; PICTURE '9999999' ; MOVE 0 ; DBLCURSOR ; NAME ARRAYNO oCol:cFooting := {| nc, ob | nc := ob:nLen, iif( Empty( nc ), '', hb_ntos( nc ) ) } oCol:bValue := {| xx, ob | xx := ob, hb_ntos( ob:nAt ) } ENDIF oCol:lEmptyValToChar := .T. oCol:cFieldTyp := 'N' oCol:nFieldLen := 10 oCol:nFieldDec := 0 RETURN oCol тогда правим так FUNCTION _DefineTBrowse( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight, ; ... IF HB_ISNUMERIC( nColNumber ) nColNumber := iif( nColNumber > 0 .AND. nColNumber <= n, nColNumber, 1 ) oCol := _TBrowse_ColNumber( oBrw ) oBrw:InsColumn( nColNumber, oCol ) oBrw:nCell := nColNumber + 1 oBrw:nFreeze := nColNumber oBrw:lLockFreeze := .T. IF HB_ISNUMERIC( nW ) .AND. nW > 0 oBrw:GetColumn( nColNumber ):nWidth := nW ENDIF ENDIF ... [/pre2] Использовать в др. тсб oCol := _TBrowse_ColNumber( oBrw, 50 ) oBrw:InsColumn( 1, oCol ) PS Можно метод такой сделать в классе и делать вызов oBrw:InsColNumber( nWidth, nNumber )
gfilatov2002: SergKis пишет: метод такой сделать в классе и делать вызов oBrw:InsColNumber( nWidth, nNumber ) Да, идея с новым методом понравилась. Тогда можно спрятать вызов oBrw:InsColumn( nNumber, oCol ) внутрь этого метода...
SergKis: gfilatov2002 пишет Да, идея с новым методом понравилась. Сделаю
SergKis: gfilatov2002 Метод тут [pre2] METHOD InsColNumber( nWidth, nColumn, cName ) CLASS TSBrowse LOCAL oCol nWidth := hb_defaultValue( nWidth , 80 ) nColumn := hb_defaultValue( nColumn, 1 ) cName := hb_defaultValue( cName, iif( ::lIsDbf, "ORDKEYNO", "ARRAYNO" ) ) IF ::lIsDbf DEFINE COLUMN oCol DATA 'hb_ntos(iif( IndexOrd() > 0, ORDKEYNO(), RecNo() ))' ; HEADER '#' ; FOOTER ' ' ; ALIGN 1, 1, 1 ; WIDTH nWidth ; PICTURE '9999999' ; MOVE 0 ; DBLCURSOR ; NAME &(cName) oCol:lEdit := .F. oCol:cAlias := ::cAlias oCol:cFooting := {| nc, ob | nc := ob:nLen, iif( Empty( nc ), '', hb_ntos( nc ) ) } #ifndef __XHARBOUR__ oCol:cData := 'hb_macroblock("' + oCol:cField + '")' oCol:bData := hb_macroBlock( oCol:cField ) #else oCol:cData := '{|| ' + oCol:cField + '}' oCol:bData := &( '{|| ' + oCol:cField + '}' ) #endif ELSEIF ::lIsArr DEFINE COLUMN oCol DATA {|| NIL } ; HEADER '#' ; FOOTER ' ' ; ALIGN 1, 1, 1 ; WIDTH nWidth ; PICTURE '9999999' ; MOVE 0 ; DBLCURSOR ; NAME &(cName) oCol:cFooting := {| nc, ob | nc := ob:nLen, iif( Empty( nc ), '', hb_ntos( nc ) ) } oCol:bValue := {| xx, ob | xx := ob, hb_ntos( ob:nAt ) } ENDIF oCol:lEmptyValToChar := .T. oCol:cFieldTyp := 'N' oCol:nFieldLen := 10 oCol:nFieldDec := 0 IF nColumn > 0 .and. nColumn <= Len( ::aColumns ) ::InsColumn( nColumn, oCol ) ENDIF RETURN oCol [/pre2] В ф-ии так выходит [pre2] FUNCTION _DefineTBrowse( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight, ; ... LOCAL cFontHead, cFontFoot, oCol, nW ... IF HB_ISNUMERIC( nColNumber ) nColNumber := iif( nColNumber > 0 .AND. nColNumber <= n, nColNumber, 1 ) oBrw:InsColNumber( 80, nColNumber ) oBrw:nCell := nColNumber + 1 oBrw:nFreeze := nColNumber oBrw:lLockFreeze := .T. IF HB_ISNUMERIC( nW ) .AND. nW > 0 oBrw:GetColumn( nColNumber ):nWidth := nW ENDIF ENDIF ... [/pre2] Пример на изменении пошел нормально
gfilatov2002: SergKis пишет: Метод тут Большое спасибо Это - реальная помощь
SergKis: gfilatov2002 Попробовал добавить параметр в SBrowse(... , lNumber) и строки[pre2] IF lRec :lNoHScroll := .T. ELSEIF !Empty( lNumber ) :lFooting := .T. :lDrawFooters := .T. :nHeightFoot := :nHeightHead AEval( :aColumns, {| o | o:cFooting := "" } ) :InsColNumber() :GetColumn("ORDKEYNO"):cFooting := hb_ntos( :nLen ) :nFreeze := :nColumn("ORDKEYNO") :nCell := :nFreeze + 1 :lLockFreeze := .T. ENDIF [/pre2] в примере lNumber параметр сделал .T. результат, в целом, получился с замечаниями: 1 - колонка SELECTOR стала 3D (кроме header) 2 - у колонки ORDKEYNO header стал 3D и цвет у строки фокуса, как у ячейки в фокусе 3 - у колонки ORDKEYNO цвет у строки фокуса, как у ячейки в фокусе Excel отрабатывает. На карточке появляется поле #, как бы почти все ok! В целом замечания не мешают Разобрался, 1 и 2 это градиент откуда то взялся, а не 3D. В примерах с _TBrowse(...) и колонкой Number все ok!, такого нет. Сделал так [pre2] LOCAL uParam, bRecord, nClr ... IF lEdit AEval( :aColumns, {| o | o:lEdit := ! o:cFieldTyp $ "+=^" } ) ENDIF nClr := :GetColumn(1):nClrHeadBack IF lRec :lNoHScroll := .T. ELSEIF !Empty( lNumber ) :lFooting := .T. :lDrawFooters := .T. :nHeightFoot := :nHeightHead :InsColNumber() :GetColumn("ORDKEYNO"):cFooting := hb_ntos( :nLen ) :nFreeze := :nColumn("ORDKEYNO") :nCell := :nFreeze + 1 :lLockFreeze := .T. ENDIF END WITH END TBROWSE IF !Empty( lNumber ) oBrw:GetColumn("SELECTOR"):nClrBack := nClr oBrw:GetColumn("ORDKEYNO"):nClrHeadBack := nClr ENDIF nY := This.ClientHeight - nGh - oApp:H1 ... [/pre2] Может, конечно, lNumber не надо (но с ним неплохо) ?
gfilatov2002: SergKis пишет: Попробовал добавить параметр в SBrowse(... , lNumber) Думаю, что такой параметр не помешает Благодарю за ваши усилия по доведению этой функции "до ума"
SergKis: gfilatov2002 Тут еще с методом [pre2] METHOD ExcelOle( cXlsFile, lActivate, hProgress, cTitle, hFont, lSave, bExtern, aColSel, bPrintRow ) CLASS TSBrowse ... uData := iif( ValType( ::aColumns[ nCol ]:cFooting ) == "B", Eval( ::aColumns[ nCol ]:cFooting, nCol, Self ), ; ::aColumns[ nCol ]:cFooting ) ... Если эту правку сделать, то можно убрать строку, но может не надо убирать эту строку, т.к. не знаю что делает на тему :cFooting метод oBrw:Report() :InsColNumber() :GetColumn("ORDKEYNO"):cFooting := hb_ntos( :nLen ) :nFreeze := :nColumn("ORDKEYNO") [/pre2]
gfilatov2002: SergKis пишет: uData := iif( ValType( ::aColumns[ nCol ]:cFooting ) == "B", Eval( ::aColumns[ nCol ]:cFooting, nCol, Self ), ; ::aColumns[ nCol ]:cFooting ) Благодарю за поправку Я добавил также строку, чтобы не было разрыва курсора при движении по ячейкам IF ! Empty( lNumber ) oBrw:GetColumn( "SELECTOR" ):nClrBack := nClr oBrw:GetColumn( "ORDKEYNO" ):nClrHeadBack := nClr oBrw:GetColumn( "ORDKEYNO" ):nClrFocuBack := oBrw:nClrPane ENDIF
SergKis: gfilatov2002 Добавьте метод в CLASS TDlu2Pix [pre2] METHOD TextWidth( cText, nSize, cFont, lBold, cChar ) CLASS TDlu2Pix LOCAL hFont, nWidth cChar := hb_defaultValue(cChar, 'A') cText := hb_defaultValue(cText, Replicate(cChar, 2)) lBold := hb_defaultValue(lBold, .F. ) cFont := hb_defaultValue(cFont, _HMG_DefaultFontName) nSize := hb_defaultValue(nSize, _HMG_DefaultFontSize) IF ValType(cText) == 'N' ; cText := Replicate(cChar, cText) ENDIF hFont := InitFont(cFont, nSize, lBold) nWidth := GetTextWidth(Nil, cText, hFont) DeleteObject(hFont) RETURN nWidth что бы можно было width контрола получить от dlu, напрмер, кратное :W(0.5) w := 0 o := oDlu4Font(nSize) // nSize: from 8 to 26 t := o:TextWidth('Bla bla ... bla', nSize) a := array(20) aFill(a, o:W(0.5)) FOR EACH n IN a w += n IF w > t ; EXIT ENDIF NEXT ? t, w, o:H1 вместо этих команд в моем варианте есть метод METHOD Breadth( w, k ) CLASS TDlu2Pix LOCAL nWidth := 0 WHILE w > ( nWidth += ::W( hb_defaultValue(k, 0.5) ) ) END RETURN nWidth т.е. делаю w := o:Breadth( o:TextWidth('Bla bla ... bla', nSize), 0.5 ) [/pre2]
gfilatov2002: SergKis пишет: Добавьте метод Ok
SergKis: gfilatov2002 пишет Ok Тогда еще немного правок для nFontSize [pre2] FUNCTION oDlu4Font( nFontSize, lDlu2Pix ) ... IF lDlu2Pix RETURN TDlu2Pix():New( nPrcW, nPrcH, nFontSize ) ENDIF ... FUNCTION oDlu2Pixel( nPrcW, nPrcH, nFontSize ) ... IF o_AppDlu2Pixel == NIL nFontSize := hb_defaultValue( nFontSize, _HMG_DefaultFontSize ) o_AppDlu2Pixel := TDlu2Pix():New( nPrcW, nPrcH, nFontSize ) ... CLASS TDlu2Pix ... VAR nB INIT 0 VAR nSize INIT 0 METHOD New( nPrcW, nPrcH, nSize ) INLINE ( ::nScaleWidth := hb_defaultValue( nPrcW, 100 ), ; ::nScaleHeight := hb_defaultValue( nPrcH, 100 ), ::nSize := hb_defaultValue( nSize, ::nSize ), ; ::UnitsToPixels(), Self ) CONSTRUCTOR ... METHOD TextWidth( cText, nSize, cFont, lBold, cChar ) CLASS TDlu2Pix ... nSize := hb_defaultValue(nSize, iif( Empty(::nSize), _HMG_DefaultFontSize, ::nSize ) ) ... METHOD Breadth( nW, k ) CLASS TDlu2Pix LOCAL nWidth := 0 IF HB_ISCHAR(nW) ; nW := ::TextWidth(nW) ENDIF WHILE nW > ( nWidth += ::W( hb_defaultValue(k, 0.5) ) ) END RETURN nWidth ... [/pre2]
gfilatov2002: SergKis пишет: еще немного правок Понял, добавлю...
gfilatov2002: Выложил 2-й апдейт сборки 21.11 с учетом всех последних изменений Обновил также Unicode архив. Благодарю за огромную помощь Сергея Киселева Желаю всем счастья и хорошего самочувствия в наступающем году
SergKis: gfilatov2002 Немного поправил SBrowse [pre2] DEFINE TBROWSE oBrw AT nY, nX Alias ( uAlias ) WIDTH nWidth HEIGHT nHeight HEADER aCols ; AUTOCOLS SELECTOR 20 ; ON INIT {|ob| ob:nColOrder := 0 , ; ob:lNoGrayBar := .F., ; ob:lNoLiteBar := .F., ; ob:lNoResetPos := .F., ; ob:nStatusItem := 0 , ; ob:lNoKeyChar := .T., ; ob:nWheelLines := 1 , ; ob:nCellMarginLR := 1 , ; ob:nLineStyle := LINES_ALL , ; ob:nClrLine := COLOR_GRID, ; ob:lCheckBoxAllReturn := .T. } oBrw:Cargo := uParam lEdit := Eval( bSetUp, oBrw ) lEdit := iif( ValType( lEdit ) == "L", lEdit, .F. ) WITH OBJECT oBrw :lEditable := lEdit :lCellBrw := ( lEdit .OR. lCellBrw ) //:nClrLine := COLOR_GRID //:nClrHeadBack := { CLR_WHITE, COLOR_GRID } :lUpdate := .T. //:Cargo := uParam :bRClicked := {|| _SetThisFormInfo( oBrw:cParentWnd ), SBrowse_Record( oBrw, , bRecord ), _SetThisFormInfo() } :lRecLockArea := .T. ... [/pre2] Пример на базе Tsb_sbrowse [pre2] #define _HMG_OUTLOG #include "minigui.ch" #include "tsbrowse.ch" #include "dbinfo.ch" *----------------------------------- Function Main() *----------------------------------- Local cTitle := "Test Browse: Right Click For Record View", ; bSetup := { |oBrw,lAft| SetMyBrowser( oBrw, lAft ) }, ; cFont := "Tahoma", nSize := 10 CreateTable() USE Test NEW SET AUTOADJUST ON NOBUTTONS SET FONT TO cFont, nSize DEFINE FONT Normal FONTNAME cFont SIZE nSize DEFINE FONT Bold FONTNAME cFont SIZE nSize BOLD SET DEFAULT ICON TO GetStartupFolder() + "\demo.ico" DEFINE WINDOW sample AT 0,0 WIDTH 740 HEIGHT 580 ; TITLE "Open Table via SBrowse" ; MAIN NOSHOW ; ON INIT ( SBrowse( "Test", cTitle, bSetup,,,,,, .T. ), This.t_1.Enabled := .T. ) ; ON RELEASE ( dbCloseArea( "Test" ), hb_dbDrop( "Test" ) ) DEFINE TIMER t_1 INTERVAL 1000 ACTION iif( Empty(CountChildWindows()), ThisWindow.Release(), ) This.t_1.Enabled := .F. END WINDOW sample.Center() sample.Activate() Return Nil *----------------------------------- Function CreateTable *----------------------------------- DBCREATE("Test", {{"CODE", "C", 3, 0},{"NAME", "C", 50, 0},{"RESIDENTS", "N", 11, 0},{"NOTES", "M", 10, 0}},,.T.) DBAPPEND() REPLACE CODE WITH 'LTU', NAME WITH 'Lithuania', RESIDENTS WITH 3369600 DBAPPEND() REPLACE CODE WITH 'USA', NAME WITH 'United States of America', RESIDENTS WITH 305397000 DBAPPEND() REPLACE CODE WITH 'POR', NAME WITH 'Portugal', RESIDENTS WITH 10617600 DBAPPEND() REPLACE CODE WITH 'POL', NAME WITH 'Poland', RESIDENTS WITH 38115967 DBAPPEND() REPLACE CODE WITH 'AUS', NAME WITH 'Australia', RESIDENTS WITH 21446187 DBAPPEND() REPLACE CODE WITH 'FRA', NAME WITH 'France', RESIDENTS WITH 64473140 DBAPPEND() REPLACE CODE WITH 'RUS', NAME WITH 'Russia', RESIDENTS WITH 141900000 DBAPPEND() REPLACE CODE WITH 'LAT', NAME WITH 'Latvja', RESIDENTS WITH 7654321 DBAPPEND() REPLACE CODE WITH 'DEM', NAME WITH 'Germanija', RESIDENTS WITH 1234567 USE Return Nil *----------------------------------- Function SetMyBrowser( oBrw, lAft ) *----------------------------------- Local cFormName := oBrw:cParentWnd, cTitle, oCol, hFont If Empty(lAft) SetProperty( cFormName, "MinWidth", 920 ) SetProperty( cFormName, "MinHeight", 480 ) oBrw:nHeightCell += 5 oBrw:nHeightHead += 12 oBrw:nClrFocuFore := CLR_BLACK oBrw:nClrFocuBack := COLOR_GRID hFont := GetFontHandle( "Bold" ) oBrw:hFontSupHd := hFont oBrw:nHeightSuper := oBrw:nHeightHead cTitle := " [" + oBrw:cAlias + "] " + DBINFO( DBI_FULLPATH ) ADD SUPER HEADER TO oBrw FROM 1 TO 2 TITLE " "+RddName() ADD SUPER HEADER TO oBrw FROM 3 TO oBrw:nColCount() TITLE cTitle FOR EACH oCol IN oBrw:aColumns oCol:hFontHead := hFont oCol:hFontFoot := hFont NEXT Else oCol := ATail(oBrw:aColumns) ATail(oBrw:aSuperHead)[ 2] := oBrw:nColumn(oCol:cName) IF oBrw:nLen > oBrw:nRowCount() oBrw:ResetVScroll( .T. ) ENDIF oBrw:SetNoHoles() oBrw:SetFocus() EndIf Return .T. // editable browse (return .F. is readonly) *----------------------------------- Function CountChildWindows *----------------------------------- Local i, nFormCount := Len (_HMG_aFormHandles), nCnt := 0 FOR i := 1 TO nFormCount IF _HMG_aFormType [ i ] <> "A" IF _IsWindowDefined ( _HMG_aFormNames [ i ] ) nCnt++ ENDIF ENDIF NEXT Return nCnt [/pre2] Есть проблемка с Super Header и OLE, т.е. вывод таблицы в excel снимается. Я не специалист ole excel, не работаю с ним. Потому только сообщаю
gfilatov2002: SergKis пишет: поправил SBrowse Принято Благодарю за помощь
SergKis: gfilatov2002 Поправил [pre2] METHOD LoadFields( lEditable, aColSel, cAlsSel, aNameSel, aHeadSel ) CLASS TSBrowse ... ELSEIF cType $ "=@T" cPicture := Nil nSize := GetTextWidth( 0, Replicate( "9", 24 ), hFont ) ELSEIF cType $ "^+" ... IF ValType( ::aFormatPic ) == "A" .AND. ! Empty( ::aFormatPic ) .AND. n <= Len( ::aFormatPic ) .and. ! cType $ "=@T" cPicture := ::aFormatPic[ n ] ENDIF ... [/pre2] У этих полей Picture оказался равным '9999999999'
gfilatov2002: SergKis пишет: Поправил Ok
gfilatov2002: SergKis пишет: Если возможно, включите в сборку последнюю версию LetoDbf, клиента и сервер Сделал, будет доступно в следующей сборке Благодарю за напоминание
SergKis: gfilatov2002 Показалось интересным, правка записи в SBrowse() [pre2] FUNCTION SBrowse( uAlias, cTitle, bSetUp, aCols, nWidth, nHeight, lSql, lModal, lNumber ) ... LOCAL uParam, bRecord, nClr, oCol ... ON KEY ESCAPE ACTION {|| iif( oBrw:IsEdit, oBrw:SetFocus(), ThisWindow.RELEASE ) } IF lRec nY := Len( oBrw:aColumns ) oBrw:aColumns[ nY - 1 ]:nWidth += 50 oBrw:aColumns[ nY - 1 ]:cName := "KEY" oBrw:aColumns[ nY ]:lEdit := .F. oBrw:aColumns[ nY ]:cName := "VALUE" FOR EACH oCol IN oBrw:aColumns oCol:cPicture := NIL oCol:nAlign := DT_LEFT NEXT oBrw:AdjColumns( nY ) IF HB_ISOBJECT( oBrw:Cargo ) .and. oBrw:ClassName == "TSBROWSE" .and. oBrw:Cargo:lIsDbf oBrw:Cargo:lRecLockArea := .T. oCol := oBrw:aColumns[3] oCol:lEdit := .T. oCol:bPrevEdit := {|uv,obr| Local lRet := .T., nn, cn, oc, ob nn := obr:nAt cn := obr:GetValue(2) obr:aColumns[ obr:nCell ]:Cargo := NIL ob := obr:Cargo IF !HB_ISOBJECT( ob ) .or. !ob:lIsDbf RETURN .F. ENDIF nn := obr:nAt oc := ob:GetColumn( cn ) IF Empty( oc:cFieldTyp ) .or. oc:cName == "SELECTOR" .or. oc:cName == "ORDKEYNO" lRet := .F. ELSEIF oc:cFieldTyp $ "T=@+^" lRet := .F. ENDIF IF lRet obr:aColumns[ obr:nCell ]:Cargo := uv ENDIF Return lRet } oCol:bPostEdit := {|uv,obr| Local nn, cn, oc, ob, uo, nm nn := obr:nAt cn := obr:GetValue(2) uo := obr:aColumns[ obr:nCell ]:Cargo IF uo != NIL .and. uo == uv RETURN Nil ENDIF ob := obr:Cargo IF !HB_ISOBJECT( ob ) .or. !ob:lIsDbf RETURN Nil ENDIF nn := obr:nAt oc := ob:GetColumn( cn ) nm := oc:nEditMove oc:nEditMove := 0 ob:PostEdit(uv, ob:nColumn(oc:cName)) oc:nEditMove := nm Return Nil } ENDIF ENDIF IF ! lbSetUp .or. lRec oBrw:SetNoHoles() oBrw:SetFocus() IF lRec oBrw:GoRight() ENDIF ENDIF IF HB_ISBLOCK( bAfter ) ; EVal( bAfter, oBrw, .T. ) ELSE ; Eval( bSetUp, oBrw, .T. ) ENDIF ... [/pre2] Пример тут https://TransFiles.ru/fvyp6
gfilatov2002: SergKis пишет: правка записи в SBrowse() Большое спасибо Это - то, что нужно...
SergKis: gfilatov2002 пишет Это - то, что нужно... Пример с логическим полем в структуре и вариантом bSetUp для SBrowse() тут https://TransFiles.ru/4zp9j
SergKis: gfilatov2002 Почистил, поправил SBrowse(), добавил задать размеры через nWidth, nHeight для SBrowse_Record() Пример и h_controlmisc2.prg тут https://TransFiles.ru/3i6zg Еще правка [pre2] METHOD D( nKfc ) CLASS TDlu2Pix LOCAL nVal := ::nPixWidthDT IF HB_ISNUMERIC( nKfc ) .AND. nKfc > 0 IF nKfc == 1 ; nVal := ::nPixWidthDT ELSEIF nKfc == 2 ; nVal := ::nPixWidthDT1 ELSEIF nKfc == 3 ; nVal := ::nPixWidthDT2 ELSE ; nVal := Int( nKfc * nVal ) ENDIF ENDIF RETURN nVal [/pre2]
gfilatov2002: SergKis пишет: поправил SBrowse() Принято Немного отформатировал, убрал в блоках кода неиспользуемое присвоение nn := obr:nAt Благодарю за помощь SergKis пишет: Еще правка OK
SergKis: PS Пример тот же, но с добавкой подключения блока кода для SBrowse_Record(...) для информации [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" #include "tsbrowse.ch" REQUEST DBFCDX, DBFFPT Function Main() LOCAL cFont := "Arial" LOCAL nSize := 12 LOCAL bSetUp, lNoMain, nW, nH, oDlu, bSet, bRec SET CODEPAGE TO RUSSIAN SET LANGUAGE TO RUSSIAN RddSetDefault("DBFCDX") //SET OOP ON SET EPOCH TO 2000 SET DATE TO GERMAN SET CENTURY ON SET AUTOPEN OFF SET DELETED OFF SET NAVIGATION EXTENDED SET DEFAULT ICON TO "HMG_ICO" // фонт по default cFont := "DejaVu Sans Mono" nSize := 16 SET FONT TO cFont, nSize DEFINE FONT Normal FONTNAME cFont SIZE nSize DEFINE FONT Bold FONTNAME cFont SIZE nSize BOLD IF ( lNoMain := Empty( _HMG_MainHandle ) ) SET WINDOW MAIN OFF ENDIF bSet := {|ob,um| Local oc, fn IF Empty(um) // before END TBROWSE ELSE // after END TBROWSE fn := GetFontHandle("Bold") FOR EACH oc IN ob:aColumns IF oc:cName == "SELECTOR" ; LOOP ENDIF oc:hFontHead := fn IF oc:cName == "ORDKEYNO" oc:hFont := fn oc:hFontFoot := fn ENDIF NEXT ob:SetNoHoles() ob:SetFocus() ENDIF Return .T. } //bSet := {|| .T. } bRec := {|| .F. } // или задавать как bSet с параметрами bSetUp := { bSet, , bRec } USE ( "CUSTOMER" ) ALIAS CUST NEW SHARED oDlu := oDlu4Font( _HMG_DefaultFontSize ) nW := Sys.ClientWidth nH := oDlu:H1 * ( fCount() + 3 ) + 5 nH := iif( nH > Sys.ClientHeight, Sys.ClientHeight, nH ) nH := { Sys.ClientHeight, nH } sBrowse( Alias(), "DEMO. Test new SBrowse", bSetUp, , nW, nH, , .T., .T. ) IF lNoMain SET WINDOW MAIN ON ENDIF RETURN NIL [/pre2]
gfilatov2002: Подготовил третий релиз-кандидат для новой сборки 22.01 Кратко, что нового: [pre2] * Fixed DATEPICKER control: 'Value' property returns TimeStamp type if the FORMATSTRING property was defined (introduced in the build 21.09). * Added the function nStrToNum( cNumericVal, [lEuropean] ) --> nVal * Added the function uCharToVal( cText, [cType] ) --> uVal. It is an inverse function to the function cValToChar(). * The improved function cValToChar() preserves the full accuracy of the number value with the internal function cNumToChar(). It does not depend on the SET DECIMALS TO <n> setting now. * The DO MESSAGE LOOP command supports the optional EXIT [ON EXCEPTION] clause (default is false). * The useful function GetPixelColor() was moved to MiniGUI core. * Updated the TSBrowse, RddLeto and SQLite3 libraries. * Added the new interesting samples and updated some examples. [/pre2]
SergKis: gfilatov2002 Добавьте строки[pre2] FUNCTION _TBrowse( oParam, uAlias, cBrw, nY, nX, nW, nH ) ... IF HB_ISBLOCK( bEnd ) ; EVal( bEnd, oBrw, oParam ) ENDIF IF HB_ISARRAY( oParam:aEvents ) FOR EACH aTmp IN oParam:aEvents (This.Object):Event( aTmp[1], aTmp[2] ) NEXT ENDIF DO EVENTS RETURN oBrw Тогда можно делать WITH OBJECT oTsb :aEvents := {} AADD( :aEvents, { 3, {|ow,ky,ob| Local cAls ob := iif( Empty(ob), ow:Cargo:oBrw, ob ) cAls := ob:cAlias IF ob:nLen > 0 IF (cAls)->(RLock()) IF (cAls)->(Deleted()) (cAls)->(dbRecall()) ELSE (cAls)->(dbDelete()) ENDIF (cAls)->(dbUnlock()) ENDIF //ob:DeleteRow(.F., .F.) ob:SetFocus() ob:DrawSelect() DO EVENTS ENDIF Return Nil } } ) ... END WITH [/pre2]
gfilatov2002: SergKis пишет: Добавьте строки OK
gfilatov2002: Завершена подготовка новой сборки 22.01, которая будет опубликована на следующей неделе. Искренне благодарю Сергея Киселева и Андрея Верченко за помощь при подготовке этой сборки
SergKis: gfilatov2002 предложение [pre2] CLASS TSBrowse FROM TControl ... DATA lYesNo AS LOGICAL INIT .F. // .T. - text _HMG_aABMLangLabel[ 20\21 ] ... METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse ... ELSEIF Empty( cPicture ) .OR. lMultiLine //uData := iif( ValType( uData ) != "C", cValToChar( uData ), uData ) IF ValType( uData ) != "C" IF ValType( uData ) == "L" .and. ::lYesNo uData := _HMG_aABMLangLabel[ iif( uData, 20, 21 ) ] ELSE uData := cValToChar( uData ) ENDIF ENDIF ELSE ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... ELSEIF Empty( cPicture ) .OR. lMulti //uData := iif( ValType( uData ) != "C", cValToChar( uData ), uData ) IF ValType( uData ) != "C" IF ValType( uData ) == "L" .and. ::lYesNo uData := _HMG_aABMLangLabel[ iif( uData, 20, 21 ) ] ELSE uData := cValToChar( uData ) ENDIF ENDIF ELSE ... [/pre2] тогда вместо F\T будут тексты из _HMG_aABMLangLabel[ 20\21 ], т.е. Yes\No или от языка Да\Нет ... В примере с SBrowse, например, делаем так [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" #include "tsbrowse.ch" REQUEST DBFCDX, DBFFPT Function Main() LOCAL cFont := "Arial" LOCAL nSize := 12 LOCAL bSetUp, lNoMain, nW, nH, oDlu, bSet, bRec SET CODEPAGE TO RUSSIAN SET LANGUAGE TO RUSSIAN RddSetDefault("DBFCDX") //SET OOP ON SET EPOCH TO 2000 SET DATE TO GERMAN SET CENTURY ON SET AUTOPEN OFF SET DELETED OFF SET NAVIGATION EXTENDED SET DEFAULT ICON TO "HMG_ICO" // фонт по default cFont := "DejaVu Sans Mono" nSize := 18 SET FONT TO cFont, nSize DEFINE FONT Normal FONTNAME cFont SIZE nSize DEFINE FONT Bold FONTNAME cFont SIZE nSize BOLD IF ( lNoMain := Empty( _HMG_MainHandle ) ) SET WINDOW MAIN OFF ENDIF bSet := {|ob,um| Local oc, fn IF Empty(um) // before END TBROWSE ELSE // after END TBROWSE fn := GetFontHandle("Bold") FOR EACH oc IN ob:aColumns IF oc:cName == "SELECTOR" ; LOOP ENDIF oc:hFontHead := fn IF oc:cName == "ORDKEYNO" oc:hFont := fn oc:hFontFoot := fn ENDIF NEXT ob:SetNoHoles() ob:SetFocus() ENDIF Return .T. } bRec := {|ob,um| Local oc, fn IF Empty(um) // before END TBROWSE ob:lYesNo := .T. ELSE // after END TBROWSE fn := GetFontHandle("Bold") FOR EACH oc IN ob:aColumns IF oc:cName == "SELECTOR" ; LOOP ENDIF oc:hFontHead := fn NEXT ob:SetNoHoles() ob:GoRight() DO EVENTS ob:SetFocus() ENDIF Return .T. } //bSet := {|| .T. } //bRec := {|| .F. } bSetUp := { bSet, , bRec } USE ( "CUSTOMER" ) ALIAS CUST NEW SHARED oDlu := oDlu4Font( _HMG_DefaultFontSize ) nW := Sys.ClientWidth nH := oDlu:H1 * ( fCount() + 3 ) + 5 nH := iif( nH > Sys.ClientHeight, Sys.ClientHeight, nH ) nH := { Sys.ClientHeight, nH } sBrowse( Alias(), "DEMO. Test new SBrowse", bSetUp, , nW, nH, , .T., .T. ) IF lNoMain SET WINDOW MAIN ON ENDIF RETURN NIL [/pre2]
SergKis: PS Можно сделать через массив текстов в классе, т.е. [pre2] DATA aYesNo AS ARRAY INIT { _HMG_aABMLangLabel[20], _HMG_aABMLangLabel[21] } [/pre2] Тогда можно ставить свой текст для вывода в методах uData := ::aYesNo[ iif( uData, 1, 2 ) ] но может это избыточно
gfilatov2002: SergKis пишет: сделать через массив текстов в классе Да, этот вариант понравился больше. Тогда можно и не изменять пример - изменения для логических полей подтягиваются автоматически Благодарю за предложение
SergKis: gfilatov2002 пишет тот вариант понравился больше Тогда надо еще правку внести [pre2] METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, nClrBack ) CLASS TSBrowse ... ELSEIF ( cType == "L" .AND. lLogicDrop ) .OR. oCol:lComboBox ... nHeight := Max( 10, Min( 10, Len( aGet ) ) ) * ::nHeightCell ELSE IF ::lYesNo aGet := { ::aYesNo[ 1 ], ::aYesNo[ 2 ] } ELSE aGet := { ::aMsg[ 1 ], ::aMsg[ 2 ] } ENDIF IF nKey == VK_RETURN uValue := iif( uValue, 1, 2 ) ELSE uValue := Max( 1, AScan( aGet, Upper( Chr( nKey ) ) ) ) ENDIF nHeight := ::nHeightCell * 4 // 1.54 ENDIF ... В примере так можно делать bRec := {|ob,um| Local oc, fn IF Empty(um) // before END TBROWSE ob:lYesNo := .T. ob:aYesNo[1] := "Вкл." ob:aYesNo[2] := "Выкл." ELSE // after END TBROWSE fn := GetFontHandle("Bold") FOR EACH oc IN ob:aColumns IF oc:cName == "SELECTOR" ; LOOP ENDIF oc:hFontHead := fn NEXT ob:SetNoHoles() ob:GoRight() DO EVENTS ob:SetFocus() ENDIF Return .T. } ... [/pre2]
gfilatov2002: SergKis пишет: aGet := { ::aMsg[ 1 ], ::aMsg[ 2 ] } Благодарю за подсказку Убрал новую переменную :aYesNo и использовал вместо нее уже готовый массив :aMsg. Введение новой переменной :lYesNo посчитал излишним также, отображение элементов вышеназванного массива для логических полей можно всегда изменить, переопределив 1-е и 2-е значение этого массива.
SergKis: gfilatov2002 пишет Введение новой переменной :lYesNo посчитал излишним также, отображение элементов вышеназванного массива для логических полей можно всегда изменить, переопределив 1-е и 2-е значение этого массива. Не очень понял. ::aMsg[1], ::aMsg[2] к отображению в ::DrawSelect() и :DrawLine() не имеет отношения, там cValToChar(uData), т.е. F\T в таблице видим. ::aMsg[1], ::aMsg[2] возникают для ::Edit(...) с cType == "L" .AND. lLogicDrop в TComboBox(). Соединить на одинаковый текст для вывода в таблице и TComboBox() на карточке надо, наверное, подключив :aMsg вместо :aYesNo. :lYesNo нужна, в таком случае, только для сохранения старого варианта.
gfilatov2002: SergKis пишет: подключив :aMsg вместо :aYesNo Именно так и сделал SergKis пишет: :lYesNo нужна, в таком случае, только для сохранения старого варианта Такая совместимость не требуется, на мой взгляд Использование Yes\No вместо T\F на карточке представляется вполне логичным
SergKis: gfilatov2002 Еще небольшие правки по SBrowse [pre2] IF /*! Empty( lNumber ) .or.*/ oBrw:nColumn( "ORDKEYNO", .T. ) > 0 oBrw:GetColumn( "SELECTOR" ):nClrBack := nClr oBrw:GetColumn( "ORDKEYNO" ):nClrHeadBack := nClr oBrw:GetColumn( "ORDKEYNO" ):nClrFocuBack := oBrw:nClrPane ENDIF ... nY := Len( oBrw:aColumns ) oBrw:aColumns[ nY - 1 ]:nWidth += 50 oBrw:aColumns[ nY - 1 ]:cName := "KEY" oBrw:aColumns[ nY - 1 ]:lEdit := .F. oBrw:aColumns[ nY ]:lEdit := .F. oBrw:aColumns[ nY ]:cName := "VALUE" ... IF HB_ISOBJECT( oBrw:Cargo ) .and. oBrw:ClassName == "TSBROWSE" .and. oBrw:Cargo:lIsDbf oBrw:Cargo:lRecLockArea := .T. oCol := oBrw:GetColumn("VALUE") //aColumns[3] oCol:lEdit := .T. ... [/pre2] Тогда пример с карточкой может быть такой [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" #include "tsbrowse.ch" REQUEST DBFCDX, DBFFPT Function Main() LOCAL cFont := "Arial" LOCAL nSize := 12 LOCAL bSetUp, lNoMain, nW, nH, oDlu, bSet, bRec SET CODEPAGE TO RUSSIAN SET LANGUAGE TO RUSSIAN RddSetDefault("DBFCDX") //SET OOP ON SET EPOCH TO 2000 SET DATE TO GERMAN SET CENTURY ON SET AUTOPEN OFF SET DELETED OFF SET NAVIGATION EXTENDED SET DEFAULT ICON TO "HMG_ICO" // фонт по default cFont := "DejaVu Sans Mono" nSize := 18 SET FONT TO cFont, nSize DEFINE FONT Normal FONTNAME cFont SIZE nSize DEFINE FONT Bold FONTNAME cFont SIZE nSize BOLD IF ( lNoMain := Empty( _HMG_MainHandle ) ) SET WINDOW MAIN OFF ENDIF bSet := {|ob,um| Local oc, fn IF Empty(um) // before END TBROWSE ELSE // after END TBROWSE fn := GetFontHandle("Bold") FOR EACH oc IN ob:aColumns IF oc:cName == "SELECTOR" ; LOOP ENDIF oc:hFontHead := fn IF oc:cName == "ORDKEYNO" oc:hFont := fn oc:hFontFoot := fn ENDIF NEXT ob:SetNoHoles() ob:SetFocus() ENDIF Return .T. } bRec := {|ob,um| Local oc, fn IF Empty(um) // before END TBROWSE ob:aMsg[1] := "Вкл." ob:aMsg[2] := "Выкл." ob:InsColNumber(60, 1, "ORDKEYNO") ob:lFooting := ob:lDrawFooters := .T. ob:nHeightFoot := ob:nHeightCell ELSE // after END TBROWSE fn := GetFontHandle("Bold") FOR EACH oc IN ob:aColumns IF oc:cName == "SELECTOR" ; LOOP ELSEIF oc:cName == "ORDKEYNO" oc:hFont := fn oc:hFontFoot := fn oc:nAlign := DT_CENTER ENDIF oc:hFontHead := fn NEXT ob:nFreeze := ob:nColumn("ORDKEYNO") ob:SetNoHoles() ob:GoRight() DO EVENTS ob:SetFocus() ENDIF Return .T. } //bSet := {|| .T. } //bRec := {|| .F. } // или задавать как bSet с параметрами bSetUp := { bSet, , bRec } USE ( "CUSTOMER" ) ALIAS CUST NEW SHARED oDlu := oDlu4Font( _HMG_DefaultFontSize ) nW := Sys.ClientWidth nH := oDlu:H1 * ( fCount() + 4 ) + 5 nH := iif( nH > Sys.ClientHeight, Sys.ClientHeight, nH ) nH := { Sys.ClientHeight, nH } sBrowse( Alias(), "DEMO. Test new SBrowse", bSetUp, , nW, nH, , .T., .T. ) IF lNoMain SET WINDOW MAIN ON ENDIF RETURN NIL [/pre2]
gfilatov2002: SergKis пишет: Еще небольшие правки OK
gfilatov2002: Выложил январскую ANSI сборку 22.01 с учетом всех последних изменений по адресу http://hmgextended.com/files/CONTRIB/hmg-22.01-setup.exe Рассматриваю эту сборку как финальную P.S. Архив уникодной сборки также обновил...
Dima: gfilatov2002 пишет: Выложил январскую ANSI сборку 22.01 с учетом всех последних изменений по адресу [pre2] * Updated: '2 TBrowse Demo' sample. Contributed by Sergej Kiselev (see demo2.prg in folder \samples\Advanced\Tsb_2tsb) [/pre2] А так и должно быть когда ставим курсор на какую то строку то все значения в ней по всем полям показаны белым по белому ?
SergKis: Dima пишет А так и должно быть когда ставим курсор на какую то строку то все значения в ней по всем полям показаны белым по белому ? Положил на ftp картинку+prg+exe demo2.prg смотри все ok!, собрал только что. Добавил в Title версию hmg
Dima: SergKis я тебе тоже сложил картинку уже из собранного тобой модуля , ни чего не изменилось
SergKis: Dima Глянь еще вариант положил. Сделал выделенное цветом, вместо GetSysColor( COLOR_WINDOWTEXT ) [pre2] oTsb1:aColor := { ; { CLR_FOCUSB, {|c,n,b| c := n, iif( b:nCell == n, -CLR_HRED, -RGB( 128, 225, 225 ) ) } }, ; { CLR_SELEF , CLR_BLACK }, ; { CLR_SELEB , {|c,n,b| c := n, iif( b:nCell == n, -CLR_BLUE, -RGB( 128, 225, 225 ) ) } } ; } [/pre2]
Dima: SergKis Тоже самое и сразу после старта , картинку сложил на фтп Ладно , забей , мне сейчас особо не когда этим заниматься , просто глянул что нового в релизе и вот попал на такое и сразу отписал. PS У меня windows 7 может с этим связано.....
SergKis: Dima Извини, но пробни еще вариант, положил. Сделал[pre2] oBrw1 := _TBrowse( oTsb1, "CUST1", "Brw_1", nY, nX, nW, nH ) oBrw1:SetColor( { CLR_TEXT }, { CLR_BLACK } ) oBrw1:SetColor( { CLR_SELEF }, { CLR_BLACK } ) [/pre2] PS У меня windows 7 может с этим связано..... Возможно это связано с массивом aColor, сталкивался ранее, что некоторые позиции цветов из него не корректно брались или перекрывались.
Dima: Картина не изменилась , могу кино сделать если нужно В Demo.exe и Demo3.exe такая же бяка
Dima: вот такую строки добавил в нужных местах oBrw1:SetColor( { CLR_FOCUSF }, { CLR_BLACK } ) oBrw2:SetColor( { CLR_FOCUSF }, { CLR_BLACK } ) и нормик
gfilatov2002: Dima пишет: вот такую строки добавил в нужных местах Благодарю за наводку Уже поправил небольшую опечатку в коде h_tbrowse.prg, завтра выложу новый инсталлятор для проверки...
gfilatov2002: Выложил обновленный инсталлятор сборки 22.01 с минимальными изменениями в файле h_tbrowse.prg
Dima: gfilatov2002 Супер , только это не решило "проблему" , все по прежнему.
gfilatov2002: Dima пишет: это не решило "проблему" Понятно Благодарю за сообщение
gfilatov2002: Снова обновил установщик сборки 22.01 для решения "проблемы" с цветом выделенного поля в функции _TBrowse(). У себя такой беды не наблюдаю (смотрел версии Win7, Win10).
Dima: https://cloud.mail.ru/public/Mb9m/28ci6LJvk У меня тема в винде обычная не Aero , хз может в этом дело
Andrey: Скачал последнюю версию МиниГуи. У меня Win 8.1 Такого кино как у Димы - не наблюдаю.
Dima: Andrey Так тема винды там наверное Aero и её не сменить как и в Win10
Dima: Чекнул интереса ради Ежели установить Aero тему (любую) то проблемы нет А если классическую то
gfilatov2002: Выложил 1-е обновление сборки 22.01 по адресу: http://hmgextended.com/files/CONTRIB/hmg-22.01-setup.exe Желаю всем мира и добра
Andrey: gfilatov2002 пишет: Выложил 1-е обновление сборки 22.01 по адресу: Попробовал. Просьба, при создании библиотеки SAMPLES\Advanced\Tsb_Viewer\Lib - саму библиотеку TsbViewer.lib копировать автоматом в папку \MiniGUI\Lib Чтобы потом можно было сразу обращаться к этой библиотеке.
Dima: Andrey пишет: Просьба, при создании библиотеки SAMPLES\Advanced\Tsb_Viewer Кстати тут те же косяки с данными под курсором и обратил внимание что они есть во всех примерах где юзается _TBrowse
Andrey: Dima пишет: Кстати тут те же косяки с данными под курсором и обратил внимание что они есть во всех примерах где юзается _TBrowse Нет не видел. По тестирую у себя.
Dima: Andrey пишет: Нет не видел. По тестирую у себя. Что бы время зря не тратил а то ведь скажешь что не читал , так вот читай мой пост в этой теме Пост N: 7563
SergKis: Dima пишет вот такую строки добавил в нужных местах oBrw1:SetColor( { CLR_FOCUSF }, { CLR_BLACK } ) oBrw2:SetColor( { CLR_FOCUSF }, { CLR_BLACK } ) и нормик Это согласуется\работает с "Пост N: 7563" ?
Dima: SergKis пишет: Это согласуется\работает с "Пост N: 7563" ? Да работает нормально если такие строки есть
SergKis: Dima Уточню. Такие строки не работают с указанным CLR_SELEF, CLR_FOCUSF в oBrw1 ? [pre2] oTsb1:aColor := { ; { CLR_FOCUSF, CLR_BLACK }, ; { CLR_FOCUSB, {|c,n,b| c := n, iif( b:nCell == n, -CLR_HRED, -RGB( 128, 225, 225 ) ) } }, ; { CLR_SELEF , CLR_BLACK }, ; { CLR_SELEB , {|c,n,b| c := n, iif( b:nCell == n, -CLR_BLUE, -RGB( 128, 225, 225 ) ) } } ; } а такой вариант работает с "Пост N: 7563" ? oBrw1:SetColor( { CLR_FOCUSF }, { GetSysColor( COLOR_WINDOWTEXT ) } ) oBrw2:SetColor( { CLR_FOCUSF }, { GetSysColor( COLOR_WINDOWTEXT ) } ) [/pre2]
Dima: SergKis пишет: а такой вариант работает с "Пост N: 7563" ? oBrw1:SetColor( { CLR_FOCUSF }, { GetSysColor( COLOR_WINDOWTEXT ) } ) oBrw2:SetColor( { CLR_FOCUSF }, { GetSysColor( COLOR_WINDOWTEXT ) } ) Работает !
Dima: SergKis пишет: oTsb1:aColor := { ; { CLR_FOCUSF, CLR_BLACK }, ; { CLR_FOCUSB, {|c,n,b| c := n, iif( b:nCell == n, -CLR_HRED, -RGB( 128, 225, 225 ) ) } }, ; { CLR_SELEF , CLR_BLACK }, ; { CLR_SELEB , {|c,n,b| c := n, iif( b:nCell == n, -CLR_BLUE, -RGB( 128, 225, 225 ) ) } } ; } Не работает
SergKis: Dima Будет время, глянь на ftp пример, сделал с трассировкой в _msglog.txt и кинь его обратно (свой с 7-ки), пожалуйста
Dima: Пример я не пересобирал и запустил как есть и все кажет нормально в то время смотрю что в сырце закоментированы строки //oBrw2:SetColor( { CLR_SELEF }, { CLR_BLACK } ) то есть как ты собирал EXE я не знаю с коментом этих строк или нет _msglog.txt закинул
SergKis: Dima пишет Пример я не пересобирал и запустил как есть и все кажет нормально в то время смотрю что в сырце закоментированы строки //oBrw2:SetColor( { CLR_SELEF }, { CLR_BLACK } ) Собран пример без этих строк, т.е. с [pre2] DEFAULT aColor := { ; { CLR_FOCUSF, GetSysColor( COLOR_WINDOWTEXT ) }, ; { CLR_FOCUSB, {|c,n,b| c := n, iif( b:nCell == n, -CLR_HRED, -RGB( 128, 225, 225 ) ) } }, ; { CLR_SELEF , GetSysColor( COLOR_WINDOWTEXT ) }, ; { CLR_SELEB , {|c,n,b| c := n, iif( b:nCell == n, -CLR_BLUE, -RGB( 128, 225, 225 ) ) } } } [/pre2] вывел в лог значения цветов на разных этапах. По идее у тебя должно было НЕ работать, а отработало правильно и :nClrFore -> 0 Может Aero стоит ?
Dima: SergKis пишет: Может Aero стоит ? Не стоит , не люблю я его
Dima: Счас пробну пересобрать пример Пересобрал и снова лажа......
Dima: закинул новый LOG на фтп
SergKis: На твоей сборке ? hb_enumindex(oc), oc:nClrFore, oc:nClrFocuFore, oc:nClrSeleFore дает 1 0 16777215 0 вместо 1 0 0 0 и массив цветов в тсб такой Brw_1 ARRAY[20] {0, 16777215, 0, 13160660, 16777215, {|| ... }, 0, 16777215, 0, 13160660, 0, {|| ... }, 0, 13160660, 8421504, 0, 13160660, 0, 13160660, 255} где цветом должен быть 0 пример такой, для ясности другим [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * * Copyright 2021 Sergej Kiselev <bilance@bilance.lv> */ #define _HMG_OUTLOG #include "hmg.ch" #include "tsbrowse.ch" REQUEST DBFCDX FUNCTION Main() LOCAL cFont := "Arial" LOCAL nSize := 12 LOCAL cForm := "wMain" LOCAL oBrw1, oBrw2, nY, nX, nH, nW, nG, oTsb1, oTsb2 LOCAL oc rddSetDefault( "DBFCDX" ) SET OOP ON SET EPOCH TO 2000 SET DATE TO GERMAN SET CENTURY ON SET AUTOPEN OFF SET DELETED OFF SET FONT TO cFont, nSize USE ( "CUSTOMER" ) ALIAS CUST1 NEW SHARED USE ( "CUSTOMER" ) ALIAS CUST2 NEW SHARED DEFINE WINDOW &cForm TITLE "Demo 2 TBrowse" MAIN TOPMOST ; ON INIT ( This.Topmost := .F. ) ; ON RELEASE ( dbCloseAll() ) This.Maximize nY := nX := nG := 20 nW := This.ClientWidth - nG * 2 nH := Int( This.ClientHeight / 2 ) - nG - nG / 2 ? procname(), GetSysColor( COLOR_WINDOWTEXT ), CLR_BLACK oTsb1 := oHmgData() oTsb1:lDrawSpecHd := .T. oTsb1:uSelector := .T. oTsb1:nBrw := 1 @ 0, nX LABEL Label_1 VALUE "F1 - window covers the table" FONTCOLOR RED SIZE 8 AUTOSIZE TRANSPARENT oBrw1 := _TBrowse( oTsb1, "CUST1", "Brw_1", nY, nX, nW, nH ) //oBrw1:SetColor( { CLR_SELEF }, { CLR_BLACK } ) oBrw1:bTSDrawCell := {|ob,o,oc| iif(o:lDrawLine, ,_logfile(.T., ob:nColumn(oc:cName), oc:cName, o:nClrFore, o:nClrTo )) } ? ? "Brw_1", oBrw1:aColors, hb_valtoexp(oBrw1:aColors) FOR EACH oc IN oBrw1:aColumns ? hb_enumindex(oc), oc:nClrFore, oc:nClrFocuFore, oc:nClrSeleFore NEXT ? nY += nH + 1 + nG nH -= 1 oTsb2 := oHmgData() oTsb2:lDrawSpecHd := .T. oTsb2:uSelector := .T. oTsb2:nBrw := 2 @ nH + 22, nX LABEL Label_2 VALUE "F2 - window covers the table without a header" FONTCOLOR RED SIZE 8 AUTOSIZE TRANSPARENT oBrw2 := _TBrowse( oTsb2, "CUST2", "Brw_2", nY, nX, nW, nH ) //oBrw2:SetColor( { CLR_SELEF }, { CLR_BLACK } ) oBrw2:bTSDrawCell := {|ob,o,oc| iif(o:lDrawLine, ,_logfile(.T., ob:nColumn(oc:cName), oc:cName, o:nClrFore, o:nClrTo )) } ? ? "Brw_2", oBrw2:aColors, hb_valtoexp(oBrw2:aColors) FOR EACH oc IN oBrw2:aColumns ? hb_enumindex(oc), oc:nClrFore, oc:nClrFocuFore, oc:nClrSeleFore NEXT ? oBrw1:SetFocus() ON KEY TAB ACTION {| cf | cf := ThisWindow.FocusedControl, ; iif( cf == "Brw_1", This.Brw_2.SetFocus, This.Brw_1.SetFocus ) } ON KEY ESCAPE ACTION ( iif( oBrw1:IsEdit, oBrw1:SetFocus(), ; iif( oBrw2:IsEdit, oBrw2:SetFocus(), ; ThisWindow.Release ) ) ) ( This.Object ):Event( 1, {| ow | myWin( ow, "Brw_1", .F. ) } ) ( This.Object ):Event( 2, {| ow | myWin( ow, "Brw_2", .T. ) } ) ON KEY F1 ACTION _wPost( 1 ) ON KEY F2 ACTION _wPost( 2 ) END WINDOW ACTIVATE WINDOW wMain RETURN NIL FUNCTION myWin( oWnd, cBrw, lHead ) LOCAL oBrw, nBrw, nW, nH, nRow, nCol, oTsb, oc1, nw1 SET WINDOW THIS TO oWnd:Name oBrw := This.&(cBrw).OBJECT oTsb := oBrw:Cargo:oParam // parameters oTsb1 or oTsb2 nBrw := oTsb:nBrw oc1 := oBrw:GetCellSize( 1, 1 ) nw1 := oBrw:GetColumn( "SELECTOR" ):nWidth nRow := oc1:nRow nCol := oc1:nCol + 1 nW := GetWindowWidth ( oBrw:hWnd ) - 2 nH := GetWindowHeight( oBrw:hWnd ) - 2 IF Empty( lHead ) nRow -= ( oBrw:nHeightSpecHd + oBrw:nHeightHead ) nRow += 1 nCol += 1 nW -= 1 ELSE nCol += nw1 nRow += 1 nCol += 1 nW -= ( nw1 + GetVScrollBarWidth() + 1 ) nH -= ( oBrw:nHeightHead + oBrw:nHeightSpecHd + GetHScrollBarHeight() + 1 ) ENDIF DEFINE WINDOW wZero AT nRow, nCol WIDTH nW HEIGHT nH MODAL NOCAPTION NOSIZE BACKCOLOR YELLOW This.Cargo := oHmgData() This.Cargo:oParent := oWnd This.Cargo:cBrw := cBrw This.Cargo:oBrw := oBrw This.Cargo:nBrw := nBrw This.Cargo:oTsb := oTsb @ nH / 2 - 20, 0 LABEL Label_0 VALUE "ESC - exit" WIDTH nW HEIGHT 40 FONTCOLOR RED SIZE 28 CENTERALIGN TRANSPARENT ON KEY ESCAPE ACTION ThisWindow.RELEASE END WINDOW ACTIVATE WINDOW wZero SET WINDOW THIS TO oBrw:SetFocus() RETURN NIL [/pre2]
Dima: я сырцы не трогал , ни примера ни самих сырцов MG Григорий выложил обнову MG и я его накатил на то что есть , так всегда делаю
SergKis: Dima пишет я сырцы не трогал тут еще одна интересная штука ? procname(), GetSysColor( COLOR_WINDOWTEXT ), CLR_BLACK дает в лог MAIN 0 0 а в массив цветов попало уже др. значение (выше цветом выделено) ? "Brw_1", oBrw1:aColors, hb_valtoexp(oBrw1:aColors) не понятка, т.к. в h_tbrowse.prg из aColors => aTmpColor простой перенос 20 элементов[pre2] IF aColors != NIL IF HB_ISARRAY( aColors ) .AND. Len( aColors ) > 0 .AND. 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] цветной кусок работает PS Я TsBrowse.lib пересобирал, но исп. только _logfile() для просмотра как данные из входного aColors => в aTmpColor[20] элементов переходят, потом убрал.
SergKis: Dima Положил на ftp свою TsBrowse.lib, попробуй с ней собрать пример
Dima: SergKis пишет: Положил на ftp свою TsBrowse.lib, попробуй с ней собрать пример Все работает штатно и правильно !
SergKis: Dima пишет Все работает штатно и правильно ! Спасибо Осталось тебе у себя пересобрать либу, запустив TsBrowse\MakeLib.bat и проверить сборку на примере
Dima: Пересобрал , снова лажа.......
Dima: видать Григорий что то не досмотрел и твои сырцы не совпадают с его
SergKis: Dima Так я не менял сырцы, как вчера развернул, потыкал _logfile(), убрал и все. Положил h_tbrowse.prg, попробуй у себя с ним собрать.
Dima: там и размеры разные по ходу счас сделаю
Dima: чёт меня этот цирк уже утомил.... пересобрал с твоим h_tbrowse.prg , собрал пример , работает НЕ правильно беру твой tsbrowse.lib и собираю с ним , все ОТЛИЧНО
SergKis: Dima пишет чёт меня этот цирк уже утомил.... Извини , сам не пойму, в чем дело (у меня win10). Подождем, может само пройдет
Dima: SergKis пишет: Подождем, может само пройдет Само не пройдет ты ведь чудесно это понимаешь Счас выложу сырцы TS к тебе , сравни со своими пожалуйста Сложил
SergKis: Dima Есть разница по 1-му файлу h_controlmisc2.prg Положил его. Пробни
Dima: SergKis пишет: Есть разница по 1-му файлу h_controlmisc2.prg Сергей вот теперь всё отлично работает Спасибо !
SergKis: Dima Нашел, где "собака порылась" 26.01 с утра сделал правку, отвлекли и я забыл пометить ее (пометки смотрю - их нет, думаю и правок нет). Тут строку вставил[pre2] DEFAULT aColor := { ; { CLR_FOCUSF, GetSysColor( COLOR_WINDOWTEXT ) }, ; { CLR_FOCUSB, {|c,n,b| c := n, iif( b:nCell == n, -CLR_HRED, -RGB( 128, 225, 225 ) ) } }, ; { CLR_SELEF , GetSysColor( COLOR_WINDOWTEXT ) }, ; { CLR_SELEB , {|c,n,b| c := n, iif( b:nCell == n, -CLR_BLUE, -RGB( 128, 225, 225 ) ) } } } [/pre2] Я же говорил, надо подождать и само пройдет
Dima:
gfilatov2002: Завершена подготовка 2-го обновления сборки 22.01, которое планируется опубликовать на следующей неделе. Что нового: - исправлена ошибка: при использовании команды SET WINDOW MAIN OFF не обрабатывались события окон ON SIZE и ON MAXIMIZE; - добавлены команды для отправки почты с вложениями и с поддержкой SSL протокола, также можно получать уведомление о прочтении письма; - добавлена возможность получить номер строки, нажатой при выполнении события ON CHECKBOXCLICKED в гриде со стилем CHECKBOXES; - добавлены два новых примера. Если у вас есть дополнения для этого обновления, то я с удовольствием их добавлю в библиотеку Благодарю за ваша внимание к данному проекту
Andrey: Просьба, при создании библиотеки SAMPLES\Advanced\Tsb_Viewer\Lib - саму библиотеку TsbViewer.lib копировать автоматом в папку \MiniGUI\Lib Чтобы потом можно было сразу обращаться к этой библиотеке.
Haz: Andrey пишет: копировать автоматом в папку \MiniGUI\Lib может сначала выясним будут ли её использовать ? Поясню Одно дело как обучающий пример, если понравилось, сделал библиотеку сам и пользуй. Другое , это примеры пихать в основу библиотек пакета. Встроенный sbrowse() более чем достаточно чтоб глянуть что попало в выборку. Для работы с базами полно внешних утилит, которые в добавок умеют несравнимо больше и удобнее.
SergKis: gfilatov2002 Небольшой пример с _TBrowse() с параметрами из ini https://TransFiles.ru/wa3ih
Andrey: Haz пишет: Другое , это примеры пихать в основу библиотек пакета. Это просто отдельная библиотека на базе ТСБ и больше ничего. Просто каждый раз ручками переписывать TsbViewer.lib в общедоступный каталог для сборки - дело утомительно. Я прошу просто подправить батники и всё, для удобства кто захочет пользоваться этой библиотекой. Внешние утилиты использовать просто утомительно, собрать свою прогу, запустить, получить dbf, завершить прогу, перейти в папку с созданной базой, запустить внешнюю прогу с нужной базой - слишком много лишних телодвижений. А так просто одна команда в исходнике и всё !!! Пользоваться или нет этой библиотекой это дело личное. Я старался сделать TsbViewer более удобным для работы с базой, у встроенного sbrowse() нет таких функций.
gfilatov2002: SergKis пишет: пример с _TBrowse() с параметрами из ini Супер Большое спасибо за наглядный пример
SergKis: gfilatov2002 В примере допустил неточность, изменил :HeightHead после END TBROWSE - это может приводить к дырке внизу Вот исправленный текст [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" #include "tsbrowse.ch" #include "Dbinfo.ch" #xtranslate MiniGuiVersionChar() => Substr( MiniGuiVersion(), At(".", MiniGuiVersion()) - 2, 8 ) #xtranslate MiniGuiVersionNumba() => Int( Val( MiniGuiVersionChar() ) * 10000 + Val( Right(MiniGuiVersionChar(), 2) ) ) #xtranslate LenU( <c> ) => Len( <c> ) /* #xtranslate LenU( <c> ) => iif( hb_IsArray( <c> ) .or. hb_IsHash( <c> ), Len( <c> ), iif( hb_IsChar( <c> ), hb_ULen( <c> ), 0 ) ) #xtranslate At( <c>, <n> ) => hb_UAt( <c>, <n> ) #xtranslate Left( <c>, <n> ) => hb_ULeft( <c>, <n> ) #xtranslate Right( <c>, <n> ) => hb_URight( <c>, <n> ) #xtranslate SubStr( <cS>, <nS> ) => hb_USubStr( <cS>, <nS> ) #xtranslate SubStr( <cS>, <nS>, <nL> ) => hb_USubStr( <cS>, <nS>, <nL> ) #xtranslate Subs( <cS>, <nS> ) => hb_USubStr( <cS>, <nS> ) #xtranslate Subs( <cS>, <nS>, <nL> ) => hb_USubStr( <cS>, <nS>, <nL> ) */ REQUEST DBFCDX, DBFFPT REQUEST HB_CODEPAGE_UTF8 Function Main() LOCAL cFont := "Arial" LOCAL nSize := 12 LOCAL cForm := "wMain" LOCAL cBrw1 := "Brw_1" LOCAL cIni := hb_FNameExtSet( hb_ProgName(), ".ini" ) LOCAL oIni := TIniData():New(cIni, .T.):Read() LOCAL oCom := oIni:COM LOCAL oBrw1, nY, nX, nH, nW, oTsb1, cLog SET CODEPAGE TO RUSSIAN SET LANGUAGE TO RUSSIAN RddSetDefault("DBFCDX") SET OOP ON SET EPOCH TO 2000 SET DATE TO GERMAN SET CENTURY ON SET AUTOPEN OFF SET DELETED OFF SET NAVIGATION EXTENDED SET DEFAULT ICON TO "1MAIN_ICO" Default oCom:FontName := cFont, ; oCom:FontSize := nSize, ; oCom:LogName := ".\Msg.log" cFont := oCom:FontName nSize := oCom:FontSize cLog := oCom:LogName SET LOGFILE TO ( cLog ) ; fErase( cLog ) SET FONT TO cFont, nSize // фонт по default для oTsb1, oBrw1 DEFINE FONT Normal FONTNAME cFont SIZE nSize DEFINE FONT Bold FONTNAME cFont SIZE nSize BOLD DEFINE FONT Italic FONTNAME cFont SIZE nSize BOLD ITALIC USE ( "CUSTOMER" ) ALIAS CUST1 NEW SHARED DEFINE WINDOW &cForm TITLE "Demo ini => TBrowse" MAIN NOSIZE TOPMOST ; ON INIT ( This.Topmost := .F. ) ; ON RELEASE ( dbCloseAll() ) This.Maximize nY := nX := 0 nW := This.ClientWidth nH := This.ClientHeight oTsb1 := oIni:&(cBrw1) // секция [Brw_1] //? oTsb1:GetAll() ; ?v oTsb1:GetAll() ; ? oTsb1:aText := oIni:&(cBrw1+"_Text"):GetAll() oTsb1:bBody := {|ob,op| Local oCol, aTxt, nTxt := 0 FOR EACH oCol IN ob:aColumns IF oCol:cName == "SELECTOR" ; LOOP ENDIF oCol:hFont := GetFontHandle( op:aFont[1] ) IF oCol:cFieldTyp == "C" oCol:cPicture := Nil oCol:nWidth := oCol:ToWidth( iif( oCol:nFieldLen > 50, 50, oCol:nFieldLen ), 0.82 ) ENDIF IF oCol:cName == "CUSTNO" oCol:lEdit := .F. ENDIF NEXT FOR EACH aTxt IN op:aText oCol := ob:GetColumn(aTxt[1]) IF "\" $ aTxt[2] nTxt++ oCol:cHeading := StrTran(aTxt[2], "\", CRLF) ELSE oCol:cHeading := aTxt[2] ENDIF NEXT IF nTxt > 0 ob:nHeightHead := GetFontHeight( op:aFont[2] ) * 2 ENDIF Return Nil } oBrw1 := _TBrowse( oTsb1, "CUST1", cBrw1, nY, nX, nW, nH ) oBrw1:SetFocus() ; DO EVENTS ON KEY ESCAPE ACTION iif( oBrw1:IsEdit, oBrw1:SetFocus(), ThisWindow.Release ) ON KEY F1 ACTION NIL END WINDOW //CENTER WINDOW wMain ACTIVATE WINDOW wMain RETURN NIL [/pre2]
gfilatov2002: SergKis пишет: исправленный текст OK
Haz: Andrey пишет: Просто каждый раз ручками переписывать TsbViewer.lib в общедоступный каталог для сборки - дело утомительно Ну так один раз положил в папку библиотек минигуи , сам, ручками и ничего прописывать больше не надо. Зачем всем то это счастье ? Более того , при обновлении минигуи поверх, свои библиотеки там остаются.
Haz: Andrey пишет: у встроенного sbrowse() нет таких функций. они там не нужны. Задача sbrowse() визуально оценить выборку и может быть чуть чуть подправить. Как отдельный пример, да хорошо, но как пример. Внешние утилиты все же не заменит. Нет sql нет удалённого подключения, нет изменения структур на лету, нет групповых операций . Да и незачем свой проект нагружать лишним кодом ради того чтобы пару раз посмотреть. Я уже не говорю про дыру безопасности в проекте Ps. Почти у всех есть свои библиотеки, это не повод под них батник править.
SergKis: gfilatov2002 Немного модифицировал пример, добавив в ini события для клавиш demo.ini - [pre2] [COM] FontName = Arial FontSize = 14 LogName = .\_msg.log [Brw_1] aFont = {"Normal", "Bold", "Bold", "Italic", "Bold"} aNumber = {1, 70} uSelector = .T. aEdit = .T. lSpecHd = .T. aFoot = .T. aEditNo = {"CUSTNO", "LASTINVOIC"} nFireKey = 0 ; F2 F3 F4 F5 F6 F7 F8 F9 aMsgPost = {113, 114, 115, 116, 117, 118, 119, 120} [Brw_1_Text] CustNo = Иденти\фикатор Company = Наименование \ клиента Addr1 = Адрес клиента Addr2 = Адрес \ ( продолжение ) City = Город State = Область Country = Страна [/pre2] demo.prg - [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" #include "tsbrowse.ch" //#include "Dbinfo.ch" #xtranslate MiniGuiVersionChar() => Substr( MiniGuiVersion(), At(".", MiniGuiVersion()) - 2, 8 ) #xtranslate MiniGuiVersionNumba() => Int( Val( MiniGuiVersionChar() ) * 10000 + Val( Right(MiniGuiVersionChar(), 2) ) ) #xtranslate LenU( <c> ) => Len( <c> ) /* #xtranslate LenU( <c> ) => iif( hb_IsArray( <c> ) .or. hb_IsHash( <c> ), Len( <c> ), iif( hb_IsChar( <c> ), hb_ULen( <c> ), 0 ) ) #xtranslate At( <c>, <n> ) => hb_UAt( <c>, <n> ) #xtranslate Left( <c>, <n> ) => hb_ULeft( <c>, <n> ) #xtranslate Right( <c>, <n> ) => hb_URight( <c>, <n> ) #xtranslate SubStr( <cS>, <nS> ) => hb_USubStr( <cS>, <nS> ) #xtranslate SubStr( <cS>, <nS>, <nL> ) => hb_USubStr( <cS>, <nS>, <nL> ) #xtranslate Subs( <cS>, <nS> ) => hb_USubStr( <cS>, <nS> ) #xtranslate Subs( <cS>, <nS>, <nL> ) => hb_USubStr( <cS>, <nS>, <nL> ) */ REQUEST DBFCDX, DBFFPT REQUEST HB_CODEPAGE_UTF8 Function Main() LOCAL cFont := "Arial" LOCAL nSize := 12 LOCAL cForm := "wMain" LOCAL cBrw1 := "Brw_1" LOCAL cIni := hb_FNameExtSet( hb_ProgName(), ".ini" ) LOCAL oIni := TIniData():New(cIni, .T.):Read() LOCAL oCom := oIni:COM LOCAL oBrw1, nY, nX, nH, nW, oTsb1, cLog, nTmp SET CODEPAGE TO RUSSIAN SET LANGUAGE TO RUSSIAN RddSetDefault("DBFCDX") SET OOP ON SET EPOCH TO 2000 SET DATE TO GERMAN SET CENTURY ON SET AUTOPEN OFF SET DELETED OFF SET NAVIGATION EXTENDED SET DEFAULT ICON TO "1MAIN_ICO" Default oCom:FontName := cFont, ; oCom:FontSize := nSize, ; oCom:LogName := ".\Msg.log" cFont := oCom:FontName nSize := oCom:FontSize cLog := oCom:LogName SET LOGFILE TO ( cLog ) ; fErase( cLog ) SET FONT TO cFont, nSize // фонт по default для oTsb1, oBrw1 DEFINE FONT Normal FONTNAME cFont SIZE nSize DEFINE FONT Bold FONTNAME cFont SIZE nSize BOLD DEFINE FONT Italic FONTNAME cFont SIZE nSize - 2 ITALIC USE ( "CUSTOMER" ) ALIAS CUST1 NEW SHARED DEFINE WINDOW &cForm TITLE "Demo ini => TBrowse" MAIN NOSIZE TOPMOST ; ON INIT ( This.Topmost := .F. ) ; ON RELEASE ( dbCloseAll() ) This.Maximize /* nY := nX := 0 nW := This.ClientWidth nH := This.ClientHeight */ oTsb1 := oIni:&(cBrw1) // секция [Brw_1] //? oTsb1:GetAll() ; ?v oTsb1:GetAll() ; ? //oTsb1:aText := oIni:&(cBrw1+"_Text"):GetAll() oTsb1:oText := oIni:&(cBrw1+"_Text") oTsb1:bBody := {|ob,op| Local oCol, aTxt, nTxt, lEditNo, nTmp, aTmp lEditNo := HB_ISARRAY(op:aEditNo) .and. LenU(op:aEditNo) > 0 FOR EACH oCol IN ob:aColumns oCol:hFont := GetFontHandle( op:aFont[1] ) IF oCol:cFieldTyp == "C" oCol:cPicture := Nil oCol:nWidth := oCol:ToWidth( iif( oCol:nFieldLen > 50, 50, oCol:nFieldLen ), 0.82 ) ELSEIF oCol:cFieldTyp == "M" oCol:cPicture := Nil oCol:nWidth := oCol:ToWidth(40) ELSEIF oCol:cFieldTyp == "D" oCol:cPicture := Nil oCol:nWidth := oCol:ToWidth(10) ELSEIF oCol:cFieldTyp == "T" oCol:cPicture := Nil oCol:nWidth := oCol:ToWidth(24) ENDIF IF lEditNo .and. AScan(op:aEditNo, oCol:cName) > 0 oCol:lEdit := .F. ENDIF NEXT nTmp := 1 nTxt := 0 FOR EACH aTxt IN op:oText:GetAll() // op:aText IF ob:nColumn(aTxt[1], .T.) == 0 ; LOOP ENDIF oCol := ob:GetColumn(aTxt[1]) IF "\" $ aTxt[2] nTxt++ aTmp := hb_ATokens(aTxt[2], "\") nTmp := Max( nTmp, LenU(aTmp)) oCol:cHeading := StrTran(aTxt[2], "\", CRLF) ELSE oCol:cHeading := aTxt[2] ENDIF NEXT IF nTxt > 0 ob:nHeightHead := GetFontHeight( op:aFont[2] ) * nTmp ENDIF IF HB_ISARRAY(op:aMsgPost) .and. LenU(op:aMsgPost) > 0 FOR EACH nTxt IN op:aMsgPost ob:UserKeys(nTxt, {|ob,nk| _wPost(nk, ob:cParentWnd, ob) }) NEXT ENDIF Return Nil } oBrw1 := _TBrowse( oTsb1, "CUST1", cBrw1, nY, nX, nW, nH ) oBrw1:SetFocus() ; DO EVENTS ON KEY ESCAPE ACTION iif( oBrw1:IsEdit, oBrw1:SetFocus(), ThisWindow.Release ) ON KEY F1 ACTION NIL IF HB_ISARRAY(oTsb1:aMsgPost) .and. LenU(oTsb1:aMsgPost) > 0 FOR EACH nTmp IN oTsb1:aMsgPost (This.Object):Event( nTmp, {|ow,ky,ob| MsgBox("Press: "+cValToChar(ky)+"-"+ob:cControlName, ow:Name), ob:SetFocus() } ) NEXT ENDIF END WINDOW //CENTER WINDOW wMain ACTIVATE WINDOW wMain RETURN NIL [/pre2]
SergKis: PS. Еще вариант этого же решения с событиями, кому интересно demo.ini - [pre2] [COM] FontName = Arial FontSize = 14 LogName = .\_msg.log [Brw_1] aFont = {"Normal", "Bold", "Bold", "Italic", "Bold"} aNumber = {1, 70} uSelector = .T. aEdit = .T. lSpecHd = .T. aFoot = .T. aEditNo = {"CUSTNO", "LASTINVOIC"} nFireKey = 0 ; F2 F3 F4 F5 F6 F7 F8 F9 aMsgPost = {113, 114, 115, 116, 117, 118, 119, 120} [Brw_1_Keys] 113 = {|ob,nk| _wPost(nk, ob:cParentWnd, ob) } ; VK_F2 114 = {|ob,nk| _wPost(nk, ob:cParentWnd, ob) } ; VK_F3 115 = {|ob,nk| _wPost(nk, ob:cParentWnd, ob) } ; VK_F4 116 = {|ob,nk| _wPost(nk, ob:cParentWnd, ob) } ; VK_F5 117 = {|ob,nk| _wPost(nk, ob:cParentWnd, ob) } ; VK_F6 118 = {|ob,nk| _wPost(nk, ob:cParentWnd, ob) } ; VK_F7 119 = {|ob,nk| _wPost(nk, ob:cParentWnd, ob) } ; VK_F8 120 = {|ob,nk| _wPost(nk, ob:cParentWnd, ob) } ; VK_F9 [Brw_1_Text] CustNo = Иденти\фикатор Company = Наименование \ клиента Addr1 = Адрес клиента Addr2 = Адрес \ ( продолжение ) City = Город State = Область Country = Страна [/pre2] demo.prg - [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" #include "tsbrowse.ch" //#include "Dbinfo.ch" #xtranslate MiniGuiVersionChar() => Substr( MiniGuiVersion(), At(".", MiniGuiVersion()) - 2, 8 ) #xtranslate MiniGuiVersionNumba() => Int( Val( MiniGuiVersionChar() ) * 10000 + Val( Right(MiniGuiVersionChar(), 2) ) ) #xtranslate LenU( <c> ) => Len( <c> ) /* #xtranslate LenU( <c> ) => iif( hb_IsArray( <c> ) .or. hb_IsHash( <c> ), Len( <c> ), iif( hb_IsChar( <c> ), hb_ULen( <c> ), 0 ) ) #xtranslate At( <c>, <n> ) => hb_UAt( <c>, <n> ) #xtranslate Left( <c>, <n> ) => hb_ULeft( <c>, <n> ) #xtranslate Right( <c>, <n> ) => hb_URight( <c>, <n> ) #xtranslate SubStr( <cS>, <nS> ) => hb_USubStr( <cS>, <nS> ) #xtranslate SubStr( <cS>, <nS>, <nL> ) => hb_USubStr( <cS>, <nS>, <nL> ) #xtranslate Subs( <cS>, <nS> ) => hb_USubStr( <cS>, <nS> ) #xtranslate Subs( <cS>, <nS>, <nL> ) => hb_USubStr( <cS>, <nS>, <nL> ) */ REQUEST DBFCDX, DBFFPT REQUEST HB_CODEPAGE_UTF8 Function Main() LOCAL cFont := "Arial" LOCAL nSize := 12 LOCAL cForm := "wMain" LOCAL cBrw1 := "Brw_1" LOCAL cIni := hb_FNameExtSet( hb_ProgName(), ".ini" ) LOCAL oIni := TIniData():New(cIni, .T.):Read() LOCAL oCom := oIni:COM LOCAL oBrw1, nY, nX, nH, nW, oTsb1, cLog, nTmp, aTmp SET CODEPAGE TO RUSSIAN SET LANGUAGE TO RUSSIAN RddSetDefault("DBFCDX") SET OOP ON SET EPOCH TO 2000 SET DATE TO GERMAN SET CENTURY ON SET AUTOPEN OFF SET DELETED OFF SET NAVIGATION EXTENDED SET DEFAULT ICON TO "1MAIN_ICO" Default oCom:FontName := cFont, ; oCom:FontSize := nSize, ; oCom:LogName := ".\Msg.log" cFont := oCom:FontName nSize := oCom:FontSize cLog := oCom:LogName SET LOGFILE TO ( cLog ) ; fErase( cLog ) SET FONT TO cFont, nSize // фонт по default для oTsb1, oBrw1 DEFINE FONT Normal FONTNAME cFont SIZE nSize DEFINE FONT Bold FONTNAME cFont SIZE nSize BOLD DEFINE FONT Italic FONTNAME cFont SIZE nSize - 2 ITALIC USE ( "CUSTOMER" ) ALIAS CUST1 NEW SHARED DEFINE WINDOW &cForm TITLE "Demo ini => TBrowse" MAIN NOSIZE TOPMOST ; ON INIT ( This.Topmost := .F. ) ; ON RELEASE ( dbCloseAll() ) This.Maximize This.Cargo := oHmgData() /* nY := nX := 0 nW := This.ClientWidth nH := This.ClientHeight */ oTsb1 := oIni:&(cBrw1) // секция [Brw_1] //? oTsb1:GetAll() ; ?v oTsb1:GetAll() ; ? //oTsb1:aText := oIni:&(cBrw1+"_Text"):GetAll() oTsb1:oText := oIni:&(cBrw1+"_Text") oTsb1:aUserKeys := {} FOR EACH aTmp IN oIni:&(cBrw1+"_Keys"):GetAll() nTmp := Val(aTmp[1]) AADD( oTsb1:aUserKeys, {nTmp, aTmp[2]} ) NEXT oTsb1:bBody := {|ob,op| Local oCol, aTxt, nTxt, lEditNo, nTmp, aTmp lEditNo := HB_ISARRAY(op:aEditNo) .and. LenU(op:aEditNo) > 0 FOR EACH oCol IN ob:aColumns oCol:hFont := GetFontHandle( op:aFont[1] ) IF oCol:cFieldTyp == "C" oCol:cPicture := Nil oCol:nWidth := oCol:ToWidth( iif( oCol:nFieldLen > 50, 50, oCol:nFieldLen ), 0.82 ) ELSEIF oCol:cFieldTyp == "M" oCol:cPicture := Nil oCol:nWidth := oCol:ToWidth(40) ELSEIF oCol:cFieldTyp == "D" oCol:cPicture := Nil oCol:nWidth := oCol:ToWidth(10) ELSEIF oCol:cFieldTyp == "T" oCol:cPicture := Nil oCol:nWidth := oCol:ToWidth(24) ENDIF IF lEditNo .and. AScan(op:aEditNo, oCol:cName) > 0 oCol:lEdit := .F. ENDIF NEXT nTmp := 1 nTxt := 0 FOR EACH aTxt IN op:oText:GetAll() // op:aText IF ob:nColumn(aTxt[1], .T.) == 0 ; LOOP ENDIF oCol := ob:GetColumn(aTxt[1]) IF "\" $ aTxt[2] nTxt++ aTmp := hb_ATokens(aTxt[2], "\") nTmp := Max( nTmp, LenU(aTmp)) oCol:cHeading := StrTran(aTxt[2], "\", CRLF) ELSE oCol:cHeading := aTxt[2] ENDIF NEXT IF nTxt > 0 ob:nHeightHead := GetFontHeight( op:aFont[2] ) * nTmp ENDIF /* IF HB_ISARRAY(op:aMsgPost) .and. LenU(op:aMsgPost) > 0 FOR EACH nTxt IN op:aMsgPost ob:UserKeys(nTxt, {|ob,nk| _wPost(nk, ob:cParentWnd, ob) }) NEXT ENDIF */ Return Nil } oBrw1 := _TBrowse( oTsb1, "CUST1", cBrw1, nY, nX, nW, nH ) oBrw1:SetFocus() ; DO EVENTS This.Cargo:cBrw1 := cBrw1 This.Cargo:oBrw1 := oBrw1 ON KEY ESCAPE ACTION iif( oBrw1:IsEdit, oBrw1:SetFocus(), ThisWindow.Release ) ON KEY F1 ACTION NIL /* IF HB_ISARRAY(oTsb1:aMsgPost) .and. LenU(oTsb1:aMsgPost) > 0 FOR EACH nTmp IN oTsb1:aMsgPost (This.Object):Event( nTmp, {|ow,ky,ob| MsgBox("Press: "+cValToChar(ky)+"-"+ob:cControlName, ow:Name), ob:SetFocus() } ) NEXT ENDIF */ FOR EACH aTmp IN oTsb1:aUserKeys (This.Object):Event( aTmp[1], {|ow,ky,ob| MsgBox("Press: "+cValToChar(ky)+"-"+ob:cControlName, ow:Name), ob:SetFocus() } ) NEXT END WINDOW //CENTER WINDOW wMain ACTIVATE WINDOW wMain RETURN NIL [/pre2]
gfilatov2002: SergKis пишет: модифицировал пример, добавив в ini события для клавиш Благодарю за помощь SergKis пишет: вариант этого же решения с событиями, кому интересно Надеюсь, что эти примеры будут кому-нибудь полезны
Andrey: Haz пишет: Почти у всех есть свои библиотеки, это не повод под них батник править. Может быть и не повод, но большее кол-во инструментов для МиниГуи будет полезней, особенно для новичков. Не смотря на ограниченность TsbViewer, я делал его под свою часто используемую работу с базой. Такого не было в МиниГуи, вот и сделал в качестве инструмента для баз. Больше никто не предлагал подобный функционал для баз, только внешние утилиты. Если кто-то делал инструмент работы с базой - было бы полезно выложить его в Минигуи, для всех. А то пока наработаешь свои библиотеки и примеры для МиниГуи - года 3-4 пройдёт... gfilatov2002 пишет: Надеюсь, что эти примеры будут кому-нибудь полезны Ещё как нужны. Работа с событиями очень нужная вещь в МиниГуи, особенно для больших проектов. Прога перестаёт падать, если использовать события, а не функции.
gfilatov2002: Andrey пишет: при создании библиотеки SAMPLES\Advanced\Tsb_Viewer\Lib библиотеку TsbViewer.lib копировать автоматом в папку \MiniGUI\Lib Именно так и сделал
SergKis: gfilatov2002 пишет Надеюсь, что эти примеры будут кому-нибудь полезны Если подключить работу с hrb, как в LetoDbf или hbedit, то обработчики событий можно делать в hrb. Будет возможность, если кому то надо, сделать утилиту похожую на DBCH как у А. Кресина. PS. Не увидел bat для сборки letoudf.hrb из LetoDbf\SERVER\SOURCE\letoudf.prg, что бы подменить на свой вариант letoudf.prg PS2. Есть более поздняя правка LetoDbf (2021-09-21 19:49 UTC+0100 Aleksander Czajczynski (hb fki.pl)), чем по ссылке родной, по адресу https://github.com/alcz/LetoDBf Может этот вариант собрать ? Предыдущий вариант так же был от Aleksander Czajczynski
gfilatov2002: SergKis пишет: Есть более поздняя правка LetoDbf (2021-09-21 19:49 UTC+0100 Aleksander Czajczynski Именно этот вариант используется при сборке LetoDbf для библиотеки Минигуи. SergKis пишет: Не увидел bat для сборки letoudf.hrb Если правильно помню, этот файл был собран вместе с бинарником сервера (но могу ошибаться).
SergKis: gfilatov2002 пишет Именно этот вариант используется при сборке LetoDbf для библиотеки Минигуи. OK! Если правильно помню, этот файл был собран вместе с бинарником сервера (но могу ошибаться). В целом да (buildall.bat), но строка нужная это hbmk2 letoudf и нужный letoudf.hbp есть [pre2] # output path does not work with .hrb ? -o../bin -W3 -es0 -n -gh letoudf.prg [/pre2] Наверно, можно применить ..\..\..\BATCH\hbmk2.bat letoudf.hbp
SergKis: gfilatov2002 В завершении темы ini + _TBrowse(), небольшой пример на 2-а тсб https://TransFiles.ru/xzgzj PS. Пропустил правку, поправьте ON RELEASE ( (This.Cargo:oBrw:cAlias)->( dbCloseAllArea() ) )
gfilatov2002: SergKis пишет: небольшой пример на 2-а тсб Большое спасибо SergKis пишет: Пропустил правку, поправьте Поправил, конечно
SergKis: gfilatov2002 Извините, не удержался и кнопки в пример добавил (маюсь от безделья сегодня) https://TransFiles.ru/s2xux
gfilatov2002: Выложил 2-е обновление сборки 22.01 по адресу: http://hmgextended.com/files/CONTRIB/hmg-22.01-setup.exe Обновил также уникод-архив...
SergKis: gfilatov2002 Можно правку в i_status.ch сделать [pre2] #xcommand STATUSITEM [ <cMsg> ] ; [ WIDTH <nSize> ] ; [ ACTION <uAction> ] ; [ ICON <cBitmap> ] ; [ STYLE ] [ <style:FLAT,RAISED> ] ; [ TOOLTIP <cToolTip> ] ; [ BACKCOLOR <backcolor> ] ; [ FONTCOLOR <fontcolor> [ <c: CENTERALIGN> ] [ <r: RIGHTALIGN> ] ] ; [ <default: DEFAULT> ] ; => ; _DefineItemMessage( "STATUSITEM", , 0, 0, <cMsg>, iif( Valtype( <uAction> ) == "B" , <uAction> , <{uAction}> ), <nSize>, 0, ... ) тогда такой код можно использовать FOR i := 1 TO k w := aStatus[ i ] IF HB_ISNUMERIC( w ) IF w < 1; w := Int( This.ClientWidth * w ) ENDIF j := "_wPost("+hb_ntos(nPost)+",,"+hb_ntos(i)+")" IF empty( w ) ; STATUSITEM '' ACTION hb_MacroBlock( j ) ELSE ; STATUSITEM '' WIDTH w ACTION hb_MacroBlock( j ) ENDIF ELSEIF HB_ISCHAR( w ) ENDIF NEXT [/pre2] В _SetFormAction() и _SetControlAction() нет варианта для StatusItem ставить ACTION
gfilatov2002: SergKis пишет: правку в i_status.ch сделать Это можно сделать, используя псевдо-функцию _SetStatusItemAction( <item>, <action>, <ParentFormHandle> ) которая вызывает реальную функцию _SetStatusItemProperty( <item>, <value>, <ParentHandle>, STATUS_ITEM_ACTION )
SergKis: gfilatov2002 пишет используя псевдо-функцию _SetStatusItemAction( <item>, <action>, <ParentFormHandle> ) Спасибо Работает, т.е. LOCAL i, j, k, w, h := GetFormHandle( This.Name ) ... _SetStatusItemAction( i, hb_MacroBlock( j ), h )
SergKis: gfilatov2002 Небольшая добавка [pre2] METHOD MoveColumn( nColPos, nNewPos ) CLASS TSBrowse ... IF HB_ISCHAR( nColPos ) ; nColPos := ::nColumn( nColPos, .T. ) ENDIF If ! Empty( nColPos ) .AND. ! Empty( nNewPos ) .AND. ; ... [/pre2]
gfilatov2002: SergKis пишет: Небольшая добавка OK
gfilatov2002: Выложил 3-й апдейт сборки 22.01 с учетом всех последних изменений Обновил также Unicode архив.
krutoff: Скачал последний UPDATE. При линковке выдает ошибку. Может кто даст ссылку на пред.версию, а то у Григория на сайте только текущая. [1]:iLink32.Exe -Gn -aa -Tpe -s @zpW.bcl Turbo Incremental Link 5.69 Copyright (c) 1997-2005 Borland Error: Unresolved external '_HB_FUN_HPDF_NEW' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_SETCOMPRESSIONMODE' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_USEUTFENCODINGS' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_SETCURRENTENCODER' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_ADDPAGE' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_PAGE_SETSIZE' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_PAGE_GETHEIGHT' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_PAGE_GETWIDTH' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_SAVETOFILE' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_RESETERROR' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_FREE' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_LOADPNGIMAGEFROMFILE' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_LOADJPEGIMAGEFROMFILE' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_PAGE_DRAWIMAGE' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_SETINFOATTR' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_SETINFODATEATTR' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_GETERROR' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf
SergKis: krutoff Тут https://TransFiles.ru/mn61y
krutoff: SergKis пишет: Тут https://TransFiles.ru/mn61y Спасибо, Сергей! Пред.версия идет без ошибок. Григорий из Одессы, ему уже, конечно, не до того. Нас в Киеве тоже бомбят, особенно по ночам.
gfilatov2002: Выложил 5-й апдейт сборки 22.01 с учетом всех последних изменений Желаю всем мира и добра
gfilatov2002: Выложил срочное 7-е обновление для исправления ошибки, внесенной в сборке 21.11 Также обновил библиотеку PageScript до новой 4-й версии с полноценной поддержкой PDF (создание, просмотр, печать и экспорт текста).
Haz: Абсолютно тоже на последнем 7-м обновлении, вернулся на 22.01 (Update 2) krutoff пишет: Скачал последний UPDATE. При линковке выдает ошибку. Может кто даст ссылку на пред.версию, а то у Григория на сайте только текущая. [1]:iLink32.Exe -Gn -aa -Tpe -s @zpW.bcl Turbo Incremental Link 5.69 Copyright (c) 1997-2005 Borland Error: Unresolved external '_HB_FUN_HPDF_NEW' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_SETCOMPRESSIONMODE' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_USEUTFENCODINGS' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_SETCURRENTENCODER' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_ADDPAGE' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_PAGE_SETSIZE' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_PAGE_GETHEIGHT' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_PAGE_GETWIDTH' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_SAVETOFILE' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_RESETERROR' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_FREE' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_LOADPNGIMAGEFROMFILE' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_LOADJPEGIMAGEFROMFILE' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_PAGE_DRAWIMAGE' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_SETINFOATTR' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_SETINFODATEATTR' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf Error: Unresolved external '_HB_FUN_HPDF_GETERROR' referenced from D:\MINIGUI\LIB\MINIGUI.LIB|h_savepdf
gfilatov2002: Haz пишет: тоже на последнем 7-м обновлении Игорь, Это не удивительно, поскольку в библиотеку была добавлена возможность сохранения печатных отчетов в формате PDF. Решение для этой проблемы - тривиальное: надо добавить библиотеки поддержки HaruPDF для линковки в ваш сценарий сборки.
Haz: gfilatov2002 пишет: Решение для этой проблемы - тривиальное: надо добавить библиотеки поддержки HaruPDF для линковки в ваш сценарий сборки. знать бы сразу какие именно. На работе подбором некогда заниматься, а дома методом тыка выяснил , что со следующим набором собирается : [pre2] <Library Filename="[harbour]png.lib"/> <Library Filename="[harbour]PdfPrinter.lib"/> <Library Filename="[harbour]libhpdf.lib"/> <Library Filename="[harbour]hbhpdf.lib"/> <Library Filename="[harbour]hmg_hpdf.lib"/> [/pre2] пошел во всех проектах скрипты сборки править
SergKis: gfilatov2002 пишет Выложил срочное 7-е обновление Unicode 22.01 осталась Update 3 До update 7 надо подождать или так останется ?
gfilatov2002: SergKis пишет: До update 7 надо подождать Сегодня сделаю и отпишусь
gfilatov2002: Обновил Unicode-архив до 7-го обновления библиотеки. Также для всех, кто поддержал этот проект материально, доступны следующие Unicode-версии: ------------------------------------------------------------- Minigui Ex Package (build date: 17.03.2022) Download links: http://hmgextended.com/files/PRIVATE ------------------------------------------------------------- Components versions: -------------------- Harbour MiniGUI Extended Edition 22.01 (Update 7) Harbour 3.2.0dev (r2104281802) Harbour Make (hbmk2) 3.2.0dev (r2021-04-28 18:02) gcc (GCC with MCF thread model, built by LH_Mouse.) 11.2.1 20220307 и ------------------------------------------------------------- Minigui Ex 64 Package (build date: 17.03.2022) Download links: http://hmgextended.com/files/PRIVATE ------------------------------------------------------------- Components versions: -------------------- Harbour MiniGUI Extended Edition 22.01 (Update 7) Harbour 3.4.0dev (a6e3e4b) (2021-11-16 00:36) Harbour Make (hbmk2) 3.4.0dev (a6e3e4b) (2021-11-16 00:36) gcc (MinGW-W64 x86_64-posix-seh, built by Brecht Sanders) 11.2.1 20211106
gfilatov2002: Выложил последнюю сборку 22.03 Кратко, что нового: * The Monthcal control may manage a 'FirstDayOfWeek' property. It was a postponed modification. * The GRID control supports the optional ON INPLACEEDITEVENT event. The following properties are available for OnInplaceEditEvent procedure: - This.IsInplaceEditEventInit: return .T. or .F. - This.IsInplaceEditEventRun: return .T. or .F. - This.IsInplaceEditEventFinish: return .T. or .F. - This.InplaceEditGridName: for example, 'Grid_1' - This.InplaceEditParentName: for example, 'Form_1' - This.InplaceEditControlHandle: Handle of InplaceEdit ColumnControl, eg. handle of TEXTBOX, DATEPICKER, COMBOBOX, SPINNER, CHECKBOX. - This.InplaceEditControlIndex: return internal controls index. * Updated Harbour Compiler 3.2.0dev: - hbrdd and hbrtl were compiled with default switch -gc3 instead -gc0 for acceleration of the Harbour core. * Updated the TSBrowse and SQLite3 libraries. * Added the new interesting samples and updated some examples. Благодарю за материальную помощь Сашу Савова Желаю всем только мира
gfilatov2002: Выложил 1-й апдейт сборки 22.03 с учетом всех последних изменений Поздравляю всех верующих с Благовещением Пресвятой Богородицы Пусть с приходом благой вести прибудут счастье в дом, успех и здоровье. Пусть весенняя бодрость духа нескончаемо радует и трепетно волнует сердце. Желаю, чтобы понимание и любовь царили во взаимоотношениях с близкими людьми. Пусть самые лучшие помыслы наполняют дом, а беды, горести и разочарования не тревожат и не беспокоят. Пусть каждая минута жизни будет наполнена уверенностью, красотой и любовью.
gfilatov2002: Выложил 2-й апдейт сборки 22.03 с учетом всех последних изменений click here Желаю всем только мира...
Alex_Cher: gfilatov2002 пишет: Выложил 2-й апдейт сборки 22.03 с учетом всех последних изменений Мужики .... с 22 сборки в TBROWSE с некоторыми цифрами во такая хрень началась (фото ниже) ... это только у меня и как это исправить ?
SergKis: Alex_Cher пишет с 22 сборки в TBROWSE с некоторыми цифрами во такая хрень началась Преобразования все в строку происходят в ф-ии cValToChar(...), для цифр это hb_ntos(...). Это цифры, наверно, не из dbf. Поставьте в колонку формат вывода oCol:cPicture := "99999999.99"
Alex_Cher: SergKis пишет: Alex_Cher пишет цитата: с 22 сборки в TBROWSE с некоторыми цифрами во такая хрень началась Преобразования все в строку происходят в ф-ии cValToChar(...), для цифр это hb_ntos(...). Это цифры, наверно, не из dbf. Поставьте в колонку формат вывода oCol:cPicture := "99999999.99" Уважаемый SergKis это цифры чисто из DBF ( пример C:\MiniGUI\SAMPLES\Advanced\Tsb_2tables те же проблемы), вопрос - почему это началось с сборки 22 ( в 21 все нормально) ? да поставить формат можно, но зачем этот линий гемор ...? и почему все молчат, мужики проверьте свои программы на TBROWSE .... !
gfilatov2002: Alex_Cher пишет: почему это началось с сборки 22 Это был экспериментальный код в функции cValToChar(). Уже поправил для следующего обновления библиотеки, которое планируется выпустить на этой неделе Alex_Cher пишет: почему все молчат Видимо, не все используют TBROWSE либо, как вариант, еще не обновились до версии 22.03
SergKis: Alex_Cher пишет да поставить формат можно, но зачем этот линий гемор ...? Поставить Picture колонке, на мой взгляд, это хороший стиль написания кода, т.к. уменьшается вероятность таких ситуевин, как произошло у вас, с течением времени, в котором живет программа. Не зависимо (почти) от смены версий, т.к. проверить все режимы работы программы нет возможности (надо иметь базу с вариантами проверок всех алгоритмов, что мало реально). Версию unicode 22.03 я применил уже (у меня все на tsbrowse) и не заметил изменений, т.к. стоят Picture для цифровых полей (у них ставлю часто отрезание правых 0 в дробной части) и timestamp gfilatov2002 пишет Видимо, не все используют TBROWSE либо, как вариант, еще не обновились до версии 22.03 Обновился на unicode версии без update, как в однобайтовой hmg. Т.к. модуль не большой - 5 штук тсб, у меня полет нормальный
Haz: gfilatov2002 пишет: Видимо, не все используют TBROWSE либо, как вариант, еще не обновились Многие уже по всем проектам :cPicture прописали т.к. слет шаблона по умолчанию произошел года 3 назад. Поэтому не заметили
Andrey: Haz пишет: Многие уже по всем проектам :cPicture прописали Аналогично, тоже везде использую :cPicture !
gfilatov2002: В "чистый" четверг выложил 3-й апдейт сборки 22.03 с учетом всех последних изменений и исправлений click here
gfilatov2002: Подготовил вторую бету для новой сборки 22.05 Кратко, что нового: [pre2] * Fixed: The ON CANCEL event in the ComboBox control was executed only if the last pressed key was the <Escape> (introduced in the build 16.08). * Fixed: Problem with SPINNER's focus at a window activation when this control was defined in the first position. * You can get HORIZONTAL property of the RadioGroup control at runtime. * You can get HORIZONTAL and WRAP properties of the Spinner control at runtime. * The RadioGroup control now supports 'On GotFocus' and 'On LostFocus' clauses similar to other controls. Since RadioGroup is actually a group of individual RadioButtons, each individual RadioButton has its own events. Added the new command SET PROCEED EACH RADIOBUTTON EVENT <ON | OFF>. * Updated the HMG IDE of Roberto Lopez, TSBrowse and SQLite3 libraries. * Added the new samples and updated some old examples. [/pre2] По видимому, до финального релиза этот список изменений кардинально не изменится.
gfilatov2002: Подготовил третью бету для новой сборки 22.05 Главное изменение: * Enhanced: The IMAGE and LABEL controls support the optional ON RCLICK clause. This clause specifies the action at the mouse right button click. Notice that you should declare the SET CONTEXT MENU OFF command also. Contributed by Grigory Filatov <gfilatov@gmail.com> (see demo in folder \samples\Applications\MineSweeper) Желаю всем МИРА и добра
Alex_Cher: gfilatov2002 пишет: Подготовил третью бету для новой сборки 22.05 извиняюсь, может 22.03 ?
gfilatov2002: Alex_Cher пишет: может 22.03 ? Нет, речь шла о новой майской сборке
Alex_Cher: gfilatov2002 пишет: Нет, речь шла о новой майской сборке снова извиняюсь .., а откуда качать, там на http://hmgextended.com/files/CONTRIB/hmg-22.05-setup.exe нет ничего ...?
gfilatov2002: Alex_Cher пишет: а откуда качать Финальная сборка майского релиза еще не готова. Речь шла о предварительных версиях, которые доступны только для разработчиков из команды Minigui
SergKis: gfilatov2002 правка, проскакивает cHeading == NIL (h_tbrowse.prg) [pre2] STATIC FUNCTION SetHeights( oBrw ) ... // Now for cells nHHeight := oBrw:nHeightCell FOR nEle := 1 TO Len( oBrw:aColumns ) ... IF ValType( cHeading ) == "C" .AND. At( Chr( 13 ), cHeading ) > 0 .OR. ; ValType( cHeading ) == "M" .OR. oColumn:cDataType != NIL .AND. oColumn:cDataType == "M" DEFAULT cHeading := "" IF Empty( oBrw:nMemoHV ) IF At( Chr( 13 ), cHeading ) > 0 oBrw:nMemoHV := Len( hb_ATokens( cHeading, Chr( 13 ) ) ) ENDIF ENDIF DEFAULT oBrw:nMemoHV := 2 ... [/pre2]
gfilatov2002: SergKis пишет: правка OK
SergKis: gfilatov2002 Я правильно понимаю, что COMBOBOXEX в unicode версии с utf8 строками не работает ? Пример требует перекодировки из utf8 => RU1251 (версия hmg unicode prg с bom utf8)[pre2] LOCAL aLangsR := { "Русский", "Английский", "Украинский", "Белорусский" , "Казахский" } ... FOR nI := 1 TO LenU( aLangsR ) AAdd( aLangs, hb_utf8ToStr(aLangsR[ nI ] + " (" + aLangsE[ nI ] + ")", "RU1251") ) NEXT @ 10, nFWidth - 300 COMBOBOXEX ComboEx_1 ; WIDTH 340 HEIGHT 200 ; ITEMS aLangs ; VALUE M->nPubLang ; IMAGE aFlags ; TOOLTIP 'Выбор языка / Select lang' INVISIBLE ; ON LISTCLOSE Forma_1.ComboEx_1.Hide ; ON CHANGE { || M->nPubLang := Forma_1.ComboEx_1.Value, ; Forma_1.ComboEx_1.Hide, Forma_1.Image_1.Hide ,; Forma_1.Image_1.Picture := aFlags[M->nPubLang],; Forma_1.Image_1.Col := GetClientWidth( GetFormHandle("Forma_1") ) - 30, ; MyTitleFormLang(), MyTitleSHLang() ,; Forma_1.Image_1.Show, Forma_1.Image_1.Setfocus } .. [/pre2] С выделенным цветом тексты в списке COMBOBOX ok, без ф-ии - кракозяблики
gfilatov2002: SergKis пишет: COMBOBOXEX в unicode версии с utf8 строками не работает Да, все верно. На входе COMBOBOXEX принимает строки в формате ANSI. Это сделано с учетом того, что эти строки могут быть получены из базы данных, которая м.б. для совместимости в формате ANSI. Перекодировка этих строк в уникод происходит уже внутри COMBOBOXEX
SergKis: gfilatov2002 пишет Это сделано с учетом того, что эти строки могут быть получены из базы данных, которая м.б. для совместимости в формате ANSI. Не понял ? Для базы мы указываем CODEPAGE конкретную и на уровне hb получаем перекодировку, т.е. SET CODEPAGE TO UNICODE ... USE ( cPath + cFileDbf ) Alias TABLE1 CODEPAGE "RU1251" VIA "DBFCDX" NEW //SHARED и работаем без всяких дополнений с utf8 данными из полей строковых aLangsR := { "Русский", "Английский", "Украинский", "Белорусский" , "Казахский" } cStr := SPACE(20)+"Папки сравнения и проект для сравнения:" + CRLF в таких вариантах тоже имеем utf8 Не логично поддерживать ANSI, по мне, для COMBOBOX... и др. контролов. Исп. язык не зависит от программы, зависит от пользователя в unicode. Получается что для COMBOBOXEX надо иметь еще таблицу имеющихся codepage к каждому элементу массива aLangsR := { "Русский", "Английский", "Украинский", "Белорусский" , "Казахский" } в чем смысл, не пойму . Тем более, что Перекодировка этих строк в уникод происходит уже внутри COMBOBOXEX
gfilatov2002: Выложил последнюю сборку 22.05 click here
SergKis: gfilatov2002 В версии unicode ButtonEx Tooltip не отображает строку в utf8, надписи на кнопке Ok https://postimg.cc/PCtnbHPQ
gfilatov2002: SergKis пишет: В версии unicode ButtonEx Tooltip не отображает строку в utf8 Проверил на системе без установки кодовой страницы - Tooltip отображает строку в utf8 правильно. Добавил в начало программы установку [pre2]set codepage to russian [/pre2]и получил кракозябры в тултипе, как и следовало ожидать. Вывод: проверьте наличие этой установки у себя в коде Также возможно следует добавить перед вызовом формы команду [pre2]set codepage to unicode[/pre2]
SergKis: gfilatov2002 пишет и получил кракозябры в тултипе, как и следовало ожидать В начале программе стоит (больше нет установок codepage) SET CODEPAGE TO UNICODE RDDSETDEFAULT('DBFCDX') SET OOP ON В ф-ии кнопка формируется [pre2] ... ? procname(), cObject, cTooltip, hb_utf8ToStr(cTooltip, 'RU1251') DEFINE BUTTONEX &cObject PARENT &cForm ROW nRow COL nCol WIDTH nWidth HEIGHT nHeight ICON cResIco CAPTION cCaption ACTION Eval( bAction ) TOOLTIP cTooltip VERTICAL lTextVertical LEFTTEXT lTextLeft FLAT .F. FONTNAME cFont FONTSIZE nFontSize FONTBOLD lFontBold FONTCOLOR aFontColor BACKCOLOR aBACKCOLOR UPPERTEXT .F. NOHOTLIGHT .F. NOXPSTYLE .T. HANDCURSOR .T. ONMOUSEHOVER ( SetProperty(ThisWindow.Name, this.name, "ICON", cResIco2), SetProperty(ThisWindow.Name, cObject, "fontcolor", aFontColorInvert ) ) ONMOUSELEAVE ( SetProperty(ThisWindow.Name, this.name, "ICON", cResIco) , SetProperty(ThisWindow.Name, cObject, "fontcolor", aFontColor) ) NOTABSTOP .F. INVISIBLE lHide END BUTTONEX [/pre2] выделенная цветом строка дает правильное значение cTooltip - кодировка utf8 hb_utf8ToStr(cTooltip, 'RU1251') - кодировка 1251 cTooltip задается в коде программы на кнопки (prg все в utf8) aObj3But[2,13] := 'Копировать файлы из папки 1 в папку 2' // подсказка aObj3But[3,13] := 'Копировать файлы из папки 2 в папку 1' // подсказка PS cTooltip := hb_utf8ToStr(cTooltip, 'RU1251') и DEFINE BUTTONEX &cObject ... выводит Tooltip правильно (версия hmg 22.03.0 unicode)
gfilatov2002: Выложил 2-й апдейт сборки 22.05 с учетом всех последних исправлений click here Желаю всем удачи...
gfilatov2002: Выложил последнюю сборку 22.06 click here Желаю всем МИРА и добра
gfilatov2002: Выложил 1-е обновление сборки 22.06 с учетом последних исправлений и дополнений См. ссылку для выкачки в посте выше
gfilatov2002: Выложил 2-е обновление сборки 22.06 с учетом последних исправлений и дополнений click here
gfilatov2002: Завершена подготовка новой сборки 22.07, которая будет опубликована завтра. Что нового: - глобальный пересмотр Си-кода с использованием макросов вида hmg_par_* / hmg_ret_* и макросов унификации Си-типов. Желаю всем доброго здоровья и успеха в делах
gfilatov2002: Как и обещал, выложил финальную сборку 22.07 click here
Andrey: Поставил новую версию. Заметил фигню у себя в прогах и в примере \MiniGUI\SAMPLES\BASIC\ButtonEx_DynamicMenu\demo.exe Мышкой когда проводишь по кнопкам БЫСТРО - все кнопки затеняются и только потом затенение проходит. Как то очень некрасиво происходит. Убрать этот эффект можно ?
SergKis: gfilatov2002 Небольшие правки [pre2] TControl.prg ... METHOD lValid() INLINE If( ::bValid != nil, !Empty(Eval( ::bValid, Self )), .t. ) METHOD lWhen() INLINE If( ::bWhen != nil, !Empty(Eval( ::bWhen, Self )), .t. ) ... METHOD GotFocus( hCtlLost ) HB_SYMBOL_UNUSED( hCtlLost ) ::lFocused := .T. ::SetMsg( ::cMsg ) if ::bGotFocus != nil return Eval( ::bGotFocus, Self ) endif return nil METHOD KeyChar( nKey, nFlags ) CLASS TControl ... if ::bKeyChar != nil return Eval( ::bKeyChar, nKey, nFlags, Self ) endif return 0 METHOD KeyDown( nKey, nFlags ) CLASS TControl ... if ::bKeyDown != nil return Eval( ::bKeyDown, nKey, nFlags, Self ) endif return 0 METHOD LButtonDown( nRow, nCol, nKeyFlags ) CLASS TControl ::lMouseDown := .T. ::nLastRow := nRow ::nLastCol := nCol if ::bLClicked != nil return Eval( ::bLClicked, nRow, nCol, nKeyFlags, Self ) endif return nil METHOD LButtonUp( nRow, nCol, nKeyFlags ) CLASS TControl if ::bLButtonUp != nil return Eval( ::bLButtonUp, nRow, nCol, nKeyFlags, Self ) endif return nil METHOD LostFocus( hWndGetFocus ) CLASS TControl ::lFocused := .F. ::SetMsg() if ! Empty( ::bLostFocus ) return Eval( ::bLostFocus, hWndGetFocus, Self ) endif RETURN nil METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TControl ... if ::bMMoved != nil return Eval( ::bMMoved, nRow, nCol, nKeyFlags, Self ) endif return 0 METHOD RButtonUp( nRow, nCol, nKeyFlags ) CLASS TControl if ::bRButtonUp != nil Eval( ::bRButtonUp, nRow, nCol, nKeyFlags, Self ) endif return nil METHOD ReSize( nSizeType, nWidth, nHeight ) CLASS TControl ::CoorsUpdate() if ::bResized != nil Eval( ::bResized, nSizeType, nWidth, nHeight, Self ) endif return nil Для использования :bLButtonUp := {|row,col,flag,ob| ? ":bLButtonUp",row,col,flag,ob IF hb_IsObject(ob) ?? ob:ClassName, ob:nCell ENDIF Return Nil } :bWhen := {|ob| ? ":bWhen",ob IF hb_IsObject(ob) ?? ob:ClassName, ob:nCell ENDIF Return .T. } :bGotFocus := {|ob| ? ":bGotFocus",ob IF hb_IsObject(ob) ?? ob:ClassName, ob:nCell ENDIF Return .T. } ... Результат :bGotFocus 'O' TSBROWSE 1 :bWhen 'O' TSBROWSE 1 :bLClicked 8 92 1 'O' TSBROWSE 2 :bLButtonUp 8 92 0 'O' TSBROWSE 2 :bLClicked 7 152 1 'O' TSBROWSE 3 :bLButtonUp 7 152 0 'O' TSBROWSE 3 :bLClicked 9 246 1 'O' TSBROWSE 4 :bLButtonUp 9 246 0 'O' TSBROWSE 4 :bLClicked 12 22 1 'O' TSBROWSE 1 :bLButtonUp 12 22 0 'O' TSBROWSE 1 :bGotFocus 'O' TSBROWSE 1 :bLClicked 7 104 1 'O' TSBROWSE 2 :bLButtonUp 7 104 0 'O' TSBROWSE 2 :bLClicked 11 162 1 'O' TSBROWSE 3 :bLButtonUp 11 162 0 'O' TSBROWSE 3 :bLClicked 6 237 1 'O' TSBROWSE 4 :bLButtonUp 6 237 0 'O' TSBROWSE 4 :bLClicked 10 28 1 'O' TSBROWSE 1 :bLButtonUp 10 28 0 'O' TSBROWSE 1 [/pre2]
gfilatov2002: SergKis пишет: Небольшие правки Принято с благодарностью
gfilatov2002: Выложил 2-е обновление сборки 22.07 с учетом последних исправлений и дополнений click here
gfilatov2002: Выложил 3-е обновление сборки 22.07 с учетом последних исправлений и дополнений click here
gfilatov2002: Завершена подготовка новой сборки 22.09, которая планируется к выпуску на следующей неделе Если у вас есть какие-либо предложения или дополнения кода, то еще не поздно сообщить мне об этом с целью включения в эту сентябрьскую сборку. Благодарю за внимание к этому проекту
gfilatov2002: Как и обещал, выложил финальную сборку 22.09 Нажмите здесь, чтобы скачать
SergKis: gfilatov2002 unicode версия живет или нет ?
gfilatov2002: SergKis пишет: unicode версия живет Только что обновил архив для этой сборки по старому адресу
SergKis: gfilatov2002 пишет обновил архив для этой сборки по старому адресу Спасибо
SergKis: gfilatov2002 Сборка версии unicode файлом MakeAllMiniguiLibs.bat выдает протокол с бяками Протокол [pre2] MiniGui.lib Borland C++ 5.82 for Win32 Copyright (c) 1993, 2005 Borland h_scrsaver.c: h_edit.c: h_edit_ex.c: h_error.c: h_ipaddress.c: c_ipaddress.c: h_monthcal.c: c_monthcal.c: h_help.c: c_help.c: h_crypt.c: c_crypt.c: h_status.c: c_status.c: h_tree.c: c_tree.c: c_toolbar.c: h_toolbar.c: errorsys.c: h_init.c: h_media.c: c_media.c: h_winapimisc.c: h_slider.c: c_button.c: c_checkbox.c: c_combo.c: c_controlmisc.c: c_datepicker.c: c_resource.c: c_cursor.c: c_ini.c: h_ini.c: h_report.c: h_savepdf.c: h_registry.c: Warning W8075 h_registry.prg 340: Suspicious pointer conversion in function HB_FUN_ISWOW64 h_font.c: c_font.c: h_hyperlink.c: h_richeditbox.c: c_richeditbox.c: h_richeditex.c: c_richeditex.c: c_bitmap.c: c_dialog.c: c_imagelist.c: h_imagelist.c: c_windowsAPI.c: c_windowsCLS.c: c_nonclient.c: Borland C++ 5.82 for Win32 Copyright (c) 1993, 2005 Borland c_winxp.c: c_editbox.c: c_dialogs.c: c_grid.c: c_windows.c: c_windowsMDI.c: c_image.c: c_label.c: c_listbox.c: c_menu.c: c_msgbox.c: c_frame.c: c_progressbar.c: c_radio.c: c_registry.c: Warning W8075 c_registry.c 66: Suspicious pointer conversion in function HB_FUN_REGOPENKEYEXA Warning W8075 c_registry.c 70: Suspicious pointer conversion in function HB_FUN_REGOPENKEYEXA Warning W8075 c_registry.c 87: Suspicious pointer conversion in function HB_FUN_REGQUERYVALUEEXA Warning W8075 c_registry.c 94: Suspicious pointer conversion in function HB_FUN_REGQUERYVALUEEXA Warning W8075 c_registry.c 128: Suspicious pointer conversion in function HB_FUN_REGENUMKEYEXA Warning W8075 c_registry.c 130: Suspicious pointer conversion in function HB_FUN_REGENUMKEYEXA Warning W8075 c_registry.c 162: Suspicious pointer conversion in function HB_FUN_REGCREATEKEY Warning W8075 c_registry.c 179: Suspicious pointer conversion in function HB_FUN_REGENUMVALUEA Warning W8075 c_registry.c 185: Suspicious pointer conversion in function HB_FUN_REGENUMVALUEA Warning W8075 c_registry.c 196: Suspicious pointer conversion in function HB_FUN_REGDELETEKEY Warning W8075 c_registry.c 209: Suspicious pointer conversion in function HB_FUN_REGCONNECTREGISTRY c_slider.c: c_spinner.c: c_tab.c: c_textbox.c: c_timer.c: h_webcam.c: c_winapimisc.c: h_button.c: h_checkbox.c: h_combo.c: h_controlmisc.c: h_datepicker.c: h_editbox.c: h_dialogs.c: h_grid.c: h_windows.c: h_windowsmdi.c: h_image.c: h_label.c: h_listbox.c: h_menu.c: h_msgbox.c: h_frame.c: h_progressbar.c: h_radio.c: h_spinner.c: h_tab.c: h_textbox.c: h_timer.c: c_scrsaver.c: h_hotkey.c: h_events.c: Borland C++ 5.82 for Win32 Copyright (c) 1993, 2005 Borland c_hotkey.c: h_draw.c: c_draw.c: h_graph.c: c_graph.c: h_activex.c: h_animate.c: h_browse.c: c_browse.c: h_socket.c: h_dialog.c: h_winprop.c: c_winprop.c: h_getbox.c: c_getbox.c: h_btntextbox.c: c_btntextbox.c: h_hotkeybox.c: c_hotkeybox.c: h_wbrush.c: h_gradient.c: h_mru.c: h_folder.c: c_folder.c: h_pager.c: c_pager.c: h_chklabel.c: c_chklabel.c: h_chklistbox.c: c_chklistbox.c: h_clbutton.c: h_splitbutton.c: h_Gif89.c: h_taskdlg.c: c_taskdlgs.c: c_tooltip.c: c_cuebanner.c: c_hmgapp.c: hbgdiplus.c: c_icon.c: c_monitors.c: c_error.c: h_objects.c: h_objmisc.c: h_misc.c: h_rptgen.c: Borland C++ 5.82 for Win32 Copyright (c) 1993, 2005 Borland h_alert.c: h_GraphBitmap.c: h_buttonex.c: h_comboex.c: h_dbf_aux.c: h_filename.c: h_owntab.c: dbinsert.c: h_checkres.c: h_progresswheel.c: h_rating.c: TLIB 4.5 Copyright (c) 1987, 1998 Borland International TLIB 4.5 Copyright (c) 1987, 1998 Borland International TLIB 4.5 Copyright (c) 1987, 1998 Borland International Warning: public '_HB_FUN_ISREGISTRYKEY' in module 'h_registry' clashes with prior module 'h_init' Warning: public '_HB_FUN_CREATEREGISTRYKEY' in module 'h_registry' clashes with prior module 'h_init' Warning: public '_HB_FUN_GETREGISTRYVALUE' in module 'h_registry' clashes with prior module 'h_init' Warning: public '_HB_FUN_SETREGISTRYVALUE' in module 'h_registry' clashes with prior module 'h_init' Warning: public '_HB_FUN_DELETEREGISTRYVAR' in module 'h_registry' clashes with prior module 'h_init' Warning: public '_HB_FUN_DELETEREGISTRYKEY' in module 'h_registry' clashes with prior module 'h_init' TLIB 4.5 Copyright (c) 1987, 1998 Borland International Warning: public '_HB_FUN_ISREGISTRYKEY' in module 'h_registry' clashes with prior module 'h_init' Warning: public '_HB_FUN_CREATEREGISTRYKEY' in module 'h_registry' clashes with prior module 'h_init' Warning: public '_HB_FUN_GETREGISTRYVALUE' in module 'h_registry' clashes with prior module 'h_init' Warning: public '_HB_FUN_SETREGISTRYVALUE' in module 'h_registry' clashes with prior module 'h_init' Warning: public '_HB_FUN_DELETEREGISTRYVAR' in module 'h_registry' clashes with prior module 'h_init' Warning: public '_HB_FUN_DELETEREGISTRYKEY' in module 'h_registry' clashes with prior module 'h_init' dbginit.obj Borland C++ 5.82 for Win32 Copyright (c) 1993, 2005 Borland dbginit.c: Debugger.lib Borland C++ 5.82 for Win32 Copyright (c) 1993, 2005 Borland dbgGUI.c: dbgHB.c: TLIB 4.5 Copyright (c) 1987, 1998 Borland International PropGrid.lib Borland C++ 5.82 for Win32 Copyright (c) 1993, 2005 Borland h_propgrid.c: h_pglang.c: Borland C++ 5.82 for Win32 Copyright (c) 1993, 2005 Borland c_PropGrid.c: TLIB 4.5 Copyright (c) 1987, 1998 Borland International PropSheet.lib Borland C++ 5.82 for Win32 Copyright (c) 1993, 2005 Borland h_propsheet.c: Borland C++ 5.82 for Win32 Copyright (c) 1993, 2005 Borland c_PropSheet.c: TLIB 4.5 Copyright (c) 1987, 1998 Borland International TsBrowse.lib Borland C++ 5.82 for Win32 Copyright (c) 1993, 2005 Borland c_TBrowse.c: h_tbrowse.c: TControl.c: TSColumn.c: scrllbar.c: SbMsg.c: c_controlmisc1.c: h_controlmisc1.c: h_controlmisc2.c: TComboBox.c: TDatePicker.c: TBtnBox.c: TGetBox.c: TSMulti.c: TCursor.c: TLIB 4.5 Copyright (c) 1987, 1998 Borland International MiniPrint2.lib Borland C++ 5.82 for Win32 Copyright (c) 1993, 2005 Borland miniprint2.c: localize.c: TLIB 4.5 Copyright (c) 1987, 1998 Borland International HMG_QHTM.lib Borland C++ 5.82 for Win32 Copyright (c) 1993, 2005 Borland h_qhtm.c: Borland C++ 5.82 for Win32 Copyright (c) 1993, 2005 Borland c_qhtm.c: TLIB 4.5 Copyright (c) 1987, 1998 Borland International WinReport.lib Borland C++ 5.82 for Win32 Copyright (c) 1993, 2005 Borland h_wrepint.c: h_wremix.c: h_WrePdf.c: hmg_hpdf.c: fncMyError.c: TLIB 4.5 Copyright (c) 1987, 1998 Borland International [/pre2] После этого сборка примеров дает [pre2] Harbour 3.2.0dev (r2104281802) Copyright (c) 1999-2021, https://harbour.github.io/ OBJ\demo.c: OBJ\_hbmkaut_demo.c: Turbo Incremental Link 5.69 Copyright (c) 1997-2005 Borland Error: Unresolved external '_WideToAnsi' referenced from C:\MINIGUIUNICODE\LIB\MINIGUI.LIB|c_windowsAPI Error: Unresolved external '_AnsiToWide' referenced from C:\MINIGUIUNICODE\LIB\MINIGUI.LIB|c_windowsAPI Error: Unresolved external '_HB_FUN_HMG_CREATEFILE_UTF16LE_BOM' referenced from C:\MINIGUIUNICODE\LIB\MINIGUI.LIB|h_ini hbmk2[demo]: Error: Running linker. 2 [/pre2] minigui.cfg имеет вид [pre2] # Basic configuration for Compile.bat MG_CMP=harbour MG_BCC=c:\borland\bcc58 MG_ROOT=c:\miniguiUnicode [/pre2]
gfilatov2002: Выложил 1-е обновление сборки 22.09 с учетом последних дополнений click here Желаю всем удачи
gfilatov2002: SergKis пишет: Сборка версии unicode файлом MakeAllMiniguiLibs.bat выдает протокол с бяками Поправил и обновил архив для этой сборки по старому адресу
SergKis: gfilatov2002 Поправил класс TIniData. Добавил чтение ini из строки буфера (для работы из ресурсов, ini в CUSTOM собираем). Почему то нет ф-ии получение ресурса в строку буфер (может не увидел), нашел только RCDataToFile(...) Весь текст [pre2] /////////////////////////////////////////////////////////////////////////////// CLASS TIniData INHERIT THmgData /////////////////////////////////////////////////////////////////////////////// VAR oIni VAR hKeys INIT { => } VAR hLens INIT { => } VAR cBOM AS STRING INIT hb_utf8Chr( 0xFEFF ) VAR cData AS STRING INIT "" VAR lData AS LOGICAL INIT .F. VAR cIni AS STRING INIT "" VAR lIni AS LOGICAL INIT .F. VAR lUtf AS LOGICAL INIT .F. VAR lUtf8 AS LOGICAL INIT .F. VAR cCommentChar AS STRING INIT ";" VAR cCommentBegin AS STRING INIT "" VAR cCommentEnd AS STRING INIT "" VAR lAutoMain AS LOGICAL INIT .F. VAR lMacro AS LOGICAL INIT .F. VAR lYesNo AS LOGICAL INIT .F. VAR aYesNo AS ARRAY INIT { "Yes", "No" } METHOD New( cIni, lMacro, lUtf8, cChar, cData ) INLINE ( ::Super:New( .T. ), ; ::Def( cIni, lMacro, lUtf8, cChar, cData ), Self ) CONSTRUCTOR _METHOD Def( cIni, lMacro, lUtf8, cChar, cData ) _METHOD Read( cIniNew ) _METHOD Write( cFile, lUtf8 ) _METHOD ToValue( cStr ) _METHOD ToString( xVal ) END CLASS METHOD Def( cIni, lMacro, lUtf8, cChar, cData ) CLASS TIniData ::cData := hb_defaultValue( cData, ::cData ) ::lData := ! Empty( ::cData ) .and. HB_ISCHAR( ::cData ) ::cIni := hb_defaultValue( cIni, ::cIni ) ::lMacro := hb_defaultValue( lMacro, ::lMacro ) ::lUtf8 := ! Empty( lUtf8 ) ::lUtf := ( Set( _SET_CODEPAGE ) == "UTF8" ) ::cCommentChar := hb_defaultValue( cChar, ::cCommentChar ) IF ! Empty( ::cIni ) .and. ! ::lData IF ! hb_FileExists( ::cIni ) hb_memoWrit( ::cIni, iif( ::lUtf8, ::cBOM, "" ) + CRLF ) ENDIF ::lIni := hb_FileExists( ::cIni ) ENDIF RETURN Self METHOD Read( cIniNew ) CLASS TIniData LOCAL hIni, cStr, cBuf, aBuf, nBuf, cSec, hSec, oSec, nLen := 1024 LOCAL cChr := ::cCommentChar, xVal, hKey, nKey, cNote, hHash LOCAL cIni := ::cIni, lIni := ::lIni LOCAL lIniNew := .F. IF HB_ISCHAR( cIniNew ) IF ( lIniNew := hb_FileExists( cIniNew ) ) cIni := cIniNew lIni := lIniNew ELSE RETURN Self ENDIF ENDIF IF ::lData .and. ! lIniNew ::lUtf8 := Left( ::cData, Len( ::cBOM ) ) == ::cBOM cBuf := Left( ::cData, nLen ) aBuf := hb_ATokens( cBuf, CRLF ) FOR EACH cBuf IN aBuf IF left( cBuf, 1 ) == "#" IF ! ::lUtf .and. ::lUtf8 ::cCommentBegin := hb_Utf8ToStr( cBuf ) ELSE ::cCommentBegin := cBuf ENDIF EXIT ENDIF NEXT cBuf := Right( ::cData, nLen ) aBuf := hb_ATokens( cBuf, CRLF ) FOR nBuf := Len(aBuf) TO 1 STEP -1 cBuf := aBuf[ nBuf ] IF left( cBuf, 1 ) == "#" IF ! ::lUtf .and. ::lUtf8 ::cCommentEnd := hb_Utf8ToStr( cBuf ) ELSE ::cCommentEnd := cBuf ENDIF EXIT ENDIF NEXT hHash := hb_hSetCaseMatch( hb_iniReadStr( ::cData, , , ::lAutoMain ), .T. ) ELSEIF lIni .and. ( hIni := FOpen( cIni, 2 ) ) > 0 cStr := space( Len( ::cBOM ) ) cBuf := space( nLen ) FRead( hIni, @cStr, Len( ::cBOM ) ) FSeek( hIni, 0, 0 ) FRead( hIni, @cBuf, nLen ) ::lUtf8 := ( cStr == ::cBOM ) aBuf := hb_ATokens( cBuf, CRLF ) FOR EACH cBuf IN aBuf IF left( cBuf, 1 ) == "#" IF ! ::lUtf .and. ::lUtf8 ::cCommentBegin := hb_Utf8ToStr( cBuf ) ELSE ::cCommentBegin := cBuf ENDIF EXIT ENDIF NEXT cBuf := space( nLen ) FSeek( hIni, -nLen, 2 ) FRead( hIni, @cBuf, nLen ) aBuf := hb_ATokens( cBuf, CRLF ) FOR nBuf := Len(aBuf) TO 1 STEP -1 cBuf := aBuf[ nBuf ] IF left( cBuf, 1 ) == "#" IF ! ::lUtf .and. ::lUtf8 ::cCommentEnd := hb_Utf8ToStr( cBuf ) ELSE ::cCommentEnd := cBuf ENDIF EXIT ENDIF NEXT FClose( hIni ) hHash := hb_hSetCaseMatch( hb_IniRead( cIni, , , ::lAutoMain ), .T. ) ENDIF FOR EACH cSec, hSec IN hb_HKeys( hHash ), hb_HValues( hHash ) IF ! ::lUtf .and. ::lUtf8 cSec := hb_Utf8ToStr( cSec ) ENDIF oSec := oHmgData() nKey := 0 hKey := { => } FOR EACH cStr, cBuf IN hb_HKeys( hSec ), hb_HValues( hSec ) cNote := "" IF ! ::lUtf .and. ::lUtf8 cStr := hb_Utf8ToStr( cStr ) cBuf := hb_Utf8ToStr( cBuf ) ENDIF IF left(cBuf, 2) == "{|" .or. left(cBuf, 3) == "{ |" cNote := cBuf ENDIF IF ! Empty( cChr ) .and. ( nBuf := At( cChr, cBuf ) ) > 0 IF ! ( left(cBuf, 2) == "{|" .or. left(cBuf, 3) == "{ |" ) cNote := subs( cBuf, nBuf ) ENDIF cBuf := Alltrim( Left( cBuf, nBuf - 1 ) ) ENDIF nKey := Max( nKey, Len( cStr ) ) hb_HSet( hKey, upper(cStr), { cStr, cNote } ) IF ::lMacro .and. ! HB_ISNIL( xVal := ::ToValue( cBuf ) ) oSec:Set( cStr, xVal ) ELSE oSec:Set( cStr, cBuf ) ENDIF NEXT ::Set( cSec, oSec ) hb_HSet( ::hKeys, cSec, hKey ) hb_HSet( ::hLens, cSec, nKey ) NEXT hHash := NIL RETURN Self METHOD ToValue( cStr ) CLASS TIniData LOCAL xVal IF Empty( cStr ) ; RETURN cStr ENDIF IF left(cStr, 1) == "{" .and. right(cStr, 1) == "}" .or. ; left(cStr, 1) == "'" .and. right(cStr, 1) == "'" .or. ; left(cStr, 1) == '"' .and. right(cStr, 1) == '"' .or. ; left(cStr, 2) == 'e"' .and. right(cStr, 1) == '"' .or. ; left(cStr, 2) == 't"' .and. right(cStr, 1) == '"' .or. ; left(cStr, 4) == '0d20' .and. Len(cStr) == 10 BEGIN SEQUENCE WITH { |e|break(e) } xVal := &(cStr) END SEQUENCE IF left(cStr, 2) == 't"' .and. right(cStr, 1) == '"' .and. ; Valtype(xVal) == "T" .and. Len( subs(cStr, 3) ) == 11 xVal := hb_TtoD( xVal ) ENDIF ELSEIF hb_ntos(Val(cStr)) == cStr xVal := Val(cStr) ELSEIF cStr == "T" .or. cStr == ".T." .or. cStr == ".t." .or. ; cStr == "Y" .or. cStr == ::aYesNo[1] // "Yes" xVal := .T. ELSEIF cStr == "F" .or. cStr == ".F." .or. cStr == ".f." .or. ; cStr == "N" .or. cStr == ::aYesNo[2] // "No" xVal := .F. ELSE xVal := cStr ENDIF RETURN xVal METHOD ToString( xVal ) CLASS TIniData LOCAL cStr, lE := .F. IF HB_ISCHAR( xVal ) cStr := Alltrim( xVal ) IF ! Empty(cStr) IF CRLF $ cStr lE := .T. cStr := StrTran( cStr, CRLF, "\r\n" ) ENDIF IF chr(9) $ cStr lE := .T. cStr := StrTran( cStr, chr(9), "\t" ) ENDIF IF lE IF left ( cStr, 1 ) == '"' ; cStr := subs( cStr, 2 ) ENDIF IF right( cStr, 1 ) == '"' ; cStr := left( cStr, Len(cStr) - 1 ) ENDIF cStr := 'e"' + cStr + '"' ENDIF ENDIF ELSEIF HB_ISLOGICAL( xVal ) .and. ::lYesNo cStr := ::aYesNo[ iif( xVal, 1, 2 ) ] ELSE cStr := hb_valtoexp( xVal ) ENDIF RETURN cStr METHOD Write( cFile, lUtf8 ) CLASS TIniData LOCAL lRet, aSec, cSec, oSec, hSec, hKey, nLen LOCAL hIni := { => }, cKey, cVal, xVal, cStr, lBlk LOCAL cIni := "_" + DtoS( Date() ) + "_" + StrTran( hb_ntos( Seconds() ), ".", "" ) + "_" + ".ini" LOCAL cBegin := "", cEnd := "" DEFAULT cFile := ::cIni, lUtf8 := ::lUtf8 FOR EACH cSec IN ::Keys() oSec := ::Get( cSec ) hSec := { => } hKey := hb_hSetCaseMatch( hb_HGetDef( ::hKeys, cSec, { => } ), .T. ) nLen := hb_HGetDef( hb_hSetCaseMatch( ::hLens, .T. ), cSec, 11 ) + 1 FOR EACH aSec IN oSec:GetAll() cKey := aSec[1] xVal := aSec[2] lBlk := HB_ISBLOCK( xVal ) cVal := ::ToString( xVal ) IF ! ::lUtf .and. lUtf8 cKey := hb_StrToUtf8( cKey ) cVal := hb_StrToUtf8( cVal ) ENDIF cStr := hb_HGetDef( hKey, cKey, Nil ) IF HB_ISARRAY( cStr ) .and. Len( cStr ) > 1 cKey := cStr[1] IF ! Empty( cStr[2] ) IF lBlk cVal := iif( ! ::lUtf .and. lUtf8, hb_StrToUtf8( cStr[2] ), cStr[2] ) ELSE cVal += space(3) + iif( ! ::lUtf .and. lUtf8, hb_StrToUtf8( cStr[2] ), cStr[2] ) ENDIF ENDIF ENDIF IF nLen > Len( cKey ) ; cKey := left( cKey + space( nLen ), nLen ) ENDIF hb_HSet( hSec, cKey, " " + cVal ) NEXT hb_HSet( hIni, cSec, hSec ) NEXT IF ! Empty( ::cCommentBegin ) cBegin += iif( Left( ::cCommentBegin, 1 ) == "#", "", "#" ) + ::cCommentBegin IF ! ::lUtf .and. lUtf8 cBegin := hb_StrToUtf8( cBegin ) ENDIF ENDIF cBegin := iif( lUtf8, ::cBOM + CRLF, "" ) + cBegin IF ! Empty( ::cCommentEnd ) cEnd += CRLF + iif( Left( ::cCommentEnd, 1 ) == "#", "", "#" ) + ::cCommentEnd IF ! ::lUtf .and. lUtf8 cEnd := hb_StrToUtf8( cEnd ) ENDIF ENDIF IF Empty( cBegin ) ; cBegin := Nil ENDIF IF Empty( cEnd ) ; cEnd := Nil ENDIF hb_iniWrite( cIni, hIni, cBegin, cEnd, ::lAutoMain ) IF hb_vfExists( cFile ) lRet := Empty( hb_vfErase( cFile ) ) IF lRet lRet := Empty( hb_vfRename( cIni, cFile ) ) ENDIF ELSE lRet := Empty( hb_vfRename( cIni, cFile ) ) ENDIF RETURN lRet [/pre2] Пример для версии unicode https://TransFiles.ru/85dt8 Пример для версии НЕ unicode https://TransFiles.ru/eviz8 В примере строки использования [pre2] // oIni := TIniData():New( cIni, .T. ):Read() cBuf := hb_memoread( cIni ) oIni := TIniData():New( , .T., , , cBuf ):Read() oCom := oIni:COM oIni:Read( ".\demo_new.ini" ) [/pre2] .\demo_new.ini - это заменяющие\добавляющие значения ключей по секциям, т.е. если базовый ini лежит в ресурсах, то доп. ini задаем текущие (для этого клиента) новые значения
SergKis: PS Используем, у себя, такую ф-ю для работы с ресурсом CUSTOM (VC2019) [pre2] #include "cons2.h" // bkLoadCustom( "Name", ["xx.dll"]) -> "..." NAME CUSTOM .\....\file.xxx HB_FUNC( BKLOADCUSTOM ) { HINSTANCE hLib, hInstance; HRSRC hSource; HGLOBAL hRes, lpVoid; char * Buf; WCHAR cFile[MAX_PATH]; WCHAR cName[33]; // +1 for '0' DWORD i, k, nSize; PHB_CODEPAGE s_cdpHost = hb_vmCDP(); if( ! HB_ISCHAR(1) ){ hb_retclen("", 0); return; } hLib = NULL; if( HB_ISCHAR(2) ){ Buf = (char *) hb_parc(2); k = hb_parclen(2); ZeroMemory( cFile, MAX_PATH * 2 ); for(i=0;i<k;i++) cFile[ i ] = _hb_cdpGetU16( s_cdpHost, TRUE, Buf[ i ] ); hLib = LoadLibraryExW( cFile, NULL, LOAD_LIBRARY_AS_DATAFILE ); hInstance = hLib; // GetModuleHandleW( NULL ); } else hInstance = GetModuleHandleW( NULL ); if( hInstance == NULL ){ if( hLib != NULL ) FreeLibrary( hLib ); hb_retclen("", 0); return; } Buf = ( char * ) hb_parc(1); k = hb_parclen(1); k = ( k > 32) ? 32 : k; ZeroMemory( cName, 33 * 2 ); for(i=0;i<k;i++) cName[ i ] = _hb_cdpGetU16( s_cdpHost, TRUE, Buf[ i ] ); hSource = FindResourceW( hInstance, cName, L"CUSTOM" ); if( hSource==NULL){ if( hLib != NULL ) FreeLibrary( hLib ); hb_retclen("", 0); return; } hRes = LoadResource( hInstance, hSource); if( hRes==NULL){ if( hLib != NULL ) FreeLibrary( hLib ); hb_retclen( "", 0); return; } lpVoid = LockResource ( hRes ); // UnLock в Win32 - не нужно из MSDN // Использовать hSource это ошибка if( lpVoid==NULL ){ hb_retclen("", 0); } else { // -------- Получить ------ nSize = SizeofResource ( hInstance, hSource ); hb_retclen( lpVoid, nSize); // ---------- } FreeResource ( hRes ); if( hLib != NULL ) FreeLibrary( hLib ); } // *** Buf = ( char * ) hb_xgrab( nSize + 1 ); // *** CopyMemory( Buf, lpVoid, nSize ); // *** hb_retclen( Buf, nSize); // *** hb_xfree( Buf ); cons2.h #ifndef __CONS2_H #define __CONS2_H #define _WIN32_WINNT 0x0600 #define HB_OS_WIN_USED #define UNICODE 1 #define _UNICODE 1 // #include "hwingui.h" from hwggui\include #include "hbgtcore.h" #include "hbapi.h" #include "hbapiitm.h" #include "hbapifs.h" #include "hbapierr.h" #include "hbapigt.h" #include "hbstack.h" #include "hbset.h" #include "hb_io.h" #include "hbvm.h" #include "hbwinuni.h" #include "hbapirdd.h" #include "hbrdddbf.h" #include "hbdbf.h" #include "hbdate.h" #include "hbapicls.h" #include <tchar.h> #include <windows.h> #include <shlobj.h> #include <shellapi.h> #include <shlwapi.h> #include <winnls.h> #include <shobjidl.h> #include <objbase.h> #include <objidl.h> #include <shlguid.h> #include <commdlg.h> #define _CHECKSUM2 0 #if ! defined( _MAX_PATH ) #define _MAX_PATH 260 #endif #if ( HB_VER_MAJOR == 3 ) #define _hb_cdpGetU16( cdp, fCtrl, ch) hb_cdpGetU16(cdp, ch ) #define _hb_cdpGetChar(cdp, fCtrl, ch) hb_cdpGetChar(cdp, ch) #else #define _hb_cdpGetU16( cdp, fCtrl, ch) hb_cdpGetU16(cdp, fCtrl, ch ) #define _hb_cdpGetChar(cdp, fCtrl, ch) hb_cdpGetChar(cdp, fCtrl, ch) #endif int MultiByteToWideChar2( UINT CodePage, // code page DWORD dwFlags, // character-type options LPCSTR lpMultiByteStr, // address of string to map int cchMultiByte, // number of characters in string LPWSTR lpWideCharStr, // address of wide-character buffer int cchWideChar // size of buffer ); int WideCharToMultiByte2( UINT CodePage, // code page DWORD dwFlags, // performance and mapping flags LPCWSTR lpWideCharStr, // address of wide-character string int cchWideChar, // number of characters in string LPSTR lpMultiByteStr, // address of buffer for new string int cchMultiByte, // size of buffer LPCSTR lpDefaultChar, // address of default for unmappable characters LPBOOL lpUsedDefaultChar // address of flag set when default char. used ); BOOL ba_IsClassName( HWND hWnd, TCHAR *Name ); typedef unsigned char uchar; #define HB_PARNI( n, x ) hb_parvni( n, x ) #define HB_PARNL( n, x ) hb_parvnl( n, x ) #define HB_STORNI( n, x, y ) hb_storvni( n, x, y ) #define HB_STORNL( n, x, y ) hb_storvnl( n, x, y ) #define HB_STORC( n, x, y ) hb_storvc_t( n, x, y ) #define HB_STORCT( n, x, y ) hb_storvc( n, x, y ) #define HB_STORCLEN( n, x, y, len) hb_storvclen( n, len, x, y) #define HB_STORL( n, x, y ) hb_storvl( n, x, y ) // Использовать для функций HWG_ #define HB_RETHANDLE( h ) hb_retptr( ( void * ) ( h ) ) #define HB_PARHANDLE( n ) hb_parptr( n ) #define HB_STOREHANDLE( h, n ) hb_storptr( ( void * ) ( h ), n ) #define HB_PUTHANDLE( i, h ) hb_itemPutPtr( i, ( void * ) ( h ) ) #define HB_GETHANDLE( i ) hb_itemGetPtr( i ) #define _HB_PARSTR( n, h, len ) wvt_wstrget( hb_param( n, HB_IT_ANY ), h, len ) #define _HB_PARSTRDEF( n, h, len ) wvt_wstrnull( hwg_wstrget( hb_param( n, HB_IT_ANY ), h, len ) ) #define _HB_RETSTR( str ) wvt_wstrset( hb_param( -1, HB_IT_ANY ), str ) #define _HB_RETSTRLEN( str, len ) wvt_wstrlenset( hb_param( -1, HB_IT_ANY ), str, len ) #define _HB_STORSTR( str, n ) wvt_wstrset( hb_param( n, HB_IT_BYREF ), str ) #define _HB_STORSTRLEN( str, len, n ) wvt_wstrlenset( hb_param( n, HB_IT_BYREF ), str, len ) #define _HB_ARRAYGETSTR( arr, n, h, len ) wvt_wstrget( hb_arrayGetItemPtr( arr, n ), h, len ) #define _HB_ARRAYSETSTR( arr, n, str ) wvt_wstrset( hb_arrayGetItemPtr( arr, n ), str ) #define _HB_ARRAYSETSTRLEN( arr, n, str, len ) wvt_wstrlenset( hb_arrayGetItemPtr( arr, n ), str, len ) #define _HB_ITEMCOPYSTR( itm, str, len ) wvt_wstrcopy( itm, str, len ) #define _HB_ITEMGETSTR( itm, h, len ) wvt_wstrget( itm, h, len ) #define _HB_ITEMPUTSTR( itm, str ) wvt_wstrput( itm, str ) #define _HB_ITEMPUTSTRLEN( itm, str, len ) wvt_wstrlenput( itm, str, len ) #define _HB_STRUNSHARE( h, str, len ) wvt_wstrunshare( h, str, len ) #define _hb_strfree( h ) wvt_wstrfree( h ) extern const char * wvt_strnull( const char * str ); extern const char * wvt_strget( PHB_ITEM pItem, void ** phStr, HB_SIZE * pulLen ); extern HB_SIZE wvt_strcopy( PHB_ITEM pItem, char * pStr, HB_SIZE ulLen ); extern char * wvt_strunshare( void ** phStr, const char * pStr, HB_SIZE ulLen ); extern void wvt_strfree( void * hString ); extern const wchar_t * wvt_wstrnull( const wchar_t * str ); extern const wchar_t * wvt_wstrget( PHB_ITEM pItem, void ** phStr, HB_SIZE * pulLen ); extern PHB_ITEM wvt_wstrput( PHB_ITEM pItem, const wchar_t * pStr ); extern void wvt_wstrset( PHB_ITEM pItem, const wchar_t * pStr ); extern PHB_ITEM wvt_wstrlenput( PHB_ITEM pItem, const wchar_t * pStr, HB_SIZE ulLen ); extern void wvt_wstrlenset( PHB_ITEM pItem, const wchar_t * pStr, HB_SIZE ulLen ); extern HB_SIZE wvt_wstrcopy( PHB_ITEM pItem, wchar_t * pStr, HB_SIZE ulLen ); extern wchar_t * wvt_wstrunshare( void ** phStr, const wchar_t * pStr, HB_SIZE ulLen ); extern void wvt_wstrfree( void * hString ); void _DbViewLogW(LPCWSTR cFormat, ... ); void _DbViewLogA(LPCSTR cFormat, ... ); #define _LA _DbViewLogA #define _LW _DbViewLogW #endif /* __CONS2_H */ [/pre2]
gfilatov2002: SergKis пишет: Поправил класс TIniData. Добавил чтение ini из строки буфера Большое спасибо за дополнение Обязательно использую эти изменения для следующей сборки (после изучения, конечно ).
gfilatov2002: SergKis пишет: Почему то нет ф-ии получение ресурса в строку буфер (может не увидел), нашел только RCDataToFile(...) Добавил новую функцию RCDataToMem() Синтаксис: RCDataToMem( <cResName>|<nResID>, [<cResType>|<nResType>], ; [<hModule>] ) => cResult Благодарю за ваш запрос
gfilatov2002: Завершена подготовка 2-го обновления сборки 22.09, которое планируется к выпуску на этой неделе Кратко, что нового: [pre2] * New: Added the useful C-function RCDataToMem(). Syntax: RCDataToMem( <cResName>|<nResID>, [<cResType>|<nResType>], ; [<hModule>] ) => cResult Requested by Sergej Kiselev on the Russian HMG forum. Contributed by Grigory Filatov <gfilatov@gmail.com> (see demo3.prg in folder \samples\Advanced\RCDataToFile) * Enhanced: OOP class TIniData supports loading the values from memory variable instead of ini file. Suggested and contributed by Sergej Kiselev (see demo2.prg in folder \samples\Advanced\Tsb_Ini2Tbrowse) * Updated: ComboBox control message APIs were used in some C-code instead the direct calling the function SendMessage(). Contributed by Grigory Filatov <gfilatov@gmail.com> (see demo in folder \samples\Advanced\AutoFill_2) * Updated: Finished replacement of LONG_PTR with HB_PTRUINT in the kernel C-code casting. Contributed by Grigory Filatov <gfilatov@gmail.com> * Updated: MySql library source code (see in folder \Source\HbMySql): - added the support for SSL options in the class TMySQLServer; - added support for TIMESTAMP and DATETIME types in the method TMySQLQuery():GetRow(). Based upon a contribution of Viktor Szakats (borrowed from 3.4 fork). Adapted for Minigui Extended by Grigory Filatov * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.39.4 (from 3.39.3). Contributed by Grigory Filatov <gfilatov@gmail.com> * Updated: 'How to add, edit, delete and browse data into an object in an MDI-child window' sample. Contributed by Grigory Filatov <gfilatov@gmail.com> (see test04.prg in folder \samples\Advanced\TDatabase) [/pre2] Благодарю за внимание к этому проекту
gfilatov2002: Выложил 2-е обновление сборки 22.09 с учетом последних исправлений и дополнений click here
Alex_Cher: Мужики ... в общем ответ на вопрос очевиден, все же хочу проконсультироваться у спецов. Руководство в конторе переводит все компы на Astra Linux, у меня все софты на Harbor - возможны ли какие-либо проблемы ..?
SergKis: gfilatov2002 Предложение вкл. ф-ии работы с txt файлами как образы в память, оч. быстрая работа. Описание ф-ий [pre2] fmp_Open( cFile, [nMapArea], [ nRO ] ) -> nMapArea | -1 cFile Имя файла в режиме только чтение. nMapArea номер области ( 1 - 10 ) или -1 ( F_ERROR ) nRO в каком режиме открывать файл == 0 fmp_Count( [nMapArea] ) -> nCount количество строк файла "...Chr(13)+Chr(10)" nMapArea - номер области ( 1 - 10 ) [ nMapArea == 1 ] учитывается что в последней строке может и не быть Chr(10) ? но текст есть Скорость на тесте : (200 файлов и 1 500 000 строк всего) время 0.2 ~ 0.3 сек fmp_Line( [nMapArea], [nLine], [lCheckUTF8] ) -> "Line..." | "" получить строку по номеру nMapArea - номер области ( 1 - 10 ) [ nMapArea == 1 ] nLine - номер строки от 1 до fmp_Count( nMapArea ) эта запись становится текущей, ее можно получить fmp_RecNo( [ nMapArea ] ) если опущена то следующая за текущей если это была последняя то fmp_EOF( nMapArea ) -> .T. lCheckUTF8 - нужно ли учитывать кодировку файла Def == .T. fmp_RecNo( [nMapArea] ) -> nRecord | 0 fmp_Close( nMapArea ) -> .T. | .F. закрыть файлы ( nMp : 1 - 10 ) nMapArea - номер области ( 1 - 10 ) [ nMapArea == 1 ] fmp_IsUtf8( nMapArea ) -> .T. | .F. кодировка ? nMapArea - номер области ( 1 - 10 ) [ nMapArea == 1 ] fmp_Eof( nMp ) -> .T. | .F. nMapArea - номер области ( 1 - 10 ) [ nMapArea == 1 ] fmp_ATokenCSV( [nMapArea], nLine, [lDel], [lCheckUTF8] ) -> {"Line..." | "", ...} получить массив токенов для файла CSV nMapArea - номер области ( 1 - 10 ) [ nMapArea == 1 ] lDel == .T. ковычки удаляет ( если есть одновременно обе ) .F. ничего не удаляет [ lDel == .T. ] lCheckUTF8 == .T. - проверять наличие utf-8 и перекодировать .F. - как есть [ lCheckUTF8 == .T. ] разделитель Chr(9) и проверяет начало и конец как '"' [/pre2] Функции [pre2] #include "cons2.h" // extern void _DbViewLogA(char *cFormat, ...); // lstrcpynA( ( LPSTR ) &MF, ( LPCSTR ) hb_parc(1), MF_SIZE ); typedef struct _hb_MapFile { HANDLE hFile; HANDLE hMap; LARGE_INTEGER nFileSize; unsigned char * pData; DWORD dwSize; /* Размер файла == 0 не открыт */ unsigned char * pLine; /* Текущая запись */ DWORD nLen; DWORD nLine; BOOL fUTF8; BOOL fUNI; BOOL fEOF; int res; } hb_MapFile; #define MF_SIZE sizeof( hb_MapFile ) #define AMF_SIZE 10 #define MF ( amf[mf_index] ) static int mf_index = 0; static hb_MapFile amf[ AMF_SIZE ] = { 0 }; static int _GetIndex( int nPar ) { int i=0; if( HB_ISNUM(nPar) ) i = hb_parnl(nPar); mf_index = (i > 0 && i <= AMF_SIZE )? i-1 : mf_index; return mf_index; } static BOOL _CodeParam( int nPar, WCHAR *cFile ) { BOOL lResult=FALSE; int k; unsigned char *s; PHB_CODEPAGE s_cdpHost = hb_vmCDP(); cFile[0] = 0; if( HB_ISCHAR(1) ) /* ZeroMemory( cFile, (MAX_PATH+1)*2); */ { k = hb_parclen( nPar ); if( k > 0) { s = (unsigned char *) hb_parc( nPar ); while( k-- > 0) *cFile++ = _hb_cdpGetU16(s_cdpHost,TRUE, *s++ ); *cFile = 0; lResult = TRUE; } } return lResult; } static BOOL __CloseFile() { if( MF.pData ) UnmapViewOfFile( MF.pData ); if( MF.hMap ) CloseHandle( MF.hMap ); if( MF.hFile != INVALID_HANDLE_VALUE) CloseHandle( MF.hFile ); ZeroMemory( &MF, MF_SIZE); return FALSE; } static BOOL __OpenFile( WCHAR * cFile, int ind, int nRO ) { int i=0,n; while( amf[ i ].dwSize > 0 && i < AMF_SIZE) i++; if(i == AMF_SIZE) return FALSE; mf_index = i; ZeroMemory( &MF, MF_SIZE); MF.res ++ ; MF.hFile = CreateFileW( cFile, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if( MF.hFile == INVALID_HANDLE_VALUE) return __CloseFile(); MF.res ++ ; if( ! GetFileSizeEx(MF.hFile, &MF.nFileSize) ) return __CloseFile(); MF.dwSize = MF.nFileSize.u.LowPart; /* MF.nFileSize.QuadPart; */ /* Контроль 0 ! */ if( MF.dwSize==0 ) return __CloseFile(); MF.res ++ ; MF.hMap = CreateFileMappingW( MF.hFile, NULL, PAGE_READONLY, MF.nFileSize.u.HighPart, MF.nFileSize.u.LowPart, NULL); if( ! MF.hMap ) return __CloseFile(); MF.res ++ ; MF.pData = ( char *) MapViewOfFile( MF.hMap, FILE_MAP_READ, 0, 0, MF.dwSize); if( ! MF.pData ) return __CloseFile(); MF.fUTF8 = MF.pData[0]==0xEF && MF.pData[1]==0xBB && MF.pData[2]==0xBF; MF.fUNI = MF.pData[0]==0xFE && MF.pData[1]==0xFF; i = ( MF.fUTF8 )? 3 : 0; i = ( MF.fUNI ) ? 2 : 0; MF.pLine = MF.pData + i; n = 0; /* while( ( DWORD ) i < MF.dwSize && MF.pData[ i ] != 10) { i++; n++; } MF.nLine = 1; MF.nLen = ( n>0 && (MF.pData[i-1]==13) )? (n-1) : n; */ return TRUE; } /* fmp_Open( cFile, [nMp], [ nRO == 0] ) -> nMp | -1 cFile Имя файла в режиме только чтение. nMp номер области ( 1 - 10 ) или -1 ( F_ERROR ) nRO в каком режиме открывать файл */ HB_FUNC( FMP_OPEN ) { WCHAR cFile[ MAX_PATH+1 ]; int nRO=0; if( _CodeParam( 1, cFile ) ) { nRO = ( HB_ISNUM(3) )? hb_parnl(3) : nRO; if( __OpenFile( cFile, _GetIndex(2), nRO ) ) { MF.pLine = MF.pData; hb_retnl( mf_index + 1 ); return ; } } hb_retnl(-1); } /* fmp_Count( [nMp] ) -> nCount количество строк файла "...Chr(13)+Chr(10)" учитывается что в последней строке может и не быть Chr(10) ? но текст есть Скорость на тесте : (200 файлов и 1 500 000 строк всего) время 0.2 ~ 0.3 сек */ HB_FUNC( FMP_COUNT ) { unsigned char *p; DWORD nCount=0, i=0, n=0; _GetIndex( 1 ); if( ! (p = MF.pData) ) { hb_retnl(0); return; } while( i++ < MF.dwSize) { if( *p++ == 10 ) { n = 0; nCount++;} /* Новая строка */ else n ++; } hb_retnl( nCount + ((n > 0)? 1 : 0) ); } static void __RetDeCode( unsigned char *utf, int Ln, BOOL lCheck, int y) { PHB_CODEPAGE cdp; int n=0; unsigned char *s; if( lCheck ) { while(n < Ln && utf[n] < 0x80) n++; if( n < Ln) /* Нужно кодировать */ { cdp = hb_vmCDP(); n = hb_cdpUTF8AsStrLen( cdp, utf, Ln, 0 ); /* Нужная длинна */ if(n > 0) { if( (s = hb_xgrab(n + 1)) ) { hb_cdpUTF8ToStr( cdp, utf, Ln, s, n + 1 ); if(y > 0) hb_storvclen_buffer( s, n, -1, y); else hb_retclen_buffer( s, n ); return ; } } } } if( y > 0 ) hb_storvclen( utf, Ln, -1, y); else hb_retclen( utf, Ln ); } /* Найти запись по номеру Вернет количество символов в строке или -1 если не найдена */ static int _findNextRec( DWORD nPar,int nSkip, BOOL lCheckUTF8) /* Найти запись номер */ { unsigned char *p; DWORD n=0, nCount, nLine; DWORD i; if( HB_ISNUM(nPar) ) /* Ищем от начала */ { p = MF.pData; if( MF.fUTF8 && lCheckUTF8 ) p += 3; /* Пропустить BOM */ nCount = 0; /* Текущий внутренний */ MF.pLine = p; nLine = hb_parnl( nPar ); } else { nLine = MF.nLine + nSkip; /* Skip 1 */ p = MF.pLine + MF.nLen; nCount = MF.nLine; } // p = MF.pLine; /* Исходные не меняем если не найдено */ // nCount = MF.nLine; i = p - MF.pData; while( i++ < MF.dwSize) { if( *p++ == 10 ) { nCount++; if( nCount == nLine ) { MF.pLine = (p - n - 1); /* Начало возвращаемой строки */ MF.nLine = nLine; /* Номер возвращаемой строки */ MF.nLen = n + 1; MF.fEOF = FALSE; return (n-1); } n = 0; } /* Новая строка */ else n ++; /* Кол-во символов в стрке */ } if( n > 0 && (nCount+1)==nLine ) { MF.pLine = p - n; /* Начало возвращаемой строки */ MF.nLine = nLine; /* Номер возвращаемой строки */ MF.nLen = n; MF.fEOF = FALSE; return n; } MF.fEOF = TRUE; return -1; } /* stores a fixed length string on a variable by reference hb_storclen( const char * szText, HB_SIZE nLength, int iParam ); */ /* fmp_Line( [nMp], [nLine], [lCheckUTF8] ) -> "Line..." | "" получить строку по номеру nLine номер строки от 1 до hb_CountFileMap(cMp) lCheckUTF8 - нужно ли учитывать кодировку файла Def == .T. */ // lstrcpynA( ( LPSTR ) &MF, ( LPCSTR ) hb_parc(1), MF_SIZE ); // hb_storclen( (char * ) &MF, MF_SIZE, 1); /* Обновить параметр */ HB_FUNC( FMP_LINE ) { long n=0; BOOL lCheckUTF8=TRUE; _GetIndex( 1 ); lCheckUTF8 = ( HB_ISLOG(3) )? hb_parl(3) : lCheckUTF8; n = _findNextRec( 2, 1, lCheckUTF8); // if( HB_ISNUM(2) ) n = _findNextRec( 2, 1, lCheckUTF8); // else n = MF.nLen; if( n >= 0) __RetDeCode( MF.pLine, n, MF.fUTF8 && lCheckUTF8, 0); else hb_retclen( "", 0); } static void __Token( unsigned char *cLine, int nLen, BOOL lDel, BOOL lCheckUTF8) { int i=0,k=0, n, y; unsigned char *p; while(i < nLen) { if(cLine[ i ]==9){ n=0; k++; } else n ++; i ++; } hb_reta( k + ( (n > 0)? 1 : 0) ); i = 0; y = 0; n = 0; while(i < nLen) { if( cLine[ i ]==9 ) { y ++; p = &cLine[i-n]; /* Начало токена */ if( lDel && n > 1 && p[0]==0x22 && p[n-1]==0x22) __RetDeCode( p+1, n-2, MF.fUTF8 && lCheckUTF8, y); /* hb_storvclen( p+1, n-2, -1, y); */ else __RetDeCode( p, n, MF.fUTF8 && lCheckUTF8, y); /* hb_storvclen( p, n, -1, y); */ n=0; } else n ++; i ++; } if( n > 0) { p = &cLine[i-n]; /* Начало токена */ if( lDel && n > 1 && p[0]==0x22 && p[n-1]==0x22) __RetDeCode( p+1, n-2, MF.fUTF8 && lCheckUTF8, y+1); /* hb_storvclen( p+1, n-2, -1, y+1); */ else __RetDeCode( p, n, MF.fUTF8 && lCheckUTF8, y+1); /* hb_storvclen( p, n, -1, y+1); */ } } /* fmp_ATokenCSV( [nMp], nLine,[lDel=.T.],[lCheckUTF8:=.T.] ) -> {"Line..." | "", ...} получить массив токенов для файла CSV разделитель Chr(9) и проверяет начало и конец как '"' lDel == .T. ковычки удаляет ( если есть одновременно обе ) .F. ничего не удаляет lCheckUTF8 == .T. - проверять наличие utf-8 и перекодировать .F. - как есть */ HB_FUNC( FMP_ATOKENCSV ) { long n; BOOL lDel=FALSE; BOOL lCheckUTF8=TRUE; _GetIndex( 1 ); lDel = ( HB_ISLOG(3) )? hb_parl(3) : lDel; lCheckUTF8 = ( HB_ISLOG(4) )? hb_parl(4) : lCheckUTF8; if( HB_ISNUM(2) ) n = _findNextRec( 2, 1, lCheckUTF8); else n = MF.nLine; if( n >= 0) __Token( MF.pLine, n, lDel, lCheckUTF8); else hb_reta( 0 ); } /* fmp_Close( nMp ) -> .T. | .F. закрыть файлы ( nMp : 1 - 10 ) */ HB_FUNC( FMP_CLOSE ) { _GetIndex( 1 ); __CloseFile(); } /* fmp_IsUtf8( nMp ) -> .T. | .F. кодировка ( nMp : 1 - 10 ) */ HB_FUNC( FMP_ISUTF8 ) { _GetIndex( 1 ); hb_retl( MF.fUTF8 ); } /* fmp_Eof( nMp ) -> .T. | .F. кодировка ( nMp : 1 - 10 ) */ HB_FUNC( FMP_EOF ) { _GetIndex( 1 ); hb_retl( MF.fEOF ); } /* fmp_RecNo( nMp ) -> nRecord | 0 кодировка ( nMp : 1 - 10 ) */ HB_FUNC( FMP_RECNO ) { _GetIndex( 1 ); if( MF.hFile==INVALID_HANDLE_VALUE || MF.hFile==NULL) hb_retnl( 0 ); else hb_retnl( MF.nLine ); } cons2.h #ifndef __CONS2_H #define __CONS2_H #define _WIN32_WINNT 0x0600 #define HB_OS_WIN_USED #define UNICODE 1 #define _UNICODE 1 // #include "hwingui.h" from hwggui\include #include "hbgtcore.h" #include "hbapi.h" #include "hbapiitm.h" #include "hbapifs.h" #include "hbapierr.h" #include "hbapigt.h" #include "hbstack.h" #include "hbset.h" #include "hb_io.h" #include "hbvm.h" #include "hbwinuni.h" #include "hbapirdd.h" #include "hbrdddbf.h" #include "hbdbf.h" #include "hbdate.h" #include "hbapicls.h" #include <tchar.h> #include <windows.h> #include <shlobj.h> #include <shellapi.h> #include <shlwapi.h> #include <winnls.h> #include <shobjidl.h> #include <objbase.h> #include <objidl.h> #include <shlguid.h> #include <commdlg.h> #define _CHECKSUM2 0 #if ! defined( _MAX_PATH ) #define _MAX_PATH 260 #endif #if ( HB_VER_MAJOR == 3 ) #define _hb_cdpGetU16( cdp, fCtrl, ch) hb_cdpGetU16(cdp, ch ) #define _hb_cdpGetChar(cdp, fCtrl, ch) hb_cdpGetChar(cdp, ch) #else #define _hb_cdpGetU16( cdp, fCtrl, ch) hb_cdpGetU16(cdp, fCtrl, ch ) #define _hb_cdpGetChar(cdp, fCtrl, ch) hb_cdpGetChar(cdp, fCtrl, ch) #endif int MultiByteToWideChar2( UINT CodePage, // code page DWORD dwFlags, // character-type options LPCSTR lpMultiByteStr, // address of string to map int cchMultiByte, // number of characters in string LPWSTR lpWideCharStr, // address of wide-character buffer int cchWideChar // size of buffer ); int WideCharToMultiByte2( UINT CodePage, // code page DWORD dwFlags, // performance and mapping flags LPCWSTR lpWideCharStr, // address of wide-character string int cchWideChar, // number of characters in string LPSTR lpMultiByteStr, // address of buffer for new string int cchMultiByte, // size of buffer LPCSTR lpDefaultChar, // address of default for unmappable characters LPBOOL lpUsedDefaultChar // address of flag set when default char. used ); BOOL ba_IsClassName( HWND hWnd, TCHAR *Name ); typedef unsigned char uchar; #define HB_PARNI( n, x ) hb_parvni( n, x ) #define HB_PARNL( n, x ) hb_parvnl( n, x ) #define HB_STORNI( n, x, y ) hb_storvni( n, x, y ) #define HB_STORNL( n, x, y ) hb_storvnl( n, x, y ) #define HB_STORC( n, x, y ) hb_storvc_t( n, x, y ) #define HB_STORCT( n, x, y ) hb_storvc( n, x, y ) #define HB_STORCLEN( n, x, y, len) hb_storvclen( n, len, x, y) #define HB_STORL( n, x, y ) hb_storvl( n, x, y ) // Использовать для функций HWG_ #define HB_RETHANDLE( h ) hb_retptr( ( void * ) ( h ) ) #define HB_PARHANDLE( n ) hb_parptr( n ) #define HB_STOREHANDLE( h, n ) hb_storptr( ( void * ) ( h ), n ) #define HB_PUTHANDLE( i, h ) hb_itemPutPtr( i, ( void * ) ( h ) ) #define HB_GETHANDLE( i ) hb_itemGetPtr( i ) #define _HB_PARSTR( n, h, len ) wvt_wstrget( hb_param( n, HB_IT_ANY ), h, len ) #define _HB_PARSTRDEF( n, h, len ) wvt_wstrnull( hwg_wstrget( hb_param( n, HB_IT_ANY ), h, len ) ) #define _HB_RETSTR( str ) wvt_wstrset( hb_param( -1, HB_IT_ANY ), str ) #define _HB_RETSTRLEN( str, len ) wvt_wstrlenset( hb_param( -1, HB_IT_ANY ), str, len ) #define _HB_STORSTR( str, n ) wvt_wstrset( hb_param( n, HB_IT_BYREF ), str ) #define _HB_STORSTRLEN( str, len, n ) wvt_wstrlenset( hb_param( n, HB_IT_BYREF ), str, len ) #define _HB_ARRAYGETSTR( arr, n, h, len ) wvt_wstrget( hb_arrayGetItemPtr( arr, n ), h, len ) #define _HB_ARRAYSETSTR( arr, n, str ) wvt_wstrset( hb_arrayGetItemPtr( arr, n ), str ) #define _HB_ARRAYSETSTRLEN( arr, n, str, len ) wvt_wstrlenset( hb_arrayGetItemPtr( arr, n ), str, len ) #define _HB_ITEMCOPYSTR( itm, str, len ) wvt_wstrcopy( itm, str, len ) #define _HB_ITEMGETSTR( itm, h, len ) wvt_wstrget( itm, h, len ) #define _HB_ITEMPUTSTR( itm, str ) wvt_wstrput( itm, str ) #define _HB_ITEMPUTSTRLEN( itm, str, len ) wvt_wstrlenput( itm, str, len ) #define _HB_STRUNSHARE( h, str, len ) wvt_wstrunshare( h, str, len ) #define _hb_strfree( h ) wvt_wstrfree( h ) extern const char * wvt_strnull( const char * str ); extern const char * wvt_strget( PHB_ITEM pItem, void ** phStr, HB_SIZE * pulLen ); extern HB_SIZE wvt_strcopy( PHB_ITEM pItem, char * pStr, HB_SIZE ulLen ); extern char * wvt_strunshare( void ** phStr, const char * pStr, HB_SIZE ulLen ); extern void wvt_strfree( void * hString ); extern const wchar_t * wvt_wstrnull( const wchar_t * str ); extern const wchar_t * wvt_wstrget( PHB_ITEM pItem, void ** phStr, HB_SIZE * pulLen ); extern PHB_ITEM wvt_wstrput( PHB_ITEM pItem, const wchar_t * pStr ); extern void wvt_wstrset( PHB_ITEM pItem, const wchar_t * pStr ); extern PHB_ITEM wvt_wstrlenput( PHB_ITEM pItem, const wchar_t * pStr, HB_SIZE ulLen ); extern void wvt_wstrlenset( PHB_ITEM pItem, const wchar_t * pStr, HB_SIZE ulLen ); extern HB_SIZE wvt_wstrcopy( PHB_ITEM pItem, wchar_t * pStr, HB_SIZE ulLen ); extern wchar_t * wvt_wstrunshare( void ** phStr, const wchar_t * pStr, HB_SIZE ulLen ); extern void wvt_wstrfree( void * hString ); void _DbViewLogW(LPCWSTR cFormat, ... ); void _DbViewLogA(LPCSTR cFormat, ... ); #define _LA _DbViewLogA #define _LW _DbViewLogW #endif /* __CONS2_H */ [/pre2] Пример использования [pre2] *----------------------------------------------------------------------------* STATIC FUNCTION TxtToDbf( cTxt, cDbf ) *----------------------------------------------------------------------------* LOCAL nMp, cTx, cDt, cKy LOCAL cNm := lower(hb_FNameName(cDbf)) LOCAL nRec := 0 IF ( nMp := fmp_Open( cTxt ) ) > 0 IF ! fmp_Eof( nMp ) fmp_Line ( nMp ) // пустая fmp_Line ( nMp ) // header fmp_Line ( nMp ) // ====== lIn := .T. ENDIF IF mDbUse( cDbf, "TMP", .F. ) // USE ( cDbf ) ALIAS TMP NEW ; IF Used() IF "e_row" $ cNm DO WHILE ! fmp_Eof( nMp ) cTx := fmp_Line( nMp ) // нет текстов utf8 в файле IF Right(( cKy := left(cTx, 12) ), 1) $ "0123456789" IF chr(0) $ cTx ; cTx := StrTran(cTx, chr(0), "") ENDIF cDt := subs( cTx,14, 12) APPEND BLANK FieldPut( 1, cKy ) FieldPut( 2, cDt ) FieldPut( 3, subs(cTx, 27, 12) ) FieldPut( 4, nUx2cDts( Val(cDt) ) ) ENDIF ENDDO ELSEIF "o_nam" $ cNm // объекты name DO WHILE ! fmp_Eof( nMp ) cTx := fmp_Line( nMp ) IF Right(( cKy := left(cTx, 12) ), 1) $ "0123456789" APPEND BLANK FieldPut( 1, cKy ) FieldPut( 2, subs( cTx, 14, 12) ) FieldPut( 3, subs( cTx, 27, 12) ) FieldPut( 4, subs( cTx, 40, 12) ) FieldPut( 5, subs( cTx, 53, 12) ) FieldPut( 6, subs( cTx, 61, 12) ) FieldPut( 7, subs( cTx, 79, 12) ) FieldPut( 8, subs( cTx, 92, 6) ) cTx := Dos4W5( alltrim(subs( cTx, 99 )), 8) IF chr(0) $ cTx ; cTx := StrTran(cTx, chr(0), "") ENDIF FieldPut( 9, cTx ) ENDIF ENDDO ELSEIF "o_" $ cNm .or. "e_nam" $ cNm .or. "e_adr" $ cNm // объекты ... DO WHILE ! fmp_Eof( nMp ) cTx := fmp_Line( nMp ) IF Right(( cKy := left(cTx, 12) ), 1) $ "0123456789" APPEND BLANK FieldPut( 1, cKy ) FieldPut( 2, subs( cTx, 14, 12) ) cTx := Dos4W5( alltrim(subs( cTx, 27 )), 8) IF chr(0) $ cTx ; cTx := StrTran(cTx, chr(0), "") ENDIF FieldPut( 3, cTx ) ENDIF ENDDO ELSE DO WHILE ! fmp_Eof( nMp ) cTx := fmp_Line( nMp ) IF Right(( cKy := left(cTx, 12) ), 1) $ "0123456789" APPEND BLANK FieldPut( 1, cKy ) cTx := Dos4W5( alltrim(subs( cTx, 14 )), 8) IF chr(0) $ cTx ; cTx := StrTran(cTx, chr(0), "") ENDIF FieldPut( 2, cTx ) ENDIF ENDDO ENDIF nRec := LastRec() USE ENDIF fmp_Close( nMp ) ENDIF fErase(cTxt) RETURN nRec [/pre2]
Andrey: Что то не совсем понятен пример использования ? Там просто функция чтения файла и всё. А как вытаскивать нужные значения в тексте программы ?
SergKis: Andrey пишет Что то не совсем понятен пример использования ? [pre2] IF ( nMp := fmp_Open( cTxt ) ) > 0 DO WHILE ! fmp_Eof( nMp ) cTx := fmp_Line( nMp ) ... ENDDO fmp_Close( nMp ) ENDIF или IF ( nMp := fmp_Open( cTxt ) ) > 0 nK := fmp_Count( nMp ) FOR nI := 1 TO nK cTx := fmp_Line( nMp, nI ) ... NEXT fmp_Close( nMp ) ENDIF ... [/pre2] Там просто функция чтения файла и всё Так это и есть ф-ии чтения файла, который мапируется средствами windows в память. Если у тебя есть журналы большие лог и их много за период, то можно организовать на этих ф-ях просмотр журналов или съесть их в dbf (данные зависят от структуры лога в каждом конкретном случае). Пример показан для выборки из файлов txt до ~10 000 000 записей каждый (выдаваемые отчеты в txt из системы sql сервера) данных в dbf для дальнейшей индексации и реализации получения отчетов, которых нет в системе (а их там практически нет - все в ручном режиме через задание sql команд select ...) А как вытаскивать нужные значения в тексте программы ? Как из полученной строки. В примере это так [pre2] cTx := fmp_Line( nMp ) IF Right(( cKy := left(cTx, 12) ), 1) $ "0123456789" APPEND BLANK FieldPut( 1, cKy ) FieldPut( 2, subs( cTx, 14, 12) ) FieldPut( 3, subs( cTx, 27, 12) ) FieldPut( 4, subs( cTx, 40, 12) ) FieldPut( 5, subs( cTx, 53, 12) ) FieldPut( 6, subs( cTx, 61, 12) ) FieldPut( 7, subs( cTx, 79, 12) ) FieldPut( 8, subs( cTx, 92, 6) ) cTx := Dos4W5( alltrim(subs( cTx, 99 )), 8) // перекодировка utf8 -> LV866 IF chr(0) $ cTx ; cTx := StrTran(cTx, chr(0), "") ENDIF FieldPut( 9, cTx ) [/pre2] ф-я ниже разбирает строку полей, отделенных Chr(9) на массив значений полей fmp_ATokenCSV( [nMapArea], nLine, [lDel], [lCheckUTF8] ) -> {"Line..." | "", ...} // получить массив токенов для файла CSV где lDel == .T. кавычки удаляет ( если есть одновременно обе ) или .F. ничего не удаляет [ lDel == .T. default ] т.е.[pre2] aVal := fmp_ATokenCSV( nMp, nI ) (cAls)->( AEval(aVal, {|c,n| FieldPut(n, c) }) ) [/pre2] Одновременно можно открыть до 10 областей (файлов) для обработки, т.е. nMp1 := fmp_Open( cTxt1 ) nMp2 := fmp_Open( cTxt2 ) ... nMp10 := fmp_Open( cTxt10 )
Dima: Сергей хочешь сказать что это быстрее механизма hb_fuse и связанных функций ?
SergKis: Dima пишет хочешь сказать что это быстрее механизма hb_fuse Да. aFile := array(200) // заполняем aFile 200 файлов log с записями 1 500 000 строк разделенных CRLF всего FOR nI := 1 TO 200 cFile := aFile[ nI ] nMp := fmp_Open( cFile ) fmp_Count( nMp ) // подсчет строк в файле fmp_Close( nMp ) NEXT это занимает ~ 0.2-0.3 сек. Опыт делался еще на hb20 давно в районе 2012 г.
Dima: SergKis пишет: Опыт делался еще на hb20 давно в районе 2012 г. Долго же ты ждал , что бы выложить PS Сам проверю.
SergKis: Dima пишет Долго же ты ждал Написал и использовал товарищ по работе для log журналов расчета квартплаты и импорта больших csv файлов. У меня ранее на VO была сделана система работы с txt файлами как с log, так и с другими, в итоге получалась база[ы] dbf и далее типа browse для работ получения отчетов (генератор их). Исп. не так часто, только при разборах полетов и оч. редких запросов налоговой при проверках. Было до лампочки по времени работы. Столкнулся с проблемой времени при ежедневной откачке инф. из firebird, где данные переменного объема (чужая задача) от ~2 500 000 записей растет до ~10 000 000 за ~3 месяца, потом база обрезается опять до последних ~2 500 000. В этой ситуации сам применил, что было давно сделано. Решил поделится, вдруг пригодится кому. Сразу скажу, что исп. fbclient.dll и класс oServer := TFBServer():New( cServer + cDatabase, cUser, cPass, nDialect ) на таких объемах (выбор всех данных из таблицы) ожидаемо сваливалось и надо было строить разные запросы с ограничениями записей и в целом усложнять все, т.е. себе лишняя работа. Исп. возможности их системы выдавать отчеты в txt файлы и обработал как в примере выше. Получилось несколько отчетов с max 10 000 000 записей (во всех ~5 штук). Раз в сутки (чаще клиенту не надо) все данные из firebird попадают в помесячную базу на CDX для ежедневных, годовых, квартальных отчетов и ...
Dima: Сергей , погонял тесты. Шикарный инструмент по скорости. Тестовый файл , длина строки 1000 + CRLF , всего строк 1 000 000 hb_flastrec() 0.93 ft_FLastRe() 0.92 fmp_Count() 0.39 Ежели в цикле читать строки hb_freadln() 5.00 ft_FReadLn() 4.7 fmp_Line () 0.72 Во время сборки ворнингов дофигища....код не совсем корректен ? [pre2] ../fmp.c:32:2: warning: missing braces around initializer [-Wmissing-braces] static hb_MapFile amf[ AMF_SIZE ] = { 0 }; ^ ../fmp.c:32:2: warning: (near initialization for 'amf[0]') [-Wmissing-braces] ../fmp.c: In function '__OpenFile': ../fmp.c:117:13: warning: pointer targets in assignment differ in signedness [-Wpointer-sign] MF.pData = ( char *) MapViewOfFile( MF.hMap, FILE_MAP_READ, 0, 0, MF.dwSize); ^ ../fmp.c:89:12: warning: variable 'n' set but not used [-Wunused-but-set-variable] int i=0,n; ^ ../fmp.c:87:45: warning: unused parameter 'ind' [-Wunused-parameter] static BOOL __OpenFile( WCHAR * cFile, int ind, int nRO ) ^ ../fmp.c:87:54: warning: unused parameter 'nRO' [-Wunused-parameter] static BOOL __OpenFile( WCHAR * cFile, int ind, int nRO ) ^ ../fmp.c: In function '__RetDeCode': ../fmp.c:208:40: warning: pointer targets in passing argument 2 of 'hb_cdpUTF8AsStrLen' differ in signedness [-Wpointer-sign] n = hb_cdpUTF8AsStrLen( cdp, utf, Ln, 0 ); /* Нужная длинна */ ^ In file included from c:/hb32mingw20/include/hbapigt.h:54:0, from c:/hb32mingw20/include/hbgtcore.h:55, from ../cons2.h:14, from ../fmp.c:1: c:/hb32mingw20/include/hbapicdp.h:479:31: note: expected 'const char *' but argument is of type 'unsigned char *' extern HB_EXPORT HB_SIZE hb_cdpUTF8AsStrLen( PHB_CODEPAGE cdp, const char * pSrc, HB_SIZE nSrc, HB_SIZE nMax ); ^ ../fmp.c:214:35: warning: pointer targets in passing argument 2 of 'hb_cdpUTF8ToStr' differ in signedness [-Wpointer-sign] hb_cdpUTF8ToStr( cdp, utf, Ln, s, n + 1 ); ^ In file included from c:/hb32mingw20/include/hbapigt.h:54:0, from c:/hb32mingw20/include/hbgtcore.h:55, from ../cons2.h:14, from ../fmp.c:1: c:/hb32mingw20/include/hbapicdp.h:480:31: note: expected 'const char *' but argument is of type 'unsigned char *' extern HB_EXPORT HB_SIZE hb_cdpUTF8ToStr( PHB_CODEPAGE cdp, const char * pSrc, HB_SIZE nSrc, char * pDst, HB_SIZE nDst ); ^ ../fmp.c:214:44: warning: pointer targets in passing argument 4 of 'hb_cdpUTF8ToStr' differ in signedness [-Wpointer-sign] hb_cdpUTF8ToStr( cdp, utf, Ln, s, n + 1 ); ^ In file included from c:/hb32mingw20/include/hbapigt.h:54:0, from c:/hb32mingw20/include/hbgtcore.h:55, from ../cons2.h:14, from ../fmp.c:1: c:/hb32mingw20/include/hbapicdp.h:480:31: note: expected 'char *' but argument is of type 'unsigned char *' extern HB_EXPORT HB_SIZE hb_cdpUTF8ToStr( PHB_CODEPAGE cdp, const char * pSrc, HB_SIZE nSrc, char * pDst, HB_SIZE nDst ); ^ ../fmp.c:216:45: warning: pointer targets in passing argument 1 of 'hb_storvclen_buffer' differ in signedness [-Wpointer-sign] if(y > 0) hb_storvclen_buffer( s, n, -1, y); ^ In file included from c:/hb32mingw20/include/hbapigt.h:53:0, from c:/hb32mingw20/include/hbgtcore.h:55, from ../cons2.h:14, from ../fmp.c:1: c:/hb32mingw20/include/hbapi.h:779:25: note: expected 'char *' but argument is of type 'unsigned char *' extern HB_EXPORT int hb_storvclen_buffer( char * szText, HB_SIZE nLength, int iParam, ... ); /* stores a fixed length string buffer on a variable by reference */ ^ ../fmp.c:217:42: warning: pointer targets in passing argument 1 of 'hb_retclen_buffer' differ in signedness [-Wpointer-sign] else hb_retclen_buffer( s, n ); ^ In file included from c:/hb32mingw20/include/hbapigt.h:53:0, from c:/hb32mingw20/include/hbgtcore.h:55, from ../cons2.h:14, from ../fmp.c:1: c:/hb32mingw20/include/hbapi.h:692:25: note: expected 'char *' but argument is of type 'unsigned char *' extern HB_EXPORT void hb_retclen_buffer( char * szText, HB_SIZE nLen ); /* same as above, but accepts an allocated buffer */ ^ ../fmp.c:224:31: warning: pointer targets in passing argument 1 of 'hb_storvclen' differ in signedness [-Wpointer-sign] if( y > 0 ) hb_storvclen( utf, Ln, -1, y); ^ In file included from c:/hb32mingw20/include/hbapigt.h:53:0, from c:/hb32mingw20/include/hbgtcore.h:55, from ../cons2.h:14, from ../fmp.c:1: c:/hb32mingw20/include/hbapi.h:778:25: note: expected 'const char *' but argument is of type 'unsigned char *' extern HB_EXPORT int hb_storvclen( const char * szText, HB_SIZE nLength, int iParam, ... ); /* stores a fixed length string on a variable by reference */ ^ ../fmp.c:225:28: warning: pointer targets in passing argument 1 of 'hb_retclen' differ in signedness [-Wpointer-sign] else hb_retclen( utf, Ln ); ^ In file included from c:/hb32mingw20/include/hbapigt.h:53:0, from c:/hb32mingw20/include/hbgtcore.h:55, from ../cons2.h:14, from ../fmp.c:1: c:/hb32mingw20/include/hbapi.h:691:25: note: expected 'const char *' but argument is of type 'unsigned char *' extern HB_EXPORT void hb_retclen( const char * szText, HB_SIZE nLen ); /* returns a string with a specific length */ ^ ../fmp.c: In function 'HB_FUN_FMP_ATOKENCSV': ../fmp.c:340:30: warning: 'n' may be used uninitialized in this function [-Wmaybe-uninitialized] hb_reta( k + ( (n > 0)? 1 : 0) ); ^ ../fmp.c:329:17: note: 'n' was declared here int i=0,k=0, n, y; ^ [/pre2]
SergKis: Dima пишет Во время сборки ворнингов дофигища....код не совсем корректен ? У нас сборка под vc 2019, протокол чистый (для 2008 и 2017 так же норм)[pre2] DbOpenCount.C FileFun.C MapFile.C CsvLine.C Создание кода... [/pre2]
Dima: SergKis У меня MinGw. Ну да ладно , работает же Спасибо !
SergKis: Dima Как я понял, тут не исп. переменная n, можно убрать [pre2] static BOOL __OpenFile( WCHAR * cFile, int ind, int nRO ) { int i=0 /*,n*/; while( amf[ i ].dwSize > 0 && i < AMF_SIZE) i++; if(i == AMF_SIZE) return FALSE; MF.pLine = MF.pData + i; ... /* n = 0; комент /* был тут while( ( DWORD ) i < MF.dwSize && MF.pData != 10) { i++; n++; } MF.nLine = 1; MF.nLen = ( n>0 && (MF.pData[i-1]==13) )? (n-1) : n; */ return TRUE; } [/pre2] в др. местах тип надо приводить не 'const char *' а 'unsigned char *', но думаю MinGw применил как надо
Dima: попробую , спасибо Серёга !
SergKis: Dima Небольшой пример тсб просмотра файла ф-ями fmp_Line(...), если интересно, конечно Тут https://TransFiles.ru/gfemn Если BOM у файла utf8 есть и стоит 3-ий параметр fmp_line(...,..., .T.), то перекодировка из utf8 есть, иначе нет и надо самому делать, как в примере ф-я dos4w5(...) делает utf8 -> lv866. Можно применять и fmp_ATokensCSV(...), тогда можно делать поколоночный показ файла (разделитель колонок chr(9) в записи) PS Пример сделан на своей версии, можешь пробнуть собрать на hmg, поставив свою CDP, свой файл и если он utf8 без BOM, заменить dos4w5(...) на hb_Utf8ToStr( fmp_Line(...) )
Dima: SergKis
gfilatov2002: Выложил 3-е обновление сборки 22.09 с учетом последних исправлений и дополнений click here
gfilatov2002: Завершена подготовка новой сборки 22.11, которая планируется к выпуску на следующей неделе Что нового: [pre2] * Fixed: Correction of style C-type from int to DWORD in the Minigui core according to the WinAPI definition. Contributed by Grigory Filatov <gfilatov@gmail.com> * Updated: C-code cleaning for unneeded variables when defining controls and windows in the Minigui core. Contributed by Grigory Filatov <gfilatov@gmail.com> * Updated: HbCurl library: - added HB_CURLOPT_MAXLIFETIME_CONN to setup max lifetime; - added HB_CURLOPT_DEBUGBLOCK to setup a block for debug. Contributed by Antonino Perricone (see in folder \Harbour\Lib) * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.40.0dev (from 3.39.4). Contributed by Grigory Filatov <gfilatov@gmail.com> * Updated: Harbour Compiler 3.2.0dev (SVN 2022-11-11 21:15). Contributed by Grigory Filatov <gfilatov@gmail.com> (look at ReadMe.txt in folder \harbour) * Updated: 'Desktop Windows Version Market Share Worldwide' sample: - updated the data for October 2022. Contributed by Grigory Filatov <gfilatov@gmail.com> (see demo.prg in folder \samples\Basic\GraphPrint) * Updated: 'MiniGUI DataBase Utility' sample: - fixed setting of tags in TBrowse with using :uLastTag variable; - others minor corrections regarding tags. Contributed by Grigory Filatov <gfilatov@gmail.com> (see in folder \Utils\mgDBU) [/pre2] Возможно, нового внесено не так уж и много, но пришлось основательно перелопатить и оптимизировать Си-код ядра библиотеки
gfilatov2002: Как и обещал, выложил финальную сборку 22.11 click here Также обновил Unicode версию библиотеки по старому адресу для Сергея Ваши комментарии приветствуются...
SergKis: gfilatov2002 пишет обновил Unicode версию библиотеки по старому адресу Спасибо Буду пробовать на ней, а предыдущую unicode дополнил RcDataToMem() и полет нормальный. Пока единственный затык с работающей версией - это работа modal окна под MdiChild, в нашей версии работает.
gfilatov2002: Завершена подготовка новой сборки 22.12, которая планируется к выпуску на следующей неделе Что нового: - исправление ошибок и неточностей в коде; - добавлена новая возможность для элемента управления SWITCHER - картинка для режима отображения disabled; - продолжена основательная чистка Си-кода с целью удаления ненужных переменных, без которых можно обойтись; - добавлен новый пример, который показывает как закрасить цветом всю строку, столбец или отдельную клетку в элементе управления GRID. Желаю всем мирного неба над головой
gfilatov2002: Опубликована финальная сборка 22.12, которая выложена по адресу click here Замечание. Обращаю ваше внимание, что также есть платные сборки этой версии библиотеки для следующих 64-битных Си-компиляторов: - Borland\Embarcadero C++ 7.20 for Win64; - MinGW GNU C 12.2.0 (packaged on 2022-08-28); - MS Visual C++ 2022 Community Edition (19.34.31933). Таким образом, работоспособность библиотеки была успешно проверена для всех актуальных версий современных Си компиляторов
gfilatov2002: Завершена подготовка 1-го обновления сборки 22.12, которая планируется к выпуску на следующей неделе Что нового: - исправление обнаруженных ошибок (подробности есть на английском форуме Минигуи); - добавлен новый переключатель AUTOUPDATE в элементе управления GetBox с использованием класса FIELD, который предназначен для принудительной записи в поле базы данных при любом изменении значения Value в GetBox; - добавлены новые макросы для унификации параметров в Си-коде библиотеки; - обновлена библиотека BosTaurus с целью оптимизации кода; - обновлена сборка компилятора Харбор до текущей версии на сервере github; - обновлены некоторые примеры с учетом изменений и дополнений в ядре библиотеки. Искренне благодарю за материальную поддержку моей работы Андрея Верченко!
gfilatov2002: Выложил 1-е обновление сборки 22.12 с учетом последних исправлений и дополнений click here
Andrey: gfilatov2002 пишет: Выложил 1-е обновление сборки 22.12 Можно ссылку на юникодную версию ? И ещё ссылку для компилятора Microsoft ?
gfilatov2002: Andrey пишет: Можно ссылку на юникодную версию ? Отравил ссылки в Л.С. Andrey пишет: ссылку для компилятора Microsoft ? Там ссылка на версию Unicode для компилятора MS VC 2022
gfilatov2002: Выложил 2-е обновление сборки 22.12 с учетом последних исправлений и дополнений click here Завершена адаптация библиотеки для работы с последней доступной 64-битной версией компилятора Borland/Embarcadero C++ 7.40, который основан на LLVM/Clang C 3.3.1 (36707.161adda.9a76976) (64-bit) Мои наилучшие поздравления и пожелания всем форумчанам с наступающими праздниками! Желаю всем здоровья и удачи в Новом году
gfilatov2002: Поздравляю всех с сочельником и Рождеством Христовым! Завершена адаптация библиотеки для работы с последней доступной 64-битной версией компилятора Pelles ISO C Compiler 11.0, который по скорости работы не уступает Embarcadero C++ 7.40 (64-bit) Моя искренняя благодарность Андрею Верченко за поддержку моей работы!
gfilatov2002: Подготовил 1-й релиз-кандидат новой сборки 23.01, которая планируется к выпуску через две недели. Что нового: * Fixed: GETBOX: GetProperty( Form, Getbox, 'PICTURE' ) call always returns an empty value. Bug was reported by Hans Marc at the Minigui forum. Contributed by Grigory Filatov <gfilatov@gmail.com> * Enhanced: The Child window may manage the 'Parent' property. You can get this property at runtime: - function syntax: GetProperty ( ChildForm, 'Parent' ) --> cParent - pseudo-OOP syntax: ChildForm.Parent --> cParent Requested by Mario Rossi. Contributed by Grigory Filatov <gfilatov@gmail.com> * Enhanced: The Image control supports now a changing of the STRETCH property at runtime. You can set this property with: - function syntax: SetProperty ( Form, Image, 'Stretch', .T.|.F. ) - pseudo-OOP syntax: Form.Image.Stretch := .T.|.F. It was a postponed modification. Contributed by Grigory Filatov <gfilatov@gmail.com> * Modified: Revised a font management with DEFINE FONT <font> FONTNAME <name> ... command: - restored a previous behavior of the function GetFontList() with the default charset parameter. The issue was reported by Vagner Sanches. Contributed by Grigory Filatov <gfilatov@gmail.com> (see demo in folder \samples\Applications\WordScribe) * Updated: Synchronized Extended HMG for compatibility with Official HMG: - added the useful functions (and appropriate properties) below: - TreeItemGetAllValues(); - TreeItemGetChildValues(); - TreeItemGetSiblingValues(). - GetProperty -> AllValue, ChildValue, SiblingValue. Based upon a contribution of Claudio Soto <srvet@adinet.com.uy>. Adapted for Minigui Extended by Grigory Filatov (see demo in folder \samples\Advanced\DirTree_2) * Updated: Pacified the C-warnings in the MiniGUI core for compatibility with the Pelles ISO C Compiler 11.0 (64-bit). Contributed by Grigory Filatov <gfilatov@gmail.com> * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.40.1 (from 3.40.0). Contributed by Grigory Filatov <gfilatov@gmail.com> * Updated: Harbour Compiler 3.2.0dev (SVN 2023-01-15 11:17): * Updated libpng library to 1.6.39 (from 1.6.38); * bumped copyright year to 2023. Contributed by Grigory Filatov <gfilatov@gmail.com> (look at ReadMe.txt in folder \harbour) * Updated: 'Inter-application communication' sample: - fixed to use temp folder instead of "C:\" to avoid write permission issues. Suggested by Grzegorz Wojnarowski (see in folder \samples\Basic\COMM) * Updated: 'Console+GUI mixed mode' sample. Contributed by Grzegorz Wojnarowski (see in folder \samples\Basic\MixedMode) * Updated: 'Virtual Grid with sorted columns' sample: - added workaround for inserted checkboxes. Contributed by Grigory Filatov <gfilatov@gmail.com> (see in folder \samples\Basic\ON_QUERYDATA) * Updated: 'Tree Menu' sample by Bicahi Esgici: - updated with the latest changes in the Minigui core. Contributed by Grigory Filatov <gfilatov@gmail.com> (see in folder \samples\Basic\TreeMenu) * Updated: 'MySql Client' sample: - code cleaning for warnings with Harbour switch -w3. Contributed by Grigory Filatov <gfilatov@gmail.com> (see in folder \samples\Advanced\MySqlClient) * Updated: 'Virtual Keyboard' sample. Contributed by Kristjan Zagar (see in folder \samples\Advanced\OnScreenKeyboard) * Updated: 'Volume Info' sample: - using the function wapi_GetVolumeInformation() instead of local implementation. Contributed by Grigory Filatov <gfilatov@gmail.com> (see demo.prg in folder \samples\Advanced\VOLUME_INFO) * Updated: 'Windows Version' sample: - fixed Windows 11 detection. Contributed by Grigory Filatov <gfilatov@gmail.com> (see in folder \samples\Advanced\WinVersion) * Updated: 'WMI Service usage' sample: - fixed 'Memory Info' detection. Contributed by Grigory Filatov <gfilatov@gmail.com> (see demo2.prg in folder \samples\Advanced\WMI_Service) Если у вас есть интересные дополнения или исправления, то я с удовольствием добавлю их в эту сборку Прошу откликнуться всех, кому это интересно...
Andrey: gfilatov2002 пишет: * Updated libpng library to 1.6.39 (from 1.6.38); А где эта библиотека сидит ? Картинки PNG будут лучше отображаться в ТСБ и на формах ? А то если картинку на форме увеличиваешь, то качество теряется, ребристая становиться...
SergKis: gfilatov2002 пишет Если у вас есть интересные дополнения или исправления Небольшие отличия THmgData() в моей версии [pre2] ... _METHOD Set( xKey, xVal ) METHOD Get( KEY, Def ) INLINE iif( KEY == NIL, ::aKey, hb_HGetDef( ::aKey, ::Upp( Key ), Def ) ) METHOD Del( Key ) INLINE ( iif( ::Pos( Key ) > 0, hb_HDel( ::aKey, ::Upp( Key ) ), Nil ), Self ) METHOD Pos( Key ) INLINE hb_HPos( ::aKey, ::Upp( Key ) ) METHOD Upp( Key ) INLINE iif( HB_ISCHAR( Key ) .AND. ::lUpp, Upper( Key ), Key ) METHOD Len() INLINE Len( ::aKey ) METHOD Keys() INLINE hb_HKeys( ::aKey ) METHOD Values() INLINE hb_HValues( ::aKey ) METHOD CloneHash() INLINE hb_HClone( ::aKey ) METHOD Json( cJ, lJ ) INLINE iif( HB_ISCHAR(cJ), ( cJ := SubS( cJ, At ("{", cJ) ), ; cJ := Left( cJ, RAt("}", cJ) ), ; ::Set(hb_jsonDecode( cJ ), ! Empty(lJ)) ), ; hb_jsonEncode( ::aKey, ! Empty(lJ) ) ) _METHOD GetAll( lAll ) _METHOD Eval( Block ) ERROR HANDLER ControlAssign ENDCLASS *-----------------------------------------------------------------------------* METHOD Set( xKey, xVal ) CLASS THmgData LOCAL k, v IF pCount() > 0 IF HB_ISHASH( xKey ) IF HB_ISLOGICAL(xVal) .and. xVal FOR EACH k, v IN hb_HKeys( xKey ), hb_HValues( xKey ) hb_HSet ( ::aKey, ::Upp( k ), v ) NEXT ELSE ::aKey := xKey ENDIF ELSE hb_HSet ( ::aKey, ::Upp( xKey ), xVal ) ENDIF ENDIF RETURN Self ... [/pre2] Хотя, METHOD Json( cJ, lJ ) не обязателен - для информации
gfilatov2002: SergKis пишет: Небольшие отличия THmgData() Спасибо Поправил, конечно, но без необязательного метода.
Andrey: Ранее было в 2019 году - SergKis пишет: Может добавить функцию (по аналогии с HMG_GetFormControls()) ? K примеру FUNCTION HMG_GetForms( cTyp, lObj ) А как узнать окно скрыто на экране или нет ? Т.е. получить признак окна Show/Hide у себя в функции: [pre2]FUNCTION myGetWinList() LOCAL i, cS, aForm := HMG_GetForms() cS := "" FOR i := 1 TO LEN(aForm) cS += STR(i) + ", " + aForm + ", " + _HMG_aFormType[ i ] + ", " cS += HB_NtoS(_HMG_aFormHandles[ i ]) + CRLF NEXT MsgInfo(cS) Return NIL[/pre2]
gfilatov2002: Andrey пишет: А как узнать окно скрыто на экране или нет ? Для этого можно использовать вызов функции GetProperty( "Form1", "Visible" ) Рабочий пример для проверки см. ниже [pre2]#include <hmg.ch> Declare window form1 Declare window form2 Declare window form3 Function Main() DEFINE WINDOW MAIN AT 218, 380 WIDTH 237 HEIGHT 286 TITLE "" MAIN DEFINE BUTTON oButton1 ACTION (formOff(),FormON(1)) CAPTION "Form1" TRANSPARENT .T. COL 53 HEIGHT 26 ROW 20 WIDTH 96 END BUTTON DEFINE BUTTON oButton2 ACTION (formOff(),FormON(2)) CAPTION "Form2" TRANSPARENT .T. COL 53 HEIGHT 26 ROW 51 WIDTH 96 END BUTTON DEFINE BUTTON oButton3 ACTION (formOff(),FormON(3)) CAPTION "Form3" TRANSPARENT .T. COL 53 HEIGHT 26 ROW 82 WIDTH 96 END BUTTON DEFINE BUTTON oButton4 ACTION MsgDebug( HMG_GetForms( "S" ) ) CAPTION "Form List" TRANSPARENT .T. COL 53 HEIGHT 26 ROW 130 WIDTH 96 END BUTTON DEFINE BUTTON oButton5 ACTION ( SetProperty( "Form1", "Visible", .F. ), ; MsgDebug( GetProperty( HMG_GetForms( "S" )[1], "Visible" ) ) ) CAPTION "Is Form1 visible?" TRANSPARENT .T. COL 53 HEIGHT 26 ROW 160 WIDTH 96 END BUTTON DEFINE BUTTON oButton6 ACTION RenameForms() CAPTION "Rename Forms" TRANSPARENT .T. COL 53 HEIGHT 26 ROW 186 WIDTH 96 END BUTTON END WINDOW CreateForm("Form1") CreateForm("Form2") CreateForm("Form3") activate window Form1,Form2,Form3,Main REturn .T. ********************************************************************************************************************************************** Procedure CreateForm(cForm) DEFINE WINDOW &(cForm) AT 286, 717 WIDTH 385 HEIGHT 351 TITLE "" //CHILD DEFINE LABEL oLabel1 VALUE cForm AUTOSIZE TRUE FONTBOLD TRUE VCENTERALIGN TRUE COL 123 FONTSIZE 30.00 HEIGHT 46.00 ROW 109 WIDTH 132 END LABEL END WINDOW Procedure FormON(nForm) switch nForm case 1 Form1.TopMost := .t. ; exit case 2 Form2.TopMost := .t. ; exit case 3 Form3.TopMost := .t. end Procedure FormOff Form1.TopMost := .f. ; Form2.TopMost := .f. ; Form3.TopMost := .f. Procedure RenameForms() LOCAL form FOR EACH form IN HMG_GetForms( "S" ) SetProperty(form,"title",form) NEXT[/pre2]
SergKis: gfilatov2002 пишет Для этого можно использовать вызов функции GetProperty( "Form1", "Visible" ) может исп. такие варианты #translate _IsWindowVisible( cForm ) => IsWindowVisible( GetFormHandle( cForm ) ) #translate IsFormVisible( FormName ) => IsWindowVisible( GetFormHandle( "FormName" ) )
gfilatov2002: SergKis пишет: исп. такие варианты Да, так можно сделать. Но все же предпочтительным в Минигуи является использование функций GetProperty()/SetProperty(). К вызову именно этих функций сводится использование псевдо-ООП в библиотеке.
SergKis: gfilatov2002 пишет К вызову именно этих функций сводится использование псевдо-ООП в библиотеке + DoMetod() и больше ничего не надо , но мнемоника параметров и их позиции для окон и конторлов при исп. этих ф-ий тоже требует усилий. Не зря же целый каталог для препроцессора существует, что бы win api напрямую не использовать.
Andrey: Спасибо БОЛЬШОЕ ! Получилось ! Только чуток не работает функции: [pre2] FOR nI := 1 TO Len(aForm) cForm := aForm[nI] ? nI, cForm, _HMG_aFormType[nI], _HMG_aFormHandles[nI] ?? "Visible=", IsWindowVisible( GetFormHandle( cForm ) ) ?? GetProperty( cForm, "Visible" ) ....[/pre2] [pre2]1 Form_Main A 460206 Visible= .T. .T. 2 Form_Win1 S 1049612 Visible= .F. .F. 3 Form_Win2 S 393928 Visible= .F. .F. 4 Form_Win3 S 67248 Visible= .F. .F. 5 Form_Table_Dog '' 0 Visible= .T. .T. 6 Form_Table_Abon S 132806 Visible= .T. .T. [/pre2] Почему нет значения Form_Table_Dog '' 0 ? Форма на экране есть, а значения в логе нет ! т.е. не работает - _HMG_aFormType[nI], _HMG_aFormHandles[nI]
SergKis: Andrey пишет т.е. не работает - _HMG_aFormType[nI], _HMG_aFormHandles[nI] посмотри значение _HMG_aFormDeleted[nI] для Form_Table_Dog (выведи для всех)
Andrey: SergKis пишет: посмотри значение _HMG_aFormDeleted[nI] для Form_Table_Dog Вот так:[pre2] 1 Form_Main A 2426566 .F. Visible= .T. .T. 2 Form_Win1 S 198358 .F. Visible= .F. .F. 3 Form_Win2 S 198356 .F. Visible= .F. .F. 4 Form_Win3 S 1115148 .F. Visible= .F. .F. 5 Form_Table_Dog '' 0 .T. Visible= .T. .T. 6 Form_Table_Abon S 983678 .F. Visible= .T. .T. 7 Form_Table_Zaivk S 852104 .F. Visible= .T. .T. [/pre2] Окно Form_Table_Dog с таблицей на экране есть ! Если сразу после главного окна открывать другое окно, то тогда оно = 0 !!! Вот открытие окон в другом порядке:[pre2] 1 Form_Main A 3344120 .F. Visible= .T. .T. 2 Form_Win1 S 722656 .F. Visible= .F. .F. 3 Form_Win2 S 1311898 .F. Visible= .F. .F. 4 Form_Win3 S 788088 .F. Visible= .F. .F. 5 Form_Table_Zaivk '' 0 .T. Visible= .T. .T. 6 Form_Table_Abon S 395016 .F. Visible= .T. .T. 7 Form_Table_Dog S 592490 .F. Visible= .T. .T. [/pre2]
SergKis: gfilatov2002 Сделал правки небольшие (управление клавишами на Preview HbPrinter) Проверял SAMPLES\Advanced\REPORT_GENERATOR_2\demo2.prg [pre2] ... #define WM_VSCROLL 0x0115 #define SB_LINEUP 0 #define SB_LINEDOWN 1 ... METHOD Preview() CLASS HBPrinter ... DEFINE WINDOW HBPREVIEW ; AT ahs[ 1, 1 ], ahs[ 1, 2 ] ; WIDTH ahs[ 1, 6 ] HEIGHT ahs[ 1, 5 ] ; TITLE aopisy[ 1 ] ICON 'zzz_Printicon' ; MODAL NOSIZE ; FONT 'Arial' SIZE 9 ; ON INIT ( DoMethod("HBPREVIEW1", "SetFocus") ) ... BUTTON B1 CAPTION aopisy[ 2 ] PICTURE 'hbprint_close' ACTION {|| ::PrevClose( .T. ) } SEPARATOR BUTTON B10 CAPTION aopisy[ 11 ] PICTURE 'hbprint_option' ACTION {|| ::PrintOption() } SEPARATOR BUTTON B8 CAPTION aopisy[ 9 ] PICTURE 'hbprint_zoomin' ACTION {|| scale := scale * 1.25, ::PrevShow(), DoMethod("HBPREVIEW1", "SetFocus") } BUTTON B9 CAPTION aopisy[ 10 ] PICTURE 'hbprint_zoomout' ACTION {|| scale := scale / 1.25, ::PrevShow(), DoMethod("HBPREVIEW1", "SetFocus") } SEPARATOR IF iloscstron > 1 BUTTON B4 CAPTION aopisy[ 5 ] PICTURE 'hbprint_top' ACTION {|| page := ::CurPage := 1, HBPREVIEW.combo_1.VALUE := page, ::PrevShow(), DoMethod("HBPREVIEW1", "SetFocus") } BUTTON B5 CAPTION aopisy[ 6 ] PICTURE 'hbprint_back' ACTION {|| page := ::CurPage := iif( page == 1, 1, page - 1 ), HBPREVIEW.combo_1.VALUE := page, ::PrevShow(), DoMethod("HBPREVIEW1", "SetFocus") } BUTTON B6 CAPTION aopisy[ 7 ] PICTURE 'hbprint_next' ACTION {|| page := ::CurPage := iif( page == iloscstron, page, page + 1 ), HBPREVIEW.combo_1.VALUE := page, ::PrevShow(), DoMethod("HBPREVIEW1", "SetFocus") } BUTTON B7 CAPTION aopisy[ 8 ] PICTURE 'hbprint_end' ACTION {|| page := ::CurPage := iloscstron, HBPREVIEW.combo_1.VALUE := page, ::PrevShow(), DoMethod("HBPREVIEW1", "SetFocus") } SEPARATOR ENDIF ... DEFINE WINDOW HBPREVIEW1 ; ... IF iloscstron > 1 _DefineHotKey( "HBPREVIEW1", 0, VK_PRIOR, {|| page := ::CurPage := iif( page == 1, 1, page - 1 ), HBPREVIEW.combo_1.VALUE := page, ::PrevShow() } ) // back _DefineHotKey( "HBPREVIEW1", 0, VK_NEXT, {|| page := ::CurPage := iif( page == iloscstron, page, page + 1 ), HBPREVIEW.combo_1.VALUE := page, ::PrevShow() } ) // next[ _DefineHotKey( "HBPREVIEW1", 0, VK_END, {|| page := ::CurPage := iloscstron, HBPREVIEW.combo_1.VALUE := page, ::PrevShow() } ) // end _DefineHotKey( "HBPREVIEW1", 0, VK_HOME, {|| page := ::CurPage := 1, HBPREVIEW.combo_1.VALUE := page, ::PrevShow() } ) // home _DefineHotKey( "HBPREVIEW1", 0, VK_LEFT, {|| page := ::CurPage := iif( page == 1, 1, page - 1 ), HBPREVIEW.combo_1.VALUE := page, ::PrevShow() } ) // Left // _DefineHotKey( "HBPREVIEW1", 0, VK_UP, {|| page := ::CurPage := iif( page == 1, 1, page - 1 ), HBPREVIEW.combo_1.VALUE := page, ::PrevShow() } ) // up _DefineHotKey( "HBPREVIEW1", 0, VK_RIGHT, {|| page := ::CurPage := iif( page == iloscstron, page, page + 1 ), HBPREVIEW.combo_1.VALUE := page, ::PrevShow() } ) // right // _DefineHotKey( "HBPREVIEW1", 0, VK_DOWN, {|| page := ::CurPage := iif( page == iloscstron, page, page + 1 ), HBPREVIEW.combo_1.VALUE := page, ::PrevShow() } ) // down ENDIF _DefineHotKey( "HBPREVIEW1", 0, VK_UP , {|| SendMessage( GetFormHandle("HBPREVIEW1"), WM_VSCROLL, SB_LINEUP , 0 ) } ) _DefineHotKey( "HBPREVIEW1", 0, VK_DOWN , {|| SendMessage( GetFormHandle("HBPREVIEW1"), WM_VSCROLL, SB_LINEDOWN, 0 ) } ) _DefineHotKey( "HBPREVIEW1", 0, VK_INSERT, {|| scale := scale * 1.25, ::PrevShow() } ) _DefineHotKey( "HBPREVIEW1", 0, VK_DELETE, {|| scale := scale / 1.25, ::PrevShow() } ) ... [/pre2] т.е. 1. фокус на окно отображения листов 2. Insert\Delete - zoom +\- листа 3. стрелки вверх, вниз перемещают строки листа вверх, вниз (PgUp, PgDown перемещают листы, как раньше) Наверно, надо для zoom задействовать еше левую\правую кнопки мыши и scroll на колесико, но не помню как на окно задействовать эти события Может это, вообще, лишнее ? PS. Поправил выше текст, вынес назначения клавиш за ENDIF (выделил цветом и bold) это с учетом 1 листа
gfilatov2002: Как и обещал, выложил финальную сборку 23.01 click here Также обновил Unicode версию библиотеки по старому адресу для Сергея Ваши комментарии приветствуются...
SergKis: gfilatov2002 пишет Также обновил Unicode версию библиотеки по старому адресу для Сергея Спасибо Покрутил еще HbPrinter-Preview, вот что вышло [pre2] METHOD Preview() CLASS HBPrinter ... DEFINE WINDOW HBPREVIEW ; ... END TOOLBAR _DefineHotKey( "HBPREVIEW", 0, VK_UP , {|| SendMessage( GetFormHandle("HBPREVIEW1"), WM_VSCROLL, SB_LINEUP , 0 ) } ) _DefineHotKey( "HBPREVIEW", 0, VK_DOWN , {|| SendMessage( GetFormHandle("HBPREVIEW1"), WM_VSCROLL, SB_LINEDOWN, 0 ) } ) _DefineHotKey( "HBPREVIEW", 0, VK_INSERT, {|| scale := scale * 1.25, ::PrevShow() } ) _DefineHotKey( "HBPREVIEW", 0, VK_DELETE, {|| scale := scale / 1.25, ::PrevShow() } ) AAdd( ahs, { 0, 0, 0, 0, 0, 0, GetFormHandle( "hbpreview" ) } ) ... DEFINE WINDOW HBPREVIEW1 ; WIDTH ahs[ 2, 6 ] - 15 HEIGHT ahs[ 2, 5 ] - ahs[ 3, 5 ] - ahs[ 4, 5 ] - 10 ; VIRTUAL WIDTH ahs[ 2, 6 ] - 5 ; VIRTUAL HEIGHT ahs[ 2, 5 ] - ahs[ 3, 5 ] - ahs[ 4, 5 ] ; TITLE aopisy[ 13 ] SPLITCHILD GRIPPERTEXT ".." _HMG_aFormClickProcedure [ GetFormIndex("HBPREVIEW1") ] := {|| IF _HMG_MouseState == 1 // WM_LBUTTONDOWN scale := scale * 1.25 ::PrevShow() ELSEIF _HMG_MouseState == 2 // WM_RBUTTONDOWN scale := scale / 1.25 ::PrevShow() ELSEIF _HMG_MouseState == 3 // WM_MBUTTONDOWN ENDIF DoMethod("HBPREVIEW", "SetFocus") Return Nil } AAdd( ahs, { 0, 0, 0, 0, 0, 0, GetFormHandle( "hbpreview1" ) } ) ... IF iloscstron > 1 _DefineHotKey( "HBPREVIEW1", 0, VK_PRIOR, {|| page := ::CurPage := iif( page == 1, 1, page - 1 ), HBPREVIEW.combo_1.VALUE := page, ::PrevShow() } ) // back _DefineHotKey( "HBPREVIEW1", 0, VK_NEXT, {|| page := ::CurPage := iif( page == iloscstron, page, page + 1 ), HBPREVIEW.combo_1.VALUE := page, ::PrevShow() } ) // next _DefineHotKey( "HBPREVIEW1", 0, VK_END, {|| page := ::CurPage := iloscstron, HBPREVIEW.combo_1.VALUE := page, ::PrevShow() } ) // end _DefineHotKey( "HBPREVIEW1", 0, VK_HOME, {|| page := ::CurPage := 1, HBPREVIEW.combo_1.VALUE := page, ::PrevShow() } ) // home _DefineHotKey( "HBPREVIEW1", 0, VK_LEFT, {|| page := ::CurPage := iif( page == 1, 1, page - 1 ), HBPREVIEW.combo_1.VALUE := page, ::PrevShow() } ) // Left // _DefineHotKey( "HBPREVIEW1", 0, VK_UP, {|| page := ::CurPage := iif( page == 1, 1, page - 1 ), HBPREVIEW.combo_1.VALUE := page, ::PrevShow() } ) // up _DefineHotKey( "HBPREVIEW1", 0, VK_RIGHT, {|| page := ::CurPage := iif( page == iloscstron, page, page + 1 ), HBPREVIEW.combo_1.VALUE := page, ::PrevShow() } ) // right // _DefineHotKey( "HBPREVIEW1", 0, VK_DOWN, {|| page := ::CurPage := iif( page == iloscstron, page, page + 1 ), HBPREVIEW.combo_1.VALUE := page, ::PrevShow() } ) // down ENDIF _DefineHotKey( "HBPREVIEW1", 0, VK_UP , {|| SendMessage( GetFormHandle("HBPREVIEW1"), WM_VSCROLL, SB_LINEUP , 0 ), DoMethod("HBPREVIEW", "SetFocus") } ) _DefineHotKey( "HBPREVIEW1", 0, VK_DOWN , {|| SendMessage( GetFormHandle("HBPREVIEW1"), WM_VSCROLL, SB_LINEDOWN, 0 ), DoMethod("HBPREVIEW", "SetFocus") } ) _DefineHotKey( "HBPREVIEW1", 0, VK_INSERT, {|| scale := scale * 1.25, ::PrevShow(), DoMethod("HBPREVIEW", "SetFocus") } ) _DefineHotKey( "HBPREVIEW1", 0, VK_DELETE, {|| scale := scale / 1.25, ::PrevShow(), DoMethod("HBPREVIEW", "SetFocus") } ) _HMG_ShowContextMenus := .F. END WINDOW ... [/pre2] Работает как хотелось (кроме прокрутки строк колесом)
gfilatov2002: SergKis пишет: Покрутил еще HbPrinter-Preview Неплохо, но как-то привычнее менять масштаб с помощью серых клавиш +/- вместо Ins/Del. SergKis пишет: кроме прокрутки строк колесом Можно попробовать задействовать такой код в обработчике события окна WM_MOUSEWHEEL [pre2] IF HiWord ( wParam ) == WHEEL_DELTA IF GetScrollPos ( hwnd , SB_VERT ) < 25 SendMessage ( hwnd , WM_VSCROLL , SB_TOP , 0 ) ELSE SendMessage ( hwnd , WM_VSCROLL , SB_PAGEUP , 0 ) ENDIF ELSE IF GetScrollPos ( hwnd , SB_VERT ) >= GetScrollRangeMax ( hwnd , SB_VERT ) - 10 SendMessage ( hwnd , WM_VSCROLL , SB_BOTTOM , 0 ) ELSE SendMessage ( hwnd , WM_VSCROLL , SB_PAGEDOWN , 0 ) ENDIF ENDIF ... [/pre2]
SergKis: gfilatov2002 пишет как-то привычнее менять масштаб с помощью серых клавиш +/- вместо Ins/Del На ноутах нет серых клавиш +/-, а у клиентов их уже больше чем стационарных, но добавить дополнительно можно. задействовать такой код в обработчике события окна WM_MOUSEWHEEL Хотелось что то цивильное, как блок в _HMG_aFormClickProcedure[...], колесико всегда есть на окнах
gfilatov2002: SergKis пишет: добавить дополнительно можно Добавлять ничего не нужно, эти клавиши уже работают. SergKis пишет: колесико всегда есть на окнах Проверил, колесико работает нормально, просто надо предварительно кликнуть внутри дочернего окна
Andrey: А GIF файлы будут работать на окне, если будем использовать его для [pre2] // Start preloding in a separate thread hb_threadDetach( hb_threadStart( HB_THREAD_INHERIT_MEMVARS, @WaitThreadTimer(), aParam ) )[/pre2]
gfilatov2002: Andrey пишет: GIF файлы будут работать на окне Да, проверил на примере из папки SAMPLES\Advanced\Tsb_Export_2 Что изменил: 1) поместил в окно WaitWin_* следующее определение для элемента GIF: [pre2] @ nIRow, nICol ANIGIF Gif_1 OBJ oGif PARENT &cFormName PICTURE "res\loading.gif" WIDTH 100 HEIGHT 100 [/pre2]2) определил глобальную статическую переменную oGif для видимости ее в функции WaitThreadTimerIcon() 3) заменил в функции WaitThreadTimerIcon() вызов [pre2] nStaticNum++ nStaticNum := IIF( nStaticNum > LEN(aStatPictWait), 1, nStaticNum ) DRAW ICON IN WINDOW &cFormName AT nRow, nCol PICTURE hStatPictWait[nStaticNum] ; WIDTH nWH HEIGHT nWH TRANSPARENT[/pre2] на [pre2] iif( ! oGif:IsRunning(), oGif:Play(), )[/pre2]
gfilatov2002: Подготовил 1-й релиз-кандидат новой сборки 23.02, которая планируется к выпуску на следующей неделе... Главное изменение связано с адаптацией библиотеки для работы с компилятором Open Watcom C версии 2.0 (32-bit). Также обновил Харбор до свежей версии: * Updated: Harbour Compiler 3.2.0dev (SVN 2023-02-03 02:46): * Updated libhpdf library to 2.4.3 (from 2.3.0 RC2). Прошу откликнуться всех, кому это интересно
Andrey: gfilatov2002 пишет: Прошу откликнуться всех, кому это интересно Конечно интересно ! С не терпеньем ждем !
Haz: gfilatov2002 пишет: Прошу откликнуться всех, кому это интересно Григорий, очень многим интересно. Многие помнят кардинальную смену курса и дальнейшее развитие неофициальной версии. Так же никто не забыл благодаря кому эта версия сохранила целостность и постоянно совершенствуется Спасибо.
SergKis: gfilatov2002 Предложение по SBrowse ( uAlias, cTitle, bSetUp, aCols, nWidth, nHeight, lSql, lModal, lNumber, lCenter ) - lModal делать (через \ варианты) : "M"\ 1 \ .T. - modal "C" \ 2 \ .F. - child "S" \ 3 - standard - new добавил окно WINDOWTYPE STANDARD и lCenter := .T. \ .F. - центровать окно или нет Пример и правленный исходник (в hbp примера prg не включал, у меня уже в основной либ сделано) тут https://TransFiles.ru/tpta8 для dbf вызов будет такой (modal окно) : SBrowse_Viewer( Alias(), Sys.ClientWidth, Sys.ClientHeight, , .T., {} )
gfilatov2002: SergKis пишет: Предложение по SBrowse Большое спасибо! Принято
SergKis: gfilatov2002 Собрал пример для типов окон "S" и "C" и получил ошибку для "C" при вып. ф-ии my_OnInit_SBrowse(), связанную с командой SET WINDOW THIS TO cWnd что то не срастается по среде This для Child окна, заменил на ф-ю HMG_This_SaveRest(...) (в тексте prg) - все ok! Запуск demo.exe C -> child окна demo.exe или demo.exe S - STANDARD окна Пример тут https://TransFiles.ru/sqagj
gfilatov2002: SergKis пишет: что то не срастается по среде This для Child окна Поправил эту функцию таким образом: FUNCTION my_OnInit_SBrowse(nMode, cWnd) LOCAL oBrw, oTsb, nWnd //, aThis LOCAL cBrw := "oBrw" SET WINDOW THIS TO cWnd //aThis := HMG_This_SaveRest( cWnd ) oBrw := this.(cBrw).Object //GetProperty(cWnd, "oBrw", "Object") oTsb := oBrw:Cargo nWnd := oTsb:nForm ? procname(), nMode, cWnd, nWnd, oTsb, oBrw:cParentWnd, oBrw:cControlName ThisWindow.Row := ThisWindow.Row + oMain:Cargo:aRow[ nMode ] ThisWindow.Col := ThisWindow.Col + oMain:Cargo:aCol[ nMode ] SET WINDOW THIS TO //HMG_This_SaveRest( aThis ) DO EVENTS ; _wPost(nMode + 1, oMain:Name, .T.) RETURN Nil У меня вроде работает нормально...
SergKis: gfilatov2002 пишет У меня вроде работает нормально... У меня тоже работает, но это не радует, т.к. порушились (для Child) правила This ... для окна (для STANDARD все ok!) This. ... ThisWindow. ... одно и тоже This.oBrw.Object ___^^^^ - имя контрола такое правописание позволяет сокращать текст и делать его более читаемым С ф-ей HMG_This_SaveRest() это все работает, ф-ю я взял из своей версии, т.к. применение ее парное, надо, наверное, подумать над командой с этой ф-ией SET WINDOW THIS SAVE aThis TO cWnd ... SET WINDOW THIS REST aThis TO для лучшей читаемости
gfilatov2002: SergKis пишет: This.oBrw.Object ___^^^^ - имя контрола Проверил запись в виде SET WINDOW THIS TO cWnd oBrw := this.oBrw.Object //GetProperty(cWnd, "oBrw", "Object") Она работает для дочернего окна тоже
SergKis: gfilatov2002 пишет Она работает для дочернего окна тоже но не работает This.Row, This.Col. Перебирать при переносе текст, та еще радость будет Сделал [pre2] #xcommand SET WINDOW THIS SAVE <a> TO <w> => <a> := HMG_This_SaveRest( <w> ) #xcommand SET WINDOW THIS REST <a> TO => HMG_This_SaveRest( <a> ) и код работает для "C" и "S" окон SET WINDOW THIS SAVE aThis TO cWnd oBrw := This.oBrw.Object //GetProperty(cWnd, "oBrw", "Object") oTsb := oBrw:Cargo nWnd := oTsb:nForm ? procname(), nMode, cWnd, nWnd, oTsb, oBrw:cParentWnd, oBrw:cControlName This.Row := This.Row + oMain:Cargo:aRow[ nMode ] This.Col := This.Col + oMain:Cargo:aCol[ nMode ] SET WINDOW THIS REST aThis TO [/pre2] PS Может лучше #xcommand SET WINDOW THIS <w> SAVE <a> => <a> := HMG_This_SaveRest( <w> ) #xcommand SET WINDOW THIS REST <a> => HMG_This_SaveRest( <a> )
gfilatov2002: SergKis пишет: не работает This.Row, This.Col Поправил в функции _SetThisFormInfo() этот фрагмент IF HB_ISCHAR( i ) i := GetFormIndex( i ) lDefine := ( _HMG_aFormType [ i ] == "C" ) и все заработало
SergKis: gfilatov2002 пишет и все заработало Да, с такой правкой работает как надо
SergKis: gfilatov2002 Довел пример с исп. SBrowse до какой то кондиции: https://TransFiles.ru/ottjz - смена типа окон S\C и немного управления - смена вида курсора - подсветка одинаковых ключей (группы) в просмотре
gfilatov2002: SergKis пишет: Довел пример с исп. SBrowse СПАСИБО
Andrey: SergKis пишет: Довел пример с исп. SBrowse до какой то кондиции: Не до конца работает пример Не работают кнопки Печать и Эксель. Как их заставить работать ?
sashaBG: Привет всем! Я решил использовать фильтра oBrw:FilterFTS( cSeek, .t. ) вместе с сервером LetoDB . Все работает, но заметил, что в логе сервера постоянно возникают вот такие строчки: 14.02.2023 12:06:30: Error BASE/1003 Variable does not exist: OB !WARNING! leto_Filter! filter not optimized or syntax error: ob:FilterFTS_Line( cFind, lUpper, lAll, ob) Становится понятно, что фильтр не оптимизирован для LEtoDB, и что LetoDB не видит переменную ob Можно ли ето както избежать?
SergKis: sashaBG пишет LetoDB не видит переменную ob По мне надо сделать 1. ф-ю на сервере, аналог методу METHOD FilterFTS_Line( cFind, lUpper, lAll ) CLASS TSBrowse которая построчно выполняет то, что надо для возврата .T.\.F. и вызывать ее в выражении :FilterData( cFilter ), переменных с клиента на сторону сервера не передавать, т.е. сделать FUNCTION UDF_FilterFTS_Line (...) ... RETURN lRet 2. Переписать на клиента в mem:File (или на диск) поля ключи для Relation на осн. базу (тут тоже можно ограничить выборку условием) и связав по Relatiion, ставим :FilterFTS(...) поля по связанному alias будут тащится на клиента, а сам :FilterFTS() применяется к базе на клиенте (TsBrowse на отобранную на клиента базу работает). По идее должно быть ok! В LetoDbF есть механизм передачи переменных и их значения на сторону сервера, но объекты (ссылка), думаю не передадуться тоже
SergKis: PS SergKis пишет Переписать на клиента в mem:File (или на диск) поля ключи для Relation на осн. базу Забыл, что LetoDb (в отличии от LetoDbF) не имеет механизма SET RELATION ..., потому кроме ключевых и др. полей для локальной индикации, надо сохранять в выборке RecNo() записи на сервере и тогда исп. механизм TsBrowse блок кода oBrw:bOnDrawLine где делать переход на запись сервера, т.е. что то типа oBrw:bOnDrawLine := {|ob,nrow| nrow := (ob:cAlias)->REC_NO, ("ALS_SERVERA")->( dbGoto(nrow) ) } 3. Сделать выборку полностью на сервере ф-ей сервера, написав ее (автономный аналог :FilerFTS(...) или только для этого запроса). Выполнением этой ф-ии на сервере должен быть рез. файл, который можно показывать на клиенте открыв TsBrowse. Из за отсутсвия механизма Relation я перешел на LetoDbF - переход оч. простой получается - код почти не отличается от clipper. Т.к. осн. сервером исторически остался LetoDb (создание, модификация, ...), причем еще старый 2-х поточный, то LetoDbF пошел дополнением к LetoDb. Т.е. оба запущены одновременно (как daemon, а не сервисы), запускаются менеджером (простым на AutoIt 3 давно написанным) и менеджеры следят за наличием программ LetoDb и LetoDbf в памяти. Обе сборки серверов свои и в LetoDbf сделаны изменения по ini и log файлам, их названия LetoDbF.ini и LetoDbF.log. Тогда оба сервера лежат рядом и не конфликтуют по именам файлов. В ini для серверов исп. Share_Tables = 1 и разные порты
sashaBG: Спасибо за ответ Сергей! Попытаюсь написать функцию со стороны сервера, как вы рекомендовали. Если будут вопросы буду задавать :) Я еще не пробовал LetoDBf. Надо найти время попробовать! А он наверное лучше, раз вы на нем перешли! Всего доброго Всем!
SergKis: sashaBG Вот код, как есть, по выборке (за период, клиенты, объекты, ...) событий (охрана) с сервера, показываем ее, связывая со спр. объектов на сервере [pre2] * ----------------------------------------------------------------------------------- * STATIC FUNCTION wSelectEvent( cFile, oBuf ) * ----------------------------------------------------------------------------------- * LOCAL cForm := 'wListSel', i, t, o := Sys.Cargo, ot := o:oBaseText LOCAL cBrw := "oListSel", aHead, aSize, aPict, aAlign, aField, aFoot, aName LOCAL cTitl := " ", cTag LOCAL oBrw, aFont, oCol, nY, nX, nW, nH, nI, nN := 2 LOCAL cAlias := "SELGGMM" LOCAL nArea := Select() LOCAL cAlsO := "OBJ" LOCAL cObj := o:HBK+"obj" LOCAL cPeri := oBuf:cPer LOCAL cCapt := upper(ot:cSele) + CRLF + ot:cPer+": " + cPeri LOCAL lExclude := oBuf:lExclude LOCAL lRowId := Empty(oBuf:lRowID) LOCAL oColor := oKeyData() LOCAL nMaxObj, cMaxEvent, cMaxName, cMaxAdres, cMaxOwner, cTmp, nTmp, cVal IF !Empty(oBuf:cTim) ; cCapt += space(7) + ot:cTime + ": " + oBuf:cTim ENDIF IF ! m_DbUse(cObj, cAlsO, .T.) MsgStop("File not used !"+CRLF+cObj+".dbf", "ERROR") RETURN Nil ENDIF OrdSetFocus("KOD") GO TOP IF ! mDbUse(cFile, cAlias, .T., "DBFCDX") (cAlsO)->( dbCloseArea() ) //MsgStop("File not used !"+CRLF+cFile+".dbf", "ERROR") RETURN Nil ENDIF INDEX ON OBJECTNUM+R_DTM TAG KOD FOR Empty( R_EXC ) INDEX ON OBJECTNUM+R_DTM TAG EXCL FOR !Empty( R_EXC ) IF lExclude INDEX ON OBJECTNUM TAG OBJ FOR !Empty( R_EXC ) UNIQUE ELSE INDEX ON OBJECTNUM TAG OBJ FOR Empty( R_EXC ) UNIQUE ENDIF OrdSetFocus("OBJ") GO TOP nMaxObj := OrdKeyCount() ; i := 0 DO WHILE !EOF() ; oColor:Set( OBJECTNUM, int(i % 2) ) ; i++ ; SKIP ENDDO GO TOP cTag := iif( lExclude, "EXCL", "KOD" ) // OrdSetFocus(cTag) SET RELATION TO OBJECTNUM INTO &cAlsO GO TOP // посчитаем строки с max длиной cMaxEvent := cMaxName := cMaxAdres := cMaxOwner := "" /* DO WHILE !EOF() cTmp := Trim(EVENT) IF Len(cTmp) > Len(cMaxEvent) ; cMaxEvent := cTmp ENDIF cTmp := Trim( (cAlsO)->NAME ) IF Len(cTmp) > Len(cMaxName) ; cMaxName := cTmp ENDIF cTmp := Trim( (cAlsO)->OWNER ) IF Len(cTmp) > Len(cMaxOwner) ; cMaxOwner := cTmp ENDIF cTmp := Trim( (cAlsO)->ADDRESS ) IF Len(cTmp) > Len(cMaxAdres) ; cMaxAdres := cTmp ENDIF SKIP ENDDO GO TOP */ aFont := {"Normal", "FontBold", "FontBold", "FontBold"} aFoot := .T. DEFINE WINDOW &cForm ; TITLE cTitl ; MDICHILD FOCUSED NOMINIMIZE ; ON INIT NIL ; ON RELEASE ( (cAlias)->( dbCloseArea() ), ; (cAlsO)->( dbCloseArea() ), ; dbSelectArea(nArea), ; oMain:Enabled("BtnExcel", .F.), DoEvents() ) nY := nX := 0 nW := This.ClientWidth nH := This.ClientHeight (This.Object):Cargo:oBuf := oBuf (This.Object):Cargo:oBuf:cAlsObj := cAlsO DEFINE TBROWSE &cBrw OBJ oBrw AT nY,nX WIDTH nW HEIGHT nH CELL ; HEADERS aHead ; COLSIZES aSize ; PICTURE aPict ; ALIAS cAlias ; ENUMERATOR NIL ; JUSTIFY aAlign ; TRANSPARENT NIL ; SELECTOR NIL ; COLUMNS aField ; COLNAMES aName ; FOOTERS aFoot ; COLNUMBER { 1, 90 } ; COLEDIT NIL ; WHEN NIL ; VALUE NIL ; FONT aFont ; TOOLTIP NIL ; BACKCOLOR NIL ; FONTCOLOR NIL ; COLORS NIL ; ON GOTFOCUS NIL ; ON CHANGE NIL ; ON LOSTFOCUS NIL ; ON DBLCLICK NIL ; STYLE NIL ; ON HEADCLICK NIL ; FIXED COLSEMPTY GOTFOCUSSELECT LOCK ; BRUSH NIL ; LOADFIELDS ; ON INIT {|ob| ob:lNoHScroll := .F. } :DelColumn("DATETIME" ) ; :DelColumn("COLOR") ; :DelColumn("R_OWN") ; :DelColumn("R_EXC") :MoveColumn( :nColumn("R_DTM"), 3 ) :MoveColumn( :nColumn("EVENT"), 4 ) IF lRowId ; :DelColumn("ROWID") ENDIF :Cargo:nClr6_1 := -CLR_HRED // #define CLR_FOCUSB 6 1 // focused back :Cargo:nClr6_2 := -CLR_HBLUE // #define CLR_FOCUSB 6 2 // focused back :Cargo:nClr12_1 := -CLR_HBLUE // #define CLR_SELEB 12 1 // focused inactive (or selected) back :Cargo:nClr12_2 := -RGB(128,225,225) // #define CLR_SELEB 12 2 // focused inactive (or selected) back aField := {"OWNER"} //"NAME", "ADDRESS", , "PHONE", "PWD", "GRP1ROWID", "GRP2ROWID", "GRP3ROWID", "STATUS"} aName := {"OWNER"} //"NAME", "ADDRESS", , "PHONE", "PWD", "GRP1" , "GRP2" , "GRP3" , "STATUS"} aHead := {"OWNER"} //"NAME", "ADDRESS", , "PHONE", "PWD", "GRP1" , "GRP2" , "GRP3" , "STATUS"} FOR nI := 1 TO Len(aField) ADD COLUMN TO oBrw DATA FieldWBlock(aField[ nI ], select(cAlsO)) ; HEADER aHead[ nI ] FOOTER "" FIXED NAME &(aName[ nI ]) NEXT :SetColor( { 6}, { {|c,n,b| c := b:Cargo, iif( b:nCell == n, c:nClr6_1 , c:nClr6_2 ) } } ) // 6 , фона курсора :SetColor( {11}, { GetSysColor( COLOR_WINDOWTEXT ) } ) // 11, текста неактивного курсора :SetColor( {12}, { {|c,n,b| c := b:Cargo, iif( b:nCell == n, c:nClr12_1, c:nClr12_2 ) } } ) // 12, фона неактивного курсора oMain:Cargo:oBrw := oBrw This.Cargo:oBrw := oBrw This.Cargo:aOrder := {} :aBitMaps := { LoadImage("USS_32") } oCol := :GetColumn("ORDKEYNO") ; oCol:cPicture := "999 999 999" oCol:cFooting := {|nc,ob| nc := (ob:cAlias)->(OrdKeyCount()), iif( Empty(nc), '', Transform(nc, "999 999 999") ) } oCol:bDecode := {|cn| Val(cn) } oCol := :GetColumn("R_DTM") ; oCol:nAlign := DT_CENTER oCol:cPicture := "@R 9999-99-99 99:99:99" oCol:nWidth := oCol:ToWidth(subs(oCol:cPicture, 2)) oCol:bDecode := {|cd| Gmt2Utc(cd, .F., .T.) } oCol:cHeading := StrTran(ot:cDtms, "\", CRLF) oCol := :GetColumn("EVENT") ; oCol:cHeading := ot:cEvnt oCol:nWidth := oCol:ToWidth(45) //nI := int( oCol:ToWidth(cMaxEvent) / 2 ) + 20 //IF nI < oCol:nWidth ; oCol:nWidth := nI //ENDIF oCol := :GetColumn("OBJECTNUM"); oCol:cHeading := ot:cObj oCol:nFAlign := DT_CENTER oCol:cFooting := hb_ntos(nMaxObj) oCol:oCargo:nMaxObj := nMaxObj oCol:oCargo:oColor := oColor oCol:oCargo:lColor := nMaxObj > 1 oCol:oCargo:aColor := { GetSysColor( COLOR_BTNFACE ) } // { CLR_HGRAY } oCol:bDrawCell := {|obrw,ocel,ocol| Local o := ocol:oCargo, nClr, nTo, cKod, nElm IF o:lColor nClr := ocel:nClrBack nTo := ocel:nClrTo cKod := ocel:uValue nElm := o:oColor:Get(cKod, 0) ocel:nClrBack := iif( nElm > 0, o:aColor[ nElm ], nClr ) ocel:nClrTo := iif( nElm > 0, o:aColor[ nElm ], nTo ) ENDIF Return Nil } oCol := :GetColumn("OBJECTNAM"); oCol:nWidth := oCol:ToWidth(40) oCol:cHeading := ot:cName //nI := int( oCol:ToWidth(cMaxName ) / 2 ) + 20 //IF nI < oCol:nWidth ; oCol:nWidth := nI //ENDIF oCol := :GetColumn("OBJECTADR"); oCol:nWidth := oCol:ToWidth(40) oCol:cHeading := ot:cAddr //nI := int( oCol:ToWidth(cMaxAdres) / 2 ) + 20 //IF nI < oCol:nWidth ; oCol:nWidth := nI //ENDIF oCol := :GetColumn("OWNER") ; oCol:nWidth := oCol:ToWidth(35) oCol:cHeading := ot:cCust //nI := int( oCol:ToWidth(cMaxOwner) / 2 ) + 20 //IF nI < oCol:nWidth ; oCol:nWidth := nI //ENDIF nTmp := Max( :nHeightHead, 32 ) ADD SUPER HEADER TO oBrw FROM 1 TO :nColCount() TITLE cCapt HEIGHT nTmp COLOR CLR_BLUE FONT "FontBold" :aSuperHead[1][8] := :aBitMaps[1] //BITMAP "USS_24" //ADD SUPER HEADER TO oBrw FROM 1 TO 2 TITLE cPeri HEIGHT :nHeightHead COLOR CLR_BLUE FONT "FontBold" //ADD SUPER HEADER TO oBrw FROM 3 TO :nColCount() TITLE cCapt HEIGHT :nHeightHead COLOR CLR_BLUE FONT "FontBold" :nHeightCell += 2 ; :nFreeze := 2 + iif( lRowId, 0, 1 ) ; :nCell := :nFreeze + 1 END TBROWSE ON END {|ob| ob:SetNoHoles(), ob:SetFocus(), ob:Refresh() } ON KEY F1 ACTION NIL ON KEY ESCAPE ACTION ThisWindow.Release oMain:Cargo:cFocused := This.Name oMain:Cargo:oFocused := This.Object oMain:Enabled("BtnExcel", .T.) (This.Object):Event( 4, {|ow,ky,nMnu| LOCAL oBrw := ow:Cargo:oBrw LOCAL cBtn := "BtnExcel" LOCAL oCol, cFoot oMain:Enabled(cBtn, .F.) ; DO EVENTS oMain:StatusBar:Say(ot:cWait, 1) oBrw:Enabled(.F.) ; DO EVENTS IF nMnu == 1 ToExcel_1(oBrw) ELSEIF nMnu == 2 oCol := oBrw:GetColumn("OBJECTNUM") cFoot := oCol:cFooting oCol:cFooting := " " ToExcel_2(oBrw) oCol:cFooting := cFoot ELSEIF nMnu == 3 ToExcel_3(oBrw) ENDIF oMain:Enabled(cBtn, .T.) ; DO EVENTS oMain:StatusBar:Say("", 1) oBrw:Enabled(.T.) ; DO EVENTS Return Nil } ) END WINDOW RETURN Nil цветом выделены строки для работы с сервером [/pre2] код не отличается от обычной локальной работы. Есть одно правило SetRddDefault("LETO"), локальные как "DBFCDX", т.е.[pre2] IF ! mDbUse(cFile, cAlias, .T., "DBFCDX") (cAlsO)->( dbCloseArea() ) //MsgStop("File not used !"+CRLF+cFile+".dbf", "ERROR") RETURN Nil ENDIF [/pre2]
Andrey: SergKis пишет: Довел пример с исп. SBrowse до какой то кондиции: Пример ОЧЕНЬ классный... Чуток бы цвета исправить...
SergKis: Andrey пишет Чуток бы цвета исправить... Посмотри строки [pre2] oTsb:bBefore := {|obrw| // before END TSBROWSE Local oCol, oTsb oTsb := obrw:Cargo oCol := obrw:GetColumn("KOD") oCol:Cargo := oHmgData() oCol:Cargo:oColor := oTsb:oKod // keys unique oCol:Cargo:lColor := Len(obrw:aArray) > 1 oCol:Cargo:nColor := GetSysColor( COLOR_BTNFACE ) // Test_Window_2() исп. CLR_HGRAY oCol:bDrawCell := oTsb:bKodCell Return Nil } и в этих строках исп. obrw:SetColor(...) никто не мешает (я использовал по минимуму для курсора, см. Test_Window_2() ) oTsb:bAfter := {|obrw| // after END TSBROWSE Local oTsb, cWnd, nWnd, cTmp, lMsg, nMode, cMain oTsb := obrw:Cargo cWnd := obrw:cParentWnd nWnd := oTsb:nForm lMsg := oTsb:lPostMsg nMode := oTsb:nMode cMain := oMain:Name oMain:Cargo:aForm[ nMode ] := cWnd // ... obrw:AdjColumns() obrw:Refresh(.T.) SetProperty( cWnd, "Topmost", .F. ) IF lMsg cTmp := 'my_OnInit_SBrowse(' + hb_ntos(nMode) + ', "'+cWnd+'")' SetProperty( cWnd, "ONINIT", hb_MacroBlock(cTmp) ) ENDIF DO EVENTS Return Nil } [/pre2] блоки кода oTsb:bAfter := {|obrw| // after END TSBROWSE oTsb:bBefore := {|obrw| // before END TSBROWSE они твои, на выполнение подключаются как написано, уточнить можешь в SBrowse_Viewer(...) В блоке кода oTsb:bBefore не все колонки, только реальные, объявленные В блоке кода oTsb:bAfter уже все колонки SLECTOR и ORDKEYNO или ARRAYNO это надо помнить при написании PS. Дополнить код SBrowse_Viewer(...) предложениями\решениями - я только ЗА
Andrey: Григорий ! В примере SergKis пишет: Довел пример с исп. SBrowse до какой то кондиции: Не работают кнопки Печать и Эксель. Там же стандартный вызов [pre2]SBrowse( uAlias, {oTsb:cTitle, oTsb}, oTsb:bSetUp, , nW, nH, , oTsb:lModal, oTsb:lNumber, oTsb:lCenter )[/pre2] Работать должно сразу или нет ?
SergKis: gfilatov2002 Посмотрел примеры Tsb_Export, Tsb_Export_2. Все режимы с Excel ole у меня падают. Подключил к примеру hbxlsxml.lib - работает Пример https://TransFiles.ru/ag8zw
SergKis: gfilatov2002 Небольшая добавка [pre2] METHOD GotoRec( nRec, nRowPos ) CLASS TSBrowse ... SysRefresh() ELSEIF ::lIsArr hb_default( @nRowPos, ::nRowPos ) ::Gotop() ::Skip( nRec - 1 ) ::nRowPos := nRowPos ::Refresh() SysRefresh() ENDIF ... [/pre2]
gfilatov2002: SergKis пишет: Небольшая добавка Благодарю за предложение! Попробовал эту добавку в примере из папки samples\Advanced\Tsb_array_3 (повесил на клавишу F2 переход на конкретную позицию в массиве, например на 50-ю строку). Но результат перехода получился неудовлетворительным: блокируется движение вверх по клавише <стрелка вверх>, а также происходит в некоторых случаях "залипание" последней строки.
SergKis: gfilatov2002 Получился такой вариант (вроде не глючит у меня) [pre2] ELSEIF ::lIsArr hb_default( @nRowPos, ::nRowPos ) IF nRec > ::nLen nRec := ::nLen ENDIF IF nRec == ::nLen ::GoBottom() ELSE ::GoPos( nRec ) ::nAt := nRec ::nRowPos := iif( nRowPos > ::nRowCount(), ::nRowCount(), nRowPos ) ::lHitTop := ::lHitBottom := .F. ENDIF ::Refresh( ::nRowCount() < ::nLen ) IF ::bChange != NIL Eval( ::bChange, Self, 0 ) ENDIF SysRefresh() ENDIF [/pre2]
SergKis: gfilatov2002 Не знаю, что рыть, с ole не работал никогда, но это примеры hmg выдают Tsb_Export и Tsb_Export_2. Offis\Excel 2016 раньше было Ok! Логи ошибок тут https://TransFiles.ru/mnoow
Haz: SergKis пишет: Не знаю, что рыть, с ole не работал никогда, но это примеры hmg выдают Tsb_Export и Tsb_Export_2. Offis\Excel 2016 раньше было Ok! Если актуально будет после обеда посмотрю. Работа с оле всегда непредсказуемая. А Что автор примеров на эту тему думает?
gfilatov2002: Как и обещал, выложил финальную сборку 23.02 click here Также обновил Unicode версию библиотеки по старому адресу для Сергея
SergKis: Haz пишет Если актуально будет после обеда посмотрю. Не могу сказать об актуальности, но не так давно, на этой же PC все работало, валится у меня одного или у кого то еще ? У меня исп. hbxlsxml.lib для форм. xml\xls и libXL для чтения данных. С xml Excel работает, с libXL тоже.
Haz: SergKis пишет: валится у меня одного или у кого то еще Запустил Tsb_Export все работает, никаких ошибок тоже Excel 2016. Правда с уже успел обновиться на сборку 23.02 Не пойму куда смотреть
Andrey: Haz пишет: Не пойму куда смотреть Пример ниже который свалиться если нажать на кнопке Эксель... SergKis пишет: Довел пример с исп. SBrowse до какой то кондиции: https://TransFiles.ru/ottjz - смена типа окон S\C и немного управления - смена вида курсора - подсветка одинаковых ключей (группы) в просмотре Мои предположения - если 1 поле в бровсе логическое, то при вызове Эксель - оля падает...
SergKis: Andrey пишет если 1 поле в бровсе логическое, то при вызове Эксель - оля падает... Всегда делаю так aYesNo := {"Yes", "No"} всегда можно параметром или еще как поменять aYesNo := {"Да", "Нет"} aYesNo := {"М", "Ж"} aYesNo := {"Открыто", "Закрыто"} ... для лог. колонки меняю .T. - aYesNo[1], .F. - aYesNo[2], самый простой вариант cValToChsr(...)
SergKis: Haz пишет Запустил Tsb_Export все работает, никаких ошибок тоже Excel 2016. Правда с уже успел обновиться на сборку 23.02 Не пойму куда смотреть Игорь, никуда не смотри, на обновленной версии у меня так же валится Буду считать, что крякнулся Excel у меня, с Word работает Ok!
Haz: Andrey пишет: Пример ниже который свалиться если нажать на кнопке Эксель... Проблема не в примере , проблема в h_tbrowse.prg. Достаточно в demo.hbp добавить строку [pre2] # Keys compile #-prgflag=-w0 -es1 -prgflag=-w2 -es1 # Enable multi/single-thread Harbour VM -mt # Incremental-compilation mode -inc # folder where are all * .obj -workdir=OBJ # Name EXE-module -odemo # to list all * .prg demo.prg h_tbrowse.prg # paths to the main and extension *.Lib -lminigui #-lhbmemio [/pre2] Все становится видно.
Haz: Haz пишет: Проблема не в примере , проблема в h_tbrowse.prg. Достаточно в demo.hbp добавить строку в исходниках метода METHOD ExcelOle() есть строки [pre2] IF ::lDrawSuperHd FOR nCol := 1 TO Len( ::aSuperHead ) nVar := iif( lSelector, 1, 0 ) uData := iif( ValType( ::aSuperhead[ nCol, 3 ] ) == "B", Eval( ::aSuperhead[ nCol, 3 ] ), ; ::aSuperhead[ nCol, 3 ] ) oSheet:Cells( nLine, ::aSuperHead[ nCol, 1 ] - nVar ):Value := uData cRange := HeadXls( ::aSuperHead[ nCol, 1 ] - nVar ) + LTrim( Str( nLine ) ) + ":" + ; HeadXls( ::aSuperHead[ nCol, 2 ] - nVar ) + LTrim( Str( nLine ) ) oSheet:Range( cRange ):Borders():LineStyle := xlContinuous oSheet:Range( cRange ):HorizontalAlignment := xlHAlignCenterAcrossSelection oRange := oSheet:Range( cRange ) IF hFont != NIL aFont := GetFontParam( hFont ) oRange:Font:Name := aFont[ 1 ] oRange:Font:Size := aFont[ 2 ] oRange:Font:Bold := aFont[ 3 ] ENDIF NEXT nStart := nLine++ ENDIF [/pre2] вот тут и идет обращение к oSheet:Cells() где номер колонки равен 0 из за этого ОЛЕ и валится как быстрая правка вместо nVar := iif( lSelector, 1, 0 ) сделать nVar := 0 тогда все работает корректно. Ну а дальше разбираться с ::lSelector ( осознанием его практической бесполезности ) и правкой метода.
SergKis: gfilatov2002 Небольшая правка, чтобы не растягивалась колонка SELECTOR [pre2] METHOD AdjColumns( aColumns, nDelta ) CLASS TSBrowse ... FOR i := 1 TO k c := aVisible[ i ] IF i == 1 .and. ::lSelector LOOP ELSEIF i == k ::aColumns[ c ]:nWidth += ( w - s ) ELSE s += n ::aColumns[ c ]:nWidth += n ENDIF NEXT ... [/pre2]
gfilatov2002: SergKis пишет: Небольшая правка, чтобы не растягивалась колонка SELECTOR OK Для метода :GotoRec() добавил такую правку: [pre2] ELSEIF ::lIsArr hb_default( @nRowPos, ::nRowPos ) IF nRec > ::nLen nRec := ::nLen ENDIF IF nRec == ::nLen ::GoBottom() ELSEIF nRec == 1 ::GoTop() ELSE ::GoPos( nRec ) ::nAt := nRec ::nRowPos := iif( nRowPos > ::nRowCount(), ::nRowCount(), nRowPos ) ::lHitTop := ::lHitBottom := .F. ENDIF ::Refresh( ::nRowCount() < ::nLen ) IF ::bChange != NIL Eval( ::bChange, Self, 0 ) ENDIF SysRefresh() ENDIF ... [/pre2]
SergKis: Haz Сделал [pre2] FOR nCol := 1 TO Len( ::aSuperHead ) nVar := 0 //nVar := iif( lSelector, 1, 0 ) попал в др. место ниже cTmp := "#0" ; nTmp := 0 IF "." $ uData //IF ( nTmp := At( ".", uData ) ) > 0 cTmp := "#,##0.00" // cTmp := Replicate( "#", nTmp - 2 ) + '0,' + Replicate( "0", Len( uData ) - nTmp ) ENDIF [/pre2] Выделенное красным валит с сообщением Error WINOLE/1006 Unable to set the NumberFormat property of the Range class (0x800A03EC): Microsoft Excel (DOS Error -2147352567) Args: [1] = C #0.00 Called from TSBROWSE:EXCELOLE(6639) ...
Haz: SergKis пишет: Выделенное красным валит с сообщением Сергей , валит скорее всего ниже красного, на этом oSheet:Cells( nLine, nCol ):NumberFormat := cTmp Посмотри что в шаблоне . Сообщение об ошибке говорит [pre2] Error WINOLE/1006 Unable to set the NumberFormat property of the Range class (0x800A03EC): Microsoft Excel (DOS Error -2147352567) Args: [1] = C #0.00 [/pre2] точно такой код как ниже ? Не должно быть ошибки , ошибка говорит что cTmp = "#0.00" [pre2] IF "." $ uData cTmp := "#,##0.00" ENDIF [/pre2]
SergKis: Haz пишет валит скорее всего ниже красного, на этом oSheet:Cells( nLine, nCol ):NumberFormat := cTmp Это понятно, указывает номер строки в тексте ошибки, я говорил, что пытается стать формат "#0" или "#,##0.00" оба формата допустимы, как и "#0.00", с xml эти форматы проходят. Может в ячейке какая фигня и на нее ставится NumberFormat ? Для меня темный лес По поводу Selector, он удаляется в начале работы потом восстанавливается
Andrey: Haz пишет: Проблема не в примере , проблема в h_tbrowse.prg. Достаточно в demo.hbp добавить строку Да точно ! Проблема в том что не указана библиотека ! Достаточно в demo.hbp добавить библиотеку [pre2]# paths to the main and extension *.Lib -lminigui -ltsbrowse[/pre2] h_tbrowse.prg добавлять в проект не надо ! А можно как то проверять что нет оли для SBrowse() ? А то проект нормально собираются а функции SBrowse не работают.
Dima: Haz пишет: IF "." $ uData cTmp := "#,##0.00" ENDIF Так видать не совсем корректно и нужно считывать символ разделителя. У меня так NumberFormat:="# ##0"+razdels+"00" Где razdels:=GET_SDECIMAL() А лучше так [pre2] **************************** Func GetActualSeparator(Oxl) return If(Oxl:UseSystemSeparators,{GET_STHOUSAND(),GET_SDECIMAL()},{Oxl:ThousandsSeparator,Oxl:DecimalSeparator}) [/pre2] PS GET_SDECIMAL() есть на форуме
SergKis: Dima пишет GET_SDECIMAL() есть на форуме Использую у себя. У меня дает ",", в коде тоже стоит '0,' cTmp := Replicate( "#", nTmp - 2 ) + '0,' + Replicate( "0", Len( uData ) - nTmp ) а не фурычит, вернул изменения назад, не пользовался Ole и нечего начинать
Dima: SergKis Так и пишу ведь что надо вероятно проверять UseSystemSeparators и в зависимости что вернет , юзать или систем сепаратор или сепаратор Excel
SergKis: Dima В xml беру Excel сепаратор без вариантов и хватает. Без ole переживу (надобность была только для примеров, причем еще недавно они работали), в примере выше, кидал архив, замену на кнопку вместо :ExcelOle() кода форм. простого варианта для hbXlsXml.lib, можно менять на :Excel2(). Этого для примеров мне достаточно. Спасибо
Haz: SergKis пишет: Этого для примеров мне достаточно. Спасибо Поддерживаю. ExcelOle() не востребованный метод. Если нужна черновая выгрузка, то она пишется за полчаса один раз. Для отчётов вообще не подходит , тут XML круче. Можно XlsWriter еще пользовать, там функционал впечатляет, но натыкался на проблемы с окном и вернулся на XML
Haz: Andrey пишет: h_tbrowse.prg добавлять в проект не надо ! h_tbrowse.prg добавил чтоб нумерацию строк в ошибку получить и было на чем смотреть не ломая библиотеку
SergKis: gfilatov2002 Правки в Tsb_Sbrowse_3\demo.prg [pre2] FUNCTION SBrowse_Viewer( uTsb, nW, nH, cTitul, lNumber, aFont, lModal, lCenter ) ... DEFAULT oTsb:lEmptyValToChar := .T. IF ! lAlias .and. Empty(oTsb:aArray) MsgStop("SBrowse_Viewer :"+CRLF+CRLF+"Alias or array not defined !", "ERROR") RETURN Nil ENDIF ... ob:nHeightCell += 5 IF hb_IsNumeric(oTsb:nSupHdFore) .and. hb_IsNumeric(oTsb:nSupHdBack) .and. hb_IsNumeric(oTsb:nSupHdHeight) DEFAULT oTsb:cSupHdCapt := GetProperty(ob:cParentWnd, "Title") ADD SUPER HEADER TO ob FROM 1 TO ob:nColCount() TITLE oTsb:cSupHdCapt ; HEIGHT oTsb:nSupHdHeight COLOR oTsb:nSupHdFore,oTsb:nSupHdBack HORZ DT_CENTER ENDIF ... ob:SetColor( {12}, { {|c,n,b| c := b:Cargo, iif( b:nCell == n, c:nClr12_1, c:nClr12_2 )} } ) // CLR_SELEB ENDIF IF nColNo > 0 .and. hb_IsNumeric(oTsb:nSupHdFore) .and. ; hb_IsNumeric(oTsb:nSupHdBack) .and. ; hb_IsNumeric(oTsb:nSupHdHeight) nCol := Len(ob:aColumns) ; nI := Len( ob:aSuperHead ) IF nCol > nI ; ob:aSuperHead[ nI ][2] := nCol ENDIF ENDIF ob:SetNoHoles() ob:SetFocus() ENDIF Return oTsb:lCellBrw } DEFAULT oTsb:bAfter := {|ob| // после END TSBROWSE выполняется Local nW, nL nW := This.oBrw.ClientWidth nL := ob:GetAllColsWidth() - 1 IF nL > nW ob:lAdjColumn := .T. ob:lNoHScroll := .F. ob:lMoreFields := ( ob:nColCount() > 30 ) ELSE ob:AdjColumns() ENDIF ob:Refresh() Return Nil } uAlias := iif( hb_IsChar(uAlias), uAlias, oTsb:aArray ) ... [/pre2]
gfilatov2002: SergKis пишет: Правки в Tsb_Sbrowse_3\demo.prg Поправил Благодарю за помощь
gfilatov2002: Выложил 1-е обновление сборки 23.02 с учетом последних исправлений и дополнений click here Желаю всем мира и добра
Andrey: gfilatov2002 пишет: Выложил 1-е обновление сборки 23.02 с учетом последних исправлений и дополнений Перешёл на него и пришлось откатиться назад. Функция ISDIRECTORY() - перестала правильно определять директории. Если в пути стоит последний знак "\" то новая функция теперь выдаёт .F. Можно это как то исправить ?
gfilatov2002: Andrey пишет: Можно это как то исправить ? Да, я тоже обратил на это внимание. Дело в том, что функция ISDIRECTORY() включена в Харбор только для совместимости с хHarbour (она берется из библиотеки xhb). Исправить это можно, если записать вверху своего модуля такую строку: [pre2]#xtranslate IsDirectory( <c> ) => hb_DirExists( <c> )[/pre2]
SergKis: gfilatov2002 пишет Исправить это можно, если записать вверху своего модуля такую строку: По мне, лучше просканировать prg файлы и заменить все IsDirectory(...) на hb_DirExists(...), меньше головной боли Или вставлять эту строку глобально в minigui.ch или hmg.ch
gfilatov2002: SergKis пишет: лучше просканировать prg файлы и заменить все IsDirectory(...) Не спорю, что так лучше...
Andrey: Есть ли функция определяющая тип время наподобие: hb_IsLogical, hb_IsDate, hb_IsChar ? Что-то не нашёл в i_pseudofunc.ch
полная версия страницы