VB程序员博客

VB程序开发

在网上搜到两个浏览文件夹的API函数,效果还真的不错,比起dirlistbox要强:

Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

不过浏览时是要弹出一个新的浏览窗口,如果不想弹出窗口直接在原窗口的某个容器中显示就更好了,不知如何实现?

想法不错………………

友情Up………..
要弹出一个新的浏览窗口 那是没办法的, 因为那毕竟是第三方的外部程序, 前阵子我也在研究这问题,也发了帖但得不到结果, 最后我用了 Timer 就让它定位.

浏览文件夹的窗口大小调整后移到你想要的位置

Private Sub Timer1_Timer()
  hProcess = FindWindow(vbNullString, "浏览文件夹")
  If hProcess > 0 Then
      Call SetWindowPos(hProcess, -1, (Me.Left + Frame1.Left + 60) 15, (Me.Top + Dir1.Top + 450) 15, Frame1.Width 15, Frame1.Height 15, SWP_NOSENDCHANGING)
      Timer1.Enabled = False
  End If
End Sub没有更好办法了吗?没有满意答案,但也要结帖散分,见者有份。


Function keyWndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

      If Msg = WM_HOTKEY Then
          Select Case wParam 'wParam 值就是 key_idHotKey
              Case 1 '激活 3 个热键后,3 个热键所对应的操作,大家在其他的程序中,只要修改此处就可以了
                  query.WindowState = 0
query.Show

Shell_NotifyIcon NIM_DELETE, tray
              Call getmydata
             
              X = Trim(query.bdh.Text)
X = X + 1
query.bdh.Text = X
              Case 2
               
                  query.Hide
Call tuopan

              Case 3
                 
                  MsgBox "alt+3"
              Case 4
                  MsgBox "alt+4"
          End Select
      End If
   
'      将消息传送给指定的窗口
      keyWndproc = CallWindowProc(key_preWinProc, hwnd, Msg, wParam, lParam)
   
End Function

Function SetHotkey(ByVal KeyId As Long, ByVal KeyAss0 As String, ByVal Action As String)
      Dim KeyAss1 As Long
      Dim KeyAss2 As String
      Dim i As Long
   
      i = InStr(1, KeyAss0, ",")
      If i = 0 Then
          KeyAss1 = Val(KeyAss0)
          KeyAss2 = ""
      Else
          KeyAss1 = Right(KeyAss0, Len(KeyAss0) - i)
          KeyAss2 = Left(KeyAss0, i - 1)
      End If
   
      key_idHotKey = 0
      key_Modifiers = 0
      key_uVirtKey = 0
   
      If key_IsWinAddress = False Then    '判断是否需要取得窗口信息,如果重复取得,再最后恢复窗口时,将会造成程序死掉
'          记录原来的window程序地址
          key_preWinProc = GetWindowLong(query.hwnd, GWL_WNDPROC)
'          用自定义程序代替原来的window程序
          SetWindowLong query.hwnd, GWL_WNDPROC, AddressOf keyWndproc
      End If

      key_idHotKey = KeyId
      Select Case Action
          Case "Add"
              If KeyAss2 = "Ctrl" Then key_Modifiers = MOD_CONTROL
              If KeyAss2 = "Alt" Then key_Modifiers = MOD_ALT
              If KeyAss2 = "Shift" Then key_Modifiers = MOD_SHIFT
              If KeyAss2 = "Ctrl+Alt" Then key_Modifiers = MOD_CONTROL + MOD_ALT
              If KeyAss2 = "Ctrl+Shift" Then key_Modifiers = MOD_CONTROL + MOD_SHIFT
              If KeyAss2 = "Ctrl+Alt+Shift" Then key_Modifiers = MOD_CONTROL + MOD_ALT + MOD_SHIFT
              If KeyAss2 = "Shift+Alt" Then key_Modifiers = MOD_SHIFT + MOD_ALT
              key_uVirtKey = Val(KeyAss1)
              RegisterHotKey query.hwnd, key_idHotKey, key_Modifiers, key_uVirtKey '向窗口注册系统热键
              key_IsWinAddress = True '不需要再取得窗口信息
           
          Case "Del"
              SetWindowLong query.hwnd, GWL_WNDPROC, key_preWinProc '恢复窗口信息
              UnregisterHotKey query.hwnd, key_uVirtKey '取消系统热键
              key_IsWinAddress = False '可以再次取得窗口信息
      End Select
End Function

Public Sub WriteToIni(ByVal Filename As String, ByVal Section As String, ByVal Key As String, ByVal Value As String)
    Dim buff As String * 128
    buff = Value + Chr(0)
    WritePrivateProfileString Section, Key, buff, Filename
End Sub
Public Function ReadFromIni(ByVal Filename As String, ByVal Section As String, ByVal Key As String) As String
    Dim i As Long
    Dim buff As String * 128
    GetPrivateProfileString Section, Key, "", buff, 128, Filename
    i = InStr(buff, Chr(0))
    ReadFromIni = Trim(Left(buff, i - 1))
End Function

其中ALT_1下为我的程序执行项,显示主窗口,并读数
ALT_2为隐藏窗口
我不知道怎么把这2个快捷键换成F10,F11,请帮忙改下,上述程序执行是没问题的上面多贴了段写INI的函数,这个别管,呵呵,贴多了query是程序的主form

下面一个vbKeyF10 —>vbKeyF11<


在这个网站提供的一个示例程序,《MSFlexgrid控件气泡提示及鼠标钩子源码 》
http://www.codefans.net/search.php?keyword=msflexgrid&searchbutton.x=45&searchbutton.y=10

变量声明如下:
    Option Explicit   
    Private Declare Function ShellExecute Lib "shell32" 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
   
    'API call to get Balloon Tips working
    Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
   
    'Declare of a new Tool Tip Object
   
    Dim MSFlexGrid1_Tip                  As New clsTooltips
   
    Dim c                                As Integer  'Column
    Dim r                                As Integer  'Row
    Dim Operator1                        As String

在操作实际中,本地窗口中看不到c ,r 等内在变量。
这是为什么????????

好像是Private Declare 起的作用。


关于窗口大小的问题,如在form1里面放一个frame1或如label1,当主窗口变大小时,frame1也随着变大,当form变小时,他也随着变小,总之与其应适大小相等

.left * 2 是什么意思呢
我要是高度要怎么表示

哈搞懂了。呵.谢2楼的

Private Sub Form_Resize()
Label1.Height = Form1.Height / 100 * 30
Label1.Width = Form1.Width / 100 * 30
End Sub


我拼凑了一个摄像头照相代码,但照相并给IMAGE1(在“员工信息”窗体中)赋值后,用DISCONNECT 截断与摄像头的联接后,原摄像头处显示黑屏,怎么也去不掉,因为在其他窗体中,不能用UNLOAD ME ,怎么办?

以下为模块:

Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" _
  Alias "capCreateCaptureWindowA" ( _
  ByVal lpszWindowName As String, _
  ByVal dwStyle As Long, _
  ByVal x As Long, _
  ByVal y As Long, _
  ByVal nWidth As Long, _
  ByVal nHeight As Long, _
  ByVal hWndParent As Long, _
  ByVal nID As Long) As Long

Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const WM_USER = &H400
Private Const WM_CAP_START = &H400
Private Const WM_CAP_EDIT_COPY = (WM_CAP_START + 30)
Private Const WM_CAP_DRIVER_CONNECT = (WM_CAP_START + 10)
Private Const WM_CAP_SET_PREVIEWRATE = (WM_CAP_START + 52)
Private Const WM_CAP_SET_OVERLAY = (WM_CAP_START + 51)
Private Const WM_CAP_SET_PREVIEW = (WM_CAP_START + 50)
Private Const WM_CAP_DRIVER_DISCONNECT = (WM_CAP_START + 11)

Private Declare Function SendMessage Lib "user32" _
  Alias "SendMessageA" ( _
  ByVal hwnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  lParam As Any) As Long
 

Private Preview_Handle As Long

Public Function CreateCaptureWindow( _
  hWndParent As Long, _
  Optional x As Long = 750, _
  Optional y As Long = 120, _
  Optional nWidth As Long = 320, _
  Optional nHeight As Long = 240, _
  Optional ncameraid As Long = 0) As Long

  Preview_Handle = capCreateCaptureWindow("Video", _
    WS_CHILD + WS_VISIBLE, x, y, _
    nWidth, nHeight, hWndParent, 1)

  SendMessage Preview_Handle, WM_CAP_DRIVER_CONNECT, ncameraid, 0
  SendMessage Preview_Handle, WM_CAP_SET_PREVIEWRATE, 30, 0
  SendMessage Preview_Handle, WM_CAP_SET_OVERLAY, 1, 0
  SendMessage Preview_Handle, WM_CAP_SET_PREVIEW, 1, 0

  CreateCaptureWindow = Preview_Handle
End Function

Public Function CapturePicture(ncapturehandle As Long) As StdPicture
  Clipboard.Clear
  SendMessage ncapturehandle, WM_CAP_EDIT_COPY, 0, 0
  Set CapturePicture = Clipboard.GetData
End Function

Public Sub Disconnect(ncapturehandle As Long, _
  Optional ncameraid = 0)

  SendMessage ncapturehandle, WM_CAP_DRIVER_DISCONNECT, _
    ncameraid, 0
   
 
End Sub

以下为command1 command2 的命令代码,“员工信息”为IMAGE1所在的窗体名称

Private Sub command1_click()
  On Error Resume Next
If Dir$("e:摄像头文件\kkk.jpg") = "" Then
MsgBox "请先采集照片!"
Command1.SetFocus
Else
Set Image1.Picture = LoadPicture("e:摄像头文件\kkk.jpg")
Kill "e:摄像头文件\kkk.jpg"
Command2.Enabled = True
Clipboard.Clear
Disconnect (Video_Handle)
Video_Handle = 0
End If
End Sub

Private Sub command2_click()
  On Error Resume Next
Video_Handle = CreateCaptureWindow(员工信息.hwnd)

If Dir$("e:摄像头文件\kkk.jpg") = "" Then
    Dim x As StdPicture
    Set x = CapturePicture(Video_Handle)
    SavePicture x, "e:摄像头文件\kkk.jpg"
    Command2.Enabled = False
    Else
    Command1.SetFocus
    End If
   
End Sub

command1  command2  的代码有一些修改,但仍不能解决问题,以下为修改后的代码:

Private Sub command1_click()
  On Error Resume Next
    Dim x As StdPicture
    Set x = CapturePicture(Video_Handle)
    Set Image1.Picture = x
Disconnect (Video_Handle)
Video_Handle = 0
Command2.Enabled = True
Command1.Enabled = False
Clipboard.Clear
End Sub

Private Sub command2_click()
  On Error Resume Next
Video_Handle = CreateCaptureWindow(员工信息.hwnd)
Command2.Enabled = False
Command1.Enabled = True
End Sub

解决了,我新建了一个窗口,专门用来照相。


我现在要实现多个窗口的定时切换,例如,我机器打开了6个EXCEL,我想间隔1分钟就换一个EXCEL在最前面显示,我不想用鼠标动作来完成,我在网上搜了相关的资料,都是针对进程名切换的,可我的进程统一叫EXCEL.EXE,唯一的办法就是根据进程PID切换,因为我还有针对PID结束进程的,哪位能告诉我如何利用进程PID进行多个见面的轮流前置显示。

不懂,帮顶

不懂,up

不懂,up

能否把你最初的需求写出来?


postmessage函数,我今天打开了一个游戏,准备向这个游戏窗口发送键盘命令,我把快捷键1的位置设置为攻击,但是postmessage函数不起作用,当我把游戏里的对话框打开时再次用这个函数,可以在对话框里发送1,这说明我的窗口的句柄以及postmessage函数写的都没有问题,这是什么原因?还是得用其他函数?

同意楼上的方法,若能熟练使用sendkey函数,你能发现这个函数可以帮你做很多东东

用sendmessage试试,向对话框、记事本提交数据时用postmessage,发送功能键等用sendmessage。

1.是因为游戏的焦点在文本框里吧,看你怎么切换了,你发送一个f1之类的试一下
2.有的软件也会越过系统直接读取键盘信息,如果你发送一个“1”,软件用getkeystate()后,就知道这是一个虚拟消息
不会处理

引用 4 楼 star_415 的回复:
1.是因为游戏的焦点在文本框里吧,看你怎么切换了,你发送一个f1之类的试一下
2.有的软件也会越过系统直接读取键盘信息,如果你发送一个“1”,软件用getkeystate()后,就知道这是一个虚拟消息
不会处理
有可能


如果我获得了某个窗口的句柄,我想向该窗口发送按键命令,用什么函数?keybd_event好像只能发送给具有焦点的窗口吧,希望高手解答下,最好能给例子,以及用到函数的参数的说明,谢谢了!!!!!

SendMessage(
  HWND hwnd,      // handle to window
  UINT uMsg,      // WM_KEYDOWN
  WPARAM wParam,  // virtual-key code
  LPARAM lParam    // key data
  );

3Q

3Q

  3Q!!!!!!!!


postmessage函数,我今天打开了一个游戏,准备向这个游戏窗口发送键盘命令,我把快捷键1的位置设置为攻击,但是postmessage函数不起作用,当我把游戏里的对话框打开时再次用这个函数,可以在对话框里发送1,这说明我的窗口的句柄以及postmessage函数写的都没有问题,这是什么原因?还是得用其他函数?

同意楼上的方法,若能熟练使用sendkey函数,你能发现这个函数可以帮你做很多东东

用sendmessage试试,向对话框、记事本提交数据时用postmessage,发送功能键等用sendmessage。

1.是因为游戏的焦点在文本框里吧,看你怎么切换了,你发送一个f1之类的试一下
2.有的软件也会越过系统直接读取键盘信息,如果你发送一个“1”,软件用getkeystate()后,就知道这是一个虚拟消息
不会处理

引用 4 楼 star_415 的回复:
1.是因为游戏的焦点在文本框里吧,看你怎么切换了,你发送一个f1之类的试一下
2.有的软件也会越过系统直接读取键盘信息,如果你发送一个“1”,软件用getkeystate()后,就知道这是一个虚拟消息
不会处理
有可能


如果我获得了某个窗口的句柄,我想向该窗口发送按键命令,用什么函数?keybd_event好像只能发送给具有焦点的窗口吧,希望高手解答下,最好能给例子,以及用到函数的参数的说明,谢谢了!!!!!

SendMessage(
  HWND hwnd,      // handle to window
  UINT uMsg,      // WM_KEYDOWN
  WPARAM wParam,  // virtual-key code
  LPARAM lParam    // key data
  );

3Q

3Q

  3Q!!!!!!!!