Автор | Сообщение |
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: 1846
Зарегистрирован: 11.02.10
|
|
Отправлено: 01.04.21 12:55. Заголовок: SergKis пишет: Хоро..
SergKis пишет: цитата: | Хорошо бы с nKey иметь похожую ф-ю |
| Да, такая функция уже есть в Харборе - hb_UChar(nKey) SergKis пишет: Я обновил архив уникод версии 21.03 с учетом последних изменений, посмотрите, пожалуйста
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3673
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.04.21 14:32. Заголовок: gfilatov2002 пишет G..
gfilatov2002 пишет цитата: | GetBox уже заработал с русским языком |
| Забрал архив, TGET от 01.04.2021 Взял пример GetBox\demo.prg -> utf8 с bom, изменил Скрытый текст
#include "hmg.ch" REQUEST HB_CODEPAGE_UTF8 REQUEST HB_CODEPAGE_RU1251 *----------------------------- Function MAIN() *----------------------------- SET CODEPAGE TO UNICODE SET CENTURY ON SET DATE ANSI SET ShowDetailError ON SET DELETED ON SET BROWSESYNC ON SET FONT TO "Arial", 10 ...
| ввода русских букв нет, курсор перемещается с набранной буквой, вместо буквы [] квадратик
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1847
Зарегистрирован: 11.02.10
|
|
Отправлено: 01.04.21 14:40. Заголовок: SergKis пишет: ввод..
SergKis пишет: Да, все верно - надо было еще править Tget класс для корректной обработки шаблонов ввода. Сейчас этот пример уже заработал, осталось поправить BackSpace, и можно залить исправленный архив. Кстати, Ваш пример с использованием TBrowse теперь тоже понимает русский язык
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1848
Зарегистрирован: 11.02.10
|
|
Отправлено: 01.04.21 16:07. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | осталось поправить BackSpace |
| Запарился исправлять TGet класс и его стыковку c GetBox. Сейчас все заработало, выложил исправленный архив для проверки. Прошу прощения за задержку...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3674
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.04.21 17:22. Заголовок: gfilatov2002 пишет З..
gfilatov2002 пишет цитата: | Запарился исправлять TGet класс и его стыковку c GetBox |
| Попробовал вариант #translate SubStr( <s> , <p> ) => hb_USubStr( <s>, <p> ) #translate SubStr( <s> , <p>, <l> ) => hb_USubStr( <s>, <p>, <l> ) #translate Left( <s> , <l> ) => hb_ULeft( <s>, <l> ) #translate Right( <s> , <l> ) => hb_URight( <s>, <l> ) #translate At( <c> , <s> ) => hb_UAt( <c>, <s> ) #translate RAt( <c> , <s> ) => hb_URAt( <c>, <s> ) Работает, вроде, по -pOut.prg смотрел Сложнее с Len(...), надо смотреть только для строк, я так понимаю Или что то не учитываю ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3675
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.04.21 17:40. Заголовок: PS По поводу Len(.....
PS По поводу Len(...), может так FUNCTION __Len( x ) IF HB_ISCHAR( x ) ; RETURN hb_ULen( x ) ENDIF RETURN Len( x ) #translate Len( <s> ) => __Len( <s> )
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3676
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.04.21 17:50. Заголовок: PS2 Еще #translate ..
PS2 Еще #translate PadR( <s> , <l> ) => hb_UPadR( <s> , <l> ) #translate PadC( <s> , <l> ) => hb_UPadC( <s> , <l> ) #translate PadL( <s> , <l> ) => hb_UPadL( <s> , <l> )
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3677
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.04.21 18:47. Заголовок: gfilatov2002 пишет С..
gfilatov2002 пишет цитата: | Сейчас все заработало, выложил исправленный архив для проверки. |
| Примеры GetBox\demo.prg и вариант App_OppReport отработали с RU и LV языками Пример тсб тут https://TransFiles.ru/5c5r6
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3678
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.04.21 20:47. Заголовок: gfilatov2002 Из кол..
gfilatov2002 Из колонки по Ctrl+C и Ctrl+V в редактор с utf8 все ok! А обратно, из редактора utf8 в колонку вставка ломает текст.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1849
Зарегистрирован: 11.02.10
|
|
Отправлено: 01.04.21 21:28. Заголовок: SergKis пишет: обра..
SergKis пишет: цитата: | обратно, из редактора utf8 в колонку вставка ломает текст |
| Уже поправил эту ошибку Благодарю за сообщение P.S. Выложил для проверки архив сборки с последними исправлениями.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3679
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.04.21 01:38. Заголовок: gfilatov2002 Собрал..
gfilatov2002 Собрал пример unicode, dbf ru1251 https://TransFiles.ru/231cz Показывает ok! :Edit нет, не пойму uValue в TGetBox должна в utf8 попадать, но ... бяки в корректировке
| |
|
|
SergKis
|
| постоянный участник
|
Пост N: 3680
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.04.21 01:44. Заголовок: PS На последней сбор..
PS На последней сборке так же все
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3681
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.04.21 08:52. Заголовок: gfilatov2002 Нашел ..
gfilatov2002 Нашел Скрытый текст
METHOD bDataEval( oCol, xVal, nCol ) CLASS TSBrowse ... IF xVal == NIL // FieldGet DEFAULT nCol := ::nCell IF HB_ISBLOCK( oCol:bValue ) IF lNoAls ; xVal := Eval( oCol:bValue, NIL, Self, nCol, oCol ) ELSE ; xVal := ( cAlias )->( Eval( oCol:bValue, NIL, Self, nCol, oCol ) ) ENDIF ELSE IF lNoAls ; xVal := Eval( oCol:bData ) ELSE ; xVal := ( cAlias )->( Eval( oCol:bData ) ) ENDIF ENDIF IF HB_ISBLOCK( oCol:bDecode ) //.AND. nCol != NIL IF lNoAls ; xVal := Eval( oCol:bDecode, xVal, Self, nCol, oCol ) ELSE ; xVal := ( cAlias )->( Eval( oCol:bDecode, xVal, Self, nCol, oCol ) ) ENDIF ENDIF ELSE // FieldPut DEFAULT nCol := ::nCell IF HB_ISBLOCK( oCol:bEncode ) //.AND. nCol != NIL IF lNoAls ; xVal := Eval( oCol:bEncode, xVal, Self, nCol, oCol ) ELSE ; xVal := ( cAlias )->( Eval( oCol:bEncode, xVal, Self, nCol, oCol ) ) ENDIF ENDIF
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3682
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.04.21 09:39. Заголовок: PS Добавил колонку с..
PS Добавил колонку с cdp DEWIN, работает (ввод через Clipboard с сайта, язык не ставил), все ok!
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3683
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.04.21 10:29. Заголовок: PS2 Не понял, но не ..
PS2 Не понял, но не подключает REQUEST HB_LANG_LVWIN, а cplvwin.c есть в hb Придется свою либ перекодировки подключать
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3685
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.04.21 10:42. Заголовок: gfilatov2002 Вопрос..
gfilatov2002 Вопросик по hbfbird. В contrib есть, в hb hmg не включен. Есть причина или просто так ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3686
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.04.21 12:09. Заголовок: Кому интересно, прим..
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1850
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.04.21 14:15. Заголовок: SergKis пишет: Наше..
SergKis пишет: Принято, благодарю за помощь SergKis пишет: цитата: | Вопросик по hbfbird. В contrib есть, в hb hmg не включен. |
| Просто FireBird никто здесь не использует, во всяком случае, запроса на него не было
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3688
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.04.21 14:43. Заголовок: gfilatov2002 пишет П..
gfilatov2002 пишет цитата: | Просто FireBird никто здесь не использует |
| У нас оборудование вешают на него, кассы, охрана ... На свой версии, файлы получали csv, возможно, напрямую надо будет, с unicode версией это уже будет иметь смысл. Подключу к проекту потом.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3689
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.04.21 14:49. Заголовок: PS Не подскажите, по..
PS Не подскажите, почему не проходит REQUEST HB_LANG_LVWIN, раньше не использовал, перекодировали и работали с LV866, но в new версии, хотелось обойтись без лишних действий.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1851
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.04.21 15:01. Заголовок: SergKis пишет: поче..
SergKis пишет: цитата: | почему не проходит REQUEST HB_LANG_LVWIN |
| Попробуйте использовать
| |
|
|
SergKis
|
| постоянный участник
|
Пост N: 3690
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.04.21 15:09. Заголовок: gfilatov2002 пишет R..
gfilatov2002 пишет Спасибо , собралось Нашел еще REQUEST HB_CODEPAGE_LVWIN это что ? Как то запутали все, бум разбирать, пробовать, бум
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3691
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.04.21 21:11. Заголовок: gfilatov2002 С язык..
gfilatov2002 С языками получилось в тсб все как надо Пример с 4-мя кодировками (Edit работает по ним) тут https://TransFiles.ru/yp6ui Языковые тексты из prg идут на ура (как должно быть при utf8) Спасибо за unicode версию
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3692
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.04.21 21:16. Заголовок: PS REQUEST HB_LANG_L..
PS Это Dos коировка цитата: | REQUEST HB_CODEPAGE_LVWIN |
| Это 1257 кодировка, которая нужна и в примере задействовал, все ok!
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3694
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.04.21 12:02. Заголовок: gfilatov2002 Не мог..
gfilatov2002 Не могу найти (уже глаза сломал), где ::lDontChange становится .T. Делаю в примере (:lEdit := .T. все колонки и в показ добавил колонку MARRIED) :lNoKeyChar := .T. // надо ставить иначе, lEdit := .T. по нажатию вкл. getbox на корркетировку :UserKeys(VK_1, {|ob| MsgBox( "Test " + ob:GetColumn(ob:nCell):cName + CRLF, ob:cParentWnd ) } ) :bLDblClick := {|up1,up2,nfl,ob| up1:=up2:=nfl, ob:PostMsg(WM_KEYDOWN, VK_RETURN, 0)} :UserKeys(VK_RETURN, {|ob| IF ob:GetColumn(ob:nCell):cName == "STREET" _wPost(111, ob:cParentWnd, ob) ELSEIF ob:GetColumn(ob:nCell):lCheckBox //cName == "MARRIED" ob:PostMsg( WM_KEYDOWN, VK_SPACE, 0 ) ; DO EVENTS ELSE _wPost(110, ob:cParentWnd, ob) ENDIF RETURN Nil } ) В :HandleEvent() попадаем сюда, выделено METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TSBrowse ... ELSEIF nMsg == WM_CHAR .AND. ::lEditing RETURN 0 ELSEIF nMsg == WM_CHAR RETURN ::KeyChar( nWParam, nLParam ) ELSEIF nMsg == WM_KEYDOWN .AND. ::lDontChange RETURN 0 ELSEIF nMsg == WM_KEYDOWN RETURN ::KeyDown( nWParam, nLParam ) ... и отрубаются назначенные клавиши Enter, Spase, dblClick Может, свежим взглядом глянете ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3695
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.04.21 12:06. Заголовок: PS Причем, отключают..
PS Причем, отключаются только (фокус курсор установлен) на колонке логической MARRIED, на других все назначения клавиш и dblclick работают
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3696
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.04.21 12:28. Заголовок: PS2 Пока писал, поня..
PS2 Пока писал, понял, дело не в ::lDontChange (но где она становится .T., все равно, интересно), а в :lNoKeyChar := .T.. По ней откл. метод ::KeyChar(), а в нем ::Edit() для логической колонки. Установленные события срабатывают, не работает ob:PostMsg( WM_KEYDOWN, VK_SPACE, 0 ), т.к. отключен ::KeyChar(). Тут что то надо ..., подумать
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3697
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.04.21 12:53. Заголовок: SergKis пишет Тут чт..
SergKis пишет цитата: | Тут что то надо ..., подумать |
| "Все уже украдено придумано до нас" :UserKeys(VK_RETURN, {|ob| IF ob:GetColumn(ob:nCell):cName == "STREET" _wPost(111, ob:cParentWnd, ob) ELSEIF ob:GetColumn(ob:nCell):lCheckBox //cName == "MARRIED" ob:PostEdit(!ob:GetValue(ob:nCell), ob:nCell) ELSE _wPost(110, ob:cParentWnd, ob) ENDIF RETURN Nil } )
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3698
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.04.21 16:34. Заголовок: SergKis пишет Тут чт..
SergKis пишет цитата: | Тут что то надо ..., подумать |
| Похоже надо, т.к. на самой колонке с :lCheckBox == .T. не работает LDblClick, не выходит на MsgBox() а клавиши работают, т.е. имеем // :lEdit := .T. на всех колонках :lNoKeyChar := .T. :UserKeys(VK_1, {|ob,lo| MsgBox( "Test " + ob:GetColumn(ob:nCell):cName + CRLF, ob:cParentWnd ) }) :bLDblClick := {|up1,up2,nfl,ob| up1:=up2:=nfl, MsgBox(":bLDblClick press", "INFO"), ; ob:PostMsg( WM_KEYDOWN, VK_RETURN, 0 ) } :UserKeys(VK_RETURN, {|ob| IF ob:GetColumn(ob:nCell):lCheckBox //cName == "MARRIED" ob:PostEdit(!ob:GetValue(ob:nCell), ob:nCell) RETURN Nil // завершить работу метода :KeyDown(), вкл. поле на корректировку ENDIF RETURN .T. // продолжить работу метода :KeyDown() } )
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3699
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.04.21 16:37. Заголовок: PS Не туда дописал ..
PS Не туда дописал RETURN Nil // завершить работу метода :KeyDown(), вкл. поле на корректировку ENDIF RETURN .T. // продолжить работу метода :KeyDown(), вкл. поле на корректировку
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3703
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.04.21 17:12. Заголовок: SergKis пишет ..
SergKis пишет цитата: | // :lEdit := .T. на всех колонках :lNoKeyChar := .T. |
| Может я рвусь в открытую дверь ? И есть способ отключить метод :KeyChar() для выключения авто корректировки в GetBox при нажатии букв, цифр. Пытаюсь понять некоторые моменты, отличающиеся в работе тек. версии hmg и своей раб. версией, т.к. при нажатии букв, цифр вкл. другие режимы работы.
| |
|
|
SergKis
|
| постоянный участник
|
Пост N: 3706
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.04.21 07:44. Заголовок: gfilatov2002 Можно ..
gfilatov2002 Можно чуток поправить FUNCTION _GetStatusItemWidth( hWnd, nItem ) ... RETURN iif( !Empty(nItem), aItemWidth [nItem], aItemWidth ) h_objects.prg CLASS TStbData INHERIT TCnlData ... METHOD Width ( nItem, nWidth ) INLINE iif( HB_ISNUMERIC( nWidth ) .AND. nWidth > 0, ; _SetStatusWidth ( ::oWin:cName, hb_defaultValue( nItem, 1 ), nWidth ), ; _GetStatusItemWidth( ::oWin:nHandle, nItem ) )
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3707
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.04.21 08:03. Заголовок: Еще METHOD KeyChar( ..
Еще METHOD KeyChar( nKey, nFlags ) CLASS TSBrowse LOCAL cComp, lProcess, cTypeCol LOCAL ix LOCAL lNoKeyChar := ::lNoKeyChar DEFAULT ::nUserKey := nKey cTypeCol := iif( ::nLen == 0, "U", ValType( ::bDataEval( ::aColumns[ ::nCell ] ) ) ) // Modificado por Carlos IF cTypeCol == "L" .AND. ::aColumns[ ::nCell ]:lCheckBox .AND. nKey == VK_SPACE lNoKeyChar := .F. ENDIF IF ::nUserKey == 255 .OR. ! ::lEnabled .OR. lNoKeyChar // from KeyDown() method RETURN 0 ENDIF IF ::lAppendMode RETURN 0 ENDIF ::lNoPaint := .F. //cTypeCol := iif( ::nLen == 0, "U", ValType( ::bDataEval( ::aColumns[ ::nCell ] ) ) ) // Modificado por Carlos IF Upper( ::aMsg[ 1 ] ) == "YES" тогда решается edit логического поля при ::lNoKeyChar := .T.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1852
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.04.21 10:05. Заголовок: SergKis пишет: попр..
SergKis пишет: OK SergKis пишет: цитата: | решается edit логического поля при ::lNoKeyChar := .T. |
| Принято с благодарностью P.S. Обновил unicode сборку с учетом всех последних изменений, в т.ч. обновил компилятор Harbour
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1853
Зарегистрирован: 11.02.10
|
|
Отправлено: 07.04.21 09:48. Заголовок: Выложил 1-е обновлен..
Выложил 1-е обновление сборки 21,03 с учетом всех последних изменений по адресу http://hmgextended.com/files/CONTRIB/hmg-21.03-setup.exe Что нового: Скрытый текст
цитата: | * New: Implementation of UNICODE support in the MiniGUI core libraries: - updated the Harbour TGet class; - updated the GETBOX control; - updated the TSBrowse library. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - correction of using the variable :lNoKeyChar with the logical fields in the method KeyChar(). Contributed by SergKis * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.35.4 (from 3.35.3). Contributed by Grigory Filatov <gfilatov@inbox.ru>. * Updated: Harbour Compiler 3.2.0dev (SVN 2021-03-31 20:37): * Updated: PostGreSQL library source code (see in folder \Source\HbPgSql). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * Updated: 'Test application' sample. - updated C-code for unicode support. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\TEST_APPLICATION) * Updated: 'Using OOP events for creation of the reports' sample: - updated database for unicode compatibility. Contributed by Sergej Kiselev (see in folder \samples\Advanced\APP_OOPREPORT) |
|
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3708
Зарегистрирован: 17.02.12
|
|
Отправлено: 07.04.21 22:47. Заголовок: gfilatov2002 Пример..
gfilatov2002 Пример BASIC\Firebird работает в unicode версии, RU1251, LV1257 (LVWIN) поддерживает. Buid Скрытый текст
Compile.bat ..\..\..\BATCH\hbmk2.bat demo.hbp demo.hbp # Keys compile #-prgflag=-w2 -es1 # Enable multi/single-thread Harbour VM -mt # Incremental-compilation mode -inc # folder where are all * .obj -workdir=OBJ # Name EXE-module -odemo # to list all * .prg demo.prg # project Resources #demo.rc # paths to the main and extension *.Lib -lminigui -ltsbrowse -lhbodbc.lib -lodbc32.lib
| Demo.prg (UTF8 с BOM) Скрытый текст
/* * * Access a firebird database through ODBC * * Based on ODBC_2 sample included in MiniGui Extended distribution * Hugo Rozas M. * HMG Extended v1.9.98 * */ #define _HMG_OUTLOG #include 'hmg.ch' #include "miniprint.ch" REQUEST HB_CODEPAGE_UTF8 REQUEST HB_CODEPAGE_RU1251 REQUEST HB_LANG_DEWIN REQUEST HB_CODEPAGE_LVWIN REQUEST DBFCDX MEMVAR TitlePrint static oConnection *-------------------------------------------------------------------------------- FUNCTION Main() SET CODEPAGE TO UNICODE RddSetDefault("DBFCDX") SET CENTURY ON SET DATE GERMAN SET DELETED ON SET EXCLUSIVE ON SET EPOCH TO 2000 SET AUTOPEN ON SET EXACT ON SET SOFTSEEK ON SET NAVIGATION EXTENDED SET FONT TO "Arial", 11 //Set navigation extended oConnection = todbc():new('DRIVER=Firebird/InterBase(r) driver;UID=SYSDBA;PWD=masterkey;DBNAME=EMPLOYEE.FDB;') oConnection:Open() define window form1; at 0,0 width 400 height 400 title 'Demo Odbc/Firebird'; Main; on init ( adjust(), load_data(1) ); on maximize ( adjust() ); on size ( adjust() ); on release ( oConnection:Destroy() ); font 'ms sans serif' size 8 @ 0, 0 button btn1 caption '&Add' width 55 height 20 action events_(1) @ 0, 60 button btn2 caption '&Edit' width 55 height 20 action events_(2) @ 0,120 button btn3 caption '&Delete' width 55 height 20 action events_(3) @ 0,180 button btn4 caption '&Print' width 55 height 20 action Print_List() @ 0,240 button btn5 caption '&Reload' width 55 height 20 action load_data(1) @ 0,300 button btn6 caption '&Quit' width 55 height 20 action form1.release define grid grid1 row 22 col 5 width 300 height 300 headers {'Id','First Name','Last Name','Salary'} widths { 50, 80,110,115 } justify {BROWSE_JTFY_RIGHT,BROWSE_JTFY_LEFT,BROWSE_JTFY_LEFT,BROWSE_JTFY_RIGHT} on dblclick events_(2) on change form1.statusbar.item(1) := "Register "+; ltrim(str(form1.grid1.value))+" of "+alltrim(str(form1.grid1.itemcount)) columncontrols { ; {'TEXTBOX','NUMERIC'} , ; {'TEXTBOX','CHARACTER'}, ; {'TEXTBOX','CHARACTER'}, ; {'TEXTBOX','NUMERIC'} ; } end grid define statusbar statusitem "Register " date end statusbar end window form1.center activate window form1 return *-------------------------------------------------------------------------------- procedure load_data(n) local i, oc form1.grid1.Deleteallitems oConnection:Setsql('SELECT * FROM Employee ORDER BY Emp_No') if !oConnection:Open() msgstop("Can't connect to database") else for i= 1 to len( oConnection:aRecordset ) form1.grid1.additem( oConnection:aRecordset[ i ] ) next form1.grid1.value := n end oConnection:Close() form1.grid1.setfocus return *-------------------------------------------------------------------------------- procedure events_(n) local cL_Name := "",cSalary := "",cF_Name := "", cID := "", Str do case case n == 1 .or. n == 2 if n = 2 cID := form1.grid1.cell( form1.grid1.value, 1 ) cF_Name := form1.grid1.cell( form1.grid1.value, 2 ) cL_Name := form1.grid1.cell( form1.grid1.value, 3 ) cSalary := form1.grid1.cell( form1.grid1.value, 4 ) end define window form1a; at 0,0 width 270 height 220; title iif(n = 2,'Edit','Add'); modal; font 'ms sans serif' size 8 @ 10, 10 label label1 width 60 height 20 value 'ID' RIGHTALIGN @ 40, 10 label label2 width 60 height 20 value 'First Name' RIGHTALIGN @ 70, 10 label label3 width 60 height 20 value 'Last Name' RIGHTALIGN @ 100,10 label label4 width 60 height 20 value 'Salary' RIGHTALIGN @ 10,80 textbox text1 width 40 height 20 value cID READONLY NUMERIC INPUTMASK '99999' NOTABSTOP @ 40,80 textbox text2 width 100 height 20 value cF_Name MaxLength 15 @ 70,80 textbox text3 width 170 height 20 value cL_Name MaxLength 25 @ 100,80 textbox text4 width 90 height 20 value cSalary NUMERIC INPUTMASK '9999999999.99' @ 150,60 button button1 caption '&Save' action save_data( n ) width 80 height 20 @ 150,150 button button2 caption '&Close' action form1a.release width 80 height 20 on key escape action form1a.button2.onclick end window form1a.center activate window form1a case n == 3 Str := "DELETE FROM Employee WHERE Emp_No="+str(form1.grid1.cell(form1.grid1.value,1)) if msgyesno('Delete this register? '+hb_osnewline()+form1.grid1.cell(form1.grid1.value,2),'Confirm') oConnection:Setsql( Str ) if !oConnection:Open() msgstop("Can't delete the register") else n := form1.grid1.value form1.grid1.deleteitem( n ) form1.grid1.value := iif(n > 1, n-1, 1) form1.statusbar.item(1) := "Register "+; ltrim(str(form1.grid1.value))+" of "+alltrim(str(form1.grid1.itemcount)) end oConnection:Close() form1.grid1.setfocus end endcase Form1.Grid1.SetFocus() return *-------------------------------------------------------------------------------- procedure save_data(n) *-------------------------------------------------------------------------------- local Str, cID if n = 1 If ( form1a.text1.value = 0 ) cID := "null" else cID := "'"+Alltrim(Str(form1a.text1.value))+"'" end Str := "INSERT INTO Employee (EMP_NO,FIRST_NAME,LAST_NAME,SALARY) VALUES ("+cID+; ",'"+form1a.text2.value+; "','"+form1a.text3.value+; "','"+Alltrim(Str(form1a.text4.value))+; "')" //msgstop( Str ) else cID := "'"+Alltrim(Str(form1a.text1.value))+"'" Str := "UPDATE Employee SET FIRST_NAME='"+form1a.text2.value+"',"+; " LAST_NAME='"+form1a.text3.value + "'," + ; " SALARY='" + Str(form1a.text4.value) + "'" + ; " WHERE Emp_No=" + cID //msgstop( Str ) end oConnection:Setsql( Str ) if !oConnection:Open() msgstop("Can't update Employee table") end oConnection:Close() if n == 1 load_data( form1.grid1.itemcount+1 ) else form1.grid1.cell( form1.grid1.value, 1 ) := form1a.text1.value form1.grid1.cell( form1.grid1.value, 2 ) := form1a.text2.value form1.grid1.cell( form1.grid1.value, 3 ) := form1a.text3.value form1.grid1.cell( form1.grid1.value, 4 ) := form1a.text4.value end form1.statusbar.item(1) := "Register "+; ltrim(str(form1.grid1.value))+" de "+alltrim(str(form1.grid1.itemcount)) form1a.release return *-------------------------------------------------------------------------------- procedure adjust() *-------------------------------------------------------------------------------- form1.grid1.width := form1.width - 20 form1.grid1.height:= ( form1.height- form1.grid1.row ) - 60 return *-------------------------------------------------------------------------------- procedure Print_List() *-------------------------------------------------------------------------------- Local nomimp, PAG, LIN, I Local cL_Name,cSalary,cF_Name,cID Private TitlePrint := "Employee List" nomimp := GetPrinter() SELECT PRINTER nomimp ORIENTATION PRINTER_ORIENT_PORTRAIT PREVIEW START PRINTDOC NAME TitlePrint START PRINTPAGE PAG:=0 LIN:=0 FOR I := 1 TO form1.grid1.ItemCount cID := form1.grid1.Cell( I, 1 ) cF_Name := form1.grid1.Cell( I, 2 ) cL_Name := form1.grid1.Cell( I, 3 ) cSalary := form1.grid1.Cell( I, 4 ) IF LIN>=260 .OR. PAG=0 IF PAG<>0 @ LIN+5,105 PRINT "Continue on Page: "+LTRIM(STR(PAG+1)) CENTER END PRINTPAGE START PRINTPAGE ENDIF PAG++ @ 20,20 PRINT "Business Name" @ 20,190 PRINT "Page: "+LTRIM(STR(PAG)) RIGHT @ 25,20 PRINT DATE() @ 25,105 PRINT "Name of Business" CENTER @ 35,105 PRINT TitlePrint FONT "ft18" CENTER LIN:=55 @ LIN+4,20 PRINT LINE TO LIN+4,130 @ LIN,27 PRINT "ID" RIGHT @ LIN,40 PRINT "First Name" @ LIN,70 PRINT "Last Name" @ LIN,125 PRINT "Salary" RIGHT LIN:=LIN+5 ENDIF @ LIN,27 PRINT cID RIGHT @ LIN,40 PRINT cF_Name @ LIN,70 PRINT cL_Name @ LIN,125 PRINT TRANSFORM( cSalary , "9,999,999,999.99" ) RIGHT LIN:=LIN+5 NEXT I END PRINTPAGE END PRINTDOC return
|
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1854
Зарегистрирован: 11.02.10
|
|
Отправлено: 08.04.21 09:36. Заголовок: SergKis пишет: Прим..
SergKis пишет: цитата: | Пример BASIC\Firebird работает в unicode версии |
| Ok Благодарю за подтверждение
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1855
Зарегистрирован: 11.02.10
|
|
Отправлено: 14.04.21 09:32. Заголовок: Всем кому это интересно :)
Выложил 2-е обновление сборки 21.03 с учетом всех последних исправлений по адресу http://hmgextended.com/files/CONTRIB/hmg-21.03-setup.exe Что нового: Скрытый текст
* Fixed: ON SIZE event is triggered to early in the Modal window with the defined menu. Bug was reported by Theo Pluijm <trmpluym/at/gmail.com>. Based upon a contribution of HMG user Edward. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> * Modified: Adaptation of the MiniGUI core for compatibility with the latest Harbour compiler version 3.0.0 (SVN 2011-07-17 19:15): - the updated header include\i_pseudofunc.ch; - added translate directives for missed Harbour 3.2 functions; - Vista's TaskDialog implementation was blocked due to the incompatibility with Harbour 3.0. Contributed by Grigory Filatov <gfilatov@inbox.ru>. * Updated: Implementation of UNICODE support in the MiniGUI core: - fixed problem with the returned items value in ListBox, ComboBox and GET ini file command. Bug was reported by Allan De Sa. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Harbour Compiler 3.2.0dev (SVN 2021-04-10 23:32): * Updated: PostGreSQL library source code (see in folder \Source\HbPgSql). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * New: 'ButtonEx and Snap Control' sample: added the function Snap2Ctrl(). Contributed by Pierpaolo Martinello <pier.martinello[at]alice.it> (see demo3.prg in folder \samples\Basic\BUTTON_1)
| Также подготовил MinGW сборки с использованием свежей версии 10.3 (вышла 8 апреля 2021 г.)
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6940
Зарегистрирован: 12.09.06
|
|
Отправлено: 15.04.21 16:10. Заголовок: Поставил, полёт норм..
Поставил, полёт нормальный !
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1856
Зарегистрирован: 11.02.10
|
|
Отправлено: 26.04.21 10:45. Заголовок: Всем кому это интересно 8-)
Завершена подготовка 3-го обновления сборки 21.03, которое выйдет послезавтра. Что нового: Скрытый текст
цитата: | * New: The OwnerDraw Menu style supported the following optional command: - SET MENUTHEME [ DEFAULT | XP | 2000 | DARK | USER <aMenu> ] [ OF <form> ] Based on using of the function HMG_SetMenuTheme(). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see menudemo2.prg in folder \samples\Basic\Menu) * Updated: Synchronized Extended HMG for compatibility with Official HMG: - added the useful functions (and appropriate properties) below: - TreeItemGetParentValue(); - TreeItemSetNodeFlag(). Based upon a contribution of Claudio Soto <srvet@adinet.com.uy>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\TreeMenu_3) * Updated: Implementation of UNICODE support in the MiniGUI core: - fixed problem with the TIMEPICKER format string. Bug was reported by Allan De Sa. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.35.5 (from 3.35.4). Contributed by Grigory Filatov <gfilatov@inbox.ru>. * Updated: Harbour Compiler 3.2.0dev (SVN 2021-04-14 22:25). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * New: 'Save/Load Tree Structure in the JSON format' sample. Based upon a contribution of HMG user Edward. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\TreeMenu_3) * Updated: 'Simple PDF Class' sample: - updated for using of the recent PDF Class version. Based upon a contribution of Jose Quintas. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\HaruPDF_2) |
|
| Ваши комментарии приветствуются...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1857
Зарегистрирован: 11.02.10
|
|
Отправлено: 28.04.21 09:41. Заголовок: Как и обещал, выложи..
Как и обещал, выложил 3-е обновление сборки 21.03 с учетом всех последних исправлений Рассматриваю эту сборку как финальную по причинам, которые неоднократно озвучивались ранее (слабый интерес и отсутствие поддержки).
| |
|
|
krutoff
|
| |
Пост N: 202
Зарегистрирован: 17.10.05
|
|
Отправлено: 28.05.21 14:25. Заголовок: _SetStatusItemWidth
Проверил псевдофункцию _SetStatusItemWidth из файла i_status.ch - она не работает. Отработала процедура PROCEDURE _SetStatusWidth ( ParentForm , Item , Size ) файла h_controlmisc.prg
| |
|
rvu
|
| |
Пост N: 320
Зарегистрирован: 05.11.05
|
|
Отправлено: 29.05.21 11:24. Заголовок: В уникодной версии п..
В уникодной версии пытаюсь вывести значение из базы, где оно записано в кодировке 1251 HB_STRTOUTF8(ALLTRIM(BASECONFIG->NAME2)) Показывает ерунду. А так - HB_STRTOUTF8('проба') нормально показывает. Пытался второй параметр HB_STRTOUTF8() прописывать, что ни пробовал, ничего не вышло. Можно, конечно, саму базу под UTF8 переделать, но интересно, почему здесь не работает.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3738
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.05.21 11:32. Заголовок: rvu HB_STRTOUTF8(AL..
rvu HB_STRTOUTF8(ALLTRIM(BASECONFIG->NAME2), "RU1251")
| |
|
rvu
|
| |
Пост N: 321
Зарегистрирован: 05.11.05
|
|
Отправлено: 29.05.21 11:54. Заголовок: SergKis При компил..
SergKis При компиляции выдает ощибку. Причем, со словом "проба" тоже. Неверный аргумент. Подумал, что HB_STRTOUTF8('проба') это неверно, у меня же текст программы уникодный. Что и куда она перекодирует? Написал HB_STRTOUTF8(HB_UTF8TOSTR('проба')) и даже HB_UTF8TOSTR('проба'). Текст, написанный в программе она никак никуда не меняет.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3739
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.05.21 12:02. Заголовок: Ранее уже выкладывал..
| |
|
rvu
|
| |
Пост N: 322
Зарегистрирован: 05.11.05
|
|
Отправлено: 29.05.21 12:14. Заголовок: SergKis Отлично! С..
SergKis Отлично! Спасибо! К сожалению эти примеры долго не живут, упустил я его в прошлый раз.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3740
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.05.21 13:21. Заголовок: PS чуток поправить н..
PS чуток поправить надо (колонку вставил, а в отчетах не поправил) *-----------------------------------------------------------------------------* STATIC FUNC Report( oWnd, nEvent ) *-----------------------------------------------------------------------------* ... LOCAL cNam := oBrw:aColumns[ nEvent+oBrw:nColumn("MARRIED") ]:cHeading ...
| |
|
rvu
|
| |
Пост N: 323
Зарегистрирован: 05.11.05
|
|
Отправлено: 29.05.21 16:23. Заголовок: Вызывал раньше из св..
Вызывал раньше из своей основной программы другую, которую закрывал такой функцией: #define WM_CLOSE 0x0010 FUNCTION CloseIt() PARAMETERS closeDoc LOCAL hWnd := FindWindowEx( ,,, Substr(closeDoc,2,LEN(closeDoc)-2) ) IF IsWindowHandle( hWnd ) PostMessage( hWnd, WM_CLOSE, 0, 0 ) Return .T. ENDIF Return .F. После перехода на уникод перестало работать, IsWindowHandle( hWnd ) возвращает .F. хотя тайтл окна правильный. Попробовал hb_utf8Substr, не помогло, да и вряд ли могло бы, у меня в тайтле только английские буквы и числа и пробел между ними.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3741
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.05.21 19:23. Заголовок: попробуйте EnumWindo..
попробуйте EnumWindows() в примерах есть использование, поищите
| |
|
Dima
|
| |
Пост N: 7374
Зарегистрирован: 17.05.05
|
|
Отправлено: 29.05.21 19:57. Заголовок: rvu пишет: После пе..
rvu пишет: цитата: | После перехода на уникод перестало работать, IsWindowHandle( hWnd ) возвращает .F. |
| А что именно возвращается в hWnd в уникодной версии ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3742
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.05.21 20:13. Заголовок: Dima пишет Наверно ..
Dima пишет цитата: | А что именно возвращается в hWnd в уникодной версии ? |
| Наверно 0 (не найдено), т.к. ф-я HB_FUNC( FINDWINDOWEX ) { #ifndef UNICODE LPCSTR lpszClass = ( char * ) hb_parc( 3 ); LPCSTR lpszWindow = ( char * ) hb_parc( 4 ); #else LPWSTR lpszClass = AnsiToWide( ( char * ) hb_parc( 3 ) ); LPWSTR lpszWindow = AnsiToWide( ( char * ) hb_parc( 4 ) ); #endif HB_RETNL( ( LONG_PTR ) FindWindowEx( ( HWND ) HB_PARNL( 1 ), ( HWND ) HB_PARNL( 2 ), lpszClass, lpszWindow ) ); #ifdef UNICODE hb_xfree( lpszClass ); hb_xfree( lpszWindow ); #endif } Через EnumWindows() можно получить весь список hWnd, title и ClassName
| |
|
rvu
|
| |
Пост N: 324
Зарегистрирован: 05.11.05
|
|
Отправлено: 30.05.21 10:51. Заголовок: Dima пишет: А что и..
Dima пишет: цитата: | А что именно возвращается в hWnd в уникодной версии ? |
| SergKis пишет: Да, 0.
| |
|
Dima
|
| |
Пост N: 7375
Зарегистрирован: 17.05.05
|
|
Отправлено: 30.05.21 20:23. Заголовок: SergKis пишет: попр..
SergKis пишет: Это конечно вариант , но с другой стороны если "сломали" работающую функцию FindWindowEx в уникодной версии , то надо бы починить.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3743
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.05.21 21:36. Заголовок: Dima пишет то надо б..
Dima пишет С этим никто не спорит. Понятно , что для unicode перелопачено много текста и отладка требуется. Попробовал ф-ю EnumWindows() вариант (unicode версия hmg) Скрытый текст
*-----------------------------------------------------------------------------* STATIC FUNCTION HandlesHbWin( cText, cClass, lLogOut ) *-----------------------------------------------------------------------------* LOCAL i, h, t LOCAL aWnd := EnumWindows() LOCAL aTmp := {} LOCAL aRet := {} IF Empty(cClass) aTmp := aWnd ELSE FOR EACH h IN aWnd IF IsWindowHandle( h ) .and. GetClassName( h ) == cClass AAdd( aTmp, h ) ENDIF NEXT ENDIF IF ! empty(cText) .and. HB_ISCHAR(cText) .and. Len(aTmp) > 0 FOR EACH h IN aTmp IF IsWindowHandle( h ) t := GetWindowText( h ) IF cText $ t ; AAdd( aRet, h ) ENDIF ENDIF NEXT ELSE aRet := aTmp ENDIF IF ! Empty(lLogOut) FOR i := 1 TO Len(aTmp) IF IsWindowHandle( aTmp[ i ] ) t := GetWindowText(aTmp[ i ]) _LogFile( .T., str(i, 5), aTmp[ i ], GetClassName(aTmp[ i ]), t ) ENDIF NEXT ENDIF RETURN aRet
| Не работает GetWindowText(), через имя класса hWnd получен, через GetWindowText() нет. Вариант unicode ф-ии GetWindowText() нашей версии и версии hmg Наш (работает) HB_FUNC( GETWINDOWTEXT ) { HWND hWnd = ( HWND ) hb_parnl( 1 ); int iLen = GetWindowTextLength( hWnd ); TCHAR *cText = ( TCHAR * ) hb_xgrab( (iLen + 1)*2 ); int iRet = GetWindowText( hWnd, ( LPTSTR ) cText, (iLen + 1)*2 ); hb_retclen_t( cText, iRet ); hb_xfree( cText ); } uncode HMG HB_FUNC( GETWINDOWTEXT ) { #ifdef UNICODE LPSTR pStr; #endif HWND hWnd = ( HWND ) HB_PARNL( 1 ); int iLen = GetWindowTextLength( hWnd ); LPTSTR szText = ( TCHAR * ) hb_xgrab( ( iLen + 1 ) * sizeof( TCHAR ) ); iLen = GetWindowText( hWnd, szText, iLen + 1 ); #ifndef UNICODE iLen = GetWindowText( hWnd, szText, iLen + 1 ); hb_retclen( szText, iLen ); #else GetWindowText( hWnd, szText, iLen + 1 ); pStr = WideToAnsi( szText ); hb_retc( pStr ); hb_xfree( pStr ); #endif hb_xfree( szText ); }
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3744
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.05.21 21:52. Заголовок: PS Результат вызовов..
PS Результат вызовов ф-ии HandlesHbWin(...) в log Скрытый текст
Find Text = HandlesHbWin('VLC iptv viewer.', , .T.) // не найдено - все в журнал 1 131180 tooltips_class32 '' 2 131202 SynTPEnhTFPWndClass Forcepad driver tray window 3 131138 SynTrackCursorWindowClass '' 4 131140 SynTPHelperWndClass '' 5 65922 ForegroundStaging '' 6 65872 ForegroundStaging '' 7 65754 tooltips_class32 '' 8 65782 tooltips_class32 '' 9 65776 tooltips_class32 '' 10 65772 tooltips_class32 '' 11 65746 tooltips_class32 '' 12 131338 TaskListThumbnailWnd '' 13 131336 tooltips_class32 '' 14 65796 tooltips_class32 '' 15 65792 tooltips_class32 '' 16 65714 Shell_TrayWnd '' 17 65794 tooltips_class32 '' 18 65756 NotifyIconOverflowWindow '' 19 66056 SystemTray_Main Battery Meter 20 66088 ATL:00007FF855FA21F0 '' 21 66114 ATL:00007FF84C89C230 Network Flyout 22 66112 PNIHiddenWnd '' 23 65950 CiceroUIWndFrame CiceroUIWndFrame 24 66480 Internet Explorer_Hidden '' 25 66478 Internet Explorer_Hidden '' 26 66476 Internet Explorer_Hidden '' 27 66468 Internet Explorer_Hidden '' 28 65942 ClassicShell.COwnerWindow '' 29 65888 CiceroUIWndFrame CiceroUIWndFrame 30 65886 CiceroUIWndFrame TF_FloatingLangBar_WndTitle 31 65836 tooltips_class32 '' 32 4457622 GDI+ Hook Window Class GeпЊ°дІ¤; 33 590832 ConsoleWindowClass {C:\MiniGuiUnicode\SAMPLES\_Test\APP_OOPREPORT} - Far 3.0.5511 x64 Администратор 34 4261026 VLC video main 0000029B6AE00660 VLC (Direct3D11 output) 35 7341156 Qt5QWindowIcon аœаАб‚б аЂа’ - Медиапроигрыватель VLC 36 22217626 QTrayIconMessageWindowClass QTrayIconMessageWindow 37 11535482 Static VLC ghk 3.0.12 38 12780242 GDI+ Hook Window Class G 39 3802124 Chrome_WidgetWin_1 '' 40 6292588 Chrome_WidgetWin_1 Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) - Google Chrome 41 12190726 Chrome_WidgetWin_0 '' 42 79496232 Chrome_WidgetWin_0 '' 43 15598672 Chrome_WidgetWin_0 '' 44 13763674 Chrome_StatusTrayWindow '' 45 9438310 Chrome_SystemMessageWindow '' 46 76153996 Chrome_WidgetWin_0 '' 47 722154 Base_PowerMessageWindow '' 48 13173218 crashpad_SessionEndWatcher '' 49 65862 ApplicationManager_DesktopShellWindow '' 50 3276890 CTouchPadSynchronizer TouchPad object helper window 51 3211396 CTouchPadSynchronizer TouchPad object helper window 52 328538 FarHiddenWindowClass '' 53 525076 WindowsForms10.Window.8.app.0.d3a00f_r6_ad1 IntelВ® Management and Security Status 54 262970 WindowsForms10.Window.0.app.0.d3a00f_r6_ad1 '' 55 394082 WindowsForms10.tooltips_class32.app.0.d3a00f_r6_ad1 '' 56 328026 ComboLBox '' 57 394230 ComboLBox '' 58 131802 .NET-BroadcastEventWindow.4.0.0.0.d3a00f.0 .NET-BroadcastEventWindow.4.0.0.0.d3a00f.0 59 328080 GDI+ Hook Window Class G 60 131608 WindowsForms10.Window.0.app.0.141b42a_r34_ad1 '' 61 131352 GDI+ Hook Window Class G 62 197630 .NET-BroadcastEventWindow.4.0.0.0.141b42a.0 .NET-BroadcastEventWindow.4.0.0.0.141b42a.0 63 459726 ATL:00A9A850 Lightshot_Tray_Wnd 64 66490 GDI+ Hook Window Class G 65 66502 VSyncHelper-000001EE4DD3B2A0-235bd58 '' 66 66506 VSyncHelper-000001EE4DD3B240-235c065 '' 67 66508 VSyncHelper-000001EE4DD3B1E0-235c1ac '' 68 66504 VSyncHelper-000001EE4DD3B180-235c013 '' 69 66360 GadgetHostListener '' 70 66354 8GadgetPackHelper '' 71 66350 BasicWindow SidebarBroadcastWatcher 72 66346 GDI+ Hook Window Class G 73 197044 EVERYTHING_TASKBAR_NOTIFICATION '' 74 131546 WindowsForms10.Window.0.app.0.14a43c5_r6_ad1 '' 75 131544 .NET-BroadcastEventWindow.4.0.0.0.14a43c5.0 .NET-BroadcastEventWindow.4.0.0.0.14a43c5.0 76 66208 HwndWrapper[SmartAudio3.exe;;666cf6d2-fb24-4259-95a1-8873a2d0dd06] '' 77 66200 HwndWrapper[SmartAudio3.exe;;498f853c-6c9e-4451-92fc-be6461d8dd95] SystemResourceNotifyWindow 78 131732 HwndWrapper[SmartAudio3.exe;;ea92a926-afef-45ac-b7bf-165f90465a8d] MediaContextNotificationWindow 79 197240 ATL:00007FF848D17D50 HDAudioAPI-D9A3021B-9BCE-458C-B667-9029C4EF4050 80 131206 SynTPEnhTrayWndClass Touchpad driver tray icon window 81 66106 CTouchPadSynchronizer TouchPad object helper window 82 66104 SynTPEnhWndClass Touchpad driver helper window 83 66100 ScrollerooWindowClass Touchpad driver backward compatibility window 84 66096 WorkerW '' 85 66048 WorkerW '' 86 66050 OleDdeWndClass DDE Server Window 87 65930 TabletModeCoverWindow '' 88 66066 WorkerW '' 89 66068 WorkerW '' 90 65912 DummyDWMListenerWindow '' 91 65906 EdgeUiInputTopWndClass '' 92 65870 OleDdeWndClass DDE Server Window 93 65858 WorkerW '' 94 65854 ClassicStartMenu.CStartHookWindow StartHookWindow 95 65844 WorkerW '' 96 65842 WorkerW '' 97 65822 WorkerW '' 98 65820 WorkerW '' 99 131716 AfxFrameOrView140su MicTray 100 197210 WorkerW '' 101 131710 BluetoothNotificationAreaIconWindowClass BluetoothNotificationAreaIconWindowClass 102 262754 QLBCONTROLLER QLBController 103 131190 MS_WebcheckMonitor MS_WebcheckMonitor 104 65712 #32770 The Event Manager Dashboard 105 65686 DDEMLEvent '' 106 65682 DDEMLMom '' 107 131104 PushNotificationsPowerManagement Windows Push Notifications Platform 108 131106 COMTASKSWINDOWCLASS Task Host Window 109 65620 Dwm DWM Notification Window 110 131110 CicLoaderWndClass '' 111 263244 tooltips_class32 '' 112 131652 ESET Client Frame ESET Smart Security 113 66438 SideBar_HTMLHostWindow '' 114 66426 BasicWindow Clock 115 66466 SideBar_HTMLHostWindow '' 116 66462 BasicWindow iBattery 117 66442 SideBar_HTMLHostWindow '' 118 66430 BasicWindow Calendar 119 66440 SideBar_HTMLHostWindow '' 120 66428 BasicWindow WeatherCenter 121 14615606 tooltips_class32 '' 122 1443008 HMG_FORM_wM3U VLC iptv viewer. 123 9962252 WorkerW '' 124 65828 Progman Program Manager 125 66134 MSCTFIME UI MSCTFIME UI 126 66102 IME Default IME 127 131142 IME Default IME 128 1507496 MSCTFIME UI MSCTFIME UI 129 65924 IME Default IME 130 1311580 MSCTFIME UI MSCTFIME UI 131 65860 IME Default IME 132 65814 MSCTFIME UI MSCTFIME UI 133 65716 IME Default IME 134 66090 IME Default IME 135 8979572 IME Default IME 136 328526 MSCTFIME UI MSCTFIME UI 137 459756 IME Default IME 138 19334172 IME Default IME 139 41550874 MSCTFIME UI MSCTFIME UI 140 656526 IME Default IME 141 1049794 IME Default IME 142 8324128 IME Default IME 143 26149966 MSCTFIME UI MSCTFIME UI 144 656604 IME Default IME 145 7471792 IME Default IME 146 9962518 IME Default IME 147 5964892 IME Default IME 148 394056 IME Default IME 149 525300 MSCTFIME UI MSCTFIME UI 150 459580 IME Default IME 151 262562 IME Default IME 152 131354 IME Default IME 153 197248 IME Default IME 154 132062 IME Default IME 155 66492 IME Default IME 156 66356 IME Default IME 157 66352 IME Default IME 158 66348 IME Default IME 159 196986 IME Default IME 160 131734 IME Default IME 161 131706 IME Default IME 162 66098 IME Default IME 163 65856 IME Default IME 164 65830 MSCTFIME UI MSCTFIME UI 165 65824 IME Default IME 166 66182 IME Default IME 167 66178 IME Default IME 168 66152 IME Default IME 169 65718 IME Default IME 170 131102 IME Default IME 171 197230 MSCTFIME UI MSCTFIME UI 172 131578 IME Default IME 173 66452 MSCTFIME UI MSCTFIME UI 174 66434 IME Default IME 175 66474 MSCTFIME UI MSCTFIME UI 176 66464 IME Default IME 177 66456 MSCTFIME UI MSCTFIME UI 178 66436 IME Default IME 179 66454 MSCTFIME UI MSCTFIME UI 180 66432 IME Default IME 181 65850 MSCTFIME UI MSCTFIME UI 182 65684 IME Default IME 183 5440658 MSCTFIME UI MSCTFIME UI 184 10159236 IME Default IME Find Class = HandlesHbWin(, 'HMG_FORM_wM3U', .T.) // найдено 1 1443008 HMG_FORM_wM3U VLC iptv viewer.
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3745
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.05.21 09:13. Заголовок: SergKis пишет Не раб..
SergKis пишет цитата: | Не работает GetWindowText() |
| Виноват, работает GetWindowText() и HandlesHbWin() работает. Похоже заработался вчера.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1863
Зарегистрирован: 11.02.10
|
|
Отправлено: 31.05.21 10:27. Заголовок: Выложил майскую ANSI..
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3746
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.05.21 10:42. Заголовок: gfilatov2002 пишет А..
gfilatov2002 пишет цитата: | Архив уникодной сборки также обновил |
| Можно получить этот вариант на посмотрреть ?
| |
|
rvu
|
| |
Пост N: 325
Зарегистрирован: 05.11.05
|
|
Отправлено: 31.05.21 11:14. Заголовок: gfilatov2002 А хор..
gfilatov2002 А хорошо бы в уникодной версии тоже завести программы-примеры. SergKis выкладывал на днях один.
| |
|
rvu
|
| |
Пост N: 326
Зарегистрирован: 05.11.05
|
|
Отправлено: 31.05.21 11:20. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Архив уникодной сборки также обновил с учетом обсуждения работы функции GetWindowText() |
| А FindWindowEx() будете менять под уникод?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1864
Зарегистрирован: 11.02.10
|
|
Отправлено: 31.05.21 13:22. Заголовок: SergKis пишет: Можн..
SergKis пишет: цитата: | Можно получить этот вариант на посмотрреть ? |
| Отправил ссылку в личку
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3747
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.05.21 13:24. Заголовок: gfilatov2002 Спасиб..
gfilatov2002 Спасибо
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3748
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.05.21 14:27. Заголовок: gfilatov2002 что то..
gfilatov2002 что то не то с GetWindowText() unicode Скрытый текст
/* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" REQUEST HB_CODEPAGE_UTF8 REQUEST HB_CODEPAGE_RU1251 REQUEST DBFCDX *-----------------------------------------------------------------------------* FUNCTION Main() *-----------------------------------------------------------------------------* SET CODEPAGE TO UNICODE RddSetDefault("DBFCDX") SET CENTURY ON SET DATE GERMAN SET DELETED ON SET EXCLUSIVE ON SET EPOCH TO 2000 SET AUTOPEN ON SET EXACT ON SET SOFTSEEK ON SET NAVIGATION EXTENDED SET FONT TO "Arial", 11 *-------------------------------- SET OOP ON *-------------------------------- ? "Find Text =", "HandlesHbWin('VLC iptv viewer.', , .T.)" ? HandlesHbWin("VLC iptv viewer.", , .T.) ? ? "Find Class = ", "HandlesHbWin(, 'HMG_FORM_wM3U', .T.)" ? HandlesHbWin(, "HMG_FORM_wM3U", .T.) ? RETURN *-----------------------------------------------------------------------------* STATIC FUNCTION HandlesHbWin( cText, cClass, lLogOut ) *-----------------------------------------------------------------------------* LOCAL i, h, t LOCAL aWnd := EnumWindows() LOCAL aTmp := {} LOCAL aRet := {} IF Empty(cClass) aTmp := aWnd ELSE FOR EACH h IN aWnd IF IsWindowHandle( h ) .and. GetClassName( h ) == cClass AAdd( aTmp, h ) ENDIF NEXT ENDIF IF ! empty(cText) .and. HB_ISCHAR(cText) .and. Len(aTmp) > 0 ? aTmp FOR EACH h IN aTmp ? hb_enumindex(h), h, IsWindowHandle( h ) IF IsWindowHandle( h ) ?? "t =" BEGIN SEQUENCE WITH { |e|break(e) } ?? "->" t := GetWindowText( h ) ?? "<-" END SEQUENCE ?? t IF cText $ t ; AAdd( aRet, h ) ENDIF ENDIF NEXT ELSE aRet := aTmp ENDIF IF ! Empty(lLogOut) FOR i := 1 TO Len(aTmp) IF IsWindowHandle( aTmp[ i ] ) t := GetWindowText(aTmp[ i ]) _LogFile( .T., str(i, 5), aTmp[ i ], GetClassName(aTmp[ i ]), t ) ENDIF NEXT ENDIF RETURN aRet
| Снимается "Abnormal program termination"
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1865
Зарегистрирован: 11.02.10
|
|
Отправлено: 31.05.21 16:55. Заголовок: SergKis пишет: что ..
SergKis пишет: Ваш пример у меня отработал нормально. Прошу попробовать снова с самого начала...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3749
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.05.21 20:16. Заголовок: gfilatov2002 пишет П..
gfilatov2002 пишет цитата: | Прошу попробовать снова с самого начала... |
| Так и сделал, не помогло. Убрал GetWndowText(), вывод только класса - работает, на запросе текста валится на строке 32 15008680 GDI+ Hook Window Class Пример Скрытый текст
/* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" REQUEST HB_CODEPAGE_UTF8, HB_CODEPAGE_RU1251 REQUEST DBFCDX *-----------------------------------------------------------------------------* FUNCTION Main() *-----------------------------------------------------------------------------* SET CODEPAGE TO UNICODE RddSetDefault("DBFCDX") SET CENTURY ON SET DATE GERMAN SET DELETED ON SET EXCLUSIVE ON SET EPOCH TO 2000 SET AUTOPEN ON SET EXACT ON SET SOFTSEEK ON SET NAVIGATION EXTENDED SET FONT TO "Arial", 11 *-------------------------------- SET OOP ON *-------------------------------- ? "Find Text =", "HandlesHbWin(, , .T.)" ? HandlesHbWin( , , .T.) ? /* ? "Find Class = ", "HandlesHbWin(, 'HMG_FORM_wM3U', .T.)" ? HandlesHbWin(, "HMG_FORM_wM3U", .T.) ? */ ? "Find Text =", "HandlesHbWin('VLC iptv viewer.', , .T.)" ? HandlesHbWin("VLC iptv viewer.", , .T.) ? */ RETURN *-----------------------------------------------------------------------------* STATIC FUNCTION HandlesHbWin( cText, cClass, lLogOut ) *-----------------------------------------------------------------------------* LOCAL i, h, t LOCAL aWnd := EnumWindows() LOCAL aTmp := {} LOCAL aRet := {} IF Empty(cClass) aTmp := aWnd ELSE FOR EACH h IN aWnd IF IsWindowHandle( h ) .and. GetClassName( h ) == cClass AAdd( aTmp, h ) ENDIF NEXT ENDIF IF ! empty(cText) .and. HB_ISCHAR(cText) .and. Len(aTmp) > 0 ? aTmp FOR EACH h IN aTmp ? hb_enumindex(h), h, IsWindowHandle( h ) IF IsWindowHandle( h ) ?? "t =" BEGIN SEQUENCE WITH { |e|break(e) } ?? "->" t := GetWindowText( h ) ?? "<-" END SEQUENCE ?? t IF cText $ t ; AAdd( aRet, h ) ENDIF ENDIF NEXT ELSE aRet := aTmp ENDIF IF ! Empty(lLogOut) FOR i := 1 TO Len(aTmp) IF IsWindowHandle( aTmp[ i ] ) //t := GetWindowText(aTmp[ i ]) _LogFile( .T., str(i, 5), aTmp[ i ], GetClassName(aTmp[ i ]) /*, t*/ ) ENDIF NEXT ENDIF RETURN aRet
| Log файл (сначала вывод только с классом, потом с текстом) Скрытый текст
Find Text = HandlesHbWin(, , .T.) 1 131138 SynTrackCursorWindowClass 2 131180 tooltips_class32 3 131202 SynTPEnhTFPWndClass 4 131140 SynTPHelperWndClass 5 65922 ForegroundStaging 6 65872 ForegroundStaging 7 65754 tooltips_class32 8 65782 tooltips_class32 9 65776 tooltips_class32 10 65772 tooltips_class32 11 65746 tooltips_class32 12 131336 tooltips_class32 13 65796 tooltips_class32 14 65792 tooltips_class32 15 65950 CiceroUIWndFrame 16 65714 Shell_TrayWnd 17 131338 TaskListThumbnailWnd 18 65794 tooltips_class32 19 65756 NotifyIconOverflowWindow 20 66056 SystemTray_Main 21 66088 ATL:00007FF855FA21F0 22 66114 ATL:00007FF84C89C230 23 66112 PNIHiddenWnd 24 66480 Internet Explorer_Hidden 25 66478 Internet Explorer_Hidden 26 66476 Internet Explorer_Hidden 27 66468 Internet Explorer_Hidden 28 65942 ClassicShell.COwnerWindow 29 65888 CiceroUIWndFrame 30 65886 CiceroUIWndFrame 31 65836 tooltips_class32 32 15008680 GDI+ Hook Window Class 33 590832 ConsoleWindowClass 34 65862 ApplicationManager_DesktopShellWindow 35 4063322 CTouchPadSynchronizer 36 3997828 CTouchPadSynchronizer 37 66442 SideBar_HTMLHostWindow 38 66430 BasicWindow 39 328538 FarHiddenWindowClass 40 525076 WindowsForms10.Window.8.app.0.d3a00f_r6_ad1 41 262970 WindowsForms10.Window.0.app.0.d3a00f_r6_ad1 42 394082 WindowsForms10.tooltips_class32.app.0.d3a00f_r6_ad1 43 328026 ComboLBox 44 394230 ComboLBox 45 131802 .NET-BroadcastEventWindow.4.0.0.0.d3a00f.0 46 328080 GDI+ Hook Window Class 47 131608 WindowsForms10.Window.0.app.0.141b42a_r34_ad1 48 131352 GDI+ Hook Window Class 49 197630 .NET-BroadcastEventWindow.4.0.0.0.141b42a.0 50 459726 ATL:00A9A850 51 66490 GDI+ Hook Window Class 52 66502 VSyncHelper-000001EE4DD3B2A0-235bd58 53 66506 VSyncHelper-000001EE4DD3B240-235c065 54 66508 VSyncHelper-000001EE4DD3B1E0-235c1ac 55 66504 VSyncHelper-000001EE4DD3B180-235c013 56 66360 GadgetHostListener 57 66354 8GadgetPackHelper 58 66350 BasicWindow 59 66346 GDI+ Hook Window Class 60 197044 EVERYTHING_TASKBAR_NOTIFICATION 61 131546 WindowsForms10.Window.0.app.0.14a43c5_r6_ad1 62 131544 .NET-BroadcastEventWindow.4.0.0.0.14a43c5.0 63 66208 HwndWrapper[SmartAudio3.exe;;666cf6d2-fb24-4259-95a1-8873a2d0dd06] 64 66200 HwndWrapper[SmartAudio3.exe;;498f853c-6c9e-4451-92fc-be6461d8dd95] 65 131732 HwndWrapper[SmartAudio3.exe;;ea92a926-afef-45ac-b7bf-165f90465a8d] 66 197240 ATL:00007FF848D17D50 67 131206 SynTPEnhTrayWndClass 68 66106 CTouchPadSynchronizer 69 66104 SynTPEnhWndClass 70 66100 ScrollerooWindowClass 71 66096 WorkerW 72 66048 WorkerW 73 66050 OleDdeWndClass 74 65930 TabletModeCoverWindow 75 66066 WorkerW 76 66068 WorkerW 77 65912 DummyDWMListenerWindow 78 65906 EdgeUiInputTopWndClass 79 65870 OleDdeWndClass 80 65858 WorkerW 81 65854 ClassicStartMenu.CStartHookWindow 82 65844 WorkerW 83 65842 WorkerW 84 65822 WorkerW 85 65820 WorkerW 86 131716 AfxFrameOrView140su 87 197210 WorkerW 88 131710 BluetoothNotificationAreaIconWindowClass 89 262754 QLBCONTROLLER 90 131190 MS_WebcheckMonitor 91 65712 #32770 92 65686 DDEMLEvent 93 65682 DDEMLMom 94 131104 PushNotificationsPowerManagement 95 131106 COMTASKSWINDOWCLASS 96 65620 Dwm 97 131110 CicLoaderWndClass 98 263244 tooltips_class32 99 131652 ESET Client Frame 100 66438 SideBar_HTMLHostWindow 101 66426 BasicWindow 102 66440 SideBar_HTMLHostWindow 103 66428 BasicWindow 104 66466 SideBar_HTMLHostWindow 105 66462 BasicWindow 106 9962252 WorkerW 107 65828 Progman 108 66134 MSCTFIME UI 109 66102 IME 110 131142 IME 111 1507496 MSCTFIME UI 112 65924 IME 113 65814 MSCTFIME UI 114 65716 IME 115 66090 IME 116 15401362 IME 117 328526 MSCTFIME UI 118 459756 IME 119 1311580 MSCTFIME UI 120 65860 IME 121 66456 MSCTFIME UI 122 66436 IME 123 394056 IME 124 525300 MSCTFIME UI 125 459580 IME 126 262562 IME 127 131354 IME 128 197248 IME 129 132062 IME 130 66492 IME 131 66356 IME 132 66352 IME 133 66348 IME 134 196986 IME 135 131734 IME 136 131706 IME 137 66098 IME 138 65856 IME 139 65830 MSCTFIME UI 140 65824 IME 141 66182 IME 142 66178 IME 143 66152 IME 144 65718 IME 145 131102 IME 146 197230 MSCTFIME UI 147 131578 IME 148 66452 MSCTFIME UI 149 66434 IME 150 66454 MSCTFIME UI 151 66432 IME 152 66474 MSCTFIME UI 153 66464 IME 154 65850 MSCTFIME UI 155 65684 IME ARRAY[155] Find Text = HandlesHbWin('VLC iptv viewer.', , .T.) ARRAY[155] 1 131138 .T. t = -> <- '' 2 131180 .T. t = -> <- '' 3 131202 .T. t = -> <- Forcepad driver tray window 4 131140 .T. t = -> <- '' 5 65922 .T. t = -> <- '' 6 65872 .T. t = -> <- '' 7 65754 .T. t = -> <- '' 8 65782 .T. t = -> <- '' 9 65776 .T. t = -> <- '' 10 65772 .T. t = -> <- '' 11 65746 .T. t = -> <- '' 12 131336 .T. t = -> <- '' 13 65796 .T. t = -> <- '' 14 65792 .T. t = -> <- '' 15 65950 .T. t = -> <- CiceroUIWndFrame 16 65714 .T. t = -> <- '' 17 131338 .T. t = -> <- '' 18 65794 .T. t = -> <- '' 19 65756 .T. t = -> <- '' 20 66056 .T. t = -> <- Battery Meter 21 66088 .T. t = -> <- '' 22 66114 .T. t = -> <- Network Flyout 23 66112 .T. t = -> <- '' 24 66480 .T. t = -> <- '' 25 66478 .T. t = -> <- '' 26 66476 .T. t = -> <- '' 27 66468 .T. t = -> <- '' 28 65942 .T. t = -> <- '' 29 65888 .T. t = -> <- CiceroUIWndFrame 30 65886 .T. t = -> <- TF_FloatingLangBar_WndTitle 31 65836 .T. t = -> <- '' 32 15008680 .T. t = ->
| В последней версии не unicode - все работает
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3750
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.05.21 20:39. Заголовок: PS восстановил пред...
PS восстановил пред. версию hmg-21.03-unicode, снятия нет, строка получается в лог такая (с бяками) 32 5244084 GDI+ Hook Window Class Geꆐ䮀;
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1866
Зарегистрирован: 11.02.10
|
|
Отправлено: 31.05.21 21:47. Заголовок: SergKis пишет: не п..
SergKis пишет: цитата: | не помогло. Убрал GetWndowText(), вывод только класса - работает, на запросе текста валится |
| Проверял работу Вашего примера под Windows 7 и Windows 10 - проблем не было. На всякий случай привожу текущую реализацию функции GetWindowText() Скрытый текст
HB_FUNC( GETWINDOWTEXT ) { #ifdef UNICODE LPSTR pStr; #endif HWND hWnd = ( HWND ) HB_PARNL( 1 ); int iLen = GetWindowTextLength( hWnd ); LPTSTR szText = ( TCHAR * ) hb_xgrab( ( iLen + 1 ) * sizeof( TCHAR ) ); #ifndef UNICODE iLen = GetWindowText( hWnd, szText, iLen + 1 ); hb_retclen( szText, iLen ); #else GetWindowText( hWnd, szText, iLen + 1 ); pStr = WideToAnsi( szText ); hb_retc( pStr ); hb_xfree( pStr ); #endif hb_xfree( szText );
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3751
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.06.21 10:56. Заголовок: gfilatov2002 пишет Н..
gfilatov2002 пишет цитата: | На всякий случай привожу текущую реализацию функции GetWindowText() |
| Ф-ии отличаются, у меня вариант в zip такой Скрытый текст
HB_FUNC( GETWINDOWTEXT ) { #ifdef UNICODE LPSTR pStr; #endif HWND hWnd = ( HWND ) HB_PARNL( 1 ); int iLen = GetWindowTextLength( hWnd ); LPTSTR szText = ( TCHAR * ) hb_xgrab( ( iLen + 1 ) * sizeof( TCHAR ) ); #ifndef UNICODE iLen = GetWindowText( hWnd, szText, iLen + 1 ); hb_retclen( szText, iLen ); #else GetWindowText( hWnd, szText, ( iLen + 1 ) * sizeof( TCHAR ) ); pStr = WideToAnsi( szText ); hb_retc( pStr ); hb_xfree( pStr ); #endif hb_xfree( szText ); }
| сделал правку, но сборка не удалась, много warning-ов и в итоге не собирается пример PS в своей версии unicode строка 32 15008680 GDI+ Hook Window Class выглядит так 37 22086474 GDI+ Hook Window Class G
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1867
Зарегистрирован: 11.02.10
|
|
Отправлено: 01.06.21 11:25. Заголовок: SergKis пишет: сбор..
SergKis пишет: Я уже обновил архив Unicode сборки, адрес прежний
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3752
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.06.21 12:47. Заголовок: gfilatov2002 пишет о..
gfilatov2002 пишет цитата: | обновил архив Unicode сборки |
| Работает пример на этой сборке, но смущает строка с бяками (в файле бяки визуально ? в квадратике) 32 86835678 GDI+ Hook Window Class G用眠眎; в нашей сборке кракозябликов нет
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1868
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.06.21 13:06. Заголовок: Dima пишет: если ..
Dima пишет: цитата: | если "сломали" работающую функцию FindWindowEx в уникодной версии , то надо бы починить. |
| Поправил работу функции FindWindowEx в уникодной версии Залил Unicode архив с исправлением как 1-й апдейт версии 21.05
| |
|
rvu
|
| |
Пост N: 327
Зарегистрирован: 05.11.05
|
|
Отправлено: 02.06.21 17:32. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Поправил работу функции FindWindowEx в уникодной версии Залил Unicode архив с исправлением как 1-й апдейт версии 21.05 |
| Большое спасибо!
| |
|
rvu
|
| |
Пост N: 328
Зарегистрирован: 05.11.05
|
|
Отправлено: 02.06.21 20:41. Заголовок: Использую HPDFPRINT...
Использую HPDFPRINT. А какую кодировку писать для уникода в SET HPDFDOC ENCODING TO? И работает ли это вообще с уникодом?
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6963
Зарегистрирован: 12.09.06
|
|
Отправлено: 07.06.21 01:03. Заголовок: Искал для себя приме..
Искал для себя пример, нашёл вылет БЕЗ ПОКАЗА ОКНА ОШИБКИ в примере BASIC\Tooltip\TrackingToolTips Что править не разбирался. Подскажите как можно сделать типа Show Balloon для окна расположенного в Панели задач ? Для трея примеры нашёл, а для Панели задачи нет. Можно ли сделать Show Balloon чтобы располагался в правом верхнем углу рабочего стола на 10-20 секунд ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1869
Зарегистрирован: 11.02.10
|
|
Отправлено: 07.06.21 10:53. Заголовок: Andrey пишет: нашёл..
Andrey пишет: цитата: | нашёл вылет БЕЗ ПОКАЗА ОКНА ОШИБКИ в примере BASIC\Tooltip\TrackingToolTips |
| Поправил в первом апдейте сборки 21.05 Благодарю за помощь
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1870
Зарегистрирован: 11.02.10
|
|
Отправлено: 07.06.21 10:56. Заголовок: Всем кому это интересно
| |
|
i3t4j6
|
| |
Пост N: 139
Зарегистрирован: 12.06.06
|
|
Отправлено: 08.06.21 08:08. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Выложил майскую ANSI сборку 21.05 с учетом всех последних изменений |
| Нельзя ли предусмотреть возможность переключения на старый добрый вариант вывода информации в ErrorLog file (без анимации) ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1871
Зарегистрирован: 11.02.10
|
|
Отправлено: 08.06.21 10:56. Заголовок: i3t4j6 пишет: вариа..
i3t4j6 пишет: цитата: | вариант вывода информации в ErrorLog file (без анимации |
| Просматриваю файл ErrorLog по клавише F3 в Total Commanderе - никакой анимации там нет. Другой вариант - собственный обработчик ошибок, образцы есть в примерах
| |
|
i3t4j6
|
| |
Пост N: 140
Зарегистрирован: 12.06.06
|
|
Отправлено: 08.06.21 12:22. Заголовок: Program Error -вывод..
Program Error -вывод ошибки на экран - обыкновенный текст на белом фоне, а не желтое на красном и на весь экран !
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1872
Зарегистрирован: 11.02.10
|
|
Отправлено: 08.06.21 12:28. Заголовок: i3t4j6 пишет: вывод..
i3t4j6 пишет: цитата: | вывод ошибки на экран - обыкновенный текст на белом фоне |
| Понял Тогда только вариант с собственным обработчиком
| |
|
Haz
|
| |
Пост N: 1691
Зарегистрирован: 20.02.11
|
|
Отправлено: 08.06.21 15:28. Заголовок: i3t4j6 пишет: Progr..
i3t4j6 пишет: цитата: | Program Error -вывод ошибки на экран - обыкновенный текст на белом фоне, а не желтое на красном и на весь экран ! |
| у меня вообще валится без всяких окон, ни красных ни белых , хорошо хоть лог пишет Time from start: 0 days 0 hours 0 mins 3 secs<BR> <span class="error">Error MGERROR/0 Control: Btn_01 Of oDlg Not defined. Program terminated.</span> </p> <details><summary> --------------------------------- Stack Trace --------------------------------- <br/></summary><span class="stacktrace"> Called from MSGMINIGUIERROR(0) <BR> Called from VERIFYCONTROLDEFINED(0) <BR> Called from SETPROPERTY(0) <BR> Called from FILLDLG(0) <BR> Called from HMG_ALERT(0) <BR> Called from _ALERT(0) <BR> Called from ALERTSTOP(0) <BR> Called from SHOWERROR(0) <BR> Called from DEFERROR(0) <BR> Called from (b)ERRORSYS(0) <BR> Called from K_BROWSE(35) in module: K_Browse.prg <BR> Called from OPENPRJ(194) in module: Module.prg <BR> Called from (b)MAIN(290) in module: Main.prg <BR> Called from DO_WINDOWEVENTPROCEDURE(0) <BR> Called from TWNDDATA:DOEVENT(0) <BR> Called from DO_ONWNDLAUNCH(0) <BR> Called from (b)INIT(0) <BR> Called from EVENTS(0) <BR> Called from DOMESSAGELOOP(0) <BR> Called from _ACTIVATEWINDOW(0) <BR> Called from MAIN(404) in module: Main.prg Саму ошибку сделал специально чтоб посмотреть на красное FUNCTION K_Browse(oWnd, nPage) LOCAl cSql := "" LOCAl cBrw, cBrw1 := "" LOCAl oBrw, oBrw1 LOCAl cAlias := "" LOCAl cAlias1 := "" LOCAL nRecCount := 0 LOCAL aFields := {} LOCAL cCol := "" ? a[1] // вот тут обращение к несуществующему массиву ЗЫ пока Пересобрал библиотеку со старой редакцией ShowError(). работает хоть
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6964
Зарегистрирован: 12.09.06
|
|
Отправлено: 08.06.21 17:03. Заголовок: Haz пишет: у меня в..
Haz пишет: цитата: | у меня вообще валится без всяких окон, ни красных ни белых , хорошо хоть лог пишет |
| Возьми в новом исходнике ErrorSys.prg строка 242: AlertStop( cMsg, "Program Error", "ZZZ_B_STOP64", 64, { { 217, 67, 67 } }, .T., bInit ) Поставь так: MsgStop( cMsg, "Program Error") // обыкновенный текст на белом фоне Но ошибка на красном фоне приятней смотрится и юзер понятней что ошибка. Я писал об ошибке в HMG_ALERT(), что-то там надо докрутить. У меня тоже вылетает в FILLDLG(). Скорее всего ошибка здесь: bInit := {|| iif( GetControlType( "Say_01", "oDlg" ) == "EDIT",, ( ; SetProperty( "oDlg", "Say_01", "FontColor", YELLOW ), ; SetProperty( "oDlg", "Say_01", "Alignment", "CENTER" ), ; SetProperty( "oDlg", "Say_02", "FontColor", YELLOW ), ; SetProperty( "oDlg", "Say_02", "Alignment", "CENTER" ) ) ) } Не находит объект Say_02. Ради теста добавь к себе в проект ErrorSys.prg и посмотри... Я у себя сделал сохранения скрина экрана ошибки в папку ошибок - полезная штука для анализа ошибок. У меня в проге один модуль работает с пятью таблицами. И когда происходит ошибка, то я не могу понять где произошла ошибка. Нет алиаса базы при ошибке, нет номера записи при ошибке. Есть только номер строки ошибки и всё. Скрин экрана ОЧЕНЬ помогает при анализе ошибки.
| |
|
Haz
|
| |
Пост N: 1692
Зарегистрирован: 20.02.11
|
|
Отправлено: 08.06.21 17:18. Заголовок: Andrey пишет: Возьм..
Andrey пишет: цитата: | Возьми в новом исходнике ErrorSys.prg строка 242: |
| так уже старый вариант в исхоники перекомпилил Andrey пишет: цитата: | Но ошибка на красном фоне приятней смотрится и юзер понятней что ошибка. |
|
Ну тут на вкус и цвет все фломастеры разные. Мне наоборот кажется что от красных окон пользователи в обморок падать начнут. У меня есть проекты с очень бледным интерфейсом по цветам ( заказчик пожелал ) и красное окно точно ему не понравится.
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6965
Зарегистрирован: 12.09.06
|
|
Отправлено: 08.06.21 17:45. Заголовок: Haz пишет: Мне наоб..
Haz пишет: цитата: | Мне наоборот кажется что от красных окон пользователи в обморок падать начнут. |
| У меня наоборот, юзер не сообщает об ошибке. Можно поправить на свой ЛЮБОЙ цвет в строке 237: SET MSGALERT BACKCOLOR TO MAROON SET MSGALERT FONTCOLOR TO WHITE С новым модулем ErrorSys.prg легче стало править окно ошибки под себя. В старом модуле у меня при ошибке кнопки Ok иногда не было видно, уходило за границу экрана. Да и скопировать ошибку в буфер экрана - это уже давно у всех есть, а в МиниГуи не было до сих пор. В новом модуле ErrorSys.prg так же зашит поиск по трём фильтрам: Если прога стоит на сервере терминалов, то не понятно было какая станция свалилась по ошибке. Сейчас добавлена вот такая строка: Html_LineText( HtmArch, 'User: ' + NetName() + " / " + GetUserName() ) Я в своём обработчике ошибок (исправленном под себя) добавил ещё такие строки: Html_LineText( HtmArch, 'Application: ' + GetExeFileName() + " " + M->cPubVersProg ) Html_LineText( HtmArch, 'User: ' + NetName()+"/"+hb_UserName()+"/"+M->cOperator ) Html_LineText( HtmArch, 'DbInfo: Alias - '+ ALIAS() + ', Ord - ' + OrdSetFocus() + ; ', Recno - ' + HB_NtoS(RecNo()) + '/' + HB_NtoS(LastRec()) )
| |
|
Haz
|
| |
Пост N: 1693
Зарегистрирован: 20.02.11
|
|
Отправлено: 08.06.21 18:00. Заголовок: Andrey пишет: У мен..
Andrey пишет: цитата: | У меня наоборот, юзер не сообщает об ошибке. |
| я Сам смотрю по логам, плюс прилетает на почту сообщение ( опционально ) и в Bitrix сообщением по некоторым проектам считаю что пользователь и сообщать не должен, т.к. многие прочитать что написано не в состоянии. Andrey пишет: цитата: | Можно поправить на свой ЛЮБОЙ цвет в строке 237: |
| вопрос не в цвете, как поправить знаю. Вопрос в тихом падении, пользователь даже понять не может куда все делось. Andrey пишет: цитата: | В новом модуле ErrorSys.prg зашит поиск по трём фильтрам: |
| наверное это хорошо. иногда быстрее просто текстовым просмотром глянуть особенно с телефона . Мне не принципиально в каком виде лог ведется , главное там все есть.
| |
|
i3t4j6
|
| |
Пост N: 141
Зарегистрирован: 12.06.06
|
|
Отправлено: 09.06.21 08:01. Заголовок: Haz пишет: Ну тут н..
Haz пишет: цитата: | Ну тут на вкус и цвет все фломастеры разные. |
| Поэтому я и предложил предусмотреть возможность переключения между классическим вариантом и мультиками.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1873
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.06.21 09:23. Заголовок: i3t4j6 пишет: я и п..
i3t4j6 пишет: цитата: | я и предложил предусмотреть возможность переключения между классическим вариантом и мультиками. |
| Благодарю за подсказку Я добавил во втором апдейте текущей сборки новую команду: цитата: | SET SHOWREDALERT [ON | OFF] |
| для возможности управлять видом этого окна. Скоро выложу это обновление
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3754
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.06.21 09:50. Заголовок: gfilatov2002 пишет Я..
gfilatov2002 пишет цитата: | Я добавил во втором апдейте текущей сборки новую команду: |
| Может вариант блока кода обработчика сделать для замены, что то такое STATIC bErrorSys FUNC _bErrorSys( bErr ) IF pCount() > 0 ; bErrorSys := bErr ENDIF RETURN bErrorSys *-----------------------------------------------------------------------------* PROCEDURE ErrorSys *-----------------------------------------------------------------------------* LOCAL bErr := _bErrorSys( bErr ) IF Valtype(bErr) != "B" ; bErr := { | oError | DefError( oError ) } ENDIF ErrorBlock( bErr ) #ifndef __XHARBOUR__ Set( _SET_HBOUTLOG, GetStartUpFolder() + "\error.log" ) Set( _SET_HBOUTLOGINFO, MiniGUIVersion() ) #endif RETURN
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1874
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.06.21 10:06. Заголовок: SergKis пишет: Може..
SergKis пишет: цитата: | Может вариант блока кода обработчика сделать для замены |
| Сергей! Идея понятна, но для такой замены есть же стандартные средства со времен Клиппера
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3755
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.06.21 10:12. Заголовок: gfilatov2002 пишет д..
gfilatov2002 пишет цитата: | для такой замены есть же стандартные средства со времен Клиппера |
| Что то я подзабыл, как это делать, так давно было Для hmg подменяем ErrorSys.prg на свой вариант
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1875
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.06.21 10:28. Заголовок: SergKis пишет: подз..
SergKis пишет: См. примеры в папках: - basic\MyErrorFunc; - basic\Hmg_Error_2.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1876
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.06.21 10:29. Заголовок: Выложил Update 2 для..
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3756
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.06.21 10:46. Заголовок: gfilatov2002 пишет С..
gfilatov2002 пишет Спасибо Примеры видел, но не вдохновили. Заменой prg (полученный new obj), показалось удобнее в использовании. Предложил блок кода для более гибких вариантов, подменой на лету, если кому надо комбинировать html\txt\...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3760
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.06.21 12:05. Заголовок: gfilatov2002 Неболь..
gfilatov2002 Небольшая добавка METHOD SetArrayTo( aArray, uFontHF, aHead, aSizes, uFooter, aPicture, aAlign, aName ) CLASS TSBrowse ... FOR nI := 1 TO Len( ::aArray ) FOR nN := 1 TO nColumns If HB_ISCHAR( ::aArray[ nI, nN ] ) .and. CRLF $ ::aArray[ nI, nN ] cData := "" AEval(hb_aTokens(::aArray[ nI, nN ], CRLF), {|x| x := trim(x), cData := If( Len(x) > Len(cData), x, cData )}) Else cData := cValToChar( ::aArray[ nI, nN ] ) EndIf IF Len( cData ) > Len( aDefMaxVal[ nN ] ) IF aDefType[ nN ] == "C" aDefMaxVal[ nN ] := Trim( cData ) aDefMaxLen[ nN ] := Max( aDefMaxLen[ nN ], Len( aDefMaxVal[ nN ] ) ) ELSE aDefMaxVal[ nN ] := cData aDefMaxLen[ nN ] := Max( aDefMaxLen[ nN ], Len( cData ) ) ENDIF ENDIF NEXT NEXT ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1877
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.06.21 13:03. Заголовок: SergKis пишет: Небо..
SergKis пишет: Принято. Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3761
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.06.21 14:45. Заголовок: gfilatov2002 Надо е..
gfilatov2002 Надо еще поправить, т.к. aDefMaxLen[ nI ] помешает расчету METHOD SetArrayTo( aArray, uFontHF, aHead, aSizes, uFooter, aPicture, aAlign, aName ) CLASS TSBrowse ... line 12950 FOR nI := 1 TO nColumns cType := ValType( ::aArray[ 1, nI ] ) aDefType[ nI ] := cType IF cType $ "CM" ::aDefValue[ nI ] := Space( Len( ::aArray[ 1, nI ] ) ) aDefMaxVal[ nI ] := Trim( ::aArray[ 1, nI ] ) aDefMaxLen[ nI ] := iif( CRLF $ aDefMaxVal[ nI ], 0, Len( aDefMaxVal[ nI ] ) ) aDefAlign[ nI ] := DT_LEFT ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1878
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.06.21 15:10. Заголовок: SergKis пишет: Надо..
SergKis пишет: OK
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1879
Зарегистрирован: 11.02.10
|
|
Отправлено: 14.06.21 10:21. Заголовок: Всем кому это интересно
Подготовил 3-й апдейт для сборки 25.05, который выйдет на этой неделе Что нового: Скрытый текст
* Modified: The some internal SetGet functions were defined as Static. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see h_controlmisc.prg in folder \Source). * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - minor correction in the method SetArrayTo in the TSBrowse class. Contributed by Sergej Kiselev (see demo in folder \samples\Advanced\Tsb_SetArrayTo) * Updated: HbSQLite3 library: - update for using SQLITE3 latest version 3.36.0dev. Contributed by Grigory Filatov <gfilatov@inbox.ru>. * Updated: 'GraphPlus library demo' sample. Based upon a contribution of S.Rathinagiri <srgiri@dataone.in> Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\GraphPlus) * Updated: 'Source Code Formatter' utility. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \Utils\ofmt)
| Если у Вас есть полезные дополнения для библиотеки, то я с удовольствием их рассмотрю с целью включения в эту сборку...
| |
|
Haz
|
| |
Пост N: 1699
Зарегистрирован: 20.02.11
|
|
Отправлено: 15.06.21 21:03. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Если у Вас есть полезные дополнения для библиотеки, то я |
|
Григорий, не знаю полезно ли? В одном из проектов делал замену errorsys на вывод лога не в html, а в json. Плюс встроенный вьювер ошибок по этому json. Достаточно компактно кажет всю информацию по ошибке. Потом идею бросил, но там так и работает. Если потребуется, могу в отдельный пример накидать. Так ради альтернативы, поскольку там по сути ничего нового, просто вывод в хтмл заменил на запись в json, и стандартные бровсы по массивам
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1880
Зарегистрирован: 11.02.10
|
|
Отправлено: 15.06.21 21:18. Заголовок: Haz пишет: могу в о..
Haz пишет: цитата: | могу в отдельный пример накидать |
| Да, конечно. Такой пример будет интересен в качестве альтернативы...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3764
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.06.21 12:21. Заголовок: gfilatov2002 Поправи..
gfilatov2002 Поправить надо CLASS TWndData ... METHOD GetProp( xKey ) INLINE iif( xKey == NIL, ::oProp, ::oProp:Get( xKey ) ) ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1881
Зарегистрирован: 11.02.10
|
|
Отправлено: 16.06.21 12:34. Заголовок: SergKis пишет: Попр..
SergKis пишет: Принято. Благодарю за помощь
| |
|
rvu
|
| |
Пост N: 333
Зарегистрирован: 05.11.05
|
|
Отправлено: 16.06.21 16:57. Заголовок: В уникодной версии U..
В уникодной версии Upper() только с английским языком работает msginfo(UPPER('abc абв áéíóú')) -> ABC абв áéíóú При этом DEFINE COMBOBOX ... UPPERCASE .T. END COMBOBOX переводит регистр правильно в любом языке из тех, что пробовал. Раньше, в неуникодной программе, я переводил данные в STR, потом делал Upper, но сейчас msginfo(HB_STRTOUTF8(UPPER(HB_UTF8TOSTR('abcабв',"RU1251")),"RU1251")) тоже не работает. Как бы с этим справиться? В принципе, могу, конечно, написать свою функцию, где условно 'абвгдежзийклмнопрстуфхцчшщъыьэюя' менять на 'АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ'. Но может есть уже штатные средства?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3766
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.06.21 19:59. Заголовок: rvu пишет В уникодно..
rvu пишет цитата: | В уникодной версии Upper() только с английским языком работает |
| Работает с русским, но с показом списка вопросик. Пример поправленный BASE\Combo_1 https://TransFiles.ru/jyfhn список Combo_1 контрола не отобржается, а выбор работает список Combo_2 контрола работает нормльно
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1882
Зарегистрирован: 11.02.10
|
|
Отправлено: 16.06.21 20:05. Заголовок: rvu пишет: Как бы с..
rvu пишет: цитата: | Как бы с этим справиться? |
| Добавил две новые функции: - HMG_UPPER(), - HMG_LOWER(). Результат работы см. на картинке.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3768
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.06.21 20:48. Заголовок: gfilatov2002 пишет Д..
gfilatov2002 пишет цитата: | Добавил две новые функции: |
| А разве старые upper() и lower() не должны работать с utf8 сразу ? Если переносить тексты в unicode версию, замучишься править
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1883
Зарегистрирован: 11.02.10
|
|
Отправлено: 16.06.21 21:07. Заголовок: SergKis пишет: разв..
SergKis пишет: цитата: | разве старые upper() и lower() не должны работать с utf8 |
| Увы, не работают. Это выглядит, как недоработка в Харборе...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1884
Зарегистрирован: 11.02.10
|
|
Отправлено: 16.06.21 21:08. Заголовок: SergKis пишет: Если..
SergKis пишет: цитата: | Если переносить тексты в unicode версию |
| Проблема решается с помощью препроцессора
| |
|
rvu
|
| |
Пост N: 334
Зарегистрирован: 05.11.05
|
|
Отправлено: 16.06.21 21:42. Заголовок: SergKis пишет: Если..
SergKis пишет: цитата: | Если переносить тексты в unicode версию, замучишься править |
| В редакторе сразу все. Автоматом. Почему нет?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3769
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.06.21 21:47. Заголовок: gfilatov2002 пишет П..
gfilatov2002 пишет цитата: | Проблема решается с помощью препроцессора |
| rvu пишет цитата: | В редакторе сразу все. Автоматом. Почему нет? |
| Это ф-ии hb, они должны работать в UNICODE сборке автоматом, по идее, без костылей иначе смысл такой сборки теряется, тут работает, а здесь нет. gfilatov2002 пишет цитата: | Увы, не работают. Это выглядит, как недоработка в Харборе... |
| Получается, что строки надо переводить из utf8 в нужную кодировку работать, как раньше, в однобайтной сборке и опять переводить в utf8 для контролов. Тогда смысл utf8 кодировки теряется, контролы в unicode, а работа в однобайтной схеме вполне хватило бы, переводить строки unicode->ansi->unicode, без utf8
| |
|
rvu
|
| |
Пост N: 336
Зарегистрирован: 05.11.05
|
|
Отправлено: 16.06.21 22:53. Заголовок: SergKis пишет: рабо..
SergKis пишет: цитата: | работа в однобайтной схеме вполне хватило бы, переводить строки unicode->ansi->unicode, без utf8 |
| Да вот не смогли мы мои хотелки реализовать в своё время. Я тогда очень пытался по вашим советам.
| |
|
rvu
|
| |
Пост N: 337
Зарегистрирован: 05.11.05
|
|
Отправлено: 17.06.21 08:31. Заголовок: Следующая проблема с..
Следующая проблема с уникодной версией: msginfo(AT('D','ABCDEF')) -> 4 msginfo(AT('Г','АБВГДЕ')) -> 7 С hb_At() аналогично.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1885
Зарегистрирован: 11.02.10
|
|
Отправлено: 17.06.21 09:31. Заголовок: rvu пишет: С hb_At(..
rvu пишет: Пробуйте функцию hb_UAt() Также в Харборе есть такие дополнительные функции hb_ULeft() hb_URight() hb_ULen() и т.д.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1886
Зарегистрирован: 11.02.10
|
|
Отправлено: 17.06.21 09:40. Заголовок: Всем кому это интересно
| |
|
rvu
|
| |
Пост N: 338
Зарегистрирован: 05.11.05
|
|
Отправлено: 17.06.21 09:51. Заголовок: gfilatov2002 , спаси..
gfilatov2002 , спасибо!
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3770
Зарегистрирован: 17.02.12
|
|
Отправлено: 17.06.21 12:18. Заголовок: gfilatov2002 пишет О..
gfilatov2002 пишет цитата: | Обновил также UNICODE архив... |
| Пример выше Combo_1 работает, показывает список развернутый, если поправить имя фонта (в родном hmg примере имя задано неверно) Скрытый текст
#define _HMG_OUTLOG #include "hmg.ch" REQUEST HB_CODEPAGE_UTF8, HB_CODEPAGE_RU1251 FUNCTION Main LOCAL a1, a2 SET CODEPAGE TO UNICODE a1 := { ' 1 | Līnijas ' , ' 2 | Rindās ' , ' 3 | Drukāt ' } //a1 := { ' 1 | Один ' , ' 2 | Два ' , ' 3 | Три ' } a2 := { ' 1 | Один - Uno' , ' 2 | Два - Dos' , ' 3 | Три - tres' } a1 := &( hmg_upper(hb_valtoexp(a1)) ) DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 400 ; HEIGHT 200 ; TITLE 'ComboBox Demo' ; MAIN @ 20,20 COMBOBOX Combo_1 ; WIDTH 150 ; ITEMS a1 ; VALUE 1 ; ON ENTER {|| MsgInfo ( hb_ntos(This.Combo_1.ITEMHEIGHT)+CRLF+ ; hb_ntos(This.Combo_1.Value)+CRLF+ ; This.Combo_1.DisplayValue ) } ; // UPPERCASE ; ITEMHEIGHT 21 ; FONT 'Courier New' SIZE 12 DEFINE COMBOBOX Combo_2 ROW 20 COL ( This.Combo_1.Col+This.Combo_1.Width + 10 ) WIDTH 150 ITEMS a2 VALUE 1 ON ENTER {|cn| cn :=This.Name, MsgInfo ( hb_ntos(This.&(cn).ITEMHEIGHT)+CRLF+ ; hb_ntos(This.&(cn).Value)+CRLF+ ; This.&(cn).DisplayValue ) } //LOWERCASE .T. ITEMHEIGHT 17 END COMBOBOX END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 Return Nil
|
| |
|
Haz
|
| |
Пост N: 1700
Зарегистрирован: 20.02.11
|
|
Отправлено: 17.06.21 17:15. Заголовок: gfilatov2002 пишет: ..
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1887
Зарегистрирован: 11.02.10
|
|
Отправлено: 17.06.21 17:46. Заголовок: Haz пишет: собрал н..
Haz пишет: OK Подход понравился...
| |
|
Haz
|
| |
Пост N: 1702
Зарегистрирован: 20.02.11
|
|
Отправлено: 17.06.21 21:41. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: Это то , что выдернул из проекта и включил в отдельный пример, чтоб показать о чем речь. Сама идея тут понятна, но пример нужно доделать, этим займусь в ближайшее дни. В проекте работает до сих пор успешно, ошибки просматривать удобно и быстро. Что касается вывода сообщения пользователю , этим не заморачивался, просто пишу извини не получилось и войди заново. 😝
| |
|
Haz
|
| |
Пост N: 1703
Зарегистрирован: 20.02.11
|
|
Отправлено: 17.06.21 21:41. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: Это то , что выдернул из проекта и включил в отдельный пример, чтоб показать о чем речь. Сама идея тут понятна, но пример нужно доделать, этим займусь в ближайшее дни. В проекте работает до сих пор успешно, ошибки просматривать удобно и быстро. Что касается вывода сообщения пользователю , этим не заморачивался, просто пишу извини не получилось и войди заново. 😝
| |
|
rvu
|
| |
Пост N: 340
Зарегистрирован: 05.11.05
|
|
Отправлено: 18.06.21 05:27. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Пробуйте функцию hb_UAt() Также в Харборе есть такие дополнительные функции hb_ULeft() hb_URight() hb_ULen() и т.д. |
| hb_URAT() нет.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3771
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.06.21 09:11. Заголовок: rvu Небольшой приме..
rvu Небольшой пример Скрытый текст
#define _HMG_OUTLOG #include "hmg.ch" REQUEST HB_CODEPAGE_UTF8, HB_CODEPAGE_RU1251, HB_CODEPAGE_RU866 REQUEST DBFCDX *-----------------------------------------------------------------------------* FUNCTION Main() *-----------------------------------------------------------------------------* LOCAL cT, cF, n1, n2, t1, t2, t3, t4 SET CODEPAGE TO UNICODE cF := hb_Utf8ToStr("замена", "RU866") cT := hb_memoread("demo.txt") // текст RU866 n1 := At(cF, cT) n2 := RAt(cF, cT) t1 := left(cT, n1) t2 := subs(cT, n2) ? n1, t1 ? n2, t2 ? t3 := hb_StrToUtf8(t1, "RU866") t4 := hb_StrToUtf8(t2, "RU866") ? t3 ? t4 ? RETURN demo.txt. кодировка RU866 -------------------------------- 0 ··· 101 999 1 замена из ремф. замена на аналог из ремфонда 101 1 2 план. устан. ТО плановые установки ТО 101 1 3 возврат с пл.ус возврат с плановых установок 101 1 4 ремонт на месте ремонт на месте 86 1 5 установка в кв. установка в кв. клиента 101 4 6 дополн. услуги дополнительные услуги 101 5 7 монтаж по дог. монтаж АДС по договору польз. 101 2 8 установка под. установка в подъезде 33 4 9 замена а/у замена абон.устройств 101 1 10 замена инд.обор замена индивид. оборудования 101 1 11 установка в под 33 2 12 монтаж на под 33 2 13 установка в под установка в подъезде 33 4 14 установка в по. установка в подъезде 33 4 13 ремонт на месте ремонт на месте 33 1 14 33 0 11 замена замена оборудования 80 4 12 замена общая замена оборудования всего 86 1 13 86 0
|
| |
|
rvu
|
| |
Пост N: 341
Зарегистрирован: 05.11.05
|
|
Отправлено: 18.06.21 09:40. Заголовок: SergKis пишет: cF :..
SergKis пишет: цитата: | cF := hb_Utf8ToStr("замена", "RU866") |
| У меня не только русский язык. У меня любой язык. И собрать свою Rat() легко можно из hb_UAt() и hb_ULen(). Тут важно определиться, что должно быть по определению в уникодной версии. Это пусть Григорий скажет.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3772
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.06.21 10:21. Заголовок: rvu пишет У меня не ..
rvu пишет цитата: | У меня не только русский язык. У меня любой язык |
| Если у вас все базы в utf8, старых вариантов нет и в одном поле присутствуют все языки мира, то ф-ии utf8 в помощь. В др. случаях можно применять и однобайтовые варианты, переводя в utf8 только для контролов
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1888
Зарегистрирован: 11.02.10
|
|
Отправлено: 18.06.21 10:30. Заголовок: rvu пишет: важно оп..
rvu пишет: цитата: | важно определиться, что должно быть по определению в уникодной версии. |
| Конечно, опираемся на Unicode-функционал, который есть в Харборе. Если необходимая реализация отсутствует, то приходится восполнять пробел. rvu пишет: Эта функция находится в TODO листе Харбора. rvu пишет: цитата: | собрать свою Rat() легко можно из hb_UAt() и hb_ULen(). |
| Значит, надо идти по этому пути, поскольку дальнейшее развитие Харбора в большом тумане...
| |
|
rvu
|
| |
Пост N: 342
Зарегистрирован: 05.11.05
|
|
Отправлено: 18.06.21 10:36. Заголовок: SergKis пишет: В д..
SergKis пишет: цитата: | В др. случаях можно применять и однобайтовые варианты, переводя в utf8 только для контролов |
| Я пробовал с русским, писал об этом: rvu пишет: цитата: | msginfo(HB_STRTOUTF8(UPPER(HB_UTF8TOSTR('abcабв',"RU1251")),"RU1251")) |
| Но и это не вышло. Не знаю почему. Там контролы используются, кроме вывода?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3773
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.06.21 10:44. Заголовок: rvu пишет Но и это н..
rvu пишет Upper() в unicode переводит ТОЛЬКО английские буквы, потому и не вышло. Другой функционал разделен по именам ф-й.
| |
|
rvu
|
| |
Пост N: 343
Зарегистрирован: 05.11.05
|
|
Отправлено: 18.06.21 10:46. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Значит, надо идти по этому пути, поскольку дальнейшее развитие Харбора в большом тумане... |
| А что с его развитием вообще? И что с Минигуи Роберто Лопеса? Как я понял там финальная версия 3.4.3? Я смотрел англоязычный форум, вроде, какая-то версия 3.4.4. существует, но я ее не смотрел. Она рабочая? Есть смысл ее ставить и смотреть?
| |
|
rvu
|
| |
Пост N: 344
Зарегистрирован: 05.11.05
|
|
Отправлено: 18.06.21 10:48. Заголовок: SergKis пишет: Uppe..
SergKis пишет: цитата: | Upper() в unicode переводит ТОЛЬКО английские буквы, потому и не вышло. |
| Для любых кодировок? Тогда понятно. Я же переводил в STR.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1889
Зарегистрирован: 11.02.10
|
|
Отправлено: 18.06.21 11:07. Заголовок: rvu пишет: что с ег..
rvu пишет: цитата: | что с его развитием вообще? |
| Этого не знает никто, поскольку форум разработчиков Харбора давно молчит. rvu пишет: цитата: | что с Минигуи Роберто Лопеса? |
| Его никто не поддерживает на постоянной основе. rvu пишет: цитата: | какая-то версия 3.4.4. существует |
| Уже есть версия 3.5 с минимальными улучшениями. rvu пишет: цитата: | Она рабочая? Есть смысл ее ставить и смотреть? |
| Да, она рабочая, но, конечно, содержит небольшие ошибки, которые периодически всплывают у пользователей. Смысл посмотреть всегда есть, а вдруг понравится Вывод: если не будет мотивации для разработки (материальной и моральной), то судьба любого дела будет под вопросом.
| |
|
rvu
|
| |
Пост N: 345
Зарегистрирован: 05.11.05
|
|
Отправлено: 18.06.21 11:22. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | собрать свою Rat() легко можно из hb_UAt() и hb_ULen(). Значит, надо идти по этому пути, поскольку дальнейшее развитие Харбора в большом тумане... |
| Function valRat Parameters Pr1,Pr2 If hb_UAt(Pr1,Pr2)=0 Return 0 Endif Return hb_ULen(Pr2)-hb_UAt(Pr1,Pr2)+1 Вы подобные вещи будете у себя включать? Это пустяк, но могут быть посложнее функции. И, наверное, их надо не под зарезервированными именами делать, не hb_URAT(). Так как это имя может потом использоваться в изначальном Харборе.
| |
|
rvu
|
| |
Пост N: 346
Зарегистрирован: 05.11.05
|
|
Отправлено: 18.06.21 11:27. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Уже есть версия 3.5 с минимальными улучшениями. |
| А ссылку дадите, чтобы самому не искать? gfilatov2002 пишет: цитата: | если не будет мотивации для разработки (материальной и моральной) |
| Моральная очень даже есть - пользуемся (ничего, что я за всех?)
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3774
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.06.21 11:28. Заголовок: rvu пишет hb_ULen(Pr..
rvu пишет цитата: | hb_ULen(Pr2)-hb_UAt(Pr1,Pr2)+1 |
| Это если Pr1 встречается 1 раз, если nn раз ? Как в примере выше
| |
|
rvu
|
| |
Пост N: 347
Зарегистрирован: 05.11.05
|
|
Отправлено: 18.06.21 11:35. Заголовок: SergKis пишет: Это ..
SergKis пишет: цитата: | Это если Pr1 встречается 1 раз, если nn раз ? |
| Ну вот. Я просто ни разу не использовал ее кроме первого вхождения. Но, кстати, посмотрел Help: SYNTAX RAT(<cSearch>, <cTarget>) --> nPosition ARGUMENTS <cSearch> is the character string to be located. <cTarget> is the character string to be searched. RETURNS RAT() returns the position of <cSearch> within <cTarget> as an integer numeric value. If <cSearch> is not found, RAT() returns zero. Вот где точно неправильно! — If <cSearch> is not found, RAT() returns zero. Добавил: Function valRat Parameters Pr1,Pr2 If hb_UAt(Pr1,Pr2)=0 Return 0 Endif Return hb_ULen(Pr2)-hb_UAt(Pr1,Pr2)+1
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3775
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.06.21 12:05. Заголовок: rvu Зачем городить ..
rvu Зачем городить огород Поищите в hb src\* по Alt+F7 в Far *.c "hb_func( hb_U" посмотрите список найденного, там будет hb_Utf8Rat(...) Используйте в примере выше ? n1, t1 ? n2, t2 ? "hb_Utf8Rat", hb_Utf8Rat("замена", hb_StrToUtf8(cT, "RU866")) ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1890
Зарегистрирован: 11.02.10
|
|
Отправлено: 18.06.21 12:07. Заголовок: rvu пишет: ссылку ..
| |
|
rvu
|
| |
Пост N: 348
Зарегистрирован: 05.11.05
|
|
Отправлено: 18.06.21 12:08. Заголовок: SergKis пишет: "..
SergKis пишет: цитата: | "hb_Utf8Rat", hb_Utf8Rat("замена", hb_StrToUtf8(cT, "RU866")) |
| Мне не только русский нужен.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3776
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.06.21 12:12. Заголовок: rvu пишет Мне не тол..
rvu пишет цитата: | Мне не только русский нужен. |
| Вы реально думаете, что ф-ии hb_U...() только для русского языка
| |
|
rvu
|
| |
Пост N: 349
Зарегистрирован: 05.11.05
|
|
Отправлено: 18.06.21 12:31. Заголовок: Смутило: hb_StrToUt..
Смутило: цитата: | hb_StrToUtf8(cT, "RU866") |
| А зачем тогда в примере перекодировку писать? SergKis пишет: Григорий написал: gfilatov2002 пишет: цитата: | Эта функция находится в TODO листе Харбора. |
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3777
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.06.21 12:40. Заголовок: rvu пишет А зачем то..
rvu пишет цитата: | А зачем тогда в примере перекодировку писать? |
| Пример был на показ использования однобайтных ф-ий в теле программы на Utf8 ( SET CODEPAGE TO UNICODE ) Взял, что было под рукой, русский (был еще латышский) текст, думал так будет понятнее.
| |
|
rvu
|
| |
Пост N: 350
Зарегистрирован: 05.11.05
|
|
Отправлено: 18.06.21 12:56. Заголовок: Поторопился я сказат..
Поторопился я сказать, что все работает. Не туда посмотрел. Так надо запрашивать? - msginfo(hb_Utf8Rat('ó','áéíóú')) -> 4
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3778
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.06.21 13:02. Заголовок: rvu Что не так ? ..
rvu Что не так ? áéíóú -> 4 áéíóú 12345 Ищет с конца, позиция от начала
| |
|
rvu
|
| |
Пост N: 351
Зарегистрирован: 05.11.05
|
|
Отправлено: 18.06.21 13:30. Заголовок: SergKis пишет: Что ..
SergKis пишет: Извините. Пришел в офис, а тут задергали. Ничего не соображаю. Это у меня всё не так. Свою хрень себе оставлю, чтобы с конца показывала. Зачем это нужно пока не знаю.
| |
|
rvu
|
| |
Пост N: 353
Зарегистрирован: 05.11.05
|
|
Отправлено: 18.06.21 14:35. Заголовок: hb_utf8Len() и hb_UL..
hb_utf8Len() и hb_ULen() ничем не отличаются? Остальные аналогичные тоже?
| |
|
Haz
|
| |
Пост N: 1704
Зарегистрирован: 20.02.11
|
|
Отправлено: 22.06.21 15:40. Заголовок: Haz пишет: собрал н..
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1891
Зарегистрирован: 11.02.10
|
|
Отправлено: 22.06.21 16:01. Заголовок: Haz пишет: подпилил..
Haz пишет: Спасибо
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1892
Зарегистрирован: 11.02.10
|
|
Отправлено: 24.06.21 11:55. Заголовок: Всем кому это интересно
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3779
Зарегистрирован: 17.02.12
|
|
Отправлено: 28.06.21 13:38. Заголовок: gfilatov2002 Неточн..
gfilatov2002 Неточность (tget) GETBOX при выполнении присваивания не срабатывает ON CHANGE ... METHOD VarPut( xValue, lReFormat ) CLASS Get ... IF lReFormat ::cType := ValType( xValue ) ::xVarGet := xValue ::lEdit := .F. ::Changed := .T. ::Picture := ::cPicture ENDIF ... с добавкой работают _SetGetBoxValue(), _SetValue() и SetProperty(..., ..., "Value", ...) Пример Скрытый текст
/* * MINIGUI - Harbour Win32 GUI library Demo * * Copyright 2021, Verchenko Andrey <verchenkoag@gmail.com> * Copyright 2021, Sergej Kiselev <bilance@bilance.lv> * * Пример построения карточки на базе объекта Tab * События на объектах карточки, контейнер на объектах * Передача и обработка данных на объектах * An example of building a card based on the Tab object * Events at card objects, container at objects * Transfer and processing of data at sites */ #define _HMG_OUTLOG #include "hmg.ch" Function Main Local nG := 20 SET MSGALERT BACKCOLOR TO { 238, 249, 142 } // for HMG_Alert() DEFINE FONT DlgFont FONTNAME "DejaVu Sans Mono" SIZE 14 // for HMG_Alert() SET OOP ON SET FONT TO "Arial", 14 DEFINE WINDOW Form_1 ; AT 0,0 WIDTH 990 HEIGHT 480 ; TITLE 'Harbour MiniGUI Demo: Tab + Button event' ; MAIN ; BACKCOLOR {0,155,173} ; ON SIZE SizeTest(nG) ; ON RELEASE _wSend(103) (This.Object):Cargo := oKeyData() // создать объект (контейнер) для окна Form_1 (This.Object):Cargo:nBtn := 0 (This.Object):Cargo:nModify := 0 @ 5, 990 - nG - 200 BUTTON Btn_Ex CAPTION "Exit" WIDTH 150 HEIGHT 35 ; BOLD ACTION ThisWindow.Release SetTab_1(,nG) // построение Tab / building Tab myThisObjectEvent() // события на объектах формы / events on form objects ON KEY ESCAPE ACTION {|| (ThisWindow.Cargo):nModify := 0 , ; ThisWindow.Release } END WINDOW Form_1.Center Form_1.Activate Return Nil //////////////////////////////////////////////////////////////////////////////// Function myThisObjectEvent (This.Object):Event( 100, {|ow,ky,cn| // обработка кнопок типа "I" Local oBtn := This.&(cn).Cargo Local nMod := ow:Cargo:nModify Local cForm := ow:Name Local aObjName := oBtn:aObjName // список наименований объектов на строке карточки ? "Event(100) PressButton=" , cn, oBtn:nObjId, oBtn:nBtn, nMod, HB_ValToExp(oBtn:aDim), HB_ValToExp(aObjName) myPressButtonI(ky, cForm, cn, oBtn:nObjId, oBtn:nBtn, nMod, oBtn:aDim, aObjName) SetProperty(ow:Name, cn, "Enabled", .T.) Return Nil }) (This.Object):Event( 102, {|ow,ky,am| // обработка menu кнопоки типа "I" Local cn := am[1] // имя кнопки Local nm := am[2] // номер пункта menu Local oBtn := This.&(cn).Cargo Local nMod := ow:Cargo:nModify Local cForm := ow:Name Local aObjName := oBtn:aObjName // список наименований объектов на строке карточки ? "Event(102) PressButton=" , cn, nm, oBtn:nObjId, oBtn:nBtn, nMod, HB_ValToExp(oBtn:aDim), HB_ValToExp(aObjName) MsgDebug("Context menu=",nm," :Event=",ky, cForm, cn, nm, oBtn:nObjId, oBtn:nBtn, nMod, oBtn:aDim, aObjName) Return Nil }) (This.Object):Event( 103, {|ow| // Завершение работы Local nMod := ow:Cargo:nModify Local cForm := ow:Name, cGet, lGet Local aGet := HMG_GetFormControls(cForm, "GETBOX") ? "Event(103) GETBOX modifycation=", nMod IF nMod > 0 FOR EACH cGet IN aGet lGet := This.&(cGet).Cargo:lModify ? hb_enumindex(cGet), cGet, lGet IF !Empty(lGet) ?? This.&(cGet).Value ENDIF NEXT ENDIF Return Nil }) Return Nil ////////////////////////////////////////////////// Procedure SizeTest(nG) Local nW, nH nW := This.ClientWidth nH := This.ClientHeight Form_1.Tab_1.Width := nW - nG*2 Form_1.Tab_1.Height := nH - nG*2 Return #define COLOR_BTNFACE 15 /////////////////////////////////////////////////////////////////////////////// Procedure SetTab_1( lBottomStyle, nG ) Local nColor := GetSysColor( COLOR_BTNFACE ) Local aColor := {GetRed( nColor ), GetGreen( nColor ), GetBlue( nColor )} Local nI, nW, nH, aTabBC, aTabName, aRet, aDimCard Default lBottomStyle := .f. IF IsControlDefined(Tab_1, Form_1) Form_1.Tab_1.Release ENDIF nW := This.ClientWidth nH := This.ClientHeight aTabBC := {159,191,236} aRet := myListTab() // list of cards for tabs aDimCard := aRet[1] aTabName := aRet[2] DEFINE TAB Tab_1 ; OF Form_1 ; AT nG,nG WIDTH nW-nG*2 HEIGHT nH-nG*2 ; VALUE 1 ; HOTTRACK ; BACKCOLOR aTabBC ; FONT "Tahona" SIZE 16 ; ON CHANGE {|| NIL /*MsgInfo( 'Page is changed!' )*/ } _HMG_ActiveTabBottom := lBottomStyle FOR nI := 1 TO LEN( aTabName ) PAGE aTabName[ nI ] TOOLTIP 'Tooltip ' + aTabName[ nI ] // Show a list of cards on a tab ShowPageCard( nI, aDimCard[ nI ] ) END PAGE NEXT END TAB Form_1.Tab_1.BACKCOLOR := aTabBC //aColor Form_1.Tab_1.HTFORECOLOR := BLACK Form_1.Tab_1.HTINACTIVECOLOR := Form_1.Backcolor Return //////////////////////////////////////////////////////////////////// Function ShowPageCard( nI, aDimLine ) Local nJ, cObj, nRow, nCol, nWName, cName, nHLine, nWidth Local nFSize, nGLine nRow := 20 + 40 // отступ сверху Tab_1 nCol := 20 nHLine := 33 // высота строки в карточке nGLine := 20 // расстояние между строками в карточке nFSize := 16 // Определение мах длины по наименованию nWName := 0 FOR nJ := 1 TO LEN( aDimLine ) cName := aDimLine[ nJ, 2 ] + ":" nWidth := GetTxtWidth( cName, nFSize, "Comic Sans MS" ) nWName := MAX( nWidth, nWName ) NEXT For nJ := 1 TO LEN( aDimLine ) cObj := "Label_Name" + HB_NtoS( nJ ) + "_Page" + HB_NtoS( nI ) cName := aDimLine[ nJ, 2 ] @ nRow, nCol LABEL &cObj VALUE cName + ":" ; WIDTH nWName HEIGHT nHLine FONT "Comic Sans MS" SIZE nFSize ; FONTCOLOR BLUE TRANSPARENT RIGHTALIGN VCENTER // показать значений полей базы myCardFieldGetBox( nI, nJ, cObj, aDimLine[nJ], nRow, nCol + nWName + 5, nHLine, nFSize ) nRow += nHLine + nGLine Next Return Nil /////////////////////////////////////////////////////////////////////////////// Function myCardFieldGetBox( nI, nJ, cObj, aDim, nRow, nCol, nHLine, nFSize ) Local cFName := _HMG_DefaultFontName //, nFSize := _HMG_DefaultFontSize Local cTypeLine, xPole, nK, xDopType, xDopRun, cRowCardAccess, xRet Local aField, cField, cAType, cObjGbx, aDimObjAI, nWCol, nWBtn, nHBtn Local cBtnFontI, nBtnFSizeI, cBtnCaptI, nWidth, cMsg, bBlock, xOldGet Local cObjGbxA, nObjId, cForm := ThisWindow.Name cTypeLine := aDim[1] // тип построения строки А-массив, CDN-обычный, M-мемополе и т.д. xPole := aDim[3] // поля базы данных или А-массив xDopType := aDim[4] // доп.обработка построения поля базы данных xDopRun := aDim[5] // вызов функции для кнопки или нет вызова cRowCardAccess := IIF( LEN(aDim) == 6, aDim[6], "?" ) // доступ юзера к строке карточки // можно сделать проверку на доступ nWBtn := nHBtn := nHLine // ширина и высота кнопки cBtnFontI := "Wingdings" nBtnFSizeI := nFSize + 6 cBtnCaptI := CHR(40) // 139 cObjGbx := cObj + "_Gbox" IF cTypeLine == "A" nWCol := 0 // смещение по строке карточки aField := xPole // список полей - {"RC_abon" ,"?","RC_abon0","?"} aDimObjAI := ARRAY( LEN(aField) ) // для типа A - список наименований объектов // выведенных в этой стоке - передать на кнопку FOR nK := 1 TO LEN(aField) cField := ALLTRIM(aField[nK]) cAType := xDopType[nK] cObjGbxA := cObj + "_A" + cAType + "_" + HB_NtoS(nK) aDimObjAI[nK] := cObjGbxA nObjId := nI*1000 + nJ*100 + nK IF cAType == "D" .OR. cAType == "C" .OR. cAType == "N" xRet := "ALIAS()->" + cField // FIELDGET(FIELDNUM(cField)) nWidth := GetTxtWidth( xRet, nFSize, cFName ) + 10 xOldGet := xRet // первоначальное значение GetBox @ nRow , nCol + nWCol GETBOX &cObjGbxA VALUE xRet ; WIDTH nWidth HEIGHT nHLine ; // ReadOnly ; ON CHANGE {|| (ThisWindow.Cargo):nModify += 1, ; _logfile(.t., This.Name, This.Cargo:lModify), ; This.Cargo:lModify := .T., ; _logfile(.t., This.Name, This.Cargo:lModify) } ; ON INIT {|| This.Cargo := oKeyData(), ; // создать объект (контейнер) для этого объекта This.Cargo:lModify := .F. } ELSEIF cAType == "I" (This.Cargo):nBtn := nK @ nRow, nCol + nWCol BUTTONEX &cObjGbxA WIDTH nWBtn HEIGHT nHBtn ; CAPTION cBtnCaptI FONT cBtnFontI SIZE nBtnFSizeI ; NOXPSTYLE HANDCURSOR FONTCOLOR BLACK BACKCOLOR ORANGE ; ACTION {|| This.Enabled := .F., _wPost(100, , This.Name) } ; ON INIT {|| This.Cargo := oKeyData() ,; // создать объект (контейнер) для этой кнопки This.Cargo:nObjId := nObjId ,; This.Cargo:nBtn := (ThisWindow.Cargo):nBtn,; This.Cargo:aDim := aDim ,; This.Cargo:aObjName := aDimObjAI } // ON INIT надо задавать только блоком кода DEFINE CONTEXT MENU CONTROL &cObjGbxA MENUITEM "Context menu (1) this Button =" ACTION _wPost(102, , {cObjGbxA, 1}) MENUITEM "Context menu (2) this Button =" ACTION _wPost(102, , {cObjGbxA, 2}) END MENU nWidth := nWBtn ELSE cMsg := "Error! No handling type ["+cAType+"] !;" + HB_ValToExp(aDim) cMsg += ";;" + ProcNL(0) cMsg := AtRepl( ";", cMsg, CRLF ) MsgStop( cMsg ) ENDIF nWCol += nWidth + 2 IF nK % 2 = 0 nWCol += 20 ENDIF NEXT ELSEIF cTypeLine == "C" .OR. cTypeLine == "D" xRet := "ALIAS()->" + xPole nWidth := GetTxtWidth( xRet, nFSize, cFName ) + 10 xOldGet := xRet // первоначальное значение GetBox @ nRow , nCol GETBOX &cObjGbx VALUE xRet ; WIDTH nWidth HEIGHT nHLine ; ON CHANGE {|| (ThisWindow.Cargo):nModify += 1, ; _logfile(.t., This.Name, This.Cargo:lModify), ; This.Cargo:lModify := .T., ; _logfile(.t., This.Name, This.Cargo:lModify) } ; ON INIT {|| This.Cargo := oKeyData(), ; // создать объект (контейнер) для этого объекта This.Cargo:lModify := .F. } ELSE cMsg := "Error! No handling type ["+cTypeLine+"] !;" + HB_ValToExp(aDim) cMsg += ";;" + ProcNL(0) cMsg := AtRepl( ";", cMsg, CRLF ) MsgStop( cMsg ) ENDIF Return Nil //////////////////////////////////////////////////////////////////////////////////// // запись в журнал изменений GETBOX Function myChangeGetBox(xOld,xNew,cObj) ? ProcNL(), xOld, xNew, cObj IF VALTYPE(xOld) == "C" xOld := ALLTRIM(xOld) xNew := ALLTRIM(xNew) ENDIF IF xOld == xNew // пропуск записи в журнал ELSE ? " Change Getbox:" + cObj + ", [" + xOld + "] # [" + xNew + "]" ENDIF Return Nil //////////////////////////////////////////////////////////////////////////////////// Function myPressButtonI(nEvent, cForm, cObj, nObjId, nBtn, nMod, aDim, aObjNameLine) Local cMsg, cRun, cTtl, cBlock, aFunc, aParam, cRet, aFld, cField, cObjRt cTtl := "nEvent = " + hb_NtoS(nEvent) + ";" cTtl += "cForm = " + cForm + ";" cTtl += "cObj = " + cObj + ";" cTtl += "Button code in line :nObjId = " + hb_NtoS(nObjId) + ";" cTtl += "Button number in line :nBtn = " + hb_NtoS(nBtn) + ";" cTtl += "(This.Object):Cargo:nModify = " + hb_NtoS(nMod) + ";" cTtl += "Card string array passed: aDim= " + hb_ValToExp(aDim) + ";" cTtl += "The name of the constructed objects of this card line:;" cTtl += hb_ValToExp(aObjNameLine) aFunc := aDim[5] aFld := aDim[3] cRun := aFunc[nBtn] cField := aFld[nBtn-1] cObjRt := aObjNameLine[nBtn-1] IF !hb_IsFunction( cRun ) cMsg := "Functions " + cRun + "() not in the EXE file!;" cMsg += "call -" + hb_ValToExp(aDim) + ";" cMsg := AtRepl( ";", cMsg, CRLF ) MsgStop( cMsg, "Stop!") ELSE cTtl := AtRepl( ";", cTtl, CRLF ) aParam := { cTtl, cField, cObjRt, nBtn, aDim } cBlock := cRun + "(" + hb_ValToExp(aParam) + ")" cRet := Eval( hb_macroBlock( cBlock ) ) IF LEN(cRet) > 0 SetProperty(cForm, cObjRt, "Value", cRet) ENDIF ENDIF Return Nil ////////////////////////////////////////////////////////////////////////// Function BtnTestRC(aPar) Local cTtl, cFld, aDim, aClr, nI, nRet, cRet, aBtn, cMsg, nBtn, cObj Default aPar := {} cTtl := aPar[1] cFld := aPar[2] cObj := aPar[3] nBtn := aPar[4] aDim := aPar[5] aClr := { YELLOW, RED, GREEN, ORANGE } aBtn := {} cRet := "" FOR nI := 1 TO 4 AADD(aBtn, "0"+hb_ntoS(nI)+"00000"+hb_ntoS(nI) ) NEXT cMsg := cTtl + ";;" cMsg += "Select the desired value for the entry!;" cMsg += "Выберите нужное значение для записи !;" cMsg += "Запись в поле: " + cFld + " и объект: " + cObj nRet := HMG_Alert( cMsg, aBtn, aDim[2], NIL, NIL, NIL, aClr, NIL ) IF nRet > 0 cRet := aBtn[nRet] ENDIF Return cRet ////////////////////////////////////////////////////////////////// Function myListTab() Local i, aTabName, aDim, aRetDim := {} // TabPage 1 aDim := {} AADD( aDim, { "A", "Personal account / Personal account-2", {"RC_abon" ,"?","RC_abon0","?"} , {"C","I","C","I"}, {NIL,"BtnTestRC",NIL,"BtnTestRC" } , "2Card:(RC+RC0)" } ) AADD( aDim, { "A", "Personal account-3/ Personal account-4", {"RC_abon3" ,"?","RC_abon4","?"} , {"C","I","C","I"}, {NIL,"BtnTestRC",NIL,"BtnTestRC" } , "2Card:(RC34)" } ) AADD( aDim, { "C", "Name of the subscriber" , "FIO" , nil , nil , "" } ) AADD( aRetDim, aDim ) // TabPage 2 aDim := {} AADD( aDim, { "D", "Date of Birth" , "DBirth" , nil , nil , "" } ) AADD( aRetDim, aDim ) // TabPage 3 aDim := {} For i := 1 To 5 AADD( aDim, { "C", "Example of row "+hb_NtoS(i)+" of tab 3", "CTEXT_"+hb_NtoS(i) , nil , nil , "" } ) Next AADD( aDim, { "A", "Example of an event on a button", {"TEST22" ,"?"} , {"C","I"}, {NIL,"MyTest22"} , "3Card:Test22" } ) AADD( aRetDim, aDim ) aTabName := { "TabPage-1", "TabPage-2","TabPage-3" } Return { aRetDim, aTabName } /////////////////////////////////////////////////////////////////////////////// FUNCTION GetTxtWidth( cText, nFontSize, cFontName, lBold ) // получить Width текста Local hFont, nWidth Default cText := REPL('A', 2) Default cFontName := _HMG_DefaultFontName // из MiniGUI.Init() Default nFontSize := _HMG_DefaultFontSize // из MiniGUI.Init() Default lBold := .F. IF Valtype(cText) == 'N' cText := repl('A', cText) ENDIF hFont := InitFont(cFontName, nFontSize, lBold) nWidth := GetTextWidth(0, cText, hFont) // ширина текста DeleteObject (hFont) RETURN nWidth ////////////////////////////////////////////////// FUNCTION ProcNL(nVal) Default nVal := 0 RETURN "Call from: " + ProcName(nVal+1) + "(" + hb_ntos(ProcLine(nVal+1)) + ") --> " + ProcFile(nVal+1)
|
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1893
Зарегистрирован: 11.02.10
|
|
Отправлено: 28.06.21 18:09. Заголовок: SergKis пишет: Нето..
SergKis пишет: цитата: | Неточность (tget) GETBOX при выполнении присваивания |
| Принято Хотя, возможно, что при переформатировании значения в TGET классе срабатывание события ON CHANGE и не планировалось... Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3780
Зарегистрирован: 17.02.12
|
|
Отправлено: 28.06.21 18:29. Заголовок: gfilatov2002 пишет Х..
gfilatov2002 пишет цитата: | Хотя, возможно, что при переформатировании значения в TGET классе срабатывание события ON CHANGE и не планировалось... |
| Согласен, тут есть подводный камень для исп. ф-ии в ON CHANGE ... и после _SetValue() ручное применение той же ф-ии, могут привести к неточностям счетчиков изменений или еще чего то. Но "правильней" после присвоения\изменения данных GETBOX по _SetValue() ON CHANGE ... должен отрабатывать. Конфликт со старой версией ON CHANGE ... возможен.
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6973
Зарегистрирован: 12.09.06
|
|
Отправлено: 30.06.21 18:16. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: Григорий, а в текущую версию эта добавка вошла ? А то я не могу пере собрать minigui.lib, ошибки лезут... Наверное из-за BCC 5.5
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1894
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.06.21 19:37. Заголовок: Andrey пишет: в тек..
Andrey пишет: цитата: | в текущую версию эта добавка вошла ? |
| Нет, она будет включена в следующую июльскую сборку. Кстати, подготовил первую бетку этой сборки со следующим списком изменений: Скрытый текст
* Fixed: Minor correction in the method VarPut() of the Harbour TGet class. It fixes the following problem: GetBox control do not execute the 'On Change' procedure after assigning a value at the calling of the function SetProperty ( Form, GetBox, 'Value', xValue ). Contributed by Sergej Kiselev. * Fixed: A missing PICTURE clause handling in the BROWSE control at the alternative syntax. Problem was reported by Pete D. Contributed by Grigory Filatov <gfilatov@inbox.ru> * New: A Star Rating is a type of rating question that allows users to rank attributes on a 5- or 10-point scale represented with stars. It is a 5-point matrix question, but instead of radio buttons or checkboxes, stars are used to represent it. Syntax: @ <row>,<col> RATING <name> [ OF <parent> ] ; [ WIDTH <w> ] ; [ HEIGHT <h> ] ; [ STARS <count> ] ; [ RATE <value> ] ; [ SPACING <space> ] ; [ ON CHANGE <change> ] ; [ TOOLTIP <tooltip> ] ; [ BORDER> ] There is the read/write 'Value' property for this control: Form.Rating.Value := 5 nRate := GetProperty( Form, Control, 'Value' ) - added auxiliary function ClearRating( Form, Control ). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demos in folder \samples\Basic\RATING) * Enhanced: INI file - added the following new commands: - GET BEGIN COMMENT TO <uVar>; - GET END COMMENT TO <uVar>; - SET BEGIN COMMENT TO <uVal>; - SET END COMMENT TO <uVal>; and the corresponding functions: - GetBeginComment() and SetBeginComment() to get/set a comment at the first line of an INI file; - GetEndComment() and SetEndComment() to get/set a comment at the last line of an INI file. Based upon a code borrowed from OOHG. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\ini) * Updated: 'GraphPlus library' by S.Rathinagiri <srathinagiri@gmail.com> (see source in folder \Source\GraphPlus) Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\GraphPlus) * Updated: 'Print Pie Graph' sample: updated the data for May 2021. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\GraphPrint) * Updated: 'Multiple Combined Search Box' sample: minor improvements. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\CombinedSearchBox)
| Но пока не решил, когда опубликовать новую сборку, потому что ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1895
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.06.21 19:43. Заголовок: P.S. Картинка из нов..
P.S. Картинка из новой сборки и полный текст этого примера ниже: Скрытый текст
/* * HMG - Harbour Win32 GUI library Demo * * Copyright 2014-2021 Grigory Filatov <gfilatov@inbox.ru> */ #include "minigui.ch" Function Main DEFINE WINDOW Win_1 ; AT 0,0 ; WIDTH 400 HEIGHT 380 ; TITLE 'Rating Test' ; ICON 'star.ico' ; MAIN ; FONT "Arial" SIZE 14 ; BACKCOLOR WHITE DEFINE MAINMENU DEFINE POPUP "File" MENUITEM "Exit" ONCLICK ThisWindow.Release END POPUP END MENU @ 20, 20 LABEL LABEL_0 VALUE '5 Star Rating Scale' WIDTH 360 FONT "Arial" SIZE 16 CENTERALIGN BOLD TRANSPARENT @ 70, 40 LABEL LABEL_1 VALUE 'Loved It' BOLD TRANSPARENT @ 70, 180 RATING Rate_1 ; WIDTH 21 ; HEIGHT 21 ; STARS 5 ; FROM RESOURCE ; SPACING 15 ; RATE 5 @ 120, 40 LABEL LABEL_2 VALUE 'Liked It' BOLD TRANSPARENT @ 120, 180 RATING Rate_2 ; WIDTH 21 ; HEIGHT 21 ; STARS 5 ; FROM RESOURCE ; SPACING 15 ; RATE 4 @ 170, 40 LABEL LABEL_3 VALUE 'It was ok' BOLD TRANSPARENT @ 170, 180 RATING Rate_3 ; WIDTH 21 ; HEIGHT 21 ; STARS 5 ; FROM RESOURCE ; SPACING 15 ; RATE 3 @ 220, 40 LABEL LABEL_4 VALUE 'Disliked It' BOLD TRANSPARENT @ 220, 180 RATING Rate_4 ; WIDTH 21 ; HEIGHT 21 ; STARS 5 ; FROM RESOURCE ; SPACING 15 ; RATE 2 @ 270, 40 LABEL LABEL_5 VALUE 'Hated It' BOLD TRANSPARENT @ 270, 180 RATING Rate_5 ; WIDTH 21 ; HEIGHT 21 ; STARS 5 ; FROM RESOURCE ; SPACING 15 ; RATE 1 END WINDOW Win_1.Center ACTIVATE WINDOW Win_1 Return Nil
|
| |
|
krutoff
|
| |
Пост N: 206
Зарегистрирован: 17.10.05
|
|
Отправлено: 17.07.21 12:51. Заголовок: INVISIBLE BLINK
Заметил одну ситуацию, если в LABEL определяется INVISIBLE BLINK, то все равно показ идет и Visible == .T. @ 15,150 LABEL Label_1 VALUE 'Blink Test:' AUTOSIZE INVISIBLE BLINK
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1897
Зарегистрирован: 11.02.10
|
|
Отправлено: 21.07.21 09:55. Заголовок: Всем кому это интересно
Выложил июльскую ANSI сборку 21.07 с учетом всех последних наработок по адресу http://hmgextended.com/files/CONTRIB/hmg-21.07-setup.exe Также подготовил эту сборку для таких бесплатных Си-компиляторов: - Embarcadero C++ 7.30 for Win32; - MinGW 32-bit (GCC with MCF thread model, built by LH_Mouse.) 11.1.1 20210708; - MinGW 64-bit (MinGW-W64 x86_64-posix-seh, built by Brecht Sanders) 11.1.1 20210710; - Microsoft Visual C++ 19.29.30037 (32/64-bit). Рассматриваю эту сборку как финальную Вот теперь ВСЕ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3793
Зарегистрирован: 17.02.12
|
|
Отправлено: 21.07.21 10:37. Заголовок: gfilatov2002 unicod..
gfilatov2002 unicode версию сделайте по старому или новому адресу, пробую когда есть время Спасибо
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1898
Зарегистрирован: 11.02.10
|
|
Отправлено: 21.07.21 10:48. Заголовок: SergKis пишет: unic..
SergKis пишет: Отправил ссылку в личку
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3794
Зарегистрирован: 17.02.12
|
|
Отправлено: 21.07.21 11:05. Заголовок: gfilatov2002 пишет О..
gfilatov2002 пишет Спасибо PS не успел предложить добавить к System. ... (но вдруг ... ) #xtranslate _GetAppCargo () => _HMG_MainCargo ///////////////////////////////////////////// // System pseudo-properties ///////////////////////////////////////////// #translate <p:System,Sys>.Cargo => _HMG_MainCargo #translate <p:System,Sys>.Cargo := <arg> => _HMG_MainCargo := <arg> #translate System.Clipboard => RetrieveTextFromClipboard() ... и в др. строках сделать <p:System,Sys>. коротко писать удобнее, например Sys.Cargo := oKeyData() ; o := Sys.Cargo o:cUsr := "sysdba" o:cPsw := "masterkey" o:cFdb := "" o:cIP := "" o:nLang := 2 o:cCur := cmCurDir()+"\" o:cLog := o:cCur+"ealarm.log" o:BIN := o:cCur+"BIN"+"\" // доп. прогрммы LogFileName( o:cLog ) o:WRK := "WRK" o:HBK := "HBK" o:BAK := "BAK" // сюда складывть bak копию для gbak.exe (сканируем) o:FDB := "FDB" // сюда складывть fdb и снимок фйлов с него o:INI := "HBK\INI" a := {o:WRK, o:WRK+"\E", o:HBK, o:INI, o:BAK, o:FDB} ; AEval( a, {|cd| DirMake(cd) } ) o:WRK := o:cCur+o:WRK+"\" ; o:HBK := o:cCur+o:HBK+"\" ; o:INI:= o:cCur+o:INI+"\" o:FDB := o:cCur+o:FDB+"\" ; o:BAK := o:cCur+o:BAK+"\" ... или LOCAL o := Sys.Cargo o:oBaseText := oKeyData() o:oBaseText:aNew := {"Add new", "Jauns" , "Добавить" } o:oBaseText:aDel := {"Delete" , "Dzēst" , "Удалить" } o:oBaseText:aRefr := {"Refresh", "Atjaunot" , "Обновить" } o:oBaseText:aEdit := {"Edit" , "Rediģēt" , "Менять" } o:oBaseText:aSort := {"Sorting", "Šķirošana", "Сортировка"} o:oBaseText:aExit := {"Exit" , "Izeja" , "Выход" } ... LOCAL cForm := 'wListSel', t, o := Sys.Cargo, ot := o:oBaseText ... BUTTON BtnList CAPTION ot:cList PICTURE 'page_plus' ; TOOLTIP NIL SEPARATOR ; ACTION _wPost(1, , This.Name) BUTTON BtnSort CAPTION ot:cSort PICTURE 'page_123' ; TOOLTIP NIL SEPARATOR ; ACTION ( DoEvents(), _wPost(4, oMain:Cargo:cFocused, 0) ) DROPDOWN ... oCol := :GetColumn("EVENT") ; oCol:cHeading := ot:cEvnt oCol := :GetColumn("OBJECTNUM"); oCol:cHeading := ot:cObj oCol := :GetColumn("NAME") ; oCol:nWidth := oCol:ToWidth(50) oCol:cHeading := ot:cName oCol := :GetColumn("ADDRESS") ; oCol:nWidth := oCol:ToWidth(50) oCol:cHeading := ot:cAddr ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1899
Зарегистрирован: 11.02.10
|
|
Отправлено: 21.07.21 12:32. Заголовок: SergKis пишет: #tr..
SergKis пишет: цитата: | #translate <p:System,Sys>.Cargo => _HMG_MainCargo #translate <p:System,Sys>.Cargo := <arg> => _HMG_MainCargo := <arg> |
| Добавил в форме цитата: | #translate <p:Application,App>.Cargo => _HMG_MainCargo #translate <p:Application,App>.Cargo := <arg> => _HMG_MainCargo := <arg> |
| SergKis пишет: цитата: | в др. строках сделать <p:System,Sys> |
| Сделал Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3807
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.07.21 23:42. Заголовок: gfilatov2002 Сделал..
gfilatov2002 Сделал у себя CLASS TSColumn ... DATA bDrawCell // before :bTSDrawCell() ... METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse ... oColumn:oCell:lInvertColor := .F. // 32 Invert color IF ISBLOCK( oColumn:bDrawCell ) ; Eval( oColumn:bDrawCell, Self, oColumn:oCell, oColumn ) ENDIF IF lDrawCell ; ::TSDrawCell( oColumn:oCell, oColumn ) ENDIF ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... oColumn:oCell:lInvertColor := !(::lCellBrw .and. nJ != ::nCell) // 32 Invert color IF HB_ISBLOCK( oColumn:bDrawCell ) ; Eval( oColumn:bDrawCell, Self, oColumn:oCell, oColumn ) ENDIF If lDrawCell .and. ::lDrawLine ; ::TSDrawCell( oColumn:oCell, oColumn ) EndIf ... Потребовалось раскрасить код объекта в выборке многострочной по объектам (аналог покраски четных\нечетных строк, т.е. через строчку), а тут через объект. С использованием :bDrawCell() получилось просто. ... LOCAL oColor := oKeyData() LOCAL nMaxObj ... выбираем уникально объекты и ставим 0\1 (чет\нечет) INDEX ON OBJECTNUM TAG OBJ UNIQUE OrdSetFocus("OBJ") GO TOP nMaxObj := OrdKeyCount() ; i := 0 DO WHILE !EOF() ; oColor:Set( OBJECTNUM, int(i % 2) ) ; i++ ; SKIP ENDDO GO TOP ... на колонку кодов объектов в тсб ставим oCol := :GetColumn("OBJECTNUM"); oCol:cHeading := ot:cObj oCol:nFAlign := DT_CENTER oCol:cFooting := hb_ntos(nMaxObj) oCol:Cargo := oKeyData() oCol:Cargo:nMaxObj := nMaxObj oCol:Cargo:oColor := oColor oCol:Cargo:lColor := nMaxObj > 1 oCol:Cargo:aColor := { GetSysColor( COLOR_BTNFACE ) } // { CLR_HGRAY } oCol:bDrawCell := {|obrw,ocel,ocol| Local o := ocol:Cargo, nClr, nTo, cKod, nElm IF o:lColor nClr := ocel:nClrBack nTo := ocel:nClrTo cKod := ocel:uValue nElm := o:oColor:Get(cKod, 0) ocel:nClrBack := iif( nElm > 0, o:aColor[ nElm ], nClr ) ocel:nClrTo := iif( nElm > 0, o:aColor[ nElm ], nTo ) ENDIF Return Nil } ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1900
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.07.21 09:49. Заголовок: SergKis пишет: Сдел..
SergKis пишет: ОК. Благодарю за предложение
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1901
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.07.21 09:54. Заголовок: Всем кому это интересно
Подготовил 1-й апдейт сборки 21.07 Подробности см. на английском форуме Минигуи. Обновил также Unicode архив. Искренне благодарю Андрея за многолетнюю поддержку Желаю всем мира и добра
| |
|
Andrey
|
| постоянный участник
|
Пост N: 7013
Зарегистрирован: 12.09.06
|
|
Отправлено: 01.08.21 22:40. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Подробности см. на английском форуме Минигуи. |
| А нам тоже интересно, на русском, а не на буржуйском. Когда ТАБ внизу, большие фонты отображаются коряво ! Я не использую такие ТАБы но может другие используют. И картинки коряво сдвинуты... Пример отправил на почту.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1902
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.08.21 10:26. Заголовок: Andrey пишет: Когда..
| |
|
rvu
|
| |
Пост N: 356
Зарегистрирован: 05.11.05
|
|
Отправлено: 04.08.21 08:52. Заголовок: Компилирую с помощью..
Компилирую с помощью ..\batch\compile.bat Сегодня заметил, стала говорить про множественные ресурсы: Duplicate resource: Type 16 (VERSIONINFO), ID 1; File мой файл ресурсов - .RES resource kept; file C:\MINIGUI\RESOURCES\MINIGUI.RES resource discarded. Не знаю как давно это появилось. Вытащил версию 21.05 — нет там такого. Как бы их примирить?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1903
Зарегистрирован: 11.02.10
|
|
Отправлено: 04.08.21 12:48. Заголовок: rvu пишет: Вытащил ..
rvu пишет: цитата: | Вытащил версию 21.05 — нет там такого. Как бы их примирить? |
| Благодарю за сообщение Уже поправил эту недоработку, которая была вызвана ошибками в работе компилятора ресурсов Borland C++. P.S. Поправил также в Unicode-архиве...
| |
|
rvu
|
| |
Пост N: 357
Зарегистрирован: 05.11.05
|
|
Отправлено: 04.08.21 16:25. Заголовок: Скачал заново. В uni..
Скачал заново. В unicode-версии пропало. А в неуникодной ничего не изменилось. Да и установочный файл такого же размера, что и раньше у меня был.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1904
Зарегистрирован: 11.02.10
|
|
Отправлено: 04.08.21 16:29. Заголовок: rvu пишет: в неуник..
rvu пишет: цитата: | в неуникодной ничего не изменилось |
| Все правильно. Это исправление будет включено во второй апдейт сборки 21.07
| |
|
rvu
|
| |
Пост N: 358
Зарегистрирован: 05.11.05
|
|
Отправлено: 04.08.21 16:39. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Это исправление будет включено во второй апдейт сборки 21.07 |
| Понял. Когда ожидается?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1905
Зарегистрирован: 11.02.10
|
|
Отправлено: 04.08.21 17:01. Заголовок: rvu пишет: Когда ож..
rvu пишет: Запланировал - на следующей неделе, если получится...
| |
|
rvu
|
| |
Пост N: 359
Зарегистрирован: 05.11.05
|
|
Отправлено: 04.08.21 17:13. Заголовок: Понятно...
Понятно.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1906
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.08.21 10:34. Заголовок: Всем кому это интересно ;-)
Завершена подготовка второго апдейта сборки 21.07, который будет опубликован послезавтра. Что нового: Скрытый текст
цитата: | * New: Added the useful function HMG_FileCopy() to copy a file to a new file. Syntax: HMG_FileCopy( <cSourceFile>, <cTargetFile>, [<nBuffer>], [<bEval>] ) --> lSuccess where <cSourceFile> is the name of the source file including the path and the extension; <cTargetFile> is the name of the target file including the path and the extension; <nBuffer> is the buffer size in bytes. The default is 8192 bytes; <bEval> is the code block which is executed with the percentage of the file copied. This function returns false if an errors occurs, otherwise, it returns true. Based upon a contribution of Jacek Kubica <kubica/at/wssk.wroc.pl> (see demo in folder \samples\Basic\Filecopy) * Updated: Pacified a C-warning in the MiniGUI core for compatibility with the new Pelles C 11.0 (64-bit). Contributed by Grigory Filatov <gfilatov@inbox.ru> * New: The SELECTOR library source code (see in folder \Source\SELECTOR). Based upon a code of Janusz Piwowarski for Clipper. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\Charts_3) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added the new variable :bDrawCell in the TSColumn class. This codeblock will executed in the methods DrawLine() and DrawSelect() before calling the method TSDrawCell(). Suggested and contributed by Sergej Kiselev. * New: 'Registry class for Xbase++ usage' sample. Based upon a contribution of HMG user Jimmy. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\RegClass) * New: 'Tab Control with OOP' sample. Contributed by Sergej Kiselev and Verchenko Andrey (see demo3.prg in folder \samples\Basic\TAB) |
|
|
Ваши комментарии приветствуются...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3808
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.08.21 11:28. Заголовок: gfilatov2002 пишет В..
gfilatov2002 пишет цитата: | Ваши комментарии приветствуются... |
| Пробовал под unicode пример Advanced\7-Zip, ... фокус не удался Может включить lib из примера в основную сборку ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1907
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.08.21 12:35. Заголовок: SergKis пишет: Може..
SergKis пишет: цитата: | Может включить lib из примера в основную сборку ? |
| Благодарю за предложение, но эта библиотека является устаревшей (с 2010 года). Ее функционал перенесен в ядро Харбора и в contrib библиотеку XHB.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3809
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.08.21 16:51. Заголовок: gfilatov2002 пишет э..
gfilatov2002 пишет цитата: | эта библиотека является устаревшей (с 2010 года). Ее функционал перенесен в ядро Харбора и в contrib библиотеку XHB. |
| Как я понял, в hb zip функционал (может ошибаюсь), а с запусками планировщиком (у нас, как правило) синхронизацию по backup откатам (баз) каталогов разных PC, используют 7z (7za.exe). 7z = ~1Г -> ~65Мб, а zip дает ~ в 2а раза больше файл после сжатия. Пример оказался очень в тему и жизненный, чуть поправил галочки настройки, добавил Size в grid и получилась автомат. распаковка 7z архива при заданных параметрах File7z, CtlgOut на входе запуска. Пока 7-zip32.dll была хорошим решением
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3811
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.08.21 21:28. Заголовок: gfilatov2002 пишет Е..
gfilatov2002 пишет цитата: | Ее функционал перенесен в ядро Харбора и в contrib библиотеку XHB. |
| Собрал hbdll32.lib на unicode версии, выбросил из своего модуля ранее // Generate the full name of the installed 7-Zip through a registry entry OPEN REGISTRY oReg KEY HKEY_CURRENT_USER Section 'Software\7-Zip' GET VALUE cPath7z NAME 'Path' OF oReg CLOSE REGISTRY oReg Заработало. Кому интересно, тут Скрытый текст
/* * MINIGUI - Harbour Win32 GUI library Demo * * Access to 7z archives by 7-zip32.dll * (c) 2008 Vladimir Chumachenko <ChVolodymyr@yandex.ru> * * Last Revised by Grigory Filatov 03/10/2017 */ #define _HMG_OUTLOG #include "CStruct.ch" // from Harbour\Contrib\xHB #include "HBCTypes.ch" // from Harbour\Contrib\xHB #include "WinTypes.ch" // from Harbour\Contrib\xHB #include "hmg.ch" #define ALONE_7Z '7za.exe' // console variant of 7-Zip archiver STATIC cPath7z := '' // Full path to installed 7-Zip archiver STATIC lPath7z := .F. MEMVAR oMain // C-structure, used in SevenZipFindFirst(), SevenZipFindNext() pragma pack( 4 ) #define FNAME_MAX32 512 typedef struct { ; DWORD dwOriginalSize; DWORD dwCompressedSize; DWORD dwCRC; UINT uFlag; UINT uOSType; WORD wRatio; WORD wDate; WORD wTime; char szFileName[ FNAME_MAX32 + 1 ]; char dummy1[ 3 ]; char szAttribute[ 8 ]; char szMode[ 8 ]; } INDIVIDUALINFO, * PINDIVIDUALINFO; FUNCTION Main( cMode, cPar1, cPar2 ) LOCAL cBuf, aBuf, cTm1, cTm2, nTime, aTmp, cTmp, nTmp, oTmp, cDir LOCAL cP1, cP2, cP3, cP4, cP5, cP6, cP7, cP8, cP9, nI, nK Default cMode := "", cPar1 := "", cPar2 := "" App.Cargo := oKeyData() ; o := App.Cargo ; SetsEnv() cMode := lower(cMode) wMain_7Zip( cMode, cPar1, cPar2 ) RETURN *----------------------------------------------------------------------------* FUNCTION wMain_7Zip( cMode, cPar1, cPar2 ) *----------------------------------------------------------------------------* LOCAL cExe := hb_progName() LOCAL cPth := left(cExe, RAt("\", cExe)) LOCAL oa, nG, nM, nY, nX, nW, nH, nL, nL1, nL2, g, y, x, w, h LOCAL cFont := 'Tahoma' LOCAL nSize := 9 LOCAL cTitl := 'Archiver 7-Zip interaction' LOCAL cIcon := 'main.ico' LOCAL lExtract := "e" $ cMode LOCAL nPost := 0 cPath7z := cPth + '7za.exe' lPath7z := hb_FileExists(cPath7z) SET FONT TO cFont, nSize DEFINE FONT DefFont FONTNAME cFont SIZE nSize oa := App.Object nX := 0 ; nW := oa:W4 * 2 // Sys.DesktopWidth * 0.5 nY := 0 ; nH := oa:H1 * 22 nG := oa:GapsWidth nM := oa:Left IF lExtract .and. !Empty(cPar1) .and. !Empty(cPar2) nPost := 5 ENDIF DEFINE WINDOW wMain At nY, nX CLIENTAREA nW, nH Title cTitl Icon cIcon ; Main NoMaximize NoSize ; ON INIT _wPost(nPost) PUBLIC oMain := This.Object ; This.Cargo := oKeyData() This.Cargo:cFile7z := cPar1 This.Cargo:cDirOut := cPar2 This.Cargo:lExtract := lExtract This.Cargo:nCount := 0 DEFINE STATUSBAR StatusItem '' StatusItem '' Width nW * 0.22 //120 StatusItem '' Width 40 StatusItem '' Width nW * 0.23 //130 END STATUSBAR y := nG ; x := nG ; w := This.ClientWidth - x*2 g := nM * 2 - nG * 3 - oa:H4 h := oa:H1 * 18 - nG DEFINE TAB tbMain at y, x Width w Height h DEFINE PAGE 'Archive' nL := w - nG * 2 - 30 nL1 := nL * 0.7 nL2 := nL - nL1 @ 30, 5 Grid grdContent Width w - nG * 2 Height h-oa:H2-nG ; Headers { 'Name', 'Size' } ; Widths { nL1 , nL2 } ; Multiselect y := This.ClientHeight - This.StatusBar.Height - nM * 2 - nG - oa:H1 @ y, 15 ButtonEx btnCreate Caption 'Create' ; Width oa:W2 ; Height oa:H2 ; Action _wPost(1) ; // RunTest( 1 ) ; Tooltip 'Create archive' @ y, 220 ButtonEx btnView Caption 'View' ; Width oa:W2 ; Height oa:H2 ; Action _wPost(2) ; // RunTest( 2 ) ; Tooltip 'View 7z/zip archive' @ y, 415 ButtonEx btnExtract Caption 'Extract' ; Width oa:W2 ; Height oa:H2 ; Action _wPost(3) ; // RunTest( 3 ) ; Tooltip 'Extract file(s) from archive' END PAGE DEFINE PAGE 'Options' @ 30, 5 Frame frmSelectTest ; Caption 'Select test' ; Width w - nG * 2 ; Height 65 ; Bold ; FontColor BLUE @ 55, 15 RadioGroup rdgSelectTest ; Options { '7-zip32.dll', '7-Zip', '7za.exe' } ; Width 100 ; Spacing 20 ; Value 1 ; ON Change wMain.btnExtract.Enabled := .F. ; Horizontal @ 110, 5 Frame frmCommon ; Caption 'Common' ; Width w - nG * 2 ; Height 65 ; Bold ; FontColor BLUE @ 135, 15 CheckBox cbxHide ; Caption 'Hide progressbar' ; Width 124 ; Value .F. @ 185, 5 Frame frmExtract ; Caption 'Extract' ; Width w - nG * 2 ; Height 65 ; Bold ; FontColor BLUE @ 210, 15 CheckBox cbxExtract ; Caption 'Extract files with full paths' ; Width 176 ; Value .F. @ 210, 200 CheckBox cbxYesAll ; Caption 'Assume (Yes) on all queries' ; Width 190 ; Value .T. @ 260, 5 Frame frmLinks ; Caption 'Links' ; Width w - nG * 2 ; Height 100 ; Bold ; FontColor BLUE @ 285, 15 LABEL lbl7z ; Value '7-Zip' ; Width 120 ; Height 15 @ 285, 140 Hyperlink hl7z ; Value 'http://www.7-zip.org' ; Address 'http://www.7-zip.org' ; HandCursor @ 305, 15 LABEL lblDLL_JA ; Value '7-Zip32.dll (Japanese)' ; Width 120 ; Height 15 @ 305, 140 Hyperlink hlDLL_JA ; Value 'http://www.csdinc.co.jp/archiver/lib/' ; Address 'http://www.csdinc.co.jp/archiver/lib/' ; Width 270 HandCursor @ 325, 15 LABEL lblDLL_EN ; Value '7-Zip32.dll (English)' ; Width 120 ; Height 15 @ 325, 140 Hyperlink hlDLL_EN ; Value 'http://www.csdinc.co.jp/archiver/lib/main-e.html' ; Address 'http://www.csdinc.co.jp/archiver/lib/main-e.html' ; Width 270 HandCursor END PAGE END TAB IF ! lPath7z wMain.rdgSelectTest.Enabled( 3 ) := .F. ENDIF wMain.btnExtract.Enabled := .F. IF nPost > 3 wMain.btnCreate.Hide ENDIF WITH OBJECT This.Object :Event( 1, {|ow,ky| RunTest(ky, ow) } ) :Event( 2, {|ow,ky| RunTest(ky, ow) } ) :Event( 3, {|ow,ky| RunTest(ky, ow) } ) :Event( 5, {|ow,ky,nCnt| ky := -1 //ow:Hide() ; DO EVENTS nCnt := RunTest(2, ow) IF nCnt > 0 ; ky := RunTest(3, ow) ENDIF //ow:Show() ; DO EVENTS ow:Release() Return Nil } ) :Event(99, {|ow| ow:Release() }) END WITH END WINDOW CENTER WINDOW wMain ACTIVATE WINDOW wMain RETURN Nil *----------------------------------------------------------------------------* STATIC PROCEDURE ShowStatus( cFile, cCount, cType, cVersion ) *----------------------------------------------------------------------------* wMain.StatusBar.Item (1) := cFile // Processed file wMain.StatusBar.Item (2) := cCount // Files in the archive wMain.StatusBar.Item (3) := cType // Archive type wMain.StatusBar.Item (4) := cVersion // Procedure Information RETURN Nil *----------------------------------------------------------------------------* STATIC FUNCTION Version7zip *----------------------------------------------------------------------------* LOCAL nVersion := SevenZipGetVersion(), ; // 7-zip nSubversion := SevenZipGetSubVersion(), ; // 7-zip32.dll cVersion := 'Version ' cVersion += ( Str( ( nVersion / 100 ), 5, 2 ) + '.' + StrZero( ( nSubversion / 100 ), 5, 2 ) ) RETURN cVersion *----------------------------------------------------------------------------* STATIC PROCEDURE RunTest( nChoice, oWnd ) *----------------------------------------------------------------------------* LOCAL nSelected := wMain.rdgSelectTest.Value LOCAL o := oWnd:Cargo LOCAL nRet := 0 DO CASE CASE ( nChoice == 1 ) // Create Archive IF ( nSelected == 1 ) ; CreateArc() // Process 7-zip32.dll ELSE ; CreateArcExternal() // Run 7z.exe or 7za.exe ENDIF CASE ( nChoice == 2 ) // View Content IF ( nSelected == 1 ) ; nRet := ViewArc( o:cFile7z, .F. ) ELSE ; ViewArcExternal() ENDIF CASE ( nChoice == 3 ) // Extract Files IF ( nSelected == 1 ) ; nRet := ExtractArc( o:cDirOut, .F. ) ELSE ; ExtractArcExternal() ENDIF ENDCASE RETURN nRet *----------------------------------------------------------------------------* STATIC PROCEDURE CreateArc *----------------------------------------------------------------------------* LOCAL aSource := GetFile( { { 'All files', '*.*' } }, ; 'Select file(s)', ; GetCurrentFolder(), .T., .T. ; ), ; cArcFile, ; cType := '', ; cCommand := 'A ', ; nDLLHandle IF !Empty( aSource ) cArcFile := PutFile ( { { '7-zip', '*.7z' }, { 'Zip', '*.zip' } }, ; 'Create archive', ; GetCurrentFolder(), ; .T. ; ) IF !Empty( cArcFile ) // Define the type of archive. The default is 7z, so // remember only in case of change in the dialog box. IF ( Upper( Right( cArcFile, 3 ) ) == 'ZIP' ) cType := 'zip' ENDIF // Build a command line to pass to the DLL IF wMain.cbxHide.Value cCommand += '-hide ' // Do not display the process ENDIF IF !Empty( cType ) cCommand += '-tzip ' // In ZIP format ENDIF cCommand += ( cArcFile + ' ' ) // Specify files to process AEval( aSource, {| elem | cCommand += ( '"' + elem + '" ' ) } ) cCommand := RTrim( cCommand ) IF !( ( nDLLHandle := LoadLibrary( '7-zip32.dll' ) ) > 0 ) MsgStop( "Can't load 7-zip32.dll.", 'Error' ) ELSE DllCall( nDLLHandle, DC_CALL_STD, 'SevenZip', _HMG_MainHandle, cCommand ) FreeLibrary( nDLLHandle ) // Fill In The Status Bar ShowStatus( cArcFile, '', iif( Empty( cType ), '7z', 'zip' ), Version7zip() ) ENDIF ENDIF ENDIF RETURN *----------------------------------------------------------------------------* STATIC FUNCTION ViewArc( xFile, lMsg ) *----------------------------------------------------------------------------* LOCAL cFile LOCAL nDLLHandle, nArcHandle, nResult, cValue, nCount := 0 LOCAL cType := '', oInfo, pInfo, aFiles := {}, nSize LOCAL nRet := -1 Default lMsg := .T. IF Empty( xFile ) cFile := GetFile( {{'7-zip', '*.7z'}, {'Zip', '*.zip'}}, ; 'Select archive', GetCurrentFolder(), .F., .T. ) ELSE cFile := xFile ENDIF IF !( ( nDLLHandle := LoadLibrary( '7-zip32.dll' ) ) > 0 ) IF lMsg ; MsgStop( "Can't load 7-zip32.dll.", 'Error' ) ENDIF RETURN nRet ENDIF nArcHandle := DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipOpenArchive', _HMG_MainHandle, cFile, 0 ) // Открыть архив IF Empty( nArcHandle ) IF lMsg ; MsgStop( cFile + ' not opened.', 'Error' ) ENDIF nRet := 0 RETURN nRet ENDIF nCount := DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipGetFileCount' , cFile ) // Количество элементов в архиве nResult := DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipGetArchiveType', cFile ) // Тип архива DO CASE CASE ( nResult == 1 ) ; cType := 'ZIP' CASE ( nResult == 2 ) ; cType := '7Z' CASE ( nResult == -1 ) ; cType := 'Error' CASE ( nResult == 0 ) ; cType := '???' ENDCASE oInfo := ( STRUCT INDIVIDUALINFO ) pInfo := oInfo:GetPointer() // Looking for the 1st file. If the search result does not matter, pass pInfo // can be omitted. DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipFindFirst', nArcHandle, '*', pInfo ) // Reset The Pointer oInfo := oInfo:Pointer( pInfo ) cValue := Space( FNAME_MAX32 ) DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipGetFileName', nArcHandle, @cValue, FNAME_MAX32 ) nSize := DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipGetOriginalSize', nArcHandle ) cValue := Trim(StrTran(cValue, chr(0), "")) IF !Empty( cValue ) // Fill out the form table. First, we enter the values into an array, // sort and pass the Grid AAdd( aFiles, { cValue, nSize } ) DO WHILE ( ( nResult := DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipFindNext', nArcHandle, pInfo ) ) == 0 ) cValue := Space( FNAME_MAX32 ) DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipGetFileName', nArcHandle, @cValue, FNAME_MAX32 ) nSize := DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipGetOriginalSize', nArcHandle ) cValue := Trim(StrTran(cValue, chr(0), "")) AAdd( aFiles, { cValue, nSize } ) ENDDO wMain.grdContent.DeleteAllItems IF Len(aFiles) > 1 ASort( aFiles,,, {| x, y | x[ 1 ] < y[ 1 ] } ) ENDIF wMain.grdContent.DisableUpdate AEval( aFiles, {| elem | wMain.grdContent.AddItem( elem ) } ) wMain.grdContent.EnableUpdate wMain.grdContent.Value := { 1 } DO EVENTS wApi_Sleep(1000) ENDIF // Close the archive file, unload the library DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipCloseArchive', nArcHandle ) FreeLibrary( nDLLHandle ) nRet := nCount // Fill In The Status Bar ShowStatus( cFile, ( 'Count files: ' + LTrim( Str( nCount ) ) ), cType, Version7zip() ) IF ( wMain.grdContent.ItemCount > 0 ) wMain.btnExtract.Enabled := .T. ENDIF RETURN nRet *----------------------------------------------------------------------------* STATIC PROCEDURE ExtractArc( xDir, lMsg ) *----------------------------------------------------------------------------* LOCAL aPos := wMain.grdContent.Value LOCAL cDir, cCommand, nPos, cFile, nDLLHandle LOCAL nRet := -1, nSize, aFiles := {}, cOut, nFile Default lMsg := .T. IF Empty( aPos ) IF lMsg ; MsgStop( 'Select item(s), please!', 'Error' ) ENDIF RETURN nRet ENDIF IF Empty( xDir ) ; cDir := GetFolder( 'Extract file(s) to' ) ELSE ; cDir := xDir ; cOut := cDir+"\" aPos := {} AEval(array(wMain.grdContent.ItemCount), {|xv,nn| xv:= nn, AAdd(aPos, nn)}) ENDIF IF !Empty( cDir ) // Retrieve while maintaining directory structure or not cCommand := ( iif( wMain.cbxExtract.Value, 'x', 'e' ) + ' ' ) IF wMain.cbxHide.Value // Do not display the process. But if you need to rewrite // existing files, the corresponding request anyway // will be output. cCommand += '-hide ' ENDIF // Overwrite existing files without warning IF wMain.cbxYesAll.Value cCommand += '-y ' ENDIF cCommand += ( '-o' + cDir + ' ' ) // Where to extract // Do not forget to add the name of the archive containing the extracted files // cCommand += ( '"' + AllTrim( wMain.Statusbar.Item( 1 ) ) + '" ' ) cCommand += ( AllTrim( wMain.Statusbar.Item( 1 ) ) + ' ' ) // Add the extracted files. To simplify processing: // if the number of marked items is equal to the total // quantity, it makes no sense to do an exhaustive search. IF ( Len( aPos ) == wMain.grdContent.ItemCount ) cCommand += '*.*' FOR EACH nPos In aPos ; Aadd( aFiles, wMain.grdContent.Item(nPos) ) NEXT ELSE FOR EACH nPos In aPos // Items containing only the directory name, skip cFile := AllTrim( wMain.grdContent.Item( nPos )[ 1 ] ) nSize := wMain.grdContent.Item( nPos )[ 2 ] AAdd( aFiles, {cFile, nSize} ) IF !( Right( cFile, 1 ) == '\' ) // cCommand += ( '"' + cFile + '" ' ) cCommand += ( cFile + ' ' ) ENDIF NEXT cCommand := RTrim( cCommand ) ENDIF IF !( ( nDLLHandle := LoadLibrary( '7-zip32.dll' ) ) > 0 ) IF lMsg ; MsgStop( "Can't load 7-zip32.dll.", 'Error' ) ENDIF nRet := -2 ELSE DllCall( nDLLHandle, DC_CALL_STD, 'SevenZip', _HMG_MainHandle, cCommand ) FreeLibrary( nDLLHandle ) IF lMsg ; MsgInfo( "Extraction is successfully.", 'Result' ) ENDIF nRet := 0 IF !Empty(cOut) FOR nPos := 1 TO Len(aFiles) cFile := aFiles[ nPos ][1] nSize := aFiles[ nPos ][2] IF ISCHAR(nSize) ; nSize := Val(nSize) ENDIF IF hb_FileExists(cOut+cFile) IF nSize != hb_fSize(cOut+cFile) ; nRet++ ENDIF ELSE ; nRet++ ENDIF NEXT IF nRet > 0 FOR nPos := 1 TO Len(aFiles) cFile := aFiles[ nPos ][1] fErase(cOut+cFile) NEXT ENDIF ENDIF ENDIF DO EVENTS wApi_Sleep(1000) ENDIF RETURN nRet DECLARE DLL_TYPE_WORD SevenZipGetVersion() in 7-zip32.dll DECLARE DLL_TYPE_WORD SevenZipGetSubVersion() in 7-zip32.dll *----------------------------------------------------------------------------* STATIC PROCEDURE CreateArcExternal *----------------------------------------------------------------------------* LOCAL aSource := GetFile( { { 'All files', '*.*' } }, ; 'Select file(s)', ; GetCurrentFolder(), .T., .T. ; ), ; cArcFile, ; nPos, ; cExt, ; cType := '', ; cCommand := ' A ' IF !Empty( aSource ) // Addressing directly to 7-Zip itself allows you to create // more types of archives cArcFile := PutFile ( { { '7-zip', '*.7z' }, ; { 'Zip', '*.zip' }, ; { 'GZip', '*.gzip' }, ; { 'BZip2', '*.bzip2' }, ; { 'Tar', '*.tar' } ; }, ; 'Create archive', ; GetCurrentFolder(), ; .T. ; ) IF !Empty( cArcFile ) // Define the type of archive. The default is 7z, so // remember only in case of change in the dialog box. nPos := RAt( '.', cArcFile ) cExt := Upper( Right( cArcFile, ( Len( cArcFile ) - nPos ) ) ) IF !( cExt == '7Z' ) cType := cExt ENDIF // Build the command line IF !Empty( cType ) cCommand += ( '-t' + cType + ' ' ) ENDIF cCommand += ( cArcFile + ' ' ) // Specify files to process AEval( aSource, {| elem | cCommand += ( '"' + elem + '" ' ) } ) // Run either the installed archiver or console // version located in the folder with the demo program IF ( wMain.rdgSelectTest.Value == 2 ) cCommand := ( cPath7z + cCommand ) ELSE cCommand := ( ALONE_7Z + cCommand ) ENDIF cCommand := RTrim( cCommand ) // Run in standby mode for the end of processing. If // while the archiver window itself is hidden (for aesthetics, because the window // console), to display that the work is being performed (if // the archive is large), you can display some kind of information window, // for example with a timer. // There is another option: for 7-Zip, run not% ProgramFiles% \ 7-Zip \ 7z.exe, // and% ProgramFiles% \ 7-Zip \ 7zG.exe is the graphical interface of the archiver. // Get the weird little progress bar on the screen. IF wMain.cbxHide.Value Execute File ( cCommand ) WAIT Hide ELSE Execute File ( cCommand ) Wait ENDIF // Fill In The Status Bar ShowStatus( cArcFile, '', iif( Empty( cType ), '7Z', cType ), ; iif( ( wMain.rdgSelectTest.Value == 2 ), '7-Zip', '7za' ) ) ENDIF ENDIF RETURN *----------------------------------------------------------------------------* STATIC PROCEDURE ViewArcExternal *----------------------------------------------------------------------------* // aFiles - a set of supported archive types. The base accept set for // console version (7za.exe), because its capabilities are more modest. LOCAL aFilters := { { '7-zip', '*.7z' }, ; { 'Zip', '*.zip' }, ; { 'Cab', '*.cab' }, ; { 'GZip', '*.gzip' }, ; { 'Tar', '*.tar' } ; }, ; cFile, ; aFiles := {}, ; cCommand, ; cTmpFile := '_Arc_.lst',; // Or GetTempFolder () + '\ _Arc_.lst' oFile, ; cString // Add archive types that the full version can work with (not all, // specified in the documentation, of course) IF ( wMain.rdgSelectTest.Value == 2 ) AAdd( aFilters, { 'Rar', '*.rar' } ) AAdd( aFilters, { 'Arj', '*.arj' } ) AAdd( aFilters, { 'Chm', '*.chm' } ) AAdd( aFilters, { 'Lzh', '*.lzh' } ) ENDIF IF Empty( cFile := GetFile( aFilters, 'Select archive', GetCurrentFolder(), .F., .T. ) ) RETURN Nil ENDIF // The contents of the archive are displayed in a temporary file and then read for display in // program. // You can, of course, use cmd.exe instead of GetEnv ('COMSPEC'), but // the name of the shell may be different in older versions of Windows cCommand := GetEnv( 'COMSPEC' ) + ' /C ' IF ( wMain.rdgSelectTest.Value == 2 ) // Quotation marks do not hurt, because Program Files has a space in the name. // Here you need to use exactly% ProgramFiles% \ 7-Zip \ 7z.exe, because // graphical version of 7zG.exe does not support redirecting output to a file cCommand := ( cCommand + '"' + cPath7z + '"' ) ELSE cCommand := ( cCommand + ALONE_7Z ) ENDIF // And the information will not be displayed in the table, but in the technical mode (switch // -slt). Then each file file will be described in several lines like this // (varies depending on the type of archive): // Path = Our archive file // Size = // Packed Size = // Modified = // Attributes = // CRC = // Method = // Block = // and the name of the archive element will be displayed in the line marked Path = // Temporary content file is better, of course, to create in // system folder of temporary files (GetTempFolder () + '\' + cTmpFile) cCommand += ( ' L -slt ' + cFile + ' > ' + cTmpFile ) Execute File ( cCommand ) WAIT Hide // A more refined solution would be to redirect the output of the console program // WinAPI function (use CreatePipe and work with it as usual // file), and not create a temporary file, but I'm not that subtle expert. IF File( cTmpFile ) // Temporary file may not be created, for example, due to the errors // in the command line. Additionally, it would not hurt to check its size. // If zero, then there is nothing in it. // Fill The Array oFile := TFileRead():New( cTmpFile ) oFile:Open() IF !oFile:Error() DO WHILE oFile:MoreToRead() IF !Empty( cString := oFile:ReadLine() ) // Several simplified processing. Just checking does not start // whether the line with "Path =" and, if so, then this is the file name. At // necessary, can be made more complicated. For example, ignore // directory names (line "Attributes = D ...." for .7z files) IF ( Left( cString, 7 ) == 'Path = ' ) cString := AllTrim( SubStr( cString, 8 ) ) IF !( cString == cFile ) AAdd( aFiles, { cString } ) ENDIF ENDIF ENDIF ENDDO oFile:Close() IF !Empty( aFiles ) wMain.grdContent.DeleteAllItems ASort( aFiles,,, {| x, y | x[ 1 ] < y[ 1 ] } ) wMain.grdContent.DisableUpdate AEval( aFiles, {| elem | wMain.grdContent.AddItem( elem ) } ) wMain.grdContent.EnableUpdate wMain.grdContent.Value := { 1 } // Fill in the status bar (it will store the name of the read // archive needed to extract files) ShowStatus( cFile, ( 'Count files: ' + LTrim( Str( Len( aFiles ) ) ) ), ; Upper( Right( cFile, ( Len( cFile ) - RAt( '.', cFile ) ) ) ), ; iif( ( wMain.rdgSelectTest.Value == 2 ), '7-Zip', '7za' ) ) ENDIF ENDIF IF ( wMain.grdContent.ItemCount > 0 ) wMain.btnExtract.Enabled := .T. ENDIF ENDIF // The temporary file also played a role. deleted. Team not // causes an error even if the deleted file does not exist. FErase ( cTmpFile ) RETURN Nil *----------------------------------------------------------------------------* STATIC PROCEDURE ExtractArcExternal *----------------------------------------------------------------------------* LOCAL aPos := wMain.grdContent.Value, ; cDir, ; cCommand, ; nPos, ; cFile IF Empty( aPos ) MsgStop( 'Select item(s), please!', 'Error' ) RETURN Nil ENDIF IF !Empty( cDir := GetFolder( 'Extract file(s) to' ) ) // Retrieve while maintaining directory structure or not cCommand := ( iif( wMain.cbxExtract.Value, 'X', 'E' ) + ' ' ) // Overwrite existing files without warning IF wMain.cbxYesAll.Value cCommand += '-y ' ENDIF cCommand += ( '-o' + cDir + ' ' ) // Where to extract cCommand += ( AllTrim( wMain.Statusbar.Item( 1 ) ) + ' ' ) IF ( Len( aPos ) == wMain.grdContent.ItemCount ) cCommand += '*.*' ELSE FOR EACH nPos In aPos // Items which containing only the directory name, skip cFile := AllTrim( wMain.grdContent.Item( nPos )[ 1 ] ) IF !( Right( cFile, 1 ) == '\' ) cCommand += ( cFile + ' ' ) ENDIF NEXT cCommand := RTrim( cCommand ) ENDIF IF ( wMain.rdgSelectTest.Value == 2 ) // If instead of 7z.exe use 7zG.exe, it will be displayed // operation indicator cCommand := ( cPath7z + ' ' + cCommand ) ELSE cCommand := ( ALONE_7Z + ' ' + cCommand ) ENDIF // Do it. IF wMain.cbxHide.Value .AND. !wMain.cbxYesAll.Value Execute File ( cCommand ) WAIT Hide ELSE Execute File ( cCommand ) Wait ENDIF MsgInfo( 'Extraction is successfully.', 'Result' ) ENDIF RETURN Nil *----------------------------------------------------------------------------* FUNCTION SetsEnv() *----------------------------------------------------------------------------* LOCAL cLog := ".\_MsgLog.txt" LOCAL cFont := "Arial" LOCAL nSize := 11 SET CENTURY ON SET DATE GERMAN SET DELETED ON SET EXCLUSIVE ON SET EPOCH TO 2000 SET AUTOPEN ON SET EXACT ON SET SOFTSEEK ON SET NAVIGATION EXTENDED //SET DEFAULT ICON TO "BIL_MAIN" *-------------------------------- SET OOP ON *-------------------------------- DEFINE FONT DlgFont FONTNAME "Tahoma" SIZE 14 fErase( cLog ) ; LogFileName( cLog ) RETURN Nil *----------------------------------------------------------------------------* FUNCTION LogFileName( cLog ) *----------------------------------------------------------------------------* RETURN _SetGetLogFile(cLog)
| Запуск для авто распаковки demo2.exe -e <FileName.7z> <FullDirNameUnPack> Текст помещаем как demo2.prg в Advanced\7-Zip
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3812
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.08.21 10:58. Заголовок: PS Поправил текст, р..
PS Поправил текст, размеры кнопок, убрал chr(0) из имени файла из архива и при запуске demo2.exe -e <FileName.7z> <FullDirNameUnPack> берет все файлы из архива (архив ОБЯЗАТЕЛЬНО без подкаталогов)
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1909
Зарегистрирован: 11.02.10
|
|
Отправлено: 12.08.21 10:18. Заголовок: Всем кому это интересно ;-)
Подготовил 2-й апдейт сборки 21.07 Обновил также Unicode архив.
| |
|
rvu
|
| |
Пост N: 360
Зарегистрирован: 05.11.05
|
|
Отправлено: 12.08.21 14:03. Заголовок: Спасибо!..
Спасибо!
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1916
Зарегистрирован: 11.02.10
|
|
Отправлено: 26.08.21 09:41. Заголовок: Всем кому это интересно
Выложил 3-й апдейт сборки 21.07 Добавлены новые интересные функции, выполнена оптимизация использования внутренних STATIC переменных в ядре библиотеки (их количество уменьшилось на треть). Обновил также Unicode архив. Желаю всем участникам форума мира и добра
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3844
Зарегистрирован: 17.02.12
|
|
Отправлено: 27.08.21 07:50. Заголовок: gfilatov2002 Если п..
gfilatov2002 Если появилось облако переменных, может есть смысл, внести обработку в Events() сообщения WM_COPYDATA, т.е. примерно так ... CASE nMsg == WM_COPYDATA .and. _SetGetGlobal("b_WM_COPYDATA") != Nil // to get data cData := GetMessageData( lParam, @nDataID ) EVal( _SetGetGlobal("b_WM_COPYDATA"), nDataID, cData ) PS. Почему массив, а не Hash, переменных ведь много можно организовать или для системных переменных завести отдельное пространство переменных
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1917
Зарегистрирован: 11.02.10
|
|
Отправлено: 27.08.21 10:02. Заголовок: SergKis пишет: може..
SergKis пишет: цитата: | может есть смысл, внести обработку в Events() |
| Благодарю за предложение, но это, по-моему, излишне. Хотя, есть над чем подумать... SergKis пишет: Так привычнее, поскольку для хранения PUBLIC переменных используется единый массив также.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3845
Зарегистрирован: 17.02.12
|
|
Отправлено: 27.08.21 11:12. Заголовок: gfilatov2002 пишет P..
gfilatov2002 пишет цитата: | PUBLIC переменных используется единый массив также. |
| Это скорее, исторический, минус для hmg, т.к. структура внутри получилась довольно костяная и индивидуальная (описания контролов, где внутренние массивы различаются). Подключение пользовательских обработчиков через SET EVENTS FUNCTION TO MYEVENTS решает многое, но требуют знаний. Использую оч. давно механизм oKeyData() для решения пространства переменных программы и в реале их бывает оч. много и это с учетом, что на окнах такие данные (глобальные) перекрываются локальными значениями В Hash ключ можно использовать не только строковые значения, что бывает очень удобно PS. Пропустил, а удаление переменной есть ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1918
Зарегистрирован: 11.02.10
|
|
Отправлено: 27.08.21 11:56. Заголовок: SergKis пишет: а уд..
SergKis пишет: цитата: | а удаление переменной есть ? |
| Нет Но Вы без труда напишите функцию _DelGlobal()
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3846
Зарегистрирован: 17.02.12
|
|
Отправлено: 27.08.21 12:26. Заголовок: gfilatov2002 пишет Н..
gfilatov2002 пишет цитата: | Но Вы без труда напишите функцию _DelGlobal() |
| Я бы пошел по пути STATIC _HMG_STATIC := oKeyData() //{} и уже все было бы через hash, CLASS TKeyData вынес бы за скобку #ifdef _OBJECT_ Код дополнительный для обслуживания _HMG_STATIC написан PS. CLASS TThrData можно, наверно, удалить. Вряд ли его используют в потоках, а для др. он не нужен
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3847
Зарегистрирован: 17.02.12
|
|
Отправлено: 27.08.21 13:28. Заголовок: PS Ф-я может быть та..
PS Ф-я может быть такой STATIC _HMG_STATIC := oKeyData() *-----------------------------------------------------------------------------* FUNCTION _SetGetGlobal( cVarName, xNewValue ) *-----------------------------------------------------------------------------* LOCAL xOldValue IF pCount() == 0 RETURN _HMG_STATIC ELSEIF pCount() == 1 IF ISCHAR(cVarName) ; cVarName := upper(cVarName) ENDIF RETURN _HMG_STATIC:Get(cVarName, NIL) ELSEIF pCount() == 2 IF ISCHAR(cVarName) ; cVarName := upper(cVarName) ENDIF xOldValue := _HMG_STATIC:Get(cVarName, NIL) IF ISNIL(xNewValue) ; _HMG_STATIC:Del(cVarName) ELSE ; _HMG_STATIC:Set(cVarName, xNewValue) ENDIF ENDIF RETURN xOldValue Применять так дополнительно (кроме выше описанных) aKeys := _SetGetGlobal():Keys() // список всех переменных и ключей aValues := _SetGetGlobal():Values() // список всех значений aAll := _SetGetGlobal():GetAll() // массив всех переменных и значений, т.е. {{key, value},...} и дальше по списку методов класса TKeyData Для строковых переменных можно работать os := _SetGetGlobal() cPath := os:cPathData os:bMy := {|| ... } примеры с Cargo есть на эту тему
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1919
Зарегистрирован: 11.02.10
|
|
Отправлено: 27.08.21 14:14. Заголовок: SergKis пишет: Ф-я ..
SergKis пишет: Выполнил предложенные изменения для использования хэша и класса TKeyData. Исправил присвоение SergKis пишет: цитата: | STATIC _HMG_STATIC := oKeyData() |
| поскольку нельзя присваивать статической переменной возврат функции ВСЕ РАБОТАЕТ (как описано выше)! БЛАГОДАРЮ ЗА ПОМОЩЬ
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3851
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.08.21 14:01. Заголовок: gfilatov2002 Может ..
gfilatov2002 Может сделать THmgData класс, почистив от лишнего и вернуть TKeyData за скобку ? Скрытый текст
STATIC _HMG_STATIC *-----------------------------------------------------------------------------* FUNCTION _SetGetGlobal( cVarName, xNewValue ) *-----------------------------------------------------------------------------* LOCAL xOldValue IF _HMG_STATIC == NIL ; _HMG_STATIC := oHmgData() ENDIF IF pCount() == 0 RETURN _HMG_STATIC ELSEIF pCount() == 1 RETURN _HMG_STATIC:Get(cVarName, Nil) ELSEIF pCount() == 2 xOldValue := _HMG_STATIC:Get(cVarName, Nil) IF ISNIL( xNewValue ) ; _HMG_STATIC:Del(cVarName) ELSE ; _HMG_STATIC:Set(cVarName, xNewValue) ENDIF ENDIF RETURN xOldValue *-----------------------------------------------------------------------------* FUNCTION oHmgData( lUpper ) *-----------------------------------------------------------------------------* hb_default( @lUpper, .T. ) RETURN THmgData():New( lUpper ) /////////////////////////////////////////////////////////////////////////////// CLASS THmgData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR lUpp AS LOGICAL VAR aKey INIT hb_Hash() EXPORTED: VAR Cargo METHOD New( lUpper ) INLINE ( ::lUpp := !Empty( lUpper ), Self ) CONSTRUCTOR METHOD Set( Key, Block ) INLINE iif( HB_ISHASH( Key ), ::aKey := Key, hb_HSet ( ::aKey, ::Upp( Key ), Block ) ) METHOD Get( Key, Def ) INLINE hb_HGetDef( ::aKey, ::Upp( Key ), Def ) METHOD Del( Key ) INLINE iif( ::Pos( Key ) > 0, hb_HDel( ::aKey, ::Upp( Key ) ), Nil ) METHOD Pos( Key ) INLINE hb_HPos( ::aKey, ::Upp( Key ) ) METHOD Upp( Key ) INLINE iif( HB_ISCHAR(Key) .and. ::lUpp, Upper( Key ), Key ) METHOD Len() INLINE Len( ::aKey ) METHOD Keys() INLINE hb_HKeys( ::aKey ) METHOD Values() INLINE hb_HValues( ::aKey ) METHOD CloneHash() INLINE hb_HClone( ::aKey ) _METHOD GetAll( lAll ) _METHOD Eval( Block ) _METHOD Destroy() ERROR HANDLER ControlAssign ENDCLASS /////////////////////////////////////////////////////////////////////////////// METHOD GetAll( lAll ) CLASS THmgData LOCAL aRet := {} IF HB_ISLOGICAL( lAll ) .AND. lAll ::Eval( {| val | AAdd( aRet, val ) } ) ELSE ::Eval( {| val, Key | AAdd( aRet, { Key, val } ) } ) ENDIF RETURN aRet METHOD Eval( Block ) CLASS THmgData 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 Destroy() CLASS THmgData 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 RETURN NIL METHOD ControlAssign( xValue ) CLASS THmgData LOCAL cMessage, uRet, lError cMessage := __GetMessage() lError := .T. IF PCount() == 0 uRet := ::Get( cMessage ) lError := .F. ELSEIF PCount() == 1 ::Set( SubStr( cMessage, 2 ), xValue ) uRet := ::Get( cMessage ) lError := .F. ENDIF IF lError uRet := NIL ::MsgNotFound( cMessage ) ENDIF RETURN uRet
| PS. Можно и метод Destroy() убрать, hb сам справится с очисткой, при завершении работы
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1920
Зарегистрирован: 11.02.10
|
|
Отправлено: 29.08.21 15:35. Заголовок: SergKis пишет: Може..
SergKis пишет: цитата: | Может сделать THmgData класс |
| Принято
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3852
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.08.21 16:05. Заголовок: gfilatov2002 пишет П..
gfilatov2002 пишет Допустил неточность в методе Eval(), поправил и выделил цветом PS. Можно сделать псевдофункции на замену __mvPublic, __mvGet, ... и перенаправить с PUBLIC переменных на hash в переменной, к примеру, _HMG_PUBLIC
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1921
Зарегистрирован: 11.02.10
|
|
Отправлено: 29.08.21 16:36. Заголовок: SergKis пишет: Допу..
SergKis пишет: цитата: | Допустил неточность в методе Eval() |
| Спасибо, исправил.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1922
Зарегистрирован: 11.02.10
|
|
Отправлено: 31.08.21 10:31. Заголовок: Всем кому это интересно
Опубликован 4-й апдейт сборки 21.07 Благодарю за помощь Сергея Киселева P.S. Обновил также Unicode архив.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3855
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.08.21 13:07. Заголовок: Григорий, сделав общ..
Григорий, сделав обще доступной с пользователем область переменных _SetGetGlobal(), не закладывается ли мина пересечения имен ? Может надо разделить, для пользователя _SetGetGlobal(), а для системных вещей, на пример, _SysGlobal()\_HmgGlobal(). По мне стремная ситуация получается с именами сейчас, к примеру IF _SetGetGlobal( 'lOnChangeEvent' ) == NIL Я так тоже люблю свои переменные называть. Или выкинуть из описания для пользователя использование _SetGetGlobal(), можно оставить ф-ю oHmgData() для использования в таком виде LOCAL oVar := oHmgData() oVar:cPathData := "\HBK\DATA" oVar:lShow := .T. oVar:cTitle := "Bla bla bla" ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1923
Зарегистрирован: 11.02.10
|
|
Отправлено: 31.08.21 13:14. Заголовок: SergKis пишет: стре..
SergKis пишет: цитата: | стремная ситуация получается с именами |
| Согласен. Для безопасности добавлю префикс _HMG_ к этим системным переменным
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3856
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.08.21 13:36. Заголовок: gfilatov2002 пишет Д..
gfilatov2002 пишет цитата: | Для безопасности добавлю префикс _HMG_ к этим системным переменным |
| Для безопасности лучше разделить, наверное и списки раздельные, т.е. контроль у каждого за своими переменными нормальный, и по действиям проще, просканировал тексты сейчас, заменил на системное использование и все.
| |
|
Haz
|
| |
Пост N: 1750
Зарегистрирован: 20.02.11
|
|
Отправлено: 03.09.21 15:22. Заголовок: Нужны ли новые методы
Всем привет. нашел у себя в старом проекте. Совсем забыл Может будет интересно METHOD Show(lShow) CLASS TSBrowse hb_default(@lShow, .t.) if lShow ShowWindow(::hWnd) else HideWindow(::hWnd) end RETURN nil Используется для прорисовки в одних координатах разных бровсов в зависимости от условий, примерно так ... oBrw_1:Show( lOk ) oBrw_2:Show( !lOk ) ... В итоге , в зависимости от значения lOk один бровс спрячется, а второй появится Правда делал через __objAddMethod() чтоб исходники не менять. Но суть та же
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3857
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.09.21 21:22. Заголовок: Haz пишет Правда дел..
Haz пишет цитата: | Правда делал через __objAddMethod() чтоб исходники не менять. |
| В TControl уже есть методы METHOD Hide() INLINE ShowWindow( ::hWnd, SW_HIDE ) METHOD Show() INLINE ShowWindow( ::hWnd, SW_SHOWNA ) они работают. Т.е. можно писать iif( lOk, oBrw:Show(), oBrw:Hide() ) Через __objAddMethod() ты просто замещал метод oBrw:Show, наследованный от TControl, своим кодом
| |
|
Haz
|
| |
Пост N: 1751
Зарегистрирован: 20.02.11
|
|
Отправлено: 03.09.21 21:33. Заголовок: Велосипед
SergKis пишет: цитата: | TControl уже есть методы METHOD Hide() INLINE ShowWindow( ::hWnd, SW_HIDE ) |
| Значит я изобрёл велосипед Нашёл разгребая архивы, не проверив исходники. Спасибо
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3858
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.09.21 21:53. Заголовок: Haz пишет Значит я и..
Haz пишет цитата: | Значит я изобрёл велосипед |
| Это часто бывает проще, чем разобрать, что где лежит и как работает. Сам страдаю таким, ну нет времени куда то залезть поглубже , делаешь быстро, что бы работало. Так что не бери в голову ... со временем все встает на свои места
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3878
Зарегистрирован: 17.02.12
|
|
Отправлено: 13.09.21 17:26. Заголовок: gfilatov2002 Предла..
gfilatov2002 Предлагаю в GetBox для valid исп. вызов со средой This. контрола, т.е. FUNCTION OGETEVENTS( hWnd, nMsg, wParam, lParam ) ... CASE nMsg == WM_INVALID ... //IF ! Eval( oGet:postblock, oGet ) IF ! Do_ControlEventProcedure ( oGet:postblock, __mvGet( oGet:name ), oGet ) // valid SetFocus( hWnd ) ... Пример тут Скрытый текст
/* * MINIGUI - Harbour Win32 GUI library Demo * * Copyright 2021 Sergej Kiselev <bilance@bilance.lv> * Copyright 2021 Verchenko Andrey <verchenkoag@gmail.com> */ ANNOUNCE RDDSYS #define _HMG_OUTLOG #include "minigui.ch" Function Main Local nFSize := 16, cFName := "Arial" Local nWDate, nWTime, x, y, nG, x2, cTime, oGet, cSay, nHObj Local ix,cv SET CENTURY ON SET NAVIGATION EXTENDED nWDate := 290 nWTime := 160 nG := 20 cTime := Space(6) nHObj := nFSize*2 DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 600 ; HEIGHT 490 ; TITLE "MiniGUI Date + Time Demo" ; MAIN ; FONT cFName SIZE nFSize y := 20 x := nG cSay := "Period from:" @ y, x LABEL Label_1 VALUE cSay WIDTH nWDate HEIGHT nHObj y += Form_1.Label_1.Height // дата период начало @ y, x DATEPICKER Date_1 VALUE DATE() WIDTH nWDate HEIGHT nHObj ; DATEFORMAT "dd'.'MMMM' 'yyyy" SHOWNONE x2 := Form_1.Date_1.Col + Form_1.Date_1.Width + nG // время период начало @ y, x2 GETBOX Time_1 OBJ oGet VALUE cTime WIDTH nWTime HEIGHT nHObj ; PICTURE "@R 99:99:99" VALID {|og| bValid( og ) } BUTTONWIDTH nHObj ; ON GOTFOCUS {|| SendMessage(This.Handle, 177 /*EM_SETSEL*/, 0, Len( This.Value )) } ; ON INIT {|| _SetAlign ( This.Name, ThisWindow.Name, "CENTER" ) } ; IMAGE {"MINIGUI_EDIT_CANCEL",NIL } ; ACTION ( This.Value := space(6) ) y += Form_1.Date_1.Height + nG*2 cSay := "Period to:" @ y, x LABEL Label_2 VALUE cSay WIDTH nWDate HEIGHT nHObj y += Form_1.Label_2.Height // дата период конец @ y, x DATEPICKER Date_2 VALUE DATE()+2 WIDTH nWDate HEIGHT nHObj ; DATEFORMAT "dd'.'MMMM' 'yyyy" SHOWNONE // время период конец @ y, x2 GETBOX Time_2 OBJ oGet VALUE cTime WIDTH nWTime HEIGHT nHObj ; PICTURE "@R 99:99:99" VALID {|og| bValid( og ) } BUTTONWIDTH nHObj ; ON GOTFOCUS {|| SendMessage(This.Handle, 177 /*EM_SETSEL*/, 0, Len( This.Value )) } ; ON INIT {|| _SetAlign ( This.Name, ThisWindow.Name, "CENTER" ) } ; IMAGE { "MINIGUI_EDIT_CANCEL", "MINIGUI_EDIT_OK" } ; ACTION ( This.Time_2.Value := cTime ) ; ACTION2 ( This.Time_2.Value := "235959" ) y += Form_1.Date_2.Height + nG @ y, x BUTTON Button_1 CAPTION "Get search bar" ; WIDTH nWDate + nWTime + nG HEIGHT 35 ; ACTION ( Form_1.Label_Search.Value := mySearchString() ) y += Form_1.Button_1.Height + nG * 2 @ y, x LABEL Label_Search VALUE "Search line:" WIDTH Form_1.Width - 40 ; HEIGHT 80 TOOLTIP "Search line" FONTCOLOR RED END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 Return Nil * ----------------------------------------------------------------------------------- * Function mySearchString() * ----------------------------------------------------------------------------------- * Local cDate1, cDate2, cTime1, cTime2, cRet cDate1 := HB_DTOC( Form_1.Date_1.Value, 'YYYY-MM-DD') cDate2 := HB_DTOC( Form_1.Date_2.Value, 'YYYY-MM-DD') cTime1 := left(trim(This.Time_1.Value) + repl("0", 6), 6) cTime2 := left(trim(This.Time_2.Value) + repl("0", 6), 6) cTime1 := Transform(cTime1, "@R 99:99:99") cTime2 := Transform(cTime2, "@R 99:99:99") cRet := "" // поиск по полю TSZ типа "T@=" // = ModTime 8 Last modified date & time of this record // @ DayTime 8 Date & Time // T Time 4 or 8 Only time (if width is 4 ) or Date & Time (if width is 8 ) IF VAL(cTime1) > 0 .OR. VAL(cTime2) > 0 // время задано cRet += '( HB_TSTOSTR(SKLAD->TSZ) >= "'+cDate1+'" .AND. ' cRet += 'HB_TSTOSTR(SKLAD->TSZ) <= "'+cDate2+'" )' cRet += ' ???? ' + cTime1 + ' ???? ' + cTime2 ELSE // время не задано cRet += '( HB_TSTOSTR(SKLAD->TSZ) >= "'+cDate1+'" .AND. ' cRet += 'HB_TSTOSTR(SKLAD->TSZ) <= "'+cDate2+'" )' ENDIF cRet += ' .AND. !DELETED()' Return cRet * ----------------------------------------------------------------------------------- * STATIC FUNCTION bValid( oGet, nPost ) // проверка правильности времени в GetBox * ----------------------------------------------------------------------------------- * LOCAL lRet, lVl1, lVl2, lVl3, nVal LOCAL cVal := left(trim(oGet:VarGet()) + repl("0", 6), 6) LOCAL hGet := This.Handle LOCAL hWnd := ThisWindow.Handle lVl1 := lVl2 := lVl3 := .F. nVal := Val(left(cVal, 2)) IF nVal >= 0 .and. nVal < 24 ; lVl1 := .T. ENDIF nVal := Val(subs(cVal, 3, 2)) IF nVal >= 0 .and. nVal < 60 ; lVl2 := .T. ENDIF nVal := Val(subs(cVal, 5, 2)) IF nVal >= 0 .and. nVal < 60 ; lVl3 := .T. ENDIF lRet := lVl1 .and. lVl2 .and. lVl3 IF ! lRet // есть команды\ф-ии управления временем Tooltip, если надо исп. ShowGetValid можно применить // т.е. сохранить старое, поставить новое и потом после ShowGetValid (InkeyGui) восстановить SetFocus(hGet) ShowGetValid( hGet, This.Name+": Задайте правильно значение времени ! ", 'ОШИБКА '+ThisWindow.Name, 'E' ) InkeyGui( 5 * 1000 ) SetFocus(hWnd) oGet:VarPut(space(6)) oGet:Refresh() SetFocus(hGet) lRet := .T. ENDIF RETURN lRet #pragma BEGINDUMP #define _WIN32_WINNT 0x0600 #include <windows.h> #include "hbapi.h" #include "hbapicdp.h" #include <commctrl.h> #if ( defined( __BORLANDC__ ) && __BORLANDC__ < 0x582 ) typedef struct _tagEDITBALLOONTIP { DWORD cbStruct; LPCWSTR pszTitle; LPCWSTR pszText; INT ttiIcon; // From TTI_* } EDITBALLOONTIP, *PEDITBALLOONTIP; #define EM_SHOWBALLOONTIP (ECM_FIRST + 3) // Show a balloon tip associated to the edit control #define Edit_ShowBalloonTip(hwnd, peditballoontip) (BOOL)SNDMSG((hwnd), EM_SHOWBALLOONTIP, 0, (LPARAM)(peditballoontip)) #define EM_HIDEBALLOONTIP (ECM_FIRST + 4) // Hide any balloon tip associated with the edit control #define Edit_HideBalloonTip(hwnd) (BOOL)SNDMSG((hwnd), EM_HIDEBALLOONTIP, 0, 0) #define ECM_FIRST 0x1500 // Edit control messages #endif // (__BORLANDC__ < 0x582) // ToolTip Icons (Set with TTM_SETTITLE) #define TTI_NONE 0 #define TTI_INFO 1 #define TTI_WARNING 2 #define TTI_ERROR 3 #if (_WIN32_WINNT >= 0x0600) #define TTI_INFO_LARGE 4 #define TTI_WARNING_LARGE 5 #define TTI_ERROR_LARGE 6 #endif // (_WIN32_WINNT >= 0x0600) /* ShowGetValid( hWnd, cText [ , cTitul ] [ , cTypeIcon ] ) */ #if ( HB_VER_MAJOR == 3 ) #define _hb_cdpGetU16( cdp, fCtrl, ch) hb_cdpGetU16(cdp, ch ) #define _hb_cdpGetChar(cdp, fCtrl, ch) hb_cdpGetChar(cdp, ch) #else #define _hb_cdpGetU16( cdp, fCtrl, ch) hb_cdpGetU16(cdp, fCtrl, ch ) #define _hb_cdpGetChar(cdp, fCtrl, ch) hb_cdpGetChar(cdp, fCtrl, ch) #endif HB_FUNC( SHOWGETVALID ) { int i, k; const char *tp, *s; WCHAR Text[512]; WCHAR Title[512]; EDITBALLOONTIP bl; PHB_CODEPAGE s_cdpHost = hb_vmCDP(); HWND hWnd = ( HWND ) hb_parnl(1); if( ! IsWindow( hWnd ) ) return; bl.cbStruct = sizeof( EDITBALLOONTIP ); bl.pszTitle = NULL; bl.pszText = NULL; bl.ttiIcon = TTI_NONE; if( HB_ISCHAR( 2 ) ){ ZeroMemory( Text, sizeof(Text) ); k = hb_parclen(2); s = (const char *) hb_parc(2); for(i=0;i<k;i++) Text[ i ] = _hb_cdpGetU16( s_cdpHost, TRUE, s[ i ] ); bl.pszText = Text; } if( HB_ISCHAR( 3 ) ){ ZeroMemory( Title, sizeof(Title) ); k = hb_parclen(3); s = (const char *) hb_parc(3); for(i=0;i<k;i++) Title[ i ] = _hb_cdpGetU16( s_cdpHost, TRUE, s[ i ] ); bl.pszTitle = Title; } tp = ( const char * ) hb_parc(4); switch( *tp ){ case 'E' : bl.ttiIcon = TTI_ERROR_LARGE; break; case 'e' : bl.ttiIcon = TTI_ERROR; break; case 'I' : bl.ttiIcon = TTI_INFO_LARGE; break; case 'i' : bl.ttiIcon = TTI_INFO; break; case 'W' : bl.ttiIcon = TTI_WARNING_LARGE; break; case 'w' : bl.ttiIcon = TTI_WARNING; break; } Edit_ShowBalloonTip( hWnd, &bl ); } #pragma ENDDUMP
|
| |
|
Andrey
|
| постоянный участник
|
Пост N: 7055
Зарегистрирован: 12.09.06
|
|
Отправлено: 13.09.21 18:06. Заголовок: SergKis пишет: Func..
SergKis пишет: цитата: | Function mySearchString() |
| Функцию исправить ! Уже есть правильная у Григория.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3879
Зарегистрирован: 17.02.12
|
|
Отправлено: 13.09.21 19:32. Заголовок: Andrey пишет Уже ест..
Andrey пишет цитата: | Уже есть правильная у Григория. |
| Тут другое, блок кода на valid запускается сейчас по Eval(...), что со средой This, неопределенно предлагаю ... (см. выше). Тогда This среда будет для текущего GETBOX. В примере, что у тебя ThisWindow.Name попадаем на окно GetBox, но можем и промахнуться, а This.Name им GetBox нет, есть опять имя окна.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1930
Зарегистрирован: 11.02.10
|
|
Отправлено: 13.09.21 20:53. Заголовок: SergKis пишет: Пред..
SergKis пишет: цитата: | Предлагаю в GetBox для valid исп. вызов со средой This. контрола |
| Принято Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3881
Зарегистрирован: 17.02.12
|
|
Отправлено: 14.09.21 13:53. Заголовок: gfilatov2002 Поправ..
gfilatov2002 Поправил в примере выше bValid(), выделил цветом. Позволяет тогда без смены времени (в пределах времени tooltip) управлять длительностью сообщения ShowGetValid, т.е. нажав клавишу или клик мышой на getbox (InkeyGui сработает), переключится фокус и сообщение уйдет, потом возвращаем фокус на getbox или сообщение будет держаться пока время InkeyGui не кончится PS ShowGetValid имеет 6 вариантов image E,e,I,i,W,w, т.е. тут ShowGetValid( hGet, This.Name+": Задайте правильно значение времени ! ", 'ОШИБКА '+ThisWindow.Name, 'E' ) Можно использовать CRLF и chr(9) в тексте ShowGetValid( hGet, This.Name+": Text 1 !"+CRLF+"Text 2"+chr(9)+"ku-ku", 'ИНФОРМАЦИЯ '+ThisWindow.Name, 'i' )
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1931
Зарегистрирован: 11.02.10
|
|
Отправлено: 14.09.21 14:26. Заголовок: SergKis пишет: Попр..
SergKis пишет: цитата: | Поправил в примере выше bValid() |
| Спасибо, теперь работает хорошо
| |
|
Петр
|
| постоянный участник
|
Пост N: 1708
Зарегистрирован: 09.10.06
|
|
Отправлено: 14.09.21 19:42. Заголовок: Andrey пишет: Уже е..
Andrey пишет: цитата: | Уже есть правильная у Григория |
| Судя по RC2 - пока нету..
| |
|
Петр
|
| постоянный участник
|
Пост N: 1709
Зарегистрирован: 09.10.06
|
|
Отправлено: 16.09.21 14:36. Заголовок: Предложения по измен..
Предложения по изменению c_datepicker.c Скрытый текст #ifdef __XHARBOUR__ #define HB_ISDATETIME ISDATETIME #endif HB_FUNC( SETDATEPICK ) { HWND hwnd; SYSTEMTIME sysTime; hwnd = ( HWND ) HB_PARNL( 1 ); if ( hb_pcount() == 2 && HB_ISDATE( 2 ) ) { long lJulian; int iYear, iMonth, iDay; lJulian = hb_pardl( 2 ); hb_dateDecode( lJulian, &iYear, &iMonth, &iDay ); sysTime.wYear = ( WORD ) iYear; sysTime.wMonth = ( WORD ) iMonth; sysTime.wDay = ( WORD ) iDay; } else if( hb_pcount() > 2 ) { sysTime.wYear = ( WORD ) hb_parni( 2 ); sysTime.wMonth = ( WORD ) hb_parni( 3 ); sysTime.wDay = ( WORD ) hb_parni( 4 ); } else { sysTime.wYear = 2005; // date() ? sysTime.wMonth = 1; sysTime.wDay = 1; } sysTime.wDayOfWeek = 0; sysTime.wHour = 0; sysTime.wMinute = 0; sysTime.wSecond = 0; sysTime.wMilliseconds = 0; if( SendMessage( hwnd, DTM_SETSYSTEMTIME, GDT_VALID, ( LPARAM ) &sysTime ) == GDT_VALID ) hb_retl( HB_TRUE ); else hb_retl( HB_FALSE ); } HB_FUNC( SETTIMEPICK ) { HWND hwnd; SYSTEMTIME sysTime; hwnd = ( HWND ) HB_PARNL( 1 ); sysTime.wYear = 2005; sysTime.wMonth = 1; sysTime.wDay = 1; sysTime.wDayOfWeek = 0; sysTime.wHour = ( WORD ) hb_parni( 2 ); sysTime.wMinute = ( WORD ) hb_parni( 3 ); sysTime.wSecond = ( WORD ) hb_parni( 4 ); sysTime.wMilliseconds = 0; if( SendMessage( hwnd, DTM_SETSYSTEMTIME, GDT_VALID, ( LPARAM ) &sysTime ) == GDT_VALID ) hb_retl( HB_TRUE ); else hb_retl( HB_FALSE ); } HB_FUNC( GETDATEPICDATE ) { SYSTEMTIME st; st.wYear = 0; st.wMonth = 0; st.wDay = 0; SendMessage( ( HWND ) HB_PARNL( 1 ), DTM_GETSYSTEMTIME, 0, ( LPARAM ) &st ); hb_retd( st.wYear, st.wMonth, st.wDay ); } HB_FUNC( GETDATEPICKYEAR ) { SYSTEMTIME st; st.wYear = 0; SendMessage( ( HWND ) HB_PARNL( 1 ), DTM_GETSYSTEMTIME, 0, ( LPARAM ) &st ); hb_retni( st.wYear ); } HB_FUNC( GETDATEPICKMONTH ) { SYSTEMTIME st; st.wMonth = 0; SendMessage( ( HWND ) HB_PARNL( 1 ), DTM_GETSYSTEMTIME, 0, ( LPARAM ) &st ); hb_retni( st.wMonth ); } HB_FUNC( GETDATEPICKDAY ) { SYSTEMTIME st; st.wDay = 0; SendMessage( ( HWND ) HB_PARNL( 1 ), DTM_GETSYSTEMTIME, 0, ( LPARAM ) &st ); hb_retni( st.wDay ); } HB_FUNC( GETDATEPICKHOUR ) { SYSTEMTIME st; st.wHour = 0; if( SendMessage( ( HWND ) HB_PARNL( 1 ), DTM_GETSYSTEMTIME, 0, ( LPARAM ) &st ) == GDT_VALID ) hb_retni( st.wHour ); else hb_retni( -1 ); } HB_FUNC( GETDATEPICKMINUTE ) { SYSTEMTIME st; st.wMinute = 0; if( SendMessage( ( HWND ) HB_PARNL( 1 ), DTM_GETSYSTEMTIME, 0, ( LPARAM ) &st ) == GDT_VALID ) hb_retni( st.wMinute ); else hb_retni( -1 ); } HB_FUNC( GETDATEPICKSECOND ) { SYSTEMTIME st; st.wSecond = 0; if( SendMessage( ( HWND ) HB_PARNL( 1 ), DTM_GETSYSTEMTIME, 0, ( LPARAM ) &st ) == GDT_VALID ) hb_retni( st.wSecond ); else hb_retni( -1 ); } HB_FUNC( DTP_SETDATETIME ) { HWND hwnd; SYSTEMTIME sysTime; BOOL bTimeToZero = FALSE; hwnd = ( HWND ) HB_PARNL( 1 ); if( HB_ISDATETIME( 2 ) ) { int iYear, iMonth, iDay, iHour, iMinute, iSecond, iMSec; #ifdef __XHARBOUR__ long lJulian, lMilliSec; #endif #ifndef __XHARBOUR__ hb_timeStampUnpack( hb_partd( 2 ), &iYear, &iMonth, &iDay, &iHour, &iMinute, &iSecond, &iMSec ); #else if( hb_partdt( &lJulian, &lMilliSec, 2 ) ) { hb_dateDecode( lJulian, &iYear, &iMonth, &iDay ); hb_timeStampDecode( lMilliSec, &iHour, &iMinute, &iSecond, &iMSec ); } #endif sysTime.wYear = ( WORD ) iYear; sysTime.wMonth = ( WORD ) iMonth; sysTime.wDay = ( WORD ) iDay; sysTime.wDayOfWeek = 0; sysTime.wHour = ( WORD ) iHour; sysTime.wMinute = ( WORD ) iMinute; sysTime.wSecond = ( WORD ) iSecond; sysTime.wMilliseconds = ( WORD ) iMSec; } else if( HB_ISDATE( 2 ) ) { long lJulian; int iYear, iMonth, iDay; lJulian = hb_pardl( 2 ); hb_dateDecode( lJulian, &iYear, &iMonth, &iDay ); sysTime.wYear = ( WORD ) iYear; sysTime.wMonth = ( WORD ) iMonth; sysTime.wDay = ( WORD ) iDay; sysTime.wDayOfWeek = 0; bTimeToZero = TRUE; } else { sysTime.wYear = ( WORD ) hb_parnidef( 2, 2005 ); sysTime.wMonth = ( WORD ) hb_parnidef( 3, 1 ); sysTime.wDay = ( WORD ) hb_parnidef( 4, 1 ); sysTime.wDayOfWeek = 0; if( hb_pcount() >= 7 ) { sysTime.wHour = ( WORD ) hb_parni( 5 ); sysTime.wMinute = ( WORD ) hb_parni( 6 ); sysTime.wSecond = ( WORD ) hb_parni( 7 ); sysTime.wMilliseconds = ( WORD ) hb_parni( 8 ); } else bTimeToZero = TRUE; } if( bTimeToZero ) { sysTime.wHour = 0; sysTime.wMinute = 0; sysTime.wSecond = 0; sysTime.wMilliseconds = 0; } if( SendMessage( hwnd, DTM_SETSYSTEMTIME, GDT_VALID, ( LPARAM ) &sysTime ) == GDT_VALID ) hb_retl( HB_TRUE ); else hb_retl( HB_FALSE ); } HB_FUNC( DTP_GETDATETIME ) { SYSTEMTIME st; SendMessage( ( HWND ) HB_PARNL( 1 ), DTM_GETSYSTEMTIME, 0, ( LPARAM ) &st ); #ifdef __XHARBOUR__ hb_retdtl( hb_dateEncode( st.wYear, st.wMonth, st.wDay ), hb_timeStampEncode( st.wHour, st.wMinute, st.wSecond, st.wMilliseconds ) ); #else hb_rettd( hb_timeStampPack( st.wYear, st.wMonth, st.wDay, st.wHour, st.wMinute, st.wSecond, st.wMilliseconds ) ); #endif }
| Что нового Добавлена функция GetDatePickDate() GetDatePickDate( c ) == hb_Date( GetDatePickYear ( c ), GetDatePickMonth ( c ), GetDatePickDay ( c ) ) SetDatePick в качестве второго аргумента может получать тип Date SetDatePick(c, Date()) dtp_SetDatetime в качестве второго аргумента может получать тип Date, тогда она работает как SetDatePick() dtp_SetDatetime(c, Date()) Улучшена совместимость с xHarbour Также теперь функции SetDatePick(), SetTimePick(), dtp_SetDatetime() в зависимости от того успешно или нет они отработали, возвращают соответственно .T. или .F.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1932
Зарегистрирован: 11.02.10
|
|
Отправлено: 16.09.21 15:14. Заголовок: Петр пишет: Предлож..
Петр пишет: цитата: | Предложения по изменению c_datepicker.c |
| Узнаю руку мастера Благодарю за помощь
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1934
Зарегистрирован: 11.02.10
|
|
Отправлено: 17.09.21 10:07. Заголовок: Всем кому это интересно
Опубликована свежая сборка 21.09 Благодарю за помощь Сергея Киселева, Игоря Назарова и Петра Черного Друзья, без Вашей помощи этот релиз не состоялся бы... P.S. Обновил также Unicode архив. P.S. 2 Желаю всем мира и добра
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3882
Зарегистрирован: 17.02.12
|
|
Отправлено: 17.09.21 14:26. Заголовок: gfilatov2002 Можно ..
gfilatov2002 Можно ссылочку на Unicode архив, старая погибла.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1935
Зарегистрирован: 11.02.10
|
|
Отправлено: 17.09.21 15:16. Заголовок: SergKis пишет: ссыл..
SergKis пишет: цитата: | ссылочку на Unicode архив |
| Отправил в личку
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3883
Зарегистрирован: 17.02.12
|
|
Отправлено: 17.09.21 16:14. Заголовок: gfilatov2002 Спасибо..
gfilatov2002 Спасибо PS Может есть смысл перевести Public &mVar и __mv... ф-ии на аналог _SetGetGlobal(), что то такое STATIC _HMG_PUBLIC FUNC _SetGetPublic(...) ... смотрел на эту тему исходники и файлы ch, должно получиться (окна и контролы, по формируемым именам, вроде укладываются в схему) В ф-ии _SetGetGlobal() можно убрать IF ISCHAR( cVarName ) cVarName := Upper( cVarName ) ENDIF т.к. параметр имя проходит через метод :Upp() в нем такое делается, т.к. в :New( lUpper := .T.)
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1936
Зарегистрирован: 11.02.10
|
|
Отправлено: 17.09.21 16:38. Заголовок: SergKis пишет: Може..
SergKis пишет: цитата: | Может есть смысл перевести Public &mVar и __mv... ф-ии на аналог _SetGetGlobal(), что то такое STATIC _HMG_PUBLIC FUNC _SetGetPublic(...) ... |
| Я не против, жду ваших предложений Но смогу ответить/рассмотреть уже только после отпуска, ухожу на две недели SergKis пишет: цитата: | В ф-ии _SetGetGlobal() можно убрать |
| Убрал, конечно Благодарю за помощь
| |
|
Петр
|
| постоянный участник
|
Пост N: 1710
Зарегистрирован: 09.10.06
|
|
Отправлено: 17.09.21 20:19. Заголовок: SergKis пишет: Може..
SergKis пишет: цитата: | Может есть смысл перевести Public &mVar и __mv... ф-ии на аналог _SetGetGlobal() |
| И в чем будет ожидаемый профит ? Убытки в виде потери совместимости и падения производительности - это понятно.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3884
Зарегистрирован: 17.02.12
|
|
Отправлено: 17.09.21 21:43. Заголовок: Петр пишет Убытки в ..
Петр пишет цитата: | Убытки в виде падения производительности |
| Почему ? Для public таблица описаний, если не ошибаюсь массив структуированный, а тут Hash цитата: | Убытки в виде потери совместимости |
| Где то нет Hash ? Сейчас он внутри hmg используется в getbox, TsBrowse, может еще где цитата: | И в чем будет ожидаемый профит ? |
| Уйти на STATIC
| |
|
Петр
|
| постоянный участник
|
Пост N: 1711
Зарегистрирован: 09.10.06
|
|
Отправлено: 17.09.21 22:09. Заголовок: SergKis пишет: Где ..
SergKis пишет: цитата: | Где то нет Hash ? Сейчас он внутри hmg используется в getbox, TsBrowse |
| Причем здесь Hash. Старый код с ухищрениями в виде прямого доступа к публичным переменным перестанет работать. А Hash используется там куда его воткнули, к месту или нет, как будто в getbox без Hash обойтись не было возможности. SergKis пишет: Что это даст? Мне никогда не нравилась "внутренняя" реализация MiniGUI, но по крайней мере она существует не один год в именно в таком виде, как её реализовал Роберто Лопез. У нее есть недостатки, но есть и какая-то концепция. Вот новую концепцию хотелось бы и услышать.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3885
Зарегистрирован: 17.02.12
|
|
Отправлено: 17.09.21 22:29. Заголовок: Петр пишет Вот новую..
Петр пишет цитата: | Вот новую концепцию хотелось бы и услышать. |
| Как то не собирался концепции разводить. Хочется просто уменьшить ко-во Public переменных в динамической памяти. При всем уважении к реализации сборщика мусора (он хорошо работает), но потери адресов public переменных происходят, так же как это было и VO (Access violation). цитата: | как будто в getbox без Hash обойтись не было возможности. |
| Можно, но с hash удобнее и код проще. цитата: | Старый код с ухищрениями в виде прямого доступа к публичным переменным перестанет работать |
| Вот потому и спросил "Может ...", т.к. пока не встречал примеров на эту тему. Не знаю кто будет организовывать прямой доступ к переменной окна или к переменной контрола для хранения индекса (речь идет только о них), т.е. mVar := '_' + ParentFormName + '_' + ControlName k := _GetControlFree() Public &mVar. := k или mVar := '_' + FormName k := AScan ( _HMG_aFormDeleted, .T. ) Public &mVar. := k и *-----------------------------------------------------------------------------* FUNCTION GetControlIndex ( ControlName , ParentForm ) *-----------------------------------------------------------------------------* LOCAL mVar := '_' + ParentForm + '_' + ControlName RETURN __mvGetDef ( mVar , 0 ) цитата: | по крайней мере она существует не один год в именно в таком виде, как её реализовал Роберто Лопез |
| Огромное САСИБО ему за это, но времени уже много прошло, жизнь идет дальше, возможно и тут надо что то менять
| |
|
Петр
|
| постоянный участник
|
Пост N: 1712
Зарегистрирован: 09.10.06
|
|
Отправлено: 17.09.21 23:09. Заголовок: SergKis пишет: но п..
SergKis пишет: цитата: | но потери адресов public переменных происходят |
| Мне понравился подход Андрея: запретить пользователям пить кофе (курить, есть, пить, спать.. ). Это лучше чем разбираться в причинах падений программы. SergKis пишет: цитата: | Как то не собирался концепции разводить. |
| Ну ладно. А как будет выглядеть такой вот код с использованием Hash _HMG_ActiveFormName := IF( Empty( _HMG_ActiveFormName ), 'Form_1', _HMG_ActiveFormName ) _HMG_BeginWindowActive := .T. ну или после препроцессора _HMG_SYSDATA[33] := IF( Empty( _HMG_SYSDATA[33] ), "Form_1", _HMG_SYSDATA[33] ) _HMG_SYSDATA[34] := .T. без потери производительности и с соблюдением безопасности при mt.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3886
Зарегистрирован: 17.02.12
|
|
Отправлено: 17.09.21 23:33. Заголовок: Петр пишет А как буд..
Петр пишет цитата: | А как будет выглядеть такой вот код с использованием Hash |
| Так и будет выглядеть, эти define не трогаем, речь идет о ф-ях __mv... __mvPublic, __mvGet, __mvPut, ... причем для ограниченного применения ТОЛЬКО для переменных от имен form и контрола, которые динамически формируются в момент создания DEFINE ... что то. Это строки mVar := '_' + ParentFormName + '_' + ControlName k := _GetControlFree() Public &mVar. := k или mVar := '_' + FormName k := AScan ( _HMG_aFormDeleted, .T. ) Public &mVar. := k и *-----------------------------------------------------------------------------* FUNCTION GetControlIndex ( ControlName , ParentForm ) *-----------------------------------------------------------------------------* LOCAL mVar := '_' + ParentForm + '_' + ControlName RETURN __mvGetDef ( mVar , 0 ) тут hash просто напрашивается, по мне цитата: | Мне понравился подход Андрея: запретить пользователям пить кофе |
| Так он и не запрещает. По моей рекомендации убирает из блока кода внешнюю для него public переменную и переводит на внутреннюю полученную через параметр и это место работает. Просто мест, сделанных от стандартного подхода от MiniGui, у него много, вот они начинают сыпаться со временем нарастания программы
| |
|
Петр
|
| постоянный участник
|
Пост N: 1713
Зарегистрирован: 09.10.06
|
|
Отправлено: 18.09.21 00:11. Заголовок: SergKis пишет: Так ..
SergKis пишет: цитата: | Так и будет выглядеть, эти define не трогаем, речь идет о ф-ях __mv... __mvPublic, __mvGet, __mvPut, ... причем для ограниченного применения ТОЛЬКО для переменных от имен form и контрола, которые динамически формируются в момент создания DEFINE ... что то. |
| Наконец-то дошло. Идея хорошая. Ждем реализацию. SergKis пишет: Я там забыл смайлик поставить
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3887
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.09.21 08:07. Заголовок: Петр пишет Ждем реал..
Петр пишет Надо определиться по именам. Мне в голову лезет такое #xtranslate _SetNameList( <x> , <v> ) => _SetGetNamesList( <x> , <v> ) #xtranslate _GetNameList( <x> ) => _SetGetNamesList( <x> ) #xtranslate _DelNameList( <x> ) => _SetGetNamesList( <x> , NIL , .T. ) *-----------------------------------------------------------------------------* FUNCTION _SetGetNamesList( cVarName, xNewValue, lDelete ) *-----------------------------------------------------------------------------* STATIC _HMG_NAMESLIST IF HB_ISNIL( _HMG_NAMESLIST ) _HMG_NAMESLIST := oHmgData() ENDIF IF PCount() == 1 RETURN _HMG_NAMESLIST:Get( cVarName, 0 ) ELSEIF PCount() == 2 _HMG_NAMESLIST:Set( cVarName, xNewValue ) ELSEIF PCount() == 3 IF lDelete ; _HMG_NAMESLIST:Del( cVarName ) ELSE ; _HMG_NAMESLIST:Set( cVarName, NIL ) ENDIF ENDIF RETURN _HMG_NAMESLIST
| |
|
Петр
|
| постоянный участник
|
Пост N: 1714
Зарегистрирован: 09.10.06
|
|
Отправлено: 18.09.21 10:13. Заголовок: SergKis пишет: Надо..
SergKis пишет: цитата: | Надо определиться по именам. |
| cVarName вроде уже как не cVarName, а cNewName d в случае Set или просто cName в других. А вот чего это Name FormsAndControlsNamesList или FCNamesList или ListOfFormsAndControlsNames или просто NamesList
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3891
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.09.21 10:36. Заголовок: Петр пишет cVarName ..
Петр пишет цитата: | cVarName вроде уже как не cVarName |
| тогда может так FUNCTION _SetGetNamesList( cName, nIndex, lDelete ) С этого начал, но в hmg сложились такие названия _SetGetGlobal, _SetGetCargo, может еще есть не помню пошел по этому пути в наименовании, а FormsAndControlsNamesList уж очень длинно прочитать, а выговорить вслух
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1937
Зарегистрирован: 11.02.10
|
|
Отправлено: 13.10.21 15:18. Заголовок: Всем кому это интересно ;-)
Петр пишет: цитата: | Идея хорошая. Ждем реализацию. |
| Подготовил первый релиз-кандидат для новой сборки 21.10 с учетом обсуждения выше Кратко, что нового Скрытый текст
* Fixed: DATEPICKER control: 'Value' property returns _always_ TimeStamp type (bug was introduced in the build 21.09). * Fixed: The clause NOSHOW was ignored on a startup of the Panel windows. That's exist in the official HMG version too. * Fixed detected resource leakage in the function ShellAbout() with usage of the MiniGUI Resources control system. * Added the important optimization the use of the internal PUBLIC variables at creating of the forms and controls in the MiniGUI core with using of the new function _SetGetNamesList() which create a GLOBAL hash for a storing of the Pseudo-Global variables. Note: There ia s slight chance of regression. * Added the OOP class TIniData for managing of the values in the ini files with converting an ini file string to the desired types. * Added the macro definition for call DLL function to the header file mgdefs.h for compatibility with Official HMG. * Updated header file i_hmgcompat.ch for compatibility with Official HMG. * Updated the TSBrowse, MiniPrint, MiniPrint2, PropGrid, PropSheet, hmg_qhtm and HbSQLite3 libraries. * Added the new interesting samples and updated some examples.
| Благодарю за помощь и ваше внимание к этому проекту
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3919
Зарегистрирован: 17.02.12
|
|
Отправлено: 14.10.21 10:33. Заголовок: gfilatov2002 Предло..
gfilatov2002 Предложение поправить CLASS TControl ... METHOD SuperKeyDown( nKey, nFlags, xObj ) ... METHOD SuperKeyDown( nKey, nFlags, xObj ) CLASS TControl ... if ::bKeyDown != nil return Eval( ::bKeyDown, nKey, nFlags, xObj ) endif ... METHOD KeyDown( nKey, nFlags ) CLASS TSBrowse ... CASE ::lIgnoreKey( nKey, nFlags ) // has to go before any other case statement ::SuperKeyDown( nKey, nFlags, Self ) ... ELSEIF ::lCellBrw .AND. ( nKey == VK_COPY .OR. nKey == VK_INSERT ) uTemp := cValToChar( ::bDataEval( ::aColumns[ nCol ] ) ) CopyToClipboard( uTemp ) SysRefresh() ELSE ::SuperKeyDown( nKey, nFlags, Self ) ENDIF ... ELSE ::SuperKeyDown( nKey, nFlags, Self ) ENDIF CASE nKey == VK_HOME ... OTHERWISE ::SuperKeyDown( nKey, nFlags, Self ) ENDCASE RETURN 0 ... METHOD New( cControlName, nRow, nCol, nWidth, nHeight, bLine, aHeaders, aColSizes, cParentWnd, ; // CLASS TSBrowse ... IF HB_ISARRAY(aHeaders) .and. Len(aHeaders) > 0 .and. aHeaders[1] == NIL aHeaders := NIL ENDIF IF HB_ISARRAY(aColSel) .and. Len(aColSel) > 0 .and. aColSel[1] == NIL aColSel := NIL ENDIF IF aColors != NIL ... тогда можно делать DEFINE TBROWSE Street OBJ oBrw AT nYBrw, nXBrw ALIAS cAls WIDTH nWBrw HEIGHT nHBrw ; HEADERS aHeader ; COLORS aColors ; BACKCOLOR aBrwBC ; JUSTIFY aAlign ; SELECTOR lSelector ; FONT aFont ; COLUMNS aField ; NAMES aNames ; FOOTERS aFooter ; LOADFIELDS ; EMPTYVALUE ; GOTFOCUSSELECT ; ON INIT {|ob| Tsb_Init( ob ) } ; задавая как массив или NIL (сейчас NIL не проходит) aHeader aField и задавать объект тсб в блоке кода (сейчас его нет) :bKeyDown := { |nKey,nFalgs,ob| myKeyAction(nKey, 0, nFalgs, ob) } и делать STATIC FUNCTION myKeyAction( nKey, nValButton, nFlags, oBrw) // static\public переменная oBrw_Street не нужна LOCAL oBrw := oBrw_Street LOCAL cForm, cAlias, cSearch, lRet := .T. DEFAULT nValButton := 0, nFlags := 0 IF ! ISOBJECT(oBrw) ; RETURN .F. ENDIF cForm := oBrw:cParentWnd cAlias := oBrw:cAlias ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1938
Зарегистрирован: 11.02.10
|
|
Отправлено: 14.10.21 16:54. Заголовок: SergKis пишет: Пред..
SergKis пишет: Принято Благодарю за помощь
| |
|
Haz
|
| |
Пост N: 1787
Зарегистрирован: 20.02.11
|
|
Отправлено: 16.10.21 17:50. Заголовок: Хотел последнюю версию скачать ....
Хотел последнюю версию скачать .... на рабочий комп , по привычке набрал http://hmgextended.com/files/CONTRIB а там теперь живет Forbidden You don't have permission to access this resource. Additionally, a 403 Forbidden error was encountered while trying to use an ErrorDocument to handle the request. что то поменялось ? или это конец ?
| |
|
Dima
|
| |
Пост N: 7460
Зарегистрирован: 17.05.05
|
|
Отправлено: 16.10.21 18:40. Заголовок: Haz так вот она htt..
| |
|
Haz
|
| |
Пост N: 1788
Зарегистрирован: 20.02.11
|
|
Отправлено: 16.10.21 18:46. Заголовок: Dima пишет: так вот..
Dima пишет: а без указания конкретного релиза никак ? Список не посмотреть?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3920
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.10.21 19:17. Заголовок: Haz Может так пойде..
| |
|
Dima
|
| |
Пост N: 7461
Зарегистрирован: 17.05.05
|
|
Отправлено: 16.10.21 19:46. Заголовок: Haz пишет: а без ук..
| |
|
Haz
|
| |
Пост N: 1789
Зарегистрирован: 20.02.11
|
|
Отправлено: 16.10.21 19:53. Заголовок: Dima пишет: Можно ч..
Dima пишет: через ж... у меня Тоже не работает.
| |
|
Haz
|
| |
Пост N: 1790
Зарегистрирован: 20.02.11
|
|
Отправлено: 16.10.21 19:56. Заголовок: SergKis пишет: Може..
SergKis пишет: Так по ссылке на HMG пишет сайт не найден.💀
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3921
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.10.21 20:23. Заголовок: Haz пишет Так по ссы..
| |
|
Haz
|
| |
Пост N: 1791
Зарегистрирован: 20.02.11
|
|
Отправлено: 16.10.21 20:36. Заголовок: SergKis пишет: повт..
SergKis пишет: цитата: | повторно вошел по адресу и скачал по ссылке |
|
скинь ссылку на список. Где все версии как раньше . У меня не работает
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3922
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.10.21 20:46. Заголовок: Haz Архивные не дос..
Haz Архивные не доступны через сайт Какую надо, у мня есть, могу на ftp положить
| |
|
Dima
|
| |
Пост N: 7462
Зарегистрирован: 17.05.05
|
|
Отправлено: 16.10.21 20:48. Заголовок: Haz пишет: через ж...
Haz пишет: цитата: | через ж... у меня Тоже не работает |
| Да ладно Список конечно не весь , но всё же и потом как именуются файлы тоже понятно.
| |
|
Haz
|
| |
Пост N: 1792
Зарегистрирован: 20.02.11
|
|
Отправлено: 16.10.21 20:59. Заголовок: SergKis пишет: Архи..
SergKis пишет: цитата: | Архивные не доступны через сайт |
| Понятно. Я просто не всегда форум отслеживаю . если где требовалось пересобрать проект. Просто дергал bcc и HMG с сайта. Исходники есть у клиента. Теперь придётся и свою версию hmg в облаках держать на случай работы в полях. Плюс иногда на новой версии старый проект не собрать и из-за мелкой правки пол дня переделывать придётся
| |
|
Haz
|
| |
Пост N: 1793
Зарегистрирован: 20.02.11
|
|
Отправлено: 16.10.21 21:03. Заголовок: Dima пишет: Да ладн..
Dima пишет: цитата: | Да ладно Список конечно не весь |
|
да так работает Но последних там не будет скорее всего
| |
|
Dima
|
| |
Пост N: 7463
Зарегистрирован: 17.05.05
|
|
Отправлено: 16.10.21 21:15. Заголовок: Haz пишет: Но после..
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1939
Зарегистрирован: 11.02.10
|
|
Отправлено: 21.10.21 10:16. Заголовок: Всем кому это интересно
Опубликована новая сборка 21.10 Благодарю за помощь Сергея Киселева Желаю всем доброго здоровья и успеха в делах
| |
|
Andrey
|
| постоянный участник
|
Пост N: 7096
Зарегистрирован: 12.09.06
|
|
Отправлено: 23.10.21 10:16. Заголовок: Пере собрал нескольк..
Пере собрал несколько своих программ. Полёт нормальный ! Спасибо !
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1940
Зарегистрирован: 11.02.10
|
|
Отправлено: 27.10.21 09:44. Заголовок: Всем кому это интересно ;-)
Выложил 1-й апдейт сборки 21.10 Обновил также Unicode архив. Благодарю за помощь Андрея Верченко Желаю всем участникам форума мира и добра
| |
|
imar2
|
| |
Не зарегистрирован
Зарегистрирован: 01.01.70
|
|
Отправлено: 28.10.21 08:36. Заголовок: Здравствуйте. Прошу ..
Здравствуйте. Прошу помощи по HMG MiniGUI. У меня консольное приложение (переведено с Clipper'а). Почему-то HMG после версии 21.05 поля GET'ов на экране выделяет двоеточиями в начале и конце. Как это можно убрать и можно ли? Спасибо.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1941
Зарегистрирован: 11.02.10
|
|
Отправлено: 28.10.21 09:59. Заголовок: imar2 пишет: Как эт..
imar2 пишет: Надо добавить в самом начале главного модуля такую строку цитата: | Set( _SET_DELIMITERS, .F. ) |
|
| |
|
imar2
|
| |
Не зарегистрирован
Зарегистрирован: 01.01.70
|
|
Отправлено: 28.10.21 10:07. Заголовок: gfilatov2002, большо..
gfilatov2002, большое спасибо. Все стало ОК.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1942
Зарегистрирован: 11.02.10
|
|
Отправлено: 29.10.21 10:11. Заголовок: Всем кому это интересно
Выложил срочное обновление сборки 21.10 из-за обнаруженной досадной опечатки в коде по адресу: http://hmgextended.com/files/CONTRIB/hmg-21.10-setup.exe Что нового: Скрытый текст
* Fixed: Bug due to stupid typo in the internal function _GenActivateId() (introduced in the build 21.10). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: WebCam commands processing for compatibility with Windows 11. Warning: You should switch ON your camera in the 'Settings': go to 'Privacy & Security' and navigate to Cameras. If you want to allow apps to have access to your camera, make sure that the 'Let apps access your camera' option is enabled. Now you can select specifically which apps can access your camera. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\WebCam_2) * New: 'Draw Edge usage' sample. Based upon a contribution of Pablo Cesar Arrascaeta at HMGFORUM. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\DrawEdge)
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3926
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.10.21 13:55. Заголовок: gfilatov2002 пишет В..
gfilatov2002 пишет цитата: | Выложил срочное обновление сборки 21.10 |
| к unicode сборке это относится ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1943
Зарегистрирован: 11.02.10
|
|
Отправлено: 29.10.21 14:52. Заголовок: SergKis пишет: к un..
SergKis пишет: цитата: | к unicode сборке это относится ? |
| Да, уже обновил unicode сборку тоже. Благодарю за напоминание
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3927
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.10.21 18:07. Заголовок: gfilatov2002 пишет у..
gfilatov2002 пишет цитата: | уже обновил unicode сборку тоже |
| получаю архив 21.10 unicode, но в нем все от 26.10.21 числа, в лучшем случае
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1944
Зарегистрирован: 11.02.10
|
|
Отправлено: 29.10.21 19:34. Заголовок: SergKis пишет: полу..
SergKis пишет: цитата: | получаю архив 21.10 unicode |
| Только что проверил этот архив путем скачивания, там все в порядке. Возможно, вам стоит почистить кэш браузера
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1945
Зарегистрирован: 11.02.10
|
|
Отправлено: 03.11.21 10:35. Заголовок: Всем кому это интересно
| |
|
Andrey
|
| постоянный участник
|
Пост N: 7113
Зарегистрирован: 12.09.06
|
|
Отправлено: 08.11.21 13:41. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Выложил срочное обновление сборки 21.10 из-за обнаруженной досадной опечатки в коде |
| Перекомпилировал свою большую прогу. Теперь вылетает... Создаю на окне DEFINE TBROWSE oBrwList ; ..... FONT aTsbFont ; BACKCOLOR aBackColor2 ; GRID ; // это oBrw:lCellBrw := TRUE EDIT // все колонки с lEdit := .T. END TBROWSE CreateBrowseAbonTxt('oBrwList', ....) END WINDOW CENTER WINDOW Form_AbLst ACTIVATE WINDOW Form_AbLst _hmg_InplaceParentHandle := hParent DoMethod(cWnd, 'SetFocus') IF ! empty(cFocus) DoMethod(cWnd, cFocus, 'SetFocus') ENDIF RETURN NIL .... STATIC FUNCTION CreateBrowseAbonTxt(cTbrName,....) .... // создаём таблицу из массива oBrwA := SetArrayTo( cTbrName, cForm, aArray, aFontHF, aHead, aFSize,; aFoot, aPict, aAlign, aName ) ..... MG_Debug(cTbrName,oBrwA:cControlName) // в лог выдаёт -> oBrwList oBrwList // по правой кнопки мышки - контекстное меню TBROWSE DEFINE CONTEXT MENU CONTROL &cTbrName ..... Ошибка при работе проги: Error MGERROR/0 Form is not defined. Program terminated. Called from MSGMINIGUIERROR(0) Called from GETFORMHANDLE(0) Called from _DEFINECONTROLCONTEXTMENU(0) Called from CREATEBROWSEABONTXT(733) in module: form_dog2abon.prg Called from FORM_ABONLIST(461) in module: form_dog2abon.prg Called from DOGLISTABON(224) in module: form_dog2abon.prg Called from (b)FORM_MYTABLE(507) in module: tbrw_table.prg Called from DO_WINDOWEVENTPROCEDURE(0) Called from TWNDDATA:DOEVENT(0) Called from DO_ONWNDLAUNCH(0) Called from (b)INIT(0)
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3934
Зарегистрирован: 17.02.12
|
|
Отправлено: 08.11.21 13:56. Заголовок: Andrey пишет MG_Debu..
Andrey пишет цитата: | MG_Debug(cTbrName,oBrwA:cControlName) // в лог выдаёт -> oBrwList oBrwList |
| Что просишь (по разному), то и получаешь cTbrName, oBrwA:cControlName спроси после поправленного MG_Debug(...) ? cForm, This.Name, ThisWindow.Name, oBrwA:cParentWnd, oBrwA:cControlName Думаю, что MG_Debug(...) (окно на варианте HMG_Alert()) между DEFINE WINDOW ... и END WINDOW портит среду This, т.е. что хотел, то и получил
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1947
Зарегистрирован: 11.02.10
|
|
Отправлено: 19.11.21 11:48. Заголовок: Всем кому это интересно
Подготовил третий релиз-кандидат для новой сборки 21.11 со следующим списком изменений: Скрытый текст
* Modified: The useful functions GetDesktopRealWidth() and GetDesktopRealHeight() were defined as Public for compatibility with Official HMG. Requested by HMG user Jimmy. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo2.prg in folder \samples\Advanced\FitToDesktop) * Modified: The useful function HMG_GetLocaleInfo() was moved to MiniGUI core. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\GetUserLocaleInfo) * Enhanced: Added the read/write property 'Editable' for the GRID control. You can set/get this property at runtime as usually: Win.Grid.Editable := lValue GetProperty( Form, Grid, 'Editable' ) --> .T. | .F. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\Grid_CellNavigation) * Updated: Synchronized Extended HMG for compatibility with Official HMG: - New: Added the read/write property 'CellNavigation' for a Grid control. You can set/get this property at runtime: - function syntax: SetProperty( FormName, GridName, 'CellNavigation', lValue ) GetProperty( FormName, GridName, 'CellNavigation' ) --> .T. | .F. - pseudo-OOP syntax: FormName.GridName.CellNavigation := lValue FormName.GridName.CellNavigation --> logical value Based upon a contribution of Claudio Soto <srvet/at/adinet.com.uy>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\Grid_CellNavigation) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added mouse click and double click processing in the Special Header; - added the new variables :nBmpMaskCell, :nBmpMaskHead, :nBmpMaskFoot and :nBmpMaskSpcHd in the TSColumn class. Usage: FUNCTION SetBrwEnum( oBrw, nOneCol ) LOCAL oCol, nI, nCnt := 0 DEFAULT nOneCol := 1 FOR EACH oCol IN oBrw:aColumns nI := hb_enumindex( oCol ) oCol:cSpcHeading := NIL oCol:cSpcHeading := iif( nI == nOneCol, "#" , "+" ) IF nI > nOneCol IF oCol:lVisible oCol:cSpcHeading := hb_ntos( ++nCnt ) oCol:nBmpMaskHead := 0x00CC0020 // SRCCOPY oCol:nBmpMaskSpcHd := 0x00CC0020 // SRCCOPY ENDIF ENDIF NEXT RETURN NIL Requested by Verchenko Andrey. Contributed by Sergej Kiselev (see demo in folder \samples\Advanced\Tsb_5Win) * Updated: HBPrinter library: - pacified the warning in the C-code for compatibility with MS Visual C++ 2022 compiler. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see source in folder \Source\HBPrinter) * Updated: HbSQLite3 library: - update for using SQLITE3 latest version 3.37.0dev. Contributed by Grigory Filatov <gfilatov@inbox.ru>. * Updated: Harbour Compiler 3.2.0dev (SVN 2021-04-28 20:02): - restored support for alternative memory manager written by Doug Lea (enabled by default in Harbour). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * New: 'Working with windows and one card' sample. Note: this example will require a widescreen monitor 22"+. Contributed by Sergej Kiselev and Verchenko Andrey (see in folder \samples\Advanced\Tsb_5Win) * Updated: 'HMG Grid Demo' sample: - updated for the recent changes in the Minigui core. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\Grid_Test) * Updated: 'Center Image From Resource' sample. Based upon a contribution of Pierpaolo Martinello (see demo.prg in folder \samples\Basic\IMAGE) * Updated: 'Directory Tree' sample by Vladimir Chumachenko: - fixed handling of the file's name from the Zip archive. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\DirTree) * Updated: 'Framework for SDI application' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\FrameWork)
| Благодарю за помощь и ваше внимание к этому проекту
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3946
Зарегистрирован: 17.02.12
|
|
Отправлено: 23.11.21 17:46. Заголовок: gfilatov2002 Неболь..
gfilatov2002 Небольшое предложение по TIMER, выполнять блок кода без смены среды This h_events.prg **************************************************************************** CASE WM_TIMER **************************************************************************** i := AScan ( _HMG_aControlIds , wParam ) IF i > 0 IF _HMG_aControlPicture [ i ] == .T. // Once _DisableControl ( _HMG_aControlNames [ i ], GetParentFormName( i ) ) ENDIF IF _HMG_aControlVisible[ i ] _DoControlEventProcedure ( _HMG_aControlProcedures [ i ] , i ) ELSEIF ISBLOCK( _HMG_aControlProcedures[ i ] ) IF _HMG_BeginWindowActive == .F. .OR. _HMG_MainClientMDIHandle != 0 Eval ( _HMG_aControlProcedures[ i ] ) ENDIF ENDIF ENDIF EXIT **************************************************************************** Пример. На окне MAIN ставим TIMER, а работаем с др. окном в его событиях. Срабатывание TIMER на MAIN привод к смене на время This среды, что мешает ... DEFINE WINDOW wMain AT nY, nX WIDTH nW HEIGHT nH ; ... DEFINE TIMER Timer_1 INTERVAL 20 ACTION ( SetProperty(oMain:Name, "Timer_1", "Enabled", .F.), ; myFunc1(), SetProperty(oMain:Name, "Timer_1", "Enabled", .T.) ) This.Timer_1.Enabled := .F. // отключить до On Init _HMG_aControlVisible[ This.Timer_1.Index ] := .F. // выполнять блок кода без смены This среды ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1948
Зарегистрирован: 11.02.10
|
|
Отправлено: 23.11.21 18:09. Заголовок: SergKis пишет: выпо..
SergKis пишет: цитата: | выполнять блок кода без смены среды This |
| Принято.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3947
Зарегистрирован: 17.02.12
|
|
Отправлено: 24.11.21 12:47. Заголовок: gfilatov2002 пишет П..
gfilatov2002 пишет Добавить надо для This.Timer_1.Visible := .T.\.F. и Set\GetProperty(..., .T.\.F.) FUNCTION _ShowControl ( ControlName , ParentForm ) ... CASE T == "TIMER" OTHERWISE CShowControl ( c ) END CASE _HMG_aControlVisible [y] := .T. RETURN Nil FUNCTION _HideControl ( ControlName , ParentForm ) ... CASE T == "TIMER" OTHERWISE HideWindow ( c ) END CASE _HMG_aControlVisible [y] := .F. RETURN Nil
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1949
Зарегистрирован: 11.02.10
|
|
Отправлено: 24.11.21 13:01. Заголовок: SergKis пишет: Доба..
SergKis пишет: цитата: | Добавить надо для This.Timer_1 |
| Добавил, конечно... Благодарю за помощь
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1952
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.11.21 11:05. Заголовок: Всем кому это интересно ;-)
Опубликована новая сборка 21.11 Благодарю за помощь Сергея Киселева и Андрея Верченко Желаю всем доброго здоровья и успеха в делах P.S. Обновил также Unicode архив.
| |
|
Dima
|
| |
Пост N: 7492
Зарегистрирован: 17.05.05
|
|
Отправлено: 30.11.21 18:01. Заголовок: Andrey А сырец то с..
Andrey А сырец то смотрел ? #define MG_VERSION "Harbour MiniGUI Extended Edition 21.10.3 (" *-----------------------------------------------------------------------------* FUNCTION MiniGuiVersion( nVer ) *-----------------------------------------------------------------------------* #ifndef __XHARBOUR__ LOCAL cVer := MG_VERSION + hb_ntos( hb_Version( HB_VERSION_BITWIDTH ) ) + "-bit)" #else LOCAL cVer := MG_VERSION + iif( IsExe64(), "64", "32" ) + "-bit)" #endif LOCAL anOfs cVer += " " + HMG_CharsetName() anOfs := { Len( cVer ), 40, 15 } hb_default( @nVer, 0 ) IF nVer > 2 nVer := 2 ELSEIF nVer < 0 nVer := 0 ENDIF RETURN Left( cVer, anOfs[ nVer + 1 ] )
| |
|
Andrey
|
| постоянный участник
|
Пост N: 7146
Зарегистрирован: 12.09.06
|
|
Отправлено: 30.11.21 18:16. Заголовок: Dima пишет: А сырец..
Dima пишет: Для чего ? Мне надо в коде версию сравнивать. Допустим новый пример MiniGUI\SAMPLES\Advanced\Tsb_5Win не будет работать в старых версиях МиниГуи. Отсюда будет не заслужанные восклицания, типа автор не отладил примеры. Т.е. примерно так хотелось бы cMsg := "ВНИМАНИЕ !;" cMsg += "Для сборки требуется версия МиниГуи 21.11 или выше !;;" IF MiniGuiVersionNumba() < 211100 AlertStop(cMsg,"Checking the MiniGui version") ENDIF Вот сделал пока свою функцию так: FUNCTION MiniGuiVersionNumba() LOCAL cRegEx, cVer, aVal, nVer := 0, cVal := MiniGuiVersion() cRegEx := "\d+\.\d+[\d.]*" aVal := HB_RegEx(cRegEx, cVal) IF LEN(aVal) > 0 cVal := aVal[1] cVer := CHARREM( '.', cVal ) cVer := PADR(cVer,6,'0') nVer := VAL( cVer ) ENDIF RETURN nVer Но каждый раз таскать в примеры свою функцию не очень то и приятно. Хотя она тоже не постоянно требуется.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3948
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.11.21 18:26. Заголовок: Andrey Чем не нрави..
Andrey Чем не нравится Harbour MiniGUI Extended Edition 21.11.0 (32-bit) ANSI не пойму ? 0 - базовая сборка, будет update 1 => 21.11.1
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3949
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.11.21 18:48. Заголовок: Andrey пишет Это так..
Andrey пишет цитата: | Это так должно быть или опечатка ? |
| Думаю, что ты что то напутал с установками по каталогам или в файле BATCH\minigui.cfg пред. версия выдает Harbour MiniGUI Extended Edition 21.10.3 (32-bit) ANSI
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3950
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.11.21 19:13. Заголовок: Так я уже поставил и..
Так я уже поставил и пробую новую версию от сегодня а есть еще каталоги со старой версией сборка, там свою строку версии получаем
| |
|
Andrey
|
| постоянный участник
|
Пост N: 7149
Зарегистрирован: 12.09.06
|
|
Отправлено: 30.11.21 19:46. Заголовок: SergKis пишет: проб..
SergKis пишет: цитата: | пробую новую версию от сегодня |
| Опять недосмотрел ...
| |
|
Andrey
|
| постоянный участник
|
Пост N: 7150
Зарегистрирован: 12.09.06
|
|
Отправлено: 01.12.21 11:00. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Опубликована новая сборка 21.11 |
| Собрал свои проги. Полёт нормальный. Обратите внимание на новый пример MiniGUI\SAMPLES\Advanced\Tsb_5Win
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1953
Зарегистрирован: 11.02.10
|
|
Отправлено: 01.12.21 12:33. Заголовок: Andrey пишет: Полёт..
Andrey пишет: Благодарю за подтверждение
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3951
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.12.21 13:01. Заголовок: Andrey пишет Вот сд..
Andrey пишет цитата: | Вот сделал пока свою функцию так: FUNCTION MiniGuiVersionNumba() |
| Можно проще в свой ch (prg) файл добавить #xtranslate MiniGuiVersionChar() => Substr( MiniGuiVersion(), At(".", MiniGuiVersion()) - 2, 8 ) #xtranslate MiniGuiVersionNumba() => Int( Val( MiniGuiVersionChar() ) * 10000 + Val( Right(MiniGuiVersionChar(), 2) ) ) использовать ? "ver. =", MiniGuiVersion() ? "v.m. =", MiniGuiVersionChar() ? "numba =", MiniGuiVersionNumba()
| |
|
Andrey
|
| постоянный участник
|
Пост N: 7151
Зарегистрирован: 12.09.06
|
|
Отправлено: 01.12.21 17:34. Заголовок: SergKis пишет: Можн..
SergKis пишет: цитата: | Можно проще в свой ch (prg) файл добавить |
| Отличное решение !
| |
|
krutoff
|
| |
Пост N: 209
Зарегистрирован: 17.10.05
|
|
Отправлено: 06.12.21 17:58. Заголовок: h_windows.prg
Ситуация такая: в ONINIT формы хочу передать фокус конкретному контролу. Если окно MODAL -> все Ok, если CHILD -> то фокус всегда на 1-м контроле. Раскопал: h_windows.prg строка 1536 -> этот блок всегда возвращает взад (на 1-й контрол): IF _SetFocusedSplitChild( i ) == .F. _SetActivationFocus( i ) ENDIF В модальном окне (строка 1513 ....) такого блока нет и поэтому SetFocus в ONINIT отрабатывает. Закоментировал этот блок - и все Ok. Можно ли блок удалить (строка 1536) ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3967
Зарегистрирован: 17.02.12
|
|
Отправлено: 06.12.21 18:05. Заголовок: krutoff попробуйте ..
krutoff попробуйте SET OOP ON ... DEFINE WINDOW ... TOPMOST ; ON INIT ( This.Topmost := .F., _wPost(0) ) ... (This.Object):Event( 0, {|| This.<контрол>.SetFocus } ) ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3968
Зарегистрирован: 17.02.12
|
|
Отправлено: 06.12.21 19:04. Заголовок: gfilatov2002 Как то..
gfilatov2002 Как то не закончено с new ф-ями: GetDesktopRealTop() GetDesktopRealLeft() GetDesktopRealWidth() GetDesktopRealHeight() в однобайтной версии hmg нет GetDesktopRealTop(), GetDesktopRealLeft() в unicode версии hmg нет GetDesktopRealTop(), GetDesktopRealLeft(), GetDesktopRealWidth(), GetDesktopRealHeight() Пример unicode https://TransFiles.ru/imyut запуск с параметром Mode : demo.exe 1 demo.exe 2 demo.exe 3 demo.exe Использование новых ф-ий лучше чем Sys.ClientWidth и Sys.ClientHeight
| |
|
Петр
|
| постоянный участник
|
Пост N: 1733
Зарегистрирован: 09.10.06
|
|
Отправлено: 06.12.21 21:01. Заголовок: SergKis пишет: в од..
SergKis пишет: цитата: | в однобайтной версии hmg нет GetDesktopRealTop(), GetDesktopRealLeft() |
| А так ли они нужны? SergKis пишет: цитата: | Использование новых ф-ий лучше чем Sys.ClientWidth и Sys.ClientHeight |
| Чем?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1965
Зарегистрирован: 11.02.10
|
|
Отправлено: 06.12.21 21:13. Заголовок: SergKis пишет: в од..
SergKis пишет: цитата: | в однобайтной версии hmg нет GetDesktopRealTop(), GetDesktopRealLeft() |
| Уже добавил эти функции с использованием команды #xtranslate в заголовок hmg.ch
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3969
Зарегистрирован: 17.02.12
|
|
Отправлено: 06.12.21 21:50. Заголовок: Петр пишет Чем? Дела..
Петр пишет Делаем в примере (остальные оставляем как есть) FUNCTION wRu866() ... IF App.Cargo:nMode > 0 This.Row := 0 //GetDesktopRealTop() This.Col := 0 //GetDesktopRealLeft() This.Width := Sys.ClientWidth //GetDesktopRealWidth() This.Height := Sys.ClientHeight //GetDesktopRealHeight() //This.Maximize ENDIF ... Запускаем demo.exe 1 У меня win10 pro 14" монитор справа и снизу ~15 pixel отступы, почти в ширину VScrollBar-а Запускаем demo.exe 2 или 3 Со всех сторон есть зазор ~ 2-3 pixel Наверно, так же как GetWindowRow(hwnd), GetWindowCol(hwnd) GetClientRow(hwnd), GetClientCol(hwnd) т.е. при их наличии, если вдруг, TaskBar окажется не внизу, то что то получим в результате
| |
|
Петр
|
| постоянный участник
|
Пост N: 1735
Зарегистрирован: 09.10.06
|
|
Отправлено: 06.12.21 22:10. Заголовок: Поюзайте MiniGUI\..
Поюзайте MiniGUI\SAMPLES\BASIC\Multi_Monitor несколько раз, каждый раз меняя позицию TaskBar. И свой пример попробуйте на системе с несколькими мониторами. SystemParametersInfo( SPI_GETWORKAREA..) работает с PRIMARY дисплеем.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3970
Зарегистрирован: 17.02.12
|
|
Отправлено: 06.12.21 22:12. Заголовок: gfilatov2002 пишет У..
gfilatov2002 пишет Тут тоже надо поправить и добавить #translate <p:System,Sys>.ClientRow => #translate <p:System,Sys>.ClientCol => #translate <p:System,Sys>.ClientWidth => ( GetDesktopWidth () - GetBorderWidth () ) #translate <p:System,Sys>.ClientHeight => ( GetDesktopHeight() - GetBorderHeight() - GetTaskBarHeight() )
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1966
Зарегистрирован: 11.02.10
|
|
Отправлено: 06.12.21 22:47. Заголовок: SergKis пишет: Тут ..
SergKis пишет: цитата: | Тут тоже надо поправить и добавить |
| Сделал Благодарю за подсказку
| |
|
krutoff
|
| |
Пост N: 210
Зарегистрирован: 17.10.05
|
|
Отправлено: 07.12.21 11:24. Заголовок: SergKis Спасибо за ..
SergKis Спасибо за код, но у меня Define window CHILD ... Define Window ... Virtual PANEL ... EDITBOX И мне надо дать фокус внутри 2-й формы
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3971
Зарегистрирован: 17.02.12
|
|
Отправлено: 07.12.21 11:46. Заголовок: krutoff пишет И мне ..
krutoff пишет цитата: | И мне надо дать фокус внутри 2-й формы |
| И в чем разница ? Контролы на окне имеют уникальные имена. Вопрос, какую среду This надо в блоке кода ? Для среды This окна ON INIT {|| _wPost(10) } Для среды This контрола ON INIT {|| _wPost(10, This.<контрол>.Index) } Суть этих действий, завершить работу обработчика окна on init и организовать через очередь другое событие (обработчик) по _wPost(...), т.е. отработает IF _SetFocusedSplitChild( i ) == .F. _SetActivationFocus( i ) ENDIF потом сработает, через очередь, событие\блок кода 10, зарегистрированный на окне
| |
|
krutoff
|
| |
Пост N: 211
Зарегистрирован: 17.10.05
|
|
Отправлено: 07.12.21 13:10. Заголовок: SergKis пишет: пото..
SergKis пишет: цитата: | потом сработает, через очередь, событие\блок кода 10, зарегистрированный на окне |
| Спасибо! Отработало как часы!
| |
|
Andrey
|
| постоянный участник
|
Пост N: 7160
Зарегистрирован: 12.09.06
|
|
Отправлено: 07.12.21 13:31. Заголовок: krutoff Посмотрите ..
krutoff Посмотрите доку Сергея Events_in_MiniGui.RU.txt на русском в \MiniGUI\SAMPLES\Advanced\Tsb_5Win Ну и использование событий по тексту программы.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3972
Зарегистрирован: 17.02.12
|
|
Отправлено: 08.12.21 12:02. Заголовок: gfilatov2002 Неболь..
gfilatov2002 Небольшая правка METHOD DrawHeaders( lFooters, lDrawCell ) CLASS TSBrowse ... IF ::lDrawSpecHd ... nClrFore := ::GetValProp( nClrFore, nClrFore, nJ ) IF nI == nBegin .AND. ::lSelector nClrBacks := ::nClrSpcHdBack ELSE nClrBacks := iif( ::nPhantom == -1, ATail( ::aColumns ):nClrSpcHdBack, nClrPane ) ENDIF nClrBackS := ::GetValProp( nClrBackS, nClrBackS, nJ ) ... Сейчас SpecHeader имеет цвет SELECTOR-а nClrPane по Default, а все остальные цвета ячейки SELECTOR по вертикали ::nClrSpcHdBack (как у Header) PS Если возможно, включите в сборку последнюю версию LetoDbf, клиента и сервер
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1967
Зарегистрирован: 11.02.10
|
|
Отправлено: 08.12.21 13:28. Заголовок: SergKis пишет: Небо..
SergKis пишет: Поправил
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1968
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.12.21 10:54. Заголовок: Выложил 1-й апдейт с..
Выложил 1-й апдейт сборки 21.11 Обновил также Unicode архив. Благодарю за помощь Сергея Киселева Желаю всем участникам форума мира и добра
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3975
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.12.21 12:46. Заголовок: gfilatov2002 надо #..
gfilatov2002 надо #translate <p:System,Sys>.ClientWidth => GetDesktopRealWidth () #translate <p:System,Sys>.ClientHeight => GetDesktopRealHeight() так, как сейчас, дает отступы справа, внизу ~15 pixel, в исправленном везде зазор ~2-3 pixel
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1969
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.12.21 13:12. Заголовок: SergKis пишет: надо..
SergKis пишет: цитата: | надо #translate <p:System,Sys>.ClientWidth => GetDesktopRealWidth () #translate <p:System,Sys>.ClientHeight => GetDesktopRealHeight() |
| Понял, поправлю
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3977
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.12.21 14:31. Заголовок: gfilatov2002 пишет п..
gfilatov2002 пишет еще _TBrowse() DEFAULT aColor := { ; { CLR_FOCUSB, {|c,n,b| c := n, iif( b:nCell == n, -CLR_HRED, -RGB( 128, 225, 225 ) ) } }, ; получше вид будет PS в примере Tsb_2tsb того же эффекта можно достичь кодом без AEval(...). По умолчанию oCol:lFixLite := .T., oCol:lOnGotFocusSelect := .T., oCol:lEmptyValToChar := .T. Скрытый текст
LOCAL oTsb1, oTsb2 ... nH := Int( This.ClientHeight / 2 ) oTsb1 := oHmgData() oTsb1:aEdit := .T. oBrw1 := _TBrowse( oTsb1, "CUST1", "Brw_1", nY, nX, nW, nH ) //AEval( oBrw1:aColumns, {| oCol | oCol:lFixLite := .T., ; // oCol:lEdit := .T., ; // oCol:lOnGotFocusSelect := .T., ; // oCol:lEmptyValToChar := .T. } ) nY += nH + 1 nH -= 1 oTsb2 := oHmgData() oTsb2:aEdit := .T. oBrw2 := _TBrowse( oTsb2, "CUST2", "Brw_2", nY, nX, nW, nH ) //AEval( oBrw2:aColumns, {| oCol | oCol:lFixLite := .T., ; // oCol:lEdit := .T., ; // oCol:lOnGotFocusSelect := .T., ; // oCol:lEmptyValToChar := .T. } ) oBrw1:SetFocus()
|
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1970
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.12.21 15:59. Заголовок: SergKis пишет: еще ..
SergKis пишет: цитата: | еще _TBrowse() ... в примере Tsb_2tsb |
| Понял, уже поправил и выложил новый инсталлятор Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3980
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.12.21 16:28. Заголовок: gfilatov2002 лучше ..
gfilatov2002 лучше так STATIC FUNCTION RecordBrowse( oBrw ) LOCAL oCol, ; aArr := {} FOR EACH oCol IN oBrw:aColumns //AAdd( aArr, { oCol:cHeading, Eval( oCol:bData ) } ) AAdd( aArr, { oCol:cHeading, oBrw:GetValue( oCol ) } ) NEXT SBrowse( aArr, "Record View", {|| .T. }, { "Key", "Value" } ) RETURN NIL
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1971
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.12.21 17:33. Заголовок: SergKis пишет: лучш..
SergKis пишет: OK
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3982
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.12.21 22:00. Заголовок: gfilatov2002 Предла..
gfilatov2002 Предлагаю правку SBrowse(), что бы можно было управлять тсб и окном + иметь общую ф-ю для работы с записью из тсб, т.е. Скрытый текст
FUNCTION SBrowse( uAlias, cTitle, bSetUp, aCols, nWidth, nHeight, lSql ) // idea from xBrowse LOCAL cFormName, oBrw, nSaveSelect, cDbf, cAlias, lEdit, cTable LOCAL lbSetUp := HB_ISBLOCK( bSetUp ) DEFAULT uAlias := Alias(), ; cTitle := iif( ValType( uAlias ) == "C", uAlias, "SBrowse" ), ; bSetUp := {|| .F. }, ; aCols := {}, ; nWidth := GetSysMetrics( 0 ) * .75, ; nHeight := GetSysMetrics( 1 ) / 2, ; lSql := .F. IF ValType( uAlias ) == 'C' .AND. Select( uAlias ) == 0 nSaveSelect := Select() IF lSql cTable := GetUniqueName( "SqlTable" ) dbUseArea( .T.,, "SELECT * FROM " + uAlias, cTable,,, "UTF8" ) SELECT &cTable cAlias := cTable uAlias := cAlias ELSE cDbf := uAlias cAlias := uAlias TRY dbUseArea( .T., NIL, cDbf, cAlias, .T. ) uAlias := cAlias CATCH uAlias := { { uAlias } } END ENDIF ELSEIF ValType( uAlias ) == 'N' If ! Empty( Alias( uAlias ) ) uAlias := Alias( uAlias ) ELSE uAlias := { { uAlias } } ENDIF ELSEIF ValType( uAlias ) $ 'BDLP' uAlias := { { uAlias } } #ifdef __XHARBOUR__ ELSEIF ValType( uAlias ) == "H" uAlias := aHash2Array( uAlias ) #endif ENDIF cFormName := GetUniqueName( "SBrowse" ) DEFINE WINDOW &cFormName AT 0, 0 WIDTH nWidth HEIGHT nHeight TITLE cTitle CHILD BACKCOLOR RGB( 191, 219, 255 ) nWidth -= 20 nHeight -= 50 DEFINE TBROWSE oBrw AT 10, 10 Alias ( uAlias ) WIDTH nWidth - 16 HEIGHT nHeight - 30 HEADER aCols ; AUTOCOLS SELECTOR 20 lEdit := Eval( bSetUp, oBrw ) lEdit := iif( ValType( lEdit ) == "L", lEdit, .F. ) WITH OBJECT oBrw :nTop := 10 :nLeft := 10 :nBottom := :nTop + nHeight - 30 :nRight := :nLeft + nWidth - 16 :lEditable := lEdit :lCellBrw := lEdit :nClrLine := COLOR_GRID :nClrHeadBack := { CLR_WHITE, COLOR_GRID } :lUpdate := .T. :bRClicked := {|| Record_SBrowse( oBrw ) } IF lEdit AEval( :aColumns, {| o | o:lEdit := .T. } ) ENDIF END WITH END TBROWSE @ nHEIGHT - 12 - iif( _HMG_IsXPorLater, 3, 0 ), 10 BUTTON Btn_1 CAPTION oBrw:aMsg[ 44 ] WIDTH 70 HEIGHT 24 ; ACTION {|| oBrw:Report( cTitle,,,, .T. ), oBrw:GoTop() } @ nHEIGHT - 12 - iif( _HMG_IsXPorLater, 3, 0 ), 90 BUTTON Btn_2 CAPTION "Excel" WIDTH 70 HEIGHT 24 ; ACTION oBrw:ExcelOle() @ nHEIGHT - 12 - iif( _HMG_IsXPorLater, 3, 0 ), nWidth - 76 BUTTON Btn_3 CAPTION oBrw:aMsg[ 45 ] WIDTH 70 HEIGHT 24 ; ACTION ThisWindow.RELEASE If ! lEdit ON KEY ESCAPE ACTION ThisWindow.RELEASE ENDIF IF lbSetUp //!!! Eval( bSetUp, oBrw, .T. ) ENDIF END WINDOW CENTER WINDOW &cFormName ACTIVATE WINDOW &cFormName If ! Empty( cAlias ) ( cAlias )->( dbCloseArea() ) ENDIF If ! Empty( nSaveSelect ) Select( nSaveSelect ) ENDIF RETURN NIL // --------------------------------------------------------------------------------------------------------------------// FUNCTION Record_SBrowse( oBrw, cTitle, bSetUp, aHead, lNoCrLf ) LOCAL oCol, aArr := {}, cHdr DEFAULT cTitle := "Record View", bSetUp := {|| .T. }, aHead := { "Key", "Value" }, lNoCrLf := .T. FOR EACH oCol IN oBrw:aColumns cHdr := oCol:cHeading IF lNoCrLf .and. CRLF $ cHdr cHdr := StrTran( cHdr, CRLF, " " ) ENDIF AAdd( aArr, { cHdr, Eval( oCol:bData ) } ) NEXT SBrowse( aArr, cTitle, bSetUp, aHead ) RETURN NIL
| Задавая в FUNCTION SBrowse( uAlias, cTitle, bSetUp, aCols, nWidth, nHeight, lSql ) // idea from xBrowse в таком виде bSetUp := {|ob,xp| Local lRet := .T. IF !Empty(xp) // второй вход в блок. Можно менять размеры окна + параметры тсб по переменной ob и This. среды окна ... ENDIF Return lRet } и исп. Record_SBrowse( oBrw, cTitle, bSetUp, aHead ) как самостоятельный вызов к любому тсб. PS Назвать ф-ю можно по традиции FUNCTION _Record_SBrowse( oBrw, cTitle, bSetUp, aHead, lNoCrLf ) или FUNCTION _SBrowse_Record( oBrw, cTitle, bSetUp, aHead, lNoCrLf )
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1972
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.12.21 22:42. Заголовок: SergKis пишет: Пред..
SergKis пишет: цитата: | Предлагаю правку SBrowse() |
| Принято
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3983
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.12.21 22:56. Заголовок: gfilatov2002 пишет П..
gfilatov2002 пишет Я в тексте небольшую правку сделал, перенес вызов блока 2-ой раз еще ниже (строки //!!!) Пример сейчас делаю. Ф-ю для работы с записью назвал FUNCTION SBrowse_Record( oBrw, cTitle, bSetUp, aHead, lNoCrLf ) как приложение к основной SBrowse(), если надо пере назвать, скажите
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3984
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.12.21 01:11. Заголовок: SergKis пишет Пример..
SergKis пишет Пример тут https://TransFiles.ru/jg78m PS Еще вариант вызова в примере bSetUp := {|ob,xp| IF !Empty(xp) ob:SetNoHoles() ob:SetFocus() ENDIF Return .T. } sBrowse( Alias(), "DEMO. Test new SBrowse", bSetUp, , Sys.ClientWidth, Sys.ClientHeight )
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3985
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.12.21 09:36. Заголовок: gfilatov2002 Сделал..
gfilatov2002 Сделал др. вариант SBrowse, привязал размеры к размеру фонта Пример тут https://TransFiles.ru/7xea7 PS не оч. нравится место (может др. предложите) lRec := HB_ISARRAY( uAlias ) .and. Len( uAlias[1] ) == 2 .and. Len( aCols ) == 2 .and. ; aCols[1] == "Key" .and. aCols[2] == "Value" возможно, надо добавить MODAL окно через параметр FUNCTION SBrowse( uAlias, cTitle, bSetUp, aCols, nWidth, nHeight, lSql, lModal ) // idea from xBrowse PS2 Забыл убрать опыт, надо поправить SBrowse DEFAULT uAlias := Alias(), ; ... lSql := .F., ; bAfter := {|ob| ob:SetNoHoles(), ob:SetFocus() } ... и FUNCTION SBrowse_Record( oBrw, cTitle, bSetUp, aHead, nWidth, nHeight, lNoCrLf ) ... SBrowse( aArr, "Record View", bSetUp, { "Key", "Value" }, nWidth, nHeight ) ...
| |
|
PSP
|
| постоянный участник
|
Пост N: 1623
Зарегистрирован: 27.01.07
|
|
Отправлено: 10.12.21 10:04. Заголовок: SergKis пишет: Сдел..
SergKis пишет: Разрешите встрять) Если в примере нажать кнопку Excel, но экселя нет на компе, появляется окно с ошибкой, после закрытия которого бровс ломается.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3986
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.12.21 10:14. Заголовок: PSP пишет Если в при..
PSP пишет цитата: | Если в примере нажать кнопку Excel, но экселя нет на компе, появляется окно с ошибкой, после закрытия которого бровс ломается |
| Еще раз проверил, работает у меня и таблица и запись => все в Excel уходит, но если нет excel, надо в методе тсб добавлять проверку, но это другое , пока эти места идут, как есть.
| |
|
Ответов - 300
, стр:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
All
[только новые]
|
|
|