寡人近日学习组件开发,苦学几日,偶有成果,不敢独享,班门弄斧,以飨读者。第二篇(解决D7下属性编辑器)(0分)

  • 主题发起人 主题发起人 huangyanming
  • 开始时间 开始时间
H

huangyanming

Unregistered / Unconfirmed
GUEST, unregistred user!
{ 此控件开发简单,只始用于初学者 主要解决D7环境下无法使用属性编辑器。
颜色按钮 Version 1.0.0
by 黄延明 2004.01.15
E-mail:huangyanming007@eyou.com
QQ:18025085
********************
以下为参考了别人的贴子才写出来的,在此谢过!

(注意:请在D7环境下,首先接下面步骤修改源文件,一定要先备份后再修改)

不改包,直接改Delphi源文件的解决方法:(我是这样改的,没有出什么问题)
1.加入搜索路径
C:/Program Files/Borland/Delphi7/Source/ToolsAPI
2.打开
C:/Program Files/Borland/Delphi7/Source/ToolsAPI/DesignEditors.pas
3.找到并把
uses
Types, SysUtils, Classes, TypInfo, Variants, DesignIntf, DesignMenus,Proxies;
改为
uses
Types, SysUtils, Classes, TypInfo, Variants, DesignIntf, DesignMenus{,Proxies};
4.找到并把
if (FAncestor = nil) and (Component <> Designer.Root)
and IsProxyClass(Component.ClassType) then
改为
if (FAncestor = nil) and (Component <> Designer.Root)
{and IsProxyClass(Component.ClassType)} then
5.找到并把
while IsProxyClass(ComponentClass) do
改为
//while IsProxyClass(ComponentClass) do
6.保存,编译运行,OK

上面3.4.5.就是把Proxies单元从DesignEditors单元中剔除,DesignEditors单元
中只有两个地方引用了Proxies单元的函数,而且是同一个函数:IsProxyClass,把
这两个地方注释掉就可以了.
}
unit ColorButton;

interface

uses
SysUtils, WinTypes,WinProcs,Messages,Classes,Graphics, Controls,Forms,Dialogs,DesignIntf,DesignEditors;

type
TAboutColorButtonProperty=class(TPropertyEditor)
public
procedure Edit;override;
function GetAttributes:TPropertyAttributes;override;
function GetValue:string;override;
end;
TActivationEvent=(aeClick,aeMouseDown);
TButtonState=(bsUp,bsDisabled,bsDown,bsExclusive);
TColorButton = class(TCustomControl)
private
FAbout:TAboutColorButtonProperty;
FColor:TColor;
FState:TButtonState;
FOptions:TColorDialogOptions;
FCustomColors:TStringList;
FOnColorChange:TNotifyEvent;// 事件
FActivationEvent:TActivationEvent;
FMargin:Byte;
procedure SetStateColor(value:TColor);
procedure SetOptions(value:TColorDialogOptions);
procedure SetCustomColors(value:TStringList);
procedure SetActivationEvent(value:TActivationEvent);
procedure SetMargin(value:Byte);
procedure DoClick;
procedure CMEnabledChanged(var Message:TMessage);message CM_ENABLEDCHANGED;
procedure CMSysColorChange(var Message:TMessage);message CM_SYSCOLORCHANGE;
protected
procedure Paint;override;
procedure MouseDown(Button:TMouseButton;Shift:TShiftstate;X,Y:integer);override;
procedure Click;override;
public
constructor Create (AOwner:TComponent);override;
destructor Destroy; override;
published
property About:TAboutColorButtonProperty read FAbout write FAbout;
property ActivationEvent:TActivationEvent read FActivationEvent write SetActivationEvent Default aeMouseDown;
property Color:TColor read FColor write SetStateColor;
property options:TColorDialogOptions read FOptions write SetOptions;
property CustomColors:TStringList read FCustomColors write SetCustomColors;
property Margin:Byte read FMargin write SetMargin default 1;
property Cursor;
property Enabled;
property TabOrder;
property TabStop;
property Visible;
property OnColorChange:TNotifyEvent read FOnColorChange write FOnColorChange;
property OnClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;

procedure Register;

implementation
{******************************************************************************}
procedure TAboutColorButtonProperty.Edit;
var msg:string;
begin
msg:='ColorButton Component'+chr(13);
msg:=msg+chr(13)+'E-mail:huangyanming007@eyou.com'+chr(13);
msg:=msg+chr(13)+'QQ:18025085';
ShowMessage(msg);
end;

function TAboutColorButtonProperty.GetAttributes:TPropertyAttributes;
begin
Result:=[paMultiSelect,paDialog,paReadOnly];
end;

function TAboutColorButtonProperty.GetValue:string;
begin
Result:='Click on ... for About box';
end;
{******************************************************************************}
constructor TColorButton.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
width:=44;
height:=22;
FColor:=clWhite;
FCustomColors:=TStringList.Create;
FMargin:=1;
TabStop:=true;
FActivationEvent:=aeClick;
end;

destructor TColorButton.Destroy;
begin
FCustomColors.Free;
inherited Destroy;
end;

procedure TColorButton.SetActivationEvent(value:TActivationEvent);
begin
FActivationEvent:=value;
end;

procedure TColorButton.SetStateColor(value:TColor);
begin
FColor:=value;
Repaint;
end;

procedure TColorButton.SetOptions(value:TColorDialogOptions);
begin
FOptions:=value;
end;
procedure TColorButton.SetCustomColors(value:TStringList);
begin
FCustomColors.Assign(value);
end;

procedure TColorButton.SetMargin(value:Byte);
begin
if value in [0..1] then FMargin:=value;
Invalidate;
end;

procedure TColorButton.Paint;
var cWidth,cHeight,cTop,cLeft:integer;
R:TRect;
begin
cWidth:=Width-14;
cHeight:=Height-14;
cTop:=(Height div 2)-(cHeight div 2)-1;
cLeft:=(Width div 2)-(cWidth div 2)-1;
if self.Focused then
begin
R:=Bounds(2,2,self.Width-5,self.Height-5);
if FState=bsDown then OffsetRect(R,1,1);
Canvas.DrawFocusRect(R);
end;
R:=Bounds(cLeft-2*FMargin,cTop-2*FMargin,cWidth+4*FMargin,cHeight+4*FMargin);
if FState=bsDown then OffsetRect(R,1,1);
Canvas.Pen.Color:=clBlack;
Canvas.Rectangle(R.Left,R.Top,R.Right+1,R.Bottom+1);
OffsetRect(R,1,1);
Dec(R.Right);
Dec(R.Bottom);
if Enabled then
Canvas.Brush.Color:=FColor
else
Canvas.Brush.Color:=clBtnFace;
Canvas.FillRect(R);
end;

procedure TColorButton.MouseDown(Button:TMouseButton;Shift:TShiftState;X,Y:integer);
begin
inherited MouseDown(Button,shift,x,y);
if (Button=mbLeft) and Enabled then
begin
if not Focused then SetFocus;
FState:=bsDown;
Repaint;
if (FActivationEvent in [aeMouseDown]) then
begin
DoClick;
Click;
end;
end;
end;

procedure TColorButton.Click;
begin
inherited Click;
FState:=bsUp;
if (ActivationEvent in [aeClick])then DoClick;
end;

procedure TColorButton.DoClick;
var ColorDlg:TColorDialog;
begin
ColorDlg:=TColorDialog.Create(self);
try
ColorDlg.Color:=self.Color;
ColorDlg.Options:=FOptions;
ColorDlg.CustomColors:=self.CustomColors;
if ColorDlg.Execute then
begin
FColor:=ColorDlg.Color;
if assigned(FOnColorChange) then FOnColorChange(self);
Repaint;
end;
finally
ColorDlg.Free;
inherited Click;
end;
end;

procedure TColorButton.CMEnabledChanged(var Message:TMessage);
begin
inherited;
Invalidate;
end;

procedure TColorButton.CMSysColorChange(var Message:TMessage);
begin
Invalidate;
end;

procedure Register;
begin
RegisterComponents('System', [TColorButton]);
RegisterPropertyEditor(TypeInfo(TAboutColorButtonProperty),TColorButton,'ABOUT',TAboutColorButtonProperty);
end;

end.
 
你可能救了我的命!
 
还是分开的好 BORLAND 这样做有他的道理 分开后编译代码会变小
 
听课。。
 
应是看课。
 
后退
顶部