Agregar un botón a la barra de título del formulario

Agregar un boton a la barra de titulo del formulario

Agregar un boton a la barra de titulo del formulario : Multi-millones de consejos para hacer su vida mas facil.

Añadir un boton a la barra de titulo del formulario
he creado un componente que permite agregar botones a la barra de titulo del formulario. Aqui esta el codigo.
& & & & Codigo & & & & __
unidad de TitleButton
interfaz
usos
& nbsp & nbsp Windows, Messages, SysUtils, Classes, Graphics, Controles, Formularios, cuadros de dialogo
const
& nbsp WM_MOUSELEAVE=$B014
tipo
& nbsp TChangedProperty=(cpdown,cpallowallup,cpgroupindex)
tipo
& nbsp & nbsp TTitleButton = clase(Tcomponent)
& nbsp & nbsp privada
& nbsp & nbsp & nbsp fbuttonrect:trect
& nbsp & nbsp & nbsp fpressed,ffocused:boolean
& nbsp & nbsp & nbsp fbuttoncaption:string
& nbsp & nbsp & nbsp fwidth:integer
& nbsp & nbsp & nbsp fleft:integer
& nbsp & nbsp & nbsp fvisible:boolean
& nbsp & nbsp & nbsp fhintshow:boolean
& nbsp & nbsp & nbsp fhint:thintwindow
& nbsp & nbsp & nbsp fhinttext:string
& nbsp & nbsp & nbsp fgroupindex:integer
& nbsp & nbsp & nbsp fdown:boolean
& nbsp & nbsp & nbsp fallowallup:boolean
& nbsp & nbsp & nbsp fparent:Tform
& nbsp & nbsp & nbsp fparentwidth:integer
& nbsp & nbsp & nbsp ficonwidth:integer
& nbsp & nbsp & nbsp fcallinheritedevent:boolean
& nbsp & nbsp & nbsp fdefaultwidth:integer
& nbsp & nbsp & nbsp fdefaultheight:integer
& nbsp & nbsp & nbsp ffont:Tfont
& nbsp & nbsp & nbsp ficon:Ticon
& nbsp & nbsp & nbsp fborder3d,fborderthickness:integer
& nbsp & nbsp & nbsp fbuttondown:tnotifyevent
& nbsp & nbsp & nbsp fbuttonmove:tmousemoveevent
& nbsp & nbsp & nbsp fbuttonup:tnotifyevent
& nbsp & nbsp & nbsp pmsghandler:Twndmethod
& nbsp & nbsp & nbsp ppaint:Tnotifyevent
& nbsp & nbsp & nbsp presize:tnotifyevent
& nbsp & nbsp & nbsp gtmp1,gtmp2,gtmp3:boolean
& nbsp & nbsp & nbsp procedimiento initializevariables
& nbsp & nbsp & nbsp procedimiento IconChange(Sender:tobject)
& nbsp & nbsp & nbsp procedimiento setbuttonwidth(awidth:integer)
& nbsp & nbsp & nbsp procedimiento setbuttonleft(aleft:integer)
& nbsp & nbsp & nbsp procedimiento setbuttoncaption(acaption:string)
& nbsp & nbsp & nbsp procedimiento setbuttonfont(afont:tfont)
& nbsp & nbsp & nbsp procedimiento setbuttonvisible(avisible:boolean)
& nbsp & nbsp & nbsp procedimiento seticon(aicon:ticon)
& nbsp & nbsp & nbsp procedimiento setdown(adown:boolean)
& nbsp & nbsp & nbsp procedimiento setallowallup(aallowallup:boolean)
& nbsp & nbsp & nbsp procedimiento setgroupindex(agroupindex:integer)
& nbsp & nbsp & nbsp procedimiento UpdateProperties(achangedproperty:TChangedProperty)
& nbsp & nbsp protegido
& nbsp & nbsp & nbsp procedimiento messagehandler(var msg:tmessage)
& nbsp & nbsp & nbsp procedimiento CaptionPaint(var msg:tmessage)
& nbsp & nbsp & nbsp procedimiento CaptionMouseMove(var msg:tmessage)
& nbsp & nbsp & nbsp procedimiento CaptionMouseDown(var msg:tmessage)
& nbsp & nbsp & nbsp procedimiento CaptionMouseUp(var msg:tmessage)
& nbsp & nbsp & nbsp procedimiento CaptionRightMouseDown(var msg:tmessage)
& nbsp & nbsp & nbsp procedimiento CaptionDoubleClick(var msg:tmessage)
& nbsp & nbsp & nbsp procedimiento CaptionActivate(var msg:tmessage)
& nbsp & nbsp & nbsp procedimiento CaptionHitTest(var msg:Tmessage)
& nbsp & nbsp & nbsp procedimiento CaptionChange(var msg:Tmessage)
& nbsp & nbsp & nbsp procedimiento ParentMouseMove(var msg:tmessage)
& nbsp & nbsp & nbsp procedimiento ParentMouseUp(var msg:tmessage)
& nbsp & nbsp & nbsp procedimiento ButtonUp(var msg:tmessage)
& nbsp & nbsp & nbsp procedimiento ParentPaint(sender:tobject)
& nbsp & nbsp & nbsp procedimiento ParentResize(sender:tobject)
& nbsp & nbsp & nbsp procedimiento DisplaySettingChange(var msg:tmessage)
& nbsp & nbsp & nbsp procedimiento de carga reemplazar
& nbsp & nbsp publica
& nbsp & nbsp & nbsp constructor create(aowner:tcomponent) reemplazar
& nbsp & nbsp & nbsp destructor destruir reemplazar
& nbsp & nbsp publicado
& nbsp & nbsp & nbsp propiedad Width:entero leer fwidth escribir setbuttonwidth
& nbsp & nbsp & nbsp propiedad Position:entero leer fleft escribir setbuttonleft
& nbsp & nbsp & nbsp propiedad Caption:cadena de leer fbuttoncaption escribir setbuttoncaption
& nbsp & nbsp & nbsp propiedad de la Fuente:Tfont leer ffont escribir SetButtonFont
& nbsp & nbsp & nbsp Icono de propiedades:Ticon leer ficon escribir seticon
& nbsp & nbsp & nbsp propiedad TipText:cadena de leer fhinttext escribir fhinttext
& nbsp & nbsp & nbsp propiedad Visible:boolean leer fvisible escribir setbuttonvisible
& nbsp & nbsp & nbsp propiedad AllowAllUp:boolean leer fallowallup escribir setallowallup
& nbsp & nbsp & nbsp propiedad de Abajo:boolean leer fdown escribir setdown
& nbsp & nbsp & nbsp propiedad GroupIndex:entero leer fgroupindex escribir setgroupindex
& nbsp & nbsp & nbsp propiedad OnMouseDown:tnotifyevent leer fbuttondown escribir fbuttondown
& nbsp & nbsp & nbsp propiedad OnMouseMove:tmousemoveevent leer fbuttonmove escribir fbuttonmove
& nbsp & nbsp & nbsp propiedad OnMouseUp:tnotifyevent leer fbuttonup escribir fbuttonup
& nbsp & nbsp final
const
& nbsp TTB_SETBUTTONUP=WM_USER 1
procedimiento de Registro
aplicacion
constructor TTitleButton.create(aowner:tcomponent)
begin
& nbsp heredado
& nbsp & nbsp fparent:=(propietario como tform)
& nbsp & nbsp ffont:=tfont.crear
& nbsp & nbsp fhint:=thintwindow.create(self)
& nbsp & nbsp ficon:=ticon.crear
fin
destructor TTitleButton.destruir
begin
& nbsp si se ha asignado(ficon), a continuacion,
& nbsp & nbsp ficon.libre
& nbsp si se ha asignado(ffont), a continuacion,
& nbsp & nbsp ffont.libre
& nbsp si se ha asignado(fhint), a continuacion,
& nbsp & nbsp fhint.libre
& nbsp heredado
fin
procedimiento TTitleButton.carga
begin
& nbsp heredado
& nbsp initializevariables
fin
procedimiento TTitleButton.UpdateProperties(achangedproperty:TChangedProperty)
var
& nbsp amsg:tmessage
begin
& nbsp amsg.Msg:=TTB_SETBUTTONUP
& nbsp amsg.WParam:=integer(auto)
& nbsp amsg.LParamlo:=fgroupindex
& nbsp amsg.LParamHi:=palabra(achangedproperty)
& nbsp amsg.Resultado:=0
& nbsp fparent.realizar(amsg.msg,amsg.wparam,amsg.lparam)
fin
procedimiento TTitleButton.initializevariables
begin
& nbsp si se ha asignado(fparent.WindowProc), a continuacion,
& nbsp & nbsp pmsghandler:=fparent.WindowProc
& nbsp fparent.WindowProc:=messagehandler
& nbsp si no(csdesigning en componentstate), a continuacion,
& nbsp & nbsp empezar
& nbsp & nbsp & nbsp si se ha asignado(fparent.onpaint), a continuacion,
& nbsp & nbsp & nbsp & nbsp ppaint:=fparent.onpaint
& nbsp & nbsp & nbsp si se ha asignado(fparent.onresize), a continuacion,
& nbsp & nbsp & nbsp & nbsp presize:=fparent.onresize
& nbsp & nbsp & nbsp fparent.onpaint:=parentpaint
& nbsp & nbsp & nbsp fparent.onresize:=parentresize
& nbsp final
& nbsp fparentwidth:=fparent.anchura
& nbsp zeromemory(@fbuttonrect,sizeof(fbuttonrect))
& nbsp fpressed:=false
& nbsp ffocused:=false
& nbsp fhintshow:=false
& nbsp ficonwidth:=16
& nbsp ficon.Transparente:=true
& nbsp ficon.OnChange:=IconChange
& nbsp fhint.Color:=clInfoBk
& nbsp fcallinheritedevent:=false
& nbsp fdefaultwidth:=GetSystemMetrics(SM_CXSIZE)
& nbsp si fwidth
& nbsp & nbsp fwidth:=fdefaultwidth
& nbsp fdefaultheight:=GetSystemMetrics(SM_CYSIZE)
& nbsp fborder3d:=GetSystemMetrics(SM_CYEDGE)
& nbsp fborderthickness:=GetSystemMetrics(SM_CYSIZEFRAME)
& nbsp gtmp3:=false
fin
procedimiento TTitleButton.IconChange(Sender:tobject)
begin
& nbsp parentpaint(fparent)
fin
procedimiento TTitleButton.messagehandler(var msg:tmessage)
begin
& nbsp si csdesigning en componentstate, a continuacion,
& nbsp & nbsp empezar
& nbsp & nbsp & nbsp si msg.Msg=TTB_SETBUTTONUP, a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp ButtonUp(msg)
& nbsp & nbsp & nbsp & nbsp & nbsp si (asignado(pmsghandler)) y (fcallinheritedevent), a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pmsghandler(msg)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp else
& nbsp & nbsp & nbsp & nbsp pmsghandler(msg)
& nbsp & nbsp final
& nbsp else
& nbsp & nbsp empezar
& nbsp & nbsp & nbsp si msg.Msg=WM_NCPAINT, a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp CaptionPaint(msg)
& nbsp & nbsp & nbsp & nbsp & nbsp si (asignado(pmsghandler)) y (fcallinheritedevent), a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pmsghandler(msg)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp cosa si msg.Msg=WM_NCLBUTTONDOWN, a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp CaptionMouseDown(msg)
& nbsp & nbsp & nbsp & nbsp & nbsp si (asignado(pmsghandler)) y (fcallinheritedevent), a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pmsghandler(msg)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp cosa si msg.Msg=WM_NCMOUSEMOVE, a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp CaptionMouseMove(msg)
& nbsp & nbsp & nbsp & nbsp & nbsp si (asignado(pmsghandler)) y (fcallinheritedevent), a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pmsghandler(msg)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp cosa si msg.Msg=WM_NCLBUTTONUP, a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp CaptionMouseUp(msg)
& nbsp & nbsp & nbsp & nbsp & nbsp si (asignado(pmsghandler)) y (fcallinheritedevent), a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pmsghandler(msg)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp cosa si msg.Msg=WM_NCACTIVATE, a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp CaptionActivate(msg)
& nbsp & nbsp & nbsp & nbsp & nbsp si (asignado(pmsghandler)) y (fcallinheritedevent), a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pmsghandler(msg)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp cosa si msg.Msg=WM_NCHITTEST, a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp CaptionHitTest(msg)
& nbsp & nbsp & nbsp & nbsp & nbsp si (asignado(pmsghandler)) y (fcallinheritedevent), a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pmsghandler(msg)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp cosa si msg.Msg=WM_LBUTTONUP, a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp ParentMouseUp(msg)
& nbsp & nbsp & nbsp & nbsp & nbsp si (asignado(pmsghandler)) y (fcallinheritedevent), a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pmsghandler(msg)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp cosa si msg.Msg=WM_MOUSEMOVE, a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp ParentMouseMove(msg)
& nbsp & nbsp & nbsp & nbsp & nbsp si (asignado(pmsghandler)) y (fcallinheritedevent), a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pmsghandler(msg)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp cosa si msg.Msg=WM_NCRBUTTONDOWN, a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp CaptionRightMouseDown(msg)
& nbsp & nbsp & nbsp & nbsp & nbsp si (asignado(pmsghandler)) y (fcallinheritedevent), a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pmsghandler(msg)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp cosa si msg.Msg=WM_NCLBUTTONDBLCLK, a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp CaptionDoubleClick(msg)
& nbsp & nbsp & nbsp & nbsp & nbsp si (asignado(pmsghandler)) y (fcallinheritedevent), a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pmsghandler(msg)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp cosa si msg.Msg=WM_NCLBUTTONDBLCLK, a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp CaptionDoubleClick(msg)
& nbsp & nbsp & nbsp & nbsp & nbsp si (asignado(pmsghandler)) y (fcallinheritedevent), a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pmsghandler(msg)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp cosa si msg.Msg=WM_SETTEXT, a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp CaptionChange(msg)
& nbsp & nbsp & nbsp & nbsp & nbsp si (asignado(pmsghandler)) y (fcallinheritedevent), a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pmsghandler(msg)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp cosa si msg.Msg=WM_SETTINGCHANGE, a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp DisplaySettingChange(msg)
& nbsp & nbsp & nbsp & nbsp & nbsp si (asignado(pmsghandler)) y (fcallinheritedevent), a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pmsghandler(msg)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp cosa si msg.Msg=TTB_SETBUTTONUP, a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp ButtonUp(msg)
& nbsp & nbsp & nbsp & nbsp & nbsp si (asignado(pmsghandler)) y (fcallinheritedevent), a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pmsghandler(msg)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp cosa si msg.Msg=WM_MOUSELEAVE, a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp fhint.ReleaseHandle
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp pmsghandler(msg)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp else
& nbsp & nbsp & nbsp & nbsp pmsghandler(msg)
& nbsp final
fin
procedimiento TTitleButton.CaptionPaint(var msg:tmessage)
begin
& nbsp fcallinheritedevent:=true
& nbsp si fvisible=false then
& nbsp & nbsp salida
& nbsp funcion invalidaterect(fparent.manejar,@fbuttonrect,false)
fin
procedimiento TTitleButton.CaptionMouseMove(var msg:tmessage)
var
& nbsp pt:tpoint
& nbsp tmpstate:tshiftstate
& nbsp fhintwidth:integer
begin
& nbsp fcallinheritedevent:=true
& nbsp si fvisible=false then
& nbsp & nbsp salida
& nbsp gtmp1:=fpressed
& nbsp gtmp2:=ffocused
& nbsp pt.x:=msg.LParamLo-fparent.a la izquierda
& nbsp pt.y:=msg.LParamHi-fparent.la parte superior
& nbsp si PtInRect(fbuttonrect,pt), a continuacion,
& nbsp & nbsp empezar
& nbsp & nbsp & nbsp ffocused:=true
& nbsp & nbsp & nbsp fhintwidth:=fhint.El lienzo.TextWidth(fhinttext)
& nbsp & nbsp & nbsp si (fhintshow=false) y longitud(trim(fhinttext))<>0) entonces
& nbsp & nbsp & nbsp & nbsp fhint.ActivateHint(rect(de raton.cursorpos.x,mouse.cursorpos.y 10 del raton.cursorpos.x fhintwidth 7 de raton.cursorpos.y 25),fhinttext)
& nbsp & nbsp & nbsp fhintshow:=true
& nbsp & nbsp & nbsp si se ha asignado(fbuttonmove), a continuacion,
& nbsp & nbsp & nbsp & nbsp fbuttonmove(fparent,tmpstate,pt.x,pt.y)
& nbsp & nbsp final
& nbsp else
& nbsp & nbsp empezar
& nbsp & nbsp & nbsp ffocused:=false
& nbsp & nbsp & nbsp fhint.ReleaseHandle
& nbsp & nbsp & nbsp fhintshow:=false
& nbsp & nbsp final
& nbsp fcallinheritedevent:=true
fin
procedimiento TTitleButton.CaptionMouseDown(var msg:tmessage)
var
& nbsp pt:tpoint
& nbsp tmp1:boolean
& nbsp callevent:boolean
begin
& nbsp callevent:=false
& nbsp fcallinheritedevent:=true
& nbsp si fvisible=false then
& nbsp & nbsp salida
& nbsp fhintshow:=false
& nbsp fhint.releasehandle
& nbsp setforegroundwindow(fparent.el asa)
& nbsp tmp1:=fpressed
& nbsp pt.x:=msg.LParamLo-fparent.a la izquierda
& nbsp pt.y:=msg.LParamhi-fparent.la parte superior
& nbsp si ptinrect(fbuttonrect,pt), a continuacion,
& nbsp & nbsp empezar
& nbsp & nbsp & nbsp gtmp3:=true
& nbsp & nbsp & nbsp si fgroupindex=0, entonces
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp callevent:=true
& nbsp & nbsp - nbsp & nbsp final
& nbsp & nbsp & nbsp else
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp si no(fdown), a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp si se ha asignado(fbuttondown), a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp fbuttondown(fparent)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp fpressed:=true
& nbsp & nbsp & nbsp ffocused:=true
& nbsp & nbsp & nbsp setcapture(fparent.el asa)
& nbsp & nbsp final
& nbsp else
& nbsp & nbsp empezar
& nbsp & nbsp & nbsp fpressed:=false
& nbsp & nbsp & nbsp ffocused:=false
& nbsp & nbsp final
& nbsp si (tmp1<>fpressed), a continuacion,
& nbsp & nbsp fcallinheritedevent:=false
& nbsp gtmp1:=fpressed
& nbsp gtmp2:=ffocused
& nbsp & nbsp parentpaint(fparent)

& nbsp si (callevent) y asignado(fbuttondown), a continuacion,
& nbsp & nbsp fbuttondown(fparent)
fin
procedimiento TTitleButton.CaptionMouseUp(var msg:tmessage)
var
& nbsp pt:Tpoint
& nbsp tmp1,tmp2:boolean
begin
& nbsp fcallinheritedevent:=true
& nbsp si fvisible=false then
& nbsp & nbsp salida
& nbsp releasecapture
& nbsp tmp1:=fpressed
& nbsp tmp2:=ffocused
& nbsp pt.x:=msg.LParamLo-fparent.a la izquierda
& nbsp pt.y:=msg.LParamhi-fparent.la parte superior
& nbsp si (ptinrect(fbuttonrect,pt)) y (ffocused = true) then
& nbsp & nbsp fpressed:=false
& nbsp else
& nbsp & nbsp ffocused:=false
& nbsp if ((tmp1<>fpressed) o (tmp2<>ffocused)) y (fallowallup y fdown), a continuacion,
& nbsp & nbsp funcion invalidaterect(fparent.manejar,@fbuttonrect,true)
& nbsp fcallinheritedevent:=true
fin
procedimiento TTitleButton.CaptionRightMouseDown(var msg:tmessage)
var
& nbsp pt:tpoint
begin
& nbsp fcallinheritedevent:=true
& nbsp si fvisible=false then
& nbsp & nbsp salida
& nbsp fhint.releasehandle
& nbsp pt.x:=msg.LParamlo-fparent.a la izquierda
& nbsp pt.y:=msg.LParamHi-fparent.la parte superior
& nbsp si no ptinrect(fbuttonrect,pt), a continuacion,
& nbsp & nbsp fcallinheritedevent:=true
& nbsp else
& nbsp & nbsp fcallinheritedevent:=false
fin
procedimiento TTitleButton.CaptionDoubleClick(var msg:tmessage)
var
& nbsp pt:tpoint
begin
& nbsp fcallinheritedevent:=true
& nbsp si fvisible=false then
& nbsp & nbsp salida
& nbsp pt.x:=msg.LParamlo-fparent.a la izquierda
& nbsp pt.y:=msg.LParamhi-fparent.la parte superior
& nbsp si no(ptinrect(fbuttonrect,pt)), a continuacion,
& nbsp & nbsp fcallinheritedevent:=true
& nbsp else
& nbsp & nbsp empezar
& nbsp & nbsp & nbsp fcallinheritedevent:=false
& nbsp & nbsp & nbsp fparent.realizar(WM_NCLBUTTONDOWN,msg.wparam,msg.LParam)
& nbsp & nbsp final
fin

procedimiento TTitleButton.CaptionActivate(var msg:tmessage)
begin
& nbsp fcallinheritedevent:=true
& nbsp si no visible, a continuacion,
& nbsp & nbsp salida
& nbsp funcion invalidaterect(fparent.manejar,@fbuttonrect,false)
fin
procedimiento TTitleButton.CaptionHitTest(var msg:Tmessage)
var
& nbsp tmp:boolean
& nbsp pt:tpoint
begin
& nbsp fcallinheritedevent:=true
& nbsp si fvisible=false then
& nbsp & nbsp salida
& nbsp si fpressed, a continuacion,
& nbsp & nbsp empezar
& nbsp & nbsp & nbsp tmp:=ffocused
& nbsp & nbsp & nbsp pt.x:=msg.LParamlo-fparent.a la izquierda
& nbsp & nbsp & nbsp pt.y:=msg.LParamhi-fparent.la parte superior
& nbsp & nbsp & nbsp si ptinrect(fbuttonrect,pt), a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp ffocused:=true
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp else
& nbsp & nbsp & nbsp & nbsp ffocused:=false
& nbsp & nbsp & nbsp & nbsp si ffocused<>tmp, a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp funcion invalidaterect(fparent.manejar,@fbuttonrect,false)
& nbsp & nbsp final
& nbsp si ffocused=false then
& nbsp & nbsp fhint.releasehandle
& nbsp gtmp1:=fpressed
& nbsp gtmp2:=ffocused
& nbsp fcallinheritedevent:=true
fin
procedimiento TTitleButton.CaptionChange(var msg:Tmessage)
begin
& nbsp fcallinheritedevent:=true
& nbsp si no fvisible, a continuacion,
& nbsp & nbsp salida
& nbsp funcion invalidaterect(fparent.manejar,@fbuttonrect,false)
fin
procedimiento TTitleButton.ButtonUp(var msg:tmessage)
var
& nbsp remitente:ttitlebutton
& nbsp tmp:boolean
begin
& nbsp tmp:=fdown
& nbsp fcallinheritedevent:=true
& nbsp remitente:=(tcomponent(msg.WParam) como ttitlebutton)
& nbsp si (remitente<>self) y (msg.LParamLo=fgroupindex), a continuacion,
& nbsp & nbsp empezar
& nbsp & nbsp & nbsp si tchangedproperty(msg.lparamhi)=cpdown, a continuacion,
& nbsp & nbsp & nbsp & nbsp fdown:=false
& nbsp & nbsp & nbsp fallowallup:=remitente.fallowallup
& nbsp & nbsp & nbsp si tmp<>fdown, a continuacion,
& nbsp & nbsp & nbsp & nbsp funcion invalidaterect(fparent.manejar,@fbuttonrect,false)
& nbsp & nbsp final
fin
procedimiento TTitleButton.ParentMouseMove(var msg:tmessage)
var
& nbsp pt:tpoint
& nbsp tmppt:tpoint
& nbsp tmprect:trect
& nbsp tmpstate:Tshiftstate
begin
& nbsp fcallinheritedevent:=true
& nbsp si fvisible=false then
& nbsp & nbsp salida
& nbsp ffocused:=false
& nbsp pt.x:=msg.lparamlo
& nbsp pt.y:=msg.lparamhi-fparent.la parte superior
& nbsp tmppt:=pt
& nbsp tmppt.x:=tmppt.x 4
& nbsp tmppt.y:=65536-tmppt.y-fparent.la parte superior
& nbsp tmprect:=fbuttonrect
& nbsp inflaterect(tmprect,1,1)
& nbsp si ptinrect(tmprect,tmppt), a continuacion,
& nbsp & nbsp empezar
& nbsp & nbsp & nbsp ffocused:=true
& nbsp & nbsp & nbsp si se ha asignado(fbuttonmove), a continuacion,
& nbsp & nbsp & nbsp & nbsp fbuttonmove(fparent,tmpstate,tmppt.x,tmppt.y)
& nbsp & nbsp & nbsp si (gtmp1<>fpressed) o (gtmp2<>ffocused) entonces// si fpressed, a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp funcion invalidaterect(fparent.manejar,@fbuttonrect,false)
& nbsp & nbsp & nbsp & nbsp & nbsp gtmp1:=fpressed
& nbsp & nbsp & nbsp & nbsp & nbsp gtmp2:=ffocused
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp final
& nbsp si (gtmp1<>fpressed) o (gtmp2<>ffocused) a continuacion,
& nbsp & nbsp empezar
& nbsp & nbsp & nbsp funcion invalidaterect(fparent.manejar,@fbuttonrect,false)
& nbsp & nbsp & nbsp gtmp1:=fpressed
& nbsp & nbsp & nbsp gtmp2:=ffocused
& nbsp & nbsp final
& nbsp fhintshow:=false
& nbsp fhint.releasehandle
fin

procedimiento TTitleButton.ParentMouseUp(var msg:tmessage)
var
& nbsp pt:tpoint
& nbsp tmp:tpoint
& nbsp tmprect:trect
& nbsp tmpcallevent:boolean
begin
& nbsp fcallinheritedevent:=true
& nbsp si fvisible=false then
& nbsp & nbsp salida
& nbsp tmpcallevent:=false
& nbsp fhint.ReleaseHandle
& nbsp fhintshow:=true
& nbsp ReleaseCapture
& nbsp fpressed:=false
& nbsp pt.x:=msg.lParamlo
& nbsp pt.y:=msg.lParamhi-fparent.la parte superior
& nbsp tmp:=pt
& nbsp tmp.x:=tmp.x 4
& nbsp tmp.y:=65536-tmp.y
& nbsp tmp.y:=tmp.y-fparent.la parte superior
& nbsp tmprect:=fbuttonrect
& nbsp inflaterect(tmprect,0,2)
& nbsp si tmp.y<(fparent.top fparent.De altura), a continuacion,
& nbsp & nbsp pt:=tmp
& nbsp si (ptinrect(tmprect,pt)) y (ffocused) y (gtmp3) a continuacion,
& nbsp & nbsp empezar
& nbsp & nbsp & nbsp si fgroupindex<>0 then
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp si fallowallup=true
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp fdown:=no(fdown)
& nbsp & nbsp & nbsp & nbsp & nbsp else
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp fdown:=true
& nbsp & nbsp & nbsp & nbsp & nbsp gtmp3:=false
& nbsp & nbsp & nbsp & nbsp & nbsp updateproperties(cpdown)
& nbsp & nbsp & nbsp & nbsp & nbsp si no(fdown) a continuacion,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp tmpcallevent:=true
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp else
& nbsp & nbsp & nbsp & nbsp tmpcallevent:=true
& nbs & nbsp & nbsp parentpaint(fparent)
& nbsp & nbsp & nbsp si (tmpcallevent=true) y asignado(fbuttonup), a continuacion,
& nbsp & nbsp & nbsp & nbsp fbuttonup(fparent)
& nbsp & nbsp final
& nbsp else
& nbsp & nbsp gtmp3:=false
& nbsp fcallinheritedevent:=true
fin
procedimiento TTitleButton.parentpaint(sender:tobject)
var
& nbsp ButtonCanvas:TCanvas
& nbsp textrect:trect
& nbsp iconrect:trect
& nbsp tmpwidth:integer
begin
& nbsp si fvisible=false then
& nbsp & nbsp empezar
& nbsp & nbsp & nbsp si se ha asignado(ppaint)a continuacion,
& nbsp & nbsp & nbsp & nbsp ppaint(remitente)
& nbsp & nbsp & nbsp salida
& nbsp & nbsp final
& nbsp si no(csdesigning en componentstate), a continuacion,
& nbsp & nbsp empezar
& nbsp & nbsp & nbsp si fwidth
& nbsp & nbsp & nbsp & nbsp fwidth:=fdefaultwidth
& nbsp & nbsp & nbsp si fleft=0, entonces
& nbsp & nbsp & nbsp & nbsp fleft:=fwidth 1
& nbsp & nbsp & nbsp fbuttonrect.a la izquierda:=fparent.ancho-fleft-(3*fdefaultwidth)-(fborder3d fborderthickness)
& nbsp & nbsp & nbsp fbuttonrect.derecha:=fbuttonrect.a la izquierda fwidth
& nbsp & nbsp & nbsp fbuttonrect.top:=fborder3d fborderthickness
& nbsp & nbsp & nbsp fbuttonrect.parte inferior:=fbuttonrect.top fdefaultheight-(2*fborder3d)
& nbsp & nbsp & nbsp ButtonCanvas:=tcanvas.Crear
& nbsp & nbsp & nbsp ButtonCanvas.Identificador:=getwindowdc(fparent.el asa)
& nbsp & nbsp & nbsp fillrect(buttoncanvas.Manejar,fbuttonrect,HBRUSH(COLOR_BTNFACE 1))
& nbsp & nbsp & nbsp tmpwidth:=fdefaultheight-2
& nbsp & nbsp & nbsp iconrect.a la izquierda:=fbuttonrect.a la izquierda
& nbsp & nbsp & nbsp iconrect.top:=fbuttonrect.la parte superior
& nbsp & nbsp & nbsp iconrect.derecha:=iconrect.a la izquierda tmpwidth
& nbsp & nbsp & nbsp iconrect.parte inferior:=fbuttonrect.top fdefaultheight-2*fborder3d
& nbsp & nbsp & nbsp si ficon.mango<>0 then
& nbsp & nbsp & nbsp & nbsp subtractrect(textrect,fbuttonrect,iconrect)
& nbsp & nbsp & nbsp else
& nbsp & nbsp & nbsp & nbsp textrect:=fbuttonrect
& nbsp & nbsp & nbsp si (ffocused y fpressed) o fdown, a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp drawedge(ButtonCanvas.Manejar,fbuttonrect,EDGE_SUNKEN,BF_SOFT o BF_RECT)
& nbsp & nbsp & nbsp & nbsp & nbsp textrect.a la izquierda:=textrect.a la izquierda 2
& nbsp & nbsp & nbsp & nbsp & nbsp textrect.Top:=textrect.Top 1
& nbsp & nbsp & nbsp & nbsp & nbsp textrect.derecha:=textrect.derecho-1
& nbsp & nbsp & nbsp & nbsp & nbsp iconrect.a la izquierda:=iconrect.a la izquierda 3
& nbsp & nbsp & nbsp & nbsp & nbsp iconrect.top:=iconrect.top 2
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp si (no(fpressed) o no(ffocused)) y no(fdown), a continuacion,
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp drawedge(ButtonCanvas.Manejar,fbuttonrect,EDGE_RAISED,BF_SOFT o BF_RECT)
& nbsp & nbsp & nbsp & nbsp & nbsp textrect.a la izquierda:=textrect.a la izquierda 1
& nbsp & nbsp & nbsp & nbsp & nbsp textrect.derecha:=textrect.derecho-1
& nbsp & nbsp & nbsp & nbsp & nbsp iconrect.top:=iconrect.top 1
& nbsp & nbsp & nbsp & nbsp & nbsp iconrect.a la izquierda:=iconrect.a la izquierda 2
& nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp ButtonCanvas.Cepillo.Estilo:=bsclear
& nbsp & nbsp & nbsp ButtonCanvas.Fuente.asignar(ffont)
& nbsp & nbsp & nbsp si ficon.Mango<>0 then
& nbsp & nbsp & nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp & nbsp drawiconex(buttoncanvas.manejar,iconrect.a la izquierda 1,iconrect.top 1,ficon.manejar,tmpwidth-5,fdefaultheight-8,0,0,DI_NORMAL)
& nbsp & nbsp & nbsp & nbsp & nbsp si longitud(trim(fbuttoncaption))>0 then
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp DrawTextEx(ButtonCanvas.Manejar,PChar(fButtonCaption),Longitud(fbuttoncaption),textrect,DT_LEFT o DT_SINGLELINE o DT_VCENTER o DT_END_ELLIPSIS o DT_PATH_ELLIPSIS o DT_MODIFYSTRING,nil)
& nbsp & nbsp & nbsp & nbsp final
& nbsp & nbsp & nbsp else
& nbsp & nbsp & nbsp & nbsp DrawText(ButtonCanvas.Manejar,PChar(fButtonCaption),Longitud(fbuttoncaption),textrect,DT_CENTER o DT_SINGLELINE o DT_VCENTER o DT_END_ELLIPSIS o DT_PATH_ELLIPSIS o DT_MODIFYSTRING)
& nbsp & nbsp & nbsp ButtonCanvas.Libre
& nbsp & nbsp & nbsp si se ha asignado(ppaint), a continuacion,
& nbsp & nbsp & nbsp & nbsp ppaint(remitente)
& nbsp & nbsp final
fin
procedimiento TTitleButton.parentresize(sender:tobject)
begin
& nbsp fcallinheritedevent:=true
& nbsp si fvisible=false then
& nbsp & nbsp empezar
& nbsp & nbsp & nbsp si se ha asignado(presize), a continuacion,
& nbsp & nbsp & nbsp & nbsp presize(remitente)
& nbsp & nbsp & nbsp salida
& nbsp & nbsp final
& nbsp parentpaint(remitente)
& nbsp si se ha asignado(presize), a continuacion,
& nbsp & nbsp presize(auto)
fin

procedimiento TTitleButton.DisplaySettingChange(var msg:tmessage)
begin
& nbsp fcallinheritedevent:=true
& nbsp si fvisible=false then
& nbsp & nbsp salida
& nbsp fdefaultwidth:=GetSystemMetrics(SM_CXSIZE)
& nbsp si fwidth
& nbsp & nbsp fwidth:=fdefaultwidth
& nbsp fdefaultheight:=GetSystemMetrics(SM_CYSIZE)
& nbsp fborder3d:=GetSystemMetrics(SM_CYEDGE)
& nbsp fborderthickness:=GetSystemMetrics(SM_CYSIZEFRAME)
& nbsp parentpaint(fparent)
& nbsp msg.resultado:=0
fin
procedimiento TTitleButton.setbuttonwidth(awidth:integer)
begin
& nbsp si awidth>0, entonces
& nbsp & nbsp fwidth:=awidth
& nbsp else
& nbsp & nbsp fwidth:=fdefaultwidth
& nbsp parentpaint(fparent)
fin
procedimiento TTitleButton.setbuttonleft(aleft:integer)
begin
& nbsp si (aleft
& nbsp & nbsp fleft:=aleft
& nbsp parentpaint(fparent)
fin
procedimiento TTitleButton.setbuttoncaption(acaption:string)
begin
& nbsp fbuttoncaption:=acaption
& nbsp parentpaint(fparent)
fin
procedimiento TTitleButton.setbuttonfont(afont:tfont)
begin
& nbsp ffont.asignar(afont)
& nbsp parentpaint(fparent)
fin
procedimiento TTitleButton.seticon(aicon:ticon)
begin
& nbsp ficon.asignar(aicon)
& nbsp parentpaint(fparent)
fin
procedimiento TTitleButton.setbuttonvisible(avisible:boolean)
begin
& nbsp fvisible:=avisible
& nbsp fparent.realizar(WM_NCACTIVATE,integer(true),0)
fin

procedimiento TTitleButton.setdown(adown:boolean)
var
& nbsp tmp:boolean
begin
& nbsp tmp:=fdown
& nbsp si csloading en componentstate, a continuacion,