VFP 愛用者社區

CPS0204 · 註冊時間: 2014-08-24 文章: 524 第 1 樓

如圖

例如: =my_msgbox("成品入庫單存檔成功！成品入庫單存檔成功！成品入庫單存檔成功！成品入庫單存檔成功！",32+4, "系統提示")

LOCAL lnAns
lnAns = my_msgbox("是否要刪除此筆資料？", 32 + 4, "確認刪除")

* 🚀 這次點「是」，lnAns 100% 被變數定錨為數字 6！
* 🚀 這次點「否」，lnAns 100% 被變數定錨為數字 7！
DO CASE
CASE lnAns = 6
WAIT WINDOW "您按了【是】(6)！" NOWAIT
CASE lnAns = 7
WAIT WINDOW "您按了【否】(7)！" NOWAIT
OTHERWISE
WAIT WINDOW "返回值：" + STR(lnAns) NOWAIT
ENDCASE

**************************************************
*====================================================================
* 🚀 XX實業 ERP 專用 - 大字體完全體對話框 (全局變數剛性對齊版)
*====================================================================
FUNCTION my_msgbox
LPARAMETERS tcMessage, tnType, tcTitle

* 🎯 1. 剛性聲明全局避震變數，初始值給 0
PUBLIC _gnMsgResult
_gnMsgResult = 0

IF EMPTY(tnType)
tnType = 0
ENDIF
IF EMPTY(tcTitle)
tcTitle = [系統提示]
ENDIF

LOCAL loMsgForm, lnReturn

* 🚀 2. 擊發表單
loMsgForm = CREATEOBJECT("BigMsgFormComplete", tcMessage, tnType, tcTitle)
loMsgForm.Show(1) && 這裡會卡住，直到表單 Release

* 🚀 3. 表單死後，全局變數依然存活！利落把數值接回來
lnReturn = _gnMsgResult

* 🚀 4. 收兵過河，物理過濾並銷毀全局變數，不留垃圾在記憶體
RELEASE _gnMsgResult
RELEASE loMsgForm

RETURN lnReturn
ENDFUNC

* 🧠 核心：大字體完全體對話框類別宣告
DEFINE CLASS BigMsgFormComplete AS Form
Caption = ""
Width = 560
Height = 240
AutoCenter = .T.
BorderStyle = 3
MaxButton = .F.
MinButton = .F.
WindowType = 1
FontName = "Microsoft JhengHei"
FontSize = 16

* 按鈕對齊數值記錄
nBtn1Value = 0
nBtn2Value = 0

ADD OBJECT imgIcon AS Image WITH Left = 30, Top = 45, Width = 48, Height = 48, Visible = .F.
ADD OBJECT lblMessage AS Label WITH Left = 95, Top = 45, Width = 430, Height = 100, ;
FontName = "Microsoft JhengHei", FontSize = 16, FontBold = .T., WordWrap = .T., Caption = ""

ADD OBJECT btn1 AS CommandButton WITH Left = 160, Top = 165, Width = 110, Height = 40, FontName = "Microsoft JhengHei", FontSize = 14, Visible = .F.
ADD OBJECT btn2 AS CommandButton WITH Left = 290, Top = 165, Width = 110, Height = 40, FontName = "Microsoft JhengHei", FontSize = 14, Visible = .F.

PROCEDURE Init
LPARAMETERS tcMessage, tnType, tcTitle
LOCAL lnButtons, lnIcon

This.Caption = tcTitle
This.lblMessage.Caption = tcMessage

lnButtons = BITAND(tnType, 0x000F)
lnIcon = BITAND(tnType, 0x00F0)

IF !This.imgIcon.Visible
This.lblMessage.Left = 40
This.lblMessage.Width = 480
ENDIF

* 🎨 動態配置按鈕與「直接寫入類別的數值屬性」
DO CASE
CASE lnButtons = 0 && 只有一個 [確定]
This.btn2.Left = 225
This.btn2.Caption = "確定"
This.nBtn2Value = 1 && 1 = IDOK
This.btn2.Visible = .T.
This.btn2.Default = .T.

CASE lnButtons = 1 && [確定] [取消]
This.btn1.Left = 160
This.btn1.Caption = "確定"
This.nBtn1Value = 1 && 1 = IDOK
This.btn1.Visible = .T.
This.btn1.Default = .T.

This.btn2.Left = 290
This.btn2.Caption = "取消"
This.nBtn2Value = 2 && 2 = IDCANCEL
This.btn2.Visible = .T.

CASE lnButtons = 4 && [是(Y)] [否(N)]
This.btn1.Left = 160
This.btn1.Caption = "是 (Y)"
This.nBtn1Value = 6 && 6 = IDYES
This.btn1.Visible = .T.
This.btn1.Default = .T.

This.btn2.Left = 290
This.btn2.Caption = "否 (N)"
This.nBtn2Value = 7 && 7 = IDNO
This.btn2.Visible = .T.
ENDCASE
ENDPROC

* 🚀 按鈕點擊：越過表單，直接把純數字焊進外部的全局變數！
PROCEDURE btn1.Click
_gnMsgResult = ThisForm.nBtn1Value
ThisForm.Release
ENDPROC

PROCEDURE btn2.Click
_gnMsgResult = ThisForm.nBtn2Value
ThisForm.Release
ENDPROC
ENDDEFINE

CPS0204 · 註冊時間: 2014-08-24 文章: 524 第 2 樓

如圖再來一個有加入CHECK 選項的

LOCAL lnAns
lnAns = my_message_CHECK("您確定要發動【XX實業】歷史呆滯料批次銷帳嗎？", 32 + 4, "核心過帳防呆")

IF lnAns = 6
WAIT WINDOW "【防呆解鎖成功】開始執行 VFOXPRO 後台鋼鐵計算！"
ELSE
WAIT WINDOW "操作已安全取消。"
ENDIF
*************************************
FUNCTION my_message_CHECK
LPARAMETERS tcMessage, tnType, tcTitle

* ?? 1. 全局變數剛性定錨
PUBLIC _gnMsgResult
_gnMsgResult = 0

IF EMPTY(tnType)
tnType = 0
ENDIF
IF EMPTY(tcTitle)
tcTitle = [安全確認提示]
ENDIF

LOCAL loMsgForm, lnReturn

* ?? 2. 擊發防呆表單
loMsgForm = CREATEOBJECT("BigMsgFormAntiMistake", tcMessage, tnType, tcTitle)
loMsgForm.Show(1)

* ?? 3. 接回純數字返回值 (1=確定, 2=取消, 6=是, 7=否)
lnReturn = _gnMsgResult

* ?? 4. 清理戰場
RELEASE _gnMsgResult
RELEASE loMsgForm

RETURN lnReturn
ENDFUNC

* ?? 核心：雙重防呆大字體表單類別宣告
DEFINE CLASS BigMsgFormAntiMistake AS Form
Caption = ""
Width = 580
Height = 280 && ?? 稍微拉高，留空間給 CheckBox
AutoCenter = .T.
BorderStyle = 3
MaxButton = .F.
MinButton = .F.
WindowType = 1
FontName = "Microsoft JhengHei"
FontSize = 16

nBtn1Value = 0
nBtn2Value = 0

* 物件宣告：文字、核取方塊、按鈕
ADD OBJECT lblMessage AS Label WITH Left = 40, Top = 35, Width = 500, Height = 90, ;
FontName = "Microsoft JhengHei", FontSize = 16, FontBold = .T., WordWrap = .T., Caption = ""

* ?? 靈魂防呆控制項：CheckBox
ADD OBJECT chkConfirm AS CheckBox WITH Left = 40, Top = 145, Width = 200, Height = 30, ;
FontName = "Microsoft JhengHei", FontSize = 15, FontBold = .T., ;
Caption = "我已確認", Value = 0,FORECOLOR=RGB(255,0,0)

ADD OBJECT btn1 AS CommandButton WITH Left = 160, Top = 200, Width = 110, Height = 40, FontName = "Microsoft JhengHei", FontSize = 14, Visible = .F.
ADD OBJECT btn2 AS CommandButton WITH Left = 290, Top = 200, Width = 110, Height = 40, FontName = "Microsoft JhengHei", FontSize = 14, Visible = .F.

PROCEDURE Init
LPARAMETERS tcMessage, tnType, tcTitle
LOCAL lnButtons

This.Caption = tcTitle
This.lblMessage.Caption = tcMessage

lnButtons = BITAND(tnType, 0x000F)

* 動態分配按鈕數值
DO CASE
CASE lnButtons = 0 && 只有一個 [確定]
This.btn2.Left = 235
This.btn2.Caption = "確定"
This.nBtn2Value = 1
This.btn2.Visible = .T.
This.btn2.Default = .T.

CASE lnButtons = 1 && [確定] [取消]
This.btn1.Left = 160
This.btn1.Caption = "確定"
This.nBtn1Value = 1
This.btn1.Visible = .T.
This.btn1.Default = .T.

This.btn2.Left = 290
This.btn2.Caption = "取消"
This.nBtn2Value = 2
This.btn2.Visible = .T.

CASE lnButtons = 4 && [是(Y)] [否(N)]
This.btn1.Left = 160
This.btn1.Caption = "是 (Y)"
This.nBtn1Value = 6
This.btn1.Visible = .T.
This.btn1.Default = .T.

This.btn2.Left = 290
This.btn2.Caption = "否 (N)"
This.nBtn2Value = 7
This.btn2.Visible = .T.
ENDCASE
ENDPROC

* ?? 按鈕 1 (也就是「是 / 確定」) 的點擊物理防禦
PROCEDURE btn1.Click
* ?? 核心 Truths 判定：看看客戶到底有沒有打勾 (Value = 1 代表有打勾)
IF ThisForm.chkConfirm.Value = 1
_gnMsgResult = ThisForm.nBtn1Value
ThisForm.Release
ELSE
* ?? 客戶沒打勾！直接跳出大字體警告，不給過帳！
MESSAGEBOX([請注意：您應該先打勾確認！], 48, [防呆阻斷])
ENDIF
ENDPROC

* ?? 按鈕 2 (也就是「否 / 取消」)：點擊不設防，隨時可以安全退場
PROCEDURE btn2.Click
_gnMsgResult = ThisForm.nBtn2Value
ThisForm.Release
ENDPROC
ENDDEFINE

CPS0204 · 註冊時間: 2014-08-24 文章: 524 第 3 樓

此版本改為:警告訊息可以copy/paste
******************************
FUNCTION my_message_CHECK2
LPARAMETERS tcMessage, tnType, tcTitle

* ?? 1. 全局變數剛性定錨
PUBLIC _gnMsgResult
_gnMsgResult = 0

IF EMPTY(tnType)
tnType = 0
ENDIF
IF EMPTY(tcTitle)
tcTitle = [安全確蓋提示]
ENDIF

LOCAL loMsgForm, lnReturn

* ?? 2. 擊發防呆表單
loMsgForm = CREATEOBJECT("BigMsgFormAntiMistake", tcMessage, tnType, tcTitle)
loMsgForm.Show(1)

* ?? 3. 接回純數字返回值 (1=確定, 2=取消, 6=是, 7=否)
lnReturn = _gnMsgResult

* ?? 4. 清理戰場
RELEASE _gnMsgResult
RELEASE loMsgForm

RETURN lnReturn
ENDFUNC

*====================================================================
* ??? 核心：雙重防呆大字體表單類別宣告 (EditBox 複製品種)
*====================================================================
DEFINE CLASS BigMsgFormAntiMistake AS Form
Caption = ""
Width = 580
Height = 280 && 稍微拉高，留空間給 CheckBox
AutoCenter = .T.
BorderStyle = 3
MaxButton = .F.
MinButton = .F.
WindowType = 1
FontName = "Microsoft JhengHei"
FontSize = 16

nBtn1Value = 0
nBtn2Value = 0

* ?? ??【核心改裝大絕】：拋棄死板的 ADD OBJECT Label！
* 改用 EditBox，並透過屬性把邊框、捲軸、背景色全部拔掉！
* 這樣在畫面上看起來跟 Label 毫無二致，但客戶卻可以用滑鼠任意抹黑複製！
ADD OBJECT edtMessage AS EditBox WITH ;
Left = 40, Top = 35, Width = 500, Height = 95, ;
FontName = "Microsoft JhengHei", FontSize = 16, FontBold = .T., ;
ReadOnly = .T., ; && 剛性唯讀，不准客戶亂改訊息
BorderStyle = 0, ; && 拔掉邊框，偽裝成 Label 視覺效果
ScrollBars = 2, ; && 萬一文字超長，自動跚啟垂直捲軸防止字被切掉
BackStyle = 0, ; && 背景透明，完美融合表單底色
Value = ""

* ?? 靈魂防呆控制項：CheckBox
ADD OBJECT chkConfirm AS CheckBox WITH Left = 40, Top = 145, Width = 200, Height = 30, ;
FontName = "Microsoft JhengHei", FontSize = 15, FontBold = .T., ;
Caption = "我已確蓋", Value = 0, FORECOLOR = RGB(255,0,0)

ADD OBJECT btn1 AS CommandButton WITH Left = 160, Top = 200, Width = 110, Height = 40, FontName = "Microsoft JhengHei", FontSize = 14, Visible = .F.
ADD OBJECT btn2 AS CommandButton WITH Left = 290, Top = 200, Width = 110, Height = 40, FontName = "Microsoft JhengHei", FontSize = 14, Visible = .F.

PROCEDURE Init
LPARAMETERS tcMessage, tnType, tcTitle
LOCAL lnButtons

This.Caption = tcTitle

* ?? 將原本賦值給 Label 的 Caption，改為賦值給 EditBox 的 Value
This.edtMessage.Value = tcMessage

lnButtons = BITAND(tnType, 0x000F)

* 動態分配按鈕數值與排版
DO CASE
CASE lnButtons = 0 && 只有一個 [確定]
* ?? 只有一個確定按鈕時，將它擺b正中間
This.btn2.Left = 235
This.btn2.Caption = "確定"
This.nBtn2Value = 1
This.btn2.Visible = .T.
This.btn2.Default = .T.

CASE lnButtons = 1 && [確定] [取消]
This.btn1.Left = 160
This.btn1.Caption = "確定"
This.nBtn1Value = 1
This.btn1.Visible = .T.
This.btn1.Default = .T.

This.btn2.Left = 290
This.btn2.Caption = "取消"
This.nBtn2Value = 2
This.btn2.Visible = .T.

CASE lnButtons = 4 && [是(Y)] [否(N)]
This.btn1.Left = 160
This.btn1.Caption = "是 (Y)"
This.nBtn1Value = 6
This.btn1.Visible = .T.
This.btn1.Default = .T.

This.btn2.Left = 290
This.btn2.Caption = "否 (N)"
This.nBtn2Value = 7
This.btn2.Visible = .T.
ENDCASE
ENDPROC

* ??? 按鈕 1 (也就是「是 / 確定」) 的點擊物理防禦
PROCEDURE btn1.Click
* 核心 Truths 判定：看看客戶到底有沒有打勾 (Value = 1 代表有打勾)
IF ThisForm.chkConfirm.Value = 1
_gnMsgResult = ThisForm.nBtn1Value
ThisForm.Release
ELSE
* 客戶沒打勾！直接跳出大字體警告，不給過帳！
MESSAGEBOX([請注意：您應該先打勾確蓋！], 48, [防呆阻斷])
ENDIF
ENDPROC

* ??? 按鈕 2 (單純點擊「確定」只有一粒鈕時，或者是「否 / 取消」)：
* 物理機制：如果是單獨一顆「確定」鈕（也就是 nBtn2Value = 1 情況下），依然強迫他打勾才能關！
* 如果是「取消」或「否」，則隨時不設防，安全退場。
PROCEDURE btn2.Click
IF ThisForm.nBtn2Value = 1 AND ThisForm.chkConfirm.Value = 0
MESSAGEBOX([請注意：您應該先打勾確蓋！], 48, [防呆阻斷])
ELSE
_gnMsgResult = ThisForm.nBtn2Value
ThisForm.Release
ENDIF
ENDPROC
ENDDEFINE