PureBasic Forums - English

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

It's in my code above

;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

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

Thanks Kale, I didn't see that.

But another problem: with IE you get this if you use the JavaScript version:

So, it kinda defeats the purpose of using JavaScript.

Posted: **Sun Mar 15, 2009 4:19 am**

The new IE always does that when executing local JS, god i hate microsoft! You can turn it off, as i have done, but i can't remember the hoops i had to jump through now.

Posted: **Sun Mar 15, 2009 6:02 pm**

Change

Code: Select all

            RunProgram("Output.htm")

To

Code: Select all

            RunProgram("Output.hta")

And it should work without any warnings.

EDit: You also need to save the file as Output.hta of course.

Posted: **Sun Mar 15, 2009 7:53 pm**

If you want smaller files and want to make sure, that it work "everywhere", you can try the following version(s)

Some information for using my code:
• hold down shift for using chars instead of tables (smaller HTML file size)
• increasing the ColorMatch procedure constants should shrink the file size also
• css would allow even better results, but I used this code to get "graphics" into simulation which does not support such things...

Michael

Code: Select all

; Define

	#PixelSize=4

	EnableExplicit
	UseJPEGImageDecoder()
	UsePNGImageDecoder()

	Enumeration
		#Dialog
		#InfoImage
		#ButtonLoadImage
		#ButtonConvert
		#ProgressBar
		#FileIn
		#FileOut
	EndEnumeration

	Global FileName.s = ""
	Define EventID.l

	#MaxUsedColors=500
	Global Dim Colors(#MaxUsedColors,1)
	Global UsedColors

; EndDefine

Procedure.s SelectImage()
	;Select a file

	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
Procedure.s RGBToHex(Colour.l)
	;Convert a 24bit colour value to a Hex string

	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
Procedure.l ColorMatch(a,b)

	#DiffOneColor=20
	#DiffAllColors=10

	Protected delta.l=a-b

	If delta<0
		delta=-delta
	EndIf

	If delta<=#DiffOneColor
		ProcedureReturn #True

	ElseIf (delta&$ff)<=#DiffAllColors
		delta>>8
		If delta<=#DiffOneColor
			ProcedureReturn #True

		ElseIf (delta&$ff)<=#DiffAllColors
			delta>>8
			If delta<=#DiffOneColor
				ProcedureReturn #True
			EndIf
		EndIf

	EndIf

	ProcedureReturn #False

EndProcedure

Procedure WritePixels(color,n,back,mode)

	Protected i

	If mode

		; Chars...
		WriteString(#FileOut,"<FONT color="+RGBToHex(Color)+">")
		For i=1 To n
			WriteString(#FileOut,"#");&diams;")
		Next i
		; WriteString(#FileOut,"</FONT>")

	Else

		; Table
		If n=1
			WriteString(#FileOut,"<td")
		Else
			WriteString(#FileOut,"<td colspan="+Str(n))
		EndIf
		WriteString(#FileOut," width="+Str(n*#PixelSize)+" height="+Str(#PixelSize))
		If ColorMatch(Back,Color)=0
			WriteString(#FileOut," bgcolor="+RGBToHex(Color))
		EndIf
		WriteString(#FileOut,"></td>")
	EndIf

EndProcedure
Procedure CreateHTML(FileName.s,Mode)
	;Convert the image

	Protected x.l,y.l,i.l
	Protected MaximumProgressValue.q,Progress.q
	Protected Color,LastColor,BackColor,Count

	If FileName <> ""
		If LoadImage(#FileIn,FileName)
			MaximumProgressValue = ImageWidth(#FileIn) * ImageHeight(#FileIn)
			SetGadgetAttribute(#ProgressBar,#PB_ProgressBar_Maximum,MaximumProgressValue)
			
			If CreateFile(#FileOut,"Output.htm")
				WriteStringN(#FileOut,"<html>")
				WriteStringN(#FileOut,"<head>")
				WriteStringN(#FileOut,"</head>")
				WriteStringN(#FileOut,"<body>")

				StartDrawing(ImageOutput(#FileIn))

				If Mode
					WriteStringN(#FileOut,"<center><PRE><font size=1><b>")
				Else

					UsedColors=0

					For y = 0 To ImageHeight(#FileIn)-1
						For x=0 To ImageWidth(#FileIn)-1
							Color=Point(x,y)
							i=UsedColors
							While i
								If ColorMatch(Colors(i,0),Color)
									Break
								EndIf
								i-1
							Wend
							If i
								Colors(i,1)+1
							ElseIf UsedColors<#MaxUsedColors
								UsedColors+1
								Colors(UsedColors,0)=Color
								Colors(UsedColors,1)=1
							EndIf
						Next x
					Next y
					; Debug UsedColors

					x=0
					BackColor=#White
					i=UsedColors
					While i
						If Colors(i,1)>x
							x=Colors(i,1)
							BackColor=Colors(i,0)
						EndIf
						i-1
					Wend
					; Debug Hex(BackColor)

					WriteStringN(#FileOut,"<table cellpadding=0 cellspacing=0 border=0 bgcolor="+RGBToHex(BackColor)+">")
				EndIf


				For y = 0 To ImageHeight(#FileIn)-1

					If Mode=0 : WriteString(#FileOut,"<tr>") : EndIf

					For x=0 To ImageWidth(#FileIn)-1
						Color=Point(x,y)
						If x
							If ColorMatch(Color,LastColor)
								Count+1
							Else
								WritePixels(LastColor,Count,BackColor,Mode)
								LastColor=Color
								Count=1
							EndIf
							If x=ImageWidth(#FileIn)-1
								WritePixels(Color,Count,BackColor,Mode)
								If Mode
									WriteStringN(#FileOut,"")
								Else
									WriteStringN(#FileOut,"</tr>")
								EndIf
							EndIf
						Else
							LastColor=Color
							Count=1
						EndIf

						Progress + 1
						SetGadgetState(#ProgressBar,Progress)
					Next x

				Next y

				StopDrawing()

				If mode
					WriteStringN(#FileOut,"</b></font></PRE></center>")
				Else
					WriteStringN(#FileOut,"</table>")
				EndIf

				WriteStringN(#FileOut,"</body>")
				WriteString(#FileOut,"</html>")
				CloseFile(#FileOut)
				RunProgram("Output.htm")
			EndIf

		EndIf
	EndIf


	SetGadgetState(#ProgressBar,0)

EndProcedure

OpenWindow(#Dialog,0,0,400,70,"Image > HTML",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)

TextGadget(#InfoImage,10,10,270,20,"",#PB_Text_Border)
ButtonGadget(#ButtonLoadImage,290,10,100,20,"Browse...")
ProgressBarGadget(#ProgressBar,10,40,270,20,0,100)
ButtonGadget(#ButtonConvert,290,40,100,20,"Convert")

filename="c:\cisco.bmp"

Repeat
	EventID.l = WaitWindowEvent()
	Select EventID

	Case #PB_Event_Gadget
		Select EventGadget()

		Case #ButtonLoadImage
			SetGadgetText(#InfoImage,SelectImage())

		Case #ButtonConvert
			CreateHTML(FileName,GetKeyState_(#VK_SHIFT)>>7&1)

		EndSelect

	EndSelect
Until EventID = #PB_Event_CloseWindow

Posted: **Fri Jan 16, 2015 1:53 am**

PB wrote:"PureBasic won't be object oriented, period" - Fred.

Thank you very much !...

PureBasic Forums - English

Convert an image to a coloured HTML table...

Re: