Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить
Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
SergKis: PS Ведь все фонты по DEFINE FONT ... цепляются к _FORMNAME_ 'Main' и там живут
SergKis: PPS Если фонтов нет в списке DEFINE FONT ..., работают С ф-ии _SetFont(...), _SetFontHandle(...), а они не используют базу. По мне, команды удаления фонтов в _EraseControl() не нужны.
SergKis: SergKis пишет По мне, команды удаления фонтов в _EraseControl() не нужны Уточню, если они находятся в секции 'Main' - удалять не нужно.
gfilatov2002: SergKis пишет: Зачем удалять фонт, созданный (сохранен в базе _HMG_aControlType == 'FONT') по DEFINE FONT ... ? Поправил этот фрагмент кода с учетом Вашего предложения: [pre2] *-----------------------------------------------------------------------------* FUNCTION _EraseControl ( i, p ) *-----------------------------------------------------------------------------* LOCAL hWnd LOCAL mVar LOCAL t, x x := _HMG_aControlFontHandle [ i ] IF ISNUMERIC ( x ) .AND. !Empty ( x ) .AND. AScan( _HMG_aControlHandles, x ) == 0 DeleteObject ( x ) ENDIF[/pre2]Благодарю за помощь
gfilatov2002: Подготовил 2-й релиз-кандидат для новой сборки 19.08 со следующим списком изменений: [pre2]* Fixed missed hiding of all controls on a FOCUSED deleted TabPage in the function _DeleteTabPage(). It exists in the official version too. * Added possibility to modify the following Windows events at runtime: - OnInit - OnRelease - OnInteractiveClose - OnGotFocus - OnLostFocus - OnNotifyClick - OnMouseclick - OnMouseDrag - OnMouseMove - OnMove - OnSize - OnMaximize - OnMinimize - OnPaint - OnRestore - OnDropFiles * Added the useful pseudo-functions RGB2n( n1 [, n2] [, n3] ) and n2RGB( n ) for converting of a color array. * The 'Cursor' property is supported in the function GetProperty() for the Forms. * Added possibility to modify of 'OnEnter' event for the controls at runtime. * Added possibility to modify of the 'OnListDisplay/OnDropDown' and 'OnListClose/OnCloseUp' events for ComboBox control at runtime. * The Spinner control supports now a changing of the INCREMENT property at runtime. * The Timer control supports now a changing of the INTERVAL and ONCE properties at runtime. * The BTNTEXTBOX control supports now a changing of the separated TOOLTIPs for the edit box and buttons at runtime. * The GETBOX control supports now a changing of the separated TOOLTIPs for the edit box and buttons at runtime. * The global fonts which were defined by the command DEFINE FONT <font> FONTNAME <name> ... will preserved after closing of a form. * A 'Value' property will changed to a first available item in the RadioGroup control if a focused item was disabled with a putting of 'ReadOnly' property. * Updated the TSBrowse, HBPrinter and Sqlite3 libraries. * Added the new interesting samples and updated some Basic and Advanced samples. [/pre2] Хотя эта сборка работает стабильно, выпуск финальной версии отложен по финансовым причинам
SergKis: gfilatov2002 Может добавить для фонта[pre2] PROCEDURE _DefineFont( FontName, fName, fSize, bold, italic, underline, strikeout, nAngle, default, charset ) ... _HMG_aControlWidth [k] := GetTextWidth ( 0, 'B', FontHandle ) _HMG_aControlHeight [k] := GetTextHeight( 0, 'B', FontHandle ) ... FUNCTION GetFontParam( FontHandle ) ... aFontAttr := { _HMG_DefaultFontName, _HMG_DefaultFontSize, .F., .F., .F., .F., 0, 0, 0 } ... iif( Len( _HMG_aControlFontAttributes[ i ] ) == 5, _HMG_aControlFontAttributes[ i, FONT_ATTR_ANGLE ], 0 ), ; _HMG_aControlWidth [ i ], _HMG_aControlHeight [ i ] } ENDIF ... И псевдо функции FUNC GetFontWidth( FontName, nLen ) RETUNR GetFontParam( GetFontHandle( FontName ) )[8] * nLen FUNC GetFontHeight( FontName ) RETUNR GetFontParam( GetFontHandle( FontName ) )[9] [/pre2]
SergKis: PS Может покороче назвать FontWidth(...), FontHeight(...) ?
gfilatov2002: SergKis пишет: добавить для фонта Добавил конечно, но оставил названия псевдо-функций с Get (так понятнее). Благодарю за помощь
SergKis: gfilatov2002 Предложение добавить[pre2] *-----------------------------------------------------------------------------* PROCEDURE _PopEventInfo( n ) *-----------------------------------------------------------------------------* LOCAL l IF ( l := Len ( _HMG_aEventInfo ) ) > 0 DEFAULT n := 0 IF n > 0 .and. n <= l; l := n ENDIF _HMG_ThisFormIndex := _HMG_aEventInfo [l] [1] _HMG_ThisEventType := _HMG_aEventInfo [l] [2] _HMG_ThisType := _HMG_aEventInfo [l] [3] _HMG_ThisIndex := _HMG_aEventInfo [l] [4] _HMG_ThisFormName := _HMG_aEventInfo [l] [5] _HMG_ThisControlName := _HMG_aEventInfo [l] [6] IF n == 0 ASize ( _HMG_aEventInfo , l - 1 ) ENDIF ELSE ... [/pre2] Тогда в блоке кода на окно, контрол можно ставить среду This запомненную ранее, к примеру, на TIMER другого окна ACTION {|| _PopEventInfo( Len( _HMG_aEventInfo ) - 1 ), ... }
gfilatov2002: SergKis пишет: Предложение добавить Добавил, хотя эта коррекция является опасным хаком, на мой взгляд
SergKis: gfilatov2002 пишет Добавил, хотя эта коррекция является опасным хаком, на мой взгляд Большой опасности нет (не удаляем из стека, применяя n), на мой взгляд, но понимать, что происходит, конечно надо. Вариантов больше получается, к примеру 1 define window ... (сохраняет среду), если сделать _PushEventInfo ... end window (восстановит среду, но останется доп. установка) action window ... _PopEventInfo() (окончательно восстановит среду до работы окна) This среда будет стоять для окна (в блоках контролов среда ставится\восстанавливается для тек. окна) 2 В Timer (к примеру, на Main окне) поставив This среду по n (который можно определить по разному) можно анализировать ThisWindow.Name и даже This.Name, что бы проделывать разные операции в зависимости от имен. Завершение блока кода Timer восстановит из последнего элемента _HMG_aEventInfo, т.е. то что было при входе.
gfilatov2002: SergKis пишет: понимать, что происходит, конечно надо Вот в этом и проблема - обычно пользователи библиотеки (они же прикладные разработчики) редко хотят заморачиваться такими вещами. Но как дополнительная возможность - не помешает, я думаю.
SergKis: gfilatov2002 Поправил LoadFields() для работы с др. alias [pre2] METHOD LoadFields( lEditable, aColSel, cAlsSel, aNameSel ) CLASS TSBrowse Local n, nE, cHeading, nAlign, nSize, cData, cType, nDec, hFont, cPicture, ; cBlock, nCols, aNames, cKey, ; aColSizes := ::aColSizes, ; cOrder, nEle, ; cAlias, ; // := ::cAlias, ; aAlign := { "LEFT", "CENTER", "RIGHT", "VERT" }, ; aStru //:= ( ::cAlias )->( DbStruct() ) Local cName Default lEditable := ::lEditable, ; aColSizes := {} cAlias := If( HB_ISCHAR ( cAlsSel ), cAlsSel, ::cAlias ) aStru := ( cAlias )->( DbStruct() ) aNames := If( HB_ISARRAY( aColSel ), aColSel, ::aColSel ) // aNames := ::aColSel nCols := If( aNames == Nil, ( cAlias )->( FCount() ), Len( aNames ) ) aColSizes := If( Len( ::aColumns ) == Len( aColSizes ), Nil, aColSizes ) For n := 1 To nCols nE := If( aNames == Nil, n, ( cAlias )->( FieldPos( aNames[ n ] ) ) ) If ValType( ::aHeaders ) == "A" .and. ! Empty( ::aHeaders ) .and. n <= Len( ::aHeaders ) cHeading := ::aHeaders[ n ] Else cHeading := ::Proper( ( cAlias )->( Field( nE ) ) ) EndIf If ( nEle := AScan( ::aTags, {|e| Upper( cHeading ) $ Upper( e[ 2 ] ) } ) ) > 0 cOrder := ::aTags[ nEle, 1 ] cKey := ( cAlias )->( OrdKey() ) If Upper( cHeading ) $ Upper( cKey ) ::nColOrder := If( Empty( ::nColOrder ), Len( ::aColumns ) + 1, ::nColOrder ) EndIf Else cOrder := "" EndIf nAlign := If( ::aJustify != Nil .and. Len( ::aJustify ) >= nE, ::aJustify[ nE ], ; If( ( cAlias )->( ValType( FieldGet( nE ) ) ) == "N", 2, ; If( ( cAlias )->( ValType( FieldGet( nE ) ) ) == "L", 1, 0 ) ) ) nAlign := If( ValType( nAlign ) == "L", If( nAlign, 2, 0 ), ; If( ValType( nAlign ) == "C", AScan( aAlign, nAlign ) - 1, nAlign ) ) nSize := If( ! aColSizes == Nil .and. Len( aColsizes ) >= nE, aColSizes[ nE ], Nil ) cType := aStru[ nE, 2 ] If cType == "C" cPicture := "@K " + Replicate( 'X', aStru[ nE, 3 ] ) ElseIf cType == "N" cPicture := Replicate( '9', aStru[ nE, 3 ] ) IF aStru[ nE, 4 ] > 0 cPicture := SubStr( cPicture, 1, aStru[ nE, 3 ]-aStru[ nE, 4 ] - 1 ) + '.' + Replicate( '9', aStru[ nE, 4 ] ) endif cPicture := "@K " + cPicture EndIf If nSize == Nil cData := ( cAlias )->( FieldGet( nE ) ) cType := aStru[ nE, 2 ] nSize := aStru[ nE, 3 ] nDec := aStru[ nE, 4 ] hFont := If( ::hFont != Nil, ::hFont, 0 ) If cType == "C" cData := PadR( Trim( cData ), nSize, "B" ) nSize := GetTextWidth( 0, cData, hFont ) ElseIf cType == "N" cData := StrZero( cData, nSize, nDec ) nSize := GetTextWidth( 0, cData, hFont ) ElseIf cType == "D" cData := cValToChar( If( Empty( cData ), Date(), cData ) ) nSize := Int( GetTextWidth( 0, cData + "B", hFont ) ) + If( lEditable, 30, 0 ) ElseIf cType == "M" nSize := If( ::nMemoWV == Nil, 200, ::nMemoWV ) Else cData := cValToChar( cData ) nSize := GetTextWidth( 0, cData, hFont ) EndIf nSize := Max( GetTextWidth( 0, Replicate( "B", Len( cHeading ) ), hFont ), nSize ) nSize += If( ! Empty( cOrder ), 14, 0 ) ElseIf ValType( ::aColSizes ) == "A" .and. ! Empty( ::aColSizes ) .and. n <= Len( ::aColSizes ) nSize := ::aColSizes[ n ] EndIf If ValType( ::aFormatPic ) == "A" .and. ! Empty( ::aFormatPic ) .and. n <= Len( ::aFormatPic ) cPicture := ::aFormatPic[ n ] EndIf cBlock := 'FieldWBlock("' + aStru[ nE, 1 ] + '",Select("' + cAlias + '"))' ::AddColumn( TSColumn():New( cHeading, FieldWBlock( aStru[ nE, 1 ], Select( cAlias ) ),cPicture, ; { ::nClrText, ::nClrPane }, { nAlign, DT_CENTER }, nSize,, lEditable,,, cOrder,,,, ; 5,,,, Self, cBlock ) ) cName := ( cAlias )->( FieldName( nE ) ) ATail( ::aColumns ):cData := cAlias + "->" + FieldName( nE ) // ATail( ::aColumns ):cName := ( cAlias )->( FieldName( nE ) ) // 21.07.2015 ATail( ::aColumns ):cField := ( cAlias )->( FieldName( nE ) ) // 08.06.2018 ATail( ::aColumns ):cFieldTyp := aStru[ nE, 2 ] // 18.07.2018 ATail( ::aColumns ):nFieldLen := aStru[ nE, 3 ] // 18.07.2018 ATail( ::aColumns ):nFieldDec := aStru[ nE, 4 ] // 18.07.2018 If HB_ISARRAY( aNameSel ) .and. Len( aNameSel ) > 0 .and. n <= Len( aNameSel ) If HB_ISCHAR( aNameSel[ n ] ) .and. !Empty( aNameSel[ n ] ) cName := aNameSel[ n ] EndIf EndIf ATail( ::aColumns ):cName := cName If cType == "L" ATail( ::aColumns ):lCheckBox := .T. EndIf If ! Empty( cOrder ) ATail( ::aColumns ):lIndexCol := .T. EndIf Next If ::nLen == 0 cAlias := ::cAlias ::nLen := If( ::bLogicLen == Nil, Eval( ::bLogicLen := {||( cAlias )->( LastRec() ) } ), Eval( ::bLogicLen ) ) EndIf Return Self [/pre2] Пример для проверки https://TransFiles.ru/1z51g
SergKis: PS Для работы с MEMIO (пропустил, не доделал), надо[pre2] REQUEST DBFCDX, DBFFPT, DBFNTX, HB_MEMIO *-----------------------------------------------------------------------------* FUNCTION Main( cPath ) *-----------------------------------------------------------------------------* LOCAL nY, nX, nW, nH, hSpl, oBrw LOCAL cWnd := 'wMain', cAlias, aStru LOCAL cOut := 'OUT' LOCAL cTmp := 'mem:out' ... [/pre2] и Compile.bat call ..\..\..\batch\compile.bat demo /l hbmemio %1 %2 %3 %4 %5 %6 %7 %8 %9
SergKis: PPS Если сделать изменения, то можно менять поля в dbf из которого выборка [pre2] :LoadFields(.F., aColSel, cOut, aNamSel) aColSel := {"FIRST" , "LAST" , "STATE" , "AGE" , "ZIP", "MARRIED" } :LoadFields(.T., aColSel, cAls) FOR nI := 1 TO Len( aColSel ) :GetColumn(aColSel[ nI ]):bPrevEdit := {|| (cAls)->( RLock() ) } IF 'MARR' $ aColSel[ nI ] :GetColumn(aColSel[ nI ]):bPostEdit := {|| (cAls)->MARRIED := ! (cAls)->MARRIED, ; (cAls)->( dbUnLock() ) } ELSE :GetColumn(aColSel[ nI ]):bPostEdit := {|| (cAls)->( dbUnLock() ) } ENDIF NEXT AEval(:aColumns, {|oc,nc| oc:lEmptyValToChar := .T., ; oc:lFixLite := .T. }) [/pre2]
gfilatov2002: SergKis пишет: Поправил LoadFields() для работы с др. alias Принято с благодарностью
SergKis: gfilatov2002 Андрей сказал, что у меня в примере простая карточка, без вызова справочника. Исправил пример, добавив имитацию вызова справочников у 2х GetBox кнопками Так же сделал на этих GetBox F5 и DublClick для вызова справочника + ToolTip информация Пример тут https://TransFiles.ru/ocym6
SergKis: PS Небольшая бяка в примере. Если карточка изменена, фокус на GetBox и нажимаем Esc, то запрос на сохранение карточки, сделанный на AletYesNo(...), улетает в координаты 0,0. Правка такая[pre2] STATIC FUNC Age_CardSave( oBrw, lSave ) ... LOCAL nRec := ATail(aRec) LOCAL cFocu := This.FocusedControl If empty( lSave ) .and. ThisWindow.Cargo If ! empty(cFocu) .and. ! 'BUTT' $ This.&(cFocu).Type This.Btn_04.SetFocus DO EVENTS EndIf // lMsg := MsgYesNo('Save card - '+cValToChar(This.AGE.Value )+CRLF+ ; lMsg := AlertYesNo('Save card - '+cValToChar(This.AGE.Value )+CRLF+ ; ... [/pre2]
gfilatov2002: SergKis пишет: Исправил пример, добавив имитацию вызова справочников у 2х GetBox кнопками Благодарю за помощь
SergKis: gfilatov2002 Если добавить методы в [pre2]CLASS TGetData INHERIT TCnlData ... METHOD SetKeyEvent ( nKey, bKey, lCtrl, lShift, lAlt ) INLINE ::Get:SetKeyEvent(nKey, bKey, lCtrl, lShift, lAlt) METHOD SetDublClick( bBlock ) INLINE ::Get:SetKeyEvent( , bBlock ) METHOD Destroy() INLINE ::oGetBox := ::Super:Destroy() ... то удобней писать (This.&(o:GetName).Object):SetKeyEvent ( VK_F5, hb_MacroBlock(o:BtnAction) ) (This.&(o:GetName).Object):SetDublClick( hb_MacroBlock(o:BtnAction) ) [/pre2]
полная версия страницы