Texteditor via API for Liberty BASIC 4+


Liberty BASIC's texteditor control doesn't allow for word-wrapping and is not accessible via API calls. You can create your own texteditor with API calls. here is a barebones demo.

nomainwin
WindowWidth=640:WindowHeight=480
UpperLeftX=1:UpperLeftY=1

Menu #1, "&File", "&Open", [open],_
    "&Save", [save], "E&xit", [quit]
Menu #1, "&Edit", "&Cut", [cut],_
    "C&opy", [copy], "&Paste", [paste],_
    "&Undo", [undo]
Menu #1, "&Font", "&Arial 14", [arial14],_
    "A&rial 18", [arial18],_
    "&Courier New 14", [courier14],_
    "Courier &New 18",[courier18]

open "Barebones Texteditor" for window as #1
print #1, "trapclose [quit]"
print #1, "resizehandler [resizeIt]"

hT=CreateTextEdit(hwnd(#1), 1, 1, 630, 432)

call SetFocus hT

wait

[quit]
    if hFont<>0 then call DeleteObject hFont
    close #1:end

[resizeIt]
    ww=WindowWidth:wh=WindowHeight
    call MoveWindow hT, 1, 1, ww-2, wh-2
    wait

[open]
    filedialog "Open","*.txt",file$
    if file$="" then wait
    open file$ for input as #f
    txt$=input$(#f, lof(#f))
    close #f
    call SetWindowText hT, txt$
    wait

[save]
    filedialog "Save","*.txt",sfile$
    if sfile$="" then wait
    if right$(sfile$,4)<>".txt" then
        sfile$=sfile$+".txt"
    end if
    open sfile$ for output as #f
    txt$=GetWindowText$(hT)
    print #f, txt$
    close #f
    wait

[cut]
    ret = SendMessageLong(hT,_WM_CUT,0,0)
    wait

[copy]
    ret = SendMessageLong(hT,_WM_COPY,0,0)
    wait

[paste]
    ret = SendMessageLong(hT,_WM_PASTE,0,0)
    wait

[undo]
    ret = SendMessageLong(hT,_WM_UNDO,0,0)
    wait

[arial14]
    if hFont<>0 then call DeleteObject hFont
    hFont=CreateFont("arial",14)
    ret = SendMessageLong(hT,_WM_SETFONT,hFont,1)
    wait

[arial18]
    if hFont<>0 then call DeleteObject hFont
    hFont=CreateFont("arial",18)
    ret = SendMessageLong(hT,_WM_SETFONT,hFont,1)
    wait

[courier14]
    if hFont<>0 then call DeleteObject hFont
    hFont=CreateFont("courier new",14)
    ret = SendMessageLong(hT,_WM_SETFONT,hFont,1)
    wait

[courier18]
    if hFont<>0 then call DeleteObject hFont
    hFont=CreateFont("courier new",18)
    ret = SendMessageLong(hT,_WM_SETFONT,hFont,1)
    wait

Function SendMessagePtr(hWnd,msg,w,p$)
    calldll #user32, "SendMessageA", hWnd as ulong, _
    msg as long, w as long, p$ as ptr,_
    SendMessagePtr as long
    end function

function SendMessageLong(hWnd,msg,w,l)
    calldll #user32, "SendMessageA", hWnd as ulong, _
    msg as long, w as long, l as long,_
    SendMessageLong as long
    end function

sub SetFocus hWnd
    calldll #user32, "SetFocus", hWnd as ulong,_
    result as ulong
    end sub

sub SetWindowText hWnd, txt$
    calldll #user32, "SetWindowTextA", hWnd as ulong,_
    txt$ as ptr, result as void
    end sub

function GetWindowText$(hWnd)
    total = GetWindowTextLength(hWnd)
    Title$=space$(total)+Chr$(0):l= Len(Title$)

    calldll #user32, "GetWindowTextA", hWnd as ulong,_
    Title$ as ptr, l as long, result as long
    GetWindowText$=trim$(Title$)
    end function

function GetWindowTextLength(hW)
    calldll #user32, "GetWindowTextLengthA",_
    hW as ulong,_
    GetWindowTextLength as long
    end function

Function CreateTextEdit(hW, x, y, w, h)
    style = _WS_CHILDWINDOW OR _WS_BORDER _
    OR _WS_VISIBLE or _ES_MULTILINE or _WS_VSCROLL
    hInst=GetWindowLong(hW, _GWL_HINSTANCE)

    calldll #user32, "CreateWindowExA",_
        0 as long,"EDIT" as ptr,_
        "" as ptr, style as long,_
        x as long,y as long,w as long,h as long,_
        hW as ulong, 0 as long, hInst as ulong,_
        0 as long, CreateTextEdit as ulong
    end function

Function GetWindowLong(hW, type)
    calldll #user32, "GetWindowLongA", _
    hW as ulong, type as long,_
    GetWindowLong as ulong
    End Function

Function CreateFont(fontname$, fontheight)
    fontname$ = fontname$ + chr$(0)
    Calldll #gdi32, "CreateFontA",_
         fontheight as long,_
         0 as long,0 as long,0 as long,_
         0 as long,0 as long,0 as long,_
         0 as long,0 as long,0 as long,_
         0 as long,0 as long,0 as long,_
         fontname$ as PTR,_
         CreateFont as ulong
    end function

sub DeleteObject hObject
    calldll #gdi32,"DeleteObject",_
    hObject as ulong,_
    r as long
    end sub

sub MoveWindow hW, x, y, w, h
    calldll #user32, "MoveWindow",_
    hW as ulong, x as long, y as long,_
    w as long, h as long,_
    1 as boolean, result as long
    end sub






Home

Source Code

Utilities

Internet

Games

Graphics

Media Demos

Snippets

DLL's

API Resources

Freeware

LB 4 Companion

Mastering LB 3

LB Workshop

Game Workshop

Links

Index