24點算式（表示式）計算程式

算式是什麼

執行介面

關於

撲克相簿檔案

‘’‘’‘’ 免費貢獻全部程式碼

‘’‘’‘’ 24點算式（表示式）計算程式 由 趙春

‘’‘’ 巖 用VB6 編寫 15065

‘’‘’ 不能寫聯絡方式，716328

‘’‘’‘’ 這種規定，純屬大腦有病。

‘’‘’‘’ 2020年10月16日

‘’‘’‘’ 我是貢獻程式碼，全部的。留個聯絡方式都不行？豈有此理！

‘’‘’‘’

‘’‘’‘’

Option Explicit

Private Declare Sub Sleep Lib “kernel32。DLL” （ByVal dwMilliseconds As Long）

Dim xAi As Long， xBi As Long， xCi As Long

Dim XTTi（4）， yS_Number

Dim BDS_24（10）， jGi As Long

Dim Ki As Long， aI As Long

Dim xBCOLOR As Variant

Dim CCCCC As New ScriptControl

Dim kStr， sStr

Dim StEnd As Integer， sTi As Integer

Dim A， B， C， D

Dim YSF

Dim Ji As Long

Dim ei As Long

Dim pK_ID As Long

Dim xRow As Integer， xCol As Integer， LXPK， PKNAME

Dim bMNum As Long， DCFX As Long

Dim DUI As Long， CUO As Long

Private Sub Check1_Click（）

Call Command2_Click

End Sub

‘’‘’ 本程式 需要 引用 “Micosoft Script Control 1。0”

‘’‘’ 新增部件，“PictureClip Control 6。0”

‘’‘’ 保證撲克圖片在程式的目錄下，不能丟失、刪除！

Private Sub Command1_Click（Index As Integer）

On Error GoTo JS_ERROR

‘’ 輸入表示式

If Index <= 9 Then

RichTextBox1。SelText = RichTextBox1。SelText & Command1（Index）。Caption

RichTextBox1。SetFocus

If Index <= 3 Then Command1（Index）。Enabled = False

End If

‘’ 清除錯誤

If Index = 10 Then

RichTextBox1。Text = “”

RichTextBox1。SetFocus

For aI = 0 To 3

Command1（aI）。Enabled = True

Next aI

‘’ DUI = 0

‘’ CUO = 0

End If

‘’ 計算表示式

If Index = 11 Then

CCCCC。Language = “VBScript”

kStr = RichTextBox1。Text

sStr = CCCCC。Eval（kStr）

RichTextBox1。Text = RichTextBox1。Text & “ = ” & sStr ‘輸出最終結果

DCFX = Val（DCFX） + 1

Text3。Text = Text3。Text & DCFX & “、”

If sStr = 24 Then

Text3。Text = Text3。Text & RichTextBox1。Text & “ …… √” & vbCrLf

DUI = Val（DUI） + 1

Command4。Enabled = False

Command5。Enabled = False

Else

Text3。Text = Text3。Text & RichTextBox1。Text & “ …… ×” & vbCrLf

CUO = Val（CUO） + 1

Command4。Enabled = True

Command5。Enabled = True

RichTextBox1。SetFocus

End If

End If

’轉移一下文字焦點，保持text3文字焦點在文字的最後。

Text3。SelStart = Len（Text3。Text）

‘’游標立即轉移到RichTextBox1

RichTextBox1。SetFocus

Label4。Caption = “正確：” & DUI & “ ； 錯誤：” & CUO

JS_ERROR：

If Err Then

MsgBox Err。Description & vbCrLf & “ 表示式書寫錯誤！表示式請使用英文字元書寫。”， vbCritical， “提示”

End If

End Sub

Private Sub Command2_Click（）

On Error GoTo StartErr：

‘ 重新開始

’ 背面 5 張

Randomize

bMNum = Int（Rnd * 9） ‘ 隨機數讀取一種背面圖案。

’ 延時顯示預讀取的背面圖案。

For aI = 3 To 0 Step -1

DoEvents

Sleep 200

Image2（aI）。Picture = PictureClip1。GraphicCell（bMNum + 52）

Next aI

‘’ 開始發牌

RichTextBox1。Text = “”

Randomize ‘初始化隨機數生成器。

For aI = 0 To 3

Ki = Int（Rnd * 52）

DoEvents

Sleep 300 ’延時顯示撲克牌

Text1（aI）。Text = Ki

Image2（aI）。Picture = PictureClip1。GraphicCell（Ki）

pK_ID = Ki

xRow = （pK_ID \ 13） ‘ 整除13，得到撲克牌在第幾行上。

xCol = 1 + （pK_ID Mod 13） ’ 求餘數，得到撲克牌在第幾列上。

Label1（aI）。Caption = pK_ID & “ ， ” & LXPK（xRow） & “ ” & PKNAME（xCol - 1） & “ ， ” & xCol

Text1（aI）。BackColor = “&H” & xBCOLOR（xRow）

If Check1。Value = 1 Then

If xCol > 10 Then xCol = 10

End If

Command1（aI）。Caption = xCol

Next aI

For aI = 0 To 3

Command1（aI）。Enabled = True

Next aI

StEnd = 0

List1。Clear

List1。AddItem “ 分析結果 …… ”

Label3。Caption = “”

RichTextBox1。SetFocus

StartErr：

If Err Then

MsgBox Err。Description & Err。Number， vbCritical， “提示”

End If

End Sub

Private Sub Command3_Click（）

Call 列出四位數的表示式

End Sub

‘ 指定游標在 RichTextBox1 中向前移動

Private Sub Command4_Click（）

Dim GB_COL As Integer

GB_COL = RichTextBox1。SelStart

If GB_COL <> 0 Then GB_COL = Val（GB_COL） - 1

RichTextBox1。SelStart = GB_COL

RichTextBox1。SetFocus

End Sub

’ 指定游標在 RichTextBox1 中向後移動

Private Sub Command5_Click（）

Dim GB_COL As Integer

GB_COL = RichTextBox1。SelStart

If GB_COL <> Len（RichTextBox1。Text） Then GB_COL = Val（GB_COL） + 1

RichTextBox1。SelStart = GB_COL

RichTextBox1。SetFocus

End Sub

Private Sub Form_Load（）

‘’‘’‘ 撲克牌圖片載入

PictureClip1。Picture = LoadPicture（App。Path & “\撲克牌全圖。jpg”）

PictureClip1。Cols = 13

PictureClip1。Rows = 5

For aI = 0 To 3

Image2（aI）。Picture = PictureClip1。GraphicCell（62）

Next aI

LXPK = Array（“黑桃”， “紅桃”， “梅花”， “方塊”， “背面”）

PKNAME = Array（“A”， “2”， “3”， “4”， “5”， “6”， “7”， “8”， “9”， “10”， “J”， “Q”， “K”）

xBCOLOR = Array（“0080FFFF”， “008080FF”， “0080FF80”， “00FF8080”， “00FF80FF”）

’ 請不要隨意更改運算子號的排列順序！

‘’‘’‘’‘’‘’‘|’‘’‘’‘’1‘’‘’‘’|‘’‘’‘’2‘’‘’‘’‘|’‘’‘’‘3’‘’‘’‘’|‘’‘’‘’4‘’‘’‘’‘|’‘’‘’‘5’‘’‘’‘’|‘’‘’‘’‘6’‘’‘’‘|’‘’‘’‘7’‘’‘’‘’|‘’‘’‘’8‘’‘’‘’‘|’‘’‘’‘9’‘’‘’‘’|‘’‘’‘’10‘’‘’‘’|‘’‘’‘’11‘’‘’‘| ； 40*3=120（ 0 to 119 ）

YSF = Array（“+”， “+”， “+”， “+”， “+”， “-”， “+”， “+”， “*”， “+”， “+”， “/”， “+”， “-”， “-”， “+”， “-”， “*”， “+”， “-”， “/”， “+”， “*”， “-”， “+”， “*”， “*”， “+”， “*”， “/”， _

“+”， “/”， “-”， “+”， “/”， “*”， “-”， “+”， “-”， “-”， “+”， “*”， “-”， “+”， “/”， “-”， “-”， “-”， “-”， “-”， “*”， “-”， “-”， “/”， “-”， “*”， “-”， “-”， “*”， “*”， _

“-”， “*”， “/”， “-”， “/”， “*”， “*”， “/”， “+”， “*”， “+”， “+”， “-”， “+”， “+”， “*”， “+”， “-”， “*”， “+”， “*”， “*”， “+”， “/”， “*”， “-”， “-”， “*”， “-”， “*”， _

“*”， “-”， “/”， “*”， “*”， “-”， “*”， “*”， “*”， “*”， “*”， “/”， “*”， “/”， “-”， “*”， “/”， “*”， “*”， “-”， “+”， “+”， “-”， “+”， “-”， “*”， “+”， “+”， “*”， “+”）

yS_Number = Array（“0123”， “0132”， “0312”， “0321”， “0213”， “0231”， “1023”， “1032”， “1203”， “1230”， _

“1302”， “1320”， “2013”， “2031”， “2103”， “2130”， “2301”， “2310”， “3012”， “3021”， _

“3102”， “3120”， “3201”， “3210”）

StEnd = 0

DCFX = 0

Text3。Text = “ 歷史記錄：” & vbCrLf

’‘’‘’ Call Command2_Click

‘’‘’RichTextBox1。SelAlignment = rtfCenter ‘’‘’ 設定文字居中

End Sub

Private Sub Image1_Click（）

frmAbout。Show

End Sub

Private Sub Label3_Click（）

Dim FileName As String， FXJGTEXT As String， FXi As Long

Label3。BackColor = &H8080FF

If MsgBox（“儲存分析結果嗎？”， vbInformation + vbYesNo， “提示”） = vbYes Then

For FXi = 0 To List1。ListCount - 1

List1。ListIndex = FXi

FXJGTEXT = FXJGTEXT & List1。Text & vbCrLf

Next FXi

FileName = InputBox（“輸入檔名，也可以使用預設，以日期為檔名”， “輸入資訊……”， Format（Now， “yyyymmddhhmm” & “分析結果”））

Open App。Path & “\” & FileName & “。txt” For Output As #1

Print #1， FXJGTEXT

Close #1

Label3。BackColor = &H8000000F

MsgBox “儲存完畢！”， vbInformation， “提示”

Else

MsgBox “您沒有選擇儲存。”， vbInformation， “提示”

Label3。BackColor = &H8000000F

End If

End Sub

Private Sub Label4_Click（）

Dim FileName As String

Label4。BackColor = &H8080FF

If MsgBox（“儲存歷史記錄嗎？”， vbInformation + vbYesNo， “提示”） = vbYes Then

FileName = InputBox（“輸入檔名，也可以使用預設，以日期為檔名”， “輸入資訊……”， Format（Now， “yyyymmddhhmm” & “歷史記錄”））

Open App。Path & “\” & FileName & “。txt” For Output As #1

Print #1， Text3。Text

Close #1

Label4。BackColor = &H8000000F

MsgBox “儲存完畢！”， vbInformation， “提示”

Else

MsgBox “您沒有選擇儲存。”， vbInformation， “提示”

Label4。BackColor = &H8000000F

End If

End Sub

‘’ 呼叫隱藏的右鍵複製選單

Private Sub List1_MouseDown（Button As Integer， Shift As Integer， X As Single， Y As Single）

If Button = 2 Then

PopupMenu mnu_Edit

End If

End Sub

Private Sub mnu_Edit_Click（）

Clipboard。Clear ‘清空剪貼簿

Clipboard。SetText List1。Text ’將剪貼簿內容設定為List1。Text

End Sub

Private Sub RichTextBox1_GotFocus（）

Command4。Enabled = True

Command5。Enabled = True

End Sub

Private Sub Text1_Change（Index As Integer）

Command1（Index）。Caption = Text1（Index）。Text

End Sub

‘’‘’

Private Sub Text1_GotFocus（Index As Integer）

Text1（Index）。SelStart = 0

Text1（Index）。SelLength = Len（Text1（Index）。Text）

End Sub

Private Sub Timer1_Timer（）

Label5。Caption = Format（Now， “mm-dd hh：mm：ss AAAA”）

End Sub

Public Sub 列出四位數的表示式（）

On Error Resume Next

Dim xWI

‘’‘ 24 種數值位置排列。4種運算子號；共寫出 120 個運算子號，每 3 個運算子號為 1 組，共 40 組；120 / 3 = 40； 24 * 40 = 960 就會有 960 種計算方法。可列出 11 種不同的算式！

CCCCC。Language = “VBScript”

List1。Clear

List1。AddItem “ 分析結果：”

For xAi = 0 To 23

xWI = yS_Number（xAi）

For xBi = 1 To 4

XTTi（xBi） = Mid（xWI， xBi， 1）

Next xBi

DoEvents

A = Command1（XTTi（1））。Caption

B = Command1（XTTi（2））。Caption

C = Command1（XTTi（3））。Caption

D = Command1（XTTi（4））。Caption

For xCi = 0 To 119 Step 3

BDS_24（0） = A & YSF（xCi） & B & YSF（xCi + 1） & C & YSF（xCi + 2） & D ’ A B C D

BDS_24（1） = A & YSF（xCi） & “（” & B & YSF（xCi + 1） & C & YSF（xCi + 2） & D & “）” ‘’‘’ （ ）

BDS_24（2） = “（” & A & YSF（xCi） & B & YSF（xCi + 1） & C & “）” & YSF（xCi + 2） & D ‘’‘’（ ）

BDS_24（3） = A & YSF（xCi） & “（” & B & YSF（xCi + 1） & C & “）” & YSF（xCi + 2） & D ‘’‘’ （ ）

BDS_24（4） = “（” & A & YSF（xCi） & B & “）” & YSF（xCi + 1） & C & YSF（xCi + 2） & D ‘（ ）

BDS_24（5） = A & YSF（xCi） & B & YSF（xCi + 1） & “（” & C & YSF（xCi + 2） & D & “）” ’ （ ）

BDS_24（6） = “（” & A & YSF（xCi） & “（” & B & YSF（xCi + 1） & C & “））” & YSF（xCi + 2） & D ‘（ （ ））

BDS_24（7） = A & YSF（xCi） & “（” & B & YSF（xCi + 1） & “（” & C & YSF（xCi + 2） & D & “））” ’ （ （ ））

BDS_24（8） = “（（” & A & YSF（xCi） & B & “）” & YSF（xCi + 1） & C & “）” & YSF（xCi + 2） & D ‘（（ ） ）

BDS_24（9） = A & YSF（xCi） & “（（” & B & YSF（xCi + 1） & C & “）” & YSF（xCi + 2） & D & “）” ’ （（ ） ）

BDS_24（10） = “（” & A & YSF（xCi） & B & “）” & YSF（xCi + 1） & “（” & C & YSF（xCi + 2） & D & “）” ‘（ ） （ ）

For jGi = 0 To 10

If CCCCC。Eval（BDS_24（jGi）） = 24 Then List1。AddItem List1。ListCount & “： ” & BDS_24（jGi） & “ = ” & CCCCC。Eval（BDS_24（jGi）） ’‘’ 結果輸出

Next jGi

Next xCi

Next xAi

List1。AddItem “ ** ‘’‘’END‘’‘’ **”

Label3。Caption = “…… 共有 【 ” & List1。ListCount - 2 & “ 】 種算式！ ”

End Sub