Автор | Сообщение |
gfilatov
|
| модератор
|
Пост N: 699
Зарегистрирован: 25.05.05
|
|
Отправлено: 29.01.08 13:59. Заголовок: Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
| |
|
Ответов - 300
, стр:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
All
[только новые]
|
|
SergKis
|
| постоянный участник
|
Пост N: 1552
Зарегистрирован: 17.02.12
|
|
Отправлено: 22.06.17 22:22. Заголовок: Я в отдыхе, на бегу ..
Я в отдыхе, на бегу отвечаю. Петр пишет цитата: | И не пишите, пожалуйста, то чего не знаете |
| Для hb2.0 знаю, для hb3.2 (думал, что знаю, но сбился на ваше сообщение о DESTRUCTOR), потребовалось время, что бы уточнить. цитата: | Я привел вам пример (destruct.prg) - там и деструктор и неявный конструктор init.. |
| Вы привели все правильно, но для не типизированных классов. В типизированном\строго типизированном это отключено т.к. hb наследник clipper. И написанная, мной, инф. это подвержтает, деструктор валится в отличии от VO. цитата: | я не знаю как на это реагировать, ну типа плакать или смеяться |
| Можете спеть, станцевать - ваше дело. У нас свободная страна. Но я не просил реагировать, инициатива от вас. цитата: | Значит класс не закончен и смотреть не на что. |
| С классами, как с ремонтом, можно бросить, приостановить, но закончить ... Для приведенного примера, его (класса) состояние вполне достаточное. Andrey пишет цитата: | да помоги написать как нужно и всех делов то... |
| Андрей, не бери в голову, у Петра такая манера, сказать A и не говорить Б. Как у тех, из за лужи: "Мы знаем, что это сделал (вы сами знаете кто). У нас факты, но не скажем, потому что секретные." Haz говорил, что у тебя есть очень секретный код (не хочешь делиться), вот и у Петра есть тааакой секретный код, что я цитата: | есть ... не могу, спать ... не могу, вот пить ... начал. Фотографии нет ? Фотографии нет ! |
| А фотографии кода нет. цитата: | Не учите меня жить, лучше помогите материально. |
| О.Бендер.
| |
|
Петр
|
| постоянный участник
|
Пост N: 1535
Зарегистрирован: 09.10.06
|
|
Отправлено: 22.06.17 23:21. Заголовок: SergKis пишет: Вы п..
SergKis пишет: цитата: | Вы привели все правильно, но для не типизированных классов. В типизированном\строго типизированном это отключено т.к. hb наследник clipper. |
| Нет никаких типизированных или не типизированных классов, по крайней мере, в hb. В MiniGUI так их точно нет SergKis пишет: цитата: | И написанная, мной, инф. это подвержтает, деструктор валится в отличии от VO. |
| Ну вы уже писали, что в hb нет деструкторов. Теперь, из ваших слов можно сделать вывод, что есть, но работают не правильно. Самодостаточный пример в devel list вам поможет (не материально ).
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1122
Зарегистрирован: 11.02.10
|
|
Отправлено: 23.06.17 11:22. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Опубликована очередная сборка 17.06 для BCC 5.51 |
| Сделал быстрое обновление новой сборки с учетом последних наработок Петра, которые были опубликованы на форуме. Список изменений см. ниже Скрытый текст
* 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>
| Прямая ссылка на архив http://hmgextended.com/files/CONTRIB/hmg-17.06.7z
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1123
Зарегистрирован: 11.02.10
|
|
Отправлено: 26.06.17 10:38. Заголовок: Сделал второе обновл..
Сделал второе обновление новой сборки с учетом последних изменений Си-кода. Список изменений см. ниже Скрытый текст
* 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>
| Прямая ссылка на архив этой сборки http://hmgextended.com/files/CONTRIB/hmg-17.06.7z Благодарю за Ваше внимание
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1557
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.06.17 09:31. Заголовок: gfilatov2002 1. По ..
gfilatov2002 1. По поводу SET EVENTS FUNCTION TO ... Для mdi окон не работает. Берем пример Mdi\demo.prg, добавляем ... Скрытый текст
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 )
| 2. Вернусь к предложению с _HMG_переменными, для возможности встраиваться в hmg со своими тараканами (через почту не буду, ничего не установлено, не пользую у себя). Скрытый текст
- ввести переменные _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 ...
| Делать вне _Define... _HMG_b...Init можно, но это равносильно написанию своих _Define..2, а в ON INIT делать не интересно (еще и писать везде), т.к. нужно до WINDOW ACTIVATE ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1558
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.06.17 09:53. Заголовок: PS По мне, лучше сде..
PS По мне, лучше сделать два WM_USER_HMG (как у меня в предложениях выше), для окна и для контртрола (проще управление в блоке кода - он один), но не настаиваю, минимизирую
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1125
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.06.17 11:08. Заголовок: SergKis Да, команда..
SergKis Да, команда SET EVENTS FUNCTION TO не работает для mdi окон. Для mdi child потребуется новая команда SET MDIEVENTS FUNCTION TO SergKis пишет: цитата: | Вернусь к предложению с _HMG_переменными |
| Выполнил эти правки для текущего кода с небольшим изменением имени этих блоков кода. Но вместо использования блоаов _HMG_bWm_User и _HMG_bWm_App предлагаю использовать новые команды ON WINUSER и ON WINAPP Присылайте реальное наполнение для новых блоков кода и свежую редакцию Ваших классов (если такая есть). Мой пример для проверки функциональности кода см. ниже Скрытый текст
#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
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1559
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.06.17 14:47. Заголовок: gfilatov2002 пишет Н..
gfilatov2002 пишет цитата: | Но вместо использования блоаов _HMG_bWm_User и _HMG_bWm_App предлагаю использовать новые команды ON WINUSER и ON WINAPP |
| Как то не перекладывается мой пример на эти команды (регистрация событий от 1,2, ... на каждое окно и каждый контрол), особенно, если окон (контролов на них) много. Использование WINAPP, кроме присвоения каждому окну уникального номера для доступа к кофигуратору, не вижу. С WINUSER совсем не понятно, где использовать, кроме прерывания циклов работы с базой. цитата: | Присылайте реальное наполнение для новых блоков кода и свежую редакцию Ваших классов (если такая есть). |
| Позже, пока в отдыхе
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1126
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.06.17 15:45. Заголовок: SergKis пишет: не п..
SergKis пишет: цитата: | не перекладывается мой пример на эти команды |
| Понимаю, поэтому добавил два пользовательских события и их обработку (события WM_WND_LAUNCH и WM_CTL_LAUNCH, их обработчики - кодоблоки _HMG_bWndLaunch и _HMG_bСtlLaunch). SergKis пишет: Буду ждать...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1560
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.07.17 11:57. Заголовок: gfilatov2002 пишет Б..
gfilatov2002 пишет Переназвал кодоблоки _HMG_bWndLaunch и _HMG_bСtlLaunch на _HMG_bOnWndLaunch и _HMG_bOnСtlLaunch На своей lib собрал пример http://my-files.ru/bzb7lk Классы Скрытый текст
// 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
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1561
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.07.17 11:57. Заголовок: PS Функции // Misk ..
PS Функции Скрытый текст
// 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
|
| |
|
|
gfilatov2002
|
| moderator
|
Пост N: 1127
Зарегистрирован: 11.02.10
|
|
Отправлено: 03.07.17 21:22. Заголовок: SergKis пишет: На с..
SergKis пишет: цитата: | На своей lib собрал пример |
| У меня тоже работает этот пример после чистки предупреждений компилятора (с ключом -w3) Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1562
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.07.17 09:08. Заголовок: gfilatov2002 пишет У..
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
|
| moderator
|
Пост N: 1128
Зарегистрирован: 11.02.10
|
|
Отправлено: 04.07.17 14:17. Заголовок: SergKis пишет: _HMG..
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 таким образом: Скрытый текст
* 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)
| Также пришлось отключить вызов метода Destroy для модальных окон, добавить дополнительные проверки, чтобы не падал код, написанный без использования объектов. В целом, впечатления двойственные: вроде бы и добавляются новые возможности, но пока код достаточно сырой... Также не уверен, что кто-то, кроме уважаемого автора, будет тратить силы на изучение этих новых возможностей
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1563
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.07.17 17:29. Заголовок: gfilatov2002 Пока чт..
gfilatov2002 цитата: | Пока что записал в текущий файл changelog таким образом: |
| Думается Set\GetProperty с объектом не надо вставлять в ядро, пусть все будет на уровне примера, т.е _HMG_... переменные зарезервированы #command тоже только на уровне примера. Переменные можно использовать _HMG_bOnFormInit - для чтения данных окна из конфигуратора _HMG_bOnFormDestroy - для записи данных окна в конфигуратор _HMG_bOnControlInit - для чтения данных контрола из конфигуратора _HMG_bOnControlDestroy - для записи данных контрола в конфигуратор цитата: | Также не уверен, что кто-то, кроме уважаемого автора, будет тратить силы на изучение этих новых возможностей |
| Для меня это возможность совместимости версий, т.е. могу с hmg 2.07 переползти на 17.07, возможно, с минимальными изменениями lib. Классы это по интересам, хотя замена содержимого функций SetProp, GetProp, EnumProp на работу с классом (у меня есть в примере), уберет те недостатки, которые есть сегодня. К примеру, если иметь на hWnd два адреса хранения объектов 1- системный hmg, 2 - пользовательский (как сейчас), то в 1 hmg сделать класс контейнер (начать Set\GetProp) и расширять постепенно (данные из _HMG_aControlMiskData1 перенести), если надо, а 2 usr для пользовательских классов (как в примере) С MdiEvents() можно не парится, сегодня нет и как то живем.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1129
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.07.17 11:31. Заголовок: SergKis пишет: Set&..
SergKis пишет: цитата: | Set\GetProperty с объектом не надо вставлять в ядро |
| Я так сначала тоже думал, но после переноса Вашего кода в ядро библиотеки удалось обнаружить проблемы с поддержкой Spinner и RadioGroup в предлагаемой реализации, а также конфликт этих классов с модальными окнами. Вроде удалось эти недостатки побороть, плэтому оставил эти классы в ядре Также адаптировал Вашу работу для поддержки xHarbour. Но, конечно, желательно было бы добавить небольшое описание с примерами работы новых классов. Думаю, это было бы очень полезно, учитывая, что раньше пользователи не использовали классы на уровне ядра...
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5429
Зарегистрирован: 12.09.06
|
|
Отправлено: 05.07.17 15:31. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Но, конечно, желательно было бы добавить небольшое описание с примерами работы новых классов. |
| Я тоже за !
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1564
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.07.17 21:30. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | желательно было бы добавить небольшое описание |
| такое Скрытый текст
/////////////////////////////////////////////////////////////////////////////// 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
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1565
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.07.17 21:32. Заголовок: gfilatov2002 Можно ..
gfilatov2002 Можно получить Вашу версию hmg, а то есть правки в классах, не хотелось бы давать вслепую.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1130
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.07.17 22:44. Заголовок: SergKis пишет: Можн..
SergKis пишет: цитата: | Можно получить Вашу версию hmg |
| Да, конечно. Файл h_objects.prg Скрытый текст
/* * 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
|
| |
|
Ответов - 300
, стр:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
All
[только новые]
|
|
|