form1.frm

遗传算法,毕业设计.让我们一起共同学习探讨吧！

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4665
   ClientLeft      =   165
   ClientTop       =   855
   ClientWidth     =   7965
   LinkTopic       =   "Form1"
   ScaleHeight     =   4665
   ScaleWidth      =   7965
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Left            =   6480
      Top             =   1200
   End
   Begin VB.Menu puhuo 
      Caption         =   "捕获"
      Begin VB.Menu start 
         Caption         =   "开始捕获"
      End
   End
   Begin VB.Menu mnureadme 
      Caption         =   "读取"
   End
   Begin VB.Menu mnuSave 
      Caption         =   "保存"
   End
   Begin VB.Menu mnuProperties 
      Caption         =   "属性"
   End
   Begin VB.Menu mnuExit 
      Caption         =   "退出"
   End
   Begin VB.Menu mnuCloseChild 
      Caption         =   "关闭子窗体"
   End
   Begin VB.Menu mnuAbout 
      Caption         =   "关于"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
    
  Function GetScreenSnapshot(Optional ByVal hwnd As Long) As IPictureDisp
    
          Dim targetDC     As Long
          Dim hdc     As Long
          Dim tempPict     As Long
          Dim oldPict     As Long
          Dim wndWidth     As Long
          Dim wndHeight     As Long
          Dim Pic As PICTDESC
          Dim rcWindow     As RECT
          Dim guid(3)     As Long
    
          '   provide   the   right   handle   for   the   desktop   window
    
          If hwnd = 0 Then hwnd = GetDesktopWindow
      
          '   get   window's   size
          GetWindowRect hwnd, rcWindow
          wndWidth = rcWindow.Right - rcWindow.Left
          wndHeight = rcWindow.Bottom - rcWindow.Top
          '   get   window's   device   context
          targetDC = GetWindowDC(hwnd)
    
          '   create   a   compatible   DC
          hdc = CreateCompatibleDC(targetDC)
    
          tempPict = CreateCompatibleBitmap(targetDC, wndWidth, wndHeight)
          oldPict = SelectObject(hdc, tempPict)
    
          '   copy   the   screen   image   into   the   DC
          bitblt hdc, 0, 0, wndWidth, wndHeight, targetDC, 0, 0, vbSrcCopy
    
          tempPict = SelectObject(hdc, oldPict)
          DeleteDC hdc
          ReleaseDC GetDesktopWindow, targetDC
    
    
          With Pic
    
                  .cbSize = Len(Pic)
                  .pictType = 1                           '   means   picture
                  .hIcon = tempPict
                  .hPal = 0                           '   (you   can   omit   this   of   course)
    
          End With
            
          guid(0) = &H7BF80980
          guid(1) = &H101ABF32
          guid(2) = &HAA00BB8B
          guid(3) = &HAB0C3000
          OleCreatePictureIndirect Pic, guid(0), True, GetScreenSnapshot
    
  End Function
    
    
  
    
  Private Sub mnuAbout_Click()
    
          MsgBox "                 丽宏织造厂" & vbCrLf & vbCrLf & "         版权所有　违者必究" & vbCrLf & vbCrLf & "　　　2002-2003年", , "随抓系统"
    
  End Sub
    
  Private Sub mnuCloseChild_Click()
    
          If Not (ActiveForm Is Nothing) Then Unload ActiveForm
    
  End Sub
    
  Private Sub mnuExit_Click()
          Unload Form1
          Unload Me
  End Sub
    
  Private Sub mnuGrabScreen_Click()
          
            
          MDIForm1.Visible = False
          Form1.Visible = False
          Timer1.Enabled = True
  End Sub
    
    
  Private Sub mnuProperties_Click()
          Dim ww As Long
          Dim hh As Long
          If MDIForm1.ActiveForm Is Nothing Then Exit Sub
          
          With MDIForm1.ActiveForm.Picture1
          ww = CInt(.ScaleX(.Picture.Width, vbHimetric, vbPixels))
        hh = CInt(.ScaleY(.Picture.Height, vbHimetric, vbPixels))
                  MsgBox "图片宽度为:=   " & ww _
                        & ",图片高度为:=   " & hh
          End With
    
  End Sub
    
  Private Sub mnureadme_Click()
      MsgBox "请点击捕获菜单下的开始捕获，系统将在1秒后变为抓图状态！！！", , "随抓系统"
  End Sub
    
  Private Sub mnuSave_Click()
          Dim ww As Long
          Dim hh As Long
          If MDIForm1.ActiveForm Is Nothing Then Exit Sub
          If MDIForm1.ActiveForm.IsDirty = False Then Exit Sub
            
          With MDIForm1.ActiveForm.Picture1
          ww = CInt(.ScaleX(.Picture.Width, vbHimetric, vbPixels))
          hh = CInt(.ScaleY(.Picture.Height, vbHimetric, vbPixels))
          End With
            
          If savepictureRoutine = True Then
                  MDIForm1.ActiveForm.IsDirty = False
                  MDIForm1.mnuSave.Enabled = False
          Else
          End If
    
  End Sub

Private Sub start_Click()
 Dim hwnd As Long
 Call GetScreenSnapshot(hwnd)
 
End Sub

Private Sub Timer1_Timer()
    
          Static count
          If count > 1 Then
    
                  Form1.Picture = GetScreenSnapshot(0)
                  count = 0
                  Timer1.Enabled = False
                  Form1.Visible = True
                    
    
          End If
    
          count = count + 1
    
  End Sub