有没有法在没有窗体的程序里调用TIME控件

解决方案 »

  1.   

    可以考虑利用api实现timer的功能具体代码你用google搜一下
      

  2.   

    还有个问题,就是TEXTOUT函数如何设置其输出字体的大小???
      

  3.   

    两个都用API
    1、SetTimer,这个函数有个回调,OnTimer事件处理代码就写在回调函数里2、CreateFont
       SelectObject yourdc,yourfont
       TextOut
       DeleteObject yourfont
      

  4.   

    自己写一个 TIMER 的类可以实现用这个类可以替代VB自带的Timer控件,这样就不用在无窗体的项目中仅为了使用Timer而多加一个窗体了。我一般用在ActiveX exe中用来分离系统控制权,用Timer的好处是避免控制权死锁,这样也就模拟出了多线程(实际上是多进程),能给用户更好的体验。代码如下:
            想直接使用的请到这里下载:http://www.chenoe.com/developer/library/timer.dll标准模块(mTimer):
    Option Explicit
    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
    Public TimerColl As New VBA.CollectionPublic Sub TimeProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
        Dim Timer As Timer, lpTimer As Long
        lpTimer = TimerColl("ID:" & idEvent)
        CopyMemory Timer, lpTimer, 4&
        Timer.PulseTimer
        CopyMemory Timer, 0&, 4&
    End Sub类模块(Timer):
    Option ExplicitPrivate Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As LongPrivate m_TimerID As Long
    Private m_Interval As Long
    Private m_Enabled As BooleanPublic Tag As Variant
    Public Event Timer()Public Property Get Interval() As Long
        Interval = m_Interval
    End PropertyPublic Property Let Interval(ByVal Value As Long)
        m_Interval = Value
        Enabled = m_Enabled
    End PropertyPublic Property Get Enabled() As Boolean
        Interval = m_Enabled
    End PropertyPublic Property Let Enabled(ByVal Value As Boolean)
        If Value Then
            m_Enabled = StartTimer
        Else
            Call StopTimer
        End If
    End PropertyPrivate Function StartTimer() As Boolean
        If m_TimerID = 0 Then
            If m_Interval > 0 Then
                m_TimerID = SetTimer(0, 0, m_Interval, AddressOf TimeProc)
                If m_TimerID <> 0 Then
                    TimerColl.Add ObjPtr(Me), "ID:" & m_TimerID
                    StartTimer = True
                End If
            Else
                m_Enabled = True
            End If
        End If
    End FunctionFriend Sub PulseTimer()
        RaiseEvent Timer
    End SubPrivate Sub StopTimer()
        If m_TimerID <> 0 Then
            KillTimer 0, m_TimerID
            TimerColl.Remove "ID:" & m_TimerID
            m_TimerID = 0
            m_Enabled = False
        End If
    End SubPrivate Sub Class_Terminate()
        Call StopTimer
    End Sub使用方法:
    Private WithEvents Timer1 As Timer
    Private Sub Form_Load()
        Set Timer1 = New TimerLib.Timer
        Timer1.Interval = 1000
        Timer1.Enabled = True
    End Sub
    Private Sub Timer1_Timer()
        Debug.Print Now
    End Sub忘了是谁写的了,呵呵
      

  5.   

    哇哈哈我昨天在www.vbaccelerator.com里找到一个不用标准模块的代码~~~~http://www.vbaccelerator.com/home/VB/Code/Libraries/Subclassing_and_Hooking_with_Machine_Code_Thunks/article.asp看看
      

  6.   

    直接都是高手啊,小弟才疏学浅
    模块
    Private mTimerBack As Long
    Public TimerTrue as Boolean
    Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Declare Function GetTickCount Lib "kernel32" () As Long
    Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As LongSub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
        If TimerTrue Then mTimer GetTickCount,100  '间隔100毫秒
    End SubPrivate Sub mTimer(ByVal thenTime As Long,ByVal jTime as long)
    If thenTime - mTimerBack > jTime Then
        '操作
        debug.print thenTime
        mTimerBack = thenTime
    End If
    End Sub
    窗体
    Private Sub Form_Load()'开始
    SetTimer Me.hwnd, 0, 1, AddressOf TimerProcEnd SubPrivate Sub Form_Unload(Cancel As Integer)
    '停止
    KillTimer Me.hwnd, 0End Sub不知道行不行
      

  7.   

    想开记时时TimerTrue=TRUE,停止时TimerTrue=FLASE(以上代码未测试.......从我BLOG修改器的代码上改的.....)
      

  8.   

    Private Sub Main()'开始
    SetTimer 0, 0, 1, AddressOf TimerProcEnd SubPrivate Sub mUnload()
    '停止
    KillTimer 0, 0End Sub复习了一下帖子,,,,,无窗体麻@!