:: Visual Foxpro, Foxpro for DOS
Ещё один вариант Messagebox()
lemenev

Сообщений: 229
Дата регистрации: 23.06.2022
Нашёл в Интернете ещё один вариант на замену функции Messagebox(). Новая функция написана на родном FoxPro (хотя и использует стандартные функции Windows), не требует дополнительных библиотек и позволяет настраивать заголовки кнопок диалогового окна и менять отображаемую иконку.

* Замена Messagebox
* vfpimaging.blogspot.com
lnOption = MsgboxEx(;
"Вы ввели неверный пароль 5 раз." + CHR (13) + CHR (13) + ;
"В целях безопасности вход в систему приостановлен.", ; && основное сообщение
0, ; && информация о значке по умолчанию
"Пароль неверен", ; && заголовок строки
"\&Повторить,&Выйти,&Нов. пароль", ; && новые названия кнопок
"41.ico") && файл значков
lnOption = MsgboxEx(;
"Произошла непредвиденная ошибка, необходимо перезагрузить систему." + ;
CHR (13) + CHR (13) + "Что ты хочешь сделать? Перезапустить ...", ;
"X", ;
"Пример MsgboxEx", ;
"&Сейчас,&Позже,&Никогда")
lnOption = MsgboxEx(;
"Не удалось найти файл Import.csv в выбранной папке.", ;
0, ;
"Файл не найден", ;
"&Прервать,\&Повторить,Нов. папка", ;
"17.ico")
PROCEDURE MsgboxEx
LPARAMETERS tcCaption, tnIcon, tcTitle, tcButtons, tcIconFile
* Описание: изменяет заголовки кнопок MessageBox
* Параметры:
* tcCaption - текст, который отображается в диалоговом окне.
* tnIcon - значок иконки: "X", "?", "!", "i"
* tcTitle - текст, который отображается в строке заголовка диалогового окна
* tcButtons - заголовки, которые будут использоваться в кнопках, с использованием
* разделителя запятая ","
* используйте символ "&" для определения горячих клавиш, которые будут
* использоваться, например: "option&1,option&2,option&3"
* используйте "\" для отключения кнопки
* tcIconFile - (необязательно) файл иконки для замены файла по умолчанию из messagebox()
* Возвращает: номер выбранной кнопки
* Пример:
* =MsgBoxEx("This is a common text", "!", "Window Title", "Option 1,Option 2,Option 3")
* Особая благодарность:
* Herman Tan - Article: 'Centering VFP MessageBox in any Form'
* hermantan.blogspot.com
* Craig boyd - Article: 'BindEvents on Steroids'
* www.sweetpotatosoftware.com
LOCAL loMsgB, lnOption
loMsgB = CREATEOBJECT("xmbMsgBoxEx")
=INKEY(.1)
lnOption = loMsgB.SendMessage(tcCaption, tnIcon, tcTitle, tcButtons, tcIconFile)
loMsgB = NULL
RETURN lnOption
DEFINE CLASS xmbMsgBoxEx AS CUSTOM
nButtonCnt = 0
cButtons = ""
nbutttype = 0
cIconFile = ""
hIcon = 0
PROCEDURE SendMessage
LPARAMETERS tcCaption, tnIcon, tcTitle, tcButtons, tcIconFile
IF VARTYPE(tntimeout) = "C" AND (PCOUNT() = 4)
tcButtons = tntimeout
tntimeout = 0
ENDIF
PRIVATE pnButtonCnt, pcButtons, pnbutttype, pcIconFile, phIcon
This.cIconFile = IIF(EMPTY(tcIconFile),"", tcIconFile)
This.nButtonCnt = GETWORDCOUNT(tcButtons, ",")
This.cButtons = tcButtons
*!* stop 16
*!* question 32
*!* exclamation 48
*!* info 64
IF (NOT EMPTY(m.tcIconFile)) OR INLIST(TRANSFORM(tnIcon), "X", "?", "!", "I")
IF VARTYPE(tnIcon) = "C"
tnIcon = UPPER(tnIcon)
DO CASE
CASE tnIcon = "X"
tnIcon = 16
CASE tnIcon = "?"
tnIcon = 32
CASE tnIcon = "!"
tnIcon = 48
CASE tnIcon = "I"
tnIcon = 64
OTHERWISE
tnIcon = 0
ENDCASE
ENDIF
ELSE
tnIcon = 0
ENDIF
* Проверить, будет ли показана иконка
* если был передан файл иконки, нам нужно убедиться, что messagebox()
* отобразит иконку, которая будет изменена в дальнейшем.
#DEFINE image_bitmap 0
#DEFINE image_Icon 1
#DEFINE lr_loadfromFile 0x0010
#DEFINE lr_defaultsize 0x0040
This.hIcon = 0
IF NOT EMPTY(This.cIconFile) AND ;
(NOT (BITTEST(tnIcon, 4) OR BITTEST(tnIcon, 5) OR BITTEST(tnIcon, 6)))
tnIcon = tnIcon + 16
This.hIcon = xmbLoadImage(0, FULLPATH(This.cIconFile), image_Icon,;
0,0, lr_loadfromFile + lr_defaultsize)
ENDIF
* это окно сообщения будет изменено перед показом
LOCAL lnoption, lnIndex
DO CASE
CASE This.nButtonCnt = 1
This.nbutttype = 0 && ok
CASE This.nButtonCnt = 2
This.nbutttype = 4 && yes / no
CASE This.nButtonCnt = 3
This.nbutttype = 2 && abort / retry / ignore
OTHERWISE
ENDCASE
BINDEVENT( 0, 0x06, THIS, 'WndProc' )
lnoption = MESSAGEBOX(tcCaption, tnIcon + This.nbutttype, tcTitle)
UNBINDEVENTS( 0, 0x06 )
LOCAL lnOffset
lnOffset = ICASE(This.nButtonCnt = 3, 2, This.nButtonCnt = 2, 5 , 0)
lnIndex = lnoption - lnOffset
IF This.hIcon <> 0
=xmbdeleteobject(This.hIcon) && очистить дескриптор иконки
ENDIF
RETURN lnIndex
ENDPROC
* Процедура обработчика событий Windows
* Функция обратного вызова MSDN WindowProc
* msdn.microsoft.com
* hermantan.blogspot.com
* Здесь мы внесем все изменения в диалоговое окно Windows.
PROCEDURE WndProc( th_Wnd, tn_Msg, t_wParam, t_lParam )
IF (tn_Msg == 0x06) AND (t_wParam == 0) AND (t_lParam <> 0)
wParam = t_lParam
#DEFINE dlg_ctrlid_Icon 0x0014
#DEFINE stm_setIcon 0x0170
#DEFINE stm_setimage 0x0172
IF NOT EMPTY(This.hIcon)
* изменение иконки диалога
LOCAL lhIconwindow
lhIconwindow = xmbGetDlgItem(wParam, dlg_ctrlid_Icon)
IF lhIconwindow <> 0
IF This.hIcon <> 0
=xmbSendMessage(lhIconwindow, stm_setIcon, This.hIcon, 0)
ENDIF
ENDIF
ENDIF
* Установим прозрачность
IF VARTYPE(_Screen.xmbMessageboxTransp) = "N"
LOCAL lnTransp
lnTransp = _Screen.xmbMessageboxTransp
* значения ниже 30 генерируют практически невидимый диалог!
IF lnTransp > 30 AND lnTransp < 255
lnTransp = MIN(INT(lnTransp), 254)
=xmbSetWindowLong( wParam, -20, ;
BITOR( xmbGetWindowLong( wParam, -20 ), 0x80000 ))
=xmbSetLayeredWindowAttributes( wParam, 0, lnTransp, 2 )
ENDIF
ENDIF
* изменим атрибуты кнопки
LOCAL N, lnOffset, lcCaption
lnOffset = ICASE(This.nButtonCnt = 3, 2, This.nButtonCnt = 2, 5 , 0)
LOCAL lnBtnhWnd
FOR N = 1 TO This.nButtonCnt
lcCaption = GETWORDNUM(This.cButtons, N, ",") + CHR(0)
* отключим текущую кнопку
IF LEFT(lcCaption, 1) = "\"
lcCaption = SUBSTR(lcCaption, 2) && получить остаток строки
lnBtnhWnd = xmbGetDlgItem(wParam, lnOffset + N)
=xmbEnableWindow(lnBtnhWnd, 0)
ENDIF
* изменим заголовок
=xmbSetDlgItemtext(wParam, lnOffset + N, lcCaption)
ENDFOR
ENDIF
LOCAL pOrgProc
pOrgProc = xmbGetWindowLong( _VFP.hWnd, -4 )
= xmbCallWindowProc( pOrgProc, th_Wnd, tn_Msg, t_wParam, t_lParam )
ENDPROC
ENDDEFINE
*********************************************************************
FUNCTION xmbSetDlgItemtext(hdlg, nidDlgItem, lpString)
*********************************************************************
DECLARE INTEGER SetDlgItemText IN user32 AS xmbsetDlgItemtext ;
LONG hdlg,;
LONG nidDlgItem,;
STRING lpString
RETURN xmbSetDlgItemtext(hdlg, nidDlgItem, lpString)
ENDFUNC
*********************************************************************
FUNCTION xmbCallNextHookEx(hhook, ncode, wParam, LParam)
*********************************************************************
DECLARE LONG callnexthookex IN user32 AS xmbcallnexthookex ;
LONG hhook, LONG ncode, LONG wParam, LONG LParam
RETURN xmbcallnexthookex(hhook, ncode, wParam, LParam)
ENDFUNC
*********************************************************************
FUNCTION xmbGetDlgItem(hdlg, nidDlgItem)
*********************************************************************
* hdlg - дескриптор диалогового окна, содержащего элемент управления.
* nidDlgItem - идентификатор элемента управления, который необходимо извлечь
* msdn.microsoft.com
DECLARE INTEGER GetDlgItem IN user32 AS xmbgetDlgItem ;
LONG hdlg,;
LONG nidDlgItem
RETURN xmbGetDlgItem(hdlg, nidDlgItem)
ENDFUNC
*********************************************************************
FUNCTION xmbEnableWindow(hWnd, fEnable)
*********************************************************************
DECLARE INTEGER EnableWindow IN user32 AS xmbEnablewindow;
INTEGER hWnd, INTEGER fEnable
RETURN xmbEnableWindow(hWnd, fEnable)
ENDFUNC
*********************************************************************
FUNCTION xmbSendMessage(hwindow, msg, wParam, LParam)
*********************************************************************
* msdn.microsoft.com
* www.news2news.com
DECLARE INTEGER SendMessage IN user32 AS xmbsendmessage;
INTEGER hwindow, INTEGER msg,;
INTEGER wParam, INTEGER LParam
RETURN xmbSendMessage(hwindow, msg, wParam, LParam)
ENDFUNC
*********************************************************************
FUNCTION xmbLoadImage(hinst, lpszname, utype, cxdesired, cydesired, fuload)
*********************************************************************
DECLARE INTEGER LoadImage IN user32 AS xmbloadimage;
INTEGER hinst,;
STRING lpszname,;
INTEGER utype,;
INTEGER cxdesired,;
INTEGER cydesired,;
INTEGER fuload
RETURN xmbLoadImage(hinst, lpszname, uType, cxdesired, cydesired, fuload)
ENDFUNC
*********************************************************************
FUNCTION xmbDeleteObject(hobject)
*********************************************************************
DECLARE INTEGER DeleteObject IN gdi32 AS xmbdeleteobject INTEGER hobject
RETURN xmbdeleteobject(hobject)
ENDFUNC
*********************************************************************
FUNCTION xmbCallWindowProc(lpPrevWndFunc, nhWnd, uMsg, wParam, LParam)
*********************************************************************
DECLARE LONG CallWindowProc IN User32 ;
AS xmbCallWindowProc ;
LONG lpPrevWndFunc, LONG nhWnd, ;
LONG uMsg, LONG wParam, LONG LParam
RETURN xmbCallWindowProc(lpPrevWndFunc, nhWnd, uMsg, wParam, LParam)
ENDFUNC
*********************************************************************
FUNCTION xmbGetWindowLong(nhWnd, nIndex)
*********************************************************************
DECLARE LONG GetWindowLong IN User32 ;
AS xmbGetWindowLong ;
LONG nhWnd, INTEGER nIndex
RETURN xmbGetWindowLong(nhWnd, nIndex)
ENDFUNC
*********************************************************************
FUNCTION xmbSetWindowLong(nHWnd, nIndex, nNewVal)
*********************************************************************
DECLARE INTEGER SetWindowLong In Win32Api ;
AS xmbSetWindowLong ;
INTEGER nHWnd, INTEGER nIndex, INTEGER nNewVal
RETURN xmbSetWindowLong(nHWnd, nIndex, nNewVal)
ENDFUNC
*********************************************************************
FUNCTION xmbSetLayeredWindowAttributes(nHWnd, cColorKey, nOpacity, nFlags)
*********************************************************************
DECLARE INTEGER SetLayeredWindowAttributes In Win32Api ;
AS xmbSetLayeredWindowAttributes ;
INTEGER nHWnd, STRING cColorKey, ;
INTEGER nOpacity, INTEGER nFlags
RETURN xmbSetLayeredWindowAttributes(nHWnd, cColorKey, nOpacity, nFlags)
ENDFUNC
Ratings: 0 negative/0 positive
Re: Ещё один вариант Messagebox()
_vit

Сообщений: 5243
Дата регистрации: 29.07.2002
Зачем столько срок кода и десяток вызовов WinAPI вместо одного?

DECLARE INTEGER MessageBoxA IN user32.dll INTEGER hWnd, STRING lpText, STRING lpCaption, INTEGER uType
LOCAL lnRetval
lnRetval = MessageBoxA(0, "Hello, World!", "Greetings", 0x00000041)
? lnRetval
RETURN
Ratings: 0 negative/0 positive
Re: Ещё один вариант Messagebox()
lemenev

Сообщений: 229
Дата регистрации: 23.06.2022
_vit
Зачем столько срок кода и десяток вызовов WinAPI вместо одного?

Чтобы поменять надписи на кнопках.
Чтобы заблокировать кнопку.
Чтобы поменять иконку.
Ratings: 0 negative/0 positive
Re: Ещё один вариант Messagebox()
Евгений Банщиков

Сообщений: 235
Откуда: Kurgan
Дата регистрации: 09.04.2004
lemenev
_vit
Зачем столько срок кода и десяток вызовов WinAPI вместо одного?

Чтобы поменять надписи на кнопках.
Чтобы заблокировать кнопку.
Чтобы поменять иконку.
Хорошая замена , только у нее есть один недостаток - нельзя задать параметр TimeOut. Это сразу делает ее непригодной для многопользовательских приложений. У Herman Tan в блоге есть аналог , в котором есть timeout .
hermantan.blogspot.com
Вот только он не реализовал в нем возможность задания иконки. Если скрестить оба примера , то получим рабочий вариант
Local lo_MsgBox
lo_MsgBox = Createobject( 'cls_MessageBox' )
lo_MsgBox.nButtonMain=2
?lo_MsgBox.ShowMsg( 'Test MessageBox','x', 'MessageBox Title' )
lo_MsgBox.Clear_Buttons()
lo_MsgBox.cButtons = '&Good'
?lo_MsgBox.ShowMsg( 'Test MessageBox','i', 'MessageBox Title' )
lo_MsgBox.lTransparent = .T. && transparent MessageBox
lo_MsgBox.nTransValue = 75 && % transparent
lo_MsgBox.Clear_Buttons()
lo_MsgBox.cButtons = '&Good,&Bad,&Worst'
?lo_MsgBox.ShowMsg( 'Test MessageBox', '?', 'MessageBox Title' )
lo_MsgBox.cButtons = "Restart &Now,Restart &later,&Never restart"
?lo_MsgBox.ShowMsg( 'Test MessageBox With Timer (5sec)',"!", 'MessageBox Title', 5000 )
lo_MsgBox.Clear_Buttons()
lo_MsgBox.cIconFile=Home()+'Graphics\Icons\Office\GRAPH07.ico'
lo_MsgBox.cButtons = "Да,Нет"
?lo_MsgBox.ShowMsg( 'Test MessageBox with TimeOut (5sec)',, 'MessageBox Title', 5000 )
lo_MsgBox = Null
Release lo_MsgBox
*************************
* собрано на базе примеров от
* vfpimaging.blogspot.com
* и Herman Tan's Blog
* hermantan.blogspot.com
Define Class cls_MessageBox As Custom
*************************
#Define WM_TIMER 0x0113
#Define IDT_TIMER 1
nButtonMain=1
cButtons = ""
cIconFile=""
lTransparent = .F.
nTimeout = 0
nTransValue = 100 && in percentage, 100% = opaque
lChangeButton = .F.
HWnd = 0
hWnd_MsgBox = 0
hIcon =0
pOrgProc = 0
lTimeout = .F.
Dimension aButtons[3] = .F.
nButtonCnt=1
*==============
Procedure Clear_Buttons
*================
With This
.aButtons = .F.
.cButtons = ""
.lChangeButton = .F.
Endwith
*==============
Procedure Init
*================
Declare Integer DeleteObject In gdi32 As xmbdeleteobject Integer hobject
Declare Integer GetDlgItem In user32 As xmbgetDlgItem Long hdlg, Long nidDlgItem
Declare Integer LoadImage In user32 As xmbloadimage;
INTEGER hinst,;
STRING lpszname,;
INTEGER utype,;
INTEGER cxdesired,;
INTEGER cydesired,;
INTEGER fuload
Declare Long SetLayeredWindowAttributes In User32 ;
Long nhWnd, Long crKey, Short bAlpha, Long dwFlags
Declare Long GetDesktopWindow In User32
Declare Long GetWindowLong In User32 ;
Long nhWnd, Integer nIndex
Declare Long SetWindowLong In User32 ;
Long nhWnd, Integer nIndex, Long dwNewLong
Declare Long GetWindowRect In User32 ;
Long nhWnd, String @O_lpRect
Declare Long SetWindowPos In User32 ;
Long nhWnd, Long hWndInsertAfter, ;
Integer nX, Integer nY, Integer nWidth, Integer nHeight, Long nFlags
Declare Long CallWindowProc In User32 ;
Long lpPrevWndFunc, Long nhWnd, ;
Long uMsg, Long wParam, Long Lparam
Declare Long FindWindowEx In User32 ;
Long hWndParent, Long hWndChildAfter, ;
String lpszClass, String lpszWindow
Declare Long SendMessage In User32 As SendMessageStr ;
Long nhWnd, Long uMsg, Long wParam, String @Lparam
Declare Long SetTimer In User32 ;
Long nhWnd, Long nEventId, Long uElapse, Long lpTimerFunc
Declare Long KillTimer In User32 Long nhWnd, Long nEventId
This.HWnd = Iif( (Vartype( th_Wnd )== 'N'), ;
iif( th_Wnd != 0, th_Wnd, GetDesktopWindow() ), _vfp.HWnd )
This.pOrgProc = GetWindowLong( _vfp.HWnd, -4 )
*================
Procedure ShowMsg( tc_Msg, tn_Type, tc_Title, tn_Timeout )
*================
Local ln_Return,m.nIndex
#Define image_bitmap 0
#Define image_Icon 1
#Define lr_loadfromFile 0x0010
#Define lr_defaultsize 0x0040
This.hIcon = 0
This.nButtonCnt=1
If !Empty(This.cButtons)
This.lChangeButton=.t.
This.nButtonCnt=Getwordcount(This.cButtons, ",")
For m.nIndex=1 To This.nButtonCnt
This.aButtons[m.nIndex] =Getwordnum(This.cButtons,m.nIndex,',')
Endfor
Endif
*!* stop 16
*!* question 32
*!* exclamation 48
*!* info 64
If Empty(This.cIconFile)
If Vartype(tn_Type)='C'
tn_Type = Upper(tn_Type)
If Inlist(Transform(tn_Type), "X", "?", "!", "I")
Do Case
Case tn_Type = "X"
tn_Type = 16
Case tn_Type = "?"
tn_Type = 32
Case tn_Type = "!"
tn_Type = 48
Case tn_Type = "I"
tn_Type = 64
Otherwise
tn_Type = 0
Endcase
Endif
Endif
Else
tn_Type = 16
This.hIcon = xmbloadimage(0, This.cIconFile, image_Icon, 0,0, lr_loadfromFile + lr_defaultsize)
Endif
Do Case
Case This.nButtonMain=2
tn_Type = tn_Type + 256
Case This.nButtonMain=3
tn_Type = tn_Type + 512
Endcase
Do Case
Case This.nButtonCnt = 2
tn_Type=tn_Type+ 4
Case This.nButtonCnt = 3
tn_Type=tn_Type+ 2
Endcase
If (Vartype( tn_Timeout ) == 'N')
This.nTimeout = Iif( tn_Timeout < 1000, 1000, tn_Timeout )
Endif
Bindevent( 0, 0x06, This, 'WndProc' )
If (Vartype( tc_Title ) == 'C')
ln_Return = Messagebox( tc_Msg, tn_Type, tc_Title )
Else
ln_Return = Messagebox( tc_Msg, tn_Type )
Endif
Unbindevents( 0, 0x06 )
If This.hIcon <> 0
=xmbdeleteobject(This.hIcon) && clear Icon handle
Endif
If (This.nTimeout > 0)
If ( This.lTimeout )
ln_Return = -1
KillTimer( This.hWnd_MsgBox, IDT_TIMER )
Unbindevents( This.hWnd_MsgBox, IDT_TIMER )
Else
KillTimer( This.HWnd, IDT_TIMER )
Unbindevents( This.HWnd, IDT_TIMER )
Endif
Endif
Store 0 To This.nTimeout, This.hWnd_MsgBox
This.lTimeout = .F.
Return ln_Return
*================
Procedure CenterWindow( th_WndParent, th_WndChild )
*================
Local ls_Rect
ls_Rect = Space( 16 )
** Get container area (parent)
GetWindowRect( th_WndParent, @ls_Rect )
ln_TargetLeft = CToBin( Substr( ls_Rect, 1, 4 ), '4rs' )
ln_TargetTop = CToBin( Substr( ls_Rect, 5, 4 ), '4rs' )
ln_Right = CToBin( Substr( ls_Rect, 9, 4 ), '4rs' ) + 1
ln_Bottom = CToBin( Substr( ls_Rect, 13, 4 ), '4rs' ) + 1
ln_Width = ln_Right - ln_TargetLeft
ln_Height = ln_Bottom - ln_TargetTop
** Get contained area (child)
GetWindowRect( th_WndChild, @ls_Rect )
ln_Left = CToBin( Substr( ls_Rect, 1, 4 ), '4rs' )
ln_Top = CToBin( Substr( ls_Rect, 5, 4 ), '4rs' )
ln_Right = CToBin( Substr( ls_Rect, 9, 4 ), '4rs' ) + 1
ln_Bottom = CToBin( Substr( ls_Rect, 13, 4 ), '4rs' ) + 1
** Get Left & Top position (XY coordinate)
ln_Left = ((ln_Width - (ln_Right - ln_Left)) / 2) + ln_TargetLeft
ln_Top = (ln_Height - (ln_Bottom - ln_Top)) / 2 + ln_TargetTop
SetWindowPos( th_WndChild, 0, ln_Left,ln_Top, 0,0, Bitor( 0x1, 0x10, 0x400 ))
*================
Procedure WndProc( th_Wnd, tn_Msg, t_wParam, t_lParam )
*================
If (tn_Msg == 0x06) And (t_wParam == 0)
#Define dlg_ctrlid_Icon 0x0014
#Define stm_setIcon 0x0170
#Define stm_setimage 0x0172
If Not Empty(This.hIcon)
* changing the dialog Icon
Local lhIconwindow
lhIconwindow = xmbgetDlgItem(t_lParam, dlg_ctrlid_Icon)
If lhIconwindow <> 0
If This.hIcon <> 0
=SendMessageStr(lhIconwindow, stm_setIcon, This.hIcon, 0)
Endif
Endif
Endif
Local ln_X, lh_Wnd, lh_WndChild, ln_OldStyle, ln_Transparent
If (This.nTimeout > 0)
This.hWnd_MsgBox = t_lParam
Bindevent( th_Wnd, WM_TIMER, This, 'TimerProc' )
SetTimer( th_Wnd, IDT_TIMER, This.nTimeout-60, 0 )
This.nTimeout = 200
Endif
With This
.CenterWindow( .HWnd, t_lParam )
If ( .lChangeButton )
lh_WndChild = 0
For ln_X = 1 To 3
lh_WndChild = FindWindowEx( t_lParam, lh_WndChild, 'Button', 0 )
If (lh_WndChild == 0)
ln_X = 4
Else
If !Empty( .aButtons[ ln_X ] )
SendMessageStr( lh_WndChild, 0x0C, 0, .aButtons[ ln_X ] )
Endif
Endif
Next
Endif
If .lTransparent And .nTransValue > 0 And .nTransValue<100
ln_Transparent = Int((255 * .nTransValue) / 100)
SetWindowLong( t_lParam, -20, ;
BitOr( GetWindowLong( t_lParam, -20 ), 0x80000 ))
SetLayeredWindowAttributes( t_lParam, 0, ln_Transparent, 2 )
Endif
Endwith
Return 0
Endif
Return CallWindowProc( This.pOrgProc, th_Wnd, tn_Msg, t_wParam, t_lParam )
*================
Procedure TimerProc( th_Wnd, tn_Msg, t_wParam, t_lParam )
*================
KillTimer( th_Wnd, IDT_TIMER)
Unbindevents( th_Wnd, IDT_TIMER )
SetTimer( This.hWnd_MsgBox, IDT_TIMER, This.nTimeout, 0 )
This.lTimeout = .T.
Return 0
Enddefine
Ratings: 0 negative/0 positive
Re: Ещё один вариант Messagebox()
Каратаев

Сообщений: 4049
Откуда: Алматы
Дата регистрации: 04.12.2001
В решениях есть такое. Там и кнопки свои, и картинка, и таймаут...
foxclub.ru


------------------
Никогда не бывает настолько плохо, чтобы не могло быть еще хуже.
Ratings: 0 negative/0 positive
Re: Ещё один вариант Messagebox()
lemenev

Сообщений: 229
Дата регистрации: 23.06.2022
Евгений Банщиков
получим рабочий вариант

Хорошее развитие идеи!

Уже набирается несколько разных вариантов.

Самый богатый по возможностям дизайна – FoxyDialog ( foxclub.ru ).

Но только представленный в решениях от Тарасова ( foxclub.ru ) позволяет выделение любых частей сообщения цветом и/или шрифтом. Последнее для меня наиболее важно, т.к. стандартный MS Sans Serif, 8 для меня слишком мелок, особенно на мониторах с большим разрешением. А тут и шрифт по умолчанию крупнее, и его можно ещё увеличить.

В варианте от Тарасова можно отдельные части сообщения (хоть отдельные буквы) красить в заранее фиксированные цвета. Я сделал простой пример визуализации этих цветов. Видно, что не все они применимы.
Ratings: 0 negative/0 positive
Re: Ещё один вариант Messagebox()
BOBAN

Сообщений: 646
Откуда: Солигорск
Дата регистрации: 05.07.2004
Я тоже когда-то экспериментировал с этим решением
forum.foxclub.ru
Ratings: 0 negative/0 positive
Re: Ещё один вариант Messagebox()
lemenev

Сообщений: 229
Дата регистрации: 23.06.2022
Нашёл на просторах Интернета упоминание ещё об одной интересной разработке: Extended MessageBox Library (FLL) for Visual FoxPro. Но у меня есть только справка по ней. Есть ли у кого сама библиотека xmsg.fll? Сайт с которого предлагается скачать прекратил своё существование и выставлен на продажу.
Ratings: 0 negative/0 positive
Re: Ещё один вариант Messagebox()
krin

Сообщений: 190
Дата регистрации: 08.02.2005
в свободном доступе видел только демо:



Исправлено 2 раз(а). Последнее : krin, 12.01.25 20:03
Ratings: 0 negative/0 positive
Re: Ещё один вариант Messagebox()
BOBAN

Сообщений: 646
Откуда: Солигорск
Дата регистрации: 05.07.2004
У меня пару нашлось. Не знаю насчет демо ли.

P.S. Вроде xmsg80.fll - не демо



Исправлено 1 раз(а). Последнее : BOBAN, 13.01.25 10:09
Ratings: 0 negative/0 positive
Re: Ещё один вариант Messagebox()
krin

Сообщений: 190
Дата регистрации: 08.02.2005
80 не демо.
по функциям
Ratings: 0 negative/0 positive
Re: Ещё один вариант Messagebox()
BOBAN

Сообщений: 646
Откуда: Солигорск
Дата регистрации: 05.07.2004
В демо-версии в выводимый текст добавляется название библиотеки.
Ratings: 0 negative/0 positive
Re: Ещё один вариант Messagebox()
BOBAN

Сообщений: 646
Откуда: Солигорск
Дата регистрации: 05.07.2004
Вроде надстройка для него
Ratings: 0 negative/0 positive
Re: Ещё один вариант Messagebox()
of63
Автор

Сообщений: 26001
Откуда: Н.Новгород
Дата регистрации: 13.02.2008
> Нашёл в Интернете ещё один вариант на замену функции Messagebox(). Новая функция написана на родном FoxPro (хотя и использует стандартные функции Windows), не требует дополнительных библиотек и позволяет настраивать заголовки кнопок диалогового окна и менять отображаемую иконку.

И это всё?

Доб вобще-то потребуется возврат:
- да-нет
- выбор одного элемента из списка
- выбор группы элементов из списка элементов
- показ в каждом из элементов списка "желтого" экранчика с обьяснением выбираемого пункта
- выбор даты
- выбор диапазона дат
- выбор ...

И этот большой код делает что? Только замену Messagebox() ? (((



Исправлено 1 раз(а). Последнее : of63, 13.01.25 23:21
Ratings: 0 negative/0 positive
Re: Ещё один вариант Messagebox()
lemenev

Сообщений: 229
Дата регистрации: 23.06.2022
BOBAN
У меня пару нашлось. Не знаю насчет демо ли.
Спасибо за библиотеку. И главное – с днём рождения!

Библиотека xmsg71.fll действительно демонстрационная. Она понимает все функции, но в части из них стоят заглушки – они не дают никакого эффекта. Библиотека не добавляет своё название в выводимый текст.

Библиотека xmsg80.fll рабочая. Но в ней отсутствует функция mxg_EnableUDFButtonFonts().
Поменять характеристики шрифта на кнопках можно и без неё. Не удаётся махом вернуть начальные установки. Но это мелочь.

Я перевёл описание к библиотеке – смотрите в приложении.
Ratings: 0 negative/0 positive
Re: Ещё один вариант Messagebox()
lemenev

Сообщений: 229
Дата регистрации: 23.06.2022
of63
И это всё?

А хочется, чтобы она готовила, стирала и гладила? Написано же: «вариант на замену функции Messagebox()»

of63
Доб вобще-то потребуется возврат:
- да-нет

Такое делают все аналоги Messagebox().

of63
- выбор одного элемента из списка
- выбор группы элементов из списка элементов

Такого не делает никто, так как слишком много вариантов представления списка – ComboBox, ListBox, Grid и т.д., а так же слишком много вариантов формирования списка.

of63
- показ в каждом из элементов списка "желтого" экранчика с обьяснением выбираемого пункта

Такое делает xMsg

of63
- выбор даты
- выбор диапазона дат

Такое делает FoxyDialog
Ratings: 0 negative/1 positive
Re: Ещё один вариант Messagebox()
Taran

Сообщений: 13872
Откуда: Красноярск
Дата регистрации: 16.01.2008
Категорически согласен.
Мы либо делаем msg с максимум 3-4 параметра, легко усвояемых.
Либо
loForm=neobj(
With loForm as...
.addPeriod(
.addDate(
.add...
. Show

Т.е. без интеллисенце не уедешь.
Ratings: 0 negative/0 positive
Re: Ещё один вариант Messagebox()
Taran

Сообщений: 13872
Откуда: Красноярск
Дата регистрации: 16.01.2008
Ну и да. Решение Тарасова достойно внимания.
Именно как msg. Возможность выделить текст и расставить акценты.
Ratings: 0 negative/0 positive
Re: Ещё один вариант Messagebox()
BOBAN

Сообщений: 646
Откуда: Солигорск
Дата регистрации: 05.07.2004
lemenev
Библиотека xmsg71.fll действительно демонстрационная.

Порылся ещё в закромах. Походу эта не демо.
Ratings: 0 negative/0 positive
Re: Ещё один вариант Messagebox()
of63
Автор

Сообщений: 26001
Откуда: Н.Новгород
Дата регистрации: 13.02.2008
lemenev
_vit
Зачем столько срок кода и десяток вызовов WinAPI вместо одного?

Чтобы поменять надписи на кнопках.
Чтобы заблокировать кнопку.
Чтобы поменять иконку.

Это ответ и Виту - Миша Леменев реализовал же, значит молодец.
() Только экранное место экрана кода не занимай, прячь его в спойлер. Просто будет приятнее общаться с твоим контентом
Ratings: 0 negative/0 positive


Извините, только зарегистрированные пользователи могут оставлять сообщения в этом форуме.

On-line: 15 (Гостей: 15)

© 2000-2025 Fox Club 
Яндекс.Метрика