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