这是一个从BitBtn继承的框架,你看看:
unit MyBitBtn;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons;type
TMyBitBtn = class(TBitBtn)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
end;procedure Register;implementationprocedure Register;
begin
RegisterComponents('Additional', [TMyBitBtn]);
end;end.
unit MyBitBtn;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons;type
TMyBitBtn = class(TBitBtn)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
end;procedure Register;implementationprocedure Register;
begin
RegisterComponents('Additional', [TMyBitBtn]);
end;end.
解决方案 »
- 各位高手帮帮忙解答Raised exception class EInvalidOperation with message 是什么一情况
- 大家帮我看看这样子的一段代码 分太少了不好意思大家就这么点分了。
- 200分请教 FarPoint.Spread.v7.0.06用法问题
- 在MouseDown事件中使用了Mousecoord(X,Y)这个函数,为何在用"右键"点击有记录的行数时,不能获得鼠标的位置?
- 报表预览的小问提
- 请教高手,如何将十进制:1234,转换成 bit7码:31D98C06,急!!!在线等待
- 用什么函数判断一个OLE对象是否存在?对于form,是用assigned,对于OLE对象用什么呢?
- 怎样在SQL2000数据库中存入图像(.bmp ,.jpg)?急!!!!
- 送分题!简单!
- 紧急求助 Activex 里面用通过HttPRIO调用Webservice 在IE6,IE7 下都行,IE8不行
- 如何将一个查询的结果以及其中某些字段的合计数列在同一个DBGRID中?
- □ ■□ ■□ ■□ ■论坛中怎么在程序中实现向网页提交数据(需要用户名密码的)□ ■□ ■□ ■□ ■□ ■□ ■□ ■□ ■□ ■□ ■□ ■□ ■□ ■
Variants, Windows, SysUtils, Messages, Controls, Forms, Classes, ComCtrls,
Graphics, Menus, StdCtrls, ExtCtrls, Mask, Buttons, DB, DBCtrls, CommCtrl;type
TDBTreeView = class(TCustomTreeView)
private
FDataLink: TFieldDataLink;
FCanvas: TControlCanvas;
FFocused: Boolean;
procedure ActiveChange(Sender: TObject);
procedure DataChange(Sender: TObject);
procedure EditingChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure SetFocused(Value: Boolean);
procedure SetReadOnly(Value: Boolean);
procedure UpdateData(Sender: TObject);
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
protected
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure Edit(const Item: TTVItem); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
property Field: TField read GetField;
published
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property Align;
property Anchors;
property AutoExpand;
property BevelEdges;
property BevelInner;
property BevelOuter;
property BevelKind default bkNone;
property BevelWidth;
property BiDiMode;
property BorderStyle;
property BorderWidth;
property ChangeDelay;
property Color;
property Ctl3D;
property Constraints;
property DragKind;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property HotTrack;
property Images;
property Indent;
property MultiSelect;
property MultiSelectStyle;
property ParentBiDiMode;
property ParentColor default False;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property RightClickSelect;
property RowSelect;
property ShowButtons;
property ShowHint;
property ShowLines;
property ShowRoot;
property SortType;
property StateImages;
property TabOrder;
property TabStop default True;
property ToolTips;
property Visible;
property OnAddition;
property OnAdvancedCustomDraw;
property OnAdvancedCustomDrawItem;
property OnChange;
property OnChanging;
property OnClick;
property OnCollapsed;
property OnCollapsing;
property OnCompare;
property OnContextPopup;
property OnCreateNodeClass;
property OnCustomDraw;
property OnCustomDrawItem;
property OnDblClick;
property OnDeletion;
property OnDragDrop;
property OnDragOver;
property OnEdited;
property OnEditing;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnExpanding;
property OnExpanded;
property OnGetImageIndex;
property OnGetSelectedIndex;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
{ Items must be published after OnGetImageIndex and OnGetSelectedIndex }
property Items;
end;procedure Register;implementationprocedure Register;
begin
RegisterComponents('Zsoft', [TDBTreeView]);
end;{ TDBTreeView }procedure TDBTreeView.ActiveChange(Sender: TObject);
begin
//
end;procedure TDBTreeView.CMEnter(var Message: TCMEnter);
begin
SetFocused(True);
inherited;
if SysLocale.FarEast and FDataLink.CanModify then
inherited ReadOnly := False;
end;procedure TDBTreeView.CMExit(var Message: TCMExit);
begin
try
FDataLink.UpdateRecord;
except
SetFocus;
raise;
end;
SetFocused(False);
DoExit;
end;procedure TDBTreeView.CMGetDataLink(var Message: TMessage);
begin
Message.Result := Integer(FDataLink);
end;constructor TDBTreeView.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
inherited ReadOnly := True;
ControlStyle := ControlStyle + [csReplicatable];
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnEditingChange := EditingChange;
FDataLink.OnUpdateData := UpdateData;
FDataLink.OnActiveChange := ActiveChange;
end;procedure TDBTreeView.DataChange(Sender: TObject);
var
vStringStream: TStringStream;
begin
if FDataLink.Field <> nil then begin
vStringStream := TStringStream.Create(FDataLink.Field.AsString);
try
vStringStream.Position := 0;
LoadFromStream(vStringStream);
finally
vStringStream.Free;
end;
end;
end;destructor TDBTreeView.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
FCanvas.Free;
inherited Destroy;
end;procedure TDBTreeView.Edit(const Item: TTVItem);
begin
FDataLink.Modified;
inherited Edit(Item);
end;procedure TDBTreeView.EditingChange(Sender: TObject);
begin
inherited ReadOnly := not FDataLink.Editing;
end;function TDBTreeView.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
FDataLink.ExecuteAction(Action);
end;function TDBTreeView.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;function TDBTreeView.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;function TDBTreeView.GetField: TField;
begin
Result := FDataLink.Field;
end;function TDBTreeView.GetReadOnly: Boolean;
begin
Result := FDataLink.ReadOnly;
end;procedure TDBTreeView.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
FDataLink.Edit;
end;procedure TDBTreeView.KeyPress(var Key: Char);
begin
inherited KeyPress(Key);
if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
not FDataLink.Field.IsValidChar(Key) then
begin
MessageBeep(0);
Key := #0;
end;
case Key of
^H, ^V, ^X, #32..#255:
FDataLink.Edit;
#27:
begin
FDataLink.Reset;
Key := #0;
end;
end;
end;procedure TDBTreeView.Loaded;
begin
inherited Loaded;
if (csDesigning in ComponentState) then DataChange(Self);
end;procedure TDBTreeView.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;procedure TDBTreeView.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;procedure TDBTreeView.SetDataSource(Value: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
FDataLink.DataSource := Value;
if Value <> nil then Value.FreeNotification(Self);
end;procedure TDBTreeView.SetFocused(Value: Boolean);
begin
if FFocused <> Value then
begin
FFocused := Value;
FDataLink.Reset;
end;
end;procedure TDBTreeView.SetReadOnly(Value: Boolean);
begin
FDataLink.ReadOnly := Value;
inherited ReadOnly := Value;
end;function TDBTreeView.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
FDataLink.UpdateAction(Action);
end;procedure TDBTreeView.UpdateData(Sender: TObject);
var
vStringStream: TStringStream;
begin
if FDataLink.Field <> nil then begin
vStringStream := TStringStream.Create('');
try
SaveToStream(vStringStream);
vStringStream.Position := 0;
FDataLink.Field.AsString := vStringStream.DataString
finally
vStringStream.Free;
end;
end;
end;end.
Messages, Windows, SysUtils, Controls, Forms, Classes, Menus, Graphics,
StdCtrls, ShellApi, ComCtrls;type
TDropFilesEvent = procedure(Sender: TObject; X, Y: Integer; FileNames: TStrings) of object;type
TDropFilesMemo = class(TCustomMemo)
private
FCanDropFiles: Boolean;
FOnDropFiles: TDropFilesEvent;
procedure WMDropFiles(var Msg: TMessage); message WM_DROPFILES;
procedure SetCanDropFiles(const Value: Boolean);
published
property Align;
property Alignment;
property Anchors;
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
property BevelOuter;
property BiDiMode;
property BorderStyle;
property Color;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property ImeMode;
property ImeName;
property Lines;
property MaxLength;
property OEMConvert;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ScrollBars;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property WantReturns;
property WantTabs;
property WordWrap;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
property CanDropFiles: Boolean read FCanDropFiles write SetCanDropFiles;
property OnDropFiles: TDropFilesEvent read FOnDropFiles write FOnDropFiles;
end; TDropFilesEdit = class(TCustomEdit)
private
FCanDropFiles: Boolean;
FOnDropFiles: TDropFilesEvent;
procedure WMDropFiles(var Msg: TMessage); message WM_DROPFILES;
procedure SetCanDropFiles(const Value: Boolean);
published
property Anchors;
property AutoSelect;
property AutoSize;
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
property BevelOuter;
property BiDiMode;
property BorderStyle;
property CharCase;
property Color;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property ImeMode;
property ImeName;
property MaxLength;
property OEMConvert;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PasswordChar;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
property Text;
property Visible;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
property CanDropFiles: Boolean read FCanDropFiles write SetCanDropFiles;
property OnDropFiles: TDropFilesEvent read FOnDropFiles write FOnDropFiles;
end; TDropFilesRichEdit = class(TCustomRichEdit)
private
FCanDropFiles: Boolean;
FOnDropFiles: TDropFilesEvent;
procedure WMDropFiles(var Msg: TMessage); message WM_DROPFILES;
procedure SetCanDropFiles(const Value: Boolean);
published
property Align;
property Alignment;
property Anchors;
property BevelEdges;
property BevelInner;
property BevelOuter;
property BevelKind default bkNone;
property BevelWidth;
property BiDiMode;
property BorderStyle;
property BorderWidth;
property Color;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property HideScrollBars;
property ImeMode;
property ImeName;
property Constraints;
property Lines;
property MaxLength;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PlainText;
property PopupMenu;
property ReadOnly;
property ScrollBars;
property ShowHint;
property TabOrder;
property TabStop default True;
property Visible;
property WantTabs;
property WantReturns;
property WordWrap;
property OnChange;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnProtectChange;
property OnResizeRequest;
property OnSaveClipboard;
property OnSelectionChange;
property OnStartDock;
property OnStartDrag;
property CanDropFiles: Boolean read FCanDropFiles write SetCanDropFiles;
property OnDropFiles: TDropFilesEvent read FOnDropFiles write FOnDropFiles;
end;procedure Register;implementationprocedure Register;
begin
RegisterComponents('Zsoft', [TDropFilesMemo, TDropFilesEdit, TDropFilesRichEdit]);
end;{ TDropFilesMemo }procedure TDropFilesMemo.SetCanDropFiles(const Value: Boolean);
begin
FCanDropFiles := Value;
DragAcceptFiles(Handle, FCanDropFiles);
end;procedure TDropFilesMemo.WMDropFiles(var Msg: TMessage);
var
I, FilesCount: Integer;
FileName: array[0..MAX_PATH] of Char;
Point: TPoint;
FilesNames: TStringList;
begin
if Assigned(FOnDropFiles) then begin
FilesNames := TStringList.Create;
try
FilesCount := DragQueryFile(THandle(Msg.wParam), Cardinal(-1), nil, 0);
DragQueryPoint(THandle(Msg.wParam), Point);
for I := 0 to FilesCount - 1 do begin
DragQueryFile(THandle(Msg.wParam), I, FileName,
SizeOf(FileName));
FilesNames.Add(FileName);
end;
FOnDropFiles(Self, Point.X, Point.Y, FilesNames);
finally
FilesNames.Free;
end;
end;
Msg.Result := 0;
DragFinish(THandle(Msg.wParam));
end;{ TDropFilesEdit }procedure TDropFilesEdit.SetCanDropFiles(const Value: Boolean);
begin
FCanDropFiles := Value;
DragAcceptFiles(Handle, FCanDropFiles);
end;procedure TDropFilesEdit.WMDropFiles(var Msg: TMessage);
var
I, FilesCount: Integer;
FileName: array[0..MAX_PATH] of Char;
Point: TPoint;
FilesNames: TStringList;
begin
if Assigned(FOnDropFiles) then begin
FilesNames := TStringList.Create;
try
FilesCount := DragQueryFile(THandle(Msg.wParam), Cardinal(-1), nil, 0);
DragQueryPoint(THandle(Msg.wParam), Point);
for I := 0 to FilesCount - 1 do begin
DragQueryFile(THandle(Msg.wParam), I, FileName,
SizeOf(FileName));
FilesNames.Add(FileName);
end;
FOnDropFiles(Self, Point.X, Point.Y, FilesNames);
finally
FilesNames.Free;
end;
end;
Msg.Result := 0;
DragFinish(THandle(Msg.wParam));
end;{ TDropFilesRichEdit }procedure TDropFilesRichEdit.SetCanDropFiles(const Value: Boolean);
begin
FCanDropFiles := Value;
DragAcceptFiles(Handle, FCanDropFiles);
end;procedure TDropFilesRichEdit.WMDropFiles(var Msg: TMessage);
var
I, FilesCount: Integer;
FileName: array[0..MAX_PATH] of Char;
Point: TPoint;
FilesNames: TStringList;
begin
if Assigned(FOnDropFiles) then begin
FilesNames := TStringList.Create;
try
FilesCount := DragQueryFile(THandle(Msg.wParam), Cardinal(-1), nil, 0);
DragQueryPoint(THandle(Msg.wParam), Point);
for I := 0 to FilesCount - 1 do begin
DragQueryFile(THandle(Msg.wParam), I, FileName,
SizeOf(FileName));
FilesNames.Add(FileName);
end;
FOnDropFiles(Self, Point.X, Point.Y, FilesNames);
finally
FilesNames.Free;
end;
end;
Msg.Result := 0;
DragFinish(THandle(Msg.wParam));
end;end.
unit EditEx;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;type
TEditEx = class(TCustomEdit)
private
{ Private declarations }
protected
procedure CreateParams(var Params: TCreateParams); override;
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
end;procedure Register;implementation
procedure Register;
begin
RegisterComponents('Additional', [TEditEx]);
end;{ TEditEx }procedure TEditEx.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style or ES_RIGHT;
end;end.
unit Unit2;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons;type
TMyBitBtn = class(TBitBtn)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
{ Published declarations }
end;procedure Register;implementationprocedure Register;
begin
RegisterComponents('Additional', [TMyBitBtn]);
end;{ TMyBitBtn }constructor TMyBitBtn.Create(AOwner: TComponent);
begin
inherited;
Caption := '简单的';
end;end.//unit1.pas
uses Unit2;{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
begin
with TMyBitBtn.Create(Self) do begin
Parent := Self;
end;
end;
unit EXNMUDP;interfaceuses
Windows, Messages, SysUtils, Classes, NMUDP;type
TEXNMUDP = class(TNMUDP)
private
{ Private declarations }
protected
{ Protected declarations }
public
function SendText(const S:String):Integer;
{ Public declarations }
published { Published declarations }
end;procedure Register;implementationprocedure Register;
begin
RegisterComponents('FastNet', [TEXNMUDP]);
end;{ TEXNMUDP }function TEXNMUDP.SendText(const S: String): Integer;
beginend;end.