Форум » 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 пишет Да, идея с новым методом понравилась. Сделаю
полная версия страницы