PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Highlighting an image (glass effect)

https://www.purebasic.fr/english/viewtopic.php?t=37392

Page 1 of 1

Highlighting an image (glass effect)

Posted: Sun May 10, 2009 5:21 pm
by Michael Vogel
some days ago, netmaestro posted a nice alarm clock which had a superb white shining area which looked like a glass...

I tried to do something like that and after a while I had the first success - an elliptical segment which is bright white in the middle and gets darker and darker to its edges.
But on thenNext step, transferring the code to alpha transparency, everything went wrong and I did not find a clue how to get it running for now :cry:

Code: Select all

Procedure.f QuickDistanz(x1.l,y1.l,x2.l)
	x1-x2
	x1*x1
	ProcedureReturn Sqr(x1+y1)
EndProcedure
Procedure GlassEffect(Image)

	Structure BGRA
		blue.c
		green.c
		red.c
		alpha.c
	EndStructure

	Protected bmp.BITMAP
	Protected *bits.BGRA,*px.BGRA

	Protected w.l,h.l
	Protected scaler.f
	Protected shifter.l
	Protected b1x.l,bx2.l
	Protected x.l,y.l,ys.l
	Protected c.b

	GetObject_(ImageID(image), SizeOf(BITMAP),bmp)

	*bits=bmp\bmBits

	; Breite und Höhe
	w=bmp\bmWidthBytes
	h=bmp\bmHeight

	; Tricksen...
	scaler=650/h
	shifter=h-h>>2

	; Brennpunkte
	bx1=w>>3
	b2x=w-b1x


	For y=0 To h
		ys=y*y*scaler

		For x=0 To w>>1

			c=(QuickDistanz(x,ys,b1x)+QuickDistanz(x,ys,b2x))-(b2x-b1x)
			If c<0
				c=0
			Else
				c*2
				If c<0
					c=0
				ElseIf c>255
					c=255
				EndIf
			EndIf

			If y%3=0
				If shifter+y/3<h
					*px=*bits+bmp\bmWidthBytes*(y/3+shifter)+x
					*px\alpha=c
					*px=*bits+bmp\bmWidthBytes*(y/3+shifter)+w-x
					*px\alpha=c
				EndIf
			EndIf
			If shifter-y>0
				*px=*bits+bmp\bmWidthBytes*(shifter-y)+x
				*px\alpha=c
				*px=*bits+bmp\bmWidthBytes*(shifter-y)+w-x
				*px\alpha=c
			EndIf
		Next x
	Next y


EndProcedure

w=200
h=100

CreateImage(0,200,100)
StartDrawing(ImageOutput(0))
Box(0,0,200,100,#Red)
DrawText(0,0,"Just a Test")
DrawText(50,30,"Just a Test")
DrawText(100,50,"Just a Test")
StopDrawing()

OpenWindow(0,0,0,w,h,"",$CF0001)
ImageGadget(0,0,0,w,h,ImageID(0))

#Glass=1
CreateImage(#Glass,200,100,32)
StartDrawing(ImageOutput(#Glass))
Box(0,0,150,100,#White)
StopDrawing()
GlassEffect(#Glass)

dc = StartDrawing(WindowOutput(0))
DrawAlphaImage(ImageID(#Glass),0,0)
StopDrawing()

Repeat:Until WaitWindowEvent()=#WM_CLOSE
Any idea how to get this stuff running?

Thanks,
Michael

Posted: Sun May 10, 2009 5:34 pm
by Perkin
Add the following just before your DrawText commands

Code: Select all

DrawingMode(#PB_2DDrawing_Transparent)
Is that what you wanted?

Posted: Sun May 10, 2009 5:42 pm
by Fluid Byte
Perkin wrote:Is that what you wanted?
No, he wants alpha-transparency.

Posted: Sun May 10, 2009 5:52 pm
by Perkin
I think I found the clock with the effect.

Sorry for the suggestion, obviously it wasn't what he wanted.

I just ran the code, saw background of text and thought that was what he wanted.

Posted: Mon May 11, 2009 6:34 am
by Michael Vogel
Slowly I'll get what I want, but there are still (at least) two problems:

- the white corners should be eleminated
- the shining effect should be smoother on the left and right border also

Michael

Code: Select all

Procedure.f QuickDistanz(x1.l,y1.l,x2.l)
	x1-x2
	x1*x1
	ProcedureReturn Sqr(x1+y1)
EndProcedure
Procedure GlassEffect(Image)

	Structure BGRA
		blue.c
		green.c
		red.c
		alpha.c
	EndStructure

	Protected bmp.BITMAP
	Protected *bits.BGRA,*px.BGRA

	Protected w.l,h.l
	Protected scaler.f
	Protected shifter.l
	Protected b1x.l,bx2.l
	Protected x.l,y.l,ys.l
	Protected c.b

	GetObject_(ImageID(image), SizeOf(BITMAP),bmp)

	*bits=bmp\bmBits


	For y=0 To bmp\bmHeight-1
		For x=0 To bmp\bmWidthBytes-1 Step 4
			*px=*bits+bmp\bmWidthBytes * y + x
			*px\alpha=128
		Next
	Next

	; Breite und Höhe
	w=bmp\bmWidthBytes>>2
	h=bmp\bmHeight

	; Tricksen...
	scaler=650/h
	shifter=h-h>>2

	; Brennpunkte
	bx1=w>>3
	b2x=w-b1x


	#MaxLight=250

	For y=0 To h
		ys=y*y*scaler

		For x=0 To w>>1

			c=(QuickDistanz(x,ys,b1x)+QuickDistanz(x,ys,b2x))-(b2x-b1x)
			If c<>9999
				c=#MaxLight-c
				If c<0
					;c=0
				ElseIf c>#MaxLight
					;c=#MaxLight
				EndIf
			Else
				c=0
			EndIf

			If y%3=0
				If shifter+y/3<h
					*px=*bits+bmp\bmWidthBytes*(y/3+shifter)+x<<2
					*px\alpha=c
					*px=*bits+bmp\bmWidthBytes*(y/3+shifter)+(w-x)<<2
					*px\alpha=c
				EndIf
			EndIf
			If (shifter-y>=0) And (shifter-y<h)
				*px=*bits+bmp\bmWidthBytes*(shifter-y)+x<<2
				*px\alpha=c
				*px=*bits+bmp\bmWidthBytes*(shifter-y)+(w-x)<<2
				*px\alpha=c
			EndIf
		Next x
	Next y


EndProcedure

w=200
h=100

CreateImage(0,200,100)
StartDrawing(ImageOutput(0))
Box(0,0,200,100,#Red)
DrawText(0,0,"Just a Test")
DrawText(50,30,"Just a Test")
DrawText(100,50,"Just a Test")
StopDrawing()

OpenWindow(0,0,0,w,h,"",$CF0001)
ImageGadget(0,0,0,w,h,ImageID(0))

#Glass=1
CreateImage(#Glass,200,100,32)
StartDrawing(ImageOutput(#Glass))
Box(0,0,200,100,#White)
StopDrawing()
GlassEffect(#Glass)

dc = StartDrawing(WindowOutput(0))
DrawAlphaImage(ImageID(#Glass),0,0)
StopDrawing()

Repeat:Until WaitWindowEvent()=#WM_CLOSE

Posted: Mon May 11, 2009 10:51 am
by Kaeru Gaman
still now, for a shiny partly transparent area, you have to prerender a 32bit PNG with this effect, include it, and draw it via DrawAlphaImage.

Alphadrawing may be possible via some API, but messin'round with this right now is futile...
according to freaks words, the beta of 4.4 is to expect within the next weeks and it will contain Alpha-Drawing.

Posted: Mon May 11, 2009 2:35 pm
by Michael Vogel
Kaeru Gaman wrote:still now, for a shiny partly transparent area, you have to prerender a 32bit PNG with this effect, include it, and draw it via DrawAlphaImage.
I need to create the effect for elements with different sizes, so I'd like to create it dynamically - ResizeImage does not work here for transparent images :x

My second approach is not that bad but still needed some improvements :roll::

Code: Select all

 :
Protected c.l	INSTEAD		Protected c.b
 :
b1x=w>>3			INSTEAD		bx1=w>>3
 :
If c<#MaxLight
	c=#MaxLight-c
Else
	c=0
EndIf
Michael

Posted: Mon May 11, 2009 2:49 pm
by netmaestro
Rectangular glass isn't difficult to achieve in code, it's basically inner dropshadows and highlights. I made custom Box and Line routines that draw at specified alphas and using these it's just a matter of drawing increasingly smaller outlined boxes at decreasing alphas. The Line version finishes the edges of the highlights. Using these simple techniques you can produce some remarkably nice glass effects. PB will probably have these native quite soon.

Posted: Mon May 11, 2009 6:43 pm
by Michael Vogel
netmaestro wrote:Rectangular glass isn't difficult to achieve in code, it's basically inner dropshadows and highlights. I made custom Box and Line routines that draw at specified alphas and using these it's just a matter of drawing increasingly smaller boxes at decreasing alphas. The Line version finishes the edges of the highlights. Using these simple techniques you can produce some remarkably nice glass effects. PB will probably have these native quite soon.
Thanks for the information - until the new 4.40 will be available I keep my selfmade code from above (not that smooth and far away from your results :?)...

Here it is - the "Glaseffekt" slider have to be changed in the configuration dialog to see the effekt

Michael

Posted: Mon May 11, 2009 7:07 pm
by dige
I can now only see the PureBasic Logo, the next screen is dark...

Posted: Mon May 11, 2009 7:19 pm
by Michael Vogel
dige wrote:I can now only see the PureBasic Logo, the next screen is dark...
@%&! - changed quite a lot in my source code and it works fine started from the editor because a different ini file (in the temp directory) is used :evil:

Sorry 'bout that - you can do a hack (add the line "smooth=0" to the ini file) or download the new exe now...

Michael

Posted: Tue May 12, 2009 10:15 am
by einander
Hi Michael:
May be this helps

Code: Select all

; Gdip Elliptic Light
; by einander
; PB 4.30 - may 11/2009 
#GDIP=0
#DEGTORAD=#PI/180.0
Global _GDIP,_GRAPH,_DRAWING

Structure PointF :  X.F : Y.F : EndStructure
Structure ARRL :  A.L[3] : EndStructure 

Structure GdiplusStartupInput
  GdiPlusVersion.L
  DebugEventCallback.L
  SuppressBackgroundThread.L
  SuppressExternalCodecs.L
EndStructure

Macro MMx :  WindowMouseX(EventWindow()) : EndMacro
Macro MMy :  WindowMouseY(EventWindow()) : EndMacro
  
Macro RGB2ARGB(RGB,Alpha=$FF) ;- RGB2ARGB(RGB,Alpha=$FF) - convert RGB to Alpha RGB
  Blue(RGB)|Green(RGB)<<8|Red(RGB)<<16|Alpha<<24
EndMacro

Macro ARGB(RGB=0,Alpha=255)  ;- ARGB((RGB=0,Alpha=255)
  RGB2ARGB(RGB,Alpha)
EndMacro 

Prototype GdiplusStartup(*a,*b,C=0)
Macro GName : GetFunction(#GDIP,Name) : EndMacro   ;- Gname
Prototype P1(A) : Macro M1(Name,A) : GF.P1=GName:GF(A) :EndMacro 
Prototype p2(A,B) : Macro M2(Name,A,B) : GF.P2=GName:GF(A,B) :EndMacro
Prototype P3(A,B,C) : Macro M3(Name,A,B,C) : GF.P3=GName:GF(A,B,C) :EndMacro
Prototype P4(A,B,C,D) : Macro M4(Name,A,B,C,D) : GF.P4=GName:GF(A,B,C,D) :EndMacro

Procedure  GradBrushF(Array Points.PointF(1),Sides,ARGB1,ARGB2,ARGB3)
  blend.ARRL\A[0]=ARGB1
  blend\A[1]=ARGB2
  blend\A[2]=ARGB3
  M4("GdipCreatePathGradient",@Points(),Sides,1,@GpBrush)
  M2("GdipSetPathGradientCenterColor",GpBrush,ARGB3)
  Le=2  ;number of colors to blend
  M3("GdipSetPathGradientSurroundColorsWithCount", GpBrush, blend, @Le)
  ProcedureReturn GpBrush
EndProcedure 

Procedure GdipPolygonFree(Sides,ARRAY Pf.PointF(1),Rim.F=1,ARGB1=0,ARGB2=$FFFFFF,ARGB3=0,Type=1)
  GpBrush=GradBrushF(Pf(),Sides,ARGB2,ARGB2,ARGB3) 
  M4("GdipFillPolygon2",_GRAPH, GpBrush, @Pf(),Sides)
  M1("GdipDeleteBrush",GpBrush)
EndProcedure

Macro DrawGDIP ;- DrawGDIP ; make new _GRAPH 
  If _GRAPH :  M1("GdipDeleteGraphics",_GRAPH) : EndIf
  M2("GdipCreateFromHDC",_DRAWING, @_GRAPH)
  M2("GdipSetSmoothingMode",_GRAPH,2)  ; 2 = HiRes
EndMacro

Procedure AngleF(X,Y,Ang.F,xRadius,yRadius,*P.PointF) ; Ret  elliptic endpoint 
  *P\X = X+Cos(Ang*#DEGTORAD) * xRadius 
  *P\Y = Y+Sin(Ang*#DEGTORAD) * yRadius
EndProcedure 

Procedure GdipEllipticLight(X,Y,RadX,RadY,ARGB,BkRGB=0,Stps=90)
  STP.F=360/Stps
  Dim pt.PointF(Stps)
  For i=0 To Stps
    AngleF(X,Y,i*STP,RadX,RadY,pt(i))
  Next
  GdipPolygonFree(Stps,pt(),0,0,ARGB(BkRGB,1),ARGB)
EndProcedure 

;<<<<<<<<<<<<<<<<<<<<<<<
hwnd=OpenWindow(0, 100, 100,700,500 ,"Elliptic Light",  #WS_OVERLAPPEDWINDOW |1) 
Wi=WindowWidth(0):He=WindowHeight(0)
_Img=CreateImage(-1,Wi,He-21,32)
Fon=LoadFont(-1,"arial",40)
Shine=800

TB=TrackBarGadget(-1,0,He-20,Wi,20,1,Shine)
SetGadgetState(TB,Shine/2)
_DRAWING=StartDrawing(ImageOutput(_Img))
  If OpenLibrary(#GDIP,"GDIPlus.DLL")
    Gdip.GdiplusStartupInput\GdiPlusVersion=1
    Gdip\DebugEventCallback = 0
    Gdip\SuppressBackgroundThread = 0
    Gdip\SuppressExternalCodecs = 0
    GF.GdiplusStartup = GetFunction(#GDIP, "GdiplusStartup") : GF(@_GDIP,@Gdip)
    _GDIP=#True
  Else
    MessageRequester("","GDIPlus.DLL Not found",0)
  EndIf
  
  Box(0,0,Wi,He,#Red)
  DrawingFont(FontID(Fon))
  DrawingMode( #PB_2DDrawing_Transparent)
  
  For i=0 To 6
    DrawText(i*40,i*60,"Just a Test",#White,#Red)
  Next
StopDrawing()
_ImGad=ImageGadget(-1,0,0,0,0,ImageID(_Img)) 
 
Repeat 
  Ev=WaitWindowEvent(1) 
  If GetAsyncKeyState_(27) :  End : EndIf
  If Ev=#WM_PAINT Or Ev=#PB_Event_Gadget And EventGadget()=TB
    Shine=GetGadgetState(TB)   
    If IsImage(TmpIMG):FreeImage(TmpIMG):EndIf
    TmpIMG=GrabImage(_Img,-1,0,0,ImageWidth(_Img),ImageHeight(_Img))
    _DRAWING=StartDrawing(ImageOutput(TmpIMG))
      DrawGDIP 
      GdipEllipticLight(Wi/2,He/2,Shine,Shine/2,ARGB(#White))      
    StopDrawing()
    SetGadgetState(_ImGad,ImageID(TmpIMG))
  EndIf
Until Ev=#WM_CLOSE
Cheers

Posted: Tue May 12, 2009 12:43 pm
by Michael Vogel
einander wrote:Hi Michael:
May be this helps
[...]
Thanks einander, every good code example helps me to learn! Therefore I'll keep your code at a safe place in my source code library :)

At the moment, I'll keep my version and wait until the end of the month :lol:

Again, here is how it looks...

Code: Select all

Procedure.f QuickDistanz(x1.l,y1.l,x2.l)
	x1-x2
	x1*x1
	ProcedureReturn Pow(x1+y1,0.51)
EndProcedure
Procedure GlassEffect(Image,MaxLight)

	Structure BGRA
		blue.c
		green.c
		red.c
		alpha.c
	EndStructure

	Protected bmp.BITMAP
	Protected *bits.BGRA,*px.BGRA

	Protected w.l,h.l
	Protected scaler.f
	Protected shifter.l
	Protected b1x.l,b2x.l
	Protected x.l,y.l,ys.l
	Protected c.l

	If IsImage(Image)

		StartDrawing(ImageOutput(Image))
		Box(0,0,ImageWidth(Image),ImageHeight(Image),#White)
		StopDrawing()

		GetObject_(ImageID(image), SizeOf(BITMAP),bmp)

		*bits=bmp\bmBits

		; komplett durchsichtig...
		;For y=0 To bmp\bmHeight-1
		;	For x=0 To bmp\bmWidthBytes-1 Step 4
		;		*px=*bits+bmp\bmWidthBytes * y + x
		;		*px\alpha=0
		;	Next
		;Next

		; Breite und Höhe
		w=bmp\bmWidthBytes>>2
		h=bmp\bmHeight

		; Tricksen...
		scaler=2000/h;	größere Werte machen die Lichtblase kleiner
		shifter=h-h>>2

		; Brennpunkte
		b1x=w>>2
		b2x=w-b1x

		For y=0 To h
			ys=y*y*scaler

			For x=0 To w>>1

				c=(QuickDistanz(x,ys,b1x)+QuickDistanz(x,ys,b2x))-(b2x-b1x)
				If c<MaxLight
					c=MaxLight-c
				Else
					c=0
				EndIf

				If y%3=0
					If shifter+y/3<h
						*px=*bits+bmp\bmWidthBytes*(y/3+shifter)+x<<2
						*px\alpha=c
						*px=*bits+bmp\bmWidthBytes*(y/3+shifter)+(w-x)<<2
						*px\alpha=c
					EndIf
				EndIf
				If (shifter-y>=0) And (shifter-y<h)
					*px=*bits+bmp\bmWidthBytes*(shifter-y)+x<<2
					*px\alpha=c
					*px=*bits+bmp\bmWidthBytes*(shifter-y)+(w-x)<<2
					*px\alpha=c
				EndIf
			Next x
		Next y

	EndIf

EndProcedure

w=400
h=100
CreateImage(0,w,h)
StartDrawing(ImageOutput(0))
Box(0,0,w,h,#Black)
y=0
While y<w
	LineXY(y,0,y,h-1,Random($ffffff))
	y+3
Wend
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(50,0,"Just a Test",#White,#Black)
DrawText(100,20,"Just a Test",#Yellow,#Black)
DrawText(150,40,"Just a Test",#Red,#Black)
StopDrawing()

OpenWindow(0,0,0,w,h,"",$CF0001)

#Glass=1
CreateImage(#Glass,w,h,32)
GlassEffect(#Glass,255)


StartDrawing(ImageOutput(0))
DrawAlphaImage(ImageID(#Glass),0,-10)
StopDrawing()
ImageGadget(0,0,0,w,h,ImageID(0))


Repeat:Until WaitWindowEvent()=#WM_CLOSE

Posted: Tue May 12, 2009 2:55 pm
by einander
@Michael:
Your new example looks nice, and now it is also in my source code library. :wink:
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited