📄 gpdfrm.frm
字号:
' Start Method Dispatch Manager channel_number = 1 tmr_Method_Dispatch.Enabled = True ElseIf on_off_toggle = True Then on_off_toggle = False cmd_ToolBar.Buttons.Item(TOGGLE_BUTTON).Caption = START_CAPTION cmd_ToolBar.Buttons.Item(TOGGLE_BUTTON).Image = START_IMAGE sts_GPDStatus.Panels.Item(GPD_STATE_PANEL).Text = CONFIGURE_MODE_CAPTION 'Close all channels If tmr_Method_Dispatch.Enabled = True Then tmr_Method_Dispatch = False For instantiation_incr = 1 To lst_ChannelList.ListItems.Count '########## RTDX(TM) ##########' Sleep (1000) ' Sleep for 1 second If (MethodValues(channel_number).CHANNEL_OPEN = True) Then MethodValues(instantiation_incr).stat = _ rtdx(instantiation_incr).Close() End If Set rtdx(instantiation_incr) = Nothing '########## RTDX(TM) ##########' Next instantiation_incr End If ' Enable ALL controls cmd_ToolBar.Buttons.Item(ADDCHANNEL_BUTTON).Enabled = True cmd_ToolBar.Buttons.Item(MODIFYCHANNEL_BUTTON).Enabled = True cmd_ToolBar.Buttons.Item(DELETECHANNEL_BUTTON).Enabled = True cmd_ToolBar.Buttons.Item(DELETEALLCHANNELS_BUTTON).Enabled = True End IfEnd SubPrivate Sub cmd_AddChannel()Dim RTDX_channel As ListItem ' Show Property page GPDPpg.Show 1 If GPDPpg.DataValid Then ' Insert new channel at the end of list Set RTDX_channel = lst_ChannelList.ListItems.Add(, , GPDPpg.txt_ChannelName) RTDX_channel.SubItems(MAXMESSAGES_ITEM) = GPDPpg.txt_MaxMessages RTDX_channel.SubItems(MAXMEMBERS_ITEM) = GPDPpg.txt_MaxMembers RTDX_channel.SubItems(CHANNELTYPE_ITEM) = GPDPpg.ChannelTypeOption RTDX_channel.SubItems(DATATYPE_ITEM) = GPDPpg.DataTypeOption RTDX_channel.SubItems(BOARD_ITEM) = GPDPpg.CurrentSelectedBoard RTDX_channel.SubItems(PROCESSOR_ITEM) = GPDPpg.CurrentSelectedProcessor 'Highlight inserted channel as selected channel lst_ChannelList.SelectedItem = lst_ChannelList.ListItems(lst_ChannelList.ListItems.Count) ' Update channel count sts_GPDStatus.Panels.Item(NUM_OF_CHANNELS_PANEL).Text = TOTAL_CHANNELS_CAPTION + _ Str(lst_ChannelList.ListItems.Count) ' Enable controls that require an existing channel cmd_ToolBar.Buttons.Item(TOGGLE_BUTTON).Enabled = True cmd_ToolBar.Buttons.Item(MODIFYCHANNEL_BUTTON).Enabled = True cmd_ToolBar.Buttons.Item(DELETECHANNEL_BUTTON).Enabled = True cmd_ToolBar.Buttons.Item(DELETEALLCHANNELS_BUTTON).Enabled = True End IfEnd SubPrivate Sub cmd_ModifyChannel()Dim i As Integer ' Update Text Boxes with current settings for selected channel GPDPpg.txt_ChannelName = lst_ChannelList.ListItems.Item(lst_ChannelList.SelectedItem.Index) GPDPpg.txt_MaxMessages = lst_ChannelList.ListItems.Item(lst_ChannelList.SelectedItem.Index).SubItems(MAXMESSAGES_ITEM) GPDPpg.txt_MaxMembers = lst_ChannelList.ListItems.Item(lst_ChannelList.SelectedItem.Index).SubItems(MAXMEMBERS_ITEM) ' Update channel type option with current settings for selected channel Select Case (lst_ChannelList.ListItems.Item(lst_ChannelList.SelectedItem.Index).SubItems(CHANNELTYPE_ITEM)) Case Is = TYPE_READ_ONLY GPDPpg.opt_ReadChannel.Value = True Case Is = TYPE_WRITE_ONLY GPDPpg.opt_WriteChannel.Value = True Case Else GPDPpg.opt_ReadChannel.Value = True End Select ' Update data type option with current settings for selected channel Select Case (lst_ChannelList.ListItems.Item(lst_ChannelList.SelectedItem.Index).SubItems(DATATYPE_ITEM)) Case Is = TYPE_8BIT_INTEGER GPDPpg.opt_8BitInteger.Value = True Case Is = TYPE_16BIT_INTEGER GPDPpg.opt_16BitInteger.Value = True Case Is = TYPE_32BIT_INTEGER GPDPpg.opt_32BitInteger.Value = True Case Is = TYPE_32BIT_FLOAT GPDPpg.opt_32BitFloat.Value = True Case Is = TYPE_64BIT_FLOAT GPDPpg.opt_64BitFloat.Value = True Case Else GPDPpg.opt_16BitInteger.Value = True End Select ' Update board For i = 0 To (GPDPpg.list_Boards.ListCount - 1) If ((GPDPpg.list_Boards.List(i)) = (lst_ChannelList.ListItems.Item(lst_ChannelList.SelectedItem.Index).SubItems(BOARD_ITEM))) Then GPDPpg.list_Boards.Selected(i) = True Exit For End If Next ' Update processor For i = 0 To (GPDPpg.list_Processors.ListCount - 1) If ((GPDPpg.list_Processors.List(i)) = (lst_ChannelList.ListItems.Item(lst_ChannelList.SelectedItem.Index).SubItems(PROCESSOR_ITEM))) Then GPDPpg.list_Processors.Selected(i) = True Exit For End If Next ' Show Property page GPDPpg.DataValid = False GPDPpg.Show 1 ' If data is valid then update item in list If GPDPpg.DataValid Then lst_ChannelList.ListItems.Item(lst_ChannelList.SelectedItem.Index) = GPDPpg.txt_ChannelName lst_ChannelList.ListItems.Item(lst_ChannelList.SelectedItem.Index).SubItems(MAXMESSAGES_ITEM) = GPDPpg.txt_MaxMessages lst_ChannelList.ListItems.Item(lst_ChannelList.SelectedItem.Index).SubItems(MAXMEMBERS_ITEM) = GPDPpg.txt_MaxMembers lst_ChannelList.ListItems.Item(lst_ChannelList.SelectedItem.Index).SubItems(CHANNELTYPE_ITEM) = GPDPpg.ChannelTypeOption lst_ChannelList.ListItems.Item(lst_ChannelList.SelectedItem.Index).SubItems(DATATYPE_ITEM) = GPDPpg.DataTypeOption lst_ChannelList.ListItems.Item(lst_ChannelList.SelectedItem.Index).SubItems(BOARD_ITEM) = GPDPpg.CurrentSelectedBoard lst_ChannelList.ListItems.Item(lst_ChannelList.SelectedItem.Index).SubItems(PROCESSOR_ITEM) = GPDPpg.CurrentSelectedProcessor End If End SubPrivate Sub cmd_DeleteChannel() ' Check to see if we have any channels If (lst_ChannelList.ListItems.Count <= 0) Then MsgBox ("There are no channels to delete!") cmd_ToolBar.Buttons.Item(TOGGLE_BUTTON).Enabled = False cmd_ToolBar.Buttons.Item(MODIFYCHANNEL_BUTTON).Enabled = False cmd_ToolBar.Buttons.Item(DELETECHANNEL_BUTTON).Enabled = False cmd_ToolBar.Buttons.Item(DELETEALLCHANNELS_BUTTON).Enabled = False ' Check to see if we have more than one channel ElseIf (lst_ChannelList.ListItems.Count > 1) Then ' Remove channel from the list lst_ChannelList.ListItems.Remove (lst_ChannelList.SelectedItem.Index) 'Highlight last channel as selected channel lst_ChannelList.SelectedItem = lst_ChannelList.ListItems(lst_ChannelList.ListItems.Count) ' We must have only one channel left so just call cmd_DeleteAllChannels Else cmd_DeleteAllChannels End If ' Update channel count sts_GPDStatus.Panels.Item(NUM_OF_CHANNELS_PANEL).Text = TOTAL_CHANNELS_CAPTION + _ Str(lst_ChannelList.ListItems.Count) End SubPrivate Sub cmd_DeleteAllChannels() ' clear all channels lst_ChannelList.ListItems.Clear ' Disable all buttons that require available channels cmd_ToolBar.Buttons.Item(TOGGLE_BUTTON).Enabled = False cmd_ToolBar.Buttons.Item(MODIFYCHANNEL_BUTTON).Enabled = False cmd_ToolBar.Buttons.Item(DELETECHANNEL_BUTTON).Enabled = False cmd_ToolBar.Buttons.Item(DELETEALLCHANNELS_BUTTON).Enabled = False ' Update channel count sts_GPDStatus.Panels.Item(NUM_OF_CHANNELS_PANEL).Text = TOTAL_CHANNELS_CAPTION + _ Str(lst_ChannelList.ListItems.Count)End SubPrivate Sub cmd_ToolBar_ButtonClick(ByVal Button As MSComctlLib.Button) Select Case Button.Key Case Is = "cmd_Toggle" cmd_Toggle ' Call cmd_Toggle procedure Case Is = "cmd_AddChannel" cmd_AddChannel ' Call cmd_AddChannel procedure Case Is = "cmd_ModifyChannel" cmd_ModifyChannel ' Call cmd_ModifyChannel procedure Case Is = "cmd_DeleteChannel" cmd_DeleteChannel ' Call cmd_DeleteChannel procedure Case Is = "cmd_DeleteAllChannels" cmd_DeleteAllChannels ' Call cmd_DeleteAllChannels procedure Case Else End SelectEnd SubPrivate Sub Form_Load()'Dim TestHelpPath As String'Dim NewHelpFile As String Left = (Screen.Width - Width) / 2 Top = (Screen.Height - Height) / 2 ' Specify help file ' TestHelpPath = Dir(App.Path + RTDXHELPFILE, vbNormal) 'If help file is not in the applications directory' If (TestHelpPath <> "") Then' App.HelpFile = App.Path & RTDXHELPFILE' Else 'Ask user to specify' MsgBox ("Warning: RTDX Help File not found!")' NewHelpFile = InputBox("Enter path and name of help file")' App.HelpFile = NewHelpFile' End If ' Initialize program Init_ProgEnd SubPrivate Sub Form_Resize()'#######################################################################' This procedure is called if the form size if modifed. It's job is to' re-size and re-position the Active-X controls according to scale.'####################################################################### ' cmd_ToolBar.Width = GPDFrm.ScaleWidth lst_ChannelList.Width = GPDFrm.ScaleWidth cmd_ToolBar.Top = GPDFrm.ScaleTop lst_ChannelList.Top = GPDFrm.ScaleTop + cmd_ToolBar.Height If (GPDFrm.MinButton <> True) Then lst_ChannelList.Height = GPDFrm.ScaleHeight - lst_ChannelList.Top - sts_GPDStatus.Height End If End SubPrivate Sub Form_Unload(Cancel As Integer)Dim instantiation_incr As Integer 'Close all channels If tmr_Method_Dispatch.Enabled = True Then tmr_Method_Dispatch = False For instantiation_incr = 1 To lst_ChannelList.ListItems.Count '########## RTDX(TM) ##########' Sleep (1000) ' Sleep for 1 second If (MethodValues(channel_number).CHANNEL_OPEN = True) Then MethodValues(instantiation_incr).stat = _ rtdx(instantiation_incr).Close() End If Set rtdx(instantiation_incr) = Nothing '########## RTDX(TM) ##########' Next instantiation_incr End If Unload GPDPpg Unload GPDGridFrmEnd SubPrivate Sub tmr_Method_Dispatch_Timer()Dim open_chan_incr As IntegerDim CHANNELS_STILL_OPEN As Boolean ' Test to see if we are done running the program CHANNELS_STILL_OPEN = False For open_chan_incr = 1 To lst_ChannelList.ListItems.Count If MethodValues(open_chan_incr).CHANNEL_OPEN Then CHANNELS_STILL_OPEN = True Exit For End If Next open_chan_incr ' Test to see if we have open channels left If Not CHANNELS_STILL_OPEN Then MsgBox ("Data Processing Complete!") cmd_Toggle Exit Sub Else ' Test to see if we are able to obtain data from the channel If MethodValues(channel_number).CHANNEL_OPEN Then ' Test the I/O type of the channel If (lst_ChannelList.ListItems.Item(channel_number).SubItems(CHANNELTYPE_ITEM) = TYPE_READ_ONLY) Then Do_Read ElseIf (lst_ChannelList.ListItems.Item(channel_number).SubItems(CHANNELTYPE_ITEM) = TYPE_WRITE_ONLY) Then Do_Write End If End If 'increment channel number channel_number = channel_number + 1 If channel_number > lst_ChannelList.ListItems.Count Then channel_number = 1 ' reset channel number End If End IfEnd Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -