Here is an example UTILITY program that should work to post indented code to the foum.by (Login The-Universe)R This is a compilation of work from Alipha and Michael Calkins, and me. MC modified Alipha's code so the clipboard part will also work in QB 1.1. For those who have PDS or QB45, you should be able to compile this source code and then make a desktop shortcut to it. I added a COMMAND$ feature to the clipboard function and developed an app that will do as follows: A) Drag a qb program file into the shortcut and the app will add alt+0160 characters to the clipboard contents. Now just past to the forum using IE or Opera and your code indentation should be preserved. (May not work in FF - untested.) or... B) Copy forum source code to the Windows clipboard and then click the shortcut. The application will open the source code in the QBasic IDE. I hope it works; it's fresh out of the oven without much testing. I would be happy to add the compiled exe file to the Downloads page if anyone who does not have QB45 would like to use it. ================ REM Clipboard functions provided by Alipha, Shellreef, and Michael Calkins. DEFINT A-Z DECLARE FUNCTION Windows () DECLARE SUB setcode () DECLARE FUNCTION ClipboardText$ () DECLARE SUB OpenClipboard () DECLARE SUB CloseClipboard () DECLARE SUB SetClipboardText (text$) DECLARE SUB EmptyClipboard () TYPE regst ax AS INTEGER 'passed & recieved cx AS INTEGER 'passed dx AS INTEGER 'passed & recieved bx AS INTEGER 'passed si AS INTEGER 'passed es AS INTEGER 'passed allow AS INTEGER code AS STRING * 40 END TYPE DIM SHARED regs AS regst CLS setcode IF NOT Windows THEN PRINT "Windows not present.": SYSTEM CLS PRINT "QB Forum Utility Program" FileName$ = LTRIM$(RTRIM$(COMMAND$)) IF FileName$ = "" THEN opt = 1: REM Open from clipboard. SELECT CASE opt CASE 0 ON ERROR GOTO endprogram OPEN FileName$ FOR INPUT AS #1 ON ERROR GOTO 0 OpenClipboard EmptyClipboard DO UNTIL EOF(1) LINE INPUT #1, a$ x$ = x$ + a$ + CHR$(13) LOOP CLOSE #1 GOSUB alt160 SetClipboardText x$ CloseClipboard PRINT "You may now use Ctrl + v or Shift + Insert to paste and post your code!" SLEEP 2 CASE 1 OpenClipboard x$ = ClipboardText$ CloseClipboard GOSUB alt160 a$ = "": OPEN "qb-forum.bas" FOR OUTPUT AS #1 DO IF INSTR(x$, CHR$(13)) <> 0 THEN a$ = MID$(x$, 1, INSTR(x$, CHR$(13)) - 1) IF MID$(a$, 1, 1) = CHR$(10) THEN a$ = MID$(a$, 2) PRINT #1, a$ x$ = MID$(x$, INSTR(x$, CHR$(13)) + 1) ELSE PRINT #1, x$: EXIT DO END IF IF x$ = "" THEN EXIT DO LOOP CLOSE #1 SHELL "qb.exe qb-forum.bas /l" END SELECT SYSTEM alt160: SELECT CASE opt CASE 0 DO UNTIL INSTR(x$, SPACE$(2)) = 0 MID$(x$, INSTR(x$, SPACE$(2)), 2) = STRING$(2, 160) LOOP CASE 1 DO UNTIL INSTR(x$, CHR$(160)) = 0 MID$(x$, INSTR(x$, CHR$(160)), 1) = " " LOOP END SELECT RETURN endprogram: PRINT "File [" + FileName$ + "] was not found. Ending..." SLEEP 2 END FUNCTION ClipboardText$ regs.ax = &H1704 regs.dx = 1 IF regs.allow THEN DEF SEG = VARSEG(regs.code): CALL absolute(regs.ax, VARPTR(regs.code)): DEF SEG IF regs.dx <> 0 OR regs.ax < 0 THEN PRINT "Too much data in clipboard." END END IF IF regs.ax = 0 THEN ClipboardText$ = "" EXIT FUNCTION END IF buffer$ = SPACE$(regs.ax) regs.ax = &H1705 regs.dx = 1 regs.es = VARSEG(buffer$) regs.bx = SADD(buffer$) IF regs.allow THEN DEF SEG = VARSEG(regs.code): CALL absolute(regs.ax, VARPTR(regs.code)): DEF SEG IF regs.ax = 0 THEN PRINT "Error while accessing clipboard data." END END IF ClipboardText$ = LEFT$(buffer$, INSTR(buffer$, CHR$(0)) - 1) END FUNCTION SUB CloseClipboard regs.ax = &H1708 IF regs.allow THEN DEF SEG = VARSEG(regs.code): CALL absolute(regs.ax, VARPTR(regs.code)): DEF SEG IF regs.ax = 0 THEN PRINT "Unable to close" END END IF END SUB SUB EmptyClipboard regs.ax = &H1702 IF regs.allow THEN DEF SEG = VARSEG(regs.code): CALL absolute(regs.ax, VARPTR(regs.code)): DEF SEG IF regs.ax = 0 THEN PRINT "Unable to empty clipboard." END END IF END SUB SUB OpenClipboard regs.ax = &H1701 IF regs.allow THEN DEF SEG = VARSEG(regs.code): CALL absolute(regs.ax, VARPTR(regs.code)): DEF SEG IF regs.ax = 0 THEN PRINT "clipboard in use" END END IF END SUB SUB SetClipboardText (text$) t$ = text$ + CHR$(0) regs.ax = &H1703 regs.dx = 1 regs.es = VARSEG(t$) regs.bx = SADD(t$) regs.cx = LEN(t$) regs.si = 0 IF regs.allow THEN DEF SEG = VARSEG(regs.code): CALL absolute(regs.ax, VARPTR(regs.code)): DEF SEG IF regs.ax = 0 THEN PRINT "Error while trying to place text in clipboard." END END IF END SUB SUB setcode h$ = "5589E55657068B7E068B058B4D028B55048B5D068B75088E450ACD2F8905895504075F5E5DCA0200" asm$ = "" FOR i = 1 TO LEN(h$) STEP 2 asm$ = asm$ + CHR$(VAL("&h" + MID$(h$, i, 2))) NEXT i IF LEN(asm$) <> LEN(regs.code) THEN PRINT LEN(asm$): BEEP: SYSTEM regs.code = asm$ regs.allow = -1 END SUB FUNCTION Windows 'This section adapted from Shellreef's code. ' Returns false if Windows is found, else true regs.ax = &H1700 IF regs.allow THEN DEF SEG = VARSEG(regs.code): CALL absolute(regs.ax, VARPTR(regs.code)): DEF SEG IF (regs.ax <> &H1700) THEN isValid = -1 ELSE isValid = 0 END IF Windows = isValid END FUNCTION --------------------------- Pete |
| Response Title | Author and Date |
| It doesn't work on my XP | qbguy on Jan 18 |
| XP/2000/NT need this add-on for clipboard copying... | on Jan 18 |