VB程序员博客

VB程序开发

在VB类模块中能不能对自己设置"窗口过程"啊?

怎么才能让类模块接收、处理自定义消息?

求解!人工直顶…楼主你说的是SetWindowLong窗口子类化那些东西吗?<
在类模块里面用SetWindowLong 老报最后一个参数WindowProc 不对
也不能加AddressOf
怎么办?不能加AddressOf
是因为取不到 后面的函数地址吧谁有和类模块有关的子类化例子 (不知道我的问法有没有错误…⊙﹏⊙)

麻烦贴一下

求救啊!!!

土办法,标准模块的调类模块的wnd不就行了。

模准模里写:
sub MyWinProc()
  oClass.WinProc()
end sub 

AddressOf 可以取到 MyWinProc了。<

<


原谅我的无知,我从来没有学习过编程基础,汗一个

但是通过google,以及论坛上的大虾们教导,也有了一些编程经验。
程序代码越来越多,我就越来越不会管理自己的代码。

我用winsock写了ftp上传和下载的代码,代码有一大堆了,但还只是我这个项目的一小部分,
我怎么管理这些代码呢?

将ftp的这部分放入一个标准模块中?标准模块不能使用winsock控制,还是使用类模块,或者?
谢谢大家。
友情支持!up……!

你怎么知道标准模块不能使用winsock控制?
一般写成过程或函数,关键地方加上标注2楼的办法不错啊尽量使用类模块,因为它们具有一定的封装性,方便代码重写和维护。还是用类模块封装好。类模块中使用2楼的方法一个好用的代码编辑器(比如Ultra Edit)足矣。


工程中有一个cls文件和一个frm文件
cls名称为Student 窗体名称为frmMain
cls文件中的代码如下:
'Student 数据成员的声明
Private strName As String
Private intAge As Integer

'初始化过程,必须的
Private Sub Class_Initialize()

  strName = "请输入你的姓名"
  intAge = 0

End Sub

'Student过程的声明(定义)
'定义一个输入过程,让用户输入数据
Public Sub IuputData()

  strName = InputBox("请输入您的姓名", "提示", strName)
  intAge = InputBox("请输入您的年龄", "提示", intAge)
 
End Sub

'定义打印信息的过程,将输入数据打印在窗体上
Public Sub PrintData(frmPrint As Form)

  frmPrint.Print strName
  frmPrint.Print intAge
 

End Sub

frm文件中的代码为:
Dim clsStu As New Student

Private Sub Form_Click()
  Dim intReply As Integer '询问用户是否打印输入的信息
 
  '调用类的成员函数
  clsStu.IuputData
 
  intReply = MsgBox("是否打印", vbYesNo, "VB类的使用")
 
  If intReply = vbYes Then
    clsStu.PrintData(frmMain)
  Else
      Exit Sub
  End If
 
End Sub

Private Sub Form_Load()

  '设置对象
  Set clsStu = New Student
 
End Sub

Private Sub Form_Unload(Cancel As Integer)

  '清空
  Set clsStu = Nothing

End Sub

程序运行时
clsStu.PrintData(frmMain)这句有错,说是“实时错误,类型不匹配”,怎么想也不明白??
但将 Public Sub PrintData(frmPrint As Form)改成Public Function PrintData(frmPrint As Form)
之后,程序却能运行!(当然,frm文件中调用要做相应的改变)十分不解?前面为何错,后面有为何能运行呢?
请大家帮我看一下。谢谢

多谢,可能今天头晕了
前面有
'调用类的成员函数
  clsStu.IuputData
这句话我居然都没有看出来……太多代码堆在一起了,是会看得眼花的.

所以才需要面向对象的思路进行封装,以管理复杂度……


Option Explicit

Event MouseDown(ByVal HWnd As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, Cancel As Boolean)
Event MouseMove(ByVal HWnd As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, Cancel As Boolean)
Event MouseUp(ByVal HWnd As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, Cancel As Boolean)
Event DblClick(ByVal HWnd As Long, Cancel As Boolean)

'——————————————————————————-
' Class_Initialize
'——————————————————————————-
'  Adds the address of this object to the gcolMouseEventObjects collection
'  and activates the mouse hook.

Private Sub Class_Initialize()
    'Add the address of the object to the collection, using the
    'address as a key.
    gcolMouseEventObjects.Add ObjPtr(Me), CStr(ObjPtr(Me))
    InstallMouseHook
End Sub

'——————————————————————————-
' Class_Terminate
'——————————————————————————-
'  Removes this object from the gcolMouseEventObjects collection
'  and deactivates the keyboard hook.

Private Sub Class_Terminate()
    gcolMouseEventObjects.Remove CStr(ObjPtr(Me))
    RemoveMouseHook
End Sub

'——————————————————————————-
' RaiseDblClick
'——————————————————————————-
'  Raises the DblClick event.

Friend Sub RaiseDblClick(ByVal HWnd As Long, Cancel As Boolean)
    RaiseEvent DblClick(HWnd, Cancel)
End Sub

'——————————————————————————-
' RaiseMouseDown
'——————————————————————————-
'  Raises the MouseDown event.
'
Friend Sub RaiseMouseDown(ByVal HWnd As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, Cancel As Boolean)
    RaiseEvent MouseDown(HWnd, Button, Shift, X, Y, Cancel)
End Sub

'——————————————————————————-
' RaiseMouseMove
'——————————————————————————-
'  Raises the MouseMove event.
'
Friend Sub RaiseMouseMove(ByVal HWnd As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, Cancel As Boolean)
    RaiseEvent MouseMove(HWnd, Button, Shift, X, Y, Cancel)
End Sub

能解释一下这段程序吗

这里的OCX 是什么,许多东西不懂啊

能不能具体点?


先定义了一个类模块Lead

Public Conductor_Earth As Boolean '判别是导线还是地线

Public Name As String '导地线名称

'—-电线的相关参数———
Dim A As Double ' 电线的总截面积
Dim d As Double '电线的直径
Dim M As Double '电线质量
Dim E As Double '弹性系数
Dim af As Double '温度伸长系数
Dim tp As Double '拉断力
Dim F As Double '使用安全系数
Dim AV As Double '平均运行张力占拉断力的百分比
Dim n As Integer '导线分裂数

Dim Fm As Double '最大使用张力
Dim Fa As Double '平均运行应力

'—–比载—————–
Dim g1 As Double '自重力荷载
Dim g2 As Double '冰重力荷载
Dim g3 As Double '自重力加冰重力荷载
Dim g4 As Double '无冰时的风荷载
Dim g5 As Double '覆冰时的风荷载
Dim g6 As Double '无冰时的综合荷载
Dim g7 As Double '覆冰时的综合荷载

Dim wind_a As Double '风压系数
Dim Inequal_wind_a As Double '风压不均匀系数
Dim Figure_a As Double '体形系数
Dim ave_height As Double '电线平均高度

Dim Ge As Double '重力加速度
Dim Ice_thick As Double '定义冰厚

'–重力加速度
Public Property Get Gravity() As Variant
  Gravity = Ge
End Property

Public Property Let Gravity(ByVal vNewGravity As Variant)
  Ge = vNewGravity
End Property

'–冰厚
Public Property Get IceThick() As Variant
  IceThick = Ice_thick
End Property

Public Property Let IceThick(ByVal vNewIceThick As Variant)
  Ice_thick = vNewIceThick
End Property

'–截面积属性
Public Property Get SectionaArea() As Variant
  SectionArea = A
End Property

Public Property Let SectionaArea(ByVal vNewSectionArea As Variant)
  A = vNewSectionArea
End Property

'–直径属性
Public Property Get Diameter() As Variant
  Diameter = d
End Property

Public Property Let Diameter(ByVal vNewDiameter As Variant)
  d = vNewDiameter
End Property

'–单位质量属性
Public Property Get Mass() As Variant
  Mass = M
End Property

Public Property Let Mass(ByVal vNewMass As Variant)
  M = vNewMass
End Property

'–弹性系数属性
Public Property Get ElasticCoefficient() As Variant
  ElasticCoefficient = E
End Property

Public Property Let ElasticCoefficient(ByVal vNewElasticCoefficient As Variant)
  E = vNewElasticCoefficient
End Property

'–温度伸长系数
Public Property Get TemperatureElongate() As Variant
  TemperatureElongate = af
End Property

Public Property Let TemperatureElongate(ByVal vNewTemperatureElongate As Variant)
  af = vNewTemperatureElongate
End Property

(下面还有代码若干,省略)

然后在另外一个类模块OperationMode中,其中一个属性就是Lead变量。

Public Conductor_Earth As Boolean '判别是导线还是地线

Public Name As String '工况名称

Public Mark As String '用于工况排序

Public Jump As Boolean ' 是否被隔越
Public Lcrl As Double '临界档距下限
Public Lcrh As Double '临界档距上限

Dim te As Double ' 传递参数
Dim v As Double
Dim th As Double

Dim tp As Double
Dim tr As Double

Dim L As Lead

Dim ro As Double

'–线模块参量
Public Property Get Line() As Lead
  Line = L
End Property

Public Property Let Line(ByVal vNewLine As Lead)
  Set L = New Lead
  L = vNewLine'——>这里报错!
End Property

(下面还有代码若干,省略)

调试的时候,报错:对象不支持这个属性或方法(错误 438)

在类模块中如何定义和使用自己做的类模块呢?
非常感谢了!

Set objHandleMenu = Nothing →Set objAA = Nothing

up

是放在这里吗?

Public Property Let Line(ByVal vNewLine As Lead)
  Set L = CreateObject(Lead)
  L = vNewLine
End Property

但是还是不对啊?
楼上能不能说具体一点到底是哪里有问题啊?

非常非常感谢!

这样还是有问题。

不明白究竟是怎么回事。可否再指点一下,非常感谢了!

还是这个在VB中没有办法实现啊?
要是这个都没有办法实现,那企不是太痛苦了啊?

lead 是一个类对象,要用set
Public Property Let Line(ByVal vNewLine As Lead)
  'Set L = CreateObject(Lead)
  set L = vNewLine
End Property

设置类变量要用set
Public Property Let Line(ByVal vNewLine As Lead)
  Set L = New Lead
'  L = vNewLine'——>这里报错!
'改成
Set L=vNewLine
End Property

啊,通过了!非常非常感谢大家!


一个form运行3个模块,都使用了GetWindowRect,SetCursorPos,mouse_event,请问会不会在同一时间都使用到mouse_event而出错?
3个模块要是都同时SetCursorPos定位了,就使用mouse_event按键
会不会出现这样的问题呢?谢谢先

引用 1 楼 zjl1234567 的回复:
常规的一个工程不论你有几个模块都是单线程的,所以你的程序中都不会在同一时间做什么事情。
况且mouse_event也是给窗体传递的消息吧,只要窗口不繁忙就没什么问题。

谢谢zjl1234567大虾指点!!!
请问,那就是不要管这个问题了是吧,要是这个电脑运行该软件,而我还要手工操作这个电脑,会不会有什么问题呢?

谢谢先


我在类模块中使用winsock的connect就出现了错误
定义
Private WithEvents Send_Http As Winsock
出错的地方
Send_Http.Connect "127.0.0.1", 80

怎么回事呢?!

建议定义变量不要含有下划线

Private WithEvents s As Timer

Private Sub Class_Initialize()
s.Interval = 100
s.Enabled = True
End Sub

Private Sub s_Timer()
Debug.Print Now
End Sub

这样也会出现错误,是不是类模块中不能使用其他组件哦?!

上面的是class1中的

下面的代码是form1中的
Dim n As Class1

Private Sub Form_Load()
Set n = New Class1
End Sub

引用 3 楼 fisheep_works 的回复:
Private WithEvents s As Timer

Private Sub Class_Initialize()
s.Interval = 100
s.Enabled = True
End Sub

Private Sub s_Timer()
Debug.Print Now
End Sub

这样也会出现错误,是不是类模块中不能使用其他组件哦?!


当然出错了,timer控件没有实例化,可以用settime函数代替timer控件

引用 3 楼 fisheep_works 的回复:
Private WithEvents s As Timer

Private Sub Class_Initialize()
s.Interval = 100
s.Enabled = True
End Sub

Private Sub s_Timer()
Debug.Print Now
End Sub

这样也会出现错误,是不是类模块中不能使用其他组件哦?!


在类模块当中这样子定义s不会自动实例化.由于ActiveX控件的特殊性,不方便这样子使用.建议使用Active Object代替或者最好使用API.


'这个是模块
public   sub   aaa(text   as   string)

end   sub
*****************************************
'下面是窗体的代码
private   sub   form_load()
a= "123 "
aa(a)             '对代码的引用
end   sub

不知道错在哪里,请高手指教。

call   aaa(a)             '对代码的引用
或  
aaa     a

都少了个a,都绕晕了。建议不要这么定义函数或过程。

哦,我试试

调试的时候提示:
编译错误:
缺少变量或过程,不是模块。
怎么办?

过程调用有两种方法:
      Call   aaa(a)  
      aaa   a

当然也可以这样写:
Call   aaa((a))       '强迫按值传递
aaa   (a)       '强迫按值传递,括号前要有空格


当窗体滚动条设置好后,还需要实现鼠标滚动轮会让窗体页面上下移动,于是引用了下面模块代码;
若窗体数量少,用起来还可以,但窗体数量多(如30个以上),因每增加一个窗体,就要加一组代码,于是
软件启动速度就变得很慢,哪位能指点一下问题所在,有什么改进的方法?或有其它更好的办法?
在模块上的代码:
Option   Explicit
Public   Type   POINTL
        x   As   Long
        y   As   Long
End   Type
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

Declare   Function   SetWindowLong   _
        Lib   "USER32 "   Alias   "SetWindowLongA "   _
                (ByVal   hWnd   As   Long,   _
                ByVal   nIndex   As   Long,   _
                ByVal   dwNewLong   As   Long)   As   Long

Declare   Function   SystemParametersInfo   _
        Lib   "USER32 "   Alias   "SystemParametersInfoA "   _
                (ByVal   uAction   As   Long,   _
                ByVal   uParam   As   Long,   _
                lpvParam   As   Any,   _
                ByVal   fuWinIni   As   Long)   As   Long
       
Declare   Function   ScreenToClient   Lib   "USER32 "   _
(ByVal   hWnd   As   Long,   xyPoint   As   POINTL)   As   Long

Public   Const   GWL_WNDPROC   =   -4
Public   Const   SPI_GETWHEELSCROLLLINES   =   104
Public   Const   WM_MOUSEWHEEL   =   &H20A
Public   WHEEL_SCROLL_LINES   As   Long
           
Global   lpPrevWndProc   As   Long

Public   Sub   Hook(ByVal   hWnd   As   Long)
        lpPrevWndProc   =   SetWindowLong(hWnd,   GWL_WNDPROC,   AddressOf   WindowProc)
        Call   SystemParametersInfo(SPI_GETWHEELSCROLLLINES,   0,   WHEEL_SCROLL_LINES,   0)
        If   WHEEL_SCROLL_LINES   >   xj1.VScroll1.Max   Then   '每增加一个窗体,就要加一组相应的代码
                WHEEL_SCROLL_LINES   =   xj1.VScroll1.Max
        End   If
End   Sub

Public   Sub   UnHook(ByVal   hWnd   As   Long)
        Dim   lngReturnValue   As   Long
        lngReturnValue   =   SetWindowLong(hWnd,   GWL_WNDPROC,   lpPrevWndProc)
End   Sub

Function   WindowProc(ByVal   hw   As   Long,   _
                ByVal   uMsg   As   Long,   _
                ByVal   wParam   As   Long,   _
                ByVal   lParam   As   Long)   As   Long
        Dim   pt   As   POINTL
        Select   Case   uMsg
                Case   WM_MOUSEWHEEL
                        If   wParam   =   -7864320   Then
                                If   xj1.VScroll1.Value   <=   xj1.VScroll1.Max   -   1000   Then     '每增加一个窗体,就要加一组相应的代码

                                        xj1.VScroll1.Value   =   xj1.VScroll1.Value   +   1000
                                Else
                                        xj1.VScroll1.Value   =   xj1.VScroll1.Max
                                End   If
                        ElseIf   wParam   =   7864320   Then
                                If   xj1.VScroll1.Value   > =   1000   Then     '每增加一个窗体,就要加一组相应的代码

                                        xj1.VScroll1.Value   =   xj1.VScroll1.Value   -   1000
                                Else
                                        xj1.VScroll1.Value   =   0
                                End   If
                        End   If
                Case   Else
                        WindowProc   =   CallWindowProc(lpPrevWndProc,   hw,   uMsg,   wParam,   lParam)
        End   Select
End   Function

Public   Function   HIWORD(LongIn   As   Long)   As   Integer
    HIWORD   =   (LongIn   And   &HFFFF0000)     &H10000
End   Function

Public   Function   LOWORD(LongIn   As   Long)   As   Integer
            LOWORD   =   LongIn   And   &HFFFF&
End   Function

在窗体上还要加上以下代码:
Private   Sub   Form_Load()
        Hook   Me.hWnd   '鼠标滚轮事件用
End   Sub
Private   Sub   Form_Resize()
        If   Frame1.Height   >   Me.Height   Then
                VScroll1.Visible   =   True
        Else
                VScroll1.Visible   =   False
        End   If
        If   Frame1.Width   >   Me.Width   Then
                HScroll1.Visible   =   True
        Else
                HScroll1.Visible   =   False
        End   If
        HScroll1.Left   =   0
        HScroll1.Top   =   Me.ScaleHeight   -   HScroll1.Height
        VScroll1.Left   =   Me.ScaleWidth   -   VScroll1.Width
        VScroll1.Top   =   0
        HScroll1.Width   =   Me.ScaleWidth
        VScroll1.Height   =   Me.ScaleHeight
        If   VScroll1.Visible   =   True   Then
                If   HScroll1.Visible   =   True   Then
                      HScroll1.Width   =   Abs(Me.ScaleWidth   -   VScroll1.Width)
                      VScroll1.Height   =   Abs(Me.ScaleHeight   -   HScroll1.Height)
                End   If
        End   If
        HScroll1.Max   =   (Frame1.Width   -   Me.Width)   +   3   *   VScroll1.Width
        VScroll1.Max   =   (Frame1.Height   -   Me.Height)   +   3   *   HScroll1.Height
        HScroll1.ZOrder
        VScroll1.ZOrder
End   Sub
Private   Sub   HScroll1_Change()   '滚动条用
    Frame1.Left   =   -HScroll1.Value
End   Sub
Private   Sub   VScroll1_Change()   '滚动条用
        Frame1.Top   =   -VScroll1.Value
End   Sub


一个程序有一个窗体和一个模块
模块中有这么一段打印代码:
Printer.FontSize = 12
Printer.FontBold = True
Printer.Print vbTab & vbTab & Space(2) & "公司报表"

我在窗体中加了一个TEXT控件
模块改为

Printer.FontSize = 12
Printer.FontBold = True
Printer.Print vbTab & vbTab & Space(2) & "公司报表" & Text1.Text & ""

运行程序始终报text1变量未定义,请问这个问题如何解决?

Printer.Print vbTab & vbTab & Space(2) & "公司报表" & Form1!Text1.Text & ""

加上:  Form1.Text1.Text  试试.
再看看你的Text1加在什么地方,用绝对引用!


专题:

栏目: