Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить
Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
gfilatov2002: gfilatov2002 пишет: Инсталляторы для других Си-компиляторов обновлю позже Выложил исталляторы сборки 16.10 для остальных Си-компиляторов (прямые ссылки есть на сайте библиотеки).
Andrey: Привет всем. На новой версии перестала работать команда: DEFINE BKGBRUSH newBrush PATTERN IN Form_9 BITMAP MyPASS48 Выдаёт ошибку: Tbrws_Test.prg(219) Error E0030 Syntax error "syntax error at 'PICTURE'" При сборке примера SAMPLES\Advanced\TsBrowse и SAMPLES\Applications\SysInfo тоже выдаёт ошибку: TestXls.prg(36) Error E0030 Syntax error "syntax error at 'BITMAP'" и SysInfo.prg(229) Error E0030 Syntax error "syntax error at 'BITMAP'" Это видел: * Changed: DEFINE BKGBRUSH command supports a reduced format now, i.e. - <DEFINE | CREATE> BKBRUSH <brush> [ STYLE ] PATTERN ; IN [ FORM | WINDOW ] <parent> PICTURE <image> - ADD BKBRUSH <brush> [ STYLE ] PATTERN ; TO [ FORM | WINDOW ] <parent> PICTURE <image> Замена на PICTURE: DEFINE BKGBRUSH Brush_1 PATTERN IN Form_1 PICTURE Skin\background.bmp ошибку не убирает...
gfilatov2002: Andrey пишет: На новой версии перестала работать команда Эта команда уже работает в исправленной сборке 16.10 Надо просто еще раз скачать и установить эту сборку заново...
Andrey: Да, в исправленной версии ошибка ушла ! Спасибо ! Но теперь потерялась функция: //DEFINE BKGBRUSH newBrush PATTERN IN &cFormName PICTURE cResFon // заливка фоном newBrush := SetWndBrush( cFormName, .F., 3, NIL, NIL, cResFon ) при сборке выдаёт: Error: Unresolved external '_HB_FUN_SETWNDBRUSH' referenced from W:\HB_PROJECT\....
gfilatov2002: Andrey пишет: Но теперь потерялась функция Она была переименована Петром в _SetWindowBKBrush() и является внутренней функцией. Т.е. прямое ее использование не рекомендуется, для этого есть соответствующая команда
Петр: Andrey пишет: Замена на PICTURE: DEFINE BKGBRUSH Brush_1 PATTERN IN Form_1 PICTURE Skin\background.bmp ошибку не убирает.. Ошибка в changelog Смотрите обновленный синтаксис в i_brush.ch [pre2]#xtranslate <dummy: CREATE,DEFINE> <dummy1: BKBRUSH,BKGBRUSH> <brush> ; [ STYLE ] <style: SOLID,HATCHED,PATTERN> ; [ [ HATCHSTYLE ] <hatch> ] ; [ <dummy3: BITMAP,IMAGE,PICTURE> <bitmap> ] ; [ COLOR <aColor> ] ; [ <nodelete: NODELETE> ] ; [ IN [ <dummy2: FORM,WINDOW> ] <window> ] ; =>[/pre2] и базовый пример SAMPLES\BASIC\WindowBackground\demo.prg SAMPLES\BASIC\WindowBackground_2\demo.prg тоже м.б. интересным
Andrey: gfilatov2002 пишет: Т.е. прямое ее использование не рекомендуется, для этого есть соответствующая команда Понял. Давно сделал, так и использовал в некоторых исходниках. Петр пишет: и базовый пример SAMPLES\BASIC\WindowBackground\demo.prg Поиск по DEFINE BKGBRUSH дал только 2 примера. А пример смотрел, там по другому уже. По синтаксису - понравилось лучше. Только в пример BASIC\WindowBackground_2\demo.prg нужно бы поставить кнопку смены заливки на лету !
Петр: Andrey пишет: Только в пример BASIC\WindowBackground_2\demo.prg нужно бы поставить кнопку смены заливки на лету ! Суть примера в применении классов CURSOR, BKBRUSH при создании окна (DEFINE WINDOW). Все остальное "рюшечки" - и кнопка, и таймер, и генератор псевдо-случайных чисел - все это, как правило, лишь отвлекает от сути. И да, писать качественные, содержательные примеры - это нужно уметь, у меня не всегда получается.
Andrey: Петр пишет: Все остальное "рюшечки" - и кнопка, и таймер, и генератор псевдо-случайных чисел - все это, как правило, лишь отвлекает от сути. Не всегда. Юзерам нравятся не унылые серые формы, а симпатичные. А кнопка смены заливки формы позволяет понять разработчику - как можно делать смену обоев на "лету" в окне. Я в своё время очень помучился с этим. Не помню уже чем и закончилось. И смена заливки тоже можно использовать для задачи - четко показывать юзеру смену задачи или меню. Петр пишет: И да, писать качественные, содержательные примеры - это нужно уметь, у меня не всегда получается. Классно получается ! Что интересно, всегда спросим !
Andrey: Теперь в новой версии при выходе из моей программы получаю ошибку: Error BASE/0 MiniGUI Err.: _ONDESTROYMENU Called from _ONDESTROYMENU(0) Called from RELEASEALLWINDOWS(2127) Called from _RELEASEWINDOW(2196) Called from DOMETHOD(4739) Called from MYEXIT(462) Called from (b)METRO_BUTTON(369) Строка 462: Form_Main.Release или выход из программы нужно делать всегда через - RELEASE WINDOW ALL ? Хотя поставил RELEASE WINDOW ALL - тоже выдаёт такую же ошибку. Откатился на 16.09 - ошибки нет.
Петр: Andrey пишет: Form_Main.Release Form_Main содержит меню или нет ? Andrey пишет: Called from RELEASEALLWINDOWS(2127) h_windows.prg замените сл. фрагмент [pre2] IF IsExtendedMenuStyleActive() _OnDestroyMenu ( GetMenu ( _HMG_MainHandle ) ) // Release OwnerDraw Main Menu ENDIF [/pre2] на [pre2] ... LOCAL hMenu ... hMenu := GetMenu ( _HMG_MainHandle ) IF IsExtendedMenuStyleActive() .AND. IsMenu( hMenu ) _OnDestroyMenu ( hMenu ) // Release OwnerDraw Main Menu ENDIF [/pre2] и, конечно, перекомпилируйте библиотеку
Петр: Andrey пишет: Откатился на 16.09 - ошибки нет. Видишь суслика? — Нет. — И я не вижу. А он есть!
gfilatov2002: Петр пишет: h_windows.prg замените сл. фрагмент Благодарю за помощь Добавил эту поправку в следующую сборку
Andrey: Петр пишет: Видишь суслика? — Нет. — И я не вижу. А он есть!
SergKis: gfilatov2002 Можно маленькую правку в TsBrowse[pre2] METHOD LoadFields( lEditable ) CLASS TSBrowse ... line: 7171 ElseIf cType == "D" cData := cValToChar( If( ! Empty( cData ), cData, Date() ) ) nSize := Int( GetTextWidth( 0, cData + " " , hFont ) ) + If( lEditable, 22, 0 ) ElseIf cType == "M" ... приходится постоянно править таким a := {}; AEval(oBrw:aColumns, {|oCol,nCol,val| val := Eval(oCol:bData), ; iif(Valtype(val)=="D", AAdd(a, nCol), ) }) i := Int( GetTextWidth( 0, " ", oBrw:hFont ) ) AEval(a, {|nCol| oBrw:aColumns[ nCol ]:nWidth += i } ) что бы дата и линии Tcb не наезжали друг на друга в колонке [/pre2]
Andrey: SergKis пишет: Можно маленькую правку в TsBrowse Поддерживаю. Меня тоже это раздражает.
Dima: Совсем не обязательно править сырец Делаю примерно так obrw:GetColumn("naim"):bPrevEdit := { |a, b, lLock| SetGetAdjustBrw(b,{2,0,-2,-3})...............
Andrey: Dima пишет: Совсем не обязательно править сырец Таблица по умолчанию должна быть правильной и красивой, без срезки колонок (как сейчас дата срезана) и т.д. Каждый раз не на исправляешься. Допилить всё можно, только времени своего жалко.
SergKis: Dima пишет Делаю примерно так obrw:GetColumn("naim"):bPrevEdit := { |a, b, lLock| SetGetAdjustBrw(b,{2,0,-2,-3})............... дело не в корректировке, на этапе отображения даты в колонки, правая цифра частично под линией
Dima: SergKis пишет: дело не в корректировке Точно. Сразу не сообразил
gfilatov2002: SergKis пишет: на этапе отображения даты в колонки, правая цифра частично под линией Благодарю за наводку! Поправил эту бяку следующим образом: nSize := Int( GetTextWidth( 0, cData + "B", hFont ) ) + If( lEditable, 30, 0 ) Мой пример для проверки см. ниже [pre2]#include "minigui.ch" #include "tsbrowse.ch" REQUEST SQLMIX Procedure Main() SET CENTURY ON DEFINE WINDOW Form1 ; AT 0,0 ; WIDTH (RR_GetDesktopArea()[4] * 0.99) ; HEIGHT (RR_GetDesktopArea()[3] * 0.91) ; TITLE "TsBrowse Array Test" ; MAIN ; FONT 'Tahoma' SIZE 9 END WINDOW Test() Form1.Center Form1.ACTIVATE Return *-------------------------------------------------------------- Function Test() local i := 0 local j := 0 Local aStr := {} local cAlias := "TEST" local cBrw := "BRW" PUBLIC &cBrw FOR j := 1 TO 30 AADD( aStr, {"F_" + NTOC(j) , "D", 8, 0 } ) NEXT rddSetDefault( "SQLMIX" ) dbCreate( cAlias, aStr,, .T., cAlias ) FOR i := 1 TO 100 (cAlias)->( DbAppend() ) FOR j := 1 TO 30 (cAlias)->( FieldPut(j, Date()) ) NEXT NEXT rddSetDefault( "SQLMIX" ) DEFINE TBROWSE &cBrw ; At 20, 5 ; ALIAS cAlias ; OF Form1 ; WIDTH (Form1.Width - 20) ; HEIGHT (Form1.Height - 70) ; COLORS { CLR_BLACK, CLR_BLUE } ; FONT "MS Sans Serif" ; SIZE 8 ; CELL; SELECTOR .T. END TBROWSE &cBrw:LoadFields( FALSE ) Return Nil[/pre2]
SergKis: Dima пишет obrw:GetColumn("naim"):bPrevEdit := { |a, b, lLock| SetGetAdjustBrw(b,{2,0,-2,-3})............... Может с учетом Edit, надо не пробел, а ширину цифры или буквы добавлять ?
Dima: SergKis пишет: Может с учетом Edit, надо не пробел, а ширину цифры или буквы добавлять ? Сергей это ты мне или Григорию адресовал ? Если мне , то этот фокус нужен что бы при входе и последующем выходе из режима редактирования не съедалась сетка грида , по периметру ячейки.
SergKis: Дима пишет Сергей это ты мне или Григорию адресовал ? Это пока я вопрос набирал, Григорий уже реализовал.
SergKis: gfilatov2002 Вспомнил (посмотрел), как делал в своей версии nSize := Int( GetTextWidth( 0, StrTran(CtoD(""), " ", "9")+"B", hFont ) ) + If( lEditable, 22, 0 )
SergKis: PS Уже заработался, у меня через xVal промежуточную, убирал и пропустил. cValToChar(xVal), т.е. nSize := Int( GetTextWidth( 0, StrTran(cValToChar(CtoD("")), " ", "9")+"B", hFont ) ) + If( lEditable, 22, 0 )
SergKis: gfilatov2002 можно пару добавок [pre2] Method AddSuperHead( nFromCol, nToCol, uHead, nHeight, aColors, l3dLook, uFont, uBitMap, lAdjust, lTransp, ; lNoLines, nHAlign, nVAlign ) CLASS TSBrowse ... uHead := "" If Valtype(nFromCol) == "C" nFromCol := ::nColumn(nFromCol) EndIf If Valtype(nToCol) == "C" nToCol := ::nColumn(nToCol) EndIf uFont := If( uFont != Nil, If( ValType( uFont ) == "O", uFont:hFont, uFont ), uFont ) If ! Empty( ::aColumns ) ... METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse ... If oColumn == Nil // if no Column object supplied Return Nil // return nil insted of reference to object EndIf If Valtype(nPos) == "C" nPos := ::nColumn(nPos) EndIf If nPos < 1 nPos := 1 ... [/pre2]
gfilatov2002: SergKis пишет: можно пару добавок Не вопрос! Конечно, добавлю в следующую сборку
Dima: gfilatov2002 Какой то не понятный глюк в 16.10 под MINGW , если в сырце прописать REQUEST HB_LANG_RUWIN то программу не собрать , в 16.06 было все нормально. Под BCC55 в 16.10 этой проблемы нет.
gfilatov2002: Dima пишет: REQUEST HB_LANG_RUWIN то программу не собрать , в 16.06 было все нормально. Это происки Виктора в его Harbour 3.4 Попробуй добавить такой код [pre2] #include "hbextcdp.ch" #include "hbextlng.ch" PROCEDURE HB_LANG_RUWIN() ; RETURN [/pre2]и отпишись, если помогло
Dima: gfilatov2002 Собралось , но при запуске упало на этой строке HB_LANGSELECT( "RUWIN" ) ранее было все хорошо
gfilatov2002: Dima пишет: HB_LANGSELECT( "RUWIN" ) Попробуй вызывать эту функцию так HB_LANGSELECT( "RU" )
Dima: gfilatov2002 пишет: Попробуй вызывать эту функцию так Да так работает. Спасибо ! А почему такая разница между сборкой под BCC и MINGW ? Под BCC все работает как и ранее а под MINGW какие то костыли нужно ставить...... И еще вопрос , EXE собранные в 16.10 под MINGW , не жмутся UPX 3.91w , он их не понимает. Чем можно заменить UPX ?
Петр: Dima пишет: А почему такая разница между сборкой под BCC и MINGW ? Под BCC все работает как и ранее а под MINGW какие то костыли нужно ставить Можно я отвечу? 1) Это еще смотреть надо где костыль 2) MiniGUI изначально заточен под bcc, все остальное overhead А зачем их жать?
Dima: Петр пишет: 2) MiniGUI изначально заточен под bcc, все остальное overhead Может и так и стоит вернуться на него , но там есть ограничения на формат и размер файлов в ресурсах , если мне память не изменяет. Петр пишет: А зачем их жать? Кто его знает :) Вычитал в инете и натыкался не раз что лучше жать , так как по сети EXE грузится быстрее , я конечно понимаю что нужно еще время и на распаковку в памяти. С секундомером не мерял и просто принял за истину что так лучше.........
gfilatov2002: Dima пишет: Под BCC все работает как и ранее а под MINGW какие то костыли нужно Поправил установку русского, немецкого и т.д. языков для MinGw-сборок на базе форка Harbour 3.4 Кстати, для испанского, португальского и итальянского языков ничего исправлять не потребовалось (это объясняет, почему не было сообщений об этой проблеме в MinGw-сборках ранее)
Andrey: Всем привет ! Нашёл косяк... Создаём цветное окно, размещаем на нем цветные Label - всё работает отлично, но если перед окном ставим: SET EVENTS FUNCTION TO MYEVENTS Цвета у Label не меняются и TRANSPARENT не работает... Протестил и на MiniGUI\SAMPLES\Applications\RunCmd Вот так это выглядит: Как сделать, чтобы заработало ?
gfilatov2002: Andrey пишет: Как сделать, чтобы заработало ? В функции MyEvents() надо записать вызов Events() следующим образом Return Events ( hWnd, nMsg, wParam, lParam ) Отпишись, если это помогло
Andrey: gfilatov2002 пишет: Отпишись, если это помогло Да, помогло ! Спасибо ! Делал по твоему примеру: [pre2] otherwise Events ( hWnd, nMsg, wParam, lParam ) endcase Return (0) [/pre2]
Петр: Andrey пишет: Как сделать, чтобы заработало ? Напишите корректный обработчик MYEVENTS, не перехватывайте ненужные события, перенаправьте их стандартному обработчику HMG (если, что Events() называется). Опять задание для телепатов. P.S. Григорий таки делает успехи в этом деле.
sashaBG: для MINGW в i_lang.ch надо поправить 63 ряд на : #translate SET LANGUAGE TO BULGARIAN => _HMG_LANG_ID := ' ' ; REQUEST HB_LANG_BG ; HB_LANGSELECT("BG" ) ; InitMessages()
gfilatov2002: sashaBG Благодарю за помощь! Я уже сделал такое изменение в заголовочном файле i_lang.ch: #if ( __HARBOUR__ - 0 > 0x030200 ) #translate SET LANGUAGE TO GERMAN => _HMG_LANG_ID := ' ' ; #include "hbextlng.ch" ; HB_LANGSELECT( "DE" ) ; InitMessages() #translate SET LANGUAGE TO GREEK => _HMG_LANG_ID := ' ' ; #include "hbextlng.ch" ; HB_LANGSELECT( "EL" ) ; InitMessages() #translate SET LANGUAGE TO RUSSIAN => _HMG_LANG_ID := ' ' ; #include "hbextlng.ch" ; HB_LANGSELECT( "RU" ) ; InitMessages() #translate SET LANGUAGE TO UKRAINIAN => _HMG_LANG_ID := ' ' ; #include "hbextlng.ch" ; HB_LANGSELECT( "UA" ) ; InitMessages() #translate SET LANGUAGE TO POLISH => _HMG_LANG_ID := ' ' ; #include "hbextlng.ch" ; HB_LANGSELECT( "PL" ) ; InitMessages() #translate SET LANGUAGE TO CROATIAN => _HMG_LANG_ID := ' ' ; #include "hbextlng.ch" ; HB_LANGSELECT( "HR" ) ; InitMessages() #translate SET LANGUAGE TO SLOVENIAN => _HMG_LANG_ID := ' ' ; #include "hbextlng.ch" ; HB_LANGSELECT( "SL" ) ; InitMessages() #translate SET LANGUAGE TO CZECH => _HMG_LANG_ID := ' ' ; #include "hbextlng.ch" ; HB_LANGSELECT( "CS" ) ; InitMessages() #translate SET LANGUAGE TO BULGARIAN => _HMG_LANG_ID := ' ' ; #include "hbextlng.ch" ; HB_LANGSELECT( "BG" ) ; InitMessages() #translate SET LANGUAGE TO HUNGARIAN => _HMG_LANG_ID := ' ' ; #include "hbextlng.ch" ; HB_LANGSELECT( "HU" ) ; InitMessages() #translate SET LANGUAGE TO SLOVAK => _HMG_LANG_ID := ' ' ; #include "hbextlng.ch" ; HB_LANGSELECT( "SK" ) ; InitMessages() #else ... Прошу проверить его работу, ожидаю Ваш комментарий здесь... Дополнение. Но Ваш вариант предпочтительнее, поскольку в таком случае к приложению не подключаются ненужные языковые модули
gfilatov2002: Просто к сведению. Выпустил сегодня первый RC для новой сборки библиотеки. Полный список изменений см. ниже [pre2] * Fixed: Append a record in a Browse control (via <Alt+A>) worked also with the <Ctrl+Alt+A> and <Shift+Alt+A> hotkeys. Reported and contributed by a HMG user. Adapted for MiniguiEx by Grigory Filatov <gfilatov@inbox.ru> * Fixed: A standard ComboBox control loses an established font color with the defined DISPLAYEDIT clause. Reported by Marcelo A. L. Carli <malcarli@terra.com.br>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\COMBO_4) * Fixed: Wrong font handling in a TimePicker control if the global command SET FONT TO <font>, <size> was defined. Problem was reported by Eladio Bravo <eladibravo@yahoo.es>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\StopEvents) * Modified: Added the global var hInstance internal handling in the all C-code. * New: Added the helpful C-function GetComCtl32DllVer() (see demo in folder \samples\Basic\MAINDEMO_(SYNTAX_I)) * New: Added the helpful C-function GetClassName( <hWnd> ) (see demo in folder \samples\Advanced\MoveDialogBox) * New: Added the internal C-functions GetWindowStyle( <hWnd> ) and IsWindowHasExStyle( <hWnd> ). Contributed by Petr Chornyj <myorg63@mail.ru> * Modified: Revised a ToolTip and ToolTip Custom Draw handling: - the function InitToolTipForRect() was renamed to InitToolTipEx(); - added the new C-functions TTM_Activate(), TTM_SetTipTextColor(), TTM_SetTipBKColor(), TTM_SetMaxTipWidth() and TTM_SetDelayTime(); - added the following new commands: SET TOOLTIP [ ACTIVATE ] <ON | OFF> OF <form> SET TOOLTIP [ ACTIVATE ] TO IsToolTipActive OF <form> Contributed by Petr Chornyj <myorg63@mail.ru> (see demos in folder \samples\Basic\ToolTip\) * Modified: The 'Type' property returns an user-friendly name instead of an internal core name for all controls. Suggested by Roberto Lopez <mail.box.hmg@gmail.com>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\FormStorage) * Modified: Added the global user variable for any purpose in the application. Usage: _HMG_MainCargo := <any value> ; MyVar := _HMG_MainCargo - function syntax: _GetMainCargo () := <value> - pseudo-OOP syntax: Main.Cargo := <value> Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\Histogram) * Enhanced: The BTNTEXTBOX control supports an optional 'NoKeepFocus' clause. Requested by Pete D. <pete_westg/at/yahoo.gr>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demos in folders \samples\Basic\BtnTextBox and \samples\Basic\BtnTextBox_2) * Changed: The function GetFontList() was moved from sample to MiniGUI core. Syntax: aFontList := ; GetFontList( [ hDC ], [ cFontFamilyName ], [ nCharSet ], [ nPitch ],; [ nFontType ], [ lSortCaseSensitive ], @aFontName ) where nCharSet may be ANSI_CHARSET, DEFAULT_CHARSET, SYMBOL_CHARSET etc. nPitch may be FONT_DEFAULT_PITCH, FONT_FIXED_PITCH, FONT_VARIABLE_PITCH nFontType may be FONT_VECTOR_TYPE, FONT_RASTER_TYPE, FONT_TRUE_TYPE Return aFontList is the multidimensional array { { cFontName, nCharSet, nPitchAndFamily, nFontType }, ... } Return by reference aFontName is the unidimensional array { cFontName1, cFontName2, ... } Based upon a contribution of Claudio Soto <srvet@adinet.com.uy> (see demo in folder \samples\Advanced\GetFonts) * Updated: HBPrinter library v.2.40: - Changed: using of the function GetFontList() from the Minigui core instead of a local implementation. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\HBPrinter) * Updated: Socket library source code by Matteo Baccan: - Added SetReplyTo( cReplyTo ) method in tsmtp.prg. Contributed by Milomir Zecevic <zeka/at/bnbos.rs> (see in folder \Source\Socket) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - Changed: using of the header file mgdefs.h in the C-code; - Updated: minor corrections contributed by SergKis. * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.15.1 (from 3.15.0). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Harbour Compiler 3.2.0dev (SVN 2016-10-28 12:29): * Modified: hbrdd and hbrtl were compiled with a custom switch -gc0; * Updated: HbVpdf library source code (see in folder \Source\HbVpdf). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * Updated: HMGS-IDE v.1.4.1 Project Manager and Two-Way Visual Form Designer. Contributed by Grigory Filatov <gfilatov@inbox.ru> (look for what's new at changelog.txt in folder \Ide) * New: 'Inter-process communication' sample. Based upon a contribution of Verchenko Andrey <verchenkoag@gmail.com>. Revised by Petr Chornyj <myorg63@mail.ru> (see in folder \samples\Basic\IPC) * New: 'Grid Columns Width' sample. Based upon a contribution of HMG user KDJ. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\Grid_ColumnsWidth) * New: 'MultiThread usage in HMG' sample. Based upon a contribution of Roberto Lopez <mail.box.hmg@gmail.com>. Enhanced by HMG user KDJ (see in folder \samples\Basic\MultiThread_2) * New: 'Show Password without the asterisks and vice versa' sample. Based upon a contribution of a HMG user. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\ShowPassword) * New: 'Template application' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\Template) * New: 'MiniPrint: insert a last page number after printing' sample. Don't miss this very interesting example! Based upon a contribution of Claudio Soto <srvet@adinet.com.uy>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\MiniPrint2_2) * New: 'TSBrowse: The discovery of different databases on a single form' sample. Based upon a contribution of SergKis. Contributed by Verchenko Andrey <verchenkoag@gmail.com> (see in folder \samples\Advanced\Tsb_4bases) * New: 'HMG Assistant Utility' sample converts HMG Control Objects Alternate Syntax to @... Commands statement. Contributed by Danny A. del Pilar <dhaine_adp/at/yahoo.com>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see readme.txt in folder \Utils\FMG2PRG) * Updated: 'Form Storage' sample. Based upon a contribution of Petr Chornyj <myorg63@mail.ru> (see in folder \samples\Basic\FormStorage) * Updated: 'Print Pie Graph' sample: updated the data for October 2016. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\GraphPrint) * Updated: 'Mouse click on one picture which is divided into 3 parts' sample. Contributed by Petr Chornyj <myorg63@mail.ru> (see demos in folder \samples\Basic\Picture_Coords) * Updated: 'Enable/Disable ToolTip Messages' sample. Contributed by Petr Chornyj <myorg63@mail.ru> (see in folder \samples\Basic\ToolTip\ActivateTTips) * Updated: 'Combo Color' sample by Janusz Pora: added the new HMG colors. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\ComboColor) * Updated: 'Read a text from an another application' sample. Revised by Petr Chornyj <myorg63@mail.ru> (see in folder \samples\Advanced\ExternalApp_3) * Updated: 'Move a standard dialog box in the screen' sample. Revised by Petr Chornyj <myorg63@mail.ru> (see in folder \samples\Advanced\MoveDialogBox) * Updated: 'Run the executable file from an application resource' mixed sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\RCDataToFile) * Updated: 'Simple Phone Book' sample: - fixed a refreshing of the grids after a record deletion. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Applications\PHONE_BOOK) [/pre2]Благодарю за Ваше внимание
gfilatov2002: Опубликована новая сборка 16.11 для следующих С-компиляторов: - BCC 5.51 (Harbour и xHarbour) - BCC 10.1 (только Harbour) - XCC (xHarbour) Прямые ссылки на дистрибутивы есть на домашней странице библиотеки Благодарю за помощь Петра и Андрея Верченко Примечание. Сборки для компилятора MinGW 6.2.0 32/64 bits (только Harbour) теперь доступны только тем, кто материально поддерживал (и поддерживает) работу по обновлению/улучшению библиотеки Прекрасно понимаю, что квалифицированный программист без труда сделает такую сборку самостоятельно на основе других доступных сборок. Но...
Andrey: Привет всем. Нашёл небольшой баг в примере MiniGUI\SAMPLES\BASIC\COLORED_TAB Добавляем в строчку допустим 87 - SIZE 22, далее собираем пример, запускаем всё отлично. Меняем Style на любой - вверху присутствует строка выше Tab. На больших шрифтах НАДПИСЬ на Tab чуток пониже бы надо, а то сильно к верху прилеплена надпись.
gfilatov2002: Andrey пишет: Меняем Style на любой - вверху присутствует строка выше Tab. Если переключиться на следующую вкладку, а затем - вернуться обратно, то все снова отлично Надеюсь, что в реальной программе (а не в примере) не потребуется "на лету" менять стиль и шрифт цветного TABа
Andrey: gfilatov2002 пишет: Надеюсь, что в реальной программе (а не в примере) не потребуется "на лету" менять стиль и шрифт цветного TABа Согласен ! А как быть с этим: На больших шрифтах НАДПИСЬ на Tab чуток пониже бы надо, а то сильно к верху прилеплена надпись.
gfilatov2002: Andrey пишет: На больших шрифтах НАДПИСЬ на Tab чуток пониже бы надо Сейчас в ТАБе большим шрифтом BigFsize считается шрифт, если его размер больше 12. Значит, для шрифтов с размером больше 20, надо вводить обработку BigBigFsize, для шрифтов с размером больше 30, надо вводить обработку BigBigBigFsize и так далее. А какой смысл так усложнять код, если такие большие шрифты используются достаточно редко (обычно размер шрифта до 20)
Andrey: У меня в программе шрифты для большого экрана 22. Уже много заказчиков с большими экранами. Если не сложно, то добавь пожалуйста ещё для обработки BigBigFsize. Заранее большое спасибо !
gfilatov2002: Andrey пишет: добавь пожалуйста ещё Сделал, до размера шрифта 28 работает (но лучше не более 24)
Andrey: Спасибо !
Dima: gfilatov2002 пишет: Сборки для компилятора MinGW 6.2.0 32/64 bits (только Harbour) теперь доступны только тем, кто материально поддерживал (и поддерживает) работу по обновлению/улучшению библиотеки Печаль то какая.... Поделится кто то ссылкой в личку ?
Andrey: gfilatov2002 пишет: Прямые ссылки на дистрибутивы есть на домашней странице библиотеки Григорий, а у себя на сайте ты можешь сделать отдельную страничку под примеры не вошедшие в библиотеку ? У всех же есть и у тебя будет. Да и на сайт чаще заглядывать станут. Тем более что при поиске в Гугле допустим: minigui harbour sendmessage или: minigui Downloader выходит твоя библиотека. Вот и так же сделай пожалуйста страничку под примеры не вошедшие в библиотеку. Кандидаты на страничку: DBF_to_XLS - сделан (уже высылал) DBF_to_DOC - делаю DBF_to_PostgreSQL - делаю Народ, поддержите идею !!!
gfilatov2002: Andrey пишет: сделать отдельную страничку под примеры не вошедшие в библиотеку Благодарю за предложение! На сайте Минигуи Ex есть такая ссылка: https://groups.yahoo.com/neo/groups/harbourminigui/files которая описана следуюшим образом: Additional samples and help files are in the Files area of the Users group З.Ы. Плохой из меня web-мастер...
Andrey: Ссылка не работает, требует логина. Это не есть хорошо. Нужно примерно так: архив-проекта, краткое описание на инглише. Просто и со смыслом. Ну и чтобы тексты попали в индексацию Гугла. А в заголовках примерах я специально пишу на русском, чтобы искать можно было тоже на русском в гугле. Типа: * Передача сообщений между приложениями/процессами при помощи сообщения WM_COPYDATA * Transmission of messages between applications / processes using the WM_COPYDATA Верни пожалуйста в пример русский комментарий заодно.
sashaBG: после SET LAGUAGE TO BULGARIAN Функция NTOCMONTH(1) пробовал и на других и на Русском показывает крокозяблики. Помоему какието йероглфы печатает в остальных сборках все ок
gfilatov2002: sashaBG пишет: Функция NTOCMONTH(1) пробовал и на других и на Русском показывает крокозяблики Благодарю за сообщение! Видимо, существует какая-то нестыковка этого нового компилятора с Харбором для этой функции. Причем это касается только кириллических языков, для латинских языков эта функция работает правильно. В целом же, этот компилятор позволяет нормально интернационалмзмровать приложение для основных востребованных языков.
gfilatov2002: Всем, кому это интересно. Завершается подготовка новой "рождественской" сборки библиотеки 16.12 Полный список изменений см. ниже [pre2] * New: Added a basic support for the multi-monitors system: - New: CountMonitors(), EnumDisplayMonitors(), GetMonitorInfo(), MonitorFromPoint(), MonitorFromWindow(), WindowToMonitor() functions. Contributed by Petr Chornyj <myorg63@mail.ru> * Enhanced: The ButtonEx control supports the optional GRADIENTFILL <aGradient> clause where aGradient can contain any number of gradients and should be specified in the following way: { { nPart, nClrStart, nClrEnd }, { nPart, nClrStart, nClrEnd }, ... } nPart is to be specified as 0.25, 0.5, etc. and should aggregate to 1. The gradient may be specified as Horizontal or Vertical (default value). The BACKCOLOR clause is required and will determine the pressed gradient color which should be defined similar to aGradient array. Based upon a contribution of Petr Chornyj <myorg63@mail.ru>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo4.prg in folder \samples\Basic\ButtonEx) * Modified: Revised a font management by DEFINE FONT <font> FONTNAME <name> ... command: - New: Added the helpful function GetFontParamByRef(). Syntax: lResult := GetFontParamByRef( GetFontHandle( "fnt" ), @n, @s, ... ) (see demo2.prg in folder \samples\Basic\Font) - Changed: The function GetFontList() uses new C-function EnumFontsEx() Contributed by Petr Chornyj <myorg63@mail.ru> * Modified: Revised a global events management by SET EVENTS FUNCTION TO <name> command: - Changed: The internal function SetEventsFunc() was renamed to SetGlobalListener() and added a verify of given funcname rightness; - New: Added the helpful functions GetGlobalListener() and ResetGlobalListener(). Contributed by Petr Chornyj <myorg63@mail.ru> * Changed: The C-function SendMessage( <hWnd>, ... ) will return an error when a first parameter is not a valid window handle. Contributed by Petr Chornyj <myorg63@mail.ru> * Updated: 'Bos Taurus' Graphics Library (see source in folder \Source\BosTaurus): - fixed the memory leaks in the various C-functions. Bug was reported by Marek Olszewski <mol/at/pro.onet.pl>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\BTGraph) * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.15.2 (from 3.15.1). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: HMGS-IDE v.1.4.2 Project Manager and Two-Way Visual Form Designer. Contributed by Grigory Filatov <gfilatov@inbox.ru> (look for what's new at changelog.txt in folder \Ide) * New: 'Ownerdraw ButtonEx control with colors support' sample. Based upon a contribution of HMG user KDJ. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\ButtonEx_2) * Updated: 'ADORDD' sample with using TBROWSE control for a search result show. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\ADORDD_4) * Updated: 'Stainway HMG Demo' sample by Jacek Kubica. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo1.prg in folder \samples\Basic\ButtonEx) * Updated: 'Print Pie Graph' sample: updated the data for November 2016. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\GraphPrint) * Updated: 'Virtual Grid Usage' sample: - New: added export an array to DBF; - New: added export a DBF To Excel. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo2.prg in folder \samples\Basic\Grid_8) [/pre2]Благодарю за Ваше внимание
Andrey: Использую в программе: SET MULTIPLE OFF WARNING Можно ли вместо простой надписи "Программа уже запущена", написать так: Попытка запуска второй копии программы: C:\path\name.exe Отказано в запуске. Программа уже запущена ! А то юзера пугаются, им не вдомёк что уже программу запустили.
Vlad04: А то юзера пугаются, им не вдомёк что уже программу запустили. Объяснишь, после второго раза перестанут пугаться. А после третьего - уже остальным смогут объяснить.
SergKis: Andrey пишет Можно ли вместо простой надписи "Программа уже запущена", написать так: Можно, если поменять значения (см. h_init.prg)[pre2] // MISC MESSAGES (ENGLISH DEFAULT) _HMG_MESSAGE [1] := 'Are you sure ?' _HMG_MESSAGE [2] := 'Close Window' _HMG_MESSAGE [3] := 'Close not allowed' _HMG_MESSAGE [4] := 'Program Already Running' _HMG_MESSAGE [5] := 'Edit' _HMG_MESSAGE [6] := 'Ok' _HMG_MESSAGE [7] := 'Cancel' _HMG_MESSAGE [8] := 'Apply' _HMG_MESSAGE [9] := 'Pag.' [/pre2]
gfilatov2002: SergKis пишет: Можно, если поменять значения (см. h_init.prg) Поправил, теперь в следующей сборке можно будет использовать таким образом: [pre2]/* * MINIGUI - Harbour Win32 GUI library Demo * */ #include "minigui.ch" Function Main() SET LANGUAGE TO RUSSIAN _HMG_MESSAGE [4] := "Попытка запуска второй копии программы:" + CRLF + ; App.ExeName + CRLF + ; "Отказано в запуске." + CRLF + ; _HMG_MESSAGE [4] SET MULTIPLE OFF WARNING DEFINE WINDOW Form_Main ; TITLE 'Warning Demo' ; MAIN END WINDOW CENTER WINDOW Form_Main ACTIVATE WINDOW Form_Main Return Nil[/pre2]
Andrey: gfilatov2002 пишет: Поправил, теперь в следующей сборке можно будет использовать таким образом: Супер, то что нужно ! Спасибо большое !
gfilatov2002: Поздравляю всех с днем Святого Николая! Опубликована новая сборка 16.12 для следующих С-компиляторов: - BCC 5.51 (Harbour и xHarbour) - BCC 10.1 (только Harbour) - XCC (xHarbour) Прямые ссылки на дистрибутивы есть на домашней странице библиотеки Благодарю Петра за огромный вклад в эту сборку, без его помощи она бы не состоялась... Примечание. Сборки для компилятора MinGW 6.2.0 32/64 bits (только Harbour) доступны только тем, кто материально поддерживал (и поддерживает) работу по обновлению/улучшению библиотеки
Dima: gfilatov2002 пишет: Сборки для компилятора MinGW 6.2.0 32/64 bits (только Harbour) доступны только тем, кто материально поддерживал (и поддерживает) работу по обновлению/улучшению библиотеки А сколько стоит билетик ?
gfilatov2002: Dima пишет: сколько стоит билетик ? Сумма пожервования - на Ваше усмотрение (от 10 евро и выше). Важна не сумма, а сам факт помощи в развитии этого проекта
Andrey: Народ ! Давайте Григория поддержим !!! Классный продукт же получился. Не уж то жалко поделиться средствами, которые получаешь на созданном Григории софте ! Там в папке MiniGui есть файл PayPal Donate.url - вот по нему можно оплачивать. Или ещё из России пока действуют переводы в Украину по системе MoneyGram в любом салоне Связной. Там нужно только ФИО и отправить спец.код Григорию по эл.почте или смс-кой.
Veeha: Andrey пишет: Народ ! Давайте Григория поддержим !!! Классный продукт же получился. gfilatov2002 пишет: Благодарю Петра за огромный вклад в эту сборку, без его помощи она бы не состоялась... gfilatov2002 пишет: Сумма пожервования - на Ваше усмотрение (от 10 евро и выше). Обидно будет, если обойдём мимо Петра. Петр, а какие у вас ставки?
Петр: Veeha пишет: Обидно будет, если обойдём мимо Петра. Петр, а какие у вас ставки? ?! What is it? У меня нет возможности работать постоянно над проектом (и отвечать на вопросы пользователей, а куда без них, - тоже ). Поэтому для меня Minigui, что называется just for fun, почти .
Veeha: Петр пишет: У меня нет возможности работать постоянно над проектом (и отвечать на вопросы пользователей На счет работы над проектом ничего не скажу, но на вопросы пользователей вы отвечаете чаще, чем Григорий ... ИМХО ...Петр пишет: что называется just for fun Та ды и мы 'что называется just for fun'
Петр: Veeha пишет: Та ды и мы 'что называется just for fun' Этого не знаю, определяйтесь сами Veeha пишет: На счет работы над проектом ничего не скажу, но на вопросы пользователей вы отвечаете чаще, чем Григорий Наверное, вы имеете в виду этот форум и последнее время, но это не показатель. Так, что Григорий - software developer + software maintainer Я только committer в той части, которая меня интересует.
Andrey: Петр пишет: Я только committer в той части, которая меня интересует. Как бы заинтересовать вас сделать нормальную поддержку PNG в МиниГуи ? Я думаю, что многие бы и я в том числе, поддержали это начинание... 1 картинка PNG 128x128 заменит все форматы ICO, вывод на форму и т.д. А как упроститься работа с ресурсами... Сказочное сокращение рисование иконок из png и т.д. Очень просим помочь !!!
Dima: Andrey пишет: Очень просим помочь !!! Только виртуальным пивом тут не обойдется точно Проданатируй Петра.
Петр: Andrey пишет: 1 картинка PNG 128x128 заменит все форматы ICO, вывод на форму и т.д. Как вы это себе представляете? И почему в MS до этого не додумались
Andrey: Dima пишет: Только виртуальным пивом тут не обойдется точно Без вопросов... Петр пишет: Как вы это себе представляете? И почему в MS до этого не додумались Ну не совсем ясно выразился. Сейчас при показе PNG (прозрачный) на форме и кнопке края картинки выглядят слово их мышь поела - так Дмитрий написал. Это из-за плохой реализации показа.
Dima: Andrey Выложи пример , он был у тебя , там все было понятно , в чем проблема. Один вроде был на чистом С# и такой же на MG + Harbour
Петр: Andrey пишет: Это из-за плохой реализации показа. Реализация вполне стандартная. А вывод PNG (как я понял - с альфа каналом) сам по себе нестандартный. Если подключить GDI+ то 1) Такой вывод достаточно медленный (особенно заметно при больших заливках) 2) Достаточно ресурсоемкий. Но, конечно, картинка иногда может получиться вполне симпатичная, особенно если еще зеркальное отображение сделать В 90% из 100% лучшим способом будет сконвертировать понравившийся PNG в ICO/BMP. Подключение внешних графических библиотек не предлагаю
Andrey: Dima пишет: Выложи пример , он был у тебя Выкладываю - https://cloud.mail.ru/public/8jVN/pbpiYjsaw Вдобавок ко всему, если на форме поменяешь цвет, то надо PNG картинку удалить, а потом заново выводить объект в этом месте, что не есть - ОЧЕНЬ хорошо, для программиста.
Andrey: Петр пишет: В 90% из 100% лучшим способом будет сконвертировать понравившийся PNG в ICO/BMP. Вот и я этим и занимаюсь, картинками, а не программированием. Хочешь красивую прогу, делай ICO все форматы... задолбало. Об этом уже писали мой - Пост N: 4996, Дмитрия - Пост N: 5847 Dima пишет: Куда копать пока не понял. Нужно менять (допиливать) функцию. За вывод PNG на форму и кнопки в минигуи отвечают две функции: HBITMAP HMG_LoadImage( char * FileName ); HBITMAP HMG_LoadPicture( char * FileName, int New_Width, int New_Height, HWND hWnd, int ScaleStretch, int Transparent, long BackgroundColor, int AdjustImage ); Вот есть подсказки как нужно делать: https://msdn.microsoft.com/en-us/library/ee719902(v=VS.85).aspx https://code.logos.com/blog/2008/09/displaying_a_splash_screen_with_c_part_i.html Григорий написал: "Теперь дело за "МАЛЫМ" - найти сишника, который согласится конвертировать эту "радость" в среду Харбора." Вот пример для ICO - https://cloud.mail.ru/public/85DF/VqQteEoJp Вот пример для PNG - https://cloud.mail.ru/public/DMSe/n43rPEZnk А вот так выглядит PNG на C# - https://cloud.mail.ru/public/HuNC/xaHcVzLLz
Петр: Andrey пишет: Хочешь красивую прогу, делай ICO все форматы... Да вот представьте себе, именно такой совет дает msdn: хотите портабельную прогу для win, которая в случае чего и в безопасном режиме могла бы заработать - будьте добры. Andrey пишет: Нужно менять (допиливать) функцию. Знаете я не всегда смотрел за развитием MiniGUI. Но когда-то, после очередного перерыва, увидел, что в состав MiniGUI включили, частично правда, код из библиотеки BosTaurus - инициализацию и использование отдельных функций GDI+. Т.е. теперь любая программа с использованием MiniGUI не будет работать без установленной gdiplus.dll - это цена за использование PNG. Да, согласен, теперь уже тяжело найти машину где б gdiplus.dll не жила, но, поверьте, так было не всегда. И в C# поддержка PNG не была заложена изначально. Не знаю, как теперь, но сначала это делалось с помощью сторонних классов - оберток над тем же GDI+ Andrey пишет: Вот есть подсказки как нужно делать: Я все это (и не только это) видел еще когда писал пример Advanced\GdiPlus и до сих пор не уверен, нужно ли всю эту "радость" тянуть в MiniGUI.
Andrey: Пример \MiniGUI\SAMPLES\BASIC\DirSelect Команда - WAIT WINDOW "Scanning Directories" NOWAIT 1) Окошко есть, а надписи нет ! Почему ? 2) Ставлю такую же команду к себе в большой проект - не собирается, выдает ошибку: Source\form_news.prg(27) Error E0030 Syntax error "syntax error at 'WINDOW'" Почему ? Поставил пока так - WaitWindow( "Загружаю файл....", .T. )
Петр: Andrey пишет: Почему ? Не включен "hmg.ch" #include "hmg.ch" или #include "i_hmgcompat.ch"
Andrey: Петр пишет: Не включен "hmg.ch" #include "hmg.ch" или #include "i_hmgcompat.ch" Это по второму вопросу - маленький пример собирается, а в большом проекте в модуле где ставлю команду WAIT WINDOW "Загружаю файл...." NOWAIT в начале модуля есть #include "minigui.ch" Но не собирается проект, выдаёт ошибку. А по первому вопросу - есть надпись или нет ? У меня надписи нет.
Петр: Andrey пишет: А по первому вопросу - есть надпись или нет ? У меня надписи нет. У меня есть - поэтому на вопрос "Окошко есть, а надписи нет! Почему ?" у меня нет ответа. Кто-то другой может и ответит. Andrey пишет: в начале модуля есть #include "minigui.ch" Вам лень посмотреть hmg.ch и чем он отличается от minigui.ch?
Dima: Петр пишет: У меня есть - поэтому на вопрос "Окошко есть, а надписи нет! Почему ?" у меня нет ответа. Кто-то другой может и ответит. И у меня есть
Andrey: Dima пишет: И у меня есть Значит что-то с 8-кой у меня ! Спасибо Дима !
Andrey: Петр пишет: Вам лень посмотреть hmg.ch и чем он отличается от minigui.ch? Посмотрел minigui.ch, понял что там нет i_hmgcompat.ch . Спасибо !
Dima: gfilatov Просто инфа. Наблюдается проблема с HB_FUNC( TONE ) , прога виснет , при этом Audiodg.exe грузит проц на 70 % Вероятно как то не правильно установлены дрова на звук. Похожая проблема на том же компе и с TeamViewer , он при выходе не заканчивает сессию и повторно попасть на комп не возможно. Остановили службу Audio на компе и выключили звуки , проблема ушла.
gfilatov2002: Опубликована новая сборка 17.01 для следующих С-компиляторов: - BCC 5.51 (Harbour и xHarbour) - BCC 10.1 (только Harbour) - XCC (xHarbour) Базовый дистрибутив для BCC 5.5 лежит по адресу http://hmgextended.com/files/CONTRIB/hmg-17.01-setup.zip Прямые ссылки на другие дистрибутивы есть на домашней странице библиотеки Сборки для компилятора MinGW 6.3.0 32/64 bits для Harbour 3.4.0 доступны только тем, кто материально поддерживал (и поддерживает) работу по обновлению/улучшению библиотеки
Andrey: gfilatov2002 пишет: Опубликована новая сборка 17.01 Попробовал новую сборку и предыдущую. Вылет в уже рабочем проекте... Писал об этом Пост N: 5307 Проект на Версии 16.11 работает без ошибки. Как бы исправить версию 17.01 ?
Петр: Andrey пишет: Как бы исправить версию 17.01 ? Правьте свой код, в 17.01., (в прочем как и в 16.12.) добавлены проверки параметров, передаваемых в функции, всего лишь. Нет у вас ошибок - ничего вылетать не будет (теоретически ). Andrey пишет: Писал об этом Пост N: 5307 Вам там ответ дали, зачем плодить посты? Лучьше последуйте совету и отпишитесь, помогло или нет.
gfilatov2002: Andrey пишет: Проект на Версии 16.11 работает без ошибки. После добавления проверки параметров на С-уровне удалось обнаружить минимум две неточности/ошибки в PRG-коде ядра библиотеки. Так что теперь в последних сборках генерируется качественный код, что, естественно, повышает стабильность программы в целом. Поэтому от Вас потребуется ревизия существующего кода программы для использования самых свежих сборок
Andrey: Понял, спасибо !
Петр: gfilatov2002 пишет: Опубликована новая сборка 17.01 При установке на Win7 постоянно возникает предупреждение, что-то вроде, "Установка завершена некорректно. Переустановить продукт?", хотя вроде бы все устанавливается. Можно ли распространять библиотеку в виде простого архива (как для xhb)? Не рассматривался ли вопрос замены стандартного архиватора на 7z, с учетом как бесплатности, так и доступности данного архиватора?
Dima: Петр пишет: При установке на Win7 постоянно возникает предупреждение, что-то вроде, "Установка завершена некорректно. Переустановить продукт?", хотя вроде бы все устанавливается. То же самое.
gfilatov2002: Петр пишет: При установке на Win7 постоянно возникает предупреждение Возможно, проблема возникает при созданнии ярлыков в папке в меню "Пуск". Просто поставьте галку "Не создавать ярлыки". Петр пишет: Не рассматривался ли вопрос замены стандартного архиватора на 7z Архив для xhb создается с помощью архиватора 7zip Петр пишет: Можно ли распространять библиотеку в виде простого архива (как для xhb)? Конечно, можно (так и было на начальном этапе, когда сборка была экспериментальной). Но с использованием инсталлятора, на мой взгляд, более профессионально...
Петр: gfilatov2002 пишет: Просто поставьте галку "Не создавать ярлыки". Это не решает проблему. gfilatov2002 пишет: Но с использованием инсталлятора, на мой взгляд, более профессионально.. Да, но множество дистрибутивов имеют еще portable версию. А здесь два инсталлятора, только один упакован, другой нет. Т.е. налицо проблема инсталятора - некорректная установка (что именно не так?) и, как я понимаю, ложные срабатывания некоторых антивирусов. Такой подход вряд ли можно назвать профессиональным Не смертельно.
gfilatov2002: Петр пишет: здесь два инсталлятора, только один упакован, другой нет Мысль понял, для следующей сборки сделаю в архиве portable версию вместо упаковки инсталлятора. Благодарю за подсказку
krutoff: Да, у мне тоже пришлось откатиться на версию 16.11, т.к. ошибки возникли в TSBrowse на уровне исходного кода библиотеки.
gfilatov2002: Просто к сведению. Выпустил сегодня первый RC для новой сборки библиотеки. Полный список изменений см. ниже [pre2] * Fixed: The problem of a RadioGroup control with TRANSPARENT clause on a THEMED colored form. Reported by Dusko Radojcin. Contributed by Grigory Filatov <gfilatov@inbox.ru>. * Fixed: Memory leak in the C-function c_SetPicture() at WinXP and an image with alpha chanel. Contributed by Petr Chornyj <myorg63@mail.ru> * New: 'Vista Split Button' control was defined as User Component. A split button control is composed of either a button and a drop-down menu. Syntax: @ <row>,<col> SPLITBUTTON <name> [ OF <parent> ] ; [ WIDTH <w> ] [ HEIGHT <h> ] ; CAPTION <caption> ; ACTION <action> ; [ FONT <cFontName> ] ; [ SIZE <nFontSize> ] ; [ TOOLTIP <tooltip> ] ; [ <default: DEFAULT> ] Note: This control works properly at Windows Vista or later only. Based upon a contribution of Petr Chornyj <myorg63@mail.ru> (see demo in folder \samples\Advanced\SplitButton) * Modified: Programmatic change executes 'On Change' procedure for all controls certainly for compatibility with Official HMG. It is not guarded via the command SET PROGRAMMATICCHANGE OFF anymore. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\Slider) * Updated: Modified SetFocus method of the 'Command Link' button for a proper handling of a focused look at a few buttons on a form. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\CommandLink) * Updated: Synchronized Extended HMG for compatibility with Official HMG 3.4.3 patch 1: - Fixed bug in GetLastActiveFormIndex() and GetLastActiveControlIndex() functions. Based upon a contribution of Claudio Soto <srvet@adinet.com.uy> (see demo in folder \samples\Basic\StopEvents) * New: HbZeeGrid library (see source in folder \Source\HbZeeGrid). ZeeGrid is an editable grid with a similar user interface to Microsoft's Excel spreadsheet. It is released as a compiled DLL and associated header file. You need only distribute the DLL file with your application. Based on the Original Work by David Hillard <david/at/kycsepp.com>. Contributed by Petr Chornyj <myorg63@mail.ru> (see demos in folder \samples\Advanced\HbZeeGrid) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - New: added handling of the variable :nStatusItem to TControl class. Contributed by SergKis. - Fixed: correction for compatibility with a last Minigui improvement. Problem was reported by russian user. * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.17.0 (from 3.16.2). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Harbour Compiler 3.2.0dev (SVN 2017-02-08 19:36): * Fixed: HbZipArc library source code (see in folder \Source\HbZipArc). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * New: 'RadioGroup with multiline items and variable or fixed height' sample. Based upon a contribution of HMG user KDJ. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\RadioGroup_multiline) * New: 'Vista Split Button' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\SplitButton) * Updated: 'ComboBox control with changing of ReadOnly property at runtime' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo2.prg in folder \samples\Basic\COMBO_4) * Updated: MsgMenu sample by Carlos Britos <bcd12a[at]yahoo.com.ar>: - modified for compatibility with a last Minigui improvement. Problem was reported by Fischer Zsolt <fischer.zsolt[at]gmail.com>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\MsgMenu) * Updated: 'UPX shell' sample: added embedding of UPX.EXE inside application. Warning: You should place of upx.exe binary into a project folder for compatibility with this change. Based upon a contribution of Pete D. <pete_westg/at/yahoo.gr> (see in folder \samples\Applications\UPXshell) [/pre2] Благодарю за Ваше внимание
Петр: Andrey пишет: За вывод PNG на форму и кнопки в минигуи отвечают две функции: HBITMAP HMG_LoadImage( char * FileName ); HBITMAP HMG_LoadPicture( char * FileName, int New_Width, int New_Height, HWND hWnd, int ScaleStretch, int Transparent, long BackgroundColor, int AdjustImage ); За вывод отвечает HMG_LoadPicture(). HMG_LoadImage() отвечает за загрузку с использованием OLE или GDI+. В качестве дополнительного анонса: в MiniGUI добавлена ограниченная поддержка вывода картинок с альфа каналом. Пример приложения
Dima: Петр пишет: В качестве дополнительного анонса: в MiniGUI добавлена ограниченная поддержка вывода картинок с альфа каналом. Отлично смотрится
Andrey: Петр пишет: В качестве дополнительного анонса: в MiniGUI добавлена ограниченная поддержка вывода картинок с альфа каналом. Классная вещь ! Давно хотелось такого ! А в чем заключается ограничение ?
gfilatov2002: Опубликована новая сборка 17.02 для следующих С-компиляторов: - BCC 5.51 (Harbour и xHarbour) - BCC 10.1 (только Harbour) - XCC (xHarbour) Базовый дистрибутив для BCC 5.5 лежит по адресу http://hmgextended.com/files/CONTRIB/hmg-17.02-setup.exe Прямые ссылки на другие дистрибутивы есть на домашней странице библиотеки Ваши комментарии приветствуются
Alex_Cher: gfilatov2002 пишет: Опубликована новая сборка 17.02 Уважаемый Григорий, резко упало качество картинок расположенных в окне ... click here
gfilatov2002: Alex_Cher пишет: резко упало качество картинок Благодарю за сообщение! Как лечить: закомментируйте следующую экспериментальную строку в функции HMG_LoadPicture() из файла c_image.c hBitmap = LoadOLEPicturePath( ( const char * ) FileName ); и пересоберите библиотеку с помощью батника MakeLib.bat. Если такое лечение помогло, то обязательно сообщите здесь на форуме...
Alex_Cher: gfilatov2002 пишет: закомментируйте следующую экспериментальную строку в функции HMG_LoadPicture() Уважаемый Григорий, замечание устранено ... благодарю за оперативность ...
Петр: Alex_Cher пишет: резко упало качество картинок расположенных в окне Было бы не плохо, если бы вы выложили фрагмент кода, который выводит картинку, и вообще, замечательно было бы оригинал картинки посмотреть
Alex_Cher: Петр пишет: Было бы не плохо, если бы вы выложили фрагмент кода @ 0,30 IMAGE Image_1 PARENT Form_8 PICTURE _tec_dir + '/dat/Logotip.jpg' ; WIDTH 150 HEIGHT 100 TOOLTIP 'ПАО "АВТОВАЗ" 2014 ' click here
Andrey: Петр пишет: В качестве дополнительного анонса: в MiniGUI добавлена ограниченная поддержка вывода картинок с альфа каналом. Я использую формы цветные (цвет формы разный). Добавил в пример demo.prg цвет формы: [pre2] MAIN BACKCOLOR BLUE [/pre2] И красота примера накрылась.... Опять обгрызанные края у картинки ...
Петр: Andrey пишет: Опять обгрызанные края у картинки ... Что могу сказать.. Ждите мартовский релиз или апрельский, это как решит Григорий. Но думаю, что уже скоро все будет хорошо
Andrey: Петр пишет: Но думаю, что уже скоро все будет хорошо Отличная новость !
Alw Spencer: Приветстую всех gfilatov2002 пишет: Опубликована новая сборка 17.02 Ошибка компиляции примера: C:\MiniGUI\SAMPLES\BASIC\ExtractIcon\demo2.prg demo2.prg(66) Error E0030 Syntax error "syntax error at '@'"
gfilatov2002: Alw Spencer пишет: demo2.prg(66) Error E0030 Syntax error Запишите эту строку следующим образом: [pre] @ nRow, nCol BUTTON &cObj ; OF Form_1 ; ICON cIconSrc ; EXTRACT nI FLAT ; WIDTH 38 HEIGHT 38 ; ACTION SaveThisIcon( cIconSrc, Val( SubStr( This.Name, At( "_", This.Name ) + 1 ) ) ) [/pre]
gfilatov2002: Опубликована новая сборка 17.03 для следующих С-компиляторов: - BCC 5.51 (Harbour и xHarbour) - BCC 10.1 (только Harbour) Базовый дистрибутив для BCC 5.5 и Harbour лежит по адресу http://hmgextended.com/files/CONTRIB/hmg-17.03-setup.exe Прямые ссылки на другие дистрибутивы есть на домашней странице библиотеки Под заказ возможно сделать сборки для таких С-компиляторов: - MinGW 6.3.0 32-bit и Harbour 3.4.0dev; - MinGW 6.3.0 64-bit и Harbour 3.4.0dev; - PellesC 8.0 32-bit и xHarbour 1.2.3 build 10193.
SergKis: gfilatov2002 В Tsb_addrecord_3 demo.prg (line 359) прошла неточность (когда копировал на сайт), надо nCol := oBrw:nColumn("NAME")
gfilatov2002: SergKis пишет: demo.prg (line 359) прошла неточность Благодарю, поправил в архиве сборки на сайте
i3t4j6: gfilatov2002 пишет: Эта функция использовалась очень давно для поиска абонентов в базе данных по фамилии. Но начиная с версии 1702 происходит сбой - в Combobox введенный символ не отражается, хотя абонент находится. Посмотрите , пожалуйста, на текст. Что изменилось в сравнении с версией 1701? *---------------- Function Poisk2(oBrw) Local Buscar,nRow Buscar:=Form_2.Combo_02.DisplayValue If .Not. Empty(Buscar) If abon->(DbSeek(Buscar)) nRow:=oBrw:nLogicPos() Form_2.Brw_8.Value := Abon->(RecNo()) oBrw:Gopos(nRow) oBrw:Refresh( .T. ) oBrw:lHasChanged := .T. Else PlayBeep() EndIf EndIf Return Nil
Vlad04: Непонятки со сборкой 1703. Создаю новый проект в ДИЗАЙНЕРЕ. Добавляю НОВЫЙ МОДУЛЬ в проект- все нормально, добавляю НОВУЮ ФОРМУ - и всё вываливается И IDE закрывается .Старые проекты нормально открываются. В сборке 1702 такого не было
Vlad04: Что-то с IDE. Сборка 1703 с IDE от 1702 нормально работает
gfilatov2002: Vlad04 пишет: добавляю НОВУЮ ФОРМУ - и всё вываливается Благодарю за сообщение! Уже поправил эту ошибку Вы можете обновить HMGS-IDE через меню Help->Update
Vlad04: ок
Andrey: Последняя версия МиниГуи. Примеры MiniGUI\SAMPLES\BASIC\WAIT_WINDOW_2 Картинка на белом фоне ТЕПЕРЬ СЕРАЯ, вместо белой !!! Как исправить на белый цвет ? Заодно и в примерах нужно поправить.
gfilatov2002: Andrey пишет: Как исправить на белый цвет ? Замени класс WHITEBACKGROUND на STRETCH при определении Image_1 Andrey пишет: Заодно и в примерах нужно поправить. Уже сделал для новой сборки
Andrey: gfilatov2002 пишет: Замени класс WHITEBACKGROUND на STRETCH при определении Image_1 Заменил. Не помогло ! Осталось также.
Andrey: Исправил так: [pre2] DEFINE WINDOW &cFormName ; ....... BACKCOLOR {240,240,240} ;[/pre2] Окно стало сереньким как и картинка ... Зато фон окна совпадает с картинкой ! gfilatov2002 правь примеры для следующей версии.
gfilatov2002: Andrey пишет: Окно стало сереньким как и картинка Разобрался с этим... Дело в том, что Минигуи использует в качестве цвета фона окна по умолчанию системный цвет COLOR_BTNFACE. Для 7-й Винды этот цвет как раз {240,240,240}, а не чисто белый, как было сделано в примере. Думаю, что теперь вопрос закрыт Больше хороших новостей о следующей апрельской сборке: - выполнена адаптация библиотеки для работы с Си-компилятором VisualC 2015; - Петр показал, как использовать уже имеющуюся в библиотеке функцию LoadIconByName() для загрузки иконок различных размеров из одного многостраничного ICON файла (это то, чего не хватало в минигуи, Андрею ). Благодарю за Ваше внимание
Andrey: gfilatov2002 пишет: LoadIconByName() для загрузки иконок различных размеров из одного многостраничного ICON файла (это то, чего не хватало в минигуи, Андрею ). Это отличная новость !!! Но боюсь что BCC 5.51 не сможет проглотить этот формат иконок. У меня он вылетает на сборке с ошибкой. Единственную иконку различных размеров линковщик берёт только для MAIN окна... gfilatov2002 пишет: выполнена адаптация библиотеки для работы с Си-компилятором VisualC 2015; Красота ! Что там будет со сборкой .... Надо бы попробовать !!!
gfilatov2002: Andrey пишет: Что там будет со сборкой Сборка библиотеки и примеров осуществляется с помощью Харбор-утилиты hbmk2 Пример батника см.ниже [pre2]@echo off set OLDPATH=%PATH% set HMGPATH=c:\minigui set vccdir=C:\VC2015 SET LIB=%vccdir%\LIB;%vccdir%\SDK\LIB;%vccdir%\kit\lib\x86;%vccdir%\kit\lib\ucrt\x86 SET INCLUDE=%vccdir%\INCLUDE;%vccdir%\SDK\INCLUDE;%hdir%\mvc\include;%vccdir%\kit\include\ucrt;%vccdir%\kit\include\ucrt\sys;%vccdir%\kit\include\um SET PATH=%HMGPATH%\harbour\bin;%vccdir%\BIN;%vccdir%\SDK\BIN echo #define HMGRPATH %HMGPATH%\RESOURCES > _hmg_resconfig.h COPY /b %HMGPATH%\resources\minigui.rc+%1.rc+%HMGPATH%\resources\filler _temp.rc >>NUL hbmk2 %1 %2 %3 %4 %5 %6 %7 %8 %HMGPATH%\minigui.hbc -D__CALLDLL__ -q -warn- -run >build.log 2>&1 del _hmg_resconfig.h del _temp.* set HMGPATH= set PATH=%OLDPATH%[/pre2] Andrey пишет: Надо бы попробовать Напиши мне, пришлю ссылку на архив бетки, в котором есть исходники, примеры, Харбор и уже собранные библиотеки. Примечание. В качестве Си-компилятора здесь используется Command Line Visual C 2015 Compiler, который лежит на сайте http://whosaway.com (его размер около 374 MB)
Andrey: gfilatov2002 пишет: - выполнена адаптация библиотеки для работы с Си-компилятором VisualC 2015; Опять засада... Папка для Си-компилятора тоже называется MiniGui. Как ставить на диск С: одновременно для BCC и MSVC и ещё MinGW ? Может пора переделать структуру папок ?
gfilatov2002: Andrey пишет: Как ставить на диск С: одновременно для BCC и MSVC и ещё MinGW ? Это не серьезно Просто временно переименуйте (или переместите на другой диск) одноименные папки А после тестирования всегда можно все вернуть назад... Andrey пишет: Может пора переделать структуру папок ? Файлы конфигурации в минигуи - только для рабочего примера. Вы можете использовать переменные окружения set HMGPATH=c:\minigui set vccdir=C:\VC2015 в батнике buildapp.bat для настройки требуемой конфигурации
Haz: Григорий Просьба подправить код т.к. если ::nRowCount() < ::nLen игнорируется выполнение ::bChange С поправкой ниже все работает. * ============================================================================ * METHOD TSBrowse:PageDown() Version 9.0 Nov/30/2009 * ============================================================================ Примерно в строке :8555 [pre2] If nKeyPressed == Nil ::Refresh( ::nLen < nTotLines ) If ::bChange != Nil Eval( ::bChange, Self, VK_NEXT ) EndIf ElseIf nSkipped >= nLines ::DrawSelect() Else nKeyPressed := Nil ::DrawSelect() If ::bChange != Nil Eval( ::bChange, Self, VK_NEXT ) EndIf EndIf [/pre2]
gfilatov2002: Haz пишет: С поправкой ниже все работает Благодарю за помощь! Уже поправил
SergKis: gfilatov2002 Возможно, будет интересно, сделать возможность не задавать значения ControlName, ParentForm в функциях, сделав их по default _HMG_ThisControlName, _HMG_ThisFormName. Тогда упростится вызов их в событиях контролов. [pre2] h_ControlMisc.prg : ============= ... *-----------------------------------------------------------------------------* FUNCTION _GetValue ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* ... Default ControlName := _HMG_ThisControlName, ; ParentForm := _HMG_ThisFormName IF PCount() < 3 // было == 2 IF Upper ( ControlName ) == 'VSCROLLBAR' RETURN GetScrollPos ( GetFormHandle ( ParentForm ) , SB_VERT ) ELSEIF Upper ( ControlName ) == 'HSCROLLBAR' RETURN GetScrollPos ( GetFormHandle ( ParentForm ) , SB_HORZ ) ENDIF ... *-----------------------------------------------------------------------------* FUNCTION GetControlIndex ( ControlName, ParentForm ) *-----------------------------------------------------------------------------* // было LOCAL mVar := '_' + ParentForm + '_' + ControlName LOCAL mVar := '_' + iif( Empty(ParentForm ), _HMG_ThisFormName , ParentForm ) + ; '_' + iif( Empty(ControlName), _HMG_ThisControlName, ControlName ) IF __mvExist ( mVar ) RETURN __mvGet ( mVar ) ENDIF RETURN 0 ... и так далее по функциям с LOCAL mVar := '_' + ParentForm + '_' + ControlName h_Windows.prg : =========== ... *-----------------------------------------------------------------------------* FUNCTION GetFormIndex ( FormName ) *-----------------------------------------------------------------------------* // было LOCAL mVar := '_' + FormName LOCAL mVar := '_' + iif( Empty(FormName), _HMG_ThisFormName, FormName ) IF __mvExist ( mVar ) RETURN __mvGet ( mVar ) ENDIF RETURN 0 ... *-----------------------------------------------------------------------------* FUNCTION _ReleaseWindow ( FormName ) *-----------------------------------------------------------------------------* LOCAL b, i, FormHandle Default FormName := _HMG_ThisFormName b := _HMG_InteractiveClose ... [/pre2]
SergKis: SergKis пишет Тогда упростится вызов их в событиях контролов. Т.е. в блоках кода ACTION, GOT\LOST FOCUS, MOUSE..., и т.д. можно писать xVal := _GetValue() _SetValue(,, xVal) nInd := GetControlInex() hCnt := GetControlHandle() ... это облегчает писанину, особенно когда "дурит" препроцессор и не пропускает псевдо ООП команды у себя сделал еще вариант If hb_IsNumeric( ControlName) - то это уже готовый Index конттрола и макро получение индекса не выполняется, используя полученное значение. Но это, наверно, выходит за пределы "религии" hmg
gfilatov2002: SergKis пишет: это, наверно, выходит за пределы "религии" hmg Благодарю за Ваши предложения, но это действительно за пределами философии МиниГуи Кстати, выпустил сегодня pre-release апрельской сборки 17.04 Огромная благодарность Петру за все предложенные улучшения Си-кода ядра библиотеки
gfilatov2002: Опубликована новая сборка 17.04 для следующих С-компиляторов: - BCC 5.51 (Harbour и xHarbour) - BCC 10.1 (только Harbour) Базовый дистрибутив для BCC 5.5 и Harbour лежит по адресу http://hmgextended.com/files/CONTRIB/hmg-17.04-setup.exe Прямые ссылки на другие дистрибутивы есть на домашней странице библиотеки Под заказ возможно сделать сборки для таких дополнительных С-компиляторов: - MinGW 6.3.0 32-bit и Harbour 3.4.0dev; - MinGW 6.3.0 64-bit и Harbour 3.4.0dev; - MS VisualC 2015 32-bit and Harbour 3.2.0dev; - PellesC 8.0 32-bit и xHarbour 1.2.3 build 10193. Ожидаю Ваших комментариев Желаю мира и добра и благодарю за Ваше внимание
SergKis: gfilatov2002 добавочка в INKEYGUI [pre2] ... switch( Msg.message ) { case WM_KEYDOWN : case WM_LBUTTONDOWN: { nRet = 1002; lNoLoop = TRUE; break; } case WM_RBUTTONDOWN: { nRet = 1004; lNoLoop = TRUE; break; } case WM_SYSKEYDOWN : { nRet = Msg.wParam; lNoLoop = TRUE; break; } case WM_TIMER : { lNoLoop = Msg.wParam == dwTimer; break; } } ... [/pre2]
gfilatov2002: SergKis Благодарю за помощь
SergKis: gfilatov2002 Товарищ по работе так предлагает InKeyGUI [pre2] static int _InKeyGUI( UINT nMSec) { MSG Msg; BOOL lNoLoop=FALSE; UINT dwTimer, nRet=0, uTimeout=10; uTimeout = nMSec; if( uTimeout==0 ) uTimeout = 0x0FFFFFFF; dwTimer = SetTimer( NULL, 0, uTimeout, NULL); while( GetMessage(&Msg, NULL, 0, 0) ) { switch( Msg.message ) { case WM_KEYDOWN : case WM_SYSKEYDOWN : { nRet = Msg.wParam; lNoLoop = TRUE; break; } case WM_TIMER : { lNoLoop = Msg.wParam == dwTimer; break; } case WM_LBUTTONDOWN : case WM_RBUTTONDOWN : { lNoLoop = TRUE; PostMessage( Msg.hwnd, Msg.message, Msg.wParam, Msg.lParam ); nRet = (Msg.message==WM_LBUTTONDOWN)? 1002:1004; break; } } if( lNoLoop ) { KillTimer( NULL, dwTimer ); return nRet; } else { TranslateMessage( &Msg ); // Translates virtual key codes DispatchMessage( &Msg ); // Dispatches message to window } } return 0; } // BAA HB_FUNC( INKEYGUI ) { UINT uTimeout=10; if( HB_ISNUM(1) ) uTimeout = hb_parni(1); hb_retni( _InKeyGUI( uTimeout ) ); } [/pre2]
Dima: SergKis пишет: Товарищ по работе так предлагает InKeyGUI Чем такой варик лучше ?
SergKis: Dima пишет Чем такой варик лучше ? При клике с inkeigui, цикл его разрывается, а клик передается туда где кликнул. На примере Tsb_addrecord3 кл. F3 с предыдущими изменениями inkeygui, при клике на др. стр. тсб, просто уберет getbox с ShowGetValid сообщением и все (курсор тсб останется на той же строке), а после предлагаемых изменений, переключится на ту строку, где кликнули, т.е. более естественное поведение inkeygui на кликах мыши
Dima: SergKis пишет: т.е. более естественное поведение inkeygui на кликах мыши
Петр: SergKis пишет: Товарищ по работе так предлагает InKeyGUI Окультуренная версия [pre2] #include "inkey.ch" extern void hmg_ErrorExit( LPCTSTR lpMessage, DWORD dwError, BOOL bExit ); #ifndef USER_TIMER_MINIMUM #define USER_TIMER_MINIMUM 0x0000000A #define USER_TIMER_MAXIMUM 0x7FFFFFFF #endif HB_FUNC( INKEYGUI ) { UINT uElapse = hb_parnidef( 1, USER_TIMER_MINIMUM ); UINT_PTR uTimer; MSG Msg; BOOL bRet, bBreak = FALSE; UINT uRet = 0; if( uElapse == 0 ) uElapse = USER_TIMER_MAXIMUM; uTimer = SetTimer( NULL, 0, uElapse, NULL ); while( ( bRet = GetMessage( &Msg, NULL, 0, 0 ) ) != 0 ) { if( bRet == -1 ) { // handle the error and possibly exit hmg_ErrorExit( TEXT( "INKEYGUI" ), 0, TRUE ); } else { switch( Msg.message ) { case WM_KEYDOWN: case WM_SYSKEYDOWN: bBreak = TRUE; uRet = Msg.wParam; break; case WM_TIMER: bBreak = ( Msg.wParam == uTimer ); break; case WM_LBUTTONDOWN: case WM_RBUTTONDOWN: bBreak = TRUE; uRet = ( Msg.message == WM_LBUTTONDOWN ) ? K_LBUTTONDOWN : K_RBUTTONDOWN; PostMessage( Msg.hwnd, Msg.message, Msg.wParam, Msg.lParam ); break; } } if( bBreak ) { KillTimer( NULL, uTimer ); break; } else { TranslateMessage( &Msg ); // Translates virtual key codes DispatchMessage( &Msg ); // Dispatches message to window } } hb_retns( uRet ); } [/pre2]
SergKis: Петр Дадуда Даду внедрёж. Окультуриваться надо. Вы со мной согласны. Окультуриваться надо.
Andrey: Helper Minigui - последняя версия. Ищу по указателю: Label - показывает @...CHECKLABEL DEFINE CHECKLABEL Так должно быть ? Смотрю там даже два Label.... и два ListBox.... Очепятка наверное...
Alex_Cher: Andrey пишет: Helper Minigui - последняя версия. у меня тоже самое, а поиск с версии 16.07 вообще не работает (я кидал эту тему ранее) ... Беда с Helper ....
gfilatov2002: Опубликована очередная сборка 17.05 для следующих С-компиляторов: - BCC 5.51 (Harbour и xHarbour) - BCC 10.1 (только Harbour) Базовый дистрибутив для BCC 5.5.1 и компилятора Harbour 3.2 лежит по адресу http://hmgextended.com/files/CONTRIB/hmg-17.05-setup.exe Прямые ссылки на другие дистрибутивы есть на домашней странице библиотеки Под заказ возможно сделать сборки для таких дополнительных С-компиляторов: - MinGW 7.1.0 32-bit и Harbour 3.4.0dev; - MinGW 7.1.0 64-bit и Harbour 3.4.0dev; - MS VisualC 2015 32-bit and Harbour 3.2.0dev; - MS VisualC 2017 32-bit and Harbour 3.2.0dev; - PellesC 8.0 32-bit и xHarbour 1.2.3 build 10194. Благодарю за Ваше внимание
SergKis: gfilatov2002 Когда то, давно, предлагал добавить на окно, по аналогии с контролами (_HMG_aControlMiscData1, _HMG_aControlMiscData2) _HMG_aFormMiscData1 - для внутренних штучек окна _HMG_aFormMiscData2 - для Cargo окна предлагаю вернуться к этому вопросу, т.к. без такой добавки затруднено наращивание функционала окна. Т.е. i_var.ch [pre2] #define _HMG_SYSDATA_SIZE 447 // было 445 ... #xtranslate _HMG_aScrollStep => _HMG_SYSDATA\[445\] #xtranslate _HMG_aFormMiscData1 => _HMG_SYSDATA\[446\] #xtranslate _HMG_aFormMiscData2 => _HMG_SYSDATA\[447\] h_init.prg ... _HMG_aFormMiscData1 := {} _HMG_aFormMiscData2 := {} ... h_dialog.prg line 217 _HMG_aFormMiscData1 [k] := {} _HMG_aFormMiscData2 [k] := '' line 273 aAdd( _HMG_aFormMiscData1, {} ) aAdd( _HMG_aFormMiscData2, '' ) line 598 _HMG_aFormMiscData1 [ i ] := {} _HMG_aFormMiscData2 [ i ] := '' h_events.prg line 3271 _HMG_aFormMiscData1 [ i ] := {} _HMG_aFormMiscData2 [ i ] := '' h_folder.prg line 237 _HMG_aFormMiscData1 [k] := {} _HMG_aFormMiscData2 [k] := '' line 293 aAdd( _HMG_aFormMiscData1, {} ) aAdd( _HMG_aFormMiscData2, '' ) line 483 _HMG_aFormMiscData1 [k] := {} _HMG_aFormMiscData2 [k] := '' line 539 aAdd( _HMG_aFormMiscData1, {} ) aAdd( _HMG_aFormMiscData2, '' ) line 905 _HMG_aFormMiscData1 [ i ] := {} _HMG_aFormMiscData2 [ i ] := '' h_windows.prg line 356 _HMG_aFormMiscData1 [k] := {} _HMG_aFormMiscData2 [k] := '' line 414 aAdd( _HMG_aFormMiscData1, {} ) aAdd( _HMG_aFormMiscData2, '' ) line 621 _HMG_aFormMiscData1 [k] := {} _HMG_aFormMiscData2 [k] := '' line 678 aAdd( _HMG_aFormMiscData1, {} ) aAdd( _HMG_aFormMiscData2, '' ) line 857 _HMG_aFormMiscData1 [k] := {} _HMG_aFormMiscData2 [k] := '' line 914 aAdd( _HMG_aFormMiscData1, {} ) aAdd( _HMG_aFormMiscData2, '' ) h_windowsMDI.prg line 277 _HMG_aFormMiscData1 [ i ] := {} _HMG_aFormMiscData2 [ i ] := '' line 426 _HMG_aFormMiscData1 [k] := {} _HMG_aFormMiscData2 [k] := '' line 483 aAdd( _HMG_aFormMiscData1, {} ) aAdd( _HMG_aFormMiscData2, '' ) h_PropSheet.prg line 379 _HMG_aFormMiscData1 [k] := {} _HMG_aFormMiscData2 [k] := '' line 432 aAdd( _HMG_aFormMiscData1, {} ) aAdd( _HMG_aFormMiscData2, '' ) line 613 _HMG_aFormMiscData1 [k] := {} _HMG_aFormMiscData2 [k] := '' line 666 aAdd( _HMG_aFormMiscData1, {} ) aAdd( _HMG_aFormMiscData2, '' ) line 1047 _HMG_aFormMiscData1 [ i ] := {} _HMG_aFormMiscData2 [ i ] := '' [/pre2] При наличии этих штучек, можно что то пробовать, к примеру аналог :UserKeys _HMG_aFormMiscData1 в нашей версии уже задействована чуть - чуть.
gfilatov2002: SergKis пишет: предлагал добавить на окно, по аналогии с контролами Благодарю за напоминание! Добавил эти изменения для следующей сборки
Andrey: gfilatov2002 пишет: - MS VisualC 2015 32-bit and Harbour 3.2.0dev; - MS VisualC 2017 32-bit and Harbour 3.2.0dev; В чём разница между ними ?
SergKis: gfilatov2002 Кое что набрал [pre2] добавить для window Cargo и _HMG_aFormMiscData1 Названия можно менять. FUNCTION _WindowCargo( cFormName, xValue ) Local i := GetFormIndex( cFormName ) Local RetVal If Pcount() == 2; RetVal := _HMG_aFormMiscData2 [ i ] Else ; _HMG_aFormMiscData2 [ i ] := xValue Endif RETURN RetValue #xtranslate _SetWindowCargo( <cFormName>, <xValue> ) ; => ; _WindowCargo( <cFormName>, <xValue> ) #xtranslate _GetWindowCargo( <cFormName> ) ; => ; _WindowCargo( <cFormName> ) #xtranslate SetWindowCargo( <cFormName>, <xValue> ) ; => ; _WindowCargo( <"cFormName">, <xValue> ) #xtranslate GetWindowCargo( <cFormName> ) ; => ; _WindowCargo( <"cFormName"> ) h_controlmisc.prg PROCEDURE SetProperty( Arg1 , Arg2 , Arg3 , Arg4 , Arg5 , Arg6 , Arg7 , Arg8 ) line 3607 CASE Arg2 == "CARGO" _WindowCargo ( Arg1, Arg3 ) FUNCTION GetProperty ( Arg1 , Arg2 , Arg3 , Arg4 , Arg5 , Arg6 , Arg7 ) line 4220 CASE Arg2 == "CARGO" RetVal := _WindowCargo ( Arg1 ) i_this.ch line 48 // WINDOWS (THIS) #xtranslate This . <p:Title,NotifyIcon,NotifyTooltip,FocusedControl,MinHeight,MinWidth,MaxHeight,MaxWidth,TitleBar,SysMenu,Sizable,MaxButton,MinButton,Topmost,HelpButton,Cargo> => GetProperty ( _HMG_THISFORMNAME , <"p"> ) #xtranslate This . <p:Title,NotifyIcon,NotifyTooltip,Cursor,MinHeight,MinWidth,MaxHeight,MaxWidth,TitleBar,SysMenu,Sizable,MaxButton,MinButton,Topmost,HelpButton,Cargo> := <arg> => SetProperty ( _HMG_THISFORMNAME , <"p"> , <arg> ) line 111 #xtranslate ThisWindow . <p:Title,NotifyIcon,NotifyTooltip,FocusedControl,BackColor,Name,Handle,Type,Index,Row,Col,Width,Height,MinHeight,MinWidth,MaxHeight,MaxWidth,TitleBar,SysMenu,Sizable,MaxButton,MinButton,Topmost,Cargo> => GetProperty ( _HMG_THISFORMNAME , <"p"> ) #xtranslate ThisWindow . <p:Title,NotifyIcon,NotifyTooltip,Cursor,BackColor,Row,Col,Width,Height,MinHeight,MinWidth,MaxHeight,MaxWidth,TitleBar,SysMenu,Sizable,MaxButton,MinButton,Topmost,Cargo> := <arg> => SetProperty ( _HMG_THISFORMNAME , <"p"> , <arg> ) i_windows.ch line 63 #xtranslate <w> . \<p:Name,Handle,Type,Index,Title,Height,Width,ClientHeight,ClientWidth,Col,Row,NotifyIcon,NotifyToolTip,FocusedControl,BackColor,MinHeight,MinWidth,MaxHeight,MaxWidth,TitleBar,SysMenu,Sizable,MaxButton,MinButton,Closable,Topmost,HelpButton,Cargo\> => GetProperty ( <"w">, \<"p"\> ) ;; #xtranslate <w> . \<p:Name,Title,Height,Width,Col,Row,NotifyIcon,NotifyToolTip,FocusedControl,Cursor,BackColor,MinHeight,MinWidth,MaxHeight,MaxWidth,TitleBar,SysMenu,Sizable,MaxButton,MinButton,Closable,Topmost,HelpButton,Cargo\> := \<n\> => SetProperty ( <"w">, \<"p"\> , \<n\> ) ;; // Класс для _HMMG_aFormMiscData1. #include "hbclass.ch" CLASS HmgWnd VAR cVar VAR cName VAR cType VAR nIndex VAR nHandle VAR nParent METHOD New( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::nIndex := nIndex, ::cName := cName, ::nHandle := nHandle, ; ::nParent := nParent, ::cType := cType, ::cVar := cVar ) 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 ] ENDCLASS FUNCTION _GetWindowObj( cFormName ) RETURN _HMG_aFormMiscData1 [ GetFormIndex( cFormName ) ][ 1 ] номера строк по последней версии. h_dialog.prg line 221 было ELSE Public &mVar. := Len( _HMG_aFormNames ) + 1 стало ELSE k := Len( _HMG_aFormNames ) + 1 Public &mVar. := k line 277 было ENDIF IF Len( _HMG_aDialogTemplate ) > 0 _HMG_aDialogTemplate[1] := &mVar. ENDIF стало ENDIF _SetThisFormInfo( k ) aAdd( _HMG_aFormMiscData1 [k], HmgWnd():New( k, ; _HMG_aFormNames [k], ; _HMG_aFormHandles [k], ; _HMG_aFormParentHandle [k], ; _HMG_aFormType [k], ; &mVar. ) ) IF Len( _HMG_aDialogTemplate ) > 0 _HMG_aDialogTemplate[1] := &mVar. ENDIF FUNCTION _EndDialog() line 395 _PopEventInfo() RETURN NIL h_folder.prg line 241 было ELSE Public &mVar. := Len( _HMG_aFormNames ) + 1 стало ELSE k := Len( _HMG_aFormNames ) + 1 Public &mVar. := k line 296 было ENDIF IF Len( _HMG_aFolderInfo[_HMG_FldID,FLD_FLT ] ) > 0 _HMG_aFolderInfo[_HMG_FldID,FLD_FLT ,1] := &mVar. ENDIF стало ENDIF _SetThisFormInfo( k ) aAdd( _HMG_aFormMiscData1 [k], HmgWnd():New( k, ; _HMG_aFormNames [k], ; _HMG_aFormHandles [k], ; _HMG_aFormParentHandle [k], ; _HMG_aFormType [k], ; &mVar. ) ) IF Len( _HMG_aFolderInfo[_HMG_FldID,FLD_FLT ] ) > 0 _HMG_aFolderInfo[_HMG_FldID,FLD_FLT ,1] := &mVar. ENDIF FUNCTION _EndFolder() line 390 было LOCAL Formhandle, k, ModalFolderReturn _HMG_aFolderInfo[_HMG_FldID,FLD_AFH] := 0 стало LOCAL Formhandle, k, ModalFolderReturn _PopEventInfo() _HMG_aFolderInfo[_HMG_FldID,FLD_AFH] := 0 line 487 было ELSE Public &mVar. := Len( _HMG_aFormNames ) + 1 стало ELSE k := Len( _HMG_aFormNames ) + 1 Public &mVar. := k line 542 было ENDIF RETURN Nil стало ENDIF _SetThisFormInfo( k ) aAdd( _HMG_aFormMiscData1 [k], HmgWnd():New( k, ; _HMG_aFormNames [k], ; _HMG_aFormHandles [k], ; _HMG_aFormParentHandle [k], ; _HMG_aFormType [k], ; &mVar. ) ) RETURN Nil h_windows.prg line 418 было ENDIF _SetThisFormInfo( k ) aAdd( _HMG_aFormMiscData1 [k], HmgWnd():New( k, ; _HMG_aFormNames [k], ; _HMG_aFormHandles [k], ; _HMG_aFormParentHandle [k], ; _HMG_aFormType [k], ; &mVar. ) ) IF !mdi // JP MDI стало ENDIF _SetThisFormInfo( k ) IF !mdi // JP MDI line 682 было ENDIF _SetThisFormInfo( k ) InitDummy( FormHandle ) стало ENDIF _SetThisFormInfo( k ) aAdd( _HMG_aFormMiscData1 [k], HmgWnd():New( k, ; _HMG_aFormNames [k], ; _HMG_aFormHandles [k], ; _HMG_aFormParentHandle [k], ; _HMG_aFormType [k], ; &mVar. ) ) InitDummy( FormHandle ) line 918 было ENDIF _HMG_ActiveSplitChildIndex := k _SetThisFormInfo( k ) InitDummy( FormHandle ) стало ENDIF _HMG_ActiveSplitChildIndex := k _SetThisFormInfo( k ) aAdd( _HMG_aFormMiscData1 [k], HmgWnd():New( k, ; _HMG_aFormNames [k], ; _HMG_aFormHandles [k], ; _HMG_aFormParentHandle [k], ; _HMG_aFormType [k], ; &mVar. ) ) InitDummy( FormHandle ) h_windowsMDI.prg line 487 было ENDIF _SetThisFormInfo( k ) RETURN ( FormHandle ) стало ENDIF _SetThisFormInfo( k ) aAdd( _HMG_aFormMiscData1 [k], HmgWnd():New( k, ; _HMG_aFormNames [k], ; _HMG_aFormHandles [k], ; _HMG_aFormParentHandle [k], ; _HMG_aFormType [k], ; &mVar. ) ) RETURN ( FormHandle ) h_PropSheet.prg line 380 было ELSE Public &mVar. := Len( _HMG_aFormNames ) + 1 стало ELSE k := Len( _HMG_aFormNames ) + 1 Public &mVar. := k line 432 было ENDIF IF Len( _HMG_aPropSheetTemplate ) > 0 _HMG_aPropSheetTemplate[ 1 ] := &mVar. ENDIF стало ENDIF _SetThisFormInfo( k ) // ????? aAdd( _HMG_aFormMiscData1 [k], HmgWnd():New( k, ; _HMG_aFormNames [k], ; _HMG_aFormHandles [k], ; _HMG_aFormParentHandle [k], ; _HMG_aFormType [k], ; &mVar. ) ) IF Len( _HMG_aPropSheetTemplate ) > 0 _HMG_aPropSheetTemplate[ 1 ] := &mVar. ENDIF line 614 было ELSE Public &mVar. := Len( _HMG_aFormNames ) + 1 стало ELSE k := Len( _HMG_aFormNames ) + 1 Public &mVar. := k line 666 было ENDIF RETURN NIL стало ENDIF _SetThisFormInfo( k ) // ????? aAdd( _HMG_aFormMiscData1 [k], HmgWnd():New( k, ; _HMG_aFormNames [k], ; _HMG_aFormHandles [k], ; _HMG_aFormParentHandle [k], ; _HMG_aFormType [k], ; &mVar. ) ) RETURN NIL // ????? это: Что то пропустил или не понял с h_PropSheet.prg и _SetThisFormInfo( k ) Если ставим _SetThisFormInfo( k ), то где снимать надо _PopEventInfo() ? Или убрать и не ставить _SetThisFormInfo( k ) ? Т.е. работать без команд This. ... . [/pre2]
gfilatov2002: SergKis пишет: Если ставим _SetThisFormInfo( k ), то где снимать надо _PopEventInfo() ? Вероятно, в функции _EndPropSheet() по аналогии с тем, как Вы это делаете в _EndDialog() SergKis пишет: Названия можно менять. Думаю назвать этот класс WndClass (видел, что это имя использует Микрософт для определения класса окна) P.S. Остановился на имени TWndData
gfilatov2002: Andrey пишет: В чём разница между ними ? MS VisualC 2017 вышла в марте этого года и содержит все последнии наработки MS в поддержке стандартов C++. Но, по-видимому, для Харбора это не принципиально...
Петр: SergKis пишет: CLASS HmgWnd Что даст применение этого класса? Кроме возможности самовыразиться
gfilatov2002: SergKis пишет: Кое что набрал Сделал следующие записи в текущий changelog файл: [pre2] * New: Added the TWndData class for storing of form's data. There are the following access variables in the above class now: - Index, Name, Handle, ParentHandle, Type, VarName; - Title, Row, Col, Width, Height, ClientWidth, ClientHeight. Usage: oWin := _GetWindowObj( ThisWindow.Name ) MsgInfo( oWin:Title ) Suggested and contributed by SergKis. * New: Added read/write the user defined property 'Cargo' for the Forms. You can set/get this property at runtime: - function syntax: SetProperty ( Form, 'Cargo', xUserData ) GetProperty ( Form, 'Cargo' ) --> xUserData - pseudo-OOP syntax: Form.Cargo := xUserData Form.Cargo --> xUserData Sample code: ThisWindow.Cargo := InputBox( 'Enter a form's title', 'New Title' ) ThisWindow.Title := ( ThisWindow.Cargo ) It was a postponed user's request. Suggested and contributed by SergKis. [/pre2] Вероятно, потребуется еще добавить пример использования Вашего класса.
SergKis: Петр пишет Что даст применение этого класса? 1. На его базе сделается аналог :UserKeys + возможно, удастся реализовать работу через Post\SendMessage 2. Получив объект, сразу имею доступ (без макросов) к его свойствам (короче писать), не i := GetFormIndex(...) _HMG_aFormNames[ i ] _HMG_aFormHandles[ i ] ... 3. Класс в наборе (пока не рабочий как надо), просто застолбил 1 элемент - HMG_aFormMiscData1 [k] 4. Когда продолжу - не знаю, какое то время буду занят, т.е. его наличие в new версии не мешает, а территория помечена (это по поводу "самовыражения")
SergKis: gfilatov2002 пишет Вероятно, потребуется еще добавить пример использования Вашего класса. Дополнится пример с :UserKes, когда будет готово. Пока ездил сегодня туда сюда, подумалось подправить [pre2] FUNCTION _GetWindowObj( cFormName ) Local i, o If HB_ISCHAR( cFormName ) i := GetFormIndex( cFormName ) Else i := Ascan( _HMG_aFormHandles, cFormName ) EndIf If i > 0 o := _HMG_aFormMiscData1 [ i ][ 1 ] EndIf RETURN o [/pre2]
gfilatov2002: SergKis пишет: Дополнится пример с :UserKes Понял, спасибо SergKis пишет: FUNCTION _GetWindowObj( cFormName ) У меня сейчас эта функция выглядит так: [pre2] *-----------------------------------------------------------------------------* FUNCTION _GetWindowObj( cFormName ) *-----------------------------------------------------------------------------* LOCAL i := GetFormIndex( cFormName ) IF i > 0 RETURN _HMG_aFormMiscData1 [ i ][ 1 ] ENDIF RETURN NIL [/pre2]
Петр: SergKis пишет: На его базе сделается аналог :UserKeys + возможно, удастся реализовать работу через Post\SendMessage Это можно организовать и без ООП. Был уже в истории такой период "hmg objects", чем закончился - не знаю SergKis пишет: просто застолбил 1 элемент - HMG_aFormMiscData1 [k] Это можно сделать и изящнее, см.BASIC\WindowProperty Тогда у вас будет быстрый доступ к данным как на C, так и на PRG уровнях. Вы можете модифицировать стандартную оконную процедуру MiniGUI - WndProc. К примеру, если message входит в диапазон WM_USER.., оконная процедура с помощью GetProp получает связанный обьект и выполняет нужный метод или просто вызывает процедуру/выполняет блок кода, функция Events в этом случае не вызывается. И т.п. было бы желание разгуляться.
SergKis: Петр пишет Это можно сделать и изящнее, см.BASIC\WindowProperty О вкусах не спорю. SET WINDOWPROPERTY "PROP_2" OF Win1 VALUE 2 SET WINDOWPROPERTY "PROP_3" OF Win1 VALUE 3.14 SET WINDOWPROPERTY "PROP_4" OF Win1 VALUE .T. SET WINDOWPROPERTY "PROP_5" OF Win1 VALUE Date() SetProp( Win1.Handle, "PROP_6", hb_serialize( { "One" => 1, 2 => "Two", "Today" => Date(), 5 => NIL, 6 => { .T., .F. } } ) ) а потом RELEASE WINDOWPROPERTY "PROP_2" OF Win1 RELEASE WINDOWPROPERTY "PROP_3" OF Win1 RELEASE WINDOWPROPERTY "PROP_4" OF Win1 RELEASE WINDOWPROPERTY "PROP_5" OF Win1 RELEASE WINDOWPROPERTY "PROP_6" OF Win1 Проходили с MDI интерфейсом - следить за что поставил, что снял - еще то занятие. Не понравилось и отказались. К примеру, если message входит в диапазон WM_USER.., оконная процедура с помощью GetProp получает связанный обьект и выполняет нужный метод или просто вызывает процедуру/выполняет блок кода, функция Events в этом случае не вызывается. Совершенно не возражаю, а даже был бы благодарен, за такую реализацию. Кто бы сделал. Был уже в истории такой период "hmg objects", чем закончился - не знаю Вроде была жива, но там тот же минус - база на _HMG_... переменных, обернутая в объекты (они сверху), не так как hwg (просто летает в сравнении, но там другое ...). А когда работают днями не выходя из проги (hmg), при больших кол-вах контролов и окон, становится заметнее прорисовки на глаз, что вызывает вопросы, у клиента, т.к. псевдо ООП крутит макро и ascan. "hmg objects" реализовывать не собираюсь, просто мне так привычнее, после VO (с C не очень дружу).
SergKis: gfilatov2002 пишет У меня сейчас эта функция выглядит так: Хотелось бы, чтобы объект получался и от Handle окна, не только от имени. Потому и изменения предложил.
Петр: SergKis пишет: Проходили с MDI интерфейсом - следить за что поставил, что снял - еще то занятие. Наверное вы проходили до включения в MiniGUI EnumProps(). Потому, что с EnumProps все эти манипуляции становятся рутинными.
SergKis: Петр пишет Наверное вы проходили до включения в MiniGUI EnumProps(). Потому, что с EnumProps все эти манипуляции становятся рутинными. Это был 2009 год. Добавив в окно простое _HMG_aFormMiscData1 - решили проблемы наращивания функционала"естественным" способом, аналогичный контролам hmg, т.е. поведение псвесдо объектов контролов и окон одинаково. Сами включали в свою версию EnumProc и это работало, пока не наткнулись (с разрастанием программы) на плавающий завис на нем. Убрали - все стало ok.
gfilatov2002: SergKis пишет: Хотелось бы, чтобы объект получался и от Handle окна, не только от имени. Не вопрос, уже переписал эту функцию так: [pre]*-----------------------------------------------------------------------------* FUNCTION _GetWindowObj( FormName ) *-----------------------------------------------------------------------------* LOCAL i := iif( HB_ISNUMERIC( FormName ), ; AScan( _HMG_aFormHandles, FormName ), GetFormIndex( FormName ) ) IF i > 0 RETURN _HMG_aFormMiscData1 [ i ][ 1 ] ENDIF RETURN NIL [/pre] И рабочий код для проверки [pre]@ 100,100 BUTTON Button_11 CAPTION "Click " WIDTH 100 HEIGHT 30 ; ACTION ( ThisWindow.Cargo := inputbox('Enter text' , 'New Title' , ; _GetWindowObj( ThisWindow.Handle ):Title ), ; ThisWindow.Title := (ThisWindow.Cargo) ) [/pre]
Петр: SergKis пишет: Сами включали в свою версию EnumProc и это работало, пока не наткнулись (с разрастанием программы) на плавающий завис на нем. Убрали - все стало ok. Я не видел сообщений об ошибке на этом форуме. К сожалению, это почти практика для пользователей MiniGUI - смастерить костыль, а не искать причину.
SergKis: Петр пишет смастерить костыль, а не искать причину. Когда костыль вылазит только у некоторых клиентов и случ. образом, как то не до практики искать истинную причину. А о сообщениях писать ... не всегда есть смыл. Писал я, что столкнулись, у клиентов, не работает совсем или частично уст. клавишь HotKey и что ... ? Переделали под себя на CLASS hmgBrowseKey, подсунули вместо HotKey и с 10-го работает как часы + в тсб KeyDown ... Как там было "Думать некогда, стучать надо."
SergKis: gfilatov2002 пишет уже переписал эту функцию так Пример может и так выглядеть. DEFINE WINDOW ... PRIVATE oWnd := _GetWindowObj(This.Name) ... ACTION ... oWnd:Title и так везде. Если в объект добавить ASSIGNы, то oWnd:Title := '...' с использованием WITH OBJECT oWnd :Title и т.д.
SergKis: gfilatov2002 Вариант с UserKeys на окно (TWndData на старом варианте) [pre2] FUNCTION GetProperty ( Arg1 , Arg2 , Arg3 , Arg4 , Arg5 , Arg6 , Arg7 ) CASE Arg2 == "CARGO" RetVal := _WindowCargo ( Arg1 ) CASE Arg2 == "OBJECT" RetVal := _GetWindowObj ( Arg1 ) i_this.ch line 48 // WINDOWS (THIS) #xtranslate This . <p:Title,NotifyIcon,NotifyTooltip,FocusedControl,MinHeight,MinWidth,MaxHeight,MaxWidth,TitleBar,SysMenu,Sizable,MaxButton,MinButton,Topmost,HelpButton,Cargo,Object> => GetProperty ( _HMG_THISFORMNAME , <"p"> ) line 111 #xtranslate ThisWindow . <p:Title,NotifyIcon,NotifyTooltip,FocusedControl,BackColor,Name,Handle,Type,Index,Row,Col,Width,Height,MinHeight,MinWidth,MaxHeight,MaxWidth,TitleBar,SysMenu,Sizable,MaxButton,MinButton,Topmost,Cargo,Object> => GetProperty ( _HMG_THISFORMNAME , <"p"> ) i_windows.ch line 63 #xtranslate <w> . \<p:Name,Handle,Type,Index,Title,Height,Width,ClientHeight,ClientWidth,Col,Row,NotifyIcon,NotifyToolTip,FocusedControl,BackColor,MinHeight,MinWidth,MaxHeight,MaxWidth,TitleBar,SysMenu,Sizable,MaxButton,MinButton,Closable,Topmost,HelpButton,Cargo,Object\> => GetProperty ( <"w">, \<"p"\> ) ;; ////////////////////////////////////////////////////////////////////////////////////////////// CLASS TWndData PROTECTED: VAR cVar VAR cName VAR cType VAR nIndex VAR nHandle VAR nParent EXPORTED: VAR oUserKeys METHOD New( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::nIndex := nIndex, ::cName := cName, ::nHandle := nHandle, ; ::nParent := nParent, ::cType := cType, ::cVar := cVar, ; ::oUserKeys := TKeyData():New(), ; Self ) CONSTRUCTOR 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 ] METHOD UserKeys( Key, Block ) INLINE iif( HB_ISBLOCK( Block ), ; ::oUserKeys:Set( Key, Block ), ; ::oUserKeys:Do ( Key, Block ) ) ENDCLASS ////////////////////////////////////////////////////////////////////////////////////////////// CLASS TKeyData PROTECTED: VAR oObj VAR aKey INIT hb_Hash() VAR bBlk EXPORTED: VAR Cargo METHOD New( o ) INLINE ( ::Obj := o, Self ) CONSTRUCTOR METHOD Set( Key, Block ) INLINE hb_HSet( ::aKey, Key, Block ) METHOD Get( Key ) INLINE hb_HGetDef( ::aKey, Key, Nil ) METHOD Del( Key ) INLINE iif( hb_hHasKey( ::aKey, Key ), hb_HDel( Key ), ) METHOD Do ( Key, Param ) INLINE ( ::bBlk := ::Get(Key), iif( HB_ISBLOCK(::bBlk), ; EVal(::bBlk, ::Obj, Key, Param), Nil ) ) ACCESS Obj INLINE ::oObj ASSIGN Obj( o ) INLINE ::oObj := iif( HB_ISOBJECT(o), o, Self ) ENDCLASS ////////////////////////////////////////////////////////////////////////////////////////////// Пример с :UserKeys дополнить ... ON RELEASE dbCloseAll() PRIV oWnd := This.Object oWnd:UserKeys('M_1_1', {|o,k,p| MsgBox( o:ClassName+"|"+cValToChar(k)+"|"+cValToChar(p), This.Name ) }) oWnd:UserKeys('M_1_2', {|o,k,p| MsgBox( o:ClassName+"|"+cValToChar(k)+"|"+cValToChar(p), This.Name ) }) oWnd:UserKeys('M_1_3', {|o,k,p| MsgBox( o:ClassName+"|"+cValToChar(k)+"|"+cValToChar(p), This.Name ) }) oWnd:UserKeys('M_1_4', {|o,k,p| MsgBox( o:ClassName+"|"+cValToChar(k)+"|"+cValToChar(p), This.Name ) }) oWnd:UserKeys('M_1_5', {|o,k,p| MsgBox( o:ClassName+"|"+cValToChar(k)+"|"+cValToChar(p), This.Name ) }) oWnd:UserKeys('M_1_6', {|o,k,p| MsgBox( o:ClassName+"|"+cValToChar(k)+"|"+cValToChar(p), This.Name ) }) oWnd:UserKeys('M_1_7', {|o,k,p| MsgBox( o:ClassName+"|"+cValToChar(k)+"|"+cValToChar(p), This.Name ) }) oWnd:UserKeys('M_1_8', {|o,k,p| MsgBox( o:ClassName+"|"+cValToChar(k)+"|"+cValToChar(p), This.Name ) }) oWnd:UserKeys('M_1_9', {|o,k,p| MsgBox( o:ClassName+"|"+cValToChar(k)+"|"+cValToChar(p), This.Name ) }) oWnd:UserKeys('M_1_0', {| | ThisWindow.Release() }) oWnd:UserKeys('M_2_1', {|o,k,p| MsgBox( o:ClassName+"|"+cValToChar(k)+"|"+cValToChar(p), This.Name ) }) oWnd:UserKeys('M_2_2', {|o,k,p| MsgBox( o:ClassName+"|"+cValToChar(k)+"|"+cValToChar(p), This.Name ) }) oWnd:UserKeys('M_2_3', {|o,k,p| MsgBox( o:ClassName+"|"+cValToChar(k)+"|"+cValToChar(p), This.Name ) }) oWnd:UserKeys('M_3_1', {| | MsgBox( ( This.Name )+"|"+( ThisWindow.Name ) , oWnd:Name ) }) oWnd:UserKeys('M_3_2', {| | MsgBox( ( This.Name )+"|"+( ThisWindow.Name ) , oWnd:Name ) }) oWnd:UserKeys('M_3_3', {| | MsgBox( ( This.Name )+"|"+( ThisWindow.Name ) , oWnd:Name ) }) DEFINE MAIN MENU POPUP 'MENU_1' ITEM 'Item main menu 1.1' ACTION oWnd:UserKeys( This.Name, {3,2,1,0} ) NAME M_1_1 IMAGE 'n1' ITEM 'Item main menu 1.2' ACTION oWnd:UserKeys( This.Name, {1,2,3,4} ) NAME M_1_2 IMAGE 'n2' ITEM 'Item main menu 1.3' ACTION oWnd:UserKeys( This.Name, {'A','B'} ) NAME M_1_3 IMAGE 'n3' ITEM 'Item main menu 1.4' ACTION oWnd:UserKeys( This.Name, {'C'} ) NAME M_1_4 IMAGE 'n4' ITEM 'Item main menu 1.5' ACTION oWnd:UserKeys( This.Name ) NAME M_1_5 IMAGE 'n5' ITEM 'Item main menu 1.6' ACTION oWnd:UserKeys( This.Name ) NAME M_1_6 IMAGE 'n6' ITEM 'Item main menu 1.7' ACTION oWnd:UserKeys( This.Name ) NAME M_1_7 IMAGE 'n7' ITEM 'Item main menu 1.8' ACTION oWnd:UserKeys( This.Name ) NAME M_1_8 IMAGE 'n8' ITEM 'Item main menu 1.9' ACTION oWnd:UserKeys( This.Name ) NAME M_1_9 IMAGE 'n9' SEPARATOR ITEM 'Exit' ACTION oWnd:UserKeys( This.Name ) NAME M_1_0 END POPUP POPUP 'MENU_2' ITEM 'Item main menu 2.1' ACTION oWnd:UserKeys( This.Name, 2.1 ) NAME M_2_1 IMAGE 'n1' ITEM 'Item main menu 2.2' ACTION oWnd:UserKeys( This.Name, 2.2 ) NAME M_2_2 IMAGE 'n2' ITEM 'Item main menu 2.3' ACTION oWnd:UserKeys( This.Name, 2.3 ) NAME M_2_3 IMAGE 'n3' END POPUP POPUP 'MENU_3' ITEM 'Item main menu 3.1' ACTION oWnd:UserKeys( This.Name ) NAME M_3_1 IMAGE 'n1' ITEM 'Item main menu 3.2' ACTION oWnd:UserKeys( This.Name ) NAME M_3_2 IMAGE 'n2' ITEM 'Item main menu 3.3' ACTION oWnd:UserKeys( This.Name ) NAME M_3_3 IMAGE 'n3' END POPUP END MENU DEFINE STATUSBAR ... [/pre2]
SergKis: PS Если ACTION контрола не задам, по умолчанию, можно выполнять oWnd:UserKeys( This.Name ) Проще писать.
gfilatov2002: SergKis пишет: Вариант с UserKeys на окно Благодарю за помощь! Буду разбираться... P.S. Супер! Все работает как надо
SergKis: gfilatov2002 В пример по использованию Cargo добавьте строки [pre2] PRIV oWnd := This.Object oWnd:oUserKeys:Cargo := TKeyData():New() oWnd:oUserKeys:Cargo:Set(1, "Harbour") oWnd:oUserKeys:Cargo:Set(2, "MiniGui") oWnd:oUserKeys:Cargo:Set(3, "OK !") oWnd:UserKeys('M_1_1', {|o,k,p| MsgBox( o:ClassName+"|"+cValToChar(k)+"|"+cValToChar(p), This.Name ) }) ... oWnd:UserKeys('M_2_4', {|o | MsgBox( o:Cargo:Get(1)+" "+o:Cargo:Get(3) , This.Name ) }) oWnd:UserKeys('M_2_5', {|o | MsgBox( o:Cargo:Get(2)+" "+o:Cargo:Get(3) , This.Name ) }) [/pre2]
SergKis: PS. промахнулся по кнопке. Еще [pre2] ITEM 'Item main menu 2.3' ACTION oWnd:UserKeys( This.Name, 2.3 ) NAME M_2_3 IMAGE 'n3' ITEM 'Item main menu 2.4' ACTION oWnd:UserKeys( This.Name ) NAME M_2_4 IMAGE 'n4' ITEM 'Item main menu 2.5' ACTION oWnd:UserKeys( This.Name ) NAME M_2_5 IMAGE 'n5' [/pre2]
gfilatov2002: SergKis пишет: В пример по использованию Cargo Благодарю за Вашу помощь! Добавил такое описание в текущий changelog: [pre2] * New: Added the simple TWndData class for a storing of the windows data. There are the following access variables in the above class now: - Index, Name, Handle, ParentHandle, Type, VarName; - Title, Row, Col, Width, Height, ClientWidth, ClientHeight. Added the readonly property 'Object' for the all windows. Usage: - function syntax: oWin := GetProperty( ThisWindow.Name, "Object" ) - pseudo-OOP syntax: oWin := ThisWindow.Object MsgInfo( oWin:Title, oWin:Name ) Added the method UserKeys( Key, Block ) and the associated set/get TKeyData class for assigning and executing a codeblock for the objects. The above classes are guarded by the constant _DEBUG_ in the sources (look at minigui.ch in folder \include). Suggested and contributed by SergKis. (see demo in folder \samples\Advanced\Tsb_UserKeys) [/pre2] Всем пока - убегаю в отпуск
Петр: SergKis пишет: у клиентов, не работает совсем или частично уст. клавишь HotKey и что ... ? Это нормально, к Минигуи претензий не может быть никаких (почти). HotKey в библиотеке построены на RegisterHotKey(), описание которой с указанием причин отказа в регистрации можно легко найти в нете. К тому же HotKey system-wide. Вот интересно почему в MiniGUI не реализована поддержка акселераторов (accelerators)?
Петр: Ваше решение (UserKeys), базированное на WM_KEYDOWN, - это нормальное рабочее решение. Но вот что пишет msdn You could implement keyboard shortcuts by handling individual WM_KEYDOWN messages, but accelerator tables provide a better solution that: -Requires less coding; -Consolidates all of your shortcuts into one data file; -Supports localization into other languages; -Enables shortcuts and menu commands to use the same application logic.
Петр: Ограниченную поддержку акселераторов в MiniGUI организовать просто Пример (only Harbour): [pre2]/* * Harbour MiniGUI Accelerators Demo * (c) 2017 P.Ch. */ #include "minigui.ch" #include "i_winuser.ch" #include "demo.ch" MEMVAR hMenu, hAccel init procedure App_OnInit() PUBLIC hMenu := LoadMenu( Nil, 'MainMenu' ) PUBLIC hAccel := LoadAccelerators( Nil, 'FontAccel' ) if Empty( hAccel ) quit endif SetGlobalListener( 'App_OnEvents' ) return ////////////////////////////////////////////////////////////////////////////// function Main() DEFINE WINDOW Win_1 ; CLIENTAREA 400, 400 ; BACKCOLOR BLACK ; TITLE 'Accelerators Demo' ; MAIN ; ON INIT ; ( ; SetMenu( ThisWindow.Handle, hMenu ), ; SetAccelerators( ThisWindow.Handle, hAccel ) ; ) ; ON RELEASE ; ( ; DestroyMenu( hMenu ), ; DestroyAcceleratorTable( hAccel ) ; ) END WINDOW Win_1.Center Win_1.Activate return 0 ////////////////////////////////////////////////////////////////////////////// function App_OnEvents( hWnd, nMsg, wParam, lParam ) local nResult switch nMsg case WM_COMMAND switch LoWord( wParam ) case IDM_REGULAR case IDM_BOLD case IDM_ITALIC case IDM_ULINE MsgInfo( 'ID:' + hb_NtoS( LoWord( wParam ) ), iif( 0 == HiWord( wParam ), 'Menu', 'Accelerator' ) ) nResult := 0 exit otherwise nResult := Events( hWnd, nMsg, wParam, lParam ) end exit otherwise nResult := Events( hWnd, nMsg, wParam, lParam ) end return nResult ////////////////////////////////////////////////////////////////////////////// #pragma BEGINDUMP /* Parts of this code is contributed and used here under permission of his author: Copyright 2016 (C) P.Chornyj <myorg63@mail.ru> */ #include <hbwinuni.h> #include <mgdefs.h> #include "hbapiitm.h" extern HINSTANCE g_hInstance; // BOOL WINAPI DestroyAcceleratorTable( HACCEL hAccel ) HB_FUNC( DESTROYACCELERATORTABLE ) { HACCEL hAccel = ( HACCEL ) ( LONG_PTR ) HB_PARNL( 1 ); hb_retl( DestroyAcceleratorTable( hAccel ) ? HB_TRUE : HB_FALSE ); } // HACCEL WINAPI LoadAccelerators( HINSTANCE hInstance, LPCTSTR lpTableName ) HB_FUNC( LOADACCELERATORS ) { HACCEL hAccel = ( HACCEL ) NULL; HINSTANCE hInstance = HB_ISNUM( 1 ) ? ( HINSTANCE ) HB_PARNL( 1 ) : g_hInstance; LPCTSTR lpTableName; if( HB_ISNUM( 2 ) ) { lpTableName = MAKEINTRESOURCE( ( WORD ) hb_parnl( 2 ) ); hAccel = LoadAccelerators( hInstance, lpTableName ); } else if( HB_ISCHAR( 2 ) ) { void * hTableName; lpTableName = HB_PARSTR( 2, &hTableName, NULL ); hAccel = LoadAccelerators( hInstance, lpTableName ); hb_strfree( hTableName ); } HB_RETNL( ( LONG_PTR ) hAccel ); } // HMENU WINAPI LoadMenu( HINSTANCE hInstance, LPCTSTR lpMenuName ) HB_FUNC( LOADMENU ) { HMENU hMenu = ( HMENU ) NULL; HINSTANCE hInstance = HB_ISNUM( 1 ) ? ( HINSTANCE ) HB_PARNL( 1 ) : g_hInstance; LPCTSTR lpMenuName; if( HB_ISNUM( 2 ) ) { lpMenuName = MAKEINTRESOURCE( ( WORD ) hb_parnl( 2 ) ); hMenu = LoadMenu( hInstance, lpMenuName ); } else if( HB_ISCHAR( 2 ) ) { void * hMenuName; lpMenuName = HB_PARSTR( 2, &hMenuName, NULL ); hMenu = LoadMenu( hInstance, lpMenuName ); hb_strfree( hMenuName ); } HB_RETNL( ( LONG_PTR ) hMenu ); } #pragma ENDDUMP [/pre2]
Петр: Для того, чтобы пример заработал нужны еще 2 файла [pre2]// demo.ch #define IDM_REGULAR 1100 #define IDM_BOLD 1200 #define IDM_ITALIC 1300 #define IDM_ULINE 1400[/pre2] [pre2]// demo.rc #include "demo.ch" MainMenu MENU { POPUP "&Character" { MENUITEM "&Regular\tF5", IDM_REGULAR MENUITEM "&Bold\tCtrl+B", IDM_BOLD MENUITEM "&Italic\tCtrl+I", IDM_ITALIC MENUITEM "&Underline\tCtrl+U", IDM_ULINE } } FontAccel ACCELERATORS { VK_F5, IDM_REGULAR, VIRTKEY "B", IDM_BOLD, CONTROL, VIRTKEY "I", IDM_ITALIC, CONTROL, VIRTKEY "U", IDM_ULINE, CONTROL, VIRTKEY }[/pre2]
Петр: Также нужно внести изменения в библиотеку (c_windowsAPI.c) и пересобрать ее [pre2] static HWND hWndMain = NULL; static HACCEL hAccel = NULL; HB_FUNC( SETACCELERATORS ) { hWndMain = ( HWND ) ( LONG_PTR ) HB_PARNL( 1 ); hAccel = ( HACCEL ) ( LONG_PTR ) HB_PARNL( 2 ); } HB_FUNC( DOMESSAGELOOP ) { MSG Msg; BOOL bRet; while( ( bRet = GetMessage( &Msg, NULL, 0, 0 ) ) != 0 ) { hDlgModeless = GetActiveWindow(); if( bRet == -1 ) { // handle the error and possibly exit hmg_ErrorExit( TEXT( "DOMESSAGELOOP" ), 0, TRUE ); } else { if( hDlgModeless == ( HWND ) NULL || ! TranslateAccelerator( hWndMain, hAccel, &Msg ) ) { if( ! IsDialogMessage( hDlgModeless, &Msg ) ) { TranslateMessage( &Msg ); DispatchMessage( &Msg ); } } } } }[/pre2]
gfilatov2002: Петр пишет: поддержку акселераторов в MiniGUI организовать просто Благодарю за Ваш весомый вклад в развитие библиотеки! Отдельное спасибо за реализацию функции LoadMenu
SergKis: Петр 1. Не очень понимаю, как это поможет решить задачу, установки таблицы- код нажатой клавиши и исп. блока кода В VO это решалось, в основном, через ресурсный редактор, но этого хотелось бы избежать. В Events нет WM_KEYDOWN (только WM_HOTKEY). Если на окне есть Tsb (несколько), и по hWnd получается объект тсб, то обработчик oBrw:HandleEvent, т.е. работают уст. клавиши на тсб, что нормально. Что мешает, вкл. обработчик на WN_KEYDOWN (тсб проскочил), схематично[pre2] IF IsInitMenuPopup .AND. wParam == VK_ESCAPE _CloseMenu() ELSE i := ascan( _HMG_aControlHandles, hWnd ) If i > 0 oWnd := _GetWindowObj( _HMG_aControlParentHandle[ i ] ) If HB_ISOBJECT(oWnd) /* в объект окна добавляем объект oKeyDown (похожий на TKeyData, для VK_клавиш) и выполняем блок кода (если установлен) с передачей Indexа контрола, который в фокусе, для вып. _DoControlEventprocedure(bBlock, i ), для обрамления переменными _HMG_This... Ведь в фокусе могут быть кнопка, GetBox, ..., т.е. ставим таблицу oWnd:KeyDown(VK_..., {|o...| ... }) Так же можем сделать и для WM_KEYUP, oKeyUp ... Что бы разъединить схемы работы wm_HotKey (сейчас в работе) и wm_KeyDown, в класс окна поставим :lHotKey := .T. - как сейчас. Что успел посмотреть, вроде склеивается (надо подправить возврат после UserKey, что то перепутал\недосмотрел), добавить в пример кнопки Button[ex], GetBox, др. окно и пробовать (это планы, вопрос только время найти. Машина сломалась, время нашлось. что то сделал, пока в ремонте). А Post\SendMsg по нажатиям\отпусканиям можем посылать др. окнам, с того, что в фокусе и получить с др. окна на текущее. */ RETURN 0 EndIf EndIf ENDIF exit 2. Уже писал, с С\WinApi не очень дружу, потому кто бы сделал (но не я) [/pre2]
Петр: SergKis пишет: Не очень понимаю, как это поможет решить задачу, установки таблицы- код нажатой клавиши и исп. блока кода А в чем проблема? Я же написал - пример ограниченной поддержки, с минимальным изменением кода библиотеки. Полную интеграцию можно провести по разному - стандартный поиск в массивах никто не отменял. SergKis пишет: В VO это решалось, в основном, через ресурсный редактор, но этого хотелось бы избежать. Опять же пример с упором на работу с ресурсами. Таблицу акселераторов также можно и создавать и менять на лету. Но это тема другого примера. SergKis пишет: Так же можем сделать и для WM_KEYUP Да мы и теперь любое сообщение (причем без всяких дополнительных обьектов) можем обрабатывать (set events) - ничего не мешает.
SergKis: Петр пишет можем обрабатывать (set events) - ничего не мешает. В версии 2.07 этого нет, да я писал, что такое решение на постоянной основе мне не по душе (как отладка какого то решения - можно использовать). Лучше привести код Evens к нужному решению, чем плодить set eventsы. В целом проблема решена (на нашей версии) работать без HotKey, но если переходить на тек. версию, все проблемы SET KEY ... ACTION ... опять вылезут. Потому я и поднимаю волну, но пока перехода не предвидится это не горит, а других все устраивает. Петр СПАСИБО за участие
gfilatov2002: Петр пишет: пример с упором на работу с ресурсами Добавил такое описание в текущий файл changelog: [pre2] * New: Added possibility to load a Menu from a resource with the accelerators. It was a postponed user's request. Contributed by Petr Chornyj <myorg63@mail.ru> (see demo in folder \samples\Basic\MenuRES) [/pre2]Благодарю за помощь
Петр: MenuRES, я так понял, по аналогии с MenuDBF. gfilatov2002 пишет: Благодарю за помощь Да не за что, будет что-то интересное поделюсь еще В часности, SergKis подбросил интересную идею, попробую реализовать что-то подобное ON APPEVENT [NAME] <evName> [ID <id>] | [AUTO] EVAL <{block}> [ONCE] EMIT <evName>
SergKis: Петр пишет попробую реализовать что-то подобное ON APPEVENT [NAME] <evName> [ID <id>] | [AUTO] EVAL <{block}> [ONCE] EMIT <evName> Как это поможет реализовать такую схему (из HwGui) [pre2] CLASS HCustomWindow содержит переменную для наращивания обработчика для своих нужд DATA bOther ... METHOD onEvent( msg, wParam, lParam ) CLASS HCustomWindow LOCAL i // Writelog( "== "+::Classname()+Str(msg)+IIF(wParam!=NIL,Str(wParam),"NIL")+IIF(lParam!=NIL,Str(lParam),"NIL") ) IF ( i := Ascan( aCustomEvents[ EVENTS_MESSAGES ], msg ) ) != 0 RETURN Eval( aCustomEvents[ EVENTS_ACTIONS, i ], Self, wParam, lParam ) ELSEIF ::bOther != NIL RETURN Eval( ::bOther, Self, msg, wParam, lParam ) ENDIF RETURN - 1 от этого класса наследованы окна, контролы и следовательно задав :bOther, получаем работу своего обработчика как на окна, так и на контролах. В МиниГуи есть некоторве обработчики на контролы, что позволило расширить поведение их Function OLABELEVENTS( hWnd, nMsg, wParam, lParam ) ... ElseIf nMsg == WM_HMG_NOTIFY_LBL // BAA IF ValType( _HMG_aControlMiscData1 [ i ] [4] )=='B' _DoControlEventProcedure( _HMG_aControlMiscData1[ i ][4], i ) ELSE // быстрый refresh MoveWindow( _HMG_aControlHandles[ i ], ; // hWnd _HMG_aControlCol[ i ], ; // X _HMG_aControlRow[ i ], ; // Y _HMG_aControlWidth[ i ], ; // W _HMG_aControlHeight[ i ], .T. ) // H SetWindowText( _HMG_aControlHandles[ i ], ; // hWnd _HMG_aControlCaption[ i ] ) // Text ENDIF EndIf Function OGETEVENTS( hWnd, nMsg, wParam, lParam ) что позволило реализовать для GetBox обработку событий ASSIGN OnEscape( bOnEscape ) ASSIGN OnEnter( bOnEnter ) ASSIGN OnDown( bOnDown ) ASSIGN OnUp( bOnUp ) ASSIGN OnF5( bOnF5 ) ASSIGN OnDblClick( bOnDblClick ) ASSIGN OnClick( bOnClick ) ASSIGN OnSetCaret( bOnSetCaret ) ASSIGN OnAfter( bOnSetAfter ) METHOD OnBlock( bPostBlock ) METHOD OnKeyEvent(nExit) [/pre2]
SergKis: Петр Чем Ваше решение будет лучше, к примеру, такого (схема) в класс вводим переменную :oEvens := TKeyData():New() :UserKeys(WM_..., {|o| ... }) :UserKeys(WM_KEYDOWN, {|o| o:OnKeyDownUp(...) }) :UserKeys(WM_KEYUP, {|o| o:OnKeyDownUp(...) }) ... :oKeyDownUp := TKeyDownUp():New() METHOD OnKeyDownUp(...) METHOD OnEvens( nMsg, wParam, Param ) функция Events по hWnd получает объект и выполняет :OnEvens такой же класс можно сделать для контролов и в _Define... таким образом получим обработчики на контролы, т.е. функция Events по hWnd получает объект и выполняет :OnEvens на контрол
SergKis: PS. читать так такой же класс можно сделать для контролов и в _Define... кониролов заполнить ...
Петр: SergKis пишет: В версии 2.07 этого нет, да я писал, что такое решение на постоянной основе мне не по душе (как отладка какого то решения - можно использовать). Лучше привести код Evens к нужному решению, чем плодить set eventsы. Я уже, вроде, обьяснял 2012/02/14: HMG Extended Edition 2.0.7 Published. 2007/02/15: Build 31 (HMG 1.3 Extended) Published. * New: SET EVENTS FUNCTION TO <funcname> command. Это конечно, если ваша версия 2.07 и HMG Extended Edition 2.0.7 одно и тоже В большинстве случаев функция - обработчик событий, устанавливаемая посредством set events func, является дополнением к Events и может использоваться в таких случаях 1) При обработке сообщений, которые неизвестны Events; 2) Для увеличения скорости реакции приложения на сообщение; 3) Для отладки; 4) Специальные случае (вроде отключение (изменение) реакции на действия пользователя в демо - версии) Если вы посмотрите, те примеры с использованием set events func to, которые приводил я, то в большинстве случаев после каких то манипуляций вызывается стандартный обработчик Events. И использование set events func to не отменяет работу над улучшением качества Events.
Петр: SergKis пишет: Как это поможет реализовать такую схему (из HwGui) SergKis пишет: Чем Ваше решение будет лучше, к примеру, такого (схема) Это вообще, что называется "из другой оперы". Реализую и выложу здесь, тогда и вопросы можно будет по существу задавать. P.S. Присмотритесь к TTaskDialog - уверен, что найдете для себя много интересного.
SergKis: gfilatov2002 К :UserKeys добавил Evens блоки кода по WM_USER+... сообщениям с примером http://my-files.ru/3d4ctz Что сделал [pre2] Изменения: ========== Функцию _GetWindowObj( FormName ) переименовал в _WindowObj ( FormName ) т.к. уже есть _WindowCargo( FormName ), _GetWindowObj вынес на #translate. Причина - в тек. версии есть функция _GetControlObject(...), чтобы не путаться. #xtranslate _GetWindowObj( <cFormName> ) ; => ; _WindowObj( <cFormName> ) Комплект базовых функций получился такой: *-----------------------------------------------------------------------------* FUNCTION _WindowObj( FormName, nIndex ) *-----------------------------------------------------------------------------* LOCAL i := iif( Pcount() > 1, nIndex, iif( HB_ISNUMERIC( FormName ), ; AScan( _HMG_aFormHandles, FormName ), GetFormIndex( FormName ) ) ) IF i > 0 .and. HB_ISOBJECT( _HMG_aFormMiscData1 [ i ][ 1 ] ) RETURN _HMG_aFormMiscData1 [ i ][ 1 ] ENDIF RETURN NIL *-----------------------------------------------------------------------------* FUNCTION _WindowCargo( FormName, xValue ) *-----------------------------------------------------------------------------* LOCAL i := iif( HB_ISOBJECT ( FormName ), FormName:Index, ; iif( HB_ISNUMERIC( FormName ), ; AScan( _HMG_aFormHandles, FormName ), GetFormIndex( FormName ) ) ) If Pcount() > 1; _HMG_aFormMiscData2 [ i ] := xValue Else ; RETURN _HMG_aFormMiscData2 [ i ] Endif RETURN NIL *-----------------------------------------------------------------------------* FUNCTION _WindowEvent( FormName, nKey, bEvent, p2, p3 ) *-----------------------------------------------------------------------------* LOCAL i := iif( HB_ISOBJECT ( FormName ), FormName:Index, ; iif( HB_ISNUMERIC( FormName ), ; AScan( _HMG_aFormHandles, FormName ), GetFormIndex( FormName ) ) ) LOCAL o IF i > 0 o := _HMG_aFormMiscData1 [ i ][ 1 ] IF HB_ISOBJECT( o ) If HB_ISBLOCK(bEvent); RETURN o:Event( nKey, bEvent ) EndIf RETURN o:Event( nKey, bEvent, p2, p3 ) ENDIF ENDIF RETURN NIL *-----------------------------------------------------------------------------* FUNCTION _ControlObj( ControlName, FormName ) *-----------------------------------------------------------------------------* LOCAL i := iif( HB_ISNUMERIC( FormName ), FormName, ; iif( HB_ISOBJECT ( ControlName ), ControlName:Index, ; iif( HB_ISNUMERIC( ControlName ), ; AScan( _HMG_aControlHandles, ControlName ), ; GetControlIndex( ControlName , FormName ) ) ) ) IF i > 0 .and. Len( _HMG_aControlMiscData0 [ i ] ) > 0 If HB_ISOBJECT ( _HMG_aControlMiscData0 [ i ][ 1 ] ) RETURN _HMG_aControlMiscData0 [ i ][ 1 ] EndIf ENDIF RETURN NIL *-----------------------------------------------------------------------------* FUNCTION _ControlCargo( ControlName, FormName, xValue ) *-----------------------------------------------------------------------------* LOCAL i := iif( HB_ISNUMERIC( FormName ), FormName, ; iif( HB_ISOBJECT ( ControlName ), ControlName:Index, ; iif( HB_ISNUMERIC( ControlName ), ; AScan( _HMG_aControlHandles, ControlName ), ; GetControlIndex( ControlName , FormName ) ) ) ) If Pcount() > 2; _HMG_aControlMiscData2 [ i ] := xValue Else ; RETURN _HMG_aControlMiscData2 [ i ] EndIf RETURN NIL *-----------------------------------------------------------------------------* FUNCTION _ControlEvent( ControlName, FormName, nKey, bEvent, p2, p3 ) *-----------------------------------------------------------------------------* LOCAL i := iif( HB_ISNUMERIC( FormName ), FormName, ; iif( HB_ISOBJECT ( ControlName ), ControlName:Index, ; iif( HB_ISNUMERIC( ControlName ), ; AScan( _HMG_aControlHandles, ControlName ), ; GetControlIndex( ControlName , FormName ) ) ) ) LOCAL o IF i > 0 .and. Len( _HMG_aControlMiscData0 [ i ] ) > 0 o := _HMG_aControlMiscData0 [ i ][ 1 ] If HB_ISOBJECT ( o ) If HB_ISBLOCK(bEvent); RETURN o:Event( nKey, bEvent ) EndIf RETURN o:Event( nKey, bEvent, p2, p3 ) EndIf ENDIF RETURN NIL Классы и вспом. функции такие: /////////////////////////////////////////////////////////////////////////////// Зарезервированы для работы два сообщения: #define WM_HMG_USER_MSG_W (WM_USER+77) #define WM_HMG_USER_MSG_C (WM_USER+78) /////////////////////////////////////////////////////////////////////////////// *-----------------------------------------------------------------------------* FUNCTION oWndData( nIndex, cName, nHandle, nParent, cType, cVar, oWin ) *-----------------------------------------------------------------------------* Default nIndex := 0, ; cName := '', ; nHandle := 0, ; nParent := 0, ; cType := '', ; cVar := '' If HB_ISOBJECT(oWin) RETURN TCntData():New( nIndex, cName, nHandle, nParent, cType, cVar, oWin ) EndIf RETURN TWndData():New( nIndex, cName, nHandle, nParent, cType, cVar ) /////////////////////////////////////////////////////////////////////////////// CLASS TWndData PROTECTED: VAR cVar VAR cName VAR cType VAR nIndex VAR nHandle VAR nParent VAR oName VAR oHand EXPORTED: VAR oCargo VAR oUserKeys VAR oEvent VAR cChr INIT ',' METHOD New( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::nIndex := nIndex, ::cName := cName, ::nHandle := nHandle, ; ::nParent := nParent, ::cType := cType, ::cVar := cVar, ; ::oName := oKeyData(), ; ::oHand := oKeyData(), ; ::oCargo := oKeyData(), ; ::oUserKeys := oKeyData(), ; ::oEvent := oKeyData( Self ), ; Self ) CONSTRUCTOR 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 ( ::Handle ) ACCESS Col INLINE GetWindowCol ( ::Handle ) ACCESS Width INLINE GetWindowWidth ( ::Handle ) ACCESS Height INLINE GetWindowHeight( ::Handle ) ACCESS ClientWidth INLINE _GetClientRect ( ::Handle )[ 3 ] ACCESS ClientHeight INLINE _GetClientRect ( ::Handle )[ 4 ] ACCESS Title INLINE GetWindowText ( ::Handle ) ACCESS Cargo INLINE _WindowCargo( Self ) ASSIGN Cargo( xVal ) INLINE _WindowCargo( Self, xVal ) METHOD Cargo( xVal ) INLINE _WindowCargo( Self, xVal ) ACCESS WM_nMsgW INLINE WM_HMG_USER_MSG_W ACCESS WM_nMsgC INLINE WM_HMG_USER_MSG_C METHOD UsK ( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ; ::oUserKeys:Set( Key, Block ), ; ::oUserKeys:Do ( Key, Block, p2, p3 ) ) METHOD UserKeys( Key, Block, p2, p3 ) INLINE ::UsK( 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, lMsgW ) INLINE ( lMsgW := lMsgW == Nil .or. !Empty(lMsgW), ; lMsgW := empty(nHandle) .or. lMsgW, ; PostMessage( ::Handle, iif( lMsgW, ::WM_nMsgW, ::WM_nMsgC ), nKey, ; hb_defaultValue(nHandle, 0) ) ) METHOD SendMsg( nKey, nHandle, lMsgW ) INLINE ( lMsgW := lMsgW == Nil .or. !Empty(lMsgW), ; lMsgW := empty(nHandle) .or. lMsgW, ; SendMessage( ::Handle, iif( lMsgW, ::WM_nMsgW, ::WM_nMsgC ), nKey, ; hb_defaultValue(nHandle, 0) ) ) METHOD DoEvent( Key, nHandle, nParam, cEvent ) METHOD Controls( xType ) ENDCLASS METHOD DoEvent ( Key, nHandle, nParam, cEvent ) CLASS TWndData LOCAL o, lW := .T. nParam := iif( HB_ISNUMERIC(nParam), nParam, 0 ) cEvent := cValToChar(cEvent) If ! empty(nHandle) o := _ControlObj(nHandle) If HB_ISOBJECT(o) lW := .F. EndIf EndIf If ! HB_ISOBJECT(o) o := Self EndIf If lW _DoWindowEventProcedure ( ::oEvent:Get(Key), o:Index, cEvent, nParam ) Else _DoControlEventProcedure( ::oEvent:Get(Key), o:Index, cEvent, nParam ) EndIf RETURN Nil METHOD Controls( xType ) CLASS TWndData LOCAL aObj := {}, c, i, o, m := {} If HB_ISCHAR ( xType ) c := ::cChr xType := hb_ATokens(xType, c) AEval(xType, {|t| iif( Empty(t), Nil, aAdd( m, upper(alltrim( t )) ) ) }) ElseIf HB_ISARRAY( xType ) AEval(xType, {|t| iif( Empty(t), Nil, aAdd( m, upper(alltrim( t )) ) ) }) Else For i := 1 To ::oName:Len o := ::oName:Value( i ) If HB_ISOBJECT( o ); aAdd( m, o:Type ) EndIf Next EndIf For i := 1 To Len( m ) o := ::oName:Value( i ) If HB_ISOBJECT( o ) .and. m[ i ] == o:Type aAdd( aObj, o ) EndIf Next RETURN aObj /////////////////////////////////////////////////////////////////////////////// CLASS TCntData INHERIT TWndData EXPORTED: VAR oWin METHOD New( nIndex, cName, nHandle, nParent, cType, cVar, oWin ) INLINE ( ; ::Super:New(nIndex, cName, nHandle, nParent, cType, cVar), ; ::oWin := oWin, ; Self ) CONSTRUCTOR ACCESS Title INLINE ::oWin:Title ACCESS Caption INLINE _GetCaption( , , ::Index ) METHOD PostMsg( nKey, nHandle ) INLINE PostMessage( ::oWin:Handle, ; iif( empty(nHandle), ::WM_nMsgW, ::WM_nMsgC ), ; nKey, hb_defaultValue(nHandle, 0) ) METHOD SendMsg( nKey, nHandle ) INLINE SendMessage( ::oWin:Handle, ; iif( empty(nHandle), ::WM_nMsgW, ::WM_nMsgC ), ; nKey, hb_defaultValue(nHandle, 0) ) METHOD Set() INLINE ( ::oWin:oName:Set( upper(::Name ), Self ), ; ::oWin:oHand:Set( ::Handle, Self ) ) METHOD Del() INLINE ( ::oWin:oName:Del( upper(::Name ), Self ), ; ::oWin:oHand:Del( ::Handle, Self ) ) ENDCLASS *-----------------------------------------------------------------------------* FUNCTION oKeyData( o ) *-----------------------------------------------------------------------------* RETURN TKeyData():New(o) ////////////////////////////////////////////////////////////////////////////////////////////// CLASS TKeyData PROTECTED: VAR oObj VAR aKey INIT hb_Hash() VAR bBlk EXPORTED: VAR Cargo METHOD New( o ) INLINE ( ::Obj := o, Self ) CONSTRUCTOR METHOD Value( nPos ) INLINE hb_HValueAt( ::aKey, nPos ) METHOD Set( Key, Block ) INLINE hb_HSet( ::aKey, Key, Block ) METHOD Get( Key, Def ) INLINE hb_HGetDef( ::aKey, Key, Def ) METHOD Del( Key ) INLINE iif( hb_hHasKey( ::aKey, Key ), hb_HDel( Key ), ) METHOD Do ( Key, p1, p2, p3 ) INLINE ( ::bBlk := ::Get(Key), iif( HB_ISBLOCK(::bBlk), ; EVal(::bBlk, ::Obj, 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 ) ENDCLASS ////////////////////////////////////////////////////////////////////////////// Подправил для совместимости и быстрого доступа через индекс контрола: h_controlmisc.prg *-----------------------------------------------------------------------------* STATIC FUNCTION _GetCaption ( ControlName , ParentForm, nIndex ) *-----------------------------------------------------------------------------* LOCAL cRetVal LOCAL i := iif( Pcount() > 2, nIndex, GetControlIndex ( ControlName , ParentForm ) ) IF _HMG_aControlType [ i ] == 'TOOLBUTTON' cRetVal := _HMG_aControlCaption [ i ] ELSE cRetVal := GetWindowText ( _HMG_aControlHandles [ i ] ) ENDIF RETURN cRetVal h_windows.prg Function _DoControlEventProcedure ( bBlock , i , cEventType , nParam ) ... if valtype( bBlock ) == 'B' .and. i > 0 ... Function _DoWindowEventProcedure ( bBlock , i , cEventType, nParam ) ... if valtype( bBlock ) == 'B' .and. i > 0 ... Посмотрел, что править связанное с _HMG_aControlMiscData1, для расширения возможностей, трудоемко (много где) и стремно, то ввел новую переменную _HMG_aControlMiscData0 i_var.ch #define _HMG_SYSDATA_SIZE 448 // было 445 ... #xtranslate _HMG_aScrollStep => _HMG_SYSDATA\[445\] #xtranslate _HMG_aFormMiscData1 => _HMG_SYSDATA\[446\] #xtranslate _HMG_aFormMiscData2 => _HMG_SYSDATA\[447\] #xtranslate _HMG_aFormMiscData0 => _HMG_SYSDATA\[448\] i_windows.ch #xtranslate <w> . \<c\> . \<p:Object\> => _ControlObj ( \<"c"\> , <"w"> ) ;; i_this.ch #xtranslate This . <p:Object> => iif ( _HMG_ThisType == 'C' , _ControlObj ( _HMG_THISCONTROLNAME , _HMG_THISFORMNAME ) , _WindowObj ( _HMG_THISFORMNAME ) ) #xtranslate This . <c> . <p:Object> => _ControlObj ( <"c"> , _HMG_THISFORMNAME ) h_init.prg ... _HMG_aFormMiscData1 := {} _HMG_aFormMiscData2 := {} _HMG_aFormMiscData0 := {} h_events.prg добавил обработку сообщений *********************************************************************** case WM_HMG_USER_MSG_W *********************************************************************** a := _WindowObj( hWnd ) If HB_ISOBJECT(a) a:DoEvent( wParam, lParam, nMsg - WM_HMG_USER_MSG_W + 1 ) EndIf exit *********************************************************************** case WM_HMG_USER_MSG_C *********************************************************************** a := iif( empty(lParam), _WindowObj( hWnd ), _ControlObj( lParam ) ) If HB_ISOBJECT(a) a:DoEvent( wParam, lParam, nMsg - WM_HMG_USER_MSG_W + 1 ) EndIf exit *********************************************************************** line 3271 _HMG_aFormMiscData1 [ i ] := {} _HMG_aFormMiscData2 [ i ] := '' _HMG_aFormMiscData0 [ i ] := {} Добавление переменной _HMG_aControlMiscData0 делал так. Во всех файлах h_*.prg искал _HMG_aControlMiscData2 и добавлял _HMG_aControlMiscData2 [k] := '' _HMG_aControlMiscData0 [k] := {} или _HMG_aControlMiscData0 [k] := { oWndData( k , ; _HMG_aControlNames [k], ; _HMG_aControlHandles [k], ; _HMG_aControlParenthandles [k], ; _HMG_aControlType [k], ; mVar, ; _WindowObj( _HMG_aControlParenthandles [k] ) ) ; } ставил значение на _HMG_aControlMiscData0 [k] там, где есть смысл от значений параметров, иначе ставил _HMG_aControlMiscData0 [k] := {} Можно заполнить значением переменную у распространенных контролов, а в остальные пустышку и постепенно заполнять по возможности и нал. времени. Функции учитывают наличие пустышки в контролах. В окнах поменял прямое создание объекта, на созд. через функцию, т.е. там где было TWndData():New(...) надо заменить с aAdd( _HMG_aFormMiscData1 [k], TWndData():New( k, ; _HMG_aFormNames [k], ; _HMG_aFormHandles [k], ; _HMG_aFormParentHandle [k], ; _HMG_aFormType [k], ; &mVar. ) ) на aAdd( _HMG_aFormMiscData1 [k], oWndData( k , ; _HMG_aFormNames [k], ; _HMG_aFormHandles [k], ; _HMG_aFormParentHandle [k], ; _HMG_aFormType [k], ; mVar ) ) В TWndData и TsBrowse добавил (у себя) методы, аналоги :UserKeys(...) с кортким названием :UsK(...), это на любителя. Пример для тестирования будет приложен. [/pre2]
SergKis: PS Надо подправить i_var.ch ... #xtranslate _HMG_aScrollStep => _HMG_SYSDATA\[445\] #xtranslate _HMG_aFormMiscData1 => _HMG_SYSDATA\[446\] #xtranslate _HMG_aFormMiscData2 => _HMG_SYSDATA\[447\] #xtranslate _HMG_aControlMiscData0 => _HMG_SYSDATA\[448\] было (размножено и не исправлено) #xtranslate _HMG_aFormMiscData0 => _HMG_SYSDATA\[448\]
Softlog86: Добрый день , форумчане ! Что сделать чтоб можно было менять ширину контрола RADIOGROUP ? Отбой тревоги .... WIDTH - это ширина одного элемента выбора , а не всего контрола .... Уже и забыл ху-из-ху :) (*) Первый ( ) Второй ( ) Третий После команды изменения ширины MyWindow.MyRADIO.WIDTH:=600 . ( Новое значение ширины гораздо больше исходного , всё должно влазить ) Отображается только первый элемент группы : (*) Первый
SergKis: gfilatov2002 Довел до рабочей кондиции пример и тексты hmg по Post\SendMessage. Пример: http://my-files.ru/gbuo3t Комплект базовых функций, классы: [pre2] *-----------------------------------------------------------------------------* FUNCTION _WindowCargo( FormName, xValue ) *-----------------------------------------------------------------------------* LOCAL i := iif( HB_ISOBJECT ( FormName ), FormName:Index, ; iif( HB_ISNUMERIC( FormName ), ; AScan( _HMG_aFormHandles, FormName ), GetFormIndex( FormName ) ) ) If Pcount() > 1; _HMG_aFormMiscData2 [ i ] := xValue Else ; RETURN _HMG_aFormMiscData2 [ i ] Endif RETURN NIL *-----------------------------------------------------------------------------* FUNCTION _WindowEvent( FormName, nKey, bEvent, p2, p3 ) *-----------------------------------------------------------------------------* LOCAL i := iif( HB_ISOBJECT ( FormName ), FormName:Index, ; iif( HB_ISNUMERIC( FormName ), ; AScan( _HMG_aFormHandles, FormName ), GetFormIndex( FormName ) ) ) LOCAL o IF i > 0 o := _HMG_aFormMiscData1 [ i ][ 1 ] IF HB_ISOBJECT( o ) If HB_ISBLOCK(bEvent); RETURN o:Event( nKey, bEvent ) EndIf RETURN o:Event( nKey, bEvent, p2, p3 ) ENDIF ENDIF RETURN NIL *-----------------------------------------------------------------------------* FUNCTION _WindowObj( FormName, nIndex ) *-----------------------------------------------------------------------------* LOCAL i := iif( Pcount() > 1, nIndex, iif( HB_ISNUMERIC( FormName ), ; AScan( _HMG_aFormHandles, FormName ), GetFormIndex( FormName ) ) ) IF i > 0 .and. HB_ISOBJECT( _HMG_aFormMiscData1 [ i ][ 1 ] ) RETURN _HMG_aFormMiscData1 [ i ][ 1 ] ENDIF RETURN NIL *-----------------------------------------------------------------------------* FUNCTION _ControlObj( ControlName, FormName ) *-----------------------------------------------------------------------------* LOCAL i := iif( HB_ISNUMERIC( FormName ), FormName, ; iif( HB_ISOBJECT ( ControlName ), ControlName:Index, ; iif( HB_ISNUMERIC( ControlName ), ; AScan( _HMG_aControlHandles, ControlName ), ; GetControlIndex( ControlName , FormName ) ) ) ) IF i > 0 .and. Len( _HMG_aControlMiscData0 [ i ] ) > 0 If HB_ISOBJECT ( _HMG_aControlMiscData0 [ i ][ 1 ] ) RETURN _HMG_aControlMiscData0 [ i ][ 1 ] EndIf ENDIF RETURN NIL *-----------------------------------------------------------------------------* FUNCTION _ControlEvent( ControlName, FormName, nKey, bEvent, p2, p3 ) *-----------------------------------------------------------------------------* LOCAL i := iif( HB_ISNUMERIC( FormName ), FormName, ; iif( HB_ISOBJECT ( ControlName ), ControlName:Index, ; iif( HB_ISNUMERIC( ControlName ), ; AScan( _HMG_aControlHandles, ControlName ), ; GetControlIndex( ControlName , FormName ) ) ) ) LOCAL o IF i > 0 .and. Len( _HMG_aControlMiscData0 [ i ] ) > 0 o := _HMG_aControlMiscData0 [ i ][ 1 ] If HB_ISOBJECT ( o ) If HB_ISBLOCK(bEvent); RETURN o:Event( nKey, bEvent ) EndIf RETURN o:Event( nKey, bEvent, p2, p3 ) EndIf ENDIF RETURN NIL *-----------------------------------------------------------------------------* FUNCTION _ControlCargo( ControlName, FormName, xValue ) *-----------------------------------------------------------------------------* LOCAL i := iif( HB_ISNUMERIC( FormName ), FormName, ; iif( HB_ISOBJECT ( ControlName ), ControlName:Index, ; iif( HB_ISNUMERIC( ControlName ), ; AScan( _HMG_aControlHandles, ControlName ), ; GetControlIndex( ControlName , FormName ) ) ) ) If Pcount() > 2; _HMG_aControlMiscData2 [ i ] := xValue Else ; RETURN _HMG_aControlMiscData2 [ i ] EndIf RETURN NIL ================================================================================ Классы и вспом. функции : ================================================================================ /////////////////////////////////////////////////////////////////////////////// Зарезервированы для работы два сообщения: #define WM_HMG_USER_MSG_W (WM_USER+77) #define WM_HMG_USER_MSG_C (WM_USER+78) /////////////////////////////////////////////////////////////////////////////// *-----------------------------------------------------------------------------* FUNCTION oWndData( nIndex, cName, nHandle, nParent, cType, cVar, oWin ) *-----------------------------------------------------------------------------* LOCAL o Default nIndex := 0, ; cName := '', ; nHandle := 0, ; nParent := 0, ; cType := '', ; cVar := '' If HB_ISOBJECT(oWin) o := TCntData():New( nIndex, cName, nHandle, nParent, cType, cVar, oWin ) If ! Empty(o:Name) .and. ! Empty(o:Handle) If o:Type == 'TBROWSE' o:TBrowse := _HMG_aControlIds [ o:Index ] ElseIf o:Type == 'MESSAGEBAR' o:StatusBar := o EndIf o:Set() EndIf RETURN o EndIf RETURN TWndData():New( nIndex, cName, nHandle, nParent, cType, cVar ) /////////////////////////////////////////////////////////////////////////////// CLASS TWndData PROTECTED: VAR cVar VAR cName VAR cType VAR nIndex VAR nHandle VAR nParent VAR oMenu VAR oToolBar VAR oStatusBar VAR cChr INIT ',' VAR uTmp EXPORTED: CLASSDATA oName INIT oKeyData() CLASSDATA oHand INIT oKeyData() VAR oCargo VAR oUserKeys VAR oEvent METHOD New( 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 ), ; Self ) CONSTRUCTOR 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 ( ::Handle ) ACCESS Col INLINE GetWindowCol ( ::Handle ) ACCESS Width INLINE GetWindowWidth ( ::Handle ) ACCESS Height INLINE GetWindowHeight( ::Handle ) ACCESS ClientWidth INLINE _GetClientRect ( ::Handle )[ 3 ] ACCESS ClientHeight INLINE _GetClientRect ( ::Handle )[ 4 ] ACCESS Title INLINE GetWindowText ( ::Handle ) 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 StatusBar INLINE ::oStatusBar ASSIGN StatusBar( o ) INLINE ::oStatusBar := o ACCESS WM_nMsgW INLINE WM_HMG_USER_MSG_W ACCESS WM_nMsgC INLINE WM_HMG_USER_MSG_C METHOD UsK ( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ; ::oUserKeys:Set( Key, Block ), ; ::oUserKeys:Do ( Key, Block, p2, p3 ) ) METHOD UserKeys( Key, Block, p2, p3 ) INLINE ::UsK( 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, lMsgW ) INLINE ( lMsgW := lMsgW == Nil .or. !Empty(lMsgW), ; lMsgW := empty(nHandle) .or. lMsgW, ; PostMessage( ::Handle, iif( lMsgW, ::WM_nMsgW, ::WM_nMsgC ), nKey, ; hb_defaultValue(nHandle, 0) ) ) METHOD SendMsg( nKey, nHandle, lMsgW ) INLINE ( lMsgW := lMsgW == Nil .or. !Empty(lMsgW), ; lMsgW := empty(nHandle) .or. lMsgW, ; SendMessage( ::Handle, iif( lMsgW, ::WM_nMsgW, ::WM_nMsgC ), nKey, ; hb_defaultValue(nHandle, 0) ) ) METHOD DoEvent( Key, nHandle, nParam, cEvent ) METHOD GetListType() METHOD GetObj4Type( cType ) METHOD GetObj4Name( cName ) METHOD GetObj( xName ) INLINE iif( HB_ISCHAR(xName), ::oName:Get(xName), ; ::oHand:Get(xName) ) ENDCLASS METHOD GetListType() CLASS TWndData LOCAL oType := oKeyData() LOCAL aType := {} ::oName:Eval({|k,o,i| k := i, oType:Set(o:Type, o:Type) }) oType:Eval({|k,v,i| k := i, aAdd(aType, v) }) oType := Nil RETURN aType METHOD GetObj4Type( cType, lEque ) CLASS TWndData LOCAL aObj := {}, a, i, o If ! empty(cType) lEque := hb_defaultValue(lEque, .T.) If ::Chr $ cType; lEque := .F. EndIf a := hb_ATokens(upper(cType), ::Chr) FOR EACH cType IN a For i := 1 To ::oName:Len o := ::oName:Value( i ) If lEque If cType == o:cType; aAdd( aObj, o ) EndIf ElseIf cType $ o:cType; aAdd( aObj, o ) EndIf Next NEXT EndIF RETURN aObj METHOD GetObj4Name( cName ) CLASS TWndData LOCAL aObj := {}, a, i, o If ! empty(cName) a := hb_ATokens(cName, ::Chr) FOR EACH cName IN a For i := 1 To ::oName:Len o := ::oName:Value( i ) If cName $ o:cName; aAdd( aObj, o ) EndIf Next NEXT EndIF RETURN aObj METHOD DoEvent ( Key, nHandle, nParam, cEvent ) CLASS TWndData LOCAL o, lW := .T. nParam := iif( HB_ISNUMERIC(nParam), nParam, 0 ) cEvent := hb_defaultValue(cEvent, '') If ! empty(nHandle) o := _ControlObj(nHandle) If HB_ISOBJECT(o); lW := .F. EndIf EndIf If ! HB_ISOBJECT(o); o := Self EndIf If lW; _DoWindowEventProcedure ( ::oEvent:Get(Key), o:Index, cEvent, nParam, o ) Else ; _DoControlEventProcedure( ::oEvent:Get(Key), o:Index, cEvent, nParam, o ) EndIf RETURN Nil /////////////////////////////////////////////////////////////////////////////// CLASS TCntData INHERIT TWndData PROTECTED: VAR oWin VAR oTBrowse EXPORTED: METHOD New( nIndex, cName, nHandle, nParent, cType, cVar, oWin ) INLINE ( ; ::Super:New(nIndex, cName, nHandle, nParent, cType, cVar), ; ::oWin := oWin, ; Self ) CONSTRUCTOR ACCESS Title INLINE ::oWin:Title ACCESS Caption INLINE iif( ::Type == 'TBROWSE', ; ::oWin:Name + "." + ::Name, ; _GetCaption( ::Name, ::oWin:Name ) ) ACCESS Cargo INLINE _ControlCargo( , ::Index ) ASSIGN Cargo( xVal ) INLINE _ControlCargo( , ::Index, xVal ) ACCESS Window INLINE ::oWin ACCESS IsWindow INLINE .F. ACCESS IsControl INLINE .T. METHOD PostMsg( nKey ) INLINE PostMessage( ::oWin:Handle, ::WM_nMsgC, nKey, ::nHandle ) METHOD SendMsg( nKey ) INLINE SendMessage( ::oWin:Handle, ::WM_nMsgC, nKey, ::nHandle ) METHOD Set() INLINE ( ::oName:Set( ::Name , Self ), ; ::oHand:Set( ::Handle, Self ) ) METHOD Del() INLINE ( ::oName:Del( ::Name ), ; ::oHand:Del( ::Handle ) ) ACCESS StatusBar INLINE ::oWin:oStatusBar ASSIGN StatusBar( o ) INLINE ::oWin:oStatusBar := o ACCESS TBrowse INLINE ::oTBrowse ASSIGN TBrowse( oBrw ) INLINE ::oTBrowse := oBrw ACCESS Value INLINE _GetValue( , , ::Index ) ASSIGN Value( xVal ) INLINE _SetValue( , , xVal, ::Index, .T. ) METHOD SetFocus() INLINE _SetFocus ( ::Name, ::oWin:Name ) METHOD Disable( nPos ) INLINE _DisableControl( ::Name, ::oWin:Name, nPos ) METHOD Enable ( nPos ) INLINE _EnableControl ( ::Name, ::oWin:Name, nPos ) METHOD Show() INLINE _ShowControl ( ::Name, ::oWin:Name ) METHOD Hide() INLINE _HideControl ( ::Name, ::oWin:Name ) ENDCLASS *-----------------------------------------------------------------------------* FUNCTION oKeyData( o ) *-----------------------------------------------------------------------------* RETURN TKeyData():New(o) ////////////////////////////////////////////////////////////////////////////////////////////// CLASS TKeyData PROTECTED: VAR oObj VAR aKey INIT hb_Hash() VAR bBlk EXPORTED: VAR Cargo METHOD New( o ) INLINE ( ::Obj := o, Self ) CONSTRUCTOR METHOD Value( nPos ) INLINE hb_HValueAt( ::aKey, nPos ) METHOD Set( Key, Block ) INLINE hb_HSet( ::aKey, Key, Block ) METHOD Get( Key, Def ) INLINE hb_HGetDef( ::aKey, Key, Def ) METHOD Del( Key ) INLINE iif( hb_hHasKey( ::aKey, Key ), hb_HDel( Key ), ) METHOD Do ( Key, p1, p2, p3 ) INLINE ( ::bBlk := ::Get(Key), iif( HB_ISBLOCK(::bBlk), ; EVal(::bBlk, ::Obj, 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 ) METHOD Eval( Block ) ENDCLASS METHOD Eval( Block ) CLASS TKeyData LOCAL i, b := HB_ISBLOCK(Block) LOCAL a := iif( b, Nil, array(0) ) For i := 1 To ::Len If b; Eval( Block, hb_HKeyAt( ::aKey, i ), hb_HValueAt( ::aKey, i ), i ) Else; aAdd( a, { hb_HKeyAt( ::aKey, i ), hb_HValueAt( ::aKey, i ), i } ) EndIf Next RETURN a [/pre2] Изменения в hmg: [pre2] h_controlmisc.prg *-----------------------------------------------------------------------------* FUNCTION _SetValue ( ControlName, ParentForm, Value, index, lSetGet ) *-----------------------------------------------------------------------------* ... RETURN iif( empty(lSetGet), Nil, _GetValue( ControlName, ParentForm, Index ) ) *-----------------------------------------------------------------------------* FUNCTION _EraseControl ( i, p ) *-----------------------------------------------------------------------------* LOCAL mVar, t, hWnd, x If HB_ISOBJECT( _HMG_aControlMiscData0 [ i ] ) _HMG_aControlMiscData0 [ i ]:Del() EndIf DeleteObject ( _HMG_aControlFontHandle [ i ] ) ... h_events.prg добавил обработку сообщений *********************************************************************** case WM_HMG_USER_MSG_W *********************************************************************** a := _WindowObj( hWnd ) If HB_ISOBJECT(a) a:DoEvent( wParam, lParam, wParam ) EndIf exit *********************************************************************** case WM_HMG_USER_MSG_C *********************************************************************** a := iif( empty(lParam), _WindowObj( hWnd ), _ControlObj( lParam ) ) If HB_ISOBJECT(a) a:DoEvent( wParam, lParam, wParam ) EndIf exit *********************************************************************** h_windows.prg *-----------------------------------------------------------------------------* Function _DoControlEventProcedure ( bBlock , i , cEventType , nParam, p2, p3 ) *-----------------------------------------------------------------------------* ... if valtype( bBlock ) == 'B' .and. i > 0 ... If _HMG_BeginWindowActive == .F. .or. !( cEventType == 'CONTROL_ONCHANGE' ) .or. _HMG_MainClientMDIHandle != 0 Eval( bBlock, nParam, p2, p3 ) EndIf ... *-----------------------------------------------------------------------------* Function _DoWindowEventProcedure ( bBlock , i , cEventType, nParam, p2, p3 ) *-----------------------------------------------------------------------------* ... if valtype( bBlock ) == 'B' .and. i > 0 ... _HMG_ThisControlName := "" lRetVal := Eval( bBlock, nParam, p2, p3 ) _PopEventInfo() ... Посмотрел, что править связанное с _HMG_aControlMiscData1, для расширения возможностей, трудоемко (много где) и стремно, то ввел новую переменную _HMG_aControlMiscData0 i_var.ch #define _HMG_SYSDATA_SIZE 448 // было 445 ... #xtranslate _HMG_aScrollStep => _HMG_SYSDATA\[445\] #xtranslate _HMG_aFormMiscData1 => _HMG_SYSDATA\[446\] #xtranslate _HMG_aFormMiscData2 => _HMG_SYSDATA\[447\] #xtranslate _HMG_aControlMiscData0 => _HMG_SYSDATA\[448\] i_windows.ch #xtranslate <w> . \<c\> . \<p:Object\> => _ControlObj ( \<"c"\> , <"w"> ) ;; i_this.ch #xtranslate This . <p:Object> => iif ( _HMG_ThisType == 'C' , _ControlObj ( _HMG_THISCONTROLNAME , _HMG_THISFORMNAME ) , _WindowObj ( _HMG_THISFORMNAME ) ) #xtranslate This . <c> . <p:Object> => _ControlObj ( <"c"> , _HMG_THISFORMNAME ) h_init.prg ... _HMG_aFormMiscData1 := {} _HMG_aFormMiscData2 := {} _HMG_aControlMiscData0 := {} Добавление переменной _HMG_aControlMiscData0 делал так. Во всех файлах h_*.prg искал _HMG_aControlMiscData2 и добавлял _HMG_aControlMiscData2 [k] := '' _HMG_aControlMiscData0 [k] := {} или _HMG_aControlMiscData0 [k] := { oWndData( k , ; _HMG_aControlNames [k], ; _HMG_aControlHandles [k], ; _HMG_aControlParenthandles [k], ; _HMG_aControlType [k], ; mVar, ; _WindowObj( _HMG_aControlParenthandles [k] ) ) ; } ставил значение на _HMG_aControlMiscData0 [k] там, где есть смысл от значений параметров, иначе ставил _HMG_aControlMiscData0 [k] := {} Можно заполнить значением переменную у распространенных контролов, а в остальные пустышку и постепенно заполнять по возможности и нал. времени. Функции учитывают наличие пустышки в контролах. В окнах поменял прямое создание объекта, на созд. через функцию, т.е. там где было TWndData():New(...) надо заменить с aAdd( _HMG_aFormMiscData1 [k], TWndData():New( k, ; _HMG_aFormNames [k], ; _HMG_aFormHandles [k], ; _HMG_aFormParentHandle [k], ; _HMG_aFormType [k], ; &mVar. ) ) на aAdd( _HMG_aFormMiscData1 [k], oWndData( k , ; _HMG_aFormNames [k], ; _HMG_aFormHandles [k], ; _HMG_aFormParentHandle [k], ; _HMG_aFormType [k], ; mVar ) ) В TWndData и TsBrowse добавил (у себя) методы, аналоги :UserKeys(...) с кортким названием :UsK(...), это на любителя. [/pre2] Замечания, дополнения принимаются.
SergKis: PS Еще [pre2] *-----------------------------------------------------------------------------* Function GetProperty ( Arg1 , Arg2 , Arg3 , Arg4 , Arg5 , Arg6 , Arg7 ) *-----------------------------------------------------------------------------* ... ElseIf Pcount() == 3 // CONTROL ... ElseIf Arg3 == "AUTOFONT" // Kevin Carmody <i@kevincarmody.com> 2007.04.23 RetVal := _SetGetAutoFont ( Arg2 , Arg1 ) ElseIf Arg3 == "OBJECT" RetVal := _ControlObj( Arg2, Arg1 ) EndIf ElseIf Pcount() == 4 // CONTROL WITH ARGUMENT OR TOOLBAR BUTTON OR (JK) HMG 1.0 Experimental Buid 6 GRID/BROWSE COLUMN - ColumnWidth ... Неточность в *-----------------------------------------------------------------------------* FUNCTION _EraseControl ( i, p ) *-----------------------------------------------------------------------------* LOCAL mVar, t, hWnd, x If HB_ISOBJECT( _HMG_aControlMiscData0 [ i ][1] ) _HMG_aControlMiscData0 [ i ][1]:Del() EndIf ... пропустил [1] [/pre2]
SergKis: PS У себя сделал [pre2] *-----------------------------------------------------------------------------* FUNCTION GetControlIndex ( ControlName, ParentForm ) *-----------------------------------------------------------------------------* LOCAL mVar IF HB_ISNUMERIC(ParentForm ); RETURN ParentForm ELSEIF HB_ISOBJECT (ControlName); RETURN ControlName:Index ELSEIF HB_ISNUMERIC(ControlName); RETURN Ascan( _HMG_aControlHandles, ControlName ) ENDIF mVar := '_' + ParentForm + '_' + ControlName IF __mvExist ( mVar ) RETURN __mvGet ( mVar ) ENDIF RETURN 0 [/pre2]
Петр: SergKis пишет: METHOD New( o ) INLINE ( ::Obj := o, Self ) CONSTRUCTOR "and please remember that :NEW() will be class method so it should not be redefined as constructor in user class. Instead :INIT() method should be used as constructor. It's executed automatically when object is created from the :NEW() method." цитата из xhb-diff
SergKis: Петр Согласен. METHOD New( o ) INLINE ( ::oObj := iif( HB_ISOBJECT(o), o, Self ), Self ) CONSTRUCTOR
SergKis: SergKis пишет Неточность в *-----------------------------------------------------------------------------* FUNCTION _EraseControl ( i, p ) *-----------------------------------------------------------------------------* LOCAL mVar, t, hWnd, x If HB_ISOBJECT( _HMG_aControlMiscData0 [ i ][1] ) _HMG_aControlMiscData0 [ i ][1]:Del() EndIf Надо усилить проверку [pre2] *-----------------------------------------------------------------------------* Function _EraseControl (i, p) *-----------------------------------------------------------------------------* Local mVar, t, hWnd, x If Len( _HMG_aControlMiscData0 [ i ] ) > 0 If HB_ISOBJECT( _HMG_aControlMiscData0 [ i ][1] ) _HMG_aControlMiscData0 [ i ][1]:Del() EndIf EndIf [/pre2] Т.е. _HMG_aControlMiscData0 [ i ] := {} - пустышка
SergKis: gfilatov2002 Повторю предложение, иметь в GetControIndex( ControlName, ParentForm ) If empty(ControlName); ControlName := _HMG_ThisControlName EndIf If empty(ParentForm); ParantForm := _HMG_ThisFormName EndIf Тогда в control ACTION можно сравнивать одинаковые контролы на разных окнах так (быстрый способ): v1 := _GetValue( , , GetControlIndex()) v2 := _GetValue( , , GetControlIndex( , 'win_2')) If v1 > v1 ... ElseIf v1 < v2 ... Else ... EndIf GetControlIndex(...) [pre2] *-----------------------------------------------------------------------------* FUNCTION GetControlIndex ( ControlName, ParentForm ) *-----------------------------------------------------------------------------* LOCAL mVar IF HB_ISNUMERIC(ParentForm ); RETURN ParentForm ELSEIF HB_ISOBJECT (ControlName); RETURN ControlName:Index ELSEIF HB_ISNUMERIC(ControlName); RETURN Ascan( _HMG_aControlHandles, ControlName ) ENDIF IF empty(ControlName); ControlName := _HMG_ThisControlName ENDIF IF empty(ParentForm); ParantForm := _HMG_ThisFormName ENDIF mVar := '_' + ParentForm + '_' + ControlName IF __mvExist ( mVar ) RETURN __mvGet ( mVar ) ENDIF RETURN 0 [/pre2]
SergKis: PS Если принять вариант GetControlIndex, то можно, пройдя по функциям, сделать:[pre2] *-----------------------------------------------------------------------------* FUNCTION _SetFocus ( ControlName, ParentForm ) *-----------------------------------------------------------------------------* LOCAL MaskStart As Numeric // LOCAL H , T , x , i, ControlCount , ParentFormHandle LOCAL H , T , x , ControlCount , ParentFormHandle LOCAL i := GetControlIndex ( ControlName, ParentForm ) ParentForm := i H := GetControlHandle( ControlName, ParentForm ) T := GetControlType ( ControlName, ParentForm ) // i := GetControlIndex ( ControlName, ParentForm ) ... [/pre2] работа без лишних макросов
Andrey: SergKis пишет: gfilatov2002 Повторю предложение, А он вроде писал, что убегает в отпуск ....
SergKis: Andrey пишет А он вроде писал, что убегает в отпуск Я в курсе, прошлый раз, Григорий, отказал, отослав к инструкции\описанию\религии МиниГуи. Выкладываю сейчас, потому как, он придет из отпуска, я уйду.
SergKis: gfilatov2002 SergKis пишет сделать [pre2] *-----------------------------------------------------------------------------* Function _DoControlEventProcedure ( bBlock , i , cEventType , nParam, p2, p3 ) *-----------------------------------------------------------------------------* ... if valtype( bBlock ) == 'B' .and. i > 0 ... If _HMG_BeginWindowActive == .F. .or. !( cEventType == 'CONTROL_ONCHANGE' ) .or. _HMG_MainClientMDIHandle != 0 Eval( bBlock, nParam, p2, p3 ) EndIf ... *-----------------------------------------------------------------------------* Function _DoWindowEventProcedure ( bBlock , i , cEventType, nParam, p2, p3 ) *-----------------------------------------------------------------------------* ... if valtype( bBlock ) == 'B' .and. i > 0 ... _HMG_ThisControlName := "" lRetVal := Eval( bBlock, nParam, p2, p3 ) _PopEventInfo() ... [/pre2] А правильнее так [pre2] *-----------------------------------------------------------------------------* Function _DoControlEventProcedure ( bBlock , i , cEventType , nParam, p2, p3 ) *-----------------------------------------------------------------------------* ... If Pcount() > 4; Eval( bBlock, p2, nParam, p3 ) // new Else ; Eval( bBlock, nParam ) // old EndIf ... *-----------------------------------------------------------------------------* Function _DoWindowEventProcedure ( bBlock , i , cEventType, nParam, p2, p3 ) *-----------------------------------------------------------------------------* ... If Pcount() > 4; lRetVal := Eval( bBlock, p2, nParam, p3 ) // new Else ; lRetVal := Eval( bBlock, nParam ) // old EndIf ... [/pre2] Тогда в примере будет [pre2] // ---------------------------------------------------------------------------- Control events WITH OBJECT oWnd:GetObj( This.FRM_4.Handle ) :Event( 1, {|ow,ky| This_Msg('Control message ' + "nKey="+cValToChar(ky), ow:Name) } ) :Event( 2, {|ow,ky| This_Msg('Control message ' + "nKey="+cValToChar(ky), ow:Name) } ) // ... END WITH nY += This.FRM_4.Height + nHgt cNam := 'ID' @ nY, nX LABEL &cNam VALUE '' WIDTH nLen HEIGHT oBrw1:nHeightCell CENTERALIGN WITH OBJECT oWnd:GetObj(cNam) :Cargo := 0 // :Event( 1, {|ky,oc,kd,id| ky := ky, ; // Get :Event( 1, {|oc,kd,id | kd := Eval( oBrw1:GetColumn('KODS'):bData ), ; // Get id := Eval( oBrw1:GetColumn('ID'):bData ), ; oc:Value := alltrim(cValToChar(id))+"-<"+ ; alltrim(cValToChar(kd))+">" } ) // :Event( 2, {|ky,oc | ky := ky, ; // Put :Event( 2, {|oc | oc:Window:oCargo:Set(oc:Name, oc:Value) } ) // Put :Window:oCargo:Set(cNam, :Value ) // init value to oCargo END WITH nY += This.&(cNam).Height cNam := 'KOLV' @ nY, nX LABEL &cNam VALUE '' WIDTH nLen HEIGHT oBrw1:nHeightCell CENTERALIGN WITH OBJECT oWnd:GetObj(cNam) // :Event( 1, {|ky,oc,kl| ky := ky, ; // Get :Event( 1, {|oc,kl | kl := Eval( oBrw1:GetColumn('KOLV'):bData ), ; // Get oc:Value := alltrim(cValToChar(kl)) } ) // :Event( 2, {|ky,oc | ky := ky, ; // Put :Event( 2, {|oc | oc:Window:oCargo:Set(oc:Name, oc:Value) } ) // Put :Window:oCargo:Set(cNam, :Value ) // init value to oCargo END WITH nY += This.&(cNam).Height cNam := 'CENA' @ nY, nX LABEL &cNam VALUE '' WIDTH nLen HEIGHT oBrw1:nHeightCell CENTERALIGN WITH OBJECT oWnd:GetObj(cNam) // :Event( 1, {|ky,oc,cn| ky := ky, ; // Get :Event( 1, {|oc,cn | cn := Eval( oBrw1:GetColumn('CENA'):bData ), ; // Get oc:Value := alltrim(cValToChar(cn)) } ) // :Event( 2, {|ky,oc | ky := ky, ; // Put :Event( 2, {|oc | oc:Window:oCargo:Set(oc:Name, oc:Value) } ) // Put :Window:oCargo:Set(cNam, :Value ) // init value to oCargo END WITH nY += This.&(cNam).Height + 10 cNam := 'NAME' cPic := oBrw1:GetColumn('NAME'):cPicture cNam := 'NAME' @ nY, nX GETBOX &cNam WIDTH nLen HEIGHT oBrw1:nHeightCell VALUE space(len(cPic)) ; PICTURE cPic ; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; FONTCOLOR {{0,0,0},{255,255,200},{0,0,255}} WITH OBJECT oWnd:GetObj(cNam) // :Event( 1, {|ky,oc | ky := ky, ; // Get :Event( 1, {|oc | oc:Value := Eval( oBrw1:GetColumn('NAME'):bData ) } ) // Get // :Event( 2, {|ky,oc | ky := ky, ; // Put :Event( 2, {|oc | oc:Window:oCargo:Set(oc:Name, oc:Value) } ) // Put :Window:oCargo:Set(cNam, :Value ) // init value to oCargo END WITH // ---------------------------------------------------------------------------- Control events DEFINE TIMER REFR INTERVAL 500 ACTION MyEvent( 'ID' ) This.REFR.Cargo := oWnd:GetObj4Type('LABEL,GETBOX') WITH OBJECT oWnd // ---- Window events :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) }) } ) // Put // ... END WITH // ---- Window events [/pre2] без лишних ky := ky, ;
SergKis: gfilatov2002 Добавил методы и подправил h_windows.prg [pre2] CLASS TWndData ... METHOD Destroy() INLINE ( ::oCargo:Destroy(), ::oCargo := Nil, ::cChr := Nil, ; ::oUserKeys:Destroy(), ::oUserKeys := Nil, ; ::oEvent:Destroy(), ::oEvent := Nil, ::cVar := Nil, ; ::oHand:Destroy(), ::oHand := Nil, ::uTmp := Nil, ; ::oName:Eval({|ky,oc,nn| ky := nn, oc:Destroy() }), ; ::oName := Nil, ::cName := Nil, ::cType := Nil, ; ::nIndex := Nil, ::nHandle := Nil, ::nParent := Nil, ; ::oStatusBar := Nil, oToolBar := Nil, ::oMenu := Nil ) ENDCLASS ... CLASS TCntData INHERIT TWndData ... METHOD Destroy() INLINE ( ::oCargo:Destroy(), ::oUserKeys:Destroy(), ; ::oEvent:Destroy(), ::cChr := Nil, ::uTmp := Nil, ; ::cVar := Nil, ::cName := Nil, ::cType := Nil, ; ::nIndex := Nil, ::nHandle := Nil, ::nParent := Nil ) ENDCLASS ... METHOD Sum( Key, nSum ) METHOD Destroy() INLINE ( ::oObj := Nil, ::bBlk := Nil, ::Cargo := Nil, ::aKey := Nil ) ENDCLASS ... 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 h_windows.prg ... *-----------------------------------------------------------------------------* Function _ReleaseWindow ( FormName ) *-----------------------------------------------------------------------------* ... line 2278 i := GetFormIndex ( Formname ) FormHandle := _HMG_aFormHandles [ i ] * Release Window If HB_ISOBJECT( _HMG_aFormMiscData1 [ i ][1] ) _HMG_aFormMiscData1 [ i ][1]:Destroy() EndIf IF _HMG_aFormType [ i ] == 'M' .AND. _HMG_ActiveModalHandle <> FormHandle ... [/pre2]
Петр: SergKis пишет: Добавил методы и подправил h_windows.prg Я надеюсь, что вы высылаете исходники Григорию или хотя-бы diff файлы? А то боюсь, что он врядли вручную захочет все это реконструировать. прошлый раз, Григорий, отказал, отослав к инструкции\описанию\религии МиниГуи. Я бы тоже отказал. В примеры - пожалуйста, там и так черт ногу сломит, а для ядра библиотеки - это слишком специфично и классово чуждо Tsbrowse не в счет. Да еще - ваши упоминания о "религии MiniGUI" ни на йоту не приближают вас к успеху Но я хотя бы понял, чего вы о ней вспомнили
Andrey: Да не так уж и много правок для ядра. А почему не нужно это вставлять ? По синтаксису понятно и пользоваться можно будет в будущем. Удобней кстати для использования. А примеры для этого тоже бы желательно иметь более подробней написанные...
SergKis: Петр пишет Я надеюсь, что вы высылаете исходники Григорию Пока, нет, т.к. нет ясности, будет ли это востребовано (работа по сообщениям) в MiniGui. Выкладываю что бы услышать коменты (исправления) и может кому пригодиться. Сборка изменений у меня есть (моя версия), но на какую версию 17.05\17.06 накладывать изменения ясности нет. для ядра библиотеки - это слишком специфично и классово чуждо чуждость странная, на мой взгляд, в одном месте ядра используем _HMG_... переменные в др. говорим низяя , хотя это такие же внутренние переменные. Мое дело предложить ...
SergKis: PS Нет ясности, у примеру, как обозвать правильно функции: oWndData() или oTWndData() oCntData() или oTCntData() oKeyData() или oTKeyData()
SergKis: Andrey пишет А примеры для этого тоже бы желательно иметь более подробней написанные... В примере, мне кажется, довольно подробно написано применение практически всех вариантов.
Петр: Andrey пишет: Да не так уж и много правок для ядра. Правки сырые, видно, что человек не читал хотя бы то, что в xhb-diff написано и примеров ООП в папке tests не смотрел. И если собираетесь использовать в harbour классы, то нужно найти и почитать документацию по Class(y). Реализация методов Destroy показывает, что еще есть чему учиться. SergKis пишет: Нет ясности, у примеру, как обозвать правильно функции: oWndData() или oTWndData() Если это функции классов, то префикс o здесь явно чуждый. Что до T - это дань Делфи, "родные" функции классов в harbour начинаются c Hb
Петр: SergKis пишет: в одном месте ядра используем _HMG_ Дело в том, что вы положили в переменную, использование классов в процедурной библиотеке, выглядит достаточно странно. А если учесть, что нет никакой продуманной обьектной модели, что визуальные обьекты, смешаны с невизуальными, довольно таки специфическими (TCntData ).. Пока, нет, т.к. нет ясности, будет ли это востребовано (работа по сообщениям) Какое отношение имеет TCntData к "работе с сообщениями" ? Какую модель работы с сообщениями вы выбрали?
SergKis: Петр пишет А если учесть, что нет никакой продуманной обьектной модели, что визуальные обьекты, смешаны с невизуальными, довольно таки специфическими (TCntData ).. Если просматривали историю выкладываня, могли увидеть, что некоторые визуальные (после отладки) уходили в невизуальные. Набираю с колес, в первую очередь, для себя, чтобы с работающей сейчас сопли (своя версия) перейди на более разумную Какое отношение имеет TCntData к "работе с сообщениями" Самое прямое, на нем, в первую очередь, ставятся\выполняются events этого This контрола + насколько команд, для упр. контролом внутри блока events. На окно, соответсвенно, для самостоятельных (не связанных event с контролом) или для организации множественной рассылки сообщений контролам, с установкой соотв. среды This. Дело в том, что вы положили в переменную, использование классов в процедурной библиотеке, выглядит достаточно странно. Вполне можно убрать, добавил только для "эстетического" написания\использования. GetControlIndex(Self) или GetControlIndex( , Self:Index) Реализация методов Destroy показывает, что еще есть чему учиться. Так всю жизнь этим занимаюсь. Правки сырые, видно, что человек не читал хотя бы то, что в xhb-diff написано и примеров ООП в папке tests не смотрел с xhb дел не имел (кроме сборки letodb) никаких. Примеры ООП, в основном hb 2.0. Правки сырые", действительно так, с "колес", но мне лично надо ехать, а шашечки ..., правильное оформление ... Разве, кто подключится и поможет.
Петр: Какое отношение имеет TCntData к "работе с сообщениями" Самое прямое А, так это - TControl и что делает метод Sum(), а главное для чего он что-то делает? Позвольте дать вам совет. 1) Для публичных библиотек не используйте конспирологические имена (:UsK) 2) Возьмите принятную для вас обьектную модель (Delphi, FoxPro, xailer ) и внимательно ее изучите. SergKis пишет: с xhb дел не имел (кроме сборки letodb) никаких. Примеры ООП, в основном hb 2.0. Правки сырые", действительно так, с "колес", но мне лично надо ехать, а шашечки ... Не буду обьяснять почему, но вам в source еще рано.
SergKis: Петр пишет что делает метод Sum(), а главное для чего он что-то делает? TKeyData для работы с ключами hash, т.е. ключ - значение и Sum делает в рамках этих правил сумму (массив сумм) на ключ. Local o1 := oKeyData() Local o2 := oKeyData() DO WHILE ! Eof() o1:Sum("#", 1) o1:Sum("KolVo", (oBrw1:cAlias)->KOLVO) o1:Sum("Summa", (oBrw1:cAlias)->SUMMA) o2:Sum("Itogo", {1, (oBrw1:cAlias)->KOLVO, (oBrw1:cAlias)->SUMMA} SKIP ENDDO o1:Eval({|k,s,i| _LogFile(.T., i, k, s) }) o2:Eval({|k,s,i| _LogFile(.T., i, k, hb_valtoexp(s)) }) и все это можно использовать в event, к примеру, окна. Для публичных библиотек не используйте конспирологические имена (:UsK) Я приписал - на любителя, оставил, что бы текст выложенный и моей версиии, соответствовалВозьмите принятную для вас обьектную модель (Delphi, FoxPro, xailer ) и внимательно ее изучите. но вам в source еще рано Скорее поздно, да и совершенно не стремлюсь.
SergKis: PS Вылез с предложениями, только по причинам 1. Убрать лишнее макро выполнение в командах (у меня убрано). См. _SetFocus постах выше 2. Получить работу с сообщениями, если мой вариант, то дополнительно бонус - список всех типов на окно - список объектов контролов по запросу типов - список объектов контролов по запросу имен Цель, иметь возможность перехода на последние версии hmg. Если предложения будут включены "правильным" образом с "правильным" описанием, я включу их в свою версию правильно. В любом случае, я перешел с поделки на Label (аналог сообщений), используя повод :UserKeys, пусть и не "правильный" код
Петр: SergKis пишет: Если предложения будут включены "правильным" образом с "правильным" описанием, я включу их в свою версию правильно. Ваш код в существующем виде не может быть включен в MiniGUI по банальной причине - MiniGUI Ext. поддерживает как harbour, так и xhb. Для того, чтобы написать совместимый код нужно знать их отличия (xhb-diff) как на PRG уровне (элементарное различие в наименовании функций и к-ве параметров), так и C API. Вот, к примеру, в xhb реализация деструктора обьекта приводит к повреждению HVM памяти. Поэтому такие вещи сильно (иногда не сильно ) лимитируют использование нативных средств языка (harbour/xhb), вынуждая создавать соотв. функциональность с помощью WinAPI и совместимого C API.
SergKis: Петр Наверно по незнанию,не вижу связи использования WinApi для установки свойства объекта (в реале STATIC переменной) в Nil, если не ставить - это произойдет все равно (как не использованная) мусоросборщиком. А др. в destroy нет. В hb (в сравнении с vo, но это уже история ...) напрягает (чуть чуть) отсутствие автоматических AXIT и Destroy, делаем ручками. Ваш код в существующем виде не может быть включен в MiniGUI по банальной причине - MiniGUI Ext. поддерживает как harbour, так и xhb. Destroy это просто название метода, его можно было назвать ToNil, если на название реагирует xhb , нет проблем, сменим, если для xhb надо отдельно метод инициализации, тоже нет проблемы, сделаем метод Init или Define и будем писать TWndData():New():Init( <параметры> ) Покажите как надо, оформлю, но изучать xhd-diff ..., т.к по жизни нет необходимости в этом
Петр: SergKis пишет: В hb (в сравнении с vo, но это уже история ...) напрягает (чуть чуть) отсутствие автоматических AXIT и Destroy, Ага-ага. Да посмотрите вы примеры, пожалуйста.. harbour\tests\destruct.prg CREATE CLASS myClass VAR TYPE VAR var1 CLASS VAR var2 METHOD INIT DESTRUCTOR dtor END CLASS В harbour деструкторы как раз таки, есть и работают не плохо. В xhb из-за особенностей реализации HVM есть проблемы. Поэтому изучив xhb-diff, напичкав свой код #ifdef ваяете что-то не слишком замысловатое (оно же еще в multithread работать должно, а там опять грабли при переносе с одной системы на другую) или забиваете на классы и с помощью WinAPI/C API/PRG кода в старом добром процедурном стиле решаете нужную вам проблему и предлагаете ее Григорию для включения в MiniGUI.
SergKis: Петр Спасибо за подробное разъяснение "религии" hmg. "Забивать на классы" не получится (задачи тоже на них), теряюсь когда надо писать процедурным языком, отвык однако . Останется сложный переход на new версию hmg, если понадобится. Если заложить в hmg следующее: 1. Оставить введенные переменные _HMG_aFormMiskData1, _HMG_aFormMiskData2 b _HMG_aControlMiskData0 или зарезервировать места аналоги этих переменных и где сейчас заполнялись объектами эти переменные, сделать вызов блоков кода Eval(_HMG_bFormInit, k), Eval(_HMG_bControlInit, k). Где k index регистрации элемента. 2. В процедурах _DoWindowControlEventProcedure, _DoWindowEventProcedure, сделать как предлагал выше или хотя бы добавить параметры в вызов и Eval и ввести проверку i > 0 3. _EraseControl, _ReleaseWindow, там где вставлял свой код, добавить выполнение блоков кода Eval(_HMG_bControlErase, k) Eval(_HMG_bFormRelease, k) Названия переменных условное, так к примеру. Может что то еще упустил, но тогда WM_USER+..., действительно обрабатывать можно в своем MyEvent. Тогда классы можно вывести в пример и сгородить весь огород по сообщениям в примере.
SergKis: Петр пишет Присмотритесь к TTaskDialog ... Поэтому изучив xhb-diff, напичкав свой код #ifdef ваяете что-то не слишком замысловатое (оно же еще в multithread работать должно, а там опять грабли при переносе с одной системы на другую) или забиваете на классы и с помощью WinAPI/C API/PRG кода в старом добром процедурном стиле решаете нужную вам проблему и предлагаете ее Григорию для включения в MiniGUI Присмотрелся, думаю в xhb, наверно, не включен h_taskdialog.prg, т.к. "забили на классы". Скачал, смотрю есть такой файл. Надо поучиться на xhb h_taskdialog.prg, как "в старом добром процедурном стиле" написать свой класс. Открываю , а там, решение "в старом добром процедурном стиле" CREATE CLASS TSimpleTaskDialog FUNCTION SimpleTaskDialog а дальше, больше, есть METHOD OnDestroyed( hWnd, nNotify, nWParam, nLParam ) CLASS TTaskDialog а в нем ужасное ::HWND := Nil От души отлегло, гора с плеч упала, в xhb (за деньги) все в порядке с классами. А то в clipper с классами работали ... а тут "с помощью WinAPI/C API/PRG кода в старом добром процедурном стиле решаете нужную вам проблему" К чему это я и о чем ? Снова о "религии", понимал, что "лезу в чужой монастырь со своим уставом" предложением ... Видно мы по разному крестимся. У себя, я получил, того чего не хватало мне в МиниГуи, для других ...
gfilatov2002: SergKis пишет: От души отлегло, гора с плеч упала Прошу без обид... SergKis пишет: заложить в hmg следующее: Сделал таким образом: 1. Оставил введенные переменные _HMG_aFormMisсData1, _HMG_aFormMisсData2, а вместо _HMG_aControlMiskData0 предлагаю использовать уже существующий _HMG_aControlMisсData2 для хранения массива. 2. В процедурах _DoWindowControlEventProcedure, _DoWindowEventProcedure добавил параметры в вызов и Eval и проверку i > 0 3. Добавил в _EraseControl() обработку 2-го элемента массива Cargo [pre2] IF ISARRAY ( _HMG_aControlMiscData2 [ i ] ) .AND. Len( _HMG_aControlMiscData2 [ i ] ) > 1 IF ISBLOCK ( _HMG_aControlMiscData2 [ i ][2] ) Eval ( _HMG_aControlMiscData2 [ i ][2], i, p ) ENDIF ENDIF [/pre2] Вместо Eval(_HMG_bFormRelease, k) предлагаю использовать событие ON RELEASE (или ON INTERACTIVECLOSE) формы. Вместо блоков кода Eval(_HMG_bFormInit, k) использовать событие ON INIT формы, а вместо блока Eval(_HMG_bControlInit, k) делать добавление объекта в 1-й элемент массива _HMG_aControlMiscData2 после определения каждого контрола (где index регистрации элемента есть GetControlIndex(c,f)). Обработку событий WM_USER+... делать в своем MyEvents с использованием команды Set Events Function To MyEvents. P.S. Мне симпатичен Ваш подход, но совместное использование псевдо-ООП и настоящих классов порождает ненужное дублирование в ядре библиотеки...
SergKis: gfilatov2002 пишет использование псевдо-ООП и настоящих классов порождает ненужное дублирование в ядре библиотеки... Лучше иметь дублирование, чем не иметь ничего, речь идет о разрезах контролов по окнам, то что в МиниГуи кроме ascan ничего нет (доступ к контролам), вызывает удивление, база есть а разрезов, по окнам нет. Это как DBFCDX только с Locate, без индексов и тегов, scope. Если нужен индекс\тег, то стройте его (клиенты) сами, там С структуры, там учебник по С и вперед. Т.е. что бы получить что то с МиниГуи пользователь должен досконально знать организацию и цепочки (itemoв), а если с версией это меняется. Словом недоработка, по моему мнению, длящаяся годами. Прошу без обид... Обиды нет, есть непонимание, почему просто не сказать, систему сообщений берем от Петра. Будет ли она лучше, посмотрим. Что предложено сечас, полная изолированность конрола, т.е. он о себе знает все, где что брать, как отображать и ничего не знает о др. конролах окна. И так каждый контрол, т.е. создана база контролов, в которых можно события пронумеровать с 1 и далее (на каждый контрол), наложив на них одинаковое действие, как в примере. В программе нет ни одного места использования контрола напрямую, только через сообщения. Окно так же ничего не знает о поведении контролов (списки-разрезы знает). На окно мы ставим с 1 и далее события, которые в основном раздают сообщения. Т.е. с контролами общаемся только через события окна, никаких прямых сообщений из разных мест прогр. нет, только через окно, так же поступаем и с др. окном, надо сделать refresh, посылаем сообщение окну, а оно контролам групповые сообщения. Сделал таким образом: Думаю это все не очень нужно (мне точно), так сказал, наверно сгоряча. Зачем это, если можно исходники подправить, не сложно. Думается и другим корячится вряд ли захочется, тем более, что исп. OnInit и OnRelease можно, но это большая морока делать в КАЖДОМ окне, а до OnInit от _DefineWindow... как до луны.
SergKis: PS совместное использование псевдо-ООП и настоящих классов порождает По мне, так положительные эмоции, можно написать с псевдо ООП, будет крутиь макро (чуть медленнее), но сделает. Можно исп. объект, будет ТОЖЕ работать, возможно, чуть быстрее, а при передаче его (объкта) в блок кода, так и писать удобнее, а с блоками сообщений (моя версия) именно так и происходит. У пользователя МиниГуи есть выбор, как писать, а сейчас его нет. Пишем только псевдо ООП, а если дурит препроцессор, в небольшом примере идет, в родной проге приходится уходить с псевдо на функции. Или сразу писать функциями. Тут тоже вопрос, а что лучше тогда ?
Петр: SergKis пишет: Присмотрелся Знаете, я ровным счетом ничего не понял, что вы хотите сказать. Прямо какой-то поток сознания. Вы случайно во второй цитате или не видели? И кто вам посоветовал "как "в старом добром процедурном стиле" писать свои классы"? Вы можете вызвать TaskDialog из xhb? Рад за вас И что у вас вызвало столько эмоций в методе OnDestroyed?
SergKis: Петр пишет Знаете, я ровным счетом ничего не понял, что вы хотите сказать. Боюсь не поймете, но попробую объяснить. На мое "с xhb дел не имел (кроме сборки letodb) никаких" и sourcе кодером становиться 'совершенно не стремлюсь" (xhb не нужен мне), вы, явно ерничая, даете советы (см. выше), особенно порадовало именно после или. Ваше "Вот, к примеру, в xhb реализация деструктора обьекта приводит к повреждению HVM памяти." навело на мысль, что просто свойство\переменную в Nil, недостаточно (со времен clipper хватало) и это вызвало эмоции, как же я работал до этого. И я, явно ерничая, побежал смотреть, как вы, применяете на практике, то что советуете ... Ваше "читать xhb-diff ... нужно знать их отличия (xhb-diff)", вызывает желание посоветовать почитать инструкцию по эксплуатации автомашины ГАЗ-51, там тоже есть отличия, при переключении передач от автомобиля ВАЗ. Вы можете вызвать TaskDialog из xhb? Рад за вас Опять фантазируете, ерничаете, я только сказал, что в xhb есть H_TaskDialog.prg, .т.е. включен в проект, работает он или нет, это др. вопрос. Прямо какой-то поток сознания. Надеюсь, я его расшифровал
Петр: SergKis пишет: Ваше "Вот, к примеру, в xhb реализация деструктора обьекта приводит к повреждению HVM памяти." навело на мысль Вы не правильно интерпретировали мою подсказку. Опять фантазируете, ерничаете, я только сказал, что в xhb есть H_TaskDialog.prg, .т.е. включен в проект Нет, но могу вам напомнить, что я не мантайнер MiniGUI. К тому же "включен в проект" можно понимать по разному, то ли это значит, что файлы включены в поставку (архив/инсталятор), то ли используется файлом сборки (make файл/bat). В поставе "xhb (за деньги)" используется 2 вариант (с классами там действительно все в порядке )
gfilatov2002: Петр пишет: могу вам напомнить, что я не мантайнер MiniGUI Ребята, давайте жить дружно Подготовил очередную бетку для новой сборки 17.06 со следующим списком изменений [pre2] * New: Added the read/write user-defined property 'Cargo' for the Forms. You can set/get this property at runtime: - function syntax: SetProperty ( Form, 'Cargo', xUserData ) GetProperty ( Form, 'Cargo' ) --> xUserData - pseudo-OOP syntax: Form.Cargo := xUserData Form.Cargo --> xUserData Sample code: ThisWindow.Cargo := InputBox( 'Enter a form's title', 'New Title' ) ThisWindow.Title := ( ThisWindow.Cargo ) It was a postponed user's request. Suggested and contributed by SergKis. * New: Added a possibility to load a menu from an application resource with the accelerators: - added a new function hMenu := LoadMenu( [<hInstance>], cMenuName ); - added the new functions hAccel := LoadAccelerators( [<hInstance>], cTableName ) and SetAcceleratorTable( hWnd, hAccel ). It was a postponed user's request. Note that hMenu handle should be destroyed ON RELEASE of a form via calling of the function DestroyMenu( hMenu ). Contributed by Petr Chornyj <myorg63@mail.ru> (see demo in folder \samples\Basic\MenuRES) * New: Added the following new commands for managing of the application events: - ON APPEVENT [ID] <nId> ACTION <bAction> OF <window> ; [NOACTIVE>] [ONCE>] [RESULT] TO <lResult>. - EMIT [EVENT] [ID] <nId> OF <window>. - REMOVE APPEVENT [[ID] [<nId>] | ALL] OF <window> ; [ONCE>] [RESULT] TO <lResult>. - UPDATE APPEVENT [ID] <nId> [ACTION <bAction>] OF <window> ; [NOACTIVE>] [ONCE>] [RESULT] TO <lResult>. Contributed by Petr Chornyj <myorg63@mail.ru> (see demo in folder \samples\Advanced\AppEvents) * Modified: GetBox control - improved caret shape in the insert/overwrite modes. A readonly GetBox will not show a caret now. Based upon a contribution of SergKis (see demo in folder \samples\Basic\GetBox) * Modified: The following obsolete C-functions were guarded with HMG_LEGACY_ON constant in the Minigui core: - BitmapSize(); - C_DrawFocusRect(); - GetWindowFromDC(). The actual function's names are GetBitmapSize(), DrawFocusRect() and WindowFromDC(). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\SetThemes) * Updated: PropSheet library source code (see in folder \Source\PropSheet): - updated for compatibility with the last Minigui changes. Suggested and contributed by SergKis. * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added a new method UserKeys( nKey, bKey, lCtrl, lShift ). Sample code: :UserKeys(VK_F2, {|oBr,nKy,cKy| Add_Rec(oBr, nKy, cKy) }) :UserKeys(VK_F3, {|oBr,nKy,cKy| Del_Rec(oBr, nKy, cKy) }) :UserKeys(VK_F3, {|oBr,nKy,cKy| MsgBox(cKy, 'Ctrl + F3') }, .T.) :UserKeys(VK_F3, {|oBr,nKy,cKy| MsgBox(cKy, 'Shift + F3') }, , .T.) :UserKeys(VK_F3, {|oBr,nKy,cKy| MsgBox(cKy, 'C + S + F3') }, .T., .T.) :UserKeys(NIL , {|oBr,nKy,cKy| _LogFile(.T.,cKy, 'other', nKy ) }) If an above codeblock returns Nil or .F., then method KeyDown will be finished, else if return is .T. then method KeyDown will work further. Contributed by SergKis (see demo in folder \samples\Advanced\Tsb_addrecord_3) * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.19.3 (from 3.19.0). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Harbour Compiler 3.2.0dev (SVN 2017-05-20 02:25). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * Updated: 'Sumatra PDF Viewer' utility: - added ability to translate the interface, - added ability to open url links from pdf documents, - added view documents in tabs, - added saving of last session and recent files in PdfView.recent, - added processing of command line with pdf files as parameters, - added auto refresh the file list when main window got focus, - minor bugs fixed. Based upon a contribution of HMG user KDJ. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\PdfView) * Updated: 'TsBrowse Add New Record with Index Order' sample: - fixed the warnings in a C-code; - modified for using of a method UserKeys. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\Tsb_addrecord_3) * Updated: 'DOS-like menu with using of TsBrowse' sample. Based upon a contribution of Krzysztof Stankiewicz <ks@nsm.pl> (see in folder \samples\Advanced\Tsb_menu) [/pre2] Благодарю за оперативную помощь в подготовке этой сборки SergKis и Петра Без Вашей поддержки ничего бы не вышло... Кстати, команды ON APPEVENT/EMIT были вдохновлены SergKis Петр пишет: SergKis подбросил интересную идею, попробую реализовать что-то подобное ON APPEVENT [NAME] <evName> [ID <id>] | [AUTO] EVAL <{block}> [ONCE] EMIT <evName>
SergKis: Петр xhb, меня не интересует в любом виде. Я, не распаковывая, глянул архив xhmg1705... и увидел, что увидел. Глянул команды из hbclass.ch и сделал вывод, что класс TWndData полностью отвечает требованиям xhb, т.е. не требует дополнительных #ifdef XHARBOUR для работы в xhb. Посмотрел и TsBrowse на предмет #ifdef их всего несколько строк, причем только 1 реальная, связанная с функ. CToT. Говорю, просто для информации, что и как посмотрел. Действительно, давайте закончим эту не интересную дискуссию.
SergKis: gfilatov2002 пишет Прошу без обид... Мне симпатичен Ваш подход, но совместное использование псевдо-ООП и настоящих классов порождает ненужное дублирование в ядре библиотеки.. Я, скорее, рассердился на себя. Мой товарищ по работе, сразу сказал, не трать время, ни один класс окна и контрола не будет принят добровольно в МиниГуи, т.к. он практически хоронит псевдо ООП (Andrey пишет Удобней кстати для использования.). Я, наивный, не поверил, т.е. "хотел как лучше ...". Так что я сильно рассердился на себя.
gfilatov2002: SergKis пишет: я сильно рассердился И зря... Ваше предложение не отвергнуто, но отложено по причинам, которые уже озвучил Петр: - отсутствие внятной модели классов; - смешивание визуальных и невизуальных методов в классах; - наличие в предлагаемом коде избыточных пользовательских методов, которые должны добавляться наследованием от базового класса. SergKis пишет: ни один класс окна и контрола не будет принят добровольно в МиниГуи Тка сложилось исторически, что библиотекой пользуются в основном старые "зубры" программирования, которые привыкли использовать процедурный стиль. Кстати, это одна из причин популярности Минигуи в отличие от того же грамотно спланированного HwGui. ИМХО Признаюсь, что я тоже овладел классами только на пользовательском уровне, что потребовало минимум 3 года работы. Поэтому я всецело доверяю в этом вопросе мнению Петра, который разработал для минигуи класс TTaskDialog и, поэтому имеет право предлагать его в качесте примера Кстати, предложенные Вами кодовые блоки для подключения классов окон и контролов могут быть легко добавлены в переменную _HMG_MainCargo как #xtranslate _HMG_bFormInit => _HMG_MainCargo \[1] #xtranslate _HMG_bControlInit => _HMG_MainCargo \[2] #xtranslate _HMG_bControlErase => _HMG_MainCargo \[3] #xtranslate _HMG_bFormRelease => _HMG_MainCargo \[4] и затем вызываться в соответствубщих функциях ядра при необходимости. Также есть замечание по поводу имени класса TCntData. Cnt - это сокращение для Count, а для контрола д.б. CTRL или CTL (это так, к слову). В заключение обратите внимание, что предложенные Вами довольно давно изменения для GetBox (форма курсора) включены в следующую сборку На все требуется время для осмысления...
SergKis: gfilatov2002 пишет отсутствие внятной модели классов... наличие в предлагаемом коде избыточных пользовательских методов, которые должны добавляться наследованием от базового класса. Я считал, что работаем в процедурной среде МиниГуи, а не среде грамотно спланированной цепочки классов. Т.к. практически исключил наследование. Как это делать в _HMG_aControlMiskData0[ i ][1] := <объект контрола> ? По этой причине сделал избыточные (немного) классы. Т.е. я отверг изначально oApp->oWindow->oWindowDialog ... Представленные классы - это скорей сложные процедуры\функции. Расширение свойств, методов - через функции объектов и примерно так, добавляем переменную в объект и присваиваем значение := oKeyData() получая сразу контейнер данных и исп. блоки с возможностью проводить групповые операции Eval() или Sum(). Т.е. с моделью я определился, она процедурная, как и МиниГуи. смешивание визуальных и невизуальных методов в классах хотелось бы конкретики По названиям, абсолютно, без разницы как будут называться, были бы в наличии.
SergKis: PS Потом, я не знаю, будем делать и повторять в классе TAppData свойства\методы из App. ... псевдо ООП команд ? Если будем, сделать не сложно, тогда там будет регистрация окон (как контролов в окне), т.е. свои :oName, :oHand с доступом. Вопрос надо ли это сейчас ?
SergKis: PS Если вопрос наследования на первом месте (или замена класса полностью в переменной _HMG_aControlMiskData0[ i ][1])?, делаем это (к примеру) в функции oWndData(...). Если к примеру _HMG_bWndObject := bBlock выполняем и возвращаем что она дает из ф-ии oWndData, если не задан - как сейчас. Все по МиниГуи-шному
SergKis: gfilatov2002 пишет в отличие от того же грамотно спланированного HwGui. Основная причина - она брошена. В 2009 году она была 2004\5 года сборки. Сейчас ее состояние (внутреннее) практически не изменилось, только перевелась на hb3.2 с небольшими улучшениями и сменой названий функции. Потом, многие вещи оставлены на очень низком уровне - что надо собирайте сами, а инстукции\примеров нет, "догадайся мол сама". Мое мнение
gfilatov2002: SergKis пишет: Все по МиниГуи-шному Замечательно, тогда присылайте мне по почте предлагаемые изменения, будем рассмативать их для будущих сборок SergKis пишет: Основная причина - она брошена. Согласен. Но чтобы этого не случилось с Минигуи, необходимы стимулы, в т.ч. Ваша поддержка и предложения по улучшению кода. Я не устаю повторять, что всегда открыт для новых улучшений, но только после их критического пересмотра
SergKis: gfilatov2002 пишет но только после их критического пересмотра Кто б возражал, я не буду. После выхода new версии, надо присмотреться (я пляшу от своей) к коду, пришлю.
SergKis: gfilatov2002 пишет переменную _HMG_MainCargo как #xtranslate _HMG_bFormInit => _HMG_MainCargo \[1] #xtranslate _HMG_bControlInit => _HMG_MainCargo \[2] #xtranslate _HMG_bControlErase => _HMG_MainCargo \[3] #xtranslate _HMG_bFormRelease => _HMG_MainCargo \[4] и затем вызываться в соответствующих функциях ядра при необходимости. Если _HMG_MainCargo новая переменная и не занята пользователями hmg, в проектах, я предложу в дальнейшем _HMG_MainCargo := oKeyData() _HMG_MainCargo:Set('bFormInit', Nil) _HMG_MainCargo:Set('bFormDestroy', Nil) _HMG_MainCargo:Set('bControlInit', Nil) _HMG_MainCargo:Set('bControlDestroy', Nil) и использовать _HMG_MainCargo:Do('bFormInit', p1, p2, p3) если много параметров, то IF _HMG_MainCargo:IsBLock('bFormInit') EVal(_HMG_MainCargo:Get('bFormInit', p1, p2, p3, p4, p5, ...) ENDIF или p1 := { x1, x2, ... } _HMG_MainCargo:Do('bFormInit', p1, p2, p3) _HMG_MainCargo:Do('bFormDestroy') _HMG_MainCargo:Do('bControlInit', p1, p2, p3) если много параметров, то IF _HMG_MainCargo:IsBLock('bControlInit') EVal(_HMG_MainCargo:Get('bControlInit', p1, p2, p3, p4, p5, ...) ENDIF или p1 := { x1, x2, ... } _HMG_MainCargo:Do('bControlInit', p1, p2, p3) _HMG_MainCargo:Do('bControlDestroy') и т.д. нет ограничений в будущих переменных #xtranslate _HMG_bFormInit => _HMG_MainCargo:Get('bFormInit') #xtranslate _HMG_bControlInit => _HMG_MainCargo:Get('bControlInit') #xtranslate _HMG_bControlDestroy => _HMG_MainCargo:Get('bControlDestroy') #xtranslate _HMG_bFormDestroy => _HMG_MainCargo:Get('bFormlDestroy') если _HMG_MainCargo уже в проектах занята, то надо ввести новую, типа _HMG_AppCargo
Vlad04: ООП , пусть да же псевдо, нельзя хоронить ни в коем случае. Наоборот - надо развивать. Это же удобно.
SergKis: Vlad04 пишет ООП , пусть да же псевдо, нельзя хоронить ни в коем случае. Наоборот - надо развивать. Это же удобно. Даже в мыслях нет. Объекты расширят возможности (могут добавиться команды псевдо ООП), сразу получите: - списки типов контролов на окно - списки контролов на окно - сможете получить массив объектов запрошенных типов\имен контролов по равно или вхождению и в цикле запустить этот список, к примеру для refresh гляньте пример, выкладывал выше, Toolbar в середине
SergKis: gfilatov2002 Класс TKeyData в целом готов, выложу, для анализа и предложений сейчас [pre2] /* * Создание объекта класса TKeyData, если задан параметр Obj, то в блоки кода * метода Do(...) передается значение Obj, иначе Self. */ *-----------------------------------------------------------------------------* FUNCTION oKeyData( Obj ) *-----------------------------------------------------------------------------* RETURN TKeyData():New(Obj) ////////////////////////////////////////////////////////////////////////////////////////////// CLASS TKeyData ////////////////////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oObj VAR aKey INIT hb_Hash() EXPORTED: VAR Cargo METHOD New( o ) INLINE ( ::oObj := iif( HB_ISOBJECT(o), o, Self ), Self ) CONSTRUCTOR METHOD Set( Key, Block ) INLINE hb_HSet( ::aKey, Key, Block ) METHOD Get( Key, Def ) INLINE hb_HGetDef( ::aKey, Key, Def ) METHOD Del( Key ) INLINE iif( hb_hHasKey( ::aKey, Key ), hb_HDel( ::aKey, Key ), ) 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 ) METHOD IsBLock( Key ) INLINE HB_ISBLOCK( ::Get(Key) ) _METHOD Eval( Block ) _METHOD Sum( Key, xSum ) _METHOD Destroy() #ifndef __XHARBOUR__ DESTRUCTOR Destroy() #endif ENDCLASS ////////////////////////////////////////////////////////////////////////////////////////////// /* * Выполнение блока кода Block над всеми элементами контейнера данных ::aKey. * Кодоблоку передаются ключ, значение и индекс. * Если параметр Block, не блок кода, возвращается массив значений, где * каждый элемент массив { ключ, значение, индекс } * Примеры использования в классе TWndData: * METHOD GetListType() * METHOD GetObj4Type( cType, lEque ) * METHOD GetObj4Name( cName ) */ METHOD Eval( Block ) CLASS TKeyData LOCAL i, b := HB_ISBLOCK(Block) LOCAL a := iif( b, Nil, array(0) ) For i := 1 To ::Len If b; Eval( Block, hb_HKeyAt( ::aKey, i ), hb_HValueAt( ::aKey, i ), i ) Else; aAdd( a, { hb_HKeyAt( ::aKey, i ), hb_HValueAt( ::aKey, i ), i } ) EndIf Next RETURN a /* * Выполнение операции суммирования над элементом контейнера данных с ключем Key. * xSum может быть числом или массивом, тогда суммируются только числовые элементы. * В качестве ключа можно использовать имена контролов, тогда возникает связка, при * событийном программировании, с событием заполнения Value контрола из контейнера. * Пример: Local o := oKeyData() * Local Als := oBrw1:cAlias * o:Sum("PRIHOD", { 0, 0, 0 }) * o:Sum("RASHOD", { 0, 0, 0 }) * DO WHILE ! Eof() * o:Sum("COUNT" , 1) * o:Sum("KOLVO" , (Als)->KOLVO) * o:Sum("SUMMA" , (Als)->SUMMA) * If (Als)->OPER == "PRI" * o:Sum("PRIHOD", { 1, (Als)->KOL_PRI, (Als)->SUM_PRI }) * ElseIf (Als)->OPER == "RAS" * o:Sum("RASHOD", { 1, (Als)->KOL_RAS, (Als)->SUM_RAS }) * EndIf * SKIP * ENDDO * ? o:Get("COUNT"), o:Get("KOLVO"), o:Get("SUMMA") * ? hb_valtoexp(o:Get("PRIHOD")) * ? hb_valtoexp(o:Get("RASHOD")) */ 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 /* * Освобождение собственных переменных объекта, устанавливаем в 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 [/pre2]
SergKis: PS _METHOD ... это у меня #define _METHOD METHOD что бы не дублировались объявления с реальными методами при работе с проектом - список Entyti на экране
SergKis: Петр Спасибо за DESTRUCTORв hb, работает.
SergKis: SergKis пишет [pre2] * Пример: Local o := oKeyData() * Local Als := oBrw1:cAlias * o:Sum("PRIHOD", { 0, 0, 0 }) * o:Sum("RASHOD", { 0, 0, 0 }) * DO WHILE ! Eof() * o:Sum("COUNT" , 1) * o:Sum("KOLVO" , (Als)->KOLVO) * o:Sum("SUMMA" , (Als)->SUMMA) * If (Als)->OPER == "PRI" * o:Sum("PRIHOD", { 1, (Als)->KOL_PRI, (Als)->SUM_PRI }) * ElseIf (Als)->OPER == "RAS" * o:Sum("RASHOD", { 1, (Als)->KOL_RAS, (Als)->SUM_RAS }) * EndIf * SKIP * ENDDO * ? o:Get("COUNT"), o:Get("KOLVO"), o:Get("SUMMA") * ? hb_valtoexp(o:Get("PRIHOD")) * ? hb_valtoexp(o:Get("RASHOD")) [/pre2] Если дополнить [pre2] * Пример: Local o := oKeyData() * o:Set('bItog', {|o,p1,p2,p3| ToItog(o,p1,p2,p3) } ) ... * ? hb_valtoexp(o:Get("RASHOD")) * o:Do('bItog', 'Harbour', 'MiniGui', 'OK!') [/pre2] то повесив в new версии эту ф-ю на APPEVENT от Петра, можно в блоке кода скинуть, полученные итоги на контролы, которым были даны имена ключей (в блоке можем сделать):[pre2] FUNC ToItog( o, cH, cM, cO ) ? o:ClassName, cH, cM, cO ? o:Get("COUNT"), o:Get("KOLVO"), o:Get("SUMMA") ? hb_valtoexp(o:Get("PRIHOD")) ? hb_valtoexp(o:Get("RASHOD")) _SetValue('COUNT', 'win_1', cValToChar(o:Get("COUNT"))) ... [/pre2]
SergKis: PS в ToItog можно и так вывести данные на контролы AEval(o:Eval(), {|ky,uv,ni| win_1.&(ky).Value := cValToChar(uv), ni := ky })
SergKis: Кому интересно. Выкладываю классы для vm и vmmt режимов hb. [pre2] *-----------------------------------------------------------------------------* FUNCTION oWndData( nIndex, cName, nHandle, nParent, cType, cVar, oWin, lVmMt ) *-----------------------------------------------------------------------------* LOCAL o Default nIndex := 0, ; cName := '', ; nHandle := 0, ; nParent := 0, ; cType := '', ; cVar := '', ; lVmMt := hb_mtvm() If ! HB_ISOBJECT( oWin ) // window o := TWndData():New():Def( nIndex, cName, nHandle, nParent, cType, cVar, lVmMt ) Else // control o := TCnlData():New():Def( nIndex, cName, nHandle, nParent, cType, cVar, oWin, lVmMt ) If ! Empty(o:Name) .and. ! Empty(o:Handle) If o:Type == 'TBROWSE' o:TBrowse := _HMG_aControlIds [ o:Index ] EndIf o:Set() EndIf EndIf RETURN o /////////////////////////////////////////////////////////////////////////////// CLASS TWndData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR cVar VAR cName VAR cType VAR nIndex VAR nHandle VAR nParent VAR cChr INIT ',' VAR lMT INIT .F. CLASSDATA oName INIT oKeyData() CLASSDATA oHand INIT oKeyData() EXPORTED: VAR oCargo VAR oUserKeys VAR oEvent METHOD New() INLINE Self CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar, lVmMt ) INLINE ( ; ::nIndex := nIndex , ::cName := cName, ::nHandle := nHandle, ; ::nParent := nParent, ::cType := cType, ::cVar := cVar, ; ::oCargo := oKeyData(), ::oUserKeys := oKeyData(), ; ::oEvent := oKeyData( Self ), ::MT := lVmMt, ; Self ) ACCESS MT INLINE ::lMT ASSIGN MT( lVmMt ) INLINE ( ::lMT := iif( HB_ISLOGICAL(lVmMt), lVmMt, .F. ), ; ::oName:MT := ::lMT, ::oHand:MT := ::lMT, ; ::oCargo:MT := ::lMT, ::oEvent:MT := ::lMT, ; ::oUserKeys:MT := ::lMT ) 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_HMG_USER_MSG_W ACCESS WM_nMsgC INLINE WM_HMG_USER_MSG_C 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, lMsgW ) INLINE ( lMsgW := lMsgW == Nil .or. !Empty(lMsgW), ; lMsgW := empty(nHandle) .or. lMsgW, ; PostMessage( ::nHandle, iif( lMsgW, ::WM_nMsgW, ::WM_nMsgC ), nKey, ; hb_defaultValue(nHandle, 0) ) ) METHOD SendMsg( nKey, nHandle, lMsgW ) INLINE ( lMsgW := lMsgW == Nil .or. !Empty(lMsgW), ; lMsgW := empty(nHandle) .or. lMsgW, ; SendMessage( ::nHandle, iif( lMsgW, ::WM_nMsgW, ::WM_nMsgC ), nKey, ; hb_defaultValue(nHandle, 0) ) ) _METHOD DoEvent( Key, nHandle, nParam, cEvent ) _METHOD GetListType() _METHOD GetObj4Type( cType ) _METHOD GetObj4Name( cName ) METHOD GetObj( xName ) INLINE iif( HB_ISCHAR(xName), ::oName:Get(xName), ; ::oHand:Get(xName) ) _METHOD DelProperty( cName ) _METHOD AddProperty( cName, xVal ) _METHOD DelMethod( cMethod ) _METHOD AddMethod( cMethod, pFunct ) METHOD Destroy() INLINE ( ::oCargo:Destroy(), ::oUserKeys:Destroy(), ; ::oHand:Destroy(), ::oName:Destroy(), ::oEvent:Destroy(), ; ::cChr := ::cName := ::oName := ::oHand := ::cVar := Nil, ; ::oUserKeys := ::oEvent := ::cType := ::oCargo := Nil, ; ::nIndex := Nil, ::nHandle := Nil, ::nParent := Nil ) ENDCLASS /////////////////////////////////////////////////////////////////////////////// METHOD AddMethod( cMethod, pFunct ) CLASS TWndData LOCAL o := Self If HB_ISCHAR( cMethod ) .and. ! __ObjHasMsg( o, cMethod ) RETURN ! Empty( __objAddMethod( o, cMethod, pFunct ) ) ENDIF RETURN .F. METHOD DelMethod( cMethod ) CLASS TWndData LOCAL o := Self If HB_ISCHAR( cMethod ) .and. __ObjHasMsg( o, cMethod ) RETURN Empty( __objDelMethod( o, cMethod ) ) ENDIF RETURN .F. METHOD AddProperty( cName, xVal ) CLASS TWndData LOCAL o := Self If HB_ISCHAR( cName ) .and. ! __objHasData( o, cName ) If ! Empty( __objAddData( o, cName ) ) RETURN ! Empty( __ObjSetValueList( o, { cName, xVal } ) ) EndIf EndIf RETURN .F. METHOD DelProperty( cName ) CLASS TWndData LOCAL o := Self If HB_ISCHAR( cName ) .and. __objHasData( o, cName ) RETURN Empty( __objDelData( o, cName ) ) EndIf RETURN .F. METHOD GetListType() CLASS TWndData LOCAL oType := oKeyData() LOCAL aType := {} ::oName:Eval({|k,o,i| k := i, oType:Set(o:cType, o:cType) }) oType:Eval({|k,v,i| k := i, aAdd(aType, v) }) 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({|ky,oc,ni| ky := ni, 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({|ky,oc,ni| ky := ni, iif( cName $ oc:cName, aAdd(aObj, oc), Nil ) }) NEXT EndIF RETURN aObj METHOD DoEvent ( Key, nHandle, nParam, cEvent ) CLASS TWndData LOCAL o, lW := .T. nParam := iif( HB_ISNUMERIC(nParam), nParam, 0 ) cEvent := hb_defaultValue(cEvent, '') If ! empty(nHandle) o := _ControlObj(nHandle) If HB_ISOBJECT(o); lW := .F. EndIf EndIf If ! HB_ISOBJECT(o); o := Self EndIf If lW; _DoWindowEventProcedure ( ::oEvent:Get(Key), o:Index, cEvent, nParam, o ) Else ; _DoControlEventProcedure( ::oEvent:Get(Key), o:Index, cEvent, nParam, o ) EndIf RETURN Nil /////////////////////////////////////////////////////////////////////////////// CLASS TCnlData INHERIT TWndData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oWin VAR oTBrowse EXPORTED: METHOD New() INLINE Self CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar, oWin, lVmMt ) INLINE ( ; ::Super:Def(nIndex, cName, nHandle, nParent, cType, cVar, lVmMt), ; ::oWin := oWin, ; Self ) CONSTRUCTOR ACCESS Title INLINE ::oWin:cTitle ACCESS Caption INLINE iif( ::cType == 'TBROWSE', ; ::oWin:cName + "." + ::cName, ; _GetCaption( ::cName, ::oWin:cName ) ) ACCESS Cargo INLINE _ControlCargo( , ::nIndex ) ASSIGN Cargo( xVal ) INLINE _ControlCargo( , ::nIndex, 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 ) ) ACCESS TBrowse INLINE ::oTBrowse ASSIGN TBrowse( oBrw ) INLINE ::oTBrowse := oBrw ACCESS Value INLINE _GetValue( , , ::nIndex ) ASSIGN Value( xVal ) INLINE _SetValue( , , xVal, ::nIndex, .T. ) ACCESS SetFocus INLINE _SetFocus ( ::cName, ::oWin:cName ) METHOD SetFocus() INLINE _SetFocus ( ::cName, ::oWin:cName ) METHOD Disable( nPos ) INLINE _DisableControl( ::cName, ::oWin:cName, nPos ) METHOD Enable ( nPos ) INLINE _EnableControl ( ::cName, ::oWin:cName, 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 Destroy() INLINE ( ::oCargo:Destroy() , ::oEvent:Destroy(), ; ::oUserKeys:Destroy(), ::oUserKeys := Nil, ; ::oCargo := ::oEvent := ::cChr := Nil, ; ::nIndex := ::cName := ::cType := Nil, ; ::nHandle := ::nParent := ::cVar := Nil ) ENDCLASS /* * Создание объекта класса TKeyData, если задан параметр Obj, то в блоки кода * метода Do(...) передается значение Obj, иначе Self. * Для использования в потоках, задаем значение параметра lVmMt := hb_mtvm(). */ *-----------------------------------------------------------------------------* FUNCTION oKeyData( Obj, lVmMt ) *-----------------------------------------------------------------------------* RETURN TKeyData():New():Def(Obj, lVmMt) ////////////////////////////////////////////////////////////////////////////////////////////// CLASS TKeyData ////////////////////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oObj 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() #ifndef __XHARBOUR__ DESTRUCTOR Destroy() #endif ENDCLASS ////////////////////////////////////////////////////////////////////////////////////////////// /* * Для работы в потоках, синхронизируется доступ к контейнеру ::aKey */ METHOD SGD( n, k, v ) CLASS TKeyData 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 /* * Выполнение блока кода Block над всеми элементами контейнера данных ::aKey. * Кодоблоку передаются ключ, значение и индекс. * Если параметр Block, не блок кода, возвращается массив значений, где * каждый элемент массив { ключ, значение, индекс } * Примеры использования в классе TWndData: * METHOD GetListType() * METHOD GetObj4Type( cType, lEque ) * METHOD GetObj4Name( cName ) */ METHOD Eval( Block ) CLASS TKeyData LOCAL m, i, b := HB_ISBLOCK(Block) LOCAL a := iif( b, Nil, array(0) ) For i := 1 To ::Len If ::lMT m := ::SGD( 4, i ) If b; Eval( Block, m[ 1 ], m[ 2 ], i ) Else; aAdd( a, { m[ 1 ], m[ 2 ], i } ) EndIf Else If b; Eval( Block, hb_HKeyAt( ::aKey, i ), hb_HValueAt( ::aKey, i ), i ) Else; aAdd( a, { hb_HKeyAt( ::aKey, i ), hb_HValueAt( ::aKey, i ), i } ) EndIf EndIf Next RETURN a /* * Выполнение операции суммирования над элементом контейнера данных с ключем Key. * xSum может быть числом или массивом, тогда суммируются только числовые элементы. * В качестве ключа можно использовать имена контролов, тогда возникает связка, при * событийном программировании, с событием заполнения Value контрола из контейнера. * Пример: Local o := oKeyData() * Local Als := oBrw1:cAlias * o:Sum("PRIHOD", { 0, 0, 0 }) * o:Sum("RASHOD", { 0, 0, 0 }) * DO WHILE ! Eof() * o:Sum("COUNT" , 1) * o:Sum("KOLVO" , (Als)->KOLVO) * o:Sum("SUMMA" , (Als)->SUMMA) * If (Als)->OPER == "PRI" * o:Sum("PRIHOD", { 1, (Als)->KOL_PRI, (Als)->SUM_PRI }) * ElseIf (Als)->OPER == "RAS" * o:Sum("RASHOD", { 1, (Als)->KOL_RAS, (Als)->SUM_RAS }) * EndIf * SKIP * ENDDO * ? o:Get("COUNT"), o:Get("KOLVO"), o:Get("SUMMA") * ? hb_valtoexp(o:Get("PRIHOD")) * ? hb_valtoexp(o:Get("RASHOD")) */ 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 /* * Освобождение собственных переменных объекта, устанавливаем в 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 [/pre2] Пример, который выкладывал ранее, работает и там и там.
Andrey: SergKis пишет: Кому интересно. Выкладываю классы для vm и vmmt режимов hb. Да всем будет интересно. Не сейчас, так позже понадобиться. gfilatov пишет: Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Григорий включи пожалуйста в библиотеку. А то проработанные и хорошие идеи пропадают !
Петр: Andrey пишет: А то проработанные и хорошие идеи пропадают ! На счет хорошие или нет - не скажу, не знаю, а вот чтобы проработанные - это еще вопрос. SergKiss скажите, вот у вас обьекты создаются по такой схеме *-----------------------------------------------------------------------------* FUNCTION oKeyData( Obj, lVmMt ) *-----------------------------------------------------------------------------* RETURN TKeyData():New():Def(Obj, lVmMt) Т.е. у вас метод Def фактически является конструктором Скажите почему вы игнорируете подсказку разработчика "and please remember that :NEW() will be class method so it should not be redefined as constructor in user class. Instead :INIT() method should be used as constructor. It's executed automatically when object is created from the :NEW() method." Какой смысл вы вкладываете в существование такого кода 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 Show INLINE _ShowControl ( ::cName, ::oWin:cName ) METHOD Show() INLINE _ShowControl ( ::cName, ::oWin:cName ) PS. Если ответ будет типа: и так работает; боюсь, что вы не поймете; некогда думать, надо по клаве стучать или "вам шашечки или ехать" - оставьте, пожалуйста, вопросы без внимания.
SergKis: Петр Спасибо за конкретные вопросы. такого ACCESS Show INLINE _ShowControl ( ::cName, ::oWin:cName ) METHOD Show() INLINE _ShowControl ( ::cName, ::oWin:cName ) Это аналог (как в псевдо ООП на препроцессоре) исп. o:Show и o:Show() а такого ACCESS Obj INLINE ::oObj ASSIGN Obj( o ) INLINE ::oObj := iif( HB_ISOBJECT(o), o, Self ) 1. Я скрыл, что вн. переменная имеет префикс oObj - хранение объектов 2. access\assign предполагает, что в дальнейшем, я должен использовать везде, в том числе и внутри класса только эти определения. Что бы в дальнейшем, подправив\изменив assign мне не требовалось править весь текст класса, а еще хуже программы. Я, кстати, нарушил это правило (что не есть хорошо), но только по причине, что классы небольшие. Какой смысл вы вкладываете в существование такого кода ACCESS MT INLINE ::lMT ASSIGN MT( lVmMt ) INLINE ::lMT := iif( HB_ISLOGICAL(lVmMt), lVmMt, .F. ) Не очень понимаю вопрос. Делал так, по причине, не привязываться к ф-ии hb_mtvm() внутри класса, не знаю как она называется в xhb, но главное, считаю (во многих случаях), что в среде vmmt, вполне можно работать без совместного доступа к классам - это в руках делающего программу. К примеру, если в потоке создаем окно с сопутствующими классами, то не х... лезть в него из др. потоков. Если очень надо, для этого есть сообщения, т.е. послали по handle и пусть идет ... А делать всегда совместный доступ - это удорожание продукта, трата времени и ... вот у вас обьекты создаются по такой схеме *-----------------------------------------------------------------------------* FUNCTION oKeyData( Obj, lVmMt ) *-----------------------------------------------------------------------------* RETURN TKeyData():New():Def(Obj, lVmMt) Т.е. у вас метод Def фактически является конструктором Мы в процедурной среде. oKeyData(...) это аналог функций _Difine...(...). Кстати, забыл, а надо бы добавить и можно это сделать не залезая в класс FUNCTION oKeyData( Obj, lVmMt ) *-----------------------------------------------------------------------------* Default lVmMt := hb_mtvm() RETURN TKeyData():New():Def(Obj, lVmMt) Нет, конструктором является :New(), то что он пустышка - это частный случай Если бы сделал [pre2] METHOD New( nIndex, cName, nHandle, nParent, cType, cVar, lVmMt ) INLINE ( ; ::nIndex := nIndex , ::cName := cName, ::nHandle := nHandle, ; ::nParent := nParent, ::cType := cType, ::cVar := cVar, ; ::oCargo := oKeyData(), ::oUserKeys := oKeyData(), ; ::oEvent := oKeyData( Self ), ::MT := lVmMt, ; Self ) [/pre2] то исп. в нем ::MT := lVmMt было бы не очень правильно, т.к. конструктор не закончился, а мы суем ему уже разные внутренние конструкции. А написав (фактически продублировав свойство assign) мы в будущем могли попасть на неприятности, модификации дубляжа. Потому применение Def вполне оправдано, а честнее, только так и надо поступать. Утрированный пример. Делаем (не в среде hmg) o := oWndData(....) для окна A, поработали, надо также поработать с окном Б, можем создавать новыу переменную окна, а можем вызвать :Def(...) существующего и по тому же тексту, что работал с А отработать Б. Еще про access\assign. Имеем ACCESS AAAA INLINE .... ASSIGN AAAA( p ) INLINE .... используем по полной и через время понадобилось немного изменить, но не влазит по потребностям в assign, то подправить ситуевину можно добавив METHOD AAAA( p, p1 ) INLINE ... и старое работает и новое есть. При исп. (хорошая команда) SETGET мы имеем чуть другое
Петр: SergKis пишет: Это аналог (как в псевдо ООП на препроцессоре) исп. o:Show и o:Show() Т.е. ради сомнительного синтаксического сиропа вы просто так добавили еще один метод, который и не нужен честно говоря. SergKis пишет: 1. Я скрыл, что вн. переменная имеет префикс oObj - хранение объектов 2. access\assign предполагает, что в дальнейшем, я должен использовать везде, в том числе и внутри класса От кого вы скрыли, oObj находится в PROTECTED и не может использоваться вне класса. Но я, вообще-то, не о том. Вот как только вы открыли свой код для других можете быть уверенны, что кто-то воспользуется не так как надо. Почему в ASSIGN нет никаких проверок и в чем прикол хранить в переменной обьекта ссылку на сам обьект? SergKis пишет: Не очень понимаю вопрос. Делал так, по причине, не привязываться к ф-ии hb_mtvm() внутри класса, не знаю как она называется в xhb, но главное, считаю (во многих случаях), что в среде vmmt, вполне можно работать без совместного доступа к классам - это в руках делающего программу. К примеру, если в потоке создаем окно с сопутствующими классами, то не х... лезть в него из др. потоков. Если очень надо, для этого есть сообщения, т.е. послали по handle и пусть идет ... А делать всегда совместный доступ - это удорожание продукта, трата времени и ... Это все ИМХО. Вы, я и др. не можем управлять многопоточностью в своей программе. Вот прилинковали соотв. библиотеку и от этого пляшем. Ну если вам так нужна эта lVmMt (мое мнение - не нужна ) то можно просто добавить, не раздувая класса CLASSVAR lVmMt INIT hb_mtvm() READONLY
SergKis: Петр пишет Т.е. ради сомнительного синтаксического сиропа вы просто так добавили еще один метод, который и не нужен честно говоря. Если вы считаете, что привыкнув писать с псевдо ООП .Show или .Show(), дадим только:Show(), нет вопросов убирайте. А "добавили еще один метод, который и не нужен честно говоря" - это из серии "сколько бухгалтеров столько и бухгалтерий". От кого вы скрыли, oObj находится в PROTECTED и не может использоваться вне класса. Вообще то, есть правила хорошего тона при программировании, сообщать, что хранится в веденной переменной. Введя o я сказал, что там объект и не надо делать операций проверок и не важно в какой области класса эта переменная. Что бы не было как TsColumn :nAlign - вроде для числа, а там и блоки и ...., про TsBrowse вообще молчу. Почему в ASSIGN нет никаких проверок и в чем прикол хранить в переменной обьекта ссылку на сам обьект? Про какое место разговор. если про TKeyData, то я написал "то в блоки кода метода Do(...) передается значение Obj, иначе Self. " и применил [pre2] METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar, lVmMt ) INLINE ( ; ::nIndex := nIndex , ::cName := cName, ::nHandle := nHandle, ; ::nParent := nParent, ::cType := cType, ::cVar := cVar, ; ::oCargo := oKeyData(), ::oUserKeys := oKeyData(), ; ::oEvent := oKeyData( Self ), ::MT := lVmMt, ; Self ) [/pre2] т.е. в блоки кода будет передан объект окна или контрола, а не только свой Self. Вы можете иметь свой объект, иметь набор блоков для исполнения с каким то др. объектом, вы можете выполнить те же блоки со своим, сделав o:Obj := <ваш объект> CLASSVAR lVmMt INIT hb_mtvm() READONLY Я сказал ранее, повторю, не хочу связывать объект с функцией hb_mtvm(), т.к. это связывает руки при использовании класса. Я, к примеру, в потоках не буду использовать совместно данные объектов, т.е. даже в vmmt у меня будет всегда .F. Я предлагал _HMG_MainCargo := oKeyData() _HMG_MainCargo:Set('bFormInit', Nil) _HMG_MainCargo:Set('bFormDestroy', Nil) _HMG_MainCargo:Set('bControlInit', Nil) _HMG_MainCargo:Set('bControlDestroy', Nil) можно подправить и добавить _HMG_MainCargo := oKeyData( , hb_mtvm()) _HMG_MainCargo:Set('lModeVmMt', .F.) или hb_mtvm() и в функциях oWndData, oKeyData заменить Default lVmMt := _HMG_MainCargo:Get('lModeVmMt') ...
Петр: SergKis пишет: Если вы считаете, что привыкнув писать с псевдо ООП .Show или .Show(), дадим только:Show(), нет вопросов убирайте. Кто вам сказал, что все убегут с псевдо на ООП? Вы используйте рационально ресурсы компьютера и все, всех остальных компилятор быстро научит "родину любить". SergKis пишет: Вообще то, есть правила хорошего тона при программировании, сообщать, что хранится в веденной переменной. Введя o я сказал, что там объект и не надо делать операций проверок и не важно в какой области класса эта переменная. Что бы не было как TsColumn :nAlign - вроде для числа, а там и блоки и ...., про TsBrowse вообще молчу. Венгерская нотация еще никому ничего не гарантировала, тем более в нетипизированных языках. В METHOD Destroy() CLASS TKeyData тогда зачем проверок напихали? Может опять какой то префикс замутить и хватит. Типа VAR aKey INIT hb_Hash() Так, что за необходимость хранить в переменной обьекта ссылку на сам обьект? ASSIGN Obj( o ) INLINE ::oObj := iif( HB_ISOBJECT(o), o, Self ) SergKis пишет: если про TKeyData, то я написал "то в блоки кода метода Do(...) передается значение Obj, иначе Self. " и применил METHOD Def Ну написали, я прочитал и что? Почему так "кучеряво" написали? Я сказал ранее, повторю, не хочу связывать объект с функцией hb_mtvm(), т.к. это связывает руки при использовании класса. Я, к примеру, в потоках не буду использовать совместно данные объектов, т.е. даже в vmmt у меня будет всегда .F. Какие руки (oHand?), каким образом? Эта функция линкуется в любой harbour бинарник при использовании ключа -mt. Прямой ее вызов в нужном месте "дешевле" хранения стандартных переменных и тем более переменных обьекта, не говоря про методы ACCESS MT INLINE ::lMT ASSIGN MT( lVmMt ) INLINE ::lMT := iif( HB_ISLOGICAL(lVmMt), lVmMt, .F. ) Вот вы не собираетесь использовать, я тоже, если Андрею придется использовать TKeyData в mt режиме и у него будет .T., может он рассчитывать на безопасность этого класса? И если да, то чем вы ее обеспечили?
SergKis: Петр пишет Венгерская нотация еще никому ничего не гарантировала, тем более в нетипизированных языках Так, что за необходимость хранить в переменной обьекта ссылку на сам обьект? Ну написали, я прочитал и что? Почему так "кучеряво" написали? ASSIGN Obj( o ) INLINE ::oObj := iif( HB_ISOBJECT(o), o, Self ) как раз и гарантирует "венгерскую нотацию", обеспечивая в переменной объект. o := oKeyData({||...}) или o:Obj := {||...} кроме объекта иное не пройдет. потому везде смело работайте с o:Obj как с объектом, без проверок типов. Объсню "кучерявость". Смысл :Obj в том, что он передается в блок кода, который зарегистририван в :aKey (их, блоков, может быть много). Если менять в :Obj ссылку с Self на ссылку др. объекта, то блоки, при выполнении, будут получать уже этот объект по ссылке. Т.е. когда создается объект TWndData\TCnlData, работает метод :Def(...), создаются объекты контейнеры CLASSDATA oName INIT oKeyData() CLASSDATA oHand INIT oKeyData() ::oCargo := oKeyData() ::oUserKeys := oKeyData() для этих в :Obj будет собственный адрес объекта Self ::oEvent := oKeyData( Self ) этот занесет в :Obj значения адреса объекта, в зависимости от того, какой объект создается TWndData или TCnlData. Таким образом решается вопрос передачи в события нужного объекта, т.е. блоки коды событий, зарегистрированные на окно, получат объект своего окна. К примеру события окна win_1 получат, в блоке кода, ссылку на объект win_1, для win_2 и т.д. будет тоже самое, т.е. доступны o:Index, o:Handle, o:Name, ... окна. Точно так же работают зарегестрированные события (блоки кода) и на контролах, т.е в блоке кода будет объект собственного контрола, т.е. доступны o:Index, o:Handle, o:Name, ... контрола. Это основное предназначение :Obj. Но можно делать и так: Пример. Имеем oBrw1 на окне 1, он решает задачи (в блоках кода), зарегистированные в o := oKeyData(oBrw1) o:Set("Ras4et1", {|ob,ky| ... }) o:Set("Ras4et2", {|ob,ky| ... }) o:Set("Ras4et3", {|ob,ky| ... }) ... На каких то событиях, а может просто где то, используем: в oBrw1 ставим нужные пользователю scope, filter ... и считаем o:Do("Ras4et1", {|ob,ky| ... }) o:Do("Ras4et2", {|ob,ky| ... }) o:Do("Ras4et3", {|ob,ky| ... }) результаты куда то отправляем На др. окнах тот же тсб будет иметь имя oBrw2 или другое, сделав o:Obj := oBrw2 можно выполнять теже блоки, они получат ссылку на объект oBrw2. ... С любым обектом можете проделать такое же. Даже объект TaskDialog можно передать. В METHOD Destroy() CLASS TKeyData тогда зачем проверок напихали? Если использовали :Cargo как oKeyData(), я проделываю все как с :aKey. Для hb хватило бы и o := Nil или уничтожение локальной переменной, приводило бы к автоматическому вызову :Destroy(). Но в xhb, от вас узнал, этого нет, поэтому, как вы говорите, "понапихал" принудительные вызовы Destroy(), значит возможны "лишние" вызовы, это просто учтено в Destroy(). [pre2] METHOD GetListType() CLASS TWndData LOCAL oType := oKeyData() LOCAL aType := {} ::oName:Eval({|k,o,i| k := i, oType:Set(o:cType, o:cType) }) oType:Eval({|k,v,i| k := i, aAdd(aType, v) }) oType:Destroy() oType := Nil RETURN aType [/pre2] выделенное для hb можно не делать Эта функция линкуется в любой harbour бинарник при использовании ключа -mt Прямой ее вызов в нужном месте "дешевле" хранения стандартных переменных и тем более переменных обьекта Причем здесь линкование hb_mtvm() ? Если я, сделаю, как вы предлагали, зашить в класс hb_mtvm CLASSVAR lVmMt INIT hb_mtvm() READONLY Возможно, что вы что то удешивили, но получили только 2-а состояния .T. и .F. А, я, хотел получить ИМЕННО внешнее управление, что бы при hb_mtvm() .T., поставить в объект окна\контрола - .F. Причем здесь "дешевле", если это удобно, минимум ЧЕЛОВЕЧЕСКИХ затрат и решаются просто, это так же относится и .Show, .Show(), :Show, :Show(), ... . Что вы пытаетесь экономить ? Все классы hb просто небольшие, в сравнении с классами VO со строгим стилем программирования. Программы VO как и clipper шустро работали на очень слабеньких машинах. Вот вы не собираетесь использовать, я тоже, если Андрею придется использовать TKeyData в mt режиме и у него будет .T., может он рассчитывать на безопасность этого класса? И если да, то чем вы ее обеспечили? Я был бы рад, сказать, Я ОБЕСПЕЧИЛ ...), но к радости это обеспечивает hb, вернее SYNC METHOD ... . hb обеспечивает синхронизацию выполнения мтодов в потоках (на мутексах). Потому с классом TKeyData должно быть все хорошо в mt, синхронизированный метод доступа к контейнеру :aKey организован. Следовательно и TWndData, TCnlData что касается работы с контейнерами - будет нормально, а что касается вызовов функций в hmg методах класса - это как было. Работу hmg классами я не затрагивал. Как было, так осталось. Делал Андрей в WaitWindow_2 в потоке окно ... это я ничего не трогал и безопасность не обеспечивал.
Петр: SergKis пишет: Если я, сделаю, как вы предлагали, зашить в класс hb_mtvm CLASSVAR lVmMt INIT hb_mtvm() READONLY Возможно, что вы что то удешивили, но получили только 2-а состояния .T. и .F. А, я, хотел получить ИМЕННО внешнее управление Петр пишет: Ну если вам так нужна эта lVmMt (мое мнение - не нужна ) то можно просто добавить, не раздувая класса А можно добавить в EXPORTED секцию VAR lVmMt INIT что-то там и иметь внешнее управление, в большинстве случаев в Clipper так и работали. Причем здесь "дешевле", если это удобно, минимум ЧЕЛОВЕЧЕСКИХ затрат и решаются просто, это так же относится и .Show, .Show(), :Show, :Show(), ... . :Show и :Show() - разницу в затратах ЧЕЛОВЕЧЕСКИХ определите? Есть ведь еще сопровождение и там затраты ничуть не меньше. Каждый раз в исходники лезть не очень то и комфортно. METHOD GetListType() CLASS TWndData LOCAL oType := oKeyData() LOCAL aType := {} ::oName:Eval({|k,o,i| k := i, oType:Set(o:cType, o:cType) }) oType:Eval({|k,v,i| k := i, aAdd(aType, v) }) oType:Destroy() oType := Nil RETURN aType выделенное для hb можно не делать В GetListType oType нафиг не нужен, он там за уши притянут, как и большинство ваших ASSIGN/ACCESS.
SergKis: Петр пишет нафиг не нужен, он там за уши притянут, как и большинство ваших ASSIGN/ACCESS Давайте определимся, класс TaskDialog не типизированный, т.е. работаем как в Clipper и др. не типизированных языках, т.е. убрав все методы SETGET в классе ничего не изменится, как был не типизированным, так и остался. Представленные классы написаны в строго типизированном стиле, где доступы к переменным осуществляются через ACCESS\ASSIGN (методы и там и там) и объявления переменных должны быть типизированы. Последнее пока не сделал (только для объектов AS OBJECT сделал) из за метода Destroy(). Если пропишу AS STRING, AS NUMERIC, AS LOGIC, то в Destroy() должен присваивать не NIL, а соответсвующие объявлению значения, в hb я не знаю хорошо ли в Destroy() сделать ::cName := "", ::nHandle := 0, ... подвиснут или уберутся. Потому предложение убрать ACCESS\ASSIGN или заменить на SETGET переведет класс в не типизированный. Если бы я этого хотел, так писал сразу. Да, набирать классы начинал не типизированными, но постепенно переводил в строгую типизацию. А можно добавить в EXPORTED секцию VAR lVmMt INIT что-то там и иметь внешнее управление, в большинстве случаев в Clipper так и работали. Даже, если вы так сделаете, все равно придется добавлять метод для установления свойства :MT в объектах TKeyData (тут ASSIGN, у вас может SETGET или просто метод) [pre2] ASSIGN MT( lVmMt ) INLINE ( ::lMT := iif( HB_ISLOGICAL(lVmMt), lVmMt, .F. ), ; ::oName:MT := ::lMT, ::oHand:MT := ::lMT, ; ::oCargo:MT := ::lMT, ::oEvent:MT := ::lMT, ; ::oUserKeys:MT := ::lMT ) [/pre2] :Show и :Show() - разницу в затратах ЧЕЛОВЕЧЕСКИХ определите? Есть ведь еще сопровождение и там затраты ничуть не меньше. Каждый раз в исходники лезть не очень то и комфортно. В данном случае, вы определили только программистские затраты и не учли затраты эксплуатационные. Т.е. не дали :Show. Пользователь hmg, неважно каким способом, написал где то в одном месте так. Проверял ..., (что бы все режимы проверить, возможно, надо держать человека или группу), но отвлекли, ..., пропустил. Ушло в эксплуатацию, режим с ошибкой редкий, раз в месяц. И как, бутерброд с маслом, вылезет в неподходящее время. И что дороже, продублировать несколько строк, в каждой исправив несколько букв или заложить мину ? Я говорю о данном случае, а не вообще ... . В GetListType oType нафиг не нужен Предложите реализацию получения уникального списка типов по другому. Я сделал так.
Andrey: Петр да помоги написать как нужно и всех делов то... Меньше ругани - больше дела !
Петр: Andrey пишет: Петр да помоги написать как нужно и всех делов то... Кому от этого легче станет? Пускай человек учится..
Петр: Петр пишет: через ACCESS\ASSIGN (методы и там и там) и объявления переменных должны быть типизированы. Последнее пока не сделал (только для объектов AS OBJECT сделал) из за метода Destroy(). Если пропишу AS STRING, AS NUMERIC, AS LOGIC, то в Destroy() должен присваивать не NIL, а соответсвующие объявлению значения, в hb я не знаю хорошо ли в Destroy() сделать ::cName := "", ::nHandle := 0, ... подвиснут или уберутся. Потому предложение убрать ACCESS\ASSIGN или заменить на SETGET переведет класс в не типизированный. Если бы я этого хотел, так писал сразу. Да, набирать классы начинал не типизированными, но постепенно переводил в строгую типизацию. Значит класс не закончен и смотреть не на что. И не пишите, пожалуйста, то чего не знаете - я не знаю как на это реагировать, ну типа плакать или смеяться Я привел вам пример (destruct.prg) - там и деструктор и неявный конструктор init.. Там (папка tests) есть и другие примеры, например, реализация FOREACH, OPERATOR для классов - очень даже интересно.
gfilatov2002: Завершена подготовка новой сборки 17.06 для BCC 5.51 (Harbour и xHarbour) , которая будет опубликована завтра. Под заказ возможно сделать индивидуальные сборки для таких дополнительных С-компиляторов: - MinGW 7.1.0 32-bit и Harbour 3.4.0dev; - MinGW 7.1.0 64-bit и Harbour 3.4.0dev; - MS VisualC 2015 32-bit и Harbour 3.2.0dev; - MS VisualC 2017 32-bit и Harbour 3.2.0dev; - BCC 10.1 32-bit и Harbour 3.2.0dev; - PellesC 8.0 32-bit и xHarbour 1.2.3 build 10194. Благодарю за Ваше внимание
gfilatov2002: Опубликована очередная сборка 17.06 для BCC 5.51 (Harbour и xHarbour) Базовый дистрибутив лежит по адресу http://hmgextended.com/files/CONTRIB/hmg-17.06-setup.exe Благодарю за Ваше внимание и помощь в подготовке этой сборкм
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]
gfilatov2002: И еще файл h_objmisc.prg [pre2]/* * MINIGUI - Harbour Win32 GUI library source code * */ #include "minigui.ch" *-----------------------------------------------------------------------------* FUNCTION _WindowCargo( FormName, xValue ) *-----------------------------------------------------------------------------* #ifdef _OBJECT_ LOCAL o := iif( HB_ISOBJECT( FormName ), FormName, _WindowObj( FormName ) ) LOCAL i := iif( HB_ISOBJECT( o ), o:Index, GetFormIndex( FormName ) ) #else LOCAL i := GetFormIndex( FormName ) #endif IF i > 0 IF PCount() > 1; _HMG_aFormMiscData2[ i ] := xValue Else ; RETURN _HMG_aFormMiscData2[ i ] ENDIF ENDIF RETURN NIL *-----------------------------------------------------------------------------* FUNCTION _ControlCargo( ControlName, FormName, xValue ) *-----------------------------------------------------------------------------* #ifdef _OBJECT_ LOCAL o := iif( HB_ISOBJECT( ControlName ), ControlName, _ControlObj( ControlName, FormName ) ) LOCAL i := iif( HB_ISOBJECT( o ), o:Index, GetControlIndex( ControlName, FormName ) ) #else LOCAL i := GetControlIndex( ControlName, FormName ) #endif IF i > 0 IF PCount() > 2; _HMG_aControlMiscData2[ i ] := xValue Else ; RETURN _HMG_aControlMiscData2[ i ] ENDIF ENDIF RETURN NIL #ifdef _OBJECT_ *-----------------------------------------------------------------------------* FUNCTION _WindowObj( FormName ) *-----------------------------------------------------------------------------* LOCAL h := iif( HB_ISNUMERIC( FormName ), FormName, GetFormHandle( FormName ) ) RETURN hmg_GetWindowObject( h ) *-----------------------------------------------------------------------------* FUNCTION _ControlObj( ControlName, FormName ) *-----------------------------------------------------------------------------* LOCAL h := iif( HB_ISNUMERIC( ControlName ), ControlName, ; GetControlHandle( ControlName, FormName ) ) RETURN hmg_GetWindowObject( h ) *-----------------------------------------------------------------------------* 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 o 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 nCtlIndex := i LOCAL cCtlName := _HMG_aControlNames[ i ] LOCAL nHandle := iif( ISARRAY( _HMG_aControlHandles[ i ] ), ; _HMG_aControlHandles[ i ][ 1 ], _HMG_aControlHandles[ i ] ) LOCAL nParent := _HMG_aControlParentHandles[ i ] LOCAL cFormName := GetParentFormName( i ) LOCAL cCtlType := iif( Empty( cFormName ), _HMG_aControlType[ i ], ; GetProperty( cFormName, cCtlName, "Type" ) ) RETURN oCnlData( nCtlIndex, cCtlName, nHandle, nParent, cCtlType, cVar ) *-----------------------------------------------------------------------------* FUNC Do_OnCtlRelease( i, p ) *-----------------------------------------------------------------------------* LOCAL o LOCAL hWnd := _HMG_aControlHandles[ i ] IF hmg_IsWindowObject( hWnd ) .AND. _HMG_aFormType[ p ] != 'M' 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_OnCtlLaunch( 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 <mgdefs.h> #include "hbapiitm.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 ); 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 #endif [/pre2] Возможно, Вы захотите указать также свой копирайт в этих файлах
SergKis: gfilatov2002 небольшие изменения [pre2] h_objmisc.prg было FUNC Do_OnCtlInit( i, cVar ) стало FUNC Do_OnCnlInit( i, cVar ) было FUNC Do_OnCtlRelease( i, p ) стало FUNC Do_OnCnlRelease( i, p ) проглядел t вместо n. Контрол это Cnl был, а Ctl вроде как каталог ? h_object.prg CLASS TWndData ... VAR cChr INIT ',' VAR oOnEventBlock AS OBJECT CLASSDATA oProp AS OBJECT INIT oKeyData() ... METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ... ::oEvent := oKeyData( Self ), ; ::oOnEventBlock := oKeyData(Self, .T.), ; hmg_SetWindowObject( ::nHandle, Self ), ; Self ) ... ASSIGN Chr( cChr ) INLINE ::cChr := iif( HB_ISCHAR( cChr ), cChr, ::cChr ) ACCESS bOnEvent INLINE ::oOnEventBlock ACCESS WM_nMsgW INLINE WM_WND_LAUNCH ... // Destructor 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 ) #ifdef __XHARBOUR__ ... CLASS TCnlData INHERIT TWndData ... // Destructor 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 ) #ifdef __XHARBOUR__ ... CLASS TTsbData INHERIT TCnlData ... ACCESS Tsb INLINE ::oTBrowse METHOD OnEvent( nMsg, wParam, lParam ) INLINE ::Tsb:HandleEvent( nMsg, wParam, lParam ) METHOD Destroy() INLINE ::oTBrowse := ::Super:Destroy() ENDCLASS CLASS TWmEData ... METHOD Do( nMsg, wParam, lParam ) CLASS TWmEData ... IF HB_ISBLOCK( b ) o := ::oObj IF o:IsWindow ... если надо, пусть будет Copyright 2017 Aleksandr Belov, Sergej Kiselev <bilance@bilance.lv> или <clipper.borda.ru> [/pre2] Пока остановлюсь с изменениями, надо посмотреть что получилось в реальности.
gfilatov2002: SergKis пишет: Контрол это Cnl был, а Ctl вроде как каталог ? Нет, это было сделано намеренно. Сокращение Ctl используется для обозначения контрола (см. название системной библиотеки comctl32.dll) SergKis пишет: VAR oOnEventBlock AS OBJECT Благодарю! Уже сделал эти правки - посмотрел в Вашем описании работы с классами SergKis пишет: METHOD Destroy() INLINE ( ::Del(), Этот метод также уже поправил ... SergKis пишет: Copyright 2017 Aleksandr Belov, Sergej Kiselev <bilance@bilance.lv>
SergKis: gfilatov2002 Можно ли добавить в TsBrowse переменную для запрета работы метода KeyChar(...) ? [pre2] VAR lNoKeyChar INIT .F. и METHOD KeyChar( nKey, nFlags ) CLASS TSBrowse ... Default ::nUserKey := nKey If ::nUserKey == 255 .or. :lNoKeyChar // from KeyDown() method Return 0 EndIf If ::lAppendMode ... [/pre2] мучить все время :nUserKey := 255 неудобно.
gfilatov2002: SergKis пишет: Можно ли добавить в TsBrowse переменную для запрета работы метода KeyChar Благодарю за предложение! Если надо, то, конечно, добавлю
SergKis: gfilatov2002 пишет Если надо, то, конечно, добавлю Это надо при работе с ячейками и lEdit := .T., но не надо вкл. Edit от нажатий цифр\букв.
gfilatov2002: SergKis пишет: Это надо при работе с ячейками и lEdit := .T. Понятно, я уже добавил этот переключатель
SergKis: gfilatov2002 Предложение [pre2] h_controlmisc.prg *-----------------------------------------------------------------------------* FUNCTION GetControlIndex ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* LOCAL mVar IF HB_ISNUMERIC ( Index ); RETURN Index ENDIF mVar := '_' + ParentForm + '_' + ControlName IF __mvExist ( mVar ) RETURN __mvGet ( mVar ) ENDIF RETURN 0 *-----------------------------------------------------------------------------* FUNCTION GetControlName ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* LOCAL i IF ( i := GetControlIndex ( ControlName, ParentForm, Index ) ) == 0 RETURN '' ENDIF RETURN ( _HMG_aControlNames [ i ] ) *-----------------------------------------------------------------------------* FUNCTION GetControlHandle ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* LOCAL i IF ( i := GetControlIndex ( ControlName, ParentForm, Index ) ) == 0 MsgMiniGuiError ( "Control " + ControlName + " Of " + ParentForm + " Not defined." ) ENDIF RETURN ( _HMG_aControlHandles [ i ] ) *-----------------------------------------------------------------------------* FUNCTION GetControlContainerHandle ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* LOCAL i IF ( i := GetControlIndex ( ControlName, ParentForm, Index ) ) == 0 RETURN 0 ENDIF RETURN ( _HMG_aControlContainerHandle [ i ] ) *-----------------------------------------------------------------------------* FUNCTION GetControlParentHandle ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* LOCAL i IF ( i := GetControlIndex ( ControlName, ParentForm, Index ) ) == 0 RETURN 0 ENDIF RETURN ( _HMG_aControlParentHandles [ i ] ) *-----------------------------------------------------------------------------* FUNCTION GetControlId ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* LOCAL i IF ( i := GetControlIndex ( ControlName, ParentForm, Index ) ) == 0 RETURN 0 ENDIF RETURN ( _HMG_aControlIds [ i ] ) *-----------------------------------------------------------------------------* FUNCTION GetControlType ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* LOCAL i IF ( i := GetControlIndex ( ControlName, ParentForm, Index ) ) == 0 RETURN '' ENDIF RETURN ( _HMG_aControlType [ i ] ) *-----------------------------------------------------------------------------* FUNCTION GetControlValue ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* LOCAL i IF ( i := GetControlIndex ( ControlName, ParentForm, Index ) ) == 0 RETURN Nil ENDIF RETURN ( _HMG_aControlValue [ i ] ) *-----------------------------------------------------------------------------* FUNCTION GetControlPageMap ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* LOCAL i IF ( i := GetControlIndex ( ControlName, ParentForm, Index ) ) == 0 RETURN {} ENDIF RETURN ( _HMG_aControlPageMap [ i ] ) *-----------------------------------------------------------------------------* FUNCTION _SetFocus ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* LOCAL MaskStart As Numeric // LOCAL H , T , x , i , ControlCount , ParentFormHandle LOCAL H , T , x , ControlCount , ParentFormHandle LOCAL i := GetControlIndex ( ControlName, ParentForm, Index ) H := GetControlHandle( ControlName, ParentForm, i ) T := GetControlType ( ControlName, ParentForm, i ) // i := GetControlIndex ( ControlName, ParentForm ) ... *-----------------------------------------------------------------------------* FUNCTION _DisableControl ( ControlName , ParentForm , nPosition, Index ) *-----------------------------------------------------------------------------* // LOCAL T , c , y , s , z , w LOCAL T , c , s , z , w LOCAL y := GetControlIndex ( ControlName, ParentForm, Index ) T := GetControlType ( ControlName, ParentForm, y ) c := GetControlHandle ( ControlName, ParentForm, y ) // y := GetControlIndex ( ControlName, ParentForm ) ... *-----------------------------------------------------------------------------* FUNCTION _EnableControl ( ControlName , ParentForm , nPosition, Index ) *-----------------------------------------------------------------------------* // LOCAL t , c , y , s , z , w LOCAL t , c , s , z , w LOCAL y := GetControlIndex ( ControlName, ParentForm, Index ) T := GetControlType ( ControlName, ParentForm, y ) c := GetControlHandle ( ControlName, ParentForm, y ) // y := GetControlIndex ( ControlName, ParentForm ) ... *-----------------------------------------------------------------------------* FUNCTION _ShowControl ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* // LOCAL t, i, c, w, s, y, z, r LOCAL t, i, c, w, s, z, r LOCAL y := GetControlIndex ( ControlName, ParentForm, Index ) LOCAL TabHide := .F. T := GetControlType ( ControlName, ParentForm, y ) c := GetControlHandle ( ControlName, ParentForm, y ) // y := GetControlIndex ( ControlName, ParentForm ) ... *-----------------------------------------------------------------------------* FUNCTION _HideControl ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* // LOCAL t, c, y, r, w, z LOCAL t, c, r, w, z LOCAL y := GetControlIndex ( ControlName, ParentForm, Index ) T := GetControlType ( ControlName, ParentForm, y ) c := GetControlHandle ( ControlName, ParentForm, y ) // y := GetControlIndex ( ControlName, ParentForm ) ... *-----------------------------------------------------------------------------* FUNCTION _SetPicture ( ControlName, ParentForm, FileName, Index ) *-----------------------------------------------------------------------------* // LOCAL w, h, t, i, c, cImage, oGet LOCAL w, h, t, c, cImage, oGet LOCAL i := GetControlIndex ( ControlName, ParentForm, Index ) c := GetControlHandle ( ControlName, ParentForm, i ) // i := GetControlIndex ( ControlName, ParentForm ) t := GetControlType ( ControlName, ParentForm, i ) ... *-----------------------------------------------------------------------------* FUNCTION _GetPicture ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* LOCAL i := GetControlIndex ( ControlName, ParentForm, Index ) ... [/pre2] Если это интересно, можно еще поискать места.
gfilatov2002: SergKis пишет: Предложение Я понимаю Вашу логику, чтобы добавить дополнительный параметр Index, как это сделано в функциях _getvalue() и _setvalue() Но без острой необходимости не хотелось бы усложнять существующую логику, которая опирается на использование только ControlName и ParentForm параметров в большинстве других внутренних функций. Поэтому пока Ваше предложение не принято...
SergKis: gfilatov2002 пишет не хотелось бы усложнять существующую логику, которая опирается на использование только ControlName и ParentForm параметров в большинстве других внутренних функций Основной целью предложения - это исп. в классах, т.к. там индекс известен и сразу может указываться в вызовах.
gfilatov2002: SergKis Возник вопрос после небольшой проверки использоапния ООП в базовом примере MAIN_DEMO. Добавил в главное меню такую строчку ITEM 'ALL TYPE' ACTION MsgDebug( (ThisWindow.Object):GetListType(), 'ALL TYPE' ) После запуска примера эта команда показывает используемые типы элементов управления главного окна, как и ожидалось. Но еслм, напрмер, открыть и затем закрыть дочернее окно из пункта меню 'More Tests', то все эти элементы управления, которые показывала добавленная в меню команда, стираются из переменной ::oName В чем состоит моя ошибка и как это исправить
SergKis: gfilatov2002 пишет В чем состоит моя ошибка и как это исправить тут моя ошибка, красным лишнее (убираться должно только в destroy() окна) [pre2] CLASS TCnlData INHERIT TWndData ... // Destructor 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 )[/pre2]
SergKis: PS Я сейчас в Питере и что бы что то смотреть, нужна Ваша сборка hmg, с собой у меня мало что есть.
gfilatov2002: SergKis пишет: убираться должно только в destroy() окна Благодарю за исправление! Сейчас после закрытия дочерних окон все в порядке Но если вызвать окно предварительного просмотра печати из главного окна, то после закрытия этого окна просмотра снова будет стерто содержимое переменной ::oName SergKis пишет: нужна Ваша сборка hmg Завтра отправлю ссылку на Ваш почтовый адрес <bilance[at]bilance.lv>
SergKis: gfilatov2002 пишет Завтра отправлю ссылку на Ваш почтовый адрес <bilance[at]bilance.lv> Лучше в личку, почты с собой нет, с работой общаюсь, через ftp
gfilatov2002: SergKis пишет: Лучше в личку Отправил ссылку ы Л.С.
SergKis: gfilatov2002 пишет Отправил ссылку ы Л.С. Спасибо, забрал и по ситуации с FUNCTION PRINTPIE, где печать Preview, можно глубже лезть, но, возможно есть еще окна такого типа, предложение для них делать, как я сделал в примере:[pre2] *------------------------------------------------------------------------------* FUNCTION PRINTPIE *------------------------------------------------------------------------------* ... LOCAL lOOP := _HMG_lOOPEnabled If lOOP SET OOP OFF EndIf SET FONT TO _GetSysFont() , 8 ... SET FONT TO _GetSysFont() , GetDefaultFontSize() If lOOP SET OOP ON EndIf RETURN NIL и в таком случае, немного подправить команду SET OOP <еще от переменной, кроме ON\OFF> еще предложение добавить функцию *------------------------------------------------------------------------------* FUNC Do_Obj( nHandle, bBlock, p1, p2, p3 ) *------------------------------------------------------------------------------* LOCAL o If hmg_IsWindowObject(nHandle) o := hmg_GetWindowObject(nHandle) If HB_ISBLOCK(bBlock) RETURN Eval( bBlock, o, p1, p2, p3 ) EndIf Endif RETURN o т.е. объект независимо от ф-ий _ControlObj(...), _WindowObj(...), определяем в блоке кода принадлежность IsWindow\IsControl [/pre2]
SergKis: PS Добавил в пример [pre2] @ 140,10 BUTTONEX Button_00 ; CAPTION 'Capture Form' ; ON CLICK SaveWindow ( 'Form_1' ) ; TOOLTIP 'Save Form to BMP file' @ 140,10+This.Button_00.Width+2 BUTTONEX Button_000 ; CAPTION 'All Type' ; ON CLICK MsgDebug( (This.Object):GetListType(), 'ALL TYPE' ) ; WIDTH 80 ; TOOLTIP 'All type for window' @ 170,10 BUTTONEX Button_0 ; [/pre2] Для демонстрации наследования. Т.е. в контроле применяем метод прописанный в окне. Списки (:GetListType(), :GetObj4Type( cType, lEque ), :GetObj4Name( cName )) можно получать и на контролах
gfilatov2002: SergKis пишет: немного подправить команду SET OOP <еще от переменной Добавил новую команду SET OOP TO <lOOP> SergKis пишет: еще предложение добавить функцию Добавил, конечно. Благодарю за помощь
SergKis: gfilatov2002 Думаю, я был не прав с [pre2] FUNCTION _ReleaseWindow ( FormName ) ... FormHandle := _HMG_aFormHandles [ i ] * Release Window // с этой вставкой IF _HMG_lOOPEnabled Eval ( _HMG_bOnFormDestroy, i ) ENDIF IF _HMG_aFormType [ i ] == 'M' .AND. _HMG_ActiveModalHandle <> FormHandle ... т.к. далее идет PostMessage ( FormHandle, WM_CLOSE, 0, 1 ) а в Events(...) CASE WM_CLOSE ... есть обработка SWITCH _HMG_InteractiveClose т.е. может быть отказ от закрытия окна. поэтому, выделенный код, надо, перенести в Events() line 3378 ELSE IF ISBLOCK( _HMG_aFormReleaseProcedure [ i ] ) _HMG_InteractiveCloseStarted := .T. _DoWindowEventProcedure ( _HMG_aFormReleaseProcedure [ i ] , i , 'WINDOW_RELEASE' ) ENDIF _hmg_OnHideFocusManagement ( i ) // эта строка сначала или выделенный код ниже ? т.е поменять местами ? IF _HMG_lOOPEnabled Eval ( _HMG_bOnFormDestroy, i ) ENDIF ENDIF ... тогда в FUNC Do_OnCtlRelease( i, p ) можно убрать IF hmg_IsWindowObject( hWnd ) // .AND. _HMG_aFormType[ p ] != 'M' [/pre2]
полная версия страницы