Discussion Topics > Script BASIC
VB6 OCX GUI
(1/1)
John Spikowski:
This is an example of the OnLine Dictionary done with ScriptBasic and using a VB6 generated OCX for the UI. I also added resizing to this example.
OLD.sb
--- Code: Script BASIC ---IMPORT COM.sbi servers[0]="dict.org"servers[1]="dict1.us.dict.org"servers[2]="all.dict.org" FUNCTION btnFetch_Clicked LOCAL dat, total, count server_selection = COM::CBN(obj, "CurrentServer") OPEN server_selection & ":2628" FOR SOCKET AS #1 PRINT#1,"SHOW DB\n" LINE INPUT#1, dat LINE INPUT#1, dat count = 0 WHILE LEFT(dat, 1) <> "." LINE INPUT#1, dat IF LEFT(dat, 1) <> "." THEN total[count] = TRIM(dat) count+=1 WEND PRINT#1,"QUIT\n" CLOSE(#1) FOR cnt = 0 TO count - 2 COM::CBN obj, "AddDictionaries", :CALL, total[cnt] NEXT COM::CBN obj, "DefaultDictionary" btnFetch_Clicked = TRUE EXIT FUNCTION FUNCTION btnSearch_clicked LOCAL dict, dat, total, info whichDictionary = COM::CBN(obj, "CurrentDictionary") searchword = COM::CBN(obj, "SearchWord", :GET) dict = LEFT(whichDictionary, INSTR(whichDictionary, " ")) OPEN COM::CBN(obj, "CurrentServer") & ":2628" FOR SOCKET AS 1 IF COM::CBN(obj, "AllDict", :GET) THEN PRINT#1,"DEFINE * " & searchword & "\n" ELSE PRINT#1,"DEFINE " & dict & " " & searchword & "\n" END IF REPEAT LINE INPUT#1, dat IF LEFT(dat, 3) = "151" THEN total$ &= "------------------------------\r\n" total$ &= RIGHT(dat, LEN(dat) - LEN(searchword) - LEN(dict)) total$ &= "------------------------------\r\n" REPEAT LINE INPUT#1, info info = REPLACE(info, CHR(34), CHR(92) & CHR(34)) IF LEFT(info, 1) <> "." THEN total &= TRIM(info) & "\r\n" UNTIL LEFT(info, 1) = "." total &= "\r\n" END IF UNTIL LEFT(dat, 3) = "250" OR VAL(LEFT(dat, 3)) > 499 PRINT#1,"QUIT\n" CLOSE(#1) IF LEFT(dat, 3) = "552" THEN total = "No match found." ELSE IF LEFT(dat, 3) = "501" THEN total = "Select a dictionary first!" ELSE IF LEFT(dat, 3) = "550" THEN total = "Invalid database!" END IF COM::CBN(obj, "SetTranslation", :CALL, total) btnSearch_Clicked = TRUEEXIT FUNCTION ' MAIN obj = COM::CREATE(:SET, "OLD.OLDict")oCollection = COM::CBN(obj, "CallBackHandlers", :GET)COM::CBN oCollection, "Add", :CALL, ADDRESS(btnFetch_Clicked()), "win.btnFetch_Click"COM::CBN oCollection, "Add", :CALL, ADDRESS(btnSearch_Clicked()), "win.btnSearch_Click"FOR idx = 0 TO UBOUND(servers) COM::CBN obj, "AddServer", :CALL, servers[idx]NEXT COM::CBN obj, "DefaultServer"COM::CBN obj, "ShowOLD"COM::RELEASE obj
VB6 Form
--- Code: Visual Basic ---Private Declare Function ext_SBCallBack Lib "COM.dll" Alias "SBCallBack" (ByVal EntryPoint As Long, ByVal arg As Long) As LongPrivate Declare Function ext_SBCallBackEx Lib "COM.dll" Alias "SBCallBackEx" (ByVal EntryPoint As Long, ByRef v As Variant) As Variant Private m_owner As OLDictPrivate Type ControlPositionType Left As Single Top As Single Width As Single Height As Single FontSize As SingleEnd Type Private m_ControlPositions() As ControlPositionTypePrivate m_FormWid As SinglePrivate m_FormHgt As Single Function ShowMain(owner As OLDict) As Long On Error Resume Next Set m_owner = owner Me.Show 1 Set m_owner = Nothing ShowMain = 0 Unload MeEnd Function Private Function TriggerCallBack(nodeID As Long, argValue As Long) As Long TriggerCallBack = ext_SBCallBack(nodeID, argValue)End Function Private Function TriggerCallBackEx(nodeID As Long, v() As Variant) TriggerCallBackEx = ext_SBCallBackEx(nodeID, v)End Function Public Sub btnClear_Click() win.serverList.Clear win.dictTB.Text = "" win.entry.Text = "" win.btnFetch.SetFocus End Sub Private Sub btnExit_Click() Set m_owner = Nothing btnExit = 0 Unload MeEnd Sub Private Sub btnFetch_Click() Dim nodeID As Long Dim arg As Long Dim rtnVal As Long win.serverList.Clear nodeID = m_owner.CallBackHandlers("win.btnFetch_Click") arg = False rtnVal = TriggerCallBack(nodeID, arg)End Sub Private Sub btnSearch_Click() Dim nodeID As Long Dim arg As Long Dim rtnVal As Long nodeID = m_owner.CallBackHandlers("win.btnSearch_Click") arg = False rtnVal = TriggerCallBack(nodeID, arg)End Sub Private Sub btnAbout_Click() MsgBox "Script BASIC VB6" & vbCrLf & "On Line Dictionary", vbInformation, "About"End Sub ' Save the form's and controls' dimensions.Private Sub SaveSizes()Dim i As IntegerDim ctl As Control ' Save the controls' positions and sizes. ReDim m_ControlPositions(1 To Controls.Count) i = 1 For Each ctl In Controls With m_ControlPositions(i) If TypeOf ctl Is Line Then .Left = ctl.X1 .Top = ctl.Y1 .Width = ctl.X2 - ctl.X1 .Height = ctl.Y2 - ctl.Y1 Else .Left = ctl.Left .Top = ctl.Top .Width = ctl.Width .Height = ctl.Height On Error Resume Next .FontSize = ctl.Font.Size On Error GoTo 0 End If End With i = i + 1 Next ctl ' Save the form's size. m_FormWid = ScaleWidth m_FormHgt = ScaleHeightEnd Sub Private Sub Form_Load() SaveSizesEnd Sub Private Sub Form_Resize() ResizeControlsEnd Sub ' Arrange the controls for the new size.Private Sub ResizeControls()Dim i As IntegerDim ctl As ControlDim x_scale As SingleDim y_scale As Single ' Don't bother if we are minimized. If WindowState = vbMinimized Then Exit Sub ' Get the form's current scale factors. x_scale = ScaleWidth / m_FormWid y_scale = ScaleHeight / m_FormHgt ' Position the controls. i = 1 For Each ctl In Controls With m_ControlPositions(i) If TypeOf ctl Is Line Then ctl.X1 = x_scale * .Left ctl.Y1 = y_scale * .Top ctl.X2 = ctl.X1 + x_scale * .Width ctl.Y2 = ctl.Y1 + y_scale * .Height Else ctl.Left = x_scale * .Left ctl.Top = y_scale * .Top ctl.Width = x_scale * .Width If Not (TypeOf ctl Is ComboBox) Then ' Cannot change height of ComboBoxes. ctl.Height = y_scale * .Height End If On Error Resume Next ctl.Font.Size = y_scale * .FontSize On Error GoTo 0 End If End With i = i + 1 Next ctlEnd Sub
VB6 Class
--- Code: Visual Basic ---Public CallBackHandlers As New Collection Public Function ShowOLD() As Long ShowOLD = win.ShowMain(Me)End Function Public Sub AddServer(server_url As String) win.serverCombo.AddItem server_urlEnd Sub Public Sub DefaultServer() win.serverCombo.ListIndex = 0End Sub Public Function CurrentServer() As String CurrentServer = win.serverCombo.List(win.serverCombo.ListIndex)End Function Public Sub AddDictionaries(dictionary As String) win.serverList.AddItem dictionaryEnd Sub Public Function CurrentDictionary() As String CurrentDictionary = win.serverList.List(win.serverList.ListIndex)End Function Public Sub DefaultDictionary() win.serverList.ListIndex = 0End Sub Public Sub SetTranslation(translation_text As String) win.dictTB.Text = translation_textEnd Sub Public Property Get SearchWord() As String win.dictTB.SetFocus SearchWord = win.entry.TextEnd Property Public Property Get AllDict() As Long AllDict = win.chkAll.ValueEnd Property
Navigation
[0] Message Index
Go to full version