 |
||||||||
 |
 |
 |
||||||
| |
|||||||||||||||||||||||||||||||||||||||||||
 |
 | |||
| Ein Programm in der Programmiersprache | A program in the programming language | |||
| Power Basic 10 for Windows | ||||
|
zur Erzeugung einer Tabelle in HTML-Code
|
for generation of a table in HTML-Code
| |||
|
Das Programm generiert eine KeyWord-Tabelle in HTML mit KeyWords aus einer Liste auf Festplatte.
|
The program generates a KeyWordTable in HTML from KeyWords in a list on hard-disk
| |||
| Das Programm ist getestet vor der Publikation, aber es kann keine Garantie gegeben werden, dass es fehlerfrei ist | The program ist tested before publication, but there can be given no guarantee, that it is free of errors | |||
| 28. Nov 2014 | Nov 28th 2014 | |||
|
' Generates a Table in HTML-Code from a list on hard-disk
' works in Windows XP, for Win 7 pathes must be changed #COMPILE EXE #DIM ALL #INCLUDE "Sendkeys.inc" #INCLUDE "UserOwnModules.inc" ' In UserOwnModules.inc are only the procedures: ' ReadArrayFromFile and WriteTextToFile needed for this purpose ' they can be found on others of my websites FUNCTION PBMAIN () AS LONG LOCAL ErrMsg, NamePart0, NamePart, Languages, Exts, FileName, ListNames, TableColors, TableColor AS STRING LOCAL CurrentPath, BrowserPath, Filespec, FileSpecOUT, HTMLtext AS STRING LOCAL PgmNames, List() AS STRING, NrOfColums, Task, HeadAndFoot AS INTEGER ' Variable Assignments NamePart0 = "Keywords-": Exts = ".dat,.htm" ' Languages = "vbs,bas,bas" ListNames = "stm,stm,ops": TableColors = "0000FF,0000FF,8000FF" BrowserPath = "c:\Program Files\Internet Explorer\" ' Win 7 PgmNames = "notepad,iexplore" NrOfColums = 4: HeadAndFoot = 1 ' HeadAndFoot can be 0 or 1 ' More Values determined CurrentPath = EXE.PATH$ ' files to process in the same folder as pgm-file ' Program ErrMsg = "" FOR Task = 1 TO PARSECOUNT(Languages) ' stm = statements, ops = operators NamePart = NamePart0 & PARSE$(Languages,Task) & "-" FileName = NamePart & PARSE$(ListNames,Task) & PARSE$(Exts,1) Filespec = CurrentPath & FileName FileSpecOUT = CurrentPath & PATHNAME$(NAME,FileName) & PARSE$(Exts,2) TableColor = PARSE$(TableColors, Task) ReadArrayFromFile List(), Filespec ' Read from disk and convert IF ARRAYATTR(List(), 0) THEN HTMLtext = MakeTable(List(), FileName, TableColor, NrOfColums, HeadAndFoot) WriteTextToFile HTMLtext, FileSpecOUT ' Output Result SHELL(PARSE$(PgmNames,1) & " " & FileSpecOUT) ' Displays result with Notepad SHELL(BrowserPath & _ PARSE$(PgmNames,2) & " " & FileSpecOUT) ' Displays result with Browser ELSE IF ErrMsg <> "" THEN ErrMsg = ErrMsg & $CRLF ErrMsg = ErrMsg & FileName END IF NEXT: SendKeys "% x" ' Maximises MsgBox-Window IF ErrMsg = "" THEN MSGBOX "Job done" ELSE MSGBOX ErrMsg,,"file(s) not found" END FUNCTION FUNCTION MakeTable(AnyList() AS STRING, AnyTitle AS STRING, AnyColor AS STRING, _ NrOfCols AS WORD, HeadAndFoot AS INTEGER) AS STRING LOCAL Ubd, rw, clm, HeaderAndFooter, NrOfRows, colspan, i, x AS INTEGER LOCAL Head, Foot, LineTxt, TableTxt, SpanStyle, sTmp AS STRING LOCAL TM, LM, CM, RM, BM, Cel AS INTEGER ' TM = Top Margin ' LM = Left Margin ' CM = Center Margin ' RM = Right Margin ' BM = Bottom Margin TM = 40: LM = 40 : CM = 20: RM = 20: BM = 40: Cel = 180 colspan = 2 * NrOfCols + 1 HeaderAndFooter = ISTRUE HeadAndFoot Head = "": Foot = "" IF HeaderAndFooter THEN Head = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01 Transitional//EN"" " & _ """http://www.w3.org/TR/html4/loose.dtd"">" & $CRLF & _ "<html><head><title>Tablemaking</title>" & $CRLF & _ "<meta NAME=""author"" CONTENT=""Erich"">" & $CRLF & _ "<meta NAME=""editor"" CONTENT=""html-editor phase 5"">" & $CRLF & _ "</head>" & $CRLF & _ "<body text=""#000000"" bgcolor=""#DDDDDD"" link=""#FF0000"" " & _ "alink=""#FF0000"" vlink=""#FF0000"">" & $CRLF Foot = "</body></html>" END IF ' spanLine ---------------------------------------------------------------------------------- SpanStyle = "font-family:Courier New;font-size:10pt;color:#" & AnyColor & ";" SpanStyle = "<span style=" & q(SpanStyle) & ">" TableTxt = $CRLF & SpanStyle & $CRLF ' TableLine --------------------------------------------------------------------------------- TableTxt &= "<table border=""0"" cellpadding=""0"" colspan=""0"" " & _ "align=""center"" bgcolor=""#FFFFFF"">" & $CRLF ' ColgroupLine ------------------------------------------------------------------------------ TableTxt &= "<colgroup><col width=" & qs(LM) & ">" FOR i = 1 TO NrOfCols TableTxt &= "<col width=" & qs(Cel) & ">" IF i < NrOfCols THEN TableTxt &= "<col width=" & qs(CM) & ">" NEXT: TableTxt &= "<col width=" & qs(RM) & "></colgroup>" & $CRLF ' TopMarginLine ----------------------------------------------------------------------------- TableTxt &= "<tr><td colspan=" & qs(colspan) & " height=" & qs(TM) & "></td></tr>" & $CRLF ' TitleLine --------------------------------------------------------------------------------- TableTxt &= "<tr><td></td><td colspan=" & qs(colspan-1) & "><B>" & _ AnyTitle & "</B><BR><BR></td></tr>" &$CRLF ' Cells ------------------------------------------------------------------------------------- x = UBOUND(AnyList): Ubd = x + (x MOD NrOfCols) ' make Listl. an integer multiple of NrOfCols IF Ubd > x THEN REDIM PRESERVE AnyList(1 TO Ubd) NrOfRows = INT((Ubd)/NrOfCols) FOR rw = 0 TO NrOfRows - 1: LineTxt = "" FOR clm = 0 TO NrOfCols - 1 IF rw = 0 AND clm = 0 THEN LineTxt &= "<td rowspan=" & qs(NrOfRows) & "></td>" LineTxt &= "<td>" & SpecChars(CellTxt(AnyList(), NrOfCols, rw, clm)) & "</td>" IF rw = 0 THEN LineTxt &= "<td rowspan=" & qs(NrOfRows) & "></td>" NEXT: TableTxt &= $CRLF & "<tr>" & LineTxt & "</tr>" NEXT ' BottomMargin ------------------------------------------------------------------------------ TableTxt &= "<tr><td height=" & qs(BM) & " colspan=" & qs(colspan) & "></td></tr>" & $CRLF ' End-TAGs ---------------------------------------------------------------------------------- TableTxt &= "</table></span>" & $CRLF & $CRLF FUNCTION = Head & TableTxt & Foot END FUNCTION FUNCTION SpecChars(AnyString AS STRING) AS STRING LOCAL Chars, SpChrs, Char, sTmp AS STRING LOCAL i, j AS INTEGER ' insert HTML-code for special characters ' & must be on first place ' at the end ";" must be missing Chars = "&äÄöÖüÜß ""<>§" SpChrs = "&äÄöÖüÜß "<>§" REPLACE $TAB WITH " " IN AnyString FOR i = 1 TO LEN(AnyString) Char = MID$(AnyString,i,1): j = INSTR(Chars,Char) IF j > 0 THEN Char = PARSE$(SpChrs,";", j) sTmp &= Char NEXT: FUNCTION = sTmp END FUNCTION FUNCTION CellTxt(AnyArray() AS STRING, NrOfCols AS INTEGER, AnyRow AS INTEGER, _ AnyCol AS INTEGER) AS STRING LOCAL NrOfRows, ListPos AS INTEGER: NrOfRows = INT((UBOUND(AnyArray))/NrOfCols) ListPos = AnyCol * NrOfRows + AnyRow + 1 FUNCTION = AnyArray(ListPos) END FUNCTION FUNCTION q(AnyString AS STRING) AS STRING ' quotes a string FUNCTION = """" & AnyString & """" END FUNCTION FUNCTION qs(AnyNr AS INTEGER) AS STRING ' strings and quotes a number FUNCTION = q(TRIM$(STR$(AnyNr))) END FUNCTION | ||
| Keywords-vbs-stm.dat | ||||||||
| Abs | Error | Left | Space | |||||
| And | Eval | Len | Split | |||||
| Array | Execute | Let | Sqr | |||||
| Asc | ExecuteGlobal | Log | Step | |||||
| AscB | Exit | Loop | Stop | |||||
| Atn | Exp | Mid | StrComp | |||||
| CBool | Explicit | Mod | StrReverse | |||||
| CByte | False | MsgBox | String | |||||
| CCur | Fix | Next | Sub | |||||
| CDate | For | Not | Then | |||||
| CDbl | ForReading | Nothing | To | |||||
| CInt | ForWriting | Null | Trim | |||||
| CLng | Function | On | True | |||||
| CSng | If | Option | UBound | |||||
| CStr | Imp | Or | UCase | |||||
| Call | In | Preserve | Until | |||||
| Case | InStr | Private | Wend | |||||
| Chr | InStrRev | Property | While | |||||
| Class | InputBox | Public | With | |||||
| Const | Int | RGB | Xor | |||||
| Cos | Is | RTrim | vbCr | |||||
| CreateObject | IsArray | Randomize | vbCrLf | |||||
| Dim | IsDate | ReDim | vbLf | |||||
| Do | IsEmpty | Replace | vbNo | |||||
| Each | IsNull | Resume | vbOK | |||||
| Else | IsNumeric | Right | vbOKCancel | |||||
| ElseIf | IsObject | Rnd | vbOKOnly | |||||
| Empty | Join | Round | vbTab | |||||
| End | LBound | Select | vbYes | |||||
| Eqv | LCase | Set | vbYesNo | |||||
| Erase | LTrim | Sin | vbYesNoCancel | |||||
| Keywords-bas-stm.dat | ||||||||
| #COMPILE EXE | ADD | IF | RIGHT | |||||
| #DIM ALL | ARRAY | IMP | RIGHT$ | |||||
| #ENDIF | AS | INCR | ROTATE | |||||
| #IF | ASC | INPUT | RTRIM$ | |||||
| #INCLUDE | BROWSE | INSERT | SAVEFILE | |||||
| #TOOLS | BYREF | INSTR | SCAN | |||||
| $CRLF | BYVAL | INTEGER | SELECT | |||||
| %ARCHIVE | CALL | ISFILE | SET | |||||
| %BIF_EDITBOX | CALLBACK | ISNOTHING | SHIFT | |||||
| %BN_CLICKED | CASE | ITERATE | SHOW | |||||
| %DEF | CBCTL | JOIN$ | SORT | |||||
| %DS_3DLOOK | CBCTLMSG | KILL | STATIC | |||||
| %DS_MODALFRAME | CBHNDL | LABEL | STATUS | |||||
| %DS_NOFAILCREATE | CBMSG | LBOUND | STRING | |||||
| %DS_SETFONT | CBWPARAM | LCASE$ | STRREVERSE$ | |||||
| %HIDDEN | CHR$ | LEFT | SUB | |||||
| %HWND_DESKTOP | CLOSE | LEFT$ | SUSPEND | |||||
| %IDC_BUTTON1 | COLOR | LEN | TAB | |||||
| %IDC_LABEL1 | CONTROL | LET | TAB$ | |||||
| %IDC_LISTBOX1 | CREATE | LINE | TALLY | |||||
| %IDD_DIALOG1 | CURDIR$ | LISTBOX | TAN | |||||
| %LBN_DBLCLK | DECLARE | LOCAL | TANH | |||||
| %LBS_NOTIFY | DECR | LONG | TEXT | |||||
| %NORMAL | DELETE | LTRIM$ | THEN | |||||
| %OFN_ALLOWMULTISELECT | DIALOG | MACRO | THREAD | |||||
| %OFN_ENABLESIZING | DIM | MCASE$ | TIME$ | |||||
| %OFN_FILEMUSTEXIST | DIR$ | MEMBER | TIMEOUT | |||||
| %OFN_NOVALIDATE | DISPLAY | MENU | TO | |||||
| %OFN_OVERWRITEPROMPT | DWORD | MID$ | TRACE | |||||
| %OFN_PATHMUSTEXIST | ELSE | MODAL | TRIM$ | |||||
| %READONLY | ELSEIF | MSGBOX | TRN | |||||
| %SS_CENTER | END | NEW | TRY | |||||
| %SS_SUNKEN | ERASE | NEXT | TXT | |||||
| %SUBDIR | ERROR | NOTHING | TYPE | |||||
| %SYSTEM | EXE.NAME$ | NUL$ | UBOUND | |||||
| %WHITE | EXE.PATH$ | NULL | UCASE$ | |||||
| %WM_COMMAND | EXIT | OBJECT | UNTIL | |||||
| %WM_INITDIALOG | EXP | OF | USING$ | |||||
| %WM_NCACTIVATE | EXTENDED | OFF | VAL | |||||
| %WS_BORDER | EXTRACT$ | ON | VARIANT | |||||
| %WS_CHILD | FIELD | OPEN | VARIANT$ | |||||
| %WS_CLIPSIBLINGS | FILESCAN | OPENFILE | VERIFY | |||||
| %WS_DLGFRAME | FILL | OUTPUT | WEND | |||||
| %WS_EX_CLIENTEDGE | FOR | PARSE | WHILE | |||||
| %WS_EX_CONTROLPARENT | FORMAT$ | PARSE$ | WIDTH | |||||
| %WS_EX_LEFT | FUNCTION | PARSECOUNT | WINDOW | |||||
| %WS_EX_LTRREADING | GET | PBMAIN | WORD | |||||
| %WS_EX_RIGHTSCROLLBAR | GETATTR | PRESERVE | WRITE | |||||
| %WS_POPUP | GLOBAL | WRITE# | ||||||
| %WS_SYSMENU | GOSUB | RECORDS | XPRINT | |||||
| %WS_TABSTOP | GOTO | REDIM | XPRINT$ | |||||
| %WS_VISIBLE | GRAPHIC | RESET | ||||||
| %WS_VSCROLL | HANDLE | RESUME | ||||||
| Keywords-bas-ops.dat | ||||||||
| & | / | >= | MOD | |||||
| &= | < | AND | NOT | |||||
| ( | <= | EQV | OR | |||||
| ) | <> | IMP | XOR | |||||
| * | = | ISFALSE | \ | |||||
| - | > | ISTRUE | ||||||