formdsystem.frm

用XML做专家系统的一个编译器,有说明书,使用简单,有模板

If x Then
    MsgBox "消息发送成功", vbInformation, "发送消息"
Else
    MsgBox "消息发送失败", vbCritical, "发送消息"
End If
End Sub

Sub AddTools()
Dim tool As ActiveBar2LibraryCtl.tool

    Set tool = ActiveBarD.Tools.Add(GetUniqueToolID(), "agenda")
        tool.Caption = "发送消息"
        tool.CaptionPosition = ddCPBelow
        tool.Category = "快捷按钮"
        tool.ControlType = ddTTButton
        tool.SetPicture ddITNormal, LoadPicture(App.path + "\icon1\agenda.ico")
        tool.Style = ddSIconText
        tool.tagVariant = "shortcutsStandard"
        
    Set tool = ActiveBarD.Tools.Add(GetUniqueToolID(), "inbox")
        tool.Caption = "收件箱"
        tool.CaptionPosition = ddCPBelow
        tool.Category = "快捷按钮"
        tool.ControlType = ddTTButton
        tool.SetPicture ddITNormal, LoadPicture(App.path + "\icon1\inbox.ico")
        tool.Style = ddSIconText
        tool.tagVariant = "shortcutsStandard"
        
    Set tool = ActiveBarD.Tools.Add(GetUniqueToolID(), "\calendar")
        tool.Caption = "聊天工具"
        tool.CaptionPosition = ddCPBelow
        tool.Category = "快捷按钮"
        tool.ControlType = ddTTButton
        tool.SetPicture ddITNormal, LoadPicture(App.path + "\icon1\Calendar.ico")
        tool.Style = ddSIconText
        tool.tagVariant = "shortcutsStandard"

        
    Set tool = ActiveBarD.Tools.Add(GetUniqueToolID(), "contacts")
        tool.Caption = "联系人"
        tool.CaptionPosition = ddCPBelow
        tool.Category = "快捷按钮"
        tool.ControlType = ddTTButton
        tool.SetPicture ddITNormal, LoadPicture(App.path + "\icon1\\contacts.ico")
        tool.Style = ddSIconText
        tool.tagVariant = "shortcutsStandard"

        
    Set tool = ActiveBarD.Tools.Add(GetUniqueToolID(), "tasks")
        tool.Caption = "任务"
        tool.CaptionPosition = ddCPBelow
        tool.Category = "快捷按钮"
        tool.ControlType = ddTTButton
        tool.SetPicture ddITNormal, LoadPicture(App.path + "\icon1\\tasks.ico")
        tool.Style = ddSIconText
        tool.tagVariant = "shortcutsStandard"

    
    Set tool = ActiveBarD.Tools.Add(GetUniqueToolID(), "notes")
        tool.Caption = "便笺"
        tool.CaptionPosition = ddCPBelow
        tool.Category = "快捷按钮"
        tool.ControlType = ddTTButton
        tool.SetPicture ddITNormal, LoadPicture(App.path + "\icon1\notes.ico")
        tool.Style = ddSIconText
        tool.tagVariant = "shortcutsStandard"

        
    Set tool = ActiveBarD.Tools.Add(GetUniqueToolID(), "recyclebin")
        tool.Caption = "回收站"
        tool.CaptionPosition = ddCPBelow
        tool.Category = "快捷按钮"
        tool.ControlType = ddTTButton
        tool.SetPicture ddITNormal, LoadPicture(App.path + "\icon1\trash.ico")
        tool.Style = ddSIconText
        tool.tagVariant = "shortcutsStandard"

    
'我的快捷按钮
    Set tool = ActiveBarD.Tools.Add(GetUniqueToolID(), "drafts")
        tool.Caption = "草稿"
        tool.CaptionPosition = ddCPBelow
        tool.Category = "快捷按钮"
        tool.ControlType = ddTTButton
        tool.Description = "Takes you to your drafts."
        tool.SetPicture ddITNormal, LoadPicture(App.path + "\icon1\drafts.ico")
        tool.Style = ddSIconText
        tool.tagVariant = "shortcutsMy"
        
    Set tool = ActiveBarD.Tools.Add(GetUniqueToolID(), "outbox")
        tool.Caption = "发件箱"
        tool.CaptionPosition = ddCPBelow
        tool.Category = "快捷按钮"
        tool.ControlType = ddTTButton
        tool.SetPicture ddITNormal, LoadPicture(App.path + "\icon1\outbox.ico")
        tool.Style = ddSIconText
        tool.tagVariant = "shortcutsMy"
    
    Set tool = ActiveBarD.Tools.Add(GetUniqueToolID(), "sentitems")
        tool.Caption = "发送项目"
        tool.CaptionPosition = ddCPBelow
        tool.Category = "快捷按钮"
        tool.ControlType = ddTTButton
        tool.SetPicture ddITNormal, LoadPicture(App.path + "\icon1\sent.ico")
        tool.Style = ddSIconText
        tool.tagVariant = "shortcutsMy"

    
    Set tool = ActiveBarD.Tools.Add(GetUniqueToolID(), "journal")
        tool.Caption = "日志"
        tool.CaptionPosition = ddCPBelow
        tool.Category = "快捷按钮"
        tool.ControlType = ddTTButton
        tool.SetPicture ddITNormal, LoadPicture(App.path + "\icon1\journal.ico")
        tool.Style = ddSIconText
        tool.tagVariant = "shortcutsMy"
    
    Set tool = ActiveBarD.Tools.Add(GetUniqueToolID(), "productupdates")
        tool.Caption = "更新"
        tool.CaptionPosition = ddCPBelow
        tool.Category = "快捷按钮"
        tool.ControlType = ddTTButton
        tool.SetPicture ddITNormal, LoadPicture(App.path + "\icon1\update.ico")
        tool.Style = ddSIconText
        tool.tagVariant = "shortcutsMy"

'其它快捷按钮
    Set tool = ActiveBarD.Tools.Add(GetUniqueToolID(), "mycomputer")
        tool.Caption = "我的电能"
        tool.CaptionPosition = ddCPBelow
        tool.Category = "快捷按钮"
        tool.ControlType = ddTTButton
        tool.SetPicture ddITNormal, LoadPicture(App.path + "\icon1\mycomputer.ico")
        tool.Style = ddSIconText
        tool.tagVariant = "shortcutsOther"
    
    Set tool = ActiveBarD.Tools.Add(GetUniqueToolID(), "mydocuments")
        tool.Caption = "我的文档"
        tool.CaptionPosition = ddCPBelow
        tool.Category = "快捷按钮"
        tool.ControlType = ddTTButton
        tool.SetPicture ddITNormal, LoadPicture(App.path + "\icon1\mydocuments.ico")
        tool.Style = ddSIconText
        tool.tagVariant = "shortcutsOther"
    
    Set tool = ActiveBarD.Tools.Add(GetUniqueToolID(), "favorites")
        tool.Caption = "收藏夹"
        tool.CaptionPosition = ddCPBelow
        tool.Category = "快捷按钮"
        tool.ControlType = ddTTButton
        tool.SetPicture ddITNormal, LoadPicture(App.path + "\icon1\favorites.ico")
        tool.Style = ddSIconText
        tool.tagVariant = "shortcutsOther"
        
End Sub

Sub AddShortcutBand()
Dim band As ActiveBar2LibraryCtl.band
Dim childBand As ActiveBar2LibraryCtl.band
Dim cnt As Long
Dim tagVariant As Variant


    Set band = ActiveBarD.Bands.Add("shortcuts")
        band.Caption = " 目录一"
        
        band.ChildBands.ChildBandBackgroundStyle = ddBSNormal
        band.ChildBands.BackColor = vbApplicationWorkspace
        band.ChildBands.ForeColor = vbWindowText
        band.ChildBands.ToolForeColor = vbWindowBackground
        
        '这个属性决定活动页"Outlook"样式
        band.ChildBandStyle = ddCBSLeftTabs
        
        band.DockedHorzWidth = 2880
        band.DockingArea = ddDALeft

        
        ABAddFlag ddBFSizer, band
        ABAddFlag ddBFStretch, band
        ABRemoveFlag ddBFCustomize, band
        ABRemoveFlag ddBFDockBottom, band
        ABRemoveFlag ddBFDockTop, band
        
        band.GrabHandleStyle = ddGSNone
        
        
        '添加可活动页
        Set childBand = band.ChildBands.Add("standardshortcuts")
        Set band.ChildBands.CurrentChildBand = childBand
            
            childBand.Caption = "目录二"
            'childBand.WrapTools = True
            
            tagVariant = "shortcutsStandard"
            For cnt = 0 To ActiveBarD.Tools.count - 1
                If tagVariant = ActiveBarD.Tools(cnt).tagVariant Then
                    childBand.Tools.Insert -1, ActiveBarD.Tools(cnt)
                End If
            Next cnt
            
         Set childBand = band.ChildBands.Add("myshortcuts")
            childBand.Caption = "目录三"
            'childBand.WrapTools = True
            
            
            tagVariant = "shortcutsMy"
            For cnt = 0 To ActiveBarD.Tools.count - 1
                If tagVariant = ActiveBarD.Tools(cnt).tagVariant Then
                    childBand.Tools.Insert -1, ActiveBarD.Tools(cnt)
                End If
            Next cnt
            
         Set childBand = band.ChildBands.Add("othershortcuts")
            childBand.Caption = "其它快捷按钮"
            'childBand.WrapTools = True
            
            tagVariant = "shortcutsOther"
            For cnt = 0 To ActiveBarD.Tools.count - 1
                If tagVariant = ActiveBarD.Tools(cnt).tagVariant Then
                    childBand.Tools.Insert -1, ActiveBarD.Tools(cnt)
                End If
            Next cnt
End Sub


Private Sub Form_Load()
txtRemoteIP = Winsock1.LocalIP
Picture1.ZOrder 0
AddTools
AddShortcutBand
populateChildBandStyles
End Sub

Private Sub populateChildBandStyles()
ActiveBarD.Bands("shortcuts").ChildBandStyle = ddCBSSlidingTabs
With ActiveBarD.Bands("shortcuts")
        If .ChildBandStyle <> ddCBSSlidingTabs Then
            .Width = IIf(.Width < 2880, 2880, .Width)
            .WrapTools = True
            For Each b In .ChildBands
                b.WrapTools = True
            Next b
            
        Else
            .WrapTools = False
            For Each b In .ChildBands
                b.WrapTools = False
            Next b
        End If
    End With
    ActiveBarD.RecalcLayout
End Sub


Private Sub Text2_KeyPress(KeyAscii As Integer)
Static Last_Line_Feed As Long
Dim New_Line As String
If Trim(Text2) = vbNullString Then
    Last_Line_Feed = 0
End If
If KeyAscii = 13 Then
    New_Line = Mid(Text2, Last_Line_Feed + 1)
    Last_Line_Feed = Text2.SelStart
    Winsock1.SendData New_Line
    StatusBar1.Panels(2).Text = "Sent " & (LenB(New_Line) / 2) & "bytes"
End If
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim New_Text As String
Winsock1.GetData New_Text
Text1.SelText = New_Text
Frame1.Caption = Winsock1.RemoteHostIP
StatusBar1.Panels(2).Text = "收到：" & bytesTotal & "字节"
End Sub