| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 5901 人关注过本帖
标题:提示“用户定义类型未定义”,为什么呢?
只看楼主 加入收藏
ictest
Rank: 3Rank: 3
等 级:论坛游侠
帖 子:333
专家分:114
注 册:2010-2-17
结帖率:70%
收藏
 问题点数:0 回复次数:3 
提示“用户定义类型未定义”,为什么呢?
'****************以下保存在窗体中,窗体中需要一个Picture图片框控件数组,一个按钮,一个计时器,一个Shape控件
'Picture1(0)用于记录当前屏幕图像,Picture1(1)用于记录每隔两秒的屏幕新的图像,对这两个图像进行对比
'****************本示例工程意义:每两秒中截一幅屏幕画面,当发现新的画面与前一次截取的画面不同的时候,将新的截图写入D盘(顺着按钮事件一步一步看即可)
'在窗体上画好控件以后,将下面代码复制到窗体代码中即可
'本示例运行后,拖动本窗口,即可实时感觉Shape控件的颜色发生变化
Private Type PALETTEENTRY
   peRed As Byte
   peGreen As Byte
   peBlue As Byte
   peFlags As Byte
End Type
Private Type LOGPALETTE
   palVersion As Integer
   palNumEntries As Integer
   palPalEntry(255) As PALETTEENTRY  ' Enough for 256 colors.
End Type
Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End Type
Private Const RASTERCAPS As Long = 38
Private Const RC_PALETTE As Long = &H100
Private Const SIZEPALETTE As Long = 104
Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type
Private Type PicBmp
   Size As Long
   Type As Long
   hBmp As Long
   hPal As Long
   Reserved As Long
End Type
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal iCapabilitiy As Long) As Long
Private Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long
Private Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDCDest As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hDCSrc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Const nPercent As Integer = 100
Dim bit1() As Byte, bit2() As Byte
Private Sub Form_Load()
Show
Me.ScaleMode = 3
Picture1(0).ScaleMode = 3
Picture1(0).Move 10, 10, 400, 300
Picture1(0).AutoRedraw = True
Picture1(1).Move 420, 10, 400, 300
Picture1(1).AutoRedraw = True
Command1.Move 300, 320, 130, 30
Command1.Caption = "对比图片"
Command1.Tag = 0
Command1.Default = True
'Delay 2000
Set Picture1(0).Picture = CaptureScreen()
Timer1.Enabled = True
Timer1.Interval = 2000 '两秒截个图
End Sub
Private Sub Picture1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 And Index = 1 And Command1.Tag = 1 Then SetBitmapBits Picture1(1).Image, UBound(bit2), bit2(1)
End Sub
Private Sub Command1_Click()
'Dim r As Long
Dim sss As String
sss = "D:\" & Replace(Replace(Replace(Now, " ", ""), ":", ""), "-", "") & ".bmp"
  getbit Picture1(0).Image, bit1()
  getbit Picture1(1).Image, bit2()
For i = 1 To UBound(bit1) Step 4
    If Abs(CInt(bit1(i)) - CInt(bit2(i))) <= nPercent And Abs(CInt(bit1(i + 1)) - CInt(bit2(i + 1))) <= nPercent And Abs(CInt(bit1(i + 2)) - CInt(bit2(i + 2))) <= nPercent Then
        n = n + 1
    End If
Next
r = Round(400 * n / UBound(bit1), 2)
If r <> 100 Then '如果两个图片不同
Shape1.BackColor = vbGreen
Picture1(0).Picture = Picture1(1).Image
SavePicture Picture1(1).Image, sss
Else
Shape1.BackColor = vbRed
End If
Command1.Tag = 1
End Sub

Function getbit(ByVal hBmp As Long, ByRef bit() As Byte)
Dim picinfo As BITMAP
GetObject hBmp, Len(picinfo), picinfo
ReDim bit(1 To picinfo.bmHeight * picinfo.bmWidth * 4)
GetBitmapBits hBmp, UBound(bit), bit(1)
End Function
Private Function CaptureScreen() As Picture
  Dim hWndScreen As Long
   hWndScreen = GetDesktopWindow()
   Set CaptureScreen = CaptureWindow(hWndScreen, False, 0, 0, Screen.Width \ Screen.TwipsPerPixelX, Screen.Height \ Screen.TwipsPerPixelY - GetTrayHeight)
End Function
  Private Function CaptureWindow(ByVal hWndSrc As Long, ByVal Client As Boolean, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture
  Dim hDCMemory As Long
  Dim hBmp As Long
  Dim hBmpPrev As Long
  Dim r As Long
  Dim hDCSrc As Long
  Dim hPal As Long
  Dim hPalPrev As Long
  Dim RasterCapsScrn As Long
  Dim HasPaletteScrn As Long
  Dim PaletteSizeScrn As Long
  Dim LogPal As LOGPALETTE
   If Client Then
      hDCSrc = GetDC(hWndSrc)
   Else
      hDCSrc = GetWindowDC(hWndSrc)
                                   
   End If
   hDCMemory = CreateCompatibleDC(hDCSrc)
   hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
   hBmpPrev = SelectObject(hDCMemory, hBmp)
   RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS)
                                                     
   HasPaletteScrn = RasterCapsScrn And RC_PALETTE
                                                      
   PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE)
                                                        
   If HasPaletteScrn And (PaletteSizeScrn = 256) Then
      LogPal.palVersion = &H300
      LogPal.palNumEntries = 256
      r = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))
      hPal = CreatePalette(LogPal)
      ' Select the new palette into the memory DC and realize it.
      hPalPrev = SelectPalette(hDCMemory, hPal, 0)
      r = RealizePalette(hDCMemory)
   End If
   ' Copy the on-screen image into the memory DC.
   r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy)
' Remove the new copy of the  on-screen image.
   hBmp = SelectObject(hDCMemory, hBmpPrev)
   ' If the screen has a palette get back the palette that was
   ' selected in previously.
   If HasPaletteScrn And (PaletteSizeScrn = 256) Then
      hPal = SelectPalette(hDCMemory, hPalPrev, 0)
   End If
   ' Release the device context resources back to the system.
   r = DeleteDC(hDCMemory)
   r = ReleaseDC(hWndSrc, hDCSrc)
   ' Call CreateBitmapPicture to create a picture object from the
   ' bitmap and palette handles. Then return the resulting picture
   ' object.
   Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)
End Function
Private Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture
  Dim r As Long
   Dim Pic As PicBmp
   ' IPicture requires a reference to "Standard OLE Types."
   Dim IPic As IPicture
   Dim IID_IDispatch As GUID
   ' Fill in with IDispatch Interface ID.
   With IID_IDispatch
      .Data1 = &H20400
      .Data4(0) = &HC0
      .Data4(7) = &H46
   End With
   ' Fill Pic with necessary parts.
   With Pic
      .Size = Len(Pic)          ' Length of structure.
      .Type = vbPicTypeBitmap   ' Type of Picture (bitmap).
      .hBmp = hBmp              ' Handle to bitmap.
      .hPal = hPal              ' Handle to palette (may be null).
   End With
   ' Create Picture object.
   r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
   ' Return the new Picture object.
   Set CreateBitmapPicture = IPic
End Function
Function GetTrayHeight() As Double
         Dim hTrayWnd     As Long, rc       As RECT
          hTrayWnd = FindWindow("Shell_TrayWnd", vbNullString)
           
          GetWindowRect hTrayWnd, rc
          GetTrayHeight = rc.Bottom - rc.Top
End Function
Private Sub Timer1_Timer()
Set Picture1(1).Picture = CaptureScreen()
Command1_Click
DoEvents
End Sub


提示“用户定义类型未定义”,为什么呢?怎么修改?
搜索更多相关主题的帖子: 定义 类型 提示 用户 
2010-05-07 10:07
不说也罢
Rank: 13Rank: 13Rank: 13Rank: 13
等 级:贵宾
威 望:39
帖 子:1481
专家分:4989
注 册:2007-10-7
收藏
得分:0 
不好意思,给楼主的例子中,自定义模块代码复制忘掉了

程序代码:
'以下代码在Module1中
Public Declare Function SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Public Const STRETCH_HALFTONE = 4
Public Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Public Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Public Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Public Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type

Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type


另外,Shape1控件的BackStyle属性请设为1,不然颜色没变化的

===================================================
讨厌C#的行尾的小尾巴;和一对大括号{ }
===================================================
2010-05-07 12:24
ictest
Rank: 3Rank: 3
等 级:论坛游侠
帖 子:333
专家分:114
注 册:2010-2-17
收藏
得分:0 
谢谢您,“不说也罢”,正确了,非常感谢您!
针对您给我的这段程序,我想再作出一些修改,但我很菜菜,能分别告诉我怎么修改么?
1,不需要保存以时间命名的那么多文件,我只需要两个,能否只保存用来对比的两个文件,其他用过的都删除?
2,截屏大小为“全屏-下方任务条高度,任务条高度大约为500”
3,picture1(1)和picture1(2)的大小能不变化么?意思是,虽然我截的是全屏,但不需要picture1(1)和picture1(2)也显示全屏,也许能省些内存呢。呵呵
2010-05-07 13:35
不说也罢
Rank: 13Rank: 13Rank: 13Rank: 13
等 级:贵宾
威 望:39
帖 子:1481
专家分:4989
注 册:2007-10-7
收藏
得分:0 
针对你上面三个问题:
1、完全可以,也很简单,用KILL和SAVEPICTURE即可;
2、给你的代码中已去除了任务栏,GetTrayHeight() 函数即是获取WINDOWS任务栏高度的
3、你说得没错,可以不用picturebox控件,改用image控件,相对要省一些内存消耗
稍候给你一个用image控件的源码

===================================================
讨厌C#的行尾的小尾巴;和一对大括号{ }
===================================================
2010-05-07 13:48
快速回复:提示“用户定义类型未定义”,为什么呢?
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.023804 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved