PureBasic Forums - English

Posted: **Sat Mar 14, 2009 12:16 pm**

Hi there,

Just made a prog that tries to convert a picture to html page,
it works but very very slow and some colors are wrong with most
pictures i tried.

Code:

Code: Select all

#title  = "HTML TEST: Picture to Html"
#width  = 640
#height = 140

UseJPEGImageDecoder()
UsePNGImageDecoder()

Procedure say(in.s)
   MessageRequester(#title, in.s)
EndProcedure
Procedure.s pic2htm(pic.s, wi.l, he.l)
  If LoadImage(0, pic.s)
     ResizeImage(0, wi, he, #PB_Image_Smooth)
     htm.s = "<HTML><HEAD></HEAD><BODY>"
     htm.s + "<table border="+Chr(34)+"0"+Chr(34)+" border="+Chr(34)+"0"+Chr(34)+" cellspacing="+Chr(34)+"0"+Chr(34)+" cellpadding="+Chr(34)+"0"+Chr(34)+" align="+Chr(34)+"center"+Chr(34)+" style="+Chr(34)+"border-collapse:collapse;"+Chr(34)+" bordercolor="+Chr(34)+"#CCCCCC"+Chr(34)+"><tr><td>"
     htm.s + "<table width="+Chr(34)+Str(wi)+Chr(34)+" border="+Chr(34)+"0"+Chr(34)+" cellspacing="+Chr(34)+"0"+Chr(34)+" cellpadding="+Chr(34)+"0"+Chr(34)+" align="+Chr(34)+"center"+Chr(34)+">"
     StartDrawing(ImageOutput(0))
        For y = 0 To he
           htm.s + "<tr height="+Chr(34)+"1"+Chr(34)+">"
           For x = 0 To wi
              pin.l = Point(x, y)
              htm.s + "<td bgColor="+Chr(34)+"#"+LCase(Hex(Red(pin)))+LCase(Hex(Green(pin)))+LCase(Hex(Blue(pin)))+Chr(34)+"></td>";&nbsp</td>"
              wevent = WindowEvent() 
              If wevent = #PB_Event_CloseWindow : y=he: x=wi: EndIf
           Next
           htm.s + "</tr>"
           SetGadgetState(7, y*wi)
        Next
     StopDrawing()     
     htm.s + "</table></td></tr></table></BODY></HTML>"
     FreeImage(0)
     ProcedureReturn htm.s   
  Else
     ProcedureReturn ""
  EndIf
EndProcedure

If OpenWindow(0, 0, 0, #width, #height, #title, #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
   ButtonGadget(     0,         0,  0, 40,        20, "File")
   TextGadget(       1,        40,  2, #width-40, 20, "None")
   TrackBarGadget(   2,         0, 40, #width-40, 20, 0, 1024)
   TextGadget(       3, #width-40, 42,        40, 20, "0") 
   TrackBarGadget(   4,         0, 80, #width-40, 40, 0, 768)
   TextGadget(       5, #width-40, 82,        40, 40, "0")    
   ButtonGadget(     6,         0, 120,        40, 20, "Start")
   ProgressBarGadget(7,        40, 120, #width-40, 20, 0, 100)
   Repeat
      wevent=WaitWindowEvent()
      If wevent=#PB_Event_Gadget
         Select EventGadget()
            Case 0; file
               pic.s = OpenFileRequester("Select picture", "", "*.*", 0)
               If LoadImage(0, pic.s)
                  SetGadgetText(1, pic.s)
                  wi.l = ImageWidth(0)
                  he.l = ImageHeight(0)
                  SetGadgetState(2, wi)
                  SetGadgetState(4, he)
                  SetGadgetText(3, Str(wi))
                  SetGadgetText(5, Str(he))
                  SetGadgetAttribute(7, #PB_ProgressBar_Maximum, wi*he.l) 
                  SetGadgetState(7, 0)
                  FreeImage(0) 
               EndIf
            Case 2; width
               wi.l = GetGadgetState(2)
               SetGadgetText(3, Str(wi))
               SetGadgetAttribute(7, #PB_ProgressBar_Maximum, wi*he.l) 
            Case 4; height
               he.l = GetGadgetState(4)
               SetGadgetText(5, Str(he))            
               SetGadgetAttribute(7, #PB_ProgressBar_Maximum, wi*he.l) 
            Case 6; start/stop
               DisableGadget(6, 1)
               htm.s = pic2htm(pic.s, wi, he)
               If htm.s=""
                  say("No valid picture file")
               Else
                  If CreateFile(0, "C:\test.html")
                     WriteStringN(0, htm.s)
                     CloseFile(0)
                     RunProgram("explorer.exe", "C:\test.html", "")
                  EndIf  
               EndIf
               DisableGadget(6, 0)
         EndSelect
      EndIf
   Until wevent = #PB_Event_CloseWindow 
   CloseWindow(0)
EndIf
End

Idea's?

Posted: **Sat Mar 14, 2009 12:28 pm**

before I dig deep into your code:
did you watch the channel order?

PureBasic uses RGB 24bit color notation, that means, the RED is first in memory.
according to that, when you write it as a 24bit HEX number the BLUE is first in the notation.
you write it $BBGGRR but it is still RGB, because the least significant byte is always first in memory but last in notation.

in HTML, the web notation is #RRGGBB, this is no 24bit HEX number,
but a coded notation für three bytes in a row.

Posted: **Sat Mar 14, 2009 1:58 pm**

Kaeru Gaman wrote:before I dig deep into your code:
did you watch the channel order?

PureBasic uses RGB 24bit color notation, that means, the RED is first in memory.
according to that, when you write it as a 24bit HEX number the BLUE is first in the notation.
you write it $BBGGRR but it is still RGB, because the least significant byte is always first in memory but last in notation.

in HTML, the web notation is #RRGGBB, this is no 24bit HEX number,
but a coded notation für three bytes in a row.

Well i didn't use hex(rgbvalue), i used hex(red(rgbvalue)), hex(green(rgbvalue)), etc..

I tried using hex(rgbvalue) directly, but it results in wrong RGB
coloring.

Most of the pics seem to have the right rgb value's, exept
there are a few distorted pixels in almost every picture i try.

Example (picture from google, see result right):

Posted: **Sat Mar 14, 2009 2:16 pm**

In case the value of a specific color component is less than $10 you need to put a zero in front of the value when converting to ASCII.
Consider the following; the color is $0f0f0f i.e. some light shade of gray, when converting using your routine you will get the following '#FFF' which is some altogether different color!

Posted: **Sat Mar 14, 2009 2:25 pm**

Pupil wrote:In case the value of a specific color component is less than $10 you need to put a zero in front of the value when converting to ASCII.
Consider the following; the color is $0f0f0f i.e. some light shade of gray, when converting using your routine you will get the following '#FFF' which is some altogether different color!

Wow tnx, works now!

Posted: **Sat Mar 14, 2009 2:43 pm**

ok... he indeed digged deeper into your code...

Posted: **Sat Mar 14, 2009 7:07 pm**

I should sue for IP rights!

You may find this helpful:

http://www.purebasic.fr/english/viewtopic.php?t=21890

Posted: **Sat Mar 14, 2009 9:28 pm**

Kale wrote:I should sue for IP rights!

You may find this helpful:

http://www.purebasic.fr/english/viewtopic.php?t=21890

Oops sorry man, i totaly didn't know, it was just a mindwave i had to explore..

Posted: **Sun Mar 15, 2009 2:28 am**

> it works but very very slow

Ain't that the truth!

> Oops sorry man, i totaly didn't know

No need to apologise. Anyone can make the same app as someone else.

Posted: **Sun Mar 15, 2009 3:16 am**

Philippe-felixer76-2 wrote:
Kale wrote:I should sue for IP rights!

You may find this helpful:

http://www.purebasic.fr/english/viewtopic.php?t=21890
Oops sorry man, i totaly didn't know, it was just a mindwave i had to explore..

He he, no problem, great minds think alike!

Posted: **Tue Mar 17, 2009 1:03 am**

I thought I would post this here (instead of the thread by Kale).

@Phillippe-felixer76-2: Your code was very slow and included a few errors. One of the errors was the subject of this thread, another was that the pictures width and height were not used correctly in the loops inside pic2htm().

Here's a replacement procedure for pic2htm(). It corrects the color values, loop values, and speed issues. Instead of hours it takes only about 2 seconds to convert the picture. It takes longer to display it, but that is a browser problem (and the files can become quite large)

. The slowdown was due to slow string functions that have to determine the length of a string everytime a small addition to the string is made. As a string grows longer so does the delay.

Code: Select all

Procedure.s pic2htm(pic.s, wi.l, he.l)
  Static h_str_1a.s = "<HTML><HEAD></HEAD><BODY>"
  Static h_str_1b.s = "<table border="+Chr(34)+"0"+Chr(34)+" border="+Chr(34)+"0"+Chr(34)+" cellspacing="+Chr(34)+"0"+Chr(34)+" cellpadding="+Chr(34)+"0"+Chr(34)+" align="+Chr(34)+"center"+Chr(34)+" style="+Chr(34)+"border-collapse:collapse;"+Chr(34)+" bordercolor="+Chr(34)+"#CCCCCC"+Chr(34)+"><tr><td>"
  Static h_str_2a.s = "<table width="+Chr(34)
  Static h_str_2c.s = Chr(34)+" border="+Chr(34)+"0"+Chr(34)+" cellspacing="+Chr(34)+"0"+Chr(34)+" cellpadding="+Chr(34)+"0"+Chr(34)+" align="+Chr(34)+"center"+Chr(34)+">"
  Static h_str_3.s = "<tr height="+Chr(34)+"1"+Chr(34)+">"
  Static h_str_4a.s = "<td bgColor="+Chr(34)+"#"
  Static h_str_4b.s = "000000" ;this will change with each pixel
  Static h_str_4c.s = Chr(34)+"></td>"
  Static h_str_5.s = "</tr>"
  Static h_str_6.s = "</table></td></tr></table></BODY></HTML>"
  
  Protected h_str_2.s = h_str_2a + Str(wi) + h_str_2c
  Protected *htm_buf,*htm_buf_ptr
  
  If LoadImage(0, pic.s)
    ResizeImage(0, wi, he, #PB_Image_Smooth)
    *htm_buf = AllocateMemory((Len(h_str_1a) + Len(h_str_1b) + Len(h_str_2) + (Len(h_str_3) + (Len(h_str_4a) + Len(h_str_4b) + Len(h_str_4c)) * wi + Len(h_str_5)) * he + Len(h_str_6) + 1) * SizeOf(Character))
    If *htm_buf
      *htm_buf_ptr = *htm_buf
      CopyMemoryString(h_str_1a,@*htm_buf_ptr)
      CopyMemoryString(h_str_1b)
      CopyMemoryString(h_str_2)
      StartDrawing(ImageOutput(0))
        For y = 0 To he - 1
          CopyMemoryString(h_str_3)
          For x = 0 To wi - 1
            pin.l = Point(x, y)
            CopyMemoryString(h_str_4a)
            CopyMemoryString(LCase(RSet(Hex(Red(pin)),2,"0"))+LCase(RSet(Hex(Green(pin)),2,"0"))+LCase(RSet(Hex(Blue(pin)),2,"0")))
            CopyMemoryString(h_str_4c)
            wevent = WindowEvent()
            If wevent = #PB_Event_CloseWindow : y=he: x=wi: EndIf
          Next
          CopyMemoryString(h_str_5)
          SetGadgetState(7, y*wi)
        Next
      StopDrawing()     
      CopyMemoryString(h_str_6)
    EndIf 
    FreeImage(0)
    If *htm_buf: FreeMemory(*htm_buf): ProcedureReturn PeekS(*htm_buf): EndIf
  Else
    ProcedureReturn ""
  EndIf
EndProcedure

@Edit: corrected code to free memory for string buffer.

Posted: **Tue Mar 17, 2009 5:39 pm**

Demivec wrote:I thought I would post this here (instead of the thread by Kale).

@Phillippe-felixer76-2: Your code was very slow and included a few errors. One of the errors was the subject of this thread, another was that the pictures width and height were not used correctly in the loops inside pic2htm().

Here's a replacement procedure for pic2htm(). It corrects the color values, loop values, and speed issues. Instead of hours it takes only about 2 seconds to convert the picture. It takes longer to display it, but that is a browser problem (and the files can become quite large)

. The slowdown was due to slow string functions that have to determine the length of a string everytime a small addition to the string is made. As a string grows longer so does the delay.

Code: Select all

Procedure.s pic2htm(pic.s, wi.l, he.l)
  Static h_str_1a.s = "<HTML><HEAD></HEAD><BODY>"
  Static h_str_1b.s = "<table border="+Chr(34)+"0"+Chr(34)+" border="+Chr(34)+"0"+Chr(34)+" cellspacing="+Chr(34)+"0"+Chr(34)+" cellpadding="+Chr(34)+"0"+Chr(34)+" align="+Chr(34)+"center"+Chr(34)+" style="+Chr(34)+"border-collapse:collapse;"+Chr(34)+" bordercolor="+Chr(34)+"#CCCCCC"+Chr(34)+"><tr><td>"
  Static h_str_2a.s = "<table width="+Chr(34)
  Static h_str_2c.s = Chr(34)+" border="+Chr(34)+"0"+Chr(34)+" cellspacing="+Chr(34)+"0"+Chr(34)+" cellpadding="+Chr(34)+"0"+Chr(34)+" align="+Chr(34)+"center"+Chr(34)+">"
  Static h_str_3.s = "<tr height="+Chr(34)+"1"+Chr(34)+">"
  Static h_str_4a.s = "<td bgColor="+Chr(34)+"#"
  Static h_str_4b.s = "000000" ;this will change with each pixel
  Static h_str_4c.s = Chr(34)+"></td>"
  Static h_str_5.s = "</tr>"
  Static h_str_6.s = "</table></td></tr></table></BODY></HTML>"
  
  Protected h_str_2.s = h_str_2a + Str(wi) + h_str_2c
  Protected *htm_buf,*htm_buf_ptr
  
  If LoadImage(0, pic.s)
    ResizeImage(0, wi, he, #PB_Image_Smooth)
    *htm_buf = AllocateMemory((Len(h_str_1a) + Len(h_str_1b) + Len(h_str_2) + (Len(h_str_3) + (Len(h_str_4a) + Len(h_str_4b) + Len(h_str_4c)) * wi + Len(h_str_5)) * he + Len(h_str_6) + 1) * SizeOf(Character))
    If *htm_buf
      *htm_buf_ptr = *htm_buf
      CopyMemoryString(h_str_1a,@*htm_buf_ptr)
      CopyMemoryString(h_str_1b)
      CopyMemoryString(h_str_2)
      StartDrawing(ImageOutput(0))
        For y = 0 To he - 1
          CopyMemoryString(h_str_3)
          For x = 0 To wi - 1
            pin.l = Point(x, y)
            CopyMemoryString(h_str_4a)
            CopyMemoryString(LCase(RSet(Hex(Red(pin)),2,"0"))+LCase(RSet(Hex(Green(pin)),2,"0"))+LCase(RSet(Hex(Blue(pin)),2,"0")))
            CopyMemoryString(h_str_4c)
            wevent = WindowEvent()
            If wevent = #PB_Event_CloseWindow : y=he: x=wi: EndIf
          Next
          CopyMemoryString(h_str_5)
          SetGadgetState(7, y*wi)
        Next
      StopDrawing()     
      CopyMemoryString(h_str_6)
    EndIf 
    FreeImage(0)
    If *htm_buf: ProcedureReturn PeekS(*htm_buf): EndIf
  Else
    ProcedureReturn ""
  EndIf
EndProcedure

Yeah i knew, it's old, i already made a better procedure.
I put it in this forum here:

http://www.purebasic.fr/english/viewtopic.php?t=21890

This version doesn't use the Point() command, wich is a speedup also.. mabe using your memory string functions it will be even
faster!

Procedure:

Code: Select all

Procedure.s pic2htm(pic.s, wi.l, he.l)
  If LoadImage(0, pic.s)
     ResizeImage(0, wi, he, #PB_Image_Smooth)
     htm.s = "<HTML><HEAD></HEAD><BODY>"
     htm.s + "<table border="+Chr(34)+"1"+Chr(34)+" cellspacing="+Chr(34)+"0"+Chr(34)+" cellpadding="+Chr(34)+"0"+Chr(34)+" align="+Chr(34)+"center"+Chr(34)+" style="+Chr(34)+"border-collapse:collapse;"+Chr(34)+" bordercolor="+Chr(34)+"#000000"+Chr(34)+"><tr><td>"
     htm.s + "<table width="+Chr(34)+Str(wi*zoom)+Chr(34)+" border="+Chr(34)+"0"+Chr(34)+" cellspacing="+Chr(34)+"0"+Chr(34)+" cellpadding="+Chr(34)+"0"+Chr(34)+" align="+Chr(34)+"center"+Chr(34)+">"
     GetObject_(ImageID(0), SizeOf(BITMAP), bmp1.BITMAP)
     *px.long
     For y1=0 To bmp1\bmHeight-1
       y = bmp1\bmHeight-y1-1
       htm.s + "<tr height="+Chr(34)+Str(zoom)+Chr(34)+">"
       *px = bmp1\bmBits + y * bmp1\bmWidthBytes
       For x=0 To bmp1\bmWidth-1
          pin1.l = *px\l
          If  *px\l&$ff>-1
             If pin1<>pon.l
                b.l   = *px\l&$ff
                g.l   = *px\l>>8&$ff 
                r.l   = *px\l>>16&$ff 
                red.s   = "0"+Hex(r)
                green.s = "0"+Hex(g)
                blue.s  = "0"+Hex(b)   
                ht.s    = "<td bgColor="+Chr(34)+"#"+Right(red,2)+Right(green,2)+Right(blue,2)+Chr(34)+"></td>"
                pon.l = pin1.l           
             EndIf                       
             htm.s + ht.s
          EndIf
          *px + SizeOf(LONG)-1         
          wevent = WindowEvent()
          If wevent = #PB_Event_CloseWindow : y1=he: x=wi: EndIf
       Next
       htm.s + "</tr>"
       SetGadgetState(7, y1*bmp1\bmWidth)
     Next
     DeleteObject_(bmp1) 
     htm.s + "</table></td></tr></table></BODY></HTML>"
     FreeImage(0)
     ProcedureReturn htm.s   
  Else
     ProcedureReturn ""
  EndIf
EndProcedure

PureBasic Forums - English

<Picture To Html code> Colors seem wrong..

<Picture To Html code> Colors seem wrong..

Re: <Picture To Html code> Colors seem wrong..