Форум » 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

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(...) такая вышла Конечно актуально ! Классно получилось ! Григорий, ждем исправленную функцию в библиотеке.



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