Автор | Сообщение |
gfilatov
|
| модератор
|
Пост N: 699
Зарегистрирован: 25.05.05
|
|
Отправлено: 29.01.08 13:59. Заголовок: Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
| |
|
Ответов - 300
, стр:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
All
[только новые]
|
|
SergKis
|
| постоянный участник
|
Пост N: 2697
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.07.19 11:23. Заголовок: PS Ведь все фонты по..
PS Ведь все фонты по DEFINE FONT ... цепляются к _FORMNAME_ 'Main' и там живут
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2698
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.07.19 11:38. Заголовок: PPS Если фонтов нет ..
PPS Если фонтов нет в списке DEFINE FONT ..., работают С ф-ии _SetFont(...), _SetFontHandle(...), а они не используют базу. По мне, команды удаления фонтов в _EraseControl() не нужны.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2699
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.07.19 11:44. Заголовок: SergKis пишет По мне..
SergKis пишет цитата: | По мне, команды удаления фонтов в _EraseControl() не нужны |
| Уточню, если они находятся в секции 'Main' - удалять не нужно.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1541
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.07.19 12:03. Заголовок: SergKis пишет: Заче..
SergKis пишет: цитата: | Зачем удалять фонт, созданный (сохранен в базе _HMG_aControlType == 'FONT') по DEFINE FONT ... ? |
| Поправил этот фрагмент кода с учетом Вашего предложения: цитата: | *-----------------------------------------------------------------------------* 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 |
|
Благодарю за помощь
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1542
Зарегистрирован: 11.02.10
|
|
Отправлено: 31.07.19 10:43. Заголовок: Всем кому это интересно
Подготовил 2-й релиз-кандидат для новой сборки 19.08 со следующим списком изменений: Скрытый текст
* 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.
| Хотя эта сборка работает стабильно, выпуск финальной версии отложен по финансовым причинам
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2701
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.08.19 11:28. Заголовок: gfilatov2002 Может ..
gfilatov2002 Может добавить для фонта 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]
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2702
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.08.19 11:44. Заголовок: PS Может покороче на..
PS Может покороче назвать FontWidth(...), FontHeight(...) ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1545
Зарегистрирован: 11.02.10
|
|
Отправлено: 01.08.19 12:18. Заголовок: SergKis пишет: доб..
SergKis пишет: Добавил конечно, но оставил названия псевдо-функций с Get (так понятнее). Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2706
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.08.19 09:22. Заголовок: gfilatov2002 Предло..
gfilatov2002 Предложение добавить *-----------------------------------------------------------------------------* 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 ... Тогда в блоке кода на окно, контрол можно ставить среду This запомненную ранее, к примеру, на TIMER другого окна ACTION {|| _PopEventInfo( Len( _HMG_aEventInfo ) - 1 ), ... }
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1546
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.08.19 10:30. Заголовок: SergKis пишет: Пред..
SergKis пишет: Добавил, хотя эта коррекция является опасным хаком, на мой взгляд
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2707
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.08.19 10:55. Заголовок: gfilatov2002 пишет Д..
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
|
| moderator
|
Пост N: 1547
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.08.19 11:01. Заголовок: SergKis пишет: пони..
SergKis пишет: цитата: | понимать, что происходит, конечно надо |
| Вот в этом и проблема - обычно пользователи библиотеки (они же прикладные разработчики) редко хотят заморачиваться такими вещами. Но как дополнительная возможность - не помешает, я думаю.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2709
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.08.19 10:03. Заголовок: gfilatov2002 Поправ..
gfilatov2002 Поправил LoadFields() для работы с др. alias Скрытый текст
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
| Пример для проверки https://TransFiles.ru/1z51g
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2710
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.08.19 11:06. Заголовок: PS Для работы с MEMI..
PS Для работы с MEMIO (пропустил, не доделал), надо 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' ... и Compile.bat call ..\..\..\batch\compile.bat demo /l hbmemio %1 %2 %3 %4 %5 %6 %7 %8 %9
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2711
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.08.19 13:47. Заголовок: PPS Если сделать изм..
PPS Если сделать изменения, то можно менять поля в dbf из которого выборка :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. })
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1548
Зарегистрирован: 11.02.10
|
|
Отправлено: 04.08.19 18:55. Заголовок: SergKis пишет: Попр..
SergKis пишет: цитата: | Поправил LoadFields() для работы с др. alias |
| Принято с благодарностью
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2712
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.08.19 10:17. Заголовок: gfilatov2002 Андрей..
gfilatov2002 Андрей сказал, что у меня в примере простая карточка, без вызова справочника. Исправил пример, добавив имитацию вызова справочников у 2х GetBox кнопками Так же сделал на этих GetBox F5 и DublClick для вызова справочника + ToolTip информация Пример тут https://TransFiles.ru/ocym6
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2713
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.08.19 11:02. Заголовок: PS Небольшая бяка в ..
PS Небольшая бяка в примере. Если карточка изменена, фокус на GetBox и нажимаем Esc, то запрос на сохранение карточки, сделанный на AletYesNo(...), улетает в координаты 0,0. Правка такая 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+ ; ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1549
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.08.19 11:24. Заголовок: SergKis пишет: Испр..
SergKis пишет: цитата: | Исправил пример, добавив имитацию вызова справочников у 2х GetBox кнопками |
| Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2714
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.08.19 15:11. Заголовок: gfilatov2002 Если д..
gfilatov2002 Если добавить методы в 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) )
| |
|
Ответов - 300
, стр:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
All
[только новые]
|
|
|