Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить
Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
gfilatov2002: SergKis пишет: под нее, с некоторыми предложенными правками, пример Спасибо Поправил функцию IconDll2File() для нового синтаксиса ExtractIconEx() из февральской сборки: [pre2] *----------------------------------------------------------------------------* FUNCTION IconDll2File(aIconList, cDirOut, cIconDll, lMsg) *----------------------------------------------------------------------------* LOCAL nI, aIcons := {}, cIconSave, nItem, cItem LOCAL aDim := {}, cPath, lRet, cFile LOCAL cMsg, cErr := "", nErr := 0 LOCAL oIco := oHmgData() DEFAULT lMsg := .T., cDirOut := "ICO", ; cIconDll := "shell32.dll" IF !HB_ISARRAY(aIconList) ; aIconList := {} ENDIF IF !hb_ps() $ cIconDll cIconDll := Sys.SystemFolder + hb_ps() + cIconDll ENDIF lRet := hb_FileExists( cIconDll ) IF !lRet .or. Empty( aIconList ) cMsg := ProcNL() cMsg += CRLF + Repl("=", Len(cMsg)) + CRLF cMsg += iif( lRet, "Undefined list of icons !", ; "DLL icon file not found !" ) + ";" cMsg += "List of icons:" + " ARRAY[ " + hb_ntos(aIconList) + " ]" ? cMsg IF lMsg ; AlertStop( cMsg , "Error" ) ENDIF RETURN NIL ENDIF FOR EACH aIcons IN aIconList ; AAdd(aDim, AClone(aIcons)) NEXT cPath := GetStartUpFolder() + hb_ps() + cDirOut + hb_ps() IF !hb_DirExists( cPath ) ; hb_DirBuild( cPath ) ENDIF FOR nI := 1 TO LEN(aDim) nItem := aDim[nI,2] cItem := HB_NtoS(nItem) cFile := ALLTRIM(aDim[nI,3]) cIconSave := cPath + cFile + "#" + cItem + '.ico' IF hb_FileExists( cIconSave ) oIco:Set ( aDim[nI,1], cIconSave ) // положили key, value LOOP ENDIF AAdd(aIcons, ExtractIconEx( cIconDll, nItem, 32, 32 )[1]) AAdd(aIcons, ExtractIconEx( cIconDll, nItem, 64, 64 )[1]) // icon with number XX to write along the path lRet := C_SaveHIconToFile( cIconSave, aIcons ) DestroyIcon(aIcons[1]) // ОБЯЗАТЕЛЬНО ! / NECESSARILY ! DestroyIcon(aIcons[2]) // ОБЯЗАТЕЛЬНО ! / NECESSARILY ! aIcons := {} wApi_Sleep(100) IF lRet ; oIco:Set( aDim[nI,1], cIconSave ) // положили key, value ELSE ; cErr += cIconSave + ";" ; nErr++ ENDIF NEXT wApi_Sleep(200) ; DO EVENTS IF nErr > 0 .and. lMsg cMsg := ProcNL() cMsg += CRLF + Repl("=", Len(cMsg)) + CRLF cMsg += cErr ? cMsg IF lMsg ; AlertStop( cMsg , "Icon is NOT saved !" ) ENDIF ENDIF RETURN oIco [/pre2]
Andrey: gfilatov2002 пишет: AAdd(aIcons, ExtractIconEx( cIconDll, nItem, 32, 32 )[1]) AAdd(aIcons, ExtractIconEx( cIconDll, nItem, 64, 64 )[1]) 128х128 - тоже нужно ОБЯЗАТЕЛЬНО ! Всякие менюшки делать, экраны у всех большие давно уже.
Andrey: Иконки размером 256х256 в ресурсы включаю, а ехе-ник не собирается. Так должно быть или нет ?
gfilatov2002: Andrey пишет: ехе-ник не собирается Попробуй сделать таким образом: ICON256 RCDATA IconVista.ico а потом используй фнкцию RCDataToFile() для извлечения ресурсов.
Andrey: Понял, Спасибо !
SergKis: gfilatov2002 Доработанный пример c menu (добавлены языки), надо учитывать, что это не unicode версия. В demo4.mnu файлы показано, как в этом черновике набирать, отлаживать меню (без сборки exe), потом можно переносить отлаженное в ресурсы .\res\_demo4.mnu, с текстами меню поступаем так же, черновики убрал в подкаталог. Пример тут https://TransFiles.ru/eztyk
gfilatov2002: SergKis пишет: Доработанный пример c menu Спасибо Но если выбираем второй пункт Config меню -> Themes menu, то получаем ошибку Error BASE/1004 Метод не экспортирован: NPOST Args: [1] = C --------------------------------- Stack Trace --------------------------------- Called from NPOST(0) Called from (b)CREATE_MENUITEM(437) in module: demo4_func.prg Called from _DOCONTROLEVENTPROCEDURE(2040) in module: h_windows.prg Called from EVENTS(1865) in module: h_events.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1644) in module: h_windows.prg Called from MAIN(98) in module: demo4.prg
SergKis: gfilatov2002 пишет Но если выбираем второй пункт Config меню -> Themes menu, то получаем ошибку Есть такое дело, пропустил добавку к имени контрола (пересеклись имена с Item строкой) в popup, надо сделать правку demo4_func.prg [pre2] *----------------------------------------------------------------------------* FUNCTION Create_Menu(cName, cMenu, oMenu, cGrup, cForm, nPost, cFltr, lIncl) *----------------------------------------------------------------------------* ... nPop += 1 cTyp := "POPUP" cGrp := cTyp+ "_" + cGrup + "_" + hb_ntos(nPop) cText := aItm[2] ... [/pre2]
gfilatov2002: SergKis пишет: пропустил добавку к имени контрола Спасибо, сейчас все пункты меню работают нормально. Но в коде этого примера есть два определения функции PromptGetForms(): Warning: Public symbol '_HB_FUN_PROMPTGETFORMS' defined in both module C:\MINIGUI\SAMPLES\1\MENU_POPUP_4\OBJ\TEST4_MENU.OBJ and C:\MINIGUI\SAMPLES\1\MENU_POPUP_4\OBJ\DEMOS_UTIL.OBJ
SergKis: gfilatov2002 пишет Но в коде этого примера есть два определения функции PromptGetForms(): Эту часть Андрей двигает, я не стал убирать, т.к. и ему перекинул версию. , но можно убрать, целью этого примера была показать возможности работы с ini, объектами-контейнерами, чтение, объединение объектов и создание псевдо объектов ф-я oSys(), где есть свойства и типа методы на основе блоков кода, а так же написания общих, в App.Object событий-блоков кода (не только на окне) и дальнейшее их использование в функциях и схему работы с языками, т.е. языковые тексты лежат в файлах utf8, а работа происходит с конкретной CDP, в данном случае RU1251. Т.к. это конечная версия hmg в таком виде, то я начал делать во всех окнах и контролах, где можно, Cargo := oHmgData() + в базовых окнах параметры от объекта oHmgData(), т.е. хочу мах. соединиться с версией от 2012 г. Делаю ~ такие правки [pre2] *-----------------------------------------------------------------------------* FUNCTION _DefineWindow ( FormName, Caption, x, y, w, h, nominimize, nomaximize, ; nosize, nosysmenu, nocaption, aMin, aMax, InitProcedure, ReleaseProcedure, ; MouseDragProcedure, SizeProcedure, ClickProcedure, MouseMoveProcedure, aRGB, ; PaintProcedure, noshow, topmost, main, icon, child, fontname, fontsize, ; NotifyIconName, NotifyIconTooltip, NotifyIconLeftClick, GotFocus, LostFocus, ; VirtualHeight, VirtualWidth, scrollleft, scrollright, scrollup, scrolldown, ; hscrollbox, vscrollbox, helpbutton, MaximizeProcedure, MinimizeProcedure, cursor, ; NoAutoRelease, InteractiveCloseProcedure, RestoreProcedure, MoveProcedure, DropProcedure, ; mdi, palette, NotifyIconDblClick, cPanelParent, panel, NotifyBalloonClick, clientwidth, clientheight ) *-----------------------------------------------------------------------------* LOCAL BrushHandle, FormHandle, ParentHandle LOCAL hnotifyicon, htooltip LOCAL ClassName LOCAL cType LOCAL mVar LOCAL vscroll, hscroll LOCAL k #ifdef _OBJECT_ LOCAL o //_!!! IF HB_ISOBJECT( FormName ) o := FormName FormName := o:FormName Caption := o:Caption x := o:x y := o:y w := o:w h := o:h nominimize := o:nominimize nomaximize := o:nomaximize nosize := o:nosize nosysmenu := o:nosysmenu nocaption := o:nocaption aMin := o:aMin aMax := o:aMax InitProcedure := o:InitProcedure ReleaseProcedure := o:ReleaseProcedure MouseDragProcedure := o:MouseDragProcedure SizeProcedure := o:SizeProcedure ClickProcedure := o:ClickProcedure MouseMoveProcedure := o:MouseMoveProcedure aRGB := o:aRGB PaintProcedure := o:PaintProcedure noshow := o:noshow topmost := o:topmost main := o:main icon := o:icon child := o:child fontname := o:fontname fontsize := o:fontsize NotifyIconName := o:NotifyIconName NotifyIconTooltip := o:NotifyIconTooltip NotifyIconLeftClick := o:NotifyIconLeftClick GotFocus := o:GotFocus LostFocus := o:LostFocus VirtualHeight := o:VirtualHeight VirtualWidth := o:VirtualWidth scrollleft := o:scrollleft scrollright := o:scrollright scrollup := o:scrollup scrolldown := o:scrolldown hscrollbox := o:hscrollbox vscrollbox := o:vscrollbox helpbutton := o:helpbutton MaximizeProcedure := o:MaximizeProcedure MinimizeProcedure := o:MinimizeProcedure cursor := o:cursor NoAutoRelease := o:NoAutoRelease InteractiveCloseProcedure := o:InteractiveCloseProcedure RestoreProcedure := o:RestoreProcedure MoveProcedure := o:MoveProcedure DropProcedure := o:DropProcedure mdi := o:mdi palette := o:palette NotifyIconDblClick := o:NotifyIconDblClick cPanelParent := o:cPanelParent panel := o:panel NotifyBalloonClick := o:NotifyBalloonClick clientwidth := o:clientwidth clientheight := o:clientheight o := NIL ENDIF //_!!! --- #endif ... //_!!! IF HB_ISNUMERIC( w ) .and. w > 0 .and. w < 1 w := int( GetDesktopWidth() * w ) ENDIF IF HB_ISNUMERIC( h ) .and. h > 0 .and. h < 1 h := int( GetDesktopHeight() * h ) ENDIF //_!!! --- IF !ISNUMBER( w ) .AND. !ISNUMBER( h ) ... _HMG_aFormMiscData2 [ k ] := oHmgData() //_!!! '' ... AAdd ( _HMG_aFormMiscData2, oHmgData() ) //_!!! '' ) ... _SetThisFormInfo ( k ) o := _HMG_aFormMiscData2 [ k ] //_!!! o:nForm := k o:cForm := FormName o:hForm := FormHandle o:cType := _HMG_aFormType [ k ] o:aBColor := _HMG_aFormBkColor [ k ] o:hParent := _HMG_aFormParentHandle [ k ] o:cParent := "" o:nParent := 0 IF !Empty( o:hParent ) o:nParent := GetFormNameByHandle ( o:hParent, @o:cParent ) ENDIF IF _HMG_lOOPEnabled Eval ( _HMG_bOnFormInit, k, mVar ) #ifdef _OBJECT_ o := _WindowObj( FormHandle ) IF HB_ISOBJECT( o ) o:cProcFile := ProcFile( 1 ) o:cProcName := ProcName( 1 ) o:nProcLine := ProcLine( 1 ) ENDIF #endif ENDIF ... [/pre2] т.е. версия 24.01 у меня только в архиве.
SergKis: gfilatov2002 Небольшие правки для multiline [pre2] METHOD TextWidth( cText, nSize, cFont, lBold, cChar ) CLASS TDlu2Pix LOCAL hFont, nWidth, cTxt := "", cTmp IF HB_ISARRAY( cText ) FOR EACH cTmp IN cText IF !HB_ISCHAR( cTmp ) ; cTmp := cValToChar( cTmp ) ENDIF IF Len(cTmp) > Len( cTxt ) ; cTxt := cTmp ENDIF NEXT cText := cTxt ENDIF cChar := hb_defaultValue( cChar, 'A' ) ... METHOD Breadth( nW, k ) CLASS TDlu2Pix LOCAL nWidth := 0, cW := "", cTmp IF HB_ISARRAY( nW ) FOR EACH cTmp IN nW IF Len(cTmp) > Len( cW ) ; cW := cTmp ENDIF NEXT nW := ::TextWidth( cW ) ELSEIF HB_ISCHAR( nW ) nW := ::TextWidth( nW ) ENDIF k := hb_defaultValue( k, 0.5 ) ... [/pre2]
gfilatov2002: SergKis пишет: Небольшие правки OK
SergKis: PS. Использование правки, например, такое (для Label) [pre2] *-----------------------------------------------------------------------------* FUNCTION _Set_Font_Default( FontName, FontSize, w, h, cText ) //_!!! *-----------------------------------------------------------------------------* LOCAL o := oHmgData(), FontHandle Default FontName := hb_defaultValue( FontName, _HMG_DefaultFontName ) IF FontSize == NIL IF ( FontHandle := GetFontHandle( FontName ) ) != 0 GetFontParamByRef( FontHandle, @FontName, @FontSize ) ENDIF ENDIF Default FontSize := hb_defaultValue( FontSize, _HMG_DefaultFontSize ) Default cText := " " o:oDlu := oDlu2Pixel( , , FontSize ) IF CRLF $ cText ; Default h := Len( hb_ATokens( cText, CRLF ) ) * o:oDlu:H1 ELSE ; Default h := 1 ENDIF IF h > 0 .and. h <= 5 ; h := o:oDlu:H( h ) ENDIF IF CRLF $ cText ; Default w := o:oDlu:Breadth( hb_ATokens( cText, CRLF ) ) ELSE ; Default w := 2 ENDIF IF w > 0 .and. w <= 5 ; w := o:oDlu:W( w ) ENDIF o:FontName := FontName o:FontSize := FontSize o:w := w o:h := h RETURN o *-----------------------------------------------------------------------------* FUNCTION _Set_Cargo_Values( k, lWindow, mVar, ParentFormName ) //_!!! *-----------------------------------------------------------------------------* LOCAL o IF !Empty( lWindow ) // for Windows IF !HB_ISOBJECT(_HMG_aFormMiscData2 [ k ] ) _HMG_aFormMiscData2 [ k ] := oHmgData() ENDIF o := _HMG_aFormMiscData2 [ k ] o:nIndex := k o:cType := _HMG_aFormType [ k ] o:cForm := _HMG_aFormNames [ k ] o:nHandle := _HMG_aFormHandles [ k ] o:aBColor := _HMG_aFormBkColor [ k ] o:hParent := _HMG_aFormParentHandle [ k ] o:cParent := "" o:nParent := 0 o:mVar := mVar o:lHandle := IsWindowHandle( o:nHandle ) o:lParent := IsWindowHandle( o:hParent ) IF !Empty( o:hParent ) .and. o:lParent o:nParent := GetFormNameByHandle ( o:hParent, @o:cParent ) ENDIF Default o:cFontName := _HMG_ActiveFontName Default o:nFontSize := _HMG_ActiveFontSize Default o:oFontDlu := oDlu2Pixel( , , o:nFontSize ) ELSE // for Controls o := _HMG_aControlMiscData2 [ k ] ; Default o := oHmgData() o:nIndex := k o:cType := _HMG_aControlType [ k ] o:cName := _HMG_aControlNames [ k ] o:nHandle := _HMG_aControlHandles [ k ] o:aBColor := _HMG_aControlBkColor [ k ] o:aFColor := _HMG_aControlFontColor[ k ] o:hParent := _HMG_aControlParenthandles [ k ] o:cParent := "" o:nParent := 0 o:mVar := mVar o:lHandle := IsWindowHandle( o:nHandle ) o:lParent := IsWindowHandle( o:hParent ) IF !Empty( ParentFormName ) o:cParent := ParentFormName o:nParent := GetFormIndex( ParentFormName ) ELSEIF !Empty( o:hParent ) .and. o:lParent o:nParent := GetFormNameByHandle ( o:hParent, @o:cParent ) ENDIF ENDIF RETURN o ... h_label.prg #include "minigui.ch" #include "i_winuser.ch" *-----------------------------------------------------------------------------* FUNCTION _CreateLabel ( oControl ) *-----------------------------------------------------------------------------* LOCAL o := oControl, q LOCAL ControlName, ParentFormName, x, y, Caption, w, h, ; fontname, fontsize, bold, BORDER, CLIENTEDGE, HSCROLL, VSCROLL, ; TRANSPARENT, aRGB_bk, aRGB_font, ProcedureName, tooltip, HelpId, ; invisible, italic, underline, strikeout, autosize, rightalign, ; centeralign, blink, mouseover, mouseleave, VCenterAlign, ; NoPrefix, nId, bInit, dblclick, rclick ControlName := o:ControlName ParentFormName := o:ParentFormName x := o:x y := o:y Caption := o:Caption w := o:w h := o:h fontname := o:fontname fontsize := o:fontsize bold := o:bold BORDER := o:BORDER CLIENTEDGE := o:CLIENTEDGE HSCROLL := o:HSCROLL VSCROLL := o:VSCROLL TRANSPARENT := o:TRANSPARENT aRGB_bk := o:aRGB_bk ; Default aRGB_bk := o:aBColor aRGB_font := o:aRGB_font ; Default aRGB_font := o:aFColor ProcedureName := o:ProcedureName tooltip := o:tooltip HelpId := o:HelpId invisible := o:invisible italic := o:italic underline := o:underline strikeout := o:strikeout autosize := o:autosize rightalign := o:rightalign centeralign := o:centeralign blink := o:blink mouseover := o:mouseover mouseleave := o:mouseleave VCenterAlign := o:VCenterAlign NoPrefix := o:NoPrefix nId := o:nId bInit := o:bInit dblclick := o:dblclick rclick := o:rclick Default aRGB_bk := o:aBackColor Default aRGB_font := o:aFontColor q := _Set_Font_Default( FontName, FontSize, w, h, Caption ) FontName := q:FontName ; w := q:w FontSize := q:FontSize ; h := q:h q := _DefineLabel ( ControlName, ParentFormName, x, y, Caption, w, h, ; fontname, fontsize, bold, BORDER, CLIENTEDGE, HSCROLL, VSCROLL, ; TRANSPARENT, aRGB_bk, aRGB_font, ProcedureName, tooltip, HelpId, ; invisible, italic, underline, strikeout, autosize, rightalign, ; centeralign, blink, mouseover, mouseleave, VCenterAlign, ; NoPrefix, nId, bInit, dblclick, rclick ) IF HB_ISOBJECT( q ) q:cProcFile := ProcFile( 1 ) q:cProcName := ProcName( 1 ) q:nProcLine := ProcLine( 1 ) IF !Empty( q:lHandle ) o := _ControlObj( q:nHandle ) o:cProcFile := ProcFile( 1 ) o:cProcName := ProcName( 1 ) o:nProcLine := ProcLine( 1 ) ENDIF ENDIF RETURN q *-----------------------------------------------------------------------------* FUNCTION _DefineLabel ( ControlName, ParentFormName, x, y, Caption, w, h, ; fontname, fontsize, bold, BORDER, CLIENTEDGE, HSCROLL, VSCROLL, ; TRANSPARENT, aRGB_bk, aRGB_font, ProcedureName, tooltip, HelpId, invisible, ; italic, underline, strikeout, autosize, rightalign, centeralign, ; blink, mouseover, mouseleave, VCenterAlign, NoPrefix, nId, bInit, dblclick, rclick ) *-----------------------------------------------------------------------------* LOCAL ParentFormHandle, ControlHandle, FontHandle LOCAL mVar LOCAL k := 0 LOCAL Style LOCAL blInit LOCAL lDialogInMemory LOCAL ow, oc, o hb_default( @w, 120 ) hb_default( @h, 24 ) __defaultNIL( @ProcedureName, "" ) hb_default( @invisible, .F. ) hb_default( @bold, .F. ) hb_default( @italic, .F. ) hb_default( @underline, .F. ) hb_default( @strikeout, .F. ) hb_default( @VCenterAlign, .F. ) __defaultNIL( @rclick, "" ) __defaultNIL( @Caption , "" ) hb_default( @blink , .F. ) hb_default( @autosize , .F. ) hb_default( @border , .F. ) hb_default( @HSCROLL , .F. ) hb_default( @VSCROLL , .F. ) hb_default( @NoPrefix , .F. ) hb_default( @TRANSPARENT , .F. ) hb_default( @rightalign , .F. ) hb_default( @centeralign , .F. ) hb_default( @VCenterAlign, .F. ) IF ( FontHandle := GetFontHandle( FontName ) ) != 0 GetFontParamByRef( FontHandle, @FontName, @FontSize, @bold, @italic, @underline, @strikeout ) ENDIF IF _HMG_BeginWindowActive .OR. _HMG_BeginDialogActive ParentFormName := iif( _HMG_BeginDialogActive, _HMG_ActiveDialogName, _HMG_ActiveFormName ) __defaultNIL( @FontName, _HMG_ActiveFontName ) __defaultNIL( @FontSize, _HMG_ActiveFontSize ) ENDIF IF _HMG_FrameLevel > 0 .AND. !_HMG_ParentWindowActive x := x + _HMG_ActiveFrameCol [_HMG_FrameLevel] y := y + _HMG_ActiveFrameRow [_HMG_FrameLevel] ParentFormName := _HMG_ActiveFrameParentFormName [_HMG_FrameLevel] ENDIF lDialogInMemory := _HMG_DialogInMemory IF .NOT. _IsWindowDefined ( ParentFormName ) .AND. .NOT. lDialogInMemory MsgMiniGuiError( "Window: " + IFNIL( ParentFormName, "Parent", ParentFormName ) + " is not defined." ) ENDIF IF _IsControlDefined ( ControlName, ParentFormName ) .AND. .NOT. lDialogInMemory MsgMiniGuiError ( "Control: " + ControlName + " Of " + ParentFormName + " Already defined." ) ENDIF IF ISARRAY ( Caption ) mVar := '' AEval ( Caption, {|v| mVar += cValToChar ( v ) } ) Caption := mVar ELSEIF ISBLOCK ( Caption ) Caption := cValToChar ( Eval ( Caption ) ) ELSE Caption := cValToChar ( Caption ) ENDIF mVar := '_' + ParentFormName + '_' + ControlName k := _GetControlFree() IF _HMG_BeginDialogActive ParentFormHandle := _HMG_ActiveDialogHandle Style := WS_CHILD + SS_NOTIFY IF border Style += WS_BORDER ENDIF IF !invisible Style += WS_VISIBLE ENDIF IF HSCROLL Style += WS_HSCROLL ENDIF IF VSCROLL Style += WS_VSCROLL ENDIF IF rightalign Style += ES_RIGHT ENDIF IF centeralign Style += ES_CENTER ENDIF IF VCenterAlign Style += SS_CENTERIMAGE ENDIF IF lDialogInMemory //Dialog Template // {{'ID',k/hwnd,class,Style,ExStyle,x,y,w,h,caption,HelpId,tooltip,font,size, bold, italic, underline, strikeout}} --->_HMG_aDialogItems blInit := {|x, y, z| InitDialogLabel( x, y, z ) } AAdd( _HMG_aDialogItems, { nId, k, "static", style, 0, x, y, w, h, caption, HelpId, tooltip, FontName, FontSize, bold, italic, underline, strikeout, blInit, _HMG_BeginTabActive, .F. , _HMG_ActiveTabPage } ) ELSE ControlHandle := GetDialogItemHandle ( ParentFormHandle, nId ) x := GetWindowCol ( Controlhandle ) y := GetWindowRow ( Controlhandle ) w := GetWindowWidth ( Controlhandle ) h := GetWindowHeight ( Controlhandle ) IF caption != NIL SetWindowText ( ControlHandle , caption ) ENDIF SetWindowStyle ( ControlHandle, Style, .T. ) ENDIF ELSE ParentFormHandle := GetFormHandle ( ParentFormName ) Controlhandle := InitLabel ( ParentFormHandle, Caption, 0, x, y, w, h, '', ( ISBLOCK( ProcedureName ) .OR. ISBLOCK( dblclick ) .OR. ISBLOCK( rclick ) .OR. ISSTRING( tooltip ) ), ( ISBLOCK( mouseover ) .OR. ISBLOCK( mouseleave ) ) , border , clientedge , HSCROLL , VSCROLL , TRANSPARENT , invisible , rightalign , centeralign , VCenterAlign , NoPrefix ) ENDIF IF .NOT. lDialogInMemory IF FontHandle != 0 _SetFontHandle( ControlHandle, FontHandle ) ELSE __defaultNIL( @FontName, _HMG_DefaultFontName ) __defaultNIL( @FontSize, _HMG_DefaultFontSize ) FontHandle := _SetFont ( ControlHandle, FontName, FontSize, bold, italic, underline, strikeout ) ENDIF IF _HMG_BeginTabActive AAdd ( _HMG_ActiveTabCurrentPageMap , Controlhandle ) ENDIF IF tooltip != NIL SetToolTip ( ControlHandle , tooltip , GetFormToolTipHandle ( ParentFormName ) ) ENDIF ENDIF #ifdef _NAMES_LIST_ _SetNameList( mVar , k ) #else Public &mVar. := k #endif _HMG_aControlType [k] := "LABEL" _HMG_aControlNames [k] := ControlName _HMG_aControlHandles [k] := ControlHandle _HMG_aControlParenthandles [k] := ParentFormHandle _HMG_aControlIds [k] := nId _HMG_aControlProcedures [k] := ProcedureName _HMG_aControlPageMap [k] := {} _HMG_aControlValue [k] := Nil _HMG_aControlInputMask [k] := transparent _HMG_aControllostFocusProcedure [k] := mouseleave _HMG_aControlGotFocusProcedure [k] := mouseover _HMG_aControlChangeProcedure [k] := rclick _HMG_aControlDeleted [k] := .F. _HMG_aControlBkColor [k] := aRGB_bk _HMG_aControlFontColor [k] := aRGB_font _HMG_aControlDblClick [k] := _HMG_ActiveTabButtons _HMG_aControlHeadClick [k] := dblclick _HMG_aControlRow [k] := y _HMG_aControlCol [k] := x _HMG_aControlWidth [k] := w _HMG_aControlHeight [k] := h _HMG_aControlSpacing [k] := iif ( autosize == .T. , 1 , 0 ) _HMG_aControlContainerRow [k] := iif ( _HMG_FrameLevel > 0 , _HMG_ActiveFrameRow [_HMG_FrameLevel] , -1 ) _HMG_aControlContainerCol [k] := iif ( _HMG_FrameLevel > 0 , _HMG_ActiveFrameCol [_HMG_FrameLevel] , -1 ) _HMG_aControlPicture [k] := "" _HMG_aControlContainerHandle [k] := 0 _HMG_aControlFontName [k] := fontname _HMG_aControlFontSize [k] := fontsize _HMG_aControlFontAttributes [k] := { bold, italic, underline, strikeout } _HMG_aControlToolTip [k] := tooltip _HMG_aControlRangeMin [k] := iif ( _HMG_FrameLevel > 0 , _HMG_ActiveTabName , '' ) _HMG_aControlRangeMax [k] := iif ( _HMG_FrameLevel > 0 , _HMG_ActiveFrameParentFormName [_HMG_FrameLevel] , '' ) _HMG_aControlCaption [k] := Caption _HMG_aControlVisible [k] := iif( invisible, FALSE, TRUE ) _HMG_aControlHelpId [k] := HelpId _HMG_aControlFontHandle [k] := FontHandle _HMG_aControlBrushHandle [k] := 0 _HMG_aControlEnabled [k] := .T. _HMG_aControlMiscData1 [k] := { 0, blink, .T. } _HMG_aControlMiscData2 [k] := oHmgData() //_!!! '' IF blink == .T. .AND. .NOT. lDialogInMemory _DefineTimer ( 'BlinkTimer' + hb_ntos( k ) , ParentFormName , 500 , {|| _HMG_aControlMiscData1 [k] [3] := ! _HMG_aControlMiscData1 [k] [3], ; iif( _HMG_aControlMiscData1 [k] [3] == .T. , _ShowControl ( ControlName , ParentFormName ), _HideControl ( ControlName , ParentFormName ) ) } ) ENDIF IF autosize == .T. .AND. .NOT. lDialogInMemory _SetControlWidth ( ControlName , ParentFormName , GetTextWidth( NIL, Caption, FontHandle ) + ; iif( bold == .T. .OR. italic == .T., GetTextWidth( NIL, " ", FontHandle ), 0 ) ) _SetControlHeight ( ControlName , ParentFormName , FontSize + iif( FontSize < 14, 12, 16 ) ) ENDIF oc := _Set_Cargo_Values( k, .F., mVar, ParentFormName ) //_!!! oc:cProcFile := ProcFile( 1 ) oc:cProcName := ProcName( 1 ) oc:nProcLine := ProcLine( 1 ) IF _HMG_lOOPEnabled Eval ( _HMG_bOnControlInit, k, mVar ) ow := _WindowObj ( ParentFormHandle ) o := _ControlObj( ControlHandle ) IF HB_ISOBJECT ( o ) o:cProcFile := ProcFile( 1 ) o:cProcName := ProcName( 1 ) o:nProcLine := ProcLine( 1 ) ENDIF ENDIF Do_ControlEventProcedure ( bInit, k, ow, o ) RETURN oc // Cargo ... [/pre2]
gfilatov2002: SergKis пишет: Использование правки, например Благодарю за пример Очень интересно
gfilatov2002: Завершена подготовка новой сборки 24.02, которая будет опубликована на следующей неделе. Как я уже сообщал ранее, дистрибутив Minigui разделен на две неравные части: стандартную и профессиональную. Одна часть — это бесплатный установщик Minigui, содержащий отладочную версию библиотеки и стандартный компилятор Harbour без оптимизаций. Она не содержит примеров готовых приложений или служебных программ, а также библиотеку SqlRdd. Другая часть представляет собой защищенный паролем архив 7z со всеми расширенными компонентами. Она содержит сжатую библиотеку Minigui без отладочной информации и оптимизированную виртуальную машину Harbour для приложений с графическим интерфейсом, а также исправленную библиотеку SqlRdd. Кратко, что нового: [pre2] * Fixed: The program crashed when using the HMG_SetMenuTheme() function along with a transparent label on the form (introduced in the build 19.10). * New: Added the useful function HMG_GetAllFonts( [ lObj ] ) to get an array of font names and parameters that were defined with DEFINE FONT <font> FONTNAME <name> ... command. * Enhanced: Added the optional 3rd and 4th parameters in the ExtractIconEx() function for extraction the ICON of a resource ID from exe or dll. Syntax: ExtractIconEx( cResName, nItem [, nX ] [, nY ] ) => { hIcon, nId }, where nX and xY are the icon sizes in pixels (32x32 by default). * Updated: Improved object error logging using the _o2Log() function. * Updated the Harbour Compiler 3.2, SQLRDD and Sqlite libraries. * Added new and updated some Basic and Advanced samples. [/pre2] Также я подготовил отдельные архивы этой сборки для работы с устаревшим компилятором BCC 5.5.1 (2000 года) и новейшим Embarcadero C++ 7.70 (2023 года) Ваши комментарии приветствуются...
SergKis: gfilatov2002 Добавил обработку json в THmgData и TIniData, подробнее в архиве в файле read.my, может пригодится Пример тут https://TransFiles.ru/l4a1g PS Переменные App.Cargo без секции, в примере, при создании ini идут в секцию [MAIN] - это можго делать и в др. секцию. Присвоение (обратите внимание) App.Cargo:Form_Main := oForm и oi:MAIN:oForm := oForm дают разные результаты PS2 Пропустил, не убрал отладочную строку в METHOD ToValue( cStr ) CLASS TIniData ? procname(), procline(), cStr
gfilatov2002: SergKis пишет: Добавил обработку json в THmgData и TIniData Благодарю за помощь Эти изменения буду рассматривать уже для следующей сборки...
gfilatov2002: Выложил финальную сборку 24.02 с последними исправлениями и дополнениями по адресу Стандартная версия SHA-256: c7622385ffbb1b01803252347a0eb35f654f8970f5029fafe8414ec13ab737cd Желаю всем хорошего дня P.S. Также на сайте проекта доступна ссылка на архив профессиональной версии (она защищена паролем).
SergKis: gfilatov2002 1. Такие конструкции, по мне, лишние, например в h_alert.prg [pre2] #ifdef _NAMES_LIST_ This.Cargo := oHmgData() #endif ... #ifdef _NAMES_LIST_ LOCAL nY, nX, cIco #endif ... #ifdef _NAMES_LIST_ This.Cargo:oTimer := "TIMER" #endif ... [/pre2] Они связаны только с использованием bInit, для облегчения жизни при обработке. oHmgData() есть всегда, а _NAMES_LIST_ только для использования списка переменных вместо PUBLIC переменных. 2. Давно хотел предложить, но вылетало из головы, для таймеров ставить Enabled := .F. сразу, что бы не было ложных срабатываний до ON INIT и лишних команд к DEFINE TIMER oTimer ... -> This.oTimer.Enabled := .F. 3. [pre2] *-----------------------------------------------------------------------------* FUNCTION AlertExclamation ( Message, Title, Icon, nSize, aColors, lTopMost, bInit, lNoSound ) *-----------------------------------------------------------------------------* LOCAL nWaitSec IF HB_ISARRAY( Title ) nWaitSec := Title[2] Title := Title[1] ENDIF ... *-----------------------------------------------------------------------------* FUNCTION AlertInfo ( Message, Title, Icon, nSize, aColors, lTopMost, bInit, lNoSound ) *-----------------------------------------------------------------------------* LOCAL nWaitSec IF HB_ISARRAY( Title ) nWaitSec := Title[2] Title := Title[1] ENDIF ... *-----------------------------------------------------------------------------* FUNCTION AlertStop ( Message, Title, Icon, nSize, aColors, lTopMost, bInit, lNoSound ) *-----------------------------------------------------------------------------* LOCAL nWaitSec IF HB_ISARRAY( Title ) nWaitSec := Title[2] Title := Title[1] ENDIF ... [/pre2]
gfilatov2002: SergKis пишет: Такие конструкции, по мне, лишние Это подстраховка, если библиотека собрана без использования NAMES_LIST (например, для xHarbour). SergKis пишет: для таймеров ставить Enabled := .F. сразу Это не всегда удобно. Но, возможно, надо добавить команду-переключатель этого режима Благодарю за Ваши предложения Они всегда двигают наш проект вперед...
полная версия страницы