VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
楼主: 410023425

[分享] VB入门技巧N例

[复制链接]
 楼主| 发表于 2007-1-21 13:34:52 | 显示全部楼层
如何使Form的背景图随Form大小改变

: 我在表单的 picture 属性设好一个图, 成为表单的背景图,
: 但是当表单的大小拉大, 超过图案大小时, 就露出难看的空白,
: 请问如何设定, 才能让背景图随表单的大小而 stretch (伸展开来) 呢 ?

单纯显示图形用Image即可,而且用Image也正好可解决你的问题
设定Image的Stretch=true
在加入以下的code
Private Sub Form_Resize()
Image1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

或者使用以下的方式来做也可以

Private Sub Form_Paint()
Me.PaintPicture Me.Picture, 0, 0, ScaleWidth, ScaleHeight
End Sub
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-1-21 13:36:24 | 显示全部楼层
拖动无标题窗口
     通常我们是拖动标题栏来移动窗口,当没有标题栏时,该如何来拖动窗口呢?方法是 当我们在窗口区按下鼠标左键时,调用ReleaseCapture函数,释放鼠标的俘获,同时 发送移动标题栏的消息,就可以实现窗口的拖动。
下面的例子实现了该功能。
>>步骤1----建立新工程,在窗体上放置CommandButton按钮。
>>步骤2----改变窗体的外观,使BorderStyle = 0(None)
>>步骤3----编写如下代码:

Private Declare Function ReleaseCapture Lib "user32" () As Long
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 Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

Private Sub Command1_Click()
    End
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ReleaseCapture
    SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0
    'SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
    '上述两种方法都能实现该功能。
End Sub

>>步骤4----编译运行,在窗体上按下鼠标左键,是不是可以拖动了?按下Command1结束。
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-1-21 14:11:52 | 显示全部楼层
捕捉 MouseExit 事件   
      
MouseDown、MouseUp、MouseMove。VB 似乎提供了很好的 Mouse 事件。但好象还缺少什么!对!还差 MouseExit(鼠标移出)事件。在 VB 中,我们要捕捉 MouseExit 事件,必须用 API 函数:
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
然后,我们可以在控件(以 Picture1 为例)的 MouseMove 事件上加上以下代码:

With Picture1 'Change this to the name of the control
If Button = 0 Then
If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
'Mouse pointer is outside button, so let other controls receive
'mouseevents too:
ReleaseCapture
' 放入鼠标离开的代码
Else
' Mouse pointer is over button, so we'll capture it, thus
' we'll receive mouse messages even if the mouse pointer is
' not over the button
SetCapture .hwnd

' 放入鼠标进入的代码
End If
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-1-21 16:44:26 | 显示全部楼层
原帖由 410023425 于 2007-1-21 14:11 发表
捕捉 MouseExit 事件   
      
MouseDown、MouseUp、MouseMove。VB 似乎提供了很好的 Mouse 事件。但好象还缺少什么!对!还差 MouseExit(鼠标移出)事件。在 VB 中,我们要捕捉 MouseExit 事件,必须用 A ...

83楼的代码少end with 和 end if ,不好意思啊  从网上找得资料,我看都没有看就发上来了,太不负责了!
修改以后的
Option Explicit

Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
'然后,我们可以在控件(以 Picture1 为例)的 MouseMove 事件上加上以下代码:

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With Picture1 'Change this to the name of the control
        If Button = 0 Then
            If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
            'Mouse pointer is outside button, so let other controls receive
            'mouseevents too:
            ReleaseCapture
            MsgBox "鼠标离开"
            Else
            ' Mouse pointer is over button, so we'll capture it, thus
            ' we'll receive mouse messages even if the mouse pointer is
            ' not over the button
            SetCapture .hWnd
            'MsgBox "鼠标进入"
            End If
        End If
    End With
End Sub

[ 本帖最后由 410023425 于 2007-1-21 16:47 编辑 ]

桌面.rar

1.62 KB, 下载次数: 166

回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-1-21 17:14:24 | 显示全部楼层
SHELL语句用法心得



一. 调用系统“创建快捷方式”向导
  是否为VB不支持创建快捷方式而于着急呢?虽然您可以调用vb5stkit.dll中的fCreateShellLink函数,但它是为安装程序设计的,快捷方式的默认路径总是从当前用户的“\Start Menu\Programs”开始,也就是说,如果您的Windows95装在C盘上,您无法通过 fCreateShellLink 函数把快捷方式创建到D盘上去。
  现在,给大家介绍一种极为方便、巧妙的方法: 用Shell语句调用系统“创建快捷方式”向导。
  新建一个项目,在窗体上放一个按钮,双击此按钮,加入以下代码:

Private Sub Command1_Click()
  Open App.Path & "\temp.lnk" For Output As #1
  Close #1 '以上两句在程序所在目录建立一个临时文件
  Shell "Rundll32.exe AppWiz.Cpl,NewLinkHere "& App.Path & "\temp.lnk"
End Sub

  (注意:Shell语句中NewLinkHere后面跟着一个空格才是引号,否则将出错。)
  运行程序,按一下命令按钮,怎么样?“创建快捷方式”向导出现了,如果创建成功,快捷方式将取 代临时文件temp.lnk的位置,如果选取消,temp.lnk 也会自动消失。当然,您可以在硬盘的任意位置建立 temp.lnk。好,现在又可以为您的程序增添一项新功能了。Enjoy!

二. Rundll32.exe的用途
  我们知道,用Shell语句只能调用可执行文件,即 exe、com、bat 和 pif 文件,有时我们想要调用其他一 些系统功能该怎么办呢?此时,Windows提供的 Rundll32.exe可大显身手了。下面我们来认识一下这些用法,也许会给您带来一点惊喜。
  1.要打开设置系统时间的控制面板文件 (Timedate.cpl),只需运行如下代码:
  Shell "Rundll32.exe
  Shell32.dll,Control_RunDLL Timedate.cpl"
  至于打开其他控制面板文件,相信您一定能够举一反三,尝试一下,换个文件名就成了。
  2.要运行某一快捷方式(*.lnk)则可以用以下代码:
  She11 "Rundll32.exe url.dll, FileProtocolHandler X"
  (X代表要运行的文件,包括路径,下同。)
  3. 也可以这样写来打开ActiveMovie控制:
  Shell "RUNDLL32.EXE amovie.ocx,Rundll",1
  而用Shell "RUNDLL32.EXE amovie.ocx,Rundll /play X",1 将直接播放媒体文件。
  4. Shell "rundll32.exe desk.cpl,InstallScreenSaver X”当然是安装屏幕保护啦,如果你写了一个屏幕保护程序,那么可以在安装程序中写上它,而不一定要装到system目录下。顺便提一下,VB不是自捞一个“Application Setup Wizard”么?它的VB源代码都在安装目录下的 “\setupkit\setup1”中放着呢,好好把它研究一下。 你完全能做出富有个性的安装程序来。
  5.按住shift键,右击某一文件,菜单中会出现 “打开方式”选项,这也许已不是什么秘密。但现在, 用shell "rundll32.exe shell32.dll OpenAs_RunDLL X" 便能直接调用“打开方式”框。
  6. 甚至能用这样一句来打印文件(包括HTML所 支持的所有文本与图像格式):
  Shell "rundll32.exe MSHTML.DLL,PrintHTML X”, 1
  怎么样?是不是小有收获呢?这下,您一定会对 Rundll32.exe这个平时不起眼的文件另眼相待了,它可是系统运行必不可少的部件呢!其实 Shell+Rundll32 还能调用其他许多系统功能,比如关于NetMeeting和Telnet方面的。如果您有兴趣,可以 到往册表的“我的电脑\HKEY_CLASSES_ROOT\”或“我的电脑\HKEY_LOCAL_MACHINE\Software\CLASSES”下 去看看,本文的内容大都是从那里“抄”来的。只要有足够的决心、信心、耐心,您一定能发现更多有价值的东西。
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-1-21 19:49:38 | 显示全部楼层
Option Explicit
'如何知道计算机是否安装声卡?
'声明:
Private Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long

Private Sub Command1_Click()
    If waveOutGetNumDevs() Then
        MsgBox "系统安装了声卡。", vbInformation
    Else
        MsgBox "系统无声卡。", vbInformation
    End If
End Sub

新建文件夹.rar

1.37 KB, 下载次数: 164

回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-1-21 20:17:17 | 显示全部楼层
获得文本框中光标所在行的内容   

'在form中放一个textBox两个label
Const EM_GETSEL = &HB0
Const EM_LINEFROMCHAR = &HC9
Const EM_LINEINDEX = &HBB

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

Public Sub GetCaretPos(ByVal hwnd5 As Long, LineNo As Long, ColNo As Long)
Dim i As Long, j As Long
Dim lParam As Long, wParam As Long
Dim k As Long
i = SendMessage(hwnd5, EM_GETSEL, wParam, lParam)
j = i / 2 ^ 16 '取得目前Caret所在前面有多少个byte
LineNo = SendMessage(hwnd5, EM_LINEFROMCHAR, j, 0) '取得前面有多少行
LineNo = LineNo + 1
k = SendMessage(hwnd5, EM_LINEINDEX, -1, 0)
'取得目前caret所在行前面有多少个byte
ColNo = j - k + 1
End Sub

Private Sub Form_Load()
Dim LineNo As Long, ColNo As Long

Call GetCaretPos(Text1.hwnd, LineNo, ColNo)
Label1.Caption = LineNo
Label2.Caption = ColNo

End Sub

Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
Dim LineNo As Long, ColNo As Long

Call GetCaretPos(Text1.hwnd, LineNo, ColNo)
Label1.Caption = LineNo
Label2.Caption = ColNo

End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim LineNo As Long, ColNo As Long

Call GetCaretPos(Text1.hwnd, LineNo, ColNo)
Label1.Caption = LineNo
Label2.Caption = ColNo

End Sub

新建文件夹.rar

1.84 KB, 下载次数: 158

回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-1-22 09:04:25 | 显示全部楼层
让窗口运行在不同的分辨率下
Dim dxSet As New DirectX7
'声明DirectX7对象
Dim ddSet As DirectDraw7
'声明DirectDraw7对象
Dim DisModesEnum As DirectDrawEnumModes
'声明DirectDrawEnumModes对象
Dim dds2 As DDSURFACEDESC2

'以下四个数组存储显示模式的相关数据
Dim lntWid(100) As Integer
'存储宽度
Dim lntHig(100) As Integer
'存储高度
Dim lntBB(100) As Integer
'存储颜色位数
Dim lntRefR(100) As Integer
'存储刷新频率
Private Sub Command1_Click()
    Dim intSel As Integer
    intSel = List1.ListIndex
    '取得在列表框中选择的显示模式
    Call ddSet.SetCooperativeLevel(Me.hWnd, DDSCL_ALLOWMODEX Or DDSCL_FULLSCREEN Or DDSCL_EXCLUSIVE)
    '设置协作水平
    ddSet.SetDisplayMode lntWid(intSel), lntHig(intSel), lntBB(intSel), lntRefR(intSel), DDSDM_DEFAULT
    '设置显示模式
End Sub

Private Sub Form_Load()
    Set ddSet = dxSet.DirectDrawCreate("")
    'dxSet建立DirectDraw对象ddSet
    ddSet.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL
    '设置协作水平
    Set DisModesEnum = ddSet.GetDisplayModesEnum(DDEDM_DEFAULT, dds2)
    'DisModesEnum获得支持的显示模式
     
     For i = 1 To DisModesEnum.GetCount()
        DisModesEnum.GetItem i, dds2
        '将指定的显示模式的相关数据存入dds2
        lntWid(i) = dds2.lWidth
        '将该显示模式下的宽度存入数组lntWid
        lntHig(i) = dds2.lHeight
        '将该显示模式下的高度存入数组lntHig
        lntBB(i) = dds2.ddpfPixelFormat.lRGBBitCount
        '将该显示模式下的色彩深度存入数组lntBB
        lntRefR(i) = dds2.lRefreshRate
        '将该显示模式下的刷新率存入数组lntRefR
        List1.AddItem "显示模式:" + Str(i - 1) + _
                      "      宽度" + Str(lntWid(i)) + _
                      "      高度" + Str(lntHig(i)) + _
                      "      颜色位数" + Str(lntBB(i)) + _
                      "      刷新率" + Str(lntRefR(i))
    Next
    '在列表框中显示各种显示模式的宽度、高度、色彩深度、刷新率,并为各显示模式编号
End Sub

[ 本帖最后由 410023425 于 2007-1-22 09:05 编辑 ]

让窗口运行在不同的分辨率下.rar

2.03 KB, 下载次数: 190

回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-1-22 09:20:49 | 显示全部楼层
字形窗口
Private Declare Function BeginPath Lib "gdi32" _
                (ByVal hdc As Long) _
                As Long

Private Declare Function SetBkMode Lib "gdi32" _
                (ByVal hdc As Long, _
                ByVal nBkMode As Long) _
                As Long

Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" _
                (ByVal hdc As Long, _
                ByVal x As Long, _
                ByVal y As Long, _
                ByVal lpString As String, _
                ByVal nCount As Long) _
                As Long

Private Declare Function EndPath Lib "gdi32" _
                (ByVal hdc As Long) _
                As Long

Private Declare Function PathToRegion Lib "gdi32" _
                (ByVal hdc As Long) _
                As Long

Private Declare Function SetWindowRgn Lib "user32" _
                (ByVal hWnd As Long, _
                ByVal hRgn As Long, _
                ByVal bRedraw As Boolean) _
                As Long

Private Declare Function SelectObject Lib "gdi32" _
                (ByVal hdc As Long, _
                ByVal hObject As Long) _
                As Long
               
Private Declare Function CreateFont Lib "gdi32" _
                Alias "CreateFontA" _
                (ByVal H As Long, _
                ByVal W As Long, _
                ByVal E As Long, _
                ByVal O As Long, _
                ByVal W As Long, _
                ByVal I As Long, _
                ByVal u As Long, _
                ByVal S As Long, _
                ByVal C As Long, _
                ByVal OP As Long, _
                ByVal CP As Long, _
                ByVal Q As Long, _
                ByVal PAF As Long, _
                ByVal F As String) _
                As Long
               
Private Const OPAQUE = 2
Private Const TRANSPARENT = 1

Private Const ANSI_CHARSET = 0
Private Const FW_HEAVY = 900
Private Const OUT_DEFAULT_PRECIS = 0
Private Const CLIP_DEFAULT_PRECIS = 0
Private Const DEFAULT_QUALITY = 0
Private Const DEFAULT_PITCH = 0
Private Const FF_SWISS = 32      '  Variable stroke width, sans-serifed.

Private Sub Form_Load()
    Dim dc As Long
    Dim m_wndRgn As Long
    Dim m_Font As Long
    Dim m_OldFont As Long
   
    dc = Me.hdc
    m_Font = CreateFont(150, 80, 0, 0, FW_HEAVY, 0, 0, _
                       0, ANSI_CHARSET, OUT_DEFAULT_PRECIS, _
                       CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, _
                       DEFAULT_PITCH Or FF_SWISS, "宋体")
    BeginPath dc
    '开始记录窗体轮廓路径
    SetBkMode dc, TRANSPARENT
    '设置背景为透明模式,这是必须有的
    m_OldFont = SelectObject(dc, m_Font)
    TextOut dc, 0, 0, "伟", 3
    SelectObject dc, m_OldFont
    EndPath dc
    '结束记录窗体轮廓路径
    m_wndRgn = PathToRegion(dc)
    '把所记录的路径转化为窗体轮廓句柄
    SetWindowRgn Me.hWnd, m_wndRgn, True
    '赋予窗体指定的轮廓形状
End Sub

字形窗口.rar

72.5 KB, 下载次数: 182

回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-1-22 09:26:52 | 显示全部楼层
控件随着窗口大小按比例变化
Dim TT, TL, TW, TH As Single
Dim CT, CL, CW, CH As Single
Dim LT, LL, LW, LH As Single
Dim CMT, CML, CMW, CMH As Single
Private Sub Form_Load()
    TT = Text1.Top
    TL = Text1.Left
    TW = Text1.Width
    TH = Text1.Height
    '保存Text1控件的Top、Left、Width和Height属性
    CT = Combo1.Top
    CL = Combo1.Left
    CW = Combo1.Width
    CH = Combo1.Height
    '保存Combo1控件的Top、Left、Width和Height属性
    LT = List1.Top
    LL = List1.Left
    LW = List1.Width
    LH = List1.Height
    '保存List1控件的Top、Left、Width和Height属性
    CMT = Command1.Top
    CML = Command1.Left
    CMW = Command1.Width
    CMH = Command1.Height
    '保存Command1控件的Top、Left、Width和Height属性
End Sub


Private Sub Form_Resize()
    Form1.ScaleHeight = 1000
    Form1.ScaleWidth = 1000
    Text1.Top = TT
    Text1.Left = TL
    Text1.Width = TW
    Text1.Height = TH
    '设置Text1的位置和大小
    List1.Top = LT
    List1.Left = LL
    List1.Width = LW
    List1.Height = LH
    '设置List1的位置和大小
    Combo1.Top = CT
    Combo1.Left = CL
    Combo1.Width = CW
'    Combo1.Height = CH
    '设置Combo1的位置和大小
    Command1.Top = CMT
    Command1.Left = CML
    Command1.Width = CMW
    Command1.Height = CMH
    '设置Command1的位置和大小
End Sub

控件随着窗口大小按比例变化.rar

1.66 KB, 下载次数: 190

回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2021-4-12 03:47

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表