Becose CBasic cant draw round rectangle directly
i try with API function but dont work
i need litlle help !!!
'how draw Round Rectangle with API function
DEF win:window
def hendle:int
Declare "gdi32",RoundRect(hdc As int, X1 As int, Y1 As int, X2 As int, Y2 As int, X3 As int, Y3 As int) As int
WINDOW win,0,0,350,350,@MINBOX|@MAXBOX|@SIZE,0,"Main-",main
retval()
'VB example
'retval = RoundRect(hdc, 25, 30, 100, 50, 10, 5) :' draw the rectangle
run = 1
waituntil run = 0
closewindow win
end
sub main
select @class
case @idclosewindow
run=0
case @IDCREATE
CenterWindow win
endselect
return
SUB retval
def hdc:int
handle = GetHDC win
RoundRect(win, 25, 30, 100, 50, 5, 5)
' draw the rectangle
return
You need to release the device context, and pass the DC NOT the window. The API knows knothing about CBasic windows.
SUB retval
def hdc:int
handle = GetHDC win
RoundRect(handle, 25, 30, 100, 50, 5, 5)
' draw the rectangle
ReleaseHDC win, handle
return
Thank you mr.Paul,now is OK.
QuoteCBasic cant draw round rectangle directly
CBasic can do anything .. ;D
def win:window
def rwid,rhgt,rthick,rrad,cbord,cfill:int
declare rrect(left:int,top:int,width:int,height:int,border:int,fill:int,radius:int,thick:int)
window win,0,0,550,450,@MINBOX|@MAXBOX|@SIZE,0,"Main",main
centerwindow win
setwindowcolor win,rgb(150,180,250)
for i = 1 to 6
'rrect(50,50,100,50,0xff0000,0xaaaaaa,15,1)
rrad = rnd(10)+5
rthick = rnd(5)+1
do:rwid = rnd(200)+50:until (rwid > 2*rrad)
do:rhgt = rnd(100)+30:until (rhgt > 2*rrad)
cbord = rgb(rnd(250),rnd(250),rnd(250))
cfill = rgb(rnd(250),rnd(250),rnd(250))
rrect(rnd(400),rnd(300),rwid,rhgt,cbord,cfill,rrad,rthick
next i
run = 1
waituntil run = 0
closewindow win
end
sub main
select @class
case @idclosewindow
run=0
case @idcreate
centerwindow win
endselect
return
sub rrect(left,top,width,height,border,fill,radius,thick)
' draw a rounded rectangle ..
setlinestyle win,@lssolid,thick
' top,bottom, and side lines
line win,left+radius,top,left+width-radius,top,border
line win,left+radius,top+height,left+width-radius,top+height,border
line win,left,top+radius,left,top+height-radius,border
line win,left+width-1,top+radius,left+width-1,top+height-radius,border
' draw corner circles ..
circle win,left+radius,top+radius,radius,border
circle win,left+width-radius,top+radius,radius,border
circle win,left+radius,top+height-radius,radius,border
circle win,left+width-radius,top+height-radius,radius,border
' draw erasing corner circles ..
circle win,left+radius,top+radius,radius-thick,fill,fill
circle win,left+width-radius,top+radius,radius-thick,fill,fill
circle win,left+radius,top+height-radius,radius-thick,fill,fill
circle win,left+width-radius,top+height-radius,radius-thick,fill,fill
' draw erasing rectangles ..
rect win,left+thick,top+radius,width-2*thick,height-2*radius,fill,fill
rect win,left+radius,top+thick,width-2*radius,radius,fill,fill
rect win,left+radius,top+height-radius-thick+1,width-2*radius,radius,fill,fill
' fill in the corners ..
floodfill win, left+radius/2, top+radius/2,fill
floodfill win, left+width-radius/2, top+radius/2,fill
floodfill win, left+radius/2, top+height-radius/2,fill
floodfill win, left+width-radius/2, top+height-radius/2,fill
return
all the best, :)
Graham
Here's a slight more sedate version - 'er well sort of .. my programs get bit exhuberant .. ::)
def win:window
def thick,rad,border,fill:int
def left,top,width,height:int
def twopi,th:float
def red,grn,blu:int
declare rrect(left:int,top:int,width:int,height:int,border:int,fill:int,radius:int,thick:int)
window win,0,0,400,300,@MINBOX|@MAXBOX|@SIZE,0,"Main",main
centerwindow win
setwindowcolor win,rgb(0,0,100)
twopi = 8 * atan(1)
starttimer win,100
width = 150
left = (400-150)/2
top = 100
height = 80
rad = 15
thick = 2
fill = 0x999999
border = 0xff0000
control win,"T,CBasic,left+thick,top+rad,width-2*thick,height-2*rad,@cteditcenter|0x200,1"
setfont win,"Arial",20,600,@SFITALIC,1
rrect(left,top,width,height,border,fill,rad,thick)
run = 1
waituntil run = 0
stoptimer win
closewindow win
end
sub main
select @class
case @idclosewindow
run=0
case @idcreate
centerwindow win
case @idtimer
rrect(left,top,width,height,border,fill,rad,thick)
endselect
return
sub rrect(left,top,width,height,border,fill,radius,thick)
' draw a rounded rectangle ..
setlinestyle win,@lssolid,thick
' top,bottom, and side lines
line win,left+radius,top,left+width-radius,top,border
line win,left+radius,top+height,left+width-radius,top+height,border
line win,left,top+radius,left,top+height-radius,border
line win,left+width-1,top+radius,left+width-1,top+height-radius,border
' draw corner circles ..
circle win,left+radius,top+radius,radius,border
circle win,left+width-radius,top+radius,radius,border
circle win,left+radius,top+height-radius,radius,border
circle win,left+width-radius,top+height-radius,radius,border
' draw erasing corner circles ..
circle win,left+radius,top+radius,radius-thick,fill,fill
circle win,left+width-radius,top+radius,radius-thick,fill,fill
circle win,left+radius,top+height-radius,radius-thick,fill,fill
circle win,left+width-radius,top+height-radius,radius-thick,fill,fill
' draw erasing rectangles ..
rect win,left+thick,top+radius,width-2*thick,height-2*radius,fill,fill
rect win,left+radius,top+thick,width-2*radius,radius,fill,fill
rect win,left+radius,top+height-radius-thick+1,width-2*radius,radius,fill,fill
' fill in the corners ..
floodfill win, left+radius/2, top+radius/2,fill
floodfill win, left+width-radius/2, top+radius/2,fill
floodfill win, left+radius/2, top+height-radius/2,fill
floodfill win, left+width-radius/2, top+height-radius/2,fill
' slowly change the text color ..
th = th + 0.04
red = 127.5 * (1 + cos(th))
grn = 127.5 * (1 + cos(th + twopi/3))
blu = 127.5 * (1 + cos(th + 2 * twopi/3))
setcontrolcolor win,1,rgb(red,grn,blu),fill
return
best wishes, :)
Graham
wow cool,thanks GWS.!
may i ask you some?
how change frontpen without frontpen command
also with API or something else
thanks...
i forget becose frontpen no efect on API drawed
The text color is set for the TextBox control in the:
setcontrolcolor win,1,rgb(red,grn,blu),fill
statement .. :)
Graham
you are not understund my question becose my enlish is bad.
i ask you how imitate FRONTPEN command with API function
if this exists
like
selectpen r g b
something like that?
See the CreatePen windows API function. Drawing with the API isn't as straightforward as we make it in EB. Using the API you select and deslect objects out of a windows device context.
Paul.
Thanks again mr.Paul .I will tray use
API for drawing becose some integrated grafics card
dont draw simple drwing objects and not recognized
Frontpen command properly or maby becose use RAM
for memory.
Then the API wouldnt work for you either as the frontpen command calls CreatePen and SetTextColor.
OK.