Byte Array an Image
'
' Use PBWIN 9.02
'
#COMPILE EXE
#DIM ALL
FUNCTION PBMAIN () AS LONG
LOCAL hBmp AS DWORD, lRes AS LONG, sBuff AS STRING
?"Press OK to read clipboard"
'
' get bitmap from clipboard
CLIPBOARD GET BITMAP TO hBmp, lRes
'
' select bitmap
GRAPHIC ATTACH hBmp, 0
'
' load bitmap content into a string...
GRAPHIC GET BITS TO sBuff
'
' analyze content...
OPEN "c:\1.dat" FOR BINARY AS 1
PUT$ 1, sBuff
CLOSE 1
'
?"Buff size:" & STR$(LEN(sBuff))
END FUNCTION
'
' convert binary data into a sequence of hex values without delimeters
' each byte will be a 2 hex digits
'
FUNCTION d2hex_to_clipboard (byval sData as string) AS LONG
LOCAL sRz AS STRIG, i AS LONG
FOR i=1 TO LEN(sData)
sRz = sRz & HEX$(ASC(sData,i),2) ' <-- only two hex digits
NEXT
CLIPBOARD RESET
CLIPBOARD SET OEMTEXT sRz
FUNCTION = LEN(sRz)
END FUNCTION
'
' now, read clipboard and decode hex values into a binary string
'
FUNCTION Clipboard_to_Image () AS STRING
LOCAL sRz AS STRIG, i, cRez AS LONG
sRz = ""
CLIPBOARD GET OEMTEXT TO sRz, cRes
IF cRes = 0 THEN
?"Problem occured when reading clipboard"
FUNCTION = ""
EXIT FUNCTION
END IF
FOR i=1 TO LEN(sRz) STEP 2
sRz = sRz & CHR$( VAL("&H"+MID$(sRz,1,2)) )
NEXT
FUNCTION = sRz
END FUNCTION
#COMPILE EXE
#DIM ALL
#INCLUDE "win32api.inc"
$Gif_In = "c:\keep\happy.gif"
$Gif_Out = "c:\keep\junk999.gif"
FUNCTION PBMAIN AS LONG
LOCAL ClipResult AS LONG
LOCAL h AS LONG
LOCAL sReadFromDisk AS STRING
LOCAL sReadFromClip AS STRING
h = FREEFILE
OPEN $Gif_In FOR BINARY AS #h
IF ERR THEN ? "Error opening file" + STR$(ERRCLEAR):GOTO Exit1
GET$ #h, LOF(h), sReadFromDisk
IF ERR THEN ? "Disk read error" + STR$(ERRCLEAR):CLOSE h:GOTO Exit1
CLOSE #h
CLIPBOARD RESET, ClipResult
IF ClipResult <> -1 THEN ? "Clipboard reset error":GOTO Exit1
CLIPBOARD SET OEMTEXT sReadFromDisk, ClipResult
IF ClipResult <> -1 THEN ? "Clipboard Set error":GOTO Exit1
CLIPBOARD GET OEMTEXT TO sReadFromClip , ClipResult
IF ClipResult <> -1 THEN ? "Clipboard GET error":GOTO Exit1
IF sReadFromDisk = sReadFromClip THEN
'another check that it actually works
h = FREEFILE
OPEN $Gif_Out FOR BINARY AS #h
IF ERR THEN ? "Open for output error" + STR$(ERRCLEAR)
PUT$ #h, sReadFromClip
IF ERR THEN ? "Disk write error" + STR$(ERRCLEAR)
CLOSE #h
ShellExecute(0,"open",$Gif_out,"","",1)
ELSE
? "Disk file does not match what was read from clipboard"
END IF
Exit1:
SLEEP 1000
END FUNCTION
#COMPILE EXE
#DIM ALL
REM #BLOAT 117108723 '117,108,723 bytes maximum bloat on this machine
#INCLUDE "win32api.inc"
FUNCTION PBMAIN AS LONG
LOCAL ErrorReturned&, sFileName AS STRING
DO
sFileName = INPUTBOX$("Prompt","1001 uses of bloat",EXE.FULL$)
ErrorReturned = FileToClipBoardOEM (sFileName)
SELECT CASE ErrorReturned
CASE 0: ? "No error"
CASE -1: ? "Nothing passed"
CASE -2: ? "Zero length file"
CASE -3: ? "Clipboard set error"
CASE -4: ? "Clipboard set oem failed"
CASE ELSE: ? "Error" + STR$(ErrorReturned)
END SELECT
? "Length of clipboard " + FORMAT$(LEN(GetClipBoardOEM),"#,")
LOOP WHILE LEN(sFileName)
END FUNCTION
FUNCTION GetClipBoardOEM EXPORT AS STRING
LOCAL sReadFromClip$, ClipResult& 'return nothing if error
CLIPBOARD GET OEMTEXT TO sReadFromClip , ClipResult
IF ClipResult = -1 THEN FUNCTION = sReadFromClip
END FUNCTION
FUNCTION FileToClipBoardOEM(sFileName AS STRING) EXPORT AS LONG
LOCAL ClipResult AS LONG ' return 0 on success
LOCAL h AS LONG
LOCAL sReadFromDisk AS STRING
'Don't reset the clipboard if invalid file passed
IF LEN(sFileName) = 0 THEN
FUNCTION = -1
EXIT FUNCTION 'nothing passed
END IF
IF NOT ISFILE(sFileName) THEN
FUNCTION = 53
EXIT FUNCTION 'use DOS value for file not found
END IF
IF FileSize(sFileName) < 1 THEN 'Large filesize routine used
FUNCTION = -2
EXIT FUNCTION 'don't use 0 length files
END IF
h = FREEFILE
OPEN sFileName FOR BINARY AS #h
IF ERR THEN FUNCTION = ERRCLEAR:EXIT FUNCTION
GET$ #h, LOF(h), sReadFromDisk
IF ERR THEN FUNCTION = ERRCLEAR:CLOSE h:EXIT FUNCTION
CLOSE #h
CLIPBOARD RESET, ClipResult
IF ClipResult <> -1 THEN FUNCTION = -3:EXIT FUNCTION
CLIPBOARD SET OEMTEXT sReadFromDisk, ClipResult
IF ClipResult <> -1 THEN FUNCTION = -4:EXIT FUNCTION
FUNCTION = ERRCLEAR 'did anything get missed?
END FUNCTION
FUNCTION FileSize(BYVAL sFileName AS STRING) AS QUAD
LOCAL FindData AS WIN32_FIND_DATA
LOCAL hDir AS LONG
hDir = FindFirstFile(BYVAL STRPTR(sFileName), FindData)
IF hDir = -1 THEN 'if not found return -53
FUNCTION = -53
ELSE 'return number of bytes
FindClose hDir
FUNCTION = MAK(QUAD, FindData.nFileSizeLow , FindData.nFileSizeHigh)
END IF
END FUNCTION
Comment