GenBinaryWebContentFile.bas

#define fbc -s gui
#include once "windows.bi"
#include once "win\commctrl.bi"

'********* Enumerating the Window's Control ID's *********'
enum WindowControls
  wcMain

  wcFileLabel       'Label saying which input is filename
  wcFileTxtBox      'To type filename to write

  wcTitleLabel      'Laben infront of title input
  wcTitleTxtBox     'Page Title input

  wcContentLabel    'Label above content input
  wcContentTxtBox   'Page Content input

  wcSubmitBtn       'Submit button
  wcLast
end enum

Declare sub WinMain()
Dim Shared as hwnd CTL(wcLast)      'controls
Dim Shared as hinstance APPINSTANCE  'instance
Dim Shared as hfont MyFont           'Font
Dim Shared as string AppName        'AppName (window title 'prefix')

AppName = "Website Content File Generator"
InitCommonControls()
APPINSTANCE = GetModuleHandle(null)
WinMain()

dim shared as any ptr ButProc

Sub CreateContentFile()
    Dim Filename as zString * 100
    Dim PageTitle as zString * 100
    Dim PageContent as zString * 65535

    GetWindowText(ctl(wcFileTxtBox), Filename, 100)
    GetWindowText(ctl(wcTitleTxtBox), PageTitle, 100)
    GetWindowText(ctl(wcContentTxtBox), PageContent, 65535)

    If (Open(Filename for binary access write as #1)) Then
        MessageBox(null, !"Error: Could not open file:\r\n"+Filename, AppName, MB_ICONERROR)
        return
    End If

    Put #1,, "BWCF"     'Write header... stands for "Binary Web Content File"

    Put #1,, Chr(&H01)                       ' Indicates page title
    Put #1,, Len(PageTitle)                  ' Length of title to read
    Put #1,, Left(PageTitle, Len(PageTitle)) ' Actual title

    Put #1,, Chr(&H02)                       ' Indicates page contents
    Put #1,, Len(PageContent)                ' Length of content to read
    Put #1,, Left(PageContent, Len(PageContent)) ' Actual content

    Close #1

    MessageBox(null,"Wrote file successfully!", AppName, MB_ICONINFORMATION)
End Sub

'***********************************************'
'******** Routines for WinAPI functions ********'
'***********************************************'
Function WndProc (hWnd as HWND, message as UINT, wParam as WPARAM, lParam as LPARAM) as LRESULT
    Select Case message
    Case WM_CREATE  'Window was created
        Scope   'Calculate Client Area Size
            Dim as rect RcWnd = any, RcCli = Any, RcDesk = any
            GetClientRect(hWnd, @RcCli)
            GetClientRect(GetDesktopWindow(), @RcDesk)
            GetWindowRect(hWnd, @RcWnd)
            'Window Rect is in SCREEN coordinate.... make right/bottom become WID/HEI
            with RcWnd
                .right -= .left: .bottom -= .top
                .right += (.right-RcCli.right)  'Add difference cli/wnd
                .bottom += (.bottom-RcCli.bottom)   'add difference cli/wnd
                var CenterX = (RcDesk.right-.right)\2
                var CenterY = (RcDesk.bottom-.bottom)\2
                SetWindowPos(hwnd,null,CenterX,CenterY,.right,.bottom,SWP_NOZORDER)
            end with
        end Scope

        'To help with creating controls
        #define CreateControl( mID , mExStyle , mClass , mCaption , mStyle , mX , mY , mWid , mHei ) CTL(mID) = CreateWindowEx(mExStyle,mClass,mCaption,mStyle,mX,mY,mWid,mHei,hwnd,cast(hmenu,mID),APPINSTANCE,null)

        '***** Define style constants *****
        const cBase = WS_VISIBLE OR WS_CHILD
        const cLabel = cBase OR WS_TABSTOP
        const cButtonStyle = cBase OR BS_MULTILINE              'Standard button style
        const cSingleLnTxtBox = cBase OR WS_HSCROLL OR ES_AUTOHSCROLL
        const cMultiLnTxtBox = cBase OR ES_MULTILINE OR WS_VSCROLL OR ES_AUTOVSCROLL
        const cEx1 = WS_EX_CLIENTEDGE

        '***** Create objects on window *****
        CreateControl(wcFileLabel, null, "static", "Filename:", cLabel, 10, 10, 45, 15)
        CreateControl(wcFileTxtBox, cEx1, WC_EDIT,  null, cSingleLnTxtBox, 60, 8, 430, 20)

        CreateControl(wcTitleLabel, null, "static", "Title:", cLabel, 10, 40, 25, 15)
        CreateControl(wcTitleTxtBox, cEx1, WC_EDIT,  null, cSingleLnTxtBox, 60, 38, 430, 20)

        CreateControl(wcContentLabel, null, "static", "Content:", cLabel, 10, 70, 40, 20)
        CreateControl(wcContentTxtBox, cEx1, WC_EDIT, null, cMultiLnTxtBox, 60, 70, 430, 215)

        CreateControl(wcSubmitBtn, null, WC_BUTTON, "Generate File", cButtonStyle, 60, 295, 75, 30)

        '***** Create fonts *****
        var hDC = GetDC(hWnd)
        var nHeight = -MulDiv(8, GetDeviceCaps(hDC, LOGPIXELSY), 72)    'Calculate size for DPI
        MyFont = CreateFont(nHeight,0,0,0,FW_NORMAL,0,0,0,DEFAULT_CHARSET,0,0,0,0,"MS Sans Serif")

        '***** Set font for all controls *****
        For CNT as Integer = wcMain to wcLast-1
            SendMessage(CTL(CNT),WM_SETFONT,cast(wparam,MyFont),true)
        Next CNT
        ReleaseDC(hWnd,hDC)

        '***** Apply extra styling *****

    Case WM_COMMAND 'Event happened to a control (child window)
        Select case hiword(wparam)
        case BN_CLICKED 'button click
            select case lparam
            case CTL(wcSubmitBtn)
                CreateContentFile()
            end Select
        End Select

    Case WM_CLOSE,WM_DESTROY    'Window was closed/destroyed
        PostQuitMessage(0)  'to quit
        return 0
    End Select
    '***** If we get here a default predefined action will happen *****
    return DefWindowProc(hWnd,message,wParam,lParam)
End Function

'******************************'
'***** WinMain Subroutine *****'
'******************************'
Sub WinMain ()
    Dim wMsg as MSG
    Dim wcls as WNDCLASS
    Dim as HWND hWnd

    'Setup window class
    With wcls
        .style          = CS_HREDRAW OR CS_VREDRAW OR CS_SAVEBITS
        .lpfnWndProc    = @WndProc
        .cbClsExtra     = 0
        .cbWndExtra     = 0
        .hInstance      = APPINSTANCE
        .hIcon          = LoadIcon(APPINSTANCE, "FB_PROGRAM_ICON")
        .hCursor        = LoadCursor(NULL, IDC_ARROW)
        .hbrBackground  = cast(hBrush, COLOR_BTNFACE + 1)
        .lpszMenuName   = NULL
        .lpszClassName  = strptr(AppName)
    End With

    'Rehister window class
    If (RegisterClass(@wcls)=FALSE) Then
        MessageBox(null,"Failed to register wcls!", AppName, MB_ICONERROR)
        Exit Sub
    End If

    Const wWidth = 500, wHeight = 340
    Const cWindowStyle = WS_VISIBLE OR WS_TILEDWINDOW OR WS_CLIPCHILDREN _
                         XOR WS_THICKFRAME XOR WS_MAXIMIZEBOX 'No resize or maximize

    'Create the window and show it
    hWnd = CreateWindowEx(WS_EX_COMPOSITED OR WS_EX_LAYERED,AppName,AppName, _
    cWindowStyle, 200,200,wWidth,wHeight,null,null,APPINSTANCE,NULL)
    SetforegroundWindow(hWnd)

    'Process windows messages
    '***** All messages(events) will be read converted/dispatched here *****
    UpdateWindow(hWnd)

    while (GetMessage(@wMsg, NULL, 0, 0) <> FALSE)
        TranslateMessage(@wMsg)
        DispatchMessage(@wMsg)
    wend

End Sub