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

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

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

Ответов - 78, стр: 1 2 3 4 All

SergKis: gfilatov2002 Поправил у себя в TsBrowse[pre2] METHOD SetNoHoles( nDelta, lSet ) CLASS TSBrowse LOCAL nH, nK, nHeight, nHole DEFAULT nDelta := 0, lSet := .T. // nHole := ::nHeight - ::nHeightHead - ::nHeightSuper - ; nHole := _GetClientRect( ::hWnd )[4] - ::nHeightHead - ::nHeightSuper - ; ::nHeightFoot - ::nHeightSpecHd - ; If( ::lNoHScroll, 0, GetHScrollBarHeight() ) ... [/pre2] А то METHOD nHeight() INLINE GetWindowHeight( ::hWnd ) дает не то

gfilatov2002: SergKis пишет: Поправил у себя в TsBrowse METHOD SetNoHoles Благодарю за исправление! Так, конечно, лучше...

SergKis: PS Может зря "завелся" с :nHeight, но не глянулось изменение дырки в тсб после on resize (с изменениями). До on resize была ~2-3 pixel, после убралась из за разницы алгоритмов высоты. Процедура на on resize [pre2] DEFINE WINDOW test ; AT 0,0 WIDTH nWwnd HEIGHT 720 ; MINWIDTH 600 MINHEIGHT 620 ; TITLE "(" + MsgAboutDim(5) + ") " + SHOW_TITLE ; ICON "1MAIN_ICO" ; MAIN TOPMOST ; ON MAXIMIZE ( ResizeForm(oBrw, .T.) ) ; ON SIZE ( ResizeForm(oBrw, .F.) ) ; BACKCOLOR { 93,114,148 } ; ON INIT ( OnInitTest(oBrw,cParam), This.Topmost := .F., oBrw:SetFocus() ) ... * ================================================================================ STATIC FUNCTION ResizeForm( oBrw, lMaximize ) Local nW // ? procname(), lMaximize, '_HMG_MouseState', _HMG_MouseState ResizeTsb( oBrw, lMaximize ) IF _HMG_MouseState == 0 // установим новую ширину PROGRESSBAR nW := This.Button_Exit.Col + This.Button_Exit.Width + 20 This.PBar_1.Width := This.ClientWidth - nW - 20 This.PBar_1.SetFocus oBrw:SetFocus() ENDIF RETURN NIL * ================================================================================ STATIC FUNCTION ResizeTsb( oBrw, lMaximize ) Local nK, nN, nS, nW, nH, nCol, oCol, cBrw STATIC oCargo DEFAULT lMaximize := .F. //? procname(), lMaximize, '_HMG_MouseState', _HMG_MouseState If ISNIL(oCargo) oCargo := oKeyData() oCargo:nHeightSuper := oBrw:nHeightSuper oCargo:nHeightHead := oBrw:nHeightHead oCargo:nHeightSpecHd := oBrw:nHeightSpecHd oCargo:nHeightCell := oBrw:nHeightCell oCargo:nHeightFoot := oBrw:nHeightFoot oCargo:aKfc := array(Len( oBrw:aColumns )) AFill( oCargo:aKfc, 0 ) EndIf IF _HMG_MouseState > 0 .or. lMaximize WITH OBJECT oBrw nW := _GetClientRect( :hWnd )[3] nN := nK := 0 For nCol := 1 To Len( :aColumns ) oCol := :aColumns[ nCol ] oCargo:aKfc[ nCol ] := 0 If nCol == 1 .and. :lSelector; LOOP ElseIf ! oCol:lVisible ; LOOP ElseIf oCol:lBitMap ; LOOP EndIf oCargo:aKfc[ nCol ] := oCol:nWidth / nW If oCargo:aKfc[ nCol ] > nK nN := nCol nK := oCargo:aKfc[ nCol ] Endif Next oCargo:nColMaxKfc := nN END WITH ENDIF IF _HMG_MouseState == 0 //? //? procname(), oCargo:nColMaxKfc, oCargo:aKfc, oBrw:lPainted //AEval(oCargo:aKfc, {|k,i| _LogFile(.T., i, k) }) //? WITH OBJECT oBrw // new size TsBrowse cBrw := :cControlName :lEnabled := .F. This.&(cBrw).Enabled := .F. :Move( :nLeft, :nTop, This.ClientWidth, This.ClientHeight - :nTop, .T. ) // new width columns nW := _GetClientRect( :hWnd )[3] nN := oCargo:nColMaxKfc nS := 0 For nCol := 1 To Len(:aColumns) oCol := :aColumns[ nCol ] If Empty( oCargo:aKfc[ nCol ] ); LOOP EndIf oCol:nWidth := int( oCargo:aKfc[ nCol ] * nW ) nS += oCol:nWidth Next :aColumns[ nN ]:nWidth += ( nW - nS ) // new rows table :nHeightSuper := oCargo:nHeightSuper :nHeightHead := oCargo:nHeightHead :nHeightSpecHd := oCargo:nHeightSpecHd :nHeightCell := oCargo:nHeightCell :nHeightFoot := oCargo:nHeightFoot nH := _GetClientRect( :hWnd )[4] nS := nH - :nHeightHead - :nHeightSuper - ; :nHeightFoot - :nHeightSpecHd - ; iif( :lNoHScroll, 0, GetHScrollBarHeight() ) nS -= ( Int( nS / :nHeightCell ) * :nHeightCell ) nN := If( :nHeightSuper > 0, 1, 0 ) + ; If( :nHeightHead > 0, 1, 0 ) + ; If( :nHeightSpecHd > 0, 1, 0 ) + ; If( :nHeightFoot > 0, 1, 0 ) If nN > 0 nK := int( nS / nN ) If :nHeightFoot > 0 :nHeightFoot += nK nS -= nK EndIf If :nHeightSuper > 0 :nHeightSuper += nK nS -= nK EndIf If :nHeightSpecHd > 0 :nHeightSpecHd += nK nS -= nK EndIf If :nHeightHead > 0 :nHeightHead += nS EndIf EndIf :lEnabled := .T. This.&(cBrw).Enabled := .T. :Paint() // :Refresh(.T.) END WITH ENDIF RETURN NIL ... [/pre2]


Andrey: SergKis пишет: Если хочешь разделить версии leto, переименуй свои rddleto.ch -> rddleto2.ch rddleto.lib -> rddleto2.lib и подключай их То что надо ! Спасибо ! Сделал rddleto_my.ch

Andrey: gfilatov2002 пишет: Два прохода для этого события решают также проблему перерисовки контролов, которая иногда возникает при быстром изменении размеров формы Григорий, а тихое обновление версии 18.11 с учётом последних изменений можно сделать ?

gfilatov2002: Andrey пишет: тихое обновление версии 18.11 с учётом последних изменений можно сделать ? Да, сейчас готовлю update 1 для версии 18.11, который запланирован к выходу на следующей неделе...

SergKis: gfilatov2002 Изменил в TsBrowse :SetNoHoles(...) с учетом исп. в ON SIZE [pre2] CLASS TSBrowse FROM TControl ... DATA aOldParams ... METHOD SetNoHoles( nDelta, lSet ) CLASS TSBrowse LOCAL nH, nK, nHeight, nHole, nCol, oCol, aRect DEFAULT nDelta := 0, lSet := .T. If ISARRAY( ::aOldParams ) .and. Len( ::aOldParams ) > 4 ::nHeightSuper := ::aOldParams[1] ::nHeightHead := ::aOldParams[2] ::nHeightSpecHd := ::aOldParams[3] ::nHeightCell := ::aOldParams[4] ::nHeightFoot := ::aOldParams[5] EndIf nHole := _GetClientRect( ::hWnd )[4] - ; ::nHeightHead - ::nHeightSuper - ; ::nHeightFoot - ::nHeightSpecHd - ; If( ::lNoHScroll, 0, GetHScrollBarHeight() ) nHole -= ( Int( nHole / ::nHeightCell ) * ::nHeightCell ) nHole -= nDelta nHeight := nHole If lSet nH := If( ::nHeightSuper > 0, 1, 0 ) + ; If( ::nHeightHead > 0, 1, 0 ) + ; If( ::nHeightSpecHd > 0, 1, 0 ) + ; If( ::nHeightFoot > 0, 1, 0 ) If nH > 0 nK := int( nHole / nH ) If ::nHeightFoot > 0 ::nHeightFoot += nK nHole -= nK EndIf If ::nHeightSuper > 0 ::nHeightSuper += nK nHole -= nK EndIf If ::nHeightSpecHd > 0 ::nHeightSpecHd += nK nHole -= nK EndIf If ::nHeightHead > 0 ::nHeightHead += nHole EndIf Else SetProperty( ::cParentWnd, ::cControlName, "Height", ; GetProperty( ::cParentWnd, ::cControlName, "Height" ) - nHole ) EndIf If Empty( ::aOldParams ) ::Display() aRect := _GetClientRect( ::hWnd ) ::aOldParams := array(7) ::aOldParams[1] := ::nHeightSuper ::aOldParams[2] := ::nHeightHead ::aOldParams[3] := ::nHeightSpecHd ::aOldParams[4] := ::nHeightCell ::aOldParams[5] := ::nHeightFoot ::aOldParams[6] := { aRect[3], aRect[4] } // client { width, height } ::aOldParams[7] := array(Len( ::aColumns )) For nCol := 1 To Len( ::aColumns ) ::aOldParams[7][ nCol ] := 0 oCol := ::aColumns[ nCol ] If nCol == 1 .and. ::lSelector; LOOP ElseIf oCol:lBitMap ; LOOP EndIf If ! Empty(::aOldParams[6][1]) ::aOldParams[7][ nCol ] := oCol:nWidth / ::aOldParams[6][1] EndIf Next Else If ::lEnabled ::lEnabled := .F. EndIf ::Paint() ::lEnabled := .T. ::Refresh(.F.) EndIf EndIf RETURN nHeight [/pre2] Добавил метод OnResize(...), сейчас он работает "правильно" для тсб со всеми колонками помещающиеся на экран, но предлагаю включить (потом может модифицируем) [pre2] METHOD OnReSize( nWidth, nHeight, lTop ) CLASS TSBrowse LOCAL nCnt, aCol, nCol, oCol, nKfc, lRet := .F. LOCAL nColMaxKfc := 0, nW, nS, nN LOCAL nTop := iif( empty( lTop ), ::nTop, 0 ) IF _HMG_MouseState == 0 .and. ISARRAY( ::aOldParams[7] ) aCol := ::aOldParams[7] nCnt := Min( Len(aCol), Len( ::aColumns ) ) nKfc := 0 lRet := .T. For nCol := 1 To nCnt oCol := ::aColumns[ nCol ] If nCol == 1 .and. ::lSelector; LOOP ElseIf ! oCol:lVisible ; LOOP ElseIf oCol:lBitMap ; LOOP EndIf If aCol[ nCol ] > nKfc nColMaxKfc := nCol nKfc := aCol[ nCol ] Endif Next ::lEnabled := .F. ::Move( ::nLeft, ::nTop, nWidth, nHeight - nTop, .T. ) nW := _GetClientRect( ::hWnd )[3] nN := nS := 0 For nCol := 1 To nCnt oCol := ::aColumns[ nCol ] If nCol == 1 .and. ::lSelector; LOOP ElseIf ! oCol:lVisible ; LOOP ElseIf oCol:lBitMap ; LOOP EndIf nKfc := aCol[ nCol ] oCol:nWidth := int( nKfc * nW ) nS += oCol:nWidth nN := nCol Next nN := iif( nColMaxKfc > 0, nColMaxKfc, nN ) ::aColumns[ nN ]:nWidth += ( nW - nS ) ::lEnabled := .T. ::SetNoHoles() ENDIF Return lRet Применение ... DEFINE WINDOW test ; ... ON MAXIMIZE ResizeForm(oBrw) ; ON SIZE ResizeForm(oBrw) ; ... DEFINE TBROWSE oBrw AT 46+10, 0 ; ... END TBROWSE oBrw:SetNoHoles() // убрать дырку внизу таблицы ... END WINDOW ... STATIC FUNCTION ResizeForm( oBrw ) Local nW oBrw:OnResize( This.ClientWidth, This.ClientHeight ) // сработает 1 раз при _HMG_MouseState == 0 (внутри анализ) IF _HMG_MouseState == 0 // установим новую ширину PROGRESSBAR nW := This.Button_Exit.Col + This.Button_Exit.Width + 20 This.PBar_1.Width := This.ClientWidth - nW - 20 This.PBar_1.SetFocus oBrw:SetFocus() ENDIF RETURN NIL [/pre2]

SergKis: PS Погонял OnResize метод на _HMG_MouseState == 1 и изменение ширины колонки мышой, получилась добавка [pre2] METHOD OnReSize( nWidth, nHeight, lTop ) CLASS TSBrowse LOCAL nCnt, aCol, nCol, oCol, nKfc, lRet := .F. LOCAL nColMaxKfc := 0, nW, nS, nN LOCAL nTop := iif( empty( lTop ), ::nTop, 0 ) IF _HMG_MouseState == 1 aCol := array(Len( ::aColumns )) nW := _GetClientRect( ::hWnd )[3] For nCol := 1 To Len( ::aColumns ) oCol := ::aColumns[ nCol ] aCol[ nCol ] := 0 If nCol == 1 .and. ::lSelector; LOOP ElseIf oCol:lBitMap ; LOOP EndIf aCol[ nCol ] := oCol:nWidth / nW Next ::aOldParams[7] := AClone( aCol ) ELSEIF _HMG_MouseState == 0 .and. ISARRAY( ::aOldParams[7] ) aCol := ::aOldParams[7] ... [/pre2]

SergKis: PPS можно добавить в класс DATA bOnResizeEnter DATA bOnResizeExit и сделать вызовы в OnResize(...) [pre2] ... ::aOldParams[7] := AClone( aCol ) IF ISBLOCK( ::bOnResizeEnter ) EVal( ::bOnResizeEnter, Self ) ENDIF ELSEIF _HMG_MouseState == 0 .and. ISARRAY( ::aOldParams[7] ) aCol := ::aOldParams[7] ... ::lEnabled := .T. IF ISBLOCK( ::bOnResizeExit ) EVal( ::bOnResizeExit, Self ) ENDIF ::SetNoHoles() ENDIF Return lRet [/pre2] возможно закроются хотелки

gfilatov2002: SergKis пишет: возможно закроются хотелки Принято с благодарностью за Вашу помощь

SergKis: gfilatov2002 Может поведение процедуры _HMG_aFormMaximizeProcedure [ i ] сделать одинаковым с процедурой на ON SIZE ?[pre2] //********************************************************************** CASE WM_SIZE //********************************************************************** ... IF _HMG_MainActive == .T. IF wParam == SIZE_MAXIMIZED // _DoWindowEventProcedure ( _HMG_aFormMaximizeProcedure [ i ], i ) If ! Empty( _HMG_aFormMaximizeProcedure [ i ] ) If _HMG_AutoAdjust _DoWindowEventProcedure ( _HMG_aFormMaximizeProcedure [ i ], i ) Else _HMG_MouseState := 1 _DoWindowEventProcedure ( _HMG_aFormMaximizeProcedure [ i ], i ) _HMG_MouseState := 0 _DoWindowEventProcedure ( _HMG_aFormMaximizeProcedure [ i ], i ) EndIf EndIf IF _HMG_AutoAdjust .AND. _HMG_MainClientMDIHandle == 0 _Autoadjust( hWnd ) ENDIF ... [/pre2]

gfilatov2002: SergKis пишет: Может поведение процедуры _HMG_aFormMaximizeProcedure [ i ] сделать одинаковым с процедурой на ON SIZE ? Нет, на мой взгляд, этого не требуется, только усложняется логика обработки

SergKis: gfilatov2002 OK! небольшая правка[pre2] METHOD OnReSize( nWidth, nHeight, lTop ) CLASS TSBrowse LOCAL nCnt, aCol, nCol, oCol, nKfc, lRet := .F. LOCAL nColMaxKfc := 0, nW, nS, nN LOCAL nTop := iif( empty( lTop ), ::nTop, 0 ) IF Empty( nWidth ) nWidth := GetWindowWidth( ::hWnd ) ENDIF IF Empty( nHeight ) nHeight := GetWindowHeight( ::hWnd ) lTop := .T. nTop := 0 ENDIF IF _HMG_MouseState == 1 aCol := array(Len( ::aColumns )) nW := _GetClientRect( ::hWnd )[3] If ! ::lNoVScroll .and. ::nLen > ::nRowCount() nW -= GetVScrollBarWidth() EndIf For nCol := 1 To Len( ::aColumns ) ... ELSEIF _HMG_MouseState == 0 .and. ISARRAY( ::aOldParams[7] ) ... nW := _GetClientRect( ::hWnd )[3] nN := nS := 0 If ! ::lNoVScroll .and. ::nLen > ::nRowCount() nW -= GetVScrollBarWidth() EndIf For nCol := 1 To nCnt ... [/pre2]

gfilatov2002: SergKis пишет: небольшая правка Благодарю за помощь

SergKis: PS Проверяю на Tsb_Basic\demo4.prg Изменения [pre2] ... DEFINE WINDOW Form_0 ; WIDTH 700 ; HEIGHT 600 ; TITLE "(4) TsBrowse DBASE SHARED Demo" ; MAIN ; // NOMAXIMIZE NOSIZE ; ON INIT oBr:SetFocus() ; ON RELEASE dbCloseArea( aAlias[1] ) ; ON MAXIMIZE ResizeForm( oBr ) ; ON SIZE ResizeForm( oBr ) ... Form_0.Activate RETURN FUNC ResizeForm( oBrw ) LOCAL nW := This.ClientWidth LOCAL nH := This.ClientHeight - This.StatusBar.Height oBrw:OnResize( nW - 10, nH - 5 ) RETURN Nil ... FUNCTION CreateBrowse() ... oBrw:nWheelLines := 1 oBrw:nClrLine := COLOR_GRID // цвет линий между ячейками таблицы oBrw:lNoChangeOrd := TRUE // убрать сортировку по полю oBrw:nColOrder := 0 // убрать значок сортировки по полю oBrw:lCellBrw := TRUE // oBrw:lNoVScroll := TRUE // отключить показ горизонтального скролинга oBrw:lNoHScroll := TRUE // отключить показ горизонтального скролинга oBrw:hBrush := CreateSolidBrush( 242, 245, 204 ) // цвет фона под таблицей ... STATIC FUNCTION RecInsert(oBrw) ... oBrw:GotoRec(nRecno, nRow + nPos) If ! oBrw:lNoVScroll .and. oBrw:nLen > oBrw:nRowCount() oBrw:ResetVScroll( .T. ) oBrw:oHScroll:SetRange( 0, 0 ) EndIf oBrw:nCell := 2 // передвинуть МАРКЕР на 2 колонку ... [/pre2] вроде, полет нормальный

SergKis: gfilatov2002 Это изменение, не давал, пропустил [pre2] METHOD SetNoHoles( nDelta, lSet ) CLASS TSBrowse ... If Empty( ::aOldParams ) ::Display() aRect := _GetClientRect( ::hWnd ) If ! ::lNoVScroll .and. ::nLen > ::nRowCount() aRect[3] -= GetVScrollBarWidth() EndIf ::aOldParams := array(7) ... Else If ::lEnabled ::lEnabled := .F. EndIf ::Paint() ::lEnabled := .T. ::Refresh(.F.) If ! ::lNoVScroll .and. ::nLen > ::nRowCount() ::ResetVScroll( .T. ) ::oHScroll:SetRange( 0, 0 ) EndIf EndIf ... [/pre2]

gfilatov2002: SergKis пишет: Это изменение, не давал Спасибо

gfilatov2002: Обновил сборку 18.11 (Update 1) с учетом последних исправлений в TsBrowse Что нового: * Enhanced: The optimized ON SIZE event detects now the mouse state. You can use the variable _HMG_MouseState for accepting of a left mouse button down (=1) or up (=0) state. Suggested and contributed by Sergej Kiselev. Revised by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \Utils\mgDBU) * New: Added the Harbour HbCurl contrib library compiled with the latest Curl and libcurl 32-bit package version 7.62.0 (30 Oct 2018). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added the new method OnReSize( nWidth, nHeight, lTop ); - the improved method SetNoHoles(). Contributed by SergKis (see demo in folder \samples\Advanced\Tsb_Export) * Updated: MySql library source code (see in folder \Source\HbMySql): - added the new method affected_rows() in the class TMySQLQuery. Contributed by Attila Szabo. * Updated: 'Print Pie Graph' sample: the updated data for November 2018. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\GraphPrint) * Updated: 'Internet Explorer ActiveX' sample: - updated the events processing routine for proper 64-bit handling. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\ActiveX) * Updated: 'HMG_HPDF library usage' sample. Based upon a contribution of HMG user Edward. Revised by Grigory Filatov <gfilatov@inbox.ru> (see demo3.prg in folder \samples\Advanced\PDF_PRINT_3)



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