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

Popular posts from this blog

c# - Send Image in Json : 400 Bad request -

jquery - Fancybox - apply a function to several elements -

An easy way to program an Android keyboard layout app -