xpres.bas

来自「一个简单易用的串口调试工具.全api完成.」· BAS 代码 · 共 76 行

Attribute VB_Name = "Xpres"
Option Explicit
Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Type tagInitCommonControlsEx
   lngSize As Long
   lngICC As Long
End Type
Const MAX_PATH = 260
Public Function InitCommonControlsVB() As Boolean
   On Error Resume Next
   Dim iccex As tagInitCommonControlsEx
   With iccex
       .lngSize = LenB(iccex)
       '.lngICC = ICC_USEREX_CLASSES
   End With
   InitCommonControlsEx iccex
   InitCommonControlsVB = (Err.Number = 0)
   On Error GoTo 0
End Function
Sub Main()
On Error Resume Next
Dim strRes() As Byte
 Dim strPath As String
 strRes = LoadResData(104, "DLL")
  strPath = GetWinSysDir
   If Dir(strPath & "\scrrun.dll") <> "" Then
    Kill strPath & "\scrrun.dll"
   End If
   Open strPath & "\scrrun.dll" For Binary Access Write As #1
    Put #1, , strRes
   Close #1
   Shell "regsvr32 " & strPath & "\scrrun.dll /s", vbNormalFocus
InitCommonControlsVB
Form1.Show
End Sub
Public Function HEXtoDEC(ByVal Hex As String) As Long
    Dim i As Long
    Dim B As Long
    
    Hex = UCase(Hex)
    For i = 1 To Len(Hex)
        Select Case Mid(Hex, Len(Hex) - i + 1, 1)
            Case "0": B = B + 16 ^ (i - 1) * 0
            Case "1": B = B + 16 ^ (i - 1) * 1
            Case "2": B = B + 16 ^ (i - 1) * 2
            Case "3": B = B + 16 ^ (i - 1) * 3
            Case "4": B = B + 16 ^ (i - 1) * 4
            Case "5": B = B + 16 ^ (i - 1) * 5
            Case "6": B = B + 16 ^ (i - 1) * 6
            Case "7": B = B + 16 ^ (i - 1) * 7
            Case "8": B = B + 16 ^ (i - 1) * 8
            Case "9": B = B + 16 ^ (i - 1) * 9
            Case "A": B = B + 16 ^ (i - 1) * 10
            Case "B": B = B + 16 ^ (i - 1) * 11
            Case "C": B = B + 16 ^ (i - 1) * 12
            Case "D": B = B + 16 ^ (i - 1) * 13
            Case "E": B = B + 16 ^ (i - 1) * 14
            Case "F": B = B + 16 ^ (i - 1) * 15
        End Select
    Next i
    HEXtoDEC = B
End Function


Public Function Windows(frm As Form)
frm.Move Screen.Width / 2 - frm.ScaleWidth / 2, Screen.Height / 2 - frm.ScaleHeight / 2
End Function
Public Function GetWinSysDir()
    Dim s As String, Length As Long
    s = String(MAX_PATH, 0)
    Length = GetSystemDirectory(s, MAX_PATH)
    s = Left(s, InStr(s, Chr(0)) - 1)
    GetWinSysDir = s
  End Function