MsgInfo(), MsgStop(), MsgExclamation(), MsgDebug()

Форум » GUI » MsgInfo(), MsgStop(), MsgExclamation(), MsgDebug() » Ответить

MsgInfo(), MsgStop(), MsgExclamation(), MsgDebug()

Andrey: Уже скоро 2019 год будет, а эти функции до сих пор неизменны. Экраны большие у пользователей уже давно. Замучили юзера вопросом, а побольше шрифт можно сделать для этих окон ? A то читать приходиться через лупу. Настолько мелкий шрифт в этих сообщениях для больших экранов. Можно ли установить для этих окон при запуске программы РАЗМЕР фонта, ну и до кучи сам фонт ? Типа: [pre2]SET MSGFUNCT FONT TO cFont, nFontSize [/pre2] Как есть команда: [pre2]SET FONT TO cFont, nFontSize [/pre2] Ну и до кучи задать другой размер иконки и картинки: [pre2]SET MSGFUNCT SIZE 256 // или 48, 64, 72, 96, 128 SET MSGINFO SIZE 64 ICO "INFO64.ICO"[/pre2] Тогда за иконку отвечать будет сам программист. Нет иконки в ресурсах, и нет в окошке иконки. И цвета окошек тоже: [pre2]SET MSGINFO BACKCOLOR aDim1 FONTCOLOR aDim2 SET MSGSTOP BACKCOLOR aDim1 FONTCOLOR aDim2 SET MSGEXCL BACKCOLOR aDim1 FONTCOLOR aDim2 SET MSGDEBUG BACKCOLOR aDim1 FONTCOLOR aDim2[/pre2] Если это нельзя сделать для этих функций и не хочется увеличивать размер ресурсов для текущей версии МиниГуи, то хотелось бы иметь дополнительную библиотеку MiniguiExt.lib и файл ресурсов miniguiExt.res Т.е. сделать доп.функции: [pre2]Msg2Info(), Msg2Stop(), Msg2Exclamation(), Msg2Debug() [/pre2] Оставить обычный синтаксис и типа такого: [pre2]SET MSG2FUNCT FONT TO cFont, nFontSize SET MS2GINFO SIZE 64 ICO "INFO64.ICO" Msg2Info( cMsg , "Инфо", ......, cFont, nFontSize, 64, "INFO64.ICO", aDim1, aDim2 )[/pre2] ------------------------------------------------------------------ Надоели танцы с бубнами, чтобы сменить иконку в этих функциях !!! Сначала в ресурсном файле объявить: #define MSGINFO 1005 Потом в prg-модуле нужно ставить: #define MSGINFO 1005 и ещё потом уже где тебе нужно: MsgInfo( cMsg , "Инфо", MSGINFO, .F. ) А по простому нельзя сделать ?

Ответов - 194, стр: 1 2 3 4 5 6 7 8 9 10 All

PSP: Напиши свою функцию да и всё.

Andrey: PSP пишет: Напиши свою функцию да и всё. Да я уже пробовал, не особо красиво получается... Тем более я думаю это не только у меня такие придирчивые пользователи. Расширение функционала МиниГуи тоже большой плюс.

Pasha: Так это обертка для функции winapi В winapi нет такого функционала. Чтобы его получить, надо делать другую реализацию. Думается, что многие пользователи захотят использовать именно стандартные средства winapi, так что лучше это сделать отдельными функциями. Ну а что там такого военного ? Модальное окно с текстом и кнопками, больше ничего.

gfilatov2002: Pasha пишет: Модальное окно с текстом и кнопками Тем более, что в ядре библиотеки уже есть Клиппер-совместимая по синтаксису и Вин7-10 подобная по виду функция HMG_Alert( cText, [<aOptions>], [<cTitle>], [<nType>] ) Пример использования см. в папке \samples\Basic\WALERT_2

Andrey: gfilatov2002 пишет: Пример использования см. в папке \samples\Basic\WALERT_2 А можно в эту функцию добавить ещё один параметр, отвечающий за иконку из ресурсов ? Было бы здорово ! И размеры фонта как можно регулировать для этой функции ? Если нет возможности, то можно ещё добавить параметр фонта ?

gfilatov2002: Andrey пишет: размеры фонта как можно регулировать для этой функции ? После изменений, предложенных Сергеем, это будет возможно, если определить свой шрифт DlgFont до вызова функции HMG_Alert() Такое изменение шрифта будет доступно в следующей сборке библиотеки

SergKis: Andrey пишет А можно в эту функцию добавить ещё один параметр, отвечающий за иконку из ресурсов ?[pre2] 1. В MiniGui\RESORCES есть файлы ico с именами aIcon := { "ALERT", "QUESTION", "INFO", "STOP" }, замени их своими. 2. FUNCTION HMG_Alert( cMsg, aOptions, cTitle, nType, cIcoFile ) LOCAL aIcon := { "ALERT", "QUESTION", "INFO", "STOP" } // LOCAL cIcoFile LOCAL nLineas ... AEval( aIcon, {|x, i| aIcon[ i ] := "ZZZ_B_" + x } ) DEFAULT cIcoFile := aIcon[ nType ] IF ! _IsControlDefined( "DlgFont", "Main" ) ... [/pre2] Иконки должны быть 32x32, так зашито в окно

gfilatov2002: SergKis пишет: FUNCTION HMG_Alert( cMsg, aOptions, cTitle, nType, cIcoFile ) Добавил новый параметр в эту функцию. Спасибо за помощь

Andrey: SergKis пишет: Иконки должны быть 32x32, так зашито в окно Ну что за невезуха, хотелось бы размер иконок 48 или 64х64 хотя бы.

SergKis: Andrey пишет Ну что за невезуха Так текст ф-ии есть, поправь, отладку сделай на разные размеры. Кто мешает ?

gfilatov2002: Andrey пишет: размер иконок 48 или 64х64 хотя бы Добавил в функцию еще один параметр nIcoSize. Пример вызова: DEFINE FONT DlgFont FONTNAME "Tahoma" SIZE 18 HMG_Alert( "MessageBox with user's defined Font and Icon", NIL, "Warning", NIL, "demo.ico", 64 ) RELEASE FONT DlgFont

Andrey: gfilatov2002 пишет: Добавил в функцию еще один параметр nIcoSize. Ура ! Спасибо большое ! Т.е. если мне всегда нужен постоянный размер фонта в HMG_Alert(), я в MAIN определяю DEFINE FONT DlgFont FONTNAME "Tahoma" SIZE 18 и больше нигде не забочусь об этом ? Правильно ? DlgFont - у меня больше ни где не присутствует.

gfilatov2002: Andrey пишет: я в MAIN определяю DEFINE FONT DlgFont FONTNAME "Tahoma" SIZE 18 и больше нигде не забочусь об этом ? Да, теперь так можно сделать...

Andrey: gfilatov2002 пишет: Да, теперь так можно сделать... Спасибо ! Жду с нетерпением новую версию !

gfilatov2002: Andrey пишет: Жду с нетерпением новую версию Осталось потерпеть всего одну неделю Кстати, мой тестовый пример для проверки этой функции [pre2]#include "hmg.ch" ANNOUNCE RDDSYS PROCEDURE MAIN SET WINDOW MAIN OFF DEFINE FONT DlgFont FONTNAME "Tahoma" SIZE 12 HMG_Alert( "MessageBox Stop", NIL, "Stop!", ICON_STOP ) HMG_Alert( "MessageBox Alert", NIL, "Alert" ) HMG_Alert( "MessageBox with the user's defined Font and Icon", NIL, "Warning", NIL, "demo.ico" ) RELEASE FONT DlgFont DEFINE FONT DlgFont FONTNAME "Verdana" SIZE 18 HMG_Alert( "MessageBox with the Big Font and Icon Size", NIL, NIL, NIL, "demo.ico", 64 ) HMG_Alert( ; HMG_Alert( "Test Question;Second Line", {"&Yes","&No","Con&tinue","&Cancel"}, "Please, Select", NIL, "demo.ico", 64 ), ; 3 /* timeout in the seconds */, "Information", ICON_INFORMATION ) RETURN [/pre2]работает нормально

Alex_Cher: gfilatov2002 пишет: работает нормально

gfilatov2002: gfilatov2002 пишет: работает нормально gfilatov2002 пишет: Осталось потерпеть всего одну неделю

Andrey: gfilatov2002 Можно кнопочки по высоте сдела раза в ТРИ больше ? Пока юзер по кнопке попадёт, выслушаешь о себе много чего.... И ему без разницы, что я пишу на готовой системе, главное чтобы он по кнопке попадал. Ну и заодно бы смену фона выбранной кнопки сделать, всего несколько строк:[pre2] NOHOTLIGHT NOXPSTYLE HANDCURSOR ; ON MOUSEHOVER ( This.Backcolor := BLACK , This.Fontcolor := YELLOW ) ; ON MOUSELEAVE ( This.Backcolor := ???? , This.Fontcolor := ????? ) ; [/pre2]

Andrey: Перешёл на новую версию МиниГуи. Теперь пример Tsb_menu слетает вот на этой строке: [pre2] DEFINE FONT DlgFont FONTNAME "Tahoma" SIZE 12 [/pre2] Первый раз срабатывает, на второй раз, вот такая ошибка: Error MGERROR/0 Font: DlgFont Of Main Already defined. Program terminated. Called from MSGMINIGUIERROR(99) in module: h_error.prg Called from _DEFINEFONT(61) in module: h_font.prg Called from RUN_TEST1(570) in module: Tsb_menu.prg Почему до этого работало, а сейчас нет ? Я знаю как исключить эту ошибку, но просто понять почему это происходит.

Haz: Andrey пишет: Почему до этого работало, а сейчас нет ? Видимо новая версия более строга к ошибкам разработчика , Григорий ее постоянно оптимизирует , заставляя внимательнее писать код. Что само по себе радует. Andrey пишет: Я знаю как исключить эту ошибку, но просто понять почему это происходит. Тебе помогли твой же косяк найти Не ясно как он бы аукнулся в дальнейшем.

Andrey: Возвращаюсь опять к HMG_Alert() Юзера жалуются, кнопка узкая, попасть плохо.... Григорий, можно кнопочки по высоте сделать раза в ДВА-ТРИ больше ? Или задавать в доп.параметрах высоту кнопки ? Заодно в параметры добавить передачу цвета кнопки, чтобы различать можно было - юзеру понятней будет. Ну и заодно бы HANDCURSOR на кнопку. Я понимаю, что можно самому сделать свою эту функцию, но стандартную осталось доделать чуть-чуть. Заранее спасибо !

gfilatov2002: Andrey пишет: можно кнопочки по высоте сделать раза в ДВА-ТРИ больше ? Высота кнопок определяется размером шрифта DlgFont. Например, можно определить DEFINE FONT DlgFont FONTNAME "Tahoma" SIZE 18 Andrey пишет: добавить передачу цвета кнопки... HANDCURSOR на кнопку. Эти фичи имеет только ButtonEX, а в функции HMG_Alert() используется обычная кнопка Button для максимального копирования стандартных инфо-функций системы. Andrey пишет: можно самому сделать свою эту функцию Да, это единственный выход

Andrey: Григорий ! А может вы добавите новую тогда функцию HMG_Alert2() с учётом новых пожеланий...

gfilatov2002: Andrey пишет: добавите новую тогда функцию HMG_Alert2() с учётом новых пожеланий Написать такую функцию на основе HMG_Alert() не проблема, но зачем тогда две похожие функции в ядре библиотеки Поэтому я и предложил "самому сделать свою эту функцию"

Andrey: gfilatov2002 пишет: Написать такую функцию на основе HMG_Alert() не проблема, но зачем тогда две похожие функции в ядре библиотеки Ну может тогда оставить и одну функцию, но сделать флаг переключения на другой тип кнопок - BUTTONEX. Как это реализовать, не знаю. Вам видней. Если увеличить высоту шрифта, то сообщение будет ОЧЕНЬ большим. Вот и нужно из за этого отдельное задание высоты кнопок. Юзеру хватает высоты 50-70 пикс. gfilatov2002 пишет: Поэтому я и предложил "самому сделать свою эту функцию" Да я исходник смотрел, куча всего, некоторые моменты вообще не понимаю...

gfilatov2002: Andrey пишет: Как это реализовать, не знаю Понял, постараюсь помочь. Но попрошу подготовить картинку, как должна выглядеть эта функция га экране

Andrey: FUNCTION HMG_Alert( cMsg, aOptions, cTitle, nType, cIcoFile, nIcoSize, nButtonExHeight, aButtonExColor ) где nButtonExHeight - высота кнопки, aButtonExColor - цвета кнопок, например { LGREEN, RED } [pre2] DEFINE FONT DlgFont FONTNAME "Verdana" SIZE 16 nK := HMG_Alert( cMsg, {"&Поиск","&Отмена"}, "Внимание!", Nil, "iExclam64", 64 ) [/pre2] Вот цветные кнопки как на картинке нужно (серые это стандартные кнопки):

SergKis: gfilatov2002 пишет Но попрошу подготовить картинку, как должна выглядеть эта функция га экране Может, достаточно, курсора пр hover, а в параметрах добавить bInit[pre2] FUNCTION HMG_Alert( cMsg, aOptions, cTitle, nType, cIcoFile, nIcoSize, bInit ) ... DEFAULT aOptions TO { "&OK" } DEFAULT bInit TO {|| NIL } ... ACTIVATE WINDOW oDlg ON INIT ( FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize ), EVal( bInit ) ) ... и меняй, в нем размеры как хочешь. Имена кнопок известны, окна тоже. [/pre2]

Vlad04: Андрей ! У твоих Юзеров явные проблемы со зрением. Тебя тяготит к большим кнопкам, шрифтам и т.п. Юзера жалуются, кнопка узкая, попасть плохо. HMG_Alert( "MessageBox with the Big Font and Icon Size", NIL, NIL, NIL, "demo.ico", 64 ) Смотрится не АЙС. Все дополнительные параметры желательно замыкающими в вызове параметров и без NIL. Если параметр не последний, отделить просто запятой - " , ". Как , к примеру, в Substr(Text,2,4) и Substr(Text,2). В первом случае выделяем 4 символа, во втором - все, начиная со второго. Иначе, подозреваю, что этими функциями будет пользоваться только Андрей.

SergKis: Vlad04 пишет У твоих Юзеров явные проблемы со зрением Вообще то, таких много. И что им не работать ? У нас есть клиентка делает размеры окна, где половина\треть за пределами экрана (механизм Dlu2Pixel). Сидит и по телефону отвечает данным, все видит. когда нет такой необходимости вкл. нормальный режим работы. Иначе, подозреваю, что этими функциями будет пользоваться только Андрей #xtranslate никто не отменял. Можно сделать красивые вызовы на базе hmg_Alert(...) без лишних NIL и запятых

Vlad04: Сейчас в функции HMG_Alert кнопки в зависимости от длины надписей на кнопках НЕ центрируются

SergKis: Vlad04 Андрей, правильно предложил (согласен с ним), кнопки сделать BUTTONEX + HANDCURSOR все остальное можно доделать в bInit. И даже, если не менять, оставить BUTTON, в bInit BUTTON можно убрать и создать BUTTONEX на их месте нужных размеров, ну и размер окна поправить если что.

Vlad04: SergKis Вообще то, таких много. И что им не работать ? Но зачем так, пусть работают. У Windows есть настройки и экрана, и шрифтов и лупа увеличительная. А если думать о масштабируемости элементов, то имеет смысл делать это для всей программы. В 1 с есть такая возможность индивидуально настроить масштаб. А с #xtranslate лучше наоборот- по умолчанию в функции ничего лишнего и #xtranslate нет. А подобные формочки типа Alert я рисую сам как хочу, помещаю в библиотеку и никаких проблем.

gfilatov2002: Andrey пишет: цветные кнопки как на картинке нужно Вот что у меня получилось Вызываю так: [pre2]PROCEDURE MAIN SET WINDOW MAIN OFF DEFINE FONT DlgFont FONTNAME "Verdana" SIZE 16 cMsg := "Первая строка" + CRLF + CRLF + "Вторая строка" + CRLF + Repl( "-._.", 15 ) + CRLF + CRLF + "Четвертая строка" nK := HMG_Alert( cMsg, {"&Поиск","&Отмена"}, "Внимание!", Nil, "alert.ico", 64, {GREEN,RED} ) RETURN [/pre2] P.S. HANDCURSOR тоже не забыл добавить...

SergKis: gfilatov2002 пишет Вот что у меня получилось Если управлять раскраской кнопок, то просится backcolor окна и label как минимум, т.е. еще параметр Еще, Андрей, любит применять gradient ... + текст в две строки ... И скажет завтра Я понимаю, что можно самому сделать свою эту функцию, но стандартную осталось доделать чуть-чуть.

SergKis: Vlad04 пишет У Windows есть настройки и экрана, и шрифтов и лупа увеличительная. На чужих компах (это все), настроишь под себя (если дадут доступ), развалятся чужие проги. Так что про это лучше забыть А если думать о масштабируемости элементов, то имеет смысл делать это для всей программы. В 1 с есть такая возможность индивидуально настроить масштаб. Dlu2Pixel именно так и делает, хотя сделать доп. режим для любого окна никто не мешает. Разговор о hb, а не о 1C. А с #xtranslate лучше наоборот- по умолчанию в функции ничего лишнего и #xtranslate нет. Можно и без #xtranslate, тогда как h_msgbox.prg. Сверху делаем новые AlertOk(), AlertYesNo(), ... , но внутри hmg_Alert() А подобные формочки типа Alert я рисую сам как хочу, помещаю в библиотеку и никаких проблем. Со своими формочками никто не спорит, а с системной hmg_Alert(), выкидывать или модифицировать (закрыв ~50-70% сообщений) ?

Andrey: Vlad04 пишет: У твоих Юзеров явные проблемы со зрением. Тебя тяготит к большим кнопкам, шрифтам и т.п. цитата: Да меня не тяготит, это юзеров моих тяготит. Vlad04 пишет: Смотрится не АЙС. Всё АЙС на больших экранах. Давно уже большие экраны у юзеров, и стонут давно уже. SergKis пишет: Еще, Андрей, любит применять gradient ... + текст в две строки ... Нет, здесь не буду извращаться. Хватит минимального сообщения. SergKis пишет: а с системной hmg_Alert(), выкидывать или модифицировать (закрыв ~50-70% сообщений) Да я все 100% сообщений в программе на эту функцию переделаю и забуду об них. gfilatov2002 пишет: nK := HMG_Alert( cMsg, {"&Поиск","&Отмена"}, "Внимание!", Nil, "alert.ico", 64, {GREEN,RED} ) То что надо ! СПАСИБО !

SergKis: Andrey пишет То что надо ! СПАСИБО ! Что делать, если 3-и кнопки или 4, как покрасить ? nK := HMG_Alert( cMsg, {"&Поиск","&Отмена", "&Восстановить"}, "Внимание!", Nil, "alert.ico", 64, {GREEN,RED} ) Потом, если цвет backcolor окон проходит темой в проге, то вызов окна сообщения выпадает из нее. Не АЙС, как то.

SergKis: gfilatov2002 Можно сделать как в GETBOX STATIC aBackColor, aFontColor + команды для установки и добавить на окно BACKCOLOR aBackColor и для LABEL BACKCOLOR aBackColor FONTCOLOR aFontColor и параметр bInit с вызовом в ON INIT окна Закроются вопросы по hmg_Alert

SergKis: PS LABELam VCENTERALIGN, наверно, добавить лучше. Под bInit понимаю возможность добавить на окно галочки или radio group

gfilatov2002: SergKis пишет: Под bInit понимаю возможность добавить на окно галочки или radio group Да, все это можно сделать Но ведь у нас есть благодаря Петру системная функция TaskDialog() с подобными возможностями А hmg_Alert() была задумана как быстрая замена функции Alert() из Клиппера

gfilatov2002: SergKis пишет: Что делать, если 3-и кнопки или 4, как покрасить ? nK := HMG_Alert( cMsg, {"&Поиск","&Отмена", "&Восстановить"}, "Внимание!", Nil, "alert.ico", 64, {GREEN,RED} ) Вот так Код [pre] DEFINE FONT DlgFont FONTNAME "Verdana" SIZE 16 _HMG_ModalDialogReturn := 2 cMsg := "Первая строка;;Вторая строка;" + Repl( "-._.", 15 ) + ";;Четвертая строка" nK := HMG_Alert( cMsg, {"&Поиск","&Отмена", "&Восстановить"}, "Внимание!", Nil, "alert.ico", 64, {YELLOW, RED, GREEN} ) HMG_Alert( nK ) [/pre]

SergKis: gfilatov2002 пишет Но ведь у нас есть благодаря Петру системная функция TaskDialog() с подобными возможностями Как то не манит ее использовать - сложновато и многовато, смотрел примеры в TaskDialog - работает все ок, но ... А hmg_Alert() была задумана как быстрая замена функции Alert() из Клиппера С добавлением icon по размерам + теперь цвета, она вышла за рамки "Alert() из Клиппера" А простые запросы куда архив откинуть (сервер, флэшка, диск, ...), уточнение по форме печати и похожие остались. Простые окна запросов постоянно делаются, думаю, hmg_Alert можно использовать вместо, простыми средствами

ММК: Andrey пишет: Нет, здесь не буду извращаться. Хватит минимального сообщения. Минимальные должны быть в ядре. Гргорий очень правильно сказал.Какая проблема сделать окошко с кнопками? Можно добавить ini файлик с настройками; размер,фонт, цвет и т.д А что бы окошко не "глушило" экран сделайте для текста скроллинг ( горизонтальный или вертикальный ), как в FW http://forums.fivetechsupport.com/viewtopic.php?f=3&t=18497&sid=1385f5e4cd43192128278e6396b9157e Окраску кнопок можно сделать трехслойной ( что бы глаза не резала) . Т.е. серые ( или что то нетральное) . При наводке курсора "раскрашивается". При активации вспыхивает ... Если уж изобретаете велосипед, то не делайте его деревянным :)

SergKis: ММК пишет Гргорий очень правильно сказал.Какая проблема сделать окошко с кнопками? Проблем сделать нет (делаются в реале), есть системная ф-я уже ПОЧТИ все делающая, привязывается по установке относительно какого окна центроваться (в своих это надо повторять каждый раз), ЕЕ, СИСТЕМНУЮ, ВЫБРОСИТЬ из использования или чуть поправить, усилив ?

SergKis: gfilatov2002 пишет Вот так Это ожидаемо Осталось фон окна и label. Помнится, в Клипперной Alert цвет фонта и цвет текстов задавался SET COORом

SergKis: PS SET COLORом , конечно

Andrey: ММК пишет: Т.е. серые ( или что то нетральное) . При наводке курсора "раскрашивается". Так цветные кнопки просто в качестве примера. На самом деле будет что-то нейтральное. Бледно красное и бледно зеленое... А свои кнопки и менюшки можно сделать используя пример Tsb_Menu05.7z https://cloud.mail.ru/public/35pf/NqnpzXCSi Григорий, я тебе его высылал.

Andrey: SergKis пишет: Осталось фон окна и label. Помнится, в Клипперной Alert цвет фонта и цвет текстов задавался SET COORом Ну да, может до кучи сделать изменение фона окна. Ну тогда хотелось бы через внешний глобальный параметр, типа: SET MSGALERT BACKCOLOR YELLOW SET MSGALERT LABELCOLOR BLUE

gfilatov2002: Andrey пишет: сделать изменение фона окна. Ну тогда хотелось бы через внешний глобальный параметр, типа: SET MSGALERT BACKCOLOR YELLOW SET MSGALERT LABELCOLOR BLUE Cделал, конечно Код ниже [pre] DEFINE FONT DlgFont FONTNAME "Verdana" SIZE 16 _HMG_ModalDialogReturn := 2 cMsg := "Первая строка;;Вторая строка;" + Repl( "-._.", 15 ) + ";;Четвертая строка" SET MSGALERT BACKCOLOR TO {240, 240, 240} SET MSGALERT FONTCOLOR TO NAVY nK := HMG_Alert( cMsg, {"&Поиск","&Отмена", "&Восстановить"}, "Внимание!", Nil, "alert.ico", 64, {YELLOW, RED, GREEN} ) [/pre]P.S. Прозрачность для иконки задана, но выглядит немного коряво...

Andrey: gfilatov2002 пишет: P.S. Прозрачность для иконки задана, но выглядит немного коряво... Пойдёт ! То что надо ! Спасибо !

SergKis: gfilatov2002 пишет Но ведь у нас есть благодаря Петру системная функция TaskDialog() с подобными возможностями Еще раз посмотрел примеры, класс TaskDialog. Совершенно не ясно как управлять расцветкой (свойствами) контролов, как добавить на окно tsb таблицу, как применить фонты из DEFINE FONT ...? Да и сама hmg_Alert() не сделана на TaskDialog, а на стандартных командах hmg. А в hmg_alert() с bInit можно спокойно добавить тсб таблицу, если надо, скрыть IMAGE, если не подобрать по сочетанию с backcolor, ... и др. штучки с окном\контролами проделать.

gfilatov2002: SergKis пишет: в hmg_alert() с bInit можно спокойно добавить Согласен Например, такой блок b := {|idx| this.title := 'New title', this.btn_01.caption := "Search", this.btn_02.caption := "Cancel", this.btn_03.caption := "Restore"} переданный hmg_alert() nK := HMG_Alert( cMsg, {"&Поиск","&Отмена", "&Восстановить"}, "Внимание!", Nil, "alert.ico", 64, {YELLOW, RED, GREEN}, b ) поменяет заголовок окна Alert и надписи на всех кнопках

SergKis: gfilatov2002 пишет поменяет заголовок окна Alert и надписи на всех кнопках Если добавить в блок кода This.btn_01.Action := {|| myBtn1() }, This.btn_03.Action := {|| myBtn3() } то выход с окна будет только по кнопке "Cancel\Отмена", а на кнопках 1,3 выполнятся соответствующие функции

Andrey: Григорий, ещё одна бяка в hmg_Alert(). Центрирование строк убрать. Или сделать по параметру SET MSGALERT LABEL TO CENTERALIGN SET MSGALERT LABEL TO RIGHTALIGN SET MSGALERT LABEL TO LEFTALIGN Мне нужно к левому краю прижимать сообщение. И ещё сталкивался с проблемой, что hmg_Alert() остаётся за другими окнами, т.е. нужен флаг - показывать окно поверх всех окон ! Как в MsgInfo() и др.

SergKis: Andrey Мы с Григорием, все время талдычим о bInit, в котором делай как надо с контролами (самим окном0 что хочешь. Ты пропускаешь мимо ушей все. Можешь каждую лабел двигать в любую нужную сторону, не хватает чего добавь на окно.

SergKis: PS 1. использовать имена лабел b := {|| This.Say_01.Alignment := 'LEFT', This.Say_02.Alignment := 'CENTER', This.Say_03.Alignment := 'RIGHT', ... } 2. режим SET OOP ON из описания в функции SayValueObj(nMode)[pre2] b := {|| MyInit() } STAT FUNC Myinit() LOCAL ow := ThisWindow.Object LOCAL ao := ow:GetObj4Type('LABEL') LOCAL o FOR EACH o IN ao o:Align := 'LEFT' // все налево или другой вариант NEXT RETURN Nil [/pre2]

SergKis: PPS и цвета у лабелов можешь поменять на другие, отличные от базовых

gfilatov2002: Andrey пишет: Мне нужно к левому краю прижимать сообщение. И ещё сталкивался с проблемой, что hmg_Alert() остаётся за другими окнами, т.е. нужен флаг - показывать окно поверх всех окон Это возможно с помощью использования кодоблока bInit, предложенного Сергеем. Рабочий код ниже [pre] _HMG_ModalDialogReturn := 2 cMsg := "Первая строка;;Вторая строка;" + Repl( "-._.", 15 ) + ";;Четвертая строка" SET MSGALERT FONTCOLOR TO NAVY b := {|idx| this.say_01.alignment := "left", ; this.say_03.alignment := "left", ; this.say_04.alignment := "left", ; this.say_06.alignment := "left", ; EraseWindow( this.name ), ; HMG_DrawIcon( this.name, "demo.ico", 30, 30, 48, 48, , .t. ), ; this.topmost := .t.} nK := HMG_Alert( cMsg, {"&Поиск","&Отмена", "&Восстановить"}, "Внимание!", Nil, "alert.ico", 64, {YELLOW, RED, GREEN}, b ) [/pre] Результат на экране (для примера добавлена также замена иконки на лету )

Andrey: gfilatov2002 пишет: Это возможно с помощью использования кодоблока bInit, предложенного Сергеем. Согласен с использованием кодоблока, но тащить такой кодоблок в каждый HMG_Alert() крайне НЕ УДОБНО ! Конечно, можно его в Public объявить и всегда ставить в конце каждого HMG_Alert(). Хотелось бы иметь и альтернативу этому кодоблоку. Кодоблок мне понравился, для индивидуального HMG_Alert() ! Спасибо за него !

SergKis: Andrey пишет Хотелось бы иметь и альтернативу этому кодоблоку. Альтернатива - своя функция (библиотека их: AlertYesNo(), ...)[pre2] FUNC Alert(...) LOCAL nRet := 2 LOCAL bBlk := ... nRet := hmg_alert(..., bBlk) RETURN nRet [/pre2]

Andrey: SergKis пишет: Альтернатива - своя функция (библиотека их: AlertYesNo(), ...) Ну да. Так тоже можно.... Ждём новую версию тогда...

Andrey: gfilatov2002 пишет: EraseWindow( this.name ), ; А это для чего нужно ? gfilatov2002 пишет: this.say_06.alignment := "left", Если такой строки не будет - какой будет результат ?

gfilatov2002: Andrey пишет: Если такой строки не будет - какой будет результат ? Врт такой будет экран Код [pre] _HMG_ModalDialogReturn := 2 cMsg := "Первая строка;;Вторая строка;" + Repl( "-._.", 15 ) + ";;Четвертая строка" SET MSGALERT FONTCOLOR TO NAVY b := {|idx| this.say_01.alignment := "left", ; this.say_03.alignment := "left", ; this.say_04.alignment := "left", ; ;// this.say_06.alignment := "left", ; ;// EraseWindow( this.name ), ; ;// HMG_DrawIcon( this.name, "demo.ico", 30, 30, 48, 48, , .t. ), ; this.topmost := .t.} nK := HMG_Alert( cMsg, {"&Поиск","&Отмена", "&Восстановить"}, "Внимание!", Nil, "alert.ico", 64, {YELLOW, RED, GREEN}, b ) [/pre]

Andrey: gfilatov2002 пишет: ;// this.say_06.alignment := "left", ; Не совсем понятно. Допустим нет в сообщении 6-8 строки вообще. А сделано так (т.е. по максимому для больших сообщений): this.say_06.alignment := "left", ; this.say_07.alignment := "left", ; this.say_08.alignment := "left", ; Что тогда будет ? Вылет ?

SergKis: Andrey У тебя ТВОЙ массив с текстами, работай от его длины AEval(aTxt, {|ct,nt| ct := 'Say_'+strzero(nt,2), This.&(ct).Aligment :='Left' })

Andrey: Понял. Спасибо !

Andrey: Версия МиниГуи 19.02 Запускаю свою большую программу. Окно [pre2] DEFINE WINDOW Form_Main ; MAIN NOSHOW ; ..... END WINDOW // Показ заставки: DEFINE WINDOW PICTURE/DELAY/ ON RELEASE _DefineSplashWindow( "Form_Splash",,,,, "SPLASH", 10, {|| Addition_MainForms() } ) ACTIVATE WINDOW Form_Splash, Form_Main ...............[/pre2] В Procedure _SplashDelay() запуск нескольких функций через Eval( hb_macroBlock( M->aRunCheck[nI] ) ) Ставлю в одной из них вот так: nK := HMG_Alert( cMsg, {"&Перезапуск","&Отмена"}, "Внимание!", Nil, "iExclam64", 64 ) Прога вешается наглухо !!! Если пытаюсь снять прогу через МЕНЕДЖЕР ЗАДАЧ, то и он сам вешается... Если меняю сообщение на MsgYesNo( cMsg, "Внимание!", .F. ) - то ВСЁ работает !!! Почему ? Что ещё нужно HMG_Alert() ?

SergKis: Andrey У тебя нет окна main и не стоит режим работы без main, для hmg_alert нужен окно-родитель Сделай так примерно[pre2] DEFINE WINDOW Form_Main ; MAIN NOSHOW ; ON INIT _wPost(1) ; ..... (This.Object):Event( 1, {|| SplasShow() }) END WINDOW ACTIVATE WINDOW Form_Main ... STAT FUNC SplashShow() // здесь окна и запуски ф-й из массива RETURN Nil [/pre2]

Andrey: Спасибо ! Буду пробовать !

Andrey: Всем привет ! Разбираюсь с новым HMG_Alert() А как сделать фокус на второй кнопке ? Вот так не работает: [pre2] bInit := {|| this.Btn_02.Setfocus }[/pre2]

SergKis: Andrey Посмотри внимательно пример от Григория (выше), думаю, ответ найдешь.

Andrey: Да, нашёл. _HMG_ModalDialogReturn := 2 А почему не срабатывает this.Btn_02.Setfocus ? Или нужно писать [pre2] Domethod(ThisWindow.Name, "Btn_02", "Setfocus")[/pre2] Хотя попробовал, тоже не срабатывает.

SergKis: Andrey пишет В исходнике, ясно написано (если глянешь )[pre2] IF HB_ISBLOCK( bBlock ) Do_WindowEventProcedure( bBlock, This.Index, 'WINDOW_ACTIVATE' ) ENDIF oDlg.&( aBut[ iif( Empty( _HMG_ModalDialogReturn ), 1, _HMG_ModalDialogReturn ) ] ).SetFocus() [/pre2] Т.е. стачала работает блок, потом ...SetFocus Можешь установить блок кода на ON INIT окна в bInit и там сделать This.Btn_02.SetFocus или на др. контрол, игнорируя _HMG_ModalDialogReturn

SergKis: PS Возможно, для большей свободы, строку уст. фокуса можно переставить выше блока

Andrey: Вылетает теперь программа на HMG_Alert(): Error BASE/1132 Переполнение массива: Неверное количество аргументов Called from FILLDLG(329) in module: h_alert.prg Called from (b)HMG_ALERT(150) in module: h_alert.prg Called from DO_WINDOWEVENTPROCEDURE(82) in module: h_objmisc.prg Called from _ACTIVATEWINDOW(1314) in module: h_windows.prg Called from HMG_ALERT(150) in module: h_alert.prg Строка 329: [pre2] oDlg.&( aBut[ iif( Empty( _HMG_ModalDialogReturn ), 1, _HMG_ModalDialogReturn ) ] ).SetFocus()[/pre2] При таких условиях: первый вызов[pre2] _HMG_ModalDialogReturn := 2 nK := HMG_Alert( cMsg, {"&Да ","&Нет"}, ...)[/pre2] Потом в коде где-то далее делаем простой вызов: [pre2] HMG_Alert( cMsg, {"&Продолжить"}, ...)[/pre2] Т.е. тогда всегда явно нужно указывать для ОДНОЙ кнопки: [pre2] _HMG_ModalDialogReturn := 1[/pre2] Что не очень удобно при написании кода. Причём эту ошибку в отдельном примере не смог сделать.

SergKis: Andrey На базе hmg_alert напиши свои ф-ии, уже говорили выше AlertOk() AlertYesNo() Alert3Btn() Alert4Btn() и используй их с уст. _hmg_modaldialogreturn

SergKis: PS или #xcommand AlertOK()... если не устраивают ф-ии и там все ставь

Andrey: SergKis пишет: На базе hmg_alert напиши свои ф-ии, уже говорили выше Да наверное так и сделаю. Спасибо !

gfilatov2002: SergKis пишет: На базе hmg_alert напиши свои ф-ии Благодарю за предложение Уже добавил в новую бета-сборку такие функции по аналогии с функциями Msg*(): AlertYesNo ( Message, Title, RevertDefault, Icon, nSize, aColors, bInit ) AlertYesNoCancel ( Message, Title, nDefaultButton, Icon, nSize, aColors, bInit ) AlertRetryCancel ( Message, Title, nDefaultButton, Icon, nSize, aColors, bInit ) AlertOkCancel ( Message, Title, nDefaultButton, Icon, nSize, aColors, bInit ) AlertInfo ( Message, Title, Icon, nSize, aColors, bInit ) AlertStop ( Message, Title, Icon, nSize, aColors, bInit ) AlertExclamation ( Message, Title, Icon, nSize, aColors, bInit )

Andrey: SergKis пишет: У тебя ТВОЙ массив с текстами, работай от его длины AEval(aTxt, {|ct,nt| ct := 'Say_'+strzero(nt,2), This.&(ct).Aligment :='Left' }) Что-то не работает.... Сделал так: [pre2] aTxt := HB_ATokens(cMsg, ";", .F., .F.) cSay := "" FOR nI := 1 TO LEN(aTxt) cSay += "this.say_" + strzero(nI,2) + ".Aligment := 'Left' " cSay += IIF( nI == LEN(aTxt), "" , "," ) NEXT bInit := {|| cSay , this.topmost := .t. }[/pre2] Проще переключатель сделать, типа SET MSGALERT TEXT TO LEFT/CENTER ....

gfilatov2002: Andrey пишет: Что-то не работает Andrey Не парься, в следующей версии hmg_Alert() выравнивание влево будет делаться по умолчанию

SergKis: Andrey пишет Что-то не работает.... Как ты это делаешь ? Все работает. Пример https://TransFiles.ru/jcgdf

SergKis: gfilatov2002 Если убрать имя окна oDlg и добавить форм. динамически имени окна, то можно несколько раз исп. hmg_alert вызов. Пример и текст h_alert.prg тут https://TransFiles.ru/8w8g8 четвертая кнопка на main (Align = 'Left') + на кнопку "Повтор" ( Btn_01, Align = 'Center' ) подвешен вызов еще одной hmg_alert

gfilatov2002: SergKis пишет: добавить форм. динамически имени окна Благодарю за помощь Обязательно использую эту возможность

SergKis: gfilatov2002 Еще надо для LABEL в hmg_alert добавить VCENTERALIGN Если сейчас для строки LABEL поставить BACKCOLOR отличный от окна, то будет вид не очень ...

gfilatov2002: SergKis пишет: для LABEL в hmg_alert добавить VCENTERALIGN Сделал

Andrey: SergKis пишет: Как ты это делаешь ? Все работает. Пример Спасибо ! Я не так делал ! Вот сделал окно для ошибки вылета, теперь у меня свои окошки:

Andrey: Всем привет ! Если самая длинная строка не помещается на окне hmg_Alert(), то она обрывается и её не видно ! Надо бы сделать проверку на длину строки и выводить остаток строки в hmg_Alert(). Как это сделать ?

SergKis: Andrey пишет Как это сделать ? Длину строки знаешь Клиентскую часть и размеры окна тоже В bInit все что надо делай - вычисляй, прибавляй, меняй

Andrey: SergKis пишет: В bInit все что надо делай - вычисляй, прибавляй, меняй Но это опять ерунда выходит. Вместо того чтобы поставить в код hmg_Alert(), делаем опять через bInit ... Вот этот кусочек кода НУЖНО вставить в hmg_Alert() и функция станет универсальной. [pre2] LOCAL nI, nJ, iMax, aDim, cText, nTabSize := 8, lWrap := .T. ...... cMsg := AtRepl( ";", cMsg, CRLF ) aDim := HB_ATokens(cMsg,CRLF,.F.,.F.) cMsg := "" FOR nI := 1 TO LEN(aDim) cText := aDim[nI] IF LEN(cText) > 70 iMax := MLCount( cText, 70, nTabSize, lWrap ) FOR nJ := 1 TO iMax cMsg += MemoLine( cText, 70, nJ, nTabSize, lWrap ) + CRLF NEXT ELSE cMsg += cText + CRLF ENDIF NEXT .... cIcoRes := "iWarning64" HMG_Alert( cMsg, {"&Продолжить"}, cTitle, Nil, cIcoRes, nIcoSize, { aButtColor } , bInit ) [/pre2] Может что и не правильно я написал, поправьте тогда меня. А так приходиться вставлять одинаковые куски кода по своим функциям, где вызываю hmg_Alert(). Дубляж кода постоянно не хочется делать. SergKis пишет: Длину строки знаешь Клиентскую часть и размеры окна тоже Длину строки на моём шрифте 18 - знаю. А для другого фонта вычислять нужно. И чем ограничена ширина окна - я не знаю.... Исходник не смотрел пока.

SergKis: Andrey пишет Вот этот кусочек кода НУЖНО вставить в hmg_Alert() и функция станет универсальной. Не будет универсальной, по height может выходить за пределы экрана, фонт увеличишь опять не попадешь (раньше попадало), надо скролы ставить для прокрутки. И т.д. и т.п. Какие отступы, как полно заполнять окном экран ? И чем ограничена ширина окна - я не знаю.... Шутишь ? Про десктоп забыл ? А так приходиться вставлять одинаковые куски кода по своим функциям, где вызываю hmg_Alert(). Уже писал, повторю (выше в теме и пример был), напиши свою с 1ым блоком кода на базе hmg_Alert(), назови My_Alert() и используй. Фонт ставь от кол-ва строк в массиве и мах. ширины строки в нем, а не в лоб 18 и все. Может на 14 все поместится, на 18 нет. На мой взгляд, свою роль hmg_Alert() и производные от нее выполняют нормально. Расширение возможностей, пожалуйста, через bInit, что угодно делай, хоть контролы добавляй.

Andrey: Всем привет ! Сделал свою функцию MG_Stop(), MG_Info() и т.д. на базе hmg_Alert(). Всё хорошо, но иногда происходит сбой... MsgStop() работает, а MG_Stop() вылетает с ошибкой: Error MGERROR/0 ACTIVATE WINDOW: activate windows within an ON RELEASE window procedure is not allowed. Program terminated. --------------------------------- Stack Trace --------------------------------- Called from MSGMINIGUIERROR(100) in module: h_error.prg Called from _ACTIVATEWINDOW(1294) in module: h_windows.prg Called from HMG_ALERT(167) in module: h_alert.prg Called from MG_STOP(59) in module: util_Alert.prg Почему ? Что нужно сделать, чтобы не вылетало ? МиниГуи последний.

SergKis: Andrey пишет Почему ? Активировать окна в ON RELEASE не разрешено, так вроде переводится.

Andrey: SergKis пишет: Активировать окна в ON RELEASE не разрешено, так вроде переводится. А почему тогда MsgStop работает нормально ? Как сделать, чтобы hmg_Alert() тоже заработал в этом режиме ?

SergKis: Andrey пишет А почему тогда MsgStop работает нормально ? Это winapi. Как сделать, чтобы hmg_Alert() тоже заработал в этом режиме ? Это hmg, т.е. DEFINE WINDOW ... END WINDOW Писать, наверно, по другому.

Andrey: Всем привет! Опять очередная загадка... В таблице клавишей DEL удаляю цифры. Происходит вылет по HMG_ALERT() ! Вот ошибка: Error MGERROR/0 Control: Btn_01 Of Form_AYC Not defined. Program terminated. --------------------------------- Stack Trace --------------------------------- Called from MSGMINIGUIERROR(100) in module: h_error.prg Called from SETPROPERTY(3792) in module: h_controlmisc.prg Called from (b)MG_YESNO(137) in module: util_Alert.prg Called from DO_WINDOWEVENTPROCEDURE(82) in module: h_objmisc.prg Called from FILLDLG(342) in module: h_alert.prg Called from (b)HMG_ALERT(167) in module: h_alert.prg Called from DO_WINDOWEVENTPROCEDURE(82) in module: h_objmisc.prg Called from _ACTIVATEWINDOW(1314) in module: h_windows.prg Called from HMG_ALERT(167) in module: h_alert.prg Called from MG_YESNO(147) in module: util_Alert.prg Called from AYC_DELREC(1975) in module: form_AbonYearCalc.prg Called from (b)TAB_AYC(793) in module: form_AbonYearCalc.prg Called from _DOCONTROLEVENTPROCEDURE(1865) in module: h_windows.prg Called from EVENTS(699) in module: h_events.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1499) in module: h_windows.prg MG_YESNO() моя функция для HMG_ALERT(), вот код: [pre2]FUNCTION MG_YesNo( cMsg, cTitle, cIcoRes, nIcoSize, bInit, aBackColor, aFontColor ) LOCAL aButton := {" &Да "," &Нет "} ................ DEFAULT cTitle := "Внимание!" , bInit := {|| this.topmost := .t. ,; this.Btn_01.Fontcolor := BLACK ,; this.Btn_02.Fontcolor := BLACK } // строка 137 [/pre2] Почему ? Если цифры вбивать, то всё нормально.

Andrey: Я понял почему. Григорий давно уже мне помогал делать и сделал на окно обработку кнопок: [pre2] // --------------- назначение клавиш ------------------- on key INSERT action AYC_InsRec(Int(Val(aTabName[ GetProperty(_HMG_ThisFormName,"Tab_1","Value") ])),"Set_Columns" + hb_ntos(GetProperty(_HMG_ThisFormName,"Tab_1","Value"))) on key DELETE action AYC_DelRec(Int(Val(aTabName[ GetProperty(_HMG_ThisFormName,"Tab_1","Value") ])),"Set_Columns" + hb_ntos(GetProperty(_HMG_ThisFormName,"Tab_1","Value")))[/pre2] При редактирование таблицы при нажатии клавиши DEL происходит вызов на функцию AYC_DelRec(). Как исправить данную коллизию ?

SergKis: Andrey пишет При редактирование таблицы при нажатии клавиши DEL происходит вызов на функцию AYC_DelRec() [pre2] 1. Делал проверку наличия кнопок на форме bInit := {|cw,ab| cw := This.Name, ab := {'Btn_01', 'Btn_02', 'Btn_03', 'Btn_04'}, this.topmost := .t., ; AEval(ab, {|cb| iif( _IsControldefined(cb, cw), SetProperty(cw, cb, 'FONTCOLOR', BLACK), ) }) 2. Перенес назначение кнопок с окна на таблицу (держал бы ее всегда в фокусе) oBrw:UserKeys( VK_INSERT, {|ob| _wPost(1, ob) } ) oBrw:UserKeys( VK_DELETE, {|ob| _wPost(2, ob) } ) 3. Сохранять\восстанавливать клавиши и блоки кода, можно делать, но это не предлагаю, т.к. лично мне не он нравится. [/pre2]

Andrey: SergKis пишет: 3. Сохранять\восстанавливать клавиши и блоки кода, можно делать, но это не предлагаю, т.к. лично мне не он нравится. Да это более простой метод. Как считать какая обработка была назначена на клавишу ? Можно ее считать, а потом восстановить ?

SergKis: Andrey пишет Как считать какая обработка была назначена на клавишу ? Можно ее считать, а потом восстановить ? Надо написать ф-ии, к примеру : 1. aKey := SaveHotkeyAll() - получить все назначения на окно 'HOTKEY' тип контрола (HMG_GetControls() функцией) - пробежать по полученному массиву и сохранить в своем данные, см. h_hotkey.prg _DefineHotKey (...) массив назначения _HMG_aControlType [k] := "HOTKEY" _HMG_aControlNames [k] := '' _HMG_aControlHandles [k] := 0 _HMG_aControlParentHandles [k] := nParentForm _HMG_aControlIds [k] := nId _HMG_aControlProcedures [k] := bAction _HMG_aControlPageMap [k] := nMod _HMG_aControlValue [k] := nKey ... - выполнить для полученного массива _ReleaseHotKey ( cParentForm, nMod , nKey ) 2. RestHotkeyAll(aKey) - по массиву aKey выполнить _DefineHotKey ( cParentForm , nMod , nKey , bAction )

SergKis: PS правильно HMG_GetFormControls ( cFormName, cUserType ), вместо HMG_GetControls()

Andrey: Всем привет ! Столкнулся с переполнением в HMG_Alert(). Т.е. если слишком много строк текста, то окно становиться посередине экрана и нет кнопки закрыть. Задачу приходиться снимать. Григорий, добавь пожалуйста в эту функцию закрытие этого окна по Alt+F4 ! MsgStop() закрывается по этой клавише. У себя конечно сделаю свою обработку, но мало ли где ещё такая бяка вылезет. А как посчитать сколько строк влезет в HMG_Alert() ? Не знаю как рассчитывается расстояние между строчками текста в Label в МиниГуи. Остальное знаю.

gfilatov2002: Andrey пишет: добавь пожалуйста в эту функцию закрытие этого окна по Alt+F4 Такая возможность уже есть (см. последний параметр в определении функции ниже) HMG_Alert( cMsg, aOptions, cTitle, nType, xIcon, nSize, aColors, bInit, lClosable )

SergKis: gfilatov2002 пишет акая возможность уже есть В AlertInfo(), AlertYesNo(), ... нет параметра lClosable

gfilatov2002: SergKis пишет: В AlertInfo(), AlertYesNo(), ... нет параметра lClosable Да, верно (этот параметр используется внутри этих функций). Но Андрей ведь спрашивал о функции HMG_Alert()

SergKis: gfilatov2002 пишет Да, верно (этот параметр используется внутри этих функций). FUNCTION HMG_Alert( cMsg, aOptions, cTitle, nType, cIcoFile, nIcoSize, aBtnColors, bInit, lClosable ) ... DEFAULT cTitle TO "Attention", aOptions TO { "&OK" }, lClosable TO .F. ... STATIC FUNCTION _Alert( cMsg, aOptions, cTitle, nType, nDefault, xIcon, nSize, aColors, lTopMost, bInit, lClosable ) В этой ф-ии желательно сделать DEFAULT lClosable TO .T. тогда Alert... функции будут похожи на Msg... функции - выход по Esc, Alt+F4

gfilatov2002: Andrey пишет: SergKis пишет: цитата: Активировать окна в ON RELEASE не разрешено, так вроде переводится. А почему тогда MsgStop работает нормально ? Как сделать, чтобы hmg_Alert() тоже заработал в этом режиме ? Уже сделал: все функции из семейства Alert*() будут работать при ON RELEASE

Andrey: gfilatov2002 пишет: Уже сделал: все функции из семейства Alert*() будут работать при ON RELEASE Спасибо ! А как это делается ?

gfilatov2002: Andrey пишет: как это делается ? Эта возможность будет доступна в следующей сборке (если таковая выйдет в будущем)

Andrey: Что то не работает правильно функция HMG_Alert() Обрезает текст с длинными строчками и не выводит его полностью. Проект высылал на почту. Кстати и в примере ButtonEx_DynamicMenu(1).7z который высылал ранее, функция MsgInfo(cText,'Menu Array') показывает правильно весь текст, а HMG_Alert(ToDimText(aBtn), , 'Menu Array') - обрезает текст. Можно исправить эту функцию ?

gfilatov2002: Andrey пишет: Можно исправить эту функцию ? Благодарю за сообщение Эта функция будет исправлена для работы с длинными строками в следующей сборке (уже скоро). P.S. Исправленный вариант функции выслал по почте...

Andrey: gfilatov2002 пишет: P.S. Исправленный вариант функции выслал по почте... Что-то не пашет... Добавил модуль в проект: [pre2]# list all files *. p r g hmg_Alert2.prg h_alert.prg[/pre2] Собирается нормально, а при запуске выдаёт ошибку: [pre2]Error BASE/1449 Синтаксическая ошибка: & --------------------------------- Stack Trace --------------------------------- Called from _DEFINEMODALWINDOW(655) in module: h_windows.prg Called from HMG_ALERT(164) in module: h_alert.prg Called from MAIN(34) in module: hmg_Alert2.prg [/pre2]

gfilatov2002: Andrey пишет: при запуске выдаёт ошибку Да, Вы правы. Дело в том, что в этой функции использованы новые возможности, которые будут доступны только в следующей сборке. Тогда нужно немного подождать выхода этой сборки...

Andrey: gfilatov2002 пишет: Тогда нужно немного подождать выхода этой сборки... Хорошо, тогда ждем !

gfilatov2002: gfilatov2002 пишет: в этой функции использованы новые возможности

Andrey: Новая версия МиниГуи - 19.10 (Update 2) Что не все окна при использовании функции HMG_Alert() делаются по центру экрана. У меня стали некоторые окна HMG_Alert() показываться в левом верхнем углу экрана. Почему ? Как сделать что бы окна HMG_Alert() были всегда по центру экрана ? У меня принудительно главное меню скидывается на панель задач, когда нужно. Может быть из-за этого ?

Andrey: Всем привет ! А как сделать окно HMG_Alert() поверх всех окон ? Что то по старому перестало работать...

SergKis: Попробуй _HMG_InplaceParentHandle := ThisWindow.Handle hmg_Alert(...)

Andrey: Что то после перехода на последню версию МиниГуи, программа стала падать на HMG_Alert() Вот такая ошибка: [pre2]Error MGERROR/0 Control: Btn_01 Of Form_CardOpl Not defined. Program terminated. --------------------------------- Stack Trace --------------------------------- Called from MSGMINIGUIERROR(100) in module: h_error.prg Called from SETPROPERTY(3977) in module: h_controlmisc.prg Called from (b)MG_YESNO(149) in module: Source\util_Alert.prg Called from DO_WINDOWEVENTPROCEDURE(82) in module: h_objmisc.prg Called from FILLDLG(355) in module: h_alert.prg Called from HMG_ALERT(166) in module: h_alert.prg [/pre2] Вот мой код: [pre2] cIcoRes := "Help64" ; nIcoSize := 64 aButton := {"&Продолжить","&Отмена"} " _HMG_ModalDialogReturn := 2 bInit := {|| this.topmost := .t. ,; this.Btn_01.Fontcolor := BLACK ,; this.Btn_02.Fontcolor := BLACK } nK := HMG_Alert( cMsg, aButton, cTitle, NIL, cIcoRes, nIcoSize, aButColor, bInit ) // строка 166 [/pre2] Почему ? Чего перестало хватать ?

SergKis: Andrey пишет Btn_01 Of Form_CardOpl Not defined. На окне Form_CardOpl timer есть ? Если есть, его (все timer работающие) надо отключать, когда, что то делаешь и вкл. когда закончил.

Andrey: SergKis пишет: На окне Form_CardOpl timer есть ? Нет у него таймера. У меня и в других окнах так же вылетает.

SergKis: Andrey пишет Нет у него таймера. У меня и в других окнах так же вылетает. Проверить не могу, не стоит bcc 5.8, но по тексту имя окна hmg_alert() "oDlg"[pre2] LOCAL cForm := "oDlg" IF _IsWindowDefined( cForm ) nLineas := 0 WHILE _IsWindowDefined( cForm := "oDlg" + hb_ntos( ++nLineas ) ) END ENDIF ... DEFINE WINDOW (cForm) WIDTH 0 HEIGHT 0 TITLE cTitle MODAL NOSIZE BACKCOLOR aBackColor ; ON INTERACTIVECLOSE ( lPressButton .OR. lClosable ) ; ON RELEASE iif( !lPressButton .AND. lClosable, _HMG_ModalDialogReturn := 0, NIL ) FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bInit, lClosable, cFontName ) // тут снятие END WINDOW ... добавь в bInit := {|| _logfile(.t., This.Name), this.topmost := .t. ,; this.Btn_01.Fontcolor := BLACK ,; this.Btn_02.Fontcolor := BLACK } какое имя окна ? [/pre2]

Andrey: SergKis пишет: какое имя окна ? Код: [pre2] Function MG_YESNO(...) ..... ? ProcNameLine() + "--1-----------------------" bInit := {|| _logfile(.t., This.Name), this.topmost := .t. ,; this.Btn_01.Fontcolor := BLACK ,; this.Btn_02.Fontcolor := BLACK } // строка 166 ? ProcNameLine() + "--2-----------------------" // строка 168 nK := HMG_Alert( cMsg, aButton, cTitle, NIL, cIcoRes, nIcoSize, aButColor, bInit ) // строка 169 [/pre2] Лог-файл: [pre2]Вызов из: MG_YESNO(162) --> util_Alert.prg--1----------------------- Вызов из: MG_YESNO(168) --> util_Alert.prg--2----------------------- Form_CardOpl [/pre2] Вылет по ошибке: [pre2]Error MGERROR/0 Control: Btn_01 Of Form_CardOpl Not defined. Program terminated. --------------------------------- Stack Trace --------------------------------- Called from MSGMINIGUIERROR(100) in module: h_error.prg Called from SETPROPERTY(3977) in module: h_controlmisc.prg Called from (b)MG_YESNO(166) in module: util_Alert.prg Called from DO_WINDOWEVENTPROCEDURE(82) in module: h_objmisc.prg Called from FILLDLG(355) in module: h_alert.prg Called from HMG_ALERT(166) in module: h_alert.prg Called from MG_YESNO(169) in module: util_Alert.prg [/pre2]

SergKis: Andrey А если так[pre2] SET OOP ON ... bInit := {|ow| _logfile(.t., This.Name, ow:Name), this.topmost := .t. ,; this.Btn_01.Fontcolor := BLACK ,; this.Btn_02.Fontcolor := BLACK } [/pre2]

SergKis: PS Что покажет ? ProcNameLine() + "--2-----------------------", ThisWindow.Name // строка 168

Andrey: SergKis пишет: А если так Вылет:[pre2] Error BASE/1004 Метод не экспортирован: NAME --------------------------------- Stack Trace --------------------------------- Called from NAME(0) Called from (b)MG_YESNO(166) in module: util_Alert.prg Called from DO_WINDOWEVENTPROCEDURE(82) in module: h_objmisc.prg Called from FILLDLG(355) in module: h_alert.prg Called from HMG_ALERT(166) in module: h_alert.prg [/pre2] SergKis пишет: Что покажет [pre2]Вызов из: MG_YESNO(162) --> util_Alert.prg--1----------------------- Вызов из: MG_YESNO(168) --> util_Alert.prg--2----------------------- Form_CardOpl [/pre2]

SergKis: Andrey Error BASE/1004 Метод не экспортирован: NAME Извини, это в моей версии передается объект окна, а тут нет такого. Хотел проверить создание окна oDlg было ли ? Если было то фокус должен был быть на нем и this среда его. Похоже окно hmg_alert не создано, т.к. this среда осталась от предыдущего окна. Пробни[pre2] bInit := {|| _logfile(.t., This.Name, _IsWindowDefined('oDlg')), this.topmost := .t. ,; this.Btn_01.Fontcolor := BLACK ,; this.Btn_02.Fontcolor := BLACK } // строка 166 [/pre2]

Andrey: Поставил вызов этой функции (без ow:Name) в главной форме, всё отлично работает. Вот лог: [pre2]Вызов из: TEST(524) --> 11main.prg--0----------------------- Вызов из: MG_YESNO(162) --> util_Alert.prg--1----------------------- Вызов из: MG_YESNO(168) --> util_Alert.prg--2----------------------- Form_Main oDlg .T. [/pre2]

SergKis: А на родном месте ? на маин не так интересно, т.к. окон мало

Andrey: SergKis пишет: Пробни [pre2]Вызов из: TEST(524) --> 11main.prg--0----------------------- Вызов из: MG_YESNO(162) --> util_Alert.prg--1----------------------- Вызов из: MG_YESNO(168) --> util_Alert.prg--2----------------------- Form_Main oDlg .T. .T. Вызов из: MG_YESNO(162) --> util_Alert.prg--1----------------------- Вызов из: MG_YESNO(168) --> util_Alert.prg--2----------------------- Form_CardOpl Form_CardOpl .T. [/pre2] Получается на главной форме (Form_Main) работает, а в нужном окне нет. Почему ? На главной форме таймер сидит. У меня в рабочей программе 3 таймера используются, без них никак ! Отключил таймер. Всё равно такая же ошибка ! Раньше стояла функция MsgYesNo() - решил переделать на свою и облом, то работает, то нет.

SergKis: Andrey пишет Всё равно такая же ошибка ! Если таймеры отключены, то трассируй h_alert.prg на предмет значения ThisWindow.name в *-----------------------------------------------------------------------------* STATIC FUNCTION FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bBlock, lClosable, cFont ) *-----------------------------------------------------------------------------* ... На главной форме таймер сидит. У меня в рабочей программе 3 таймера используются, без них никак ! По мне, без глобальных таймеров обходиться можно (он может нарушить this среду если не управлять его вкл.\выкл.). Просто распределяешь работу таймера на смену режимов\окон\событий клавы и мыши ... Таимер тек. окна то же может нарушить this среду, без упр. вкл.\выкл., если работает блок кода для контрола, кнопки например - это надо учитывать делая останов\пуск таймера

Andrey: Andrey пишет: Отключил таймер. Всё равно такая же ошибка ! Дело не в таймере ! Раньше стояла функция MsgYesNo() - решил переделать на свою через HMG_ALERT() и облом, то работает, то нет.

SergKis: Andrey пишет решил переделать на свою через HMG_ALERT() и облом, то работает, то нет. Так потестируй h_alert.prg _logfile(...), раз у тебя вылезло в данном месте стабильное сваливание, найди причину, пересобирая либу

SergKis: Andrey пишет Дело не в таймере ! Если у тебя глобальные таймеры и ты ими не жестко управляешь, то могут быть бяки при работе с This средой. Возможно, надо отказаться в таком случае от нее и оперировать факт. именами окон и контролов всегда. Только это хотел сказать про таймер и this среду

Andrey: Пробовал в других местах вызов HMG_ALERT(), работает. Как вызываю из таблицы свою карточку (окно Form_CardOpl), вот там вылетает... Обычное окно, по базе ищет что нужно. Мистика какая то ...

SergKis: Andrey пишет Как вызываю из таблицы свою карточку (окно Form_CardOpl), вот там вылетает... Обвесь _logfile(...) как писал выше в h_alert.prg, посмотри, что даст log У бери NOSHOW при создании окна и снова посмотри. Понятнее будет с мистикой ...

Andrey: У меня 2 окна скрываются, т.е. делаю DoMethod( сForm, "Hide" ) два раза, чтобы окон много не было. Может из-за этого, но по другому нельзя. Забодался искать. Сделал так: [pre2] bInit := {|| _logfile(.t., This.Name, _IsWindowDefined('oDlg')) ,; SetProperty("oDlg", "Topmost", .t. ) ,; SetProperty("oDlg", "Btn_01", "Fontcolor", BLACK ) ,; SetProperty("oDlg", "Btn_02", "Fontcolor", BLACK ) }[/pre2] Надеюсь теперь ВСЕГДА будут работать !

Andrey: Всем привет ! Возвращаюсь опять к функции HMG_ALERT(). Если очень много строк передаю в эту функцию (а это часто бывает) , то беда с этим окном ! Верх и низ окна просто УЛЕТАЮТ за границу экрана. Вот примерно выглядит так это: Юзера в шоке, я тоже. Кнопки закрыть и выйти нет ! Писать ещё свою функцию нет резона, хотелось бы одну стандартную. Т.е. достаточно было бы проверить в HMG_ALERT() выход за границы экрана и уменьшить их.. А сам текст хотелось бы "затолкать" в объект EDITBOX в режиме READONLY Вот так примерно чтобы выглядело: Такое решение было бы просто отличным для многих ! Заранее спасибо ! Проект для пробы выкладываю - https://cloud.mail.ru/public/g3VA%2Fi87fBERHx

Pasha: Юзера в шоке, я тоже. Кнопки закрыть и выйти нет Я в подобном случае проверяю количество строк, и при превышении некоторого значения вместо alert формирую окно с бровсом и кнопками

SergKis: Andrey пишет А сам текст хотелось бы "затолкать" в объект EDITBOX в режиме READONLY ... Такое решение было бы просто отличным для многих ! Вариант от Pasha более перспективный, т.к. просто вывести ошибки это меньшая часть дела. Надо с ошибки выйти на карточку с ошибкой для исправления. Потому надо сразу все ошибки выводить в TsBrowse и организовывать выход при DblClick и Enter на исправление ошибки (можно и кнопки добавлять) на окно. Тсб может быть с одной колонкой или иметь их несколько. Пример, как это делать, есть в Advanced\App_OopReport\demo2.prg функция ( использование HMG_Alert() для этого) STATIC FUNC AgeCard( oWnd, oBrw, oCnl ) + STATIC FUNC bAgeCard( oWnd, oBrw, oCnl ) ... Вместо тсб можно и EDITBOX прикрутить в bInit блоке кода.

gfilatov2002: Andrey пишет: А сам текст хотелось бы "затолкать" в объект EDITBOX в режиме READONLY Благодарю за предложение! Результат отработки функции для вашего примера см. на картинке

Andrey: Pasha пишет: Я в подобном случае проверяю количество строк, и при превышении некоторого значения вместо alert формирую окно с бровсом и кнопками Да это тоже вариант, но это не есть хорошо. Если это ОДНА функция, то такое решение универсальное и самое простое для всех. В противном случае нужно делать свою отдельную функцию и в коде писать обращение к своей функции. SergKis пишет: т.к. просто вывести ошибки это меньшая часть дела. Надо с ошибки выйти на карточку с ошибкой для исправления. Потому надо сразу все ошибки выводить в TsBrowse и организовывать выход при DblClick и Enter на исправление ошибки (можно и кнопки добавлять) на окно. Тсб может быть с одной колонкой или иметь их несколько. Не надо лишних движений. Юзер вошёл в список квартир, ни фига не заполнил и вышел из списка. Вот для таких случаев и надо ему выводить КРАСНОЕ ОКНО с ошибками, ни фига не видят.

Andrey: gfilatov2002 пишет: Результат отработки функции для вашего примера см. на картинке А самому пощупать когда можно будет ?

gfilatov2002: Andrey пишет: самому пощупать когда можно будет ? После выхода апрельской сборки в конце месяца

Andrey: Спасибо ! Буду ждать ! Только текст проверить на кол-во строк. При 150 строках падала программа... а может и с меньшим кол-вом строк...

gfilatov2002: Andrey пишет: Только текст проверить на кол-во строк. Проверял на 1500 строк - работает нормально

Andrey: Ещё одно уточнение, кнопку на окне прижать вправо по месту окончания объекта EDITBOX, красивей будет !

SergKis: Andrey пишет Не надо лишних движений. Юзер вошёл в список квартир, ни фига не заполнил и вышел из списка. Вот для таких случаев и надо ему выводить КРАСНОЕ ОКНО с ошибками, ни фига не видят. ... Только текст проверить на кол-во строк. При 150 строках падала программа... а может и с меньшим кол-вом строк... Если они ни фига не видят и не смотрят, то и 150 строк смотреть не будут, но когда нибудь все равно исправлять надо. Тогда достаточно спросить "В 150 карточках\квартирах ошибки", Распечатать ? Yes \ No И безразмерных EditBox не надо. На крайняк, есть внешние редакторы с readonly режимами.

gfilatov2002: Andrey пишет: кнопку на окне прижать вправо Так подходит

SergKis: Andrey пишет Ещё одно уточнение, кнопку на окне прижать вправо по месту окончания объекта EDITBOX, красивей будет ! Вот, вот, тут и начинается ... у каждого свое. А почему слева под image пусто, надо editbox под image и на всю ширину окно, но с отступами, а до edit заголовок (справа от image) и т.д. и т.п.

SergKis: PS Использование TsBrowse, вместо editbox - более интересно, на мой взгляд

Andrey: gfilatov2002 пишет: Так подходит Отлично ! SergKis пишет: Использование TsBrowse, вместо editbox - более интересно, на мой взгляд Да, если нужен полный журнал этих ошибок для правки. Но как правило юзер живёт своими измерениями. Если выводить 5 сточек ошибок, то опять нужен код для учёта. Вывод сообщения в HMG_Alert(): 10 ошибок + .... и ещё 40 строчек ошибок ! А тут универсальная функция, если не входит список ошибок в границы окна, то EDITBOX со скролингом поможет оценить юзеру что дофига ошибок, т.е. забыл сделать и юзер вернётся опять в список и исправит что забыл сделать. Позволяет программисту не думать о кол-ве строк ошибок.

SergKis: Andrey пишет А тут универсальная функция Editbox универсальности практически не добавляет, а тсб с массивом\алиасом решает до фига. Наверно половину окон с таблицами заменит, надо только немного из bInit подстроить работу, колонки, header, footer, ... Если окну добавить режим CHILD к MODAL, то получишь, действительно, универсальное окно. Т.е. задав только (хотя бы в размерах editbox)[pre2] DEFINE TBROWSE Tsb_Alert AT nY,nX WIDTH nW HEIGHT nH ALIAS xArray CELL :nHeightHead := 1 END TBROWSE [/pre2] уже будешь иметь таблицу замену editbox, если xArray многоколоночный массив, то и таблица с колонками, если xAlias это ALIAS области, то можешь в bInit настроить на :LoadFields(). И т.д. настройки ...

SergKis: Пример BASIC\EditBox модифицированный [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #include "minigui.ch" FUNCTION Main LOCAL cVal := ' demo ', i, cTxt := '' cVal += repl('_', 150)+' '+cVal+CRLF FOR i := 1 TO 9500 cTxt += str(i,4)+cVal NEXT DEFINE WINDOW Form_1 ; AT 0, 0 ; WIDTH 640 HEIGHT 480 ; TITLE 'Harbour MiniGUI Demo' ; ICON 'demo.ico' ; MAIN ; ON INIT ( Form_1.Edit_1.Value := cTxt ) ; FONT 'Arial' SIZE 10 DEFINE STATUSBAR STATUSITEM 'HMG Power Ready!' END STATUSBAR @ 30, 10 EDITBOX Edit_1 ; WIDTH 410 ; HEIGHT 140 ; VALUE '' READONLY ; TOOLTIP 'EditBox' ; MAXLENGTH len(cTxt)+100 ; ON CHANGE ShowRowCol() // NOHSCROLL DEFINE BUTTON B ROW 250 COL 10 CAPTION 'Set CaretPos' ACTION ( Form_1.Edit_1.CaretPos := Val( InputBox( 'Set Caret Position', '' ) ), Form_1.Edit_1.SetFocus ) END BUTTON DEFINE TIMER Timer_1 INTERVAL 100 ACTION ShowRowCol() END WINDOW Form_1.Center() Form_1.Activate() RETURN NIL PROCEDURE ShowRowCol LOCAL s, c, i, e, q s := Form_1.Edit_1.Value c := Form_1.Edit_1.CaretPos e := 0 q := 0 FOR i := 1 TO c IF SubStr ( s, i, 1 ) == Chr( 13 ) e++ q := 0 ELSE q++ ENDIF NEXT i Form_1.StatusBar.Item( 1 ) := 'Row: ' + hb_ntos( e + 1 ) + ' Col: ' + hb_ntos( q ) IF e < 7 Form_1.Edit_1.Refresh ENDIF RETURN [/pre2] Листаем pgDn станицами до индикации Row: 385 Col: 1 Жмем pgDn и получаем индикацию Row: 3 Col: 37 , в просмотре, как бы все правильно. Но нажав стрелку вверх, пару раз, улетаем в начало строк. Наличие\отсутствие MAXLENGTH не влияет на ситуацию. Есть, наверно, ограничения на EDITBOX ? У Андрея, как понимаю, происходит чтение файла и показ в HMG_Alert() и возникнут вопросики в связи с EDITBOX. Вот вырезка с его тестового примера[pre2] cText := "" FOR nI := 1 TO 2150 cText += "Квартира: " + HB_NtoS(nI) + " не заполнен тариф оплаты ! . ;" NEXT ... cMsg := cText // высчитываем размерность текста cMsg := AtRepl( ";", cMsg, CRLF ) cMsg := StrTran(cMsg, CRLF, chr(10)) // если текст кривой cMsg := StrTran(cMsg, chr(10), CRLF) ... @ nG, nCMemo EDITBOX Edit_Memo WIDTH nWMemo HEIGHT nHMemo ; VALUE cMsg READONLY ; BACKCOLOR aEBoxBack FONTCOLOR aFontColor ... [/pre2] т.е. HSCROLL назначен, но не работает, на контроле он присутствует, но без ползунка и включается перенос\искажение текста по разным строкам. Т.е. в начале ok! в конце ерунда. [pre2] Квартира: 1 не заполнен тариф оплаты ! . Квартира: 2 не заполнен тариф оплаты ! . Квартира: 3 не заполнен тариф оплаты ! . Квартира: 4 не заполнен тариф оплаты ! . Квартира: 5 не заполнен тариф оплаты ! . Квартира: 6 не заполнен тариф оплаты ! . Квартира: 7 не заполнен тариф оплаты ! . Квартира: 8 не заполнен тариф оплаты ! . ... Квартира: 2133 не заполнен тариф оплаты ! . Квартира: 2134 не заполнен тариф оплаты ! . Квартира: 2135 не заполнен тариф оплаты ! . Квартира: 2136 не заполнен тариф оплаты ! . Квартира: 2137 не заполнен тариф оплаты ! . Квартира: 2138 не заполнен тариф оплаты ! . Квартира: 2139 не заполнен тариф оплаты ! . Квартира: 2140 не заполнен тариф оплаты ! . Квартира: 2141 не заполнен тариф оплаты ! . Квартира: 2142 не заполнен тариф оплаты ! . Квартира: 2143 не заполнен тариф оплаты ! . Квартира: 2144 не заполнен тариф оплаты ! . Квартира: 2145 не заполнен тариф оплаты ! . Квартира: 2146 не заполнен тариф оплаты ! . Квартира: 2147 не заполнен тариф оплаты ! . Квартира: 2148 не заполнен тариф оплаты ! . Квартира: 2149 не заполнен тариф оплаты ! . Квартира: 2150 не заполнен тариф оплаты ! . [/pre2]

SergKis: PS Размер width у EDITBOX достаточный для показа любой всей строки из показанных, справа места от CRLF много

Andrey: Всем привет ! Почему по коду идёт вот такая ошибка: Error MGERROR/0 Only Panel windows can be defined inside a DEFINE WINDOW...END WINDOW structure. Program terminated. --------------------------------- Stack Trace --------------------------------- Called from MSGMINIGUIERROR(100) in module: h_error.prg Called from _DEFINEWINDOW(150) in module: h_windows.prg Called from WAITWINDOW(2742) in module: h_windows.prg Called from CREATEDATOSPRND31(783) in module: Tsb_demo7.prg При вызове вот этой функции WaitWindow( 'Загрузка базы ...', .T. ) // open the wait window И можно это малюсенькое окошечко сделать крупней ? Юзера на своих мониторах просто не замечают. Может через параметр передавать хотя бы: WaitWindow( 'Загрузка базы ...', .T. , 500,200,RED,"DejaVu Sans Mono",16,YELLOW) где RED - цвет фона формы, YELLOW-цвет текста формы И будет юзеру счастье ....

Andrey: Последняя версия МиниГуи. Использую ТСБ, в нём: [pre2] // удаление/восстановление записи разрешена // кнопка для удаления, будет работать и на восстановление :SetDeleteMode( .T., .F., {|| AlertYesNo(iif((oBrw:cAlias)->(Deleted()), "Восстановить", "Удалить") + ; " запись в таблице ?", "Подтверждение") } )[/pre2] по клавише DEL вызов функции в которой: [pre2] lDelete := (oBrw:cAlias)->(Deleted()) ..... IF !lDelete cMsg := "1) ....;;" cMsg += "Вы действительно хотите удалить запись в таблице ?" aColors := _SetMsgAlertColors( {179, 30, 173} ) IF !AlertYesNo( cMsg, "Выбор действия", , "Cancel64x1", 64 , {RED,LGREEN} ) RETURN NIL ENDIF SET MSGALERT BACKCOLOR TO aColors ENDIF // встроенный метод для удаления текущей записи lChange := oBrw:DeleteRow(.F., .T.) ....[/pre2] После вызова первого 1) - AlertYesNo() если нажать ДА, то происходит вылет: [pre2]Error BASE/1132 Переполнение массива: Неверное количество аргументов Args: [1] = A { ... } length: 2 [2] = N 3 --------------------------------- Stack Trace --------------------------------- Called from EVENTS(337) in module: h_events.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1514) in module: h_windows.prg Called from HMG_ALERT(176) in module: h_alert.prg Called from _ALERT(115) in module: h_alert.prg Called from ALERTYESNO(20) in module: h_alert.prg Called from (b)MYSETEDITTSB(778) in module: Forma_D40setup.prg Called from TSBROWSE:DELETEROW(3102) in module: h_tbrowse.prg Called from MYRECNODELETERECOVER(1277) in module: Forma_D40setup.prg Called from (b)FORM_D40SETUP(272) in module: Forma_D40setup.prg Called from DO_CONTROLEVENTPROCEDURE(58) in module: h_objmisc.prg Called from TWNDDATA:DOEVENT(729) in module: h_objects.prg Called from DO_ONWNDLAUNCH(240) in module: h_objmisc.prg Called from (b)INIT(123) in module: h_init.prg Called from EVENTS(1224) in module: h_events.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1514) in module: h_windows.prg [/pre2] Строка 176 в модуле h_alert.prg ACTIVATE WINDOW ( cForm ) Почему ? Что не хватает ? Потерялось окно ? P.S. Потом идет вылет на любом AlertXXXX

Dima: А если без ТСБ , тоже глючит в каком нибудь простом примере ? PS Чую косяк у тебя где то.......

Andrey: Dima пишет: А если без ТСБ , тоже глючит в каком нибудь простом примере ? Сделал на простом примере, не вылетает. НО !!! Потом в другом AlertYesNo() вместо текста ЧЕРНЫЙ КВАДРАТ ! Вот ссылка - https://drive.google.com/file/d/1Qtbatqdha93BUirBsHIj05FL82nG8pxZ/view?usp=sharing Значит при использовании в блоке кода вылетит точно !

Andrey: Нашёл при каком варианте сбоит: [pre2] aColors := _SetMsgAlertColors( {189, 30, 73} ) SET MSGALERT FONTCOLOR TO YELLOW IF !AlertYesNo( cMsg, "Выбор действия" , , "iCancel64x1", 64 , {RED,LGREEN} ) SET MSGALERT BACKCOLOR TO aColors SET MSGALERT FONTCOLOR TO BLACK RETURN NIL ENDIF SET MSGALERT BACKCOLOR TO aColors SET MSGALERT FONTCOLOR TO BLACK[/pre2] Повторный вызов любого AlertXXXX - будет сваливаться ... Кодировать неудобно (зеленым цветом дублирующий код), цвет КРАСНЫЙ окна делаешь для юзера, чтобы впечатлился. Предлагал же заталкивать цвет фона окна и цвет текста сообщения - параметром последним в этой функции. Почему ломается код при использовании _SetMsgAlertColors() ?

SergKis: Andrey Глянь исходник[pre2]*-----------------------------------------------------------------------------* FUNCTION _SetMsgAlertColors( aBackClr, aFontClr ) *-----------------------------------------------------------------------------* LOCAL aOldClrs := { aBackColor, aFontColor } IF aBackClr != NIL aBackColor := aBackClr ENDIF IF aFontClr != NIL aFontColor := aFontClr ENDIF RETURN aOldClrs [/pre2] и что ты проделываешь aColors := _SetMsgAlertColors( {189, 30, 73} ) и SET MSGALERT BACKCOLOR TO aColors SET MSGALERT FONTCOLOR TO BLACK как говорится, "найдите разницу" ?

Andrey: SergKis пишет: как говорится, "найдите разницу" ? Опять заработался я... Спасибо за подсказку ! Оказывается можно и так делать:[pre2] SET MSGALERT BACKCOLOR TO {189, 30, 73} STOREIN aColors SET MSGALERT FONTCOLOR TO YELLOW IF !AlertYesNo( cMsg2, "Выбор действия" ) SET MSGALERT BACKCOLOR TO aColors[1] SET MSGALERT FONTCOLOR TO aColors[2] RETURN NIL ENDIF SET MSGALERT BACKCOLOR TO aColors[1] SET MSGALERT FONTCOLOR TO aColors[2][/pre2]

rvu: А в AlertYesNo() звука нет? Если в других подобных функциях есть звук и возможность его отключения, мне кажется было бы логично везде это сделать.

SergKis: rvu пишет было бы логично везде это сделать. По мне, звук вообще отключить (у клиента орет и все шарахаются, т.к. после виде всегда громкость стоит). Звук есть только в ф-ях 1. AlertExclamation() - PlayExclamation() 2. AlertInfo() - PlayAsterisk() 3. AlertStop() - PlayHand() Добавить звук в ф-ии легко, в AlertYesNo( Message, Title, RevertDefault, Icon, nSize, aColors, lTopMost, bInit ) ltkftnt bInit := {|| PlayHand() } или bInit := {|| TONE(3600) }

rvu: SergKis пишет: По мне, звук вообще отключить Я по умолчанию отключаю. Но вдруг кому нравится.

rvu: В программе выставлена кодировка 1251. AlertYesNo() пишет: Да, Нет. AlertRetryCancel: Retry, Cancel. Наверное, где-то не включили нужные слова в русскую локализацию. Или так и задумано? А можно вообще свои слова вставлять в эти функции? Было бы удобно.

SergKis: rvu проверьте, что дает после SET LANGUAGE TO RUSSIAN ? _HMG_LANG_ID если не "RU", то _HMG_LANG_ID := "RU" ; InitMessages() // см. h_init.prg +[pre2] *-----------------------------------------------------------------------------* FUNCTION AlertOkCancel ( Message, Title, nDefaultButton, Icon, nSize, aColors, lTopMost, bInit ) *-----------------------------------------------------------------------------* LOCAL aOptions := { _HMG_BRWLangButton [4], _HMG_BRWLangButton [3] } // можете поменять на свои тексты RETURN ( _Alert( Message, aOptions, Title, , hb_defaultValue( nDefaultButton, 1 ), Icon, nSize, aColors, lTopMost, bInit, .T. ) == IDOK ) [/pre2]

rvu: SergKis пишет: проверьте, что дает после SET LANGUAGE TO RUSSIAN ? _HMG_LANG_ID если не "RU" Не "RU". Интересно, а почему? То _HMG_LANG_ID := "RU" ; InitMessages() - Теперь "RU". Но AlertRetryCancel все равно: Retry, Cancel.

SergKis: rvu смотрите InitMessage(), сначала ставятся en тексты, потом от _HMG_LANG_ID == "RU", возможно не все переведено делайте t1 := _HMG_BRWLangButton [4] t2 := _HMG_BRWLangButton [3] _HMG_BRWLangButton [4] := "текст 1" _HMG_BRWLangButton [3] := "текст 1" AlertYsNo(...) _HMG_BRWLangButton [4] := t1 _HMG_BRWLangButton [3] := t2 или замените не устраивающие тексты в _HMG_... массивах на нужные (свою Ru_InitMessages() заведите) напишите свою, Андрей написал и использует везде[pre2] /////////////////////////////////////////////////////////////////////////// Function MG_YesNo(cMsg, cTitle, cIcoRes, nIcoSize, aWinColor, cParentWin, aBtnMsg, aBtnColor) LOCAL hParentWin, nI, lRet := .F. DEFAULT aBtnColor := { LGREEN , {189,30,73} } DEFAULT aBtnMsg := {"&Продолжить", "&Отмена"} DEFAULT cParentWin := _HMG_ThisFormName DEFAULT cIcoRes := "iSmile64", nIcoSize := 64 DEFAULT cTitle := "Ваш выбор" DEFAULT aWinColor := { { 63, 108, 25 } , WHITE } IF ! empty(cParentWin) .and. _IsWindowDefined( cParentWin ) hParentWin := GetFormHandle( cParentWin ) ENDIF IF ! empty( hParentWin ) hParentWin := GetFormHandle( cParentWin ) Darken2Open(hParentWin) // Затенение на форме ENDIF SET MSGALERT FONTCOLOR TO aWinColor[2] SET MSGALERT BACKCOLOR TO aWinColor[1] _HMG_ModalDialogReturn := 2 nI := HMG_Alert( cMsg, aBtnMsg, cTitle, Nil, cIcoRes, nIcoSize, aBtnColor ) IF nI == 1 lRet := .T. ENDIF _HMG_ModalDialogReturn := 1 IF ! empty( hParentWin ) Darken2Close(hParentWin) // Затенение на форме ENDIF RETURN lRet [/pre2] Если хочешь сделать что-то хорошо, сделай это сам

rvu: SergKis пишет: Если хочешь сделать что-то хорошо, сделай это сам В идеале — да, но всё самому сделать невозможно. За советы спасибо!

Andrey: Последняя версия МиниГуи. Система Win10 ! При вызове вот этой функции: [pre2]WaitWindow( 'Загрузка программы ... ' + GetExeFileName(), .T. ) [/pre2] Получаю окно без надписи ! Пустое окно ! Как у меня было на Win8.1 Почему ? Если сделать WaitWindow( 'Загрузка программы ... ', .T. ) то надпись есть. А как сделать надпись в 2-3 строчки ?

SergKis: Andrey пишет Получаю окно без надписи ! Пустое окно ! Как у меня было на Win8.1 Почему ? Если сделать WaitWindow( 'Загрузка программы ... ', .T. ) то надпись есть. Ширина окна ставится SetProperty( cFormName, "Width", Min( 2 * nWidth, Min( GetDesktopWidth(), 800 ) ) ) Если текст шириной больше ширины окна, то вкл. timer прокрутки текста в label Наверно, тут не клеится с ним и прокруткой. Если текст короткий, то все работает как надо. А как сделать надпись в 2-3 строчки ? Как то так. Пример [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" REQUEST DBFCDX, DBFFPT REQUEST HB_CODEPAGE_UTF8, HB_CODEPAGE_RU866, HB_CODEPAGE_RU1251 *-----------------------------------------------------------------------------* FUNCTION Main() *-----------------------------------------------------------------------------* LOCAL cNam := hb_FNameName( hb_ProgName() ) LOCAL cForm SET CODEPAGE TO RUSSIAN SET LANGUAGE TO RUSSIAN RddSetDefault("DBFCDX") SET CENTURY ON SET DATE GERMAN SET DELETED ON SET EXCLUSIVE ON SET EPOCH TO 2000 SET AUTOPEN OFF SET EXACT ON SET SOFTSEEK ON SET NAVIGATION EXTENDED SET FONT TO "Arial", 14 *-------------------------------- SET OOP ON *-------------------------------- // Первый тест - строка cForm := ToWaitWindow( "... Запуск программы "+cNam+" ... " ) InkeyGui(5 * 1000 ) ToWaitWindow( "!!!!!!!!!!!!!!!!!!!!" ) InkeyGui(5 * 1000 ) SetProperty(cForm, "Message" , "Value", "@@@@@@@@@@@@@@@") InkeyGui(5 * 1000 ) ToWaitWindow() InkeyGui( 1000 ) // Второй тест - массив cForm := ToWaitWindow( {"... Запуск программы "+cNam+" ... ", ; "Тестируем массив в окне. Строка 1" , ; "Тестируем массив в окне. Строка 2"} ) SET WINDOW THIS TO cForm This.Message.FontColor := BLUE This.Message.FontBold := .T. SET WINDOW THIS TO InkeyGui(10 * 1000 ) ToWaitWindow( {upper("... Запуск программы "+cNam+" ... "), ; "Замена строки 1 в окне. ****** 1 *", ; "Замена строки 2 в окне. ###### 2 #"} ) InkeyGui(10 * 1000 ) SetProperty(cForm, "Message" , "Value", "@@@@@@@@@@@@@@@@@@@@") SetProperty(cForm, "Message2", "Value", "********************") SetProperty(cForm, "Message3", "Value", "####################") InkeyGui(10 * 1000 ) ToWaitWindow() InkeyGui( 1000 ) */ RETURN FUNCTION ToWaitWindow( uMsg ) // Режим NOWAIT для Activate LOCAL cForm := "_HMG_CHILDWAITWINDOW" LOCAL lDef, oDlu, cMsg, cFont, nSize LOCAL nI, nY, nX, nW, nH, nS, cN IF pCount() == 0 WaitWindow() IF Empty( _HMG_MainHandle ) // нет MAIN окна SET WINDOW MAIN ON ENDIF RETURN cForm ELSEIF _IsWindowDefined( cForm ) // вывод на окно IF hb_IsChar( uMsg ) .and. ";" $ uMsg uMsg := hb_ATokens( uMsg, ";" ) ELSEIF hb_IsChar( uMsg ) uMsg := { uMsg } ENDIF IF ! hb_IsArray( uMsg ) ; RETURN cForm ENDIF SET WINDOW THIS TO cForm FOR nI := 1 TO Len( uMsg ) cN := "Message" IF nI > 1 ; cN += hb_ntos(nI) ENDIF IF _IsControlDefined( cN, cForm ) This.&(cN).Value := uMsg[ nI ] ENDIF NEXT SET WINDOW THIS TO RETURN cForm ENDIF cFont := App.FontName nSize := App.FontSize oDlu := oDlu4Font( nSize ) IF !_IsWindowDefined( cForm ) // создание окна IF hb_IsChar( uMsg ) .and. ";" $ uMsg uMsg := hb_ATokens( uMsg, ";" ) ENDIF IF hb_IsChar( uMsg ) cMsg := uMsg ELSEIF hb_IsArray( uMsg ) .and. Len( uMsg ) > 0 cMsg := uMsg[1] ELSEIF hb_IsNumeric( uMsg ) cMsg := Repl(" ", uMsg) ELSE cMsg := Repl(" ", 50) ENDIF IF Empty( _HMG_MainHandle ) // нет MAIN окна SET WINDOW MAIN OFF ENDIF WaitWindow( cMsg, .T. ) IF _IsWindowDefined( cForm ) SET WINDOW THIS TO cForm IF hb_IsArray( uMsg ) .and. Len( uMsg ) > 0 nX := This.Message.Col nW := This.Message.Width nH := oDlu:H1 This.Message.Height := nH This.Message.FontName := cFont This.Message.FontSize := nSize nS := This.Message.Row * 3 nY := nS + This.Message.Height FOR nI := 2 TO Len( uMsg ) cN := "Message"+hb_ntos(nI) @ nY, nX LABEL &cN OF &cForm WIDTH nW HEIGHT nH ; VALUE uMsg[ nI ] FONT cFont SIZE nSize ; BACKCOLOR This.Message.BackColor ; CENTERALIGN TRANSPARENT nY := This.&(cN).Row + This.&(cN).Height nS += This.&(cN).Height NEXT ThisWindow.Height := ThisWindow.Height + nS //- This.Message.Row ELSEIF hb_IsChar( uMsg ) nH := oDlu:H1 This.Message.Height := nH This.Message.FontName := cFont This.Message.FontSize := nSize This.Message.Value := uMsg ENDIF SET WINDOW THIS TO ENDIF ENDIF RETURN cForm [/pre2]

SergKis: Поправил ф-ю WaitWindow() [pre2] *-----------------------------------------------------------------------------* FUNCTION WaitWindow ( cMessage, lNoWait, nWidth, nSize, cFont ) *-----------------------------------------------------------------------------* LOCAL cFormName := "_HMG_CHILDWAITWINDOW" LOCAL lDefined := _IsWindowDefined( cFormName ) LOCAL lIsModal, nHeight, nY, nX // BK LOCAL lWidth := Empty( nWidth ) //LOCAL nWidth IF PCount() == 0 IF lDefined nCtEfeito := 0 cDescEfeito := "" DoMethod( cFormName, "Release" ) ENDIF ELSE hb_default( @lNoWait, .F. ) IF lDefined IF lNoWait SetProperty( cFormName, "Message", "Value", cMessage ) ENDIF ELSE lIsModal := _HMG_IsModalActive Default nSize := 10 // BK Default nHeight := nSize + 8 IF lNoWait _HMG_IsModalActive := .F. DEFINE WINDOW _HMG_CHILDWAITWINDOW CHILD ELSE DEFINE WINDOW _HMG_CHILDWAITWINDOW MODAL ENDIF IF lWidth // BK nWidth := GetTextWidth( , cMessage ) nWidth := Min( 2 * nWidth, Min( GetDesktopWidth(), 800 ) ) ENDIF nY := iif( IsVistaOrLater(), 4, 7 ) nX := 12 //SetProperty( cFormName, "Width", Min( 2 * nWidth, Min( GetDesktopWidth(), 800 ) ) ) SetProperty( cFormName, "Width" , nWidth ) // BK SetProperty( cFormName, "Height", nHeight + nY * 2 + GetBorderHeight() ) //SetProperty( cFormName, "Height", 36 + GetBorderHeight() / 2 ) SetProperty( cFormName, "Title", "" ) SetProperty( cFormName, "TitleBar", .F. ) SetProperty( cFormName, "SysMenu", .F. ) IF hb_osisWin10() SetProperty( cFormName, "Height", GetProperty( cFormName, "Height" ) + 7 ) SetProperty( cFormName, "BackColor", nRGB2Arr( GetSysColor( COLOR_WINDOW ) ) ) ENDIF @ nY, nX LABEL Message ; // BK WIDTH GetProperty( cFormName, "Width" ) - 24 - GetBorderWidth() ; HEIGHT nHeight VALUE cMessage FONT cFont SIZE nSize CENTERALIGN TRANSPARENT IF lWidth .and. GetProperty( cFormName, "Width" ) < 2 * nWidth // BK SetProperty( cFormName, "Message", "Value", "" ) _DefineTimer( "Timer", cFormName, 100, {|| EfeitoLabel( cMessage ) } ) ENDIF END WINDOW // BK DoMethod( cFormName, "Center" ) _ActivateWindow( { cFormName }, .T. ) _HMG_IsModalActive := lIsModal IF ! lNoWait InkeyGUI( 0 ) IF _IsControlDefined( "Timer", cFormName ) nCtEfeito := 0 cDescEfeito := "" ENDIF DoMethod( cFormName, "Release" ) ENDIF ENDIF ENDIF DO EVENTS RETURN cFormName // BK [/pre2] Пример [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" REQUEST DBFCDX, DBFFPT REQUEST HB_CODEPAGE_UTF8, HB_CODEPAGE_RU866, HB_CODEPAGE_RU1251 *-----------------------------------------------------------------------------* FUNCTION Main() *-----------------------------------------------------------------------------* SET CODEPAGE TO RUSSIAN SET LANGUAGE TO RUSSIAN RddSetDefault("DBFCDX") SET CENTURY ON SET DATE GERMAN SET DELETED ON SET EXCLUSIVE ON SET EPOCH TO 2000 SET AUTOPEN OFF SET EXACT ON SET SOFTSEEK ON SET NAVIGATION EXTENDED SET FONT TO "Arial", 14 *-------------------------------- SET OOP ON *-------------------------------- DEFINE WINDOW wMain TITLE "Demo WaitWindow" MAIN NOSIZE TOPMOST ; ON INIT ( This.Topmost := .F., _wPost(0) ) ; ON RELEASE ( dbCloseAll() ) ON KEY F1 ACTION NIL (This.Object):Event( 0, {| | InkeyGui(1000), Test_WW0(), Test_WW(), _wPost(99) } ) (This.Object):Event(99, {|ow| ow:Release() } ) END WINDOW CENTER WINDOW wMain ACTIVATE WINDOW wMain RETURN NIL STATIC FUNCTION Test_WW0() //LOCAL cNam := hb_FNameName( hb_ProgName() ) LOCAL cNam := hb_ProgName() LOCAL cForm cForm := WaitWindow( "... Запуск программы "+cNam+" ... ", .T., 900, 16 ) InkeyGui(5 * 1000 ) WaitWindow( "!!!!!!!!!!!!!!!!!!!!" ) InkeyGui(5 * 1000 ) SetProperty(cForm, "Message" , "Value", "@@@@@@@@@@@@@@@") InkeyGui(5 * 1000 ) WaitWindow() InkeyGui( 1000 ) RETURN Nil STATIC FUNCTION Test_WW() LOCAL cNam := hb_FNameName( hb_ProgName() ) LOCAL cForm // Первый тест - строка cForm := ToWaitWindow( "... Запуск программы "+cNam+" ... ", 700 ) InkeyGui(5 * 1000 ) ToWaitWindow( "!!!!!!!!!!!!!!!!!!!!" ) InkeyGui(5 * 1000 ) SetProperty(cForm, "Message" , "Value", "@@@@@@@@@@@@@@@") InkeyGui(5 * 1000 ) ToWaitWindow() InkeyGui( 1000 ) // Второй тест - массив cForm := ToWaitWindow( {"... Запуск программы "+cNam+" ... ", ; "Тестируем массив в окне. Строка 1" , ; "Тестируем массив в окне. Строка 2"}, 700 ) SET WINDOW THIS TO cForm This.Message.FontColor := BLUE This.Message.FontBold := .T. InkeyGui(5 * 1000 ) ToWaitWindow( {upper("... Запуск программы "+cNam+" ... "), ; "Замена строки 1 в окне. ****** 1 *", ; "Замена строки 2 в окне. ###### 2 #"} ) InkeyGui(5 * 1000 ) This.Message .Value := "@@@@@@@@@@@@@@@@@@@@" This.Message2.Value := "********************" This.Message3.Value := "####################" SET WINDOW THIS TO InkeyGui(5 * 1000 ) ToWaitWindow() InkeyGui( 1000 ) RETURN Nil FUNCTION ToWaitWindow( uMsg, nWidth ) // Режим NOWAIT для Activate LOCAL cForm := "_HMG_CHILDWAITWINDOW" LOCAL lDef, oDlu, cMsg, cFont, nSize LOCAL nI, nY, nX, nW, nH, nS, cN IF pCount() == 0 // завершение работы окна WaitWindow() IF Empty( _HMG_MainHandle ) // нет MAIN окна SET WINDOW MAIN ON ENDIF RETURN cForm ELSEIF _IsWindowDefined( cForm ) // вывод на окно IF hb_IsChar( uMsg ) .and. ";" $ uMsg uMsg := hb_ATokens( uMsg, ";" ) ELSEIF hb_IsChar( uMsg ) uMsg := { uMsg } ENDIF IF ! hb_IsArray( uMsg ) ; RETURN Nil ENDIF SET WINDOW THIS TO cForm FOR nI := 1 TO Len( uMsg ) cN := "Message" IF nI > 1 ; cN += hb_ntos(nI) ENDIF IF _IsControlDefined( cN, cForm ) This.&(cN).Value := uMsg[ nI ] ENDIF NEXT SET WINDOW THIS TO RETURN cForm ENDIF cFont := App.FontName nSize := App.FontSize oDlu := oDlu4Font( nSize ) IF !_IsWindowDefined( cForm ) // создание окна IF hb_IsChar( uMsg ) .and. ";" $ uMsg uMsg := hb_ATokens( uMsg, ";" ) ENDIF IF hb_IsChar( uMsg ) cMsg := uMsg ELSEIF hb_IsArray( uMsg ) .and. Len( uMsg ) > 0 cMsg := uMsg[1] ELSEIF hb_IsNumeric( uMsg ) cMsg := Repl(" ", uMsg) ELSE cMsg := Repl(" ", 70) ENDIF IF Empty( _HMG_MainHandle ) // нет MAIN окна SET WINDOW MAIN OFF ENDIF WaitWindow( cMsg, .T., nWidth ) IF _IsWindowDefined( cForm ) SET WINDOW THIS TO cForm nX := This.Message.Col nH := oDlu:H1 This.Message.Height := nH This.Message.FontName := cFont This.Message.FontSize := nSize IF hb_IsArray( uMsg ) .and. Len( uMsg ) > 0 nW := This.Message.Width nS := This.Message.Row * 3 nY := nS + This.Message.Height FOR nI := 2 TO Len( uMsg ) cN := "Message"+hb_ntos(nI) @ nY, nX LABEL &cN OF &cForm WIDTH nW HEIGHT nH ; VALUE uMsg[ nI ] FONT cFont SIZE nSize ; BACKCOLOR This.Message.BackColor ; CENTERALIGN TRANSPARENT nY := This.&(cN).Row + This.&(cN).Height nS += This.&(cN).Height NEXT ThisWindow.Height := ThisWindow.Height + nS ELSEIF hb_IsChar( uMsg ) This.Message.Value := uMsg ENDIF SET WINDOW THIS TO ENDIF ENDIF RETURN cForm [/pre2]

gfilatov2002: SergKis пишет: Поправил ф-ю WaitWindow() Ok

Andrey: SergKis пишет: Поправил ф-ю WaitWindow() А сразу туда нельзя добавить несколько строк для разделителя ";" или CRLF ? Несколько добавочных строк и можно будет не делать свою отдельную функцию. Плюс к этому добавить ещё 2 параметра [pre2] WaitWindow ( cMessage, lNoWait, nWidth, nSize, cFont, aBackColor, aFontColor ) [/pre2] И будет законченное решение. Я конечно сам могу себе сделать свою функцию, но хочется иметь готовую стандартную функцию, где это всё уже есть.

SergKis: Andrey пишет Я конечно сам могу себе сделать свою функцию, но хочется иметь готовую стандартную функцию, где это всё уже есть. Можно сделать. Надо перенести код из примера ToWaitWindow(...) в WaitWindow(). Даже была мысль такая, но надо для массива иметь доступ к ф-ям расчета от dlu, для "правильных" пропорций размеров от фонта, а для этого нужен set oop on. Другие расчеты размеров, по мне, не очень подходят и саму ф-ю надо сильно переписать. Не знаю, надо ли ? PS По поводу aBackColor, aFontColor cWWname := WaitWindow(...) SetProperty(cWWname, "Message", "FontColor", aFontColor ) SetProperty(cWWname, "Message", "BackColor", aBackColor ) Если надо. Это вполне можно на #xcommand вынести А есть еще свойства фонта BOLD, ITALIC ..., как с ними быть ..., т.е. ограничения есть, все в ф-ю WaitWindow(...) не засунешь Можно и параметры в ф-ю добавить, но для однострочного вывода, по мне, это не так актуально, но сделать просто, добавив в @ nY, nX LABEL Message ; ... BACKCOLOR aBackColor FONTCOLOR aFontColor PS2 Имея cWWname можно на окно ProgressBar добавлять самостоятельно, по аналогии с примером выше и "двигать" его, а не счетчик

Andrey: [pre2]WaitWindow ( cMessage, lNoWait, nWidth, nSize, cFont, aBackColor, aFontColor ) [/pre2] Высоту строк считать просто от параметра nSize, остальное BOLD, ITALIC не нужно. SergKis пишет: Можно и параметры в ф-ю добавить, но для однострочного вывода, по мне, это не так актуально, но сделать просто, добавив в @ nY, nX LABEL Message ... ; BACKCOLOR aBackColor FONTCOLOR aFontColor Сделай пожалуйста правильно, а то я опять сделаю и Григорию не понравиться ! Хочется иметь стандартную ПРОСТУЮ функцию, остальные требуют отдельного подключения к проектам.

SergKis: Andrey пишет Высоту строк считать просто от параметра nSize, Приемлемо на 11', 14' (что под рукой) отображение идет от nSize := 10 до nSize := 18, при выводе массива или одной строки. За пределами этого - искажения отображения. Это при условии, что в WaitWindow(...) сделал правку высоты Default nHeight := nSize + 14 вместо Default nHeight := nSize + 8 Если такой вариант использования устраивает, то можно сделать вывод строки и массива в WaitWindow(...) с указанными параметрами.

Andrey: SergKis пишет: Если такой вариант использования устраивает, то можно сделать вывод строки и массива в WaitWindow(...) с указанными параметрами. Да, устраивает !

SergKis: Andrey пишет Хочется иметь стандартную ПРОСТУЮ функцию, остальные требуют отдельного подключения к проектам. WaitWindow(...) получилась такая [pre2] *--------------------------------------------------------------------------------------* FUNCTION WaitWindow ( cMessage, lNoWait, nWidth, nSize, cFont, aFontColor, aBackColor ) *--------------------------------------------------------------------------------------* LOCAL cFormName := "_HMG_CHILDWAITWINDOW" LOCAL lDefined := _IsWindowDefined( cFormName ) LOCAL lIsModal LOCAL lWidth := Empty( nWidth ) LOCAL nHeight LOCAL nY, nX, nW, nI, nK LOCAL hFont, cTmp, nTmp, cLbl IF PCount() == 0 IF lDefined nCtEfeito := 0 cDescEfeito := "" DoMethod( cFormName, "Release" ) ENDIF ELSE hb_default( @lNoWait, .F. ) hb_default( @cFont, _HMG_DefaultFontName ) IF HB_ISCHAR( cMessage ) IF CRLF $ cMessage cMessage := hb_ATokens( cMessage, CRLF ) ELSEIF ";" $ cMessage cMessage := hb_ATokens( cMessage, ";" ) ELSE cMessage := { cMessage } ENDIF ELSEIF ! HB_ISARRAY( cMessage ) cMessage := { cMessage } ENDIF nK := Len( cMessage ) IF lDefined IF lNoWait FOR nI := 1 TO nK cLbl := "Message" + iif( nI > 1, hb_ntos( nI ), "" ) IF _IsControlDefined( cLbl, cFormName ) SetProperty( cFormName, cLbl, "Value", cValToChar( cMessage[ nI ] ) ) ENDIF NEXT ENDIF ELSE lIsModal := _HMG_IsModalActive nTmp := 1 cTmp := cMessage[ nTmp ] FOR nI := 1 TO nK nTmp := iif( Len( cValToChar( cMessage[ nI ] ) ) > Len( cTmp ), nI, nTmp ) NEXT cTmp := cValToChar( cMessage[ nTmp ] ) DEFAULT nSize := 10 hFont := InitFont( cFont, nSize ) nHeight := GetTextHeight ( Nil, "A" , hFont ) IF lWidth nWidth := GetTextWidth( Nil, cTmp, hFont ) + 24 nWidth := Min( 2 * nWidth, Min( GetDesktopWidth(), 800 ) ) ENDIF DeleteObject( hFont ) nHeight += 8 IF lNoWait _HMG_IsModalActive := .F. DEFINE WINDOW _HMG_CHILDWAITWINDOW CHILD ELSE DEFINE WINDOW _HMG_CHILDWAITWINDOW MODAL ENDIF nY := iif( IsVistaOrLater(), 4, 7 ) nX := 12 SetProperty( cFormName, "Width", nWidth ) SetProperty( cFormName, "Height", nHeight * nK + nY * 2 + iif( IsSeven(), 2, 1 ) * GetBorderHeight() ) SetProperty( cFormName, "Title", "" ) SetProperty( cFormName, "TitleBar", .F. ) SetProperty( cFormName, "SysMenu", .F. ) IF hb_osIsWin10() SetProperty( cFormName, "Height", GetProperty( cFormName, "Height" ) + 7 ) SetProperty( cFormName, "BackColor", nRGB2Arr( GetSysColor( COLOR_WINDOW ) ) ) ENDIF nW := GetProperty( cFormName, "ClientWidth" ) - nX * 2 FOR nI := 1 TO nK cLbl := "Message" + iif( nI > 1, hb_ntos( nI ), "" ) @ nY, nX LABEL &(cLbl) WIDTH nW HEIGHT nHeight ; VALUE cValToChar( cMessage[ nI ] ) ; FONT cFont SIZE nSize ; BACKCOLOR aBackColor FONTCOLOR aFontColor ; CENTERALIGN TRANSPARENT nY += nHeight NEXT IF lWidth .AND. GetProperty( cFormName, "Width" ) < 2 * nWidth SetProperty( cFormName, "Message", "Value", "" ) _DefineTimer( "Timer", cFormName, 100, {|| EfeitoLabel( cMessage[1] ) } ) ENDIF END WINDOW DoMethod( cFormName, "Center" ) _ActivateWindow( { cFormName }, .T. ) _HMG_IsModalActive := lIsModal IF ! lNoWait InkeyGUI( 0 ) IF _IsControlDefined( "Timer", cFormName ) nCtEfeito := 0 cDescEfeito := "" ENDIF DoMethod( cFormName, "Release" ) ENDIF ENDIF ENDIF DO EVENTS RETURN cFormName [/pre2] Пример использования [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" REQUEST DBFCDX, DBFFPT REQUEST HB_CODEPAGE_UTF8, HB_CODEPAGE_RU866, HB_CODEPAGE_RU1251 *-----------------------------------------------------------------------------* FUNCTION Main() *-----------------------------------------------------------------------------* LOCAL cFont := "Arial", nSize := 12 SET CODEPAGE TO RUSSIAN SET LANGUAGE TO RUSSIAN RddSetDefault("DBFCDX") SET CENTURY ON SET DATE GERMAN SET DELETED ON SET EXCLUSIVE ON SET EPOCH TO 2000 SET AUTOPEN OFF SET EXACT ON SET SOFTSEEK ON SET NAVIGATION EXTENDED SET FONT TO cFont, nSize *-------------------------------- SET OOP ON *-------------------------------- DEFINE WINDOW wMain TITLE "Demo WaitWindow" MAIN NOSIZE TOPMOST ; ON INIT ( This.Topmost := .F., _wPost(0) ) ; ON RELEASE ( dbCloseAll() ) ON KEY F1 ACTION NIL (This.Object):Event( 0, {| | InkeyGui(1000), Test_WW0(), Test_WW(), _wPost(99) } ) (This.Object):Event(99, {|ow| ow:Release() } ) END WINDOW CENTER WINDOW wMain ACTIVATE WINDOW wMain RETURN NIL STATIC FUNCTION Test_WW0() //LOCAL cNam := hb_FNameName( hb_ProgName() ) LOCAL cNam := hb_ProgName() LOCAL cForm cForm := WaitWindow( "... Запуск программы "+cNam+" ... ", .T., 900) InkeyGui(5 * 1000 ) WaitWindow( "!!!!!!!!!!!!!!!!!!!!", .T. ) InkeyGui(5 * 1000 ) SetProperty(cForm, "Message" , "Value", "@@@@@@@@@@@@@@@") InkeyGui(5 * 1000 ) WaitWindow() InkeyGui( 1000 ) RETURN Nil STATIC FUNCTION Test_WW() LOCAL cNam := hb_FNameName( hb_ProgName() ) LOCAL cForm, nSize := 20 // Первый тест - строка cForm := WaitWindow( "... Запуск программы "+cNam+" ... ", .T., 700, nSize ) InkeyGui(5 * 1000 ) WaitWindow( "!!!!!!!!!!!!!!!!!!!!", .T. ) InkeyGui(5 * 1000 ) SetProperty(cForm, "Message" , "Value", "@@@@@@@@@@@@@@@") InkeyGui(5 * 1000 ) WaitWindow() InkeyGui( 1000 ) // Второй тест - массив cForm := WaitWindow( {"... Запуск программы "+cNam+" ... ", ; "Тестируем массив в окне. Строка 1" , ; "Тестируем массив в окне. Строка 2"}, .T., 700, nSize ) SET WINDOW THIS TO cForm This.Message.FontColor := BLUE This.Message.FontBold := .T. InkeyGui(5 * 1000 ) WaitWindow( {upper("... Запуск программы "+cNam+" ... "), ; "Замена строки 1 в окне. ****** 1 *" , ; "Замена строки 2 в окне. ###### 2 #"}, .T. ) InkeyGui(5 * 1000 ) WaitWindow("@@@@@@@@@@@@@@@@@@@@;********************;####################", .T.) This.Message .Value := "@..................@" This.Message2.Value := "*..................*" This.Message3.Value := "#..................#" SET WINDOW THIS TO InkeyGui(5 * 1000 ) WaitWindow() InkeyGui( 1000 ) RETURN Nil [/pre2]

gfilatov2002: SergKis пишет: WaitWindow(...) Принято Благодарю за помощь

Andrey: Что то не работает фон окна и вообще оно пропадает ! [pre2] cForm := WaitWindow( "... Запуск программы ...;"+cNam, .T., 700, nSize, YELLOW, RED ) [/pre2]

gfilatov2002: Andrey пишет: вообще оно пропадает А если записать так: cForm := WaitWindow( "... Запуск программы ...;"+cNam, .T., 700, nSize, NIL, YELLOW, RED ) Кстати, выложил "тихое" обновление с учетом предложенных изменений для функции WaitWindow().

Andrey: gfilatov2002 пишет: А если записать так: Как всегда, слона cFont и не заметил. Спасибо ! Добавил в h_windows.prg вот так: [pre2] IF hb_osIsWin10() SetProperty( cFormName, "Height", GetProperty( cFormName, "Height" ) + 7 ) SetProperty( cFormName, "BackColor", nRGB2Arr( GetSysColor( COLOR_WINDOW ) ) ) ENDIF IF hb_IsArray(aBackColor) SetProperty( cFormName, "BackColor", aBackColor ) ENDIF[/pre2] Ну не видят юзера серый цвет, от слова СОВСЕМ НЕ ВИДЯТ. БОЛЬШАЯ просьба добавить это в исходник. А как убрать беленькую полоску в титуле окна ? Вот есть такое - https://docs.microsoft.com/ru-ru/windows/apps/develop/title-bar?tabs=wasdk И ещё - https://translated.turbopages.org/proxy_u/en-ru.ru.740f60a8-6229ca4d-aa890b0b-74722d776562/https/stackoverflow.com/questions/70446389/how-to-recolor-windows-forms-title-bar-c-sharp

SergKis: gfilatov2002 Нельзя сделать ширину окна > 800, это, наверно, неправильно, т.е. задать[pre2] LOCAL cNam := hb_FNameName( hb_ProgName() ) LOCAL cForm, nSize := 16 LOCAL nW := GetDesktopWidth() * 0.95 // Первый тест - строка cForm := WaitWindow( "... Запуск программы ...;"+hb_ProgName(), .T., nW, nSize, NIL, YELLOW, BLUE ) [/pre2] Предлагаю правку [pre2] ... LOCAL lWidth := ( nWidth == NIL ) ... nHeight := GetTextHeight ( NIL, "A", hFont ) IF lWidth nWidth := GetTextWidth( NIL, cTmp, hFont ) + nX * 2 nWidth := Min( 2 * nWidth, 800 ) ELSEIF Empty( nWidth ) .or. nWidth < 0 nWidth := GetTextWidth( NIL, cTmp+Replicate("A", 5), hFont ) + nX * 2 ENDIF DeleteObject( hFont ) nHeight += 8 IF lNoWait _HMG_IsModalActive := .F. DEFINE WINDOW _HMG_CHILDWAITWINDOW CHILD ELSE DEFINE WINDOW _HMG_CHILDWAITWINDOW MODAL ENDIF //SetProperty( cFormName, "Width", Min( 2 * nWidth, Min( GetDesktopWidth(), 800 ) ) ) SetProperty( cFormName, "Width", Min( GetDesktopWidth(), nWidth ) ) SetProperty( cFormName, "Height", nHeight * nK + nY * 2 + GetBorderHeight() ) SetProperty( cFormName, "Title", "" ) SetProperty( cFormName, "TitleBar", .F. ) SetProperty( cFormName, "SysMenu", .F. ) IF hb_osIsWin10() SetProperty( cFormName, "Height", GetProperty( cFormName, "Height" ) + 7 ) SetProperty( cFormName, "BackColor", nRGB2Arr( GetSysColor( COLOR_WINDOW ) ) ) ENDIF IF HB_ISARRAY( aBackColor ) SetProperty( cFormName, "BackColor", aBackColor ) ENDIF nW := GetProperty( cFormName, "ClientWidth" ) - nX * 2 ... тогда проходят варианты LOCAL nW := GetDesktopWidth() * 0.95 cForm := WaitWindow( "... Запуск программы ...;"+hb_ProgName(), .T., nW, nSize, NIL, YELLOW, BLUE ) и cForm := WaitWindow( "... Запуск программы ...;"+hb_ProgName(), .T., 0, nSize, NIL, YELLOW, BLUE ) расчет от текста ширины окна [/pre2] Возможно, надо добавить вариант Андрея с заголовком окна, т.е. совсем без него DEFINE WINDOW ... CHILD ... NOSIZE NOSYSMENU NOCAPTION ... и DEFINE WINDOW ... MODAL ... NOSIZE NOSYSMENU NOCAPTION ...

Andrey: Я уже попробовал. Не особо красиво, текст прилипает к вверху окна. Нужно делать отступ от верха окна. И нет теней для окна на Win10, и окантовки нет. Может на других ОС будет красиво, но я не могу пока проверить это. Взял тихое обновление Григория и облом с моим примером, серый фон и блеклые жёлтые буквы на нём. Нужно делать так: [pre2] IF hb_osIsWin10() SetProperty( cFormName, "Height", GetProperty( cFormName, "Height" ) + 7 ) SetProperty( cFormName, "BackColor", nRGB2Arr( GetSysColor( COLOR_WINDOW ) ) ) //ELSEIF HB_ISARRAY( aBackColor ) // SetProperty( cFormName, "BackColor", aBackColor ) ENDIF IF HB_ISARRAY( aBackColor ) SetProperty( cFormName, "BackColor", aBackColor ) ENDIF[/pre2] Свой пример выкладываю - https://cloud.mail.ru/public/FVpn/Bh6MHPvKU

SergKis: Andrey пишет Я уже попробовал. Не особо красиво, текст прилипает к вверху окна. Нужно делать отступ от верха окна. Вот что получилось у меня WaitWindow(...) [pre2] *----------------------------------------------------------------------------------------------* FUNCTION WaitWindow ( cMessage, lNoWait, nWidth, nSize, cFont, aFontColor, aBackColor, lNoCapt ) *----------------------------------------------------------------------------------------------* LOCAL cFormName := "_HMG_CHILDWAITWINDOW" LOCAL lDefined := _IsWindowDefined( cFormName ) LOCAL lIsModal LOCAL lWidth := ( nWidth == NIL ) LOCAL nHeight LOCAL nY, nX, nW, nI, nK LOCAL hFont, cTmp, nTmp, cLbl, nPos := 0 IF PCount() == 0 IF lDefined nCtEfeito := 0 cDescEfeito := "" DoMethod ( cFormName, "Release" ) ENDIF ELSE hb_default( @lNoWait, .F. ) hb_default( @cFont, _HMG_DefaultFontName ) IF HB_ISCHAR( cMessage ) IF CRLF $ cMessage cMessage := hb_ATokens( cMessage, CRLF ) ELSEIF ";" $ cMessage cMessage := hb_ATokens( cMessage, ";" ) ELSE cMessage := { cMessage } ENDIF ELSEIF ! HB_ISARRAY( cMessage ) cMessage := { cMessage } ENDIF nK := Len( cMessage ) IF lDefined IF lNoWait FOR nI := 1 TO nK cLbl := "Message" + iif( nI > 1, hb_ntos( nI ), "" ) IF _IsControlDefined( cLbl, cFormName ) SetProperty( cFormName, cLbl, "Value", cValToChar( cMessage[ nI ] ) ) ENDIF NEXT ENDIF ELSE IF HB_ISLOGICAL( lNoCapt ) nPos := iif( lNoCapt, 10, nPos ) ELSEIF HB_ISNUMERIC( lNoCapt ) nPos := iif( lNoCapt > 0, lNoCapt, nPos ) ENDIF lNoCapt := !Empty( nPos ) lIsModal := _HMG_IsModalActive nTmp := 1 cTmp := cMessage[ nTmp ] FOR nI := 1 TO nK nTmp := iif( Len( cValToChar( cMessage[ nI ] ) ) > Len( cTmp ), nI, nTmp ) NEXT cTmp := cValToChar( cMessage[ nTmp ] ) DEFAULT nSize := 10 nY := iif( IsVistaOrLater(), 4, 7 ) + nPos nX := 12 hFont := InitFont( cFont, nSize ) nHeight := GetTextHeight ( NIL, "A", hFont ) IF lWidth nWidth := GetTextWidth( NIL, cTmp, hFont ) + nX * 2 nWidth := Min( 2 * nWidth, 800 ) ELSEIF Empty( nWidth ) .or. nWidth < 0 nWidth := GetTextWidth( NIL, cTmp+Replicate("A", 5), hFont ) + nX * 2 ENDIF DeleteObject( hFont ) nHeight += 8 IF lNoWait _HMG_IsModalActive := .F. IF lNoCapt DEFINE WINDOW _HMG_CHILDWAITWINDOW CHILD ; CLIENTAREA Min( GetDesktopWidth(), nWidth ), nHeight * nK + nY * 2 ; NOSIZE NOSYSMENU NOCAPTION ELSE DEFINE WINDOW _HMG_CHILDWAITWINDOW CHILD ; CLIENTAREA Min( GetDesktopWidth(), nWidth ), nHeight * nK + nY * 2 ENDIF ELSE IF lNoCapt DEFINE WINDOW _HMG_CHILDWAITWINDOW MODAL ; CLIENTAREA Min( GetDesktopWidth(), nWidth ), nHeight * nK + nY * 2 ; NOSIZE NOSYSMENU NOCAPTION ELSE DEFINE WINDOW _HMG_CHILDWAITWINDOW MODAL ; CLIENTAREA Min( GetDesktopWidth(), nWidth ), nHeight * nK + nY * 2 ENDIF ENDIF //SetProperty( cFormName, "Width", Min( 2 * nWidth, Min( GetDesktopWidth(), 800 ) ) ) //SetProperty( cFormName, "Width", Min( GetDesktopWidth(), nWidth ) ) //SetProperty( cFormName, "Height", nHeight * nK + nY * 2 + GetBorderHeight() ) SetProperty( cFormName, "Title", "" ) SetProperty( cFormName, "TitleBar", .F. ) SetProperty( cFormName, "SysMenu", .F. ) IF hb_osIsWin10() SetProperty( cFormName, "Height", GetProperty( cFormName, "Height" ) + 7 ) SetProperty( cFormName, "BackColor", nRGB2Arr( GetSysColor( COLOR_WINDOW ) ) ) ENDIF IF HB_ISARRAY( aBackColor ) SetProperty( cFormName, "BackColor", aBackColor ) ENDIF nW := GetProperty( cFormName, "ClientWidth" ) - nX * 2 FOR nI := 1 TO nK cLbl := "Message" + iif( nI > 1, hb_ntos( nI ), "" ) @ nY, nX LABEL &( cLbl ) WIDTH nW HEIGHT nHeight ; VALUE cValToChar( cMessage[ nI ] ) ; FONT cFont SIZE nSize ; FONTCOLOR aFontColor ; CENTERALIGN TRANSPARENT nY += nHeight NEXT IF lWidth .AND. GetProperty( cFormName, "Width" ) < 2 * nWidth SetProperty( cFormName, "Message", "Value", "" ) _DefineTimer( "Timer", cFormName, 100, {|| EfeitoLabel( cMessage[ 1 ] ) } ) ENDIF END WINDOW DoMethod ( cFormName, "Center" ) _ActivateWindow( { cFormName }, .T. ) _HMG_IsModalActive := lIsModal IF ! lNoWait InkeyGUI( 0 ) IF _IsControlDefined( "Timer", cFormName ) nCtEfeito := 0 cDescEfeito := "" ENDIF DoMethod ( cFormName, "Release" ) ENDIF ENDIF ENDIF DO EVENTS RETURN cFormName [/pre2] Пример [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" REQUEST DBFCDX, DBFFPT REQUEST HB_CODEPAGE_UTF8, HB_CODEPAGE_RU866, HB_CODEPAGE_RU1251 *-----------------------------------------------------------------------------* FUNCTION Main() *-----------------------------------------------------------------------------* LOCAL cFont := "Arial", nSize := 12 SET CODEPAGE TO RUSSIAN SET LANGUAGE TO RUSSIAN RddSetDefault("DBFCDX") SET CENTURY ON SET DATE GERMAN SET DELETED ON SET EXCLUSIVE ON SET EPOCH TO 2000 SET AUTOPEN OFF SET EXACT ON SET SOFTSEEK ON SET NAVIGATION EXTENDED SET FONT TO cFont, nSize *-------------------------------- SET OOP ON *-------------------------------- DEFINE WINDOW wMain TITLE "Demo WaitWindow" MAIN NOSIZE TOPMOST ; ON INIT ( This.Topmost := .F., _wPost(0) ) ; ON RELEASE ( dbCloseAll() ) ON KEY F1 ACTION NIL (This.Object):Event( 0, {| | InkeyGui(1000), Test_WW0(), Test_WW(), _wPost(99) } ) (This.Object):Event(99, {|ow| ow:Release() } ) END WINDOW CENTER WINDOW wMain ACTIVATE WINDOW wMain RETURN NIL STATIC FUNCTION Test_WW0() //LOCAL cNam := hb_FNameName( hb_ProgName() ) LOCAL cNam := hb_ProgName() LOCAL cForm cForm := WaitWindow( "... Запуск программы "+cNam+" ... ", .T., 700, 12, NIL, YELLOW, RED, .T.) //cForm := WaitWindow( "... Запуск программы "+cNam+" ... ", .T., 700, 12, NIL, YELLOW, RED, 20 ) //cForm := WaitWindow( "... Запуск программы "+cNam+" ... ", .T., 700, 12, NIL, YELLOW, RED) InkeyGui(5 * 1000 ) WaitWindow( "!!!!!!!!!!!!!!!!!!!!;"+cNam, .T. ) // не работает InkeyGui(5 * 1000 ) SetProperty(cForm, "Message" , "Value", "@@@@@@@@@@@@@@@") InkeyGui(5 * 1000 ) WaitWindow() InkeyGui( 1000 ) RETURN Nil STATIC FUNCTION Test_WW() LOCAL cNam := hb_FNameName( hb_ProgName() ) LOCAL cForm, nSize := 16, aMsg LOCAL nW := GetDesktopWidth() * 0.95 // Первый тест - строка //nW := 0 aMsg := "... Запуск программы ...;"+hb_ProgName() cForm := WaitWindow( aMsg, .T., nW, nSize, NIL, YELLOW, BLUE, .T. ) //cForm := WaitWindow( aMsg, .T., nW, nSize, NIL, YELLOW, BLUE, 20 ) //cForm := WaitWindow( aMsg, .T., nW, nSize, NIL, YELLOW, BLUE ) InkeyGui(5 * 1000 ) WaitWindow( "!!!!!!!!!!!!!!!!!!!!", .T. ) InkeyGui(5 * 1000 ) SetProperty(cForm, "Message" , "Value", "@@@@@@@@@@@@@@@") InkeyGui(5 * 1000 ) WaitWindow() InkeyGui( 1000 ) // Второй тест - массив aMsg := {"... Запуск программы "+cNam+" ... ", ; "Тестируем массив в окне. Строка 1" , ; "Тестируем массив в окне. Строка 2"} cForm := WaitWindow( aMsg, .T., 700, nSize, NIL, YELLOW, RED, .T. ) //cForm := WaitWindow( aMsg, .T., 700, nSize, NIL, YELLOW, RED, 20 ) //cForm := WaitWindow( aMsg, .T., 700, nSize, NIL, YELLOW, RED ) SET WINDOW THIS TO cForm This.Message.FontColor := BLUE This.Message.FontBold := .T. InkeyGui(5 * 1000 ) WaitWindow( {upper("... Запуск программы "+cNam+" ... "), ; "Замена строки 1 в окне. ****** 1 *" , ; "Замена строки 2 в окне. ###### 2 #"}, .T. ) InkeyGui(5 * 1000 ) WaitWindow("@@@@@@@@@@@@@@@@@@@@;********************;####################", .T.) This.Message .Value := "@..................@" This.Message2.Value := "*..................*" This.Message3.Value := "#..................#" SET WINDOW THIS TO InkeyGui(5 * 1000 ) WaitWindow() InkeyGui( 1000 ) RETURN Nil [/pre2] И нет теней для окна на Win10, и окантовки нет На счет окантовки есть ф-я, которая может делать окантовку с закругленными углами, ее можно тут применить. Но я не вспомнил ее название, а пример использования не нашел. Найди и можно вставить для пробы PS CLIENTAREA Min( GetDesktopWidth(), nWidth ), nHeight * nK + nY * 2 Вместо GetDesktopWidth() можно исп. GetDesktopRealWidth() PS2[pre2] IF hb_osIsWin10() SetProperty( cFormName, "Height", GetProperty( cFormName, "Height" ) /*+ 7*/ )[/pre2] Выделенное цветом, по мне лишнее, т.е. эту строку можно убрать Пример и h_windows.prg со всеми исправлениями WaitWindow() https://TransFiles.ru/sczh6 PS Пример с заголовком окна https://TransFiles.ru/o6uph В h_windows.prg добавил правку [pre2] IF lNoWait _HMG_IsModalActive := .F. IF lNoCapt DEFINE WINDOW _HMG_CHILDWAITWINDOW CHILD CLIENTAREA nW, nH NOSIZE NOSYSMENU NOCAPTION ELSE nH -= GetTitleHeight() DEFINE WINDOW _HMG_CHILDWAITWINDOW CHILD CLIENTAREA nW, nH ENDIF ELSE IF lNoCapt DEFINE WINDOW _HMG_CHILDWAITWINDOW MODAL CLIENTAREA nW, nH NOSIZE NOSYSMENU NOCAPTION ELSE nH -= GetTitleHeight() DEFINE WINDOW _HMG_CHILDWAITWINDOW MODAL CLIENTAREA nW, nH ENDIF ENDIF [/pre2]

SergKis: Andrey пишет окантовки нет Вариант окантовки (добавка в h_windows.prg из последнего архива пред поста) [pre2] FUNCTION WaitWindow ( cMessage, lNoWait, nWidth, nSize, cFont, aFontColor, aBackColor, lNoCapt, aPenColor, nPen ) ... NEXT IF HB_ISARRAY( aPenColor ) nPen := iif( Empty( nPen ), 2, nPen ) nI := nPen - 1 nY := nX := nI nH := ThisWindow.ClientHeight - nI nW := ThisWindow.ClientWidth - nI DrawRect( cFormName, nY, nX, nH, nW, aPenColor, nPen ) ENDIF IF lWidth .AND. GetProperty( cFormName, "Width" ) < 2 * nWidth SetProperty( cFormName, "Message", "Value", "" ) _DefineTimer( "Timer", cFormName, 100, {|| EfeitoLabel( cMessage[ 1 ] ) } ) ENDIF ... [/pre2] Пример [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" REQUEST DBFCDX, DBFFPT REQUEST HB_CODEPAGE_UTF8, HB_CODEPAGE_RU866, HB_CODEPAGE_RU1251 *-----------------------------------------------------------------------------* FUNCTION Main() *-----------------------------------------------------------------------------* LOCAL cFont := "Arial", nSize := 12 SET CODEPAGE TO RUSSIAN SET LANGUAGE TO RUSSIAN RddSetDefault("DBFCDX") SET CENTURY ON SET DATE GERMAN SET DELETED ON SET EXCLUSIVE ON SET EPOCH TO 2000 SET AUTOPEN OFF SET EXACT ON SET SOFTSEEK ON SET NAVIGATION EXTENDED SET FONT TO cFont, nSize *-------------------------------- SET OOP ON *-------------------------------- DEFINE WINDOW wMain TITLE "Demo WaitWindow" MAIN NOSIZE TOPMOST ; ON INIT ( This.Topmost := .F., _wPost(0) ) ; ON RELEASE ( dbCloseAll() ) ON KEY F1 ACTION NIL (This.Object):Event( 0, {| | InkeyGui(1000), Test_WW0(), Test_WW(), _wPost(99) } ) (This.Object):Event(99, {|ow| ow:Release() } ) END WINDOW CENTER WINDOW wMain ACTIVATE WINDOW wMain RETURN NIL STATIC FUNCTION Test_WW0() //LOCAL cNam := hb_FNameName( hb_ProgName() ) LOCAL cNam := hb_ProgName() LOCAL cForm, y, x, w, h, n //cForm := WaitWindow( "... Запуск программы "+cNam+" ... ", .T., 700, 12, NIL, YELLOW, RED, .T., GRAY ) cForm := WaitWindow( "... Запуск программы "+cNam+" ... ", .T., 700, 12, NIL, YELLOW, RED, 20, GRAY ) //cForm := WaitWindow( "... Запуск программы "+cNam+" ... ", .T., 700, 12, NIL, YELLOW, RED, , GRAY ) InkeyGui(5 * 1000 ) WaitWindow( "!!!!!!!!!!!!!!!!!!!!;"+cNam, .T. ) InkeyGui(5 * 1000 ) SetProperty(cForm, "Message" , "Value", "@@@@@@@@@@@@@@@") InkeyGui(5 * 1000 ) WaitWindow() InkeyGui( 1000 ) RETURN Nil STATIC FUNCTION Test_WW() LOCAL cNam := hb_FNameName( hb_ProgName() ) LOCAL cForm, nSize := 16, aMsg LOCAL nW := GetDesktopWidth() * 0.95 // Первый тест - строка //nW := 0 aMsg := "... Запуск программы ...;"+hb_ProgName() //cForm := WaitWindow( aMsg, .T., nW, nSize, NIL, YELLOW, BLUE, .T., GRAY ) cForm := WaitWindow( aMsg, .T., nW, nSize, NIL, YELLOW, BLUE, 20, GRAY ) //cForm := WaitWindow( aMsg, .T., nW, nSize, NIL, YELLOW, BLUE, , GRAY ) InkeyGui(5 * 1000 ) WaitWindow( "!!!!!!!!!!!!!!!!!!!!", .T. ) InkeyGui(5 * 1000 ) SetProperty(cForm, "Message" , "Value", "@@@@@@@@@@@@@@@") InkeyGui(5 * 1000 ) WaitWindow() InkeyGui( 1000 ) // Второй тест - массив aMsg := {"... Запуск программы "+cNam+" ... ", ; "Тестируем массив в окне. Строка 1" , ; "Тестируем массив в окне. Строка 2"} //cForm := WaitWindow( aMsg, .T., 700, nSize, NIL, YELLOW, RED, .T., GRAY ) cForm := WaitWindow( aMsg, .T., 700, nSize, NIL, YELLOW, RED, 20, GRAY ) //cForm := WaitWindow( aMsg, .T., 700, nSize, NIL, YELLOW, RED, , GRAY ) SET WINDOW THIS TO cForm This.Message.FontColor := BLUE This.Message.FontBold := .T. InkeyGui(5 * 1000 ) WaitWindow( {upper("... Запуск программы "+cNam+" ... "), ; "Замена строки 1 в окне. ****** 1 *" , ; "Замена строки 2 в окне. ###### 2 #"}, .T. ) InkeyGui(5 * 1000 ) WaitWindow("@@@@@@@@@@@@@@@@@@@@;********************;####################", .T.) This.Message .Value := "@..................@" This.Message2.Value := "*..................*" This.Message3.Value := "#..................#" SET WINDOW THIS TO InkeyGui(5 * 1000 ) WaitWindow() InkeyGui( 1000 ) RETURN Nil [/pre2]

Andrey: Круто ! То что надо для юзера ! Спасибо БОЛЬШОЕ ! Пошёл переделывать проги.

SergKis: Andrey пишет Пошёл переделывать проги. Еще пример с добавленным ProgressBar к строкам массива [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" REQUEST DBFCDX, DBFFPT REQUEST HB_CODEPAGE_UTF8, HB_CODEPAGE_RU866, HB_CODEPAGE_RU1251 *-----------------------------------------------------------------------------* FUNCTION Main() *-----------------------------------------------------------------------------* LOCAL cFont := "Arial", nSize := 12 SET CODEPAGE TO RUSSIAN SET LANGUAGE TO RUSSIAN RddSetDefault("DBFCDX") SET CENTURY ON SET DATE GERMAN SET DELETED ON SET EXCLUSIVE ON SET EPOCH TO 2000 SET AUTOPEN OFF SET EXACT ON SET SOFTSEEK ON SET NAVIGATION EXTENDED SET FONT TO cFont, nSize *-------------------------------- SET OOP ON *-------------------------------- DEFINE WINDOW wMain TITLE "Demo WaitWindow" MAIN NOSIZE TOPMOST ; ON INIT ( This.Topmost := .F., _wPost(0) ) ; ON RELEASE ( dbCloseAll() ) ON KEY F1 ACTION NIL (This.Object):Event( 0, {| | InkeyGui(1000), Test_WW0(), Test_WW(), _wPost(99) } ) (This.Object):Event(99, {|ow| ow:Release() } ) END WINDOW CENTER WINDOW wMain ACTIVATE WINDOW wMain RETURN NIL STATIC FUNCTION Test_WW0() //LOCAL cNam := hb_FNameName( hb_ProgName() ) LOCAL cNam := hb_ProgName() LOCAL cForm, y, x, w, h, n //cForm := WaitWindow( "... Запуск программы "+cNam+" ... ", .T., 700, 12, NIL, YELLOW, RED, .T., GREEN, 4 ) cForm := WaitWindow( "... Запуск программы "+cNam+" ... ", .T., 700, 12, NIL, YELLOW, RED, 20, GREEN, 4 ) //cForm := WaitWindow( "... Запуск программы "+cNam+" ... ", .T., 700, 12, NIL, YELLOW, RED, , BLACK, 1 ) InkeyGui(5 * 1000 ) WaitWindow( "!!!!!!!!!!!!!!!!!!!!;"+cNam, .T. ) InkeyGui(5 * 1000 ) SetProperty(cForm, "Message" , "Value", "@@@@@@@@@@@@@@@") InkeyGui(5 * 1000 ) WaitWindow() InkeyGui( 1000 ) RETURN Nil STATIC FUNCTION Test_WW() LOCAL cNam := hb_FNameName( hb_ProgName() ) LOCAL cForm, nSize := 16, aMsg, i, n, y, x, w, h LOCAL nW := GetDesktopWidth() * 0.95 // Первый тест - строка //nW := 0 aMsg := "... Запуск программы ...;"+hb_ProgName() //cForm := WaitWindow( aMsg, .T., nW, nSize, NIL, YELLOW, BLUE, .T., GREEN, 4 ) cForm := WaitWindow( aMsg, .T., nW, nSize, NIL, YELLOW, BLUE, 20, GREEN, 4 ) //cForm := WaitWindow( aMsg, .T., nW, nSize, NIL, YELLOW, BLUE, , BLACK, 1 ) InkeyGui(5 * 1000 ) WaitWindow( "!!!!!!!!!!!!!!!!!!!!", .T. ) InkeyGui(5 * 1000 ) SetProperty(cForm, "Message" , "Value", "@@@@@@@@@@@@@@@") InkeyGui(5 * 1000 ) WaitWindow() InkeyGui( 1000 ) // Второй тест - массив aMsg := {"... Запуск программы "+cNam+" ... ", ; "Тестируем массив в окне. Строка 1" , ; "Тестируем массив в окне. Строка 2"} //cForm := WaitWindow( aMsg, .T., 700, nSize, NIL, YELLOW, RED, .T., BLUE , 4 ) cForm := WaitWindow( aMsg, .T., 700, nSize, NIL, YELLOW, RED, 20, BLUE , 4 ) //cForm := WaitWindow( aMsg, .T., 700, nSize, NIL, YELLOW, RED, , BLACK, 1 ) SET WINDOW THIS TO cForm h := 5 n := 10 This.Message.FontColor := BLUE This.Message.FontBold := .T. This.Message3.Row := This.Message3.Row + h ThisWindow.Height := ThisWindow.Height + h y := This.Message2.Row + This.Message2.Height x := This.Message2.Col w := This.Message2.Width @ y, x PROGRESSBAR Progress OF &(cForm) RANGE 0, n WIDTH w HEIGHT h FOR i := 1 TO n This.Progress.Value := This.Progress.Value + 1 IF InkeyGui(1 * 1000 ) == 27 EXIT ENDIF NEXT IF i != n This.Progress.Value := n ENDIF InkeyGui(3 * 1000 ) This.Progress.Hide WaitWindow( {upper("... Запуск программы "+cNam+" ... "), ; "Замена строки 1 в окне. ****** 1 *" , ; "Замена строки 2 в окне. ###### 2 #"}, .T. ) InkeyGui(5 * 1000 ) WaitWindow("@@@@@@@@@@@@@@@@@@@@;********************;####################", .T.) This.Message .Value := "@..................@" This.Message2.Value := "*..................*" This.Message3.Value := "#..................#" SET WINDOW THIS TO InkeyGui(5 * 1000 ) WaitWindow() InkeyGui( 1000 ) RETURN Nil [/pre2]

SergKis: PS Пример с изменением размера окна для ProgressBar оставляет снизу лишнюю полоску. Лучше применить др. методу замены элемента массива для размещения ProgressBar Пример [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" REQUEST DBFCDX, DBFFPT REQUEST HB_CODEPAGE_UTF8, HB_CODEPAGE_RU866, HB_CODEPAGE_RU1251 *-----------------------------------------------------------------------------* FUNCTION Main() *-----------------------------------------------------------------------------* LOCAL cFont := "Arial", nSize := 12 SET CODEPAGE TO RUSSIAN SET LANGUAGE TO RUSSIAN RddSetDefault("DBFCDX") SET CENTURY ON SET DATE GERMAN SET DELETED ON SET EXCLUSIVE ON SET EPOCH TO 2000 SET AUTOPEN OFF SET EXACT ON SET SOFTSEEK ON SET NAVIGATION EXTENDED SET FONT TO cFont, nSize *-------------------------------- SET OOP ON *-------------------------------- DEFINE WINDOW wMain TITLE "Demo WaitWindow" MAIN NOSIZE TOPMOST ; ON INIT ( This.Topmost := .F., _wPost(0) ) ; ON RELEASE ( dbCloseAll() ) ON KEY F1 ACTION NIL (This.Object):Event( 0, {| | InkeyGui(1000), Test_WW0(), Test_WW(), _wPost(99) } ) (This.Object):Event(99, {|ow| ow:Release() } ) END WINDOW CENTER WINDOW wMain ACTIVATE WINDOW wMain RETURN NIL STATIC FUNCTION Test_WW0() //LOCAL cNam := hb_FNameName( hb_ProgName() ) LOCAL cNam := hb_ProgName() LOCAL cForm, y, x, w, h, n //cForm := WaitWindow( "... Запуск программы "+cNam+" ... ", .T., 700, 12, NIL, YELLOW, RED, .T., GREEN, 4 ) cForm := WaitWindow( "... Запуск программы "+cNam+" ... ", .T., 700, 12, NIL, YELLOW, RED, 20, GREEN, 4 ) //cForm := WaitWindow( "... Запуск программы "+cNam+" ... ", .T., 700, 12, NIL, YELLOW, RED, , BLACK, 1 ) InkeyGui(5 * 1000 ) WaitWindow( "!!!!!!!!!!!!!!!!!!!!;"+cNam, .T. ) InkeyGui(5 * 1000 ) SetProperty(cForm, "Message" , "Value", "@@@@@@@@@@@@@@@") InkeyGui(5 * 1000 ) WaitWindow() InkeyGui( 1000 ) RETURN Nil STATIC FUNCTION Test_WW() LOCAL cNam := hb_FNameName( hb_ProgName() ) LOCAL cForm, nSize := 16, aMsg, i, n, y, x, w, h, s LOCAL nW := GetDesktopWidth() * 0.95 // Первый тест - строка //nW := 0 aMsg := "... Запуск программы ...;"+hb_ProgName() //cForm := WaitWindow( aMsg, .T., nW, nSize, NIL, YELLOW, BLUE, .T., GREEN, 4 ) cForm := WaitWindow( aMsg, .T., nW, nSize, NIL, YELLOW, BLUE, 20, GREEN, 4 ) //cForm := WaitWindow( aMsg, .T., nW, nSize, NIL, YELLOW, BLUE, , BLACK, 1 ) InkeyGui(5 * 1000 ) WaitWindow( "!!!!!!!!!!!!!!!!!!!!", .T. ) InkeyGui(5 * 1000 ) SetProperty(cForm, "Message" , "Value", "@@@@@@@@@@@@@@@") InkeyGui(5 * 1000 ) WaitWindow() InkeyGui( 1000 ) // Второй тест - массив aMsg := {"... Запуск программы "+cNam+" ... ", ; "Тестируем массив в окне. Строка 1" , ; "Тестируем массив в окне. Строка 2" , ; "Тестируем массив в окне. Строка 3"} //cForm := WaitWindow( aMsg, .T., 700, nSize, NIL, YELLOW, RED, .T., BLUE , 4 ) cForm := WaitWindow( aMsg, .T., 700, nSize, NIL, YELLOW, RED, 20, BLUE , 4 ) //cForm := WaitWindow( aMsg, .T., 700, nSize, NIL, YELLOW, RED, , BLACK, 1 ) SET WINDOW THIS TO cForm h := 5 n := 10 This.Message.FontColor := BLUE This.Message.FontBold := .T. This.Message3.Hide s := Int( (This.Message2.Height - h )/2 ) y := This.Message2.Row + This.Message2.Height + s x := This.Message2.Col w := This.Message2.Width s := This.Message4.Value @ y, x PROGRESSBAR Progress OF &(cForm) RANGE 0, n WIDTH w HEIGHT h FOR i := 1 TO n This.Message4.Value := cValToChar( This.Progress.Value ) This.Progress.Value := This.Progress.Value + 1 IF InkeyGui(1 * 1000 ) == VK_ESCAPE EXIT ENDIF NEXT IF i != n This.Progress.Value := n ENDIF This.Message4.Value := n InkeyGui(1 * 1000 ) This.Progress.Hide This.Message3.Show This.Message4.Value := s InkeyGui(3 * 1000 ) WaitWindow( {upper("... Запуск программы "+cNam+" ... "), ; "Замена строки 1 в окне. ****** 1 *" , ; "Замена строки 2 в окне. ###### 2 #" , ; "Замена строки 3 в окне. $$$$$$ 3 $"}, .T. ) InkeyGui(5 * 1000 ) WaitWindow("@@@@@@@@@@@@@@@@@@@@;********************;####################", .T.) This.Message .Value := "@..................@" This.Message2.Value := "*..................*" This.Message3.Value := "#..................#" This.Message4.Value := "$..................$" SET WINDOW THIS TO InkeyGui(5 * 1000 ) WaitWindow() InkeyGui( 1000 ) RETURN Nil [/pre2]

SergKis: Не знаю, актуально или уже нет, WaitWindow(...) такая вышла [pre2] *----------------------------------------------------------------------------------------------* FUNCTION WaitWindow ( cMessage, lNoWait, nWidth, nSize, cFont, aFontColor, aBackColor, lNoCapt, aPenColor, nPen ) *----------------------------------------------------------------------------------------------* LOCAL cFormName := "_HMG_CHILDWAITWINDOW" LOCAL lDefined := _IsWindowDefined( cFormName ) LOCAL lIsModal LOCAL lWidth := ( nWidth == NIL ) LOCAL nHeight LOCAL nY, nX, nW, nH, nI, nK LOCAL hFont, cTmp, nTmp, cLbl, nPos := 0 IF PCount() == 0 IF lDefined nCtEfeito := 0 cDescEfeito := "" DoMethod ( cFormName, "Release" ) ENDIF ELSE hb_default( @lNoWait, .F. ) hb_default( @cFont, _HMG_DefaultFontName ) IF HB_ISCHAR( cMessage ) IF CRLF $ cMessage cMessage := hb_ATokens( cMessage, CRLF ) ELSEIF ";" $ cMessage cMessage := hb_ATokens( cMessage, ";" ) ELSE cMessage := { cMessage } ENDIF ELSEIF ! HB_ISARRAY( cMessage ) cMessage := { cMessage } ENDIF nK := Len( cMessage ) IF lDefined IF lNoWait FOR nI := 1 TO nK cLbl := "Message" + iif( nI > 1, hb_ntos( nI ), "" ) IF _IsControlDefined( cLbl, cFormName ) SetProperty( cFormName, cLbl, "Value", cValToChar( cMessage[ nI ] ) ) ENDIF NEXT ENDIF ELSE IF HB_ISLOGICAL( lNoCapt ) nPos := iif( lNoCapt, 10, nPos ) ELSEIF HB_ISNUMERIC( lNoCapt ) nPos := iif( lNoCapt > 0, lNoCapt, nPos ) ENDIF lNoCapt := !Empty( nPos ) lIsModal := _HMG_IsModalActive nTmp := 1 cTmp := cMessage[ nTmp ] FOR nI := 1 TO nK nTmp := iif( Len( cValToChar( cMessage[ nI ] ) ) > Len( cTmp ), nI, nTmp ) NEXT cTmp := cValToChar( cMessage[ nTmp ] ) DEFAULT nSize := 10 nY := iif( IsVistaOrLater(), 4, 7 ) + nPos nX := 12 hFont := InitFont( cFont, nSize ) nHeight := GetTextHeight ( NIL, "A", hFont ) IF lWidth nWidth := GetTextWidth( NIL, cTmp, hFont ) + nX * 2 nWidth := Min( 2 * nWidth, 800 ) ELSEIF Empty( nWidth ) .or. nWidth < 0 nWidth := GetTextWidth( NIL, cTmp+Replicate("A", 5), hFont ) + nX * 2 ENDIF DeleteObject( hFont ) nHeight += 8 nW := Min( GetDesktopRealWidth(), nWidth ) nH := nHeight * nK + nY * 2 IF lNoWait _HMG_IsModalActive := .F. IF lNoCapt DEFINE WINDOW _HMG_CHILDWAITWINDOW CHILD CLIENTAREA nW, nH NOSIZE NOSYSMENU NOCAPTION ELSE nH -= GetTitleHeight() DEFINE WINDOW _HMG_CHILDWAITWINDOW CHILD CLIENTAREA nW, nH ENDIF ELSE IF lNoCapt DEFINE WINDOW _HMG_CHILDWAITWINDOW MODAL CLIENTAREA nW, nH NOSIZE NOSYSMENU NOCAPTION ELSE nH -= GetTitleHeight() DEFINE WINDOW _HMG_CHILDWAITWINDOW MODAL CLIENTAREA nW, nH ENDIF ENDIF SetProperty( cFormName, "Title", "" ) SetProperty( cFormName, "TitleBar", .F. ) SetProperty( cFormName, "SysMenu", .F. ) IF HB_ISARRAY( aBackColor ) SetProperty( cFormName, "BackColor", aBackColor ) ELSEIF hb_osIsWin10() SetProperty( cFormName, "BackColor", nRGB2Arr( GetSysColor( COLOR_WINDOW ) ) ) ENDIF nW := GetProperty( cFormName, "ClientWidth" ) - nX * 2 FOR nI := 1 TO nK cLbl := "Message" + iif( nI > 1, hb_ntos( nI ), "" ) @ nY, nX LABEL &( cLbl ) WIDTH nW HEIGHT nHeight ; VALUE cValToChar( cMessage[ nI ] ) ; FONT cFont SIZE nSize ; FONTCOLOR aFontColor ; CENTERALIGN TRANSPARENT nY += nHeight NEXT IF HB_ISARRAY( aPenColor ) nPen := iif( Empty( nPen ), 2, nPen ) nI := nPen - 1 nY := nX := nI nH := ThisWindow.ClientHeight - nI nW := ThisWindow.ClientWidth - nI DrawRect( cFormName, nY, nX, nH, nW, aPenColor, nPen ) ENDIF IF lWidth .AND. GetProperty( cFormName, "Width" ) < 2 * nWidth SetProperty( cFormName, "Message", "Value", "" ) _DefineTimer( "Timer", cFormName, 100, {|| EfeitoLabel( cMessage[ 1 ] ) } ) ENDIF END WINDOW DoMethod ( cFormName, "Center" ) _ActivateWindow( { cFormName }, .T. ) _HMG_IsModalActive := lIsModal IF ! lNoWait InkeyGUI( 0 ) IF _IsControlDefined( "Timer", cFormName ) nCtEfeito := 0 cDescEfeito := "" ENDIF DoMethod ( cFormName, "Release" ) ENDIF ENDIF ENDIF DO EVENTS RETURN cFormName [/pre2]

Andrey: SergKis пишет: Не знаю, актуально или уже нет, WaitWindow(...) такая вышла Конечно актуально ! Классно получилось ! Григорий, ждем исправленную функцию в библиотеке.

полная версия страницы