DrawText changing fonts, fontsize and colors

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

DrawText changing fonts, fontsize and colors

Post by einander »

DrawText changing fonts, fontsizes and colors

Code: Select all

;By einander
;PB 4.20 Beta 2 - march 2008

Global _DRAWING

Procedure AlignText(X,YAlign,Text.s,Font,RGB=-1,BackRGB=-1)
     ; ;Without  RGB Param or RGB=-1, keeps previous RGB. Default=#Black
     ; ;Without BackRGB Param or BackRGB=-1, keeps previous BackRGB. Default=#White
     Static X1,Y1,OldRGB,OldBACK
     FontID=FontID(Font)
     DrawingFont(FontID)
     If RGB=-1 : RGB=OldRGB: EndIf
     If BackRGB=-1
          If OldBACK=RGB:BackRGB=#White
          Else :  BackRGB=OldBACK
          EndIf
     EndIf
     If X=-1
          If X1=0:X=0
          Else:X=X1
          EndIf
     EndIf
     If YAlign=-1
          If Y1=0:YAlign=0
          Else:YAlign=Y1
          EndIf
     EndIf
     GetTextMetrics_(_DRAWING, TM.NEWTEXTMETRIC)  ;to change text bottom position
     
     
     X1=DrawText(X,YAlign-TM\tmAscent,Text,RGB,BackRGB)
     Y1=YAlign
     
     OldRGB=RGB :  OldBACK=BackRGB
     ProcedureReturn X1 ; x position for the next string
EndProcedure
   
     ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;Test it
hwnd=OpenWindow(0, 100, 100,700,500 ,"Draw text aligned changing font sizes and colors",  #WS_OVERLAPPEDWINDOW | #WS_MAXIMIZE)
CreateGadgetList(hwnd)
Wi=WindowWidth(0):He=WindowHeight(0)
ImGad=ImageGadget(-1,0,0,0,0,0)
IMG=CreateImage(-1,Wi,He,32)

Dim Font(5)
     
Font(0)=LoadFont(-1,"Arial",26)
Font(1)=LoadFont(-1,"Comic sans MS",30)
Font(2)=LoadFont(-1,"Times new Roman",22)
Font(3)=LoadFont(-1,"WingDings",18)
Font(4)=LoadFont(-1,"Courier New",12)
Font(5)=LoadFont(-1,"Courier New",24)
     
_DRAWING=StartDrawing(ImageOutput(IMG))
     X=10 :YAlign=100
     AlignText(X,YAlign,"Draw text aligned",Font(2),#Magenta)
     AlignText(-1,-1, " changing",Font(1),#Yellow)
     AlignText(-1,-1," font sizes and c",Font(2),#Red)
     AlignText(-1,-1,"o",Font(0),#Green)
     AlignText(-1,-1,"l",Font(1),#Magenta)
     AlignText(-1,-1,"o",Font(5),#Cyan)
     AlignText(-1,-1,"r",Font(0),#Yellow)
     AlignText(-1,-1,"s",Font(4),#White)
     
     X=10:YAlign=200  ; new line
     AlignText(X,YAlign,"Arial 10",Font(0),#Red)
     AlignText(-1,-1," Comic Sans MS 30",Font(1),$FFFCC2)
     X1=AlignText(-1,-1," Times New Roman 22",Font(2),#Yellow)
     LineXY(10,YAlign,X1,YAlign,$AABBCC)
     
     YAlign=300  ; new line
     
     AlignText(10,YAlign,"WingDings 18",Font(3))
     AlignText(-1,-1," Courier new 12",Font(4),#Red,#Cyan)
     X1=AlignText(-1,-1," Courier New 24",Font(5),0)
     LineXY(0,YAlign,X1,YAlign,#Blue)
StopDrawing():_DRAWING=0
SetGadgetState(ImGad,ImageID(IMG))
     
Repeat
     If GetAsyncKeyState_(#VK_ESCAPE):Break:EndIf
     Ev=WaitWindowEvent()
Until Ev=#WM_CLOSE
For i = 0 To 5
     FreeFont(Font(i))
Next
End
Have fun!
Last edited by einander on Tue Mar 04, 2008 2:27 pm, edited 1 time in total.
Top
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Post by srod »

Nice! :)
I may look like a mule, but I'm not a complete ass.
Top
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Post by einander »

Thanks Srod!
Top
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Post by Kwai chang caine »

Yes, it's great and very nice 8)

You give me an idea to your turn, is it possible to insert a little jpg picture, (Like the size of the characters), Between your characters, As if the photo was an character ?? :roll:
ImageThe happiness is a road...
Not a destination
Top
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Post by einander »

Yes this can be achieved.
Each block of text on the example is treated like a rectangle, so it's matter of replace a text block with an image.
Ill try it.
Top
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

The same code with image insert

Post by einander »

Code: Select all

;By einander
;idea by Kwaï chang caïne
;PB 4.20 Beta 2 - march 2008
Global _DRAWING


Procedure AlignText(X,YAlign,Text.s,Font,wParam=-1,lParam=-1,IMG=-1)
     ; for text, wParam=frontcolor, lParam=BackColor
     ; ;Without  wParam or wParam=-1, keeps previous FrontColor. Default=#Black
     ; ;Without lParam or lParam=-1, keeps previous BackColor. Default=#White
     
     ; for image, wParam=ImageWidth:lParam=ImageHeight
     Static X1,Y1,OldRGB,OldBACK
     
     If X=-1
          If X1=0:X=0
          Else:X=X1
          EndIf
     EndIf
     If YAlign=-1
          If Y1=0:YAlign=0
          Else:YAlign=Y1
          EndIf
     EndIf
     If IMG>-1
          DrawImage(ImageID(IMG),X,YAlign-lParam,wParam,lParam)
          X1= X+wParam
     Else
          FontID=FontID(Font)
          DrawingFont(FontID)
          If wParam=-1 : wParam=OldRGB: EndIf
          If lParam=-1
               If OldBACK=wParam:lParam=#White
               Else :  lParam=OldBACK
               EndIf
          EndIf
          GetTextMetrics_(_DRAWING, TM.NEWTEXTMETRIC)  ;to change text bottom position
          
          X1=DrawText(X,YAlign-TM\tmAscent,Text,wParam,lParam)
          Y1=YAlign
          OldRGB=wParam :  OldBACK=lParam
     EndIf
     ProcedureReturn X1 ; x position for the next string
EndProcedure
   
     ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;Test it
hwnd=OpenWindow(0, 100, 100,700,500 ,"Draw text and images changing font sizes and colors",  #WS_OVERLAPPEDWINDOW | #WS_MAXIMIZE)
CreateGadgetList(hwnd)
Wi=WindowWidth(0):He=WindowHeight(0)
ImGad=ImageGadget(-1,0,0,0,0,0)
IMG=CreateImage(-1,Wi,He,32)
Img1=LoadImage(-1,"c:\test3.bmp") ;here put your image <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Dim Font(5)
     
Font(0)=LoadFont(-1,"Arial",26)
Font(1)=LoadFont(-1,"Comic sans MS",30)
Font(2)=LoadFont(-1,"Times new Roman",22)
Font(3)=LoadFont(-1,"WingDings",18)
Font(4)=LoadFont(-1,"Courier New",12)
Font(5)=LoadFont(-1,"Courier New",24)
     
_DRAWING=StartDrawing(ImageOutput(IMG))
     X=10 :YAlign=100
     AlignText(X,YAlign,"Draw text and images ",Font(2),#Magenta)
     AlignText(-1,-1,"",0,50,50,Img1)   ; this line can be moved as you like <<<<<<<<<<<<<<<<<<<<<
     AlignText(-1,-1, " changing",Font(1),#Yellow)
     AlignText(-1,-1," font sizes and c",Font(2),#Red)
     AlignText(-1,-1,"o",Font(0),#Green)
     AlignText(-1,-1,"l",Font(1),#Magenta)
     AlignText(-1,-1,"o",Font(5),#Cyan)
     AlignText(-1,-1,"r",Font(0),#Yellow)
     AlignText(-1,-1,"s",Font(4),#White)
     X=10:YAlign=200  ; new line
     AlignText(X,YAlign,"Arial 10",Font(0),#Red)
     AlignText(-1,-1," Comic Sans MS 30",Font(1),$FFFCC2)
     X1=AlignText(-1,-1," Times New Roman 22",Font(2),#Yellow)
     LineXY(10,YAlign,X1,YAlign,$AABBCC)
     
     YAlign=300  ; new line
     
     AlignText(10,YAlign,"WingDings 18",Font(3))
     AlignText(-1,-1," Courier new 12",Font(4),#Red,#Cyan)
     X1=AlignText(-1,-1," Courier New 24",Font(5),0)
     LineXY(0,YAlign,X1,YAlign,#Blue)
StopDrawing():_DRAWING=0
SetGadgetState(ImGad,ImageID(IMG))
     
Repeat
     If GetAsyncKeyState_(#VK_ESCAPE):Break:EndIf
     Ev=WaitWindowEvent()
Until Ev=#WM_CLOSE
For i = 0 To 5
     FreeFont(Font(i))
Next
End
Last edited by einander on Tue Mar 04, 2008 2:19 pm, edited 1 time in total.
Top
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Post by Kwai chang caine »

Yeeeeessss !!!!

It's super cool !!!!! :D
More, the picture auto stretching 8)

I have put a big picture and she appears more little 8)
Exactly what i want, without ask you this option, thanks again.

This is a big beginner for make approximatly the same effect that the code of SROD and NICO with a EditorGadget, but in more simple, i think 8)
http://www.purebasic.fr/english/viewtop ... jectaddref
Just add the keyboard management and this is a clone :D

Code: Select all

;By einander 
;idea by Kwaï chang caïne 
;PB 4.20 Beta 2 - march 2008 
Global _DRAWING
Thank you very much for this little word in begin of your code 8)
I do not deserve this honour :oops:

I wish you a good night
ImageThe happiness is a road...
Not a destination
Top
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Post by einander »

You're welcome :)
Top
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Post by Kwai chang caine »

:wink:
ImageThe happiness is a road...
Not a destination
Top
User avatar
DoubleDutch
Addict
Addict
Posts: 3220
Joined: Thu Aug 07, 2003 7:01 pm
Location: United Kingdom
Contact:
Contact DoubleDutch

Post by DoubleDutch »

einander: You can replace...

Code: Select all

DrawText(X,YAlign-TM\tmAscent,Text,RGB,BackRGB) 
X1=X+TextWidth(Text) : Y1=YAlign
with...

Code: Select all

X1=DrawText(X,YAlign-TM\tmAscent,Text,RGB,BackRGB)
Y1=YAlign
https://deluxepixel.com <- My Business website
https://reportcomplete.com <- School end of term reports system
Top
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Post by einander »

Thanks DoubleDutch!

Oops! Surprise :oops:
From the new PB Help:
The new x position of the text cursor (ie: just after the last printed character) is returned in 'Result' to allow easy text concatenation, if required.
Changed on both examples
Top
User avatar
DoubleDutch
Addict
Addict
Posts: 3220
Joined: Thu Aug 07, 2003 7:01 pm
Location: United Kingdom
Contact:
Contact DoubleDutch

Post by DoubleDutch »

I requested it on an alpha or beta ages ago and Fred put it in. :)
https://deluxepixel.com <- My Business website
https://reportcomplete.com <- School end of term reports system
Top
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:
Contact Psychophanta

Post by Psychophanta »

Nice code.
By the way, you can download lots of text fonts at:
http://www.hackingballz.com/fuentes
even i don't know all of it is legal :?
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
Top
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Post by einander »

Thanks Albert.
Some nice fonts on that site.
Top
Michel_k17
User
User
Posts: 14
Joined: Sun Dec 14, 2003 4:57 am
Location: Wichita, Kansas
Contact:
Contact Michel_k17

Re: DrawText changing fonts, fontsize and colors

Post by Michel_k17 »

Code was not working for me (using PB 5.10), which was driving me nuts. It looks like older versions of PB might have selected the font object as part of the DrawingFont function.

At any rate, here is the modified code that works.

Note: although not clear in the subject line, this code vertically aligns text of different fonts/sizes to the Baseline of the font rather than the top.

Code: Select all

;By einander
;PB 4.20 Beta 2 - march 2008
;PB 5.10 Dec 2013 modified by Michel K-17 (added SelectObject_ so that it would work)

Global _DRAWING

Procedure AlignText(X,YAlign,Text.s,Font,RGB=-1,BackRGB=-1)
     ; ;Without  RGB Param or RGB=-1, keeps previous RGB. Default=#Black
     ; ;Without BackRGB Param or BackRGB=-1, keeps previous BackRGB. Default=#White
     Static X1,Y1,OldRGB,OldBACK
     FontID=FontID(Font)
     DrawingFont(FontID)
     If RGB=-1 : RGB=OldRGB: EndIf
     If BackRGB=-1
          If OldBACK=RGB:BackRGB=#White
          Else :  BackRGB=OldBACK
          EndIf
     EndIf
     If X=-1
          If X1=0:X=0
          Else:X=X1
          EndIf
     EndIf
     If YAlign=-1
          If Y1=0:YAlign=0
          Else:YAlign=Y1
          EndIf
     EndIf

     ; Select the font, Get the Font Metrics, and then reselect the current object
     hOld.l = SelectObject_(_DRAWING,FontID)
     GetTextMetrics_(_DRAWING, TM.NEWTEXTMETRIC)  ;to change text bottom position
     If hOld <> 0 : SelectObject_(_DRAWING,hOld):EndIf
     
     
     
     X1=DrawText(X,YAlign-TM\tmAscent,Text,RGB,BackRGB)
     Y1=YAlign
     
     OldRGB=RGB :  OldBACK=BackRGB
     ProcedureReturn X1 ; x position for the next string
EndProcedure
   
     ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;Test it
hwnd=OpenWindow(0, 100, 100,700,500 ,"Draw text aligned changing font sizes and colors",  #WS_OVERLAPPEDWINDOW | #WS_MAXIMIZE)
CreateGadgetList(hwnd)
Wi=WindowWidth(0):He=WindowHeight(0)
ImGad=ImageGadget(-1,0,0,0,0,0)
IMG=CreateImage(-1,Wi,He,32)

Dim Font(5)
     
Font(0)=LoadFont(-1,"Arial",26)
Font(1)=LoadFont(-1,"Comic sans MS",30)
Font(2)=LoadFont(-1,"Times new Roman",22)
Font(3)=LoadFont(-1,"WingDings",18)
Font(4)=LoadFont(-1,"Courier New",12)
Font(5)=LoadFont(-1,"Courier New",24)
     
_DRAWING=StartDrawing(ImageOutput(IMG))
     X=10 :YAlign=100
     AlignText(X,YAlign,"Draw text aligned",Font(2),#Magenta)
     AlignText(-1,-1, " changing",Font(1),#Yellow)
     AlignText(-1,-1," font sizes and c",Font(2),#Red)
     AlignText(-1,-1,"o",Font(0),#Green)
     AlignText(-1,-1,"l",Font(1),#Magenta)
     AlignText(-1,-1,"o",Font(5),#Cyan)
     AlignText(-1,-1,"r",Font(0),#Yellow)
     AlignText(-1,-1,"s",Font(4),#White)
     LineXY(10,YAlign,700,YAlign,$AABBCC)
     
     X=10:YAlign=200  ; new line
     AlignText(X,YAlign,"Arial 10",Font(0),#Red)
     AlignText(-1,-1," Comic Sans MS 30",Font(1),$FFFCC2)
     X1=AlignText(-1,-1," Times New Roman 22",Font(2),#Yellow)
     LineXY(10,YAlign,X1,YAlign,$AABBCC)
     
     YAlign=300  ; new line
     
     AlignText(10,YAlign,"WingDings 18",Font(3))
     AlignText(-1,-1," Courier new 12",Font(4),#Red,#Cyan)
     X1=AlignText(-1,-1," Courier New 24",Font(5),0)
     LineXY(0,YAlign,X1,YAlign,#Blue)
StopDrawing():_DRAWING=0
SetGadgetState(ImGad,ImageID(IMG))
     
Repeat
     If GetAsyncKeyState_(#VK_ESCAPE):Break:EndIf
     Ev=WaitWindowEvent()
Until Ev=#WM_CLOSE
For i = 0 To 5
     FreeFont(Font(i))
Next
End
Michel "K-17" Korwin-Szymanowski
Top
Post Reply

Return to “Tricks 'n' Tips”