Private Sub 命令0_Click()fExistTableEnd Sub

Private Sub mnuPaste_Click()
RichTextBox1.SelText = “” ‘这一步对Undo功用至关心重视要
RichTextBox1.SelText = Clipboard.GetText(1) ‘粘贴
End Sub

用该事件现身参数不可选的不当。稳重商量,发掘fExistTable贫乏参数,即已知表名没有在代码中反射。

‘下一行为按键或菜单代码
SendMessage RichTextBox1.hwnd, WM_UNDO, 0, 0

注明:以下代码为平常的援引Dao做的一模块

Private Sub RichTextBox1_Change()
If Not trapUndo Then Exit Sub ‘因为because trapping is disabled

Private Sub 命令0_Click()fExistTableEnd Sub

‘设置按键、菜单属性
Private Sub EnableControls()
Command1.Enabled = UndoStack.Count > 1
Command2.Enabled = RedoStack.Count > 0
mnuUndo.Enabled = Command1.Enabled
mnuRedo.Enabled = Command2.Enabled
RichTextBox1_SelChange
End Sub

修改为:

Private Sub RichTextBox1_KeyDown(KeyCode As Integer, Shift As
Integer)
If Shift = 2 Then
KeyCode = 0
End If
End Sub

Function fExistTable(strTableName As String) As IntegerDim db As
DatabaseDim i As Integer Set db = DBEngine.Workspaces(0).Databases(0)
fExistTable = False db.TableDefs.Refresh For i = 0 To db.TableDefs.Count

Private Sub mnuUndo_Click()
Command1_Click
End Sub

  • 1 If strTableName = db.TableDefs(i).Name Then ‘Table Exists
    fExistTable = True Exit For End If Next i Set db = NothingEnd Function

‘Redo子程序
Public Sub Redo()
Dim chg$
Dim DeleteFlag As Boolean ‘标识删除或丰硕文本的变量
Dim objElement As Object
If RedoStack.Count > 0 And trapUndo Then
trapUndo = False
DeleteFlag = RedoStack(RedoStack.Count).TextLen <
Len(RichTextBox1.Text)
If DeleteFlag Then ‘为真则删除
Set objElement = RedoStack(RedoStack.Count)
RichTextBox1.SelStart = objElement.SelStart
RichTextBox1.SelLength = Len(RichTextBox1.Text) – objElement.TextLen
RichTextBox1.SelText = “”
Else ‘反之则拉长
Set objElement = RedoStack(RedoStack.Count)
chg$ = Change(RichTextBox1.Text, objElement.Text, objElement.SelStart +
1)
RichTextBox1.SelStart = objElement.SelStart – Len(chg$)
RichTextBox1.SelLength = 0
RichTextBox1.SelText = chg$
RichTextBox1.SelStart = objElement.SelStart – Len(chg$)
If Len(chg$) > 1 And chg$ <> vbCrLf Then
RichTextBox1.SelLength = Len(chg$)
Else
RichTextBox1.SelStart = RichTextBox1.SelStart + Len(chg$)
End If
End If
UndoStack.Add Item:=objElement
RedoStack.Remove RedoStack.Count
End If
EnableControls
trapUndo = True
RichTextBox1.SetFocus
End Sub

缓慢解决问题后,倏然想起Access数据库也是有系统表,贮存有目的名,是还是不是做一询问来判别呢

Private Declare Function SendMessage Lib “user32” Alias “SendMessageA”
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As
Any) As Long

SELECT Count(*State of Qatar AS QtyFROM MSysObjectsWHERE (((MSysObjects.Name卡塔尔国 Like
需判别的已知表名卡塔尔国卡塔尔;

‘请给窗体加多按键七个、RichTextBox八个,取默许值;
‘菜单若干:——
‘层次 Name属性 Caption属性
‘ 1 Edit 编辑
‘ 2 mnuUndo 撤销
‘ 2 mnuRedo 恢复
‘ 2 mnuCut 剪切
‘ 2 mnuCopy 复制
‘ 2 mnuPaste 粘贴
‘ 2 mnuDelete 删除
‘ 2 mnuSelectAll 全选

何以用SQL语句来判断已知表是或不是存在

Public SelStart As Long ‘文本框中的开第3地方
Public TextLen As Long ‘文本长度
Public Text As String ‘文本内容

经求证,能够完成必要。若是Qty0,即表示表已存在,不然就象征不设有。

Private Sub mnuCut_Click()
Clipboard.SetText RichTextBox1.SelText, 1 ‘剪切
RichTextBox1.SelText = “”
End Sub

答:具体消除方法如下:

Private Sub mnuDelete_Click()
RichTextBox1.SelText = “” ‘删除
End Sub

End Sub不再报错。留神解析,其实是用 已知表名
通过Dao判定数据库中是或不是留存,假若fExistTable的值为True便是存在,不然正是荒诞不经。

Dim newElement As New UndoElement ‘创立新的undo集结
Dim c%, l&

‘给新会集赋值
newElement.SelStart = RichTextBox1.SelStart
newElement.TextLen = Len(RichTextBox1.Text)
newElement.Text = RichTextBox1.Text

Private Sub RichTextBox1_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeySpace Then
RichTextBox1.SelFontName = “金鼎文” ‘定义字体
End If
End Sub

‘申明API函数
Public Declare Function SendMessage Lib “User32” Alias “SendMessageA”
_
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Long) As Long

Private Sub Form_Load()
RichTextBox1.Text = “”
Command1.Caption = “撤销”
Command2.Caption = “恢复”
trapUndo = True
RichTextBox1_Change
RichTextBox1_SelChange
Show
DoEvents
End Sub

‘ ****** 模块代码:

生存中的What’s done cannot be undone在大家的次第中应当改为What’s done
can always be undone。你不信任?那么请看——
比如单单象MS的小记事本这样唯有二次undo功能,那不是一件小事,用SendMessage函数就能够轻易达成。下列代码能使RichTextBox有一回撤消操作的死守:

admin

相关文章

发表评论

电子邮件地址不会被公开。 必填项已用*标注