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

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

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

gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №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: Я в отдыхе, на бегу отвечаю. Петр пишет И не пишите, пожалуйста, то чего не знаете Для hb2.0 знаю, для hb3.2 (думал, что знаю, но сбился на ваше сообщение о DESTRUCTOR), потребовалось время, что бы уточнить. Я привел вам пример (destruct.prg) - там и деструктор и неявный конструктор init.. Вы привели все правильно, но для не типизированных классов. В типизированном\строго типизированном это отключено т.к. hb наследник clipper. И написанная, мной, инф. это подвержтает, деструктор валится в отличии от VO. я не знаю как на это реагировать, ну типа плакать или смеяться Можете спеть, станцевать - ваше дело. У нас свободная страна. Но я не просил реагировать, инициатива от вас. Значит класс не закончен и смотреть не на что. С классами, как с ремонтом, можно бросить, приостановить, но закончить ... Для приведенного примера, его (класса) состояние вполне достаточное. Andrey пишет да помоги написать как нужно и всех делов то... Андрей, не бери в голову, у Петра такая манера, сказать A и не говорить Б. Как у тех, из за лужи: "Мы знаем, что это сделал (вы сами знаете кто). У нас факты, но не скажем, потому что секретные." Haz говорил, что у тебя есть очень секретный код (не хочешь делиться), вот и у Петра есть тааакой секретный код, что я есть ... не могу, спать ... не могу, вот пить ... начал. Фотографии нет ? Фотографии нет ! А фотографии кода нет. Пускай человек учится.. Не учите меня жить, лучше помогите материально. О.Бендер.

Петр: SergKis пишет: Вы привели все правильно, но для не типизированных классов. В типизированном\строго типизированном это отключено т.к. hb наследник clipper. Нет никаких типизированных или не типизированных классов, по крайней мере, в hb. В MiniGUI так их точно нет SergKis пишет: И написанная, мной, инф. это подвержтает, деструктор валится в отличии от VO. Ну вы уже писали, что в hb нет деструкторов. Теперь, из ваших слов можно сделать вывод, что есть, но работают не правильно. Самодостаточный пример в devel list вам поможет (не материально ).

gfilatov2002: gfilatov2002 пишет: Опубликована очередная сборка 17.06 для BCC 5.51 Сделал быстрое обновление новой сборки с учетом последних наработок Петра, которые были опубликованы на форуме. Список изменений см. ниже [pre2] * New: Added the following new commands for managing of the Windows events: - ON WINEVENT [ID] <nId> ACTION <bAction> OF <window> ; [NOACTIVE>] [ONCE>] [RESULT] TO <lResult>. - REMOVE WINEVENT [[ID] [<nId>] | ALL] OF <window> ; [ONCE>] [RESULT] TO <lResult>. - UPDATE WINEVENT [ID] <nId> [ACTION <bAction>] OF <window> ; [NOACTIVE>] [ONCE>] [RESULT] TO <lResult>. Contributed by Petr Chornyj <myorg63@mail.ru> (see demos in folder \samples\Advanced\MESSAGEONLY_WINDOW) * Updated: The Windows events and the Application events are available for xHarbour compiler also. Contributed by Petr Chornyj <myorg63@mail.ru> (see demo in folder \samples\Advanced\AppEvents) * Updated: A thread safe lock/unlock into the Global Listener C-code is available for xHarbour compiler also. Contributed by Petr Chornyj <myorg63@mail.ru> [/pre2] Прямая ссылка на архив http://hmgextended.com/files/CONTRIB/hmg-17.06.7z

gfilatov2002: Сделал второе обновление новой сборки с учетом последних изменений Си-кода. Список изменений см. ниже [pre2] * Fixed: A C-code cleaning for the warnings at Visual C 2017 compiler with a warning level is established to Yes in hbmk2 utility. The above warnings were found into the Minigui core and TSBrowse library. It was a postponed modification for a core stability. Contributed by Grigory Filatov <gfilatov@inbox.ru> [/pre2] Прямая ссылка на архив этой сборки http://hmgextended.com/files/CONTRIB/hmg-17.06.7z Благодарю за Ваше внимание

SergKis: gfilatov2002 1. По поводу SET EVENTS FUNCTION TO ... Для mdi окон не работает. Берем пример Mdi\demo.prg, добавляем ... [pre2] Function Main SET EVENTS FUNCTION TO App_OnEvents Public nChild := 0 ... FUNCTION App_OnEvents( hWnd, nMsg, wParam, lParam ) _LogFile(.T., procname(),hwnd,nmsg) RETURN Events( hWnd, nMsg, wParam, lParam ) [/pre2] 2. Вернусь к предложению с _HMG_переменными, для возможности встраиваться в hmg со своими тараканами (через почту не буду, ничего не установлено, не пользую у себя). [pre2] - ввести переменные _HMG_bFormInit _HMG_bFormDestroy _HMG_bControlInit _HMG_bControlDestroy _HMG_bWm_User _HMG_bWm_App - в _Define... для окон (где наличие _HMG_aFormMiskData1\2) перед выходом из ф-ии делать If HB_ISBLOCK( _HMG_bFormInit ) EVal( _HMG_bFormInit, k, cVar ) // k - индекс (где то он i возможно) EndIf // cVar - имя переменной RETURN ... - h_window.prg Function ReleaseAllWindows () ... For Each FormHandle In _HMG_aFormHandles ... if _HMG_aFormActive [ i ] == .T. _DoWindowEventProcedure ( _HMG_aFormReleaseProcedure [ i ] , i , 'WINDOW_RELEASE' ) If HB_ISBLOCK( _HMG_bFormDestroy ) EVal( _HMG_bFormDestroy, i ) EndIf ... Function _ReleaseWindow ( FormName ) i := GetFormIndex ( Formname ) hWindowHandle := _HMG_aFormHandles [ i ] * Release Window If HB_ISBLOCK( _HMG_bFormDestroy ) EVal( _HMG_bFormDestroy, i ) EndIf ... - в _Define... для контролов (наличие _HMG_aControlMiskData1\2) перед выходом из ф-ии делать If HB_ISBLOCK( _HMG_bControlInit ) EVal( _HMG_bControlInit, k, cVar ) // k - индекс (где то он i возможно) EndIf // cVar - имя переменной RETURN ... - добавить Function _EraseControl (i, p) ... If HB_ISBLOCK( _HMG_bControlDestroy ) EVal( _HMG_bControlDestroy, i ) EndIf ... // названия условные #define WM_USER_HMG WM_USER + ... #define WM_APP_HMG WM_APP + ... Function Events ( hWnd, nMsg, wParam, lParam ) ... *********************************************************************** case WM_USER_HMG *********************************************************************** If HB_ISBLOCK( _HMG_bWM_User ) EVal( _HMG_bWm_User, hWnd, nMsg, wParam, lParam ) EndIf exit *********************************************************************** case WM_APP_HMG *********************************************************************** If HB_ISBLOCK( _HMG_bWM_App ) EVal( _HMG_bWm_App, hWnd, nMsg, wParam, lParam ) EndIf exit ... [/pre2] Делать вне _Define... _HMG_b...Init можно, но это равносильно написанию своих _Define..2, а в ON INIT делать не интересно (еще и писать везде), т.к. нужно до WINDOW ACTIVATE ...

SergKis: PS По мне, лучше сделать два WM_USER_HMG (как у меня в предложениях выше), для окна и для контртрола (проще управление в блоке кода - он один), но не настаиваю, минимизирую

gfilatov2002: SergKis Да, команда SET EVENTS FUNCTION TO не работает для mdi окон. Для mdi child потребуется новая команда SET MDIEVENTS FUNCTION TO SergKis пишет: Вернусь к предложению с _HMG_переменными Выполнил эти правки для текущего кода с небольшим изменением имени этих блоков кода. Но вместо использования блоаов _HMG_bWm_User и _HMG_bWm_App предлагаю использовать новые команды ON WINUSER и ON WINAPP Присылайте реальное наполнение для новых блоков кода и свежую редакцию Ваших классов (если такая есть). Мой пример для проверки функциональности кода см. ниже [pre2]#include "minigui.ch" DECLARE WINDOW Win_2 FUNCTION Main LOCAL i, cForm _HMG_bOnFormInit := {|i,c| MsgInfo(i,"Init of "+c)} _HMG_bOnFormDestroy := {|i| MsgInfo(i,"Destroy of "+_HMG_aFormNames [ i ])} _HMG_bOnControlInit := {|i,c| MsgInfo(i,"Init of "+c)} _HMG_bOnControlDestroy := {|i,p| MsgDebug("Destroy control ",_HMG_aControlNames [ i ]," of ",_HMG_aFormNames [ p ])} DEFINE WINDOW Win_1 ; MAIN ; TITLE 'Hello World!' ; ON GOTFOCUS iif( IsWindowDefined( Win_2 ) .AND. iswinnt(), Win_2.Setfocus(), NIL ) END WINDOW DEFINE WINDOW Win_2 ; CHILD ; TITLE 'Child Window' END WINDOW DEFINE WINDOW Win_3 ; MODAL ; TITLE 'Modal Window' @ 100,100 BUTTON Button_11 CAPTION "Click " WIDTH 100 HEIGHT 30 ACTION MsgInfo("Click!") END WINDOW FOR i := 1 TO 3 cForm := "Win_" + Str( i, 1 ) _DefineHotKey( cForm, 0, VK_ESCAPE, hb_MacroBlock( "_ReleaseWindow('" + cForm + "')" ) ) NEXT Win_2.Center Win_3.Center ACTIVATE WINDOW Win_3, Win_2, Win_1 RETURN NIL[/pre2]

SergKis: gfilatov2002 пишет Но вместо использования блоаов _HMG_bWm_User и _HMG_bWm_App предлагаю использовать новые команды ON WINUSER и ON WINAPP Как то не перекладывается мой пример на эти команды (регистрация событий от 1,2, ... на каждое окно и каждый контрол), особенно, если окон (контролов на них) много. Использование WINAPP, кроме присвоения каждому окну уникального номера для доступа к кофигуратору, не вижу. С WINUSER совсем не понятно, где использовать, кроме прерывания циклов работы с базой. Присылайте реальное наполнение для новых блоков кода и свежую редакцию Ваших классов (если такая есть). Позже, пока в отдыхе

gfilatov2002: SergKis пишет: не перекладывается мой пример на эти команды Понимаю, поэтому добавил два пользовательских события и их обработку (события WM_WND_LAUNCH и WM_CTL_LAUNCH, их обработчики - кодоблоки _HMG_bWndLaunch и _HMG_bСtlLaunch). SergKis пишет: Позже Буду ждать...

SergKis: gfilatov2002 пишет Буду ждать... Переназвал кодоблоки _HMG_bWndLaunch и _HMG_bСtlLaunch на _HMG_bOnWndLaunch и _HMG_bOnСtlLaunch На своей lib собрал пример http://my-files.ru/bzb7lk Классы [pre2] // Misk class, function #include "minigui.ch" #include "hbclass.ch" *-----------------------------------------------------------------------------* FUNCTION oWndData( nIndex, cName, nHandle, nParent, cType, cVar ) *-----------------------------------------------------------------------------* LOCAL o Default nIndex := 0, ; cName := '', ; nHandle := 0, ; nParent := 0, ; cType := '', ; cVar := '' If empty(nIndex) .or. empty(nHandle) .or. empty(cName) RETURN o EndIf o := TWndData():New():Def( nIndex, cName, nHandle, nParent, cType, cVar ) RETURN o /////////////////////////////////////////////////////////////////////////////// CLASS TWndData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR cVar INIT '' VAR cName INIT '' VAR cType INIT '' VAR nIndex INIT 0 VAR nHandle INIT 0 VAR nParent INIT 0 VAR cChr INIT ',' CLASSDATA oProp AS OBJECT INIT oKeyData() CLASSDATA oName AS OBJECT INIT oKeyData() CLASSDATA oHand AS OBJECT INIT oKeyData() EXPORTED: VAR oCargo AS OBJECT VAR oUserKeys AS OBJECT VAR oEvent AS OBJECT METHOD New() INLINE ( Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::nIndex := nIndex , ::cName := cName, ::nHandle := nHandle, ; ::nParent := nParent, ::cType := cType, ::cVar := cVar, ; ::oCargo := oKeyData(), ::oUserKeys := oKeyData(), ; ::oEvent := oKeyData(Self), ; hmg_SetWindowObject(::nHandle, Self), ; Self ) ACCESS Index INLINE ::nIndex ACCESS Name INLINE ::cName ACCESS Handle INLINE ::nHandle ACCESS Parent INLINE ::nParent ACCESS Type INLINE ::cType ACCESS VarName INLINE ::cVar ACCESS Row INLINE GetWindowRow ( ::nHandle ) ACCESS Col INLINE GetWindowCol ( ::nHandle ) ACCESS Width INLINE GetWindowWidth ( ::nHandle ) ACCESS Height INLINE GetWindowHeight( ::nHandle ) ACCESS ClientWidth INLINE _GetClientRect ( ::nHandle )[ 3 ] ACCESS ClientHeight INLINE _GetClientRect ( ::nHandle )[ 4 ] ACCESS Title INLINE GetWindowText ( ::nHandle ) ACCESS Cargo INLINE _WindowCargo( Self ) ASSIGN Cargo( xVal ) INLINE _WindowCargo( Self, xVal ) ACCESS IsWindow INLINE .T. ACCESS IsControl INLINE .F. ACCESS Chr INLINE ::cChr ASSIGN Chr( cChr ) INLINE ::cChr := iif( HB_ISCHAR(cChr), cChr, ::cChr ) ACCESS WM_nMsgW INLINE WM_WND_LAUNCH ACCESS WM_nMsgC INLINE WM_CNL_LAUNCH METHOD SetProp( xKey, xVal ) INLINE ::oProp:Set( xKey, xVal ) METHOD GetProp( xKey ) INLINE ::oProp:Get( xKey ) METHOD DelProp( xKey ) INLINE ::oProp:Del( xKey ) METHOD UserKeys( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ; ::oUserKeys:Set( Key, Block ), ; ::oUserKeys:Do ( Key, Block, p2, p3 ) ) METHOD Event ( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ; ::oEvent:Set( Key, Block ), ; ::oEvent:Do ( Key, Block, p2, p3 ) ) METHOD PostMsg( nKey, nHandle ) INLINE PostMessage( ::nHandle, ::WM_nMsgW, nKey, ; hb_defaultValue(nHandle, 0) ) METHOD SendMsg( nKey, nHandle ) INLINE SendMessage( ::nHandle, ::WM_nMsgW, nKey, ; hb_defaultValue(nHandle, 0) ) _METHOD DoEvent( Key, nHandle ) _METHOD GetListType() _METHOD GetObj4Type( cType ) _METHOD GetObj4Name( cName ) METHOD GetObj( xName ) INLINE iif( HB_ISCHAR(xName), ::oName:Get(xName), ; ::oHand:Get(xName) ) METHOD Destroy() INLINE ( hmg_DelWindowObject( ::nHandle ), ; iif( HB_ISOBJECT(::oCargo ) , ::oCargo:Destroy() , Nil ), ; iif( HB_ISOBJECT(::oEvent ) , ::oEvent:Destroy() , Nil ), ; iif( HB_ISOBJECT(::oName ) , ::oName:Destroy() , Nil ), ; iif( HB_ISOBJECT(::oHand ) , ::oHand:Destroy() , Nil ), ; iif( HB_ISOBJECT(::oProp ) , ::oProp:Destroy() , Nil ), ; iif( HB_ISOBJECT(::oUserKeys) , ::oUserKeys:Destroy() , Nil ), ; ::oCargo := ::oEvent := ::oName := ::nHandle := ::cVar := Nil, ; ::oUserKeys := ::cType := ::cChr := ::cName := Nil, ; ::nIndex := ::nParent := ::oProp := ::oHand := Nil ) ENDCLASS /////////////////////////////////////////////////////////////////////////////// METHOD GetListType() CLASS TWndData LOCAL oType := oKeyData() LOCAL aType := {} ::oName:Eval({|o| oType:Set(o:cType, o:cType) }) aType := oType:Eval(.T.) oType:Destroy() oType := Nil RETURN aType METHOD GetObj4Type( cType, lEque ) CLASS TWndData LOCAL aObj := {} If ! empty(cType) lEque := hb_defaultValue(lEque, .T.) If ::cChr $ cType; lEque := .F. EndIf FOR EACH cType IN hb_ATokens(upper(cType), ::cChr) ::oName:Eval({|oc| iif( lEque, iif( cType == oc:cType, aAdd(aObj, oc), ), ; iif( cType $ oc:cType, aAdd(aObj, oc), ) ) }) NEXT EndIf RETURN aObj METHOD GetObj4Name( cName ) CLASS TWndData LOCAL aObj := {} If ! empty(cName) FOR EACH cName IN hb_ATokens(cName, ::cChr) ::oName:Eval({|oc| iif( cName $ oc:cName, aAdd(aObj, oc), Nil ) }) NEXT EndIF RETURN aObj METHOD DoEvent ( Key, nHandle ) CLASS TWndData LOCAL o := iif( hmg_IsWindowObject(nHandle), hmg_GetWindowObject(nHandle), Self ) If o:IsWindow RETURN Do_WindowEventProcedure ( ::oEvent:Get(Key), o:Index, o, Key ) EndIf RETURN Do_ControlEventProcedure( ::oEvent:Get(Key), o:Index, o, Key ) *-----------------------------------------------------------------------------* FUNCTION oCnlData( nIndex, cName, nHandle, nParent, cType, cVar, oWin ) *-----------------------------------------------------------------------------* LOCAL o, ob Default nIndex := 0, ; cName := '', ; nHandle := 0, ; nParent := 0, ; cType := '', ; cVar := '' If empty(nIndex) .or. empty(nHandle) .or. empty(nParent) .or. empty(cName); RETURN o EndIf Default oWin := hmg_GetWindowObject( nParent ) If HB_ISOBJECT(oWin) If cType == 'TBROWSE' ob := _HMG_aControlIds [ nIndex ] o := TTsbData():New( oWin, ob ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) Else o := TCnlData():New( oWin ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) EndIf EndIf RETURN o /////////////////////////////////////////////////////////////////////////////// CLASS TCnlData INHERIT TWndData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oWin AS OBJECT EXPORTED: METHOD New( oWnd ) INLINE ( ::Super:New(), ::oWin := oWnd, Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::Super:Def(nIndex, cName, nHandle, nParent, cType, cVar), ; ::Set(), hmg_SetWindowObject( ::nHandle, Self ), ; Self ) ACCESS Title INLINE ::oWin:cTitle ACCESS Caption INLINE _GetCaption ( ::cName, ::oWin:cName ) ACCESS Cargo INLINE _ControlCargo( Self ) ASSIGN Cargo( xVal ) INLINE _ControlCargo( Self, , xVal ) ACCESS Window INLINE ::oWin ACCESS IsWindow INLINE .F. ACCESS IsControl INLINE .T. METHOD PostMsg( nKey ) INLINE PostMessage( ::oWin:nHandle, ::WM_nMsgC, nKey, ::nHandle ) METHOD SendMsg( nKey ) INLINE SendMessage( ::oWin:nHandle, ::WM_nMsgC, nKey, ::nHandle ) METHOD Set() INLINE ( ::oName:Set( ::cName , Self ), ; ::oHand:Set( ::nHandle, Self ) ) METHOD Del() INLINE ( ::oName:Del( ::cName ), ; ::oHand:Del( ::nHandle ) ) METHOD Get( xName ) INLINE iif( HB_ISCHAR(xName), ::oName:Get(xName), ; ::oHand:Get(xName) ) ACCESS Value INLINE _GetValue( , , ::nIndex ) ASSIGN Value( xVal ) INLINE ( _SetValue( , , xVal, ::nIndex ), ; _GetValue( , , ::nIndex ) ) ACCESS SetFocus INLINE _SetFocus ( ::cName, ::oWin:cName ) METHOD SetFocus() INLINE _SetFocus ( ::cName, ::oWin:cName ) ACCESS Disable INLINE _DisableControl( ::cName, ::oWin:cName ) METHOD Disable( nPos ) INLINE _DisableControl( ::cName, ::oWin:cName, nPos ) ACCESS Enable INLINE _EnableControl ( ::cName, ::oWin:cName ) METHOD Enable ( nPos ) INLINE _EnableControl ( ::cName, ::oWin:cName, nPos ) ACCESS Enabled INLINE GetProperty( ::oWin:cName, ::cName, 'Enabled' ) METHOD Enabled( nPos ) INLINE GetProperty( ::oWin:cName, ::cName, 'Enabled', nPos ) ACCESS Show INLINE _ShowControl ( ::cName, ::oWin:cName ) METHOD Show() INLINE _ShowControl ( ::cName, ::oWin:cName ) ACCESS Hide INLINE _HideControl ( ::cName, ::oWin:cName ) METHOD Hide() INLINE _HideControl ( ::cName, ::oWin:cName ) _METHOD DoEvent ( Key, nHandle ) METHOD Destroy() INLINE ( ::Del(), hmg_DelWindowObject( ::nHandle ), ; iif( HB_ISOBJECT(::oCargo ) , ::oCargo:Destroy() , Nil ), ; iif( HB_ISOBJECT(::oEvent ) , ::oEvent:Destroy() , Nil ), ; iif( HB_ISOBJECT(::oOnEventBlock ), ::oOnEventBlock:Destroy(), Nil ), ; iif( HB_ISOBJECT(::oName ) , ::oName:Destroy() , Nil ), ; iif( HB_ISOBJECT(::oHand ) , ::oHand:Destroy() , Nil ), ; iif( HB_ISOBJECT(::oUserKeys) , ::oUserKeys:Destroy() , Nil ), ; ::nParent := ::nIndex := ::cName := ::cType := Nil, ; ::oUserKeys := ::oCargo := ::oEvent := ::cVar := Nil, ; ::oOnEventBlock := ::cChr := ::nHandle := Nil ) ENDCLASS /////////////////////////////////////////////////////////////////////////////// METHOD DoEvent ( Key, nHandle ) CLASS TCnlData LOCAL o := iif( hmg_IsWindowObject(nHandle), hmg_GetWindowObject(nHandle), Self ) RETURN Do_ControlEventProcedure( ::oEvent:Get(Key), o:Index, o, Key ) /////////////////////////////////////////////////////////////////////////////// CLASS TTsbData INHERIT TCnlData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oTBrowse AS OBJECT EXPORTED: METHOD New( oWnd, oTsb ) INLINE ( ::Super:New(oWnd), ::oTBrowse := oTsb, Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::Super:Def(nIndex, cName, nHandle, nParent, cType, cVar), ; ::Set(), hmg_SetWindowObject( ::nHandle, Self ), ; Self ) ACCESS Caption INLINE ::oWin:cName + "." + ::cName ACCESS Tsb INLINE ::oTBrowse METHOD Destroy() INLINE ( ::Super:Destroy(), ::oTBrowse := Nil ) ENDCLASS /////////////////////////////////////////////////////////////////////////////// *-----------------------------------------------------------------------------* FUNCTION oKeyData( Obj, Event ) *-----------------------------------------------------------------------------* LOCAL o If HB_ISNIL ( Event ) ; o := TKeyData():New():Def( Obj ) ElseIf HB_ISLOGICAL( Event ) .and. Event; o := TWmEData():New( Obj ) Else ; o := TThrData():New():Def( Obj, hb_mtvm() ) EndIf RETURN o ////////////////////////////////////////////////////////////////////////////////////////////// CLASS TWmEData ////////////////////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oObj AS OBJECT VAR aMsg INIT hb_Hash() VAR lMsg INIT .F. EXPORTED: METHOD New( o ) INLINE ( ::oObj := o, Self ) CONSTRUCTOR ACCESS IsEvent INLINE ::lMsg METHOD Set( nMsg, Block ) INLINE ( hb_HSet ( ::aMsg, nMsg, Block ), ::lMsg := Len( ::aMsg ) > 0 ) METHOD Get( nMsg, Def ) INLINE hb_HGetDef( ::aMsg, nMsg, Def ) METHOD Del( nMsg ) INLINE ( hb_HDel ( ::aMsg, nMsg ), ::lMsg := Len( ::aMsg ) > 0 ) _METHOD Do ( nMsg, wParam, lParam ) _METHOD Destroy() ENDCLASS ////////////////////////////////////////////////////////////////////////////////////////////// METHOD Do( nMsg, wParam, lParam ) CLASS TWmEData LOCAL o, r, b := ::Get( nMsg ) If HB_ISBLOCK( b ) o := ::Obj If o:IsWindow r := Do_WindowEventProcedure ( b, o:Index, o, nMsg, wParam, lParam ) // {|ow,nm,wp,lp| ... } Else r := Do_ControlEventProcedure( b, o:Index, o, nMsg, wParam, lParam ) // {|oc,nm,wp,lp| ... } EndIf EndIf RETURN iif( empty( r ), 0, 1) METHOD Destroy() CLASS TWmEData LOCAL i, k If HB_ISHASH( ::aMsg ) For i := 1 To Len( ::aMsg ) k := hb_HKeyAt( ::aMsg, i ) hb_HSet( ::aMsg, k, Nil ) hb_HDel( ::aMsg, k ) Next EndIf ::oObj := ::aMsg := Nil RETURN Nil ////////////////////////////////////////////////////////////////////////////////////////////// CLASS TKeyData ////////////////////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oObj AS OBJECT VAR aKey INIT hb_Hash() VAR lKey INIT .F. EXPORTED: VAR Cargo METHOD New() INLINE ( Self ) CONSTRUCTOR METHOD Def( o ) INLINE ( ::Obj := o, Self ) METHOD Set( Key, Block ) INLINE ( hb_HSet ( ::aKey, Key, Block ), ::lKey := .T. ) METHOD Get( Key, Def ) INLINE hb_HGetDef( ::aKey, Key, Def ) METHOD Del( Key ) INLINE ( hb_HDel ( ::aKey, Key ), ::lKey := Len( ::aKey ) > 0 ) METHOD Do ( Key, p1, p2, p3 ) BLOCK {|Self,Key,p1,p2,p3,b| b := ::Get(Key), ; iif( HB_ISBLOCK(b), EVal(b, ::oObj, Key, p1, p2, p3), Nil ) } ACCESS Obj INLINE ::oObj ASSIGN Obj( o ) INLINE ::oObj := iif( HB_ISOBJECT(o), o, Self ) ACCESS Len INLINE Len( ::aKey ) ACCESS IsEvent INLINE ::lKey METHOD IsBLock( Key ) INLINE HB_ISBLOCK( ::Get(Key) ) _METHOD Eval( Block ) _METHOD Sum( Key, xSum ) _METHOD Destroy() ENDCLASS ////////////////////////////////////////////////////////////////////////////////////////////// METHOD Eval( Block ) CLASS TKeyData LOCAL m, i, b := HB_ISBLOCK(Block) LOCAL l := HB_ISLOGICAL(Block) .and. Block LOCAL a := iif( b, Nil, array(0) ) For i := 1 To ::Len If b; Eval( Block, hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i ) ElseIf l; aAdd( a, { hb_HValueAt( ::aKey, i ) } ) Else ; aAdd( a, { hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i } ) EndIf Next RETURN a METHOD Sum( Key, xSum ) CLASS TKeyData LOCAL sum := ::Get( Key, 0 ) If HB_ISNUMERIC( xSum ) If HB_ISNUMERIC( sum ); sum += xSum Else ; sum := xSum EndIf ::Put( Key, sum ) ElseIf HB_ISARRAY( xSum ) If HB_ISARRAY(sum) .and. Len(sum) == Len(xSum) AEval(xSum, {|s,i| sum[ i ]:= iif( HB_ISNUMERIC( s ), sum[ i ] + s, s ) } ) Else sum := xSum EndIf ::Put( Key, sum ) EndIf RETURN Nil METHOD Destroy CLASS TKeyData LOCAL i, k, o If HB_ISHASH( ::aKey ) For i := 1 To Len( ::aKey ) k := hb_HKeyAt( ::aKey, i ) hb_HSet( ::aKey, k, Nil ) hb_HDel( ::aKey, k ) Next EndIf If HB_ISOBJECT(::Cargo) .and. ::Cargo:ClassName == ::ClassName o := ::Cargo If HB_ISHASH( o:aKey ) For i := 1 To Len( o:aKey ) k := hb_HKeyAt( o:aKey, i ) hb_HSet( o:aKey, k, Nil ) hb_HDel( o:aKey, k ) Next EndIf EndIf ::oObj := ::aKey := ::Cargo := Nil RETURN Nil ////////////////////////////////////////////////////////////////////////////////////////////// CLASS TThrData ////////////////////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oObj AS OBJECT VAR aKey INIT hb_Hash() VAR lMT INIT .F. SYNC METHOD SGD( n, k, v ) EXPORTED: VAR Cargo METHOD New() INLINE ( Self ) CONSTRUCTOR METHOD Def( o, lVmMt ) INLINE ( ::Obj := o, ::MT := lVmMt, Self ) METHOD Set( Key, Block ) INLINE iif( ::lMT, ::SGD( 1, Key, Block ), hb_HSet ( ::aKey, Key, Block ) ) METHOD Get( Key, Def ) INLINE iif( ::lMT, ::SGD( 2, Key, Def ), hb_HGetDef( ::aKey, Key, Def ) ) METHOD Del( Key ) INLINE iif( ::lMT, ::SGD( 3, Key ), ; iif( hb_hHasKey( ::aKey, Key ), hb_HDel ( ::aKey, Key ), Nil ) ) METHOD Do ( Key, p1, p2, p3 ) BLOCK {|Self,Key,p1,p2,p3,b| b := ::Get(Key), ; iif( HB_ISBLOCK(b), EVal(b, ::oObj, Key, p1, p2, p3), Nil ) } ACCESS MT INLINE ::lMT ASSIGN MT( lVmMt ) INLINE ::lMT := iif( HB_ISLOGICAL(lVmMt), lVmMt, .F. ) ACCESS Obj INLINE ::oObj ASSIGN Obj( o ) INLINE ::oObj := iif( HB_ISOBJECT(o), o, Self ) ACCESS Len INLINE Len( ::aKey ) METHOD IsBLock( Key ) INLINE HB_ISBLOCK( ::Get(Key) ) _METHOD Eval( Block ) _METHOD Sum( Key, xSum ) _METHOD Destroy() ENDCLASS ////////////////////////////////////////////////////////////////////////////////////////////// METHOD SGD( n, k, v ) CLASS TThrData SWITCH n CASE 1 hb_HSet( ::aKey, k, v ) EXIT CASE 2 RETURN hb_HGetDef( ::aKey, k, v ) EXIT CASE 3 If hb_hHasKey( ::aKey, k ) hb_HDel ( ::aKey, k ) EndIf EXIT CASE 4 RETURN { hb_HKeyAt( ::aKey, k ), hb_HValueAt( ::aKey, k ) } EXIT END RETURN Nil METHOD Eval( Block ) CLASS TThrData LOCAL m, i, b := HB_ISBLOCK(Block) LOCAL l := HB_ISLOGICAL(Block) .and. Block LOCAL a := iif( b, Nil, array(0) ) For i := 1 To ::Len If ::lMT m := ::SGD( 4, i ) If b; Eval( Block, m[ 2 ], m[ 1 ], i ) ElseIf l; aAdd( a, { m[ 2 ] } ) Else ; aAdd( a, { m[ 2 ], m[ 1 ], i } ) EndIf Else If b; Eval( Block, hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i ) ElseIf l; aAdd( a, { hb_HValueAt( ::aKey, i ) } ) Else ; aAdd( a, { hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i } ) EndIf EndIf Next RETURN a METHOD Sum( Key, xSum ) CLASS TThrData LOCAL sum := ::Get( Key, 0 ) If HB_ISNUMERIC( xSum ) If HB_ISNUMERIC( sum ); sum += xSum Else ; sum := xSum EndIf ::Put( Key, sum ) ElseIf HB_ISARRAY( xSum ) If HB_ISARRAY(sum) .and. Len(sum) == Len(xSum) AEval(xSum, {|s,i| sum[ i ]:= iif( HB_ISNUMERIC( s ), sum[ i ] + s, s ) } ) Else sum := xSum EndIf ::Put( Key, sum ) EndIf RETURN Nil METHOD Destroy CLASS TThrData LOCAL i, k, o If HB_ISHASH( ::aKey ) For i := 1 To Len( ::aKey ) k := hb_HKeyAt( ::aKey, i ) hb_HSet( ::aKey, k, Nil ) hb_HDel( ::aKey, k ) Next EndIf If HB_ISOBJECT(::Cargo) .and. ::Cargo:ClassName == ::ClassName o := ::Cargo If HB_ISHASH( o:aKey ) For i := 1 To Len( o:aKey ) k := hb_HKeyAt( o:aKey, i ) hb_HSet( o:aKey, k, Nil ) hb_HDel( o:aKey, k ) Next EndIf EndIf ::oObj := ::aKey := ::Cargo := ::lMT := Nil RETURN Nil [/pre2]

SergKis: PS Функции [pre2] // Misk function #include "minigui.ch" ////////////////////////////////////////////////////////////////////////////////////////////////////////////// *-----------------------------------------------------------------------------* FUNCTION _WindowObj( FormName ) *-----------------------------------------------------------------------------* LOCAL h := iif( HB_ISNUMERIC( FormName ), FormName, GetFormHandle( FormName ) ) RETURN hmg_GetWindowObject( h ) *-----------------------------------------------------------------------------* FUNCTION _WindowCargo( FormName, xValue ) *-----------------------------------------------------------------------------* LOCAL o := iif( HB_ISOBJECT( FormName), FormName, _WindowObj( FormName ) ) LOCAL i := iif( HB_ISOBJECT( o ), o:Index , 0 ) If i > 0 If Pcount() > 1; _HMG_aFormMiscData2 [ i ] := xValue Else ; RETURN _HMG_aFormMiscData2 [ i ] Endif EndIf RETURN NIL *-----------------------------------------------------------------------------* FUNCTION _ControlObj( ControlName, FormName ) *-----------------------------------------------------------------------------* LOCAL h := iif( HB_ISNUMERIC( ControlName ), ControlName, ; GetControlHandle( ControlName, FormName ) ) RETURN hmg_GetWindowObject( h ) *-----------------------------------------------------------------------------* FUNCTION _ControlCargo( ControlName, FormName, xValue ) *-----------------------------------------------------------------------------* LOCAL o := iif( HB_ISOBJECT( ControlName ), ControlName, ; _ControlObj( ControlName, FormName ) ) LOCAL i := iif( HB_ISOBJECT( o ), o:Index, 0 ) If i > 0 If Pcount() > 2; _HMG_aControlMiscData2 [ i ] := xValue Else ; RETURN _HMG_aControlMiscData2 [ i ] EndIf EndIf RETURN NIL *--------------------------------------------------------------------------------* Function Do_ControlEventProcedure ( bBlock, i, p1, p2, p3, p4 ) *--------------------------------------------------------------------------------* Local RetVal if HB_ISBLOCK( bBlock ) .and. i > 0 _PushEventInfo() _HMG_ThisFormIndex := ascan ( _HMG_aFormHandles , _HMG_aControlParentHandles[ i ] ) _HMG_ThisType := 'C' _HMG_ThisIndex := i _HMG_ThisFormName := _HMG_aFormNames [ _HMG_ThisFormIndex ] _HMG_ThisControlName := _HMG_aControlNames [ _HMG_ThisIndex ] RetVal := Eval( bBlock, p1, p2, p3, p4 ) _PopEventInfo() EndIf Return RetVal *-----------------------------------------------------------------------------* Function Do_WindowEventProcedure ( bBlock, i, p1, p2, p3, p4 ) *-----------------------------------------------------------------------------* Local RetVal if HB_ISBLOCK( bBlock ) .and. i > 0 _PushEventInfo() _HMG_ThisFormIndex := i _HMG_ThisEventType := '' _HMG_ThisType := 'W' _HMG_ThisIndex := i _HMG_ThisFormName := _HMG_aFormNames [ _HMG_ThisFormIndex ] _HMG_ThisControlName := "" RetVal := Eval( bBlock, p1, p2, p3, p4 ) _PopEventInfo() EndIf Return RetVal *-----------------------------------------------------------------------------* FUNC Do_OnWndInit( i, cVar ) *-----------------------------------------------------------------------------* LOCAL nIndex := i LOCAL cName := _HMG_aFormNames [ i ] LOCAL nHandle := _HMG_aFormHandles [ i ] LOCAL nParent := _HMG_aFormParentHandle [ i ] LOCAL cType := _HMG_aFormType [ i ] RETURN oWndData( nIndex, cName, nHandle, nParent, cType, cVar ) *-----------------------------------------------------------------------------* FUNC Do_OnWndRelease( i ) *-----------------------------------------------------------------------------* LOCAL hWnd := _HMG_aFormHandles [ i ] If hmg_IsWindowObject( hWnd ) o := hmg_GetWindowObject( hWnd ) If __objHasMethod( o, 'Del' ); o:Del() EndIf If __objHasMethod( o, 'Destroy' ); o:Destroy() EndIf RETURN .T. EndIf RETURN .F. *-----------------------------------------------------------------------------* FUNC Do_OnCtlInit( i, cVar ) *-----------------------------------------------------------------------------* LOCAL nIndex := i LOCAL cName := _HMG_aControlNames [ i ] LOCAL nHandle := _HMG_aControlHandles [ i ] LOCAL nParent := _HMG_aControlParentHandles[ i ] LOCAL cType := _HMG_aControlType [ i ] RETURN oCnlData( nIndex, cName, nHandle, nParent, cType, cVar ) *-----------------------------------------------------------------------------* FUNC Do_OnCtlRelease( i ) *-----------------------------------------------------------------------------* LOCAL hWnd := _HMG_aControlHandles [ i ] If hmg_IsWindowObject( hWnd ) o := hmg_GetWindowObject( hWnd ) If __objHasMethod( o, 'Del' ); o:Del() EndIf If __objHasMethod( o, 'Destroy' ); o:Destroy() EndIf RETURN .T. EndIf RETURN .F. FUNC Do_OnWndLaunch( hWnd, nMsg, wParam, lParam ) If hmg_IsWindowObject ( hWnd ) hmg_GetWindowObject( hWnd ):DoEvent( wParam, lParam ) EndIf HB_SYMBOL_UNUSED(nMsg) RETURN Nil FUNC Do_OnCnlLaunch( hWnd, nMsg, wParam, lParam ) If ! empty(lParam); hWnd := lParam EndIf If hmg_IsWindowObject ( hWnd ) hmg_GetWindowObject( hWnd ):DoEvent( wParam, lParam ) EndIf HB_SYMBOL_UNUSED(nMsg) RETURN Nil #pragma BEGINDUMP #include <windows.h> #include <TChar.h> #include "hbapi.h" #include "hbapiitm.h" #include "hbapicdp.h" #include "hbapifs.h" #include "hbvm.h" #include <commctrl.h> HB_FUNC( HMG_SETWINDOWOBJECT ) { PHB_ITEM pObject; HWND hWnd = ( HWND ) hb_parnl(1); if( IsWindow( hWnd ) ) { pObject = ( PHB_ITEM ) hb_param( 2, HB_IT_OBJECT ); // hb_parnl(2); if( pObject && HB_IS_OBJECT( pObject ) ) { pObject = hb_itemNew( pObject ); // Новая ссылка на объект hb_gcLock( pObject ); // Ref++ SetWindowLongPtr( hWnd, GWLP_USERDATA, ( LPARAM ) pObject); hb_retl( TRUE ); return ; } } hb_retl( FALSE ); } HB_FUNC( HMG_DELWINDOWOBJECT ) { PHB_ITEM pObject; HWND hWnd = ( HWND ) hb_parnl(1); if( IsWindow( hWnd ) ) { pObject = ( PHB_ITEM ) GetWindowLongPtr( hWnd, GWLP_USERDATA ); SetWindowLongPtr( hWnd, GWLP_USERDATA, 0); if( pObject && HB_IS_OBJECT( pObject ) ){ hb_gcUnlock( pObject ); // Ref -- hb_itemRelease( pObject ); } } } HB_FUNC( HMG_GETWINDOWOBJECT ) { HWND hWnd = ( HWND ) hb_parnl(1); if( ! IsWindow( hWnd ) ) { hb_ret(); return; } hb_itemReturn( ( PHB_ITEM ) GetWindowLongPtr( hWnd, GWLP_USERDATA ) ); } HB_FUNC( HMG_ISWINDOWOBJECT ) { PHB_ITEM pObject; HWND hWnd = ( HWND ) hb_parnl(1); if( ! IsWindow( hWnd ) ) { hb_retl( FALSE ); return; } pObject = ( PHB_ITEM ) GetWindowLongPtr( hWnd, GWLP_USERDATA ); if( ! pObject ) { hb_retl( FALSE ); return; } if( ! HB_IS_OBJECT( pObject ) ) { hb_retl( FALSE ); return; } hb_retl( TRUE ); } #pragma ENDDUMP [/pre2]

gfilatov2002: SergKis пишет: На своей lib собрал пример У меня тоже работает этот пример после чистки предупреждений компилятора (с ключом -w3) Благодарю за помощь

SergKis: gfilatov2002 пишет У меня тоже работает этот пример после чистки предупреждений компилятора (с ключом -w3) "Был не прав, вспылил." (с) Голова была забита изменением своей lib, времени мало, а кода ... . Учту. Пожелания: Добавить к _HMG_bOnFormInit := {|nIndex,cVarName | Do_OnWndInit ( nIndex, cVarName ) } _HMG_bOnFormDestroy := {|nIndex | Do_OnWndRelease( nIndex ) } _HMG_bOnControlInit := {|nIndex,cVarName | Do_OnCnlInit ( nIndex, cVarName ) } _HMG_bOnControlDestroy := {|nIndex | Do_OnCnlRelease( nIndex ) } _HMG_bOnWndLaunch := {|hWnd,nMsg,wParam,lParam| Do_OnWndLaunch ( hWnd, nMsg, wParam, lParam ) } _HMG_bOnCnlLaunch := {|hWnd,nMsg,wParam,lParam| Do_OnCnlLaunch ( hWnd, nMsg, wParam, lParam ) } _HMG_bOnEvents := {|hWnd,nMsg,wParam,lParam| Do_OnEvents ( hWnd, nMsg, wParam, lParam ) } и стандартную функцию для SET EVENTS FUNCTION TO SET MDIEVENTS FUNCTION TO // у нас 90% MDI с условным именем FUNC hmg_Events( hWnd, nMsg, wParam, lParam ) If HB_ISBLOCK( _HMG_bOnEvents ) RETURN EVal ( _HMG_bOnEvents, hWnd, nMsg, wParam, lParam ) EndIf RETURN 0

gfilatov2002: SergKis пишет: _HMG_bOnEvents := {|hWnd,nMsg,wParam,lParam| Do_OnEvents ( hWnd, nMsg, wParam, lParam ) } Не смогу это сделать, пока не увижу кода функции Do_OnEvents() SergKis пишет: стандартную функцию для SET EVENTS FUNCTION TO SET MDIEVENTS FUNCTION TO Стандартный обработчик для дочерних MDI окон - это функция MdiEvents(). Возможно, этот кодовый блок нужно добавить туда, нл я не уверен Пока что записал в текущий файл changelog таким образом: [pre2] * New: Added the OOP classes for managing of the Minigui windows and controls as objects. It is an experimental feature which is guarded by the constant _OBJECT_ in the core. You can disable the OOP classes at all if you will add the following assignings on top in your main module: _HMG_bOnFormInit := NIL _HMG_bOnFormDestroy := NIL _HMG_bOnControlInit := NIL _HMG_bOnControlDestroy := NIL A new property called 'Object' was added to manipulate the objects. You can get this property at runtime: - function syntax: GetProperty ( Form, 'Object' ) --> oFormObject GetProperty ( Form, Control, 'Object' ) --> oControlObject - pseudo-OOP syntax: Form.Object --> oFormObject Form.Control.Object --> oControlObject Suggested and contributed by SergKis. Revised by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\Tsb_UserKeysEvent) [/pre2] Также пришлось отключить вызов метода Destroy для модальных окон, добавить дополнительные проверки, чтобы не падал код, написанный без использования объектов. В целом, впечатления двойственные: вроде бы и добавляются новые возможности, но пока код достаточно сырой... Также не уверен, что кто-то, кроме уважаемого автора, будет тратить силы на изучение этих новых возможностей

SergKis: gfilatov2002 Пока что записал в текущий файл changelog таким образом: Думается Set\GetProperty с объектом не надо вставлять в ядро, пусть все будет на уровне примера, т.е _HMG_... переменные зарезервированы #command тоже только на уровне примера. Переменные можно использовать[pre2] _HMG_bOnFormInit - для чтения данных окна из конфигуратора _HMG_bOnFormDestroy - для записи данных окна в конфигуратор _HMG_bOnControlInit - для чтения данных контрола из конфигуратора _HMG_bOnControlDestroy - для записи данных контрола в конфигуратор [/pre2] Также не уверен, что кто-то, кроме уважаемого автора, будет тратить силы на изучение этих новых возможностей Для меня это возможность совместимости версий, т.е. могу с hmg 2.07 переползти на 17.07, возможно, с минимальными изменениями lib. Классы это по интересам, хотя замена содержимого функций SetProp, GetProp, EnumProp на работу с классом (у меня есть в примере), уберет те недостатки, которые есть сегодня. К примеру, если иметь на hWnd два адреса хранения объектов 1- системный hmg, 2 - пользовательский (как сейчас), то в 1 hmg сделать класс контейнер (начать Set\GetProp) и расширять постепенно (данные из _HMG_aControlMiskData1 перенести), если надо, а 2 usr для пользовательских классов (как в примере) С MdiEvents() можно не парится, сегодня нет и как то живем.

gfilatov2002: SergKis пишет: Set\GetProperty с объектом не надо вставлять в ядро Я так сначала тоже думал, но после переноса Вашего кода в ядро библиотеки удалось обнаружить проблемы с поддержкой Spinner и RadioGroup в предлагаемой реализации, а также конфликт этих классов с модальными окнами. Вроде удалось эти недостатки побороть, плэтому оставил эти классы в ядре Также адаптировал Вашу работу для поддержки xHarbour. Но, конечно, желательно было бы добавить небольшое описание с примерами работы новых классов. Думаю, это было бы очень полезно, учитывая, что раньше пользователи не использовали классы на уровне ядра...

Andrey: gfilatov2002 пишет: Но, конечно, желательно было бы добавить небольшое описание с примерами работы новых классов. Я тоже за !

SergKis: gfilatov2002 пишет: желательно было бы добавить небольшое описание такое [pre2] /////////////////////////////////////////////////////////////////////////////// CLASS TWndData // класс для работы с окном /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR cVar INIT '' // переменные VAR cName INIT '' // класса VAR cType INIT '' // заполняются из VAR nIndex INIT 0 // переменных _HMG_aForm...\_HMG_aControl... VAR nHandle INIT 0 // после функций _Define...(...) VAR nParent INIT 0 // окна или контрола VAR cChr INIT ',' // символ разделитель списка для hb_ATokens(...) CLASSDATA oProp AS OBJECT INIT oKeyData() // для глобальных данных окна\контрола CLASSDATA oName AS OBJECT INIT oKeyData() // индекс контролов по наименованию на окне CLASSDATA oHand AS OBJECT INIT oKeyData() // индекс контролов по хендлеру на окне EXPORTED: VAR oCargo AS OBJECT // свойство, аналог Cargo, организованный как объект, // с доступом через :Set(...), :Get(...), :Del(...), ... VAR oUserKeys AS OBJECT // свойство, аналог UserKeys из TsBrowse VAR oEvent AS OBJECT // свойство, для регистрации событий окна\контрола // для работы по сообщениям VAR oOnEventBlock AS OBJECT // свойство, для регистрации событий WM_... окна\контрола? // для исп. в SET EVENTS FUNCTION TO ... функции и др. // доступ через свойство :bOnEvent // Пример: SET EVENTS FUNCTION TO MYEVENTS ... // установки могут быть как на окно, так и на контрол :bOnEvent:Set( WM_CREATE , {|o,nm,wp,lp| ... } ) :bOnEvent:Set( WM_COMMAND, {|o,nm,wp,lp| ... } ) :bOnEvent:Set( WM_PAINT , {|o,nm,wp,lp| ... } ) :bOnEvent:Set( WM_SIZE , {|o,nm,wp,lp| ... } ) ... FUNC MyEvents ( hWnd, nMsg, wParam, lParam ) LOCAL o, r If hmg_IsWindowObject(hWnd) o := hmg_GetWindowObject(hWnd) // может быть объект окна\контрола If o:bOnEvent:IsEvent // есть регистрированные события r := o:bOnEvent:Do(nMsg, wParam, lParam ) If r > 0; RETURN r EndIf EndIf EndIf RETURN Events( hWnd, nMsg, wParam, lParam ) METHOD New() INLINE ( Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::nIndex := nIndex , ::cName := cName, ::nHandle := nHandle, ; ::nParent := nParent, ::cType := cType, ::cVar := cVar, ; ::oCargo := oKeyData(), ::oOnEventBlock := oKeyData(Self, .T.), ; ::oEvent := oKeyData(Self), ::oUserKeys := oKeyData(), ; hmg_SetWindowObject(::nHandle, Self), ; Self ) // далее свойства доступа для работы с объектом, т.е. надо исп. имя после ACCESS : // :Index, :Name, :Handle, :ClientWidth, ... ACCESS Index INLINE ::nIndex ACCESS Name INLINE ::cName ACCESS Handle INLINE ::nHandle ACCESS Parent INLINE ::nParent ACCESS Type INLINE ::cType ACCESS VarName INLINE ::cVar ACCESS Row INLINE GetWindowRow ( ::nHandle ) ACCESS Col INLINE GetWindowCol ( ::nHandle ) ACCESS Width INLINE GetWindowWidth ( ::nHandle ) ACCESS Height INLINE GetWindowHeight( ::nHandle ) ACCESS ClientWidth INLINE _GetClientRect ( ::nHandle )[ 3 ] ACCESS ClientHeight INLINE _GetClientRect ( ::nHandle )[ 4 ] ACCESS Title INLINE GetWindowText ( ::nHandle ) ACCESS Cargo INLINE _WindowCargo( Self ) ASSIGN Cargo( xVal ) INLINE _WindowCargo( Self, xVal ) // свойство ASSIGN позволяет делать присвоение значения, т.е. :Cargo := xValue ACCESS IsWindow INLINE .T. ACCESS IsControl INLINE .F. ACCESS Chr INLINE ::cChr ASSIGN Chr( cChr ) INLINE ::cChr := iif( HB_ISCHAR(cChr), cChr, ::cChr ) ACCESS bOnEvent INLINE ::oOnEventBlock ACCESS WM_nMsgW INLINE WM_WND_LAUNCH ACCESS WM_nMsgC INLINE WM_CNL_LAUNCH // аналоги функций Set\GetProp, уст. значения доступны при работе с окном\контролом // :DelProp(...) делать не обязательно, убирается автоматом в :Destroy() METHOD SetProp( xKey, xVal ) INLINE ::oProp:Set( xKey, xVal ) METHOD GetProp( xKey ) INLINE ::oProp:Get( xKey ) METHOD DelProp( xKey ) INLINE ::oProp:Del( xKey ) // свойство, аналог UserKeys из TsBrowse METHOD UserKeys( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ; ::oUserKeys:Set( Key, Block ), ; ::oUserKeys:Do ( Key, Block, p2, p3 ) ) // Пример: // WITH OBJECT oWnd // :oUserKeys:Cargo := oKeyData() // :oUserKeys:Cargo:Set(1, "Harbour.") // :oUserKeys:Cargo:Set(2, "MiniGui.") // :oUserKeys:Cargo:Set(3, "OK !") // :UserKeys('FRM_1' , {|o | MsgBox( ( This.Name )+" | "+o:Cargo:Get(1)+( This.FRM_1.Cargo ), oWnd:Name ) }) // :UserKeys('FRM_2' , {|o | MsgBox( ( This.Name )+" | "+o:Cargo:Get(2)+( This.FRM_2.Cargo ), oWnd:Name ) }) // :UserKeys('FRM_3' , {|o | MsgBox( ( This.Name )+" | "+o:Cargo:Get(3)+( This.FRM_3.Cargo ), oWnd:Name ) }) // END WITH // устанавливаем\регистрируем события для работы по сообщениям. METHOD Event ( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ; ::oEvent:Set( Key, Block ), ; ::oEvent:Do ( Key, Block, p2, p3 ) ) // Примеры: // WITH OBJECT oWnd /* для окна */ // :Event( 1, {|ow,ky| This_Msg('Window message ' + "nKey="+cValToChar(ky), ow:Name) } ) // :Event( 2, {|ow,ky| This_Msg('Window message ' + "nKey="+cValToChar(ky), ow:Name) } ) // :Event( 3, {| | AEval( This.REFR.Cargo , {|oc| oc:SendMsg(2) }) } ) // ... // END WITH // WITH OBJECT oWnd:GetObj(cNam) /* для контрола */ // :Event( 1, {|oc,kl | kl := Eval( oBrw1:GetColumn('KOLV'):bData ), ; // oc:Value := alltrim(cValToChar(kl)) } ) // :Event( 2, {|oc | oc:Window:oCargo:Set(oc:Name, oc:Value) } ) // .... // END WITH // // PS. исполнять регистрированные блоки кода можно и без сообщений, делая в нужном // месте :Event(1) или :Event(2), ... . В таком случае, ключ может быть и не // цифрой и в блок кода можно передать параметры (до 3-х), т.е. // :Event('MyKey', p1, p2, p3 ) это примечание относится и к :UserKeys(...) // посылаем сообщение окну (без ожидания) для выполнения Event с ключем nKey, // если nHandle задан контрола, то для выполнения создается среда _HMG_This... контрола, // если nHandle не задан, то среда _HMG_This... окна. METHOD PostMsg( nKey, nHandle ) INLINE PostMessage( ::nHandle, ::WM_nMsgW, nKey, ; hb_defaultValue(nHandle, 0) ) // посылаем сообщение окну (с ожиданием завершения) для выполнения Event с ключем nKey, // если nHandle задан контрола, то для выполнения создается среда _HMG_This... контрола, // если nHandle не задан, то среда _HMG_This... окна. METHOD SendMsg( nKey, nHandle ) INLINE SendMessage( ::nHandle, ::WM_nMsgW, nKey, ; hb_defaultValue(nHandle, 0) ) // выполняет блок кода ключа Key окна\контрола от значения nHandle, создавая среду // переменных _HMG_This... от nHandle. _METHOD DoEvent( Key, nHandle ) // список (оглавление) типов контролов на окне (массив) _METHOD GetListType() // Пример: // AEval( oWnd:GetListType(), {|ct,ni| _LogFile(.T., ni, ct) }) // получить список (массив) объектов контролов по типу\типам контролов, к примеру, // для рассылки сообщений :Post\SendMsg(...) _METHOD GetObj4Type( cType, lEque ) // Примеры: // lEgue будет .T. по умолчанию // AEval( oWnd:GetObj4Type('GETBOX'), {|oc,ni| _LogFile(.T., ni, oc:Name, oc:Type, oc:Index, oc:VarName) }) // lEgue будет .F., т.к. cType задан списком // AEval( oWnd:GetObj4Type('LABEL,GETBOX'), {|oc,ni| _LogFile(.T., ni, oc:Name, oc:Type, oc:Index, oc:VarName) }) // lEgue зададим .F., выберем объекты контролов по вхождению 'BUT' $ :Type // AEval( oWnd:GetObj4Type('BUT', .F.), {|oc,ni| _LogFile(.T., ni, oc:Name, oc:Type, oc:Index, oc:VarName) }) // получить список (массив) объектов контролов по именам контролов, к примеру, // для рассылки сообщений :Post\SendMsg(...) _METHOD GetObj4Name( cName ) // Пример: // AEval( oWnd:GetObj4Name('Cnt_,Rec_'), {|oc,ni| _LogFile(.T., ni, oc:Name, oc:Type, oc:Index, oc:VarName) }) // т.е. если определенным образом составлять имена контролов, то можно получать объекты // по разрезам\фильтрам имен // получить объект контрола окна по его имени или Handle. Получаем через индексы контролов. METHOD GetObj( xName ) INLINE iif( HB_ISCHAR(xName), ::oName:Get(xName), ; ::oHand:Get(xName) ) // Примеры: // oWnd:GetObj( cNam ) // oWnd:GetObj( This.FRM_1.Handle ) после DEFINE WINDOW ... или в ACTION контрола // oWnd:GetObj( This.Handle ) // освобождаем память METHOD Destroy() INLINE ( ; ::oCargo := iif( HB_ISOBJECT(::oCargo ), ::oCargo:Destroy() , Nil ), ; ::oEvent := iif( HB_ISOBJECT(::oEvent ), ::oEvent:Destroy() , Nil ), ; ::oOnEventBlock := iif( HB_ISOBJECT(::oOnEventBlock), ::oOnEventBlock:Destroy(), Nil ), ; ::oName := iif( HB_ISOBJECT(::oName ), ::oName:Destroy() , Nil ), ; ::oHand := iif( HB_ISOBJECT(::oHand ), ::oHand:Destroy() , Nil ), ; ::oProp := iif( HB_ISOBJECT(::oProp ), ::oProp:Destroy() , Nil ), ; ::oUserKeys := iif( HB_ISOBJECT(::oUserKeys ), ::oUserKeys:Destroy() , Nil ), ; ( ::nIndex := ::nParent := ::cType := ::cName := ::cVar := ::cChr := Nil ), ; hmg_DelWindowObject( ::nHandle ), ::nHandle := Nil ) ENDCLASS /////////////////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////////////////////////////// CLASS TCnlData INHERIT TWndData // класс для работы с контролом /////////////////////////////////////////////////////////////////////////////// // наследован от класса окна, следовательно // в нем доступны все свойства и методы окна, // но относятся к контролу. PROTECTED: VAR oWin AS OBJECT // переменная для хранения ссылки на объект окна EXPORTED: METHOD New( oWnd ) INLINE ( ::Super:New(), ::oWin := oWnd, Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::Super:Def(nIndex, cName, nHandle, nParent, cType, cVar), ; ::Set(), hmg_SetWindowObject( ::nHandle, Self ), ; Self ) // далее свойства доступа для работы с объектом, т.е. надо исп. имя после ACCESS : // :Title, :Caption, :Cargo, :Index, :Name, :ClientWidth, ... ACCESS Title INLINE ::oWin:cTitle ACCESS Caption INLINE _GetCaption ( ::cName, ::oWin:cName ) ACCESS Cargo INLINE _ControlCargo( Self ) ASSIGN Cargo( xVal ) INLINE _ControlCargo( Self, , xVal ) // свойство ASSIGN позволяет делать присвоение значения, т.е. :Cargo := xValue // доступ к свойствам\методам окна ACCESS Window INLINE ::oWin // Примеры: // WITH OBJECT oWnd:GetObj(cNam) // :Title // :Window:Title // :Window:Cargo := { 1,2,3,4,5 } // :Window:Cargo // :Window:oCargo:Set(cNam, :Value ) // :Window:oCargo:Get(cNam) // :Window:Hide // :Window:Show // END WITH ACCESS IsWindow INLINE .F. // Пример: // If o:IsWindow // окно // Else // контрол // Endif ACCESS IsControl INLINE .T. // Пример: // If o:IsControl // контрол // Else // окно // Endif // посылаем сообщение контролу (без ожидания) для выполнения Event с ключем nKey, // для выполнения всегда создается среда _HMG_This... контрола METHOD PostMsg( nKey ) INLINE PostMessage( ::oWin:nHandle, ::WM_nMsgC, nKey, ::nHandle ) // посылаем сообщение контролу (с ожиданием завершения) для выполнения Event с ключем nKey, // для выполнения всегда создается среда _HMG_This... контрола METHOD SendMsg( nKey ) INLINE SendMessage( ::oWin:nHandle, ::WM_nMsgC, nKey, ::nHandle ) // методы :Set(), :Del(), :Get() используется для ведения индексов контролов METHOD Set() INLINE ( ::oName:Set( ::cName , Self ), ; ::oHand:Set( ::nHandle, Self ) ) METHOD Del() INLINE ( ::oName:Del( ::cName ), ; ::oHand:Del( ::nHandle ) ) METHOD Get( xName ) INLINE iif( HB_ISCHAR(xName), ::oName:Get(xName), ; ::oHand:Get(xName) ) // получить\установить значение в контрол, аналог This.&(Nam).Value ... ACCESS Value INLINE _GetValue( , , ::nIndex ) ASSIGN Value( xVal ) INLINE ( _SetValue( , , xVal, ::nIndex ), ; _GetValue( , , ::nIndex ) ) // Прмеры: // x := o:Value // x := :Value // o:Value := xVal // :Value := xVal // далее аналоги псевдо ООП комманд ACCESS SetFocus INLINE _SetFocus ( ::cName, ::oWin:cName ) METHOD SetFocus() INLINE _SetFocus ( ::cName, ::oWin:cName ) ACCESS Disable INLINE _DisableControl( ::cName, ::oWin:cName ) METHOD Disable( nPos ) INLINE _DisableControl( ::cName, ::oWin:cName, nPos ) ACCESS Enable INLINE _EnableControl ( ::cName, ::oWin:cName ) METHOD Enable ( nPos ) INLINE _EnableControl ( ::cName, ::oWin:cName, nPos ) ACCESS Enabled INLINE GetProperty( ::oWin:cName, ::cName, 'Enabled' ) METHOD Enabled( nPos ) INLINE GetProperty( ::oWin:cName, ::cName, 'Enabled', nPos ) ACCESS Show INLINE _ShowControl ( ::cName, ::oWin:cName ) METHOD Show() INLINE _ShowControl ( ::cName, ::oWin:cName ) ACCESS Hide INLINE _HideControl ( ::cName, ::oWin:cName ) METHOD Hide() INLINE _HideControl ( ::cName, ::oWin:cName ) // выполняет блок кода ключа Key контрола, создавая среду переменных _HMG_This... // от nHandle указанного контрола или от собственного, т.е. может быть Key из // одного контрола, а созданная среда _HMG_This..., для блока кода, из другого. _METHOD DoEvent ( Key, nHandle ) // освобождаем память METHOD Destroy() INLINE ( ::Del(), ; ::oCargo := iif( HB_ISOBJECT(::oCargo ) , ::oCargo:Destroy() , Nil ), ; ::oEvent := iif( HB_ISOBJECT(::oEvent ) , ::oEvent:Destroy() , Nil ), ; ::oOnEventBlock := iif( HB_ISOBJECT(::oOnEventBlock ), ::oOnEventBlock:Destroy(), Nil ), ; ::oName := iif( HB_ISOBJECT(::oName ) , ::oName:Destroy() , Nil ), ; ::oHand := iif( HB_ISOBJECT(::oHand ) , ::oHand:Destroy() , Nil ), ; ::oUserKeys := iif( HB_ISOBJECT(::oUserKeys) , ::oUserKeys:Destroy() , Nil ), ; ( ::nParent := ::nIndex := ::cName := ::cType := ::cVar := ::cChr := Nil ), ; hmg_DelWindowObject( ::nHandle ), ::nHandle := Nil ) ENDCLASS /////////////////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////////////////////////////// CLASS TTsbData INHERIT TCnlData // класс для работы с контролом TsBrowse /////////////////////////////////////////////////////////////////////////////// // наследован от класса контрола, следовательно // в нем доступны все свойства и методы контрола, // но относятся к контролу TsBrowse. PROTECTED: VAR oTBrowse AS OBJECT // переменная для ссылки на объект TsBrowse EXPORTED: METHOD New( oWnd, oTsb ) INLINE ( ::Super:New(oWnd), ::oTBrowse := oTsb, Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::Super:Def(nIndex, cName, nHandle, nParent, cType, cVar), ; Self ) ACCESS Caption INLINE ::oWin:cName + "." + ::cName // свойство доступа к объекту TsBrowse ACCESS Tsb INLINE ::oTBrowse // Примеры: // WITH OBJECT oWnd:GetObj('oBrw1'):Tsb // ( :cAlias )->KODS := 123 // :Refresh() // END WITH // oBrw := oWnd:GetObj('oBrw1'):Tsb // cAls := ( This.oBrw1.Object ):Tsb:cAlias METHOD OnEvent( nMsg, wParam, lParam ) INLINE ::oTBrowse:HandleEvent( nMsg, wParam, lParam ) // освобождаем память METHOD Destroy() INLINE ::oTBrowse := ::Super:Destroy() ENDCLASS /////////////////////////////////////////////////////////////////////////////// Правка: Function Events ( hWnd, nMsg, wParam, lParam ) ... было #ifdef _TSBROWSE_ oGet := GetObjectByHandle( hWnd ) IF ISOBJECT( oGet ) r := oGet:HandleEvent ( nMsg, wParam, lParam ) IF ValType ( r ) == 'N' IF r != 0 RETURN r ENDIF ENDIF ENDIF #endif стало // может применяться не только для TsBrowse If hmg_IsWindowObject(hWnd) oGet := hmg_GetWindowObject(hWnd) If __objHasMethod( oGet, 'OnEvent' ) r := oGet:OnEvent( nMsg , wParam , lParam ) If HB_ISNUMERIC( r ) .and. r != 0 RETURN r EndIf EndIf EndIf [/pre2]

SergKis: gfilatov2002 Можно получить Вашу версию hmg, а то есть правки в классах, не хотелось бы давать вслепую.

gfilatov2002: SergKis пишет: Можно получить Вашу версию hmg Да, конечно. Файл h_objects.prg [pre2]/* * MINIGUI - Harbour Win32 GUI library source code * */ #include "minigui.ch" #ifdef _OBJECT_ #include "i_winuser.ch" #ifdef __XHARBOUR__ #include "hbcompat.ch" #endif #include "hbclass.ch" #define _METHOD METHOD /////////////////////////////////////////////////////////////////////////////// CLASS TWndData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR cVar INIT '' VAR cName INIT '' VAR cType INIT '' VAR nIndex INIT 0 VAR nHandle INIT 0 VAR nParent INIT 0 VAR cChr INIT ',' CLASSDATA oProp AS OBJECT INIT oKeyData() CLASSDATA oName AS OBJECT INIT oKeyData() CLASSDATA oHand AS OBJECT INIT oKeyData() EXPORTED: VAR oCargo AS OBJECT VAR oUserKeys AS OBJECT VAR oEvent AS OBJECT METHOD New() INLINE ( Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::nIndex := nIndex, ::cName := cName, ::nHandle := nHandle, ; ::nParent := nParent, ::cType := cType, ::cVar := cVar, ; ::oCargo := oKeyData(), ::oUserKeys := oKeyData(), ; ::oEvent := oKeyData( Self ), ; hmg_SetWindowObject( ::nHandle, Self ), ; Self ) ACCESS Index INLINE ::nIndex ACCESS Name INLINE ::cName ACCESS Handle INLINE ::nHandle ACCESS Parent INLINE ::nParent ACCESS Type INLINE ::cType ACCESS VarName INLINE ::cVar ACCESS Row INLINE GetWindowRow ( ::nHandle ) ACCESS Col INLINE GetWindowCol ( ::nHandle ) ACCESS Width INLINE GetWindowWidth ( ::nHandle ) ACCESS Height INLINE GetWindowHeight( ::nHandle ) ACCESS ClientWidth INLINE _GetClientRect ( ::nHandle )[ 3 ] ACCESS ClientHeight INLINE _GetClientRect ( ::nHandle )[ 4 ] ACCESS Title INLINE GetWindowText ( ::nHandle ) ACCESS Cargo INLINE _WindowCargo( Self ) ASSIGN Cargo( xVal ) INLINE _WindowCargo( Self, xVal ) ACCESS IsWindow INLINE .T. ACCESS IsControl INLINE .F. ACCESS Chr INLINE ::cChr ASSIGN Chr( cChr ) INLINE ::cChr := iif( HB_ISCHAR( cChr ), cChr, ::cChr ) ACCESS WM_nMsgW INLINE WM_WND_LAUNCH ACCESS WM_nMsgC INLINE WM_CTL_LAUNCH METHOD SetProp( xKey, xVal ) INLINE ::oProp:Set( xKey, xVal ) METHOD GetProp( xKey ) INLINE ::oProp:Get( xKey ) METHOD DelProp( xKey ) INLINE ::oProp:Del( xKey ) METHOD UserKeys( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ; ::oUserKeys:Set( Key, Block ), ; ::oUserKeys:Do ( Key, Block, p2, p3 ) ) METHOD Event ( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ; ::oEvent:Set( Key, Block ), ; ::oEvent:Do ( Key, Block, p2, p3 ) ) METHOD PostMsg( nKey, nHandle ) INLINE PostMessage( ::nHandle, ::WM_nMsgW, nKey, ; hb_defaultValue( nHandle, 0 ) ) METHOD SendMsg( nKey, nHandle ) INLINE SendMessage( ::nHandle, ::WM_nMsgW, nKey, ; hb_defaultValue( nHandle, 0 ) ) _METHOD DoEvent( Key, nHandle ) _METHOD GetListType() _METHOD GetObj4Type( cType, lEque ) _METHOD GetObj4Name( cName ) METHOD GetObj( xName ) INLINE iif( HB_ISCHAR( xName ), ::oName:Get( xName ), ; ::oHand:Get( xName ) ) // Destructor METHOD Destroy() INLINE ( hmg_DelWindowObject( ::nHandle ), ; iif( HB_ISOBJECT( ::oCargo ), ::oCargo:Destroy(), Nil ), ; iif( HB_ISOBJECT( ::oEvent ), ::oEvent:Destroy(), Nil ), ; iif( HB_ISOBJECT( ::oName ), ::oName:Destroy(), Nil ), ; iif( HB_ISOBJECT( ::oHand ), ::oHand:Destroy(), Nil ), ; iif( HB_ISOBJECT( ::oProp ), ::oProp:Destroy(), Nil ), ; iif( HB_ISOBJECT( ::oUserKeys ), ::oUserKeys:Destroy(), Nil ), ; ::oCargo := ::oEvent := ::oName := ::nHandle := ::cVar := Nil, ; ::oUserKeys := ::cType := ::cChr := ::cName := Nil, ; ::nIndex := ::nParent := ::oProp := ::oHand := Nil ) #ifdef __XHARBOUR__ DESTRUCTOR DestroyObject() INLINE Destroy() #endif ENDCLASS /////////////////////////////////////////////////////////////////////////////// METHOD GetListType() CLASS TWndData LOCAL oType := oKeyData() LOCAL aType ::oName:Eval( {| o| oType:Set( o:cType, o:cType ) } ) aType := oType:Eval( .T. ) oType:Destroy() oType := Nil RETURN aType METHOD GetObj4Type( cType, lEque ) CLASS TWndData LOCAL aObj := {} IF ! Empty( cType ) lEque := hb_defaultValue( lEque, .T. ) If ::cChr $ cType; lEque := .F. ENDIF FOR EACH cType IN hb_ATokens( Upper( cType ), ::cChr ) ::oName:Eval( {| oc| iif( lEque, iif( cType == oc:cType, AAdd( aObj, oc ), ), ; iif( cType $ oc:cType, AAdd( aObj, oc ), ) ) } ) NEXT ENDIF RETURN aObj METHOD GetObj4Name( cName ) CLASS TWndData LOCAL aObj := {} IF ! Empty( cName ) FOR EACH cName IN hb_ATokens( cName, ::cChr ) ::oName:Eval( {| oc| iif( cName $ oc:cName, AAdd( aObj, oc ), Nil ) } ) NEXT ENDIF RETURN aObj METHOD DoEvent ( Key, nHandle ) CLASS TWndData LOCAL o := iif( hmg_IsWindowObject( nHandle ), hmg_GetWindowObject( nHandle ), Self ) IF o:IsWindow RETURN Do_WindowEventProcedure ( ::oEvent:Get( Key ), o:Index, o, Key ) ENDIF RETURN Do_ControlEventProcedure( ::oEvent:Get( Key ), o:Index, o, Key ) /////////////////////////////////////////////////////////////////////////////// CLASS TCnlData INHERIT TWndData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oWin AS OBJECT EXPORTED: METHOD New( oWnd ) INLINE ( ::Super:New(), ::oWin := oWnd, Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::Super:Def( nIndex, cName, nHandle, nParent, cType, cVar ), ; ::Set(), hmg_SetWindowObject( ::nHandle, Self ), ; Self ) ACCESS Title INLINE ::oWin:cTitle ACCESS Caption INLINE GetProperty ( ::oWin:cName, ::cName ) ACCESS Cargo INLINE _ControlCargo( Self ) ASSIGN Cargo( xVal ) INLINE _ControlCargo( Self, , xVal ) ACCESS Window INLINE ::oWin ACCESS IsWindow INLINE .F. ACCESS IsControl INLINE .T. METHOD PostMsg( nKey ) INLINE PostMessage( ::oWin:nHandle, ::WM_nMsgC, nKey, ::nHandle ) METHOD SendMsg( nKey ) INLINE SendMessage( ::oWin:nHandle, ::WM_nMsgC, nKey, ::nHandle ) METHOD Set() INLINE ( iif( HB_ISOBJECT( ::oName ), ::oName:Set( ::cName, Self ), ), ; iif( HB_ISOBJECT( ::oHand ), ::oHand:Set( ::nHandle, Self ), ) ) METHOD Del() INLINE ( iif( HB_ISOBJECT( ::oName ), ::oName:Del( ::cName ), ), ; iif( HB_ISOBJECT( ::oHand ), ::oHand:Del( ::nHandle ), ) ) METHOD Get( xName ) INLINE iif( HB_ISCHAR( xName ), ::oName:Get( xName ), ; ::oHand:Get( xName ) ) ACCESS Value INLINE _GetValue( , , ::nIndex ) ASSIGN Value( xVal ) INLINE ( _SetValue( , , xVal, ::nIndex ), ; _GetValue( , , ::nIndex ) ) //ACCESS SetFocus INLINE _SetFocus ( ::cName, ::oWin:cName ) METHOD SetFocus() INLINE _SetFocus ( ::cName, ::oWin:cName ) //ACCESS Disable INLINE _DisableControl( ::cName, ::oWin:cName ) METHOD Disable( nPos ) INLINE _DisableControl( ::cName, ::oWin:cName, nPos ) //ACCESS Enable INLINE _EnableControl ( ::cName, ::oWin:cName ) METHOD Enable ( nPos ) INLINE _EnableControl ( ::cName, ::oWin:cName, nPos ) //ACCESS Enabled INLINE GetProperty( ::oWin:cName, ::cName, 'Enabled' ) METHOD Enabled( nPos ) INLINE GetProperty( ::oWin:cName, ::cName, 'Enabled', nPos ) //ACCESS Show INLINE _ShowControl ( ::cName, ::oWin:cName ) METHOD Show() INLINE _ShowControl ( ::cName, ::oWin:cName ) //ACCESS Hide INLINE _HideControl ( ::cName, ::oWin:cName ) METHOD Hide() INLINE _HideControl ( ::cName, ::oWin:cName ) _METHOD DoEvent ( Key, nHandle ) // Destructor METHOD Destroy() INLINE ( ::Del(), hmg_DelWindowObject( ::nHandle ), ; iif( HB_ISOBJECT( ::oCargo ), ::oCargo:Destroy(), Nil ), ; iif( HB_ISOBJECT( ::oEvent ), ::oEvent:Destroy(), Nil ), ; iif( HB_ISOBJECT( ::oName ), ::oName:Destroy(), Nil ), ; iif( HB_ISOBJECT( ::oHand ), ::oHand:Destroy(), Nil ), ; iif( HB_ISOBJECT( ::oUserKeys ), ::oUserKeys:Destroy(), Nil ), ; ::nParent := ::nIndex := ::cName := ::cType := Nil, ; ::oUserKeys := ::oCargo := ::oEvent := ::cVar := Nil, ; ::cChr := ::nHandle := Nil ) #ifdef __XHARBOUR__ DESTRUCTOR DestroyObject() INLINE Destroy() #endif ENDCLASS /////////////////////////////////////////////////////////////////////////////// METHOD DoEvent ( Key, nHandle ) CLASS TCnlData LOCAL o := iif( hmg_IsWindowObject( nHandle ), hmg_GetWindowObject( nHandle ), Self ) RETURN Do_ControlEventProcedure( ::oEvent:Get( Key ), o:Index, o, Key ) /////////////////////////////////////////////////////////////////////////////// CLASS TTsbData INHERIT TCnlData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oTBrowse AS OBJECT EXPORTED: METHOD New( oWnd, oTsb ) INLINE ( ::Super:New( oWnd ), ::oTBrowse := oTsb, Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::Super:Def( nIndex, cName, nHandle, nParent, cType, cVar ), ; ::Set(), hmg_SetWindowObject( ::nHandle, Self ), ; Self ) ACCESS Caption INLINE ::oWin:cName + "." + ::cName ACCESS Tsb INLINE ::oTBrowse METHOD Destroy() INLINE ( ::Super:Destroy(), ::oTBrowse := Nil ) ENDCLASS /////////////////////////////////////////////////////////////////////////////// CLASS TWmEData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oObj AS OBJECT VAR aMsg INIT hb_Hash() VAR lMsg INIT .F. EXPORTED: METHOD New( o ) INLINE ( ::oObj := o, Self ) CONSTRUCTOR ACCESS IsEvent INLINE ::lMsg METHOD Set( nMsg, Block ) INLINE ( hb_HSet ( ::aMsg, nMsg, Block ), ::lMsg := Len( ::aMsg ) > 0 ) METHOD Get( nMsg, Def ) INLINE hb_HGetDef( ::aMsg, nMsg, Def ) METHOD Del( nMsg ) INLINE ( hb_HDel ( ::aMsg, nMsg ), ::lMsg := Len( ::aMsg ) > 0 ) _METHOD DO ( nMsg, wParam, lParam ) _METHOD Destroy() ENDCLASS /////////////////////////////////////////////////////////////////////////////// METHOD Do( nMsg, wParam, lParam ) CLASS TWmEData LOCAL o, r, b := ::Get( nMsg ) IF HB_ISBLOCK( b ) o := ::Obj IF o:IsWindow r := Do_WindowEventProcedure ( b, o:Index, o, nMsg, wParam, lParam ) // {|ow,nm,wp,lp| ... } ELSE r := Do_ControlEventProcedure( b, o:Index, o, nMsg, wParam, lParam ) // {|oc,nm,wp,lp| ... } ENDIF ENDIF RETURN iif( Empty( r ), 0, 1 ) METHOD Destroy() CLASS TWmEData LOCAL i, k IF HB_ISHASH( ::aMsg ) FOR i := 1 TO Len( ::aMsg ) k := hb_HKeyAt( ::aMsg, i ) hb_HSet( ::aMsg, k, Nil ) hb_HDel( ::aMsg, k ) NEXT ENDIF ::oObj := ::aMsg := Nil RETURN NIL /////////////////////////////////////////////////////////////////////////////// CLASS TKeyData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oObj AS OBJECT VAR aKey INIT hb_Hash() VAR lKey INIT .F. EXPORTED: VAR Cargo METHOD New() INLINE ( Self ) CONSTRUCTOR METHOD Def( o ) INLINE ( ::Obj := o, Self ) METHOD Set( Key, Block ) INLINE ( hb_HSet ( ::aKey, Key, Block ), ::lKey := .T. ) METHOD Get( Key, Def ) INLINE hb_HGetDef( ::aKey, Key, Def ) METHOD Del( Key ) INLINE ( iif( ::Len > 0, hb_HDel ( ::aKey, Key ), ), ::lKey := Len( ::aKey ) > 0 ) METHOD DO ( Key, p1, p2, p3 ) BLOCK {| Self, Key, p1, p2, p3, b| b := ::Get( Key ), ; iif( HB_ISBLOCK( b ), Eval( b, ::oObj, Key, p1, p2, p3 ), Nil ) } ACCESS Obj INLINE ::oObj ASSIGN Obj( o ) INLINE ::oObj := iif( HB_ISOBJECT( o ), o, Self ) ACCESS Len INLINE Len( ::aKey ) ACCESS IsEvent INLINE ::lKey METHOD ISBLOCK( Key ) INLINE HB_ISBLOCK( ::Get( Key ) ) _METHOD Eval( Block ) _METHOD Sum( Key, xSum ) _METHOD Destroy() ENDCLASS /////////////////////////////////////////////////////////////////////////////// METHOD Eval( Block ) CLASS TKeyData LOCAL i, b := HB_ISBLOCK( Block ) LOCAL l := HB_ISLOGICAL( Block ) .AND. Block LOCAL a := iif( b, Nil, Array( 0 ) ) FOR i := 1 To ::Len IF b; Eval( Block, hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i ) ELSEIF l; AAdd( a, { hb_HValueAt( ::aKey, i ) } ) Else ; AAdd( a, { hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i } ) ENDIF NEXT RETURN a METHOD Sum( Key, xSum ) CLASS TKeyData LOCAL sum := ::Get( Key, 0 ) IF HB_ISNUMERIC( xSum ) IF HB_ISNUMERIC( sum ); sum += xSum Else ; sum := xSum ENDIF ::Put( Key, sum ) ELSEIF HB_ISARRAY( xSum ) IF HB_ISARRAY( sum ) .AND. Len( sum ) == Len( xSum ) AEval( xSum, {| s, i| sum[ i ] := iif( HB_ISNUMERIC( s ), sum[ i ] + s, s ) } ) ELSE sum := xSum ENDIF ::Put( Key, sum ) ENDIF RETURN NIL METHOD Destroy() CLASS TKeyData LOCAL i, k, o IF HB_ISHASH( ::aKey ) FOR i := 1 TO Len( ::aKey ) k := hb_HKeyAt( ::aKey, i ) hb_HSet( ::aKey, k, Nil ) hb_HDel( ::aKey, k ) NEXT ENDIF IF HB_ISOBJECT( ::Cargo ) .AND. ::Cargo:ClassName == ::ClassName o := ::Cargo IF HB_ISHASH( o:aKey ) FOR i := 1 TO Len( o:aKey ) k := hb_HKeyAt( o:aKey, i ) hb_HSet( o:aKey, k, Nil ) hb_HDel( o:aKey, k ) NEXT ENDIF ENDIF ::oObj := ::aKey := ::Cargo := Nil RETURN NIL /////////////////////////////////////////////////////////////////////////////// CLASS TThrData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oObj AS OBJECT VAR aKey INIT hb_Hash() VAR lMT INIT .F. SYNC METHOD SGD( n, k, v ) EXPORTED: VAR Cargo METHOD New() INLINE ( Self ) CONSTRUCTOR METHOD Def( o, lVmMt ) INLINE ( ::Obj := o, ::MT := lVmMt, Self ) METHOD Set( Key, Block ) INLINE iif( ::lMT, ::SGD( 1, Key, Block ), hb_HSet ( ::aKey, Key, Block ) ) METHOD Get( Key, Def ) INLINE iif( ::lMT, ::SGD( 2, Key, Def ), hb_HGetDef( ::aKey, Key, Def ) ) METHOD Del( Key ) INLINE iif( ::lMT, ::SGD( 3, Key ), ; iif( hb_HHasKey( ::aKey, Key ), hb_HDel ( ::aKey, Key ), Nil ) ) METHOD DO ( Key, p1, p2, p3 ) BLOCK {| Self, Key, p1, p2, p3, b| b := ::Get( Key ), ; iif( HB_ISBLOCK( b ), Eval( b, ::oObj, Key, p1, p2, p3 ), Nil ) } ACCESS MT INLINE ::lMT ASSIGN MT( lVmMt ) INLINE ::lMT := iif( HB_ISLOGICAL( lVmMt ), lVmMt, .F. ) ACCESS Obj INLINE ::oObj ASSIGN Obj( o ) INLINE ::oObj := iif( HB_ISOBJECT( o ), o, Self ) ACCESS Len INLINE Len( ::aKey ) METHOD ISBLOCK( Key ) INLINE HB_ISBLOCK( ::Get( Key ) ) _METHOD Eval( Block ) _METHOD Sum( Key, xSum ) _METHOD Destroy() ENDCLASS /////////////////////////////////////////////////////////////////////////////// METHOD SGD( n, k, v ) CLASS TThrData SWITCH n CASE 1 hb_HSet( ::aKey, k, v ) EXIT CASE 2 RETURN hb_HGetDef( ::aKey, k, v ) CASE 3 IF hb_HHasKey( ::aKey, k ) hb_HDel ( ::aKey, k ) ENDIF EXIT CASE 4 RETURN { hb_HKeyAt( ::aKey, k ), hb_HValueAt( ::aKey, k ) } END SWITCH RETURN NIL METHOD Eval( Block ) CLASS TThrData LOCAL m, i, b := HB_ISBLOCK( Block ) LOCAL l := HB_ISLOGICAL( Block ) .AND. Block LOCAL a := iif( b, Nil, Array( 0 ) ) FOR i := 1 To ::Len If ::lMT m := ::SGD( 4, i ) IF b; Eval( Block, m[ 2 ], m[ 1 ], i ) ELSEIF l; AAdd( a, { m[ 2 ] } ) Else ; AAdd( a, { m[ 2 ], m[ 1 ], i } ) ENDIF ELSE IF b; Eval( Block, hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i ) ELSEIF l; AAdd( a, { hb_HValueAt( ::aKey, i ) } ) Else ; AAdd( a, { hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i } ) ENDIF ENDIF NEXT RETURN a METHOD Sum( Key, xSum ) CLASS TThrData LOCAL sum := ::Get( Key, 0 ) IF HB_ISNUMERIC( xSum ) IF HB_ISNUMERIC( sum ); sum += xSum Else ; sum := xSum ENDIF ::Put( Key, sum ) ELSEIF HB_ISARRAY( xSum ) IF HB_ISARRAY( sum ) .AND. Len( sum ) == Len( xSum ) AEval( xSum, {| s, i| sum[ i ] := iif( HB_ISNUMERIC( s ), sum[ i ] + s, s ) } ) ELSE sum := xSum ENDIF ::Put( Key, sum ) ENDIF RETURN NIL METHOD Destroy() CLASS TThrData LOCAL i, k, o IF HB_ISHASH( ::aKey ) FOR i := 1 TO Len( ::aKey ) k := hb_HKeyAt( ::aKey, i ) hb_HSet( ::aKey, k, Nil ) hb_HDel( ::aKey, k ) NEXT ENDIF IF HB_ISOBJECT( ::Cargo ) .AND. ::Cargo:ClassName == ::ClassName o := ::Cargo IF HB_ISHASH( o:aKey ) FOR i := 1 TO Len( o:aKey ) k := hb_HKeyAt( o:aKey, i ) hb_HSet( o:aKey, k, Nil ) hb_HDel( o:aKey, k ) NEXT ENDIF ENDIF ::oObj := ::aKey := ::Cargo := ::lMT := Nil RETURN NIL *-----------------------------------------------------------------------------* FUNCTION oWndData( nIndex, cName, nHandle, nParent, cType, cVar ) *-----------------------------------------------------------------------------* LOCAL o DEFAULT nIndex := 0, ; cName := '', ; nHandle := 0, ; nParent := 0, ; cType := '', ; cVar := '' IF Empty( nIndex ) .OR. Empty( nHandle ) .OR. Empty( cName ) RETURN o ENDIF o := TWndData():New():Def( nIndex, cName, nHandle, nParent, cType, cVar ) RETURN o *-----------------------------------------------------------------------------* FUNCTION oCnlData( nIndex, cName, nHandle, nParent, cType, cVar, oWin ) *-----------------------------------------------------------------------------* LOCAL o, ob DEFAULT nIndex := 0, ; cName := '', ; nHandle := 0, ; nParent := 0, ; cType := '', ; cVar := '' IF Empty( nIndex ) .OR. Empty( nHandle ) .OR. Empty( nParent ) .OR. Empty( cName ); RETURN o ENDIF DEFAULT oWin := hmg_GetWindowObject( nParent ) IF HB_ISOBJECT( oWin ) IF cType == 'TBROWSE' ob := _HMG_aControlIds[ nIndex ] o := TTsbData():New( oWin, ob ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) ELSE o := TCnlData():New( oWin ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) ENDIF ENDIF RETURN o *-----------------------------------------------------------------------------* FUNCTION oKeyData( Obj, Event ) *-----------------------------------------------------------------------------* LOCAL o IF HB_ISNIL ( Event ) ; o := TKeyData():New():Def( Obj ) ELSEIF HB_ISLOGICAL( Event ) .AND. Event; o := TWmEData():New( Obj ) Else ; o := TThrData():New():Def( Obj, hb_mtvm() ) ENDIF RETURN o #ifdef __XHARBOUR__ *-----------------------------------------------------------------------------* STATIC FUNCTION hb_HGetDef( hHash, xKey, xDef ) *-----------------------------------------------------------------------------* LOCAL nPos := HGetPos( hHash, xKey ) RETURN iif( nPos > 0, HGetValueAt( hHash, nPos ), xDef ) #endif #endif [/pre2]

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