editexmpl.frm

来自「kaufj kjashg iyutjhxcu bvjg gvv」· FRM 代码 · 共 220 行

VERSION 5.00
Begin VB.Form frmEditor 
   BackColor       =   &H00C0FFFF&
   Caption         =   "Edit example"
   ClientHeight    =   4950
   ClientLeft      =   1140
   ClientTop       =   1800
   ClientWidth     =   6540
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4950
   ScaleWidth      =   6540
   Begin VB.CommandButton cmdLoad 
      Caption         =   "Load picture"
      Height          =   375
      Left            =   720
      TabIndex        =   5
      Top             =   4320
      Width           =   1455
   End
   Begin VB.PictureBox Picture2 
      BackColor       =   &H00FFFFC0&
      Height          =   3375
      Left            =   3480
      ScaleHeight     =   3315
      ScaleWidth      =   2475
      TabIndex        =   4
      Top             =   720
      Width           =   2535
   End
   Begin VB.TextBox Text2 
      BackColor       =   &H00C0FFC0&
      Height          =   495
      Left            =   3600
      MultiLine       =   -1  'True
      TabIndex        =   3
      Text            =   "EditExmpl.frx":0000
      Top             =   120
      Width           =   2415
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "EXIT"
      Height          =   375
      Left            =   4200
      TabIndex        =   2
      Top             =   4320
      Width           =   1335
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00FFFFC0&
      Height          =   3375
      Left            =   240
      ScaleHeight     =   3315
      ScaleWidth      =   2355
      TabIndex        =   1
      Top             =   720
      Width           =   2415
   End
   Begin VB.TextBox Text1 
      BackColor       =   &H00C0FFC0&
      Height          =   495
      Left            =   360
      TabIndex        =   0
      Text            =   "To be or not to be ..."
      Top             =   120
      Width           =   2415
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "&Edit"
      Begin VB.Menu mnuCut 
         Caption         =   "&Cut"
         Shortcut        =   ^X
      End
      Begin VB.Menu mnuCopy 
         Caption         =   "C&opy"
         Shortcut        =   ^C
      End
      Begin VB.Menu mnuPaste 
         Caption         =   "&Paste"
         Shortcut        =   ^V
      End
      Begin VB.Menu mnuEditionSep 
         Caption         =   "-"
      End
      Begin VB.Menu mnuClear 
         Caption         =   "C&lear clipboard"
      End
   End
End
Attribute VB_Name = "frmEditor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Example of editing using a Menu
'May edit text or picture controls

Option Explicit

Private Sub cmdLoad_Click()
    'Note use of App.Path to specify the directory
    'where the application resides
    'As long as the picture file is with the .vbp file,
    'it can be loaded without a specific path
    
    Dim pictName As String
    pictName = App.Path & "\footb2.jpg"
    Picture1.Picture = LoadPicture(pictName)
End Sub

Private Sub Form_Load()
    'Standard routine to center form on screen
    'Can be copied and pasted in any application
    'Me stands for active form
    
    Me.Left = (Screen.Width - Me.Width) / 2
    Me.Top = (Screen.Height - Me.Height) / 2
End Sub

Private Sub mnuEdit_Click()
   'All menu functions are disabled until
   'we decide what we want to do.
   
    mnuCut.Enabled = False
    mnuCopy.Enabled = False
    mnuPaste.Enabled = False
    mnuClear.Enabled = False
    
    'If cursor is in a textbox and text has been selected,
    'Cut and Copy are enabled
    'If there is text in the Clipboard,
    'Paste is enabled
    
    If TypeOf Screen.ActiveControl Is TextBox Then
        If Screen.ActiveControl.SelLength Then
            mnuCut.Enabled = True
            mnuCopy.Enabled = True
        End If
        If Clipboard.GetFormat(vbCFText) Then
            mnuPaste.Enabled = True
        End If
    End If
    
    If TypeOf Screen.ActiveControl Is PictureBox Then
        mnuCut.Enabled = True
        mnuCopy.Enabled = True
        If Clipboard.GetFormat(vbCFBitmap) Or Clipboard.GetFormat(vbCFDIB) _
            Or Clipboard.GetFormat(vbCFMetafile) Then
            mnuPaste.Enabled = True
        End If
    End If
    If Clipboard.GetFormat(vbCFText) Or Clipboard.GetFormat(vbCFBitmap) Or _
        Clipboard.GetFormat(vbCFMetafile) Or Clipboard.GetFormat(vbCFDIB) Then
        mnuClear.Enabled = True
    End If
End Sub

Private Sub mnuPaste_Click()
    
    If TypeOf Screen.ActiveControl Is TextBox And _
        Clipboard.GetFormat(vbCFText) Then
        Screen.ActiveControl.SelText = Clipboard.GetText()
        Exit Sub
    End If
    
    If TypeOf Screen.ActiveControl Is PictureBox _
        And Clipboard.GetFormat(vbCFBitmap) Then
        Screen.ActiveControl.Picture = Clipboard.GetData()
        Exit Sub
    End If
End Sub

Private Sub mnuCopy_Click()
   
    If TypeOf Screen.ActiveControl Is TextBox Then
        If Screen.ActiveControl.SelLength Then
            Clipboard.Clear
            Clipboard.SetText Screen.ActiveControl.SelText
            Exit Sub
        End If
    End If
    
    If TypeOf Screen.ActiveControl Is PictureBox Then
        Clipboard.Clear
        Clipboard.SetData Screen.ActiveControl.Image
    End If
End Sub

Private Sub mnuCut_Click()
    Dim StartPos, SelLength, EndPos As Integer
    Dim Temp As String
    
    mnuCopy_Click
    
    If TypeOf Screen.ActiveControl Is TextBox Then
        StartPos = Screen.ActiveControl.SelStart
        SelLength = Screen.ActiveControl.SelLength
        Temp = Left(Screen.ActiveControl.Text, StartPos)
        EndPos = Len(Screen.ActiveControl.Text) - (StartPos + SelLength)
        Temp = Temp + Right(Screen.ActiveControl.Text, EndPos)
        Screen.ActiveControl.Text = Temp
        Exit Sub
    End If
    
    If TypeOf Screen.ActiveControl Is PictureBox Then
        Screen.ActiveControl.Picture = LoadPicture("")
    End If
    
End Sub


Private Sub mnuClear_Click()
    Clipboard.Clear
End Sub

Private Sub cmdExit_Click()
    End
End Sub