Read image from memory to string of HEX values

[l1marik]

Is any way how to read image created by CreateImage() to string of HEX values without saving of file to disc?

THX

[infratec]

You mean convert not read?

Look at:

Code: Select all

EncodeImage()
Base64Encoder()

[l1marik]

Base64Encoder() is not suitable for me, I need HEX (for RTF).

Code: Select all

UsePNGImageEncoder()
UsePNGImageDecoder()

Define W = 200, H = 200, tWindow, tCanvas, *Buffer, tImg, t

tWindow = OpenWindow(#PB_Any, 0, 0, W, H, "Create image and convert to PNG", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
tCanvas = CanvasGadget(#PB_Any, 0, 0, W, H)
If CreateImage(tImg, W, H)
  If StartDrawing(ImageOutput(tImg))
    Circle(100,100,50,RGB(0,0,255))
    Box(150,20,20,20, RGB(0,255,0)) 
    StopDrawing()
  EndIf
  
EndIf

;SetGadgetAttribute(tCanvas, #PB_Canvas_Image, ImageID(tImg))

*Buffer = EncodeImage(tImg, #PB_ImagePlugin_PNG, 0, 32)

If *Buffer
  CatchImage(tImg, *Buffer, MemorySize(*Buffer))
  ShowMemoryViewer(*Buffer, MemorySize(*Buffer))
  SetGadgetAttribute(tCanvas, #PB_Canvas_Image, ImageID(tImg)) ; can save image, proceed etc... 
  ;SaveImage(tPNG, "something.png", #PB_ImagePlugin_PNG) 
 
  *Mem = AllocateMemory(MemorySize(*Buffer))
  For t=0 To MemorySize(*Buffer)-1
    ; HERE I NEED TO CONVERT BINARY TO HEX LIKE IS SHOWING MEMORY VIEWER
  Next
  FreeMemory(*Buffer)
EndIf
FreeImage(tImg)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

[infratec]

Then look at:

Code: Select all

Hex()

[infratec]

Maybe in combination with RSet():

Code: Select all

RSet(Hex(PeekA(*Buffer + t)), 2, "0")

[infratec]

Better then PeekA:

Code: Select all

;Define *Ptr.Ascii, *EndBuffer
  *EndBuffer = *Buffer + MemorySize(*Buffer) - 1
  For *Ptr = *Buffer To *EndBuffer
    Hex$ + RSet(Hex(*Ptr\a), 2, "0")
  Next
  Debug Hex$

[l1marik]

Final version, slow with big images, but better than nothing
Thank guys!

Code: Select all

UsePNGImageEncoder()
UsePNGImageDecoder()

Define W = 200, H = 200, tWindow, tCanvas, *Buffer, tImg, t, out.s, *Ptr.Ascii, *EndBuffer

tWindow = OpenWindow(#PB_Any, 0, 0, W, H, "Create image and convert to PNG", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
tCanvas = CanvasGadget(#PB_Any, 0, 0, W, H)
If CreateImage(tImg, W, H)
  If StartDrawing(ImageOutput(tImg))
    Circle(100,100,50,RGB(0,0,255))
    Box(150,20,20,20, RGB(0,255,0)) 
    StopDrawing()
  EndIf
EndIf

*Buffer = EncodeImage(tImg, #PB_ImagePlugin_PNG, 0, 32)

If *Buffer
  CatchImage(tImg, *Buffer, MemorySize(*Buffer))
  ;can save image, proceed etc... 
  SetGadgetAttribute(tCanvas, #PB_Canvas_Image, ImageID(tImg)) 
  ;SaveImage(tPNG, "something.png", #PB_ImagePlugin_PNG) 
  
  *Mem = AllocateMemory(MemorySize(*Buffer))
  
  *EndBuffer = *Buffer + MemorySize(*Buffer) - 1
  For *Ptr = *Buffer To *EndBuffer
    out + RSet(Hex(*Ptr\a), 2, "0")
  Next
  
  FreeMemory(*Buffer)
  Debug out
  
EndIf
FreeImage(tImg)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

[infratec]

This should be faster, because it avoids string concatenation:

Code: Select all

*Mem = AllocateMemory(MemorySize(*Buffer) * 2)
  If *Mem
    *MemPtr = *Mem
    
    *EndBuffer = *Buffer + MemorySize(*Buffer) - 1
    For *Ptr = *Buffer To *EndBuffer
      PokeS(*MemPtr, RSet(Hex(*Ptr\a), 2, "0"), 2, #PB_Ascii)
      *MemPtr + 2
    Next
    
    Debug PeekS(*Mem, MemorySize(*Mem), #PB_Ascii)
    FreeMemory(*Mem)
  EndIf

And ... it makes use of *Mem and it frees it.

[infratec]

Maybe this is even faster:

Code: Select all

*Mem = AllocateMemory(MemorySize(*Buffer) * 2)
  If *Mem
    *MemPtr.Ascii = *Mem
    
    *EndBuffer = *Buffer + MemorySize(*Buffer) - 1
    
    For *Ptr = *Buffer To *EndBuffer
      
      Nibble = '0'
      Nibble | (*Ptr\a >> 4)
      If Nibble > '9' : Nibble + 7 : EndIf
      *MemPtr\a = Nibble
  
      *MemPtr + 1
  
      Nibble = '0'
      Nibble | (*Ptr\a & $0F)
      If Nibble > '9' : Nibble + 7 : EndIf
      *MemPtr\a = Nibble
  
      *MemPtr + 1
    Next
    
    Debug PeekS(*Mem, MemorySize(*Mem), #PB_Ascii)
    FreeMemory(*Mem)
  EndIf

But not with the debugger on, because of more PB lines and internal Debug stuff.
You have to test it in your real program.

[l1marik]

YESSS!

[SMaag]

Timing without debugger:
Version Rset = 352ms
Version Pointer = 3ms
Version Nibble = 4ms

Code: Select all

DeclareModule HexString
  
  Global Dim ByteToHexConversionTable.l(255) 
  
  Declare.s BufferToHexString(*Buffer, Bytes)
EndDeclareModule


Module HexString
  
  ; Structure for direct Memory-Access-Pointer
  ; [0] define a virtual Array, so both a and l are at the same address
  ; this works like Union
  Structure pBuffer
    a.a[0]      ; ByteAccess
    l.l[0]      ; LongAccess
  EndStructure
  
  Procedure InitByteToHexConversionTable()
  ; ============================================================================
  ; NAME: CreateByteToHexConversionTable
  ; DESC: Creates the Conversion Table for Byte{0..255} to HexChar {00..FF}
  ; DESC: Writes the correspondig Hex$ in ASCII-Code for each Byte into the 
  ; DESC: ConversionTable-Array: 0 => '00'; 255 ='FF';  
  ; DESC: the conversion use PureBasic 2Byte Character so each entry is a
  ; DESC: 4 Byte value. 2 Bytes vor each Character.
  ; DESC: To convert a ByteValue to Hex$ Characters Value
  ; DESC: for Byte=254: HexCahrs.l = ByteToHexConversionTable(16)
  ; DESC: now HexCahrs contains the ASCII-Codes for "FE" in 2Byte-Char-Coding
  ; DESC: 
  ; RET : -
  ; ============================================================================    
    Protected N, I, J, hi 
    #cstShift = 16
    ; because there is a gap in the ASCII-Codes between '9' and 'A'
    ; we must use to Loops to create the correct ASCII Codes
    For I = '0' To '9'      ; 48..57
      hi = I
      For J = '0' To '9'
        ByteToHexConversionTable(N) = I + J << #cstShift  
        N + 1 
      Next    
      For J = 'A' To 'F'    ; 65..70
        ByteToHexConversionTable(N) = I + J << #cstShift 
        N + 1     
      Next
    Next
    
    For I = 'A' To 'F' 
      hi = I
      For J = '0' To '9'
        ByteToHexConversionTable(N) = I + J  << #cstShift
        N + 1 
      Next  
      For J = 'A' To 'F'
        ByteToHexConversionTable(N) = I + J  << #cstShift
        N + 1     
      Next
    Next
    
  EndProcedure
    
  Procedure.s BufferToHexString(*Buffer, Bytes)
  ; ============================================================================
  ; NAME: BufferToHexString
  ; DESC: Converts a Buffer to a Hex-String
  ; DESC: Convert each Byte to a 2-char-Hex-String
  ; VAR(*Buffer) : Pointer to the Buffer
  ; VAR(Bytes) : Number of Bytes to convert    
  ; RET.s: The String with the Bytes Hex-Values
  ; ============================================================================
   
    Protected I
    Protected *src.pBuffer, *dest.pBuffer
    Protected sRet.s
        
    If *Buffer
      sRet = Space(Bytes * 2)
      *dest = @sRet
      *src = *Buffer
      
      For I = 0 To (Bytes -1)
        *dest\l[I] = ByteToHexConversionTable(*src\a[I])
         ;Debug Chr(*dest\l[I]>>16) +  Chr(*dest\l[I] & $FFFF)
      Next
    EndIf   
    ProcedureReturn sRet
  EndProcedure
  
  Procedure DebugConversionTable()
    Protected I   
    For I = 0 To 255
      Debug Str(I) + " : "  +  Chr(ByteToHexConversionTable(I) & $FFFF) + Chr(ByteToHexConversionTable(I)>>16)
    Next    
  EndProcedure
    
  InitByteToHexConversionTable()
  DebugConversionTable()
  
EndModule

CompilerIf #PB_Compiler_IsMainFile   
  EnableExplicit
  
  Procedure.s ByteToHex_RSet(*Buffer, Bytes)
    ; Using PureBasic Rset command
    Protected I
    Protected sRet.s
    Protected *Ptr.Ascii, *EndBuffer
    
    If *Buffer
      *Ptr = *Buffer
      *EndBuffer = *Ptr + Bytes - 1
      For *Ptr = *Buffer To *EndBuffer
        sRet + RSet(Hex(*Ptr\a), 2, "0")
      Next
    EndIf   
    ProcedureReturn sRet
  EndProcedure
  
  Procedure.s ByteToHex_Nibble(*Buffer, Bytes)
    Protected *Mem, *MemPtr.Ascii, *Ptr.Ascii
    Protected *EndBuffer, Nibble.a
    Protected sRet.s
    *Mem = AllocateMemory(Bytes*2 +2)
  
    If *Mem
      *MemPtr = *Mem
    
      *EndBuffer = *Buffer + MemorySize(*Buffer) - 1
    
      For *Ptr = *Buffer To *EndBuffer
        
        Nibble = '0'
        Nibble | (*Ptr\a >> 4)
        If Nibble > '9' : Nibble + 7 : EndIf
        *MemPtr\a = Nibble
      
        *MemPtr + 1
      
        Nibble = '0'
        Nibble | (*Ptr\a & $0F)
        If Nibble > '9' : Nibble + 7 : EndIf
        *MemPtr\a = Nibble
      
        *MemPtr + 1
      Next
  
      sRet = PeekS(*Mem, MemorySize(*Mem), #PB_Ascii)
     
      ; ProcedureReturn PeekS(*Mem, MemorySize(*Mem), #PB_Ascii) ; This is not possible because it ends and do not release *Mem
       FreeMemory(*Mem)   
      ProcedureReturn sRet
    EndIf
    
  EndProcedure
  
  UseModule HexString
  
  UsePNGImageEncoder()
  UsePNGImageDecoder()
  
  Define W = 200, H = 200, tWindow, tCanvas, *Buffer, tImg,  I
  Define out.s, msg.s
  Define tim1, tim2, tim3
  Define.s msg1, msg2, msg3
  
  tWindow = OpenWindow(#PB_Any, 0, 0, W, H, "Create image and convert to PNG", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  tCanvas = CanvasGadget(#PB_Any, 0, 0, W, H)
  If CreateImage(tImg, W, H)
    If StartDrawing(ImageOutput(tImg))
      Circle(100,100,50,RGB(0,0,255))
      Box(150,20,20,20, RGB(0,255,0)) 
      StopDrawing()
    EndIf
  EndIf
  
  *Buffer = EncodeImage(tImg, #PB_ImagePlugin_PNG, 0, 32)
  
  If *Buffer
    CatchImage(tImg, *Buffer, MemorySize(*Buffer))
    ;can save image, proceed etc... 
    SetGadgetAttribute(tCanvas, #PB_Canvas_Image, ImageID(tImg)) 
    ;SaveImage(tPNG, "something.png", #PB_ImagePlugin_PNG) 
      
    tim1 = ElapsedMilliseconds()
    For I = 1 To 1000
      out = ByteToHex_RSet(*Buffer, MemorySize(*Buffer))
    Next
    Debug out
    msg1= "With RSet : ms=" + Str(ElapsedMilliseconds() - tim1)
    Debug msg
    
    Debug #Null$ 
    tim2 = ElapsedMilliseconds()
    For I = 1 To 1000
      out = BufferToHexString(*Buffer, MemorySize(*Buffer))
    Next
    Debug out
    msg2= "With Pointer : ms=" + Str(ElapsedMilliseconds() - tim2)
    Debug msg2
    
    Debug #Null$ 
    tim3 = ElapsedMilliseconds()
    For I = 1 To 1000
      out = ByteToHex_Nibble(*Buffer, MemorySize(*Buffer))
    Next
    Debug out
    msg3= "With Nibble : ms=" + Str(ElapsedMilliseconds() - tim3)
    Debug msg3
    
    FreeMemory(*Buffer)
    
    MessageRequester("Buffer to Hex-String", msg1 + #CRLF$ + msg2 + #CRLF$ + msg3)
  EndIf
  
  FreeImage(tImg)
  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
CompilerEndIf

[infratec]

@SMaag

Your measurment is wrong.

You have the Debugger enabled.
As I have written, cause of the more lines the nibble version is slower then the pointer version.

If you want to measure the real speed, you have to use a MessageRequester() for the output.
Then disable the Debugger and run it.