delphi - How to put an image in the Activex Control Button -
i not sure how going make procedure put image in button, seems no tbitbtn or tspeedbutton in activex control wizard, when button stretch image stretched.
the project .dpr
library buttonxcontrol1; uses comserv, buttonxcontrol1_tlb in 'buttonxcontrol1_tlb.pas', buttonimpl1 in 'buttonimpl1.pas' {buttonx: coclass}, about1 in 'about1.pas' {buttonxabout}; {$e ocx} exports dllgetclassobject, dllcanunloadnow, dllregisterserver, dllunregisterserver; {$r *.tlb} {$r *.res} begin end.
the project implementation:
unit buttonimpl1; {$warn symbol_platform off} interface uses windows, activex, classes, controls, graphics, menus, forms, stdctrls, comserv, stdvcl, axctrls, buttonxcontrol1_tlb; type tbuttonx = class(tactivexcontrol, ibuttonx) private { private declarations } fdelphicontrol: tbutton; fevents: ibuttonxevents; procedure clickevent(sender: tobject); procedure keypressevent(sender: tobject; var key: char); protected { protected declarations } procedure definepropertypages(definepropertypage: tdefinepropertypage); override; procedure eventsinkchanged(const eventsink: iunknown); override; procedure initializecontrol; override; function drawtextbidimodeflagsreadingonly: integer; safecall; function get_aligndisabled: wordbool; safecall; function get_cancel: wordbool; safecall; function get_caption: widestring; safecall; function get_default: wordbool; safecall; function get_doublebuffered: wordbool; safecall; function get_dragcursor: smallint; safecall; function get_dragmode: txdragmode; safecall; function get_enabled: wordbool; safecall; function get_font: ifontdisp; safecall; function get_visible: wordbool; safecall; function get_visibledockclientcount: integer; safecall; function get_wordwrap: wordbool; safecall; function isrighttoleft: wordbool; safecall; function userighttoleftreading: wordbool; safecall; function userighttoleftscrollbar: wordbool; safecall; procedure _set_font(var value: ifontdisp); safecall; procedure aboutbox; safecall; procedure initiateaction; safecall; procedure set_cancel(value: wordbool); safecall; procedure set_caption(const value: widestring); safecall; procedure set_default(value: wordbool); safecall; procedure set_doublebuffered(value: wordbool); safecall; procedure set_dragcursor(value: smallint); safecall; procedure set_dragmode(value: txdragmode); safecall; procedure set_enabled(value: wordbool); safecall; procedure set_font(const value: ifontdisp); safecall; procedure set_visible(value: wordbool); safecall; procedure set_wordwrap(value: wordbool); safecall; procedure setsubcomponent(issubcomponent: wordbool); safecall; end; implementation uses comobj, about1; { tbuttonx } procedure tbuttonx.definepropertypages(definepropertypage: tdefinepropertypage); begin {todo: define property pages here. property pages defined calling definepropertypage class id of page. example, definepropertypage(class_buttonxpage); } end; procedure tbuttonx.eventsinkchanged(const eventsink: iunknown); begin fevents := eventsink ibuttonxevents; end; procedure tbuttonx.initializecontrol; begin fdelphicontrol := control tbutton; fdelphicontrol.onclick := clickevent; fdelphicontrol.onkeypress := keypressevent; end; function tbuttonx.drawtextbidimodeflagsreadingonly: integer; begin result := fdelphicontrol.drawtextbidimodeflagsreadingonly; end; function tbuttonx.get_aligndisabled: wordbool; begin result := fdelphicontrol.aligndisabled; end; function tbuttonx.get_cancel: wordbool; begin result := fdelphicontrol.cancel; end; function tbuttonx.get_caption: widestring; begin result := widestring(fdelphicontrol.caption); end; function tbuttonx.get_default: wordbool; begin result := fdelphicontrol.default; end; function tbuttonx.get_doublebuffered: wordbool; begin result := fdelphicontrol.doublebuffered; end; function tbuttonx.get_dragcursor: smallint; begin result := smallint(fdelphicontrol.dragcursor); end; function tbuttonx.get_dragmode: txdragmode; begin result := ord(fdelphicontrol.dragmode); end; function tbuttonx.get_enabled: wordbool; begin result := fdelphicontrol.enabled; end; function tbuttonx.get_font: ifontdisp; begin getolefont(fdelphicontrol.font, result); end; function tbuttonx.get_visible: wordbool; begin result := fdelphicontrol.visible; end; function tbuttonx.get_visibledockclientcount: integer; begin result := fdelphicontrol.visibledockclientcount; end; function tbuttonx.get_wordwrap: wordbool; begin result := fdelphicontrol.wordwrap; end; function tbuttonx.isrighttoleft: wordbool; begin result := fdelphicontrol.isrighttoleft; end; function tbuttonx.userighttoleftreading: wordbool; begin result := fdelphicontrol.userighttoleftreading; end; function tbuttonx.userighttoleftscrollbar: wordbool; begin result := fdelphicontrol.userighttoleftscrollbar; end; procedure tbuttonx._set_font(var value: ifontdisp); begin setolefont(fdelphicontrol.font, value); end; procedure tbuttonx.aboutbox; begin showbuttonxabout; end; procedure tbuttonx.clickevent(sender: tobject); begin if fevents <> nil fevents.onclick; end; procedure tbuttonx.initiateaction; begin fdelphicontrol.initiateaction; end; procedure tbuttonx.keypressevent(sender: tobject; var key: char); var tempkey: smallint; begin tempkey := smallint(key); if fevents <> nil fevents.onkeypress(tempkey); key := char(tempkey); end; procedure tbuttonx.set_cancel(value: wordbool); begin fdelphicontrol.cancel := value; end; procedure tbuttonx.set_caption(const value: widestring); begin fdelphicontrol.caption := tcaption(value); end; procedure tbuttonx.set_default(value: wordbool); begin fdelphicontrol.default := value; end; procedure tbuttonx.set_doublebuffered(value: wordbool); begin fdelphicontrol.doublebuffered := value; end; procedure tbuttonx.set_dragcursor(value: smallint); begin fdelphicontrol.dragcursor := tcursor(value); end; procedure tbuttonx.set_dragmode(value: txdragmode); begin fdelphicontrol.dragmode := tdragmode(value); end; procedure tbuttonx.set_enabled(value: wordbool); begin fdelphicontrol.enabled := value; end; procedure tbuttonx.set_font(const value: ifontdisp); begin setolefont(fdelphicontrol.font, value); end; procedure tbuttonx.set_visible(value: wordbool); begin fdelphicontrol.visible := value; end; procedure tbuttonx.set_wordwrap(value: wordbool); begin fdelphicontrol.wordwrap := value; end; procedure tbuttonx.setsubcomponent(issubcomponent: wordbool); begin fdelphicontrol.setsubcomponent(issubcomponent); end; initialization tactivexcontrolfactory.create( comserver, tbuttonx, tbutton, class_buttonx, 1, '{b3400964-1afe-45e8-a3ed-1286ae605314}', 0, tmapartment); end.
the tlb?
unit buttonxcontrol1_tlb; // ************************************************************************ // // warning // ------- // types declared in file generated data read // type library. if type library explicitly or indirectly (via // type library referring type library) re-imported, or // 'refresh' command of type library editor activated while editing // type library, contents of file regenerated , // manual modifications lost. // ************************************************************************ // // pastlwtr : 1.2 // file generated on 4/20/2013 7:14:17 type library described below. {$typedaddress off} // unit must compiled without type-checked pointers. {$warn symbol_platform off} {$writeableconst on} {$varpropsetter on} interface uses windows, activex, classes, graphics, olectrls, stdvcl, variants; // *********************************************************************// // guids declared in typelibrary. following prefixes used: // type libraries : libid_xxxx // coclasses : class_xxxx // dispinterfaces : diid_xxxx // non-disp interfaces: iid_xxxx // *********************************************************************// const // typelibrary major , minor versions buttonxcontrol1majorversion = 1; buttonxcontrol1minorversion = 0; libid_buttonxcontrol1: tguid = '{5285c4f5-89fe-4491-9d87-bd284c195c49}'; iid_ibuttonx: tguid = '{0dbf599a-1513-415b-99f8-c49f023ae176}'; diid_ibuttonxevents: tguid = '{f3555b69-8f22-4fec-b088-40b02ab5311d}'; class_buttonx: tguid = '{1099073b-bd04-4974-bd25-c0b1c3a110f4}'; // *********************************************************************// // declaration of enumerations defined in type library // *********************************************************************// // constants enum txdragmode type txdragmode = toleenum; const dmmanual = $00000000; dmautomatic = $00000001; // constants enum txmousebutton type txmousebutton = toleenum; const mbleft = $00000000; mbright = $00000001; mbmiddle = $00000002; type // *********************************************************************// // forward declaration of types defined in typelibrary // *********************************************************************// ibuttonx = interface; ibuttonxdisp = dispinterface; ibuttonxevents = dispinterface; // *********************************************************************// // declaration of coclasses defined in type library // (note: here map each coclass default interface) // *********************************************************************// buttonx = ibuttonx; // *********************************************************************// // declaration of structures, unions , aliases. // *********************************************************************// ppusertype1 = ^ifontdisp; {*} // *********************************************************************// // interface: ibuttonx // flags: (4416) dual oleautomation dispatchable // guid: {0dbf599a-1513-415b-99f8-c49f023ae176} // *********************************************************************// ibuttonx = interface(idispatch) ['{0dbf599a-1513-415b-99f8-c49f023ae176}'] function get_cancel: wordbool; safecall; procedure set_cancel(value: wordbool); safecall; function get_caption: widestring; safecall; procedure set_caption(const value: widestring); safecall; function get_default: wordbool; safecall; procedure set_default(value: wordbool); safecall; function get_dragcursor: smallint; safecall; procedure set_dragcursor(value: smallint); safecall; function get_dragmode: txdragmode; safecall; procedure set_dragmode(value: txdragmode); safecall; function get_enabled: wordbool; safecall; procedure set_enabled(value: wordbool); safecall; function get_font: ifontdisp; safecall; procedure set_font(const value: ifontdisp); safecall; procedure _set_font(var value: ifontdisp); safecall; function get_visible: wordbool; safecall; procedure set_visible(value: wordbool); safecall; function get_wordwrap: wordbool; safecall; procedure set_wordwrap(value: wordbool); safecall; function get_doublebuffered: wordbool; safecall; procedure set_doublebuffered(value: wordbool); safecall; function get_aligndisabled: wordbool; safecall; function get_visibledockclientcount: integer; safecall; function drawtextbidimodeflagsreadingonly: integer; safecall; procedure initiateaction; safecall; function isrighttoleft: wordbool; safecall; function userighttoleftreading: wordbool; safecall; function userighttoleftscrollbar: wordbool; safecall; procedure setsubcomponent(issubcomponent: wordbool); safecall; procedure aboutbox; safecall; property cancel: wordbool read get_cancel write set_cancel; property caption: widestring read get_caption write set_caption; property default: wordbool read get_default write set_default; property dragcursor: smallint read get_dragcursor write set_dragcursor; property dragmode: txdragmode read get_dragmode write set_dragmode; property enabled: wordbool read get_enabled write set_enabled; property font: ifontdisp read get_font write set_font; property visible: wordbool read get_visible write set_visible; property wordwrap: wordbool read get_wordwrap write set_wordwrap; property doublebuffered: wordbool read get_doublebuffered write set_doublebuffered; property aligndisabled: wordbool read get_aligndisabled; property visibledockclientcount: integer read get_visibledockclientcount; end; // *********************************************************************// // dispintf: ibuttonxdisp // flags: (4416) dual oleautomation dispatchable // guid: {0dbf599a-1513-415b-99f8-c49f023ae176} // *********************************************************************// ibuttonxdisp = dispinterface ['{0dbf599a-1513-415b-99f8-c49f023ae176}'] property cancel: wordbool dispid 201; property caption: widestring dispid -518; property default: wordbool dispid 202; property dragcursor: smallint dispid 203; property dragmode: txdragmode dispid 204; property enabled: wordbool dispid -514; property font: ifontdisp dispid -512; property visible: wordbool dispid 205; property wordwrap: wordbool dispid 206; property doublebuffered: wordbool dispid 207; property aligndisabled: wordbool readonly dispid 208; property visibledockclientcount: integer readonly dispid 209; function drawtextbidimodeflagsreadingonly: integer; dispid 210; procedure initiateaction; dispid 211; function isrighttoleft: wordbool; dispid 212; function userighttoleftreading: wordbool; dispid 213; function userighttoleftscrollbar: wordbool; dispid 214; procedure setsubcomponent(issubcomponent: wordbool); dispid 215; procedure aboutbox; dispid -552; end; // *********************************************************************// // dispintf: ibuttonxevents // flags: (0) // guid: {f3555b69-8f22-4fec-b088-40b02ab5311d} // *********************************************************************// ibuttonxevents = dispinterface ['{f3555b69-8f22-4fec-b088-40b02ab5311d}'] procedure onclick; dispid 201; procedure onkeypress(var key: smallint); dispid 202; end; // *********************************************************************// // ole control proxy class declaration // control name : tbuttonx // string : buttonx control // default interface: ibuttonx // def. intf. disp? : no // event interface: ibuttonxevents // typeflags : (38) cancreate licensed control // *********************************************************************// tbuttonxonkeypress = procedure(asender: tobject; var key: smallint) of object; tbuttonx = class(tolecontrol) private fonclick: tnotifyevent; fonkeypress: tbuttonxonkeypress; fintf: ibuttonx; function getcontrolinterface: ibuttonx; protected procedure createcontrol; procedure initcontroldata; override; public function drawtextbidimodeflagsreadingonly: integer; procedure initiateaction; function isrighttoleft: wordbool; function userighttoleftreading: wordbool; function userighttoleftscrollbar: wordbool; procedure setsubcomponent(issubcomponent: wordbool); procedure aboutbox; property controlinterface: ibuttonx read getcontrolinterface; property defaultinterface: ibuttonx read getcontrolinterface; property doublebuffered: wordbool index 207 read getwordboolprop write setwordboolprop; property aligndisabled: wordbool index 208 read getwordboolprop; property visibledockclientcount: integer index 209 read getintegerprop; published property anchors; property cancel: wordbool index 201 read getwordboolprop write setwordboolprop stored false; property caption: widestring index -518 read getwidestringprop write setwidestringprop stored false; property default: wordbool index 202 read getwordboolprop write setwordboolprop stored false; property dragcursor: smallint index 203 read getsmallintprop write setsmallintprop stored false; property dragmode: toleenum index 204 read gettoleenumprop write settoleenumprop stored false; property enabled: wordbool index -514 read getwordboolprop write setwordboolprop stored false; property font: tfont index -512 read gettfontprop write settfontprop stored false; property visible: wordbool index 205 read getwordboolprop write setwordboolprop stored false; property wordwrap: wordbool index 206 read getwordboolprop write setwordboolprop stored false; property onclick: tnotifyevent read fonclick write fonclick; property onkeypress: tbuttonxonkeypress read fonkeypress write fonkeypress; end; procedure register; resourcestring dtlserverpage = 'servers'; dtlocxpage = 'activex'; implementation uses comobj; procedure tbuttonx.initcontroldata; const ceventdispids: array [0..1] of dword = ( $000000c9, $000000ca); ctfontids: array [0..0] of dword = ( $fffffe00); ccontroldata: tcontroldata2 = ( classid: '{1099073b-bd04-4974-bd25-c0b1c3a110f4}'; eventiid: '{f3555b69-8f22-4fec-b088-40b02ab5311d}'; eventcount: 2; eventdispids: @ceventdispids; licensekey: nil (*hr:$80040154*); flags: $0000001c; version: 401; fontcount: 1; fontids: @ctfontids); begin controldata := @ccontroldata; tcontroldata2(ccontroldata).firsteventofs := cardinal(@@fonclick) - cardinal(self); end; procedure tbuttonx.createcontrol; procedure docreate; begin fintf := iunknown(oleobject) ibuttonx; end; begin if fintf = nil docreate; end; function tbuttonx.getcontrolinterface: ibuttonx; begin createcontrol; result := fintf; end; function tbuttonx.drawtextbidimodeflagsreadingonly: integer; begin result := defaultinterface.drawtextbidimodeflagsreadingonly; end; procedure tbuttonx.initiateaction; begin defaultinterface.initiateaction; end; function tbuttonx.isrighttoleft: wordbool; begin result := defaultinterface.isrighttoleft; end; function tbuttonx.userighttoleftreading: wordbool; begin result := defaultinterface.userighttoleftreading; end; function tbuttonx.userighttoleftscrollbar: wordbool; begin result := defaultinterface.userighttoleftscrollbar; end; procedure tbuttonx.setsubcomponent(issubcomponent: wordbool); begin defaultinterface.setsubcomponent(issubcomponent); end; procedure tbuttonx.aboutbox; begin defaultinterface.aboutbox; end; procedure register; begin registercomponents(dtlocxpage, [tbuttonx]); end; end.
Comments
Post a Comment