【VB】以前学习的GDI+源码。还有TreeView1+SSTab 另类用法。

xtahtygyqq

非常简单的演示了，GDI+几种读取图片的方式 。话不多说，看图吧

源代码都做了注释，通谷易懂。自己拿去改改就可以做一个很漂亮的菜单了。
链接：https://pan.baidu.com/s/1LAxP5zulTw-ayqym5aQbyA
提取码：32jm

二  。

使用最简单的控件，做出树型菜单与多标签互动。所有加载,关闭，的子窗子。均只使用了SetCapture，SendMessage 等一些常用操作窗体的API
下面我们来讲讲，具体如何实现！..
实现以上框架用到了一位大牛的无注册DLL 和网上流传的子类化SSTAB子类化模块！
首先我们来讲讲，无需注册的DLL 文件，一直以为VB 都被 认为是无法做出无需注册的DLL文件，但是通过修改OBJ VB 生成EXE 时产生的链接文件修改来实现效果，这位大牛，做一款工具，可以在生成时直接导出
函数，这样我们就要吧像声明系统API 一样，来直接调用！
工具展示
1.无窗体DLL
建立一个模块。写入如下内容 我们用一段连接server SQL 的模块。来演示

Private Sub Main():  End Sub
Private Function DllMain(ByVal hModule As Long, _
                       ByVal ul_reason_for_call As Long, _
                       ByVal lpReserved As Long) As Long
   DllMain = 1
End Function
在新一个模块。输入如下内容（SQL连接模块）
'连接SQL的模块
Public conn As ADODB.Connection
Public rs As ADODB.Recordset
Public iStm As ADODB.Stream
Public addFlag As Boolean
Public cmd As ADODB.Command
Public param As ADODB.Parameter
Public Function OpenCn(ByVal Cip As String, ByVal kl As String, ByVal users As String, ByVal pw As String) As Boolean '连接模块 填写数据库等信息
Dim mag As String
On Error GoTo strerrmag
Set conn = New ADODB.Connection
conn.ConnectionTimeout = 2
conn.Provider = "sqloledb"
conn.Properties("data source").Value = StrConv(Cip, vbUnicode)     '服务器的名字
conn.Properties("initial catalog").Value = StrConv(kl, vbUnicode)           '库名
'conn.Properties("integrated security").Value = "SSPI"      '登陆类型
conn.Properties("user id").Value = StrConv(users, vbUnicode)   'SQL库名
conn.Properties("password").Value = StrConv(pw, vbUnicode)  '密码
'sql = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;password=;Initial Catalog=pubs;Data Source=127.0.0.1"    '如果不用这个模块也行可以，这一句便是常用的引擎。
'conn.ConnectionString = sql
conn.Open
OpenCn = True
If conn.State = 1 Then addFlag = True
Exit Function
strerrmag:
     addFlag = False
             If Err.Number <> 0 Then
     MsgBox Err.Number & " " & Err.Description, 48, "错误"
End If
     Exit Function      '连接错误消息
End Function
Public Function rsado()
Set rsado = rs
End Function
'关闭数据库，释放连接
Public Sub cloCn()
On Error Resume Next
If conn.State <> adStateClosed Then conn.Close
Set conn = Nothing
End Sub
Public Function openRs(ByVal strsql As String) As Boolean      '连接数据库记录集
Dim mag As String
Dim rpy As Boolean
On Error GoTo strerrmag
     Set rs = New ADODB.Recordset
     If addFlag = False Then rpy = True
       With rs
     .ActiveConnection = conn
     .CursorLocation = adUseClient
     .CursorType = adOpenKeyset
     .LockType = adLockOptimistic
     .Open StrConv(strsql, vbUnicode)
     End With
     addFlag = True
     openRs = True
     'End        '将记录集给rs
     Exit Function
strerrmag:
     openRs = False
          If Err.Number <> 0 And InStr(1, Err.Description, "ERRO556") = 0 Then
         MsgBox Err.Number & " " & Err.Description, 48, "提示"
End If
     'Exit Function '连接错误消息
End Function
Public Function opencmd(ByVal text As String, ByVal texttype As Integer, ByVal blbm As String, ByVal blbz As String) As Boolean
Dim mag As String
Dim rpy As Boolean
Dim tf
Dim us As Integer
On Error GoTo strerrmag
Set cmd = New ADODB.Command
Set rs = New ADODB.Recordset
conn.CursorLocation = adUseClient
If addFlag = False Then rpy = True
With cmd
     .ActiveConnection = conn
   Select Case StrConv(texttype, vbUnicode)
     Case 1:
     .CommandType = adCmdText
     Case 2:
     .CommandType = adCmdTable
     Case 3:
     .CommandType = adCmdStoredProc
   End Select
   .CommandText = StrConv(text, vbUnicode)
   .NamedParameters = True
   If Len(StrConv(blbm, vbUnicode)) > 0 Then
   tf = Split(StrConv(blbm, vbUnicode), "~")
.Parameters.Append .CreateParameter("@bmz", adVarChar, adParamInput, 200, tf(0))
.Parameters.Append .CreateParameter("@xgz", adVarChar, adParamInput, 20000000, tf(1))
  .Parameters.Append .CreateParameter("@jlr", adVarChar, adParamInput, 200, tf(2))
   .Parameters.Append .CreateParameter("@jlsjt", adVarChar, adParamInput, 200, tf(3))
    .Parameters.Append .CreateParameter("@ID", adVarChar, adParamInput, 200, tf(4))
   End If
     Set rs = .Execute()
     End With
     addFlag = True
     opencmd = True
strerrmag:
     opencmd = False
     If Err.Number <> 0 Then
     MsgBox Err.Number & " " & Err.Description, vbQuestion, "发生了一个错误!", 48, "提示"
End If
Set tf = Nothing
End Function
Public Sub cloRs()
On Error Resume Next
If rs.State <> adStateClosed Then rs.Clone
Set rs = Nothing '释放记录集
End Sub
‘’--以上有六个过程。opencn 连接数据。OPENRS 执行SQL 语句。OPENCMD 执行存储过程，带参数。CLOSCN CLOSrS 关闭连接和释放资源，还有RSADO  要注意上面接收时使用的StrConv(strsql, vbUnicode) 。不然会乱码

在安装大牛马的工具后。生成DLL 时，就会出现如图“

我们选中所需要导出的函数后，点击确认
此时，DLL 文件就制作好，我们如何来使用它呢。看下文
Private Declare Function OpenCn Lib "Std_DLL.dll" (ByVal Cip As String, ByVal kl As String, ByVal users As String, ByVal pw As String) As Boolean '连接数据库
Private Declare Function opencmd Lib "Std_DLL.dll" (ByVal text As String, ByVal texttype As Integer, ByVal blbm As String, ByVal blbz As String) As Boolean '传参查询，执行存储过程
Private Declare Sub cloRs Lib "Std_DLL.dll" ()
Private Declare Sub cloCn Lib "Std_DLL.dll" ()
Private Declare Function rsado Lib "Std_DLL.dll" ()yVal text As String, ByVal texttype As Integer, ByVal blbm As String, ByVal blbz As String) As Boolean '传参查询，执行存储过程
像声明系统的API 一样，写上名称和参数类型即可。（最注要的是，此时你会发现，此DLL 是无需用REGSVR32 来注册的，放在程序目录中，或是丢在SYSTEM32 中就可以直接使用了）
运行效果如下图

1，当然能生成DLL 无窗体，也可以DLL带窗体，只是需要在处理下！
打开工程，新建模块。
输入以下内容
Option Explicit
Private Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, _
                                       ByVal bInheritHandle As Long, _
                                       ByVal dwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "Kernel32" (ByVal hProcess As Long, _
                                       ByVal lpBaseAddress As Long, _
                                       ByRef lpBuffer As Any, ByVal nSize As Long, _
                                       ByRef lpNumberOfBytesWritten As Long) As Long
Private Declare Function GetCurrentProcessId Lib "Kernel32" () As Long
Private Declare Function SetErrorMode Lib "Kernel32" (ByVal wMode As Long) As Long
Private Declare Function VBDllGetClassObject Lib "MSVBVM60.dll" (g1 As Long, _
                                       g2 As Long, ByVal g3_vbHeader As Long, _
                                       REFCLSID As Long, pREFIID As Any, ppv As Long) As Long

Private Const SEM_NOGPFAULTERRORBOX As Long = 2&
Private Const PROCESS_VM_READ       As Long = 16&
Private m_lMainThread   As Long
Private m_lMainHandle   As Long
Private m_lFakeHeader   As Long
' - - - - - - - - - - - - - - -
Private Sub Main(): End Sub   ' 不要修改或删除这行 ！！！
' - - - - - - - - - - - - - - -
Private Function MainInit(ByVal hMod As Long, ByVal hAppInst As Long) As Long
      Dim aGUID(15)  As Byte
      Dim lDummy  As Long
      Dim lRetVal As Long
   m_lMainHandle = hMod
   m_lFakeHeader = GetFakeHeader
   Call SetErrorMode(SEM_NOGPFAULTERRORBOX)
   If (m_lFakeHeader) Then
      aGUID(0) = 1
      aGUID(8) = 192
      aGUID(15) = 70
      Call VBDllGetClassObject(hMod, lDummy, m_lFakeHeader, lDummy, aGUID(0), lDummy)
      lRetVal = 0&
   Else
      lRetVal = -1&
   End If
   MainInit = lRetVal
End Function
Private Function GetFakeHeader() As Long
      Dim bData(1023)   As Byte
      Dim sFakeFlag     As String
      Dim lDataPnt      As Long
      Dim lhProc        As Long
      Dim lRetVal       As Long
   sFakeFlag = ChrW$(16982) & ChrW$(8501)
   lDataPnt = m_lMainHandle
   lhProc = OpenProcess(PROCESS_VM_READ, 0&, GetCurrentProcessId)
   If (lhProc) Then
      Do
         If (ReadProcessMemory(lhProc, lDataPnt, bData(0), 1024&, 0&) = 0&) Then lRetVal = 0&: Exit Do
         lRetVal = InStrB(1&, bData, sFakeFlag)
         If (lRetVal) Then lRetVal = lDataPnt + lRetVal - 1&:  Exit Do
         lDataPnt = 1020& + lDataPnt
      Loop
      Call CloseHandle(lhProc)
   End If
   GetFakeHeader = lRetVal
End Function
按照生成以上DLL 的方式，生成DLL文件即可
在自己的工作中，加上以上DLL 文件API 声明
Option Explicit
Private Declare Function MainInit Lib "DLL_Init" (ByVal hMod As Long, ByVal hAppInst As Long) As Long
Private mlHModule As Long
Private Sub Main(): End Sub
Private Function DllMain(ByVal hModule As Long, _
    ByVal ul_reason_for_call As Long, _
    ByVal lpReserved As Long) As Long
    mlHModule = hModule
    DllMain = 1
End Function
Private Sub AABCTY15(ByVal hInst As Long, ByVal tf As String, ByVal yst As Integer, zdyzd As String)
    Call MainInit(mlHModule, hInst)                                             '必须！！！
    cz = StrConv(tf, vbUnicode)                                                 '获取数据连接
    ys = StrConv(yst, vbUnicode)
    selects = StrConv(zdyzd, vbUnicode)
    Form2.Show
End Sub
如下图

在主工程就，你就可以使用
Private Declare Sub AABCYTP15 Lib "AABO.dll" (ByVal hInst As Long, ByVal user As String, ByVal langit As String)  'DLL连接模块
Call AABCYTP15(App.hInstance, jsq, yyzs) ‘调用DLL窗体文件
回到正题。我们实现了DLL窗体和无DLL窗体后在来谈谈SSTAB 的子类化
源码我就不贴了。最后面有该文中所提到的事例下载。
其实SSTAB 并不适合来做导H条，因为，即例是子类化后，在SSTAB 生成多个标签后也不能，指定标签删除。只能选择隐藏。可能我技术不行
例：如现在生成的SSTAB五个标签。1，2，3，4，5 你只能按顺序删除标签。也就是先删除5 然后删除4 不能先删除0或是1.
最后因为前面做了很多东西，不想在去改，就用到了隐的方法。网上流传对SSTAB 子类化的模块。也没有针对这个做处理
不过我分享的已以修复了这些问题。加上了一些自绘。和图标功能
所以大家如果想做好像的导H条，可以使用PICTURE 来。效果一样，而且更好控制
-------------------------
话太多了。最后分享下，以上代码的源文件吧
http://pan.baidu.com/s/1geK2Arx
密码:bb4m

xtahtygyqq

，哎呀工具太老了，没人感兴趣了，哈哈！

kk1212

这个感觉眼前一亮，很新颖

小吴昊

以前学习的GDI现在还行