Автор | Сообщение |
gfilatov
|
| модератор
|
Пост N: 699
Зарегистрирован: 25.05.05
|
|
Отправлено: 29.01.08 13:59. Заголовок: Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
| |
|
Ответов - 300
, стр:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
All
[только новые]
|
|
gfilatov2002
|
| moderator
|
Пост N: 1016
Зарегистрирован: 11.02.10
|
|
Отправлено: 19.10.16 21:37. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Инсталляторы для других Си-компиляторов обновлю позже |
| Выложил исталляторы сборки 16.10 для остальных Си-компиляторов (прямые ссылки есть на сайте библиотеки).
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5143
Зарегистрирован: 12.09.06
|
|
Отправлено: 20.10.16 12:21. Заголовок: Привет всем. На ново..
Привет всем. На новой версии перестала работать команда: 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
|
| moderator
|
Пост N: 1017
Зарегистрирован: 11.02.10
|
|
Отправлено: 20.10.16 12:42. Заголовок: Andrey пишет: На но..
Andrey пишет: цитата: | На новой версии перестала работать команда |
| Эта команда уже работает в исправленной сборке 16.10 Надо просто еще раз скачать и установить эту сборку заново...
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5144
Зарегистрирован: 12.09.06
|
|
Отправлено: 20.10.16 13:39. Заголовок: Да, в исправленной в..
Да, в исправленной версии ошибка ушла ! Спасибо ! Но теперь потерялась функция: //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
|
| moderator
|
Пост N: 1018
Зарегистрирован: 11.02.10
|
|
Отправлено: 20.10.16 13:50. Заголовок: Andrey пишет: Но те..
Andrey пишет: цитата: | Но теперь потерялась функция |
| Она была переименована Петром в _SetWindowBKBrush() и является внутренней функцией. Т.е. прямое ее использование не рекомендуется, для этого есть соответствующая команда
| |
|
Петр
|
| постоянный участник
|
Пост N: 1310
Зарегистрирован: 09.10.06
|
|
Отправлено: 20.10.16 14:06. Заголовок: Andrey пишет: Замен..
Andrey пишет: цитата: | Замена на PICTURE: DEFINE BKGBRUSH Brush_1 PATTERN IN Form_1 PICTURE Skin\background.bmp ошибку не убирает.. |
| Ошибка в changelog Смотрите обновленный синтаксис в i_brush.ch #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> ] ; => и базовый пример SAMPLES\BASIC\WindowBackground\demo.prg SAMPLES\BASIC\WindowBackground_2\demo.prg тоже м.б. интересным
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5145
Зарегистрирован: 12.09.06
|
|
Отправлено: 20.10.16 18:43. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Т.е. прямое ее использование не рекомендуется, для этого есть соответствующая команда |
| Понял. Давно сделал, так и использовал в некоторых исходниках. Петр пишет: цитата: | и базовый пример SAMPLES\BASIC\WindowBackground\demo.prg |
| Поиск по DEFINE BKGBRUSH дал только 2 примера. А пример смотрел, там по другому уже. По синтаксису - понравилось лучше. Только в пример BASIC\WindowBackground_2\demo.prg нужно бы поставить кнопку смены заливки на лету !
| |
|
Петр
|
| постоянный участник
|
Пост N: 1313
Зарегистрирован: 09.10.06
|
|
Отправлено: 20.10.16 19:22. Заголовок: Andrey пишет: Тольк..
Andrey пишет: цитата: | Только в пример BASIC\WindowBackground_2\demo.prg нужно бы поставить кнопку смены заливки на лету ! |
| Суть примера в применении классов CURSOR, BKBRUSH при создании окна (DEFINE WINDOW). Все остальное "рюшечки" - и кнопка, и таймер, и генератор псевдо-случайных чисел - все это, как правило, лишь отвлекает от сути. И да, писать качественные, содержательные примеры - это нужно уметь, у меня не всегда получается.
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5146
Зарегистрирован: 12.09.06
|
|
Отправлено: 20.10.16 23:11. Заголовок: Петр пишет: Все ост..
Петр пишет: цитата: | Все остальное "рюшечки" - и кнопка, и таймер, и генератор псевдо-случайных чисел - все это, как правило, лишь отвлекает от сути. |
| Не всегда. Юзерам нравятся не унылые серые формы, а симпатичные. А кнопка смены заливки формы позволяет понять разработчику - как можно делать смену обоев на "лету" в окне. Я в своё время очень помучился с этим. Не помню уже чем и закончилось. И смена заливки тоже можно использовать для задачи - четко показывать юзеру смену задачи или меню. Петр пишет: цитата: | И да, писать качественные, содержательные примеры - это нужно уметь, у меня не всегда получается. |
| Классно получается ! Что интересно, всегда спросим !
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5147
Зарегистрирован: 12.09.06
|
|
Отправлено: 21.10.16 01:13. Заголовок: Теперь в новой верси..
Теперь в новой версии при выходе из моей программы получаю ошибку: 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 - ошибки нет.
| |
|
Петр
|
| постоянный участник
|
Пост N: 1314
Зарегистрирован: 09.10.06
|
|
Отправлено: 21.10.16 01:40. Заголовок: Andrey пишет: Form_..
Andrey пишет: Form_Main содержит меню или нет ? Andrey пишет: цитата: | Called from RELEASEALLWINDOWS(2127) |
| h_windows.prg замените сл. фрагмент IF IsExtendedMenuStyleActive() _OnDestroyMenu ( GetMenu ( _HMG_MainHandle ) ) // Release OwnerDraw Main Menu ENDIF на ... LOCAL hMenu ... hMenu := GetMenu ( _HMG_MainHandle ) IF IsExtendedMenuStyleActive() .AND. IsMenu( hMenu ) _OnDestroyMenu ( hMenu ) // Release OwnerDraw Main Menu ENDIF и, конечно, перекомпилируйте библиотеку
| |
|
|
Петр
|
| постоянный участник
|
Пост N: 1315
Зарегистрирован: 09.10.06
|
|
Отправлено: 21.10.16 01:42. Заголовок: Andrey пишет: Отка..
Andrey пишет: цитата: | Откатился на 16.09 - ошибки нет. |
| Видишь суслика? — Нет. — И я не вижу. А он есть!
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1019
Зарегистрирован: 11.02.10
|
|
Отправлено: 21.10.16 10:52. Заголовок: Петр пишет: h_windo..
Петр пишет: цитата: | h_windows.prg замените сл. фрагмент |
| Благодарю за помощь Добавил эту поправку в следующую сборку
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5148
Зарегистрирован: 12.09.06
|
|
Отправлено: 21.10.16 12:32. Заголовок: Петр пишет: Видишь ..
Петр пишет: цитата: | Видишь суслика? — Нет. — И я не вижу. А он есть! |
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1242
Зарегистрирован: 17.02.12
|
|
Отправлено: 25.10.16 10:28. Заголовок: gfilatov2002 Можно ..
gfilatov2002 Можно маленькую правку в TsBrowse 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 не наезжали друг на друга в колонке
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5152
Зарегистрирован: 12.09.06
|
|
Отправлено: 25.10.16 14:11. Заголовок: SergKis пишет: Можн..
SergKis пишет: цитата: | Можно маленькую правку в TsBrowse |
| Поддерживаю. Меня тоже это раздражает.
| |
|
Dima
|
| |
Пост N: 6063
Зарегистрирован: 17.05.05
|
|
Отправлено: 25.10.16 14:22. Заголовок: Совсем не обязательн..
Совсем не обязательно править сырец Делаю примерно так obrw:GetColumn("naim"):bPrevEdit := { |a, b, lLock| SetGetAdjustBrw(b,{2,0,-2,-3})...............
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5153
Зарегистрирован: 12.09.06
|
|
Отправлено: 25.10.16 14:26. Заголовок: Dima пишет: Совсем ..
Dima пишет: цитата: | Совсем не обязательно править сырец |
| Таблица по умолчанию должна быть правильной и красивой, без срезки колонок (как сейчас дата срезана) и т.д. Каждый раз не на исправляешься. Допилить всё можно, только времени своего жалко.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1243
Зарегистрирован: 17.02.12
|
|
Отправлено: 25.10.16 14:49. Заголовок: Dima пишет Делаю при..
Dima пишет цитата: | Делаю примерно так obrw:GetColumn("naim"):bPrevEdit := { |a, b, lLock| SetGetAdjustBrw(b,{2,0,-2,-3})............... |
| дело не в корректировке, на этапе отображения даты в колонки, правая цифра частично под линией
| |
|
Dima
|
| |
Пост N: 6064
Зарегистрирован: 17.05.05
|
|
Отправлено: 25.10.16 14:50. Заголовок: SergKis пишет: дело..
SergKis пишет: Точно. Сразу не сообразил
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1020
Зарегистрирован: 11.02.10
|
|
Отправлено: 25.10.16 15:00. Заголовок: SergKis пишет: на э..
SergKis пишет: цитата: | на этапе отображения даты в колонки, правая цифра частично под линией |
| Благодарю за наводку! Поправил эту бяку следующим образом: цитата: | nSize := Int( GetTextWidth( 0, cData + "B", hFont ) ) + If( lEditable, 30, 0 ) |
| Мой пример для проверки см. ниже Скрытый текст
#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
|
| |
|
|
SergKis
|
| постоянный участник
|
Пост N: 1244
Зарегистрирован: 17.02.12
|
|
Отправлено: 25.10.16 15:02. Заголовок: Dima пишет obrw:Get..
Dima пишет цитата: | obrw:GetColumn("naim"):bPrevEdit := { |a, b, lLock| SetGetAdjustBrw(b,{2,0,-2,-3})............... |
| Может с учетом Edit, надо не пробел, а ширину цифры или буквы добавлять ?
| |
|
Dima
|
| |
Пост N: 6065
Зарегистрирован: 17.05.05
|
|
Отправлено: 25.10.16 15:29. Заголовок: SergKis пишет: Може..
SergKis пишет: цитата: | Может с учетом Edit, надо не пробел, а ширину цифры или буквы добавлять ? |
| Сергей это ты мне или Григорию адресовал ? Если мне , то этот фокус нужен что бы при входе и последующем выходе из режима редактирования не съедалась сетка грида , по периметру ячейки.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1245
Зарегистрирован: 17.02.12
|
|
Отправлено: 25.10.16 15:37. Заголовок: Дима пишет Сергей эт..
Дима пишет цитата: | Сергей это ты мне или Григорию адресовал ? |
| Это пока я вопрос набирал, Григорий уже реализовал.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1246
Зарегистрирован: 17.02.12
|
|
Отправлено: 25.10.16 15:58. Заголовок: gfilatov2002 Вспомн..
gfilatov2002 Вспомнил (посмотрел), как делал в своей версии nSize := Int( GetTextWidth( 0, StrTran(CtoD(""), " ", "9")+"B", hFont ) ) + If( lEditable, 22, 0 )
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1247
Зарегистрирован: 17.02.12
|
|
Отправлено: 25.10.16 16:19. Заголовок: PS Уже заработался, ..
PS Уже заработался, у меня через xVal промежуточную, убирал и пропустил. cValToChar(xVal), т.е. nSize := Int( GetTextWidth( 0, StrTran(cValToChar(CtoD("")), " ", "9")+"B", hFont ) ) + If( lEditable, 22, 0 )
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1248
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.10.16 00:39. Заголовок: gfilatov2002 можно ..
gfilatov2002 можно пару добавок 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 ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1022
Зарегистрирован: 11.02.10
|
|
Отправлено: 29.10.16 21:00. Заголовок: SergKis пишет: можн..
SergKis пишет: Не вопрос! Конечно, добавлю в следующую сборку
| |
|
Dima
|
| |
Пост N: 6081
Зарегистрирован: 17.05.05
|
|
Отправлено: 09.11.16 17:24. Заголовок: gfilatov2002 Какой ..
gfilatov2002 Какой то не понятный глюк в 16.10 под MINGW , если в сырце прописать REQUEST HB_LANG_RUWIN то программу не собрать , в 16.06 было все нормально. Под BCC55 в 16.10 этой проблемы нет.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1026
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.11.16 17:59. Заголовок: Dima пишет: REQUEST..
Dima пишет: цитата: | REQUEST HB_LANG_RUWIN то программу не собрать , в 16.06 было все нормально. |
| Это происки Виктора в его Harbour 3.4 Попробуй добавить такой код #include "hbextcdp.ch" #include "hbextlng.ch" PROCEDURE HB_LANG_RUWIN() ; RETURN и отпишись, если помогло
| |
|
Dima
|
| |
Пост N: 6083
Зарегистрирован: 17.05.05
|
|
Отправлено: 09.11.16 18:03. Заголовок: gfilatov2002 Собрал..
gfilatov2002 Собралось , но при запуске упало на этой строке HB_LANGSELECT( "RUWIN" ) ранее было все хорошо
| |
|
|
gfilatov2002
|
| moderator
|
Пост N: 1027
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.11.16 18:30. Заголовок: Dima пишет: HB_LANG..
Dima пишет: Попробуй вызывать эту функцию так
| |
|
Dima
|
| |
Пост N: 6084
Зарегистрирован: 17.05.05
|
|
Отправлено: 09.11.16 18:38. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Попробуй вызывать эту функцию так |
| Да так работает. Спасибо ! А почему такая разница между сборкой под BCC и MINGW ? Под BCC все работает как и ранее а под MINGW какие то костыли нужно ставить...... И еще вопрос , EXE собранные в 16.10 под MINGW , не жмутся UPX 3.91w , он их не понимает. Чем можно заменить UPX ?
| |
|
Петр
|
| постоянный участник
|
Пост N: 1317
Зарегистрирован: 09.10.06
|
|
Отправлено: 09.11.16 20:36. Заголовок: Dima пишет: А почем..
Dima пишет: цитата: | А почему такая разница между сборкой под BCC и MINGW ? Под BCC все работает как и ранее а под MINGW какие то костыли нужно ставить |
| Можно я отвечу? 1) Это еще смотреть надо где костыль 2) MiniGUI изначально заточен под bcc, все остальное overhead А зачем их жать?
| |
|
Dima
|
| |
Пост N: 6089
Зарегистрирован: 17.05.05
|
|
Отправлено: 09.11.16 22:23. Заголовок: Петр пишет: 2) Mini..
Петр пишет: цитата: | 2) MiniGUI изначально заточен под bcc, все остальное overhead |
| Может и так и стоит вернуться на него , но там есть ограничения на формат и размер файлов в ресурсах , если мне память не изменяет. Петр пишет: Кто его знает :) Вычитал в инете и натыкался не раз что лучше жать , так как по сети EXE грузится быстрее , я конечно понимаю что нужно еще время и на распаковку в памяти. С секундомером не мерял и просто принял за истину что так лучше.........
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1029
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.11.16 11:52. Заголовок: Dima пишет: Под BCC..
Dima пишет: цитата: | Под BCC все работает как и ранее а под MINGW какие то костыли нужно |
| Поправил установку русского, немецкого и т.д. языков для MinGw-сборок на базе форка Harbour 3.4 Кстати, для испанского, португальского и итальянского языков ничего исправлять не потребовалось (это объясняет, почему не было сообщений об этой проблеме в MinGw-сборках ранее)
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5163
Зарегистрирован: 12.09.06
|
|
Отправлено: 10.11.16 16:36. Заголовок: Всем привет ! Нашёл ..
Всем привет ! Нашёл косяк... Создаём цветное окно, размещаем на нем цветные Label - всё работает отлично, но если перед окном ставим: SET EVENTS FUNCTION TO MYEVENTS Цвета у Label не меняются и TRANSPARENT не работает... Протестил и на MiniGUI\SAMPLES\Applications\RunCmd Вот так это выглядит: Как сделать, чтобы заработало ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1030
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.11.16 17:16. Заголовок: Andrey пишет: Как с..
Andrey пишет: цитата: | Как сделать, чтобы заработало ? |
| В функции MyEvents() надо записать вызов Events() следующим образом цитата: | Return Events ( hWnd, nMsg, wParam, lParam ) |
| Отпишись, если это помогло
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5164
Зарегистрирован: 12.09.06
|
|
Отправлено: 10.11.16 17:21. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Отпишись, если это помогло |
| Да, помогло ! Спасибо ! Делал по твоему примеру: otherwise Events ( hWnd, nMsg, wParam, lParam ) endcase Return (0)
| |
|
Петр
|
| постоянный участник
|
Пост N: 1318
Зарегистрирован: 09.10.06
|
|
Отправлено: 10.11.16 17:29. Заголовок: Andrey пишет: Как с..
Andrey пишет: цитата: | Как сделать, чтобы заработало ? |
| Напишите корректный обработчик MYEVENTS, не перехватывайте ненужные события, перенаправьте их стандартному обработчику HMG (если, что Events() называется). Опять задание для телепатов. P.S. Григорий таки делает успехи в этом деле.
| |
|
sashaBG
|
| постоянный участник
|
Пост N: 187
Зарегистрирован: 15.09.05
|
|
Отправлено: 10.11.16 19:44. Заголовок: И для Болгарского надо исправить :)
для MINGW в i_lang.ch надо поправить 63 ряд на : #translate SET LANGUAGE TO BULGARIAN => _HMG_LANG_ID := ' ' ; REQUEST HB_LANG_BG ; HB_LANGSELECT("BG" ) ; InitMessages()
| |
|
|
gfilatov2002
|
| moderator
|
Пост N: 1031
Зарегистрирован: 11.02.10
|
|
Отправлено: 11.11.16 12:32. Заголовок: sashaBG Благодарю ..
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
|
| moderator
|
Пост N: 1032
Зарегистрирован: 11.02.10
|
|
Отправлено: 14.11.16 12:55. Заголовок: Просто к сведению. В..
Просто к сведению. Выпустил сегодня первый RC для новой сборки библиотеки. Полный список изменений см. ниже Скрытый текст
* 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)
|
Благодарю за Ваше внимание
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1039
Зарегистрирован: 11.02.10
|
|
Отправлено: 22.11.16 11:53. Заголовок: Опубликована новая с..
Опубликована новая сборка 16.11 для следующих С-компиляторов: - BCC 5.51 (Harbour и xHarbour) - BCC 10.1 (только Harbour) - XCC (xHarbour) Прямые ссылки на дистрибутивы есть на домашней странице библиотеки Благодарю за помощь Петра и Андрея Верченко Примечание. Сборки для компилятора MinGW 6.2.0 32/64 bits (только Harbour) теперь доступны только тем, кто материально поддерживал (и поддерживает) работу по обновлению/улучшению библиотеки Прекрасно понимаю, что квалифицированный программист без труда сделает такую сборку самостоятельно на основе других доступных сборок. Но...
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5183
Зарегистрирован: 12.09.06
|
|
Отправлено: 25.11.16 11:52. Заголовок: Привет всем. Нашёл н..
Привет всем. Нашёл небольшой баг в примере MiniGUI\SAMPLES\BASIC\COLORED_TAB Добавляем в строчку допустим 87 - SIZE 22, далее собираем пример, запускаем всё отлично. Меняем Style на любой - вверху присутствует строка выше Tab. На больших шрифтах НАДПИСЬ на Tab чуток пониже бы надо, а то сильно к верху прилеплена надпись.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1045
Зарегистрирован: 11.02.10
|
|
Отправлено: 25.11.16 12:30. Заголовок: Andrey пишет: Меняе..
Andrey пишет: цитата: | Меняем Style на любой - вверху присутствует строка выше Tab. |
| Если переключиться на следующую вкладку, а затем - вернуться обратно, то все снова отлично Надеюсь, что в реальной программе (а не в примере) не потребуется "на лету" менять стиль и шрифт цветного TABа
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5184
Зарегистрирован: 12.09.06
|
|
Отправлено: 25.11.16 13:04. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Надеюсь, что в реальной программе (а не в примере) не потребуется "на лету" менять стиль и шрифт цветного TABа |
| Согласен ! А как быть с этим: На больших шрифтах НАДПИСЬ на Tab чуток пониже бы надо, а то сильно к верху прилеплена надпись.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1046
Зарегистрирован: 11.02.10
|
|
Отправлено: 25.11.16 13:24. Заголовок: Andrey пишет: На бо..
Andrey пишет: цитата: | На больших шрифтах НАДПИСЬ на Tab чуток пониже бы надо |
| Сейчас в ТАБе большим шрифтом BigFsize считается шрифт, если его размер больше 12. Значит, для шрифтов с размером больше 20, надо вводить обработку BigBigFsize, для шрифтов с размером больше 30, надо вводить обработку BigBigBigFsize и так далее. А какой смысл так усложнять код, если такие большие шрифты используются достаточно редко (обычно размер шрифта до 20)
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5186
Зарегистрирован: 12.09.06
|
|
Отправлено: 25.11.16 13:57. Заголовок: У меня в программе ш..
У меня в программе шрифты для большого экрана 22. Уже много заказчиков с большими экранами. Если не сложно, то добавь пожалуйста ещё для обработки BigBigFsize. Заранее большое спасибо !
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1049
Зарегистрирован: 11.02.10
|
|
Отправлено: 25.11.16 15:17. Заголовок: Andrey пишет: добав..
Andrey пишет: Сделал, до размера шрифта 28 работает (но лучше не более 24)
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5187
Зарегистрирован: 12.09.06
|
|
Отправлено: 25.11.16 15:18. Заголовок: Спасибо ! :sm36: ..
Спасибо !
| |
|
Dima
|
| |
Пост N: 6147
Зарегистрирован: 17.05.05
|
|
Отправлено: 28.11.16 18:55. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Сборки для компилятора MinGW 6.2.0 32/64 bits (только Harbour) теперь доступны только тем, кто материально поддерживал (и поддерживает) работу по обновлению/улучшению библиотеки |
| Печаль то какая.... Поделится кто то ссылкой в личку ?
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5193
Зарегистрирован: 12.09.06
|
|
Отправлено: 01.12.16 14:38. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Прямые ссылки на дистрибутивы есть на домашней странице библиотеки |
| Григорий, а у себя на сайте ты можешь сделать отдельную страничку под примеры не вошедшие в библиотеку ? У всех же есть и у тебя будет. Да и на сайт чаще заглядывать станут. Тем более что при поиске в Гугле допустим: minigui harbour sendmessage или: minigui Downloader выходит твоя библиотека. Вот и так же сделай пожалуйста страничку под примеры не вошедшие в библиотеку. Кандидаты на страничку: DBF_to_XLS - сделан (уже высылал) DBF_to_DOC - делаю DBF_to_PostgreSQL - делаю Народ, поддержите идею !!!
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1051
Зарегистрирован: 11.02.10
|
|
Отправлено: 01.12.16 15:01. Заголовок: Andrey пишет: сдела..
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
|
| постоянный участник
|
Пост N: 5195
Зарегистрирован: 12.09.06
|
|
Отправлено: 01.12.16 15:56. Заголовок: Ссылка не работает, ..
Ссылка не работает, требует логина. Это не есть хорошо. Нужно примерно так: архив-проекта, краткое описание на инглише. Просто и со смыслом. Ну и чтобы тексты попали в индексацию Гугла. А в заголовках примерах я специально пишу на русском, чтобы искать можно было тоже на русском в гугле. Типа: * Передача сообщений между приложениями/процессами при помощи сообщения WM_COPYDATA * Transmission of messages between applications / processes using the WM_COPYDATA Верни пожалуйста в пример русский комментарий заодно.
| |
|
sashaBG
|
| постоянный участник
|
Пост N: 188
Зарегистрирован: 15.09.05
|
|
Отправлено: 08.12.16 16:18. Заголовок: Что то не так с Яыками в сборке МиниГУИ для BCC101
после SET LAGUAGE TO BULGARIAN Функция NTOCMONTH(1) пробовал и на других и на Русском показывает крокозяблики. Помоему какието йероглфы печатает в остальных сборках все ок
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1053
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.12.16 15:53. Заголовок: sashaBG пишет: Функ..
sashaBG пишет: цитата: | Функция NTOCMONTH(1) пробовал и на других и на Русском показывает крокозяблики |
| Благодарю за сообщение! Видимо, существует какая-то нестыковка этого нового компилятора с Харбором для этой функции. Причем это касается только кириллических языков, для латинских языков эта функция работает правильно. В целом же, этот компилятор позволяет нормально интернационалмзмровать приложение для основных востребованных языков.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1054
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.12.16 15:58. Заголовок: Всем, кому это интер..
Всем, кому это интересно. Завершается подготовка новой " рождественской" сборки библиотеки 16.12 Полный список изменений см. ниже Скрытый текст
* 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)
|
Благодарю за Ваше внимание
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5249
Зарегистрирован: 12.09.06
|
|
Отправлено: 15.12.16 13:34. Заголовок: Использую в программ..
Использую в программе: SET MULTIPLE OFF WARNING Можно ли вместо простой надписи "Программа уже запущена", написать так: Попытка запуска второй копии программы: C:\path\name.exe Отказано в запуске. Программа уже запущена ! А то юзера пугаются, им не вдомёк что уже программу запустили.
| |
|
Vlad04
|
| постоянный участник
|
Пост N: 637
Зарегистрирован: 13.10.05
|
|
Отправлено: 16.12.16 09:21. Заголовок: А то юзера пугаются,..
цитата: | А то юзера пугаются, им не вдомёк что уже программу запустили. |
| Объяснишь, после второго раза перестанут пугаться. А после третьего - уже остальным смогут объяснить.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1339
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.12.16 10:55. Заголовок: Andrey пишет Можно л..
Andrey пишет цитата: | Можно ли вместо простой надписи "Программа уже запущена", написать так: |
| Можно, если поменять значения (см. h_init.prg) // 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.'
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1056
Зарегистрирован: 11.02.10
|
|
Отправлено: 16.12.16 11:21. Заголовок: SergKis пишет: Можн..
SergKis пишет: цитата: | Можно, если поменять значения (см. h_init.prg) |
| Поправил, теперь в следующей сборке можно будет использовать таким образом: /* * 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
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5251
Зарегистрирован: 12.09.06
|
|
Отправлено: 16.12.16 14:51. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Поправил, теперь в следующей сборке можно будет использовать таким образом: |
| Супер, то что нужно ! Спасибо большое !
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1057
Зарегистрирован: 11.02.10
|
|
Отправлено: 19.12.16 11:41. Заголовок: Поздравляю всех с дн..
Поздравляю всех с днем Святого Николая! Опубликована новая сборка 16.12 для следующих С-компиляторов: - BCC 5.51 (Harbour и xHarbour) - BCC 10.1 (только Harbour) - XCC (xHarbour) Прямые ссылки на дистрибутивы есть на домашней странице библиотеки Благодарю Петра за огромный вклад в эту сборку, без его помощи она бы не состоялась... Примечание. Сборки для компилятора MinGW 6.2.0 32/64 bits (только Harbour) доступны только тем, кто материально поддерживал (и поддерживает) работу по обновлению/улучшению библиотеки
| |
|
Dima
|
| |
Пост N: 6215
Зарегистрирован: 17.05.05
|
|
Отправлено: 19.12.16 13:06. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Сборки для компилятора MinGW 6.2.0 32/64 bits (только Harbour) доступны только тем, кто материально поддерживал (и поддерживает) работу по обновлению/улучшению библиотеки |
| А сколько стоит билетик ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1058
Зарегистрирован: 11.02.10
|
|
Отправлено: 19.12.16 13:23. Заголовок: Dima пишет: сколько..
Dima пишет: Сумма пожервования - на Ваше усмотрение (от 10 евро и выше). Важна не сумма, а сам факт помощи в развитии этого проекта
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5260
Зарегистрирован: 12.09.06
|
|
Отправлено: 19.12.16 14:05. Заголовок: Народ ! Давайте Григ..
Народ ! Давайте Григория поддержим !!! Классный продукт же получился. Не уж то жалко поделиться средствами, которые получаешь на созданном Григории софте ! Там в папке MiniGui есть файл PayPal Donate.url - вот по нему можно оплачивать. Или ещё из России пока действуют переводы в Украину по системе MoneyGram в любом салоне Связной. Там нужно только ФИО и отправить спец.код Григорию по эл.почте или смс-кой.
| |
|
Veeha
|
| |
Пост N: 16
Зарегистрирован: 07.02.13
|
|
Отправлено: 19.12.16 15:33. Заголовок: Andrey пишет: Народ..
Andrey пишет: цитата: | Народ ! Давайте Григория поддержим !!! Классный продукт же получился. |
|
gfilatov2002 пишет: цитата: | Благодарю Петра за огромный вклад в эту сборку, без его помощи она бы не состоялась... |
|
gfilatov2002 пишет: цитата: | Сумма пожервования - на Ваше усмотрение (от 10 евро и выше). |
| Обидно будет, если обойдём мимо Петра. Петр, а какие у вас ставки?
| |
|
Петр
|
| постоянный участник
|
Пост N: 1386
Зарегистрирован: 09.10.06
|
|
Отправлено: 19.12.16 16:31. Заголовок: Veeha пишет: Обидно..
Veeha пишет: цитата: | Обидно будет, если обойдём мимо Петра. Петр, а какие у вас ставки? |
| ?! What is it? У меня нет возможности работать постоянно над проектом (и отвечать на вопросы пользователей, а куда без них, - тоже ). Поэтому для меня Minigui, что называется just for fun, почти .
| |
|
Veeha
|
| |
Пост N: 18
Зарегистрирован: 07.02.13
|
|
Отправлено: 19.12.16 17:00. Заголовок: Петр пишет: У меня ..
Петр пишет: цитата: | У меня нет возможности работать постоянно над проектом (и отвечать на вопросы пользователей |
| На счет работы над проектом ничего не скажу, но на вопросы пользователей вы отвечаете чаще, чем Григорий ... ИМХО ...Петр пишет: цитата: | что называется just for fun |
| Та ды и мы 'что называется just for fun'
| |
|
Петр
|
| постоянный участник
|
Пост N: 1387
Зарегистрирован: 09.10.06
|
|
Отправлено: 19.12.16 19:04. Заголовок: Veeha пишет: Та ды ..
Veeha пишет: цитата: | Та ды и мы 'что называется just for fun' |
| Этого не знаю, определяйтесь сами Veeha пишет: цитата: | На счет работы над проектом ничего не скажу, но на вопросы пользователей вы отвечаете чаще, чем Григорий |
| Наверное, вы имеете в виду этот форум и последнее время, но это не показатель. Так, что Григорий - software developer + software maintainer Я только committer в той части, которая меня интересует.
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5263
Зарегистрирован: 12.09.06
|
|
Отправлено: 19.12.16 20:03. Заголовок: Петр пишет: Я тольк..
Петр пишет: цитата: | Я только committer в той части, которая меня интересует. |
| Как бы заинтересовать вас сделать нормальную поддержку PNG в МиниГуи ? Я думаю, что многие бы и я в том числе, поддержали это начинание... 1 картинка PNG 128x128 заменит все форматы ICO, вывод на форму и т.д. А как упроститься работа с ресурсами... Сказочное сокращение рисование иконок из png и т.д. Очень просим помочь !!!
| |
|
Dima
|
| |
Пост N: 6218
Зарегистрирован: 17.05.05
|
|
Отправлено: 19.12.16 20:52. Заголовок: Andrey пишет: Очень..
Andrey пишет: Только виртуальным пивом тут не обойдется точно Проданатируй Петра.
| |
|
Петр
|
| постоянный участник
|
Пост N: 1388
Зарегистрирован: 09.10.06
|
|
Отправлено: 19.12.16 21:03. Заголовок: Andrey пишет: 1 кар..
Andrey пишет: цитата: | 1 картинка PNG 128x128 заменит все форматы ICO, вывод на форму и т.д. |
| Как вы это себе представляете? И почему в MS до этого не додумались
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5264
Зарегистрирован: 12.09.06
|
|
Отправлено: 19.12.16 21:13. Заголовок: Dima пишет: Только ..
Dima пишет: цитата: | Только виртуальным пивом тут не обойдется точно |
| Без вопросов... Петр пишет: цитата: | Как вы это себе представляете? И почему в MS до этого не додумались |
| Ну не совсем ясно выразился. Сейчас при показе PNG (прозрачный) на форме и кнопке края картинки выглядят слово их мышь поела - так Дмитрий написал. Это из-за плохой реализации показа.
| |
|
Dima
|
| |
Пост N: 6219
Зарегистрирован: 17.05.05
|
|
Отправлено: 19.12.16 21:24. Заголовок: Andrey Выложи приме..
Andrey Выложи пример , он был у тебя , там все было понятно , в чем проблема. Один вроде был на чистом С# и такой же на MG + Harbour
| |
|
Петр
|
| постоянный участник
|
Пост N: 1389
Зарегистрирован: 09.10.06
|
|
Отправлено: 19.12.16 21:34. Заголовок: Andrey пишет: Это и..
Andrey пишет: цитата: | Это из-за плохой реализации показа. |
| Реализация вполне стандартная. А вывод PNG (как я понял - с альфа каналом) сам по себе нестандартный. Если подключить GDI+ то 1) Такой вывод достаточно медленный (особенно заметно при больших заливках) 2) Достаточно ресурсоемкий. Но, конечно, картинка иногда может получиться вполне симпатичная, особенно если еще зеркальное отображение сделать В 90% из 100% лучшим способом будет сконвертировать понравившийся PNG в ICO/BMP. Подключение внешних графических библиотек не предлагаю
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5265
Зарегистрирован: 12.09.06
|
|
Отправлено: 19.12.16 21:44. Заголовок: Dima пишет: Выложи ..
Dima пишет: цитата: | Выложи пример , он был у тебя |
| Выкладываю - https://cloud.mail.ru/public/8jVN/pbpiYjsaw Вдобавок ко всему, если на форме поменяешь цвет, то надо PNG картинку удалить, а потом заново выводить объект в этом месте, что не есть - ОЧЕНЬ хорошо, для программиста.
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5266
Зарегистрирован: 12.09.06
|
|
Отправлено: 19.12.16 21:45. Заголовок: Петр пишет: В 90% и..
Петр пишет: цитата: | В 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
| |
|
Петр
|
| постоянный участник
|
Пост N: 1390
Зарегистрирован: 09.10.06
|
|
Отправлено: 19.12.16 23:06. Заголовок: Andrey пишет: Хочеш..
Andrey пишет: цитата: | Хочешь красивую прогу, делай ICO все форматы... |
| Да вот представьте себе, именно такой совет дает msdn: хотите портабельную прогу для win, которая в случае чего и в безопасном режиме могла бы заработать - будьте добры. Andrey пишет: цитата: | Нужно менять (допиливать) функцию. |
| Знаете я не всегда смотрел за развитием MiniGUI. Но когда-то, после очередного перерыва, увидел, что в состав MiniGUI включили, частично правда, код из библиотеки BosTaurus - инициализацию и использование отдельных функций GDI+. Т.е. теперь любая программа с использованием MiniGUI не будет работать без установленной gdiplus.dll - это цена за использование PNG. Да, согласен, теперь уже тяжело найти машину где б gdiplus.dll не жила, но, поверьте, так было не всегда. И в C# поддержка PNG не была заложена изначально. Не знаю, как теперь, но сначала это делалось с помощью сторонних классов - оберток над тем же GDI+ Andrey пишет: цитата: | Вот есть подсказки как нужно делать: |
| Я все это (и не только это) видел еще когда писал пример Advanced\GdiPlus и до сих пор не уверен, нужно ли всю эту "радость" тянуть в MiniGUI.
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5289
Зарегистрирован: 12.09.06
|
|
Отправлено: 10.01.17 13:31. Заголовок: Пример \MiniGUI&..
Пример \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. )
| |
|
Петр
|
| постоянный участник
|
Пост N: 1402
Зарегистрирован: 09.10.06
|
|
Отправлено: 10.01.17 13:50. Заголовок: не включен "hmg...
Andrey пишет: Не включен "hmg.ch" #include "hmg.ch" или #include "i_hmgcompat.ch"
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5290
Зарегистрирован: 12.09.06
|
|
Отправлено: 10.01.17 13:59. Заголовок: Петр пишет: Не вклю..
Петр пишет: цитата: | Не включен "hmg.ch" #include "hmg.ch" или #include "i_hmgcompat.ch" |
| Это по второму вопросу - маленький пример собирается, а в большом проекте в модуле где ставлю команду WAIT WINDOW "Загружаю файл...." NOWAIT в начале модуля есть #include "minigui.ch" Но не собирается проект, выдаёт ошибку. А по первому вопросу - есть надпись или нет ? У меня надписи нет.
| |
|
Петр
|
| постоянный участник
|
Пост N: 1403
Зарегистрирован: 09.10.06
|
|
Отправлено: 10.01.17 14:09. Заголовок: Andrey пишет: А по ..
Andrey пишет: цитата: | А по первому вопросу - есть надпись или нет ? У меня надписи нет. |
| У меня есть - поэтому на вопрос "Окошко есть, а надписи нет! Почему ?" у меня нет ответа. Кто-то другой может и ответит. Andrey пишет: цитата: | в начале модуля есть #include "minigui.ch" |
| Вам лень посмотреть hmg.ch и чем он отличается от minigui.ch?
| |
|
Dima
|
| |
Пост N: 6245
Зарегистрирован: 17.05.05
|
|
Отправлено: 10.01.17 15:01. Заголовок: Петр пишет: У меня ..
Петр пишет: цитата: | У меня есть - поэтому на вопрос "Окошко есть, а надписи нет! Почему ?" у меня нет ответа. Кто-то другой может и ответит. |
| И у меня есть
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5291
Зарегистрирован: 12.09.06
|
|
Отправлено: 10.01.17 16:15. Заголовок: Dima пишет: И у мен..
Dima пишет: Значит что-то с 8-кой у меня ! Спасибо Дима !
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5292
Зарегистрирован: 12.09.06
|
|
Отправлено: 10.01.17 16:22. Заголовок: Петр пишет: Вам лен..
Петр пишет: цитата: | Вам лень посмотреть hmg.ch и чем он отличается от minigui.ch? |
| Посмотрел minigui.ch, понял что там нет i_hmgcompat.ch . Спасибо !
| |
|
Dima
|
| |
Пост N: 6251
Зарегистрирован: 17.05.05
|
|
Отправлено: 15.01.17 15:00. Заголовок: gfilatov Просто инф..
gfilatov Просто инфа. Наблюдается проблема с HB_FUNC( TONE ) , прога виснет , при этом Audiodg.exe грузит проц на 70 % Вероятно как то не правильно установлены дрова на звук. Похожая проблема на том же компе и с TeamViewer , он при выходе не заканчивает сессию и повторно попасть на комп не возможно. Остановили службу Audio на компе и выключили звуки , проблема ушла.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1062
Зарегистрирован: 11.02.10
|
|
Отправлено: 31.01.17 10:52. Заголовок: Опубликована новая с..
Опубликована новая сборка 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
|
| постоянный участник
|
Пост N: 5309
Зарегистрирован: 12.09.06
|
|
Отправлено: 31.01.17 22:44. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Опубликована новая сборка 17.01 |
| Попробовал новую сборку и предыдущую. Вылет в уже рабочем проекте... Писал об этом Пост N: 5307 Проект на Версии 16.11 работает без ошибки. Как бы исправить версию 17.01 ?
| |
|
Петр
|
| постоянный участник
|
Пост N: 1411
Зарегистрирован: 09.10.06
|
|
Отправлено: 31.01.17 22:59. Заголовок: Andrey пишет: Как б..
Andrey пишет: цитата: | Как бы исправить версию 17.01 ? |
| Правьте свой код, в 17.01., (в прочем как и в 16.12.) добавлены проверки параметров, передаваемых в функции, всего лишь. Нет у вас ошибок - ничего вылетать не будет (теоретически ). Andrey пишет: цитата: | Писал об этом Пост N: 5307 |
| Вам там ответ дали, зачем плодить посты? Лучьше последуйте совету и отпишитесь, помогло или нет.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1063
Зарегистрирован: 11.02.10
|
|
Отправлено: 01.02.17 11:38. Заголовок: Andrey пишет: Проек..
Andrey пишет: цитата: | Проект на Версии 16.11 работает без ошибки. |
| После добавления проверки параметров на С-уровне удалось обнаружить минимум две неточности/ошибки в PRG-коде ядра библиотеки. Так что теперь в последних сборках генерируется качественный код, что, естественно, повышает стабильность программы в целом. Поэтому от Вас потребуется ревизия существующего кода программы для использования самых свежих сборок
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5310
Зарегистрирован: 12.09.06
|
|
Отправлено: 01.02.17 12:19. Заголовок: Понял, спасибо ! :s..
Понял, спасибо !
| |
|
Петр
|
| постоянный участник
|
Пост N: 1418
Зарегистрирован: 09.10.06
|
|
Отправлено: 06.02.17 14:51. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Опубликована новая сборка 17.01 |
| При установке на Win7 постоянно возникает предупреждение, что-то вроде, "Установка завершена некорректно. Переустановить продукт?", хотя вроде бы все устанавливается. Можно ли распространять библиотеку в виде простого архива (как для xhb)? Не рассматривался ли вопрос замены стандартного архиватора на 7z, с учетом как бесплатности, так и доступности данного архиватора?
| |
|
Dima
|
| |
Пост N: 6280
Зарегистрирован: 17.05.05
|
|
Отправлено: 06.02.17 15:21. Заголовок: Петр пишет: При уст..
Петр пишет: цитата: | При установке на Win7 постоянно возникает предупреждение, что-то вроде, "Установка завершена некорректно. Переустановить продукт?", хотя вроде бы все устанавливается. |
| То же самое.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1065
Зарегистрирован: 11.02.10
|
|
Отправлено: 07.02.17 15:23. Заголовок: Петр пишет: При уст..
Петр пишет: цитата: | При установке на Win7 постоянно возникает предупреждение |
| Возможно, проблема возникает при созданнии ярлыков в папке в меню "Пуск". Просто поставьте галку "Не создавать ярлыки". Петр пишет: цитата: | Не рассматривался ли вопрос замены стандартного архиватора на 7z |
| Архив для xhb создается с помощью архиватора 7zip Петр пишет: цитата: | Можно ли распространять библиотеку в виде простого архива (как для xhb)? |
| Конечно, можно (так и было на начальном этапе, когда сборка была экспериментальной). Но с использованием инсталлятора, на мой взгляд, более профессионально...
| |
|
Петр
|
| постоянный участник
|
Пост N: 1419
Зарегистрирован: 09.10.06
|
|
Отправлено: 07.02.17 17:18. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Просто поставьте галку "Не создавать ярлыки". |
| Это не решает проблему. gfilatov2002 пишет: цитата: | Но с использованием инсталлятора, на мой взгляд, более профессионально.. |
| Да, но множество дистрибутивов имеют еще portable версию. А здесь два инсталлятора, только один упакован, другой нет. Т.е. налицо проблема инсталятора - некорректная установка (что именно не так?) и, как я понимаю, ложные срабатывания некоторых антивирусов. Такой подход вряд ли можно назвать профессиональным Не смертельно.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1066
Зарегистрирован: 11.02.10
|
|
Отправлено: 07.02.17 19:49. Заголовок: Петр пишет: здесь д..
Петр пишет: цитата: | здесь два инсталлятора, только один упакован, другой нет |
| Мысль понял, для следующей сборки сделаю в архиве portable версию вместо упаковки инсталлятора. Благодарю за подсказку
| |
|
krutoff
|
| |
Пост N: 188
Зарегистрирован: 17.10.05
|
|
Отправлено: 09.02.17 18:41. Заголовок: Да, у мне тоже пришл..
Да, у мне тоже пришлось откатиться на версию 16.11, т.к. ошибки возникли в TSBrowse на уровне исходного кода библиотеки.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1068
Зарегистрирован: 11.02.10
|
|
Отправлено: 21.02.17 11:36. Заголовок: Просто к сведению. В..
Просто к сведению. Выпустил сегодня первый RC для новой сборки библиотеки. Полный список изменений см. ниже Скрытый текст
* 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)
| Благодарю за Ваше внимание
| |
|
Петр
|
| постоянный участник
|
Пост N: 1427
Зарегистрирован: 09.10.06
|
|
Отправлено: 24.02.17 14:51. Заголовок: Andrey пишет: За вы..
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
|
| |
Пост N: 6309
Зарегистрирован: 17.05.05
|
|
Отправлено: 24.02.17 15:10. Заголовок: Петр пишет: В качес..
Петр пишет: цитата: | В качестве дополнительного анонса: в MiniGUI добавлена ограниченная поддержка вывода картинок с альфа каналом. |
| Отлично смотрится
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5321
Зарегистрирован: 12.09.06
|
|
Отправлено: 24.02.17 18:21. Заголовок: Петр пишет: В качес..
Петр пишет: цитата: | В качестве дополнительного анонса: в MiniGUI добавлена ограниченная поддержка вывода картинок с альфа каналом. |
| Классная вещь ! Давно хотелось такого ! А в чем заключается ограничение ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1070
Зарегистрирован: 11.02.10
|
|
Отправлено: 28.02.17 10:44. Заголовок: Опубликована новая с..
Опубликована новая сборка 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
|
| |
Пост N: 39
Зарегистрирован: 18.06.15
|
|
Отправлено: 01.03.17 12:21. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Опубликована новая сборка 17.02 |
| Уважаемый Григорий, резко упало качество картинок расположенных в окне ... click here
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1071
Зарегистрирован: 11.02.10
|
|
Отправлено: 01.03.17 13:46. Заголовок: Alex_Cher пишет: ре..
Alex_Cher пишет: цитата: | резко упало качество картинок |
| Благодарю за сообщение! Как лечить: закомментируйте следующую экспериментальную строку в функции HMG_LoadPicture() из файла c_image.c hBitmap = LoadOLEPicturePath( ( const char * ) FileName ); и пересоберите библиотеку с помощью батника MakeLib.bat. Если такое лечение помогло, то обязательно сообщите здесь на форуме...
| |
|
Alex_Cher
|
| |
Пост N: 40
Зарегистрирован: 18.06.15
|
|
Отправлено: 01.03.17 15:03. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | закомментируйте следующую экспериментальную строку в функции HMG_LoadPicture() |
| Уважаемый Григорий, замечание устранено ... благодарю за оперативность ...
| |
|
Петр
|
| постоянный участник
|
Пост N: 1428
Зарегистрирован: 09.10.06
|
|
Отправлено: 01.03.17 15:11. Заголовок: Alex_Cher пишет: ре..
Alex_Cher пишет: цитата: | резко упало качество картинок расположенных в окне |
| Было бы не плохо, если бы вы выложили фрагмент кода, который выводит картинку, и вообще, замечательно было бы оригинал картинки посмотреть
| |
|
Alex_Cher
|
| |
Пост N: 41
Зарегистрирован: 18.06.15
|
|
Отправлено: 02.03.17 08:51. Заголовок: Петр пишет: Было бы..
Петр пишет: цитата: | Было бы не плохо, если бы вы выложили фрагмент кода |
| @ 0,30 IMAGE Image_1 PARENT Form_8 PICTURE _tec_dir + '/dat/Logotip.jpg' ; WIDTH 150 HEIGHT 100 TOOLTIP 'ПАО "АВТОВАЗ" 2014 ' click here
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5322
Зарегистрирован: 12.09.06
|
|
Отправлено: 05.03.17 14:06. Заголовок: Петр пишет: В качес..
Петр пишет: цитата: | В качестве дополнительного анонса: в MiniGUI добавлена ограниченная поддержка вывода картинок с альфа каналом. |
| Я использую формы цветные (цвет формы разный). Добавил в пример demo.prg цвет формы: MAIN BACKCOLOR BLUE И красота примера накрылась.... Опять обгрызанные края у картинки ...
| |
|
Петр
|
| постоянный участник
|
Пост N: 1429
Зарегистрирован: 09.10.06
|
|
Отправлено: 05.03.17 21:11. Заголовок: Andrey пишет: Опять..
Andrey пишет: цитата: | Опять обгрызанные края у картинки ... |
| Что могу сказать.. Ждите мартовский релиз или апрельский, это как решит Григорий. Но думаю, что уже скоро все будет хорошо
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5323
Зарегистрирован: 12.09.06
|
|
Отправлено: 06.03.17 10:01. Заголовок: Петр пишет: Но дума..
Петр пишет: цитата: | Но думаю, что уже скоро все будет хорошо |
| Отличная новость !
| |
|
Alw Spencer
|
| |
Не зарегистрирован
Зарегистрирован: 01.01.70
|
|
Отправлено: 15.03.17 13:25. Заголовок: Приветстую всех gfi..
Приветстую всех gfilatov2002 пишет: цитата: | Опубликована новая сборка 17.02 |
| Ошибка компиляции примера: C:\MiniGUI\SAMPLES\BASIC\ExtractIcon\demo2.prg demo2.prg(66) Error E0030 Syntax error "syntax error at '@'"
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1077
Зарегистрирован: 11.02.10
|
|
Отправлено: 15.03.17 14:09. Заголовок: Alw Spencer пишет: ..
Alw Spencer пишет: цитата: | demo2.prg(66) Error E0030 Syntax error |
| Запишите эту строку следующим образом: @ 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 ) ) )
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1080
Зарегистрирован: 11.02.10
|
|
Отправлено: 21.03.17 11:40. Заголовок: Опубликована новая с..
Опубликована новая сборка 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
|
| постоянный участник
|
Пост N: 1396
Зарегистрирован: 17.02.12
|
|
Отправлено: 21.03.17 12:50. Заголовок: gfilatov2002 В Tsb_..
gfilatov2002 В Tsb_addrecord_3 demo.prg (line 359) прошла неточность (когда копировал на сайт), надо nCol := oBrw:nColumn("NAME")
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1081
Зарегистрирован: 11.02.10
|
|
Отправлено: 21.03.17 14:01. Заголовок: SergKis пишет: demo..
SergKis пишет: цитата: | demo.prg (line 359) прошла неточность |
| Благодарю, поправил в архиве сборки на сайте
| |
|
i3t4j6
|
| |
Пост N: 136
Зарегистрирован: 12.06.06
|
|
Отправлено: 22.03.17 12:10. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: [quote]` Эта функция использовалась очень давно для поиска абонентов в базе данных по фамилии. Но начиная с версии 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
|
| постоянный участник
|
Пост N: 676
Зарегистрирован: 13.10.05
|
|
Отправлено: 23.03.17 10:52. Заголовок: Непонятки со сборкой..
Непонятки со сборкой 1703. Создаю новый проект в ДИЗАЙНЕРЕ. Добавляю НОВЫЙ МОДУЛЬ в проект- все нормально, добавляю НОВУЮ ФОРМУ - и всё вываливается И IDE закрывается .Старые проекты нормально открываются. В сборке 1702 такого не было
| |
|
Vlad04
|
| постоянный участник
|
Пост N: 677
Зарегистрирован: 13.10.05
|
|
Отправлено: 23.03.17 10:56. Заголовок: Что-то с IDE. Сборка..
Что-то с IDE. Сборка 1703 с IDE от 1702 нормально работает
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1082
Зарегистрирован: 11.02.10
|
|
Отправлено: 23.03.17 13:00. Заголовок: Vlad04 пишет: добав..
Vlad04 пишет: цитата: | добавляю НОВУЮ ФОРМУ - и всё вываливается |
| Благодарю за сообщение! Уже поправил эту ошибку Вы можете обновить HMGS-IDE через меню Help->Update
| |
|
Vlad04
|
| постоянный участник
|
Пост N: 678
Зарегистрирован: 13.10.05
|
|
Отправлено: 23.03.17 13:07. Заголовок: :sm12: ок..
ок
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5333
Зарегистрирован: 12.09.06
|
|
Отправлено: 26.03.17 19:24. Заголовок: Последняя версия Мин..
Последняя версия МиниГуи. Примеры MiniGUI\SAMPLES\BASIC\WAIT_WINDOW_2 Картинка на белом фоне ТЕПЕРЬ СЕРАЯ, вместо белой !!! Как исправить на белый цвет ? Заодно и в примерах нужно поправить.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1083
Зарегистрирован: 11.02.10
|
|
Отправлено: 26.03.17 19:37. Заголовок: Andrey пишет: Как и..
Andrey пишет: цитата: | Как исправить на белый цвет ? |
| Замени класс WHITEBACKGROUND на STRETCH при определении Image_1 Andrey пишет: цитата: | Заодно и в примерах нужно поправить. |
| Уже сделал для новой сборки
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5334
Зарегистрирован: 12.09.06
|
|
Отправлено: 26.03.17 21:14. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Замени класс WHITEBACKGROUND на STRETCH при определении Image_1 |
| Заменил. Не помогло ! Осталось также.
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5335
Зарегистрирован: 12.09.06
|
|
Отправлено: 27.03.17 23:54. Заголовок: Исправил так: DEF..
Исправил так: DEFINE WINDOW &cFormName ; ....... BACKCOLOR {240,240,240} ; Окно стало сереньким как и картинка ... Зато фон окна совпадает с картинкой ! gfilatov2002 правь примеры для следующей версии.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1084
Зарегистрирован: 11.02.10
|
|
Отправлено: 29.03.17 11:01. Заголовок: Andrey пишет: Окно ..
Andrey пишет: цитата: | Окно стало сереньким как и картинка |
| Разобрался с этим... Дело в том, что Минигуи использует в качестве цвета фона окна по умолчанию системный цвет COLOR_BTNFACE. Для 7-й Винды этот цвет как раз {240,240,240}, а не чисто белый, как было сделано в примере. Думаю, что теперь вопрос закрыт Больше хороших новостей о следующей апрельской сборке: - выполнена адаптация библиотеки для работы с Си-компилятором VisualC 2015; - Петр показал, как использовать уже имеющуюся в библиотеке функцию LoadIconByName() для загрузки иконок различных размеров из одного многостраничного ICON файла (это то, чего не хватало в минигуи, Андрею ). Благодарю за Ваше внимание
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5336
Зарегистрирован: 12.09.06
|
|
Отправлено: 29.03.17 18:46. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | LoadIconByName() для загрузки иконок различных размеров из одного многостраничного ICON файла (это то, чего не хватало в минигуи, Андрею ). |
| Это отличная новость !!! Но боюсь что BCC 5.51 не сможет проглотить этот формат иконок. У меня он вылетает на сборке с ошибкой. Единственную иконку различных размеров линковщик берёт только для MAIN окна... gfilatov2002 пишет: цитата: | выполнена адаптация библиотеки для работы с Си-компилятором VisualC 2015; |
| Красота ! Что там будет со сборкой .... Надо бы попробовать !!!
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1085
Зарегистрирован: 11.02.10
|
|
Отправлено: 31.03.17 11:05. Заголовок: Andrey пишет: Что т..
Andrey пишет: Сборка библиотеки и примеров осуществляется с помощью Харбор-утилиты hbmk2 Пример батника см.ниже Скрытый текст
@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%
| Andrey пишет: Напиши мне, пришлю ссылку на архив бетки, в котором есть исходники, примеры, Харбор и уже собранные библиотеки. Примечание. В качестве Си-компилятора здесь используется Command Line Visual C 2015 Compiler, который лежит на сайте http://whosaway.com (его размер около 374 MB)
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5344
Зарегистрирован: 12.09.06
|
|
Отправлено: 05.04.17 11:13. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | - выполнена адаптация библиотеки для работы с Си-компилятором VisualC 2015; |
| Опять засада... Папка для Си-компилятора тоже называется MiniGui. Как ставить на диск С: одновременно для BCC и MSVC и ещё MinGW ? Может пора переделать структуру папок ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1086
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.04.17 14:40. Заголовок: Andrey пишет: Как с..
Andrey пишет: цитата: | Как ставить на диск С: одновременно для BCC и MSVC и ещё MinGW ? |
| Это не серьезно Просто временно переименуйте (или переместите на другой диск) одноименные папки А после тестирования всегда можно все вернуть назад... Andrey пишет: цитата: | Может пора переделать структуру папок ? |
| Файлы конфигурации в минигуи - только для рабочего примера. Вы можете использовать переменные окружения цитата: | set HMGPATH=c:\minigui set vccdir=C:\VC2015 |
|
в батнике buildapp.bat для настройки требуемой конфигурации
| |
|
Haz
|
| |
Пост N: 1080
Зарегистрирован: 20.02.11
|
|
Отправлено: 13.04.17 15:50. Заголовок: Григорий Просьба по..
Григорий Просьба подправить код т.к. если ::nRowCount() < ::nLen игнорируется выполнение ::bChange С поправкой ниже все работает. * ============================================================================ * METHOD TSBrowse:PageDown() Version 9.0 Nov/30/2009 * ============================================================================ Примерно в строке :8555 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
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1087
Зарегистрирован: 11.02.10
|
|
Отправлено: 13.04.17 16:39. Заголовок: Haz пишет: С поправ..
Haz пишет: цитата: | С поправкой ниже все работает |
| Благодарю за помощь! Уже поправил
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1408
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.04.17 07:11. Заголовок: gfilatov2002 Возмож..
gfilatov2002 Возможно, будет интересно, сделать возможность не задавать значения ControlName, ParentForm в функциях, сделав их по default _HMG_ThisControlName, _HMG_ThisFormName. Тогда упростится вызов их в событиях контролов. 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 ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1422
Зарегистрирован: 17.02.12
|
|
Отправлено: 20.04.17 08:58. Заголовок: SergKis пишет Тогда ..
SergKis пишет цитата: | Тогда упростится вызов их в событиях контролов. |
| Т.е. в блоках кода ACTION, GOT\LOST FOCUS, MOUSE..., и т.д. можно писать xVal := _GetValue() _SetValue(,, xVal) nInd := GetControlInex() hCnt := GetControlHandle() ... это облегчает писанину, особенно когда "дурит" препроцессор и не пропускает псевдо ООП команды у себя сделал еще вариант If hb_IsNumeric( ControlName) - то это уже готовый Index конттрола и макро получение индекса не выполняется, используя полученное значение. Но это, наверно, выходит за пределы "религии" hmg
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1088
Зарегистрирован: 11.02.10
|
|
Отправлено: 20.04.17 10:16. Заголовок: SergKis пишет: это,..
SergKis пишет: цитата: | это, наверно, выходит за пределы "религии" hmg |
| Благодарю за Ваши предложения, но это действительно за пределами философии МиниГуи Кстати, выпустил сегодня pre-release апрельской сборки 17.04 Огромная благодарность Петру за все предложенные улучшения Си-кода ядра библиотеки
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1092
Зарегистрирован: 11.02.10
|
|
Отправлено: 26.04.17 10:35. Заголовок: Всем, кому это интересно
Опубликована новая сборка 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
|
| постоянный участник
|
Пост N: 1426
Зарегистрирован: 17.02.12
|
|
Отправлено: 28.04.17 12:41. Заголовок: gfilatov2002 добаво..
gfilatov2002 добавочка в INKEYGUI ... 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; } } ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1093
Зарегистрирован: 11.02.10
|
|
Отправлено: 28.04.17 12:58. Заголовок: SergKis Благодарю з..
SergKis Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1430
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.04.17 11:59. Заголовок: gfilatov2002 Товари..
gfilatov2002 Товарищ по работе так предлагает InKeyGUI Скрытый текст
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 ) ); }
|
| |
|
Dima
|
| |
Пост N: 6397
Зарегистрирован: 17.05.05
|
|
Отправлено: 30.04.17 14:47. Заголовок: SergKis пишет: Това..
SergKis пишет: цитата: | Товарищ по работе так предлагает InKeyGUI |
| Чем такой варик лучше ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1431
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.04.17 15:07. Заголовок: Dima пишет Чем такой..
Dima пишет При клике с inkeigui, цикл его разрывается, а клик передается туда где кликнул. На примере Tsb_addrecord3 кл. F3 с предыдущими изменениями inkeygui, при клике на др. стр. тсб, просто уберет getbox с ShowGetValid сообщением и все (курсор тсб останется на той же строке), а после предлагаемых изменений, переключится на ту строку, где кликнули, т.е. более естественное поведение inkeygui на кликах мыши
| |
|
Dima
|
| |
Пост N: 6398
Зарегистрирован: 17.05.05
|
|
Отправлено: 30.04.17 15:16. Заголовок: SergKis пишет: т.е...
SergKis пишет: цитата: | т.е. более естественное поведение inkeygui на кликах мыши |
|
| |
|
Петр
|
| постоянный участник
|
Пост N: 1451
Зарегистрирован: 09.10.06
|
|
Отправлено: 30.04.17 22:36. Заголовок: SergKis пишет: Тов..
SergKis пишет: цитата: | Товарищ по работе так предлагает InKeyGUI |
| Окультуренная версия цитата: | #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 ); } |
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1432
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.04.17 23:02. Заголовок: Петр :sm36: Дадуда..
Петр Дадуда цитата: | Даду внедрёж. Окультуриваться надо. Вы со мной согласны. Окультуриваться надо. |
|
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5395
Зарегистрирован: 12.09.06
|
|
Отправлено: 20.05.17 00:32. Заголовок: Helper Minigui - пос..
Helper Minigui - последняя версия. Ищу по указателю: Label - показывает @...CHECKLABEL DEFINE CHECKLABEL Так должно быть ? Смотрю там даже два Label.... и два ListBox.... Очепятка наверное...
| |
|
Alex_Cher
|
| |
Пост N: 43
Зарегистрирован: 18.06.15
|
|
Отправлено: 22.05.17 07:17. Заголовок: Andrey пишет: Helpe..
Andrey пишет: цитата: | Helper Minigui - последняя версия. |
| у меня тоже самое, а поиск с версии 16.07 вообще не работает (я кидал эту тему ранее) ... Беда с Helper ....
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1100
Зарегистрирован: 11.02.10
|
|
Отправлено: 24.05.17 09:48. Заголовок: Опубликована очередн..
Опубликована очередная сборка 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
|
| постоянный участник
|
Пост N: 1467
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.05.17 19:25. Заголовок: gfilatov2002 Когда ..
gfilatov2002 Когда то, давно, предлагал добавить на окно, по аналогии с контролами (_HMG_aControlMiscData1, _HMG_aControlMiscData2) _HMG_aFormMiscData1 - для внутренних штучек окна _HMG_aFormMiscData2 - для Cargo окна предлагаю вернуться к этому вопросу, т.к. без такой добавки затруднено наращивание функционала окна. Т.е. i_var.ch #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 ] := '' При наличии этих штучек, можно что то пробовать, к примеру аналог :UserKeys _HMG_aFormMiscData1 в нашей версии уже задействована чуть - чуть.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1105
Зарегистрирован: 11.02.10
|
|
Отправлено: 29.05.17 21:22. Заголовок: SergKis пишет: пре..
SergKis пишет: цитата: | предлагал добавить на окно, по аналогии с контролами |
| Благодарю за напоминание! Добавил эти изменения для следующей сборки
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5403
Зарегистрирован: 12.09.06
|
|
Отправлено: 30.05.17 00:12. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | - MS VisualC 2015 32-bit and Harbour 3.2.0dev; - MS VisualC 2017 32-bit and Harbour 3.2.0dev; |
| В чём разница между ними ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1469
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.05.17 11:04. Заголовок: gfilatov2002 Кое чт..
gfilatov2002 Кое что набрал Скрытый текст
добавить для 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. ... .
|
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1106
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.05.17 13:43. Заголовок: SergKis пишет: Если..
SergKis пишет: цитата: | Если ставим _SetThisFormInfo( k ), то где снимать надо _PopEventInfo() ? |
| Вероятно, в функции _EndPropSheet() по аналогии с тем, как Вы это делаете в _EndDialog() SergKis пишет: Думаю назвать этот класс WndClass (видел, что это имя использует Микрософт для определения класса окна) P.S. Остановился на имени TWndData
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1107
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.05.17 13:46. Заголовок: Andrey пишет: В чём..
Andrey пишет: цитата: | В чём разница между ними ? |
| MS VisualC 2017 вышла в марте этого года и содержит все последнии наработки MS в поддержке стандартов C++. Но, по-видимому, для Харбора это не принципиально...
| |
|
Петр
|
| постоянный участник
|
Пост N: 1489
Зарегистрирован: 09.10.06
|
|
Отправлено: 30.05.17 17:13. Заголовок: SergKis пишет: CLAS..
SergKis пишет: Что даст применение этого класса? Кроме возможности самовыразиться
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1108
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.05.17 17:15. Заголовок: SergKis пишет: Кое ..
SergKis пишет: Сделал следующие записи в текущий changelog файл: * 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. Вероятно, потребуется еще добавить пример использования Вашего класса.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1471
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.05.17 21:43. Заголовок: Петр пишет Что даст ..
Петр пишет цитата: | Что даст применение этого класса? |
| 1. На его базе сделается аналог :UserKeys + возможно, удастся реализовать работу через Post\SendMessage 2. Получив объект, сразу имею доступ (без макросов) к его свойствам (короче писать), не i := GetFormIndex(...) _HMG_aFormNames[ i ] _HMG_aFormHandles[ i ] ... 3. Класс в наборе (пока не рабочий как надо), просто застолбил 1 элемент - HMG_aFormMiscData1 [k] 4. Когда продолжу - не знаю, какое то время буду занят, т.е. его наличие в new версии не мешает, а территория помечена (это по поводу "самовыражения")
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1472
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.05.17 21:55. Заголовок: gfilatov2002 пишет В..
gfilatov2002 пишет цитата: | Вероятно, потребуется еще добавить пример использования Вашего класса. |
| Дополнится пример с :UserKes, когда будет готово. Пока ездил сегодня туда сюда, подумалось подправить 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
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1109
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.05.17 22:10. Заголовок: SergKis пишет: Допо..
SergKis пишет: цитата: | Дополнится пример с :UserKes |
| Понял, спасибо SergKis пишет: цитата: | FUNCTION _GetWindowObj( cFormName ) |
| У меня сейчас эта функция выглядит так: *-----------------------------------------------------------------------------* FUNCTION _GetWindowObj( cFormName ) *-----------------------------------------------------------------------------* LOCAL i := GetFormIndex( cFormName ) IF i > 0 RETURN _HMG_aFormMiscData1 [ i ][ 1 ] ENDIF RETURN NIL
| |
|
Петр
|
| постоянный участник
|
Пост N: 1490
Зарегистрирован: 09.10.06
|
|
Отправлено: 30.05.17 22:38. Заголовок: SergKis пишет: На е..
SergKis пишет: цитата: | На его базе сделается аналог :UserKeys + возможно, удастся реализовать работу через Post\SendMessage |
| Это можно организовать и без ООП. Был уже в истории такой период "hmg objects", чем закончился - не знаю SergKis пишет: цитата: | просто застолбил 1 элемент - HMG_aFormMiscData1 [k] |
| Это можно сделать и изящнее, см.BASIC\WindowProperty Тогда у вас будет быстрый доступ к данным как на C, так и на PRG уровнях. Вы можете модифицировать стандартную оконную процедуру MiniGUI - WndProc. К примеру, если message входит в диапазон WM_USER.., оконная процедура с помощью GetProp получает связанный обьект и выполняет нужный метод или просто вызывает процедуру/выполняет блок кода, функция Events в этом случае не вызывается. И т.п. было бы желание разгуляться.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1473
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.05.17 00:05. Заголовок: Петр пишет Это можно..
Петр пишет цитата: | Это можно сделать и изящнее, см.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
|
| постоянный участник
|
Пост N: 1474
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.05.17 00:08. Заголовок: gfilatov2002 пишет У..
gfilatov2002 пишет цитата: | У меня сейчас эта функция выглядит так: |
| Хотелось бы, чтобы объект получался и от Handle окна, не только от имени. Потому и изменения предложил.
| |
|
Петр
|
| постоянный участник
|
Пост N: 1491
Зарегистрирован: 09.10.06
|
|
Отправлено: 31.05.17 09:34. Заголовок: SergKis пишет: Прох..
SergKis пишет: цитата: | Проходили с MDI интерфейсом - следить за что поставил, что снял - еще то занятие. |
| Наверное вы проходили до включения в MiniGUI EnumProps(). Потому, что с EnumProps все эти манипуляции становятся рутинными.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1476
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.05.17 09:46. Заголовок: Петр пишет Наверное ..
Петр пишет цитата: | Наверное вы проходили до включения в MiniGUI EnumProps(). Потому, что с EnumProps все эти манипуляции становятся рутинными. |
| Это был 2009 год. Добавив в окно простое _HMG_aFormMiscData1 - решили проблемы наращивания функционала"естественным" способом, аналогичный контролам hmg, т.е. поведение псвесдо объектов контролов и окон одинаково. Сами включали в свою версию EnumProc и это работало, пока не наткнулись (с разрастанием программы) на плавающий завис на нем. Убрали - все стало ok.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1110
Зарегистрирован: 11.02.10
|
|
Отправлено: 31.05.17 11:48. Заголовок: SergKis пишет: Хоте..
SergKis пишет: цитата: | Хотелось бы, чтобы объект получался и от Handle окна, не только от имени. |
| Не вопрос, уже переписал эту функцию так: *-----------------------------------------------------------------------------* 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 И рабочий код для проверки @ 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) )
| |
|
Петр
|
| постоянный участник
|
Пост N: 1492
Зарегистрирован: 09.10.06
|
|
Отправлено: 31.05.17 12:05. Заголовок: SergKis пишет: Сами..
SergKis пишет: цитата: | Сами включали в свою версию EnumProc и это работало, пока не наткнулись (с разрастанием программы) на плавающий завис на нем. Убрали - все стало ok. |
| Я не видел сообщений об ошибке на этом форуме. К сожалению, это почти практика для пользователей MiniGUI - смастерить костыль, а не искать причину.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1481
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.05.17 13:53. Заголовок: Петр пишет смастерит..
Петр пишет цитата: | смастерить костыль, а не искать причину. |
| Когда костыль вылазит только у некоторых клиентов и случ. образом, как то не до практики искать истинную причину. А о сообщениях писать ... не всегда есть смыл. Писал я, что столкнулись, у клиентов, не работает совсем или частично уст. клавишь HotKey и что ... ? Переделали под себя на CLASS hmgBrowseKey, подсунули вместо HotKey и с 10-го работает как часы + в тсб KeyDown ... Как там было "Думать некогда, стучать надо."
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1483
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.05.17 18:24. Заголовок: gfilatov2002 пишет у..
gfilatov2002 пишет цитата: | уже переписал эту функцию так |
| Пример может и так выглядеть. DEFINE WINDOW ... PRIVATE oWnd := _GetWindowObj(This.Name) ... ACTION ... oWnd:Title и так везде. Если в объект добавить ASSIGNы, то oWnd:Title := '...' с использованием WITH OBJECT oWnd :Title и т.д.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1484
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.06.17 18:17. Заголовок: gfilatov2002 Вариан..
gfilatov2002 Вариант с UserKeys на окно (TWndData на старом варианте) Скрытый текст
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 ...
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1485
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.06.17 18:31. Заголовок: PS Если ACTION контр..
PS Если ACTION контрола не задам, по умолчанию, можно выполнять oWnd:UserKeys( This.Name ) Проще писать.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1111
Зарегистрирован: 11.02.10
|
|
Отправлено: 01.06.17 20:21. Заголовок: SergKis пишет: Вар..
SergKis пишет: цитата: | Вариант с UserKeys на окно |
| Благодарю за помощь! Буду разбираться... P.S. Супер! Все работает как надо
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1486
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.06.17 22:36. Заголовок: gfilatov2002 В прим..
gfilatov2002 В пример по использованию Cargo добавьте строки 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 ) })
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1487
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.06.17 22:40. Заголовок: PS. промахнулся по ..
PS. промахнулся по кнопке. Еще 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'
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1112
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.06.17 11:48. Заголовок: SergKis пишет: В пр..
SergKis пишет: цитата: | В пример по использованию Cargo |
| Благодарю за Вашу помощь! Добавил такое описание в текущий changelog: * 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) Всем пока - убегаю в отпуск
| |
|
Петр
|
| постоянный участник
|
Пост N: 1493
Зарегистрирован: 09.10.06
|
|
Отправлено: 02.06.17 14:17. Заголовок: SergKis пишет: у кл..
SergKis пишет: цитата: | у клиентов, не работает совсем или частично уст. клавишь HotKey и что ... ? |
| Это нормально, к Минигуи претензий не может быть никаких (почти). HotKey в библиотеке построены на RegisterHotKey(), описание которой с указанием причин отказа в регистрации можно легко найти в нете. К тому же HotKey system-wide. Вот интересно почему в MiniGUI не реализована поддержка акселераторов (accelerators)?
| |
|
Петр
|
| постоянный участник
|
Пост N: 1494
Зарегистрирован: 09.10.06
|
|
Отправлено: 02.06.17 14:22. Заголовок: Ваше решение (UserKe..
Ваше решение (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. |
|
| |
|
Петр
|
| постоянный участник
|
Пост N: 1495
Зарегистрирован: 09.10.06
|
|
Отправлено: 02.06.17 14:25. Заголовок: Поддержку акселерато..
Ограниченную поддержку акселераторов в MiniGUI организовать просто Пример (only Harbour): /* * 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
| |
|
Петр
|
| постоянный участник
|
Пост N: 1496
Зарегистрирован: 09.10.06
|
|
Отправлено: 02.06.17 14:29. Заголовок: Для того, чтобы прим..
Для того, чтобы пример заработал нужны еще 2 файла цитата: | // demo.ch #define IDM_REGULAR 1100 #define IDM_BOLD 1200 #define IDM_ITALIC 1300 #define IDM_ULINE 1400 |
| цитата: | // 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 } |
|
| |
|
Петр
|
| постоянный участник
|
Пост N: 1497
Зарегистрирован: 09.10.06
|
|
Отправлено: 02.06.17 14:33. Заголовок: Также нужно внести и..
Также нужно внести изменения в библиотеку (c_windowsAPI.c) и пересобрать ее цитата: | 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 ); } } } } } |
|
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1113
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.06.17 16:00. Заголовок: Петр пишет: поддерж..
Петр пишет: цитата: | поддержку акселераторов в MiniGUI организовать просто |
| Благодарю за Ваш весомый вклад в развитие библиотеки! Отдельное спасибо за реализацию функции LoadMenu
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1489
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.06.17 16:25. Заголовок: Петр 1. Не очень по..
Петр 1. Не очень понимаю, как это поможет решить задачу, установки таблицы- код нажатой клавиши и исп. блока кода В VO это решалось, в основном, через ресурсный редактор, но этого хотелось бы избежать. В Events нет WM_KEYDOWN (только WM_HOTKEY). Если на окне есть Tsb (несколько), и по hWnd получается объект тсб, то обработчик oBrw:HandleEvent, т.е. работают уст. клавиши на тсб, что нормально. Что мешает, вкл. обработчик на WN_KEYDOWN (тсб проскочил), схематично 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 не очень дружу, потому кто бы сделал (но не я)
| |
|
Петр
|
| постоянный участник
|
Пост N: 1500
Зарегистрирован: 09.10.06
|
|
Отправлено: 02.06.17 18:43. Заголовок: SergKis пишет: Не ..
SergKis пишет: цитата: | Не очень понимаю, как это поможет решить задачу, установки таблицы- код нажатой клавиши и исп. блока кода |
| А в чем проблема? Я же написал - пример ограниченной поддержки, с минимальным изменением кода библиотеки. Полную интеграцию можно провести по разному - стандартный поиск в массивах никто не отменял. SergKis пишет: цитата: | В VO это решалось, в основном, через ресурсный редактор, но этого хотелось бы избежать. |
| Опять же пример с упором на работу с ресурсами. Таблицу акселераторов также можно и создавать и менять на лету. Но это тема другого примера. SergKis пишет: цитата: | Так же можем сделать и для WM_KEYUP |
| Да мы и теперь любое сообщение (причем без всяких дополнительных обьектов) можем обрабатывать (set events) - ничего не мешает.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1490
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.06.17 20:00. Заголовок: Петр пишет можем об..
Петр пишет цитата: | можем обрабатывать (set events) - ничего не мешает. |
| В версии 2.07 этого нет, да я писал, что такое решение на постоянной основе мне не по душе (как отладка какого то решения - можно использовать). Лучше привести код Evens к нужному решению, чем плодить set eventsы. В целом проблема решена (на нашей версии) работать без HotKey, но если переходить на тек. версию, все проблемы SET KEY ... ACTION ... опять вылезут. Потому я и поднимаю волну, но пока перехода не предвидится это не горит, а других все устраивает. Петр СПАСИБО за участие
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1114
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.06.17 20:52. Заголовок: Петр пишет: пример ..
Петр пишет: цитата: | пример с упором на работу с ресурсами |
| Добавил такое описание в текущий файл changelog: * 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) Благодарю за помощь
| |
|
Петр
|
| постоянный участник
|
Пост N: 1501
Зарегистрирован: 09.10.06
|
|
Отправлено: 02.06.17 21:17. Заголовок: MenuRES, я так понял..
MenuRES, я так понял, по аналогии с MenuDBF. gfilatov2002 пишет: Да не за что, будет что-то интересное поделюсь еще В часности, SergKis подбросил интересную идею, попробую реализовать что-то подобное ON APPEVENT [NAME] <evName> [ID <id>] | [AUTO] EVAL <{block}> [ONCE] EMIT <evName>
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1491
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.06.17 05:06. Заголовок: Петр пишет попробую..
Петр пишет цитата: | попробую реализовать что-то подобное ON APPEVENT [NAME] <evName> [ID <id>] | [AUTO] EVAL <{block}> [ONCE] EMIT <evName> |
| Как это поможет реализовать такую схему (из HwGui) 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)
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1492
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.06.17 07:16. Заголовок: Петр Чем Ваше решен..
Петр Чем Ваше решение будет лучше, к примеру, такого (схема) в класс вводим переменную :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
|
| постоянный участник
|
Пост N: 1493
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.06.17 07:19. Заголовок: PS. читать так тако..
PS. читать так такой же класс можно сделать для контролов и в _Define... кониролов заполнить ...
| |
|
Петр
|
| постоянный участник
|
Пост N: 1502
Зарегистрирован: 09.10.06
|
|
Отправлено: 03.06.17 11:22. Заголовок: SergKis пишет: В ве..
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.
| |
|
Петр
|
| постоянный участник
|
Пост N: 1503
Зарегистрирован: 09.10.06
|
|
Отправлено: 03.06.17 11:35. Заголовок: SergKis пишет: Как ..
SergKis пишет: цитата: | Как это поможет реализовать такую схему (из HwGui) |
| SergKis пишет: цитата: | Чем Ваше решение будет лучше, к примеру, такого (схема) |
| Это вообще, что называется "из другой оперы". Реализую и выложу здесь, тогда и вопросы можно будет по существу задавать. P.S. Присмотритесь к TTaskDialog - уверен, что найдете для себя много интересного.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1504
Зарегистрирован: 17.02.12
|
|
Отправлено: 07.06.17 17:24. Заголовок: gfilatov2002 К :Use..
gfilatov2002 К :UserKeys добавил Evens блоки кода по WM_USER+... сообщениям с примером http://my-files.ru/3d4ctz Что сделал Скрытый текст
Изменения: ========== Функцию _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(...), это на любителя. Пример для тестирования будет приложен.
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1505
Зарегистрирован: 17.02.12
|
|
Отправлено: 07.06.17 17:41. Заголовок: PS Надо подправить ..
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
|
| |
Пост N: 358
Зарегистрирован: 03.12.08
|
|
Отправлено: 09.06.17 12:29. Заголовок: Добрый день , форумч..
Добрый день , форумчане ! Что сделать чтоб можно было менять ширину контрола RADIOGROUP ? Отбой тревоги .... WIDTH - это ширина одного элемента выбора , а не всего контрола .... Уже и забыл ху-из-ху :) (*) Первый ( ) Второй ( ) Третий После команды изменения ширины MyWindow.MyRADIO.WIDTH:=600 . ( Новое значение ширины гораздо больше исходного , всё должно влазить ) Отображается только первый элемент группы : (*) Первый
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1506
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.06.17 22:41. Заголовок: gfilatov2002 Довел ..
gfilatov2002 Довел до рабочей кондиции пример и тексты hmg по Post\SendMessage. Пример: http://my-files.ru/gbuo3t Комплект базовых функций, классы: Скрытый текст
*-----------------------------------------------------------------------------* 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
| Изменения в hmg: Скрытый текст
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(...), это на любителя.
| Замечания, дополнения принимаются.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1507
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.06.17 08:56. Заголовок: PS Еще *-----------..
PS Еще Скрытый текст
*-----------------------------------------------------------------------------* 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]
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1508
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.06.17 09:35. Заголовок: PS У себя сделал *-..
PS У себя сделал *-----------------------------------------------------------------------------* 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
| |
|
Петр
|
| постоянный участник
|
Пост N: 1513
Зарегистрирован: 09.10.06
|
|
Отправлено: 10.06.17 12:20. Заголовок: SergKis пишет: METH..
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
|
| постоянный участник
|
Пост N: 1509
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.06.17 19:34. Заголовок: Петр Согласен. :sm..
Петр Согласен. METHOD New( o ) INLINE ( ::oObj := iif( HB_ISOBJECT(o), o, Self ), Self ) CONSTRUCTOR
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1511
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.06.17 21:55. Заголовок: SergKis пишет Неточ..
SergKis пишет цитата: | Неточность в *-----------------------------------------------------------------------------* FUNCTION _EraseControl ( i, p ) *-----------------------------------------------------------------------------* LOCAL mVar, t, hWnd, x If HB_ISOBJECT( _HMG_aControlMiscData0 [ i ][1] ) _HMG_aControlMiscData0 [ i ][1]:Del() EndIf |
| Надо усилить проверку *-----------------------------------------------------------------------------* 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 Т.е. _HMG_aControlMiscData0 [ i ] := {} - пустышка
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1512
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.06.17 06:29. Заголовок: gfilatov2002 Повтор..
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(...) Скрытый текст
*-----------------------------------------------------------------------------* 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
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1513
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.06.17 11:12. Заголовок: PS Если принять вари..
PS Если принять вариант GetControlIndex, то можно, пройдя по функциям, сделать: *-----------------------------------------------------------------------------* 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 ) ... работа без лишних макросов
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5409
Зарегистрирован: 12.09.06
|
|
Отправлено: 11.06.17 14:30. Заголовок: SergKis пишет: gfil..
SergKis пишет: цитата: | gfilatov2002 Повторю предложение, |
| А он вроде писал, что убегает в отпуск ....
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1514
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.06.17 16:03. Заголовок: Andrey пишет А он вр..
Andrey пишет цитата: | А он вроде писал, что убегает в отпуск |
| Я в курсе, прошлый раз, Григорий, отказал, отослав к инструкции\описанию\религии МиниГуи. Выкладываю сейчас, потому как, он придет из отпуска, я уйду.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1517
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.06.17 17:23. Заголовок: gfilatov2002 SergKi..
gfilatov2002 SergKis пишет сделать цитата: | *-----------------------------------------------------------------------------* 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() ... |
| А правильнее так *-----------------------------------------------------------------------------* 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 ... Тогда в примере будет Скрытый текст
// ---------------------------------------------------------------------------- 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
| без лишних ky := ky, ;
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1520
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.06.17 14:11. Заголовок: gfilatov2002 Добави..
gfilatov2002 Добавил методы и подправил h_windows.prg Скрытый текст
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 ...
|
| |
|
Петр
|
| постоянный участник
|
Пост N: 1514
Зарегистрирован: 09.10.06
|
|
Отправлено: 12.06.17 14:49. Заголовок: SergKis пишет: Доб..
SergKis пишет: цитата: | Добавил методы и подправил h_windows.prg |
| Я надеюсь, что вы высылаете исходники Григорию или хотя-бы diff файлы? А то боюсь, что он врядли вручную захочет все это реконструировать. цитата: | прошлый раз, Григорий, отказал, отослав к инструкции\описанию\религии МиниГуи. |
| Я бы тоже отказал. В примеры - пожалуйста, там и так черт ногу сломит, а для ядра библиотеки - это слишком специфично и классово чуждо Tsbrowse не в счет. Да еще - ваши упоминания о "религии MiniGUI" ни на йоту не приближают вас к успеху Но я хотя бы понял, чего вы о ней вспомнили
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5413
Зарегистрирован: 12.09.06
|
|
Отправлено: 12.06.17 15:04. Заголовок: Да не так уж и много..
Да не так уж и много правок для ядра. А почему не нужно это вставлять ? По синтаксису понятно и пользоваться можно будет в будущем. Удобней кстати для использования. А примеры для этого тоже бы желательно иметь более подробней написанные...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1521
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.06.17 15:07. Заголовок: Петр пишет Я надеюсь..
Петр пишет цитата: | Я надеюсь, что вы высылаете исходники Григорию |
| Пока, нет, т.к. нет ясности, будет ли это востребовано (работа по сообщениям) в MiniGui. Выкладываю что бы услышать коменты (исправления) и может кому пригодиться. Сборка изменений у меня есть (моя версия), но на какую версию 17.05\17.06 накладывать изменения ясности нет. цитата: | для ядра библиотеки - это слишком специфично и классово чуждо |
| чуждость странная, на мой взгляд, в одном месте ядра используем _HMG_... переменные в др. говорим низяя , хотя это такие же внутренние переменные. Мое дело предложить ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1522
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.06.17 15:16. Заголовок: PS Нет ясности, у пр..
PS Нет ясности, у примеру, как обозвать правильно функции: oWndData() или oTWndData() oCntData() или oTCntData() oKeyData() или oTKeyData()
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1523
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.06.17 15:24. Заголовок: Andrey пишет А приме..
Andrey пишет цитата: | А примеры для этого тоже бы желательно иметь более подробней написанные... |
| В примере, мне кажется, довольно подробно написано применение практически всех вариантов.
| |
|
Петр
|
| постоянный участник
|
Пост N: 1515
Зарегистрирован: 09.10.06
|
|
Отправлено: 12.06.17 15:44. Заголовок: Andrey пишет: Да не..
Andrey пишет: цитата: | Да не так уж и много правок для ядра. |
| Правки сырые, видно, что человек не читал хотя бы то, что в xhb-diff написано и примеров ООП в папке tests не смотрел. И если собираетесь использовать в harbour классы, то нужно найти и почитать документацию по Class(y). Реализация методов Destroy показывает, что еще есть чему учиться. SergKis пишет: цитата: | Нет ясности, у примеру, как обозвать правильно функции: oWndData() или oTWndData() |
| Если это функции классов, то префикс o здесь явно чуждый. Что до T - это дань Делфи, "родные" функции классов в harbour начинаются c Hb
| |
|
Петр
|
| постоянный участник
|
Пост N: 1516
Зарегистрирован: 09.10.06
|
|
Отправлено: 12.06.17 16:01. Заголовок: SergKis пишет: в од..
SergKis пишет: цитата: | в одном месте ядра используем _HMG_ |
| Дело в том, что вы положили в переменную, использование классов в процедурной библиотеке, выглядит достаточно странно. А если учесть, что нет никакой продуманной обьектной модели, что визуальные обьекты, смешаны с невизуальными, довольно таки специфическими (TCntData ).. цитата: | Пока, нет, т.к. нет ясности, будет ли это востребовано (работа по сообщениям) |
| Какое отношение имеет TCntData к "работе с сообщениями" ? Какую модель работы с сообщениями вы выбрали?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1524
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.06.17 16:49. Заголовок: Петр пишет А если уч..
Петр пишет цитата: | А если учесть, что нет никакой продуманной обьектной модели, что визуальные обьекты, смешаны с невизуальными, довольно таки специфическими (TCntData ).. |
| Если просматривали историю выкладываня, могли увидеть, что некоторые визуальные (после отладки) уходили в невизуальные. Набираю с колес, в первую очередь, для себя, чтобы с работающей сейчас сопли (своя версия) перейди на более разумную цитата: | Какое отношение имеет TCntData к "работе с сообщениями" |
| Самое прямое, на нем, в первую очередь, ставятся\выполняются events этого This контрола + насколько команд, для упр. контролом внутри блока events. На окно, соответсвенно, для самостоятельных (не связанных event с контролом) или для организации множественной рассылки сообщений контролам, с установкой соотв. среды This. цитата: | Дело в том, что вы положили в переменную, использование классов в процедурной библиотеке, выглядит достаточно странно. |
| Вполне можно убрать, добавил только для "эстетического" написания\использования. GetControlIndex(Self) или GetControlIndex( , Self:Index) цитата: | Реализация методов Destroy показывает, что еще есть чему учиться. |
| Так всю жизнь этим занимаюсь. цитата: | Правки сырые, видно, что человек не читал хотя бы то, что в xhb-diff написано и примеров ООП в папке tests не смотрел |
| с xhb дел не имел (кроме сборки letodb) никаких. Примеры ООП, в основном hb 2.0. Правки сырые", действительно так, с "колес", но мне лично надо ехать, а шашечки ..., правильное оформление ... Разве, кто подключится и поможет.
| |
|
Петр
|
| постоянный участник
|
Пост N: 1517
Зарегистрирован: 09.10.06
|
|
Отправлено: 12.06.17 17:39. Заголовок: Какое отношение име..
цитата: | Какое отношение имеет TCntData к "работе с сообщениями" Самое прямое |
| А, так это - TControl и что делает метод Sum(), а главное для чего он что-то делает? Позвольте дать вам совет. 1) Для публичных библиотек не используйте конспирологические имена (:UsK) 2) Возьмите принятную для вас обьектную модель (Delphi, FoxPro, xailer ) и внимательно ее изучите. SergKis пишет: цитата: | с xhb дел не имел (кроме сборки letodb) никаких. Примеры ООП, в основном hb 2.0. Правки сырые", действительно так, с "колес", но мне лично надо ехать, а шашечки ... |
| Не буду обьяснять почему, но вам в source еще рано.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1525
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.06.17 18:00. Заголовок: Петр пишет что дела..
Петр пишет цитата: | что делает метод 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 ) и внимательно ее изучите. |
| Скорее поздно, да и совершенно не стремлюсь.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1526
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.06.17 20:05. Заголовок: PS Вылез с предложен..
PS Вылез с предложениями, только по причинам 1. Убрать лишнее макро выполнение в командах (у меня убрано). См. _SetFocus постах выше 2. Получить работу с сообщениями, если мой вариант, то дополнительно бонус - список всех типов на окно - список объектов контролов по запросу типов - список объектов контролов по запросу имен Цель, иметь возможность перехода на последние версии hmg. Если предложения будут включены "правильным" образом с "правильным" описанием, я включу их в свою версию правильно. В любом случае, я перешел с поделки на Label (аналог сообщений), используя повод :UserKeys, пусть и не "правильный" код
| |
|
Петр
|
| постоянный участник
|
Пост N: 1519
Зарегистрирован: 09.10.06
|
|
Отправлено: 12.06.17 21:18. Заголовок: SergKis пишет: Если..
SergKis пишет: цитата: | Если предложения будут включены "правильным" образом с "правильным" описанием, я включу их в свою версию правильно. |
| Ваш код в существующем виде не может быть включен в MiniGUI по банальной причине - MiniGUI Ext. поддерживает как harbour, так и xhb. Для того, чтобы написать совместимый код нужно знать их отличия (xhb-diff) как на PRG уровне (элементарное различие в наименовании функций и к-ве параметров), так и C API. Вот, к примеру, в xhb реализация деструктора обьекта приводит к повреждению HVM памяти. Поэтому такие вещи сильно (иногда не сильно ) лимитируют использование нативных средств языка (harbour/xhb), вынуждая создавать соотв. функциональность с помощью WinAPI и совместимого C API.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1527
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.06.17 21:46. Заголовок: Петр Наверно по нез..
Петр Наверно по незнанию,не вижу связи использования WinApi для установки свойства объекта (в реале STATIC переменной) в Nil, если не ставить - это произойдет все равно (как не использованная) мусоросборщиком. А др. в destroy нет. В hb (в сравнении с vo, но это уже история ...) напрягает (чуть чуть) отсутствие автоматических AXIT и Destroy, делаем ручками. цитата: | Ваш код в существующем виде не может быть включен в MiniGUI по банальной причине - MiniGUI Ext. поддерживает как harbour, так и xhb. |
| Destroy это просто название метода, его можно было назвать ToNil, если на название реагирует xhb , нет проблем, сменим, если для xhb надо отдельно метод инициализации, тоже нет проблемы, сделаем метод Init или Define и будем писать TWndData():New():Init( <параметры> ) Покажите как надо, оформлю, но изучать xhd-diff ..., т.к по жизни нет необходимости в этом
| |
|
Петр
|
| постоянный участник
|
Пост N: 1520
Зарегистрирован: 09.10.06
|
|
Отправлено: 12.06.17 22:31. Заголовок: SergKis пишет: В hb..
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
|
| постоянный участник
|
Пост N: 1528
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.06.17 23:44. Заголовок: Петр Спасибо за под..
Петр Спасибо за подробное разъяснение "религии" 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
|
| постоянный участник
|
Пост N: 1529
Зарегистрирован: 17.02.12
|
|
Отправлено: 13.06.17 11:36. Заголовок: Петр пишет Присмотр..
Петр пишет цитата: | Присмотритесь к 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
|
| moderator
|
Пост N: 1115
Зарегистрирован: 11.02.10
|
|
Отправлено: 13.06.17 13:51. Заголовок: SergKis пишет: От д..
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 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 Вместо 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
|
| постоянный участник
|
Пост N: 1530
Зарегистрирован: 17.02.12
|
|
Отправлено: 13.06.17 19:12. Заголовок: gfilatov2002 пишет и..
gfilatov2002 пишет цитата: | использование псевдо-ООП и настоящих классов порождает ненужное дублирование в ядре библиотеки... |
| Лучше иметь дублирование, чем не иметь ничего, речь идет о разрезах контролов по окнам, то что в МиниГуи кроме ascan ничего нет (доступ к контролам), вызывает удивление, база есть а разрезов, по окнам нет. Это как DBFCDX только с Locate, без индексов и тегов, scope. Если нужен индекс\тег, то стройте его (клиенты) сами, там С структуры, там учебник по С и вперед. Т.е. что бы получить что то с МиниГуи пользователь должен досконально знать организацию и цепочки (itemoв), а если с версией это меняется. Словом недоработка, по моему мнению, длящаяся годами. Обиды нет, есть непонимание, почему просто не сказать, систему сообщений берем от Петра. Будет ли она лучше, посмотрим. Что предложено сечас, полная изолированность конрола, т.е. он о себе знает все, где что брать, как отображать и ничего не знает о др. конролах окна. И так каждый контрол, т.е. создана база контролов, в которых можно события пронумеровать с 1 и далее (на каждый контрол), наложив на них одинаковое действие, как в примере. В программе нет ни одного места использования контрола напрямую, только через сообщения. Окно так же ничего не знает о поведении контролов (списки-разрезы знает). На окно мы ставим с 1 и далее события, которые в основном раздают сообщения. Т.е. с контролами общаемся только через события окна, никаких прямых сообщений из разных мест прогр. нет, только через окно, так же поступаем и с др. окном, надо сделать refresh, посылаем сообщение окну, а оно контролам групповые сообщения. Думаю это все не очень нужно (мне точно), так сказал, наверно сгоряча. Зачем это, если можно исходники подправить, не сложно. Думается и другим корячится вряд ли захочется, тем более, что исп. OnInit и OnRelease можно, но это большая морока делать в КАЖДОМ окне, а до OnInit от _DefineWindow... как до луны.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1531
Зарегистрирован: 17.02.12
|
|
Отправлено: 13.06.17 19:38. Заголовок: PS совместное исполь..
PS цитата: | совместное использование псевдо-ООП и настоящих классов порождает |
| По мне, так положительные эмоции, можно написать с псевдо ООП, будет крутиь макро (чуть медленнее), но сделает. Можно исп. объект, будет ТОЖЕ работать, возможно, чуть быстрее, а при передаче его (объкта) в блок кода, так и писать удобнее, а с блоками сообщений (моя версия) именно так и происходит. У пользователя МиниГуи есть выбор, как писать, а сейчас его нет. Пишем только псевдо ООП, а если дурит препроцессор, в небольшом примере идет, в родной проге приходится уходить с псевдо на функции. Или сразу писать функциями. Тут тоже вопрос, а что лучше тогда ?
| |
|
Петр
|
| постоянный участник
|
Пост N: 1521
Зарегистрирован: 09.10.06
|
|
Отправлено: 13.06.17 21:56. Заголовок: SergKis пишет: Прис..
SergKis пишет: Знаете, я ровным счетом ничего не понял, что вы хотите сказать. Прямо какой-то поток сознания. Вы случайно во второй цитате или не видели? И кто вам посоветовал "как "в старом добром процедурном стиле" писать свои классы"? Вы можете вызвать TaskDialog из xhb? Рад за вас И что у вас вызвало столько эмоций в методе OnDestroyed?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1532
Зарегистрирован: 17.02.12
|
|
Отправлено: 14.06.17 10:05. Заголовок: Петр пишет Знаете, я..
Петр пишет цитата: | Знаете, я ровным счетом ничего не понял, что вы хотите сказать. |
| Боюсь не поймете, но попробую объяснить. На мое "с xhb дел не имел (кроме сборки letodb) никаких" и sourcе кодером становиться 'совершенно не стремлюсь" (xhb не нужен мне), вы, явно ерничая, даете советы (см. выше), особенно порадовало именно после или. Ваше "Вот, к примеру, в xhb реализация деструктора обьекта приводит к повреждению HVM памяти." навело на мысль, что просто свойство\переменную в Nil, недостаточно (со времен clipper хватало) и это вызвало эмоции, как же я работал до этого. И я, явно ерничая, побежал смотреть, как вы, применяете на практике, то что советуете ... Ваше "читать xhb-diff ... нужно знать их отличия (xhb-diff)", вызывает желание посоветовать почитать инструкцию по эксплуатации автомашины ГАЗ-51, там тоже есть отличия, при переключении передач от автомобиля ВАЗ. цитата: | Вы можете вызвать TaskDialog из xhb? Рад за вас |
| Опять фантазируете, ерничаете, я только сказал, что в xhb есть H_TaskDialog.prg, .т.е. включен в проект, работает он или нет, это др. вопрос. цитата: | Прямо какой-то поток сознания. |
| Надеюсь, я его расшифровал
| |
|
Петр
|
| постоянный участник
|
Пост N: 1522
Зарегистрирован: 09.10.06
|
|
Отправлено: 14.06.17 13:43. Заголовок: SergKis пишет: Ваше..
SergKis пишет: цитата: | Ваше "Вот, к примеру, в xhb реализация деструктора обьекта приводит к повреждению HVM памяти." навело на мысль |
| Вы не правильно интерпретировали мою подсказку. цитата: | Опять фантазируете, ерничаете, я только сказал, что в xhb есть H_TaskDialog.prg, .т.е. включен в проект |
| Нет, но могу вам напомнить, что я не мантайнер MiniGUI. К тому же "включен в проект" можно понимать по разному, то ли это значит, что файлы включены в поставку (архив/инсталятор), то ли используется файлом сборки (make файл/bat). В поставе "xhb (за деньги)" используется 2 вариант (с классами там действительно все в порядке )
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1116
Зарегистрирован: 11.02.10
|
|
Отправлено: 14.06.17 17:22. Заголовок: Петр пишет: могу ва..
Петр пишет: цитата: | могу вам напомнить, что я не мантайнер MiniGUI |
| Ребята, давайте жить дружно Подготовил очередную бетку для новой сборки 17.06 со следующим списком изменений Скрытый текст
* 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)
| Благодарю за оперативную помощь в подготовке этой сборки SergKis и Петра Без Вашей поддержки ничего бы не вышло... Кстати, команды ON APPEVENT/EMIT были вдохновлены SergKis Петр пишет: цитата: | SergKis подбросил интересную идею, попробую реализовать что-то подобное ON APPEVENT [NAME] <evName> [ID <id>] | [AUTO] EVAL <{block}> [ONCE] EMIT <evName> |
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1533
Зарегистрирован: 17.02.12
|
|
Отправлено: 14.06.17 19:27. Заголовок: Петр xhb, меня не и..
Петр xhb, меня не интересует в любом виде. Я, не распаковывая, глянул архив xhmg1705... и увидел, что увидел. Глянул команды из hbclass.ch и сделал вывод, что класс TWndData полностью отвечает требованиям xhb, т.е. не требует дополнительных #ifdef XHARBOUR для работы в xhb. Посмотрел и TsBrowse на предмет #ifdef их всего несколько строк, причем только 1 реальная, связанная с функ. CToT. Говорю, просто для информации, что и как посмотрел. Действительно, давайте закончим эту не интересную дискуссию.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1534
Зарегистрирован: 17.02.12
|
|
Отправлено: 14.06.17 22:49. Заголовок: gfilatov2002 пишет П..
gfilatov2002 пишет цитата: | Мне симпатичен Ваш подход, но совместное использование псевдо-ООП и настоящих классов порождает ненужное дублирование в ядре библиотеки.. |
| Я, скорее, рассердился на себя. Мой товарищ по работе, сразу сказал, не трать время, ни один класс окна и контрола не будет принят добровольно в МиниГуи, т.к. он практически хоронит псевдо ООП (Andrey пишет цитата: | Удобней кстати для использования. |
|
). Я, наивный, не поверил, т.е. "хотел как лучше ...". Так что я сильно рассердился на себя.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1117
Зарегистрирован: 11.02.10
|
|
Отправлено: 15.06.17 11:51. Заголовок: SergKis пишет: я си..
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
|
| постоянный участник
|
Пост N: 1535
Зарегистрирован: 17.02.12
|
|
Отправлено: 15.06.17 15:09. Заголовок: gfilatov2002 пишет о..
gfilatov2002 пишет цитата: | отсутствие внятной модели классов... наличие в предлагаемом коде избыточных пользовательских методов, которые должны добавляться наследованием от базового класса. |
| Я считал, что работаем в процедурной среде МиниГуи, а не среде грамотно спланированной цепочки классов. Т.к. практически исключил наследование. Как это делать в _HMG_aControlMiskData0[ i ][1] := <объект контрола> ? По этой причине сделал избыточные (немного) классы. Т.е. я отверг изначально oApp->oWindow->oWindowDialog ... Представленные классы - это скорей сложные процедуры\функции. Расширение свойств, методов - через функции объектов и примерно так, добавляем переменную в объект и присваиваем значение := oKeyData() получая сразу контейнер данных и исп. блоки с возможностью проводить групповые операции Eval() или Sum(). Т.е. с моделью я определился, она процедурная, как и МиниГуи. цитата: | смешивание визуальных и невизуальных методов в классах |
| хотелось бы конкретики По названиям, абсолютно, без разницы как будут называться, были бы в наличии.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1536
Зарегистрирован: 17.02.12
|
|
Отправлено: 15.06.17 15:17. Заголовок: PS Потом, я не знаю,..
PS Потом, я не знаю, будем делать и повторять в классе TAppData свойства\методы из App. ... псевдо ООП команд ? Если будем, сделать не сложно, тогда там будет регистрация окон (как контролов в окне), т.е. свои :oName, :oHand с доступом. Вопрос надо ли это сейчас ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1537
Зарегистрирован: 17.02.12
|
|
Отправлено: 15.06.17 15:26. Заголовок: PS Если вопрос насле..
PS Если вопрос наследования на первом месте (или замена класса полностью в переменной _HMG_aControlMiskData0[ i ][1])?, делаем это (к примеру) в функции oWndData(...). Если к примеру _HMG_bWndObject := bBlock выполняем и возвращаем что она дает из ф-ии oWndData, если не задан - как сейчас. Все по МиниГуи-шному
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1538
Зарегистрирован: 17.02.12
|
|
Отправлено: 15.06.17 15:51. Заголовок: gfilatov2002 пишет ..
gfilatov2002 пишет цитата: | в отличие от того же грамотно спланированного HwGui. |
| Основная причина - она брошена. В 2009 году она была 2004\5 года сборки. Сейчас ее состояние (внутреннее) практически не изменилось, только перевелась на hb3.2 с небольшими улучшениями и сменой названий функции. Потом, многие вещи оставлены на очень низком уровне - что надо собирайте сами, а инстукции\примеров нет, "догадайся мол сама". Мое мнение
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1118
Зарегистрирован: 11.02.10
|
|
Отправлено: 15.06.17 16:16. Заголовок: SergKis пишет: Все ..
SergKis пишет: Замечательно, тогда присылайте мне по почте предлагаемые изменения, будем рассмативать их для будущих сборок SergKis пишет: цитата: | Основная причина - она брошена. |
| Согласен. Но чтобы этого не случилось с Минигуи, необходимы стимулы, в т.ч. Ваша поддержка и предложения по улучшению кода. Я не устаю повторять, что всегда открыт для новых улучшений, но только после их критического пересмотра
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1539
Зарегистрирован: 17.02.12
|
|
Отправлено: 15.06.17 17:17. Заголовок: gfilatov2002 пишет н..
gfilatov2002 пишет цитата: | но только после их критического пересмотра |
| Кто б возражал, я не буду. После выхода new версии, надо присмотреться (я пляшу от своей) к коду, пришлю.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1540
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.06.17 07:05. Заголовок: gfilatov2002 пишет п..
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
|
| постоянный участник
|
Пост N: 715
Зарегистрирован: 13.10.05
|
|
Отправлено: 16.06.17 08:20. Заголовок: ООП , пусть да же п..
ООП , пусть да же псевдо, нельзя хоронить ни в коем случае. Наоборот - надо развивать. Это же удобно.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1541
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.06.17 09:11. Заголовок: Vlad04 пишет ООП , п..
Vlad04 пишет цитата: | ООП , пусть да же псевдо, нельзя хоронить ни в коем случае. Наоборот - надо развивать. Это же удобно. |
| Даже в мыслях нет. Объекты расширят возможности (могут добавиться команды псевдо ООП), сразу получите: - списки типов контролов на окно - списки контролов на окно - сможете получить массив объектов запрошенных типов\имен контролов по равно или вхождению и в цикле запустить этот список, к примеру для refresh гляньте пример, выкладывал выше, Toolbar в середине
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1542
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.06.17 09:19. Заголовок: gfilatov2002 Класс ..
gfilatov2002 Класс TKeyData в целом готов, выложу, для анализа и предложений сейчас Скрытый текст
/* * Создание объекта класса 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
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1543
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.06.17 09:22. Заголовок: PS _METHOD ... это у..
PS _METHOD ... это у меня #define _METHOD METHOD что бы не дублировались объявления с реальными методами при работе с проектом - список Entyti на экране
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1544
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.06.17 09:28. Заголовок: Петр Спасибо за DEST..
Петр Спасибо за DESTRUCTORв hb, работает.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1545
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.06.17 13:01. Заголовок: SergKis пишет * П..
SergKis пишет цитата: | * Пример: 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")) |
| Если дополнить * Пример: 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!') то повесив в new версии эту ф-ю на APPEVENT от Петра, можно в блоке кода скинуть, полученные итоги на контролы, которым были даны имена ключей (в блоке можем сделать): 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"))) ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1546
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.06.17 13:32. Заголовок: PS в ToItog можно и ..
PS в ToItog можно и так вывести данные на контролы цитата: | AEval(o:Eval(), {|ky,uv,ni| win_1.&(ky).Value := cValToChar(uv), ni := ky }) |
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1547
Зарегистрирован: 17.02.12
|
|
Отправлено: 17.06.17 14:40. Заголовок: Кому интересно. Выкл..
Кому интересно. Выкладываю классы для vm и vmmt режимов hb. Скрытый текст
*-----------------------------------------------------------------------------* 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
| Пример, который выкладывал ранее, работает и там и там.
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5417
Зарегистрирован: 12.09.06
|
|
Отправлено: 17.06.17 14:57. Заголовок: SergKis пишет: Кому..
SergKis пишет: цитата: | Кому интересно. Выкладываю классы для vm и vmmt режимов hb. |
| Да всем будет интересно. Не сейчас, так позже понадобиться. gfilatov пишет: цитата: | Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне |
| Григорий включи пожалуйста в библиотеку. А то проработанные и хорошие идеи пропадают !
| |
|
Петр
|
| постоянный участник
|
Пост N: 1525
Зарегистрирован: 09.10.06
|
|
Отправлено: 17.06.17 23:26. Заголовок: Andrey пишет: А то ..
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
|
| постоянный участник
|
Пост N: 1548
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.06.17 14:36. Заголовок: Петр Спасибо за кон..
Петр Спасибо за конкретные вопросы. цитата: | такого 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(), то что он пустышка - это частный случай Если бы сделал 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 ) то исп. в нем ::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 мы имеем чуть другое
| |
|
Петр
|
| постоянный участник
|
Пост N: 1526
Зарегистрирован: 09.10.06
|
|
Отправлено: 18.06.17 16:22. Заголовок: SergKis пишет: Это ..
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
|
| постоянный участник
|
Пост N: 1549
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.06.17 17:41. Заголовок: Петр пишет Т.е. ради..
Петр пишет цитата: | Т.е. ради сомнительного синтаксического сиропа вы просто так добавили еще один метод, который и не нужен честно говоря. |
| Если вы считаете, что привыкнув писать с псевдо ООП .Show или .Show(), дадим только:Show(), нет вопросов убирайте. А "добавили еще один метод, который и не нужен честно говоря" - это из серии "сколько бухгалтеров столько и бухгалтерий". цитата: | От кого вы скрыли, oObj находится в PROTECTED и не может использоваться вне класса. |
| Вообще то, есть правила хорошего тона при программировании, сообщать, что хранится в веденной переменной. Введя o я сказал, что там объект и не надо делать операций проверок и не важно в какой области класса эта переменная. Что бы не было как TsColumn :nAlign - вроде для числа, а там и блоки и ...., про TsBrowse вообще молчу. цитата: | Почему в ASSIGN нет никаких проверок и в чем прикол хранить в переменной обьекта ссылку на сам обьект? |
| Про какое место разговор. если про TKeyData, то я написал "то в блоки кода метода Do(...) передается значение Obj, иначе Self. " и применил 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 ) т.е. в блоки кода будет передан объект окна или контрола, а не только свой 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') ...
| |
|
Петр
|
| постоянный участник
|
Пост N: 1527
Зарегистрирован: 09.10.06
|
|
Отправлено: 18.06.17 23:23. Заголовок: SergKis пишет: Если..
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
|
| постоянный участник
|
Пост N: 1550
Зарегистрирован: 17.02.12
|
|
Отправлено: 19.06.17 15:25. Заголовок: Петр пишет Венгерс..
Петр пишет цитата: | Венгерская нотация еще никому ничего не гарантировала, тем более в нетипизированных языках Так, что за необходимость хранить в переменной обьекта ссылку на сам обьект? Ну написали, я прочитал и что? Почему так "кучеряво" написали? |
| 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(). 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 можно не делать цитата: | Эта функция линкуется в любой 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 в потоке окно ... это я ничего не трогал и безопасность не обеспечивал.
| |
|
Петр
|
| постоянный участник
|
Пост N: 1528
Зарегистрирован: 09.10.06
|
|
Отправлено: 19.06.17 21:41. Заголовок: SergKis пишет: Если..
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
|
| постоянный участник
|
Пост N: 1551
Зарегистрирован: 17.02.12
|
|
Отправлено: 20.06.17 11:41. Заголовок: Петр пишет нафиг не ..
Петр пишет цитата: | нафиг не нужен, он там за уши притянут, как и большинство ваших 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 или просто метод) 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 ) цитата: | :Show и :Show() - разницу в затратах ЧЕЛОВЕЧЕСКИХ определите? Есть ведь еще сопровождение и там затраты ничуть не меньше. Каждый раз в исходники лезть не очень то и комфортно. |
| В данном случае, вы определили только программистские затраты и не учли затраты эксплуатационные. Т.е. не дали :Show. Пользователь hmg, неважно каким способом, написал где то в одном месте так. Проверял ..., (что бы все режимы проверить, возможно, надо держать человека или группу), но отвлекли, ..., пропустил. Ушло в эксплуатацию, режим с ошибкой редкий, раз в месяц. И как, бутерброд с маслом, вылезет в неподходящее время. И что дороже, продублировать несколько строк, в каждой исправив несколько букв или заложить мину ? Я говорю о данном случае, а не вообще ... . цитата: | В GetListType oType нафиг не нужен |
| Предложите реализацию получения уникального списка типов по другому. Я сделал так.
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5423
Зарегистрирован: 12.09.06
|
|
Отправлено: 20.06.17 12:45. Заголовок: Петр да помоги напис..
Петр да помоги написать как нужно и всех делов то... Меньше ругани - больше дела !
| |
|
Петр
|
| постоянный участник
|
Пост N: 1530
Зарегистрирован: 09.10.06
|
|
Отправлено: 20.06.17 13:26. Заголовок: Andrey пишет: Петр ..
Andrey пишет: цитата: | Петр да помоги написать как нужно и всех делов то... |
| Кому от этого легче станет? Пускай человек учится..
| |
|
Петр
|
| постоянный участник
|
Пост N: 1531
Зарегистрирован: 09.10.06
|
|
Отправлено: 20.06.17 13:36. Заголовок: Петр пишет: через A..
Петр пишет: цитата: | через 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
|
| moderator
|
Пост N: 1120
Зарегистрирован: 11.02.10
|
|
Отправлено: 21.06.17 11:31. Заголовок: Завершена подготовка..
Завершена подготовка новой сборки 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
|
| moderator
|
Пост N: 1121
Зарегистрирован: 11.02.10
|
|
Отправлено: 22.06.17 10:46. Заголовок: Опубликована очередн..
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1552
Зарегистрирован: 17.02.12
|
|
Отправлено: 22.06.17 22:22. Заголовок: Я в отдыхе, на бегу ..
Я в отдыхе, на бегу отвечаю. Петр пишет цитата: | И не пишите, пожалуйста, то чего не знаете |
| Для hb2.0 знаю, для hb3.2 (думал, что знаю, но сбился на ваше сообщение о DESTRUCTOR), потребовалось время, что бы уточнить. цитата: | Я привел вам пример (destruct.prg) - там и деструктор и неявный конструктор init.. |
| Вы привели все правильно, но для не типизированных классов. В типизированном\строго типизированном это отключено т.к. hb наследник clipper. И написанная, мной, инф. это подвержтает, деструктор валится в отличии от VO. цитата: | я не знаю как на это реагировать, ну типа плакать или смеяться |
| Можете спеть, станцевать - ваше дело. У нас свободная страна. Но я не просил реагировать, инициатива от вас. цитата: | Значит класс не закончен и смотреть не на что. |
| С классами, как с ремонтом, можно бросить, приостановить, но закончить ... Для приведенного примера, его (класса) состояние вполне достаточное. Andrey пишет цитата: | да помоги написать как нужно и всех делов то... |
| Андрей, не бери в голову, у Петра такая манера, сказать A и не говорить Б. Как у тех, из за лужи: "Мы знаем, что это сделал (вы сами знаете кто). У нас факты, но не скажем, потому что секретные." Haz говорил, что у тебя есть очень секретный код (не хочешь делиться), вот и у Петра есть тааакой секретный код, что я цитата: | есть ... не могу, спать ... не могу, вот пить ... начал. Фотографии нет ? Фотографии нет ! |
| А фотографии кода нет. цитата: | Не учите меня жить, лучше помогите материально. |
| О.Бендер.
| |
|
Петр
|
| постоянный участник
|
Пост N: 1535
Зарегистрирован: 09.10.06
|
|
Отправлено: 22.06.17 23:21. Заголовок: SergKis пишет: Вы п..
SergKis пишет: цитата: | Вы привели все правильно, но для не типизированных классов. В типизированном\строго типизированном это отключено т.к. hb наследник clipper. |
| Нет никаких типизированных или не типизированных классов, по крайней мере, в hb. В MiniGUI так их точно нет SergKis пишет: цитата: | И написанная, мной, инф. это подвержтает, деструктор валится в отличии от VO. |
| Ну вы уже писали, что в hb нет деструкторов. Теперь, из ваших слов можно сделать вывод, что есть, но работают не правильно. Самодостаточный пример в devel list вам поможет (не материально ).
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1122
Зарегистрирован: 11.02.10
|
|
Отправлено: 23.06.17 11:22. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Опубликована очередная сборка 17.06 для BCC 5.51 |
| Сделал быстрое обновление новой сборки с учетом последних наработок Петра, которые были опубликованы на форуме. Список изменений см. ниже Скрытый текст
* New: Added the following new commands for managing of the Windows events: - ON WINEVENT [ID] <nId> ACTION <bAction> OF <window> ; [NOACTIVE>] [ONCE>] [RESULT] TO <lResult>. - REMOVE WINEVENT [[ID] [<nId>] | ALL] OF <window> ; [ONCE>] [RESULT] TO <lResult>. - UPDATE WINEVENT [ID] <nId> [ACTION <bAction>] OF <window> ; [NOACTIVE>] [ONCE>] [RESULT] TO <lResult>. Contributed by Petr Chornyj <myorg63@mail.ru> (see demos in folder \samples\Advanced\MESSAGEONLY_WINDOW) * Updated: The Windows events and the Application events are available for xHarbour compiler also. Contributed by Petr Chornyj <myorg63@mail.ru> (see demo in folder \samples\Advanced\AppEvents) * Updated: A thread safe lock/unlock into the Global Listener C-code is available for xHarbour compiler also. Contributed by Petr Chornyj <myorg63@mail.ru>
| Прямая ссылка на архив http://hmgextended.com/files/CONTRIB/hmg-17.06.7z
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1123
Зарегистрирован: 11.02.10
|
|
Отправлено: 26.06.17 10:38. Заголовок: Сделал второе обновл..
Сделал второе обновление новой сборки с учетом последних изменений Си-кода. Список изменений см. ниже Скрытый текст
* Fixed: A C-code cleaning for the warnings at Visual C 2017 compiler with a warning level is established to Yes in hbmk2 utility. The above warnings were found into the Minigui core and TSBrowse library. It was a postponed modification for a core stability. Contributed by Grigory Filatov <gfilatov@inbox.ru>
| Прямая ссылка на архив этой сборки http://hmgextended.com/files/CONTRIB/hmg-17.06.7z Благодарю за Ваше внимание
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1557
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.06.17 09:31. Заголовок: gfilatov2002 1. По ..
gfilatov2002 1. По поводу SET EVENTS FUNCTION TO ... Для mdi окон не работает. Берем пример Mdi\demo.prg, добавляем ... Скрытый текст
Function Main SET EVENTS FUNCTION TO App_OnEvents Public nChild := 0 ... FUNCTION App_OnEvents( hWnd, nMsg, wParam, lParam ) _LogFile(.T., procname(),hwnd,nmsg) RETURN Events( hWnd, nMsg, wParam, lParam )
| 2. Вернусь к предложению с _HMG_переменными, для возможности встраиваться в hmg со своими тараканами (через почту не буду, ничего не установлено, не пользую у себя). Скрытый текст
- ввести переменные _HMG_bFormInit _HMG_bFormDestroy _HMG_bControlInit _HMG_bControlDestroy _HMG_bWm_User _HMG_bWm_App - в _Define... для окон (где наличие _HMG_aFormMiskData1\2) перед выходом из ф-ии делать If HB_ISBLOCK( _HMG_bFormInit ) EVal( _HMG_bFormInit, k, cVar ) // k - индекс (где то он i возможно) EndIf // cVar - имя переменной RETURN ... - h_window.prg Function ReleaseAllWindows () ... For Each FormHandle In _HMG_aFormHandles ... if _HMG_aFormActive [ i ] == .T. _DoWindowEventProcedure ( _HMG_aFormReleaseProcedure [ i ] , i , 'WINDOW_RELEASE' ) If HB_ISBLOCK( _HMG_bFormDestroy ) EVal( _HMG_bFormDestroy, i ) EndIf ... Function _ReleaseWindow ( FormName ) i := GetFormIndex ( Formname ) hWindowHandle := _HMG_aFormHandles [ i ] * Release Window If HB_ISBLOCK( _HMG_bFormDestroy ) EVal( _HMG_bFormDestroy, i ) EndIf ... - в _Define... для контролов (наличие _HMG_aControlMiskData1\2) перед выходом из ф-ии делать If HB_ISBLOCK( _HMG_bControlInit ) EVal( _HMG_bControlInit, k, cVar ) // k - индекс (где то он i возможно) EndIf // cVar - имя переменной RETURN ... - добавить Function _EraseControl (i, p) ... If HB_ISBLOCK( _HMG_bControlDestroy ) EVal( _HMG_bControlDestroy, i ) EndIf ... // названия условные #define WM_USER_HMG WM_USER + ... #define WM_APP_HMG WM_APP + ... Function Events ( hWnd, nMsg, wParam, lParam ) ... *********************************************************************** case WM_USER_HMG *********************************************************************** If HB_ISBLOCK( _HMG_bWM_User ) EVal( _HMG_bWm_User, hWnd, nMsg, wParam, lParam ) EndIf exit *********************************************************************** case WM_APP_HMG *********************************************************************** If HB_ISBLOCK( _HMG_bWM_App ) EVal( _HMG_bWm_App, hWnd, nMsg, wParam, lParam ) EndIf exit ...
| Делать вне _Define... _HMG_b...Init можно, но это равносильно написанию своих _Define..2, а в ON INIT делать не интересно (еще и писать везде), т.к. нужно до WINDOW ACTIVATE ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1558
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.06.17 09:53. Заголовок: PS По мне, лучше сде..
PS По мне, лучше сделать два WM_USER_HMG (как у меня в предложениях выше), для окна и для контртрола (проще управление в блоке кода - он один), но не настаиваю, минимизирую
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1125
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.06.17 11:08. Заголовок: SergKis Да, команда..
SergKis Да, команда SET EVENTS FUNCTION TO не работает для mdi окон. Для mdi child потребуется новая команда SET MDIEVENTS FUNCTION TO SergKis пишет: цитата: | Вернусь к предложению с _HMG_переменными |
| Выполнил эти правки для текущего кода с небольшим изменением имени этих блоков кода. Но вместо использования блоаов _HMG_bWm_User и _HMG_bWm_App предлагаю использовать новые команды ON WINUSER и ON WINAPP Присылайте реальное наполнение для новых блоков кода и свежую редакцию Ваших классов (если такая есть). Мой пример для проверки функциональности кода см. ниже Скрытый текст
#include "minigui.ch" DECLARE WINDOW Win_2 FUNCTION Main LOCAL i, cForm _HMG_bOnFormInit := {|i,c| MsgInfo(i,"Init of "+c)} _HMG_bOnFormDestroy := {|i| MsgInfo(i,"Destroy of "+_HMG_aFormNames [ i ])} _HMG_bOnControlInit := {|i,c| MsgInfo(i,"Init of "+c)} _HMG_bOnControlDestroy := {|i,p| MsgDebug("Destroy control ",_HMG_aControlNames [ i ]," of ",_HMG_aFormNames [ p ])} DEFINE WINDOW Win_1 ; MAIN ; TITLE 'Hello World!' ; ON GOTFOCUS iif( IsWindowDefined( Win_2 ) .AND. iswinnt(), Win_2.Setfocus(), NIL ) END WINDOW DEFINE WINDOW Win_2 ; CHILD ; TITLE 'Child Window' END WINDOW DEFINE WINDOW Win_3 ; MODAL ; TITLE 'Modal Window' @ 100,100 BUTTON Button_11 CAPTION "Click " WIDTH 100 HEIGHT 30 ACTION MsgInfo("Click!") END WINDOW FOR i := 1 TO 3 cForm := "Win_" + Str( i, 1 ) _DefineHotKey( cForm, 0, VK_ESCAPE, hb_MacroBlock( "_ReleaseWindow('" + cForm + "')" ) ) NEXT Win_2.Center Win_3.Center ACTIVATE WINDOW Win_3, Win_2, Win_1 RETURN NIL
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1559
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.06.17 14:47. Заголовок: gfilatov2002 пишет Н..
gfilatov2002 пишет цитата: | Но вместо использования блоаов _HMG_bWm_User и _HMG_bWm_App предлагаю использовать новые команды ON WINUSER и ON WINAPP |
| Как то не перекладывается мой пример на эти команды (регистрация событий от 1,2, ... на каждое окно и каждый контрол), особенно, если окон (контролов на них) много. Использование WINAPP, кроме присвоения каждому окну уникального номера для доступа к кофигуратору, не вижу. С WINUSER совсем не понятно, где использовать, кроме прерывания циклов работы с базой. цитата: | Присылайте реальное наполнение для новых блоков кода и свежую редакцию Ваших классов (если такая есть). |
| Позже, пока в отдыхе
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1126
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.06.17 15:45. Заголовок: SergKis пишет: не п..
SergKis пишет: цитата: | не перекладывается мой пример на эти команды |
| Понимаю, поэтому добавил два пользовательских события и их обработку (события WM_WND_LAUNCH и WM_CTL_LAUNCH, их обработчики - кодоблоки _HMG_bWndLaunch и _HMG_bСtlLaunch). SergKis пишет: Буду ждать...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1560
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.07.17 11:57. Заголовок: gfilatov2002 пишет Б..
gfilatov2002 пишет Переназвал кодоблоки _HMG_bWndLaunch и _HMG_bСtlLaunch на _HMG_bOnWndLaunch и _HMG_bOnСtlLaunch На своей lib собрал пример http://my-files.ru/bzb7lk Классы Скрытый текст
// Misk class, function #include "minigui.ch" #include "hbclass.ch" *-----------------------------------------------------------------------------* FUNCTION oWndData( nIndex, cName, nHandle, nParent, cType, cVar ) *-----------------------------------------------------------------------------* LOCAL o Default nIndex := 0, ; cName := '', ; nHandle := 0, ; nParent := 0, ; cType := '', ; cVar := '' If empty(nIndex) .or. empty(nHandle) .or. empty(cName) RETURN o EndIf o := TWndData():New():Def( nIndex, cName, nHandle, nParent, cType, cVar ) RETURN o /////////////////////////////////////////////////////////////////////////////// CLASS TWndData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR cVar INIT '' VAR cName INIT '' VAR cType INIT '' VAR nIndex INIT 0 VAR nHandle INIT 0 VAR nParent INIT 0 VAR cChr INIT ',' CLASSDATA oProp AS OBJECT INIT oKeyData() CLASSDATA oName AS OBJECT INIT oKeyData() CLASSDATA oHand AS OBJECT INIT oKeyData() EXPORTED: VAR oCargo AS OBJECT VAR oUserKeys AS OBJECT VAR oEvent AS OBJECT METHOD New() INLINE ( Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::nIndex := nIndex , ::cName := cName, ::nHandle := nHandle, ; ::nParent := nParent, ::cType := cType, ::cVar := cVar, ; ::oCargo := oKeyData(), ::oUserKeys := oKeyData(), ; ::oEvent := oKeyData(Self), ; hmg_SetWindowObject(::nHandle, Self), ; Self ) ACCESS Index INLINE ::nIndex ACCESS Name INLINE ::cName ACCESS Handle INLINE ::nHandle ACCESS Parent INLINE ::nParent ACCESS Type INLINE ::cType ACCESS VarName INLINE ::cVar ACCESS Row INLINE GetWindowRow ( ::nHandle ) ACCESS Col INLINE GetWindowCol ( ::nHandle ) ACCESS Width INLINE GetWindowWidth ( ::nHandle ) ACCESS Height INLINE GetWindowHeight( ::nHandle ) ACCESS ClientWidth INLINE _GetClientRect ( ::nHandle )[ 3 ] ACCESS ClientHeight INLINE _GetClientRect ( ::nHandle )[ 4 ] ACCESS Title INLINE GetWindowText ( ::nHandle ) ACCESS Cargo INLINE _WindowCargo( Self ) ASSIGN Cargo( xVal ) INLINE _WindowCargo( Self, xVal ) ACCESS IsWindow INLINE .T. ACCESS IsControl INLINE .F. ACCESS Chr INLINE ::cChr ASSIGN Chr( cChr ) INLINE ::cChr := iif( HB_ISCHAR(cChr), cChr, ::cChr ) ACCESS WM_nMsgW INLINE WM_WND_LAUNCH ACCESS WM_nMsgC INLINE WM_CNL_LAUNCH METHOD SetProp( xKey, xVal ) INLINE ::oProp:Set( xKey, xVal ) METHOD GetProp( xKey ) INLINE ::oProp:Get( xKey ) METHOD DelProp( xKey ) INLINE ::oProp:Del( xKey ) METHOD UserKeys( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ; ::oUserKeys:Set( Key, Block ), ; ::oUserKeys:Do ( Key, Block, p2, p3 ) ) METHOD Event ( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ; ::oEvent:Set( Key, Block ), ; ::oEvent:Do ( Key, Block, p2, p3 ) ) METHOD PostMsg( nKey, nHandle ) INLINE PostMessage( ::nHandle, ::WM_nMsgW, nKey, ; hb_defaultValue(nHandle, 0) ) METHOD SendMsg( nKey, nHandle ) INLINE SendMessage( ::nHandle, ::WM_nMsgW, nKey, ; hb_defaultValue(nHandle, 0) ) _METHOD DoEvent( Key, nHandle ) _METHOD GetListType() _METHOD GetObj4Type( cType ) _METHOD GetObj4Name( cName ) METHOD GetObj( xName ) INLINE iif( HB_ISCHAR(xName), ::oName:Get(xName), ; ::oHand:Get(xName) ) METHOD Destroy() INLINE ( hmg_DelWindowObject( ::nHandle ), ; iif( HB_ISOBJECT(::oCargo ) , ::oCargo:Destroy() , Nil ), ; iif( HB_ISOBJECT(::oEvent ) , ::oEvent:Destroy() , Nil ), ; iif( HB_ISOBJECT(::oName ) , ::oName:Destroy() , Nil ), ; iif( HB_ISOBJECT(::oHand ) , ::oHand:Destroy() , Nil ), ; iif( HB_ISOBJECT(::oProp ) , ::oProp:Destroy() , Nil ), ; iif( HB_ISOBJECT(::oUserKeys) , ::oUserKeys:Destroy() , Nil ), ; ::oCargo := ::oEvent := ::oName := ::nHandle := ::cVar := Nil, ; ::oUserKeys := ::cType := ::cChr := ::cName := Nil, ; ::nIndex := ::nParent := ::oProp := ::oHand := Nil ) ENDCLASS /////////////////////////////////////////////////////////////////////////////// METHOD GetListType() CLASS TWndData LOCAL oType := oKeyData() LOCAL aType := {} ::oName:Eval({|o| oType:Set(o:cType, o:cType) }) aType := oType:Eval(.T.) oType:Destroy() oType := Nil RETURN aType METHOD GetObj4Type( cType, lEque ) CLASS TWndData LOCAL aObj := {} If ! empty(cType) lEque := hb_defaultValue(lEque, .T.) If ::cChr $ cType; lEque := .F. EndIf FOR EACH cType IN hb_ATokens(upper(cType), ::cChr) ::oName:Eval({|oc| iif( lEque, iif( cType == oc:cType, aAdd(aObj, oc), ), ; iif( cType $ oc:cType, aAdd(aObj, oc), ) ) }) NEXT EndIf RETURN aObj METHOD GetObj4Name( cName ) CLASS TWndData LOCAL aObj := {} If ! empty(cName) FOR EACH cName IN hb_ATokens(cName, ::cChr) ::oName:Eval({|oc| iif( cName $ oc:cName, aAdd(aObj, oc), Nil ) }) NEXT EndIF RETURN aObj METHOD DoEvent ( Key, nHandle ) CLASS TWndData LOCAL o := iif( hmg_IsWindowObject(nHandle), hmg_GetWindowObject(nHandle), Self ) If o:IsWindow RETURN Do_WindowEventProcedure ( ::oEvent:Get(Key), o:Index, o, Key ) EndIf RETURN Do_ControlEventProcedure( ::oEvent:Get(Key), o:Index, o, Key ) *-----------------------------------------------------------------------------* FUNCTION oCnlData( nIndex, cName, nHandle, nParent, cType, cVar, oWin ) *-----------------------------------------------------------------------------* LOCAL o, ob Default nIndex := 0, ; cName := '', ; nHandle := 0, ; nParent := 0, ; cType := '', ; cVar := '' If empty(nIndex) .or. empty(nHandle) .or. empty(nParent) .or. empty(cName); RETURN o EndIf Default oWin := hmg_GetWindowObject( nParent ) If HB_ISOBJECT(oWin) If cType == 'TBROWSE' ob := _HMG_aControlIds [ nIndex ] o := TTsbData():New( oWin, ob ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) Else o := TCnlData():New( oWin ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) EndIf EndIf RETURN o /////////////////////////////////////////////////////////////////////////////// CLASS TCnlData INHERIT TWndData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oWin AS OBJECT EXPORTED: METHOD New( oWnd ) INLINE ( ::Super:New(), ::oWin := oWnd, Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::Super:Def(nIndex, cName, nHandle, nParent, cType, cVar), ; ::Set(), hmg_SetWindowObject( ::nHandle, Self ), ; Self ) ACCESS Title INLINE ::oWin:cTitle ACCESS Caption INLINE _GetCaption ( ::cName, ::oWin:cName ) ACCESS Cargo INLINE _ControlCargo( Self ) ASSIGN Cargo( xVal ) INLINE _ControlCargo( Self, , xVal ) ACCESS Window INLINE ::oWin ACCESS IsWindow INLINE .F. ACCESS IsControl INLINE .T. METHOD PostMsg( nKey ) INLINE PostMessage( ::oWin:nHandle, ::WM_nMsgC, nKey, ::nHandle ) METHOD SendMsg( nKey ) INLINE SendMessage( ::oWin:nHandle, ::WM_nMsgC, nKey, ::nHandle ) METHOD Set() INLINE ( ::oName:Set( ::cName , Self ), ; ::oHand:Set( ::nHandle, Self ) ) METHOD Del() INLINE ( ::oName:Del( ::cName ), ; ::oHand:Del( ::nHandle ) ) METHOD Get( xName ) INLINE iif( HB_ISCHAR(xName), ::oName:Get(xName), ; ::oHand:Get(xName) ) ACCESS Value INLINE _GetValue( , , ::nIndex ) ASSIGN Value( xVal ) INLINE ( _SetValue( , , xVal, ::nIndex ), ; _GetValue( , , ::nIndex ) ) ACCESS SetFocus INLINE _SetFocus ( ::cName, ::oWin:cName ) METHOD SetFocus() INLINE _SetFocus ( ::cName, ::oWin:cName ) ACCESS Disable INLINE _DisableControl( ::cName, ::oWin:cName ) METHOD Disable( nPos ) INLINE _DisableControl( ::cName, ::oWin:cName, nPos ) ACCESS Enable INLINE _EnableControl ( ::cName, ::oWin:cName ) METHOD Enable ( nPos ) INLINE _EnableControl ( ::cName, ::oWin:cName, nPos ) ACCESS Enabled INLINE GetProperty( ::oWin:cName, ::cName, 'Enabled' ) METHOD Enabled( nPos ) INLINE GetProperty( ::oWin:cName, ::cName, 'Enabled', nPos ) ACCESS Show INLINE _ShowControl ( ::cName, ::oWin:cName ) METHOD Show() INLINE _ShowControl ( ::cName, ::oWin:cName ) ACCESS Hide INLINE _HideControl ( ::cName, ::oWin:cName ) METHOD Hide() INLINE _HideControl ( ::cName, ::oWin:cName ) _METHOD DoEvent ( Key, nHandle ) METHOD Destroy() INLINE ( ::Del(), hmg_DelWindowObject( ::nHandle ), ; iif( HB_ISOBJECT(::oCargo ) , ::oCargo:Destroy() , Nil ), ; iif( HB_ISOBJECT(::oEvent ) , ::oEvent:Destroy() , Nil ), ; iif( HB_ISOBJECT(::oOnEventBlock ), ::oOnEventBlock:Destroy(), Nil ), ; iif( HB_ISOBJECT(::oName ) , ::oName:Destroy() , Nil ), ; iif( HB_ISOBJECT(::oHand ) , ::oHand:Destroy() , Nil ), ; iif( HB_ISOBJECT(::oUserKeys) , ::oUserKeys:Destroy() , Nil ), ; ::nParent := ::nIndex := ::cName := ::cType := Nil, ; ::oUserKeys := ::oCargo := ::oEvent := ::cVar := Nil, ; ::oOnEventBlock := ::cChr := ::nHandle := Nil ) ENDCLASS /////////////////////////////////////////////////////////////////////////////// METHOD DoEvent ( Key, nHandle ) CLASS TCnlData LOCAL o := iif( hmg_IsWindowObject(nHandle), hmg_GetWindowObject(nHandle), Self ) RETURN Do_ControlEventProcedure( ::oEvent:Get(Key), o:Index, o, Key ) /////////////////////////////////////////////////////////////////////////////// CLASS TTsbData INHERIT TCnlData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oTBrowse AS OBJECT EXPORTED: METHOD New( oWnd, oTsb ) INLINE ( ::Super:New(oWnd), ::oTBrowse := oTsb, Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::Super:Def(nIndex, cName, nHandle, nParent, cType, cVar), ; ::Set(), hmg_SetWindowObject( ::nHandle, Self ), ; Self ) ACCESS Caption INLINE ::oWin:cName + "." + ::cName ACCESS Tsb INLINE ::oTBrowse METHOD Destroy() INLINE ( ::Super:Destroy(), ::oTBrowse := Nil ) ENDCLASS /////////////////////////////////////////////////////////////////////////////// *-----------------------------------------------------------------------------* FUNCTION oKeyData( Obj, Event ) *-----------------------------------------------------------------------------* LOCAL o If HB_ISNIL ( Event ) ; o := TKeyData():New():Def( Obj ) ElseIf HB_ISLOGICAL( Event ) .and. Event; o := TWmEData():New( Obj ) Else ; o := TThrData():New():Def( Obj, hb_mtvm() ) EndIf RETURN o ////////////////////////////////////////////////////////////////////////////////////////////// CLASS TWmEData ////////////////////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oObj AS OBJECT VAR aMsg INIT hb_Hash() VAR lMsg INIT .F. EXPORTED: METHOD New( o ) INLINE ( ::oObj := o, Self ) CONSTRUCTOR ACCESS IsEvent INLINE ::lMsg METHOD Set( nMsg, Block ) INLINE ( hb_HSet ( ::aMsg, nMsg, Block ), ::lMsg := Len( ::aMsg ) > 0 ) METHOD Get( nMsg, Def ) INLINE hb_HGetDef( ::aMsg, nMsg, Def ) METHOD Del( nMsg ) INLINE ( hb_HDel ( ::aMsg, nMsg ), ::lMsg := Len( ::aMsg ) > 0 ) _METHOD Do ( nMsg, wParam, lParam ) _METHOD Destroy() ENDCLASS ////////////////////////////////////////////////////////////////////////////////////////////// METHOD Do( nMsg, wParam, lParam ) CLASS TWmEData LOCAL o, r, b := ::Get( nMsg ) If HB_ISBLOCK( b ) o := ::Obj If o:IsWindow r := Do_WindowEventProcedure ( b, o:Index, o, nMsg, wParam, lParam ) // {|ow,nm,wp,lp| ... } Else r := Do_ControlEventProcedure( b, o:Index, o, nMsg, wParam, lParam ) // {|oc,nm,wp,lp| ... } EndIf EndIf RETURN iif( empty( r ), 0, 1) METHOD Destroy() CLASS TWmEData LOCAL i, k If HB_ISHASH( ::aMsg ) For i := 1 To Len( ::aMsg ) k := hb_HKeyAt( ::aMsg, i ) hb_HSet( ::aMsg, k, Nil ) hb_HDel( ::aMsg, k ) Next EndIf ::oObj := ::aMsg := Nil RETURN Nil ////////////////////////////////////////////////////////////////////////////////////////////// CLASS TKeyData ////////////////////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oObj AS OBJECT VAR aKey INIT hb_Hash() VAR lKey INIT .F. EXPORTED: VAR Cargo METHOD New() INLINE ( Self ) CONSTRUCTOR METHOD Def( o ) INLINE ( ::Obj := o, Self ) METHOD Set( Key, Block ) INLINE ( hb_HSet ( ::aKey, Key, Block ), ::lKey := .T. ) METHOD Get( Key, Def ) INLINE hb_HGetDef( ::aKey, Key, Def ) METHOD Del( Key ) INLINE ( hb_HDel ( ::aKey, Key ), ::lKey := Len( ::aKey ) > 0 ) METHOD Do ( Key, p1, p2, p3 ) BLOCK {|Self,Key,p1,p2,p3,b| b := ::Get(Key), ; iif( HB_ISBLOCK(b), EVal(b, ::oObj, Key, p1, p2, p3), Nil ) } ACCESS Obj INLINE ::oObj ASSIGN Obj( o ) INLINE ::oObj := iif( HB_ISOBJECT(o), o, Self ) ACCESS Len INLINE Len( ::aKey ) ACCESS IsEvent INLINE ::lKey METHOD IsBLock( Key ) INLINE HB_ISBLOCK( ::Get(Key) ) _METHOD Eval( Block ) _METHOD Sum( Key, xSum ) _METHOD Destroy() ENDCLASS ////////////////////////////////////////////////////////////////////////////////////////////// METHOD Eval( Block ) CLASS TKeyData LOCAL m, i, b := HB_ISBLOCK(Block) LOCAL l := HB_ISLOGICAL(Block) .and. Block LOCAL a := iif( b, Nil, array(0) ) For i := 1 To ::Len If b; Eval( Block, hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i ) ElseIf l; aAdd( a, { hb_HValueAt( ::aKey, i ) } ) Else ; aAdd( a, { hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i } ) EndIf Next RETURN a METHOD Sum( Key, xSum ) CLASS TKeyData LOCAL sum := ::Get( Key, 0 ) If HB_ISNUMERIC( xSum ) If HB_ISNUMERIC( sum ); sum += xSum Else ; sum := xSum EndIf ::Put( Key, sum ) ElseIf HB_ISARRAY( xSum ) If HB_ISARRAY(sum) .and. Len(sum) == Len(xSum) AEval(xSum, {|s,i| sum[ i ]:= iif( HB_ISNUMERIC( s ), sum[ i ] + s, s ) } ) Else sum := xSum EndIf ::Put( Key, sum ) EndIf RETURN Nil METHOD Destroy CLASS TKeyData LOCAL i, k, o If HB_ISHASH( ::aKey ) For i := 1 To Len( ::aKey ) k := hb_HKeyAt( ::aKey, i ) hb_HSet( ::aKey, k, Nil ) hb_HDel( ::aKey, k ) Next EndIf If HB_ISOBJECT(::Cargo) .and. ::Cargo:ClassName == ::ClassName o := ::Cargo If HB_ISHASH( o:aKey ) For i := 1 To Len( o:aKey ) k := hb_HKeyAt( o:aKey, i ) hb_HSet( o:aKey, k, Nil ) hb_HDel( o:aKey, k ) Next EndIf EndIf ::oObj := ::aKey := ::Cargo := Nil RETURN Nil ////////////////////////////////////////////////////////////////////////////////////////////// CLASS TThrData ////////////////////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oObj AS OBJECT VAR aKey INIT hb_Hash() VAR lMT INIT .F. SYNC METHOD SGD( n, k, v ) EXPORTED: VAR Cargo METHOD New() INLINE ( Self ) CONSTRUCTOR METHOD Def( o, lVmMt ) INLINE ( ::Obj := o, ::MT := lVmMt, Self ) METHOD Set( Key, Block ) INLINE iif( ::lMT, ::SGD( 1, Key, Block ), hb_HSet ( ::aKey, Key, Block ) ) METHOD Get( Key, Def ) INLINE iif( ::lMT, ::SGD( 2, Key, Def ), hb_HGetDef( ::aKey, Key, Def ) ) METHOD Del( Key ) INLINE iif( ::lMT, ::SGD( 3, Key ), ; iif( hb_hHasKey( ::aKey, Key ), hb_HDel ( ::aKey, Key ), Nil ) ) METHOD Do ( Key, p1, p2, p3 ) BLOCK {|Self,Key,p1,p2,p3,b| b := ::Get(Key), ; iif( HB_ISBLOCK(b), EVal(b, ::oObj, Key, p1, p2, p3), Nil ) } ACCESS MT INLINE ::lMT ASSIGN MT( lVmMt ) INLINE ::lMT := iif( HB_ISLOGICAL(lVmMt), lVmMt, .F. ) ACCESS Obj INLINE ::oObj ASSIGN Obj( o ) INLINE ::oObj := iif( HB_ISOBJECT(o), o, Self ) ACCESS Len INLINE Len( ::aKey ) METHOD IsBLock( Key ) INLINE HB_ISBLOCK( ::Get(Key) ) _METHOD Eval( Block ) _METHOD Sum( Key, xSum ) _METHOD Destroy() ENDCLASS ////////////////////////////////////////////////////////////////////////////////////////////// METHOD SGD( n, k, v ) CLASS TThrData SWITCH n CASE 1 hb_HSet( ::aKey, k, v ) EXIT CASE 2 RETURN hb_HGetDef( ::aKey, k, v ) EXIT CASE 3 If hb_hHasKey( ::aKey, k ) hb_HDel ( ::aKey, k ) EndIf EXIT CASE 4 RETURN { hb_HKeyAt( ::aKey, k ), hb_HValueAt( ::aKey, k ) } EXIT END RETURN Nil METHOD Eval( Block ) CLASS TThrData LOCAL m, i, b := HB_ISBLOCK(Block) LOCAL l := HB_ISLOGICAL(Block) .and. Block LOCAL a := iif( b, Nil, array(0) ) For i := 1 To ::Len If ::lMT m := ::SGD( 4, i ) If b; Eval( Block, m[ 2 ], m[ 1 ], i ) ElseIf l; aAdd( a, { m[ 2 ] } ) Else ; aAdd( a, { m[ 2 ], m[ 1 ], i } ) EndIf Else If b; Eval( Block, hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i ) ElseIf l; aAdd( a, { hb_HValueAt( ::aKey, i ) } ) Else ; aAdd( a, { hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i } ) EndIf EndIf Next RETURN a METHOD Sum( Key, xSum ) CLASS TThrData LOCAL sum := ::Get( Key, 0 ) If HB_ISNUMERIC( xSum ) If HB_ISNUMERIC( sum ); sum += xSum Else ; sum := xSum EndIf ::Put( Key, sum ) ElseIf HB_ISARRAY( xSum ) If HB_ISARRAY(sum) .and. Len(sum) == Len(xSum) AEval(xSum, {|s,i| sum[ i ]:= iif( HB_ISNUMERIC( s ), sum[ i ] + s, s ) } ) Else sum := xSum EndIf ::Put( Key, sum ) EndIf RETURN Nil METHOD Destroy CLASS TThrData LOCAL i, k, o If HB_ISHASH( ::aKey ) For i := 1 To Len( ::aKey ) k := hb_HKeyAt( ::aKey, i ) hb_HSet( ::aKey, k, Nil ) hb_HDel( ::aKey, k ) Next EndIf If HB_ISOBJECT(::Cargo) .and. ::Cargo:ClassName == ::ClassName o := ::Cargo If HB_ISHASH( o:aKey ) For i := 1 To Len( o:aKey ) k := hb_HKeyAt( o:aKey, i ) hb_HSet( o:aKey, k, Nil ) hb_HDel( o:aKey, k ) Next EndIf EndIf ::oObj := ::aKey := ::Cargo := ::lMT := Nil RETURN Nil
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1561
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.07.17 11:57. Заголовок: PS Функции // Misk ..
PS Функции Скрытый текст
// Misk function #include "minigui.ch" ////////////////////////////////////////////////////////////////////////////////////////////////////////////// *-----------------------------------------------------------------------------* FUNCTION _WindowObj( FormName ) *-----------------------------------------------------------------------------* LOCAL h := iif( HB_ISNUMERIC( FormName ), FormName, GetFormHandle( FormName ) ) RETURN hmg_GetWindowObject( h ) *-----------------------------------------------------------------------------* FUNCTION _WindowCargo( FormName, xValue ) *-----------------------------------------------------------------------------* LOCAL o := iif( HB_ISOBJECT( FormName), FormName, _WindowObj( FormName ) ) LOCAL i := iif( HB_ISOBJECT( o ), o:Index , 0 ) If i > 0 If Pcount() > 1; _HMG_aFormMiscData2 [ i ] := xValue Else ; RETURN _HMG_aFormMiscData2 [ i ] Endif EndIf RETURN NIL *-----------------------------------------------------------------------------* FUNCTION _ControlObj( ControlName, FormName ) *-----------------------------------------------------------------------------* LOCAL h := iif( HB_ISNUMERIC( ControlName ), ControlName, ; GetControlHandle( ControlName, FormName ) ) RETURN hmg_GetWindowObject( h ) *-----------------------------------------------------------------------------* FUNCTION _ControlCargo( ControlName, FormName, xValue ) *-----------------------------------------------------------------------------* LOCAL o := iif( HB_ISOBJECT( ControlName ), ControlName, ; _ControlObj( ControlName, FormName ) ) LOCAL i := iif( HB_ISOBJECT( o ), o:Index, 0 ) If i > 0 If Pcount() > 2; _HMG_aControlMiscData2 [ i ] := xValue Else ; RETURN _HMG_aControlMiscData2 [ i ] EndIf EndIf RETURN NIL *--------------------------------------------------------------------------------* Function Do_ControlEventProcedure ( bBlock, i, p1, p2, p3, p4 ) *--------------------------------------------------------------------------------* Local RetVal if HB_ISBLOCK( bBlock ) .and. i > 0 _PushEventInfo() _HMG_ThisFormIndex := ascan ( _HMG_aFormHandles , _HMG_aControlParentHandles[ i ] ) _HMG_ThisType := 'C' _HMG_ThisIndex := i _HMG_ThisFormName := _HMG_aFormNames [ _HMG_ThisFormIndex ] _HMG_ThisControlName := _HMG_aControlNames [ _HMG_ThisIndex ] RetVal := Eval( bBlock, p1, p2, p3, p4 ) _PopEventInfo() EndIf Return RetVal *-----------------------------------------------------------------------------* Function Do_WindowEventProcedure ( bBlock, i, p1, p2, p3, p4 ) *-----------------------------------------------------------------------------* Local RetVal if HB_ISBLOCK( bBlock ) .and. i > 0 _PushEventInfo() _HMG_ThisFormIndex := i _HMG_ThisEventType := '' _HMG_ThisType := 'W' _HMG_ThisIndex := i _HMG_ThisFormName := _HMG_aFormNames [ _HMG_ThisFormIndex ] _HMG_ThisControlName := "" RetVal := Eval( bBlock, p1, p2, p3, p4 ) _PopEventInfo() EndIf Return RetVal *-----------------------------------------------------------------------------* FUNC Do_OnWndInit( i, cVar ) *-----------------------------------------------------------------------------* LOCAL nIndex := i LOCAL cName := _HMG_aFormNames [ i ] LOCAL nHandle := _HMG_aFormHandles [ i ] LOCAL nParent := _HMG_aFormParentHandle [ i ] LOCAL cType := _HMG_aFormType [ i ] RETURN oWndData( nIndex, cName, nHandle, nParent, cType, cVar ) *-----------------------------------------------------------------------------* FUNC Do_OnWndRelease( i ) *-----------------------------------------------------------------------------* LOCAL hWnd := _HMG_aFormHandles [ i ] If hmg_IsWindowObject( hWnd ) o := hmg_GetWindowObject( hWnd ) If __objHasMethod( o, 'Del' ); o:Del() EndIf If __objHasMethod( o, 'Destroy' ); o:Destroy() EndIf RETURN .T. EndIf RETURN .F. *-----------------------------------------------------------------------------* FUNC Do_OnCtlInit( i, cVar ) *-----------------------------------------------------------------------------* LOCAL nIndex := i LOCAL cName := _HMG_aControlNames [ i ] LOCAL nHandle := _HMG_aControlHandles [ i ] LOCAL nParent := _HMG_aControlParentHandles[ i ] LOCAL cType := _HMG_aControlType [ i ] RETURN oCnlData( nIndex, cName, nHandle, nParent, cType, cVar ) *-----------------------------------------------------------------------------* FUNC Do_OnCtlRelease( i ) *-----------------------------------------------------------------------------* LOCAL hWnd := _HMG_aControlHandles [ i ] If hmg_IsWindowObject( hWnd ) o := hmg_GetWindowObject( hWnd ) If __objHasMethod( o, 'Del' ); o:Del() EndIf If __objHasMethod( o, 'Destroy' ); o:Destroy() EndIf RETURN .T. EndIf RETURN .F. FUNC Do_OnWndLaunch( hWnd, nMsg, wParam, lParam ) If hmg_IsWindowObject ( hWnd ) hmg_GetWindowObject( hWnd ):DoEvent( wParam, lParam ) EndIf HB_SYMBOL_UNUSED(nMsg) RETURN Nil FUNC Do_OnCnlLaunch( hWnd, nMsg, wParam, lParam ) If ! empty(lParam); hWnd := lParam EndIf If hmg_IsWindowObject ( hWnd ) hmg_GetWindowObject( hWnd ):DoEvent( wParam, lParam ) EndIf HB_SYMBOL_UNUSED(nMsg) RETURN Nil #pragma BEGINDUMP #include <windows.h> #include <TChar.h> #include "hbapi.h" #include "hbapiitm.h" #include "hbapicdp.h" #include "hbapifs.h" #include "hbvm.h" #include <commctrl.h> HB_FUNC( HMG_SETWINDOWOBJECT ) { PHB_ITEM pObject; HWND hWnd = ( HWND ) hb_parnl(1); if( IsWindow( hWnd ) ) { pObject = ( PHB_ITEM ) hb_param( 2, HB_IT_OBJECT ); // hb_parnl(2); if( pObject && HB_IS_OBJECT( pObject ) ) { pObject = hb_itemNew( pObject ); // Новая ссылка на объект hb_gcLock( pObject ); // Ref++ SetWindowLongPtr( hWnd, GWLP_USERDATA, ( LPARAM ) pObject); hb_retl( TRUE ); return ; } } hb_retl( FALSE ); } HB_FUNC( HMG_DELWINDOWOBJECT ) { PHB_ITEM pObject; HWND hWnd = ( HWND ) hb_parnl(1); if( IsWindow( hWnd ) ) { pObject = ( PHB_ITEM ) GetWindowLongPtr( hWnd, GWLP_USERDATA ); SetWindowLongPtr( hWnd, GWLP_USERDATA, 0); if( pObject && HB_IS_OBJECT( pObject ) ){ hb_gcUnlock( pObject ); // Ref -- hb_itemRelease( pObject ); } } } HB_FUNC( HMG_GETWINDOWOBJECT ) { HWND hWnd = ( HWND ) hb_parnl(1); if( ! IsWindow( hWnd ) ) { hb_ret(); return; } hb_itemReturn( ( PHB_ITEM ) GetWindowLongPtr( hWnd, GWLP_USERDATA ) ); } HB_FUNC( HMG_ISWINDOWOBJECT ) { PHB_ITEM pObject; HWND hWnd = ( HWND ) hb_parnl(1); if( ! IsWindow( hWnd ) ) { hb_retl( FALSE ); return; } pObject = ( PHB_ITEM ) GetWindowLongPtr( hWnd, GWLP_USERDATA ); if( ! pObject ) { hb_retl( FALSE ); return; } if( ! HB_IS_OBJECT( pObject ) ) { hb_retl( FALSE ); return; } hb_retl( TRUE ); } #pragma ENDDUMP
|
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1127
Зарегистрирован: 11.02.10
|
|
Отправлено: 03.07.17 21:22. Заголовок: SergKis пишет: На с..
SergKis пишет: цитата: | На своей lib собрал пример |
| У меня тоже работает этот пример после чистки предупреждений компилятора (с ключом -w3) Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1562
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.07.17 09:08. Заголовок: gfilatov2002 пишет У..
gfilatov2002 пишет цитата: | У меня тоже работает этот пример после чистки предупреждений компилятора (с ключом -w3) |
| "Был не прав, вспылил." (с) Голова была забита изменением своей lib, времени мало, а кода ... . Учту. Пожелания: Добавить к _HMG_bOnFormInit := {|nIndex,cVarName | Do_OnWndInit ( nIndex, cVarName ) } _HMG_bOnFormDestroy := {|nIndex | Do_OnWndRelease( nIndex ) } _HMG_bOnControlInit := {|nIndex,cVarName | Do_OnCnlInit ( nIndex, cVarName ) } _HMG_bOnControlDestroy := {|nIndex | Do_OnCnlRelease( nIndex ) } _HMG_bOnWndLaunch := {|hWnd,nMsg,wParam,lParam| Do_OnWndLaunch ( hWnd, nMsg, wParam, lParam ) } _HMG_bOnCnlLaunch := {|hWnd,nMsg,wParam,lParam| Do_OnCnlLaunch ( hWnd, nMsg, wParam, lParam ) } _HMG_bOnEvents := {|hWnd,nMsg,wParam,lParam| Do_OnEvents ( hWnd, nMsg, wParam, lParam ) } и стандартную функцию для SET EVENTS FUNCTION TO SET MDIEVENTS FUNCTION TO // у нас 90% MDI с условным именем FUNC hmg_Events( hWnd, nMsg, wParam, lParam ) If HB_ISBLOCK( _HMG_bOnEvents ) RETURN EVal ( _HMG_bOnEvents, hWnd, nMsg, wParam, lParam ) EndIf RETURN 0
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1128
Зарегистрирован: 11.02.10
|
|
Отправлено: 04.07.17 14:17. Заголовок: SergKis пишет: _HMG..
SergKis пишет: цитата: | _HMG_bOnEvents := {|hWnd,nMsg,wParam,lParam| Do_OnEvents ( hWnd, nMsg, wParam, lParam ) } |
| Не смогу это сделать, пока не увижу кода функции Do_OnEvents() SergKis пишет: цитата: | стандартную функцию для SET EVENTS FUNCTION TO SET MDIEVENTS FUNCTION TO |
| Стандартный обработчик для дочерних MDI окон - это функция MdiEvents(). Возможно, этот кодовый блок нужно добавить туда, нл я не уверен Пока что записал в текущий файл changelog таким образом: Скрытый текст
* New: Added the OOP classes for managing of the Minigui windows and controls as objects. It is an experimental feature which is guarded by the constant _OBJECT_ in the core. You can disable the OOP classes at all if you will add the following assignings on top in your main module: _HMG_bOnFormInit := NIL _HMG_bOnFormDestroy := NIL _HMG_bOnControlInit := NIL _HMG_bOnControlDestroy := NIL A new property called 'Object' was added to manipulate the objects. You can get this property at runtime: - function syntax: GetProperty ( Form, 'Object' ) --> oFormObject GetProperty ( Form, Control, 'Object' ) --> oControlObject - pseudo-OOP syntax: Form.Object --> oFormObject Form.Control.Object --> oControlObject Suggested and contributed by SergKis. Revised by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\Tsb_UserKeysEvent)
| Также пришлось отключить вызов метода Destroy для модальных окон, добавить дополнительные проверки, чтобы не падал код, написанный без использования объектов. В целом, впечатления двойственные: вроде бы и добавляются новые возможности, но пока код достаточно сырой... Также не уверен, что кто-то, кроме уважаемого автора, будет тратить силы на изучение этих новых возможностей
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1563
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.07.17 17:29. Заголовок: gfilatov2002 Пока чт..
gfilatov2002 цитата: | Пока что записал в текущий файл changelog таким образом: |
| Думается Set\GetProperty с объектом не надо вставлять в ядро, пусть все будет на уровне примера, т.е _HMG_... переменные зарезервированы #command тоже только на уровне примера. Переменные можно использовать _HMG_bOnFormInit - для чтения данных окна из конфигуратора _HMG_bOnFormDestroy - для записи данных окна в конфигуратор _HMG_bOnControlInit - для чтения данных контрола из конфигуратора _HMG_bOnControlDestroy - для записи данных контрола в конфигуратор цитата: | Также не уверен, что кто-то, кроме уважаемого автора, будет тратить силы на изучение этих новых возможностей |
| Для меня это возможность совместимости версий, т.е. могу с hmg 2.07 переползти на 17.07, возможно, с минимальными изменениями lib. Классы это по интересам, хотя замена содержимого функций SetProp, GetProp, EnumProp на работу с классом (у меня есть в примере), уберет те недостатки, которые есть сегодня. К примеру, если иметь на hWnd два адреса хранения объектов 1- системный hmg, 2 - пользовательский (как сейчас), то в 1 hmg сделать класс контейнер (начать Set\GetProp) и расширять постепенно (данные из _HMG_aControlMiskData1 перенести), если надо, а 2 usr для пользовательских классов (как в примере) С MdiEvents() можно не парится, сегодня нет и как то живем.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1129
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.07.17 11:31. Заголовок: SergKis пишет: Set&..
SergKis пишет: цитата: | Set\GetProperty с объектом не надо вставлять в ядро |
| Я так сначала тоже думал, но после переноса Вашего кода в ядро библиотеки удалось обнаружить проблемы с поддержкой Spinner и RadioGroup в предлагаемой реализации, а также конфликт этих классов с модальными окнами. Вроде удалось эти недостатки побороть, плэтому оставил эти классы в ядре Также адаптировал Вашу работу для поддержки xHarbour. Но, конечно, желательно было бы добавить небольшое описание с примерами работы новых классов. Думаю, это было бы очень полезно, учитывая, что раньше пользователи не использовали классы на уровне ядра...
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5429
Зарегистрирован: 12.09.06
|
|
Отправлено: 05.07.17 15:31. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Но, конечно, желательно было бы добавить небольшое описание с примерами работы новых классов. |
| Я тоже за !
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1564
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.07.17 21:30. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | желательно было бы добавить небольшое описание |
| такое Скрытый текст
/////////////////////////////////////////////////////////////////////////////// CLASS TWndData // класс для работы с окном /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR cVar INIT '' // переменные VAR cName INIT '' // класса VAR cType INIT '' // заполняются из VAR nIndex INIT 0 // переменных _HMG_aForm...\_HMG_aControl... VAR nHandle INIT 0 // после функций _Define...(...) VAR nParent INIT 0 // окна или контрола VAR cChr INIT ',' // символ разделитель списка для hb_ATokens(...) CLASSDATA oProp AS OBJECT INIT oKeyData() // для глобальных данных окна\контрола CLASSDATA oName AS OBJECT INIT oKeyData() // индекс контролов по наименованию на окне CLASSDATA oHand AS OBJECT INIT oKeyData() // индекс контролов по хендлеру на окне EXPORTED: VAR oCargo AS OBJECT // свойство, аналог Cargo, организованный как объект, // с доступом через :Set(...), :Get(...), :Del(...), ... VAR oUserKeys AS OBJECT // свойство, аналог UserKeys из TsBrowse VAR oEvent AS OBJECT // свойство, для регистрации событий окна\контрола // для работы по сообщениям VAR oOnEventBlock AS OBJECT // свойство, для регистрации событий WM_... окна\контрола? // для исп. в SET EVENTS FUNCTION TO ... функции и др. // доступ через свойство :bOnEvent // Пример: SET EVENTS FUNCTION TO MYEVENTS ... // установки могут быть как на окно, так и на контрол :bOnEvent:Set( WM_CREATE , {|o,nm,wp,lp| ... } ) :bOnEvent:Set( WM_COMMAND, {|o,nm,wp,lp| ... } ) :bOnEvent:Set( WM_PAINT , {|o,nm,wp,lp| ... } ) :bOnEvent:Set( WM_SIZE , {|o,nm,wp,lp| ... } ) ... FUNC MyEvents ( hWnd, nMsg, wParam, lParam ) LOCAL o, r If hmg_IsWindowObject(hWnd) o := hmg_GetWindowObject(hWnd) // может быть объект окна\контрола If o:bOnEvent:IsEvent // есть регистрированные события r := o:bOnEvent:Do(nMsg, wParam, lParam ) If r > 0; RETURN r EndIf EndIf EndIf RETURN Events( hWnd, nMsg, wParam, lParam ) METHOD New() INLINE ( Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::nIndex := nIndex , ::cName := cName, ::nHandle := nHandle, ; ::nParent := nParent, ::cType := cType, ::cVar := cVar, ; ::oCargo := oKeyData(), ::oOnEventBlock := oKeyData(Self, .T.), ; ::oEvent := oKeyData(Self), ::oUserKeys := oKeyData(), ; hmg_SetWindowObject(::nHandle, Self), ; Self ) // далее свойства доступа для работы с объектом, т.е. надо исп. имя после ACCESS : // :Index, :Name, :Handle, :ClientWidth, ... ACCESS Index INLINE ::nIndex ACCESS Name INLINE ::cName ACCESS Handle INLINE ::nHandle ACCESS Parent INLINE ::nParent ACCESS Type INLINE ::cType ACCESS VarName INLINE ::cVar ACCESS Row INLINE GetWindowRow ( ::nHandle ) ACCESS Col INLINE GetWindowCol ( ::nHandle ) ACCESS Width INLINE GetWindowWidth ( ::nHandle ) ACCESS Height INLINE GetWindowHeight( ::nHandle ) ACCESS ClientWidth INLINE _GetClientRect ( ::nHandle )[ 3 ] ACCESS ClientHeight INLINE _GetClientRect ( ::nHandle )[ 4 ] ACCESS Title INLINE GetWindowText ( ::nHandle ) ACCESS Cargo INLINE _WindowCargo( Self ) ASSIGN Cargo( xVal ) INLINE _WindowCargo( Self, xVal ) // свойство ASSIGN позволяет делать присвоение значения, т.е. :Cargo := xValue ACCESS IsWindow INLINE .T. ACCESS IsControl INLINE .F. ACCESS Chr INLINE ::cChr ASSIGN Chr( cChr ) INLINE ::cChr := iif( HB_ISCHAR(cChr), cChr, ::cChr ) ACCESS bOnEvent INLINE ::oOnEventBlock ACCESS WM_nMsgW INLINE WM_WND_LAUNCH ACCESS WM_nMsgC INLINE WM_CNL_LAUNCH // аналоги функций Set\GetProp, уст. значения доступны при работе с окном\контролом // :DelProp(...) делать не обязательно, убирается автоматом в :Destroy() METHOD SetProp( xKey, xVal ) INLINE ::oProp:Set( xKey, xVal ) METHOD GetProp( xKey ) INLINE ::oProp:Get( xKey ) METHOD DelProp( xKey ) INLINE ::oProp:Del( xKey ) // свойство, аналог UserKeys из TsBrowse METHOD UserKeys( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ; ::oUserKeys:Set( Key, Block ), ; ::oUserKeys:Do ( Key, Block, p2, p3 ) ) // Пример: // WITH OBJECT oWnd // :oUserKeys:Cargo := oKeyData() // :oUserKeys:Cargo:Set(1, "Harbour.") // :oUserKeys:Cargo:Set(2, "MiniGui.") // :oUserKeys:Cargo:Set(3, "OK !") // :UserKeys('FRM_1' , {|o | MsgBox( ( This.Name )+" | "+o:Cargo:Get(1)+( This.FRM_1.Cargo ), oWnd:Name ) }) // :UserKeys('FRM_2' , {|o | MsgBox( ( This.Name )+" | "+o:Cargo:Get(2)+( This.FRM_2.Cargo ), oWnd:Name ) }) // :UserKeys('FRM_3' , {|o | MsgBox( ( This.Name )+" | "+o:Cargo:Get(3)+( This.FRM_3.Cargo ), oWnd:Name ) }) // END WITH // устанавливаем\регистрируем события для работы по сообщениям. METHOD Event ( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ; ::oEvent:Set( Key, Block ), ; ::oEvent:Do ( Key, Block, p2, p3 ) ) // Примеры: // WITH OBJECT oWnd /* для окна */ // :Event( 1, {|ow,ky| This_Msg('Window message ' + "nKey="+cValToChar(ky), ow:Name) } ) // :Event( 2, {|ow,ky| This_Msg('Window message ' + "nKey="+cValToChar(ky), ow:Name) } ) // :Event( 3, {| | AEval( This.REFR.Cargo , {|oc| oc:SendMsg(2) }) } ) // ... // END WITH // WITH OBJECT oWnd:GetObj(cNam) /* для контрола */ // :Event( 1, {|oc,kl | kl := Eval( oBrw1:GetColumn('KOLV'):bData ), ; // oc:Value := alltrim(cValToChar(kl)) } ) // :Event( 2, {|oc | oc:Window:oCargo:Set(oc:Name, oc:Value) } ) // .... // END WITH // // PS. исполнять регистрированные блоки кода можно и без сообщений, делая в нужном // месте :Event(1) или :Event(2), ... . В таком случае, ключ может быть и не // цифрой и в блок кода можно передать параметры (до 3-х), т.е. // :Event('MyKey', p1, p2, p3 ) это примечание относится и к :UserKeys(...) // посылаем сообщение окну (без ожидания) для выполнения Event с ключем nKey, // если nHandle задан контрола, то для выполнения создается среда _HMG_This... контрола, // если nHandle не задан, то среда _HMG_This... окна. METHOD PostMsg( nKey, nHandle ) INLINE PostMessage( ::nHandle, ::WM_nMsgW, nKey, ; hb_defaultValue(nHandle, 0) ) // посылаем сообщение окну (с ожиданием завершения) для выполнения Event с ключем nKey, // если nHandle задан контрола, то для выполнения создается среда _HMG_This... контрола, // если nHandle не задан, то среда _HMG_This... окна. METHOD SendMsg( nKey, nHandle ) INLINE SendMessage( ::nHandle, ::WM_nMsgW, nKey, ; hb_defaultValue(nHandle, 0) ) // выполняет блок кода ключа Key окна\контрола от значения nHandle, создавая среду // переменных _HMG_This... от nHandle. _METHOD DoEvent( Key, nHandle ) // список (оглавление) типов контролов на окне (массив) _METHOD GetListType() // Пример: // AEval( oWnd:GetListType(), {|ct,ni| _LogFile(.T., ni, ct) }) // получить список (массив) объектов контролов по типу\типам контролов, к примеру, // для рассылки сообщений :Post\SendMsg(...) _METHOD GetObj4Type( cType, lEque ) // Примеры: // lEgue будет .T. по умолчанию // AEval( oWnd:GetObj4Type('GETBOX'), {|oc,ni| _LogFile(.T., ni, oc:Name, oc:Type, oc:Index, oc:VarName) }) // lEgue будет .F., т.к. cType задан списком // AEval( oWnd:GetObj4Type('LABEL,GETBOX'), {|oc,ni| _LogFile(.T., ni, oc:Name, oc:Type, oc:Index, oc:VarName) }) // lEgue зададим .F., выберем объекты контролов по вхождению 'BUT' $ :Type // AEval( oWnd:GetObj4Type('BUT', .F.), {|oc,ni| _LogFile(.T., ni, oc:Name, oc:Type, oc:Index, oc:VarName) }) // получить список (массив) объектов контролов по именам контролов, к примеру, // для рассылки сообщений :Post\SendMsg(...) _METHOD GetObj4Name( cName ) // Пример: // AEval( oWnd:GetObj4Name('Cnt_,Rec_'), {|oc,ni| _LogFile(.T., ni, oc:Name, oc:Type, oc:Index, oc:VarName) }) // т.е. если определенным образом составлять имена контролов, то можно получать объекты // по разрезам\фильтрам имен // получить объект контрола окна по его имени или Handle. Получаем через индексы контролов. METHOD GetObj( xName ) INLINE iif( HB_ISCHAR(xName), ::oName:Get(xName), ; ::oHand:Get(xName) ) // Примеры: // oWnd:GetObj( cNam ) // oWnd:GetObj( This.FRM_1.Handle ) после DEFINE WINDOW ... или в ACTION контрола // oWnd:GetObj( This.Handle ) // освобождаем память METHOD Destroy() INLINE ( ; ::oCargo := iif( HB_ISOBJECT(::oCargo ), ::oCargo:Destroy() , Nil ), ; ::oEvent := iif( HB_ISOBJECT(::oEvent ), ::oEvent:Destroy() , Nil ), ; ::oOnEventBlock := iif( HB_ISOBJECT(::oOnEventBlock), ::oOnEventBlock:Destroy(), Nil ), ; ::oName := iif( HB_ISOBJECT(::oName ), ::oName:Destroy() , Nil ), ; ::oHand := iif( HB_ISOBJECT(::oHand ), ::oHand:Destroy() , Nil ), ; ::oProp := iif( HB_ISOBJECT(::oProp ), ::oProp:Destroy() , Nil ), ; ::oUserKeys := iif( HB_ISOBJECT(::oUserKeys ), ::oUserKeys:Destroy() , Nil ), ; ( ::nIndex := ::nParent := ::cType := ::cName := ::cVar := ::cChr := Nil ), ; hmg_DelWindowObject( ::nHandle ), ::nHandle := Nil ) ENDCLASS /////////////////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////////////////////////////// CLASS TCnlData INHERIT TWndData // класс для работы с контролом /////////////////////////////////////////////////////////////////////////////// // наследован от класса окна, следовательно // в нем доступны все свойства и методы окна, // но относятся к контролу. PROTECTED: VAR oWin AS OBJECT // переменная для хранения ссылки на объект окна EXPORTED: METHOD New( oWnd ) INLINE ( ::Super:New(), ::oWin := oWnd, Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::Super:Def(nIndex, cName, nHandle, nParent, cType, cVar), ; ::Set(), hmg_SetWindowObject( ::nHandle, Self ), ; Self ) // далее свойства доступа для работы с объектом, т.е. надо исп. имя после ACCESS : // :Title, :Caption, :Cargo, :Index, :Name, :ClientWidth, ... ACCESS Title INLINE ::oWin:cTitle ACCESS Caption INLINE _GetCaption ( ::cName, ::oWin:cName ) ACCESS Cargo INLINE _ControlCargo( Self ) ASSIGN Cargo( xVal ) INLINE _ControlCargo( Self, , xVal ) // свойство ASSIGN позволяет делать присвоение значения, т.е. :Cargo := xValue // доступ к свойствам\методам окна ACCESS Window INLINE ::oWin // Примеры: // WITH OBJECT oWnd:GetObj(cNam) // :Title // :Window:Title // :Window:Cargo := { 1,2,3,4,5 } // :Window:Cargo // :Window:oCargo:Set(cNam, :Value ) // :Window:oCargo:Get(cNam) // :Window:Hide // :Window:Show // END WITH ACCESS IsWindow INLINE .F. // Пример: // If o:IsWindow // окно // Else // контрол // Endif ACCESS IsControl INLINE .T. // Пример: // If o:IsControl // контрол // Else // окно // Endif // посылаем сообщение контролу (без ожидания) для выполнения Event с ключем nKey, // для выполнения всегда создается среда _HMG_This... контрола METHOD PostMsg( nKey ) INLINE PostMessage( ::oWin:nHandle, ::WM_nMsgC, nKey, ::nHandle ) // посылаем сообщение контролу (с ожиданием завершения) для выполнения Event с ключем nKey, // для выполнения всегда создается среда _HMG_This... контрола METHOD SendMsg( nKey ) INLINE SendMessage( ::oWin:nHandle, ::WM_nMsgC, nKey, ::nHandle ) // методы :Set(), :Del(), :Get() используется для ведения индексов контролов METHOD Set() INLINE ( ::oName:Set( ::cName , Self ), ; ::oHand:Set( ::nHandle, Self ) ) METHOD Del() INLINE ( ::oName:Del( ::cName ), ; ::oHand:Del( ::nHandle ) ) METHOD Get( xName ) INLINE iif( HB_ISCHAR(xName), ::oName:Get(xName), ; ::oHand:Get(xName) ) // получить\установить значение в контрол, аналог This.&(Nam).Value ... ACCESS Value INLINE _GetValue( , , ::nIndex ) ASSIGN Value( xVal ) INLINE ( _SetValue( , , xVal, ::nIndex ), ; _GetValue( , , ::nIndex ) ) // Прмеры: // x := o:Value // x := :Value // o:Value := xVal // :Value := xVal // далее аналоги псевдо ООП комманд ACCESS SetFocus INLINE _SetFocus ( ::cName, ::oWin:cName ) METHOD SetFocus() INLINE _SetFocus ( ::cName, ::oWin:cName ) ACCESS Disable INLINE _DisableControl( ::cName, ::oWin:cName ) METHOD Disable( nPos ) INLINE _DisableControl( ::cName, ::oWin:cName, nPos ) ACCESS Enable INLINE _EnableControl ( ::cName, ::oWin:cName ) METHOD Enable ( nPos ) INLINE _EnableControl ( ::cName, ::oWin:cName, nPos ) ACCESS Enabled INLINE GetProperty( ::oWin:cName, ::cName, 'Enabled' ) METHOD Enabled( nPos ) INLINE GetProperty( ::oWin:cName, ::cName, 'Enabled', nPos ) ACCESS Show INLINE _ShowControl ( ::cName, ::oWin:cName ) METHOD Show() INLINE _ShowControl ( ::cName, ::oWin:cName ) ACCESS Hide INLINE _HideControl ( ::cName, ::oWin:cName ) METHOD Hide() INLINE _HideControl ( ::cName, ::oWin:cName ) // выполняет блок кода ключа Key контрола, создавая среду переменных _HMG_This... // от nHandle указанного контрола или от собственного, т.е. может быть Key из // одного контрола, а созданная среда _HMG_This..., для блока кода, из другого. _METHOD DoEvent ( Key, nHandle ) // освобождаем память METHOD Destroy() INLINE ( ::Del(), ; ::oCargo := iif( HB_ISOBJECT(::oCargo ) , ::oCargo:Destroy() , Nil ), ; ::oEvent := iif( HB_ISOBJECT(::oEvent ) , ::oEvent:Destroy() , Nil ), ; ::oOnEventBlock := iif( HB_ISOBJECT(::oOnEventBlock ), ::oOnEventBlock:Destroy(), Nil ), ; ::oName := iif( HB_ISOBJECT(::oName ) , ::oName:Destroy() , Nil ), ; ::oHand := iif( HB_ISOBJECT(::oHand ) , ::oHand:Destroy() , Nil ), ; ::oUserKeys := iif( HB_ISOBJECT(::oUserKeys) , ::oUserKeys:Destroy() , Nil ), ; ( ::nParent := ::nIndex := ::cName := ::cType := ::cVar := ::cChr := Nil ), ; hmg_DelWindowObject( ::nHandle ), ::nHandle := Nil ) ENDCLASS /////////////////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////////////////////////////// CLASS TTsbData INHERIT TCnlData // класс для работы с контролом TsBrowse /////////////////////////////////////////////////////////////////////////////// // наследован от класса контрола, следовательно // в нем доступны все свойства и методы контрола, // но относятся к контролу TsBrowse. PROTECTED: VAR oTBrowse AS OBJECT // переменная для ссылки на объект TsBrowse EXPORTED: METHOD New( oWnd, oTsb ) INLINE ( ::Super:New(oWnd), ::oTBrowse := oTsb, Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::Super:Def(nIndex, cName, nHandle, nParent, cType, cVar), ; Self ) ACCESS Caption INLINE ::oWin:cName + "." + ::cName // свойство доступа к объекту TsBrowse ACCESS Tsb INLINE ::oTBrowse // Примеры: // WITH OBJECT oWnd:GetObj('oBrw1'):Tsb // ( :cAlias )->KODS := 123 // :Refresh() // END WITH // oBrw := oWnd:GetObj('oBrw1'):Tsb // cAls := ( This.oBrw1.Object ):Tsb:cAlias METHOD OnEvent( nMsg, wParam, lParam ) INLINE ::oTBrowse:HandleEvent( nMsg, wParam, lParam ) // освобождаем память METHOD Destroy() INLINE ::oTBrowse := ::Super:Destroy() ENDCLASS /////////////////////////////////////////////////////////////////////////////// Правка: Function Events ( hWnd, nMsg, wParam, lParam ) ... было #ifdef _TSBROWSE_ oGet := GetObjectByHandle( hWnd ) IF ISOBJECT( oGet ) r := oGet:HandleEvent ( nMsg, wParam, lParam ) IF ValType ( r ) == 'N' IF r != 0 RETURN r ENDIF ENDIF ENDIF #endif стало // может применяться не только для TsBrowse If hmg_IsWindowObject(hWnd) oGet := hmg_GetWindowObject(hWnd) If __objHasMethod( oGet, 'OnEvent' ) r := oGet:OnEvent( nMsg , wParam , lParam ) If HB_ISNUMERIC( r ) .and. r != 0 RETURN r EndIf EndIf EndIf
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1565
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.07.17 21:32. Заголовок: gfilatov2002 Можно ..
gfilatov2002 Можно получить Вашу версию hmg, а то есть правки в классах, не хотелось бы давать вслепую.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1130
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.07.17 22:44. Заголовок: SergKis пишет: Можн..
SergKis пишет: цитата: | Можно получить Вашу версию hmg |
| Да, конечно. Файл h_objects.prg Скрытый текст
/* * MINIGUI - Harbour Win32 GUI library source code * */ #include "minigui.ch" #ifdef _OBJECT_ #include "i_winuser.ch" #ifdef __XHARBOUR__ #include "hbcompat.ch" #endif #include "hbclass.ch" #define _METHOD METHOD /////////////////////////////////////////////////////////////////////////////// CLASS TWndData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR cVar INIT '' VAR cName INIT '' VAR cType INIT '' VAR nIndex INIT 0 VAR nHandle INIT 0 VAR nParent INIT 0 VAR cChr INIT ',' CLASSDATA oProp AS OBJECT INIT oKeyData() CLASSDATA oName AS OBJECT INIT oKeyData() CLASSDATA oHand AS OBJECT INIT oKeyData() EXPORTED: VAR oCargo AS OBJECT VAR oUserKeys AS OBJECT VAR oEvent AS OBJECT METHOD New() INLINE ( Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::nIndex := nIndex, ::cName := cName, ::nHandle := nHandle, ; ::nParent := nParent, ::cType := cType, ::cVar := cVar, ; ::oCargo := oKeyData(), ::oUserKeys := oKeyData(), ; ::oEvent := oKeyData( Self ), ; hmg_SetWindowObject( ::nHandle, Self ), ; Self ) ACCESS Index INLINE ::nIndex ACCESS Name INLINE ::cName ACCESS Handle INLINE ::nHandle ACCESS Parent INLINE ::nParent ACCESS Type INLINE ::cType ACCESS VarName INLINE ::cVar ACCESS Row INLINE GetWindowRow ( ::nHandle ) ACCESS Col INLINE GetWindowCol ( ::nHandle ) ACCESS Width INLINE GetWindowWidth ( ::nHandle ) ACCESS Height INLINE GetWindowHeight( ::nHandle ) ACCESS ClientWidth INLINE _GetClientRect ( ::nHandle )[ 3 ] ACCESS ClientHeight INLINE _GetClientRect ( ::nHandle )[ 4 ] ACCESS Title INLINE GetWindowText ( ::nHandle ) ACCESS Cargo INLINE _WindowCargo( Self ) ASSIGN Cargo( xVal ) INLINE _WindowCargo( Self, xVal ) ACCESS IsWindow INLINE .T. ACCESS IsControl INLINE .F. ACCESS Chr INLINE ::cChr ASSIGN Chr( cChr ) INLINE ::cChr := iif( HB_ISCHAR( cChr ), cChr, ::cChr ) ACCESS WM_nMsgW INLINE WM_WND_LAUNCH ACCESS WM_nMsgC INLINE WM_CTL_LAUNCH METHOD SetProp( xKey, xVal ) INLINE ::oProp:Set( xKey, xVal ) METHOD GetProp( xKey ) INLINE ::oProp:Get( xKey ) METHOD DelProp( xKey ) INLINE ::oProp:Del( xKey ) METHOD UserKeys( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ; ::oUserKeys:Set( Key, Block ), ; ::oUserKeys:Do ( Key, Block, p2, p3 ) ) METHOD Event ( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ; ::oEvent:Set( Key, Block ), ; ::oEvent:Do ( Key, Block, p2, p3 ) ) METHOD PostMsg( nKey, nHandle ) INLINE PostMessage( ::nHandle, ::WM_nMsgW, nKey, ; hb_defaultValue( nHandle, 0 ) ) METHOD SendMsg( nKey, nHandle ) INLINE SendMessage( ::nHandle, ::WM_nMsgW, nKey, ; hb_defaultValue( nHandle, 0 ) ) _METHOD DoEvent( Key, nHandle ) _METHOD GetListType() _METHOD GetObj4Type( cType, lEque ) _METHOD GetObj4Name( cName ) METHOD GetObj( xName ) INLINE iif( HB_ISCHAR( xName ), ::oName:Get( xName ), ; ::oHand:Get( xName ) ) // Destructor METHOD Destroy() INLINE ( hmg_DelWindowObject( ::nHandle ), ; iif( HB_ISOBJECT( ::oCargo ), ::oCargo:Destroy(), Nil ), ; iif( HB_ISOBJECT( ::oEvent ), ::oEvent:Destroy(), Nil ), ; iif( HB_ISOBJECT( ::oName ), ::oName:Destroy(), Nil ), ; iif( HB_ISOBJECT( ::oHand ), ::oHand:Destroy(), Nil ), ; iif( HB_ISOBJECT( ::oProp ), ::oProp:Destroy(), Nil ), ; iif( HB_ISOBJECT( ::oUserKeys ), ::oUserKeys:Destroy(), Nil ), ; ::oCargo := ::oEvent := ::oName := ::nHandle := ::cVar := Nil, ; ::oUserKeys := ::cType := ::cChr := ::cName := Nil, ; ::nIndex := ::nParent := ::oProp := ::oHand := Nil ) #ifdef __XHARBOUR__ DESTRUCTOR DestroyObject() INLINE Destroy() #endif ENDCLASS /////////////////////////////////////////////////////////////////////////////// METHOD GetListType() CLASS TWndData LOCAL oType := oKeyData() LOCAL aType ::oName:Eval( {| o| oType:Set( o:cType, o:cType ) } ) aType := oType:Eval( .T. ) oType:Destroy() oType := Nil RETURN aType METHOD GetObj4Type( cType, lEque ) CLASS TWndData LOCAL aObj := {} IF ! Empty( cType ) lEque := hb_defaultValue( lEque, .T. ) If ::cChr $ cType; lEque := .F. ENDIF FOR EACH cType IN hb_ATokens( Upper( cType ), ::cChr ) ::oName:Eval( {| oc| iif( lEque, iif( cType == oc:cType, AAdd( aObj, oc ), ), ; iif( cType $ oc:cType, AAdd( aObj, oc ), ) ) } ) NEXT ENDIF RETURN aObj METHOD GetObj4Name( cName ) CLASS TWndData LOCAL aObj := {} IF ! Empty( cName ) FOR EACH cName IN hb_ATokens( cName, ::cChr ) ::oName:Eval( {| oc| iif( cName $ oc:cName, AAdd( aObj, oc ), Nil ) } ) NEXT ENDIF RETURN aObj METHOD DoEvent ( Key, nHandle ) CLASS TWndData LOCAL o := iif( hmg_IsWindowObject( nHandle ), hmg_GetWindowObject( nHandle ), Self ) IF o:IsWindow RETURN Do_WindowEventProcedure ( ::oEvent:Get( Key ), o:Index, o, Key ) ENDIF RETURN Do_ControlEventProcedure( ::oEvent:Get( Key ), o:Index, o, Key ) /////////////////////////////////////////////////////////////////////////////// CLASS TCnlData INHERIT TWndData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oWin AS OBJECT EXPORTED: METHOD New( oWnd ) INLINE ( ::Super:New(), ::oWin := oWnd, Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::Super:Def( nIndex, cName, nHandle, nParent, cType, cVar ), ; ::Set(), hmg_SetWindowObject( ::nHandle, Self ), ; Self ) ACCESS Title INLINE ::oWin:cTitle ACCESS Caption INLINE GetProperty ( ::oWin:cName, ::cName ) ACCESS Cargo INLINE _ControlCargo( Self ) ASSIGN Cargo( xVal ) INLINE _ControlCargo( Self, , xVal ) ACCESS Window INLINE ::oWin ACCESS IsWindow INLINE .F. ACCESS IsControl INLINE .T. METHOD PostMsg( nKey ) INLINE PostMessage( ::oWin:nHandle, ::WM_nMsgC, nKey, ::nHandle ) METHOD SendMsg( nKey ) INLINE SendMessage( ::oWin:nHandle, ::WM_nMsgC, nKey, ::nHandle ) METHOD Set() INLINE ( iif( HB_ISOBJECT( ::oName ), ::oName:Set( ::cName, Self ), ), ; iif( HB_ISOBJECT( ::oHand ), ::oHand:Set( ::nHandle, Self ), ) ) METHOD Del() INLINE ( iif( HB_ISOBJECT( ::oName ), ::oName:Del( ::cName ), ), ; iif( HB_ISOBJECT( ::oHand ), ::oHand:Del( ::nHandle ), ) ) METHOD Get( xName ) INLINE iif( HB_ISCHAR( xName ), ::oName:Get( xName ), ; ::oHand:Get( xName ) ) ACCESS Value INLINE _GetValue( , , ::nIndex ) ASSIGN Value( xVal ) INLINE ( _SetValue( , , xVal, ::nIndex ), ; _GetValue( , , ::nIndex ) ) //ACCESS SetFocus INLINE _SetFocus ( ::cName, ::oWin:cName ) METHOD SetFocus() INLINE _SetFocus ( ::cName, ::oWin:cName ) //ACCESS Disable INLINE _DisableControl( ::cName, ::oWin:cName ) METHOD Disable( nPos ) INLINE _DisableControl( ::cName, ::oWin:cName, nPos ) //ACCESS Enable INLINE _EnableControl ( ::cName, ::oWin:cName ) METHOD Enable ( nPos ) INLINE _EnableControl ( ::cName, ::oWin:cName, nPos ) //ACCESS Enabled INLINE GetProperty( ::oWin:cName, ::cName, 'Enabled' ) METHOD Enabled( nPos ) INLINE GetProperty( ::oWin:cName, ::cName, 'Enabled', nPos ) //ACCESS Show INLINE _ShowControl ( ::cName, ::oWin:cName ) METHOD Show() INLINE _ShowControl ( ::cName, ::oWin:cName ) //ACCESS Hide INLINE _HideControl ( ::cName, ::oWin:cName ) METHOD Hide() INLINE _HideControl ( ::cName, ::oWin:cName ) _METHOD DoEvent ( Key, nHandle ) // Destructor METHOD Destroy() INLINE ( ::Del(), hmg_DelWindowObject( ::nHandle ), ; iif( HB_ISOBJECT( ::oCargo ), ::oCargo:Destroy(), Nil ), ; iif( HB_ISOBJECT( ::oEvent ), ::oEvent:Destroy(), Nil ), ; iif( HB_ISOBJECT( ::oName ), ::oName:Destroy(), Nil ), ; iif( HB_ISOBJECT( ::oHand ), ::oHand:Destroy(), Nil ), ; iif( HB_ISOBJECT( ::oUserKeys ), ::oUserKeys:Destroy(), Nil ), ; ::nParent := ::nIndex := ::cName := ::cType := Nil, ; ::oUserKeys := ::oCargo := ::oEvent := ::cVar := Nil, ; ::cChr := ::nHandle := Nil ) #ifdef __XHARBOUR__ DESTRUCTOR DestroyObject() INLINE Destroy() #endif ENDCLASS /////////////////////////////////////////////////////////////////////////////// METHOD DoEvent ( Key, nHandle ) CLASS TCnlData LOCAL o := iif( hmg_IsWindowObject( nHandle ), hmg_GetWindowObject( nHandle ), Self ) RETURN Do_ControlEventProcedure( ::oEvent:Get( Key ), o:Index, o, Key ) /////////////////////////////////////////////////////////////////////////////// CLASS TTsbData INHERIT TCnlData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oTBrowse AS OBJECT EXPORTED: METHOD New( oWnd, oTsb ) INLINE ( ::Super:New( oWnd ), ::oTBrowse := oTsb, Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::Super:Def( nIndex, cName, nHandle, nParent, cType, cVar ), ; ::Set(), hmg_SetWindowObject( ::nHandle, Self ), ; Self ) ACCESS Caption INLINE ::oWin:cName + "." + ::cName ACCESS Tsb INLINE ::oTBrowse METHOD Destroy() INLINE ( ::Super:Destroy(), ::oTBrowse := Nil ) ENDCLASS /////////////////////////////////////////////////////////////////////////////// CLASS TWmEData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oObj AS OBJECT VAR aMsg INIT hb_Hash() VAR lMsg INIT .F. EXPORTED: METHOD New( o ) INLINE ( ::oObj := o, Self ) CONSTRUCTOR ACCESS IsEvent INLINE ::lMsg METHOD Set( nMsg, Block ) INLINE ( hb_HSet ( ::aMsg, nMsg, Block ), ::lMsg := Len( ::aMsg ) > 0 ) METHOD Get( nMsg, Def ) INLINE hb_HGetDef( ::aMsg, nMsg, Def ) METHOD Del( nMsg ) INLINE ( hb_HDel ( ::aMsg, nMsg ), ::lMsg := Len( ::aMsg ) > 0 ) _METHOD DO ( nMsg, wParam, lParam ) _METHOD Destroy() ENDCLASS /////////////////////////////////////////////////////////////////////////////// METHOD Do( nMsg, wParam, lParam ) CLASS TWmEData LOCAL o, r, b := ::Get( nMsg ) IF HB_ISBLOCK( b ) o := ::Obj IF o:IsWindow r := Do_WindowEventProcedure ( b, o:Index, o, nMsg, wParam, lParam ) // {|ow,nm,wp,lp| ... } ELSE r := Do_ControlEventProcedure( b, o:Index, o, nMsg, wParam, lParam ) // {|oc,nm,wp,lp| ... } ENDIF ENDIF RETURN iif( Empty( r ), 0, 1 ) METHOD Destroy() CLASS TWmEData LOCAL i, k IF HB_ISHASH( ::aMsg ) FOR i := 1 TO Len( ::aMsg ) k := hb_HKeyAt( ::aMsg, i ) hb_HSet( ::aMsg, k, Nil ) hb_HDel( ::aMsg, k ) NEXT ENDIF ::oObj := ::aMsg := Nil RETURN NIL /////////////////////////////////////////////////////////////////////////////// CLASS TKeyData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oObj AS OBJECT VAR aKey INIT hb_Hash() VAR lKey INIT .F. EXPORTED: VAR Cargo METHOD New() INLINE ( Self ) CONSTRUCTOR METHOD Def( o ) INLINE ( ::Obj := o, Self ) METHOD Set( Key, Block ) INLINE ( hb_HSet ( ::aKey, Key, Block ), ::lKey := .T. ) METHOD Get( Key, Def ) INLINE hb_HGetDef( ::aKey, Key, Def ) METHOD Del( Key ) INLINE ( iif( ::Len > 0, hb_HDel ( ::aKey, Key ), ), ::lKey := Len( ::aKey ) > 0 ) METHOD DO ( Key, p1, p2, p3 ) BLOCK {| Self, Key, p1, p2, p3, b| b := ::Get( Key ), ; iif( HB_ISBLOCK( b ), Eval( b, ::oObj, Key, p1, p2, p3 ), Nil ) } ACCESS Obj INLINE ::oObj ASSIGN Obj( o ) INLINE ::oObj := iif( HB_ISOBJECT( o ), o, Self ) ACCESS Len INLINE Len( ::aKey ) ACCESS IsEvent INLINE ::lKey METHOD ISBLOCK( Key ) INLINE HB_ISBLOCK( ::Get( Key ) ) _METHOD Eval( Block ) _METHOD Sum( Key, xSum ) _METHOD Destroy() ENDCLASS /////////////////////////////////////////////////////////////////////////////// METHOD Eval( Block ) CLASS TKeyData LOCAL i, b := HB_ISBLOCK( Block ) LOCAL l := HB_ISLOGICAL( Block ) .AND. Block LOCAL a := iif( b, Nil, Array( 0 ) ) FOR i := 1 To ::Len IF b; Eval( Block, hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i ) ELSEIF l; AAdd( a, { hb_HValueAt( ::aKey, i ) } ) Else ; AAdd( a, { hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i } ) ENDIF NEXT RETURN a METHOD Sum( Key, xSum ) CLASS TKeyData LOCAL sum := ::Get( Key, 0 ) IF HB_ISNUMERIC( xSum ) IF HB_ISNUMERIC( sum ); sum += xSum Else ; sum := xSum ENDIF ::Put( Key, sum ) ELSEIF HB_ISARRAY( xSum ) IF HB_ISARRAY( sum ) .AND. Len( sum ) == Len( xSum ) AEval( xSum, {| s, i| sum[ i ] := iif( HB_ISNUMERIC( s ), sum[ i ] + s, s ) } ) ELSE sum := xSum ENDIF ::Put( Key, sum ) ENDIF RETURN NIL METHOD Destroy() CLASS TKeyData LOCAL i, k, o IF HB_ISHASH( ::aKey ) FOR i := 1 TO Len( ::aKey ) k := hb_HKeyAt( ::aKey, i ) hb_HSet( ::aKey, k, Nil ) hb_HDel( ::aKey, k ) NEXT ENDIF IF HB_ISOBJECT( ::Cargo ) .AND. ::Cargo:ClassName == ::ClassName o := ::Cargo IF HB_ISHASH( o:aKey ) FOR i := 1 TO Len( o:aKey ) k := hb_HKeyAt( o:aKey, i ) hb_HSet( o:aKey, k, Nil ) hb_HDel( o:aKey, k ) NEXT ENDIF ENDIF ::oObj := ::aKey := ::Cargo := Nil RETURN NIL /////////////////////////////////////////////////////////////////////////////// CLASS TThrData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oObj AS OBJECT VAR aKey INIT hb_Hash() VAR lMT INIT .F. SYNC METHOD SGD( n, k, v ) EXPORTED: VAR Cargo METHOD New() INLINE ( Self ) CONSTRUCTOR METHOD Def( o, lVmMt ) INLINE ( ::Obj := o, ::MT := lVmMt, Self ) METHOD Set( Key, Block ) INLINE iif( ::lMT, ::SGD( 1, Key, Block ), hb_HSet ( ::aKey, Key, Block ) ) METHOD Get( Key, Def ) INLINE iif( ::lMT, ::SGD( 2, Key, Def ), hb_HGetDef( ::aKey, Key, Def ) ) METHOD Del( Key ) INLINE iif( ::lMT, ::SGD( 3, Key ), ; iif( hb_HHasKey( ::aKey, Key ), hb_HDel ( ::aKey, Key ), Nil ) ) METHOD DO ( Key, p1, p2, p3 ) BLOCK {| Self, Key, p1, p2, p3, b| b := ::Get( Key ), ; iif( HB_ISBLOCK( b ), Eval( b, ::oObj, Key, p1, p2, p3 ), Nil ) } ACCESS MT INLINE ::lMT ASSIGN MT( lVmMt ) INLINE ::lMT := iif( HB_ISLOGICAL( lVmMt ), lVmMt, .F. ) ACCESS Obj INLINE ::oObj ASSIGN Obj( o ) INLINE ::oObj := iif( HB_ISOBJECT( o ), o, Self ) ACCESS Len INLINE Len( ::aKey ) METHOD ISBLOCK( Key ) INLINE HB_ISBLOCK( ::Get( Key ) ) _METHOD Eval( Block ) _METHOD Sum( Key, xSum ) _METHOD Destroy() ENDCLASS /////////////////////////////////////////////////////////////////////////////// METHOD SGD( n, k, v ) CLASS TThrData SWITCH n CASE 1 hb_HSet( ::aKey, k, v ) EXIT CASE 2 RETURN hb_HGetDef( ::aKey, k, v ) CASE 3 IF hb_HHasKey( ::aKey, k ) hb_HDel ( ::aKey, k ) ENDIF EXIT CASE 4 RETURN { hb_HKeyAt( ::aKey, k ), hb_HValueAt( ::aKey, k ) } END SWITCH RETURN NIL METHOD Eval( Block ) CLASS TThrData LOCAL m, i, b := HB_ISBLOCK( Block ) LOCAL l := HB_ISLOGICAL( Block ) .AND. Block LOCAL a := iif( b, Nil, Array( 0 ) ) FOR i := 1 To ::Len If ::lMT m := ::SGD( 4, i ) IF b; Eval( Block, m[ 2 ], m[ 1 ], i ) ELSEIF l; AAdd( a, { m[ 2 ] } ) Else ; AAdd( a, { m[ 2 ], m[ 1 ], i } ) ENDIF ELSE IF b; Eval( Block, hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i ) ELSEIF l; AAdd( a, { hb_HValueAt( ::aKey, i ) } ) Else ; AAdd( a, { hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i } ) ENDIF ENDIF NEXT RETURN a METHOD Sum( Key, xSum ) CLASS TThrData LOCAL sum := ::Get( Key, 0 ) IF HB_ISNUMERIC( xSum ) IF HB_ISNUMERIC( sum ); sum += xSum Else ; sum := xSum ENDIF ::Put( Key, sum ) ELSEIF HB_ISARRAY( xSum ) IF HB_ISARRAY( sum ) .AND. Len( sum ) == Len( xSum ) AEval( xSum, {| s, i| sum[ i ] := iif( HB_ISNUMERIC( s ), sum[ i ] + s, s ) } ) ELSE sum := xSum ENDIF ::Put( Key, sum ) ENDIF RETURN NIL METHOD Destroy() CLASS TThrData LOCAL i, k, o IF HB_ISHASH( ::aKey ) FOR i := 1 TO Len( ::aKey ) k := hb_HKeyAt( ::aKey, i ) hb_HSet( ::aKey, k, Nil ) hb_HDel( ::aKey, k ) NEXT ENDIF IF HB_ISOBJECT( ::Cargo ) .AND. ::Cargo:ClassName == ::ClassName o := ::Cargo IF HB_ISHASH( o:aKey ) FOR i := 1 TO Len( o:aKey ) k := hb_HKeyAt( o:aKey, i ) hb_HSet( o:aKey, k, Nil ) hb_HDel( o:aKey, k ) NEXT ENDIF ENDIF ::oObj := ::aKey := ::Cargo := ::lMT := Nil RETURN NIL *-----------------------------------------------------------------------------* FUNCTION oWndData( nIndex, cName, nHandle, nParent, cType, cVar ) *-----------------------------------------------------------------------------* LOCAL o DEFAULT nIndex := 0, ; cName := '', ; nHandle := 0, ; nParent := 0, ; cType := '', ; cVar := '' IF Empty( nIndex ) .OR. Empty( nHandle ) .OR. Empty( cName ) RETURN o ENDIF o := TWndData():New():Def( nIndex, cName, nHandle, nParent, cType, cVar ) RETURN o *-----------------------------------------------------------------------------* FUNCTION oCnlData( nIndex, cName, nHandle, nParent, cType, cVar, oWin ) *-----------------------------------------------------------------------------* LOCAL o, ob DEFAULT nIndex := 0, ; cName := '', ; nHandle := 0, ; nParent := 0, ; cType := '', ; cVar := '' IF Empty( nIndex ) .OR. Empty( nHandle ) .OR. Empty( nParent ) .OR. Empty( cName ); RETURN o ENDIF DEFAULT oWin := hmg_GetWindowObject( nParent ) IF HB_ISOBJECT( oWin ) IF cType == 'TBROWSE' ob := _HMG_aControlIds[ nIndex ] o := TTsbData():New( oWin, ob ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) ELSE o := TCnlData():New( oWin ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) ENDIF ENDIF RETURN o *-----------------------------------------------------------------------------* FUNCTION oKeyData( Obj, Event ) *-----------------------------------------------------------------------------* LOCAL o IF HB_ISNIL ( Event ) ; o := TKeyData():New():Def( Obj ) ELSEIF HB_ISLOGICAL( Event ) .AND. Event; o := TWmEData():New( Obj ) Else ; o := TThrData():New():Def( Obj, hb_mtvm() ) ENDIF RETURN o #ifdef __XHARBOUR__ *-----------------------------------------------------------------------------* STATIC FUNCTION hb_HGetDef( hHash, xKey, xDef ) *-----------------------------------------------------------------------------* LOCAL nPos := HGetPos( hHash, xKey ) RETURN iif( nPos > 0, HGetValueAt( hHash, nPos ), xDef ) #endif #endif
|
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1131
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.07.17 22:46. Заголовок: И еще файл h_objmisc..
И еще файл h_objmisc.prg Скрытый текст
/* * 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
| Возможно, Вы захотите указать также свой копирайт в этих файлах
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1570
Зарегистрирован: 17.02.12
|
|
Отправлено: 06.07.17 22:02. Заголовок: gfilatov2002 неболь..
gfilatov2002 небольшие изменения Скрытый текст
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>
| Пока остановлюсь с изменениями, надо посмотреть что получилось в реальности.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1132
Зарегистрирован: 11.02.10
|
|
Отправлено: 06.07.17 22:22. Заголовок: SergKis пишет: Конт..
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
|
| постоянный участник
|
Пост N: 1571
Зарегистрирован: 17.02.12
|
|
Отправлено: 07.07.17 13:20. Заголовок: gfilatov2002 Можно ..
gfilatov2002 Можно ли добавить в TsBrowse переменную для запрета работы метода KeyChar(...) ? 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 ... мучить все время :nUserKey := 255 неудобно.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1133
Зарегистрирован: 11.02.10
|
|
Отправлено: 07.07.17 13:52. Заголовок: SergKis пишет: Можн..
SergKis пишет: цитата: | Можно ли добавить в TsBrowse переменную для запрета работы метода KeyChar |
| Благодарю за предложение! Если надо, то, конечно, добавлю
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1572
Зарегистрирован: 17.02.12
|
|
Отправлено: 07.07.17 18:07. Заголовок: gfilatov2002 пишет Е..
gfilatov2002 пишет цитата: | Если надо, то, конечно, добавлю |
| Это надо при работе с ячейками и lEdit := .T., но не надо вкл. Edit от нажатий цифр\букв.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1134
Зарегистрирован: 11.02.10
|
|
Отправлено: 07.07.17 22:05. Заголовок: SergKis пишет: Это ..
SergKis пишет: цитата: | Это надо при работе с ячейками и lEdit := .T. |
| Понятно, я уже добавил этот переключатель
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1576
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.07.17 17:39. Заголовок: gfilatov2002 Предло..
gfilatov2002 Предложение Скрытый текст
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 ) ...
| Если это интересно, можно еще поискать места.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1135
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.07.17 12:06. Заголовок: SergKis пишет: Пред..
SergKis пишет: Я понимаю Вашу логику, чтобы добавить дополнительный параметр Index, как это сделано в функциях _getvalue() и _setvalue() Но без острой необходимости не хотелось бы усложнять существующую логику, которая опирается на использование только ControlName и ParentForm параметров в большинстве других внутренних функций. Поэтому пока Ваше предложение не принято...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1577
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.07.17 12:19. Заголовок: gfilatov2002 пишет н..
gfilatov2002 пишет цитата: | не хотелось бы усложнять существующую логику, которая опирается на использование только ControlName и ParentForm параметров в большинстве других внутренних функций |
| Основной целью предложения - это исп. в классах, т.к. там индекс известен и сразу может указываться в вызовах.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1136
Зарегистрирован: 11.02.10
|
|
Отправлено: 11.07.17 16:42. Заголовок: SergKis Возник вопр..
SergKis Возник вопрос после небольшой проверки использоапния ООП в базовом примере MAIN_DEMO. Добавил в главное меню такую строчку цитата: | ITEM 'ALL TYPE' ACTION MsgDebug( (ThisWindow.Object):GetListType(), 'ALL TYPE' ) |
|
После запуска примера эта команда показывает используемые типы элементов управления главного окна, как и ожидалось. Но еслм, напрмер, открыть и затем закрыть дочернее окно из пункта меню 'More Tests', то все эти элементы управления, которые показывала добавленная в меню команда, стираются из переменной ::oName В чем состоит моя ошибка и как это исправить
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1580
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.07.17 20:30. Заголовок: gfilatov2002 пишет В..
gfilatov2002 пишет цитата: | В чем состоит моя ошибка и как это исправить |
| тут моя ошибка, красным лишнее (убираться должно только в destroy() окна) 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 )
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1581
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.07.17 20:35. Заголовок: PS Я сейчас в Питере..
PS Я сейчас в Питере и что бы что то смотреть, нужна Ваша сборка hmg, с собой у меня мало что есть.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1137
Зарегистрирован: 11.02.10
|
|
Отправлено: 11.07.17 21:10. Заголовок: SergKis пишет: убир..
SergKis пишет: цитата: | убираться должно только в destroy() окна |
| Благодарю за исправление! Сейчас после закрытия дочерних окон все в порядке Но если вызвать окно предварительного просмотра печати из главного окна, то после закрытия этого окна просмотра снова будет стерто содержимое переменной ::oName SergKis пишет: Завтра отправлю ссылку на Ваш почтовый адрес <bilance[at]bilance.lv>
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1582
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.07.17 21:34. Заголовок: gfilatov2002 пишет З..
gfilatov2002 пишет цитата: | Завтра отправлю ссылку на Ваш почтовый адрес <bilance[at]bilance.lv> |
| Лучше в личку, почты с собой нет, с работой общаюсь, через ftp
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1138
Зарегистрирован: 11.02.10
|
|
Отправлено: 12.07.17 10:36. Заголовок: SergKis пишет: Лучш..
SergKis пишет: Отправил ссылку ы Л.С.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1583
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.07.17 11:33. Заголовок: gfilatov2002 пишет О..
gfilatov2002 пишет Спасибо, забрал и по ситуации с FUNCTION PRINTPIE, где печать Preview, можно глубже лезть, но, возможно есть еще окна такого типа, предложение для них делать, как я сделал в примере: *------------------------------------------------------------------------------* 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
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1584
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.07.17 11:50. Заголовок: PS Добавил в пример ..
PS Добавил в пример @ 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 ; Для демонстрации наследования. Т.е. в контроле применяем метод прописанный в окне. Списки (:GetListType(), :GetObj4Type( cType, lEque ), :GetObj4Name( cName )) можно получать и на контролах
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1139
Зарегистрирован: 11.02.10
|
|
Отправлено: 12.07.17 12:51. Заголовок: SergKis пишет: немн..
SergKis пишет: цитата: | немного подправить команду SET OOP <еще от переменной |
| Добавил новую команду SET OOP TO <lOOP> SergKis пишет: цитата: | еще предложение добавить функцию |
| Добавил, конечно. Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1586
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.07.17 18:01. Заголовок: gfilatov2002 Думаю,..
gfilatov2002 Думаю, я был не прав с 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'
| |
|
Ответов - 300
, стр:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
All
[только новые]
|
|
|