tlb檔案定義如下：
TImage = class(TDBOleControl)
private
FOnBeforeDragOver: TImageBeforeDragOver;
FOnBeforeDropOrPaste: TImageBeforeDropOrPaste;
FOnError: TImageError;
FIntf: IImage;
function GetControlInterface: IImage;
protected
procedure CreateControl;
procedure InitControlData; override;
function Get_Object_: IDispatch;
function Get_Parent: IDispatch;
function Get_BoundValue: OleVariant;
public
procedure SetFocus;
function _GethWnd: SYSINT;
function _GetID: Integer;
procedure _Move(Left: Integer; Top: Integer; Width: Integer; Height: Integer);
procedure _ZOrder(zPosition: fmZOrder);
property ControlInterface: IImage read GetControlInterface;
property DefaultInterface: IImage read GetControlInterface;
property InSelection: WordBool index -2147385341 read GetWordBoolProp write SetWordBoolProp;
property LayoutEffect: TOleEnum index -2147385340 read GetTOleEnumProp;
property OldHeight: Single index -2147385339 read GetSingleProp;
property OldLeft: Single index -2147385338 read GetSingleProp;
property OldTop: Single index -2147385337 read GetSingleProp;
property OldWidth: Single index -2147385336 read GetSingleProp;
property Object_: IDispatch index -2147385335 read GetIDispatchProp;
property Parent: IDispatch index -2147418104 read GetIDispatchProp;
published
property Anchors;
property Cancel: WordBool index -2147418056 read GetWordBoolProp write SetWordBoolProp stored False;
property ControlSource: WideString index -2147385343 read GetWideStringProp write SetWideStringProp stored False;
property ControlTipText: WideString index -2147418043 read GetWideStringProp write SetWideStringProp stored False;
property Default: WordBool index -2147418057 read GetWordBoolProp write SetWordBoolProp stored False;
property HelpContextID: Integer index -2147418062 read GetIntegerProp write SetIntegerProp stored False;
property Name: WideString index -2147418112 read GetWideStringProp write SetWideStringProp stored False;
property RowSource: WideString index -2147385330 read GetWideStringProp write SetWideStringProp stored False;
property RowSourceType: Smallint index -2147385329 read GetSmallintProp write SetSmallintProp stored False;
property TabIndex: Smallint index -2147418097 read GetSmallintProp write SetSmallintProp stored False;
property TabStop: WordBool index -2147418098 read GetWordBoolProp write SetWordBoolProp stored False;
property Tag: WideString index -2147418101 read GetWideStringProp write SetWideStringProp stored False;
property Visible: WordBool index -2147418105 read GetWordBoolProp write SetWordBoolProp stored False;
property Enabled: WordBool index -514 read GetWordBoolProp write SetWordBoolProp stored False;
property MousePointer: TOleEnum index -521 read GetTOleEnumProp write SetTOleEnumProp stored False;
property AutoSize: WordBool index -500 read GetWordBoolProp write SetWordBoolProp stored False;
property BackColor: TColor index -501 read GetTColorProp write SetTColorProp stored False;
property BackStyle: TOleEnum index -502 read GetTOleEnumProp write SetTOleEnumProp stored False;
property BorderColor: TColor index -503 read GetTColorProp write SetTColorProp stored False;
property BorderStyle: TOleEnum index -504 read GetTOleEnumProp write SetTOleEnumProp stored False;
property Picture: TPicture index -523 read GetTPictureProp write SetTPictureProp stored False;
property MouseIcon: TPicture index -522 read GetTPictureProp write SetTPictureProp stored False;
property PictureSizeMode: TOleEnum index 27 read GetTOleEnumProp write SetTOleEnumProp stored False;
property PictureAlignment: TOleEnum index 26 read GetTOleEnumProp write SetTOleEnumProp stored False;
property PictureTiling: WordBool index 28 read GetWordBoolProp write SetWordBoolProp stored False;
property SpecialEffect: TOleEnum index 12 read GetTOleEnumProp write SetTOleEnumProp stored False;
property OnBeforeDragOver: TImageBeforeDragOver read FOnBeforeDragOver write FOnBeforeDragOver;
property OnBeforeDropOrPaste: TImageBeforeDropOrPaste read FOnBeforeDropOrPaste write FOnBeforeDropOrPaste;
property OnError: TImageError read FOnError write FOnError;
end;
我想給image 系結事件，這個怎么實作，我看有說invoke的，有的好像IConnectionPoint，這個要怎么實作，自己要重新寫實作類嗎，我目前有個TEventSink 的類
uj5u.com熱心網友回復：
tlb 其他相關的定義// *********************************************************************//
// Interface: IImage
// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable
// GUID: {4C599243-6926-101B-9992-00000B65C6F9}
// *********************************************************************//
IImage = interface(IControl)
['{4C599243-6926-101B-9992-00000B65C6F9}']
procedure Set_Enabled(fEnabled: WordBool); safecall;
function Get_Enabled: WordBool; safecall;
procedure Set_MousePointer(MousePointer: fmMousePointer); safecall;
function Get_MousePointer: fmMousePointer; safecall;
procedure Set_AutoSize(fAutoSize: WordBool); safecall;
function Get_AutoSize: WordBool; safecall;
procedure Set_BackColor(BackColor: OLE_COLOR); safecall;
function Get_BackColor: OLE_COLOR; safecall;
procedure Set_BackStyle(BackStyle: fmBackStyle); safecall;
function Get_BackStyle: fmBackStyle; safecall;
procedure Set_BorderColor(BorderColor: OLE_COLOR); safecall;
function Get_BorderColor: OLE_COLOR; safecall;
procedure Set_BorderStyle(Style: fmBorderStyle); safecall;
function Get_BorderStyle: fmBorderStyle; safecall;
procedure Set_Picture(const Picture: IPictureDisp); safecall;
procedure _Set_Picture(const Picture: IPictureDisp); safecall;
function Get_Picture: IPictureDisp; safecall;
procedure Set_MouseIcon(const MouseIcon: IPictureDisp); safecall;
procedure _Set_MouseIcon(const MouseIcon: IPictureDisp); safecall;
function Get_MouseIcon: IPictureDisp; safecall;
procedure Set_PictureSizeMode(PictureSizeMode: fmPictureSizeMode); safecall;
function Get_PictureSizeMode: fmPictureSizeMode; safecall;
procedure Set_PictureAlignment(PictureAlignment: fmPictureAlignment); safecall;
function Get_PictureAlignment: fmPictureAlignment; safecall;
procedure Set_PictureTiling(PictureTiling: WordBool); safecall;
function Get_PictureTiling: WordBool; safecall;
procedure Set_SpecialEffect(SpecialEffect: fmSpecialEffect); safecall;
function Get_SpecialEffect: fmSpecialEffect; safecall;
property Enabled: WordBool read Get_Enabled write Set_Enabled;
property MousePointer: fmMousePointer read Get_MousePointer write Set_MousePointer;
property AutoSize: WordBool read Get_AutoSize write Set_AutoSize;
property BackColor: OLE_COLOR read Get_BackColor write Set_BackColor;
property BackStyle: fmBackStyle read Get_BackStyle write Set_BackStyle;
property BorderColor: OLE_COLOR read Get_BorderColor write Set_BorderColor;
property BorderStyle: fmBorderStyle read Get_BorderStyle write Set_BorderStyle;
property Picture: IPictureDisp read Get_Picture write Set_Picture;
property MouseIcon: IPictureDisp read Get_MouseIcon write Set_MouseIcon;
property PictureSizeMode: fmPictureSizeMode read Get_PictureSizeMode write Set_PictureSizeMode;
property PictureAlignment: fmPictureAlignment read Get_PictureAlignment write Set_PictureAlignment;
property PictureTiling: WordBool read Get_PictureTiling write Set_PictureTiling;
property SpecialEffect: fmSpecialEffect read Get_SpecialEffect write Set_SpecialEffect;
end;
// *********************************************************************//
// DispIntf: IImageDisp
// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable
// GUID: {4C599243-6926-101B-9992-00000B65C6F9}
// *********************************************************************//
IImageDisp = dispinterface
['{4C599243-6926-101B-9992-00000B65C6F9}']
property Enabled: WordBool dispid -514;
property MousePointer: fmMousePointer dispid -521;
property Picture: IPictureDisp dispid -523;
property MouseIcon: IPictureDisp dispid -522;
property PictureSizeMode: fmPictureSizeMode dispid 27;
property PictureAlignment: fmPictureAlignment dispid 26;
property PictureTiling: WordBool dispid 28;
property SpecialEffect: fmSpecialEffect dispid 12;
property Cancel: WordBool dispid -2147418056;
property ControlSource: WideString dispid -2147385343;
property ControlTipText: WideString dispid -2147418043;
property Default: WordBool dispid -2147418057;
procedure _SetHeight(Height: Integer); dispid 1610743816;
procedure _GetHeight(out Height: Integer); dispid 1610743817;
property Height: Single dispid -2147418106;
property HelpContextID: Integer dispid -2147418062;
property InSelection: WordBool dispid -2147385341;
property LayoutEffect: fmLayoutEffect readonly dispid -2147385340;
procedure _SetLeft(Left: Integer); dispid 1610743825;
procedure _GetLeft(out Left: Integer); dispid 1610743826;
property Left: Single dispid -2147418109;
property Name: WideString dispid -2147418112;
procedure _GetOldHeight(out OldHeight: Integer); dispid 1610743831;
property OldHeight: Single readonly dispid -2147385339;
procedure _GetOldLeft(out OldLeft: Integer); dispid 1610743833;
property OldLeft: Single readonly dispid -2147385338;
procedure _GetOldTop(out OldTop: Integer); dispid 1610743835;
property OldTop: Single readonly dispid -2147385337;
procedure _GetOldWidth(out OldWidth: Integer); dispid 1610743837;
property OldWidth: Single readonly dispid -2147385336;
property Object_: IDispatch readonly dispid -2147385335;
property Parent: IDispatch readonly dispid -2147418104;
property RowSource: WideString dispid -2147385330;
property RowSourceType: Smallint dispid -2147385329;
property TabIndex: Smallint dispid -2147418097;
property TabStop: WordBool dispid -2147418098;
property Tag: WideString dispid -2147418101;
procedure _SetTop(Top: Integer); dispid 1610743851;
procedure _GetTop(out Top: Integer); dispid 1610743852;
property Top: Single dispid -2147418108;
function BoundValue: {??POleVariant1}OleVariant; dispid -2147385328;
property Visible: WordBool dispid -2147418105;
procedure _SetWidth(Width: Integer); dispid 1610743859;
procedure _GetWidth(out Width: Integer); dispid 1610743860;
property Width: Single dispid -2147418107;
procedure Move(Left: OleVariant; Top: OleVariant; Width: OleVariant; Height: OleVariant;
Layout: OleVariant); dispid -2147385088;
procedure ZOrder(zPosition: OleVariant); dispid -2147385083;
procedure Select(SelectInGroup: WordBool); dispid -2147385086;
procedure SetFocus; dispid -2147385085;
function _GethWnd: SYSINT; dispid 1610743867;
function _GetID: Integer; dispid 1610743868;
procedure _Move(Left: Integer; Top: Integer; Width: Integer; Height: Integer); dispid 1610743869;
procedure _ZOrder(zPosition: fmZOrder); dispid 1610743870;
end;
// *********************************************************************//
// DispIntf: ImageEvents
// Flags: (4112) Hidden Dispatchable
// GUID: {4C5992A5-6926-101B-9992-00000B65C6F9}
// *********************************************************************//
ImageEvents = dispinterface
['{4C5992A5-6926-101B-9992-00000B65C6F9}']
procedure BeforeDragOver(const Cancel: ReturnBoolean; const Data: DataObject; X: Single;
Y: Single; DragState: fmDragState; const Effect: ReturnEffect;
Shift: Smallint); dispid 3;
procedure BeforeDropOrPaste(const Cancel: ReturnBoolean; Action: fmAction;
const Data: DataObject; X: Single; Y: Single;
const Effect: ReturnEffect; Shift: Smallint); dispid 4;
procedure Click; dispid -600;
procedure DblClick(const Cancel: ReturnBoolean); dispid -601;
procedure Error(Number: Smallint; const Description: ReturnString; SCode: Integer;
const Source: WideString; const HelpFile: WideString; HelpContext: Integer;
const CancelDisplay: ReturnBoolean); dispid -608;
procedure MouseDown(Button: Smallint; Shift: Smallint; X: Single; Y: Single); dispid -605;
procedure MouseMove(Button: Smallint; Shift: Smallint; X: Single; Y: Single); dispid -606;
procedure MouseUp(Button: Smallint; Shift: Smallint; X: Single; Y: Single); dispid -607;
end;
uj5u.com熱心網友回復：
問題解決了，是在invoke方法中呼叫的，我參照 一個截圖軟體的原始碼 的MSOEventSink.pas 解決的，代碼如下：
{-----------------------------------------------------------------------------
Unit Name: MSOEventSink
Author: Vadim Krochak
Copyright: ?2003 All rights reserved.
E.Mail: [email protected]
License: Don't redistribute for cash. Don't change and
redistribute under your name. Let me know if you fix anything or improve
anything.
Purpose: TCommandBarButtonEventsSink, TCommandBarsEventsSink and
TCommandBarComboBoxEventsSink implementation
History:
-----------------------------------------------------------------------------}
unit MSOEventSink;
interface
uses EventSink, Office_TLB;
type
TOnCommandBarButtonClick = procedure(const Ctrl: CommandBarButton; var CancelDefault: WordBool) of object;
TCommandBarButtonEventsSink = class(TEventSink)
private
FOnCommandBarButtonClick: TOnCommandBarButtonClick;
protected
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; override;
procedure ProcessEvent(Params: Pointer);
public
property OnCommandBarButtonClick: TOnCommandBarButtonClick read FOnCommandBarButtonClick write FOnCommandBarButtonClick;
end;
TOnCommandBarsUpdate = procedure() of object;
TCommandBarsEventsSink = class(TEventSink)
private
FOnCommandBarsUpdate: TOnCommandBarsUpdate;
protected
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; override;
procedure ProcessEvent(Params: Pointer);
public
property OnCommandBarsUpdate: TOnCommandBarsUpdate read FOnCommandBarsUpdate write FOnCommandBarsUpdate;
end;
TOnCommandBarComboBoxChange = procedure(const Ctrl: CommandBarComboBox) of object;
TCommandBarComboBoxEventsSink = class(TEventSink)
private
FOnCommandBarComboBoxChange: TOnCommandBarComboBoxChange;
protected
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; override;
procedure ProcessEvent(Params: Pointer);
public
property OnCommandBarComboBoxChange: TOnCommandBarComboBoxChange read FOnCommandBarComboBoxChange write FOnCommandBarComboBoxChange;
end;
//******************************************************************************
//******************************************************************************
implementation
uses Windows, ActiveX;
//******************************************************************************
//******************************************************************************
function TCommandBarButtonEventsSink.Invoke(DispID: Integer;
const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult,
ExcepInfo, ArgErr: Pointer): HResult;
begin
if ( DispID = 1 ) and ( TDispParams(Params).cArgs = 2 ) then
begin
Self.ProcessEvent(Pointer(@Params));
Result := S_OK;
end
else
begin
Result := inherited Invoke(DispID, IID, LocaleID, Flags, Params, VarResult, ExcepInfo, ArgErr );
end;// if-else
end;
//******************************************************************************
procedure TCommandBarButtonEventsSink.ProcessEvent(Params: Pointer);
var
CanCancel: WordBool;
begin
if Assigned(Self.FOnCommandBarButtonClick) then
begin
CanCancel := PDispParams(Params)^.rgvarg[0].pbool^;
Self.FOnCommandBarButtonClick(
CommandBarButton(PDispParams(Params)^.rgvarg[1].pdispVal), CanCancel
);
PDispParams(Params)^.rgvarg[0].pbool^ := CanCancel;
end;// if
end;
{ TCommandBarsEventsSink }
//******************************************************************************
procedure TCommandBarsEventsSink.ProcessEvent(Params: Pointer);
begin
if Assigned(Self.FOnCommandBarsUpdate) then
begin
Self.FOnCommandBarsUpdate();
end;// if
end;
//******************************************************************************
function TCommandBarsEventsSink.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
begin
if DispID = 1 then
begin
Self.ProcessEvent(Pointer(@Params));
Result := S_OK;
end
else
begin
Result := inherited Invoke(DispID, IID, LocaleID, Flags, Params, VarResult, ExcepInfo, ArgErr );
end;// if-else
end;
{ TCommandBarComboBoxEventsSink }
//******************************************************************************
procedure TCommandBarComboBoxEventsSink.ProcessEvent(Params: Pointer);
begin
if Assigned(Self.FOnCommandBarComboBoxChange) then
begin
Self.FOnCommandBarComboBoxChange(
CommandBarComboBox( PDispParams(Params)^.rgvarg[0].pdispVal )
);
end;// if
end;
//******************************************************************************
function TCommandBarComboBoxEventsSink.Invoke(DispID: Integer;
const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult,
ExcepInfo, ArgErr: Pointer): HResult;
begin
if ( DispID = 1 ) and ( TDispParams(Params).cArgs = 1 ) then
begin
Self.ProcessEvent(Pointer(@Params));
Result := S_OK;
end
else
begin
Result := inherited Invoke(DispID, IID, LocaleID, Flags, Params, VarResult, ExcepInfo, ArgErr );
end;// if-else
end;
end.
轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/110194.html
標籤：VCL組件開發及應用