Private Declare Function htmlhelp Lib _
 "hhctrl.ocx" Alias "HtmlHelpA" _
 (ByVal hwndCaller As Long, _
ByVal pszFile As String, ByVal _
uCommand As Long, ByVal dwData As Long) As LongDim Changed As BooleanDim Button As Integer
Private Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End TypePrivate Type POINTAPI
    X As Long
    Y As Long
End Type
Private Type PageSetupDlg
    lStructSize As Long
    hwndOwner As Long
    hDevMode As Long
    hDevNames As Long
    FLAGS As Long
    ptPaperSize As POINTAPI
    rtMinMargin As Rect
    rtMargin As Rect
    hInstance As Long
    lCustData As Long
    lpfnPageSetupHook As Long
    lpfnPagePaintHook As Long
    lpPageSetupTemplateName As String
    hPageSetupTemplate As Long
End TypePrivate Declare Function PageSetupDlg Lib "comdlg32.dll" Alias "PageSetupDlgA" _
(pPagesetupdlg As PageSetupDlg) As Long
Dim PageSetup As PageSetupDlg
Dim Pflag As Long
Dim Pmode As Long
Dim Psize As POINTAPIPrivate Sub Form_Load()
Form1.Caption = "NoTitled-notePad"mnuUndo.Caption = "撤消(&U)" + Chr(9) + "Ctrl+Z"
mnuJian.Caption = "剪切(&T)" + Chr(9) + "Ctrl+X"
mnuCopy.Caption = "复制(&C)" + Chr(9) + "Ctrl+C"
mnuPaste.Caption = "粘贴(&P)" + Chr(9) + "Ctrl+V"
mnuJian.Enabled = False
mnuUndo.Enabled = False
mnuCopy.Enabled = FalsemnuDelete.Enabled = False
If Clipboard.GetText() <> "" Then
    mnuPaste.Enabled = True
Else
    mnuPaste.Enabled = False
End If
'Text1.SelAlignment = Null
Changed = FalseEnd SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Changed = True Then
    
    Button = MsgBox(Form1.Caption + "file has changed," + Chr(13) + "do you save?", vbYesNoCancel + vbExclamation)
    
    If Button = vbYes Then
        mnuSave_Click
        End
    ElseIf Button = vbNo Then
       End
    End If
    Cancel = True
    
Else
    End
End IfEnd SubPrivate Sub Form_resize()
Text1.Top = ScaleTop
Text1.Left = ScaleLeft
Text1.Width = ScaleWidth
Text1.Height = ScaleHeightEnd Sub
Private Sub mnuAbout_Click()
Form4.Show
End SubPrivate Sub mnuAll_Click()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End SubPrivate Sub mnuCline_Click()mnuCline.Checked = Not mnuCline.Checked
If mnuCline.Checked = True Then
    Text1.RightMargin = 0
Else
    Text1.RightMargin = 2500
End If
End SubPrivate Sub mnuCopy_Click()SendKeys "^{insert}"
End SubPrivate Sub mnuDate_Click()
Dstring = FormatDateTime(Now, 4) + Space(2) + FormatDateTime(Now, 2)
SendKeys Dstring
End SubPrivate Sub mnuDelete_Click()
Text1.SelText = ""
End SubPrivate Sub mnuExit_Click()
If Changed = True Then
    
    Button = MsgBox(Form1.Caption + "file has changed," + Chr(13) + "do you save?", vbYesNoCancel + vbExclamation)
    
    If Button = vbYes Then
        mnuSave_Click
    ElseIf Button = vbNo Then
       End
    End If
    
Else
    End
End If    
End SubPrivate Sub mnuFind_Click()
Form2.Show
End SubPrivate Sub mnuFont_Click()
CommonDialog1.FontName = Text1.SelFontName
CommonDialog1.FLAGS = FontsConstants.cdlCFScreenFonts
CommonDialog1.FontStrikethru = Text1.SelStrikeThru
CommonDialog1.FontBold = Text1.SelBold
CommonDialog1.FontItalic = Text1.SelItalic
CommonDialog1.FontUnderline = Text1.SelUnderline
CommonDialog1.FontSize = Text1.SelFontSize
CommonDialog1.FontStrikethru = Text1.SelStrikeThru
CommonDialog1.Color = Text1.SelColor
CommonDialog1.ShowFont
'Text1.SelFontName = CommonDialog1.FontName
'Text1.SelStrikeThru = CommonDialog1.FontStrikethru
'Text1.SelBold = CommonDialog1.FontBold
'Text1.SelColor = CommonDialog1.Color
'Text1.SelItalic = CommonDialog1.FontItalic
'Text1.SelUnderline = CommonDialog1.FontUnderline
'Text1.SelFontSize = CommonDialog1.FontSize
'Text1.SelStrikeThru = CommonDialog1.FontStrikethruText1.Font.Bold = CommonDialog1.FontBold
Text1.Font.Italic = CommonDialog1.FontItalic
Text1.Font.Name = CommonDialog1.FontName
Text1.Font.Size = CommonDialog1.FontSize
End SubPrivate Sub mnuGoto_Click()
Form3.Show
'Form3.SetFocus = Form3.Text1.Text
End SubPrivate Sub mnuHelpTopic_Click()'App.HelpFile = "e:\notepad\note.CHM"
'SendKeys "{F1}"
'yeah = shellExecute(Form1.hwnd, "open", "e:\notepad\note.CHM", Null, Null, SW_SHOWNORMAL)
'Shell "e:\notepad\note.chm", vbNormalFocus
'Shell "hh " + App.Path + "\note.chm", vbNormalFocus
'Shell "e:\notepad\note.CHM", vbNormalFocus
htmlhelp hwnd, "d:\notepad\note.CHM", 0, 0
End SubPrivate Sub mnuJian_Click()SendKeys "+{del}"
End SubPrivate Sub mnuline7_Click(Index As Integer)
Dim i As Integer
CommonDialog1.ShowOpenEnd SubPrivate Sub mnuNew_Click()
If Changed = True Then
    
    Button = MsgBox(Form1.Caption + "file has changed," + Chr(13) + "do you save?", vbYesNoCancel + vbExclamation)
    
    If Button = vbYes Then
        mnuSave_Click
    End If
End If
Text1.Text = ""
Form1.Caption = "NoTitled-notePad"
Changed = False
End Sub Private Sub mnuNext_Click()If Gstring <> "" Then
    Form2.Visible = False
    Form2.Command1_Click
Else
    Form2.Visible = True
End IfEnd SubPrivate Sub mnuOpen_Click()
If Changed = True Then
    
    Button = MsgBox(Form1.Caption + "file has changed," + Chr(13) + "do you save?", vbYesNoCancel + vbExclamation)
    
    If Button = vbYes Then
        mnuSave_Click
    End If
End If
CommonDialog1.ShowOpen
file = CommonDialog1.FileNameIf file <> "" Then
Form1.Caption = file
Open file For Input As #1
    If Not EOF(file) Then Text1.Text = Input(LOF(1), #1)
Close #1
Changed = False
End If
End SubPrivate Sub mnuPage_Click()    
 With PageSetup
     .lStructSize = Len(PageSetup)
       .hwndOwner = hwnd
      
  PageSetupDlg PageSetup
        Pflag = .FLAGS
        Psize = .ptPaperSize
        Pmode = .hDevMode
     End With
       'Pflag = PageSetupDlg(PageSetup)
       
'Text1.SetFocus
End SubPrivate Sub mnuPaste_Click()
SendKeys "+{insert}"
End SubPrivate Sub mnuPrint_Click()
CommonDialog1.FLAGS = Pmode
'If Text1.SelLength = 0 Then
 '   CommonDialog1.FLAGS = cdlPDReturnDC + cdlPDAllPages
'Else
   ' CommonDialog1.FLAGS = cdlPDReturnDC + cdlPDSelection
'End If
CommonDialog1.ShowPrinter
On Error GoTo trip
Printer.Print ""If CommonDialog1.hDC > 0 Then Text1.Print CommonDialog1.hDC
Printer.EndDoc
trip: End SubPrivate Sub mnuReplace_Click()
FrmReplace.Show
End SubPrivate Sub mnuSave_Click()
If Form1.Caption = "NoTitled-notePad" ThenCommonDialog1.DialogTitle = "save"
CommonDialog1.ShowSave
file = CommonDialog1.FileName
    If file <> "" Then
    Form1.Caption = file
    Open file For Output As #1
    Print #1, Text1.Text
    Close #1
    End IfElse
    file = Form1.Caption
    Open file For Output As #1
    Print #1, Text1.Text
    Close #1
End If
End SubPrivate Sub mnuSaveAs_Click()
CommonDialog1.DialogTitle = "save as "
CommonDialog1.ShowSave
file = CommonDialog1.FileName
If file <> "" Then
    Form1.Caption = file
    Open file For Output As #1
    Print #1, Text1.Text
    Close #1
End If
End SubPrivate Sub mnuUndo_Click()
SendKeys "^{z}"
End SubPrivate Sub Text1_Change()
Changed = True
mnuUndo.Enabled = TrueEnd Sub Private Sub Text1_SelChange()
If Text1.SelLength <> 0 Then
    mnuJian.Enabled = True
    mnuCopy.Enabled = True
    mnuDelete.Enabled = True
    
    
Else
    mnuJian.Enabled = False
    mnuCopy.Enabled = False
    mnuDelete.Enabled = False
End If
End Sub

解决方案 »

  1.   

    没那么麻烦。检查剪贴版,如果有内容Clipboard.GetText<>""则可以粘贴,如果TextBox选择了内容,就是Text1.SelLength<>0 ,则可以剪切和复制。
      

  2.   

    : dbcontrols(泰山) 检查?怎么检查?用个Timer不停的检查么?竟胡扯!
      

  3.   

    : dbcontrols(泰山) 检查?怎么检查?用个Timer不停的检查么?竟胡扯!不懂就别乱咬人。当然不须要用Timer来做啦。不过我想你也不可能会用的啦。。要与剪切板同步变化而不用Timer来检测,得用到子类技术(SubClass)。
      

  4.   

    在textbox得到焦点时检查剪贴板,若不为空且为文本,则可设置按钮状态;在textbox的mousedown or mouseup事件中检测是否有文本选中,则也可设置按钮状态。楼上的二位火气还是小一点,大家都是讨论问题,没必要。
    要相互尊重。
      

  5.   

    监视 Clipboard API!
    Hook
      

  6.   

    真的很感谢各位,但我还是不太明白。
    playyuer(女㊣爱)大哥,可否详细说明一下? 
      

  7.   

    在文本框的转移事件和得到焦点事件
    '粘贴
    toolbar.buttons(1).Enabled =(Clipboard <>"")以此例推