2006/05/02

Ein Basic Interpreter mit Wordbasic kompatibler GUI-Funktionalität.

Der unterstützte Sprachstandard entspricht in etwa dem von Wordbasic Version 6.

- Alle Basic Typen inklusive type
- Dialoge über Wordbasic kompatible Dialogdefinitionen.
- Zugriff auf Windows API und andere DLL-Funktionen über 'declare function'
- Präprocessor-Direktiven, wie #include, #if, #const, etc. .

Der eigentliche Interpreter wurde als OLE2/ActiveX-Control realisiert, der in andere Programme integriert werden kann oder via WIOSRV im Interaktiven Modus verwendet werden kann.

Code-Fragmente:

#if WIN32 = 1 then
#   uses "inst32.dll"
#else
#   uses "inst16.dll"
#endif

declare function MessageBox lib "user" (hwnd as integer, msg as string, _
title as string, flags as integer) as integer


function CheckNMIsRunning()
    hwndcs% = FindWindow("NewMenus16CallServer", "")
    hwndcd% = FindWindow("KDLLMSG", "")
    CheckNMIsRunning = TRUE
    if hwnd% <> 0 or hwndcd% <> 0 then
        MessageBox(0, "Quit New Menus before re- oder de-installing!", _
"Installation", MB_ICONHAND)
        exit function
    endif
    CheckNMIsRunning = FALSE
end function



#const INST_STATE_HALLO = 0
#const INST_STATE_PREVER = 1
#const INST_STATE_INSTDIR = 2
#const INST_STATE_INSTOPT = 3
#const INST_STATE_INSTDO = 4

function IsOldInstallation() as integer
    IsOldInstallation = 0
    erg = CallInstSection("CheckOldInstDir")
    if erg  = 0 then exit function
    t$ = String$(256, " ")
    GetInstDef("OLDINSTDIR", t$)
    if t$ = "" then exit function
#if WIN32 <> 0 then
    oldexe$ = t$ + "\nmwm32.exe"
    oldoexe$ = t$ + "\nmwm16.exe"
#else
    oldexe$ = t$ + "\nmwm16.exe"
    oldoexe$ = t$ + "\nmwm32.exe"
#endif
    if DoFileExist(oldexe$) = 0 then
exit function
    end if
    OldInstDir = t$
    IsOldInstallation = 1
end function

Funktion, die einen Dialog aufruft

function GetInstDirDialog() as integer
    Begin Dialog TargetDirTab 650, 250, "New Menu Install", .TargetDirTabProc
        Text 50, 42, 300, 13, "Select Source Directory for Installation:"
        TextBox 50, 64, 427, 18, .SourceDir
        Text 55, 96, 296, 13, "Select Target Directory for Installation:" 
        TextBox 55, 118, 427, 18, .TargetDir
  PushButton 512, 117, 88, 21, "&Browse", .BrowseBtn
        Text 55, 142, 303, 13, "Please select an new or empty directory"
        CancelButton 250, 212, 100, 25
        PushButton 400, 212, 100, 25, "<&Prev", .PrevBtn 
       PushButton 525, 212, 100, 25, "&Next>", .NextBtn
    End Dialog 
    Dim dlg as TargetDirTab
    td$ = String$(256, " ")
    sd$ = String$(256, " ")
    GetInstDef("TARGETDIR", td$)
    GetInstDef("SOURCEDIR", sd$)
    dlg.TargetDir = td$
    dlg.SourceDir = sd$
    dlg.NextBtn = IDNEXT
    dlg.PrevBtn = IDPREV
    GetInstDirDialog = DoDialog(dlg)
    SetInstDef("TARGETDIR", dlg.TargetDir)
    SetInstDef("SOURCEDIR", dlg.SourceDir)
end function
            

Der Obige Dialog nutzt diese Callbackfunktion:

function TargetDirTabProc(control as string, action as integer, _
notifycode as integer) as integer
    TargetDirTabProc = 0
    select case control
    case "BrowseBtn"
        if action = 2 then
            dim buffer as string
            buffer = String$(255, " ")
            Title = "Select Target dir"
            erg = SelectDir(DlgHandle(me), Title, buffer)
            if erg <> 0 then 
                SetWindowText(ControlHandle(me, "TargetDir"), buffer)
            endif
        endif
    case "NextBtn"
        if action = 2 then
            dim s as string
            s = Space$(256)
            GetWindowText(ControlHandle(me, "TargetDir"), s, 256)
            if IsDirEmpty(s) <> True then
                msg$ = "The directory where you install New Menus should be a new empty _
directory because the deinstallation "
                msg$ = msg$ + "procedure removes all files and subdirectories from " _
 + s + "!" + chr$(10) + chr$(10)
                msg$ = msg$ + "Would you like to install New Menus in the directory " _
+ s + "?"
                erg = MessageBox(DlgHandle(me), msg$, "New Menus Install", _
MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2)
                if erg = IDNO then exit function
            endif
            CloseDialog(me, IDNEXT)
        endif

    case "PrevBtn"
        if action = 2 then
            CloseDialog(me, IDPREV)
        endif
    end select
end function
          

Dadurch wird dieser Dialog angezeigt: