廣告廣告
  加入我的最愛 設為首頁 風格修改
首頁 首尾
 手機版   訂閱   地圖  簡體 
您是第 3873 個閱讀者
 
發表文章 發表投票 回覆文章
  可列印版   加為IE收藏   收藏主題   上一主題 | 下一主題   
sob790717
數位造型
個人文章 個人相簿 個人日記 個人地圖
小人物
級別: 小人物 該用戶目前不上站
推文 x17 鮮花 x27
分享: 轉寄此文章 Facebook Plurk Twitter 複製連結到剪貼簿 轉換為繁體 轉換為簡體 載入圖片
推文 x0
[Basic][求助] 簡化以下程式碼
此段程式碼的最終目的如最後一行的注解一樣
但我覺得應該還可以在刪減一些程式碼

請問該刪什麼碼跟元件又不會影響程式原本的功能?

Text5.Text = Text2.Text
Text3.Text = Len(Text5)
Text3.Te ..

訪客只能看到部份內容,免費 加入會員 或由臉書 Google 可以看到全部內容



[ 此文章被sob790717在2010-08-31 11:01重新編輯 ]


獻花 x0 回到頂端 [樓 主] From:台灣中華電信 | Posted:2010-08-31 10:53 |
ebolaman 手機 會員卡
個人文章 個人相簿 個人日記 個人地圖
特殊貢獻獎

級別: 副版主 該用戶目前不上站
版區: 程式設計
推文 x38 鮮花 x458
分享: 轉寄此文章 Facebook Plurk Twitter 複製連結到剪貼簿 轉換為繁體 轉換為簡體 載入圖片

基本上如果不知道附近的程式碼結構,有些簡化程序有時會出問題
例如那個 Text5 ,如果像是化學的催化劑就可以刪除
但如果是在表單上必須用到的就不可刪除

依照僅提供的程式碼
我覺得可以簡化成:

k = CInt(Len(Text2.txt))
If Not (k = 3) Then Goto Err02


If Not (..瓜瓜) 這很好用,假如版本長度要限定在 3~5 可以改成 Not (k >=3 And k <= 5) ,這常常在限制 KeyPress 的 KeyAscii 的數字範圍用到

而後面多了個 Else 我就不清楚是什麼意思了

此文章被評分,最近評分記錄
財富:50 (by 三仙) | 理由: ^^ 因為您的參與,讓程式設計更容易!!


My BOINC stats :

獻花 x2 回到頂端 [1 樓] From:台灣台灣寬頻 | Posted:2010-08-31 19:13 |
sob790717
數位造型
個人文章 個人相簿 個人日記 個人地圖
小人物
級別: 小人物 該用戶目前不上站
推文 x17 鮮花 x27
分享: 轉寄此文章 Facebook Plurk Twitter 複製連結到剪貼簿 轉換為繁體 轉換為簡體 載入圖片

下面是引用 ebolaman 於 2010-08-31 19:13 發表的 : 到引言文
基本上如果不知道附近的程式碼結構,有些簡化程序有時會出問題
例如那個 Text5 ,如果像是化學的催化劑就可以刪除
但如果是在表單上必須用到的就不可刪除

依照僅提供的程式碼
我覺得可以簡化成:

k = CInt(Len(Text2.txt))
If Not (k = 3) Then Goto Err02


If Not (..瓜瓜) 這很好用,假如版本長度要限定在 3~5 可以改成 Not (k >=3 And k <= 5) ,這常常在限制 KeyPress 的 KeyAscii 的數字範圍用到

而後面多了個 Else 我就不清楚是什麼意思了

ELSE後面是要接原本的
ELSE前面就是如果發現到字串長度不合規定時就GOTO到某個標籤


我把這整段做在timer2
這是整個整段程式碼
就可以得知為什要判斷字串長度

複製程式
Private Sub Timer2_Timer()

On Error GoTo err01 '如果先偵測到有問題時就跳到err01
Dim Buff1 As String, iNum1 As Integer

Text1.Text = "" & App.Major & "." & App.Minor '讀取目前的版本號碼

Buff1 = Inet1.OpenURL("http://dl.dropbox.com/u/8455775/trconverter/trconverter_update/msspintw/trconverter2/cht_tw/verinfo.txt")
Do Until Not Inet1.StillExecuting
DoEvents '下載新版版本號碼並等待完成

Loop

iNum1 = FreeFile
If Dir("newver.txt") <> "" Then Kill "newver.txt" '如果有先前下載的新版版本號碼就先刪除然後再開啟

Open "newver.txt" For Binary As #iNum1

Put #iNum1, , Buff1
Close #iNum1

newver = "newver.txt"
Dim nv() As Byte: ReDim nv(FileLen(newver))
Open newver For Binary As #1: Get #1, , nv: Close #1
Text2.Text = StrConv(nv, vbUnicode)

If Text2.Text = "" Then GoTo err01 Else '偵測新版版本號碼欄位的內容是否為空來判斷網路是否正常或本機檔案是否有問題

Text5.Text = Text2.Text
Text3.Text = Len(Text5)
Text3.Text = CInt(Text3)
If Text3 >= 4 Or Text3 <= 2 Then GoTo err02 Else '計算新版版本號碼欄位內的資料長度來判斷網路空間是否正常

If Text1.Text = Text2.Text Then '如果版本號碼一樣就直接關閉更新機制

Timer2.Enabled = False
Form6.Hide

Else

uq = MsgBox(FNV_1, MsgStr_004, MsgTle_001) '如果號碼不一樣就提示使用者

If uq = vbYes Then GoTo au1 Else

Timer2.Enabled = False
Form6.Hide

End If
Exit Sub

au1:

    Rem 開啟更新檔下載連結然後結束程式
    Call ShellExecute(Me.hwnd, "open", "http://dl.dropbox.com/u/8455775/trconverter/trconverter_fulldownload/msspintw/trconverter2/cht_tw/installer_.zip", "", "", vbNormalFocus)

    Timer2.Enabled = False
    Form6.Hide

    End

Exit Sub

err01:

    Rem 偵測更新時發生錯誤之處理區
    MsgBox CNCVN_1, MsgStr_001, MsgTle_003
    Timer2.Enabled = False
    Form6.Hide

Exit Sub

err02:

    Rem 偵測更新時發生錯誤之處理區
    MsgBox CNCVN_2, MsgStr_001, MsgTle_003
    Timer2.Enabled = False
    Form6.Hide

End Sub


獻花 x0 回到頂端 [2 樓] From:台灣中華電信 | Posted:2010-09-01 19:52 |
ebolaman 手機 會員卡
個人文章 個人相簿 個人日記 個人地圖
特殊貢獻獎

級別: 副版主 該用戶目前不上站
版區: 程式設計
推文 x38 鮮花 x458
分享: 轉寄此文章 Facebook Plurk Twitter 複製連結到剪貼簿 轉換為繁體 轉換為簡體 載入圖片

下面是引用 sob790717 於 2010-09-01 19:52 發表的 : 到引言文

ELSE後面是要接原本的
ELSE前面就是如果發現到字串長度不合規定時就GOTO到某個標籤

我把這整段做在timer2
.......


恩,不過我在想,Text2 檢查長度應該可以拿來與 Text1 直接做比較
If Len(Text2.txt) <> Len(Text1.txt) Then ...


My BOINC stats :

獻花 x1 回到頂端 [3 樓] From:台灣台灣寬頻 | Posted:2010-09-02 05:44 |
sob790717
數位造型
個人文章 個人相簿 個人日記 個人地圖
小人物
級別: 小人物 該用戶目前不上站
推文 x17 鮮花 x27
分享: 轉寄此文章 Facebook Plurk Twitter 複製連結到剪貼簿 轉換為繁體 轉換為簡體 載入圖片

下面是引用 ebolaman 於 2010-09-02 05:44 發表的 : 到引言文



恩,不過我在想,Text2 檢查長度應該可以拿來與 Text1 直接做比較
If Len(Text2.txt) <> Len(Text1.txt) Then ...

額.....
本來有點問題

不過我還是依你的範例改好了
省了兩個textbox和四行程式碼表情

感謝表情

不過不知您是否願意幫我解決一個API的問題?


[ 此文章被sob790717在2010-09-02 23:46重新編輯 ]


獻花 x0 回到頂端 [4 樓] From:台灣中華電信 | Posted:2010-09-02 22:56 |
ebolaman 手機 會員卡
個人文章 個人相簿 個人日記 個人地圖
特殊貢獻獎

級別: 副版主 該用戶目前不上站
版區: 程式設計
推文 x38 鮮花 x458
分享: 轉寄此文章 Facebook Plurk Twitter 複製連結到剪貼簿 轉換為繁體 轉換為簡體 載入圖片

下面是引用 sob790717 於 2010-09-02 22:56 發表的 : 到引言文


額.....
本來有點問題

不過我還是依你的範例改好了
省了兩個textbox和四行程式碼表情

感謝表情

不過不知您是否願意幫我解決一個API的問題?

OK~


My BOINC stats :

獻花 x0 回到頂端 [5 樓] From:台灣台灣寬頻 | Posted:2010-09-03 05:03 |
sob790717
數位造型
個人文章 個人相簿 個人日記 個人地圖
小人物
級別: 小人物 該用戶目前不上站
推文 x17 鮮花 x27
分享: 轉寄此文章 Facebook Plurk Twitter 複製連結到剪貼簿 轉換為繁體 轉換為簡體 載入圖片

圖 1.



下面是引用 ebolaman 於 2010-09-03 05:03 發表的 : 到引言文


OK~


如圖綠色框框
目前搞不定的是如何像圖一樣增加個訊息

網路上有找到一範例
不過寫法太高深表情
搞不進我的程式中表情
目前單純增加圖示已經OK了
所以當我要在系統列增加一個圖示時引用GetStar就好了(反之亦然)

只剩下這個提示訊息的部份



以下是我的BAS
複製程式
Rem 調用函數
Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Public Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public prevWndProc As Long

Option Explicit

Public Const GWL_WNDPROC = (-4)
Public Const WM_USER = &H400
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONUP = 517

Public Const NIM_ADD = 0
Public Const NIM_MODIFY = 1
Public Const NIM_DELETE = 2

Public Const NIF_MESSAGE = 1
Public Const NIF_ICON = 2
Public Const NIF_TIP = 4
Public Const NIF_INFO = 10

Type NOTIFYICONDATA
Rem 設定系統列通知相關代碼
    cbSize As Long
    hwnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * 128
    dwState As Long
    dwStateMask As Long
    szInfo As String * 256
    uTimeoutAndVersion As Long
    szInfoTitle As String * 64
    dwInfoFlags As Long
    
End Type

Enum RootKey
Rem 設定代碼
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
    HKEY_PERFORMANCE_DATA = &H80000004
    HKEY_CURRENT_CONFIG = &H80000005
    HKEY_DYN_DATA = &H80000006
    
End Enum

Enum ErrorCode
Rem 設定代碼
    ERROR_SUCCESS = 0&
    ERROR_MORE_DATA = 234&
    
End Enum

Enum ValueType
Rem 設定代碼
    REG_NONE = 0
    REG_SZ = 1
    REG_EXPAND_SZ = 2
    REG_BINARY = 3
    REG_DWORD = 4
    REG_DWORD_BIG_ENDIAN = 5
    REG_MULTI_SZ = 7
    
End Enum

Private Type PROCESSENTRY32
Rem 設定類型
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 1024

End Type

Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Function SetDefaultValue(ByVal hKey As Long, ByVal Subkey As String, ByVal Value As String) As Boolean
Rem 設定登錄的預設值

Dim ret As Long, lenS As Long, S As String

    ret = RegSetValue(hKey, Subkey, REG_SZ, Value, LenB(StrConv(Value, vbFromUnicode)) + 1)
    SetDefaultValue = (ret = 0)
    
End Function
Function SetValue(ByVal hKey As Long, ByVal ValueName As String, ByVal vType As Long, Value As Variant, Optional ByVal lenValue As Integer) As Boolean
Rem 設定登錄的值

    Dim ret As Long, bArr() As Byte

    On Error GoTo ErrorExit
    
    Select Case vType
    
        Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
            ret = RegSetValueEx(hKey, ValueName, 0&, vType, ByVal CStr(Value), LenB(StrConv(Value, vbFromUnicode)) + 1)
        
        Case REG_DWORD, REG_DWORD_BIG_ENDIAN
            ret = RegSetValueEx(hKey, ValueName, 0&, vType, CLng(Value), 4)
        
        Case REG_BINARY
            Dim i As Integer
            
            ReDim bArr(0 To lenValue - 1)
            
            For i = 0 To lenValue - 1
                bArr(i) = Value(i)
            Next
            
            ret = RegSetValueEx(hKey, ValueName, 0&, vType, bArr(0), lenValue)
    
    End Select
    
    SetValue = (ret = 0)

ErrorExit:

End Function
Public Function KillNull(ByVal S As String) As String
Rem 殺掉路徑中的空字元

Dim m As Long

    m = InStr(1, S, vbNullChar)
    KillNull = Left(S, m - 1)
  
End Function
Public Function GetPath(ByVal S As String) As String
Rem 取得路徑

Dim m As Long

 m = InStrRev(S, "\")
 If m <> 0 Then GetPath = Left(S, m)

End Function
Public Function fun_FindProcess(ByVal ProcessName As String) As Long
Rem 找程序ID

Dim strdata As String
Dim my As PROCESSENTRY32
Dim L As Long
Dim l1 As Long
Dim mName As String
Dim i As Integer, pId As Long

L = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If L Then

    my.dwSize = 1060
    If (Process32First(L, my)) Then
    
        Do
            i = InStr(1, my.szExeFile, Chr(0))
            mName = LCase(Left(my.szExeFile, i - 1))
            
            If mName = LCase(ProcessName) Then
        
            
                pId = my.th32ProcessID
                fun_FindProcess = pId
                
            Exit Function
            
            End If
            
        Loop Until (Process32Next(L, my) < 1)
        
    End If

l1 = CloseHandle(L)

End If

fun_FindProcess = 0

End Function
Public Sub GetStar()
Rem 在系統通知列顯示圖示和訊息

Dim NID As NOTIFYICONDATA
    
NID.cbSize = Len(NID)
NID.hwnd = Form1.hwnd
NID.uID = 9694
NID.uFlags = NIF_MESSAGE + NIF_ICON + NIF_TIP
NID.hIcon = Form1.Icon
NID.szTip = "" & App.Title + Chr(0)
NID.uCallbackMessage = WM_USER + 100


Shell_NotifyIcon NIM_ADD, NID
End Sub
Public Sub GetEnd()
Rem 移除系統通知列的圖示

Dim NID As NOTIFYICONDATA
    
NID.cbSize = Len(NID)
NID.hwnd = Form1.hwnd
NID.uID = 9694
NID.uFlags = NIF_MESSAGE + NIF_ICON + NIF_TIP
NID.uCallbackMessage = WM_USER + 100

Shell_NotifyIcon NIM_DELETE, NID
    
End Sub


獻花 x0 回到頂端 [6 樓] From:台灣中華電信 | Posted:2010-09-03 10:25 |
ebolaman 手機 會員卡
個人文章 個人相簿 個人日記 個人地圖
特殊貢獻獎

級別: 副版主 該用戶目前不上站
版區: 程式設計
推文 x38 鮮花 x458
分享: 轉寄此文章 Facebook Plurk Twitter 複製連結到剪貼簿 轉換為繁體 轉換為簡體 載入圖片

下面是引用 sob790717 於 2010-09-03 10:25 發表的 : 到引言文


如圖綠色框框
目前搞不定的是如何像圖一樣增加個訊息
網路上有找到一範例
.......

我對 API 真是不太熟...大部分還是參考別人寫的..

在 BinaryWorld 有人已經寫好了:http://binaryworld.net/Main/Co...?CodeId=3835

點上面的 "下載附件" 即可下載 VB6.0 專案


這叫做 Balloon ToolTip ,中文叫作什麼我就不知道了
這個是 Balloon ToolTip In System Tray
有另外一種型態是在表單上附在某個 Control 上的,不過這種在系統工具列的是不是就是改了 Hwnd 在系統工具列呢?
我並沒有深入研究所以尚未得知

他這個用到了簡單的 Form 中的程式碼,並利用了 Module 與 Class
你要應用的話應該只要把後面兩個載入,並且把 Form 中的程式碼移到你的專案中即可

你會發現就只有底下這幾行是必須修改的:

複製程式
 
   Dim WithEvents tt As CBalloonToolTipNotify
   Set tt = New CBalloonToolTipNotify

    tt.ContextMenu = 給予的 Popup Menu
    tt.TrayIcon = Icon
    tt.Visible = True
    tt.BalloonTitle = "標題"
    tt.BalloonText = "內容"
    tt.BalloonTimeOut = 顯示逾時時間
    tt.BalloonIconType = 圖示類別
    tt.Text = "滑鼠移上去時的簡易 ToolTip"
    tt.ShowNotifyBalloonTip
 


[ 此文章被ebolaman在2010-09-04 04:19重新編輯 ]


My BOINC stats :

獻花 x0 回到頂端 [7 樓] From:台灣台灣寬頻 | Posted:2010-09-03 19:09 |

首頁  發表文章 發表投票 回覆文章
Powered by PHPWind v1.3.6
Copyright © 2003-04 PHPWind
Processed in 0.087418 second(s),query:16 Gzip disabled
本站由 瀛睿律師事務所 擔任常年法律顧問 | 免責聲明 | 本網站已依台灣網站內容分級規定處理 | 連絡我們 | 訪客留言