Code archives/BlitzPlus Gui/drawpixmaptext
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
| This command allows you to write text to a pixmap without requiring a DX or OGL graphics context open. | |||||
Function drawpixmaptext(text$,pix:TPixmap,x,y,font:TImageFont,red=255,green=255,blue=255)
Local newx
Local theight
theight = font.Height()
Print theight
For i = 0 To text.length-1
tempText$ = Mid(text, i+1, 1)
asciiVal = Asc(tempText)
n=font.CharToGlyph( asciiVal )
If n<0 Continue
glyph:TImageGlyph = font.LoadGlyph(n)
image:TImage=glyph._image
Print "Draw "+Chr(asciiVal)
If image <> Null
tempix:TPixmap = LockImage(image)
UnlockImage(glyph._image)
If tempix
For yy = 0 To tempix.height-1
For xx = 0 To tempix.width-1
If newx+x+xx < pix.width And y+yy < pix.height Then
alpha# = RGBA_alpha(ReadPixel(tempix,xx,yy))
alphan# = Float(alpha#/255.0)
anti# = 1.0-alphan#
ured = RGBA_Red(ReadPixel(tempix,xx,yy))
ugrn = RGBA_Green(ReadPixel(tempix,xx,yy))
ublu = RGBA_Blue(ReadPixel(tempix,xx,yy))
newred = ((RGBA_Red(ReadPixel(pix,newx+x+xx,y+yy))*anti#)+(ured*alphan#))
newgrn = ((RGBA_Green(ReadPixel(pix,newx+x+xx,y+yy))*anti#)+(ugrn*alphan#))
newblu = ((RGBA_Blue(ReadPixel(pix,newx+x+xx,y+yy))*anti#)+(ublu*alphan#))
If newred > 255 Then newred = 255
If newgrn > 255 Then newgrn = 255
If newblu > 255 Then newblu = 255
WritePixel(pix,newx+x+xx,(theight-tempix.height)+y+yy,ToRGBA(newred,newgrn,newblu,255))
EndIf
Next
Next
EndIf
EndIf
newx = newx + tempix.width
Next
End Function
Function RGBA_Red%(rgba%)
Return (rgba Shr 16) & $FF
End Function
Function RGBA_Green%(rgba%)
Return (rgba Shr 8) & $FF
End Function
Function RGBA_Blue%(rgba%)
Return rgba & $FF
End Function
Function RGBA_alpha%(rgba%)
Return (rgba% Shr 24) & $FF
End Function
Function ToRGBA%(r%,g%,b%,a%)
'return (a << 24) | (r << 16) | (g << 8) | (b);
Return ((A Shl 24) | (R Shl 16) | (G Shl 8) | B)
End Function |
Comments
| ||
| really nice,thanks for share! |
| ||
| Awesome! I wonder why I haven't seen this before... EDIT: Nevermind. Doesn't work too well. |
| ||
| the color part doesn't work also the alpha code doesn't work! you can modify this a little to draw the alpha text |
| ||
try this:
Function drawpixmaptext(Text:String, pix:TPixmap, x:Int, y:Int, font:TImageFont, RED:Int = 255, Green:Int = 255, Blue:Int = 255)
Local newx:Int
Local theight:Int
IF font = Null then return
theight = font.Height()
For Local I:Int = 0 To Text.Length - 1
Local tempText:String = Mid(Text, I + 1, 1)
Local asciiVal:Int = Asc(tempText)
Local n:Int = font.CharToGlyph(asciiVal)
If n<0 Continue
Local glyph:TImageGlyph = font.LoadGlyph(n)
Local image:TImage = glyph._image
Local tempix:TPixmap
If image <> Null
tempix = LockImage(image)
UnlockImage(glyph._image)
If tempix
Local tx:Float = glyph._x
Local ty:Float = glyph._y
For Local yy:Int = 0 To glyph._h - 1'Height - 1
For Local xx:Int = 0 To glyph._w - 1'tempix.width - 1
If newx + x + xx + tx < pix.width And y + yy + ty < pix.Height Then
Local Alpha:Float = RGBA_alpha(ReadPixel(tempix, xx, yy))
Local alphan:Float = Float(Alpha:Float / 255.0)
Local anti:Float = 1.0 - alphan:Float
Local ured:Int = RED'RGBA_Red(ReadPixel(tempix, xx, yy))
Local ugrn:Int = Green'RGBA_Green(ReadPixel(tempix, xx, yy))
Local ublu:Int = Blue'RGBA_Blue(ReadPixel(tempix, xx, yy))
Local newred:Int = ((RGBA_Red(ReadPixel(pix, newx + x + xx + tx, ty + y + yy)) * anti) + (ured * alphan:Float))
Local newgrn:Int = ((RGBA_Green(ReadPixel(pix, newx + x + xx + tx, ty + y + yy)) * anti) + (ugrn * alphan:Float))
Local newblu:Int = ((RGBA_Blue(ReadPixel(pix, newx + x + xx + tx, ty + y + yy)) * anti) + (ublu * alphan:Float))
Local newAlpha:Int = ((RGBA_alpha(ReadPixel(pix, newx + x + xx + tx, ty + y + yy)) * anti) + (Alpha * alphan:Float))
If newred > 255 Then newred = 255
If newgrn > 255 Then newgrn = 255
If newblu > 255 Then newblu = 255
If newAlpha > 255 Then newAlpha = 255
WritePixel(pix, newx + x + xx + tx, y + yy + ty, ToRGBA(newred, newgrn, newblu, newAlpha))
EndIf
Next
Next
EndIf
EndIf
newx = newx + glyph.Advance()
Next
End Function
Function RGBA_Red:Int(rgba:Int)
Return (rgba Shr 16) & $FF
End Function
Function RGBA_Green:Int(rgba:Int)
Return (rgba Shr 8) & $FF
End Function
Function RGBA_Blue:Int(rgba:Int)
Return rgba & $FF
End Function
Function RGBA_alpha:Int(rgba:Int)
Return (rgba:Int Shr 24) & $FF
End Function
Function ToRGBA:Int(r:Int, g:Int, b:Int, a:Int)
'return (a << 24) | (r << 16) | (g << 8) | (b);
Return ((A Shl 24) | (R Shl 16) | (G Shl 8) | B)
End Function
Function TextWidthFont:Int(Text:String, Font:TImageFont)
Local width:Int = 0
For Local n:Int = 0 Until Text.Length
Local I:Int = font.CharToGlyph(Text[n])
If I < 0 Continue
width:+font.LoadGlyph(I).Advance()
Next
Return width
End Function
Its fixed version of the above: -Alpha support -Color Support -Correct Spacing for chars (using glyph details) -Extra Function to retrieve the TextWidth without the need to have a graphiccontext |
| ||
| got an error :pixmap coordinates out of bounds! i used a unicode truetype font for testing. also i used a "simple" version to show the original text: Function drawpixmaptext1(text$,pix:TPixmap,x,y,font:TImageFont) Local newx Local theight theight = font.Height() 'Print theight For i = 0 To text.length-1 tempText$ = Mid(text, i+1, 1) asciiVal = Asc(tempText) n=font.CharToGlyph( asciiVal ) If n<0 Continue glyph:TImageGlyph = font.LoadGlyph(n) image:TImage=glyph._image 'Print "Draw "+Chr(asciiVal) If image <> Null tempix:TPixmap = LockImage(image) UnlockImage(glyph._image) If tempix For yy = 0 To tempix.height-1 For xx = 0 To tempix.width-1 If newx+x+xx < pix.width And y+yy < pix.height Local rgba:Int=ReadPixel(tempix,xx,yy) WritePixel(pix,newx+x+xx,(theight-tempix.height)+y+yy,rgba) EndIf Next Next EndIf EndIf newx = newx + tempix.width Next End Function |
| ||
| oh yeah, i missed the glyph height and width in the checking for pixmap bounds. Otherwise it should work. I have tested it with various ttfs and also had written the whole maxide src to one pixmap. (time < 5sec) |
| ||
| kelpto2, can you modify your code above? |
| ||
| I think he did. Some test code. 'Rem
Strict
Graphics 640,480,0
Local pixmap:TPixmap = CreatePixmap(128, 128, PF_RGBA8888)
Local font:TImageFont = TImageFont.CreateDefault()
DrawPixmapText("R", pixmap, 10, 10, font, 255, 0, 0)
DrawPixmapText(" A", pixmap, 10, 10, font, 255, 127, 0)
DrawPixmapText(" I", pixmap, 10, 10, font, 255, 255, 0)
DrawPixmapText(" N", pixmap, 10, 10, font, 0, 255, 0)
DrawPixmapText(" B", pixmap, 10, 10, font, 0, 255, 255)
DrawPixmapText(" O", pixmap, 10, 10, font, 255, 0, 255)
DrawPixmapText(" W", pixmap, 10, 10, font, 127, 0, 255)
DrawPixmapText(" :)", pixmap, 10, 10, font, 255, 255, 255)
While Not (KeyDown(KEY_ESCAPE) Or AppTerminate())
Cls
DrawPixmap(pixmap,0,0)
Flip
Wend
'EndRem |
| ||
| works fine now,thanks |
Code Archives Forum
   |