HTML Coder

The purpose of this is to simply the creation of a web page involving graphic images, a block of text, and a Heading. I find it useful sometimes in converting untidy emails such as those set left of centre, with unnecessary massive TPI print, and inter line spacing. A number of such conversions can often bee seen from contributions I receive each day at http://www.sigord.co.uk/News.htm A number of sites host the complete package such as at

http://download.cnet.com/HTMLcoder/3000-10247_4-10906797.html?tag=mncol

As you can see it allows for a variety of options such selecting the Text, heading and background colours along with the size of fonts, and width of the images. The height of the images are adjusted accordingly. Text is COPY and Pasted in, allowing for automatic reformatting to remove all extra line and word spacing. Also any single CHR$ such as the dreaded < can be removed. An extra option allows reformatted text to be saved as a TXT file. The HTML coding is fairly simple with my limitations, but others may be able to include greater improvements for their use.

Gordon

 nomainwin 
 ' Beginners HTML Thanks to Alyce for image323.dll 
 dim dir$(10,3) : dim pic$(60,2) 
 head$ = "" "" : hfile$ = "" "" : tfile$ = "" "" : this$ = DefaultDir$ 
 tcol$ = "000000" "000000" : bcol$ = "FFFFFF" "FFFFFF" 
 txtsize$ = "3" "3" : headsize$ = "5" "5" : imagewidth$ = "500" "500" 
 open "image323.dll" "image323.dll" for dll as #im 
 [main] 
 WindowWidth = 800 : WindowHeight = 600 
 button #h, "Text Colour", "Text Colour", [textcol], UL, 140, 140 
 button #h, "Back Colour", "Back Colour", [backcol], UL, 320, 140 
 button #h, "Heading", "Heading", [heading], UL, 470, 140 
 button #h, "Colour", "Colour", [headcol], UL, 540, 140 
 button #h, "Text Window", "Text Window", [text], UL, 175, 180 
 button #h, "Insert JPGs", "Insert JPGs", [jpg], UL, 296, 180 
 button #h, "Save "Save web page", page", [page], UL, 416, 180 
 button #h, "Save text", "Save text", [file], UL, 550, 180 
 button #h, " Text "Text Size ", ", [textsize], UL, 180, 220 
 button #h, "Heading "Heading Size ", ", [headsize], UL, 350, 220 
 button #h, "Images Width", "Images Width", [imgwidth], UL, 520, 220 
 button #h, "Display HTML", "Display HTML", [show], UL, 180, 280 
 button #h, "Test "Test web page", page", [test], UL, 300, 280 
 button #h, "Display .txt", "Display .txt", [tfile], UL, 430, 280 
 button #h, "* "* QUIT *", *", [quit], UL, 550, 280 
 open "Simple "Simple Web Pages" Pages" for graphics_nsb as #h 
 #h "trapclose "trapclose [quit]; font arial 18 bold; place 280 40; down" #h "\Simple down" 
 #h "\Simple Web Pages" #h "font Pages" 
 #h "font arial 8 bold; color black; place 250 56" #h "\Produced 56" 
 #h "\Produced with Liberty Basic - ver 2.1- Gordon Sweet" #h "font Sweet" 
 #h "font arial 10 bold; place 180 80; color darkgreen" #h "\You darkgreen" 
 #h "\You can import any text by using COPY then Text Window Options to" #h "\PASTE, to" 
 #h "\PASTE, up to 50 JPGs must be placed in an adjoining folder to this" #h "\program. this" 
 #h "\program. The HTML file that is saved and the folder must be uploaded." #h "\Note uploaded." 
 #h "\Note the display of samples such as the colours etc is only temporary." #h "font temporary." 
 #h "font fixedsys 9; color black; place 250 160 " : #h "\Sample" #h "place " : #h "\Sample" 
 #h "place 610 160" : #h "\Sample" #h "color darkblue" #h "place 160" : #h "\Sample" 
 #h "color darkblue" 
 #h "place 180 320" : #h "|Web 320" : #h "|Web page = ";hfile$ #h "place ";hfile$ 
 #h "place 180 340" : #h "|Text 340" : #h "|Text file = ";tfile$ #h "place ";tfile$ 
 #h "place 180 360" : #h "\HEADING = ";head$ #h "place 360" : #h "\HEADING = ";head$ 
 #h "place 180 260" : #h "\Current 260" : #h "\Current Text size 3, Heading size 5, Images width 500" #h "place 500" 
 #h "place 420 164; box 440 140; flush" flush" 
 'get DC of graphicbox 
 gDC=GetDC(hwnd(#h)) 
 'create memory DC 
 mDC=CreateCompatibleDC(gDC) 
 hW=hwnd(#h) 'graphicbox hW=hwnd(#h)'graphicbox handle 
 wait 
 
 [textcol] 
 gosub [colours] : tcol$ = html$ 
 #h "place "place 250 160; color " " + col$ : #h "\Sample" #h "color black" "\Sample" 
 #h "color black" 
 wait 
 
 [backcol] 
 gosub [colours] : bcol$ = html$ 
 #h "backcolor ";col$ : #h "place "backcolor ";col$ : #h "place 420 164; boxfilled 440 140" #h "backcolor white" 140" 
 #h "backcolor white" 
 wait 
 
 [colours] 
 colordialog "red", "red", col$ 
 if val(col$) = 0 then col$ ="0 ="0 0 0" 0" : notice "black selected" "black selected" 
 r$ = word$(col$,1) : g$ = word$(col$,2) : b$ = word$(col$,3) 
 html$ = RIGHT$("0"+dechex$(val(r$)),2) RIGHT$("0"+dechex$(val(r$)),2) 
 html$ = html$ + RIGHT$("0"+dechex$(val(g$)),2) RIGHT$("0"+dechex$(val(g$)),2) 
 html$ = html$ + RIGHT$("0"+dechex$(val(b$)),2) RIGHT$("0"+dechex$(val(b$)),2) 
 return 
 
 [heading] 
 prompt "Enter "Enter a heading";head$ heading";head$ : if head$ = "" then wait #h "place "" then wait 
 #h "place 180 360" : #h "\HEADING = ";head$ 360" : #h "\HEADING = ";head$ : wait 
 
 [headcol] 
 gosub [colours] : hcol$ = html$ 
 #h "place "place 610 160; color " " + col$ : #h "\Sample" #h "color black" "\Sample" 
 #h "color black" 
 wait 
 
 [page] 
 DefaultDir$ = this$ 
 prompt "Enter filename.htm";hfile$ "Enter filename.htm";hfile$ 
 if hfile$ = "" "" then wait 
 open hfile$ for output as #2 
 #2 "<html><head><title>Text "<html><head><title>Text & Images</title></head>" Images</title></head>" 
 t$ ="<body><body bgcolor="+bcol$+">" ="<body><body bgcolor="+bcol$+">" 
 #2 t$ 
 t$ = "<font "<font face=arial><font size="+headsize$+"><font color="+hcol$+">" size="+headsize$+"><font color="+hcol$+">" 
 #2 t$ 
 t$ = "<br><b><center>"+head$+"</center></b><font>" "<br><b><center>"+head$+"</center></b><font>" 
 #2 t$ 
 #2 "</center></b><font><br>" "</center></b><font><br>" 
 t$ = "<font "<font face=arial><font size="+textsize$+"><font color="+tcol$+">" size="+textsize$+"><font color="+tcol$+">" 
 #2 t$ 
 #2 "<BLOCKQUOTE><b>" "<BLOCKQUOTE><b>" 
 #2 new$ 
 #2 "</b></BLOCKQUOTE>" "</b></BLOCKQUOTE>" 
 #2 t$ 
 for N = 1 to qtyFiles 
 t$="<center><img src="+pic$(N,1) t$="<center><img src="+pic$(N,1) 
 t$ = t$ +" width="+imagewidth$+" height="+pic$(N,2)+"></center><p>" +" width="+imagewidth$+" height="+pic$(N,2)+"></center><p>" 
 if qtyFiles > 0 then #2 t$ 
 next N 
 #2 "</body><html>" "</body><html>" 
 close #2 
 #h "place #h "place 180 320" : #h "|Web 320" : #h "|Web page = ";hfile$; #h "place ";hfile$; 
 #h "place 180 340" : #h "|Text 340" : #h "|Text file = ";tfile$ ";tfile$ 
 wait 
 
 [file] 
 DefaultDir$ = this$ 
 prompt "Enter filename.txt";tfile$ "Enter filename.txt";tfile$ 
 if tfile$ = "" "" then wait 
 open tfile$ for output as #2 
 #2 new$ 
 close #2 
 #h "place "place 180 320" : #h "|Web 320" : #h "|Web page = ";hfile$; #h "place ";hfile$; 
 #h "place 180 340" : #h "|Text 340" : #h "|Text file = ";tfile$ ";tfile$ 
 wait 
 
 [textsize] 
 prompt "Enter "Enter text size 1/7";textsize$ 1/7";textsize$ : q = val(textsize$) 
 if q < 1 or q > 7 then notice "INVALID "INVALID ENTRY !" : textsize$ = "3" #h "place !" :textsize$ = "3" 
 #h "place 180 260" #h "\Current 260" 
 #h "\Current Text size ";textsize$;" ";textsize$;" Heading size ";headsize$;" ";headsize$;" Images width ";imgwidth$;" " ";imgwidth$;"" 
 wait 
 
 [headsize] 
 prompt "Enter "Enter heading size 1/7";headsize$ 1/7";headsize$ : q = val(headsize$) 
 if q < 1 or q > 7 then notice "INVALID "INVALID ENTRY !" !" : headsize$ = "5" #h "place "5" 
 #h "place 180 260" #h "\Current 260" 
 #h "\Current Text size ";textsize$;" ";textsize$;" Heading size ";headsize$;" ";headsize$;" Images width ";imgwidth$;" " ";imgwidth$;"" 
 wait 
 
 [imgwidth] 
 prompt "Enter "Enter images width over 99";imagewidth$ 99";imagewidth$ : q = val(imagewidth$) 
 if q < 100 then notice "INVALID "INVALID ENTRY !" !" : imagewidth$ = "500" #h "place "500" 
 #h "place 180 260" #h "\Current 260" 
 #h "\Current Text size ";textsize$;" ";textsize$;" Heading size ";headsize$;" ";headsize$;" Images width ";imagewidth$;" " ";imagewidth$;"" 
 wait 
 
 [show] 
 if hfile$ = "" "" then notice "NO "NO FILE !" : wait !" : wait 
 op$ = "notepad.exe "+hfile$ "notepad.exe "+hfile$ : run op$ 
 wait 
 
 [test] 
 if hfile$ = "" "" then notice "NO "NO Web Page" Page" : wait 
 CALL ShellExecute hWnd, hfile$ 
 wait 
 
 [tfile] 
 if tfile$ = "" "" then notice "NO "NO FILE !" : wait !" : wait 
 op$ = "notepad.exe "+tfile$ "notepad.exe "+tfile$ : run op$ 
 wait 
 
 [text] 
 close #h 
 menu #t, "OPTIONS","Paste",[insert],"Clear",[clear],"Remove "OPTIONS","Paste",[insert],"Clear",[clear],"Remove Blank Lines",[lines],_ "Erase Character",[del],"Reformat Text",[format],|,"MAIN MENU", Lines",[lines],_ 
 "Erase Character",[del],"Reformat Text",[format],|,"MAIN MENU", [quitclip] 
 open "Text" "Text" for text as #t 
 #t "!trapclose [quitclip]" : #t "!font #t "!trapclose [quitclip]" :#t "!font fixedsys 9" wait 9" 
 wait 
 
 [insert] #t "!cls" : #t "!paste" : #t "!contents? new$"; #t "!contents? text$"; : #t "!cls" 
 #t "!cls" : #t "!paste" : #t "!contents? new$"; 
 #t "!contents? text$"; : #t "!cls" 
 if len(text$) < 50 then notice "Text "Text too short to reformat" reformat" : wait 
 temp$ = "" "" : p = 1 : lp = 1: l = len(text$) 
 while p < l+1 
 k$ = mid$(text$,p,1) 
 k asc(k$) : =asc(k$) : p= p p + 1 
 new$ = new$ + chr$(k) 
 temp$ = temp$ + chr$(k) : lp = lp + 1 
 if lp > 88 and k = 32 or lp > 124 then 
 #t temp$ : temp$ = "" "" : lp = 0 
 end if 
 wend 
 #t "!contents? new$"; : #t "!origin 1 1" "!contents? new$"; : #t "!origin 1 1" 
 wait 
 
 wait 
 
 [clear] 
 #t "!cls" "!cls" : text$ = "" : #t "!copy" "" : #t "!copy" ; 
 wait 
 
 [lines] 
 text$ = new$ 
 if len(text$) < 5 then notice "NO "NO REAL TEXT !!" !!" : wait 
 new$ = "" "" : p = 1 : l = len(text$) : k1 = 0 : ls = 0 
 while p < l+1 
 ok = 0 
 k$ = mid$(text$,p,1) : k = asc(k$) 
 if k = 13 and k1 <> 999 then ls = 0 
 if k = 9 or k > 31 and k < 127 then ok = 1 
 if k = 13 and ls = 0 then 
 new$ = new$ + chr$(13)+chr$(10) 
 ls = 1 : k1 = 999 : p = p + 1 
 end if 
 if ok = 1 then new$ = new$ + chr$(k) : k1 = k 
 p = p + 1 
 wend 
 text$ = new$ : #t "!cls" "!cls" : #t text$ 
 #t "!contents? new$"; : #t "!origin 1 1" #t "!contents? new$"; : #t "!origin 1 1" 
 wait 
 
 [del] 
 if new$ = "" "" then notice "NO "NO TEXT !!" !!" : wait 
 d$ = "" "" : prompt "Enter "Enter one character to delete"; delete"; d$ 
 if len(d$) <> 1 then notice "ONE "ONE CHARACTER ONLY !!" : wait #t "!contents? text$"; : #t "!cls" !!" : wait 
 #t "!contents? text$"; : #t "!cls" 
 if len(text$) < 50 then notice "Text "Text too short to reformat" reformat" : wait 
 x asc(d$) : new$ "" =asc(d$) : new$= "" : p = 1 : l = len(text$) 
 while p < l+1 
 ok = 0 
 k$ = mid$(text$,p,1) : k = asc(k$) 
 if k = 9 or k > 31 and k < 127 then ok = 1 
 if k = 13 then 
 new$ = new$ + chr$(13)+chr$(10) 
 p = p + 1 
 end if 
 if ok = 1 and k <> x then new$ = new$ + chr$(k) 
 p = p + 1 
 wend 
 text$ = new$ : #t "!cls" "!cls" : #t text$ 
 #t "!contents? new$"; : #t "!origin 1 1" wait #t "!contents? new$"; : #t "!origin 1 1" 
 wait 
 
 [format] #t "!contents? text$"; : #t "!cls" 
 #t "!contents? text$"; : #t "!cls" 
 if len(text$) < 50 then notice "Text "Text too short to reformat" reformat" : wait 
 temp$ = "" "" : p = 1 : lp = 1 
 l len(text$) : k1 0 =len(text$) : k1=0 
 while p < l+1 : ok = 0 
 k$ = mid$(text$,p,1) 
 k asc(k$) : p =asc(k$) : p= p + 1 
 if k = 9 or k > 31 and k < 127 then ok = 1 
 if k = 13 then k = 32 : ok = 1 
 if k = 32 and k1 = 32 then ok = 0 
 if ok = 1 then 
 new$ = new$ + chr$(k) : k1 = k 
 temp$ = temp$ + chr$(k) : lp = lp + 1 
 end if 
 if lp > 88 and k = 32 or lp > 124 then 
 #t temp$ : temp$ = "" "" : lp = 0 
 end if 
 wend 
 #t "!contents? new$"; : #t "!origin 1 1" "!contents? new$"; : #t "!origin 1 1" 
 wait 
 
 [jpg] 
 DefaultDir$ = left$(DefaultDir$,2)+"\HTMLcode" left$(DefaultDir$,2)+"\HTMLcode" 
 filedialog "Select "Select any JPG file","*.jpg", file","*.jpg", File$ 
 if File$ = "" "" then wait 
 
 sFile$ = noPath$(File$) : plen :plen = len(File$)-len(sFile$) 
 path$ = left$(File$,plen) : ext$ = "*.jpg" "*.jpg" 
 files path$, ext$, dir$() 
 qtyFiles = val(dir$(0, 0)) 
 if qtyFiles > 50 then notice "LIMITED "LIMITED to maximum of 50)" 50)" : qtyFiles = 50 
 'reformat the file information 
 for x = 1 to qtyFiles 
 dir$(x, 1) = right$(" " right$("" + dir$(x, 1), 9) 
 pic$(x,1) = dir$(x, =dir$(x, 0) 
 next x 
 
 FL = len(path$)-1 
 for TEST = FL to 1 step -1 
 if mid$(path$,TEST,1)="\" mid$(path$,TEST,1)="\" then 
 PL = FL-TEST : exit for 
 end if 
 next TEST 
 dpath$ = right$(path$,PL+1) 
 
 #h "place "place 10 390 " : #h "|";space$(20);qtyFiles;" JPGs " : #h "|";space$(20);qtyFiles;"JPGs FILES IN ";dpath$ IN";dpath$ 
 
 for j = 1 to qtyFiles 
 jpg$ = jpg$ + " " - ";pic$(j,1) ";pic$(j,1) 
 if len(jpg$) > 70 then #h "\";jpg$ "\";jpg$ : jpg$ = "" "" 
 pic$(j,1) = dpath$ + pic$(j,1) : bmp$ = pic$(j,1) 
 gosub [picsize] : f = val(imagewidth$) 
 height = int(f/bw * bh) 
 pic$(j,2) = str$(height) 
 next : #h "\";jpg$ "\";jpg$ 
 wait 
 
 [picsize] 
 hImage=LoadImageFile(hW,bmp$) 
 if hImage=0 then 
 notice "Function failed." "Function failed." 
 cursor normal 
 wait 
 end if 
 if hDemo<>0 then unloadbmp "demo" "demo" 
 loadbmp "demo",hImage : hDemo=hbmp("demo") "demo",hImage : hDemo=hbmp("demo") 
 if bmp$ ="" ="" then notice "NO image" "NO image" : goto [quit] 
 bw=BitmapWidth(hDemo) : bh=BitmapHeight(hDemo) 
 return 
 
 [quitclip] close #t : goto [main] 
 
 [quit] 
 if hDemo<>0 then unloadbmp "demo" "demo" 
 if hImage<>0 then ok = DeleteObject(hImage) 
 call ReleaseDC hwnd(#h), gDC 
 call DeleteDC mDC 
 close #h : close #im : end 
 
 Function GetDC(hWnd) 
 CallDLL #user32, "GetDC",_ "GetDC",_ 
 hWnd As Long,_ 'window Long,_'window or control handle 
 GetDC As Long 'returns Long'returns device context 
 End Function 
 
 Sub ReleaseDC hWnd, hDC 
 CallDLL#user32,"ReleaseDC",_ CallDLL#user32,"ReleaseDC",_ 
 hWnd As Long,_ 'window Long,_'window or control handle 
 hDC As Long,_ 'handle Long,_'handle of DC to delete 
 result As Long 
 End Sub 
 
 Function CreateCompatibleDC(hDC) 
 CallDLL #gdi32,"CreateCompatibleDC",_ #gdi32,"CreateCompatibleDC",_ 
 hDC As Long,_ 'window Long,_'window DC 
 CreateCompatibleDC As Long 'memory Long'memory DC 
 End Function 
 
 Sub DeleteDC hDC 
 CallDLL #gdi32, "DeleteDC",_ "DeleteDC",_ 
 hDC As Long,_ 'memory Long,_'memory DC to delete 
 r As Boolean 
 End Sub 
 
 Function BitmapWidth(Hbmp) 
 struct BITMAP,_ 
 bmType As Long,_ 
 bmWidth As Long,_ 
 bmHeight As Long,_ 
 bmWidthBytes As Long,_ 
 bmPlanes As Word,_ 
 bmBitsPixel As Word,_ 
 bmBits As Long 
 
 nSize=Len(BITMAP.struct) 
 CallDLL #gdi32, "GetObjectA", "GetObjectA", Hbmp As Long,_ 
 nSize As Long,BITMAP As struct,_ 
 results As Long 
 
 BitmapWidth=BITMAP.bmWidth.struct 
 End Function 
 
 Function BitmapHeight(Hbmp) 
 struct BITMAP,_ 
 bmType As Long,_ 
 bmWidth As Long,_ 
 bmHeight As Long,_ 
 bmWidthBytes As Long,_ 
 bmPlanes As Word,_ 
 bmBitsPixel As Word,_ 
 bmBits As Long 
 
 nSize=Len(BITMAP.struct) 
 CallDLL #gdi32, "GetObjectA", "GetObjectA", Hbmp As Long,_ 
 nSize As Long,BITMAP As struct,_ 
 results As Long 
 
 BitmapHeight=BITMAP.bmHeight.struct 
 End Function 
 
 Function DeleteObject(hObject) 
 CallDLL #gdi32,"DeleteObject",_ #gdi32,"DeleteObject",_ 
 hObject As Long,_ 'handle Long,_'handle of object 
 DeleteObject As Long 'returns whatever 
 End Function 
 
 Function LoadImageFile(hWnd, file$) 
 'load an image from file, 
 'bmp, jpg, emf, wmf, ico 
 'returns handle of memory bmp 
 calldll #im, "LoadImageFile",hWnd "LoadImageFile",hWnd as ulong,_ 
 file$ as ptr,LoadImageFile as ulong 
 End Function 
 
 function noPath$(t$) 
 while instr(t$, "\") "\") 
 t$ = mid$(t$, 2) 
 wend 
 noPath$ = t$ 
 end function 
 
 Sub ShellExecute hWnd, cf$ 
 parameter = _SW_SHOWNORMAL ' _SW_SHOWNORMAL' set up for viewing 
 lpszOp$ = "open" "open" + Chr$(0)' "open" or "play" or "print" 
 lpszFile$ = cf$ + Chr$(0) ' "open" or "play" or "print" lpszFile$ = cf$ 
 lpszDir$ = DefaultDir$ + Chr$(0) 
 lpszDir$ = DefaultDir$ + Chr$(0) lpszParams$="" lpszParams$="" + Chr$(0) 
 CallDLL #shell32, "ShellExecuteA", "ShellExecuteA", hWnd As long,lpszOp$ As ptr,lpszFile$ As ptr,_ 
 lpszParams$ As ptr,lpszDir$ As ptr,parameter As long, result As long 
 End Sub