最近业余时间在写游戏修改器玩,对于Delphi自带的组件总觉得差强人意,需要书写大量冗余代码,如果大量使用第三方组件,在以后的移植和与他人交互时也不是很方便,因此便产生了自己封装组件的想法。 实际上这个想法在很久以前(大概04年写第一个修改器的时候)就有了,一直没有闲暇时间去做,而工作上类似的组件也会很实用,虽然不见得有第三方组件设计的那么规范、强大,但小巧、灵活是自主开发的优点。 很多初学者喜欢大量使用第三方组件库,经常见到一个软件中掺杂了四、五种组件库,这是让人很郁闷的。为了阅读、维护这样一个代码,需要下载、携带很多不必要的文件,一旦系统出现Bug,也要在海量的代码中查找,对于一个初学者来说,这更是一个很麻烦的事情。 很多初学者不愿意,甚至惧怕阅读核心代码,喜欢求捷径,一旦遇到问题,必然手足无措。阅读并继承Delphi类、组件,将会提高对内核的认识。 1.由简入繁 万事开头难,想从无到有总会让人无所头绪。那么从已有的组件继承会事半功倍。 考虑到组件或者程序在不同语言的操作系统上执行,应该让组件支持Unicode,那么Delphi 7原生的组件就略显力不从心,所以决定从Tnt组件继承。 Delphi 2009开始支持Unicode,但有很多的Bug,Delphi 2010略有改善,也总觉得差强人意,而且Tnt组件库卖给TMS之后,对Delphi 2009、2010均有支持,并能自动识别判断,因此从Tnt组件库继承衍生是一个良好的开始。当然,也可以参照Tnt组件库的代码,判断Delphi内核是否支持Unicode。 1.1.创建一个TGcxEdit组件 1.1.1.了解TCustom-xxx类 在StdCtrls单元内可以看到如下代码:
TLabel = class(TCustomLabel) TEdit = class(TCustomEdit) TComboBox = class(TCustomComboBox) TCheckBox = class(TCustomCheckBox) TGroupBox = class(TCustomGroupBox) ……
可以看出,在Delphi中,大部分面向开发的组件或者类,基本都有一个带有Custom前缀的类。 该类(TCustom-xxx)实现基本功能,而子类(Txxx)仅仅将公开(Public)或保护(Protected)的属性公布(Published)到Object Inspector中,或者将保护(Protected)的方法函数公开。 TEdit = class(TCustomEdit) published property Anchors; property AutoSelect; property AutoSize; property BevelEdges; …… property OnMouseUp; property OnStartDock; property OnStartDrag; end; 不要偷懒,如果你没有书写Custom类,以后在扩展、继承的时候会感觉很麻烦。 1.1.2.师从TTntCustomEdit 打开TntStdCtrls单元,可以看到TTntEdit继承自TTntCustomEdit,TTntCustomEdit继承自TCustomEdit。那么,我们将从TTntCustomEdit继承,开始超越。 1.1.2.1.颜色属性CommonColor与ReadOnlyColor 我首先要建立的这个组件很简单,会根据ReadOnly属性自动设置颜色,那么需要增加两个属性以及相应的私有变量: TGcxCustomEdit = class(TTntCustomEdit) private { Private declarations } FCommonColor: TColor; FReadOnlyColor: TColor; procedure SetCommonColor(const Value: TColor); procedure SetReadOnlyColor(const Value: TColor); protected { Protected declarations } property CommonColor: TColor read FCommonColor write SetCommonColor default clInfoBk; property ReadOnlyColor: TColor read FReadOnlyColor write SetReadOnlyColor default clSkyBlue; end; 好了,开始填写代码: procedure TGcxCustomEdit.SetCommonColor(const Value: TColor); begin FCommonColor := Value; UpdateColor; end;
procedure TGcxCustomEdit.SetReadOnlyColor(const Value: TColor); begin FReadOnlyColor := Value; UpdateColor; end; 1.1.2.2.更新组件颜色方法UpdateColor 可以看到,两个设置函数中,都调用了一个UpdateColor,因为很多属性的改变都会改变颜色,所以将颜色更新部分提取出来,声明一个被保护的方法: protected { Protected declarations } procedure UpdateColor; 代码部分如下: procedure TGcxCustomEdit.UpdateColor; begin if ReadOnly then inherited Color := FReadOnlyColor else inherited Color := FCommonColor; end; 看起来很简单吧,可以看看效果了。当ReadOnly为假的时候,你修改FCommonColor属性,组件的颜色会变化;当ReadOnly为真的时候,你修改FReadOnlyColor属性,组件的颜色会变化;但是修改ReadOnly属性,不会产生变化。 关于如何发布组件,后面叙述,请参考1.1.5.发布 TGcxEdit。 1.1.3.修改已有属性、方法 1.1.3.1.继承只读属性ReadOnly 想要在修改ReadOnly属性时,颜色自动变化,就要重新声明和书写ReadOnly属性: private function GetColor: TColor; procedure SetColor(const Value: TColor); protected property Color: TColor read GetColor write SetColor default clInfoBk; 代码部分很简单,首先就是引用父类属性,并在 Set 方法中调用 UpdateColor 更新组件颜色。 function TGcxCustomEdit.GetReadOnly: Boolean; begin Result := inherited ReadOnly; end;
procedure TGcxCustomEdit.SetReadOnly(const Value: Boolean); begin inherited ReadOnly := Value; UpdateColor; end; 1.1.3.2.继承颜色属性Color 此时,修改Color会怎样呢?仅仅是改变了组件的当前颜色,因为FCommonColor和FReadOnlyColor没有变化,当你修改CommonColor、ReadOnlyColor或ReadOnly属性时,Color属性会重新改变,同样,修改Color属性避免该问题: private function GetColor: TColor; procedure SetColor(const Value: TColor); protected property Color: TColor read GetColor write SetColor default clInfoBk; 与ReadOnly属性修改类似: function TGcxCustomEdit.GetColor: TColor; begin Result := inherited Color; end;
procedure TGcxCustomEdit.SetColor(const Value: TColor); begin if ReadOnly then FReadOnlyColor := Value else FCommonColor := Value; UpdateColor; end; 这里的关键点是判断ReadOnly属性,并根据该属性决定将当前颜色设置到FCommonColor还是FReadOnlyColor中。 1.1.4.设计构造器 当你书写了那些属性和方法之后,如果没有书写一个相应的构造器,你将面对一个很郁闷的界面,那可能是你不想看到的结果。 public constructor Create(AOwner: TComponent); override; published property Width default 49;
constructor TGcxCustomEdit.Create(AOwner: TComponent); begin inherited; FCommonColor := clInfoBk; FReadOnlyColor := clSkyBlue; UpdateColor; ImeName := ''; Width := 49; end; 很简单的代码,就是设置一些初始值。 好了,它基本完工了。当然,如果以后从它再次继承的时候,它还有一些缺陷需要修正,如果它就是终结版的话,已经够用了。 关于修正缺陷的描述,后面叙述。 1.1.5.发布TGcxEdit TGcxCustomEdit并没有公开(Public)和公布(Published)任何属性、方法,想要在设计期间修改属性或运行期间控制该组件,就需要发布一个标准的组件出来,很简单: TGcxEdit = class(TGcxCustomEdit) published property CommonColor; property ReadOnlyColor; 这样就公布了新派生的属性,然后再将TTntCustomEdit原有的一些属性、方法、事件公布出来: TGcxEdit = class(TGcxCustomEdit) published property Align; property Anchors; property AutoSelect; …… property Text; property Visible; property OnChange; property OnClick; property OnContextPopup; …… property OnMouseMove; property OnMouseUp; property OnStartDock; property OnStartDrag; end; 最后一步,注册组件: procedure Register; begin RegisterComponents('GameControlX', [TGcxEdit]); end; 1.2.设计一个数值输入组件TGcxIntEdit 很多时候,我们需要一个能够输入数值的对象,TEdit虽然可以完成,但需要屏蔽按键消息、考虑字符串的合法性,还要负责字符串与数值的相互转换。 这个组件的设计思想,很多地方参考了IOComp的TiIntegerOutput组件。 1.2.1.从TGcxCustomEdit开始继承 前面设计了 TGcxCustomEdit,我们可以从它开始衍生新的类型。 新的组件将提供整数的输入,那么需要一个Value属性,如果想限制Value范围,还要增加ValueMax、ValueMin属性。 TGcxCustomIntEdit = class(TGcxCustomEdit) private FValueMax: Integer; FValue: Integer; FValueMin: Integer; protected property Value : Integer read FValue write SetValue default 0; property ValueMax : Integer read FValueMax write SetValueMax default 0; property ValueMin : Integer read FValueMin write SetValueMin default 0; 好了,开始填写代码: procedure TGcxCustomIntEdit.SetValue(const Value: Integer); var TempValue : Integer; begin TempValue := Value;
if not ((FValueMax = 0) and (FValueMin = 0)) and not Loading then begin if TempValue > FValueMax then TempValue := FValueMax; if TempValue < FValueMin then TempValue := FValueMin; end;
if FValue <> TempValue then begin FValue := TempValue; UpdateText; end; end;
procedure TGcxCustomIntEdit.SetValueMax(const Value: Integer); begin if FValueMax <> Value then begin FValueMax := Value; Self.Value := FValue; end; end;
procedure TGcxCustomIntEdit.SetValueMin(const Value: Integer); begin if FValueMin <> Value then begin FValueMin := Value; Self.Value := FValue; end; end; 在SetValue这里出现了两个关键词:Loading和UpdateText。 Loading用于判断组件的装载状态,避免反复更新数据并刷新显示,这个属性方法将在TGcxCustomEdit中增加。 UpdateText用于刷新组件的文本显示。 1.2.2.数据类型与限制 1.2.2.1.数据输入类型FormatStyle 为了输入、输出包括10进制、2进制、8进制、16进制数据,扩展一个FormatStyle属性,参考TiIntegerOutput组件。 type TIntegerFormatStyle = (ifsInteger, ifsHex, ifsBinary, ifsOctal); TGcxCustomIntEdit = class(TGcxCustomEdit) private FFormatStyle: TIntegerFormatStyle; procedure SetFormatStyle(const Value: TIntegerFormatStyle); protected property FormatStyle: TIntegerFormatStyle read FFormatStyle write SetFormatStyle default ifsInteger; 代码如下: procedure TGcxCustomIntEdit.SetFormatStyle(const Value: TIntegerFormatStyle); begin if FFormatStyle <> Value then begin FFormatStyle := Value; UpdateText; end; end; 1.2.2.2.数据输入长度MaxLength 为了能够限制数据输入长度,重载 MaxLength 属性: private function GetMaxLength: Integer; procedure SetMaxLength(const Value: Integer); protected property MaxLength: Integer read GetMaxLength write SetMaxLength default 0; 代码如下: function TGcxCustomIntEdit.GetMaxLength: Integer; begin Result := inherited MaxLength; end;
procedure TGcxCustomIntEdit.SetMaxLength(const Value: Integer); begin inherited MaxLength := Value; UpdateText; end; 1.2.2.3.字符“0”前缀属性LeadingZeros private FLeadingZeros: Boolean; procedure SetLeadingZeros(const Value: Boolean); protected property LeadingZeros: Boolean read FLeadingZeros write SetLeadingZeros default False; 代码部分: procedure TGcxCustomIntEdit.SetLeadingZeros(const Value: Boolean); begin if FLeadingZeros <> Value then begin FLeadingZeros := Value; UpdateText; end; end; 同样,设置属性的最后,还是更新文本(UpdateText)。 1.2.3.数据的读写 1.2.3.1.从Value更新文本 此处开始大规模剽窃TiIntegerOutput,功力浅的可以不求甚解。 甚解不是初学者应该关心的事情,毕竟李维、侯捷那种人凤毛麟角。但一定要求解,至少要明白你在做什么、它在做什么。 TGcxCustomIntEdit = class(TGcxCustomEdit) protected function GetText(Value: Integer): WideString; procedure UpdateText;
function TGcxCustomIntEdit.GetText(Value: Integer): WideString; var TempMaxLength : Integer; begin TempMaxLength := MaxLength; case FFormatStyle of ifsInteger: begin end; ifsHex: begin if (TempMaxLength > 8) or (TempMaxLength = 0) then TempMaxLength := 8; end; ifsBinary: begin if (TempMaxLength > 32) or (TempMaxLength = 0) then TempMaxLength := 32; end; ifsOctal: begin if (TempMaxLength > 10) or (TempMaxLength = 0) then TempMaxLength := 10; end; else Exit; end; Result := GcxIntToStr(Value, FFormatStyle, TempMaxLength, FLeadingZeros); end; 1.2.3.2.公共方法UpdateText procedure TGcxCustomIntEdit.UpdateText; begin Text := GetText(FValue); end; 1.2.3.3.转换函数GcxIntToStr 这段函数来源自IOComp组件库iGPFunctions单元的iIntToStr,但是原有的“Value: Longword”显然是有问题的,因此修改类型为Int64。 function GcxIntToStr(Value: Int64; Format: TIntegerFormatStyle; MaxLength: Integer; LeadingZeros: Boolean): String; var x : Integer; ShiftMultiplier : Integer; DigitValue : Integer; TempValue : Longword; begin Result := '';
ShiftMultiplier := 0; TempValue := Value;
case Format of ifsInteger: begin Result := IntToStr(Value); end; ifsHex: begin for x := 1 to 8 do begin if ShiftMultiplier <> 0 then TempValue := Value shr (4 * ShiftMultiplier); DigitValue := TempValue and $F; Result := IntToHex(DigitValue, 1) + Result; Inc(ShiftMultiplier); end; end; ifsBinary: begin for x := 1 to 32 do begin if ShiftMultiplier <> 0 then TempValue := Value shr (1 * ShiftMultiplier); DigitValue := TempValue and $1; Result := IntToStr(DigitValue) + Result; Inc(ShiftMultiplier); end; end; ifsOctal: begin for x := 1 to 10 do begin if ShiftMultiplier <> 0 then TempValue := Value shr (3*ShiftMultiplier); DigitValue := TempValue and $7; Result := IntToStr(DigitValue) + Result; Inc(ShiftMultiplier); end; end; end;
while Copy(Result, 1, 1) = '0' do Result := Copy(Result, 2, Length(Result) - 1);
if LeadingZeros then begin while Length(Result) < MaxLength do Result := '0' + Result; end;
if Result = '' then Result := '0'; end; 好了,现在可以通过修改Value属性,显示相应的数值了,但是输入呢? 1.2.3.4.重载DoExit protected procedure CompleteChange; override; procedure DoExit; override; function GetValue(Value: WideString): Integer; DoExit方法来源于TWinControl,响应的是CM_EXIT消息。实现代码如下: procedure TGcxCustomIntEdit.CompleteChange; begin inherited; Value := GetValue(Text); end;
procedure TGcxCustomIntEdit.DoExit; begin inherited; CompleteChange; end;
function TGcxCustomIntEdit.GetValue(Value: WideString): Integer; begin Result := 0; try case FFormatStyle of ifsInteger : Result := GcxStrToInt( Value); ifsHex : Result := GcxStrToInt('$' + Value); ifsBinary : Result := GcxStrToInt('b' + Value); ifsOctal : Result := GcxStrToInt('o' + Value); end; except on e : exception do begin if FUndoOnError then begin Undo; Result := FValue; if FBeepOnError then Beep; end else raise; end; end; end; 1.2.3.5.转换函数GcxStrToInt 这段函数来源自IOComp组件库iGPFunctions单元的iStrToInt,依旧是剽窃,可贾宝玉都说了“除四书外无书,其他都是杜撰的”,我们剽窃一下也无所谓。 function GcxStrToInt(Value: String): Int64; var ACharacter : String; AString : String; CurrentPower : Integer;
begin Result := 0; CurrentPower := 0; ACharacter := Copy(Value, 1, 1);
if ACharacter = 'b' then begin AString := Copy(Value, 2, Length(Value) -1); while Length(AString) <> 0 do begin ACharacter := Copy(AString, Length(AString), 1); Result := Result + StrToInt(ACharacter) * Trunc(Power(2, CurrentPower) + 0.0001); AString := Copy(AString, 1, Length(AString) -1); Inc(CurrentPower); end; end else if ACharacter = 'o' then begin AString := Copy(Value, 2, Length(Value) -1); while Length(AString) <> 0 do begin ACharacter := Copy(AString, Length(AString), 1); Result := Result + StrToInt(ACharacter) * Trunc(Power(8, CurrentPower) + 0.0001); AString := Copy(AString, 1, Length(AString) -1); Inc(CurrentPower); end; end else begin Result := StrToInt(Value); end; end; 1.2.3.6.关于BeepOnError与UndoOnError属性 这两个属性目前看来可有可无,因为从IOComp剽窃,暂时保留这两个属性。 private FBeepOnError: Boolean; FUndoOnError: Boolean; protected property BeepOnError: Boolean read FBeepOnError write FBeepOnError default False; property UndoOnError: Boolean read FUndoOnError write FUndoOnError default True; 1.2.3.7.键盘响应 以上的设计,可以实现代码控制的数值输入及显示,但无法限制键盘输入,那么增加一个AllowKey来判断并过滤键盘输入,为了今后扩展方便,AllowKey将从TGcxCustomEdit增加,并通过KeyPress事件处理程序调用。 protected { Protected declarations } function AllowKey(Key: Char): Boolean; override; 代码实现: function TGcxCustomIntEdit.AllowKey(Key: Char): Boolean; var BadKey : Boolean; begin case FormatStyle of ifsInteger : BadKey := not (Key in [#8, '0'..'9', '-']); ifsHex : BadKey := not (Key in [#8, '0'..'9', 'a'..'f', 'A'..'F']); ifsBinary : BadKey := not (Key in [#8, '0'..'1']); ifsOctal : BadKey := not (Key in [#8, '0'..'7']); else BadKey := True; end;
if BadKey then begin if FBeepOnError then Beep; end; Result := not BadKey; end; 1.2.4.修改父类TGcxCustomEdit 1.2.4.1.组件的csLoading标志与Loading属性设计 这个属性可以为组件本事和衍生的子类提供状态信息。 TGcxCustomEdit = class(TTntCustomEdit) private FLoading: Boolean; protected function GetLoading: Boolean; procedure SetLoading(Value: Boolean); property Loading: Boolean read GetLoading; 代码部分: function TGcxCustomEdit.GetLoading: Boolean; begin Result := False; if csLoading in ComponentState then Result := True; if FLoading then Result := True; end; 当组件正从资料流中读出时,它的ComponentState属性会包含csLoading标志。 procedure TGcxCustomEdit.SetLoading(Value: Boolean); begin FLoading := Value end; 1.2.4.2.键盘输入响应KeyPress及AllowKey TGcxCustomEdit = class(TTntCustomEdit) protected function AllowKey(Key: Char): Boolean; virtual; procedure KeyPress(var Key: Char); override; 代码部分: function TGcxCustomEdit.AllowKey(Key: Char): Boolean; begin Result := True; end;
procedure TGcxCustomEdit.KeyPress(var Key: Char); begin inherited; if not AllowKey(Key) then begin Key := #0; end; end;
1.2.4.3.组件焦点丢失的处理CompleteChange procedure CompleteChange; virtual;
procedure TGcxCustomEdit.CompleteChange; begin end; 1.2.5.设计构造器 同样,一个装载初始值的构造函数是必须存在的。 constructor TGcxCustomIntEdit.Create(AOwner: TComponent); begin inherited; Self.ImeName := ''; Self.ImeMode := imClose;
FUndoOnError := True; FValueMax := 0; FValue := 0; UpdateText; end; 1.2.6.发布TGcxIntEdit 参照TGcxEdit,就是将TGcxCustomIntEdit的属性、方法、事件公开。 例如: published { Published declarations } property CommonColor; property FormatStyle; property LeadingZeros; property ReadOnlyColor; property Value; property ValueMax; property ValueMin;
|
请发表评论