Legg en knapp til bildetekst bar av FORMI har skapt en komponent som lar deg legge til knapper i bildeteksten linjen i form. Her er koden .____________ Code______________unit TitleButton; interfaceuses Windows, Meldinger, SysUtils, klasser, Grafikk, kontroller, skjemaer Dialoger; konst WM_MOUSELEAVE = $ B014, skriver TChangedProperty = (cpdown, cpallowallup, cpgroupindex), skriver TTitleButton = klasse (Tcomponent) private fbuttonrect: trect; fpressed, ffocused: boolean; fbuttoncaption: string; fwidth: integer; fleft: integer; fvisible: boolean; fhintshow: boolean; fhint: thintwindow; fhinttext: string; fgroupindex: integer; fdown: boolean; fallowallup: boolean; fparent: TForm; fparentwidth: integer; ficonwidth: integer; fcallinheritedevent: boolean; fdefaultwidth: integer; fdefaultheight: integer; ffont: Tfont; FICON: Ticon; fborder3d, fborderthickness: integer; fbuttondown: tnotifyevent; fbuttonmove: tmousemoveevent; fbuttonup: tnotifyevent; pmsghandler: Twndmethod; ppaint: Tnotifyevent; presize: tnotifyevent; gtmp1, gtmp2, gtmp3: boolean; prosedyre initializevariables; Prosedyren IconChange (Sender: TObject); Prosedyren setbuttonwidth (awidth: integer); Prosedyren setbuttonleft (aleft: integer); Prosedyren setbuttoncaption (acaption: string); Prosedyren setbuttonfont (afont: tfont); Prosedyren setbuttonvisible (avisible: boolean); Prosedyren seticon (Aicon: Ticon); Prosedyren setdown (adown: boolean); Prosedyren setallowallup (aallowallup: boolean); Prosedyren setgroupindex (agroupindex: integer); prosedyre UpdateProperties (achangedproperty: TChangedProperty); beskyttet prosedyre messagehandler (var msg: tmessage); Prosedyren CaptionPaint (var msg: tmessage); Prosedyren CaptionMouseMove (var msg: tmessage); Prosedyren CaptionMouseDown (var msg: tmessage); Prosedyren CaptionMouseUp (var msg: tmessage); Prosedyren CaptionRightMouseDown (var msg: tmessage); Prosedyren CaptionDoubleClick (var msg: tmessage); Prosedyren CaptionActivate (var msg: tmessage); Prosedyren CaptionHitTest (var msg: Tmessage); Prosedyren CaptionChange (var msg: Tmessage); Prosedyren ParentMouseMove (var msg: tmessage); Prosedyren ParentMouseUp (var msg: tmessage); Prosedyren ButtonUp (var msg: tmessage); Prosedyren ParentPaint (avsender: TObject); Prosedyren ParentResize (avsender: TObject); Prosedyren DisplaySettingChange (var msg: tmessage); Prosedyren lastet; styre; offentlig konstruktør skape (aowner: tcomponent); overstyring; destructor ødelegge; styre; publisert eiendom Bredde: integer lese fwidth skrive setbuttonwidth; eiendom plassering: heltall lese fleft skrive setbuttonleft; Eiendommen Caption: string lese fbuttoncaption skrive setbuttoncaption; Eiendommen Font: Tfont lese ffont skrive SetButtonFont; Eiendommen Ikon: Ticon lese FICON skrive seticon; Eiendommen TipText: string lese fhinttext skrive fhinttext; Eiendommen Synlig: boolean lese fvisible skrive setbuttonvisible; Eiendommen AllowAllUp: boolean lese fallowallup skrive setallowallup; Eiendommen Down: boolean lese fdown skrive setdown; Eiendommen GroupIndex: integer lese fgroupindex skrive setgroupindex; Eiendommen OnMouseDown: tnotifyevent lese fbuttondown skrive fbuttondown; Eiendommen OnMouseMove: tmousemoveevent lese fbuttonmove skrive fbuttonmove; Eiendommen OnMouseUp: tnotifyevent lese fbuttonup skrive fbuttonup; end; konst TTB_SETBUTTONUP = WM_USER + 1; prosedyre register, implementationconstructor TTitleButton.create (aowner: tcomponent), begynner arvet; fparent: = (eier som TForm); ffont: = tfont.create; fhint: = thintwindow.create (selv); FICON: = ticon.create; ende; destructor TTitleButton.destroy, begynne hvis tildelt (FICON) så ficon.free; hvis tildelt (ffont) så ffont.free; hvis tildelt (fhint) så fhint.free; arvet; end; prosedyre TTitleButton.loaded, begynner arvet; initializevariables; end; prosedyre TTitleButton.UpdateProperties (achangedproperty: TChangedProperty); Var amsg: tmessage, begynner amsg.Msg: = TTB_SETBUTTONUP; amsg.WParam: = heltall (selv); amsg.LParamlo: = fgroupindex; amsg.LParamHi: = ord (achangedproperty); amsg.Result: = 0; fparent.perform (amsg.msg, amsg.wparam, amsg.lparam); end; prosedyre TTitleButton.initializevariables, begynne hvis tildelt (fparent.WindowProc) så pmsghandler: = fparent.WindowProc; fparent.WindowProc: = messagehandler; hvis ikke (csdesigning i componentstate), og start hvis tildelt (fparent.onpaint) så ppaint: = fparent.onpaint; hvis tildelt (fparent.onresize) så presize: = fparent.onresize; fparent.onpaint: = parentpaint; fparent.onresize: = parentresize; slutt; fparentwidth: = fparent.width; zeromemory (@ fbuttonrect, sizeof (fbuttonrect)); fpressed: = false; ffocused: = false; fhintshow: = false; ficonwidth: = 16; ficon.Transparent: = true; ficon.OnChange: = IconChange; fhint.Color: = clInfoBk; fcallinheritedevent: = false; fdefaultwidth: = GetSystemMetrics (SM_CXSIZE); hvis fwidth fwidth: = fdefaultwidth; fdefaultheight: = GetSystemMetrics (SM_CYSIZE); fborder3d: = GetSystemMetrics (SM_CYEDGE); fborderthickness: = GetSystemMetrics (SM_CYSIZEFRAME); gtmp3: = false; ende; prosedyre TTitleButton.IconChange (Sender: TObject), begynner parentpaint (fparent); end; prosedyre TTitleButton.messagehandler (var msg: tmessage); begynne hvis csdesigning i componentstate deretter begynne hvis msg.Msg = TTB_SETBUTTONUP deretter begynne ButtonUp (msg); if (tilordnet (pmsghandler)) og (fcallinheritedevent) så pmsghandler (msg); ende annet pmsghandler (msg); ende annet begynne hvis msg.Msg = WM_NCPAINT deretter begynne CaptionPaint (msg); if (tilordnet (pmsghandler)) og (fcallinheritedevent) så pmsghandler (msg); ende annet hvis msg.Msg = WM_NCLBUTTONDOWN deretter begynne CaptionMouseDown (msg); if (tilordnet (pmsghandler)) og (fcallinheritedevent) så pmsghandler (msg); ende annet hvis msg.Msg = WM_NCMOUSEMOVE deretter begynne CaptionMouseMove (msg); if (tilordnet (pmsghandler)) og (fcallinheritedevent) så pmsghandler (msg); ende annet hvis msg.Msg = WM_NCLBUTTONUP deretter begynne CaptionMouseUp (msg); if (tilordnet (pmsghandler)) og (fcallinheritedevent) så pmsghandler (msg); ende annet hvis msg.Msg = WM_NCACTIVATE deretter begynne CaptionActivate (msg); if (tilordnet (pmsghandler)) og (fcallinheritedevent) så pmsghandler (msg); ende annet hvis msg.Msg = WM_NCHITTEST deretter begynne CaptionHitTest (msg); if (tilordnet (pmsghandler)) og (fcallinheritedevent) så pmsghandler (msg); ende annet hvis msg.Msg = WM_LBUTTONUP deretter begynne ParentMouseUp (msg); if (tilordnet (pmsghandler)) og (fcallinheritedevent) så pmsghandler (msg); ende annet hvis msg.Msg = WM_MOUSEMOVE deretter begynne ParentMouseMove (msg); if (tilordnet (pmsghandler)) og (fcallinheritedevent) så pmsghandler (msg); ende annet hvis msg.Msg = WM_NCRBUTTONDOWN deretter begynne CaptionRightMouseDown (msg); if (tilordnet (pmsghandler)) og (fcallinheritedevent) så pmsghandler (msg); ende annet hvis msg.Msg = WM_NCLBUTTONDBLCLK deretter begynne CaptionDoubleClick (msg); if (tilordnet (pmsghandler)) og (fcallinheritedevent) så pmsghandler (msg); ende annet hvis msg.Msg = WM_NCLBUTTONDBLCLK deretter begynne CaptionDoubleClick (msg); if (tilordnet (pmsghandler)) og (fcallinheritedevent) så pmsghandler (msg); ende annet hvis msg.Msg = WM_SETTEXT deretter begynne CaptionChange (msg); if (tilordnet (pmsghandler)) og (fcallinheritedevent) så pmsghandler (msg); ende annet hvis msg.Msg = WM_SETTINGCHANGE, hvor da begynne DisplaySettingChange (msg); if (tilordnet (pmsghandler)) og (fcallinheritedevent) så pmsghandler (msg); ende annet hvis msg.Msg = TTB_SETBUTTONUP deretter begynne ButtonUp (msg); if (tilordnet (pmsghandler)) og (fcallinheritedevent) så pmsghandler (msg); ende annet hvis msg.Msg = WM_MOUSELEAVE deretter begynne fhint.ReleaseHandle; pmsghandler (msg); ende annet pmsghandler (msg); end, end, prosedyre TTitleButton.CaptionPaint (var msg: tmessage), begynner fcallinheritedevent: = true; hvis fvisible = false deretter exit; invalidaterect (fparent.handle, @ fbuttonrect, false); end; prosedyre TTitleButton.CaptionMouseMove (var msg: tmessage); Var pt: tpoint; tmpstate: tshiftstate; fhintwidth: integer; begynne fcallinheritedevent: = true; hvis fvisible = false deretter exit; gtmp1: = fpressed; gtmp2: = ffocused; pt.x: = msg.LParamLo-fparent.left; pt.y: = msg.LParamHi-fparent.top; hvis PtInRect (fbuttonrect, pt) så begynner ffocused: = true; fhintwidth: = fhint.Canvas.TextWidth (fhinttext); if (fhintshow = false) og (lengde (trim (fhinttext)) < > 0) deretter fhint.ActivateHint(rect(mouse.cursorpos.x,mouse.cursorpos.y+10,mouse.cursorpos.x+fhintwidth+7,mouse.cursorpos.y+25),fhinttext); fhintshow: = true; hvis tildelt (fbuttonmove) så fbuttonmove (fparent, tmpstate, pt.x, pt.y); ende ellers begynner ffocused: = false; fhint.ReleaseHandle; fhintshow: = false; slutt; fcallinheritedevent: = true; ende; prosedyre TTitleButton.CaptionMouseDown (var msg: tmessage); Var pt: tpoint; TMP1: boolean; callevent: boolean, begynner callevent: = false; fcallinheritedevent: = true; hvis fvisible = false deretter exit; fhintshow: = false; fhint.releasehandle; setforegroundwindow (fparent.handle); TMP1: = fpressed; pt.x: = msg.LParamLo-fparent.left; pt.y: = msg.LParamhi-fparent.top; hvis ptinrect (fbuttonrect, pt), og start gtmp3: = true; hvis fgroupindex = 0 da begynne callevent: = true; ende annet begynne hvis ikke (fdown) så hvis tildelt (fbuttondown) så fbuttondown (fparent); slutt; fpressed: = true; ffocused: = true; setcapture (fparent.handle); ende ellers begynner fpressed: = false; ffocused: = false; slutt; if (TMP1 < > fpressed) så fcallinheritedevent: = false; gtmp1: = fpressed; gtmp2: = ffocused; parentpaint (fparent); if (callevent) og tildeles (fbuttondown) så fbuttondown (fparent); end; prosedyre TTitleButton.CaptionMouseUp (var msg: tmessage); Var pt: Tpoint; TMP1, TMP2: boolean, begynner fcallinheritedevent: = true; hvis fvisible = false deretter exit; releasecapture; TMP1: = fpressed; TMP2: = ffocused; pt.x: = msg.LParamLo-fparent.left; pt.y: = msg.LParamhi-fparent.top; if (ptinrect (fbuttonrect, pt)) og (ffocused = true) så fpressed: = false ellers ffocused: = false; if ((TMP1 < > fpressed) eller (TMP2 < > ffocused)) og (fallowallup og fdown) deretter invalidaterect (fparent.handle, @ fbuttonrect, true); fcallinheritedevent: = true; ende; prosedyre TTitleButton.CaptionRightMouseDown (var msg: tmessage); Var pt: tpoint, begynner fcallinheritedevent: = true; hvis fvisible = false deretter exit; fhint.releasehandle; pt.x: = msg.LParamlo-fparent.left; pt.y: = msg.LParamHi-fparent.top; hvis ikke ptinrect (fbuttonrect, pt) så fcallinheritedevent: = true annet fcallinheritedevent: = false; ende; prosedyre TTitleButton.CaptionDoubleClick (var msg: tmessage); Var pt: tpoint, begynner fcallinheritedevent: = true; hvis fvisible = false deretter exit; pt.x: = msg.LParamlo-fparent.left; pt.y: = msg.LParamhi-fparent.top; hvis ikke (ptinrect (fbuttonrect, pt)) så fcallinheritedevent: = true andre begynner fcallinheritedevent: = false; fparent.perform (WM_NCLBUTTONDOWN, msg.wparam, msg.LParam); end, end, prosedyre TTitleButton.CaptionActivate (var msg: tmessage), begynner fcallinheritedevent: = true; hvis ikke synlig og avslutter; invalidaterect (fparent.handle, @ fbuttonrect, false); end; prosedyre TTitleButton.CaptionHitTest (var msg: Tmessage); Var tmp: boolean; pt: tpoint, begynner fcallinheritedevent: = true; hvis fvisible = false deretter exit; hvis fpressed deretter begynne tmp: = ffocused; pt.x: = msg.LParamlo-fparent.left; pt.y: = msg.LParamhi-fparent.top; hvis ptinrect (fbuttonrect, pt) så begynner ffocused: = true end annet ffocused: = false; hvis ffocused < > tmp så invalidaterect (fparent.handle, @ fbuttonrect, false); slutt; hvis ffocused = false så fhint.releasehandle; gtmp1: = fpressed; gtmp2: = ffocused; fcallinheritedevent: = true; ende; prosedyre TTitleButton.CaptionChange (var msg: Tmessage), begynner fcallinheritedevent: = true; hvis ikke fvisible deretter exit; invalidaterect (fparent.handle, @ fbuttonrect, false); end; prosedyre TTitleButton.ButtonUp (var msg: tmessage); Var avsender: ttitlebutton; tmp: boolean, begynner tmp: = fdown; fcallinheritedevent: = true; avsender: = (tcomponent (msg.WParam) som ttitlebutton); if (avsender < > egen-) og (msg.LParamLo = fgroupindex), og start hvis tchangedproperty (msg.lparamhi) = cpdown deretter fdown: = false; fallowallup: = sender.fallowallup; hvis tmp < > fdown deretter invalidaterect (fparent.handle, @ fbuttonrect, false); end, end, prosedyre TTitleButton.ParentMouseMove (var msg: tmessage); Var pt: tpoint; tmppt: tpoint; tmprect: trect; tmpstate: Tshiftstate, begynner fcallinheritedevent: = true; hvis fvisible = false deretter exit; ffocused: = false; pt.x: = msg.lparamlo; pt.y: = msg.lparamhi-fparent.top; tmppt: = pt; tmppt.x: = tmppt.x + 4; tmppt.y: = 65536-tmppt.y-fparent.top; tmprect: = fbuttonrect; inflaterect (tmprect, 1,1); hvis ptinrect (tmprect, tmppt) så begynner ffocused: = true; hvis tildelt (fbuttonmove) så fbuttonmove (fparent, tmpstate, tmppt.x, tmppt.y); if (gtmp1 < > fpressed) eller (gtmp2 < > ffocused) så //hvis fpressed deretter begynne invalidaterect (fparent.handle, @ fbuttonrect, false); gtmp1: = fpressed; gtmp2: = ffocused; slutt; slutt; if (gtmp1 < > fpressed) eller (gtmp2 < > ffocused), og start invalidaterect (fparent.handle, @ fbuttonrect, false); gtmp1: = fpressed; gtmp2: = ffocused; slutt; fhintshow: = false; fhint.releasehandle; end; prosedyre TTitleButton.ParentMouseUp (var msg: tmessage); Var pt: tpoint; tmp: tpoint; tmprect: trect; tmpcallevent: boolean, begynner fcallinheritedevent: = true; hvis fvisible = false deretter exit; tmpcallevent: = false; fhint.ReleaseHandle; fhintshow: = true; ReleaseCapture; fpressed: = false; pt.x: = msg.lParamlo; pt.y: = msg.lParamhi-fparent.top; tmp: = pt; tmp.x: = tmp.x + 4; tmp.y: = 65536-tmp.y; tmp.y: = tmp.y-fparent.top; tmprect: = fbuttonrect; inflaterect (tmprect, 0,2); hvis tmp.y < (fparent.top + fparent.Height) så pt: = tmp; if (ptinrect (tmprect, pt)) og (ffocused) og (gtmp3) begynne så hvis fgroupindex < > 0 da begynne hvis fallowallup = sant da fdown: = ikke (fdown) ellers fdown: = true; gtmp3: = false; updateproperties (cpdown); hvis ikke (fdown) så tmpcallevent: = true; ende annet tmpcallevent: = true; parentpaint (fparent); if (tmpcallevent = true) og tildeles (fbuttonup) så fbuttonup (fparent); ende annet gtmp3: = false; fcallinheritedevent: = true; ende; prosedyre TTitleButton.parentpaint (avsender: TObject); Var ButtonCanvas: TCanvas; textrect: trect; iconrect: trect; tmpwidth: integer; begynne hvis fvisible = false deretter begynne hvis tildelt (ppaint) så ppaint (sender); gå; slutt; hvis ikke (csdesigning i componentstate), og start hvis fwidth fwidth: = fdefaultwidth; hvis fleft = 0 da fleft: = fwidth + 1; fbuttonrect.left: = fparent.width-fleft- (3 * fdefaultwidth) - (fborder3d + fborderthickness); fbuttonrect.right: = fbuttonrect.left + fwidth; fbuttonrect.top:=fborder3d+fborderthickness; fbuttonrect.bottom: = fbuttonrect.top + fdefaultheight- (2 * fborder3d); ButtonCanvas: = tcanvas.Create; ButtonCanvas.Handle: = getwindowdc (fparent.handle); fillrect (buttoncanvas.Handle, fbuttonrect, HBRUSH (COLOR_BTNFACE + 1)); tmpwidth: = fdefaultheight-2; iconrect.left: = fbuttonrect.left; iconrect.top:=fbuttonrect.top; iconrect.right: = iconrect.left + tmpwidth; iconrect.bottom: = fbuttonrect.top + fdefaultheight-2 * fborder3d; hvis ficon.handle < > 0 da subtractrect (textrect, fbuttonrect, iconrect) ellers textrect: = fbuttonrect; if (ffocused og fpressed) eller fdown deretter begynne drawedge (ButtonCanvas.Handle, fbuttonrect, EDGE_SUNKEN, BF_SOFT eller BF_RECT); textrect.left: = textrect.left + 2; textrect.Top:=textrect.Top+1; textrect.right: = textrect.right-1; iconrect.left: = iconrect.left + 3; iconrect.top:=iconrect.top+2; slutt; if (ikke (fpressed) eller ikke (ffocused)) og ikke (fdown), og start drawedge (ButtonCanvas.Handle, fbuttonrect, EDGE_RAISED, BF_SOFT eller BF_RECT); textrect.left: = textrect.left + 1; textrect.right: = textrect.right-1; iconrect.top:=iconrect.top+1; iconrect.left: = iconrect.left + 2; slutt; ButtonCanvas.Brush.Style:=bsclear; ButtonCanvas.Font.assign (ffont); hvis ficon.Handle < > 0 da begynne drawiconex(buttoncanvas.handle,iconrect.left+1,iconrect.top+1,ficon.handle,tmpwidth-5,fdefaultheight-8,0,0,DI_NORMAL); hvis lengde (trim (fbuttoncaption)) > 0 da DrawTextEx (ButtonCanvas.Handle, PChar (fButtonCaption), Lengde (fbuttoncaption), textrect, DT_LEFT eller DT_SINGLELINE eller DT_VCENTER eller DT_END_ELLIPSIS eller DT_PATH_ELLIPSIS eller DT_MODIFYSTRING, null); ende annet DrawText (ButtonCanvas.Handle, PChar (fButtonCaption), Lengde (fbuttoncaption), textrect, DT_CENTER eller DT_SINGLELINE eller DT_VCENTER eller DT_END_ELLIPSIS eller DT_PATH_ELLIPSIS eller DT_MODIFYSTRING); ButtonCanvas.Free; hvis tildelt (ppaint) så ppaint (sender); end, end, prosedyre TTitleButton.parentresize (avsender: TObject), begynner fcallinheritedevent: = true; hvis fvisible = false deretter begynne hvis tildelt (presize) så presize (sender); gå; slutt; parentpaint (sender); hvis tildelt (presize) så presize (egen-); end; prosedyre TTitleButton.DisplaySettingChange (var msg: tmessage), begynner fcallinheritedevent: = true; hvis fvisible = false deretter exit; fdefaultwidth: = GetSystemMetrics (SM_CXSIZE); hvis fwidth fwidth: = fdefaultwidth; fdefaultheight: = GetSystemMetrics (SM_CYSIZE); fborder3d: = GetSystemMetrics (SM_CYEDGE); fborderthickness: = GetSystemMetrics (SM_CYSIZEFRAME); parentpaint (fparent); msg.result: = 0; ende; prosedyre TTitleButton.setbuttonwidth (awidth: integer); begynne hvis awidth > 0 da fwidth: = awidth annet fwidth: = fdefaultwidth; parentpaint (fparent); end; prosedyre TTitleButton.setbuttonleft (aleft: integer), begynne if (aleft fleft: = aleft; parentpaint (fparent); end; prosedyre TTitleButton.setbuttoncaption (acaption: string); begynne fbuttoncaption: = acaption; parentpaint (fparent); end; prosedyre TTitleButton.setbuttonfont (afont: tfont), begynner ffont.assign (afont), parentpaint (fparent); end; prosedyre TTitleButton.seticon (Aicon: Ticon), begynner ficon.assign (Aicon); parentpaint (fparent); end; prosedyre TTitleButton.setbuttonvisible (avisible: boolean), begynner fvisible: = avisible; fparent.perform (WM_NCACTIVATE, heltall (sann), 0); end; prosedyre TTitleButton.setdown (adown: boolean); Var tmp : boolean, begynner tmp: = fdown, hvis csloading i componentstate deretter fdown: = adown annet begynne hvis fdown < > adown deretter begynne hvis fgroupindex = 0 da fdown: = false ellers begynne hvis fallowallup = sant da fdown: = adown annet fdown : = true; ende, slutt, slutt, hvis tmp < > fdown deretter updateproperties (cpdown); end; prosedyre TTitleButton.setallowallup (aallowallup: boolean); Var tmp: boolean, begynner fcallinheritedevent: = true; tmp: = fallowallup; hvis csloading i componentstate deretter fallowallup: = aallowallup annet begynne hvis fgroupindex < > 0 da fallowallup: = aallowallup; hvis tmp < > fallowallup deretter updateproperties (cpallowallup); end, end, prosedyre TTitleButton.setgroupindex (agroupindex: integer); Var tmp: integer; begynne tmp: = fgroupindex; hvis csloading i componentstate deretter fgroupindex: = agroupindex annet begynne hvis agroupindex > = 65535 så agroupindex: = 0; if (agroupindex > = 0) så fgroupindex: = agroupindex; hvis fgroupindex = 0 da begynne fallowallup: = false; fdown: = false; slutt; hvis tmp < > fgroupindex deretter updateproperties (cpgroupindex); end, end, prosedyre register, begynner RegisterComponents ( 'Mine Components ", [TTitleButton]); end;. slutten ._____________ End of code_____________Copy koden til en pas-fil og deretter registrere det