Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить
Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
gfilatov2002: Andrey пишет: функция определяющая тип время Попробуй использовать функцию HB_ISTIMESTAMP()
Andrey: Спасибо БОЛЬШОЕ !
SergKis: Andrey Уже публиковали, повторю https://github.com/Petewg/harbour-core/wiki
Andrey: gfilatov2002 пишет: Попробуй использовать функцию HB_ISTIMESTAMP() А можно добавить аналогично как другие hb_IsLogical, hb_IsDate, hb_IsChar , типа - hb_IsDateTime ?
SergKis: Andrey по ссылке на оглавлении hb_I смотреть не пробовал ? [pre2] ... hb_IsDateTime(<xExp>) ➜ lResult determines if <xExp> evaluates to a timestamp (valtype "T") or a date (valtype "D") value. hb_IsTimestamp(<xExp>) ➜ lResult determines if <xExp> evaluates to a timestamp (valtype "T). [/pre2]
Andrey: SergKis пишет: по ссылке на оглавлении hb_I смотреть не пробовал ? Да опять моё невнимание. Посмотрел только в CH и все... Извиняюсь...
SergKis: gfilatov2002 Небольшая недоработка в MDI с ToolBar, примеры тут https://TransFiles.ru/duv77 1. demo.exe - ToolBar на MdiMain окне - нажатие Maximize окна работает как надо ToolBar меняет размер 2. demo2.exe- ToolBar на MdiChild окне - нажатие Maximize окна работает НЕ как надо ToolBar НЕ меняет размер с тсб, то что размер не меняется, так и должно быть - нет обработчика [pre2]h_events.prg **************************************************************************** CASE WM_SIZE **************************************************************************** ... FOR i := 1 TO ControlCount IF _HMG_aControlParentHandles [ i ] == hWnd IF _HMG_aControlType [ i ] == "TOOLBAR" SendMessage ( _HMG_aControlHandles [ i ], TB_AUTOSIZE, 0, 0 ) ENDIF ENDIF NEXT i ... h_windowsmdi.prg //********************************************************************** CASE nMsg == WM_SIZE //********************************************************************** ... нет SendMessage ( _HMG_aControlHandles [ i ], TB_AUTOSIZE, 0, 0 ), как выше [/pre2] может тут причина
gfilatov2002: Выложил 2-е обновление сборки 23.02 с учетом последних исправлений и дополнений click here Благодарю Андрея Верченко и Сергея Киселева за непрерывную поддержку разработки этой библиотеки Желаю всем форумчанам здоровья и процветания
Andrey: gfilatov2002 пишет: Выложил 2-е обновление сборки 23.02 с учетом последних исправлений и дополнений Спасибо БОЛЬШОЕ Григорий за твой труд ! Народ ! Оцените код примера - MiniGUI\SAMPLES\Advanced\Tsb_array_4 Огромное СПАСИБО Сергею за его участие в создание таких примеров ! Был бы раньше такой пример, я бы по другому сделал у себя ВСЕ таблицы.
SergKis: gfilatov2002 SergKis пишет Небольшая недоработка в MDI с ToolBar Сделал как в нашей версии 1. убрал в FUNCTION MdiEvents ( hWnd, nMsg, wParam, lParam ) секцию WM_SIZE, т.е. /* //********************************************************************** CASE nMsg == WM_SIZE //********************************************************************** ... */ //********************************************************************** CASE nMsg == WM_CLOSE //********************************************************************** ... 2. h_events.prg [pre2] **************************************************************************** CASE WM_SIZE **************************************************************************** ... IF _HMG_MainClientMDIHandle != 0 IF wParam != SIZE_MINIMIZED .AND. hWnd==_HMG_MainHandle SizeClientWindow ( hWnd, _HMG_ActiveStatusHandle, _HMG_MainClientMDIHandle, r ) ENDIF ENDIF ... [/pre2] работает как надо с изменением Maximize\Normalize Main окна, но так же не работает, как и раньше, с Maximize MdiChild окна (пример 1 из архива выше)
gfilatov2002: SergKis пишет: не работает, как и раньше, с Maximize MdiChild окна Решил эту проблему в примере 2 из архива, добавив в основное окно два обработчика событий ON MAXIMIZE и ON SIZE: [pre2] DEFINE WINDOW wMain AT nY,nX WIDTH nW HEIGHT nH TITLE cTitle ; MAIN MDI TOPMOST ; BACKCOLOR {227, 238, 251} ; ON INIT {|| This.Topmost := .F., DoEvents(), _wPost(0) } ; ON MAXIMIZE {|| iif( ISNUMERIC( hSpl ), _SetWindowSizePos ( hSpl, , , This.Width ), ) } ; ON SIZE {|| iif( ISNUMERIC( hSpl ), _SetWindowSizePos ( hSpl, , , This.Width ), ) } ; ON INTERACTIVECLOSE {|| _wSend(98), This.Cargo:lCloseForm } ; ON RELEASE {|| dbCloseAll() } [/pre2] и сделал переменную hSpl типа Public в функции Main (соответственно убрал ее из функции Child_Button()): PUBLIC hSpl
SergKis: gfilatov2002 пишет Решил эту проблему в примере 2 из архива, добавив в основное окно два обработчика событий ON MAXIMIZE и ON SIZE: С самим MdiChild окном - все ясно (надо обработчики, лучше спрятать во внутрь, а не прописывать каждому окну). Изменения про которые писал выше, касаются только притягивания StatusBar и ToolBar к размеру MdiMain окна (Maximize\Normalize кнопка), в 1-м и во втором примерах (до изменений работало правильно только во 2-м примере, в 1-м нет). А но так же не работает, как и раньше, с Maximize MdiChild окна (пример 1 из архива выше) относится к 1-му примеру, т.е. запускаем, жмем, например, кнопку 3, получаем MdiChild окно, жмем кнопку Maxmize этого окна и получаем .... Тут тоже вопрос есть. Как выполнять Maximize ? Приводить все MdiChild окна к режиму Maximize или делать MdiChild окно в размер реальной клиентской области MdiMain окна ? PS В своей версии режим работы 1-го примера не используем в работе MDI, все только в режиме 2-го примера, т.е. всем MdiChild окнам (в lib загнали) делается This.Maximize, т.е. всегда видим только одно окно (под ним могут быть др. MdiChild окна, можно их видимость переключать) + Modal окна как в примере 2-а. Как показала практика - этого достаточно
gfilatov2002: Выложил 3-е обновление сборки 23.02 с учетом последних исправлений и дополнений click here Это последнее обновление библиотеки, дальнейшая ее разработка и поддержка поставлены на паузу... Благодарю за ваше внимание.
Andrey: Григорий, можно в h_tbrowse.prg в METHOD ExcelOle(...) поменять местами строки ? [pre2] IF bExtern != NIL Eval( bExtern, oSheet, Self ) ENDIF oRange:Borders():LineStyle := xlContinuous oRange:Columns:AutoFit() Сделать так: oRange:Borders():LineStyle := xlContinuous oRange:Columns:AutoFit() IF bExtern != NIL Eval( bExtern, oSheet, Self ) ENDIF [/pre2] Дело в том что [pre2]oRange:Columns:AutoFit() // автоматически поменять ширину всех столбцов и высоту всех строк // в диапазоне, чтобы туда уместился текст ячеек.[/pre2] А я хочу менять ширину колонок.
Haz: Andrey пишет: А я хочу менять ширину колонок. Гораздо полезнее если метод будет опционально возвращать oExcel вне зависимости от установки lActivate. Тогда делать можно что угодно с созданным объектом. Ps. Повторюсь, метод на любителя. Скорее как пример работы с оле , чем реально требующийся.
Andrey: gfilatov2002 пишет: Выложил 3-е обновление сборки 23.02 с учетом последних исправлений и дополнений Перешёл на него, отдельные проекты собираются. Перестал работать ехе-ник моей большой системы. Собирается, запускается, в лог чуток пишет и выходит без ошибки ! Совсем выходит, без запуска MAIN окна. Откатился на 23.01 - прога собирается и запускается нормально... Что такого нового в этом обновление ?
gfilatov2002: gfilatov2002 пишет: Это последнее обновление библиотеки Завершается подготовка 4-го и последнего обновления сборки 23.02 Что нового: * New: Added the new C-function IsHIcon( hIcon ) --> lIsHIcon to check if the given parameter is a pointer to an icon. This function is already used in the Minigui core. Contributed by Grigory Filatov <gfilatov@gmail.com> * New: Added HbLibXlsxWriter library by Fausto Di Creddo Trautwein for creating new Excel XLSX files. Based upon the Libxlsxwriter C library of John McNamara. Adapted for Minigui Extended by Grigory Filatov (see source in folder \Source\hblibxlsxwriter) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - minor corrections in the method UpStable(). Investigated and contributed by Igor Nazarov (see demo in folder \samples\Advanced\TSBrowse) * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.41.2 (from 3.41.1). Contributed by Grigory Filatov <gfilatov@gmail.com> * New: 'HyperLinks and Labels usage' sample. Based upon a contribution of Pablo Cesar Arrascaeta at HMGFORUM. Adapted for Minigui Extended by Grigory Filatov (see in folder \samples\Basic\HYPERLINK_2) * Updated: 'Usage of the built-in ZIP support of Windows' sample: - modified for archiving to the Backup subfolder. Contributed by Grigory Filatov <gfilatov@gmail.com> (see in folder \samples\Basic\Zip_4) * Updated: 'HbLibXlsxWriter library test' samples: - update for using libxlsxwriter version 1.1.5 (from 0.7.5). Contributed by Grigory Filatov <gfilatov@gmail.com> (see in folder \samples\Advanced\HbXlsxWriter) Если у вас есть дополнения к этой сборке, то я с удовольствием рассмотрю их Желаю всем доброго здоровья (SergKis) и благодарю за ваше внимание.
Andrey: gfilatov2002 пишет: Если у вас есть дополнения к этой сборке, то я с удовольствием рассмотрю Отправил на почту.
SergKis: gfilatov2002 Спасибо за пожелание. Всем его желаю. Такую правку предлагаю.[pre2] FUNCTION _EndTBrowse( bEnd ) ... IF i > 0 oBrw := _HMG_aControlIds[ i ] IF Len(oBrw:aColumns) > 0 oc := ATail(oBrw:aColumns) oBrw:oPhant:nClrHeadBack := oc:nClrHeadBack oBrw:oPhant:nClrFootBack := oc:nClrFootBack oc := NIL ENDIF oBrw:lRePaint := .T. ... что бы не писать END TBROWSE ON END {|ob,oc| ob:SetNoHoles(), oc := ATail(ob:aColumns), ; ob:oPhant:nClrHeadBack := oc:nClrHeadBack, ; ob:oPhant:nClrFootBack := oc:nClrFootBack, ; ob:Refresh(), ob:SetFocus() } [/pre2]
gfilatov2002: SergKis пишет: правку предлагаю Принято, но с поправкой. SergKis пишет: ... oBrw := _HMG_aControlIds[ i ] IF Len(oBrw:aColumns) > 0 oc := ATail(oBrw:aColumns) oBrw:oPhant:nClrHeadBack := oc:nClrHeadBack oBrw:oPhant:nClrFootBack := oc:nClrFootBack oc := NIL ENDIF oBrw:lRePaint := .T. Поскольку в этот момент колонка oPhant не определена, переписал эту правку таким образом: [pre2] ... oBrw:lRePaint := .T. oBrw:Display() IF Len( oBrw:aColumns ) > 0 .AND. ! Empty( oBrw:oPhant ) oc := ATail( oBrw:aColumns ) oBrw:oPhant:nClrHeadBack := oc:nClrHeadBack oBrw:oPhant:nClrFootBack := oc:nClrFootBack oc := NIL ENDIF ... [/pre2]
SergKis: gfilatov2002 Немного поправил, получилось [pre2] *-----------------------------------------------------------------------------* FUNCTION _EndTBrowse( bEnd ) *-----------------------------------------------------------------------------* LOCAL i, k, n, oBrw LOCAL oc := NIL, ow := NIL #ifdef _OBJECT_ ow := oDlu2Pixel() #endif IF _HMG_BeginTBrowseActive i := AScan( _HMG_aControlHandles, _HMG_ActiveTBrowseHandle ) IF i > 0 oBrw := _HMG_aControlIds[ i ] oBrw:lRePaint := .T. oBrw:Display() IF ( k := Len(oBrw:aColumns) ) > 0 .AND. ! Empty( oBrw:oPhant ) oc := ATail(oBrw:aColumns) n := iif( ValType( oc:nClrHeadBack ) == "B", Eval( oc:nClrHeadBack, k, oBrw ), oc:nClrHeadBack ) oBrw:oPhant:nClrHeadBack := n n := iif( ValType( oc:nClrFootBack ) == "B", Eval( oc:nClrFootBack, k, oBrw ), oc:nClrFootBack ) oBrw:oPhant:nClrFootBack := n oBrw:Refresh() oc := NIL ENDIF [/pre2]
gfilatov2002: SergKis пишет: Немного поправил OK, принято Благодарю за помощь
gfilatov2002: Выложил 4-е обновление сборки 23.02 с учетом последних исправлений и дополнений click here Благодарю за многолетнюю поддержку и помощь в разработке этого проекта: Сергея Киселева, Игоря Назарова и Андрея Верченко. Также я признателен Саше Савову из Болгарии. До новых встреч
SergKis: gfilatov2002 пишет Выложил 4-е обновление сборки 23.02 - minor corrections in the method UpStable(). [pre2] ::lPainted := ::lInitGoTop IF ::lPainted .AND. ::bChange != NIL Eval( ::bChange, Self, VK_UP ) ENDIF ::bChange := NIL ::lHitTop := .F. ::lHitBottom := .F. ::GoTop() ::lPainted := .T. While !( ::cAlias )->( Eof() ) [/pre2] Получается, что прорисовку теперь в :UpStable() нельзя отключить. Наверно, такую возможность надо было оставить, сделать [pre2] LOCAL nRow := ::nRowPos, ; ... bChange := ::bChange, ; nLastPos := ::nLastPos, ; lPainted := ::lPainted ... ::GoTop() ::lPainted := lPainted While !( ::cAlias )->( Eof() ) [/pre2] PS Только сейчас обратил внимание, что HB_FUNC( RCDATATOFILE ) HB_FUNC( RCDATATOMEM ) достают только из ресурсов своего exe, а из dll внешней - нет, HMODULE hModule = GetResources(); может есть смысл брать, если задан параметр из него hModule брать
gfilatov2002: SergKis пишет: такую возможность надо было оставить, сделать LOCAL nRow := ::nRowPos, ; ... bChange := ::bChange, ; nLastPos := ::nLastPos, ; lPainted := ::lPainted ... ::GoTop() ::lPainted := lPainted While !( ::cAlias )->( Eof() ) Да, так будет лучше Благодарю за подсказку P.S. Уже поправил эту неточность в инсталляторе текущей сборки P.S.2 Обновил также Unicode архив этой сборки для Сергея...
gfilatov2002: По ходу добавил возможность отображения на кнопке PNG файлов с альфа-каналом. На картинке ниже видно, как выглядят кнопки в нормальном и отключенном виде. Кстати, сегодня исполнилось ровно 170 лет со дня рождения Ван Гога...
SergKis: gfilatov2002 пишет Обновил также Unicode архив этой сборки для Сергея... Спасибо , уже взял
Andrey: gfilatov2002 пишет: Обновил также Unicode архив этой сборки для Сергея А я тоже хочу....
Haz: SergKis пишет: bChange := ::bChange, ; nLastPos := ::nLastPos, ; lPainted := ::lPainted ... ::GoTop() ::lPainted := lPainted в новой версии как моргал при редактировании ::Upstable() так и моргает в ::GoTop() влетаем со включенным ::lPainted и это вызывает прорисовку , простое решение перед ::Gotop() выключить а после него включить. У себя такую правку делаю, чтоб не править везде bPre(Post)Edit. Но если никто не жалуется , значит не востребовано. PS или во все методы навигации добавлять параметр , например ::Gotop( lRefresh ) по умолчанию включено.
SergKis: Haz пишет в новой версии как моргал при редактировании ::Upstable() так и моргает в ::GoTop() влетаем со включенным ::lPainted и это вызывает прорисовку , простое решение перед ::Gotop() выключить а после него включить. У себя такую правку делаю, чтоб не править везде bPre(Post)Edit. Но если никто не жалуется , значит не востребовано Моргать и должно, ситуация не менялась от пред. версии. То что не востребовано, согласен, т.к. заметно на "тяжелых" таблицах, а таких раз, два и все. Мест, где надо править bPostEdit (отключить :lPainted) с зависимыми строками по Row, от произведенного Edit, тоже мало, так что это не вызывает трудностей. Делать ::Gotop( lRefresh ), по мне так совсем не катит, лишнее. Если доберусь до переделки VO прогр., где таблица с откл. стандартным поведением клавиш перемещения (назначены свои блоки кода), то попробую после 1-го отображения откл. ::lPainted и вкл.\выкл. в своих блоках кода на клавишах перемещения. Но программа VO работает и пока острой замены не требует.
Haz: SergKis пишет: заметно на "тяжелых" таблицах, а таких раз, два и все. заметно на простой таблице при работе со слабой сеткой. Ну а все невостребованные решения я и так делаю заменой методов на внешние, так что править bPostEdit нужды нет. У остальных , при необходимости трудностей видимо не вызовет
Andrey: gfilatov2002 пишет: По ходу добавил возможность отображения на кнопке PNG файлов с альфа-каналом. А где этот красивый пример ?
gfilatov2002: Andrey пишет: где этот красивый пример ? Это пример из папки SAMPLES\BASIC\BUTTON_4 для будущих сборок, поскольку требуется также изменение в ядре библиотеки. Если же интересует текст сырцов самого примера, то он приведен ниже. [pre]/* * MINIGUI - Harbour Win32 GUI library */ #include "minigui.ch" FUNCTION Main() LOCAL aBtn, n LOCAL cPngPath := ".\images\" LOCAL aPng := {} AEval( { 3, 1, 2, 6, 7, 8, 9, 10 }, {| c | ; AAdd( aPng, cPngPath + "image" + hb_ntos( c ) + ".png" ) } ) aBtn := Array( Len( aPng ) ) DEFINE WINDOW Form_1 ; AT 0, 0 ; WIDTH 80 + 70 * Len( aPng ) ; HEIGHT 430 ; MAIN ; TITLE 'Disabled Buttons Test' ; NOSIZE ; NOMAXIMIZE @ 40, 40 LABEL Lbl_1 VALUE "ENABLED BUTTONS NORMAL LOOK" AUTOSIZE FOR n := 1 TO Len( aPng ) aBtn[ n ] := "Btn1_" + hb_ntos( n ) DEFINE BUTTON &( aBtn[ n ] ) ROW 70 COL n * 70 - 30 ACTION NIL PICTURE aPng[ n ] WIDTH 64 HEIGHT 64 END BUTTON NEXT @ 150, 40 LABEL Lbl_2 VALUE "LOADED PICTURES NORMAL LOOK" AUTOSIZE FOR n := 1 TO Len( aPng ) aBtn[ n ] := "Img2_" + hb_ntos( n ) DEFINE IMAGE &( aBtn[ n ] ) ROW 180 COL n * 70 - 20 ACTION NIL PICTURE aPng[ n ] WIDTH 48 HEIGHT 48 STRETCH .T. IF n == 4 HEIGHT 55 ENDIF END IMAGE NEXT @ 260, 40 LABEL Lbl_3 VALUE "DISABLED BUTTONS" AUTOSIZE FOR n := 1 TO Len( aPng ) aBtn[ n ] := "Btn3_" + hb_ntos( n ) DEFINE BUTTON &( aBtn[ n ] ) ROW 290 COL n * 70 - 30 ACTION NIL PICTURE aPng[ n ] WIDTH 64 HEIGHT 64 END BUTTON Form_1.&( aBtn[ n ] ).Enabled := .F. NEXT END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 RETURN NIL [/pre]
Andrey: Ждём с не терпеньем - этот пример !
Andrey: Пример MiniGUI\SAMPLES\Advanced\AESDEMO Не собирается...[pre2] Harbour 3.2.0dev (r2301231146) Copyright (c) 1999-2023, https://harbour.github.io/ D:\TEMP\hbmk_bh65r7.dir\aesdemo.c: D:\TEMP\hbmk_12kx7d.c: Turbo Incremental Link 5.66 Copyright (c) 1997-2002 Borland Error: Unresolved external '_HB_FUN_ENCRYPTFILEAES' referenced from D:\TEMP\HBMK_BH65R7.DIR\AESDEMO.OBJ Error: Unresolved external '_HB_FUN_DECRYPTFILEAES' referenced from D:\TEMP\HBMK_BH65R7.DIR\AESDEMO.OBJ hbmk2[aesdemo]: Error: Running linker. 2[/pre2] Откуда брать эти функции ?
Dima: Andrey пишет: Откуда брать эти функции ? HBAES
SergKis: Andrey build.bat запусти в примере (в нем написано)
Andrey: SergKis пишет: build.bat запусти в примере (в нем написано) Не сообразил сразу. Начал как всегда запускать Compile.bat Спасибо !
gfilatov2002: Попробовал добавить иконки приложений в список запущенных задач в примере из папки SAMPLES\Advanced\PROCESS_TERMINATOR И вот что у меня получилось:
Andrey: Классное решение ! Пример в новую библиотеку !
gfilatov2002: Выложил апрельскую сборку 23.04 с учетом последних исправлений и дополнений click here Что нового (кратко): [pre2]* Fixed: Revised a releasing of the COMBOBOXEX control (a bug has been introduced since the first implementation of this control). * Enhanced: Standard IMAGE BUTTON control supports normal display of the PNG images with alpha channel. * Enhanced: The GetBox control additionally supports Ctrl+Z hotkey to undo the current value when editing. * Enhanced: Added a new optional clause IMAGESIZE <w>, <h> to the COMBOBOXEX control (similar to ButtonEx control). The alternative syntax is IMAGEWIDTH <w> and IMAGEHEIGHT <h>. * Enhanced: MENUITEM command supports optional clause ICON <icon> in the context menu. * Enhanced: Added description of OS error value in the ErrorLog file using the new GetOSErrorDescription( <nError> ) function. * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - fixed incorrect use of the SetMsg() method in the TSBrowse class when TBROWSE was defined without a MESSAGE clause. * Updated: HbZipArc library source code: - added new function hb_IsZipFile( <cFilename> ) for a quick test to determine if a file is a ZIP file. * Updated: PageScript 32 library: - update for using PageScript DLL 4.0.1.157 (from 4.0.1.144). * Updated: Harbour Compiler 3.2.0dev (SVN 2023-04-21 13:01). * Updated some Basic and Advanced samples. [/pre2] Желаю всем мирного неба над головой Берегите себя!
SergKis: gfilatov2002 пишет Выложил апрельскую сборку 23.04 с учетом последних исправлений и дополнений Unicode сборка будет ?
gfilatov2002: SergKis пишет: Unicode сборка Выложил Unicode сборку по известному адресу. Что нового: - добавил новый пример GOOGLE7 для перевода слов (или предложения) на шесть европейских языков с помощью сервиса Google Translate
SergKis: gfilatov2002 Спасибо, забрал
Andrey: На новой версии МиниГуи мой большой проект собрался и работает ! Классно !!!
gfilatov2002: Подготовил 1-е обновление для сборки 23.04, которое планируется опубликовать на следующей неделе Что нового: [pre2] * Enhanced: New GetCPUInfo() function was used in the Error logging routine. Contributed by Grigory Filatov <gfilatov@gmail.com> (see demo in folder \samples\Basic\ShowDetailError) * Enhanced: Added a new optional clause HOTKEY <KeyName> to the CREATE LINK FILE command. Contributed by Grigory Filatov <gfilatov@gmail.com> (see demo in folder \samples\Basic\CreateLink) * Updated: Unneeded casting of the C-code was removed in some places. Contributed by Grigory Filatov <gfilatov@gmail.com> * Updated: Added use of low-level resource management system to C code of CreateGradientBrush() function. Contributed by Grigory Filatov <gfilatov@gmail.com> (see demo in folder \samples\Advanced\SetThemes) * Updated: HBPrinter library: - further parameter substitution in C-code using macros from the header file mgdefs.h. Contributed by Grigory Filatov <gfilatov@gmail.com> (see source in folder \Source\HBPrinter) * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.42.0 (from 3.41.2). Contributed by Grigory Filatov <gfilatov@gmail.com> * Updated: 'Tree Menu' sample: added useful function TreeItemGetPathValue ( ControlName, ParentForm, nItem ). Adapted for Minigui Extended by Grigory Filatov (see in folder \samples\Basic\TreeMenu_2) * Updated: 'PageScript 32 test' sample: - update external app Viewer.exe to version 1.2 (from 1.0). Contribution of Richard Visscher <richard/at/irvis.com> (see in folder \samples\Advanced\PageScript) [/pre2] До новых встреч
gfilatov2002: Всем кому это интересно Выложил 1-е обновление сборки 23.04 с учетом последних исправлений и дополнений click here Желаю всем мира и добра
gfilatov2002: Выложил 2-е обновление сборки 23.04 с учетом последних исправлений и дополнений Что нового: [pre2] * Enhanced: Added the OOP class TThrData for managing objects in the thread. Suggested and contributed by Sergej Kiselev (see demo3.prg in folder \samples\Advanced\ShellExec) * Updated: Harbour Compiler 3.2.0dev (SVN 2023-05-19 16:29): * Fixed: do not generate warnings for undeclared methods when -w[12] is used. Contributed by Przemyslaw Czerpak <druzus/at/priv.onet.pl> (look at ReadMe.txt in folder \harbour) * New: 'FTP Navigator' sample based upon CURL library. Note: this example requires curl.dll. Based upon a contribution of HMG user Edward. Adapted for Minigui Extended by Jozef Rudnicki (see in folder \samples\Advanced\FtpNavigator) * New: 'Read xlsx files without using OLE, libraries, etc' sample. Don't miss this very interesting example! Based upon a contribution of HMG user Edward (see in folder \samples\Advanced\ReadXLSX) * Updated: 'Horizontal radio group with variable items width' sample: - updated with the latest changes in the Minigui core. Contributed by Grigory Filatov <gfilatov@gmail.com> (see in folder \samples\Basic\RadioGroup_nofixed) * Updated: 'ShellExecuteEx() and WaitForSingleObject() usage' sample. Contributed by Sergej Kiselev and Verchenko Andrey (see in folder \samples\Advanced\ShellExec) * Updated: 'Monthly calendar with date stamp at runtime' sample: - changed color theme. Contributed by Grigory Filatov <gfilatov@gmail.com> (see demo2.prg in folder \samples\Advanced\Tsb_calendar) [/pre2] Скачать До новых встреч
Andrey: Как можно это сообщение сделать чтобы запускался AlertStop() вместо MsgStop() ? [pre2] _HMG_MESSAGE[4] := "Попытка запуска второй копии программы:" + CRLF + ; App.ExeName + CRLF + ; "Отказано в запуске !" + CRLF + _HMG_MESSAGE[4] SET MULTIPLE OFF WARNING[/pre2]
Andrey: Григорий, а можно написать в группу Harbour что глючит последняя версия ? И когда будет новая версия Харбора ?
gfilatov2002: Andrey пишет: Как можно это сообщение сделать чтобы запускался AlertStop() вместо MsgStop() ? Можно сделать таким образом: [pre2]#translate SET ALERT MULTIPLE <x:ON,OFF> [ <warning: WARNING> ] ; => ; _HMG_lMultiple := ( Upper(<(x)>) == "ON" ) ; iif ( _HMG_lMultiple == .F. .AND. _HMG_IsMultiple == .T. , ( iif ( <.warning.> , AlertStop( _HMG_MESSAGE\[4\] ) , ) , ExitProcess() ) , ) [/pre2]
gfilatov2002: Andrey пишет: написать в группу Harbour что глючит последняя версия Это бесполезно, поскольку компилятор BCC не является приоритетным для Харбора. Таким рекомендуемым Си-компилятором является изначально бесплатный MinGW.
Andrey: gfilatov2002 пишет: Можно сделать таким образом: Не получается... Всё равно выходит MsgStop() ! Можно другую команду придумать ? Чтобы не делать всякие #translate Типа такой или другой: SET ALERTMULTIPLE OFF WARNING
SergKis: Andrey пишет Всё равно выходит MsgStop() ! Создавай DlgFont и ВСЕГДА окно MAIN в режиме hide (Title можешь делать рабочий, потом переустанавливать) будет работать AlertStop() и другие Alert... после этого можешь выходить или _SplashWindow() делать со считыванием данных настроек и т.д. это если хочешь общаться. При повторных запусках (хоть закликайся мышкой) делаю выход из проги без разговоров\сообщений PS. Схема такая, например [pre2] LOCAL nStartPost := 0 ... IF OnlyOneInstance( cAppTitle ) // .T. - 2-ой запуск nStartPost := 98 ENDIF ... DEFINE WINDOW ... MAIN ... NOSHOW ... ; ON INIT {|| DoEvents(), _wPost(nStartPost) } ; ... o := This.Object o:Event( 0, {|ow| _SplashWindow(ow, ...) }) ... o:Event(98, {|| AlertStop(...), _wSend(99) }) o:Event(99, {|ow| ow:Release() }) ... [/pre2]
SergKis: gfilatov2002 пишет Можно сделать таким образом: #translate SET ALERT MULTIPLE <x:ON,OFF> [ <warning: WARNING> ] ; => ; _HMG_lMultiple := ( Upper(<(x)>) == "ON" ) ; iif ( _HMG_lMultiple == .F. .AND. _HMG_IsMultiple == .T. , ( iif ( <.warning.> , AlertStop( _HMG_MESSAGE\[4\] ) , ) , ExitProcess() ) , ) Зачем так сложно ? Достаточно, что то такое [pre2] #translate SET EXIT MULTIPLE [ <warning: WARNING> ] ; => ; _HMG_lMultiple := !Empty( _HMG_IsMultiple ) ; iif ( _HMG_lMultiple , ( iif ( <.warning.> , AlertStop( _HMG_MESSAGE\[4\] ) , ) , ExitProcess() ) , ) [/pre2] использовать для выхода второго запуска с сообщением SET EXIT MULTIPLE WARNING или для выхода без сообщения SET EXIT MULTIPLE или такую команду #translate SET MULTIPLE QUIT [ <warning: WARNING> ] ; ...
gfilatov2002: SergKis пишет: #translate SET MULTIPLE QUIT [ <warning: WARNING> ] Благодарю за помощь! Добавил эту команду в следующее обновление, но дата его выхода неизвестна.
Andrey: Возвращаюсь к вопросу управления иконок в кнопке. Можно ли как то иконку сдвигать влево, если текст расположен справа в кнопке ? Большие иконки 96х96 просто двигают текст направо и он обрезается. Можно ли как то повлиять на данную ситуацию.
gfilatov2002: Andrey пишет: Можно ли как то повлиять на данную ситуацию Можно, например, использовать другую кнопку HMGBUTTON (размер картинки 128х128), как показано ниже. Вот полный текст этого примера: [pre2] #include "minigui.ch" Procedure Main DEFINE WINDOW Win1 ; AT 0,0 ; WIDTH 550 ; HEIGHT 450 ; TITLE 'Custom Component Demo' ; MAIN DEFINE MAIN MENU DEFINE POPUP 'Test' MENUITEM 'Custom Method: SetFocus' ACTION Win1.Test.SetFocus MENUITEM 'Custom Method: Disable' ACTION Win1.Test.Disable MENUITEM 'Custom Method: Enable' ACTION Win1.Test.Enable MENUITEM 'Custom Property: Handle (Get)' ACTION MsgInfo ( Win1.Test.Handle ) MENUITEM 'Custom Property: Handle (Set)' ACTION Win1.Test.Handle := 1 MENUITEM 'Custom Property: Caption (Get)' ACTION MsgInfo ( Win1.Test.Caption ) MENUITEM 'Custom Property: Caption (Set)' ACTION Win1.Test.Caption := 'New Caption' MENUITEM 'Custom Property: Picture (Get)' ACTION MsgInfo ( Win1.Test.Picture ) MENUITEM 'Custom Property: Picture (Set)' ACTION Win1.Test.Picture := 'button.png' END POPUP END MENU @ 10 , 10 HMGBUTTON test ; OF Win1 ; CAPTION 'Left Align Button' ; PICTURE "hmg.png" ; WIDTH 280 ; HEIGHT 180 ; ACTION MsgInfo('Click! 1') LEFT @ 200 , 10 HMGBUTTON test2 ; OF Win1 ; CAPTION 'Right Align Button' ; PICTURE "hmg.png" ; WIDTH 280 ; HEIGHT 180 ; ACTION MsgInfo('Click! 2') RIGHT @ 10 , 300 HMGBUTTON test3 ; OF Win1 ; CAPTION 'Top Picture Align Button' ; PICTURE "hmg.png" ; WIDTH 220 ; HEIGHT 180 ; ACTION MsgInfo('Click! 3') TOP @ 200 , 300 HMGBUTTON test4 ; OF Win1 ; CAPTION 'Bottom Picture Align Button' ; PICTURE "hmg.png" ; WIDTH 220 ; HEIGHT 180 ; ACTION MsgInfo('Click! 4') BOTTOM END WINDOW Win1.Test.SetFocus CENTER WINDOW Win1 ACTIVATE WINDOW Win1 Return [/pre2]
Andrey: Спасибо ! Буду пробовать.
SergKis: gfilatov2002 Небольшие добавки [pre2] CLASS TWNDDATA ... ACCESS Enabled INLINE IsWindowEnabled ( ::nHandle ) ASSIGN Enabled( xVal ) INLINE iif( Empty( xVal ), DisableWindow ( ::nHandle ), EnableWindow ( ::nHandle ) ) METHOD Enabler( cName, xVal ) INLINE SetProperty( ::cName, cName, "Enabled", !Empty(xVal) ) ... *-----------------------------------------------------------------------------* FUNCTION Do_Obj( nHandle, bBlock, p1, p2, p3 ) *-----------------------------------------------------------------------------* LOCAL o IF HB_ISCHAR( nHandle ) nHandle := GetFormHandle( nHandle ) ENDIF IF hmg_IsWindowObject( nHandle ) o := hmg_GetWindowObject( nHandle ) IF ISBLOCK( bBlock ) IF o:IsWindow // set the environment This window RETURN Do_WindowEventProcedure ( bBlock, o:Index, o, p1, p2, p3 ) ELSE // set the environment This control RETURN Do_ControlEventProcedure( bBlock, o:Index, o, p1, p2, p3 ) ENDIF ELSEIF bBlock != NIL // do not change the environment This RETURN o:Event( bBlock, o, p1, p2, p3 ) // bBlock - execution key ENDIF ENDIF RETURN o [/pre2]
gfilatov2002: SergKis пишет: Небольшие добавки Принято
SergKis: gfilatov2002 Предлагаю добавить для dbf use shared и режима :lRowPosAtRec := .T. обновление первой записи на экране, т.к. при ее модификации (в потоке или др. пользователем) буфер RDD остается прежним, не соответствующим записи на диске, т.е. [pre2] CLASS TSBrowse FROM TControl ... DATA lShared AS LOGICAL INIT .F. // dbf file opened shared at .T. ... METHOD SetDbf( cAlias ) CLASS TSBrowse ... IF "ADS" $ ::cDriver ... ELSE ... ::lShared := ( cAlias )->( dbInfo( 36 ) ) // DBI_SHARED 36 /* the file opened shared ? */ ENDIF ... METHOD Refresh( lPaint, lRecount, lClearHash ) CLASS TSBrowse LOCAL nOldRec ... ::lNoPaint := .F. IF ::lIsDbf .and. ::nLen > 0 .and. ::lShared .and. ::lRowPosAtRec .and. HB_ISARRAY( ::aRowPosAtRec ) IF Len( ::aRowPosAtRec ) > 0 nOldRec := ( ::cAlias )->( RecNo() ) ( ::cAlias )->( dbGoto( ::aRowPosAtRec[ 1 ] ) ) IF nOldRec != ::aRowPosAtRec[ 1 ] ( ::cAlias )->( dbGoto( nOldRec ) ) ENDIF ENDIF ENDIF RETURN ::Super:Refresh( lPaint ) [/pre2]
gfilatov2002: SergKis пишет: добавить для dbf use shared и режима :lRowPosAtRec := .T. обновление первой записи на экране Принято с благодарностью Сейчас готовлю 3-е обновление для сборки 23.04
SergKis: gfilatov2002 Немного изменить код выше с :lRowPosAtRec (для удобного использования) [pre2] CLASS TSBrowse FROM TControl ... ACCESS nAtPos INLINE iif( ::lIsDbf, ( ::cAlias )->( RecNo() ), ::nAt ) ACCESS IsRowPosAtRec INLINE ( ::lIsDbf .AND. ::nLen > 0 .AND. ::lRowPosAtRec .AND. HB_ISARRAY( ::aRowPosAtRec ) .AND. Len( ::aRowPosAtRec ) > 0 ) ... METHOD Refresh( lPaint, lRecount, lClearHash ) CLASS TSBrowse ... IF ::IsRowPosAtRec .and. ::lShared nOldRec := ( ::cAlias )->( RecNo() ) ( ::cAlias )->( dbGoto( ::aRowPosAtRec[ 1 ] ) ) IF nOldRec != ::aRowPosAtRec[ 1 ] ( ::cAlias )->( dbGoto( nOldRec ) ) ENDIF ENDIF ... [/pre2]
gfilatov2002: SergKis пишет: Немного изменить код выше Понял, добавил этот код
SergKis: gfilatov2002 Был не прав с :IsRowPosAtRec , работает и с массивом ( ::aRowPosAtRec[ xRow ] := ( nAt := ::nAtPos ) ), надо поправить [pre2] ACCESS IsRowPosAtRec INLINE ( ::lIsDbf .AND. ::nLen > 0 .AND. ::lRowPosAtRec .AND. HB_ISARRAY( ::aRowPosAtRec ) .AND. Len( ::aRowPosAtRec ) > 0 ) и IF ::lIsDbf .and. ::lShared .and. ::IsRowPosAtRec nOldRec := ( ::cAlias )->( RecNo() ) ... [/pre2]
gfilatov2002: SergKis пишет: надо поправить Поправил, конечно. Благодарю за помощь
gfilatov2002: Выложил 3-е обновление сборки 23.04 с учетом последних исправлений и дополнений Скачать Обновил также Unicode архив этой сборки для Сергея... Ну вот и все
SergKis: gfilatov2002 Возникла путаница Было b := This.(cBtn).Action ... This.(cBtn).Action := b Теперь b := This.(cBtn).Action не работает, т.к. (i_this.ch) стало #xtranslate This . <c> . <p:Refresh,SetFocus,DeleteAllItems,Release,Show,Save,Hide,Play,Stop,Close,Pause,Eject,OpenDialog,Resume,Action,OnClick,OnGotFocus,OnLostFocus,OnChange,OnDblClick,OnEnter,ColumnsAutoFit,ColumnsAutoFitH> [()] => DoMethod ( _HMG_THISFORMNAME, <(c)> , <"p"> ) ... #xtranslate This . <c> . <p:ReadOnly,DisableEdit,Options,Spacing,Speed,Volume,Zoom,Action,OnClick,OnGotFocus,OnLostFocus,OnChange,OnDblClick,OnEnter> := <n> => SetProperty ( _HMG_THISFORMNAME, <(c)> , <"p"> , <n> ) ... т.е. This.(cBtn).Action := b работает, как и b := GetProperty(cWnd, cBtn, "Action") ... SetProperty(cWnd, cBtn, "Action", b)
gfilatov2002: SergKis пишет: Возникла путаница Поправил, прошу проверить результат ниже: [pre2]/*---------------------------------------------------------------------------- MINIGUI - Harbour Win32 GUI library source code Copyright 2002-2010 Roberto Lopez <harbourminigui@gmail.com> http://harbourminigui.googlepages.com/ This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this software; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). As a special exception, you have permission for additional uses of the text contained in this release of Harbour Minigui. The exception is that, if you link the Harbour Minigui library with other files to produce an executable, this does not by itself cause the resulting executable to be covered by the GNU General Public License. Your use of that executable is in no way restricted on account of linking the Harbour-Minigui library code into it. Parts of this project are based upon: "Harbour GUI framework for Win32" Copyright 2001 Alexander S.Kresin <alex@kresin.ru> Copyright 2001 Antonio Linares <alinares@fivetech.com> www - https://harbour.github.io/ "Harbour Project" Copyright 1999-2023, https://harbour.github.io/ "WHAT32" Copyright 2002 AJ Wos <andrwos@aust1.net> "HWGUI" Copyright 2001-2021 Alexander S.Kresin <alex@kresin.ru> ---------------------------------------------------------------------------*/ // WINDOWS (THIS) #xtranslate This . <p:Title,Parent,NotifyIcon,NotifyTooltip,Cursor,FocusedControl,MinHeight,MinWidth,MaxHeight,MaxWidth,TitleBar,SysMenu,Sizable,Closable,MaxButton,MinButton,Visible,Enabled,Topmost,HelpButton,Object> => GetProperty ( _HMG_THISFORMNAME , <"p"> ) #xtranslate This . <p:Title,NotifyIcon,NotifyTooltip,Cursor,MinHeight,MinWidth,MaxHeight,MaxWidth,TitleBar,SysMenu,Sizable,Closable,MaxButton,MinButton,Visible,Enabled,Topmost,HelpButton> := <arg> => SetProperty ( _HMG_THISFORMNAME , <"p"> , <arg> ) #xtranslate This . <p:OnInit,OnRelease,OnInterActiveClose,OnNotifyClick,OnMouseClick,OnMouseDrag,OnMouseMove,OnMove,OnSize,OnMaximize,OnMinimize,OnPaint,OnRestore,OnDropFiles> := <arg> => SetProperty ( _HMG_THISFORMNAME , <"p"> , <arg> ) #xtranslate This . <p:Activate,Center,Release,Maximize,Minimize,Restore> [()] => DoMethod ( _HMG_THISFORMNAME , <"p"> ) #xtranslate This . <p:Names,Controls> => HMG_GetFormControls ( _HMG_THISFORMNAME , "ALL" ) #xtranslate This . <c> . <p:Names> => HMG_GetFormControls ( _HMG_THISFORMNAME , <(c)> ) #xtranslate This . <c> . <p:ClientWidth> => _GetClientRect ( GetControlHandle ( <(c)> , _HMG_THISFORMNAME ) ) \[3] #xtranslate This . <c> . <p:ClientHeight> => _GetClientRect ( GetControlHandle ( <(c)> , _HMG_THISFORMNAME ) ) \[4] #xtranslate This . <c> . <p:Value,Name,Handle,Type,Index,Address,BackColor,BackgroundColor,FontColor,Picture,Icon,HBitmap,ToolTip,FontName,FontSize,FontBold,FontUnderline,FontItalic,FontStrikeOut,Caption,Row,DisplayValue,Col,Width,Height,Visible,Enabled,Checked,ItemCount,RangeMin,RangeMax,Cargo,Tabstop,ColumnCOUNT> => GetProperty ( _HMG_THISFORMNAME, <(c)> , <"p"> ) #xtranslate This . <c> . <p:Value,Name,Address,BackColor,BackgroundColor,FontColor,Picture,Icon,HBitmap,ToolTip,FontName,FontSize,FontBold,FontUnderline,FontItalic,FontStrikeOut,Caption,Row,DisplayValue,Col,Width,Height,Visible,Enabled,Checked,ItemCount,RangeMin,RangeMax,Cargo,Tabstop> := <n> => SetProperty ( _HMG_THISFORMNAME, <(c)> , <"p"> , <n> ) #xtranslate This . <c> . <p:ListWidth,Position,CaretPos,ForeColor,AllowAppend,AllowDelete,AllowEdit,InputItems,DisplayItems,FormatString,Indent,Linecolor,ItemHeight,ValidMessage,AutoFont,RichValue,Alignment,CaseConvert,Transparent,CueBanner,GradientFill,GradientOver,Object,ImageWidth,ImageHeight> => GetProperty ( _HMG_THISFORMNAME, <(c)> , <"p"> ) #xtranslate This . <c> . <p:ListWidth,Position,CaretPos,ForeColor,AllowAppend,AllowDelete,AllowEdit,Blink,InputItems,DisplayItems,FormatString,Indent,Linecolor,ItemHeight,ValidMessage,AutoFont,RichValue,Alignment,CaseConvert,Transparent,ColumnWidthLimits,CueBanner,GradientFill,GradientOver,Increment,ImageWidth,ImageHeight> := <n> => SetProperty ( _HMG_THISFORMNAME, <(c)> , <"p"> , <n> ) #xtranslate This . <c> . <p:Caption,Header,Image,Item,Icon,ToolTip,Width,ColumnWidth,Enabled,RichValue,HeaderImage,CheckboxItem,Cargo,Increment,ColumnDISPLAYPOSITION> (<arg>) => GetProperty ( _HMG_THISFORMNAME, <(c)> , <"p"> , <arg> ) #xtranslate This . <c> . <p:Velocity> := <n> => SetProperty ( _HMG_THISFORMNAME, <(c)> , "Velocity" , <n> ) #xtranslate This . <c> . <p:Caption,Header,Image,Item,Icon,ToolTip,Width,ColumnWidth,Enabled,RichValue,CheckboxItem,Cargo,ColumnDISPLAYPOSITION> (<arg>) := <n> => SetProperty ( _HMG_THISFORMNAME, <(c)> , <"p"> , <arg> , <n> ) #xtranslate This . <c> . <p:Cell> (<arg1> , <arg2>) => GetProperty ( _HMG_THISFORMNAME, <(c)> , <"p"> , <arg1> , <arg2> ) #xtranslate This . <c> . <p:Cell> (<arg1> , <arg2>) := <n> => SetProperty ( _HMG_THISFORMNAME, <(c)> , <"p"> , <arg1> , <arg2> , <n> ) #xtranslate This . <c> . <p:HeaderImage> (<arg1>) := <arg2> => SetProperty ( _HMG_THISFORMNAME, <(c)> , <"p"> , <arg1> , <arg2> ) #xtranslate This . <c> . <p:HeaderImage> (<arg1>) := {<arg2> , <arg3>} => SetProperty ( _HMG_THISFORMNAME, <(c)> , <"p"> , <arg1> , <arg2> , <arg3> ) #xtranslate This . <c> . <p:Refresh,SetFocus,DeleteAllItems,Release,Show,Save,Hide,Play,Stop,Close,Pause,Eject,OpenDialog,Resume,Action,OnClick,OnGotFocus,OnLostFocus,OnChange,OnDblClick,OnEnter,ColumnsAutoFit,ColumnsAutoFitH> [()] => DoMethod ( _HMG_THISFORMNAME, <(c)> , <"p"> ) #xtranslate This . <c> . <p:AddItem,DeleteItem,Open,DeletePage,DeleteColumn,Expand,Collapse,Seek,ColumnAutoFit,ColumnAutoFitH> (<a>) => Domethod ( _HMG_THISFORMNAME, <(c)> , <"p"> , <a> ) #xtranslate This . <c> . <p:AddItem,AddPage> (<a1> , <a2> ) => Domethod ( _HMG_THISFORMNAME, <(c)> , <"p"> , <a1> , <a2> ) #xtranslate This . <c> . <p:AddItem,AddPage> (<a1> , <a2> , <a3> ) => Domethod ( _HMG_THISFORMNAME, <(c)> , <"p"> , <a1> , <a2> , <a3> ) #xtranslate This . <c> . <p:AddItem,AddColumn,AddControl,AddPage> (<a1> , <a2> , <a3> , <a4> ) => Domethod ( _HMG_THISFORMNAME, <(c)> , <"p"> , <a1> , <a2> , <a3> , <a4> ) #xtranslate This . <c> . <p:ReadOnly,DisableEdit,Options,Spacing,Length> => GetProperty ( _HMG_THISFORMNAME, <(c)> , <"p"> ) #xtranslate This . <c> . <p:ReadOnly,DisableEdit,Options,Spacing,Speed,Volume,Zoom,OnClick,OnGotFocus,OnLostFocus,OnChange,OnDblClick,OnEnter> := <n> => SetProperty ( _HMG_THISFORMNAME, <(c)> , <"p"> , <n> ) #xtranslate This . <x> . <c> . <p:Caption,Enabled,Value> => GetProperty ( _HMG_THISFORMNAME , <(x)> , <(c)> , <"p"> ) #xtranslate This . <x> . <c> . <p:Caption,Enabled,Value> := <n> => SetProperty ( _HMG_THISFORMNAME , <(x)> , <(c)> , <"p"> , <n> ) #xtranslate This . <x> (<k>) . <c> . <p:Value,Name,Address,BackColor,FontColor,Picture,ToolTip,FontName,FontSize,FontBold,FontItalic,FontUnderline,FontStrikeOut,Caption,Row,DisplayValue,Col,Width,Height,Visible,Enabled,Checked,ItemCount,RangeMin,RangeMax,Cargo> => GetProperty ( _HMG_THISFORMNAME, <(x)> , <k> , <(c)> , <"p"> ) #xtranslate This . <x> (<k>) . <c> . <p:Value,Name,Address,BackColor,FontColor,Picture,ToolTip,FontName,FontSize,FontBold,FontItalic,FontUnderline,FontStrikeOut,Caption,Row,DisplayValue,Col,Width,Height,Visible,Enabled,Checked,ItemCount,RangeMin,RangeMax,Cargo> := <n> => SetProperty ( _HMG_THISFORMNAME , <(x)> , <k> , <(c)> , <"p"> , <n> ) #xtranslate This . <x> (<k>) . <c> . <p:ListWidth,Position,CaretPos,ForeColor,RichValue> => GetProperty ( _HMG_THISFORMNAME, <(x)> , <k> , <(c)> , <"p"> ) #xtranslate This . <x> (<k>) . <c> . <p:ListWidth,Position,CaretPos,ForeColor,RichValue> := <n> => SetProperty ( _HMG_THISFORMNAME , <(x)> , <k> , <(c)> , <"p"> , <n> ) #xtranslate This . <x> (<k>) . <c> . <p:Caption,Header,Item,Icon,RichValue,CheckboxItem> (<arg>) => GetProperty ( _HMG_THISFORMNAME, <(x)> , <k> , <(c)> , <"p"> , <arg> ) #xtranslate This . <x> (<k>) . <c> . <p:Caption,Header,Item,Icon,RichValue,CheckboxItem> (<arg>) := <n> => SetProperty ( _HMG_THISFORMNAME, <(x)> , <k> , <(c)> , <"p"> , <arg> , <n> ) #xtranslate This . <x> (<k>) . <c> . <p:Refresh,SetFocus,DeleteAllItems,Release,Show,Save,Hide,Play,Stop,Close,Pause,Eject,OpenDialog,Resume,Action,OnClick,OnGotFocus,OnLostFocus,OnChange,OnDblClick,OnEnter> [()] => DoMethod ( _HMG_THISFORMNAME, <(x)> , <k> , <(c)> , <"p"> ) #xtranslate This . <x> (<k>) . <c> . <p:AddItem,DeleteItem,Open,DeletePage,DeleteColumn,Expand,Collapse,Seek> (<a>) => Domethod ( _HMG_THISFORMNAME, <(x)> , <k> , <(c)> , <"p"> , <a> ) #xtranslate This . <x> (<k>) . <c> . <p:AddItem,AddPage> (<a1> , <a2>) => Domethod ( _HMG_THISFORMNAME, <(x)> , <k> , <(c)> , <"p"> , <a1> , <a2> ) #xtranslate This . <x> (<k>) . <c> . <p:AddItem,AddPage> (<a1> , <a2> , <a3> ) => Domethod ( _HMG_THISFORMNAME, <(x)> , <k> , <(c)> , <"p"> , <a1> , <a2> , <a3> ) #xtranslate This . <x> (<k>) . <c> . <p:AddItem,AddColumn,AddControl,AddPage> (<a1> , <a2> , <a3> , <a4> ) => Domethod ( _HMG_THISFORMNAME, <(x)> , <k> , <(c)> , <"p"> , <a1> , <a2> , <a3> , <a4> ) #xtranslate This . <x> (<k>) . <c> . <p:Length,Options,Spacing> => GetProperty ( _HMG_THISFORMNAME, <(x)> , <k> , <(c)> , <"p"> ) #xtranslate This . <x> (<k>) . <c> . <p:ReadOnly,DisableEdit,Options,Spacing,Speed,Volume,Zoom> := <n> => SetProperty ( _HMG_THISFORMNAME, <(x)> , <k> , <(c)> , <"p"> , <n> ) #xtranslate This . <x> (<k>) . <c> . <p:Cell> (<arg1> , <arg2>) => GetProperty ( _HMG_THISFORMNAME, <(x)> , <k> , <(c)> , <"p"> , <arg1> , <arg2> ) #xtranslate This . <x> (<k>) . <c> . <p:Cell> (<arg1> , <arg2>) := <n> => SetProperty ( _HMG_THISFORMNAME, <(x)> , <k> , <(c)> , <"p"> , <arg1> , <arg2> , <n> ) #xtranslate This . SplitBox . <c> . <p:Value,Name,Address,BackColor,FontColor,Picture,ToolTip,FontName,FontSize,FontBold,FontItalic,FontUnderline,FontStrikeOut,Caption,Row,DisplayValue,Col,Width,Height,Visible,Enabled,Checked,ItemCount,RangeMin,RangeMax,Position,CaretPos,ForeColor,AllowEdit,Object,InputItems,DisplayItems,Cargo> => GetProperty ( _HMG_THISFORMNAME, "SplitBox" , <(c)> , <"p"> ) #xtranslate This . SplitBox . <c> . <p:Value,Name,Address,BackColor,FontColor,Picture,ToolTip,FontName,FontSize,FontBold,FontItalic,FontUnderline,FontStrikeOut,Caption,Row,DisplayValue,Col,Width,Height,Visible,Enabled,Checked,ItemCount,RangeMin,RangeMax,Position,CaretPos,ForeColor,AllowEdit,Blink,InputItems,DisplayItems,Cargo> := <n> => SetProperty ( _HMG_THISFORMNAME, "SplitBox" , <(c)> , <"p"> , <n> ) #xtranslate This . SplitBox . <c> . <p:AllowAppend,AllowDelete,DisableEdit,ReadOnly> => GetProperty ( _HMG_THISFORMNAME, "SplitBox", <(c)> , <"p"> ) #xtranslate This . SplitBox . <c> . <p:AllowAppend,AllowDelete,DisableEdit,ReadOnly> := <n> => SetProperty ( _HMG_THISFORMNAME, "SplitBox", <(c)> , <"p"> , <n> ) #xtranslate This . SplitBox . <c> . <p:Caption,Header,Item,Icon,HeaderImages,CheckboxItem> (<arg>) => GetProperty ( _HMG_THISFORMNAME, "SplitBox", <(c)> , <"p"> , <arg> ) #xtranslate This . SplitBox . <c> . <p:Caption,Header,Item,Icon,HeaderImages,CheckboxItem> (<arg>) := <n> => SetProperty ( _HMG_THISFORMNAME, "SplitBox", <(c)> , <"p"> , <arg> , <n> ) #xtranslate This . SplitBox . <c> . <p:Cell> (<arg1> , <arg2>) => GetProperty ( _HMG_THISFORMNAME, "SplitBox", <(c)> , <"p"> , <arg1> , <arg2> ) #xtranslate This . SplitBox . <c> . <p:Cell> (<arg1> , <arg2>) := <n> => SetProperty ( _HMG_THISFORMNAME, "SplitBox", <(c)> , <"p"> , <arg1> , <arg2> , <n> ) #xtranslate This . SplitBox . <c> . <p:Refresh,SetFocus,DeleteAllItems,Release,Show,Save,Hide,Play,Stop,Close,Pause,Eject,OpenDialog,Resume,Action,OnClick,OnGotFocus,OnLostFocus,OnChange,OnDblClick,OnEnter> [()] => DoMethod ( _HMG_THISFORMNAME, "SplitBox", <(c)> , <"p"> ) #xtranslate This . SplitBox . <c> . <p:AddItem,DeleteItem,Open,DeletePage,DeleteColumn,Expand,Collapse,Seek> (<a>) => Domethod ( _HMG_THISFORMNAME, "SplitBox", <(c)> , <"p"> , <a> ) #xtranslate This . SplitBox . <c> . <p:AddItem,AddPage> (<a1> , <a2>) => Domethod ( _HMG_THISFORMNAME, "SplitBox", <(c)> , <"p"> , <a1> , <a2> ) #xtranslate This . SplitBox . <c> . <p:AddItem,AddPage> (<a1> , <a2> , <a3> ) => Domethod ( _HMG_THISFORMNAME, "SplitBox", <(c)> , <"p"> , <a1> , <a2> , <a3> ) #xtranslate This . SplitBox . <c> . <p:AddItem,AddColumn,AddControl,AddPage> (<a1> , <a2> , <a3> , <a4> ) => Domethod ( _HMG_THISFORMNAME, "SplitBox", <(c)> , <"p"> , <a1> , <a2> , <a3> , <a4> ) #xtranslate This . SplitBox . <c> . <p:Name,Length> => GetProperty ( _HMG_THISFORMNAME, "SplitBox", <(c)> , <"p"> ) #xtranslate This . SplitBox . <c> . <p:ReadOnly,DisableEdit,Speed,Volume,Zoom> := <n> => SetProperty ( _HMG_THISFORMNAME, "SplitBox", <(c)> , <"p"> , <n> ) #xtranslate This . SplitBox . <x> . <c> . <p:Caption,Enabled,Value> => GetProperty ( _HMG_THISFORMNAME , "SplitBox" , <(x)> , <(c)> , <"p"> ) #xtranslate This . SplitBox . <x> . <c> . <p:Caption,Enabled,Value> := <n> => SetProperty ( _HMG_THISFORMNAME , "SplitBox", <(x)> , <(c)> , <"p"> , <n> ) // WINDOWS (THISWINDOW) #xtranslate ThisWindow . <p:Title,Parent,NotifyIcon,NotifyTooltip,Cursor,FocusedControl,BackColor,Name,Handle,Type,Index,Row,Col,Width,Height,MinHeight,MinWidth,MaxHeight,MaxWidth,TitleBar,SysMenu,Sizable,Closable,MaxButton,MinButton,Visible,Enabled,Topmost,HelpButton,Cargo,Object> => GetProperty ( _HMG_THISFORMNAME , <"p"> ) #xtranslate ThisWindow . <p:Title,NotifyIcon,NotifyTooltip,Cursor,BackColor,Row,Col,Width,Height,MinHeight,MinWidth,MaxHeight,MaxWidth,TitleBar,SysMenu,Sizable,Closable,MaxButton,MinButton,Visible,Enabled,Topmost,HelpButton,Cargo> := <arg> => SetProperty ( _HMG_THISFORMNAME , <"p"> , <arg> ) #xtranslate ThisWindow . <p:OnInit,OnRelease,OnInterActiveClose,OnGotFocus,OnLostFocus,OnNotifyClick,OnMouseClick,OnMouseDrag,OnMouseMove,OnMove,OnSize,OnMaximize,OnMinimize,OnPaint,OnRestore,OnDropFiles> := <arg> => SetProperty ( _HMG_THISFORMNAME , <"p"> , <arg> ) #xtranslate ThisWindow . <p:AlphaBlendTransparent,BackColorTransparent> := <arg> => SetProperty ( _HMG_THISFORMNAME , <"p"> , <arg> ) #xtranslate ThisWindow . <p:Activate,Center,EnableUpdate,DisableUpdate,Redraw,Release,Maximize,Minimize,Restore,Show,Hide,SetFocus> [ () ] => DoMethod ( _HMG_THISFORMNAME , <"p"> ) #xtranslate ThisWindow . <p:Names,Controls> => HMG_GetFormControls ( _HMG_THISFORMNAME , "ALL" ) #xtranslate ThisWindow . <p:ClientWidth> => _GetClientRect ( GetFormHandle ( _HMG_THISFORMNAME ) ) \[3] #xtranslate ThisWindow . <p:ClientHeight> => _GetClientRect ( GetFormHandle ( _HMG_THISFORMNAME ) ) \[4] // CONTROLS // RichEditBox ( by Dr. Claudio Soto, January 2014 ) #xtranslate ThisRichEditBox . <p: GetClickLinkRange,GetClickLinkText> => GetProperty ( _HMG_THISFORMNAME , _HMG_THISCONTROLNAME , <"p"> ) * Property without arguments #xtranslate This . <p:FontColor,ForeColor,Value,ReadOnly,DisableEdit,Options,Spacing,Address,Picture,Icon,HBitmap,Tooltip,FontName,FontSize,FontBold,FontItalic,FontUnderline,FontStrikeout,Caption,Displayvalue,Visible,Enabled,Checked,ItemCount,RangeMin,RangeMax,Length,Position,CaretPos,Alignment,CaseConvert,Transparent,CueBanner,GradientFill,GradientOver,Increment,ImageWidth,ImageHeight,ColumnCOUNT,FormatString> => GetProperty ( _HMG_THISFORMNAME , _HMG_THISCONTROLNAME , <"p"> ) #xtranslate This . <p:FontColor,ForeColor,Value,ReadOnly,DisableEdit,Options,Spacing,Address,Picture,Icon,HBitmap,Tooltip,FontName,FontSize,FontBold,FontItalic,FontUnderline,FontStrikeout,Caption,DisplayValue,Visible,Enabled,Checked,RangeMin,RangeMax,Repeat,Speed,Volume,Zoom,Position,CaretPos,Action,Blink,Alignment,CaseConvert,Transparent,ColumnWidthLimits,CueBanner,GradientFill,GradientOver,Increment,ImageWidth,ImageHeight,FormatString> := <arg> => SetProperty ( _HMG_THISFORMNAME , _HMG_THISCONTROLNAME , <"p"> , <arg> ) * Property with 1 argument #xtranslate This . <p:Item,Caption,Header,Icon,Width,ColumnWidth,ColumnDISPLAYPOSITION,Enabled> (<n>) => GetProperty ( _HMG_THISFORMNAME , _HMG_THISCONTROLNAME , <"p"> , <n> ) #xtranslate This . <p:Item,Caption,Header,Icon,Width,ColumnWidth,ColumnDISPLAYPOSITION,Enabled> (<n>) := <arg> => SetProperty ( _HMG_THISFORMNAME , _HMG_THISCONTROLNAME , <"p"> , <n> , <arg> ) #xtranslate This . <p:ColumnCONTROL,ColumnDYNAMICBACKCOLOR,ColumnDYNAMICFORECOLOR,ColumnJUSTIFY,ColumnVALID,ColumnWHEN,ColumnVALIDMESSAGE,ColumnONHEADCLICK,HeaderDYNAMICFONT,HeaderDYNAMICBACKCOLOR,HeaderDYNAMICFORECOLOR> (<n>) => GetProperty ( _HMG_THISFORMNAME , _HMG_THISCONTROLNAME , <"p"> , <n> ) #xtranslate This . <p:ColumnCONTROL,ColumnDYNAMICBACKCOLOR,ColumnDYNAMICFORECOLOR,ColumnJUSTIFY,ColumnVALID,ColumnWHEN,ColumnVALIDMESSAGE,ColumnONHEADCLICK,HeaderDYNAMICFONT,HeaderDYNAMICBACKCOLOR,HeaderDYNAMICFORECOLOR> (<n>) := <arg> => SetProperty ( _HMG_THISFORMNAME , _HMG_THISCONTROLNAME , <"p"> , <n> , <arg> ) * Property with 2 arguments #xtranslate This . <p:Cell> ( <n1> , <n2> ) => GetProperty ( _HMG_THISFORMNAME , _HMG_THISCONTROLNAME , <"p"> , <n1> , <n2> ) #xtranslate This . <p:Cell> ( <n1> , <n2> ) := <arg> => SetProperty ( _HMG_THISFORMNAME , _HMG_THISCONTROLNAME , <"p"> , <n1> , <n2> , <arg> ) * Method without arguments #xtranslate This . <p:Redraw,Refresh,DeleteAllItems,Release,Play,Stop,Close,PlayReverse,Pause,Eject,OpenDialog,Resume,Save,GetArray,EnableUpdate,DisableUpdate,Action,OnClick,OnGotFocus,OnLostFocus,OnChange,OnDblClick,OnEnter,ColumnAutoFit,ColumnAutoFitH> [ () ] => DoMethod ( _HMG_THISFORMNAME , _HMG_THISCONTROLNAME , <"p"> ) * Method with 1 argument #xtranslate This . <p:AddItem,DeleteItem,Open,Seek,SetArray,DeletePage,DeleteColumn,Expand,Collapse> (<arg>) => DoMethod ( _HMG_THISFORMNAME , _HMG_THISCONTROLNAME , <"p"> , <arg> ) * Method with 2 arguments #xtranslate This . <p:AddItem,AddPage> ( <arg1> , <arg2> ) => DoMethod ( _HMG_THISFORMNAME , _HMG_THISCONTROLNAME , <"p"> , <arg1> , <arg2> ) * Method with 3 arguments #xtranslate This . <p:AddItem,AddPage> ( <arg1>,<arg2>,<arg3> ) => DoMethod ( _HMG_THISFORMNAME , _HMG_THISCONTROLNAME , <"p"> , <arg1> , <arg2> , <arg3> ) * Method with 4 arguments #xtranslate This . <p:AddItem,AddControl,AddColumn,AddPage> ( <arg1> , <arg2> , <arg3> , <arg4> ) => DoMethod ( _HMG_THISFORMNAME , _HMG_THISCONTROLNAME , <"p"> , <arg1> , <arg2> , <arg3> , <arg4> ) // COMMON ( REQUIRES TYPE CHECK ) #xtranslate This . <p:Name,Handle,Type,Index,Row,Col,Width,Height,BackColor,Cargo,Object> => iif ( _HMG_THISType == 'C' , GetProperty ( _HMG_THISFORMNAME , _HMG_THISCONTROLNAME , <"p"> ) , GetProperty ( _HMG_THISFORMNAME , <"p"> ) ) #xtranslate This . <p:Row,Col,Width,Height,BackColor,Cargo> := <arg> => iif ( _HMG_THISType == 'C' , SetProperty ( _HMG_THISFORMNAME , _HMG_THISCONTROLNAME , <"p"> , <arg> ) , SetProperty ( _HMG_THISFORMNAME , <"p"> , <arg> ) ) #xtranslate This . <p:Show,Hide,SetFocus> [ () ] => iif ( _HMG_THISType == 'C' , DoMethod ( _HMG_THISFORMNAME , _HMG_THISCONTROLNAME , <"p"> ) , DoMethod ( _HMG_THISFORMNAME , <"p"> ) ) #xtranslate This . <p:ClientWidth> => _GetClientRect ( iif ( _HMG_THISType == 'C' , GetControlHandle ( _HMG_THISCONTROLNAME , _HMG_THISFORMNAME ) , GetFormHandle ( _HMG_THISFORMNAME ) ) ) \[3] #xtranslate This . <p:ClientHeight> => _GetClientRect ( iif ( _HMG_THISType == 'C' , GetControlHandle ( _HMG_THISCONTROLNAME , _HMG_THISFORMNAME ) , GetFormHandle ( _HMG_THISFORMNAME ) ) ) \[4] // EVENT PROCEDURES #xtranslate This . QueryRowIndex => _HMG_THISQueryRowIndex #xtranslate This . QueryColIndex => _HMG_THISQueryColIndex #xtranslate This . QueryData => _HMG_THISQueryData #xtranslate This . CellRowIndex => _HMG_THISItemRowIndex #xtranslate This . CellColIndex => _HMG_THISItemColIndex #xtranslate This . CellRow => _HMG_THISItemCellRow #xtranslate This . CellCol => _HMG_THISItemCellCol #xtranslate This . CellWidth => _HMG_THISItemCellWidth #xtranslate This . CellHeight => _HMG_THISItemCellHeight #xtranslate This . CellValue => _HMG_THISItemCellValue #xtranslate This . CellValue := <arg> => _SetGridCellEditValue ( <arg> ) // INPLACE EDIT GRID EVENT #xtranslate This . InplaceEditControlHandle => _HMG_GridInplaceEdit_ControlHandle #xtranslate This . InplaceEditControlIndex => _HMG_GridInplaceEdit_GridIndex #xtranslate This . InplaceEditGridName => iif( _HMG_GridInplaceEdit_GridIndex > 0, _HMG_aControlNames \[ _HMG_GridInplaceEdit_GridIndex ], "" ) #xtranslate This . InplaceEditParentName => iif( _HMG_GridInplaceEdit_GridIndex > 0, GetParentFormName( _HMG_GridInplaceEdit_GridIndex ), "" ) #xtranslate This . IsInplaceEditEventInit => ( _HMG_GridInplaceEdit_StageEvent == 1 ) #xtranslate This . IsInplaceEditEventRun => ( _HMG_GridInplaceEdit_StageEvent == 2 ) #xtranslate This . IsInplaceEditEventFinish => ( _HMG_GridInplaceEdit_StageEvent == 3 ) [/pre2]
SergKis: gfilatov2002 пишет прошу проверить Проверил, с new i_this.ch ошибка компиляции на строке This.(cBtn).Action := b Пример тут https://TransFiles.ru/r516c строки помечены (начало) //!!! new i_this.ch PS. такое же как i_this.ch содержимое i_window.ch
gfilatov2002: SergKis пишет: с new i_this.ch ошибка компиляции на строке Да, у меня такая же ошибка в этой строке. Поэтому вернул старый i_this.ch обратно. SergKis пишет: такое же как i_this.ch содержимое i_window.ch Именно так Я снова проверил эти определения для свойства Action, и они все используют вызов функции DoMethod() Поэтому для вашего случая надо использовать вызов b := GetProperty(cWnd, cBtn, "Action") как и сделано в вашем примере.
SergKis: gfilatov2002 тогда немного не логично в названиях, т.е. далее идут списком как события OnClick,On..., и к ним Domethod () подходит, а Action выпадает (для события OnAction название подходит). #xtranslate This . <c> . <p:...,Action,OnClick,OnGotFocus,OnLostFocus,OnChange,OnDblClick,... Может тогда сделать дополнительно OnAction,Click,GotFocus,LostFocus,Change,DblClick => Get\SetProperty(...) Получается установить можем This.(cBtn).Action := b а прочитать, в таком же синтаксисе, нет b := This.(cBtn).Action
gfilatov2002: SergKis пишет: Получается установить можем This.(cBtn).Action := b а прочитать, в таком же синтаксисе, нет b := This.(cBtn).Action Согласен. Но для Минигуи основным синтаксисом является Get\SetProperty(...) Кстати, в официальной версии HMG вообще не существует определений свойства Action для синтаксиса This
SergKis: gfilatov2002 пишет Кстати, в официальной версии HMG вообще не существует определений свойства Action для синтаксиса This Там много чего удобного нет, потому и не используем ее. А товарищ пошел дальше и обвязал в MiniGui все _Define... объектами и пишет как в VO (привычка), а oHMG - слабоват был на 2011 г.
SergKis: gfilatov2002 Добавил в i_this.ch [pre2] #xtranslate This . <c> . Event . <p:Action,OnClick,OnGotFocus,OnLostFocus,OnChange,OnDblClick,OnEnter> => GetProperty ( _HMG_THISFORMNAME, <(c)> , <"p"> ) #xtranslate This . <c> . Event . <p:Action,OnClick,OnGotFocus,OnLostFocus,OnChange,OnDblClick,OnEnter> := <n> => SetProperty ( _HMG_THISFORMNAME, <(c)> , <"p"> , <n> ) в примере b := This.(cBtn).Event.Action ... This.(cBtn).Action := b или This.(cBtn).Event.Action := b [/pre2] работает
gfilatov2002: SergKis пишет: Добавил в i_this.ch Продублировал у себя эти изменения SergKis пишет: работает Благодарю за помощь
gfilatov2002: По ходу добавил пример отображения строки с разным цветом букв (давно был запрос об этой возможности ). Разноцветная строка рисуется по окну в событии ON PAINT: Если есть интерес в таком примере - напишите...
SergKis: gfilatov2002 пишет Если есть интерес в таком примере - напишите... Если бы окно было Transparent к нижним окнам, было бы super. Андрей бы точно с использовал и много раз.
SergKis: gfilatov2002 Почему убрано ? [pre2] METHOD LDblClick( nRowPix, nColPix, nKeyFlags ) CLASS TSBrowse ... #if 0 ELSEIF nClickRow == -1 .AND. ! Empty( ::lDrawFooters ) // Added 19.05.2020 IF ::bLDblClick != NIL Eval( ::bLDblClick, uPar1, uPar2, nKeyFlags, Self ) ENDIF #endif ELSEIF nClickRow == -2 .AND. ::lDrawSpecHd // SergKis 11.11.21 ... [/pre2] тогда :bLDblClick не работает для Footer
gfilatov2002: SergKis пишет: Почему убрано ? Ваш ответ в посте №3211 от 19.05.20 10:57 Выяснил, наверно, почему не было Footers в METHOD LDblClick( nRowPix, nColPix, nKeyFlags ) CLASS TSBrowse Если одновременно использовать с :LDblClick() :LButtonClick() или :RButtonClick(), то при нажатии LDblClick делая левый или правый клик "ложно" срабатывает после них LDblClick Это надо отметить для себя, что можно использовать или :LDblClick() или :LButtonClick(), :RButtonClick().
SergKis: gfilatov2002 Спасибо Не использовал для Footer LDblClick, но просят, если не отпадет, то решу след. образом [pre2] ... oBrw := _TBrowse( oTsb, cAls, cBrw, nY, nX, nW, nH ) oBrw:bEvents := {|ob,nMsg,nWParam,nLParam| Local lRet, nCell, nHead, nFoot, nSpec // события назначаем (можно не все, тогда должен работать и ob:bLdblClick) nHead := 30 nFoot := 31 nSpec := 32 nCell := 33 lRet := bEvents_LDblClick( ob, nMsg, nWParam, nLParam, nCell, nHead, nFoot, nSpec ) Return lRet } ... :Event(30, {|ow,ky,ap| Local nI, xv ? "E-"+StrZero(ky, 2), ow:Name, ap, ap[3]:cControlName for nI := 1 TO Len(ap) xv := ap[nI] ? nI, xv IF Valtype(xv) == "O" ; ?? xv:ClassName ENDIF next ? Return Nil }) :Event(31, {|ow,ky,ap| Local nI, xv ? "E-"+StrZero(ky, 2), ow:Name, ap, ap[3]:cControlName for nI := 1 TO Len(ap) xv := ap[nI] ? nI, xv IF Valtype(xv) == "O" ; ?? xv:ClassName ENDIF next ? Return Nil }) :Event(32, {|ow,ky,ap| Local nI, xv ? "E-"+StrZero(ky, 2), ow:Name, ap, ap[3]:cControlName for nI := 1 TO Len(ap) xv := ap[nI] ? nI, xv IF Valtype(xv) == "O" ; ?? xv:ClassName ENDIF next ? Return Nil }) :Event(33, {|ow,ky,ap| Local nI, xv ? "E-"+StrZero(ky, 2), ow:Name, ap, ap[3]:cControlName for nI := 1 TO Len(ap) xv := ap[nI] ? nI, xv IF Valtype(xv) == "O" ; ?? xv:ClassName ENDIF next ? Return Nil }) ... FUNCTION bEvents_LDblClick( ob, nMsg, nWParam, nLParam, nCell, nHead, nFoot, nSpec ) Local nRowPix, nColPix, nRow, nCol, lPost, nPost, o //#define WM_LBUTTONDBLCLK 515 // 0x203 IF nMsg == 515 .and. !_GetKeyState( VK_SHIFT ) .and. ! ob:IsEdit .and. ob:lCellBrw IF ! ob:lEnabled .or. ob:lDontChange ; RETURN lPost ENDIF o := ob:Cargo ; Default o := oHmgData() Default nCell := o:nEventCell Default nHead := o:nEventHead Default nFoot := o:nEventFoot Default nSpec := o:nEventSpec Default nCell := 0, nHead := 0, nFoot := 0, nSpec := 0 IF Empty( nCell + nHead + nFoot + nSpec) ; RETURN lPost ENDIF nRowPix := HiWord( nLParam ) nColPix := LoWord( nLParam ) nRow := ob:GetTxtRow( nRowPix ) nCol := ob:nAtColActual( nColPix ) lPost := .F. nPost := 0 IF ! Empty(nCell) .and. nRow == ob:nRowPos .and. nRow > 0 lPost := .T. nPost := nCell ELSEIF ! Empty(nHead) .and. nRow == 0 .and. ! Empty( ob:lDrawHeaders ) lPost := .T. nPost := nHead ELSEIF ! Empty(nFoot) .and. nRow == -1 .and. ! Empty( ob:lDrawFooters ) lPost := .T. nPost := nFoot ELSEIF ! Empty(nSpec) .and. nRow == -2 .and. ! Empty( ob:lDrawSpecHd ) lPost := .T. nPost := nSpec ENDIF IF lPost ; DO EVENTS ; _wPost( nPost, ob:cParentWnd, { nRow, nCol, ob, nWParam } ) ENDIF ENDIF RETURN lPost ... [/pre2] Это тест, что в oBrw:bLDblClick - не важно, отключен можно использовать или :LDblClick() или :LButtonClick(), :RButtonClick(). Для Footers :LDblClick() не работает, отключена #if 0 ... :LButtonClick(), :RButtonClick() не назначены (:lCellBrw := .T.)
Andrey: Григорий, а почему при ошибке в программе - заново срабатывает MYINITWIN$() ? Он же не должен 2 раза вызываться. Вот лог из моей программы: [pre2] [_fFind] 2: Forms: ARRAY[4] {"Form_Main", "Form_Table_Abon", "Form_TbrwFiltr", "Form_Find"} Вот здесь была ошибка!!! ********** Вызов из: MYINITWIN$(281) --> Source\main.prg Free Open Source Software: Harbour 3.2.0dev (r2301151017) Free Compiler: Embarcadero C++ 7.30 (32-bit) Free Gui library: Harbour MiniGUI Extended Edition 23.01.0 (32-bit) ANSI ... далее показ самой ошибки Error MGERROR/0 Window: Form_Seek is not defined. Program terminated. Called from MSGMINIGUIERROR(0) Called from GETPROPERTY(0) Called from FORMA_FILTER(878) in module: Source\Tbrw_fFind.prg Called from MYFINDEDIT(762) in module: Source\Tbrw_fFind.prg[/pre2]
gfilatov2002: Andrey пишет: почему при ошибке в программе - заново срабатывает MYINITWIN$() ? Точно не могу сказать, но, возможно, эта функция определена как INIT процедура.
SergKis: Andrey [pre2] Сделай STATIC lStaticMyInitWin := .F. INIT PROCEDURE MyInitWin() IF lStaticMyInitWin ; RETURN ENDIF lStaticMyInitWin := .T. ... [/pre2] может поможет
Andrey: gfilatov2002 пишет: Точно не могу сказать, но, возможно, эта функция определена как INIT процедура. Да, у меня в программе эта функция определена, как было вами сделано ещё в 2013 году ! Пример \SAMPLES\BASIC\SPLASHDEMO_3 А она разве должна при ошибке ещё раз вызываться ? Я считал что инициализация переменных прошла и всё, больше это функция не вызывается. У меня в этой функции стоит удаление лог-файла. И получается, что при ошибке лог стирается. SergKis пишет: Сделай STATIC lStaticMyInitWin := .F. Спасибо !
Andrey: Григорий, что делать с MODAL окнами ? У меня пропала очередность возврата этих окон. Я писал об этом в другой теме. И ещё обнаружил проблемы с этими окнами в другом месте программы. На экране открыто MODAL окно (1), открываю по кнопке другое MODAL окно (2), видно построение этого окна, а потом бац и оно пропадает с экрана. Закрываешь все окна программы, а оно (2) обнаруживается под всеми окнами. Причём фокус на окна совсем пропадает, окно приходиться закрывать по Alt+F4, ну и будет сразу вылет, типа нет такого окна. Как такое может быть и как исправить ? До этого года всё отлично работало и юзера не жаловались !!! Тестировал на BCC 5.5 и MiniGUI 22.12.2
SergKis: Andrey Попробуй после DEFINE WINDOW ... MODAL ... сделать This.Topmost := .T. или _ChangeWindowTopmostStyle ( This.Handle , .T. ) или _ChangeWindowTopmostStyle ( GetFormHandle( This.Name ) , .T. ) каждому modal окну Что будет ? PS Проверь, есть Topmost == .T. у окна на котором вызываешь modal, т.е. DEFINE WINDOW ... TOPMOST ... ON INIT {|| This.Topmost := .F., ... } на этом окне идет вызов DEFINE WINDOW ... MODAL ... Есть выделенное цветом ?
Andrey: Откатился до версии MiniGUI 21.11.1 - пропали эти проблемы !!! Т.е. ошибка пошла с версии 21.12
Andrey: SergKis пишет: Есть выделенное цветом ? Сделал ! Помогло ! Спасибо ! Но это всё равно что окна прибить гвоздями... Оно же по умолчанию MODAL
SergKis: Andrey пишет Но это всё равно что окна прибить гвоздями... Оно же по умолчанию MODAL — Мы не будем полагаться на случай. Мы пойдем простым логическим путем. — Пойдем вместе. Так что, "Если не мы, то кто же ..."
Andrey: У меня в проге было: [pre2] DEFINE WINDOW Form_YACIMP ; .... MODAL NOSIZE /*NOSYSMENU*/ ; ON INIT {|| This.Topmost := .T., aDimInit := InitYACIMP(nYear) ,; ..... FUNCTION InitYACIMP(nYear,lCreateIndex) .... WaitThreadCreateIcon( 'Поиск оплат абонента', ) DO EVENTS ... WaitThreadCloseIcon() // kill the window waiting DO EVENTS DbSelectArea(nSel) RETURN aRetDim[/pre2] Функция WaitThreadCreateIcon( 'Поиск оплат абонента',) создаёт окно MODAL и назначает This.Topmost := .T. В версии MiniGUI 21.11.1 - работало отлично, окно не пропадало и возврат вызова чепочки MODAL окон срабатывало как надо. Ошибка пошла с версии 21.12, я в эти модули не лазил, юзера начали жаловаться... Я перепроверил, собираешь с новой версии 21.12 и выше - ошибка, окно убегает, т.е. теряет Topmost := .T. И что делать ? Приколачивать каждое окно, это не выход ?
Andrey: Собираю с новой версии BCC 7.30 вообще фигня получается... [pre] .... WaitThreadCloseIcon() // kill the window waiting DO EVENTS DbSelectArea(nSel) Form_YACIMP.Topmost := .T. // добавил так !!! RETURN aRetDim[/pre] Окно на переднем плане, но НЕТ возможности нажать на кнопки на форме !!! Прога висит ! Нажатие Alt+F4 тоже не помогает... Потыкаешь и прога сваливается с ошибкой... Повторюсь - при сборке MiniGUI 21.11.1 - работает отлично ! P.S. убрал WaitThreadCreateIcon() - тогда всё заработало !!! Функцию WaitThreadCreateIcon() вместе писали...
SergKis: Andrey Смотрю в Tsb_DemoMdi WaitThreadCreateIcon( cTitle, cIndicator ), если у тебя такой же, то неточности есть: - нет _HMG_InplaceParentHandle - на передний план ставил бы сразу после [pre2] DEFINE WINDOW &cFormName ; CLIENTAREA nMaxWidth, 104 ; MODAL NOCAPTION ; ... This.Topmost := .T. ... - в ON INIT можно делать This.Topmost := .F. (что бы можно было на excel окно, или другое не твое, переключиться)[/pre2] Так как нет _HMG_InplaceParentHandle, то после Release фокус идет на MAIN окно, а на передний план ты переводишь Form_YACIMP В целом все объяснимо
SergKis: Andrey пишет Функцию WaitThreadCreateIcon() вместе писали... Тогда я говорил, что ЭТО плохая затея с потоками, т.к. надо использовать нормальное окно modal и внутри его исполнять, например, блок кода, для длит. операций и было бы значительно проще [pre2] FUNC Wait_Modal(..., bBlock ) LOCAL cForm := ... ... _HMG_InplaceParentHandle := ThisWindow:Handle ... DEFINE WINDOW ... MODAL ... ON INIT {|| This.Topmost := .F., This.TimerSetIcon.Enabled := .T., DoEvents(), _wPost(0) } This.Topmost := .T. ... DEFINE TIMER TimerSetIcon ... ACTION {|| SetProperty(cForm, "TimerSetIcon", "Enabled", .F.), ; CheckTimerSetIcon(cForm), SetProperty(cForm, "TimerSetIcon", "Enabled", .T.) } This.TimerSetIcon.Enabled := .F. This.TimerSetIcon.Visible := .F. ... (This.Object):Event( 0, bBlock ) ... END WINDOW ... _HMG_InplaceParentHandle := 0 RETURN Nil STATIC FUNC CheckTimerSetIcon( cForm ) ... [/pre2]
Andrey: Что-то в МиниГуи пошло не так. У меня 2 проекта, один полный (вес ехе-ника 26 Мб), второй сокращённый для отладки модулей (вес ехе-ника 16 Мб). Собираю оба проекта на: Harbour 3.2.0dev (r2301231146) Borland C++ 5.8.2 (32-bit) Harbour MiniGUI Extended Edition 23.01.0 (32-bit) ANSI Сокращённый проект собирается быстрей, да и удобней с ним отлаживать. В обоих проектах есть меню (модальное окно с выбором 4 кнопки) Сокращённый проект прекрасно работает с этими кнопками и выбор/возврат есть по этим кнопкам. Если запускаю полный проект, то кнопки отрабатывают ТОЛЬКО один раз, а потом при возврате на это окно - оно ТУПО ВЕШАЕТСЯ.... ни мышкой окно подвинуть, ни кнопки не доступны. Срабатывает только клавиша ESC, потому что назначил эту клавишу сам. Вопрос на засыпку, почему такое СТРАННОЕ поведение окна ? Как это побороть ? Окно обычное, без всяких наворотов. Сделал назначение AlertInfo() по клавише F2 - то в полном проекте, ТОЖЕ СРАЗУ ВЕШАЕТ окно... Вот такой простой код: [pre2]FUNCTION FindListZa(...) ... hOld := _HMG_InplaceParentHandle _HMG_InplaceParentHandle := ThisWindow.Handle DEFINE WINDOW Form_NZ ; MODAL ; ON INIT {|| MyInitFormNZ(...) } ... cText := "1.Меню" @ BUTTONEX Button_1 ... ACTION {|| _wSend(10), DoEvents(), _wPost(12) } cText := "2.Меню" @ BUTTONEX Button_2 ... ACTION {|| _wSend(20), DoEvents(), _wPost(22) } cText := "3.Меню" @ BUTTONEX Button_3 .... ACTION {|| _wSend(30), DoEvents(), _wPost(32) } cText := "Выход" @ BUTTONEX Button_5 ... ACTION {|| _wSend(97) } ON KEY ESCAPE OF Form_NZ ACTION _wPost(97) ON KEY F2 OF Form_NZ ACTION _wPost(87, ThisWindow.Name) WITH OBJECT This.Object :Event( 0, {| | InkeyGui(200) } ) :Event( 1, {| | This.Button_1.Setfocus , _PushKey( VK_RETURN ) } ) :Event( 2, {| | This.Button_2.Setfocus , _PushKey( VK_RETURN ) } ) :Event( 3, {| | This.Button_3.Setfocus , _PushKey( VK_RETURN ) } ) :Event( 4, {| | This.Button_4.Setfocus , _PushKey( VK_RETURN ) } ) :Event(10, {| | This.Button_1.Enabled := .F. } ) :Event(11, {|ow| This.Button_1.Enabled := .T. , _wPost(90, ow) } ) :Event(12, {|ow| // 1.Меню IniSaveFileThisNZ(...) ReListNZ1(...) DoEvents() _wPost(11, ow:Name) RETURN NIL } ) :Event(20, {| | This.Button_2.Enabled := .F. } ) :Event(21, {|ow| This.Button_2.Enabled := .T. , _wPost(90, ow) } ) :Event(22, {|ow| // 2.Меню LOCAL nMsg IniSaveFileThisFNZ(...) aNew := ReListNZ2(...) nMsg := iif( LEN(aNew) > 0, 99, 21 ) DoEvents() _wPost(nMsg, ow:Name) RETURN NIL } ) :Event( 30, {| | This.Button_3.Enabled := .F. } ) :Event( 31, {|ow| This.Button_3.Enabled := .T. , _wPost(90, ow) } ) :Event( 32, {|ow| // 3.Меню LOCAL nMsg IniSaveFileThisFNZ(...) aNew := ReListNZ3(...) nMsg := iif( LEN(aNew) > 0, 99, 31 ) DoEvents() _wPost(nMsg, ow:Name) RETURN NIL } ) :Event( 87, {|ow| HelpThisWindow() , DoEvents(), _wPost(90, ow) } ) :Event( 90, {|ow| // остаться в окне выбора Local cMsg := "Window not found ! " + ow:Name + ";" + ProcNL() IF ! To_Focus(ow:Name , "Label_0") AlertStop(cMsg, "ERROR") ENDIF DO EVENTS wApi_Sleep(100) Return Nil } ) :Event( 97, {|ow| IniSaveFileThisFNZ(...) ,; aNew := {} , DoEvents(), _wPost(99, ow:Name) } ) :Event(99, {|ow| ow:Release() } ) END WITH END WINDOW CENTER WINDOW Form_NZ ACTIVATE WINDOW Form_NZ IF ! ISNIL(hOld) ; _HMG_InplaceParentHandle := hOld ENDIF RETURN aNew[/pre2]
SergKis: Andrey Сделай так[pre2] ... ON KEY F2 OF Form_NZ ACTION _wPost(87, ThisWindow.Name) ... :Event( 87, {|ow| _HMG_InplaceParentHandle := This.Handle , HelpThisWindow(), ; _HMG_InplaceParentHandle := 0 , DoEvents(), _wPost(90, ow) } ) [/pre2] Используемая AlertInfo() -> HMG_Alert() - MODAL окно и нет заданого _HMG_InplaceParentHandle
SergKis: gfilatov2002 Может добавить что такое для окна modal (_HMG_InplaceOwnerHandle - new variable) [pre2] #xtranslate SET WINDOW MODAL [ PARENT ] HANDLE <x:ON,OFF> => _HMG_InplaceOwnerHandle := ( Upper(<(x)>) == "ON" ) FUNCTION _DefineModalWindow ( FormName, Caption, x, y, w, h, Parent, nosize, nosysmenu, nocaption, aMin, aMax, ; ... IF ! Empty( _HMG_InplaceOwnerHandle ) _HMG_InplaceParentHandle := iif( _HMG_BeginWindowMDIActive, GetActiveMdiHandle(), GetActiveWindow() ) ENDIF IF _HMG_InplaceParentHandle <> 0 Parent := _hmg_InplaceParentHandle ELSEIF ! _HMG_BeginWindowMDIActive Parent := _hmg_MainHandle ENDIF ... IF ! Empty( _HMG_InplaceOwnerHandle ) _HMG_InplaceParentHandle := 0 ENDIF RETURN ( FormHandle ) [/pre2]
gfilatov2002: SergKis пишет: для окна modal (_HMG_InplaceOwnerHandle - new variable) Сделаю, конечно. Только хочу дать этой переменной имя _HMG_OwnerModalHandle
Andrey: SergKis пишет: Сделай так Сделал. Не помогает. Цепочка старта окон WINDOWTYPE STANDARD TOPMOST, затем MODAL 1, затем MODAL 2 и вот на нём виснет. Хотя в других местах программы есть такое же и не виснет... Убрал ВСЕ ресурсы из полного проекта, ехе-ник стал весить 10 Мб, проблема осталась. Видно всё таки что-то в полном проекте - построение модулей типа как в SAMPLES\BASIC\SPLASHDEMO_3 ? Или ограничение по коду в Харборе ?
SergKis: gfilatov2002 Вроде поймал ситуацию, которая возникает у Андрея. Пример на базе SPLASHDEMO_3: https://TransFiles.ru/vz2sa На кнопках входим в окно STANDARD с тсб, выбираем запись и входим в окно AlertInfo(...) Не смотря на заданный _HMG_InplaceParentHandle при первом входе в окно по кнопке, выбора записи и выхода из AlertInfo(), окно с тсб убегает под окно MAIN. Окно STANDARD имеет родителя окно DeskTop. Повторные выборы записи и все ok! окно STANDARD на переднем плане, но закрыв его и снова жмем кнопку, та же картина, окно под main. Т.е. поведение окна STANDARD первый раз правильное, раз привязана к desktop, то на desktop и убежало (хоть и было поверх main), тогда надо дать возможность, как и у модал, привязывать родителя, может через тот же _HMG_InplaceParentHandle, сейчас стоит в _DefineWindow() ParentHandle := iif( child == .T., _HMG_MainHandle, 0 )
gfilatov2002: SergKis Большое спасибо за Ваш пример Решил эту проблему с помощью вызова функции SwitchToThisWindow() после выхода из модального окна. [pre2] (This.Object):Event(VK_RETURN, {|ow| my_Modal(ow), SwitchToThisWindow( GetFormHandle( cForm ), 1 ) }) [/pre2] где вспомогательная функция определена в одну строку: [pre2]DECLARE DLL_TYPE_VOID SwitchToThisWindow( DLL_TYPE_LONG hWnd, DLL_TYPE_BOOL lRestore ) ; IN USER32.DLL [/pre2]
SergKis: gfilatov2002 пишет Решил эту проблему с помощью вызова функции SwitchToThisWindow() после выхода из модального окна Дело не в этом, а во внутренней работе hmg (ф-я events()), которая перемещает окно standard на desktop после первого вызова, т.е. убирает окно с переднего плана, окно должно оставаться как было на переднем плане или привязывать parentHandle к main например. Поднять окно после модального можно и To_Focus(...) можно[pre2] FUNCTION my_Modal( oWnd ) LOCAL nBrw, oBrw, cBrw, cAls, cWnd LOCAL cMsg := "" LOCAL o := oWnd:Cargo cWnd := oWnd:Name nBrw := o:nBrw oBrw := o:oBrw cBrw := o:cBrw cAls := o:cAls cMsg := hb_valtoexp({cWnd, nBrw, cBrw, cAls, oBrw:cControlName}) AlertInfo(cMsg, "INFO - "+cWnd) To_Focus(cWnd, cBrw) RETURN Nil [/pre2] Последующие выборы строки (не выходя из STANDARD) работают не перемещая окно STANDARD после modal
SergKis: PS Проявление ситуации хорошо видно на следующем примере (добавил модальное окно на выбор записи с таблицей тсб). Выбор в этом окне и выход из окна AlertInfo() дает перенос окна STANDARD под main, т.е. с окна модального с таблицей улетели под main. Пример https://TransFiles.ru/0s7wp PS Попробовал простое (для теста) в [pre2] FUNCTION _DefineWindow ( FormName, Caption, x, y, w, h, nominimize, nomaximize, ; ... //ParentHandle := iif( child == .T., _HMG_MainHandle, 0 ) ParentHandle := iif( child == .T., _HMG_MainHandle, _HMG_InplaceParentHandle ) ... и в примере в ф-ии (цветом) STATIC FUNCTION my_Btn( nEvnt, cButt, oWnd ) LOCAL cBtn, cWnd, o, cForm, y, x cWnd := oWnd:Name cBtn := "ButtonEX_" + hb_ntos(nEvnt) cForm := "w"+cBtn IF cBtn != cButt ? ProcName(), "ERROR", cBtn, "!=", cButt RETURN .F. ENDIF SET WINDOW THIS TO cWnd o := This.(cBtn).Cargo cAls := "CUST_"+hb_ntos(o:nBtn) cTitle := cBtn+": "+hb_ntos(o:nBtn)+" "+o:cCap y := o:nY - 100 x := o:nX + 50 _HMG_InplaceParentHandle := This.Handle ? ProcName(), nEvnt, cBtn, o:cBtn, o:nBtn, o:cCap, cForm, cTitle my_Standard( cForm, o:nBtn, cTitle, o:aBClr, y, x, o:nW, o:nH, cAls ) _HMG_InplaceParentHandle := 0 SET WINDOW THIS TO RETURN .T. [/pre2] Окна не убегают под main, но при выходе из окна modal с тсб, окно STANDARD без фокуса (это все про первый вход с кнопки, потом все ok!)
SergKis: Григорий Есть эффект не оч. красивый, если в последнем примере, например кнопку "Sample 2" нажать, сделать выбор строки, попадаем на окно модал с таблицей, теперь, если кликнуть мышкой по заголовку окна STANDARD (пред. таблица), то будет мелькание окон и только потом звук с возвратом фокуса на тек. модальное окно
SergKis: gfilatov2002 пишет Решил эту проблему с помощью вызова функции SwitchToThisWindow() после выхода из модального окна. (This.Object):Event(VK_RETURN, {|ow| my_Modal(ow), SwitchToThisWindow( GetFormHandle( cForm ), 1 ) }) Тогда получается, что код в ф-ии Events(...), для окна modal, не работает [pre2] ... **************************************************************************** CASE WM_CLOSE **************************************************************************** ... _hmg_OnHideFocusManagement ( i ) ... *-----------------------------------------------------------------------------* PROCEDURE _hmg_OnHideFocusManagement ( i ) *-----------------------------------------------------------------------------* ... * Modal IF ( x := AScan ( _HMG_aFormHandles, _HMG_aFormParenthandle [ i ] ) ) > 0 IF _HMG_aFormType [ x ] == "M" * Modal Parent _HMG_IsModalActive := .T. _HMG_ActiveModalHandle := _HMG_aFormParenthandle [ i ] EnableWindow ( _HMG_aFormParenthandle [ i ] ) SetFocus ( _HMG_aFormParenthandle [ i ] ) ELSE ...[/pre2] Может есть смысл здесь подключить вместо SetFocus ( _HMG_aFormParenthandle [ i ] ) SwitchToThisWindow( _HMG_aFormParenthandle [ i ], 1 )
gfilatov2002: SergKis пишет: Может есть смысл здесь подключить вместо SetFocus ( _HMG_aFormParenthandle [ i ] ) SwitchToThisWindow( _HMG_aFormParenthandle [ i ], 1 ) Да, тоже подумываю об этом. Благодарю за наводку
gfilatov2002: Добавил в ядро библиотеки функцию SwitchToThisWindow(hWnd,[lRestore]). По умолчанию значение lRestore = .T. Теперь конструкции вида IF IsIconic( hForm ) ; _Restore( hForm ) ENDIF можно заменить на SwitchToThisWindow( hForm )
SergKis: gfilatov2002 Маленькая добавка [pre2] METHOD LoadFields( lEditable, aColSel, cAlsSel, aNameSel, aHeadSel ) CLASS TSBrowse ... ATail( ::aColumns ):nFieldDec := aStru[ nE, 4 ] // 18.07.2018 IF aStru[ nE, 2 ] $ "=@T^+" ATail( ::aColumns ):lEdit := .F. ENDIF IF HB_ISARRAY( aNameSel ) .AND. Len( aNameSel ) > 0 .AND. n <= Len( aNameSel ) ... для режима SET DELETED OFF METHOD DeleteRow( lAll, lUpStable ) CLASS TSBrowse ... ::lHasChanged := .T. ::DrawSelect() CASE ::lIsArr ... [/pre2] Без этой строки надо oBrw:bPostDel := {|ob| ob:DrawSelect() } добавлять
gfilatov2002: SergKis пишет: Маленькая добавка Принято
Andrey: gfilatov2002 пишет: Добавил в ядро библиотеки функцию SwitchToThisWindow(hWnd,[lRestore]). Когда обновление будет ?
gfilatov2002: Andrey пишет: Когда обновление будет ? Послезавтра, в среду
SergKis: gfilatov2002 Поймал ситуацию, как у Андрея. Не лечится To_Focus(), SwitchToThisWindow( hForm, 1 ) Пример https://TransFiles.ru/eudq8 После запуска, например, жмем "Sample 1", потом "Sample 2" Снова жмем "Sample 1", что бы перевести окно STANDARD на передний план. Не получается, окно приходит поверх main и опять прячется под него, т.е. мелькает Так же ведет себя и кнопка "Sample 2" и остальные тоже. Мышкой или Alt+TAB все работает Ф-я my_Btn() находится в table.prg. Работает для всех кнопок окна standard.
gfilatov2002: SergKis пишет: Поймал ситуацию, как у Андрея. Благодарю за пример! SergKis пишет: Мышкой или Alt+TAB все работает Не понятен выбор окон типа STANDARD для внутренних окон приложения. Окна STANDARD являются самостоятельными по отношению к главному окну. Для внутренних окон, конечно, надо использовать окна CHILD. Думаю, это решит проблему с иерархией окон в приложении.
SergKis: gfilatov2002 пишет Думаю, это решит проблему с иерархией окон в приложении. У Андрея, я так понимаю, запускается ~5 окон STANDARD, которые получают фокус для работы пользователем по выбору в TaskBar, все работает на один раз открытые базы (наверно исторически так сложилось). Окна STANDARD являются самостоятельными по отношению к главному окну Это да, но это не значит, что Main окно, должно захватывать фокус. Немного подработал, почистил пример и сделал TABSTOP на кнопки main окна и стало видно, что повторно поднять окно standard кнопкой не получается, оно мелькает и фокус на main визуально, реально не понятно, т.к. (добавил в my_Standard() на входе)[pre2] IF _IsWindowDefined(cForm) hW := GetFormHandle(cForm) nI := GetFormNameByHandle( hW, @cVal ) ? "*Form =", hW, nI, cVal hW := GetFocus() cVal := "" nI := -1 IF hW <> 0 nI := GetFormNameByHandle( hW, @cVal ) ENDIF ? "*Focus=", hW, nI, cVal To_Focus(cForm) hW := GetFocus() cVal := "" nI := -1 IF hW <> 0 nI := GetFormNameByHandle( hW, @cVal ) ENDIF ? "#Focus=", hW, nI, cVal IF select(cAls) > 0 ; dbSelectArea(cAls) ENDIF RETURN Nil ENDIF ... выдает следующее *Form = 23594206 2 wButton_1 *Focus= 6030820 0 '' Call from: TO_FOCUS(20) --> main_misc.prg wButton_1 23594206 NIL #Focus= 45286518 0 '' ... [/pre2] Если интересно, пример с правками тут https://TransFiles.ru/hjqmk
SergKis: PS Заменил ссылку на пример, т.к. потерял bmp в ресурсах для индикации удаленных записей
Andrey: gfilatov2002 пишет: Не понятен выбор окон типа STANDARD для внутренних окон приложения. Окна STANDARD являются самостоятельными по отношению к главному окну. Для внутренних окон, конечно, надо использовать окна CHILD. Думаю, это решит проблему с иерархией окон в приложении. Во многих приложениях есть главное окно, с которого юзер запускает нужные ему окна для работы. У меня юзер запускает STANDARD окна с заявками, договорами, абонентами и т.д. Заставить юзера работать только с одним окном это не по современному, пускай что хочет, то и делает. STANDARD окно ОЧЕНЬ удобно для юзера, оно остаётся на панели задач со своим значком и юзеру это нравиться. Пример SAMPLES\Advanced\Tsb_5Win тоже такой же, и я думаю его так же можно поломать - поставив окно ожидания с прелодером и вызовом нескольких MODAL окон.
SergKis: gfilatov2002 Есть еще интересное поведение modal окон. Запускаем "Sample 1", "Sample 2" Поднимаем фокус на "Sample 1" (оба окна Sample над main) Жмем Enter на "Sample 1" -> попадаем на окно modal, кусочек окна "Sample 2" виден Жмем мышкой на видимый заголовок окна "Sample 2" Активируется окно "Sample 1" как будто на нем нажали Enter несколько раз -> попадаем на окно modal AlertInfo()
SergKis: Andrey пишет STANDARD окно ОЧЕНЬ удобно для юзера, оно остаётся на панели задач со своим значком и юзеру это нравиться. Ты получишь то же самое, если запустишь свой exe 6 раз (можно в потоке, как пример FileChangeControl2), т.е. 0. main 0 // main окно с кнопками запуска в потоке пунктов ниже 1. main 1 // main окно заменяющее окно STANDARD 1 ... 5. main 5 // main окно заменяющее окно STANDARD 5 программа бы сильно упростилась, по мне
Andrey: SergKis пишет: Ты получишь то же самое, если запустишь свой exe 6 раз (можно в потоке, как пример FileChangeControl2), Нужно тогда менять иконку и титул окна задачи. Время запуска и открытия баз при запуске нового ехе-ника намного БОЛЬШЕ чем создание STANDART окна, базы все уже открыты. А так юзер будет нервничать, при каждом запуске ругаясь на "тормозную" программу. Уже такое видел и не раз. И логику программирования свою менять. Это можно, но уже в новых проектах.
SergKis: Andrey пишет А так юзер будет нервничать, при каждом запуске ругаясь на "тормозную" программу Все в твоих руках. Можно без потоков запустить все 5 окон под splash в hide и все - переключай фокус между приложениями с главной main или после splash, из памяти убирай когда выходят из главной main, а так делай по X hide. Время на запуск будет тоже И логику программирования свою менять. Это можно, но уже в новых проектах. У тебя уже все есть в твоем модуле (ты его один и запускай с разными параметрами с главного main). С окнами Standard, думаю, провозишься дольше. Вместо STANDARD у тебя будут MAIN окна и разный запуск
gfilatov2002: Выложил 4-е обновление сборки 23.04 с учетом последних исправлений и дополнений Скачать Обновил также Unicode архив этой сборки для Сергея Желаю всем хорошего дня
i3t4j6: Появилась необходимость в TsBrowse написать oBrw:cMsg:= ' ↓ -добавить F10 -выход '. Так вот - "стрелка вниз" - не отображается, как и chr(25) . Это как-то можно победить?
SergKis: i3t4j6 Сделайте, что то такое [pre2] 1. oBrw:cMsg:= ' <Dn> - добавить F10 -выход ' 2. oBrw:cMsg := {|ob,nc| my_cMsg(ob, nc) } FUNC my_cMsg( oBrw, nCol) LOCAL cMsg := "", oWnd LOCAL cImg := "Dn" // image в ресурсах SET WINDOW THIS TO oBrw oWnd := This.Object IF nCol == ... cMsg := "..." cImg := "..." ELSE cMsg := "- добавить F10 -выход " cImg := "Dn" ENDIF //oWnd:StatusBar:Say(cMsg, 1) oWnd:StatusBar:Icon(cImg, 1) SET WINDOW THIS TO RETURN cMsg [/pre2] Это схема PS Если колонки не обрабатывать, то oBrw:cMsg := {|ob| SetProperty(ob:cParentWnd, "StatusBar", "Icon", 1, "Dn"), "- добавить F10 -выход " }
Andrey: А есть функция в МиниГуи, которая возвращает фокус текущей формы в программе ? И фокус объекта на этой текущей форме ? А то делаю так: [pre2] Local aFocu := { ThisWindow.Name, This.FocusedControl } // текущее окно и фокус в окне ...... To_Focus(aFocu[1], aFocu[2]) // восстановим текущее окно и фокус в окне Return Nil }[/pre2] и получаю вылет из программы с такой ошибкой: [pre2]Error BASE/1081 Неверный аргумент: + Args: [1] = C Window: [2] = U Called from GETPROPERTY(0) Called from (b)SHOW_SITE(227) in module: Source\form_site.prg Called from EVENTS(0) Called from MYEVENTSHANDLER(1833) in module: Source\main.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(0) [/pre2] Причём тут + ? вообще непонятно...
i3t4j6: SergKis пишет: Если колонки не обрабатывать, то Я скорее всего привел неудачный пример. Вот другой : DEFINE TBROWSE oBrw AT 0,0 OF Form_3 celled ALIAS cFile ; WIDTH 1008 HEIGHT 612 SIZE 9 ; MESSAGE ' ↓ -добавить F10 -выход '. "Стрелка вниз" - не отображается !??
SergKis: 3t4j6 пишет "Стрелка вниз" - не отображается !?? И не будет, в ToolTip так же не отобразится (код < 32). Надо менять на картинку. Подберите вариант стрелки вниз и делайте как написал выше. Слева будет картинка "Стрелка вниз", потом текст ' -добавить F10 -выход '. Возможно блок кода будет чуть сложнее, т.к. картинку и текст, по мне, надо отображать когда в фокусе тсб будет последняя строка LastRec(), для TsBrowse - это ob:nLen. Что бы не связываться с MESSAGE TsBrowse, можно в StatusBar сделать все варианты режимов работы с записью, т.е. разбить StatusBar на Item-ы (самый левый не занимать) в которых вывести с картинками, например так: <для Message тсб или свои> |<картинка> Добавить |<картинка> Удалить |<картинка> Edit | ... | <картинка> Выход | ... можно установить для каждого Item StatusBar FontColor и BackColor + назначить блок кода ACTION {|| ... } по клику по Item он сработает и выполнит соответствующий блок\режим. + эти режимы продублировать на клавиши Ins, Del, F4 или Enter ... Получите аналог кнопок в StatusBar. Каждому StatusBar Item можно задать ToolTip, где написать текст-расшифровку, он будет высвечиваться при наведении мыши на каждый Item, где задан, т.е. навели на Item "Выход", получили типа "Нажмите кл. F10 или Esc для завершения работы"
i3t4j6: Спасибо !!!
Andrey: Есть пример SAMPLES\BASIC\Icons Если хочу добавить общую иконку для проги так: [pre2]demo.res 1_MAIN ICON 1Mg.ico IconVista ICON IconVista.ico[/pre2] То ехе-ник не собирается, выдаёт ошибку: [pre2]Borland Resource Compiler Version 5.40 Copyright (c) 1990, 1999 Inprise Corporation. All rights reserved. Error demo.rc 2 40: Allocate failed Resource compile error.[/pre2] Почему ? Что не хватает для BCC 5.8 ? И не собирается \BASIC\Icons\MyIcons\build.bat [pre2]myicons.c: Turbo Incremental Link 6.90 Copyright (c) 1997-2017 Embarcadero Technologies, Inc. или Turbo Incremental Link 5.69 Copyright (c) 1997-2005 Borland Error: Unresolved external '_hb_dynsymToNum' referenced from C:\MINIGUI-23.04.4\HARBOUR\LIB\HBWIN.LIB|hbolesrv Error: Unresolved external '_hb_dynsymFromNum' referenced from C:\MINIGUI-23.04.4\HARBOUR\LIB\HBWIN.LIB|hbolesrv Error: Unresolved external '_hb_errRT_New' referenced from C:\MINIGUI-23.04.4\HARBOUR\LIB\HBWIN.LIB|hbolesrv Error: Unresolved external '_hb_pcount' referenced from C:\MINIGUI-23.04.4\HARBOUR\LIB\HBWIN.LIB|hbolesrv Error: Unresolved external '_hb_arrayBaseParams' referenced from C:\MINIGUI-23.04.4\HARBOUR\LIB\HBWIN.LIB|hbolesrv Error: Unresolved external '_hb_errPutArgsArray' referenced from C:\MINIGUI-23.04.4\HARBOUR\LIB\HBWIN.LIB|hbolesrv ..... и далее куча сообщений [/pre2]
gfilatov2002: Ну вот и все! Выложил июльскую сборку 23.07 с учетом последних исправлений и дополнений скачать После 18-ти лет активной разработки этот проект подошел для меня к концу по понятным причинам. В заключение хотел бы отметить важные этапы в истории Минигуи: - прекрасный старт на основе кода автора библиотеки Роберто Лопеза; - обеспечена совместимость кода со всеми бесплатными Си-компиляторами: MinGW, MS VC, Pelles C, Open Watcom; - поддержка 64-битной архитектуры; - поддержка Unicode; - адаптация FiveWin класса TSBrowse (автор - Мануэл Меркадо); - HMGS-IDE Project Manager and Two-Way Visual Form Designer (автор - Уолтер Формигони); - улучшенные версии библиотек Харбора (hbsqldd, hbziparc, hbmysql, hbpqsql, hbsqlite3, hbcrypto); - множество примеров использования (от самых простых и до готовых приложений). Большое спасибо всем форумчанам за интерес и поддержку библиотеки Желаю всем удачи!
Haz: gfilatov2002 пишет: Большое спасибо всем форумчанам за интерес и поддержку библиотеки Желаю всем удачи! Григорий, спасибо за Ваш многолетний труд и поддержку проекта
SergKis: gfilatov2002 СПАСИБО
Andrey: gfilatov2002 Спасибо ОГРОМНОЕ за ваш проект и вашу помощь ! P.S. Зря не добавили пример - Tsb_array_image, в нём все варианты чтения и показа картинок в ТСБ. И в качестве добавки - сборка своих DLL с ресурсами через BCC.
gfilatov2002: Andrey пишет: Зря не добавили пример - Tsb_array_image Мне тоже понравился этот пример, но не хотелось значительно увеличивать размер дистрибутива за счет большого количества картинок. К тому же, к этому времени уже был готов финальный инсталлятор этой сборки.
SergKis: gfilatov2002 пишет уже был готов финальный инсталлятор этой сборки Unicode версия есть ? Если есть, можно получить ?
gfilatov2002: SergKis пишет: Unicode версия есть ? Уже есть. Выложил ее по старому адресу, как обычно
SergKis: gfilatov2002 Спасибо !
Andrey: Григорий, я высылал тебе для ErrorSys.prg новую секцию для анализа ошибок: ---------------------------- List of open windows ----------------------------- Удобная штука, сразу видно сколько окон в программе открыто. Жалко что туда нельзя прикрутить в каком окне произошла ошибка.
SergKis: gfilatov2002 пишет На следующей неделе выложу обновление Добавки небольшие [pre2] METHOD Set( xKey, xVal ) CLASS THmgData ... IF HB_ISHASH( xKey ) ... ELSEIF HB_ISARRAY( xKey ) .and. HB_ISARRAY( xVal ) FOR EACH k, v IN xKey, xVal Default k := hb_enumIndex( k ) hb_HSet( ::aKey, ::Upp( k ), v ) NEXT ELSEIF HB_ISARRAY( xKey ) FOR EACH v IN xKey IF HB_ISARRAY( v ) .and. Len( v ) > 1 hb_HSet( ::aKey, ::Upp( v[1] ), v[2] ) ENDIF NEXT ELSE hb_HSet( ::aKey, ::Upp( xKey ), xVal ) ENDIF ... // Допустил неточность в названии переменной ( oParam:bDblClick вместо oParam:bLDblClick) и уже использовал, думаю надо поправить ... FUNCTION _TBrowse( oParam, uAlias, cBrw, nY, nX, nW, nH ) ... IF HB_ISBLOCK( oParam:bBody ) ; EVal( oParam:bBody, oBrw, oParam ) // 2. call your customization functions ENDIF IF HB_ISLOGICAL( oParam:bLDblClick ) .or. HB_ISLOGICAL( oParam:bDblClick ) :bLDblClick := {|p1, p2, p3, ob| p1:=p2:=p3, ob:PostMsg( WM_KEYDOWN, VK_RETURN, 0 ) } ELSEIF HB_ISBLOCK( oParam:bLDblClick ) // :bLDblClick := {|p1,p2,p3,ob| ... } :bLDblClick := oParam:bLDblClick ELSEIF HB_ISBLOCK( oParam:bDblClick ) // :bLDblClick := {|p1,p2,p3,ob| ... } :bLDblClick := oParam:bDblClick ENDIF IF HB_ISBLOCK( oParam:bRClicked ) :bRClicked := oParam:bRClicked // :bRClicked := {|p1,p2,p3,ob| ... } ENDIF ... [/pre2]
gfilatov2002: SergKis пишет: Добавки небольшие OK
SergKis: gfilatov2002 Предложение [pre2] FUNCTION Events ( hWnd, nMsg, wParam, lParam ) ... **************************************************************************** CASE WM_TIMER **************************************************************************** i := AScan ( _HMG_aControlIds , wParam ) IF i > 0 #ifdef _NAMES_LIST_ x := _SetGetNamesList( "bWM_TIMER" ) IF HB_ISBLOCK( x ) IF !Empty( Eval( x, _HMG_aControlNames [ i ], GetParentFormName( i ), i ) ) EXIT // return 1 => everything is done ENDIF ENDIF #endif IF _HMG_aControlPicture [ i ] == .T. // Once ... **************************************************************************** CASE WM_COPYDATA **************************************************************************** #ifdef _NAMES_LIST_ x := _SetGetNamesList( "bWM_COPYDATA" ) IF HB_ISBLOCK( x ) Eval( x, hWnd, nMsg, wParam, lParam ) ENDIF #endif EXIT **************************************************************************** CASE WM_QUERYENDSESSION CASE WM_POWERBROADCAST **************************************************************************** i := 0 #ifdef _NAMES_LIST_ x := _SetGetNamesList( "bWM_PowerEndSession" ) IF HB_ISBLOCK( x ) i := Eval( x, hWnd, nMsg, wParam, lParam ) ENDIF #endif IF Empty( i ) __Quit() ENDIF EXIT **************************************************************************** CASE WM_CLOSE **************************************************************************** ... или WM_POWERBROADCAST отделить от WM_QUERYENDSESSION, т.е. ... **************************************************************************** CASE WM_QUERYENDSESSION **************************************************************************** __Quit() EXIT **************************************************************************** CASE WM_POWERBROADCAST **************************************************************************** #ifdef _NAMES_LIST_ x := _SetGetNamesList( "bWM_POWERBROADCAST" ) IF HB_ISBLOCK( x ) i := Eval( x, hWnd, nMsg, wParam, lParam ) ENDIF #endif EXIT ... [/pre2] PS Для разных таймеов можно делать один обработчик, назначив _SetGetNamesList( "bWM_TIMER", bBlock ) без исп. This среды, например для запуска выполнения в потоке DEFINE TIMER <name> INTERVAL <interval>
gfilatov2002: SergKis пишет: Предложение Это предложение мне очень нравится, но оно вносит в систему новые недокументированные глобальные статические переменные, знание имен которых будет требоваться от разработчика. Поэтому пока я отказался от этого дополнения в пользу универсального обработчика, который легко заменить на собственный менеджер событий по команде SET EVENTS FUNC TO <имя функции> Поскольку новая сборка уже собрана, буду рассматривать это предложение как задел на будущее...
SergKis: gfilatov2002 пишет буду рассматривать это предложение как задел на будущее... Вариант работы с сообщениями, как пример: [pre2] STATIC s_oWM_Names, s_oWM_Events MEMWAR p_oWM_Message ... PUBLIC p_oWM_Message ... s_oWM_Names := oHmgData() s_oWM_Names:Set( { ; {WM_MBUTTONDOWN , "WM_MBUTTONDOWN "}, ; {WM_RBUTTONDOWN , "WM_RBUTTONDOWN "}, ; {WM_LBUTTONDOWN , "WM_LBUTTONDOWN "}, ; {WM_MOUSEMOVE , "WM_MOUSEMOVE "}, ; {WM_MOVE , "WM_MOVE "}, ; {WM_HOTKEY , "WM_HOTKEY "}, ; {WM_KEYDOWN , "WM_KEYDOWN "}, ; {WM_KEYUP , "WM_KEYUP "}, ; {WM_MOUSEWHEEL , "WM_MOUSEWHEEL "}, ; {WM_INITMENUPOPUP , "WM_INITMENUPOPUP "}, ; {WM_UNINITMENUPOPUP, "WM_UNINITMENUPOPUP"}, ; {WM_SETFOCUS , "WM_SETFOCUS "}, ; {WM_HELP , "WM_HELP "}, ; {WM_HSCROLL , "WM_HSCROLL "}, ; {WM_VSCROLL , "WM_VSCROLL "}, ; {WM_TASKBAR , "WM_TASKBAR "}, ; {WM_WND_LAUNCH , "WM_WND_LAUNCH "}, ; {WM_CTL_LAUNCH , "WM_CTL_LAUNCH "}, ; {WM_NEXTDLGCTL , "WM_NEXTDLGCTL "}, ; {WM_DROPFILES , "WM_DROPFILES "}, ; {WM_CONTEXTMENU , "WM_CONTEXTMENU "}, ; {WM_SIZE , "WM_SIZE "}, ; {WM_COMMAND , "WM_COMMAND "}, ; {WM_NOTIFY , "WM_NOTIFY "}} ) s_oWM_Events := oHmgData() FOR EACH nMsg IN s_oWM_Message:Keys() s_oWM_Events:Set( nMsg, NIL ) // или блок кода для исполнения можно заносить на ключ nMsg, потом читать для выполнения NEXT p_oWM_Message := oHmgData() p_oWM_Message:oNames := s_oWM_Names p_oWM_Message:oEvents := s_oWM_Events ... добываем ... o := p_oWM_Message:oNames cMsg := "Event arrived - " + o:Get(nMsg, "?") ? HB_TSTOSTR( HB_DATETIME() ), cMsg, ProcNL() ... o := p_oWM_Message:oEvents IF HB_ISBLOCK( o:Get(nMsg, Nil) ) x := Eval( o:Get(nMsg), hWnd, nMsg, wParam, lParam ) IF !Empty( x ) RETURN 1 ENDIF ENDIF ... [/pre2] Можно подумать и убрать из prg в ресурсы языковые тексты. Например в формат ini, т.е. имеем в RESOURCE ini файлы, например, в utf8 с BOM en.ini ru.ini cs.ini ... в rc файле имеем EN RCDATA en.ini RU RCDATA ru.ini CS RCDATA cs.ini ... Пример Ini варианта для переменных _HMG_... как секции для языков EN и RU тут https://TransFiles.ru/icjjs
gfilatov2002: SergKis пишет: Вариант работы с сообщениями, как пример Спасибо!
gfilatov2002: Выложил последнюю сборку 23.09 с учетом последних исправлений Скачать Желаю всем форумчанам доброго здоровья! Мира вам, добра и процветания
Andrey: Собрал на новой версии свою большую систему. [pre2]: Harbour 3.2.0dev (r2307062207) : Borland C++ 5.8.2 (32-bit) : Harbour MiniGUI Extended Edition 23.09.0 (32-bit) ANSI [/pre2] Работает, у меня Win10 У заказчика в Николаеве тоже Win10, вылетает на ВСЕХ таблицах... Вот такая ошибка: [pre2]Error BASE/1001 Неизвестная функция: EVENTS Args: [1] = N 67202 [2] = N 129 [3] = N 0 [4] = N 1695368 Called from EVENTS(0) Called from _CREATEWINDOWEX(0) Called from TSBROWSE:CREATE(0) Called from TSBROWSE:NEW(0) Called from _DEFINETBROWSE(0) Called from FORM_MYTABLE(324) in module: Source\Tbrw_table.prg Called from TBRWDOGOVOR(16) in module: Source\Tbrw_1Run.prg Called from (b)HB_MACROBLOCK(0)[/pre2] Почему так ? У меня в коде так:[pre2] SET EVENTS FUNCTION TO MyEventsHandler DEFINE WINDOW Form_Main ; .... // этот обработчик вызывается всегда вместо Events(...) FUNCTION MyEventsHandler( hHwnd, nMsg, wParam, lParam ) ... RETURN Events( hHwnd, nMsg, wParam, lParam) [/pre2]
Dima: Andrey У тебя с 2019 года глюки какие то с MyEventsHandler и Пётр писал тебе что нужно сделать.
Andrey: Dima пишет: У тебя с 2019 года глюки какие то с MyEventsHandler и Пётр писал тебе что нужно сделать. Что-то по форуму поискал и не нашёл это сообщение. Покажи пожалуйста его.
Dima: Тема http://clipper.borda.ru/?1-1-0-00000495-000-10001-0-1499871709 сообщение 1318
Andrey: Dima пишет: сообщение 1318 Петр пишет: Напишите корректный обработчик MYEVENTS, не перехватывайте ненужные события, перенаправьте их стандартному обработчику HMG (если, что Events() называется). Опять задание для телепатов. Дима - ошибка в другом: [pre2]Error BASE/1001 Неизвестная функция: EVENTS Args: [1] = N 67202 [2] = N 129 [3] = N 0 [4] = N 1695368 Called from EVENTS(0) Called from _CREATEWINDOWEX(0) [/pre2] Обработчик нормальный !!! У меня работает, у заказчика НЕТ ! 3 раза перепроверил только что - Версия 23.07 работает, а 23.09 вылетает
SergKis: Andrey Когда то давно предлагал вариант, который у меня в версии от 2012 года, попробуй сейчас у себя Добавка в h_events.prg [pre2] STATIC s_bEvents *-----------------------------------------------------------------------------* FUNCTION Set_bEvents ( bBlock ) *-----------------------------------------------------------------------------* LOCAL b := s_bEvents IF HB_ISCHAR( bBlock ) IF "(" $ bBlock bBlock := "{|...| " + bBlock + " }" ELSE bBlock := "{|...| " + bBlock + "(...)" + " }" ENDIF bBlock := &( bBlock ) ENDIF s_bEvents := bBlock RETURN b *-----------------------------------------------------------------------------* FUNCTION Events ( hWnd, nMsg, wParam, lParam ) *-----------------------------------------------------------------------------* ... #endif IF HB_ISBLOCK( s_bEvents ) IF !Empty( Eval( s_bEvents, hWnd, nMsg, wParam, lParam ) ) RETURN 1 ENDIF ENDIF SWITCH nMsg **************************************************************************** CASE WM_MEASUREITEM **************************************************************************** ... В программе делаешь //SET EVENTS FUNC TO App_OnEvents // или MyEventsHandler Set_bEvents("App_OnEvents") // Set_bEvents("MyEventsHandler") ... FUNCTION App_OnEvents( hWnd, nMsg, wParam, lParam ) // или MyEventsHandler( hWnd, nMsg, wParam, lParam ) ... wParam := lParam // что бы компилятор не ругался, если не используются RETURN 0 // Events( hWnd, nMsg, wParam, lParam) // nMsg НЕ выполненно [/pre2]
Dima: Andrey пишет: 3 раза перепроверил только что - Версия 23.07 работает, а 23.09 вылетает Вероятно Григорий где то не тот код написал......... Так бывает..
Andrey: Проверил у другого заказчика. У него Win7 Core i3 4Gb ОЗУ Пару раз слетало за день вот примерно с такой ошибкой. [pre2]Time from start: 0 days 0 hours 2 mins 0 secs Error BASE/1001 Неизвестная функция: EVENTS Args: [1] = N 262796 [2] = N 129 [3] = N 0 [4] = N 1240660 --------------------------------- Stack Trace --------------------------------- Called from EVENTS(0) Called from _CREATEWINDOWEX(0) Called from TSBROWSE:CREATE(0) Called from TSBROWSE:NEW(0) Called from _DEFINETBROWSE(0) Called from WINFORM3(48) in module: Source\mWinForm3.prg Called from START3WIN(57) in module: Source\mWin3Start.prg [/pre2]
Dima: Andrey а что если сделать не большой примерчик , ну там окно , меню и твой MyEventsHandler тоже будет падать ? ps такой пример могу затестить у себя , у меня win7
Andrey: Dima пишет: а что если сделать не большой примерчик , ну там окно , меню и твой MyEventsHandler тоже будет падать ? Не выйдет ! Короткие примеры работают ОЧЕНЬ четко, никогда не валятся. А вот когда ехе-ник большой (у меня 25 Мб) и юзер целый день сидит в программе, то начинаются чудеса. Вот на сервере терминалов прога вчера повисла и сутки висела, почему не знаю. Прога висит (выполняется, таймер каждые 5 минут в лог пишет), а на менюшках тыкать бесполезно. И юзер не может прогу снять, так как это сервер-терминалов, помогает только заход на сервер и снятие программы юзера на сервере. Т.е. в проге опять ОКНО ушло с фокуса и из-за этого прога ВИСИТ, хотя и работает. Уходит окно скорее всего из-за таймера, у меня в проге 3 таймера. Смотрю лог файл, там срабатывает таймер и всё, больше нет ничего, т.е. уход на таймер и окно проги потеряно. Как от этого избавиться - хз Самый длительный вариант избавления - выкинуть эту функцию по таймеру в отдельную программу, но это столько переписывать нужно..... работа на месяц...
Andrey: Прога на новом МиниГуи 23.09 на отличном сервере WinServer 2008 16Гб озу - СТАБИЛЬНО ПАДАЕТ раза два за день в одном и том же месте программы.... То работает, то падает... [pre2]Date: 29.08.2023 Time: 17:05:43 Time from start: 0 days 0 hours 20 mins 3 secs Error BASE/1001 Неизвестная функция: EVENTS Args: [1] = N 5048360 [2] = N 129 [3] = N 0 [4] = N 1630660 Date: 29.08.2023 Time: 14:01:00 Time from start: 0 days 0 hours 17 mins 43 secs Error BASE/1001 Неизвестная функция: EVENTS Args: [1] = N 7406422 [2] = N 129 [3] = N 0 [4] = N 1630660 Date: 30.08.2023 Time: 09:23:19 Time from start: 0 days 0 hours 20 mins 13 secs Error BASE/1001 Неизвестная функция: EVENTS Args: [1] = N 1836998 [2] = N 129 [3] = N 0 [4] = N 1630660 Date: 31.08.2023 Time: 16:01:08 Time from start: 0 days 7 hours 11 mins 6 secs Error BASE/1001 Неизвестная функция: EVENTS Args: [1] = N 5703460 [2] = N 129 [3] = N 0 [4] = N 1630660 --------------------------------- Stack Trace --------------------------------- Called from EVENTS(0) Called from _CREATEWINDOWEX(0) Called from TSBROWSE:CREATE(0) Called from TSBROWSE:NEW(0) Called from _DEFINETBROWSE(0) Called from FORM_MYTABLE(324) in module: Source\Tbrw_table.prg Called from TBRWZAIVKA(116) in module: Source\Tbrw_1Run.prg Called from (b)HB_MACROBLOCK(0) [/pre2] Почему ?
Dima: Andrey А если закоментить строку и пересобрать , тоже упадет ? SET EVENTS FUNCTION TO MyEventsHandler
SergKis: Andrey пишет Самый длительный вариант избавления - выкинуть эту функцию по таймеру в отдельную программу, но это столько переписывать нужно..... работа на месяц... Не соглашусь, т.к. таймер это отдельный вход-запуск, значит можно его запуск повторить с др. места, т.е. запускаем твою же программу с параметрами. Делаем (все ф-ии в твоей проге как были доступны, так и остались): 1 новые параметры входа, данные для таймера сохранили в базе, файле ... 2 создаем событие, аналог запуска таймера, например :Event( 0, {|...| ... }) // запуск ф-ии, которая была по таймеру 3 Main window другое, по параметрам 1 на него попадаем 4 на ON INIT {|| DoEvents(), _wPost(0) } 5 в событии прочитали данные из базы, файла ..., отработали
Andrey: Dima пишет: А если закоментить строку и пересобрать , тоже упадет ? SET EVENTS FUNCTION TO MyEventsHandler Не могу - пропадёт отправка записей на сайт в PostgreSql, да и некоторые вызовы функций из терминалки пропадут. У меня SendMessageData активно используется. Юзер останется с частично рабочей программой.
Haz: Andrey пишет: из-за таймера, у меня в проге 3 таймера. Вместо таймера лучше использовать зацикленный поток и из него посылать событие окну , которое вызывает нужную процедуру Еще лучше - обрабатывать отдельным потоком, но при этом не забываем что рабочие области в потоках не видны постоянно нужно передавать через зеро спэйс или открывать свои в потоке ( можно с тем же алиасом ) Переделка быстрая, к примеру этот поток контролирует oBrw:bCahange и вызывает процедуру только когда пользователь оторвал палец от клавиатурных стрелок ( есть любители ездить вверх-вниз по бровсе без остановок , что вызывает бесконечное число ненужных вызовов bChenge ) [pre2] ... __objAddData (oBrw, 'tTs' ) __objAddData (oBrw, 'lChange' ) oBrw:tTs := HB_DateTime() oBrw:lChange := .f. oBrw:bChange := {|| oBrw:tTs := HB_DateTime(), oBrw:lChange := .t. } ... Func Change() local lMore := .t. local tTs := HB_DateTime() local nTick := 0.041667 / ( 3600 * 4 ) // кждую 1/4 секунды, 0,041667 это разница во времени в 1 час while lMore if oBrw:lChange if HB_DateTime() - oBrw:tTs > nTick oBrw:lChange := .f. _wpost(100, "Form_0") end end HB_ReleaseCPU() end return nil [/pre2]
Haz: Andrey пишет: из-за таймера, у меня в проге 3 таймера. Вместо таймера лучше использовать зацикленный поток и из него посылать событие окну , которое вызывает нужную процедуру Еще лучше - обрабатывать отдельным потоком, но при этом не забываем что рабочие области в потоках не видны постоянно нужно передавать через зеро спэйс или открывать свои в потоке ( можно с тем же алиасом ) Переделка быстрая, к примеру этот поток контролирует oBrw:bCahange и вызывает процедуру только когда пользователь оторвал палец от клавиатурных стрелок ( есть любители ездить вверх-вниз по бровсу без остановок , что вызывает бесконечное число ненужных вызовов bChenge ) [pre2] ... __objAddData (oBrw, 'tTs' ) __objAddData (oBrw, 'lChange' ) oBrw:tTs := HB_DateTime() oBrw:lChange := .f. oBrw:bChange := {|| oBrw:tTs := HB_DateTime(), oBrw:lChange := .t. } ... hb_threadDetach( hb_threadStart( HB_THREAD_INHERIT_PUBLIC, @Change() )) ... Func Change() local lMore := .t. local tTs := HB_DateTime() local nTick := 0.041667 / ( 3600 * 4 ) // кждую 1/4 секунды, 0,041667 это разница во времени в 1 час while lMore if oBrw:lChange if HB_DateTime() - oBrw:tTs > nTick oBrw:lChange := .f. _wpost(100, "Form_0") end end HB_ReleaseCPU() end return nil [/pre2]
SergKis: Haz пишет Переделка быстрая, к примеру этот поток контролирует oBrw:bCahange и вызывает процедуру Не забываем, для доступа к одним и тем же Public переменным (особенно при изменении значений) надо делать блокировки доступа. Можно делать: в основном потоке PUBLIC p_oThr := oThrData():New() // блокировка доступов на уровне класса p_oThr:oBrw := oBrw в основном потоке и Thread работаем безопасно с oBrw p_oThr:oBrw:lChange := .f. ...
Andrey: Andrey пишет: Вот такая ошибка: Error BASE/1001 Неизвестная функция: EVENTS Разобрался почему так происходит. Большое СПАСИБО Сергею за его помощь. Нельзя использовать БОЛЬШОЙ ON INIT для окна, плюс в нём делал ОКНО запроса пароля ! А это получается большая вложенность. Разбил на 2-3 части и всё заработало. Пропала ошибка ! Было:[pre2] SET EVENTS FUNCTION TO MyEventsHandler DEFINE WINDOW Form_Main ; MAIN NOSHOW ; ON INIT {|| MyInitForm() } ; Сделал: Set_bEvents("MyEventsHandler") // новый синтаксис ON INIT {|| DoEvents(), _wPost(0) } ; ... WITH OBJECT This.Object :Event( 0, {|ow| // запуск при инициализации окна myInitForm() DO EVENTS _wPost(1, ow) // запуск события 1 Return Nil }) :Event( 1, {|ow| // запуск при инициализации окна myInitForm2(ow) DO EVENTS Return Nil }) ....[/pre2]
SergKis: SergKis пишет в основном потоке и Thread работаем безопасно с oBrw p_oThr:oBrw:lChange := .f. К TsBrowse это не относится, т.к в осн. потоке Tsb работает с oBrw и ему глубоко до лампочки наша переменная p_oThr, по мне, надо все делать в осн. потоке с oBrw, т.е. из потока к тсб нет прямого доступа, только, примерно, такой, на окне имеем :Event(101, {|ow,ky,lval,obr| obr := This.oBrw.Object, obr:lChange := lVal, ky := ow }) :Event(102, {|ow,ky,lval,obr| obr := This.oBrw.Object, obr:Refresh(lval), ky := ow }) в потоке делаем вместо oBrw:lChange := .f. _wSend(101, oBrw, .F.) _wPost(100, oBrw) или если надо refresh с полной прорисовкой, то _wSend(102, oBrw, .T.) oBrw идет для чтения, потому блокировка не нужна, т.к. адрес объекта oBrw не меняется похожим образом поступаем с Label и др. контролами (можно списком), в потоке в p_oThr:cLabel_1, ... заносим значения p_oThr:cLabel_1 := ... p_oThr:cLabel_2 := ... ... p_oThr:cLabel_N := ... _wPost(200, oBrw) на окне есть событие[pre2] :Event(200, {|ow| Local cNm FOR EACH cNm IN {"Label_1","Label_2",...,"Label_N"} cVal := p_oThr:&("c"+cNm) SetProperty(ow:Name, cNm, "Value", cVal) NEXT Return Nil } [/pre2]
Haz: Не забываем, для доступа к одним и тем же Public переменным Само собой с семафорами там где нужно, привел упрощённый пример в котором переменной пользуется сам поток и все
SergKis: gfilatov2002 Сделал изменения у себя в minigui.lib (h_events.prg, h_objects.prg, h_objmisc.prg) - перевел bEvents с блока кода на ф-ю hb_ExecFromArray() - сделал возможность задавать и работать с событиями в мнемонике, а не только в числах, т.е. задаем . :Events({0, "InitWindow"}, {|...| ... }) . :Events({1, "Main-Menu"}, {|...| ... }) в сообщениях исп. символьное имя вместо числового кода (если ставим много событий, то с мнемоникой легче) _wPost("InitWindow") или _wPost(0) _wPost("Main-Menu") или _wPost(1) добавил ф-ии _pPost(...), _pSend(...) для посылки сообщений App.Object параметры аналогичны _wPost(...), _wSend(...) oThis := _oThis() - вернет объект контейнер уст. This среды oThis := _oThis("Form_5") или oThis := _oThis(ow) - поставит среду окна из параметра и вернет объект контейнер уст. This среды oThis := _oThis(oThis) - вернет что было в тек. This, поставит из oThis Переменные объекта контейнера для работы oThis:nFormIndex oThis:cEventType oThis:cType oThis:nIndex oThis:cFormName oThis:cControlName не знаю, надо это или нет ? Пример кода [pre2] WITH OBJECT This.Object // events begin :Event({ 0, "myInit_Window"}, {|ow| // запуск при инициализации окна ... Return Nil }) :Event({ 1, "myMain-Menu"}, {|ow| // главное событие запуска всех отложенных событий ... Return Nil }) посылать сообщения можно так _wPost(0), _wPost(1) или _wPost("myInit_Window"), _wPost("myMain-Menu") Для App.Object (работа таймеров в осн. потоке БЕЗ учета\смены среды This) WITH OBJECT App.Object // объект программы // set events App\Program begin :Event({ 1, "Timer_1" }, {|oa,ky,nn,cnam| // таймер 1 ... :Event({ 2, "Timer_2" }, {|oa,ky,nn,cnam| // таймер 2 ... :Event({10, "Timer_All"}, {|oa,ky,nn,cnam| // таймера все 3-и в одном событии, для примера ... посылаем сообщения так (это SET EVENTS FUNC TO App_OnEvents или Set_bEvents("App_OnEvents")) FUNCTION App_OnEvents( hWnd, nMsg, wParam, lParam ) ... ********************************************************************** CASE WM_TIMER ********************************************************************** cMsg := "Event arrived - WM_TIMER" IF ( i := AScan ( _HMG_aControlIds, wParam ) ) > 0 cn := _HMG_aControlNames[ i ] ky := Val( subs(cn, RAt("_", cn) + 1) ) cMsg += " = " + cn + " ( ky = "+hb_ntos(ky)+" )" // не меняет среду This i := "Timer_"+hb_ntos(ky) // имя события _pPost(i, ky, cn) //_pPost(ky, ky, cn) //(App.Object):PostMsg(ky, ky, cn) // свое событие у timer-а //IF ky == 9 // (App.Object):PostMsg(ky, 0, cn) // 1.свое событие у timer-а //ELSE //_pPost("Timer_All", ky, cn) // (App.Object):PostMsg(10, ky, cn) // 2.одно событие для 3-х timer-ов, //ENDIF ENDIF ... [/pre2]
PSP: SergKis пишет: не знаю, надо это или нет ? Хоть я и не в теме minigui, но могу точно сказать: надо!) Это читается и воспринимается легче. #define тоже не просто так придумали когда-то)
gfilatov2002: SergKis пишет: Сделал изменения у себя SergKis Как я уже ранее писал на форуме, любые Ваши изменения интересны и познавательны, поскольку они основаны на практическом опыте. Но очень важно иметь в библиотеке пример применения этих изменений (например, как Tsb_Basic_3 или Tsb_Basic_4), так как это другой стиль написания кода, который требует понимания взаимосвязи функций и событий.
gfilatov2002: Andrey пишет: Вот такая ошибка: Error BASE/1001 Неизвестная функция: EVENTS Уже поправил код, чтобы такая ошибка не возникала и функция EVENTS() не терялась
SergKis: gfilatov2002 пишет Но очень важно иметь в библиотеке пример применения этих изменений (например, как Tsb_Basic_3 или Tsb_Basic_4), так как это другой стиль написания кода, который требует понимания взаимосвязи функций и событий. Сделаю, надо на подумать время
Andrey: gfilatov2002 пишет: Уже поправил код, чтобы такая ошибка не возникала и функция EVENTS() не терялась Григорий, когда обновление будет ? Добавил в код ещё пару форм и всё труба, опять у заказчика лезет ошибка: [pre2]Error BASE/1001 Неизвестная функция: EVENTS Args: [1] = N 524726 [2] = N 129 [3] = N 0 [4] = N 1632052 --------------------------------- Stack Trace --------------------------------- Called from EVENTS(0) Called from _CREATEWINDOWEX(0) Called from TSBROWSE:CREATE(0) Called from TSBROWSE:NEW(0) Called from _DEFINETBROWSE(0) Called from FORM_MYTABLE(324) in module: Source\Tbrw_table.prg Called from TBRWDOGOVOR(16) in module: Source\Tbrw_1Run.prg Called from EXECTASK(172) in module: Source\ExecTask.prg Called from HB_EXECFROMARRAY(0) Called from (b)METRO_BUTTON(455) in module: Source\main_forms.prg Called from DO_WINDOWEVENTPROCEDURE(82) in module: h_objmisc.prg Called from TWNDDATA:DOEVENT(1233) in module: h_objects.prg Called from DO_ONWNDLAUNCH(256) in module: h_objmisc.prg Called from (b)INIT(126) in module: h_init.prg [/pre2] Разбил свой ON INIT на 4 события, не помогает... Блин заколдованный круг, у меня работает у заказчика нет. У заказчика на сервере 16 Гб оперативки, а прога не может найти функцию в ядре программы.
alkresin: Andrey пишет: прога не может найти функцию в ядре программы. Я не имею представления о внутренностях Minigui, но с подобным сталкивался - в моем HbEdit. Это происходило иногда во время выполнения кода в Idle - состоянии. Пришлось, в конце концов, отказаться от использования Idle и реализовать нужную функциональность другим образом. Так что, похоже, проблема где-то во внутренностях Harbour. Еще один похожий эпизод был с использованием таймера в программе на HwGUI, тогда, правда, это не проявлялось в "забывании" имени функции. Иногда, ровно в 24:00, программа вылетала в функции - обработчике таймера. Проверял сто раз - вылетала программа в самом начале выполнения функции, до всяких действий. Пришлось сделать глупейшую вещь: перед полуночью временно изменял интервал таймера, чтобы он не срабатывал в 24:00. Помогло). Здесь я грешу на Windows. Harbour и HwGUI, полагаю, тут не замешаны.
Andrey: Новая версия МиниГуи 23.09 Опять засада в работающем коде. В старой версии 23.04.4 ни разу такого не было !!! У юзера за сегодня ПЯТЫЙ раз (это только 13:00) за сегодня падает программа вот с такой ошибкой: [pre2]DbInfo: Alias - USER2LOG, Recno - 138035/138035 Time from start: 0 days 0 hours 0 mins 59 secs Error BASE/1003 Переменная не существует: EVENT --------------------------------- Stack Trace --------------------------------- Called from USER2LOGWRITE(103) in module: Source\users2log.prg Called from USERLOGGETBOXCARD(4702) in module: Source\Tbrw_fCard.prg Called from MYWRTGETUSERLOG(2742) in module: Source\Tbrw_fCard.prg Called from (b)MYCARDFIELDGETBOX(2611) in module: Source\Tbrw_fCard.prg Called from _DOCONTROLEVENTPROCEDURE(1993) in module: h_windows.prg Called from EVENTS(2146) in module: h_events.prg Called from DOMESSAGELOOP(0) [/pre2] Вот мой код: [pre2] nSel := SELECT("User2Log") IF nSel == 0 cMsg := ";;БАЗА ЖУРНАЛА-действий закрыта !;" WaitWindowError( cMsg ) ELSE SELECT User2Log APPEND BLANK // добавить запись dDT := User2Log->DT_MODIFY IF User2Log->( RLock() ) User2Log->EVENT := dDT // 3 TimeStamp 8 0 - строка 103 User2Log->NEVENT := nEvtn // 6 Numeric 6 0[/pre2] Да, имел неосторожность назвать поле EVENT И что теперь делать ? Переименовывать ?
SergKis: Попробуй (alias уже установлен ссылку можно не делать) 1. FieldPut(FieldPos('EVENT'), dDT) 2. REPLACE EVENT with dDT или REPL EVENT with dDT // тут может FIELD-><имя> добавлять надо 3. hRec := { "EVENT" => dDT, "NEVENT" => nEvtn } lRet := HMG_HashToRec( hRec ) RLock\UnLock внутри есть, можешь проверить lRet -> .T. - Ok! PS Можешь читать запись в Hash. hRec := HMG_RecToHash( cFieldList, cNames ) (данные получает по макро, лучше бы через FieldGet(FieldPos(...))) Можешь писать запись из Hash. HMG_HashToRec( hRec, cFieldList ) Можешь получить запись в контейнере oRec := oHmgData() ; oRec:Set(HMG_RecToHash(), .T.) или oRec := oHmgData():Set(HMG_RecToHash(), .T.) и работать ? oRec:Event, oRec:NEvent oRec:Event := dDT oRec:NEVENT := nEvtn lRet := HMG_HashToRec(oRec:CloneHash()) если названия полей не совпадут с методами
gfilatov2002: Подготовил 1-е обновление для сборки 23.09 с последними исправлениями и дополнениями, которое будет опубликовано на следующей неделе Что исправлено: * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - fixed an incorrect call of the Events() function when changing of the main event listener with the SET EVENTS FUNCTION TO <name> command. The bug was reported by Verchenko Andrey Благодарю Андрея за настойчивость и Сергея - за точное определение причины этой ошибки
SergKis: gfilatov2002 Немного модифицируйте ф-ю в Excel (я не работаю с ole совсем, потому сделать ... ), добавить вывод строк заголовков и подножия, т.е. что то такое[pre2] *-----------------------------------------------------------------------------* FUNCTION HMG_DbfToExcel( cFieldList, aHeader, bFor, bWhile, nNext, nRec, lRest ) *-----------------------------------------------------------------------------* LOCAL nRecNo := RecNo() LOCAL bLine, aFooter, aTitle, o LOCAL oExcel, oBook, oSheet, oRange LOCAL nCols LOCAL nRow := 1 IF HB_ISOBJECT( aHeader ) .and. aHeader:ClassName $ "THMGDATA,TKEYDATA,TTHRDATA" o := aHeader aHeader := o:aHeader aFooter := o:aFooter aTitle := o:aTitle ELSEIF HB_ISARRAY( aHeader ) o := ASize( AClone( aHeader ), 3 ) aHeader := o[1] aFooter := o[2] aTitle := o[3] ENDIF ... далее добавить строки из aTitle фонт bold, если заданы (колонки объединить) в конце таблицы строки из aFooter фонт bold, если заданы (как колонки aHeader) [/pre2]
SergKis: PS Ф-я HMG_HashToRec( hRec, cFieldList ) не учитывает наличие защищенных полей и что ключ может быть не символьный, а значение к ключу NIL, т.е. из ф-ии oRecPut(oRec, aFieldList) обрывок[pre2] FOR EACH aFld IN oRec:GetAll() cFld := aFld[1] IF !HB_ISCHAR( cFld ) .or. aFld[2] == NIL LOOP ENDIF IF ( nPos := FieldPos( cFld ) ) > 0 IF FieldType( nPos ) $ "+^=" LOOP // write protection ENDIF FieldPut( nPos, aFld[2] ) nCnt++ ENDIF NEXT [/pre2]
Andrey: Что-то непонятная ошибка начала показываться: Какая картинка, строка вызова - ничего нет. Гадание на кофейной гуще... Да я что-то забыл указать, а где искать то ?
Andrey: Нашёл в исходнике h_tbrowse.prg эту ошибку: [pre2] IF uBitMap != NIL .AND. ValType( uBitMap ) != "L" DEFAULT lNoLines := .T. cHeading := iif( ValType( uBitMap ) == "B", Eval( uBitMap ), uBitMap ) cHeading := iif( ValType( cHeading ) == "O", Eval( ::bBitMapH, cHeading ), cHeading ) IF Empty( cHeading ) MsgStop( "Image is not found!" + CRLF + "cHeading=???????" + CRLF + ProcNL(), "Error" ) RETURN NIL ENDIF nLHeight := SBmpHeight( cHeading )[/pre2] Добавить так можно ? Ещё бы указать какой картинки нет. Только я не знаю как ?
SergKis: SergKis пишет Сделаю, надо на подумать время Пример тут https://TransFiles.ru/cin6x Что сделано [pre2] Прилагаемый пример сделан на основе APP_OOPREPORT\demo.prg, на кнопку Print окни выборки-отчета Report сделал вызов AlertInfo(), вместо MsgInfo(), что бы показать как работает фокус на этих окнах, т.к. окно AlertInfo() это hmg, а окно MsgInfo() - нет. Правил файлы: - h_controlmisc2.prg ~~~~~~~~~~~~~~~~~~~~ ... добавил, пропущенные свойства в DEFINE TBROWSE ON GOTFOCUS oParam:bOnGotFocus ; ON CHANGE oParam:bOnChange ; ON LOSTFOCUS oParam:bOnLostFocus ; ON DBLCLICK oParam:bOnDblClick ; ... - h_events.prg ~~~~~~~~~~~~~~ ... добавил код STATIC s_bEvents, s_lEvents := .F. *-----------------------------------------------------------------------------* FUNCTION Set_bEvents ( bBlock ) *-----------------------------------------------------------------------------* IF HB_ISCHAR( bBlock ) .and. "(" $ bBlock bBlock := hb_ULeft( bBlock, hb_UAt( "(", bBlock ) - 1 ) ENDIF s_lEvents := !Empty( bBlock ) RETURN ( s_bEvents := bBlock ) *-----------------------------------------------------------------------------* FUNCTION Events ( hWnd, nMsg, wParam, lParam ) *-----------------------------------------------------------------------------* ... IF s_lEvents IF HB_ISBLOCK( s_bEvents ) // could be a static function IF !Empty( Eval( s_bEvents, hWnd, nMsg, wParam, lParam ) ) RETURN 1 ENDIF ELSEIF HB_ISCHAR( s_bEvents ) // Can't be a static function IF !Empty( hb_ExecFromArray(s_bEvents, {hWnd, nMsg, wParam, lParam}) ) RETURN 1 ENDIF ENDIF ENDIF ... Задавать свой обработчик можно так 1. Set_bEvents("App_OnEvents") // NO static function 2. Set_bEvents( {|...| App_OnEvents(...) } ) // static function Во втором случае обработчик может быть STATIC FUNCTION, по мне, предпочтительнее, т.е. STATIC FUNCTION App_OnEvents( hWnd, nMsg, wParam, lParam ) ... - h_objects.prg ~~~~~~~~~~~~~~~ ... добавлена возможность задавать не только числом, но символьной мнемоникой: WITH OBJECT App.Object // set events App\Program begin :Event({ 1, "Timer_1"}, {|oa,ky,nn,cnam| // таймер 1 ... :Event({ 2, "Timer_2"}, {|oa,ky,nn,cnam| // таймер 2 ... :Event({ 1, 'отчет First'}, {|ow,ky| Report(ow, ky) } ) :Event({ 2, 'отчет Last' }, {|ow,ky| Report(ow, ky) } ) ... активация событий посылкой сообщения так // App.Object _pPost(1, nParam, xParam) _pPost("Timer_1", nParam, xParam) _pPost(2, nParam, xParam) _pPost("Timer_2", nParam, xParam) // This.Object :UserKeys( VK_1, {|ob| _wPost('отчет First' , ob:cParentWnd) } ) или :UserKeys( VK_1, {|ob| _wPost(1, ob:cParentWnd) } ) :UserKeys( VK_2, {|ob| _wPost(2, ob:cParentWnd) } ) или :UserKeys( VK_2, {|ob| _wPost('отчет Last' , ob:cParentWnd) } ) ON KEY SHIFT+1 ACTION _wPost('отчет First' ) или ON KEY SHIFT+1 ACTION _wPost(1) ON KEY SHIFT+2 ACTION _wPost(2) или ON KEY SHIFT+2 ACTION _wPost('отчет Last' ) ... В прилагаемом примере показано это - h_objmisc.prg ~~~~~~~~~~~~~~~ ... поправлены ф-ии и добавлены новые _pPost(nEvent, nParam, xParam) - активация событий для App.Object _pSend(nEvent, nParam, xParam) - активация событий для App.Object _oThis() - снимок текущей среды This в oHmgData(), формирование переменных аналогов _HMG_This... ( o := oTis ): o:FormIndex o:EventType o:Type o:Index o:FormName o:ControlName o:FocusedForm o:FocusedControl o:ControlCargo o:ControlHandle o:ControlParentHandle o:ControlParentName o:FormCargo o:FormHandle o:FormParentHandle o:FormObject если o:FocusedForm и o:FocusedControl имеют значение (фокус на hmg), а o:FormName не задано или задано, но др. именем, то все переменные объекта oThis приводятся к значениям от o:FocusedForm, только среда окна, не контрола. Преременные _HMG_This... по умолчанию не меняются, но их можно принудительно привести в соответствие переменным объекта oThis. Для этого надо в функция получения использовать параметр lSets может принимать значения: 0 - вернуть все как есть, без приведения к переменной o:FocusedForm .F. - привести только внутренние переменные oThis к значениям от переменной o:FocusedForm .T. - привести все переменные, включая _HMG_This..., к значениям от переменной o:FocusedForm В прилагаемом примере показано использование _oThis(), параметры FUNCTION _oThis( oThis, lSets ) // Snapshot of current data This or Sets ... - h_tbrowse.prg ~~~~~~~~~~~~~~~ ... METHOD LostFocus( hCtlFocus ) CLASS TSBrowse ... IF ! Empty( ::bLostFocus ) Eval( ::bLostFocus, hCtlFocus, Self ) //!!! правка ENDIF // ^^^^ ... В методе ::GotFocus( hCtlLost ) и ::LostFocus( hCtlFocus ) сторическое не соответсвие параметров IF ::bGotFocus != NIL Eval( ::bGotFocus, Self, hCtlLost ) ENDIF // ^^^^ [/pre2]
gfilatov2002: SergKis пишет: Что сделано ОК, принято Пример demo3 работает нормально с учетом всех правок
SergKis: gfilatov2002 Правки в примере, упустил чуток[pre2] 1. INIT PROCEDURE Sets_ENV() ... (App.Object):IsError правильнее применять чем (App.Object):lError , т.е. можно оба варианта IF (App.Object):IsError // ошибка создания обработчика сообытий App.Object MsgStop( (App.Object):cError, "ERROR" ) QUIT ENDIF ... END WITH fErase( App.Cargo:cTimer1Log ) fErase( App.Cargo:cTimer2Log ) RETURN 2. для сортировки колонок по двойному клику STATIC FUNCTION TsbReport( oWnd, nEvent, aArray, cColName ) ... :UserKeys( VK_F6, {|ob| _wPost(/*2*/"Excel", ob) } ) :lNoChangeOrd := .F. AEval( :aColumns, {|oc,nc| oc:lFixLite := .T., ; oc:lIndexCol := nc > 1 }) :AdjColumns({3, 4, 5, 6}) // :AdjColumns() ... 3. сместить вложенные данные при выводе FUNCTION o2Log( o, nLen, cMsg ) ... IF HB_ISOBJECT( a[2] ) ; o2Log( a[2], nLen + 5 ) ELSE ; ?? a[2] ENDIF ... [/pre2]
gfilatov2002: SergKis пишет: Правки в примере Принято. Благодарю за помощь
SergKis: gfilatov2002 Еще небольшая правка (подумал, что информация о контроле в фокусе должна быть всегда)[pre2] FUNCTION _oThis( oThis, lSets ) // Snapshot of current data This or Sets ... o:FocusedForm := "" o:FocusedControl := "" o:FocusedControlIndex := 0 IF !Empty( c := GetFocus() ) IF ( k := AScan( _HMG_aControlHandles, c ) ) > 0 o:FocusedControlIndex := k o:FocusedControl := _HMG_aControlNames [ k ] ... ENDIF k := iif( Empty( _HMG_ThisControlName ), o:FocusedControlIndex, _HMG_ThisIndex ) IF !Empty( k ) o:ControlCargo := _HMG_aControlMiscData2 [ k ] o:ControlHandle := _HMG_aControlHandles [ k ] o:ControlParentHandle := _HMG_aControlParenthandles [ k ] o:ControlParentName := GetParentFormName ( k ) ENDIF IF _HMG_ThisFormIndex > 0 ... и в примере правка, обсчитался в max длине имени переменной FUNCTION myTimer_1( oThis ) ... o2Log(oThis, 19, "*** oThis =>") ... FUNCTION myTimer_2( oThis ) ... o2Log(oThis, 19, "*** oThis =>") ... [/pre2]
gfilatov2002: SergKis пишет: Еще небольшая правка OK
Andrey: Минигуи 23.09 Вот такая ошибка появляется:[pre2] Как это понять ? Может есть переключатель для вывода ошибок ТОЛЬКО на английском ?
SergKis: gfilatov2002 Предложение по _LogFile(...). 1-й параметр сделать не только Logical, а Array или Char, для того, что бы на таймерах можно было использовать для них свои имена файлов log [pre2] *-----------------------------------------------------------------------------* #ifndef __XHARBOUR__ FUNCTION _LogFile( lCrLf, ... ) #else FUNCTION _LogFile( ... ) #endif *-----------------------------------------------------------------------------* LOCAL hFile, i, xVal, cTp LOCAL aParams := hb_AParams() LOCAL nParams := Len( aParams ) LOCAL cFile := hb_defaultValue( _SetGetLogFile(), GetStartUpFolder() + hb_ps() + "_MsgLog.txt" ) #ifdef __XHARBOUR__ LOCAL lCrLf #endif IF nParams > 0 IF HB_ISCHAR( aParams[1] ) aParams[1] := { .T., aParams[1] } ENDIF IF HB_ISARRAY( aParams[1] ) IF Len( aParams[1] ) > 1 IF HB_ISLOGICAL( aParams[1][1] ) // { .T.\.F. , cFile } cTp := aParams[1][2] aParams[1] := aParams[1][1] ELSEIF HB_ISLOGICAL( aParams[1][2] ) // { cFile , .T.\.F. } cTp := aParams[1][1] aParams[1] := aParams[1][2] ELSE // errors aParams[1] := .T. ENDIF IF !Empty( cTp ) IF !hb_ps() $ cTp cTp := GetStartUpFolder() + hb_ps() + cTp ENDIF cFile := cTp ENDIF ELSE // errors aParams[1] := .T. ENDIF cTp := NIL lCrlf := aParams[1] ENDIF ENDIF IF !Empty( cFile ) ... В примере APP_OOPREPORT\demo3.prg можно сделать (для примера по одной строке, например) *-----------------------------------------------------------------------------* FUNCTION myTimer_1( oThis ) *-----------------------------------------------------------------------------* ... LOCAL cLog := "_timer_1.log" ... _LogFile({.T., cLog}, "@@@ Timer_1 - 1", HB_DATETIME(), ProcName(), nCnt) _LogFile(cLog, "@@@ Timer_1 - 2", HB_DATETIME(), ProcName(), nCnt) _LogFile({cLog, .T.}, "@@@ Timer_1 - 3", HB_DATETIME(), ProcName(), ProcLine(), nCnt) ? "@@@ Timer_1", HB_DATETIME(), ProcName(), nCnt ... *-----------------------------------------------------------------------------* FUNCTION myTimer_2( oThis ) *-----------------------------------------------------------------------------* ... LOCAL cLog := "_timer_2.log" ... _LogFile({.T., cLog}, "@@@ Timer_2 - 1", HB_DATETIME(), ProcName(), nCnt) _LogFile(cLog, "@@@ Timer_2 - 2", HB_DATETIME(), ProcName(), nCnt) _LogFile({cLog, .T.}, "@@@ Timer_2 - 3", HB_DATETIME(), ProcName(), ProcLine(), nCnt) ? "@@@ Timer_2", HB_DATETIME(), ProcName(), nCnt ... [/pre2]
SergKis: PS Возможно, для стека This переменных надо ставить правильный тип для child окна, т.к. в реале "W" типа нет, т.е[pre2] *-----------------------------------------------------------------------------* PROCEDURE _PushEventInfo *-----------------------------------------------------------------------------* AAdd ( _HMG_aEventInfo , { _HMG_ThisFormIndex , _HMG_ThisEventType , ; iif( _HMG_ThisType == "W", "C", _HMG_ThisType ) , ; _HMG_ThisIndex , _HMG_ThisFormName , _HMG_ThisControlName } ) RETURN *-----------------------------------------------------------------------------* PROCEDURE _PopEventInfo( n ) *-----------------------------------------------------------------------------* ... _HMG_ThisType := iif( _HMG_aEventInfo [l] [3] == "C", "W", _HMG_aEventInfo [l] [3] ) ... [/pre2] С этим правками не уверен, т.к. протокол (смотрим ниже пост) выдает[pre2] *** aForm => ARRAY[3] // это дает HMG_GetForms( , .T. ) 1. {1, "A", "wMainInit", 201590000, "Template of the finished program on MiniGui"} 2. {2, "S", "Forma_Main", 19072408, "STANDARD: Forma_Main (1280x720)"} 3. {3, "S", "Form_ListCD", 30868462, "Message log WM_COPYDATA"} *** _HMG_aEventInfo => ARRAY[3] // это стек This переменных 1. {0, "", "", 0, NIL, NIL} 2. {1, "", "W", 1, "wMainInit", ""} 3. {2, "", "W", 2, "Forma_Main", ""} [/pre2] такой подмены типов S -> W не было, была C -> W
SergKis: PS2 Если сделать изменения по _LogFile(), как выше, то ф-я o2Log(...) из примера APP_OOPREPORT\demo3.prg может быть такой (сделана модификация) [pre2] *----------------------------------------------------------------------------* FUNCTION o2Log( o, nLen, cMsg, lExt, cLog ) *----------------------------------------------------------------------------* LOCAL a, b, c, i, j, k := pCount() DEFAULT lExt := .F., cLog := _SetGetLogFile() IF HB_ISCHAR(o) IF ( i := At("*", o) ) > 0 c := o o := upper(o) b := subs(o+" ", i + 1) IF left(o, i) $ "FORM*,FORMS*,AFORM*,AFORMS*" DEFAULT nLen := 12 o := {} b := iif( Empty(b), "", upper(alltrim(b)) ) FOR EACH a IN HMG_GetForms( , .T. ) IF iif( Empty(b), .T., a:Type $ b ) AAdd(o, {hb_enumIndex(a), a:Type, a:Index, a:Name, a:Handle, a:Title}) ENDIF NEXT c := iif( Empty(b), "", "<"+c+">"+" " ) Default cMsg := "==> aForms: " + c k := 3 ELSEIF left(o, i) $ "P*,PROC*, PROCNL*" DEFAULT nLen := 25 b := Val( b ) i := 0 o := oHmgData() WHILE ( ++i < 100 ) IF Empty( j := procname(i) ) ; EXIT ENDIF o:Set(TR0(ProcFile(i), nLen-7)+str(procline(i), 7), j) IF b > 0 .and. i >= b ; EXIT ENDIF END b := i := Nil Default cMsg := "==> ProcNL: " k := 3 ENDIF ENDIF ENDIF DEFAULT nLen := 19 IF k > 2 .and. HB_ISCHAR(cMsg) ; _LogFile({.T., cLog}, cMsg) ELSEIF !Empty(cMsg) ; _LogFile({.T., cLog}, Nil) ENDIF IF HB_ISOBJECT( o ) _LogFile({.F., cLog}, "O:"+o:ClassName) IF o:ClassName $ "THMGDATA,TKEYDATA,TTHRDATA,TINIDATA" _LogFile({.F., cLog}, o:GetAll()) FOR EACH a IN o:GetAll() i := hb_enumIndex( a ) b := iif( HB_ISCHAR( a[1] ), TR0(a[1], nLen), a[1] ) _LogFile({.T., cLog}, TR0(i, nLen-1)+".", b, "=") IF HB_ISOBJECT( a[2] ) IF lExt o2Log( a[2], nLen + 5, , , cLog ) ELSE _LogFile({.F., cLog}, "O:"+a[2]:ClassName) IF a[2]:ClassName $ "THMGDATA,TKEYDATA,TTHRDATA,TINIDATA" _LogFile({.F., cLog}, a[2]:GetAll()) ELSEIF a[2]:ClassName == "TWNDDATA" _LogFile({.F., cLog}, a[2]:Name, a[2]:Type) ELSEIF a[2]:ClassName $ "TCNLDATA,TTSBDATA,TGETDATA,TSTBDATA" _LogFile({.F., cLog}, a[2]:Window, a[2]:Name, a[2]:Type) ELSEIF a[2]:ClassName == "TBROWSE" _LogFile({.F., cLog}, a[2]:cControlName, a[2]:cParentWnd) ENDIF ENDIF ELSEIF HB_ISARRAY( a[2] ) .and. lExt _LogFile({.F., cLog}, hb_valtoexp( a[2] )) ELSE _LogFile({.F., cLog}, a[2]) ENDIF NEXT ELSEIF o:ClassName == "TWNDDATA" _LogFile({.F., cLog}, o:Name, o:Type) ELSEIF o:ClassName $ "TCNLDATA,TTSBDATA,TGETDATA,TSTBDATA" _LogFile({.F., cLog}, o:Window, o:Name, o:Type) ELSEIF o:ClassName == "TBROWSE" _LogFile({.F., cLog}, o:cControlName, o:cParentWnd) ENDIF ELSEIF HB_ISARRAY( o ) _LogFile({.F., cLog}, o) FOR EACH a IN o i := hb_enumIndex( a ) IF HB_ISOBJECT( a ) o2Log( a, nLen, , , cLog ) ELSEIF HB_ISARRAY( a ) _LogFile({.T., cLog}, TR0(i, nLen-1)+".") IF lExt _LogFile({.F., cLog}, a) FOR EACH j IN a k := hb_enumIndex( j ) _LogFile({.T., cLog}, TR0(k, nLen-1+5)+".", hb_valtoexp( j )) NEXT ELSE _LogFile({.F., cLog}, hb_valtoexp( a )) ENDIF ELSE _LogFile({.F., cLog}, a) ENDIF NEXT ELSE _LogFile({.F., cLog}, o) ENDIF RETURN .T. *----------------------------------------------------------------------------* FUNCTION TR0( cTxt, nLen, cSim ) *----------------------------------------------------------------------------* IF !HB_ISCHAR(cTxt) ; cTxt := cValToChar(cTxt) ENDIF Default nLen := Len(cTxt) IF cSim == Nil; cSim := " " ENDIF RETURN PadL( AllTrim( cTxt ), nLen, cSim ) [/pre2] применение[pre2] // доп. ф-ии FUNCTION To2Log(lExt) // lExt = .T. - расширенная распечатка, массивы по вертикали, объекты по содержимому o2Log(_oThis(), 19, "*** oThis =>", lExt) o2Log(oGetForms(.F.), 12, "*** aForm =>", lExt) o2Log(_HMG_aEventInfo,12, "*** _HMG_aEventInfo =>", lExt) o2Log("procNL*") RETURN Nil FUNCTION oGetForms(lChar) LOCAL aForms := {}, cRet := "", ow, aw Default lChar := .T. FOR EACH ow IN HMG_GetForms( , .T. ) AAdd(aForms, {hb_enumIndex(), ow:Type, ow:Name, ow:Handle, ow:Title} ) NEXT IF lChar FOR EACH aw IN aForms cRet += hb_valtoexp(aw) + CRLF NEXT RETURN cRet ENDIF RETURN aForms [/pre2] вызовы (это для отладки) ? "*** TsbObjViewer() *** Start" ; To2Log() ; ? TsbObjViewer(oWin, oUse, oIndx, oMenu, oTsb, aEvent, bInitForm) ? "*** TsbObjViewer() *** Stop" ; To2Log() ; ? результат [pre2] *** TsbObjViewer() *** Start *** oThis => O:THMGDATA ARRAY[13] 1. FORMINDEX = 2 2. EVENTTYPE = '' 3. TYPE = S 4. INDEX = 2 5. FORMNAME = Forma_Main 6. CONTROLNAME = '' 7. FOCUSEDFORM = '' 8. FOCUSEDCONTROL = '' 9. FOCUSEDCONTROLINDEX = 0 10. FORMHANDLE = 19072408 11. FORMPARENTHANDLE = 0 12. FORMPARENTNAME = '' 13. FORMCARGO = O:THMGDATA ARRAY[5] *** aForm => ARRAY[3] 1. {1, "A", "wMainInit", 201590000, "Template of the finished program on MiniGui"} 2. {2, "S", "Forma_Main", 19072408, "STANDARD: Forma_Main (1280x720)"} 3. {3, "S", "Form_ListCD", 30868462, "Message log WM_COPYDATA"} *** _HMG_aEventInfo => ARRAY[3] 1. {0, "", "", 0, NIL, NIL} 2. {1, "", "W", 1, "wMainInit", ""} 3. {2, "", "W", 2, "Forma_Main", ""} ==> ProcNL: O:THMGDATA ARRAY[14] 1. UTIL_MISC.PRG 17 = TO2LOG 2. TABLE4.PRG 82 = MY_STANDARD4 3. MAINMENU_FORM.PRG 283 = MY_BTN 4. MAINMENU_FORM.PRG 238 = (b)FORM_MENU_MAIN 5. H_OBJMISC.PRG 82 = DO_WINDOWEVENTPROCEDURE 6. H_OBJECTS.PRG 1279 = TWNDDATA:DOEVENT 7. H_OBJMISC.PRG 483 = DO_ONWNDLAUNCH 8. H_INIT.PRG 126 = (b)INIT 9. H_EVENTS.PRG 1283 = EVENTS 10. WAITWINGIF.PRG 0 = DOMESSAGELOOP 11. H_WINDOWS.PRG 1597 = _ACTIVATEWINDOW 12. MAINMENU_FORM.PRG 252 = FORM_MENU_MAIN 13. MAIN.PRG 476 = (b)SETS_EVENT2MAINWINDOW 14. MAIN.PRG 170 = MAIN Call from: TSBVIEWER(80) --> TsbViewer.prg aWinPar= ARRAY[13] {"WAIT", "Button_4: 4 Sample 4", 0, 0, 1280, 680, .F., {0, 176, 240}, {"LblDown", 23, {255, 255, 255}, {0, 120, 215}, .T., "! you can write something here ...."}, .F., NIL, {|| ... }, {|| ... }} ... *** TsbObjViewer() *** Stop *** oThis => O:THMGDATA ARRAY[13] 1. FORMINDEX = 2 2. EVENTTYPE = '' 3. TYPE = S 4. INDEX = 2 5. FORMNAME = Forma_Main 6. CONTROLNAME = '' 7. FOCUSEDFORM = '' 8. FOCUSEDCONTROL = '' 9. FOCUSEDCONTROLINDEX = 0 10. FORMHANDLE = 19072408 11. FORMPARENTHANDLE = 0 12. FORMPARENTNAME = '' 13. FORMCARGO = O:THMGDATA ARRAY[5] *** aForm => ARRAY[3] 1. {1, "A", "wMainInit", 201590000, "Template of the finished program on MiniGui"} 2. {2, "S", "Forma_Main", 19072408, "STANDARD: Forma_Main (1280x720)"} 3. {3, "S", "Form_ListCD", 30868462, "Message log WM_COPYDATA"} *** _HMG_aEventInfo => ARRAY[3] 1. {0, "", "", 0, NIL, NIL} 2. {1, "", "W", 1, "wMainInit", ""} 3. {2, "", "W", 2, "Forma_Main", ""} ==> ProcNL: O:THMGDATA ARRAY[14] 1. UTIL_MISC.PRG 17 = TO2LOG 2. TABLE4.PRG 86 = MY_STANDARD4 3. MAINMENU_FORM.PRG 283 = MY_BTN 4. MAINMENU_FORM.PRG 238 = (b)FORM_MENU_MAIN 5. H_OBJMISC.PRG 82 = DO_WINDOWEVENTPROCEDURE 6. H_OBJECTS.PRG 1279 = TWNDDATA:DOEVENT 7. H_OBJMISC.PRG 483 = DO_ONWNDLAUNCH 8. H_INIT.PRG 126 = (b)INIT 9. H_EVENTS.PRG 1283 = EVENTS 10. WAITWINGIF.PRG 0 = DOMESSAGELOOP 11. H_WINDOWS.PRG 1597 = _ACTIVATEWINDOW 12. MAINMENU_FORM.PRG 252 = FORM_MENU_MAIN 13. MAIN.PRG 476 = (b)SETS_EVENT2MAINWINDOW 14. MAIN.PRG 170 = MAIN ... [/pre2] PS Заменил, текст ф-ии o2Log(...), т.к. потерял при перетаскивании часть строк, ее можно применять для App.Cargo, This.Object:Cargo, но она исп. правку для _LogFile(...) ф-ии из поста выше
gfilatov2002: Выложил 1-е обновление сборки 23.09 по адресу Скачать Желаю всем хорошего дня!
Andrey: Собрал свою большую систему на новой версии - падает сразу при запуске. Вот такая ошибка: [pre2]Time from start: 0 days 0 hours 0 mins 0 secs Error BASE/1004 Message not found: TWNDDATA:EVENT Args: [1] = O TWNDDATA --------------------------------- Stack Trace --------------------------------- Called from __ERRRT_SBASE(0) Called from TWNDDATA:ERROR(0) Called from (b)HBOBJECT(0) Called from TWNDDATA:MSGNOTFOUND(0) Called from TWNDDATA:EVENT(0) Called from MAIN(158) in module: Source\main.prg [/pre2] Вот код: [pre2] SET EVENTS FUNCTION TO MyEventsHandler DEFINE WINDOW Form_Main ; MAIN NOSHOW ; NOMAXIMIZE NOSIZE NOCAPTION ; ON INIT {|| DoEvents(), _wPost(0) } ; ON RELEASE {|| _LogFile(.T., CRLF + ">>> STOP <<< " + HMG_TimeMS(App.Cargo:tStart) ) } ; .... WITH OBJECT This.Object :Event( 0, {|ow| // запуск при инициализации окна Local hWnd, cWnd hWnd := ow:Handle cWnd := ow:Name ? REPL(".", 90 ) ? SPACE(5) + ":Event(0)", ProcNL(), hWnd, IsIconic( hWnd ), cWnd, _HMG_MainHandle myInitForm() DO EVENTS _wSend(1, ow) // запуск события 1 DO EVENTS _wSend(2, ow) // запуск события 2 DO EVENTS _wPost(3, ow) // запуск события 3 Return Nil MAIN(158) -->> })[/pre2]
Andrey: Заменил в новой версии МиниГуи Харбор на январский (из версии МиниГуи) [pre2]Version: 3.2.0dev (r2211251714) Built on: Dec 3 2022 Last ChangeLog entry: 2022-11-25 18:14 UTC+0100 Przemyslaw Czerpak ChangeLog ID: 179749ac31ef3a6665d109ba6d02563840596d21[/pre2] Прога моя собралась и работает нормально. Чего в Харборе намудрили ?
gfilatov2002: SergKis пишет: Предложение по _LogFile(...) Принято SergKis пишет: Если сделать изменения по _LogFile(), как выше, то ф-я o2Log(...) из примера APP_OOPREPORT\demo3.prg Возможно получить весь этот пример в крайней редакции? Заранее благодарен
SergKis: gfilatov2002 Пример тут https://TransFiles.ru/tqcd8 положил h_objmisc.prg, в нем ф-ия _o2Log() аналог o2Log() из примера, я положил для использования в lib и что бы не пересекались с примерами переименовал. Команды в o2Log() o2Log("Forms*" , , , , cLog) o2Log("procNL*", , , , cLog) имеют подкоманды o2Log("Forms*M" , , , , cLog) // только окна модал o2Log("Forms*MS" , , , , cLog) // только окна модал и standard, т.е. за * список типов окон o2Log("procNL*3", , , , cLog) o2Log("procNL*5", , , , cLog) // сколько строк из списка подать на вывод
gfilatov2002: SergKis пишет: положил h_objmisc.prg Спасибо, пример работает нормально
SergKis: gfilatov2002 В пример можно добавить работу с записями dbf в контейнере, функция oRecGet(). Правка [pre2] WITH OBJECT App.Object // set events App\Program begin :Event({ 1, "Timer_1"}, {|oa,ky,nn,cnam| // таймер 1 Local oMain := App.Cargo:oMain, cAls, oRec Local oThis, cFunc, xRet, cKey, nKey oMain:Enabler(cnam, .F.) // выкл.timer // --- для примера cKey := oa:oEvents:Get(ky, "???") // имя события от кода его nKey := oa:oEvents:Get(cKey, 0) // код события от его имени // ---- cFunc := "my" + cnam // имя ф-ии обработчика ? "#", "O:"+oa:ClassName,ky,nn,cnam, cKey, nKey, cFunc, oMain:Name oThis := _oThis() // снимок this среды oThis:cFunc := cFunc oThis:cKey := cKey oThis:nKey := nKey oThis:cLog := App.Cargo:cFileLog IF HB_ISOBJECT(oMain:Cargo:oBrw) cAls := (oMain:Cargo:oBrw:cAlias) oRec := (cAls)->( oRecGet() ) oRec:nRecNo := (cAls)->( RecNo() ) oThis:oRec := oRec ENDIF xRet := hb_ExecFromArray( cFunc, {oThis} ) oMain:Enabler(cnam, .T.) // вкл. timer nn := ky oThis := Nil Return Nil }) при перемещении по тсб, Timer_1 будет считывать тек. запись Записать в запись в dbf можно так (cAls)->(dbAppend()) IF (cAls)->(RLock()) (cAls)->(oRecPut(oRec)) // пишет в dbf только существующие и не защищенные поля из объекта ENDIF объединить записи из разных alias oRec := (cAls)->(oRecGet()) oRec := (cAls2)->(oRecGet(oRec)) _o2Log(oRec, 11, "*** oRec: ") [/pre2]
Andrey: SergKis пишет: o2Log("Forms*MS" , , , , cLog) // только окна модал и standard, т.е. за * список типов окон А можно получить другой список окон, чтобы было имя prg в котором находиться данное окно ? [pre2] aForms :={} FOR EACH ow IN HMG_GetForms( , .T. ) AAdd(aForms, {hb_enumIndex(), ow:Type, ow:Name, ow:Handle, ow:Title, ow:Prg} ) // примерно так NEXT cRet := "" FOR EACH aw IN aForms cRet += hb_valtoexp(aw) + CRLF NEXT ? cRet [/pre2]
SergKis: Andrey пишет AAdd(aForms, {hb_enumIndex(), ow:Type, ow:Name, ow:Handle, ow:Title, ow:Prg} ) // примерно так Таких данных нет, сам организуй[pre2] DEFINE WINDOW ... This.Cargo := oHmgData() This.Cargo:cFormName := ThisName This.Cargo:cFormPrg := ProcFile() ... [/pre2] o2log(This.Cargo, , "==> :Cargo: ") PS Можно поправить тексты hmg для получения данных ProcFile(), ProcName(), ProcLine() - они, правки не большие, тогда будет вывод добавлен AAdd(o, {hb_enumIndex(ow), ow:Type, ow:Index, ow:Name, ow:Handle, IsWindowVisible(ow:Handle), ow:Title, ow:cProcFile, ow:cProcName, ow:nProcLine}) для пробы сделал, положил на ftp, проверь, если Григорий даст добро на изменения, перекинь
gfilatov2002: SergKis пишет: Григорий даст добро на изменения Все изменения приняты Благодарю за помощь
SergKis: gfilatov2002 Небольшая добавка в h_objmisc.prg [pre2] FUNCTION _o2Log( o, nLen, cMsg, lExt, cLog ) ... IF HB_ISOBJECT( o ) _LogFile({.F., cLog}, "O:"+o:ClassName) IF o:ClassName $ "THMGDATA,TKEYDATA,TTHRDATA,TINIDATA" _LogFile({.F., cLog}, o:GetAll()) IF o:ClassName == "TINIDATA" _LogFile({.F., cLog}, o:cIni) ENDIF FOR EACH a IN o:GetAll() ... IF a[2]:ClassName $ "THMGDATA,TKEYDATA,TTHRDATA,TINIDATA" _LogFile({.F., cLog}, a[2]:GetAll()) IF a[2]:ClassName == "TINIDATA" _LogFile({.F., cLog}, a[2]:cIni) ENDIF ELSEIF a[2]:ClassName == "TWNDDATA" ... [/pre2] Пример проверка для ini https://TransFiles.ru/9yjqn
gfilatov2002: SergKis пишет: Небольшая добавка в h_objmisc.prg Принято
gfilatov2002: Выложил 2-е обновление сборки 23.09 по адресу Скачать До новых встреч!
Andrey: gfilatov2002 пишет: Выложил 2-е обновление сборки 23.09 Собрал на новой версии свою прогу. Сразу вылетает с ошибкой:[pre2] Time from start: 0 days 0 hours 0 mins 0 secs Error BASE/1001 Неизвестная функция: EVENTS Args: [1] = N 329558 [2] = N 129 [3] = N 0 [4] = N 1701896 --------------------------------- Stack Trace --------------------------------- Called from EVENTS(0) Called from INITWINDOW(0) Called from _DEFINEWINDOW(0) Called from MAIN(121) in module: Source\main.prg [/pre2] Вот код: [pre2] Set_bEvents( {|hH,nM,wP,lP| MyEventsHandler(hH,nM,wP,lP) } ) // блок кода, сделать STATIC DEFINE WINDOW Form_Main ; AT 0,0 WIDTH 640 HEIGHT 480 ; TITLE cTitle ICON cIcon ; MAIN NOSHOW ; NOMAXIMIZE NOSIZE NOCAPTION ; ON INIT {|| DoEvents(), _wPost(0) } ; ON RELEASE {|| _LogFile(.T., CRLF + ">>> STOP <<< " + HMG_TimeMS(App.Cargo:tStart) ) } ; ON INTERACTIVECLOSE {|| IIF( lStaticErrorClose, MyExit(), Nil ) } // строка 121 [/pre2] Собираю на предыдущей версии 23.09.01, такой ошибки нет !
Andrey: Григорий ! Что делать с НОВОЙ версией ? Не работает прога...
gfilatov2002: Andrey пишет: Что делать с НОВОЙ версией ? Andrey Внимательно проверь, какая версия библиотека tsbrowse используется при линковке программы. Размер файла: 359 936 байт Дата изменения: 15 сентября 2023 г., 19:57:37 Рекомендую временно убрать с диска все старые версии этой библиотеки, чтобы гарантировано использовать только эту версию
SergKis: Andrey Твой пример zProgram_Template(1.4p-2).7z, с убранными из каталога *.lib и .\OBJ - собирается, работает
Andrey: SergKis пишет: Твой пример zProgram_Template(1.4p-2).7z, с убранными из каталога *.lib и .\OBJ - собирается, работает Да, собирается... gfilatov2002 пишет: Рекомендую временно убрать с диска все старые версии этой библиотеки, чтобы гарантировано использовать только эту версию Убрал, удалил все .\OBJ tsbrowse такая же как указана выше. Сборку делаю так: [pre2]set MG_ROOT=C:\MiniGUI-23.09.2 set MG_BCC=C:\borland\BCC58 set PATH=%MG_ROOT%\BATCH;%MG_BCC%\bin;%MG_ROOT%\harbour\bin;%PATH% echo ------------ сделана замена линковщика ------ rem echo %PATH% echo %MG_ROOT%\BATCH\hbmk2.bat echo %MG_BCC% hbmk2.bat Abonent4win.hbp[/pre2] Собираю, ехе-ник собирается, при запуске падает с такой же ошибкой: [pre2]Time from start: 0 days 0 hours 0 mins 0 secsTime from start: 0 days 0 hours 0 mins 0 secs Error BASE/1001 Неизвестная функция: EVENTS Args: [1] = N 1836110 [2] = N 129 [3] = N 0 [4] = N 1701896 --------------------------------- Stack Trace --------------------------------- Called from EVENTS(0) Called from INITWINDOW(0) Called from _DEFINEWINDOW(0) Called from MAIN(124) in module: Source\main.prg [/pre2] Сделал ещё так: [pre2] ? ProcNL(), Repl("*",10) + " DEFINE WINDOW " + Repl("*",10), "Set_bEvents('MyEventsHandler')" DoEvents() Set_bEvents( {|hH,nM,wP,lP| MyEventsHandler(hH,nM,wP,lP) } ) // блок кода, сделать STATIC DEFINE WINDOW Form_Main ; AT 0,0 WIDTH 640 HEIGHT 480 ; TITLE cTitle ICON cIcon ; MAIN NOSHOW ; NOMAXIMIZE NOSIZE NOCAPTION ; ON INIT {|| DoEvents(), _wPost(0) } ; ON RELEASE {|| _LogFile(.T., CRLF + ">>> STOP <<< " + HMG_TimeMS(App.Cargo:tStart) ) } ; ON INTERACTIVECLOSE {|| IIF( lStaticErrorClose, MyExit(), Nil ) } // строка 124 [/pre2]
Andrey: Сделал небольшие перетасовки в программе, перестало работать на версии MiniGUI-23.09.1 Работает теперь только на версии MiniGUI-23.09
gfilatov2002: Подготовил новую сборку 23.10, которая будет опубликована на следующей неделе. Что нового: - добавлена поддержка библиотеки SQLRDD, которая позволяет с минимальными изменениями кода мигрировать в среду SQL; - добавлен большой пример-шаблон программы от Андрея Верченко. Желаю всем мира и добра!
Andrey: gfilatov2002 пишет: - добавлен большой пример-шаблон программы от Андрея Верченко. Про Сергея забыл добавить ! Без него, примера бы не было !!!
Andrey: А почему иконка на форме появляется где-то через секунд 4-5 ? Показ формы в новом примере меню Setting - "Show MAIN form"
gfilatov2002: Andrey пишет: почему иконка на форме появляется где-то через секунд 4-5 ? Потому что иконка прорисовывается на форме после поступления события ON PAINT. Для того, чтобы она появлялась сразу, запиши показ главной формы из меню таким образом: Item 'Show MAIN window' ACTION {|| oMainWnd:Show(), SendMessage( oMainWnd:Handle, WM_PAINT, 0, 0 ) } ICON "i_Menu32x1" FONT hFont1
Andrey: Спасибо ! Заработало !
gfilatov2002: Как и обещал, выложил последнюю сборку 23.10 с поддержкой библиотеки SQLRDD по адресу click here Пример шаблона программы с использованием OOП от Андрея и Сергея можно посмотреть в папке \SAMPLES\Advanced\APP_OOPTEMPLATE Желаю всем хорошего дня
gfilatov2002: Выложил 1-е обновление сборки 23.10 по адресу Скачать Альтернативная ссылка на zip-архив, если антивирус блокирует выкачку инталлятора: Скачать архив - обновлен большой пример-шаблон программы от Андрея Верченко и Сергея Киселева. Желаю всем хорошего дня
gfilatov2002: Адаптировал текущую сборку Минигуи для работы со свежим ВСС 7.70, который вышел в октябре этого года. Harbour Build Info --------------------------- Version: Harbour 3.2.0dev (r2311151457) Compiler: Borland/Embarcadero C++ 7.7 (32-bit) Platform: Windows 10 10.0 PCode version: 0.3 ChangeLog last entry: 2023-11-15 15:57 UTC+0100 Phil Krylov (phil a t krylov.eu) ChangeLog ID: 99237045fe4821b9a0b6d824f94711e3c31e382c Built on: Nov 18 2023 16:39:58 Extra Harbour compiler options: -gc0 Extra C compiler options: -DHB_GUI -DHB_NO_PROFILER -DHB_NO_TRACE -DHB_MEMO_SAFELOCK Build options: (Clipper 5.3b) (Clipper 5.x undoc) --------------------------- Ваши комментарии приветствуются
Dima: gfilatov2002 пишет: Ваши комментарии приветствуются Взять его можно тут в принципе вот Смущает одно "(Evaluation Only!)" По ходу качнул а BRC там древний
gfilatov2002: Dima пишет: Смущает одно "(Evaluation Only!)" Это C++Builder 11 Community Edition Его можно использовать бесплатно при следующих условиях: 1. If you're an individual you may use C++Builder CE to create apps for your own use and apps that you can sell until your revenue reaches $5,000 per year. 2. If you’re a small company or organization without revenue (or up to $5,000 per year in revenue), you can also use the C++Builder CE.
PSP: gfilatov2002 пишет: or up to $5,000 per year in revenue Решение!))
Dima: PSP пишет: Решение!))
Andrey: gfilatov2002 пишет: текущую сборку Минигуи для работы со свежим ВСС 7.70 Как там решена проблема с русским языком: [pre2] FOR nI := 1 TO 12 AADD( aMonth, " " + LOWER( NTOCMONTH( nI ) ) ) NEXT ... @ .... COMBOBOXEX ComboEx_Month ... ITEMS aMonth ...[/pre2]
gfilatov2002: Andrey пишет: решена проблема с русским языком Да.
Andrey: Отлично ! Как можно попробовать данную версию ?
gfilatov2002: Andrey пишет: Как можно попробовать данную версию ? Если это действительно интересно, то пиши на почту - договоримся!
gfilatov2002: Выложил 2-е обновление сборки 23.10 по адресу Скачать Альтернативная ссылка на zip-архив, если антивирус блокирует выкачку инталлятора: Скачать архив Желаю всем хорошего дня
gfilatov2002: gfilatov2002 пишет: Выложил 2-е обновление сборки 23.10 по адресу Скачать Альтернативная ссылка на zip-архив, если антивирус блокирует выкачку инталлятора: Скачать архив Сделал "тихое" обновление этой сборки с учетом последних исправлений библиотеки TsbViewer, присланных Андреем. Прямые ссылки на дистрибутив есть в сообщении выше. До новых встреч
gfilatov2002: gfilatov2002 пишет: Сделал "тихое" обновление этой сборки с учетом последних исправлений библиотеки TsbViewer, присланных Андреем. Прямые ссылки на дистрибутив есть в сообщении выше. Снова обновил дистрибутив этой сборки с учетом исправлений, присланных Андреем. Желаю всем хорошего дня
gfilatov2002: Выложил заключительную сборку 23.12 с поддержкой библиотеки SQLRDD по адресу Скачать SHA-256: a74136d6cc4c769f9a7897fd9e0722dbde76a63ab407e8e2c677b0259b90b72f Желаю всем хорошего дня
SergKis: gfilatov2002 пишет * New: 'Windows with different languages' sample. Contributed by Sergej Kiselev and Verchenko Andrey (see in folder \samples\Advanced\APP_OOPLANG) Этот пример больше подходит для версии hmg unicode реализации. Пример тут https://TransFiles.ru/lahsp
gfilatov2002: SergKis пишет: для версии hmg unicode Благодарю за помощь Это очень интересный пример, поместил его в папку Tsb_Lang
SergKis: gfilatov2002 пишет пример, поместил его в папку Tsb_Lang Пример собран на версии unicode Harbour MiniGUI Extended Edition 23.07 (Release) + изменения из этой темы до версии с SqlRDD (~23.09) - это важно для правки и пересборки примера
SergKis: gfilatov2002 Для Alert... с длинными текстами сделал простой вариант[pre2] STATIC aBackColor, aFontColor, s_nLineLen := 79 ... *-----------------------------------------------------------------------------* FUNCTION HMG_Alert_MaxLines( nLines, nLineLen ) *-----------------------------------------------------------------------------* LOCAL cVarName := "_" + ProcName() LOCAL nOldLines := _AddNewGlobal( cVarName, 20 ) IF HB_ISNUMERIC( nLines ) .AND. nLines > 0 _SetGetGlobal( cVarName, nLines ) ENDIF IF HB_ISNUMERIC( nLineLen ) .AND. nLineLen > 0 .AND. nLineLen < 255 s_nLineLen := nLineLen ENDIF RETURN nOldLines ... *-----------------------------------------------------------------------------* STATIC FUNCTION FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bBlock, lClosable, cFont, nMaxLen ) *-----------------------------------------------------------------------------* ... nMaxWidth *= 0.7 ENDIF FOR n := 1 TO nLineas nMaxLin := Max( nMaxLin, GetTextWidth( hDC, AllTrim( MemoLine( cMsg, s_nLineLen, n ) ), hDlgFont ) ) NEXT // calculate the maximum width of the buttons FOR n := 1 TO nLenaOp ... FOR n := 1 TO nLineas cLblName := "Say_" + StrZero( n, 2 ) @ nRow * ( n + iif( nLineas == 1, .5, 0 ) ) + GetBorderHeight(), nCol ; LABEL ( cLblName ) VALUE AllTrim( MemoLine( cMsg, s_nLineLen, n ) ) OF ( cForm ) ; FONT cFont WIDTH nWidthCli - nCol - GetBorderWidth() - MARGIN / 4 - nMaxWidth ; HEIGHT nChrHeight ; FONTCOLOR aFontColor BACKCOLOR aBackColor VCENTERALIGN NEXT n ... В начале программы ставлю ... SetMenuBitmapHeight( 32 ) // set menu icons size to 32x32 HMG_Alert_MaxLines( , 120) SET NAVIGATION EXTENDED ... [/pre2] помогает
gfilatov2002: SergKis пишет: с длинными текстами сделал простой вариант Спасибо Добавил такую возможность тоже...
gfilatov2002: Подготовил новую сборку 24.01, которая будет опубликована на следующей неделе. Что нового: * Fixed: Incorrect handling of the FontColor and BackColor properties in the CHECKLISTBOX control. You can set/get these properties with - function syntax: SetProperty ( Form, Control, 'BackColor', { n1 , n2 , n3 } ) GetProperty ( Form, Control, 'FontColor' ) --> aColor - pseudo-OOP syntax: Form.ChkListBox.FontColor := { n1 , n2 , n3 } Form.ChkListBox.BackColor --> aColor Bug was reported by Ivanil Marcelino. Contributed by Grigory Filatov (see demo.prg in folder \samples\Basic\CheckListBox) * Enhanced: Added the optional second parameter in the HMG_Alert_MaxLines() function for managing of the max width of the EditBox line in the HMG_Alert() function. Syntax: HMG_Alert_MaxLines( <nLines> [, <nMaxWide>] ) => nPrevLines Suggested and contributed by Sergej Kiselev (see demo in folder \samples\Advanced\APP_OOPTEMPLATE) * New: The GetAppLocalDataFolder() function returns an Application Data Folder path for a local user. The GetWindowsTempFolder() function returns the path to the Windows temporary folder on the root drive. Contributed by Grigory Filatov (see demo in folder \samples\Basic\Misc) Желаю всем мира и добра!
SergKis: gfilatov2002 Небольшая правка[pre2] *-----------------------------------------------------------------------------* FUNCTION Set_bEvents ( bBlock ) *-----------------------------------------------------------------------------* LOCAL bOld := s_bEvents IF HB_ISCHAR( bBlock ) .AND. "(" $ bBlock bBlock := hb_ULeft( bBlock, hb_UAt( "(", bBlock ) - 1 ) ENDIF s_bEvents := bBlock s_lEvents := !Empty( s_bEvents ) RETURN bOld [/pre2] тогда можно делать bBlockOld := Set_bEvents ( bBlockNew ) ... Set_bEvents ( bBlockOld ) bBlockOld := Set_bEvents ( NIL ) ... Set_bEvents ( bBlockOld ) для конкретных окон ставить свои обработчики
gfilatov2002: SergKis пишет: Небольшая правка OK
SergKis: gfilatov2002 Небольшая добавка[pre2] *----------------------------------------------------------------------------* FUNCTION _o2Log( o, nLen, cMsg, lExt, cLog ) *----------------------------------------------------------------------------* LOCAL a, b, c, i, j, k := pCount(), l := .F., xRet := .T. IF Valtype(cLog) $ "LND" l := .T. cLog := hb_FNameDir(cLog) + "_" + hb_ntos(Seconds()) ENDIF DEFAULT lExt := .F., cLog := _SetGetLogFile() ... ENDIF IF l .and. hb_FileExists( cLog ) xRet := hb_memoread( cLog ) hb_FileDelete( cLog ) ENDIF RETURN xRet [/pre2] для использования, например, так AlertInfo( _o2log(o, 15, "=> oLbl:Cargo", .T., .T.) )
gfilatov2002: SergKis пишет: Небольшая добавка Принято Благодарю за помощь
SergKis: gfilatov2002 Пропустил ошибку в строке cLog := hb_FNameDir(_SetGetLogFile()) + "_" + hb_ntos(Seconds())
SergKis: gfilatov2002 Может ~ такую добавку сделать ? [pre2] STATIC s_lOutLogFile := .T. *-----------------------------------------------------------------------------* FUNCTION _SetGetLogFile( cFile, lOut ) *-----------------------------------------------------------------------------* LOCAL cVarName := "_HMG_" + SubStr( ProcName(), 8 ) LOCAL cOld := _AddNewGlobal( cVarName, NIL ), lOld IF HB_ISLOGICAL( lOut ) lOld := s_lOutLogFile s_lOutLogFile := lOut IF cFile == NIL RETURN lOld ENDIF ENDIF IF cFile != NIL _SetGetGlobal( cVarName, cFile ) RETURN cFile ENDIF RETURN cOld *-----------------------------------------------------------------------------* #ifndef __XHARBOUR__ FUNCTION _LogFile( lCrLf, ... ) #else FUNCTION _LogFile( ... ) #endif *-----------------------------------------------------------------------------* LOCAL hFile, i, xVal, cTp LOCAL aParams := hb_AParams() LOCAL nParams := Len( aParams ) LOCAL cFile := hb_defaultValue( _SetGetLogFile(), GetStartUpFolder() + hb_ps() + "_MsgLog.txt" ) #ifdef __XHARBOUR__ LOCAL lCrLf #endif IF ! s_lOutLogFile RETURN .F. ENDIF IF nParams > 0 ... [/pre2] Для приостановки вывода в log не меняя код. Можно команду сделать, типа SET LOGFILE OUT ON\OFF
SergKis: PS видел, но не понял к чему относятся #xtranslate IsErrorLogActive () ; => ; _HMG_CreateErrorLog и #xcommand SET LOGERROR <x:ON,OFF> => _HMG_CreateErrorlog := ( Upper(<(x)>) == "ON" ) возможно надо такую еще #xcommand SET LOGERROR TO [<uVal>] => _HMG_CreateErrorlog := !Empty( <uVal> ) #xtranslate SetErrorLogActive ( <uVal> ) ; => ; _HMG_CreateErrorLog := !Empty( <uVal> ) и тогда в _LogFile(...)[pre2] IF ! IsErrorLogActive () RETURN .F. ENDIF [/pre2] Это, если речь об этом шла с переменной _HMG_CreateErrorLog
gfilatov2002: SergKis пишет: Пропустил ошибку в строке Поправил. Большое спасибо! SergKis пишет: тогда в _LogFile(...) IF ! IsErrorLogActive () RETURN .F. ENDIF Добавил этот код.
gfilatov2002: Выложил финальную сборку 24.01 с последними исправлениями и дополнениями по адресу Скачать SHA-256: 8d506a1c284bb8cbc6ba3f1298a6a806585ee9a718e560113111e8998b91324e и в виде архива Скачать SHA-256: 3f40d354e2e7247c670f45bba4f55096e9823468f22f30d5c86b0f6e0f84e67c Желаю всем хорошего дня P.S. За последние годы была прекращена разработка и поддержка нескольких проектов, основанных на синтаксисе команд Минигуи: - 2017 - официальный релиз HMG - 2017 - Marinas GUI, основанный на Qt (http://marinas-gui.org/projects/marinas-gui/_Index_help_marinas-gui.htm) - 2023 - OOHG, использующий OOП Если не трудно, напишите ваш комментарий...
SergKis: gfilatov2002 пишет ваш комментарий... - релиз HMG, не было TsBrowse и был ли препроцессор команд, уже забыл, помню, что в основе была работа напрямую с _HMG_SYSDATA - Marinas GUI, сложноватый синтаксис и переход с VO - OOHG, ООП был (отличный от VO), но суть (наличие массива _HMG_SYSDATA), а значит вся работа по доступу к окнам, контролам это AScan() Когда появился hb 2.0 unicode все это пощупали, HMG Extended оказалась единственным работоспособным и адаптируемым к своим возможностям проектом, к тому в очень актуальном состоянии С 2010 года перевели проекты на hb console+wvt, а 2011 года, пощупав, многое, перешли с VO на HMG Extended. Товарищ полностью обвязал объектами, как VO и с мин. затратами перешел. У меня была сильная помесь кода от clipper (в VO на базе VOSсripta) и GUI (свои ф-ии окна), то идти его путем (объектов) было сложно. Переход на родной язык hmg препроцессора оказался оч. к стати. Григорию, за его труд, БОЛЬШОЕ СПАСИБО ! Единственным минусом, который не преодолел я (переход на последние версии hmg) это 1. сокрытие команд, функций из FUNCTION -> STATIC FUNCTION, например, в h_controlmisc.prg не было static ф-ий, теперь все скрыто, доступ, практически только через Set\GetProperty() 2. ускорение доступа к элементам hmg, например, в моей версии сделано (работа через полученный ранее index)[pre2] *-----------------------------------------------------------------------------* Function GetControlName ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* Local i := GetControlIndex ( ControlName, ParentForm, Index ) if i == 0; Return '' EndIf Return ( _HMG_aControlNames [ i ] ) *-----------------------------------------------------------------------------* Function GetControlHandle ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* Local i := GetControlIndex ( ControlName, ParentForm, Index ) if i == 0; Return 0 EndIf Return ( _HMG_aControlHandles [ i ] ) *-----------------------------------------------------------------------------* Function GetControlContainerHandle ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* Local i := GetControlIndex ( ControlName, ParentForm, Index ) if i == 0; Return 0 EndIf Return ( _HMG_aControlContainerHandle [ i ] ) ... Сейчас я бы это упростил, сделав IF HB_ISNUMERIC(ControlName) i := ControlName ControlName := _HMG_aControlNames [ i ] ELSE i := GetControlIndex ( ControlName, ParentForm ) ENDIF [/pre2] PS. Пару лет назад товарищ сделал вывод, что делать проект на псевдо ООП командах hmg значительно быстрее, чем на VO, согласен с этим выводом уже давно.
gfilatov2002: SergKis пишет: делать проект на псевдо ООП командах hmg значительно быстрее Как обычно, благодарю за Ваш быстрый ответ. Надеюсь, что это интересно не только мне.
Andrey: gfilatov2002 пишет: За последние годы была прекращена разработка и поддержка нескольких проектов, основанных на синтаксисе команд Минигуи: - 2017 - официальный релиз HMG - 2017 - Marinas GUI, основанный на Qt (http://marinas-gui.org/projects/marinas-gui/_Index_help_marinas-gui.htm) - 2023 - OOHG, использующий OOП 2017 - официальный релиз HMG - не понравился 2017 - Marinas GUI - пробовал делать свою программу, тоже не понравился 2023 - OOHG - не смотрел В 2012 году начал разбираться с МиниГуи, понравилось присутствие разработчика на этом сайте, ну и его помощь в освоении МиниГуи ! Григорий, ОГРОМНОЕ СПАСИБО за твой такой большой труд ! Да и без Сергея я бы тоже не осилил перенос программы на МиниГуи, тоже ОГРОМНОЕ СПАСИБО ! Свою большую прогу с терминалки на МиниГуи переводил 4 года.
SergKis: gfilatov2002 Не понял с примером FiveLibsTest. Может не так понимаю его ? prgflags=-DHBMK_HAS_HMGE -работает а prgflags=-DHBMK_HAS_GTWVG - нет, не находит frm_class.ch(50) Error F0029 Can't open #include file 'gtwvg.ch' его нет и в core-master от 09.03.23, есть hbgtwvg.ch т.е. пример должен работать под разными проектами hmge, hwgui, ... но gtwvg - должен быть в hb и по идее должен работать или ошибаюсь ? то что нет gtwvg.lib понимаю, но у меня под msvc hb (от 2020 года) в contrib есть gtwvg.lib, но файла gtwvg.ch так же нет PS. Может gtwvg.lib надо вкл. в сборку hmg ?
gfilatov2002: SergKis пишет: prgflags=-DHBMK_HAS_HMGE -работает Этот пример был доработан для корректного использования с библиотекой Минигуи. Работа с другими библиотеками не тестировалась...
gfilatov2002: Продолжаем хорошие новости Рекомендую посмотреть довольно зрелый IDE, заточенный для работы с SQL базами, свежая версия которого была выпущена вчера. Этому проекту уже пять лет, и он поставляется в 3-х версиях: - полной; - персональной; - для экспертов. click here
SergKis: gfilatov2002 Небольшая правка[pre2] CLASS TIniData INHERIT THmgData ... VAR aYesNo AS ARRAY INIT { "Yes", "No" } VAR nMaxVal AS NUMERIC INIT 20 // Max. length Value for note ... METHOD Write( cFile, lUtf8 ) CLASS TIniData ... IF ! Empty( cStr[2] ) IF lBlk cVal := iif( ! ::lUtf .AND. lUtf8, hb_StrToUtf8( cStr[2] ), cStr[2] ) ELSE IF Len(cVal) <= ::nMaxVal cVal := Left( cVal + Space( ::nMaxVal ), ::nMaxVal ) ENDIF cVal += space(3) + iif( ! ::lUtf .AND. lUtf8, hb_StrToUtf8( cStr[2] ), cStr[2] ) ENDIF ENDIF ... [/pre2] Тогда будет выравнивание в секции oIni для строк с наличием примечания на длину :nMaxVal и можно задать new значение oIni:nMaxVal := 40 для выполнения oIni:Write() И предложение [pre2] *----------------------------------------------------------------------------* FUNCTION HMG_GetAllFonts( lObj ) *----------------------------------------------------------------------------* LOCAL oFonts := oHmgData() LOCAL aFonts := {}, cName LOCAL aFont := {}, cFont, hFont FOR EACH cFont IN _HMG_aControlType IF cFont == "FONT" AAdd( aFonts, _HMG_aControlNames[ hb_enumindex( cFont ) ] ) ENDIF NEXT IF lObj == NIL ; RETURN aFonts ENDIF FOR EACH cName IN aFonts hFont := GetFontHandle( cName ) cFont := GetFontParam ( hFont ) hb_AIns( cFont, 1 , cName , .T. ) hb_ADel( cFont, Len(cFont), .T. ) IF Empty( lObj ) AAdd( aFont, AClone( cFont ) ) ELSE oFonts:Set( cName, AClone( cFont ) ) ENDIF NEXT IF Empty( lObj ) ; RETURN aFont ENDIF RETURN oFonts [/pre2]
SergKis: gfilatov2002 Вопросик по использованию hrb в hmg с использованием hb_compileFromBuff(...), hb_compileBuf(...). Как быть, например, с i_psevdofunc.ch ? Его, наверно, надо отключить из hmg.ch сборки по какому то признаку, а из i_psevdofunc.ch сделать psevdofunc.lib ? Или есть др. варианты ?
gfilatov2002: SergKis пишет: Небольшая правка Большое спасибо SergKis пишет: Вопросик по использованию hrb в hmg Я глубоко не разбирался с использованием hrb в hmg (только проверял для Харбор-кода). SergKis пишет: надо отключить из hmg.ch сборки по какому то признаку, а из i_psevdofunc.ch сделать psevdofunc.lib ? Полностью доверяю вашему опыту в этом вопросе.
gfilatov2002: Решил не добавлять новую функцию PrivateExtractIcons(), а вместо этого изменить уже существующую в ядре функцию ExtractIconEx(), добавив в нее два новых параметра, которые задают высоту и ширину иконки. Syntax: ExtractIconEx( cResName, nItem [, nX ] [, nY ] ) => { hIcon, nId }, where nX and xY are the icon sizes in pixels (32x32 by default). Примеры использования: ExtractIconEx( cIcon, -1 ) возвращает количество иконок в DLL или EXE hIconFromDll := ExtractIconEx( cIcon, nIcon, 256, 256 )[1] получает хэндл иконки с номером nIcon, которая находится в файле cIcon
Andrey: gfilatov2002 пишет: ExtractIconEx(), добавив в нее два новых параметра, которые задают высоту и ширину иконки. Супер !
Andrey: А можно ещё сделать так ? [pre2]aIcons := ExtractIconEx( cIcon, nIcon ) - вытащить ВСЕ иконки, т.е. все размеры иконок[/pre2] Или ключик какой то предусмотреть, чтобы осталась совместимость со старым синтаксисом ?
gfilatov2002: Andrey пишет: вытащить ВСЕ иконки, т.е. все размеры иконок В системе не хранятся иконки ВСЕХ размеров. Если в ресурсной DLL нет иконки требуемого размера, то при извлечении иконки этого размера она масштабируется из хранящейся там иконки большего размера.
SergKis: gfilatov2002 Предложение для ф-ий Alert...(...) сделать обработку параметра Title как массива, например, для ф-ии[pre2] *-----------------------------------------------------------------------------* FUNCTION AlertYesNo ( Message, Title, RevertDefault, Icon, nSize, aColors, lTopMost, bInit ) *-----------------------------------------------------------------------------* LOCAL aOptions := { '&' + _HMG_aABMLangLabel [20], '&' + _HMG_aABMLangLabel [21] } LOCAL nDefaultButton := 1 IF HB_ISARRAY( Title ) aOptions := Title[2] Title := Title[1] ENDIF ...[/pre2] а то получается много мороки, сохранять перед AlertYesNo(...) и др. функциями данные из _HMG_aABMLangLabel [20] и _HMG_aABMLangLabel [21], а потом надо восстанавливать и + к этому может мешать '&' + _HMG_..., надо на другое место '&' поставить.
gfilatov2002: SergKis пишет: Предложение для ф-ий Alert...(...) Сделал, конечно. Благодарю за подсказку
gfilatov2002: gfilatov2002 пишет: Примеры использования: Иконка номер 308 размера 64x64, взятая из системной DLL, выглядит так:
SergKis: gfilatov2002 Предложение по [pre2] FUNCTION HMG_Alert( cMsg, aOptions, cTitle, nType, cIcoFile, nIcoSize, aBtnColors, bInit, lClosable, cFontName ) ... ON RELEASE iif( ! _SetGetGlobal( "_HMG_PressButton" ) .AND. lClosable, _HMG_ModalDialogReturn := 0, NIL ) This.Cargo := oHmgData() FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bInit, lClosable, cFontName, nMaxLen ) ... STATIC FUNCTION FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bBlock, lClosable, cFont, nMaxLen ) ... LOCAL lExt, nY, nX, cIco ... DEFINE TIMER oTimer OF ( cForm ) INTERVAL nSeconds * 1000 ACTION ( _SetGetGlobal( "_HMG_PressButton", .T. ), ThisWindow.Release() ) This.Cargo:oTimer := "TIMER" This.oTimer.Enabled := .F. ... IF nLineas > 1 IF nLineas > nMaxLines cLblName := "Say_01" ... This.Cargo:Set( cLblName, This.&(cLblName).Type ) ELSE FOR n := 1 TO nLineas cLblName := "Say_" + StrZero( n, 2 ) ... This.Cargo:Set( cLblName, This.&(cLblName).Type ) NEXT n ... ELSE cLblName := "Say_01" ... This.Cargo:Set( cLblName, This.&(cLblName).Type ) ENDIF IF nIcoSize > 0 nY := nRow + GetBorderHeight() cIco := "ICON" IF ISNUMBER( cIcoFile ) IF IsHIcon( cIcoFile ) nX := MARGIN / iif( nIcoSize == 32, 1.4, iif( nIcoSize == 48, 1.7, 2 ) ) DRAW ICON IN WINDOW ( cForm ) ; AT nRow + GetBorderHeight(), MARGIN / iif( nIcoSize == 32, 1.4, iif( nIcoSize == 48, 1.7, 2 ) ) ; HICON cIcoFile WIDTH nIcoSize HEIGHT nIcoSize TRANSPARENT ELSE nX := MARGIN / 1.4 cIco := "SYSICON" DRAW SYSICON IN WINDOW ( cForm ) ; AT nRow + GetBorderHeight(), MARGIN / 1.4 ; ICON cIcoFile WIDTH nIcoSize HEIGHT nIcoSize TRANSPARENT ENDIF ELSE nX := MARGIN / iif( nIcoSize == 32, 1.4, iif( nIcoSize == 48, 1.7, 2 ) ) DRAW ICON IN WINDOW ( cForm ) ; AT nRow + GetBorderHeight(), MARGIN / iif( nIcoSize == 32, 1.4, iif( nIcoSize == 48, 1.7, 2 ) ) ; PICTURE cIcoFile WIDTH nIcoSize HEIGHT nIcoSize TRANSPARENT ENDIF This.Cargo:Draw := { cIco , nY , nX , cIcoFile , nIcoSize } ENDIF This.Cargo:lExtButton := lExt FOR n := 1 TO nLenaOp ... IF lExt ... This.Cargo:Set( cBtnName, This.&(cBtnName).Type ) ELSE ... This.Cargo:Set( cBtnName, This.&(cBtnName).Type ) ENDIF ... тогда bInit := {|| Local oWnd := _WindowObj( _HMG_THISFORMNAME ) _o2log(oWnd:Cargo, 12, "=>", .T.) Return Nil } выдаст в log => O:THMGDATA ARRAY[8] 1. SAY_01 = LABEL 2. SAY_02 = LABEL 3. SAY_03 = LABEL 4. SAY_04 = LABEL 5. DRAW = {"ICON", 34.0000, 22.8571, {{0, 128, 0}, {189, 30, 73}}, 32} 6. LEXTBUTTON = .F. 7. BTN_01 = BUTTON 8. BTN_02 = BUTTON ... или => O:THMGDATA ARRAY[5] 1. SAY_01 = EDITBOX 2. DRAW = {"ICON", 34.0000, 22.8571, {{0, 128, 0}, {189, 30, 73}}, 32} 3. LEXTBUTTON = .F. 4. BTN_01 = BUTTON 5. BTN_02 = BUTTON ... PS. Вместо oWnd := _WindowObj( _HMG_THISFORMNAME ) можно использовать ?v GetProperty(_HMG_THISFORMNAME, "Cargo"):GetAll() получим 1 {"SAY_01", "EDITBOX"} 2 {"DRAW", {"ICON", 34.0000, 22.8571, {{0, 128, 0}, {189, 30, 73}}, 32}} 3 {"LEXTBUTTON", .F.} 4 {"BTN_01", "BUTTON"} 5 {"BTN_02", "BUTTON"} ... 1 {"SAY_01", "LABEL"} 2 {"SAY_02", "LABEL"} 3 {"SAY_03", "LABEL"} 4 {"SAY_04", "LABEL"} 5 {"DRAW", {"ICON", 34.0000, 22.8571, {{0, 128, 0}, {189, 30, 73}}, 32}} 6 {"LEXTBUTTON", .F.} 7 {"BTN_01", "BUTTON"} 8 {"BTN_02", "BUTTON"} ... [/pre2]
gfilatov2002: SergKis пишет: Предложение по Принято Но я добавлю эти изменения в обрамлении переменной __DEBUG__: #ifdef __DEBUG__ ... #endif
SergKis: gfilatov2002 пишет Но я добавлю эти изменения в обрамлении переменной __DEBUG__: Почему ? Это основной режим, в моем понимании. Сейчас Cargo окна пуст и доступа к нему нет. А сделать на базе Alert ф-ий по темам с доп. наполнением - большая потребность. Сейчас мешает полное отсутствие инф. о DRAW ICON ... и лишние манипуляции делать чтобы определять тип button-ов., а так доступна вся инф. о контролах окна в простом виде PS Сейчас пробую использовать добавки, для отладки, код получается ~ такой (если интересно)[pre2] код prg (еще в начальной стадии) cTitle := "OK-CANCEL" aBtnColor := { LGREEN , {189,30,73} } cIcoRes := nIcoSize := NIL bInit := oa:bInitSomeBtn AlertOkCancel( cMsg, cTitle,1, cIcoRes, nIcoSize, aBtnColor, .T., bInit ) cTitle := "YES-NO-CANCEL" aBtnColor := { FUCHSIA, LGREEN , {189,30,73} } cIcoRes := oa:cIcoYesNo64 //App.Cargo:cIcoYesNo64 nIcoSize := oa:nIcoSize //64 bInit := oa:bInitSomeBtn AlertYesNoCancel( cMsg, cTitle, 3, cIcoRes, nIcoSize, aBtnColor, .T., bInit ) cTitle := "YES-NO" aBtnColor := { FUCHSIA, {189,30,73} } bInit := oa:bInitSomeBtn //{|| bInitAlertSomeBtn() } AlertYesNo( cMsg, cTitle, , cIcoRes, nIcoSize, aBtnColor, .T., bInit ) ... код обработчика (замена BUTTON на OBUTTON) o:bInitSomeBtn := {|| Local lBExt, lTime, lEbox, lDraw, ob, oo, a, b, i, o Local oc := This.Cargo Local cFocus := This.FocusedControl lTime := !Empty(oc:oTimer) lEbox := !Empty(oc:EditBox) lDraw := !Empty(oc:Draw) lBExt := !Empty(oc:lExtButton) IF !lBExt // метяем Button -> OButton IF HB_ISBLOCK( b := oAlert():b_Cargo2oNew ) oo := EVal(b, oc) //_o2log(oo, 12, "=> oo:...", .T.) i := 0 FOR EACH a IN oo:GetAll() o := a[2] IF "BUTT" $ o:cType i++ ? str(i, 2), o:cName, o:cType IF HB_ISBLOCK( b := oAlert():b_Btn2BtnEx ) This.&(o:cName).Release ob := EVal(b, o) IF !Empty(cFocus) This.&(cFocus).SetFocus ENDIF //_o2log(ob, 12, "=> ob:...", .T.) ENDIF ENDIF NEXT ENDIF ENDIF Return Nil } o:b_Cargo2oNew := {|oc| Local oo := oHmgData(), a, o Default oc := This.Cargo FOR EACH a IN oc:GetAll() o := oHmgData() o:nPos := hb_enumindex(a) IF HB_ISCHAR(a[2]) o:cName := a[1] o:cType := a[2] o:nIndex := This.&(a[1]).Index o:nY := int(This.&(a[1]).Row) o:nX := int(This.&(a[1]).Col) o:nW := int(This.&(a[1]).Width) o:nH := int(This.&(a[1]).Height) IF "BUTT" $ a[2] // [O]BUTTON o:cCaption := This.&(a[1]).Caption o:cInpMask := _HMG_aControlInputMask [ o:nIndex ] o:bAction := _HMG_aControlProcedures[ o:nIndex ] o:cFont := _HMG_aControlFontName [ o:nIndex ] o:nFont := _HMG_aControlFontSize [ o:nIndex ] o:aFont := _HMG_aControlFontAttributes[ o:nIndex ] o:hFont := _HMG_aControlFontHandle[ o:nIndex ] ELSEIF "LABE" $ a[2] // LABEL o:cValue := This.&(a[1]).Value ELSEIF "EDIT" $ a[2] // EDIBOX ELSEIF "TIME" $ a[2] // TIMER ENDIF oo:Set(a[1], o) ELSEIF a[1] == "DRAW" o:cType := a[1] o:aDraw := AClone(a[2]) o:cName := a[2][1] o:nY := int(a[2][2]) o:nX := int(a[2][3]) o:nW := a[2][5] o:nH := a[2][5] o:cIcoFile := a[2][4] o:lIsNumber := HB_ISNUMERIC( o:cIcoFile ) IF o:lIsNumber o:lIsHIcon := IsHIcon( o:cIcoFile ) ELSE o:lIsHIcon := .F. ENDIF oo:Set(a[1], o) ENDIF NEXT DO EVENTS Return oo } o:b_Btn2BtnEx := {|o| // меняем Button -> OButton Local ob := oHmgData() ob:Set(o:GetAll()) DEFINE BUTTONEX &(ob:cName) ROW ob:nY COL ob:nX WIDTH ob:nW HEIGHT ob:nH CAPTION ob:cCaption //BACKCOLOR aBack NOHOTLIGHT .F. NOXPSTYLE .F. VERTICAL .T. FLAT .T. END BUTTONEX This.&(ob:cName).Action := ob:bAction ob:nIndex := This.&(ob:cName).Index ob:cType := This.&(ob:cName).Type //"OBUTTON" Return ob } ... [/pre2]
gfilatov2002: SergKis пишет: Это основной режим Понял. Тогда обрамление кода будет другим: #ifdef _OBJECT_ ... #endif поскольку в лайт-версии библиотеки команда SET OOP ON не поддерживается. P.S. Кстати, решил разделить Минигуи на две сборки: 1) профессиональную версию (с разными дополнительными оптимизациями в Харборе и компактным бинарником Минигуи) 2) стандартную версию, которая будет распространяться бесплатно, но без дополнительных оптимизаций в Харборе и с отладочным кодом в библиотеке). Что скажете по этому поводу На мой взгляд, надо стимулировать пользователей, которые поддерживают развитие и поддержание библиотеки в актуальном состоянии.
SergKis: gfilatov2002 пишет поскольку в лайт-версии библиотеки команда SET OOP ON не поддерживается Поддерживается (включен) CLASS THmgData и oHmgData() до команды #ifdef _OBJECT_ в h_objects.prg
gfilatov2002: SergKis пишет: Поддерживается А как же тогда работает эта запись в заголовке minigui.ch /* *********************************************************************** * Enable support for the internal OOP classes * * By default this is turned ON. */ #ifndef _LITE_ #define _OBJECT_ #endif
SergKis: gfilatov2002 Смотрю h_objects.prg[pre2] /* * MINIGUI - Harbour Win32 GUI library source code * * Copyright 2017-2022 Aleksandr Belov, Sergej Kiselev <bilance@bilance.lv> */ #include "minigui.ch" #include "i_winuser.ch" #ifdef __XHARBOUR__ #include "hbcompat.ch" #else #xtranslate hb_HSetCaseMatch( <x>[, <z>] ) => ( hb_HCaseMatch( <x>[, <z>] ), <x> ) #endif #include "hbclass.ch" #define _METHOD METHOD STATIC o_AppDlu2Pixel /////////////////////////////////////////////////////////////////////////////// CLASS THmgData /////////////////////////////////////////////////////////////////////////////// ... #ifdef _OBJECT_ #ifndef __XHARBOUR__ /////////////////////////////////////////////////////////////////////////////// CLASS TIniData INHERIT THmgData /////////////////////////////////////////////////////////////////////////////// ... [/pre2] Объект-контейнер в любой версии должен быть, мое мнение, он, как и препроцессор, основа в псевдо ООП
gfilatov2002: SergKis пишет: Смотрю h_objects.prg Все верно! Функция oHmgData() используется при создании глобальных статических переменных в ядре библиотеки. Тогда обрамление будет таким #ifdef _NAMES_LIST_ ...
SergKis: gfilatov2002 пишет Кстати, решил разделить Минигуи на две сборки: Не оч. понятно деление. По мне сейчас Min. комплект - SET OOP OFF, даже не представляю, что что то, серьезное, можно делать с ним (SQLRDD лишнее в ней). Когда заходили в hmg (~2012 г.) именно SET OOP ON не было, сделали и с тех пор это рабочая версия (по TsBrowse по мелочи перенес изменения из тек. версии в свою и всего хватает) PS В той, старой, версии еще не было тотальной борьбы за минимизацию кода и это хорошо, в ней спокойно работают hrb компиляции на лету, без комплекта harbour.exe и Include файлов, сейчас компиляция на лету затруднена, т.к. практически все нужные ф-ии убраны в файлы *.ch, например, это одна из причин, по которой не могу задействовать тек. версии hmg (только в качестве небольших утилит использовал) PS Пример для наглядности работы с macro использованием псевдо ф-й (т.е. городим огород), на основе oHmgData() делаем [pre2] *----------------------------------------------------------------------------* FUNCTION oSys(cSec) // App.Cargo:oSystem usage: oSys():cTempFolder *----------------------------------------------------------------------------* LOCAL o IF Empty( App.Cargo:oSystem ) App.Cargo:oSystem := oHmgData() ; o := App.Cargo:oSystem o:nBorderWidth := GetBorderWidth() o:nBorderHeight := GetBorderHeight() o:nTitleHeight := GetTitleHeight() o:nMenuBarHeight := GetMenuBarHeight() o:BorderWidth := o:nBorderWidth o:BorderHeight := o:nBorderHeight o:TitleHeight := o:nTitleHeight o:MenuBarHeight := o:nMenuBarHeight // System folder o:cDesktopFolder := Sys.DesktopFolder + hb_ps() o:cMyDocumentsFolder := Sys.MyDocumentsFolder + hb_ps() o:cProgramFilesFolder := Sys.ProgramFilesFolder + hb_ps() o:cSystemFolder := Sys.SystemFolder + hb_ps() o:cTempFolder := Sys.TempFolder + hb_ps() o:cUserTempFolder := Sys.UserTempFolder + hb_ps() o:cWindowsFolder := Sys.WindowsFolder + hb_ps() o:DesktopFolder := Sys.DesktopFolder o:MyDocumentsFolder := Sys.MyDocumentsFolder o:ProgramFilesFolder := Sys.ProgramFilesFolder o:SystemFolder := Sys.SystemFolder o:TempFolder := Sys.TempFolder o:UserTempFolder := Sys.UserTempFolder o:WindowsFolder := Sys.WindowsFolder // Desktop area o:nRow := 0 o:nCol := 0 - GetBorderWidth() o:nWidth := Sys.DesktopWidth o:nHeight := Sys.DesktopHeight o:nDesktopWidth := Sys.DesktopWidth o:nDesktopHeight := Sys.DesktopHeight o:Y := o:nRow o:X := o:nCol o:W := o:nWidth o:H := o:nHeight o:MaxW := GetDesktopWidth() + 2*GetBorderWidth () o:MinH := GetTitleHeight () + 2*GetBorderHeight() + 2*GetMenuBarHeight() o:Row := o:nRow o:Col := o:nCol o:Width := o:nWidth o:Height := o:nHeight o:DesktopWidth := o:nDesktopWidth o:DesktopHeight := o:nDesktopHeight // Cliend area o:nClientRow := Sys.ClientRow o:nClientCol := Sys.ClientCol o:nClientWidth := Sys.ClientWidth o:nClientHeight := Sys.ClientHeight o:nY := o:nClientRow o:nX := o:nClientCol o:nW := o:nClientWidth o:nH := o:nClientHeight o:ClientRow := o:nClientRow o:ClientCol := o:nClientCol o:ClientWidth := o:nClientWidth o:ClientHeight := o:nClientHeight // TsBrowse color o:oTsbClr := oHmgData() o:oTsbClr:nClrText := GetSysColor( COLOR_WINDOWTEXT ) // [ 1 ] o:oTsbClr:nClrPane := GetSysColor( COLOR_WINDOW ) // [ 2 ] o:oTsbClr:nClrHeadFore := GetSysColor( COLOR_BTNTEXT ) // [ 3 ] o:oTsbClr:nClrHeadBack := GetSysColor( COLOR_BTNFACE ) // [ 4 ] o:oTsbClr:nClrForeFocu := GetSysColor( COLOR_CAPTIONTEXT ) // [ 5 ] o:oTsbClr:nClrFocuBack := GetSysColor( COLOR_ACTIVECAPTION ) // [ 6 ] o:oTsbClr:nClrEditFore := GetSysColor( COLOR_WINDOWTEXT ) // [ 7 ] o:oTsbClr:nClrEditBack := GetSysColor( COLOR_WINDOW ) // [ 8 ] o:oTsbClr:nClrFootFore := GetSysColor( COLOR_BTNTEXT ) // [ 9 ] o:oTsbClr:nClrFootBack := GetSysColor( COLOR_BTNFACE ) // [ 10 ] o:oTsbClr:nClrSeleFore := CLR_HGRAY // [ 11 ] inactive focused o:oTsbClr:nClrSeleBack := CLR_GRAY // [ 12 ] inactive focused o:oTsbClr:nClrOrdeFore := GetSysColor( COLOR_BTNTEXT ) // [ 13 ] o:oTsbClr:nClrOrdeBack := GetSysColor( COLOR_BTNFACE ) // [ 14 ] o:oTsbClr:nClrLine := GetSysColor( COLOR_BTNSHADOW ) // [ 15 ] o:oTsbClr:nClrSupHeadFore := GetSysColor( COLOR_BTNTEXT ) // [ 16 ] o:oTsbClr:nClrSupHeadBack := GetSysColor( COLOR_BTNFACE ) // [ 17 ] o:oTsbClr:nClrSpecHeadFore := GetSysColor( COLOR_BTNTEXT ) // [ 18 ] o:oTsbClr:nClrSpecHeadBack := GetSysColor( COLOR_BTNFACE ) // [ 19 ] o:oTsbClr:nClrSpecHeadActive := CLR_HRED // [ 20 ] o:oTsbClr:nClrAutoFilter := GetSysColor( COLOR_INACTCAPTEXT ) // [ 19 ] o:oTsbClr:nClrAutoSearch := GetSysColor( COLOR_INFOBK ) // [ 19 ] o:oTsbClr:nClrBtnHighLight := GetSysColor( COLOR_BTNHIGHLIGHT ) o:oTsbClr:nClrBtnChadow := GetSysColor( COLOR_BTNSHADOW ) o:oTsbClr:nClr_1 := o:nClrText // [ 1 ] o:oTsbClr:nClr_2 := o:nClrPane // [ 2 ] o:oTsbClr:nClr_3 := o:nClrHeadFore // [ 3 ] o:oTsbClr:nClr_4 := o:nClrHeadBack // [ 4 ] o:oTsbClr:nClr_5 := o:nClrForeFocu // [ 5 ] o:oTsbClr:nClr_6 := o:nClrFocuBack // [ 6 ] o:oTsbClr:nClr_7 := o:nClrEditFore // [ 7 ] o:oTsbClr:nClr_8 := o:nClrEditBack // [ 8 ] o:oTsbClr:nClr_9 := o:nClrFootFore // [ 9 ] o:oTsbClr:nClr_10 := o:nClrFootBack // [ 10 ] o:oTsbClr:nClr_11 := o:nClrSeleFore // [ 11 ] inactive focused o:oTsbClr:nClr_12 := o:nClrSeleBack // [ 12 ] inactive focused o:oTsbClr:nClr_13 := o:nClrOrdeFore // [ 13 ] o:oTsbClr:nClr_14 := o:nClrOrdeBack // [ 14 ] o:oTsbClr:nClr_15 := o:nClrLine // [ 15 ] o:oTsbClr:nClr_16 := o:nClrSupHeadFore // [ 16 ] o:oTsbClr:nClr_17 := o:nClrSupHeadBack // [ 17 ] o:oTsbClr:nClr_18 := o:nClrSpecHeadFore // [ 18 ] o:oTsbClr:nClr_19 := o:nClrSpecHeadBack // [ 19 ] o:oTsbClr:nClr_20 := o:nClrSpecHeadActive // [ 20 ] ENDIF IF HB_ISCHAR(cSec) IF "TSBC" $ upper(cSec) .or. "TSB" $ upper(cSec) RETURN App.Cargo:oSystem:oTsbClr ENDIF ENDIF RETURN App.Cargo:oSystem [/pre2] и используем в ini aWindow_YXWH = { oSys():Y, oSys():X, oSys():MaxW, oSys():MinH + 64 } PS Используя такую методику, теряется совместимость кодов для получения hrb, т.е. надо используемые ф-ии из *.ch переносить в отдельную lib и отключать *.ch от сборки проекта (собирать harbour.exe+Include можно, но для меня не вариант). Пока др. мыслей у меня нет
SergKis: gfilatov2002 пишет Тогда обрамление будет таким #ifdef _NAMES_LIST_ ... CLASS THmgData не должен иметь никаких обрамлений кода, т.е. доступен всегда, как и заполнение Cargo Alert окна. Обрамление, как было, так и должно остаться при определении public переменных
gfilatov2002: SergKis пишет: CLASS THmgData не должен иметь никаких обрамлений кода Да. Именно так сейчас и сделано в коде ядра. И в заголовке minigui.ch указано: [pre2] /* *********************************************************************** * Enable support for the internal OOP classes * * By default this is turned ON. */ #ifndef _LITE_ #define _OBJECT_ #endif [/pre2]
SergKis: gfilatov2002 пишет Именно так сейчас и сделано в коде ядра. Я бы еще добавил уст. Значения во всех окнах, контролах (где сейчас пусто) _HMG_aControlMiscData2 [k] := oHmgData() вместо '' _HMG_aFormMiscData2 [ k ] := oHmgData() вместо '' и ,возможно, App.Cargo тоже, сейчас там версия (значение char), его перенести в объект App.Cargo под опред. именем "раз пошла такая пьянка ..."
Andrey: Да при старте программы делаем:[pre2] INIT PROCEDURE SetsENV() SET DATE TO GERMAN SET DECIMALS TO 4 SET EPOCH TO 2000 SET EXACT ON SET SOFTSEEK ON SET CENTURY ON SET AUTOPEN OFF SET DELETED OFF ? Valtype(App.Cargo), App.Cargo .....[/pre2] Получаем - C Harbour MiniGUI 3.2.8 (stable) А почему сразу нельзя присвоить так: [pre2] App.Cargo := oHmgData() App.Cargo:MiniGui := "Harbour MiniGUI 3.2.8 (stable)" [/pre2] И потом нигде не мучиться по коду, делая своё пере присвоение для App.Cargo !
gfilatov2002: Andrey пишет: почему сразу нельзя присвоить так: App.Cargo := oHmgData() Уже сделал Благодарю за подсказку
Andrey: gfilatov2002 пишет: P.S. Кстати, решил разделить Минигуи на две сборки: 1) профессиональную версию (с разными дополнительными оптимизациями в Харборе и компактным бинарником Минигуи) 2) стандартную версию, которая будет распространяться бесплатно, но без дополнительных оптимизаций в Харборе и с отладочным кодом в библиотеке). Что скажете по этому поводу Может и надо такое деление... Только в проф-версию ещё бы предоставить сборку с MS-C и Unicode
SergKis: gfilatov2002 Небольшая добавка [pre2] CLASS TIniData INHERIT THmgData ... VAR nMaxVal AS NUMERIC INIT 20 // Max. length Value for note VAR cSrcReplChar AS STRING INIT "" // Original replacement character VAR cOutReplChar AS STRING INIT "" // Replacement by output symbol METHOD New( cIni, lMacro, lUtf8, cChar, cData, cSrcChar, cOutChar ) INLINE ( ::Super:New( .T. ), ; ::Def( cIni, lMacro, lUtf8, cChar, cData, cSrcChar, cOutChar ), Self ) CONSTRUCTOR _METHOD Def( cIni, lMacro, lUtf8, cChar, cData, cSrcChar, cOutChar ) _METHOD Read( cIniNew ) ... METHOD Def( cIni, lMacro, lUtf8, cChar, cData, cSrcChar, cOutChar ) CLASS TIniData ... ::cCommentChar := hb_defaultValue( cChar, ::cCommentChar ) IF HB_ISCHAR( cSrcChar ) .and. HB_ISCHAR( cOutChar ) ::cSrcReplChar := cSrcChar ::cOutReplChar := cOutChar ENDIF ... METHOD ToValue( cStr ) CLASS TIniData LOCAL xVal IF Empty( cStr ) ; RETURN cStr ENDIF IF !Empty( ::cSrcReplChar ) cStr := StrTran( cStr, ::cSrcReplChar, ::cOutReplChar ) ENDIF ... Это для оформления строк ini как таблица с колонками, задавать надо оба значения сразу, т.е. o:oMenuData := TIniData():New(o:cMenuFile, .T., , , , "|", ","):Read() или o:oMenuData := TIniData():New(o:cMenuFile, .T., , , , chr(9), ""):Read() [/pre2] содержимое ini, например, такое [pre2] [MENU_1] ; //--------------------------------------------------------------------------------------------------------------------------------- ; // Name Item text Icon Font Disable Function Param Separator ; //--1-------------------2---------------------------3------------------------4--------5-------6---------------7---------------8---- 010 = { 0 | gTxt('Caption_1') | "i_About32" | "Bold" | 1 | "MsgInfo" | "" | 1 } 020 = {"I_1"| '&1. '+gTxt('Menu_by_1') | oAC('ICO'):cIcoMyDbg | "Bold" | | "My_Debug" | {1,2,3} | } 030 = {"I_2"| '&2. '+gTxt('Menu_by_2') | oAC('ICO'):cIcoMyDbg | "Normal" | | "My_Debug" | {2,"Str3"} | } 040 = {"I_3"| '&3. '+gTxt('Menu_by_3') | oAC('ICO'):cIcoMyDbg | "Bold" | | "My_Debug" | {3,"Str4"} | 1 } 050 = {"I_4"| '&4. '+gTxt('Menu_by_4') | oAC('ICO'):cIcoMgDbg | "Normal" | | "Mg_Debug" | {4,"Str4"} | } 060 = {"I_5"| '&5. '+gTxt('Menu_by_5') | oAC('ICO'):cIcoMgDbg | "Bold" | | "Mg_Debug" | {5,"Str5"} | 1 } 070 = {"M11"| '&6. '+gTxt('Menu_by_6') | oAC('ICO'):cIcoYesNo | "DlgFont" | | "My_YesNo" | {"test11"} | } 080 = {"M13"| '&7. '+gTxt('Menu_by_7') | oAC('ICO'):cIcoYesNo | "ComSnMs" | | "My_YesNo" | {"test12"} | 1 } 090 = {"M14"| '&8. '+gTxt('Menu_by_8') | oAC('ICO'):cIcoInfo | "Bold" | | "AlertInfo" | {"test14"} | } 100 = {"M15"| '&9. '+gTxt('Menu_by_9') | oAC('ICO'):cIcoInfo | "DlgFont" | | "AlertInfo" | {"test15"} | 1 } 110 = {"YYY"| '&A. '+gTxt('Run_Notepad_1') | oAC('ICO'):cIcoNtpd | "ComSnMs" | | "myViewLog" | {1,2,3,.F. , ,"a"} | } 120 = {"ZZZ"| '&B. '+gTxt('Run_Notepad_2') | oAC('ICO'):cIcoNtpd | "ComSnMs" | | "myOpenLog" | {2,4,6,.T. , ,"b"} | 1 } 130 = {"I_7"| '&C. '+gTxt('No_processing_f_1') | "i_About32" | "Bold" | 1 | "No_Funct" | {"Str7",7} | } 140 = {"I_8"| '&D. '+gTxt('No_processing_f_2') | oAC('ICO'):cIcoNoExe | "Normal" | | "No_Funct" | {"Str8",8} | } [/pre2]
gfilatov2002: SergKis пишет: Небольшая добавка OK
SergKis: gfilatov2002 пишет Кстати, решил разделить Минигуи на две сборки: Сборки, по мне, должны содержать WVT, WVG lib, т.к. часто надо делать доступы к разным, чужим базам, почта, ... Это проще делать на WVT (у нас она сделана была как WVG еще на hb 2.0, содержит main menu, statusbar, button, ...). Сейчас иду делать это на свою сбору hb и hmg, т.к. для таких работ не требуется GUI интерфейс, но схожесть нужна
SergKis: PS Как относится к тек. версии hmg, как к конечной ? След. сборки уже поделятся на 2-е ? Т.к. новые сборки пока изучишь, пока поймешь, что можно, что нельзя ..., т.е. до реал. использования много времени утечет.
gfilatov2002: SergKis пишет: След. сборки уже поделятся на 2-е ? Да. Но разница между ними будет только в отсутствии оптимизации кода Минигуи и Харбора в стандартной сборке. Эти оптимизации будут использованы в платной PRO-версии. Вот и все.
SergKis: gfilatov2002 пишет Да. Тогда под нее, с некоторыми предложенными правками, пример (кому интересно) Тут https://TransFiles.ru/k17ey
gfilatov2002: SergKis пишет: под нее, с некоторыми предложенными правками, пример Спасибо Поправил функцию IconDll2File() для нового синтаксиса ExtractIconEx() из февральской сборки: [pre2] *----------------------------------------------------------------------------* FUNCTION IconDll2File(aIconList, cDirOut, cIconDll, lMsg) *----------------------------------------------------------------------------* LOCAL nI, aIcons := {}, cIconSave, nItem, cItem LOCAL aDim := {}, cPath, lRet, cFile LOCAL cMsg, cErr := "", nErr := 0 LOCAL oIco := oHmgData() DEFAULT lMsg := .T., cDirOut := "ICO", ; cIconDll := "shell32.dll" IF !HB_ISARRAY(aIconList) ; aIconList := {} ENDIF IF !hb_ps() $ cIconDll cIconDll := Sys.SystemFolder + hb_ps() + cIconDll ENDIF lRet := hb_FileExists( cIconDll ) IF !lRet .or. Empty( aIconList ) cMsg := ProcNL() cMsg += CRLF + Repl("=", Len(cMsg)) + CRLF cMsg += iif( lRet, "Undefined list of icons !", ; "DLL icon file not found !" ) + ";" cMsg += "List of icons:" + " ARRAY[ " + hb_ntos(aIconList) + " ]" ? cMsg IF lMsg ; AlertStop( cMsg , "Error" ) ENDIF RETURN NIL ENDIF FOR EACH aIcons IN aIconList ; AAdd(aDim, AClone(aIcons)) NEXT cPath := GetStartUpFolder() + hb_ps() + cDirOut + hb_ps() IF !hb_DirExists( cPath ) ; hb_DirBuild( cPath ) ENDIF FOR nI := 1 TO LEN(aDim) nItem := aDim[nI,2] cItem := HB_NtoS(nItem) cFile := ALLTRIM(aDim[nI,3]) cIconSave := cPath + cFile + "#" + cItem + '.ico' IF hb_FileExists( cIconSave ) oIco:Set ( aDim[nI,1], cIconSave ) // положили key, value LOOP ENDIF AAdd(aIcons, ExtractIconEx( cIconDll, nItem, 32, 32 )[1]) AAdd(aIcons, ExtractIconEx( cIconDll, nItem, 64, 64 )[1]) // icon with number XX to write along the path lRet := C_SaveHIconToFile( cIconSave, aIcons ) DestroyIcon(aIcons[1]) // ОБЯЗАТЕЛЬНО ! / NECESSARILY ! DestroyIcon(aIcons[2]) // ОБЯЗАТЕЛЬНО ! / NECESSARILY ! aIcons := {} wApi_Sleep(100) IF lRet ; oIco:Set( aDim[nI,1], cIconSave ) // положили key, value ELSE ; cErr += cIconSave + ";" ; nErr++ ENDIF NEXT wApi_Sleep(200) ; DO EVENTS IF nErr > 0 .and. lMsg cMsg := ProcNL() cMsg += CRLF + Repl("=", Len(cMsg)) + CRLF cMsg += cErr ? cMsg IF lMsg ; AlertStop( cMsg , "Icon is NOT saved !" ) ENDIF ENDIF RETURN oIco [/pre2]
Andrey: gfilatov2002 пишет: AAdd(aIcons, ExtractIconEx( cIconDll, nItem, 32, 32 )[1]) AAdd(aIcons, ExtractIconEx( cIconDll, nItem, 64, 64 )[1]) 128х128 - тоже нужно ОБЯЗАТЕЛЬНО ! Всякие менюшки делать, экраны у всех большие давно уже.
Andrey: Иконки размером 256х256 в ресурсы включаю, а ехе-ник не собирается. Так должно быть или нет ?
gfilatov2002: Andrey пишет: ехе-ник не собирается Попробуй сделать таким образом: ICON256 RCDATA IconVista.ico а потом используй фнкцию RCDataToFile() для извлечения ресурсов.
Andrey: Понял, Спасибо !
SergKis: gfilatov2002 Доработанный пример c menu (добавлены языки), надо учитывать, что это не unicode версия. В demo4.mnu файлы показано, как в этом черновике набирать, отлаживать меню (без сборки exe), потом можно переносить отлаженное в ресурсы .\res\_demo4.mnu, с текстами меню поступаем так же, черновики убрал в подкаталог. Пример тут https://TransFiles.ru/eztyk
gfilatov2002: SergKis пишет: Доработанный пример c menu Спасибо Но если выбираем второй пункт Config меню -> Themes menu, то получаем ошибку Error BASE/1004 Метод не экспортирован: NPOST Args: [1] = C --------------------------------- Stack Trace --------------------------------- Called from NPOST(0) Called from (b)CREATE_MENUITEM(437) in module: demo4_func.prg Called from _DOCONTROLEVENTPROCEDURE(2040) in module: h_windows.prg Called from EVENTS(1865) in module: h_events.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1644) in module: h_windows.prg Called from MAIN(98) in module: demo4.prg
SergKis: gfilatov2002 пишет Но если выбираем второй пункт Config меню -> Themes menu, то получаем ошибку Есть такое дело, пропустил добавку к имени контрола (пересеклись имена с Item строкой) в popup, надо сделать правку demo4_func.prg [pre2] *----------------------------------------------------------------------------* FUNCTION Create_Menu(cName, cMenu, oMenu, cGrup, cForm, nPost, cFltr, lIncl) *----------------------------------------------------------------------------* ... nPop += 1 cTyp := "POPUP" cGrp := cTyp+ "_" + cGrup + "_" + hb_ntos(nPop) cText := aItm[2] ... [/pre2]
gfilatov2002: SergKis пишет: пропустил добавку к имени контрола Спасибо, сейчас все пункты меню работают нормально. Но в коде этого примера есть два определения функции PromptGetForms(): Warning: Public symbol '_HB_FUN_PROMPTGETFORMS' defined in both module C:\MINIGUI\SAMPLES\1\MENU_POPUP_4\OBJ\TEST4_MENU.OBJ and C:\MINIGUI\SAMPLES\1\MENU_POPUP_4\OBJ\DEMOS_UTIL.OBJ
SergKis: gfilatov2002 пишет Но в коде этого примера есть два определения функции PromptGetForms(): Эту часть Андрей двигает, я не стал убирать, т.к. и ему перекинул версию. , но можно убрать, целью этого примера была показать возможности работы с ini, объектами-контейнерами, чтение, объединение объектов и создание псевдо объектов ф-я oSys(), где есть свойства и типа методы на основе блоков кода, а так же написания общих, в App.Object событий-блоков кода (не только на окне) и дальнейшее их использование в функциях и схему работы с языками, т.е. языковые тексты лежат в файлах utf8, а работа происходит с конкретной CDP, в данном случае RU1251. Т.к. это конечная версия hmg в таком виде, то я начал делать во всех окнах и контролах, где можно, Cargo := oHmgData() + в базовых окнах параметры от объекта oHmgData(), т.е. хочу мах. соединиться с версией от 2012 г. Делаю ~ такие правки [pre2] *-----------------------------------------------------------------------------* FUNCTION _DefineWindow ( FormName, Caption, x, y, w, h, nominimize, nomaximize, ; nosize, nosysmenu, nocaption, aMin, aMax, InitProcedure, ReleaseProcedure, ; MouseDragProcedure, SizeProcedure, ClickProcedure, MouseMoveProcedure, aRGB, ; PaintProcedure, noshow, topmost, main, icon, child, fontname, fontsize, ; NotifyIconName, NotifyIconTooltip, NotifyIconLeftClick, GotFocus, LostFocus, ; VirtualHeight, VirtualWidth, scrollleft, scrollright, scrollup, scrolldown, ; hscrollbox, vscrollbox, helpbutton, MaximizeProcedure, MinimizeProcedure, cursor, ; NoAutoRelease, InteractiveCloseProcedure, RestoreProcedure, MoveProcedure, DropProcedure, ; mdi, palette, NotifyIconDblClick, cPanelParent, panel, NotifyBalloonClick, clientwidth, clientheight ) *-----------------------------------------------------------------------------* LOCAL BrushHandle, FormHandle, ParentHandle LOCAL hnotifyicon, htooltip LOCAL ClassName LOCAL cType LOCAL mVar LOCAL vscroll, hscroll LOCAL k #ifdef _OBJECT_ LOCAL o //_!!! IF HB_ISOBJECT( FormName ) o := FormName FormName := o:FormName Caption := o:Caption x := o:x y := o:y w := o:w h := o:h nominimize := o:nominimize nomaximize := o:nomaximize nosize := o:nosize nosysmenu := o:nosysmenu nocaption := o:nocaption aMin := o:aMin aMax := o:aMax InitProcedure := o:InitProcedure ReleaseProcedure := o:ReleaseProcedure MouseDragProcedure := o:MouseDragProcedure SizeProcedure := o:SizeProcedure ClickProcedure := o:ClickProcedure MouseMoveProcedure := o:MouseMoveProcedure aRGB := o:aRGB PaintProcedure := o:PaintProcedure noshow := o:noshow topmost := o:topmost main := o:main icon := o:icon child := o:child fontname := o:fontname fontsize := o:fontsize NotifyIconName := o:NotifyIconName NotifyIconTooltip := o:NotifyIconTooltip NotifyIconLeftClick := o:NotifyIconLeftClick GotFocus := o:GotFocus LostFocus := o:LostFocus VirtualHeight := o:VirtualHeight VirtualWidth := o:VirtualWidth scrollleft := o:scrollleft scrollright := o:scrollright scrollup := o:scrollup scrolldown := o:scrolldown hscrollbox := o:hscrollbox vscrollbox := o:vscrollbox helpbutton := o:helpbutton MaximizeProcedure := o:MaximizeProcedure MinimizeProcedure := o:MinimizeProcedure cursor := o:cursor NoAutoRelease := o:NoAutoRelease InteractiveCloseProcedure := o:InteractiveCloseProcedure RestoreProcedure := o:RestoreProcedure MoveProcedure := o:MoveProcedure DropProcedure := o:DropProcedure mdi := o:mdi palette := o:palette NotifyIconDblClick := o:NotifyIconDblClick cPanelParent := o:cPanelParent panel := o:panel NotifyBalloonClick := o:NotifyBalloonClick clientwidth := o:clientwidth clientheight := o:clientheight o := NIL ENDIF //_!!! --- #endif ... //_!!! IF HB_ISNUMERIC( w ) .and. w > 0 .and. w < 1 w := int( GetDesktopWidth() * w ) ENDIF IF HB_ISNUMERIC( h ) .and. h > 0 .and. h < 1 h := int( GetDesktopHeight() * h ) ENDIF //_!!! --- IF !ISNUMBER( w ) .AND. !ISNUMBER( h ) ... _HMG_aFormMiscData2 [ k ] := oHmgData() //_!!! '' ... AAdd ( _HMG_aFormMiscData2, oHmgData() ) //_!!! '' ) ... _SetThisFormInfo ( k ) o := _HMG_aFormMiscData2 [ k ] //_!!! o:nForm := k o:cForm := FormName o:hForm := FormHandle o:cType := _HMG_aFormType [ k ] o:aBColor := _HMG_aFormBkColor [ k ] o:hParent := _HMG_aFormParentHandle [ k ] o:cParent := "" o:nParent := 0 IF !Empty( o:hParent ) o:nParent := GetFormNameByHandle ( o:hParent, @o:cParent ) ENDIF IF _HMG_lOOPEnabled Eval ( _HMG_bOnFormInit, k, mVar ) #ifdef _OBJECT_ o := _WindowObj( FormHandle ) IF HB_ISOBJECT( o ) o:cProcFile := ProcFile( 1 ) o:cProcName := ProcName( 1 ) o:nProcLine := ProcLine( 1 ) ENDIF #endif ENDIF ... [/pre2] т.е. версия 24.01 у меня только в архиве.
SergKis: gfilatov2002 Небольшие правки для multiline [pre2] METHOD TextWidth( cText, nSize, cFont, lBold, cChar ) CLASS TDlu2Pix LOCAL hFont, nWidth, cTxt := "", cTmp IF HB_ISARRAY( cText ) FOR EACH cTmp IN cText IF !HB_ISCHAR( cTmp ) ; cTmp := cValToChar( cTmp ) ENDIF IF Len(cTmp) > Len( cTxt ) ; cTxt := cTmp ENDIF NEXT cText := cTxt ENDIF cChar := hb_defaultValue( cChar, 'A' ) ... METHOD Breadth( nW, k ) CLASS TDlu2Pix LOCAL nWidth := 0, cW := "", cTmp IF HB_ISARRAY( nW ) FOR EACH cTmp IN nW IF Len(cTmp) > Len( cW ) ; cW := cTmp ENDIF NEXT nW := ::TextWidth( cW ) ELSEIF HB_ISCHAR( nW ) nW := ::TextWidth( nW ) ENDIF k := hb_defaultValue( k, 0.5 ) ... [/pre2]
gfilatov2002: SergKis пишет: Небольшие правки OK
SergKis: PS. Использование правки, например, такое (для Label) [pre2] *-----------------------------------------------------------------------------* FUNCTION _Set_Font_Default( FontName, FontSize, w, h, cText ) //_!!! *-----------------------------------------------------------------------------* LOCAL o := oHmgData(), FontHandle Default FontName := hb_defaultValue( FontName, _HMG_DefaultFontName ) IF FontSize == NIL IF ( FontHandle := GetFontHandle( FontName ) ) != 0 GetFontParamByRef( FontHandle, @FontName, @FontSize ) ENDIF ENDIF Default FontSize := hb_defaultValue( FontSize, _HMG_DefaultFontSize ) Default cText := " " o:oDlu := oDlu2Pixel( , , FontSize ) IF CRLF $ cText ; Default h := Len( hb_ATokens( cText, CRLF ) ) * o:oDlu:H1 ELSE ; Default h := 1 ENDIF IF h > 0 .and. h <= 5 ; h := o:oDlu:H( h ) ENDIF IF CRLF $ cText ; Default w := o:oDlu:Breadth( hb_ATokens( cText, CRLF ) ) ELSE ; Default w := 2 ENDIF IF w > 0 .and. w <= 5 ; w := o:oDlu:W( w ) ENDIF o:FontName := FontName o:FontSize := FontSize o:w := w o:h := h RETURN o *-----------------------------------------------------------------------------* FUNCTION _Set_Cargo_Values( k, lWindow, mVar, ParentFormName ) //_!!! *-----------------------------------------------------------------------------* LOCAL o IF !Empty( lWindow ) // for Windows IF !HB_ISOBJECT(_HMG_aFormMiscData2 [ k ] ) _HMG_aFormMiscData2 [ k ] := oHmgData() ENDIF o := _HMG_aFormMiscData2 [ k ] o:nIndex := k o:cType := _HMG_aFormType [ k ] o:cForm := _HMG_aFormNames [ k ] o:nHandle := _HMG_aFormHandles [ k ] o:aBColor := _HMG_aFormBkColor [ k ] o:hParent := _HMG_aFormParentHandle [ k ] o:cParent := "" o:nParent := 0 o:mVar := mVar o:lHandle := IsWindowHandle( o:nHandle ) o:lParent := IsWindowHandle( o:hParent ) IF !Empty( o:hParent ) .and. o:lParent o:nParent := GetFormNameByHandle ( o:hParent, @o:cParent ) ENDIF Default o:cFontName := _HMG_ActiveFontName Default o:nFontSize := _HMG_ActiveFontSize Default o:oFontDlu := oDlu2Pixel( , , o:nFontSize ) ELSE // for Controls o := _HMG_aControlMiscData2 [ k ] ; Default o := oHmgData() o:nIndex := k o:cType := _HMG_aControlType [ k ] o:cName := _HMG_aControlNames [ k ] o:nHandle := _HMG_aControlHandles [ k ] o:aBColor := _HMG_aControlBkColor [ k ] o:aFColor := _HMG_aControlFontColor[ k ] o:hParent := _HMG_aControlParenthandles [ k ] o:cParent := "" o:nParent := 0 o:mVar := mVar o:lHandle := IsWindowHandle( o:nHandle ) o:lParent := IsWindowHandle( o:hParent ) IF !Empty( ParentFormName ) o:cParent := ParentFormName o:nParent := GetFormIndex( ParentFormName ) ELSEIF !Empty( o:hParent ) .and. o:lParent o:nParent := GetFormNameByHandle ( o:hParent, @o:cParent ) ENDIF ENDIF RETURN o ... h_label.prg #include "minigui.ch" #include "i_winuser.ch" *-----------------------------------------------------------------------------* FUNCTION _CreateLabel ( oControl ) *-----------------------------------------------------------------------------* LOCAL o := oControl, q LOCAL ControlName, ParentFormName, x, y, Caption, w, h, ; fontname, fontsize, bold, BORDER, CLIENTEDGE, HSCROLL, VSCROLL, ; TRANSPARENT, aRGB_bk, aRGB_font, ProcedureName, tooltip, HelpId, ; invisible, italic, underline, strikeout, autosize, rightalign, ; centeralign, blink, mouseover, mouseleave, VCenterAlign, ; NoPrefix, nId, bInit, dblclick, rclick ControlName := o:ControlName ParentFormName := o:ParentFormName x := o:x y := o:y Caption := o:Caption w := o:w h := o:h fontname := o:fontname fontsize := o:fontsize bold := o:bold BORDER := o:BORDER CLIENTEDGE := o:CLIENTEDGE HSCROLL := o:HSCROLL VSCROLL := o:VSCROLL TRANSPARENT := o:TRANSPARENT aRGB_bk := o:aRGB_bk ; Default aRGB_bk := o:aBColor aRGB_font := o:aRGB_font ; Default aRGB_font := o:aFColor ProcedureName := o:ProcedureName tooltip := o:tooltip HelpId := o:HelpId invisible := o:invisible italic := o:italic underline := o:underline strikeout := o:strikeout autosize := o:autosize rightalign := o:rightalign centeralign := o:centeralign blink := o:blink mouseover := o:mouseover mouseleave := o:mouseleave VCenterAlign := o:VCenterAlign NoPrefix := o:NoPrefix nId := o:nId bInit := o:bInit dblclick := o:dblclick rclick := o:rclick Default aRGB_bk := o:aBackColor Default aRGB_font := o:aFontColor q := _Set_Font_Default( FontName, FontSize, w, h, Caption ) FontName := q:FontName ; w := q:w FontSize := q:FontSize ; h := q:h q := _DefineLabel ( ControlName, ParentFormName, x, y, Caption, w, h, ; fontname, fontsize, bold, BORDER, CLIENTEDGE, HSCROLL, VSCROLL, ; TRANSPARENT, aRGB_bk, aRGB_font, ProcedureName, tooltip, HelpId, ; invisible, italic, underline, strikeout, autosize, rightalign, ; centeralign, blink, mouseover, mouseleave, VCenterAlign, ; NoPrefix, nId, bInit, dblclick, rclick ) IF HB_ISOBJECT( q ) q:cProcFile := ProcFile( 1 ) q:cProcName := ProcName( 1 ) q:nProcLine := ProcLine( 1 ) IF !Empty( q:lHandle ) o := _ControlObj( q:nHandle ) o:cProcFile := ProcFile( 1 ) o:cProcName := ProcName( 1 ) o:nProcLine := ProcLine( 1 ) ENDIF ENDIF RETURN q *-----------------------------------------------------------------------------* FUNCTION _DefineLabel ( ControlName, ParentFormName, x, y, Caption, w, h, ; fontname, fontsize, bold, BORDER, CLIENTEDGE, HSCROLL, VSCROLL, ; TRANSPARENT, aRGB_bk, aRGB_font, ProcedureName, tooltip, HelpId, invisible, ; italic, underline, strikeout, autosize, rightalign, centeralign, ; blink, mouseover, mouseleave, VCenterAlign, NoPrefix, nId, bInit, dblclick, rclick ) *-----------------------------------------------------------------------------* LOCAL ParentFormHandle, ControlHandle, FontHandle LOCAL mVar LOCAL k := 0 LOCAL Style LOCAL blInit LOCAL lDialogInMemory LOCAL ow, oc, o hb_default( @w, 120 ) hb_default( @h, 24 ) __defaultNIL( @ProcedureName, "" ) hb_default( @invisible, .F. ) hb_default( @bold, .F. ) hb_default( @italic, .F. ) hb_default( @underline, .F. ) hb_default( @strikeout, .F. ) hb_default( @VCenterAlign, .F. ) __defaultNIL( @rclick, "" ) __defaultNIL( @Caption , "" ) hb_default( @blink , .F. ) hb_default( @autosize , .F. ) hb_default( @border , .F. ) hb_default( @HSCROLL , .F. ) hb_default( @VSCROLL , .F. ) hb_default( @NoPrefix , .F. ) hb_default( @TRANSPARENT , .F. ) hb_default( @rightalign , .F. ) hb_default( @centeralign , .F. ) hb_default( @VCenterAlign, .F. ) IF ( FontHandle := GetFontHandle( FontName ) ) != 0 GetFontParamByRef( FontHandle, @FontName, @FontSize, @bold, @italic, @underline, @strikeout ) ENDIF IF _HMG_BeginWindowActive .OR. _HMG_BeginDialogActive ParentFormName := iif( _HMG_BeginDialogActive, _HMG_ActiveDialogName, _HMG_ActiveFormName ) __defaultNIL( @FontName, _HMG_ActiveFontName ) __defaultNIL( @FontSize, _HMG_ActiveFontSize ) ENDIF IF _HMG_FrameLevel > 0 .AND. !_HMG_ParentWindowActive x := x + _HMG_ActiveFrameCol [_HMG_FrameLevel] y := y + _HMG_ActiveFrameRow [_HMG_FrameLevel] ParentFormName := _HMG_ActiveFrameParentFormName [_HMG_FrameLevel] ENDIF lDialogInMemory := _HMG_DialogInMemory IF .NOT. _IsWindowDefined ( ParentFormName ) .AND. .NOT. lDialogInMemory MsgMiniGuiError( "Window: " + IFNIL( ParentFormName, "Parent", ParentFormName ) + " is not defined." ) ENDIF IF _IsControlDefined ( ControlName, ParentFormName ) .AND. .NOT. lDialogInMemory MsgMiniGuiError ( "Control: " + ControlName + " Of " + ParentFormName + " Already defined." ) ENDIF IF ISARRAY ( Caption ) mVar := '' AEval ( Caption, {|v| mVar += cValToChar ( v ) } ) Caption := mVar ELSEIF ISBLOCK ( Caption ) Caption := cValToChar ( Eval ( Caption ) ) ELSE Caption := cValToChar ( Caption ) ENDIF mVar := '_' + ParentFormName + '_' + ControlName k := _GetControlFree() IF _HMG_BeginDialogActive ParentFormHandle := _HMG_ActiveDialogHandle Style := WS_CHILD + SS_NOTIFY IF border Style += WS_BORDER ENDIF IF !invisible Style += WS_VISIBLE ENDIF IF HSCROLL Style += WS_HSCROLL ENDIF IF VSCROLL Style += WS_VSCROLL ENDIF IF rightalign Style += ES_RIGHT ENDIF IF centeralign Style += ES_CENTER ENDIF IF VCenterAlign Style += SS_CENTERIMAGE ENDIF IF lDialogInMemory //Dialog Template // {{'ID',k/hwnd,class,Style,ExStyle,x,y,w,h,caption,HelpId,tooltip,font,size, bold, italic, underline, strikeout}} --->_HMG_aDialogItems blInit := {|x, y, z| InitDialogLabel( x, y, z ) } AAdd( _HMG_aDialogItems, { nId, k, "static", style, 0, x, y, w, h, caption, HelpId, tooltip, FontName, FontSize, bold, italic, underline, strikeout, blInit, _HMG_BeginTabActive, .F. , _HMG_ActiveTabPage } ) ELSE ControlHandle := GetDialogItemHandle ( ParentFormHandle, nId ) x := GetWindowCol ( Controlhandle ) y := GetWindowRow ( Controlhandle ) w := GetWindowWidth ( Controlhandle ) h := GetWindowHeight ( Controlhandle ) IF caption != NIL SetWindowText ( ControlHandle , caption ) ENDIF SetWindowStyle ( ControlHandle, Style, .T. ) ENDIF ELSE ParentFormHandle := GetFormHandle ( ParentFormName ) Controlhandle := InitLabel ( ParentFormHandle, Caption, 0, x, y, w, h, '', ( ISBLOCK( ProcedureName ) .OR. ISBLOCK( dblclick ) .OR. ISBLOCK( rclick ) .OR. ISSTRING( tooltip ) ), ( ISBLOCK( mouseover ) .OR. ISBLOCK( mouseleave ) ) , border , clientedge , HSCROLL , VSCROLL , TRANSPARENT , invisible , rightalign , centeralign , VCenterAlign , NoPrefix ) ENDIF IF .NOT. lDialogInMemory IF FontHandle != 0 _SetFontHandle( ControlHandle, FontHandle ) ELSE __defaultNIL( @FontName, _HMG_DefaultFontName ) __defaultNIL( @FontSize, _HMG_DefaultFontSize ) FontHandle := _SetFont ( ControlHandle, FontName, FontSize, bold, italic, underline, strikeout ) ENDIF IF _HMG_BeginTabActive AAdd ( _HMG_ActiveTabCurrentPageMap , Controlhandle ) ENDIF IF tooltip != NIL SetToolTip ( ControlHandle , tooltip , GetFormToolTipHandle ( ParentFormName ) ) ENDIF ENDIF #ifdef _NAMES_LIST_ _SetNameList( mVar , k ) #else Public &mVar. := k #endif _HMG_aControlType [k] := "LABEL" _HMG_aControlNames [k] := ControlName _HMG_aControlHandles [k] := ControlHandle _HMG_aControlParenthandles [k] := ParentFormHandle _HMG_aControlIds [k] := nId _HMG_aControlProcedures [k] := ProcedureName _HMG_aControlPageMap [k] := {} _HMG_aControlValue [k] := Nil _HMG_aControlInputMask [k] := transparent _HMG_aControllostFocusProcedure [k] := mouseleave _HMG_aControlGotFocusProcedure [k] := mouseover _HMG_aControlChangeProcedure [k] := rclick _HMG_aControlDeleted [k] := .F. _HMG_aControlBkColor [k] := aRGB_bk _HMG_aControlFontColor [k] := aRGB_font _HMG_aControlDblClick [k] := _HMG_ActiveTabButtons _HMG_aControlHeadClick [k] := dblclick _HMG_aControlRow [k] := y _HMG_aControlCol [k] := x _HMG_aControlWidth [k] := w _HMG_aControlHeight [k] := h _HMG_aControlSpacing [k] := iif ( autosize == .T. , 1 , 0 ) _HMG_aControlContainerRow [k] := iif ( _HMG_FrameLevel > 0 , _HMG_ActiveFrameRow [_HMG_FrameLevel] , -1 ) _HMG_aControlContainerCol [k] := iif ( _HMG_FrameLevel > 0 , _HMG_ActiveFrameCol [_HMG_FrameLevel] , -1 ) _HMG_aControlPicture [k] := "" _HMG_aControlContainerHandle [k] := 0 _HMG_aControlFontName [k] := fontname _HMG_aControlFontSize [k] := fontsize _HMG_aControlFontAttributes [k] := { bold, italic, underline, strikeout } _HMG_aControlToolTip [k] := tooltip _HMG_aControlRangeMin [k] := iif ( _HMG_FrameLevel > 0 , _HMG_ActiveTabName , '' ) _HMG_aControlRangeMax [k] := iif ( _HMG_FrameLevel > 0 , _HMG_ActiveFrameParentFormName [_HMG_FrameLevel] , '' ) _HMG_aControlCaption [k] := Caption _HMG_aControlVisible [k] := iif( invisible, FALSE, TRUE ) _HMG_aControlHelpId [k] := HelpId _HMG_aControlFontHandle [k] := FontHandle _HMG_aControlBrushHandle [k] := 0 _HMG_aControlEnabled [k] := .T. _HMG_aControlMiscData1 [k] := { 0, blink, .T. } _HMG_aControlMiscData2 [k] := oHmgData() //_!!! '' IF blink == .T. .AND. .NOT. lDialogInMemory _DefineTimer ( 'BlinkTimer' + hb_ntos( k ) , ParentFormName , 500 , {|| _HMG_aControlMiscData1 [k] [3] := ! _HMG_aControlMiscData1 [k] [3], ; iif( _HMG_aControlMiscData1 [k] [3] == .T. , _ShowControl ( ControlName , ParentFormName ), _HideControl ( ControlName , ParentFormName ) ) } ) ENDIF IF autosize == .T. .AND. .NOT. lDialogInMemory _SetControlWidth ( ControlName , ParentFormName , GetTextWidth( NIL, Caption, FontHandle ) + ; iif( bold == .T. .OR. italic == .T., GetTextWidth( NIL, " ", FontHandle ), 0 ) ) _SetControlHeight ( ControlName , ParentFormName , FontSize + iif( FontSize < 14, 12, 16 ) ) ENDIF oc := _Set_Cargo_Values( k, .F., mVar, ParentFormName ) //_!!! oc:cProcFile := ProcFile( 1 ) oc:cProcName := ProcName( 1 ) oc:nProcLine := ProcLine( 1 ) IF _HMG_lOOPEnabled Eval ( _HMG_bOnControlInit, k, mVar ) ow := _WindowObj ( ParentFormHandle ) o := _ControlObj( ControlHandle ) IF HB_ISOBJECT ( o ) o:cProcFile := ProcFile( 1 ) o:cProcName := ProcName( 1 ) o:nProcLine := ProcLine( 1 ) ENDIF ENDIF Do_ControlEventProcedure ( bInit, k, ow, o ) RETURN oc // Cargo ... [/pre2]
gfilatov2002: SergKis пишет: Использование правки, например Благодарю за пример Очень интересно
gfilatov2002: Завершена подготовка новой сборки 24.02, которая будет опубликована на следующей неделе. Как я уже сообщал ранее, дистрибутив Minigui разделен на две неравные части: стандартную и профессиональную. Одна часть — это бесплатный установщик Minigui, содержащий отладочную версию библиотеки и стандартный компилятор Harbour без оптимизаций. Она не содержит примеров готовых приложений или служебных программ, а также библиотеку SqlRdd. Другая часть представляет собой защищенный паролем архив 7z со всеми расширенными компонентами. Она содержит сжатую библиотеку Minigui без отладочной информации и оптимизированную виртуальную машину Harbour для приложений с графическим интерфейсом, а также исправленную библиотеку SqlRdd. Кратко, что нового: [pre2] * Fixed: The program crashed when using the HMG_SetMenuTheme() function along with a transparent label on the form (introduced in the build 19.10). * New: Added the useful function HMG_GetAllFonts( [ lObj ] ) to get an array of font names and parameters that were defined with DEFINE FONT <font> FONTNAME <name> ... command. * Enhanced: Added the optional 3rd and 4th parameters in the ExtractIconEx() function for extraction the ICON of a resource ID from exe or dll. Syntax: ExtractIconEx( cResName, nItem [, nX ] [, nY ] ) => { hIcon, nId }, where nX and xY are the icon sizes in pixels (32x32 by default). * Updated: Improved object error logging using the _o2Log() function. * Updated the Harbour Compiler 3.2, SQLRDD and Sqlite libraries. * Added new and updated some Basic and Advanced samples. [/pre2] Также я подготовил отдельные архивы этой сборки для работы с устаревшим компилятором BCC 5.5.1 (2000 года) и новейшим Embarcadero C++ 7.70 (2023 года) Ваши комментарии приветствуются...
SergKis: gfilatov2002 Добавил обработку json в THmgData и TIniData, подробнее в архиве в файле read.my, может пригодится Пример тут https://TransFiles.ru/l4a1g PS Переменные App.Cargo без секции, в примере, при создании ini идут в секцию [MAIN] - это можго делать и в др. секцию. Присвоение (обратите внимание) App.Cargo:Form_Main := oForm и oi:MAIN:oForm := oForm дают разные результаты PS2 Пропустил, не убрал отладочную строку в METHOD ToValue( cStr ) CLASS TIniData ? procname(), procline(), cStr
gfilatov2002: SergKis пишет: Добавил обработку json в THmgData и TIniData Благодарю за помощь Эти изменения буду рассматривать уже для следующей сборки...
gfilatov2002: Выложил финальную сборку 24.02 с последними исправлениями и дополнениями по адресу Стандартная версия SHA-256: c7622385ffbb1b01803252347a0eb35f654f8970f5029fafe8414ec13ab737cd Желаю всем хорошего дня P.S. Также на сайте проекта доступна ссылка на архив профессиональной версии (она защищена паролем).
SergKis: gfilatov2002 1. Такие конструкции, по мне, лишние, например в h_alert.prg [pre2] #ifdef _NAMES_LIST_ This.Cargo := oHmgData() #endif ... #ifdef _NAMES_LIST_ LOCAL nY, nX, cIco #endif ... #ifdef _NAMES_LIST_ This.Cargo:oTimer := "TIMER" #endif ... [/pre2] Они связаны только с использованием bInit, для облегчения жизни при обработке. oHmgData() есть всегда, а _NAMES_LIST_ только для использования списка переменных вместо PUBLIC переменных. 2. Давно хотел предложить, но вылетало из головы, для таймеров ставить Enabled := .F. сразу, что бы не было ложных срабатываний до ON INIT и лишних команд к DEFINE TIMER oTimer ... -> This.oTimer.Enabled := .F. 3. [pre2] *-----------------------------------------------------------------------------* FUNCTION AlertExclamation ( Message, Title, Icon, nSize, aColors, lTopMost, bInit, lNoSound ) *-----------------------------------------------------------------------------* LOCAL nWaitSec IF HB_ISARRAY( Title ) nWaitSec := Title[2] Title := Title[1] ENDIF ... *-----------------------------------------------------------------------------* FUNCTION AlertInfo ( Message, Title, Icon, nSize, aColors, lTopMost, bInit, lNoSound ) *-----------------------------------------------------------------------------* LOCAL nWaitSec IF HB_ISARRAY( Title ) nWaitSec := Title[2] Title := Title[1] ENDIF ... *-----------------------------------------------------------------------------* FUNCTION AlertStop ( Message, Title, Icon, nSize, aColors, lTopMost, bInit, lNoSound ) *-----------------------------------------------------------------------------* LOCAL nWaitSec IF HB_ISARRAY( Title ) nWaitSec := Title[2] Title := Title[1] ENDIF ... [/pre2]
gfilatov2002: SergKis пишет: Такие конструкции, по мне, лишние Это подстраховка, если библиотека собрана без использования NAMES_LIST (например, для xHarbour). SergKis пишет: для таймеров ставить Enabled := .F. сразу Это не всегда удобно. Но, возможно, надо добавить команду-переключатель этого режима Благодарю за Ваши предложения Они всегда двигают наш проект вперед...
полная версия страницы