[4.61B3] Unsharp font when using AlphaBlend

[Michael Vogel]

But if DrawText does no antialiasing, why your example has not show just black and white pixels?

I try to find a workaround (Fred knows, that DrawText has already worked smooth in earlier PB versions), because GDI+ must not be available on all machines.

Here are two first code snippets for showing a alpha blended text on a window, would be interesting which results you can see on your PC?

Code: Select all

Enumeration
	#CatWindow
	#CatImage
	#CatIcon
	#FontIDs
	#FontIDsEnde=#FontIDs+6
EndEnumeration

#MaxFontSize=1
#MaxFontStyle=1
#FontFace="Calibri"
;#FontFace="Arial"

Global Dim TextFont(#MaxFontSize,#MaxFontStyle)
s=-10
For i=0 To 1
	s-6
	t=0
	For j=0 To 1
		TextFont(i,j)=LoadFont(#FontIDs+i*(#MaxFontStyle+1)+j,#FontFace,s,#PB_Font_HighQuality|t)
		t=#PB_Font_Bold
	Next j
Next i


Procedure CreateText(x,y,w,h,Text.s,Flags=0)

	Protected FontSize
	Protected FontStyle

	; Absatz
	#TA=#CR;   	Absatz
	#TZ=#LF;   	Zeilenumbruch
	#TT=#TAB;	Tabulator

	; Flags
	#T1=#SI;   	Farbe 1 (rot)
	#T2=#SO;   	Farbe 2 (grün)
	#TB=#ACK;	Fettschrift
	#CB=Chr(#TB)
	;#TU=#BEL;	Unterstrichen
	;#CU=Chr(#TU)
	#TH=#ENQ;	Highlight (gelb)
	#CH=Chr(#TH)
		
	#FontBold=1
	#FontUnderline=2
	#FontHighlight=4
	
	l=Len(Text)

	px=x
	n=0
	DrawingFont(TextFont(FontSize,FontStyle))
	DrawingFont(FontID(#FontIDs))

	While n<l

		c=PeekC(@Text+n)
		n+1

		Select c
		Case #TB
			FontStyle!#FontBold
			DrawingFont(TextFont(FontSize,FontStyle&#FontBold))
		Case #TH
			FontStyle!#FontUnderline

		Default
			If c=' '
				xmem=x
				nmem=n
				MemFontStyle=FontStyle
			EndIf

			px=DrawText(px,y,Chr(c),$FF000000,$FFFFFF00)

			If c<>' ' And px>w+x And nmem
				px=x
				n=nmem
				FontStyle=MemFontStyle
				y+20
			EndIf

		EndSelect

	Wend

EndProcedure

Procedure CreateBox(Image,w,h,Title.s,Text.s)

	Protected n,c

	#NoTransparency=$FF000000
	
	#Radius=10
	CreateImage(Image,w,h,32|#PB_Image_Transparent)
	StartDrawing(ImageOutput(Image))

	DrawingMode(#PB_2DDrawing_AllChannels)
	RoundBox(1,1,w-2,h-2,#Radius-1,#Radius-1,#NoTransparency|$A0A0A0)
	RoundBox(2,2,w-4,h-4,#Radius-2,#Radius-2)

	DrawingMode(#PB_2DDrawing_AlphaBlend)
	DrawText(20,30,Title,#NoTransparency)
	Text=Text+" "+#CH+Text+#CH+" "
	CreateText(20,60,260,200,Text+Text+Text)
	StopDrawing()

EndProcedure
Procedure AlphaImageWindow(WindowID,ImageID)

	Protected Image_HDC
	Protected Image_Bitmap.BITMAP,Image_BitmapInfo.BITMAPINFO
	Protected ContextOffset.POINT,Blend.BLENDFUNCTION
	Protected x,y,w,h,Alpha

	SetWindowLong_(WindowID,#GWL_EXSTYLE,GetWindowLong_(WindowID,#GWL_EXSTYLE)|#WS_EX_LAYERED)

	Image_HDC=CreateCompatibleDC_(#Null)
	Image_Ancienne=SelectObject_(Image_HDC,ImageID)

	GetObject_(ImageID,SizeOf(BITMAP),@Image_Bitmap)
	Image_BitmapInfo\bmiHeader\biSize=SizeOf(BITMAPINFOHEADER)
	Image_BitmapInfo\bmiHeader\biWidth=Image_Bitmap\bmWidth
	Image_BitmapInfo\bmiHeader\biHeight=Image_Bitmap\bmHeight
	Image_BitmapInfo\bmiHeader\biPlanes=1
	Image_BitmapInfo\bmiHeader\biBitCount=32

	w=Image_Bitmap\bmWidth-1
	h=Image_Bitmap\bmHeight-1
	Protected Dim Image.l(w,h)

	GetDIBits_(Image_HDC,ImageID,0,Image_Bitmap\bmHeight,@Image(),@Image_BitmapInfo,#DIB_RGB_COLORS)

	For x=0 To w
		For y=0 To h
			Couleur=Image(x,y)
			Alpha=Couleur>>24&$FF
			If Alpha<$FF
				Image(x,y)=Alpha<<24|MulDiv_(Couleur&$FF,Alpha,255)|(MulDiv_(Couleur&$FF00,Alpha,255)&$FF00)|(MulDiv_(Couleur&$FF0000,Alpha,255)&$FF0000)
			EndIf
		Next
	Next

	SetDIBits_(Image_HDC,ImageID,0,Image_Bitmap\bmHeight,@Image(),@Image_BitmapInfo,#DIB_RGB_COLORS)

	Blend\SourceConstantAlpha=255
	Blend\AlphaFormat=1
	Blend\BlendOp=0
	Blend\BlendFlags=0
	UpdateLayeredWindow_(WindowID,0,0,@Image_BitmapInfo+4,Image_HDC,@ContextOffset,0,@Blend,2)

	SelectObject_(Image_HDC,Image_Ancienne)
	DeleteDC_(Image_HDC)

EndProcedure

CreateBox(#CatImage,300,220,"Title","This is a nice text with "+#CB+"extremly"+#CB+" nonsence.")
OpenWindow(#CatWindow,0,200,ImageWidth(#CatImage),ImageHeight(#CatImage),"Test",#PB_Window_BorderLess|#PB_Window_ScreenCentered|#PB_Window_Invisible)
AlphaImageWindow(WindowID(#CatWindow),ImageID(#CatImage))

HideWindow(0,0)

Repeat

	Event=WaitWindowEvent()

	If Event=#WM_LBUTTONDOWN
		SendMessage_(WindowID(0),#WM_NCLBUTTONDOWN,#HTCAPTION,0)
	EndIf

Until Event=#PB_Event_CloseWindow Or  Event=#WM_CHAR

In the second code I have tried to use larger fonts to get better results, but everything looks blurred when setting the #FontQuality>0...

BTW: the CatText procedure is used to calculate word wrapping and the height of the text in one pass and to draw the result in a second pass...

Code: Select all

#FontQuality=1;	0: original font size, 1: size*2, 2: size*4 etc.

Procedure Init()

	Enumeration
		#CatWindow
		#CatImage
		#CatText
		#CatOnOff
	EndEnumeration

	#MaxFontSize=1
	#MaxFontColors=2

	#FontFace="Calibri"

	Structure FontType
		ID.i[2]
		Height.i
	EndStructure

	Global Dim Font.FontType(#MaxFontSize)
	Global Dim FontColor.i(#MaxFontColors)

	FontColor(0)=$FF000000
	FontColor(1)=$FFA02020
	FontColor(2)=$FF20A020

	Protected i,s
	Protected LF.LOGFONT

	;LF\lfHeight=32
	;LF\lfWidth=0
	;LF\lfEscapement=0
	;LF\lfOrientation=0
	;LF\lfWeight=#FW_DONTCARE
	;LF\lfItalic=0
	;LF\lfUnderline=0
	;LF\lfStrikeOut=0
	LF\lfCharSet=#DEFAULT_CHARSET
	LF\lfOutPrecision=#OUT_DEFAULT_PRECIS
	LF\lfClipPrecision=#CLIP_DEFAULT_PRECIS
	LF\lfQuality=#CLEARTYPE_NATURAL_QUALITY;#CLEARTYPE_QUALITY
	LF\lfPitchAndFamily=#DEFAULT_PITCH|#FF_DONTCARE

	PokeS(@LF\lfFaceName[0],#FontFace)

	For i=0 To 1
		With Font(i)
			\Height=(31+i*18)<<#FontQuality>>1
			LF\lfHeight=-\Height
			LF\lfWeight=#FW_NORMAL
			;LF\lfWeight=#FW_DEMIBOLD
			\ID[0]=CreateFontIndirect_(@LF)

			;LF\lfWeight=#FW_BLACK
			LF\lfWeight=#FW_BOLD
			\ID[1]=CreateFontIndirect_(@LF)

		EndWith
	Next i

	Font(0)\Height+2<<#FontQuality
	Font(1)\Height-1<<#FontQuality

EndProcedure
Procedure AlphaImageWindow(Window,Image)

	Protected Image_HDC,Image_Object
	Protected Image_Bitmap.BITMAP,Image_BitmapInfo.BITMAPINFO
	Protected ContextOffset.POINT,Blend.BLENDFUNCTION
	Protected x,y,w,h,Alpha,Color

	Window=WindowID(Window)
	Image=ImageID(Image)

	SetWindowLong_(Window,#GWL_EXSTYLE,GetWindowLong_(Window,#GWL_EXSTYLE)|#WS_EX_LAYERED)

	Image_HDC=CreateCompatibleDC_(#Null)
	Image_Object=SelectObject_(Image_HDC,Image)

	GetObject_(Image,SizeOf(BITMAP),@Image_Bitmap)
	Image_BitmapInfo\bmiHeader\biSize=SizeOf(BITMAPINFOHEADER)
	Image_BitmapInfo\bmiHeader\biWidth=Image_Bitmap\bmWidth
	Image_BitmapInfo\bmiHeader\biHeight=Image_Bitmap\bmHeight
	Image_BitmapInfo\bmiHeader\biPlanes=1
	Image_BitmapInfo\bmiHeader\biBitCount=32

	w=Image_Bitmap\bmWidth-1
	h=Image_Bitmap\bmHeight-1

	SetWindowPos_(Window,#HWND_TOPMOST,100,100,w,h,#SWP_NOACTIVATE)

	Protected Dim Image.l(w,h)

	GetDIBits_(Image_HDC,Image,0,Image_Bitmap\bmHeight,@Image(),@Image_BitmapInfo,#DIB_RGB_COLORS)

	For x=0 To w
		For y=0 To h
			Color=Image(x,y)
			Alpha=Color>>24&$FF
			If Alpha<$FF
				Image(x,y)=Alpha<<24|MulDiv_(Color&$FF,Alpha,255)|(MulDiv_(Color&$FF00,Alpha,255)&$FF00)|(MulDiv_(Color&$FF0000,Alpha,255)&$FF0000)
			EndIf
		Next
	Next

	SetDIBits_(Image_HDC,Image,0,Image_Bitmap\bmHeight,@Image(),@Image_BitmapInfo,#DIB_RGB_COLORS)

	Blend\SourceConstantAlpha=255
	Blend\AlphaFormat=1
	Blend\BlendOp=0
	Blend\BlendFlags=0
	UpdateLayeredWindow_(Window,0,0,@Image_BitmapInfo+4,Image_HDC,@ContextOffset,0,@Blend,2)

	SelectObject_(Image_HDC,Image_Object)
	DeleteDC_(Image_HDC)

EndProcedure
Procedure.i CatText(w,h,Text.s,Flags=0)

	Debug "***"+Str(w)+"***"

	#FontBold=%0001

	#FlagBig=			%00000001
	#FlagVCenter=	%00000010
	#FlagCenter=		%00000100
	#FlagIndent=		%00001000
	#FlagDrawing=	%10000000

	Protected FontSize=Flags&#FlagBig
	Protected FontStyle,MemFontStyle
	Protected FontColor,MemFontColor

	Protected Px,Py,MemPx,n,MemN,Word
	Protected c,l,z

	; Absatz
	#TR=#CR;   	Absatz

	#TZ=#LF;   	Zeilenumbruch
	#CZ=#LF$
	#TT=#TAB;	Tabulator
	#CT=#TAB$
	; Flags
	#T1=#SI;   	Farbe 1 (rot)
	#C1=Chr(#T1)
	#T2=#SO;   	Farbe 2 (grün)
	#C2=Chr(#T2)
	#TB=#ACK;	Fettschrift
	#CB=Chr(#TB)

	#FontBold=1

	;LineXY(x,y,x,y+h,$FFFF0000)
	;LineXY(x+w,y,x+w,y+h,$FFFF0000)

	w<<#FontQuality
	h<<#FontQuality

	If Flags&#FlagDrawing
		StopDrawing()
	EndIf

	CreateImage(#CatText,w,h,32|#PB_Image_Transparent)
	StartDrawing(ImageOutput(#CatText))
	;DrawingMode(#PB_2DDrawing_AlphaBlend)
	;DrawingMode(#PB_2DDrawing_Transparent)
	DrawingMode(#PB_2DDrawing_AllChannels)

	With Font(FontSize)

		z=0
		Word=0
		l=Len(Text)

		Repeat

			FontStyle=0
			FontColor=0

			n=0
			Px=0
			If z And Flags&#FlagVCenter
				Py=(h-Py-MulDiv_(\Height,10,8))>>1
			Else
				Py=0
			EndIf

			DrawingFont(\ID[FontStyle])

			While n<l

				c=PeekC(@Text+n)
				n+1

				Select c
				Case #TB
					FontStyle!#FontBold
					DrawingFont(\ID[FontStyle])
				Case #TR
					Px=0
					Py+\Height+\Height>>2
					Word=0
				Case #T1
					If FontColor=1
						FontColor=0
					Else
						FontColor=1
					EndIf
				Case #T2
					If FontColor=2
						FontColor=0
					Else
						FontColor=2
					EndIf
				Case #TZ
					Px=0
					Py+\Height
					Word=0

				Default
					If c=' '
						MemPx=Px
						MemN=n
						MemFontStyle=FontStyle
						MemFontColor=FontColor
						Word+1
					EndIf

					If z
						Px=DrawText(Px,Py,Chr(c),FontColor(FontColor),#Null)
					Else
						Px+TextWidth(Chr(c))
					EndIf

					If c<>' ' And Px>w And MemN
						;LineXY(MemPx,Py,MemPx,Py+\Height,$FF00FF00)
						Px=0
						If Word
							n=MemN
							FontStyle=MemFontStyle
							FontColor=MemFontColor
							PokeC(@Text+n-1,#TZ)
							Word=0
						Else
							Text=Left(Text,n-1)+#CZ+Mid(Text,n)
							l+1
						EndIf
						Py+\Height

					EndIf

				EndSelect

			Wend

			z+1+(Flags!#FlagDrawing)&#FlagDrawing

		Until z>1

		StopDrawing()
		ResizeImage(#CatText,w>>#FontQuality,h>>#FontQuality)

		If Flags&#FlagDrawing
			StartDrawing(ImageOutput(#CatImage))
			DrawingMode(#PB_2DDrawing_AlphaBlend)
		EndIf

		ProcedureReturn (Py+MulDiv_(\Height,10,8))>>#FontQuality

	EndWith

EndProcedure
Procedure CatHelp(Title.s,Text.s)

	#CatWidth=380
	#CatCorner=6
	#CatSpace=15

	Protected n,c,h

	#NoTransparency=$FF000000
	For n=0 To Random(2)
		Text=Text+#C1+Text+#C1+#C2+Text+#C2
	Next n

	n=CatText(#CatWidth-#CatSpace<<1,60,Text,#False)
	h=n+50

	CreateImage(#CatImage,#CatWidth,h,32|#PB_Image_Transparent)
	StartDrawing(ImageOutput(#CatImage))
	DrawingMode(#PB_2DDrawing_AllChannels)
	RoundBox(1,1,#CatWidth-2,h-2,#CatCorner-1,#CatCorner-1,#NoTransparency|$A0A0A0)
	RoundBox(2,2,#CatWidth-4,h-4,#CatCorner-2,#CatCorner-2)

	DrawingMode(#PB_2DDrawing_AlphaBlend)
	CatText(#CatWidth-#CatSpace<<1,50,Title,#FlagBig|#FlagVCenter|#FlagDrawing)
	DrawImage(ImageID(#CatText),#CatSpace,0)
	CatText(#CatWidth-#CatSpace<<1,h-50,Text,#FlagVCenter|#FlagDrawing)
	DrawImage(ImageID(#CatText),#CatSpace,50)
	StopDrawing()

	AlphaImageWindow(#CatWindow,#CatImage)
	HideWindow(#CatWindow,0)

EndProcedure

Init()

OpenWindow(#CatWindow,0,0,0,0,"Cat",#PB_Window_BorderLess|#PB_Window_Invisible)
StickyWindow(#CatWindow,1)

CatHelp("Hi, stranger!","Need some training? This is a "+#C2+"nice"+#C2+" text with "+#CB+"extremly"+#CB+" nonsence.")


Repeat

	Event=WaitWindowEvent()
	Select Event
	Case #WM_LBUTTONDOWN
		SendMessage_(WindowID(0),#WM_NCLBUTTONDOWN,#HTCAPTION,0)
	Case #PB_Event_CloseWindow,#WM_CHAR
		End
	EndSelect

ForEver

[STARGÅTE]

But if DrawText does no antialiasing, why your example has not show just black and white pixels?

anti-aliasing does not mean that there is no mixing (alpha blend) with the background!
If the font need a half pixel, he mix it to gray.
But we have not the correction method "anti-aliasing"

The result with your codes:
first:

second code:


Edit:

because GDI+ must not be available on all machines

the font "Calibri" is also not on any system!
Calibri looks better because this font use hinting
http://en.wikipedia.org/wiki/Font_hinting

[Michael Vogel]

Thanks for the screen shots, I wasn't sure if the terrible output would be seen on other machines as well (code example 1) - I can't see a coding error, maybe it's a DrawText problem?

Code example 2 (is more close to my actual work) is not that bad, but using FontQuality>0 means to use larger fonts (slows down the program) and resizing the resulting image (steals some information, can be seen on the character "g").


PS nice try about Calibri

Code: Select all

OpenWindow(0,0,0,480,200,"")
CreateImage(0,480,200,32)
LoadFont(0,"Arial",-60)
StartDrawing(ImageOutput(0))
Box(0,0,240,200,#White)
Title.s="Test Hanburg"
DrawingMode(#PB_2DDrawing_AlphaBlend)
;DrawingMode(#PB_2DDrawing_Default)
DrawingFont(FontID(0))
DrawText(20,10,Title,$ff000000,$ffffffff)
DrawText(20,100,Title,$ffffffff,$ff000000)
StopDrawing()
ImageGadget(0,0,0,0,0,ImageID(0))
HideWindow(0,0)

Repeat

	Event=WaitWindowEvent()

	If Event=#WM_LBUTTONDOWN
		SendMessage_(WindowID(0),#WM_NCLBUTTONDOWN,#HTCAPTION,0)
	EndIf

Until Event=#PB_Event_CloseWindow Or  Event=#WM_CHAR

[Michael Vogel]

The drawtext result of the last code above is ok?!

[Michael Vogel]

I still get weird results when using AlphaBlend with the new beta.

The image seen in the latest posting was done with windows XP. When using W7 the text results are blurry, which has been the reason for starting this thread. There was also another trhead available facing the second issue with some comments from freak, but thread #41044 seems to be unavailable now.

[Michael Vogel]

As there is a workaround to get a smoother text (which needs a little more cpu power) by using larger fonts I would need to know the font size which is used by default for all gadgets - is there a simple command available like GetGadgetFont()to get the point size?

The following example shows text smoothing by setting the constant #Smooth equals 1:

Code: Select all

#Smooth=0
#Button=64

Procedure CreateButtonText(n,size,Text.s)

	#NoTransparency=$ff000000

	size<<#Smooth
	CreateImage(n,size,size,32|#PB_Image_Transparent)

	StartDrawing(ImageOutput(n))

	DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Transparent)
	DrawingFont(FontID(0))
	DrawText((size-TextWidth(Text))>>1,(size-TextHeight("Wg"))>>1,Text,#NoTransparency|#Black)
	StopDrawing()

	size>>#Smooth
	ResizeImage(n,size,size)

EndProcedure
Procedure Main()

	WinID=OpenWindow(0,0,0,#Button<<2,#Button,"ABCD",#PB_Window_ScreenCentered|#PB_Window_Invisible|#PB_Window_SystemMenu)
	LoadFont(0,"Trebuchet MS",MulDiv_(#Button,4,5))

	For i=0 To 3
		CreateButtonText(i,#Button,Mid("ABCD",i+1,1))
		ButtonImageGadget(i,i*#Button,0,#Button,#Button,ImageID(i))
	Next i

	HideWindow(0,0)

	quit=0
	Repeat
		Select WaitWindowEvent()
		Case #WM_CHAR,#PB_Event_CloseWindow
			quit=1
		EndSelect
	Until quit

EndProcedure
Main()