form1.frm

图像处理

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Nosferatu Editor v1.0"
   ClientHeight    =   4560
   ClientLeft      =   120
   ClientTop       =   390
   ClientWidth     =   5730
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4560
   ScaleWidth      =   5730
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox MainPic 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000005&
      ClipControls    =   0   'False
      DrawStyle       =   3  'Dash-Dot
      FillColor       =   &H00FFFFFF&
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   14.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   3936
      Left            =   0
      Picture         =   "Form1.frx":0000
      ScaleHeight     =   260
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   366
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   0
      Width           =   5520
      Begin VB.PictureBox destPic 
         Appearance      =   0  'Flat
         AutoRedraw      =   -1  'True
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   12
         Left            =   1080
         ScaleHeight     =   1
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   1
         TabIndex        =   3
         Top             =   720
         Visible         =   0   'False
         Width           =   12
      End
      Begin VB.PictureBox picVuoto 
         BackColor       =   &H80000009&
         BorderStyle     =   0  'None
         Height          =   252
         Left            =   0
         Picture         =   "Form1.frx":BD76
         ScaleHeight     =   255
         ScaleWidth      =   15
         TabIndex        =   2
         Top             =   0
         Visible         =   0   'False
         Width           =   12
      End
      Begin VB.Shape Shape1 
         Height          =   492
         Left            =   0
         Top             =   0
         Visible         =   0   'False
         Width           =   12
      End
      Begin VB.Shape Shape2 
         BorderStyle     =   3  'Dot
         DrawMode        =   1  'Blackness
         Height          =   756
         Left            =   4440
         Top             =   2520
         Visible         =   0   'False
         Width           =   12
      End
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Selezione"
      Height          =   372
      Left            =   4440
      TabIndex        =   0
      Top             =   4080
      Width           =   852
   End
   Begin VB.PictureBox EtsLinkLabel1 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   204
      Left            =   120
      ScaleHeight     =   150
      ScaleWidth      =   1215
      TabIndex        =   4
      Top             =   4200
      Width           =   1272
   End
   Begin VB.Label Label1 
      Caption         =   "Download this code and many other visiting:"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   7.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   120
      TabIndex        =   5
      Top             =   3960
      Width           =   4092
   End
   Begin VB.Menu ModificaMainMnu 
      Caption         =   "Edit"
      Begin VB.Menu TagliaMnu 
         Caption         =   "&Cut"
         Enabled         =   0   'False
         Shortcut        =   ^T
      End
      Begin VB.Menu CopiaMnu 
         Caption         =   "&Copy"
         Enabled         =   0   'False
         Shortcut        =   ^C
      End
      Begin VB.Menu IncollaMnu 
         Caption         =   "&Paste"
         Enabled         =   0   'False
         Shortcut        =   ^I
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************'
'*     Nosferatu Editor v1.0  *'
'******************************'
'*      di Andrea Martelli    *'
'******************************'
'*                            *'
'* per scaricare gratuitamente*'
'* le guide utilizzate per    *'
'* sviluppare questo editor   *'
'* fare riferimento al sito:  *'
'******************************'
'http://digilander.iol.it/VBItalia/INDICE.html

Dim XX As Double, YY As Double
Dim XX1 As Double, YY1 As Double
Dim Xcopia As Double
Dim OkSeleziona As Boolean
Dim retval As Variant
Dim destL As Long
Dim Incolla As Boolean
Dim destT As Long
Dim destW As Long
Dim destH As Long
Dim Ycopia As Double
Dim Sposta As Boolean
Option Explicit
Private Sub CopiaPerSpostare()
'cancella l'immagine eventualmente
'creata in precedenza nella picturebox
'di destinazione
destPic.Cls
'richiama la funzione BitBlt.
retval = BitBlt(destPic.hDC, 0, 0, Shape1.Width, Shape1.Height, MainPic.hDC, XX, YY, SRCCOPY)
'aggiorna la picturebox di destinazione
destPic.Refresh
'Notare che alla lunghezza e all'altezza della
'Shape1 sono stati tolti due pixels mentre alle
'coordinate x ed y uno. Questo allo scopo di non
'copiare anche le linee della Shape1, ma solo quello che
'contiene
Shape1.Left = destPic.Left - 1
Shape1.Top = destPic.Top - 1
Shape1.Width = destPic.Width + 2
Shape1.Height = destPic.Height + 2
Shape1.BorderStyle = 1
'imposta il puntatore "size all" della
'selezione sulla quale si pu