frmmain.frm

远端荧幕传输程序,远端荧幕传输程序.rar

VERSION 5.00
Begin VB.Form FrmMain 
   Caption         =   "网络图像传输"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   HasDC           =   0   'False
   Icon            =   "FrmMain.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   213
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   312
   StartUpPosition =   3  '窗口缺省
   Begin NetPicTran.NetGIFTran NetGIFTran1 
      Left            =   1200
      Top             =   1800
      _ExtentX        =   1058
      _ExtentY        =   1058
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long

Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal hDC As Long, ByVal nStretchMode As Long) As Long
Private Const HALFTONE = 4

Private mOldTime As Currency

Private Sub Form_DblClick()
    FrmSet.Show , Me
End Sub

Private Sub Form_Load()
    FrmSet.Show , Me
    
End Sub

Private Sub Form_Paint()
    'Dim OldMode As Long
    
    'OldMode = SetStretchBltMode(Me.hDC, HALFTONE)
    NetGIFTran1.Draw Me.hDC ', , , Me.ScaleWidth, Me.ScaleHeight
    'Call SetStretchBltMode(Me.hDC, OldMode)
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    NetGIFTran1.CloseConnect
    
End Sub

Private Sub NetGIFTran1_CloseConnect()
    Call FrmSet.UpdataUI
End Sub

Private Sub NetGIFTran1_OnPictureArrival()
    Dim CurTime As Currency
    
    CurTime = GetCurTime()
    Me.Caption = App.Title & ": " & vbTab & "间隔:" & Format$(CurTime - mOldTime, "###,###,###,##0.0000") & "ms"
    mOldTime = CurTime
    
    Me.Refresh
    
End Sub

Private Sub NetGIFTran1_OnQueryPicture()
    'Debug.Print "NetGIFTran1_OnQueryPicture"
    
    Static OldTime As Currency
    Dim CurTime As Currency
    Const SampTimeDis = 1000 '采样间隔(ms)
    
    If NetGIFTran1.CurClients > 1 Then '只有客户数大于1时才控制采样间隔
        CurTime = GetCurTime()
        If OldTime + SampTimeDis > CurTime Then '未到时间
            Exit Sub
        End If
        OldTime = CurTime
    End If
    
    Dim hDCScr As Long
    
    hDCScr = GetDC(0)
    If hDCScr Then
        Me.MousePointer = vbHourglass
        Call NetGIFTran1.SetBitmap(hDCScr, 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY)
        Me.MousePointer = vbDefault
        
        Call ReleaseDC(0, hDCScr)
        
        Me.Refresh
        
    End If
    
End Sub