我不确定如何制作一个将图像放入的程序 按钮,在activex控件中似乎没有Tbitbtn或TspeedButton 向导,所以当按钮拉伸时,图像也会拉伸。
项目.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.
项目实施:
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 are defined by calling
DefinePropertyPage with the class id of the page. For example,
DefinePropertyPage(Class_ButtonXPage); }
end;
procedure TButtonX.EventSinkChanged(const EventSink: IUnknown);
begin
FEvents := EventSink as IButtonXEvents;
end;
procedure TButtonX.InitializeControl;
begin
FDelphiControl := Control as 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 then 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 then 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.
TLB?
unit ButtonXControl1_TLB;
// ************************************************************************ //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //
// PASTLWTR : 1.2
// File generated on 4/20/2013 7:14:17 AM from Type Library described below.
{$TYPEDADDRESS OFF} // Unit must be 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 the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and 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 for enum TxDragMode
type
TxDragMode = TOleEnum;
const
dmManual = $00000000;
dmAutomatic = $00000001;
// Constants for 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 we map each CoClass to its Default Interface)
// *********************************************************************//
ButtonX = IButtonX;
// *********************************************************************//
// Declaration of structures, unions and 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
// Help 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) as IButtonX;
end;
begin
if FIntf = nil then 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.