eye candy for text/fonts...

Community Forums/Graphic Chat/eye candy for text/fonts...

xMicky (Posted 2009) [#1]

The current code mainly taken from brl.mod/max2d.mod/imagefont.bmx and a little bit modified (therefore perhaps not best candidate for the Code Archives...I refer to the Software-Copyright-Discussion in the forum "General discussions") allows drawing text on a TPixmap: Strict Graphics 800, 600, 0 'using Arial Bold, which should be available on all Win PCs Local testFont:TImageFont =LoadImageFont("C:/Windows/Fonts/ARIALBD.TTF", 45) Local testText:String ="Test-Text" Local curImg:TImage =DrawTextOnPixmap(testText, testFont, 0, 0, 255) ' calculate the outputs position on screen: SetImageFont(testFont) Local textX:Int =100 Local textY:Int =150 Local imgX:Int =textX Local imgY:Int =textY +TextHeight(testText) +3 Local imgX2:Int =textX +TextWidth(testText) +3 Local imgY2:Int =textY SetBlend ALPHABLEND Repeat Cls SetColor 255, 0, 0 SetImageFont(testFont) DrawText testText, textX, textY SetColor 255, 255, 255 DrawImage curImg, imgX, imgY DrawImage curImg, imgX2, imgY2 ' being curious, lets look at the bounding-boxes : SetColor 255, 0, 0 Local w:Int =TextWidth(testText) Local h:Int =TextHeight(testText) DrawLine textX, textY, textX +w, textY DrawLine textX +w, textY, textX +w, textY +h DrawLine textX +w, textY +h, textX, textY +h DrawLine textX, textY +h, textX, textY w =ImageWidth(curImg) h =ImageHeight(curImg) SetColor 0, 0, 255 DrawLine imgX, imgY, imgX +w, imgY DrawLine imgX +w, imgY, imgX +w, imgY +h DrawLine imgX +w, imgY +h, imgX, imgY +h DrawLine imgX, imgY +h, imgX, imgY DrawLine imgX2, imgY2, imgX2 +w, imgY2 DrawLine imgX2 +w, imgY2, imgX2 +w, imgY2 +h DrawLine imgX2 +w, imgY2 +h, imgX2, imgY2 +h DrawLine imgX2, imgY2 +h, imgX2, imgY2 Flip Until KeyHit(KEY_ESCAPE) '============================================================= 'returns TImage sized to display the given text(single lined)/font -combination 'text color r,g,b: each from 0 to 255 (alpha is taken from font's pixel) Function DrawTextOnPixmap:TImage(text:String, font:TImageFont, r:Int, g:Int, b:Int) Local h:Int =font.Height() Local w:Int =0 For Local z:Int =0 To text.Length -1 Local curGlyph:Int =font.CharToGlyph(text[z]) Local glyph:TImageGlyph =font.LoadGlyph(curGlyph) w :+glyph._advance Next Local newImage:TImage =CreateImage(w, h, 1, DYNAMICIMAGE) Local newPixmap:TPixmap =LockImage(newImage) ClearPixels(newPixmap) Local x:Int For Local z:Int =0 To text.Length -1 Local n =font.CharToGlyph(text[z]) If n <0 Continue Local glyph:TImageGlyph =font.LoadGlyph(n) Local image:TImage =glyph._image If image Then Local curPixmap:TPixmap =LockImage(image) For Local curX:Int =0 To Min(curPixmap.width -1, glyph._advance -1) For Local curY:Int =0 To curPixmap.height -1 Local argb:Int =curPixmap.ReadPixel(curX, curY) Local curAlpha:Int =(argb Shr 24) & $FF If curAlpha >0 Then Local argb2:Int =(curAlpha Shl 24) +(r Shl 16) +(g Shl 8) +b WritePixel(newPixmap, x +curX, glyph._y +curY, argb2) End If Next Next UnlockImage(image) EndIf x :+glyph._advance Next UnlockImage(newImage) Return newImage End Function Having access to the TPixmaps gives you tremendous possibilities to enhance the texts optical appearance. Isn't this is a nice opportunity where we can benefit from each others inspirations ? So come on, show your own beautiful special effect for fonts ! The entries should be simple functions with this head: 'a little Description... DrawTextOnPixmap_SFX{ongoing numbering}:TImage(text:String, font:TImageFont, {parameters to set your special effect}) To make the start and to make clear what I have in mind two contributions from me: Strict Graphics 800, 600, 0 'using Arial Bold, which should be available on all Win PCs Local testFont:TImageFont =LoadImageFont("C:/Windows/Fonts/ARIALBD.TTF", 45) Local testText:String ="Test-Text" Local curImg:TImage =DrawTextOnPixmap_SFX1(testText, testFont, True) ' calculate the outputs position on screen: SetImageFont(testFont) Local textX:Int =100 Local textY:Int =150 Local imgX:Int =textX Local imgY:Int =textY +TextHeight(testText) +3 Local imgX2:Int =textX +TextWidth(testText) +3 Local imgY2:Int =textY SetBlend ALPHABLEND Repeat Cls SetColor 255, 0, 0 SetImageFont(testFont) DrawText testText, textX, textY SetColor 255, 255, 255 DrawImage curImg, imgX, imgY DrawImage curImg, imgX2, imgY2 ' being curious, lets look at the bounding-boxes : SetColor 255, 0, 0 Local w:Int =TextWidth(testText) Local h:Int =TextHeight(testText) DrawLine textX, textY, textX +w, textY DrawLine textX +w, textY, textX +w, textY +h DrawLine textX +w, textY +h, textX, textY +h DrawLine textX, textY +h, textX, textY w =ImageWidth(curImg) h =ImageHeight(curImg) SetColor 0, 0, 255 DrawLine imgX, imgY, imgX +w, imgY DrawLine imgX +w, imgY, imgX +w, imgY +h DrawLine imgX +w, imgY +h, imgX, imgY +h DrawLine imgX, imgY +h, imgX, imgY DrawLine imgX2, imgY2, imgX2 +w, imgY2 DrawLine imgX2 +w, imgY2, imgX2 +w, imgY2 +h DrawLine imgX2 +w, imgY2 +h, imgX2, imgY2 +h DrawLine imgX2, imgY2 +h, imgX2, imgY2 Flip Until KeyHit(KEY_ESCAPE) '============================================================= 'returns TImage sized to display the given text(single lined)/font -combination 'text has a vertical color gradient from topR,G,B to bottomR,G,B, each from 0 to 255 (alpha is taken from font's pixel) 'gradOverChar =FALSE: gradient is calculated over font height identically for all chars ' =TRUE : gradient is calculated over each chars individual size Function DrawTextOnPixmap_SFX1:TImage(text:String, font:TImageFont, gradOverChar:Int =False,.. topR:Int =255, topG:Int =0, topB:Int =0,.. bottomR:Int =0, bottomG:Int =0, bottomB:Int =255) Local h:Int =font.Height() Local w:Int =0 For Local z:Int =0 To text.Length -1 Local curGlyph:Int =font.CharToGlyph(text[z]) Local glyph:TImageGlyph =font.LoadGlyph(curGlyph) w :+glyph._advance Next Local newImage:TImage =CreateImage(w, h, 1, DYNAMICIMAGE) Local newPixmap:TPixmap =LockImage(newImage) ClearPixels(newPixmap) Local deltaR:Int =bottomR -topR Local deltaG:Int =bottomG -topG Local deltaB:Int =bottomB -topB Local x:Int For Local z:Int =0 To text.Length -1 Local n =font.CharToGlyph(text[z]) If n <0 Continue Local glyph:TImageGlyph =font.LoadGlyph(n) Local image:TImage =glyph._image If image Then Local curPixmap:TPixmap =LockImage(image) For Local curX:Int =0 To Min(curPixmap.width -1, glyph._advance -1) For Local curY:Int =0 To curPixmap.height -1 Local argb:Int =curPixmap.ReadPixel(curX, curY) Local curAlpha:Int =(argb Shr 24) & $FF If curAlpha >0 Then If gradOverChar Then Local r:Int =topR +(deltaR *curY) /(curPixmap.height -1) Local g:Int =topG +(deltaG *curY) /(curPixmap.height -1) Local b:Int =topB +(deltaB *curY) /(curPixmap.height -1) Local argb2:Int =(curAlpha Shl 24) +(r Shl 16) +(g Shl 8) +b WritePixel(newPixmap, x +curX, glyph._y +curY, argb2) Else Local r:Int =topR +(deltaR *(glyph._y +curY)) /h Local g:Int =topG +(deltaG *(glyph._y +curY)) /h Local b:Int =topB +(deltaB *(glyph._y +curY)) /h Local argb2:Int =(curAlpha Shl 24) +(r Shl 16) +(g Shl 8) +b WritePixel(newPixmap, x +curX, glyph._y +curY, argb2) End If End If Next Next UnlockImage(image) EndIf x :+glyph._advance Next UnlockImage(newImage) Return newImage End Function Second entry: Strict Graphics 800, 600, 0 'using Arial Bold, which should be available on all Win PCs Local testFont:TImageFont =LoadImageFont("C:/Windows/Fonts/ARIALBD.TTF", 45) Local testText:String ="Test-Text" 'make us a filling demo Image: Cls SetColor 255, 255, 0 DrawRect 1, 1, 110, 25 SetColor 255, 0, 0 DrawRect 111, 1, 110, 25 SetColor 0, 0, 255 DrawRect 1, 26, 110, 25 SetColor 255, 255, 255 DrawRect 111, 26, 110, 25 Local fillingImage:TImage =CreateImage(220, 50, 1, DYNAMICIMAGE) GrabImage fillingImage, 1, 1, 0 Local curImg:TImage =DrawTextOnPixmap_SFX2(testText, testFont, fillingImage, False, 0, -4) ' calculate the outputs position on screen: SetImageFont(testFont) Local textX:Int =100 Local textY:Int =150 Local imgX:Int =textX Local imgY:Int =textY +TextHeight(testText) +3 Local imgX2:Int =textX +TextWidth(testText) +3 Local imgY2:Int =textY SetBlend ALPHABLEND Repeat Cls SetColor 255, 0, 0 SetImageFont(testFont) DrawText testText, textX, textY SetColor 255, 255, 255 DrawImage curImg, imgX, imgY DrawImage curImg, imgX2, imgY2 ' show the Image used for text filling: DrawImage fillingImage, imgX, imgY2 +2 *ImageHeight(curImg) +10 ' being curious, lets look at the bounding-boxes : SetColor 255, 0, 0 Local w:Int =TextWidth(testText) Local h:Int =TextHeight(testText) DrawLine textX, textY, textX +w, textY DrawLine textX +w, textY, textX +w, textY +h DrawLine textX +w, textY +h, textX, textY +h DrawLine textX, textY +h, textX, textY w =ImageWidth(curImg) h =ImageHeight(curImg) SetColor 0, 0, 255 DrawLine imgX, imgY, imgX +w, imgY DrawLine imgX +w, imgY, imgX +w, imgY +h DrawLine imgX +w, imgY +h, imgX, imgY +h DrawLine imgX, imgY +h, imgX, imgY DrawLine imgX2, imgY2, imgX2 +w, imgY2 DrawLine imgX2 +w, imgY2, imgX2 +w, imgY2 +h DrawLine imgX2 +w, imgY2 +h, imgX2, imgY2 +h DrawLine imgX2, imgY2 +h, imgX2, imgY2 Flip Until KeyHit(KEY_ESCAPE) '============================================================= 'returns TImage sized to display the given text(single lined)/font -combination 'text has a filling from fillingImage(alpha is taken from font's pixel) 'tiledForChar =TRUE : images filling starts new with every new char ' =FALSE : images filling works over the whole text 'fillingStartX, Y: left, top of fillingImage where to begin with filling 'if chars size exceeds fillingImage's size : 'voidFillStyle =0 : char is clipped ' =1 : char is completed with solidR, G, B, A ' =2 : fillingImage is wrapped Function DrawTextOnPixmap_SFX2:TImage(text:String, font:TImageFont, fillingImage:TImage, tiledForChar:Int =False,.. fillingStartX:Int =0, fillingStartY:Int =0, voidFillStyle:Int =0,.. solidR:Int =255, solidG:Int =255, solidB:Int =255, solidA:Int =255) Local h:Int =font.Height() Local w:Int =0 For Local z:Int =0 To text.Length -1 Local curGlyph:Int =font.CharToGlyph(text[z]) Local glyph:TImageGlyph =font.LoadGlyph(curGlyph) w :+glyph._advance Next Local newImage:TImage =CreateImage(w, h, 1, DYNAMICIMAGE) Local newPixmap:TPixmap =LockImage(newImage) ClearPixels(newPixmap) Local fillPixmap:TPixmap =LockImage(fillingImage) Local curFillX:Int Local curFillY:Int Local argbSolid:Int =(solidA Shl 24) +(solidR Shl 16) +(solidG Shl 8) +solidB Local x:Int For Local z:Int =0 To text.Length -1 Local n =font.CharToGlyph(text[z]) If n <0 Continue Local glyph:TImageGlyph =font.LoadGlyph(n) Local image:TImage =glyph._image If tiledForChar Then curFillX =fillingStartX Else curFillX =x +fillingStartX End If If image Then Local curPixmap:TPixmap =LockImage(image) For Local curX:Int =0 To Min(curPixmap.width -1, glyph._advance -1) curFillY =fillingStartY For Local curY:Int =0 To curPixmap.height -1 Local argb:Int =curPixmap.ReadPixel(curX, curY) Local curAlpha:Int =(argb Shr 24) & $FF If curAlpha >0 Then Local fillOK:Int =False If curFillX >-1 And curFillX <fillPixmap.width Then fillOK =True ElseIf voidFillStyle =2 Then fillOK =True If curFillX <0 Then Repeat curFillX :+fillPixmap.width Until curFillX =>0 Else curFillX =curFillX Mod fillPixmap.width End If End If If fillOK Then If curFillY +glyph._y <0 Then If voidFillStyle =2 Then Repeat curFillY :+fillPixmap.height Until curFillY +glyph._y =>0 Else fillOK =False End If ElseIf curFillY +glyph._y >fillPixmap.height -1 Then If voidFillStyle =2 Then Repeat curFillY :-fillPixmap.height Until curFillY +glyph._y <fillPixmap.height Else fillOK =False End If End If End If If fillOK Then Local argbFill:Int =fillPixmap.ReadPixel(curFillX, curFillY +glyph._y) Local r:Int =(argbFill Shr 16) & $FF Local g:Int =(argbFill Shr 8) & $FF Local b:Int =argbFill & $FF WritePixel(newPixmap, x +curX, glyph._y +curY, (curAlpha Shl 24) +(r Shl 16) +(g Shl 8) +b) ElseIf voidFillStyle =1 Then WritePixel(newPixmap, x +curX, glyph._y +curY, argbSolid) End If End If curFillY :+1 Next curFillX :+1 Next UnlockImage(image) EndIf x :+glyph._advance Next UnlockImage(fillingImage) UnlockImage(newImage) Return newImage End Function

big10p (Posted 2009) [#2]

Code lives in the code archives, not here. ;)

xMicky (Posted 2009) [#3]

the effects above dynamically: SFX 1: Strict Graphics 800, 600, 0 'using Arial Bold, which should be available on all Win PCs Local testFont:TImageFont =LoadImageFont("C:/Windows/Fonts/ARIALBD.TTF", 45) Local testText:String ="Test-Text" ' calculate the outputs position on screen: SetImageFont(testFont) Local textX:Int =100 Local textY:Int =150 Local imgX:Int =textX Local imgY:Int =textY +TextHeight(testText) +3 Local imgX2:Int =textX +TextWidth(testText) +3 Local imgY2:Int =textY SetBlend ALPHABLEND 'variables for dynamic effect Local lastupdate:Int =MilliSecs() Local topR:Int =255 Local topG:Int =0 Local topB:Int =0 Local bottomR:Int =0 Local bottomG:Int =0 Local bottomB:Int =255 Local direction:Int =1 Local curImage :TImage =DrawTextOnPixmap_SFX1(testText, testFont, True, topR, topG, topB, bottomR, bottomG, bottomB) Repeat Cls SetColor 255, 0, 0 SetImageFont(testFont) DrawText testText, textX, textY SetColor 255, 255, 255 If MilliSecs() -lastupdate >10 Then If direction =1 Then topR :-5 topB :+5 bottomB :-5 BottomR :+5 If topR =0 Then direction =-1 End If Else topR :+5 topB :-5 bottomB :+5 BottomR :-5 If topR =255 Then direction =1 End If End If lastupdate =MilliSecs() curImage =DrawTextOnPixmap_SFX1(testText, testFont, True, topR, topG, topB, bottomR, bottomG, bottomB) End If DrawImage curImage, imgX, imgY DrawImage curImage, imgX2, imgY2 Flip Until KeyHit(KEY_ESCAPE) '============================================================= 'returns TImage sized to display the given text(single lined)/font -combination 'text has a vertical color gradient from topR,G,B to bottomR,G,B, each from 0 to 255 (alpha is taken from font's pixel) 'gradOverChar =FALSE: gradient is calculated over font height identically for all chars ' =TRUE : gradient is calculated over each chars individual size Function DrawTextOnPixmap_SFX1:TImage(text:String, font:TImageFont, gradOverChar:Int =False,.. topR:Int =255, topG:Int =0, topB:Int =0,.. bottomR:Int =0, bottomG:Int =0, bottomB:Int =255) Local h:Int =font.Height() Local w:Int =0 For Local z:Int =0 To text.Length -1 Local curGlyph:Int =font.CharToGlyph(text[z]) Local glyph:TImageGlyph =font.LoadGlyph(curGlyph) w :+glyph._advance Next Local newImage:TImage =CreateImage(w, h, 1, DYNAMICIMAGE) Local newPixmap:TPixmap =LockImage(newImage) ClearPixels(newPixmap) Local deltaR:Int =bottomR -topR Local deltaG:Int =bottomG -topG Local deltaB:Int =bottomB -topB Local x:Int For Local z:Int =0 To text.Length -1 Local n =font.CharToGlyph(text[z]) If n <0 Continue Local glyph:TImageGlyph =font.LoadGlyph(n) Local image:TImage =glyph._image If image Then Local curPixmap:TPixmap =LockImage(image) For Local curX:Int =0 To Min(curPixmap.width -1, glyph._advance -1) For Local curY:Int =0 To curPixmap.height -1 Local argb:Int =curPixmap.ReadPixel(curX, curY) Local curAlpha:Int =(argb Shr 24) & $FF If curAlpha >0 Then If gradOverChar Then Local r:Int =topR +(deltaR *curY) /(curPixmap.height -1) Local g:Int =topG +(deltaG *curY) /(curPixmap.height -1) Local b:Int =topB +(deltaB *curY) /(curPixmap.height -1) Local argb2:Int =(curAlpha Shl 24) +(r Shl 16) +(g Shl 8) +b WritePixel(newPixmap, x +curX, glyph._y +curY, argb2) Else Local r:Int =topR +(deltaR *(glyph._y +curY)) /h Local g:Int =topG +(deltaG *(glyph._y +curY)) /h Local b:Int =topB +(deltaB *(glyph._y +curY)) /h Local argb2:Int =(curAlpha Shl 24) +(r Shl 16) +(g Shl 8) +b WritePixel(newPixmap, x +curX, glyph._y +curY, argb2) End If End If Next Next UnlockImage(image) EndIf x :+glyph._advance Next UnlockImage(newImage) Return newImage End Function SFX2: Strict Graphics 800, 600, 0 'using Arial Bold, which should be available on all Win PCs Local testFont:TImageFont =LoadImageFont("C:/Windows/Fonts/ARIALBD.TTF", 45) Local testText:String ="Test-Text" 'make us a filling demo Image: Cls SetColor 255, 255, 0 DrawRect 1, 1, 110, 25 SetColor 255, 0, 0 DrawRect 111, 1, 110, 25 SetColor 0, 0, 255 DrawRect 1, 26, 110, 25 SetColor 255, 255, 255 DrawRect 111, 26, 110, 25 Local fillingImage:TImage =CreateImage(220, 50, 1, DYNAMICIMAGE) GrabImage fillingImage, 1, 1, 0 ' calculate the outputs position on screen: SetImageFont(testFont) Local textX:Int =100 Local textY:Int =150 Local imgX:Int =textX Local imgY:Int =textY +TextHeight(testText) +3 Local imgX2:Int =textX +TextWidth(testText) +3 Local imgY2:Int =textY SetBlend ALPHABLEND 'variables for dynamic effect Local lastupdate:Int =MilliSecs() Local offsetX:Int =0 Local curImg:TImage =DrawTextOnPixmap_SFX2(testText, testFont, fillingImage, False, offsetX, -4, 2) Repeat Cls SetColor 255, 0, 0 SetImageFont(testFont) DrawText testText, textX, textY SetColor 255, 255, 255 If MilliSecs() -lastupdate >15 Then offsetX :+5 curImg =DrawTextOnPixmap_SFX2(testText, testFont, fillingImage, False, offsetX, -4, 2) lastupdate =MilliSecs() End If DrawImage curImg, imgX, imgY DrawImage curImg, imgX2, imgY2 ' show the Image used for text filling: DrawImage fillingImage, imgX, imgY2 +2 *ImageHeight(curImg) +10 Flip Until KeyHit(KEY_ESCAPE) '============================================================= 'returns TImage sized to display the given text(single lined)/font -combination 'text has a filling from fillingImage(alpha is taken from font's pixel) 'tiledForChar =TRUE : images filling starts new with every new char ' =FALSE : images filling works over the whole text 'fillingStartX, Y: left, top of fillingImage where to begin with filling 'if chars size exceeds fillingImage's size : 'voidFillStyle =0 : char is clipped ' =1 : char is completed with solidR, G, B, A ' =2 : fillingImage is wrapped Function DrawTextOnPixmap_SFX2:TImage(text:String, font:TImageFont, fillingImage:TImage, tiledForChar:Int =False,.. fillingStartX:Int =0, fillingStartY:Int =0, voidFillStyle:Int =0,.. solidR:Int =255, solidG:Int =255, solidB:Int =255, solidA:Int =255) Local h:Int =font.Height() Local w:Int =0 For Local z:Int =0 To text.Length -1 Local curGlyph:Int =font.CharToGlyph(text[z]) Local glyph:TImageGlyph =font.LoadGlyph(curGlyph) w :+glyph._advance Next Local newImage:TImage =CreateImage(w, h, 1, DYNAMICIMAGE) Local newPixmap:TPixmap =LockImage(newImage) ClearPixels(newPixmap) Local fillPixmap:TPixmap =LockImage(fillingImage) Local curFillX:Int Local curFillY:Int Local argbSolid:Int =(solidA Shl 24) +(solidR Shl 16) +(solidG Shl 8) +solidB Local x:Int For Local z:Int =0 To text.Length -1 Local n =font.CharToGlyph(text[z]) If n <0 Continue Local glyph:TImageGlyph =font.LoadGlyph(n) Local image:TImage =glyph._image If tiledForChar Then curFillX =fillingStartX Else curFillX =x +fillingStartX End If If image Then Local curPixmap:TPixmap =LockImage(image) For Local curX:Int =0 To Min(curPixmap.width -1, glyph._advance -1) curFillY =fillingStartY For Local curY:Int =0 To curPixmap.height -1 Local argb:Int =curPixmap.ReadPixel(curX, curY) Local curAlpha:Int =(argb Shr 24) & $FF If curAlpha >0 Then Local fillOK:Int =False If curFillX >-1 And curFillX <fillPixmap.width Then fillOK =True ElseIf voidFillStyle =2 Then fillOK =True If curFillX <0 Then Repeat curFillX :+fillPixmap.width Until curFillX =>0 Else curFillX =curFillX Mod fillPixmap.width End If End If If fillOK Then If curFillY +glyph._y <0 Then If voidFillStyle =2 Then Repeat curFillY :+fillPixmap.height Until curFillY +glyph._y =>0 Else fillOK =False End If ElseIf curFillY +glyph._y >fillPixmap.height -1 Then If voidFillStyle =2 Then Repeat curFillY :-fillPixmap.height Until curFillY +glyph._y <fillPixmap.height Else fillOK =False End If End If End If If fillOK Then Local argbFill:Int =fillPixmap.ReadPixel(curFillX, curFillY +glyph._y) Local r:Int =(argbFill Shr 16) & $FF Local g:Int =(argbFill Shr 8) & $FF Local b:Int =argbFill & $FF WritePixel(newPixmap, x +curX, glyph._y +curY, (curAlpha Shl 24) +(r Shl 16) +(g Shl 8) +b) ElseIf voidFillStyle =1 Then WritePixel(newPixmap, x +curX, glyph._y +curY, argbSolid) End If End If curFillY :+1 Next curFillX :+1 Next UnlockImage(image) EndIf x :+glyph._advance Next UnlockImage(fillingImage) UnlockImage(newImage) Return newImage End Function

Retimer (Posted 2009) [#4]

Nice effects