Page 1 of 2

Convert an image to a coloured HTML table...

Posted: Thu May 18, 2006 11:03 pm
by Kale
This fun piece of code transforms an image to a coloured HTML table and displays it in a simple webpage. This is good for creating pages that dont need linked images. Be careful though, if you use big images, you may be processing all day! :twisted:

Adjust these constants:

Code: Select all

#HTML_PIXEL_WIDTH = "5"
#HTML_PIXEL_HEIGHT = "5"
to customise the size of the finished HTML table.

Here's the code, (browse for a (small) image then click convert):

Code: Select all

EnableExplicit
UseJPEGImageDecoder()
UsePNGImageDecoder()

;]=============================================================================
;-CONSTANTS
;[=============================================================================

#APP_NAME = "Image2HTML v1.0"

Enumeration
	#WINDOW_ROOT
	#TEXT_IMAGE_FILE
	#BUTTON_CHOOSE_IMAGE
	#PROGRESS_IMAGE_TO_HTML
	#BUTTON_CONVERT_IMAGE
	#IMAGE_FILE
	#FILE_HTML
EndEnumeration

#HTML_PIXEL_WIDTH = "5"
#HTML_PIXEL_HEIGHT = "5"

;]=============================================================================
;-GLOBAL FLAGS / VARIABLES / STRUCTURES / ARRAYS
;[=============================================================================

Global FileName.s = ""
Define EventID.l

;]=============================================================================
;-PROCEDURES
;[=============================================================================

;Handle an error
Procedure HandleError(Result.l, Text.s)
	If Result = 0
		MessageRequester("Error", Text, #PB_MessageRequester_Ok)
		End
	EndIf
EndProcedure

;Select a file
Procedure.s SelectImage()
	Protected Pattern.s = "All Files (*.*)|*.*"
	Pattern.s + "|Bitmap Image (*.bmp)|*.bmp"
	Pattern.s + "|Jpeg Image (*.jpg)|*.jpg"
	Pattern.s + "|PNG Image (*.png)|*.png"
	FileName.s = OpenFileRequester("Open a file for conversion", "", Pattern, 0)
	If FileName <> ""
		ProcedureReturn GetFilePart(FileName)
	EndIf
EndProcedure

;Convert a 24bit colour value to a Hex string
Procedure.s RGBToHex(Colour.l)
	Protected HexString.s = "#"
	HexString + RSet(Hex(Red(Colour)), 2, "0")
	HexString + RSet(Hex(Green(Colour)), 2, "0")
	HexString + RSet(Hex(Blue(Colour)), 2, "0")
	ProcedureReturn HexString
EndProcedure

;Convert the image
Procedure ConvertImage(FileName.s)
	Protected x.l, y.l, MaximumProgressValue.q, Progress.q
	If FileName <> ""
		If LoadImage(#IMAGE_FILE, FileName)
			MaximumProgressValue = ImageWidth(#IMAGE_FILE) * ImageHeight(#IMAGE_FILE)
			SetGadgetAttribute(#PROGRESS_IMAGE_TO_HTML, #PB_ProgressBar_Maximum, MaximumProgressValue)
			If CreateFile(#FILE_HTML, "Output.htm")
				WriteStringN(#FILE_HTML, "<html>")
				WriteStringN(#FILE_HTML, #TAB$ + "<head>")
				WriteStringN(#FILE_HTML, #TAB$ + "</head>")
				WriteStringN(#FILE_HTML, #TAB$ + "<body>")
				WriteStringN(#FILE_HTML, #TAB$ + #TAB$ + "<table cellpadding=" + #DQUOTE$ + "0" + #DQUOTE$ + " cellspacing=" + #DQUOTE$ + "0" + #DQUOTE$ + ">")
				StartDrawing(ImageOutput(#IMAGE_FILE))
				For y = 0 To ImageHeight(#IMAGE_FILE) - 1
					WriteStringN(#FILE_HTML, #TAB$ + #TAB$ + #TAB$ + "<tr>")
					For x = 0 To ImageWidth(#IMAGE_FILE) - 1
						WriteStringN(#FILE_HTML, #TAB$ + #TAB$ + #TAB$ + #TAB$ + "<td width=" + #DQUOTE$ + #HTML_PIXEL_WIDTH + #DQUOTE$ + " height=" + #DQUOTE$ + #HTML_PIXEL_HEIGHT + #DQUOTE$ + " bgcolor=" + #DQUOTE$ + RGBToHex(Point(x, y)) + #DQUOTE$ + "></td>")
						Progress + 1
						SetGadgetState(#PROGRESS_IMAGE_TO_HTML, Progress)
					Next x
					WriteStringN(#FILE_HTML, #TAB$ + #TAB$ + #TAB$ + "</tr>")
				Next y
				StopDrawing()
				WriteStringN(#FILE_HTML, #TAB$ + #TAB$ + "</table>")
				WriteStringN(#FILE_HTML, #TAB$ + "</body>")
				WriteString(#FILE_HTML, "</html>")
				CloseFile(#FILE_HTML)
				RunProgram("Output.htm")
			EndIf
		EndIf
	EndIf
	SetGadgetState(#PROGRESS_IMAGE_TO_HTML, 0)
EndProcedure

;]=============================================================================
;-GEOMETRY
;[=============================================================================

HandleError(OpenWindow(#WINDOW_ROOT, 0, 0, 400, 70, #APP_NAME, #PB_Window_SystemMenu | #PB_Window_ScreenCentered), "Main window could not be created.")
HandleError(CreateGadgetList(WindowID(#WINDOW_ROOT)), "Gadget list for the main window could not be created.")

TextGadget(#TEXT_IMAGE_FILE, 10, 10, 270, 20, "", #PB_Text_Border)
ButtonGadget(#BUTTON_CHOOSE_IMAGE, 290, 10, 100, 20, "Browse...")
ProgressBarGadget(#PROGRESS_IMAGE_TO_HTML, 10, 40, 270, 20, 0, 100)
ButtonGadget(#BUTTON_CONVERT_IMAGE, 290, 40, 100, 20, "Convert")

;]=============================================================================
;-MAIN LOOP
;[=============================================================================

Repeat
	EventID.l = WaitWindowEvent()
	Select EventID

		Case #PB_Event_Gadget
			Select EventGadget()

				Case #BUTTON_CHOOSE_IMAGE
					SetGadgetText(#TEXT_IMAGE_FILE, SelectImage())
					
				Case #BUTTON_CONVERT_IMAGE
					ConvertImage(FileName)

			EndSelect
	
	EndSelect
Until EventID = #PB_Event_CloseWindow
End

;]=============================================================================
;-END
;==============================================================================

Posted: Thu May 18, 2006 11:19 pm
by rsts
Fantastic.

Nice piece of code :D

cheers

Posted: Thu May 18, 2006 11:48 pm
by jack
there's a bug somewhere, set #HTML_PIXEL_WIDTH = "1" and #HTML_PIXEL_HEIGHT = "1" then convert this picture http://home.online.no/~rsvensse/sleep01.jpg , the bottom portion is corrupted

Posted: Fri May 19, 2006 12:16 am
by rsts
Hmm - I can't seem to access the image :)

cheers

Posted: Fri May 19, 2006 12:30 am
by jack
sorry about that, the link is fixed.

Posted: Fri May 19, 2006 4:45 pm
by josku_x
this is good for pixel images, you can save people from stealing your art ^^

Posted: Fri May 19, 2006 6:17 pm
by Flype
that's funny, but beware of 'out of space disk'.
i tried with a 1500x1280 pixels and the output.html was growing up to 200mb...
when opening the html, opera was 2x or 3x faster than firefox to display the picture.

Posted: Fri May 19, 2006 7:36 pm
by Kale
jack wrote:there's a bug somewhere, set #HTML_PIXEL_WIDTH = "1" and #HTML_PIXEL_HEIGHT = "1" then convert this picture http://home.online.no/~rsvensse/sleep01.jpg , the bottom portion is corrupted
Works perfectly here with that image.

Posted: Fri May 19, 2006 9:17 pm
by josku_x
Flype wrote:that's funny, but beware of 'out of space disk'.
i tried with a 1500x1280 pixels and the output.html was growing up to 200mb...
when opening the html, opera was 2x or 3x faster than firefox to display the picture.
Same here, but in IE, it took so long I had time to go shopping and then to drink hot coffee :wink:

Posted: Fri May 19, 2006 10:36 pm
by Kale
I warned you about big images! :wink: Anything over 50x50 pixel images and things get a bit ugly. :twisted:

Posted: Tue May 23, 2006 6:38 am
by omit59
Nice code Kale!

With JacaScript you can limit needed disk size to about 20%,
but still it's only usefull for small images!

Code: Select all

;Convert the image
Procedure ConvertImage_JS(FileName.s)
   Protected x.l, y.l, MaximumProgressValue.q, Progress.q
   If FileName <> ""
      If LoadImage(#IMAGE_FILE, FileName)
         MaximumProgressValue = ImageWidth(#IMAGE_FILE) * ImageHeight(#IMAGE_FILE)
         SetGadgetAttribute(#PROGRESS_IMAGE_TO_HTML, #PB_ProgressBar_Maximum, MaximumProgressValue)
         If CreateFile(#FILE_HTML, "Output.htm")
            WriteStringN(#FILE_HTML, "<html>")
            WriteStringN(#FILE_HTML, #TAB$ + "<head>")
            WriteStringN(#FILE_HTML, #TAB$ + "</head>")
            WriteStringN(#FILE_HTML, #TAB$ + "<body>")
            WriteStringN(#FILE_HTML, #TAB$ + "<script type=" + #DQUOTE$ + "text/javascript" + #DQUOTE$ + "><!--")
            StartDrawing(ImageOutput(#IMAGE_FILE))
            WriteStringN(#FILE_HTML, "var MyImage = [")
            
            For y = 0 To ImageHeight(#IMAGE_FILE) - 1
               Define Line.s = ""
               For x = 0 To ImageWidth(#IMAGE_FILE) - 1
                  If y = ImageHeight(#IMAGE_FILE) - 1 And x = ImageWidth(#IMAGE_FILE) - 1
                    Line = Line + #DQUOTE$ + RGBToHex(Point(x, y)) + #DQUOTE$ + "]"
                  Else
                    Line + #DQUOTE$ + RGBToHex(Point(x, y)) + #DQUOTE$ + ","
                  EndIf
                  Progress + 1
                  SetGadgetState(#PROGRESS_IMAGE_TO_HTML, Progress)
               Next x
               WriteStringN(#FILE_HTML, Line)
            Next y
            StopDrawing()
            
            WriteStringN(#FILE_HTML, "document.write(" + #DQUOTE$ + "<table cellpadding='0' cellspacing='0'>" + #DQUOTE$ + ");")
            WriteStringN(#FILE_HTML, "var y = 0;")
            WriteStringN(#FILE_HTML, "var x = 0;")
            WriteStringN(#FILE_HTML, "var mycounter = 0;")
            
            WriteStringN(#FILE_HTML, "for (y=0;y<" + Str(ImageHeight(#IMAGE_FILE)) + ";y++) {")
            WriteStringN(#FILE_HTML, #TAB$ + "document.write(" + #DQUOTE$ + "<tr>" + #DQUOTE$ + ");")
            
            WriteStringN(#FILE_HTML, #TAB$ + "for (x=0;x<" + Str(ImageWidth(#IMAGE_FILE)) + ";x++) {")
            WriteStringN(#FILE_HTML, #TAB$ + #TAB$ + "document.write(" + #DQUOTE$ + "<td width='" + #HTML_PIXEL_WIDTH + "' height='" + #HTML_PIXEL_HEIGHT + "' bgcolor='" + #DQUOTE$ + " + MyImage[mycounter] + " + #DQUOTE$ + "'></td>" + #DQUOTE$ + ");")
            WriteStringN(#FILE_HTML, #TAB$ + #TAB$ + "mycounter++")

            WriteStringN(#FILE_HTML, #TAB$ + "}")
            WriteStringN(#FILE_HTML, #TAB$ + "document.write(" + #DQUOTE$ + "</tr>" + #DQUOTE$ + ");")
            WriteStringN(#FILE_HTML, "}")
            WriteStringN(#FILE_HTML, "document.write(" + #DQUOTE$ + "</table>" + #DQUOTE$ + ");")
                        
            WriteStringN(#FILE_HTML, #TAB$ + "--></script>")
            WriteStringN(#FILE_HTML, #TAB$ + "</body>")
            WriteString(#FILE_HTML, "</html>")
            CloseFile(#FILE_HTML)
            RunProgram("Output.htm")
         EndIf
      EndIf
   EndIf
   SetGadgetState(#PROGRESS_IMAGE_TO_HTML, 0)
EndProcedure
Timo

Posted: Tue May 23, 2006 7:12 am
by josku_x
[finnish] Vähänks tyyppi on hyvä! Mä oon opiskellu kaikkee niinku js:ssää ja php:tä, mut sä ilmeisesti osaat myös käyttää niitä kunnolla näissä tilanteissa. Sun koodilla tää kääntää nopeammin, kiitos! [/finnish]

[english] Thanks! Nice piece of code! [/english]

Posted: Tue May 23, 2006 8:30 am
by omit59
[finnish] Kovasti olen harrastaja, monenlaista yrittänyt, mutta kaikkea yleensä vain pintaa raapaissut...
Tuosta JS-versiosta kannattaa muistaa etta edelleen vain kovin pienille
kuville, sillä muuten selain poksahtaa, ja nopeuskin on aika huono.
Kuitenkin tällä voisi olla käyttöä esim tehtäessä ohjelmalle opastus ilman
chm-tiedostoa käyttäen WebgadgetExtras.pbi ja webgadget![/finnish]

Code is from Kale, me just using it...

Timo

Another way ..

Posted: Sat Mar 14, 2009 9:41 pm
by Philippe-felixer76-2
A bit faster not using Point()??!

Code: Select all

; maak van plaatje een website.. 
; test

#title  = "HTML TEST: Picture to Html color code, P.v.C. 2009"
#width  = 640
#height = 180
UseJPEGImageDecoder()
UsePNGImageDecoder()
Global zoom.b=1

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)+"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

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-80, 20, 0, 400)
   TextGadget(       3, #width-80, 42,        80, 20, "Width 0") 
   TrackBarGadget(   4,         0, 80, #width-80, 20, 0, 400)
   TextGadget(       5, #width-80, 82,        80, 20, "Height 0")    
   TrackBarGadget(   9,        60, 120,    #width-60, 20, 1, 10)  
   TextGadget(      10,         4, 122,           56, 20, "Zoom 1x")
   ButtonGadget(     6,         0, 160,        40, 20, "Start")
   ProgressBarGadget(7,        40, 160, #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)
                  If ImageWidth(0)>400
                     wi.l = 400
                  Else
                     wi.l = ImageWidth(0)
                  EndIf
                  If ImageHeight(0)>400
                     he.l = 400
                  Else
                     he.l = ImageHeight(0)
                  EndIf
                  SetGadgetState(2, wi)
                  SetGadgetState(4, he)
                  SetGadgetText(3, "Width "+Str(wi))
                  SetGadgetText(5, "Height "+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, "Width "+Str(wi))
                  SetGadgetText(5, "Height "+Str(he))
               SetGadgetAttribute(7, #PB_ProgressBar_Maximum, wi*he.l) 
            Case 4; height
               he.l = GetGadgetState(4)
                  SetGadgetText(3, "Width "+Str(wi))
                  SetGadgetText(5, "Height "+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, pic.s+".html")
                     WriteStringN(0, htm.s)
                     CloseFile(0)
                     RunProgram("explorer.exe", pic.s+".html", "")
                  EndIf  
               EndIf
               DisableGadget(6, 0)
            Case 9
               zoom = GetGadgetState(9)
               SetGadgetText(10, "Zoom "+Str(zoom)+"x")
         EndSelect
      EndIf
   Until wevent = #PB_Event_CloseWindow 
   CloseWindow(0)
EndIf
End
PS: Select low resolutions!! (CPU Sensitive..)

Posted: Sun Mar 15, 2009 3:04 am
by PB
> With JavaScript you can limit needed disk size to about 20%

I get this error: "RGBToHex() is not a function, array, macro or linked list"

Can you post this procedure, please? Thanks.