September 26, 2020, 05:52:53 pm

News:

Own IWBasic 2.x ? -----> Get your free upgrade to 3.x now.........


How do I calculate with of a text in pixels?

Started by Egil, November 23, 2010, 07:08:48 am

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Egil

When the Creative Basic user forum was over at Coder Creations only, I suddenly needed to draw a labeled box.
What I came up with can be found here: http://www.codercreations.com/forums/index.php?topic=3880.0

Last night I sat down thinking "wouldn't it be nice to add colour background to the box and maybe a border around the text label?"

This is what I have come up with so far. The random colours used will be changed to fixed values in the final "masterpiece"...
Code Select
' gbox-02.cba
AUTODEFINE "OFF"

DECLARE "gdi32.dll",RoundRect(hdc As int, X1 As int, Y1 As int, X2 As int, Y2 As int, X3 As int, Y3 As int) As int
DECLARE gbox(x:int,y:int,w:int,h:int,msg$:string)

DEF win:window
def run:int

WINDOW win,0,0,640,480,@MINBOX|@MAXBOX|@SIZE,0,"- Main -",main
drawmode win,@TRANSPARENT

gbox(25,30,175,100,"  gbox1")
gbox(210,150,175,60,"  gbox2")
gbox(250,30,175,30,"  gbox3")
gbox(50,300,375,50,"  Creative Basic rules")

move win, 100,230
print win, "default colors retained outside the boxes"

run = 1
waituntil run = 0
closewindow win
end

sub main
select @class
case @idclosewindow
run=0
case @IDCREATE
CenterWindow win
endselect
return

'
'--------------------------------------------------------------------
' CB Groupbox - modified version
'
SUB gbox(x,y,w,h,msg$)
def message_length,left,top,right,bottom,hdc:int
left   = x
top    = y
right  = x+w
bottom = y+h

hdc = GetHDC win
RoundRect(hdc, x,y, right, bottom, 9, 9) :' rounded box
RELEASEHDC(win,hdc)
FLOODFILL win, x+2, y+2, RGB(rnd(255),rnd(255),rnd(255)) :' background colour

if msg$ <> ""
message_length = len(msg$)
hdc = GetHDC win

RoundRect(hdc, left+12,top-8, (left+12+(message_length*8)), top+9, 5, 7) :' label border

RELEASEHDC(win,hdc)
FLOODFILL win, left+14, top-6, RGB(rnd(255),rnd(255),rnd(255)) :' background colour
move win, left+12,top-8 :' positioning text label
print win, msg$ :' printing text label
endif

RETURN 

But I am not very happy with the way I solve the calculation of needed length for the label box .
The line in question is this:

Code Select
RoundRect(hdc, left+12,top-8, (left+12+(message_length*8)), top+9, 5, 7) :' label border

As you can see by running my code, this is not an ideal solution.

I expect there is a way to calulate the length of the label box in pixels, and that is taking care of different fonts and sizes. But just now I am not able to figure it out.
Can anyone lead me into the right direction, please?
Support Amateur Radio  -  Have a ham  for dinner!

sapero

Hello,
GetTextExtentPoint32 should return the width and height of text, in pixels:

Code Select
type SIZE
def cx:int
def cy:int
endtype

declare "gdi32", GetTextExtentPoint32A(hdc:int, lpString:string, cbString:int, lpSize:SIZE),int

' demo
def s:SIZE

hdc = GetHDC(win)
GetTextExtentPoint32A(hdc, "hello", len("hello"), s)
' s.cx is the width of string
RELEASEHDC(win,hdc)

Egil

November 23, 2010, 07:47:16 am #2 Last Edit: November 23, 2010, 07:57:30 am by Egil
Hi Sapero!
Thanks for the solution. I only wished I had half of your programming knowledge......

Here is the corrected version, the boxed text labels now are self dimensioning.

Code Select
' gbox-03.cba
AUTODEFINE "OFF"

type SIZE
def cx:int
def cy:int
endtype

declare "gdi32", GetTextExtentPoint32A(hdc:int, lpString:string, cbString:int, lpSize:SIZE),int
DECLARE "gdi32.dll",RoundRect(hdc As int, X1 As int, Y1 As int, X2 As int, Y2 As int, X3 As int, Y3 As int) As int
DECLARE gbox(x:int,y:int,w:int,h:int,msg$:string)

DEF win:window
def run:int

WINDOW win,0,0,640,480,@MINBOX|@MAXBOX|@SIZE,0,"- Main -",main
drawmode win,@TRANSPARENT

gbox(25,30,175,100,"  gbox1  ")
gbox(210,150,175,60,"  gbox2  ")
gbox(250,30,175,30,"  gbox3  ")
gbox(50,300,375,50,"  Creative Basic rules  ")

move win, 100,230
print win, "default colors retained outside the boxes"

run = 1
waituntil run = 0
closewindow win
end

sub main
select @class
case @idclosewindow
run=0
case @IDCREATE
CenterWindow win
endselect
return

'
'--------------------------------------------------------------------
' CB Groupbox - modified version
'
SUB gbox(x,y,w,h,msg$)
def message_length,message_height,left,top,right,bottom,hdc:int
left   = x
top    = y
right  = x+w
bottom = y+h
def s:SIZE

hdc = GetHDC win
RoundRect(hdc, x,y, right, bottom, 9, 9) :' rounded box
RELEASEHDC(win,hdc)
FLOODFILL win, x+2, y+2, RGB(rnd(255),rnd(255),rnd(255)) :' background colour

if msg$ <> ""
hdc = GetHDC(win)
GetTextExtentPoint32A(hdc, msg$, len(msg$), s)
' s.cx is the width of string
message_length = s.cx
message_height = s.cy
RELEASEHDC(win,hdc)
hdc = GetHDC win
RoundRect(hdc, left+12,top-(message_height/2)+1, (left+12+(message_length)), top+(message_height/2)+1, 5, 7) :' label border
RELEASEHDC(win,hdc)
FLOODFILL win, left+14, top-6, RGB(rnd(255),rnd(255),rnd(255)) :' background colour
move win, left+12,top-(message_height/2) :' positioning text label
print win, msg$ :' printing text label
endif

RETURN 


And if anyone has wondered why this is one of the first lines i the code: drawmode win,@TRANSPARENT , try to take the line away...

Support Amateur Radio  -  Have a ham  for dinner!

GWS

Nice one Egil ..  :)

I've been experimenting a bit, and I think it can be simplified a bit using just the inbuilt 'GETTEXTSIZE' function rather than the API call ..

Code Select

' gbox-03.cba
AUTODEFINE "OFF"

type SIZE
def cx:int
def cy:int
endtype

'declare "gdi32", GetTextExtentPoint32A(hdc:int, lpString:string, cbString:int, lpSize:SIZE),int
DECLARE "gdi32.dll",RoundRect(hdc As int, X1 As int, Y1 As int, X2 As int, Y2 As int, X3 As int, Y3 As int) As int
DECLARE gbox(x:int,y:int,w:int,h:int,msg$:string)

DEF win:window
def run:int

WINDOW win,0,0,640,480,@MINBOX|@MAXBOX|@SIZE,0,"- Main -",main
drawmode win,@TRANSPARENT
setwindowcolor win,rgb(100,250,240)

gbox(25,30,175,100,"  gbox1  ")
gbox(210,150,175,60,"  gbox2  ")
gbox(250,30,175,30,"  gbox3  ")
gbox(50,300,375,50,"  Creative Basic rules  ")

move win, 100,230
print win, "default colors retained outside the boxes"

run = 1
waituntil run = 0
closewindow win
end

sub main
select @class
case @idclosewindow
run=0
case @IDCREATE
CenterWindow win
endselect
return

'
'--------------------------------------------------------------------
' CB Groupbox - modified version
'
SUB gbox(x,y,w,h,msg$)
def message_length,message_height,left,top,right,bottom,hdc:int
left   = x
top    = y
right  = x+w
bottom = y+h
def s:SIZE

hdc = GetHDC win
RoundRect(hdc, x,y, right, bottom, 9, 9) :' rounded box
RELEASEHDC(win,hdc)
FLOODFILL win, x+2, y+2, RGB(rnd(255),rnd(255),rnd(255)) :' background colour

if msg$ <> ""

'*****************************************

' hdc = GetHDC(win)
' GetTextExtentPoint32A(hdc, msg$, len(msg$), s)
' s.cx is the width of string

def textwidth,textheight:int
GETTEXTSIZE win, msg$, textWidth, textHeight
message_length = textwidth
message_height = textheight

' message_length = s.cx
' message_height = s.cy
' RELEASEHDC(win,hdc)

'*****************************************

hdc = GetHDC win
RoundRect(hdc, left+12,top-(message_height/2)+1, (left+12+(message_length)), top+(message_height/2)+1, 5, 7) :' label border
RELEASEHDC(win,hdc)
FLOODFILL win, left+14, top-6, RGB(rnd(255),rnd(255),rnd(255)) :' background colour
move win, left+12,top-(message_height/2) :' positioning text label
print win, msg$ :' printing text label
endif

RETURN


That seems to work just as well.

all the best, :)

Graham
Tomorrow may be too late ..

Egil

Hi Graham!

Well, I don't know what to say... I tried GETTEXTSIZE first, but couldn't get it to work. But your code made me check that file again now.
The first ting I notice, is a big fat typo!!! Dont understand why I didn't see it before.
But this only verifies what I said in another  thread here on the forum, that CB always responds to errors made by myself.... hehe.
Going to use this sub in the radio controller program I mentioned earlier, for fast checking of parameter settings, and maybe customized error messages. I know there are other ways to do just that, but I do it this way just to learn.

All the best!  :D
Support Amateur Radio  -  Have a ham  for dinner!

Egil

Here is the final version of my gbox subroutine. Instuctions and a small test program are included.
And as always, a big thank you to Sapero and GWS for all help and suggestions.

Have fun!

Egil

Code Select
' gbox.cba
AUTODEFINE "OFF"

' Declares for gbox sub:
DECLARE "gdi32.dll",RoundRect(hdc As int, X1 As int, Y1 As int, X2 As int, Y2 As int, X3 As int, Y3 As int) As int
DECLARE gbox(x:int,y:int,w:int,h:int,br:int,bg:int,bb:int,msg$:string,lr:int,lg:int,lb:int)


'--- Test program -------------------------------------------------------
'
DEF win:window
def run:int

WINDOW win,0,0,640,480,@MINBOX|@MAXBOX|@SIZE,0,"GBOX Demo",main
drawmode win,@TRANSPARENT
setwindowcolor win, rgb(100,250,250)

gbox(25,30,175,100,96,192,240," GBOX1 ",255,255,128)
gbox(210,150,175,60,192,192,240," gbox2 ",255,128,128)
gbox(250,30,175,30,148,201,201," gbox3 ",204,204,152)

SETFONT win, "Comic Sans MS", 24, 700, @SFITALIC
gbox(50,240,475,150,255,222,186," Creative Basic rules ",196,255,0)

run = 1
waituntil run = 0
closewindow win
end

'
SUB main
select @class
case @idclosewindow
run=0
case @IDCREATE
CenterWindow win
endselect
RETURN
'--- End of test program ------------------------------------------------

'
'------------------------------------------------------------------------
' Draw colored box with rounded corners
' Adds self dimensioning text labels with border if label text is supplied
'
' Parameters:
' x, y: Upper left corner of rounded box
'    h: Box height
' w: Box with
'   br: Box RED value
'   bg: Box GREEN value
'   bb: Box BLUE value
'     msg$: Label text string - use "" if no label
'   lr: Label RED value for label
'   lg: Label GREEN value
'   lb: Label BLUE value
'
' Note: To change radius of the rounded corners, change the values
' of the last two parameters in the RoundRect call to suit
' your needs.
'------------------------------------------------------------------------
'
SUB gbox(x,y,w,h,br,bg,bb,msg$,lr,lg,lb)
def left,top,right,bottom,hdc:int
def textwidth,textheight:int
left   = x
top    = y
right  = x+w
bottom = y+h

hdc = GetHDC win
RoundRect(hdc, x,y, right, bottom, 9, 9) :' draw rounded box
RELEASEHDC(win,hdc)
FLOODFILL win, x+2, y+2, RGB(br,bg,bb) :' background colour

if msg$ <> "" :' text label exists?
GETTEXTSIZE win, msg$, textwidth, textheight :' label dimensions
hdc = GetHDC win
RoundRect(hdc, left+12,top-(textheight/2), (left+12+(textwidth)), top+(textheight/2)+2, 5, 7) :' draw label border
RELEASEHDC(win,hdc)
FLOODFILL win, left+14, top-6, RGB(lr,lg,lb) :' text label background colour
move win, left+12,top-(textheight/2) :' positioning text label
print win, msg$ :' printing text label
endif
RETURN

Support Amateur Radio  -  Have a ham  for dinner!

GWS

It looks very nice now Egil .. yet another tool for my 'keepers' folder ..  ;D

best wishes, :)

Graham
Tomorrow may be too late ..

Egil

I did som experiments with the rounded corner arc radiuses, and discovered that the floodfill statements failed with large values.  Now the startposition for FLOODFILL is the excact center of gthe boxes, and the problem is gone.
Here is the corrected version:
Code Select
SUB gbox(x,y,w,h,br,bg,bb,msg$,lr,lg,lb)
def hdc:int
def textwidth,textheight:int

hdc = GetHDC win
RoundRect(hdc, x,y, x+w, y+h, 9, 9)                :' draw rounded box
RELEASEHDC(win,hdc)
FLOODFILL win, x+(w/2), y+(h/2), RGB(br,bg,bb)                :' background colour

if msg$ <> "" :' text label exists?
GETTEXTSIZE win, msg$, textwidth, textheight :' label dimensions
hdc = GetHDC win
RoundRect(hdc, x+12,y-(textheight/2), (x+12+(textwidth)), y+(textheight/2)+2, 5, 7) :' draw label border
RELEASEHDC(win,hdc)
FLOODFILL win, x+12+(textwidth/2), y, RGB(lr,lg,lb) :' text label background colour
move win, x+12,y-(textheight/2) :' positioning text label
print win, msg$ :' printing text label
endif
RETURN


Have fun!

Egil
Support Amateur Radio  -  Have a ham  for dinner!