注册并使用我自己的彩色/IdentToColor
注册并使用我自己的彩色/IdentToColor
提问于 2022-05-05 10:29:07
在我的Delphi包中，我有自己的颜色列表和相应的颜色名称。
当我将包注册到Delphi时，颜色将显示在属性编辑器的列表中，以及所有预定义的颜色：
当我将颜色分配给控件时，该颜色值将与其颜色名称保存在.dfm文件中。
但是，当我运行我的程序时，会显示一个应用程序错误：
错误读取Form1.Color:无效属性值
我添加了一个调用，在我的initialization单元的TSColor部分注册我自己的颜色转换函数，但是我没有为这些行获得任何调试器点。
如果我从当前项目的源( initialization )的.dpr部分添加调用，那么错误的原因是我的TSColor单元的initialization部分从未被执行。为什么会这样呢？
我可以将initialization调用添加到每个项目的项目源中，但是我更希望在我的任何一个项目单元中使用TSColors之后，这个调用就会自动进行。
是什么控制单元的initialization部分是否被编译/执行？
以下是我的`TSColors.pas单元的一些摘录：
我自己定义的颜色：
const
TSColorCount = 4;
clTSRed = TColor($005652EE); //5657327
clTSYellow = TColor($0080FFFE); //8454143
clTSGreen = TColor($004BF562); //4978017
clTSGray = TColor($00BCBCBD); //12369084
TSColorMap: array[0..TSColorCount - 1] of TIdentMapEntry = (
(Value: clTSRed; Name: 'clTSRed'),
(Value: clTSYellow; Name: 'clTSYellow'),
(Value: clTSGreen; Name: 'clTSGreen'),
(Value: clTSGray; Name: 'clTSGray')
)我有自己的相应函数将颜色名称转换为颜色值，反之亦然：
function TSColorToIdent(Color: Longint; var Ident: string): Boolean;
var
I: Integer;
begin
for I := Low(TSColorMap) to High(TSColorMap) do
if TSColorMap[I].Value = Color then
begin
Result := True;
Ident := TSColorMap[I].Name;
Exit;
end;
Result := ColorToIdent(Color, Ident); //No Color found. Do the original conversion.
end;
function TSIdentToColor(const Ident: string; var Color: Longint): Boolean;
var
I: Integer;
begin
Result := IdentToColor(Ident, Color);//first call Delphi original.
if not Result then //if Ident is no known Delphi color name, check my list.
for I := Low(TSColorMap) to High(TSColorMap) do
if SameText(TSColorMap[I].Name, Ident) then
begin
Result := True;
Color := TSColorMap[I].Value;
Exit;
end;
end;我有功能来注册我自己的颜色转换和重置到Delphi的原始：
procedure UnregisterCurrentColorConst;
var
Int2ID: TIntToIdent;
ID2Int: TIdentToInt;
begin
Int2ID := FindIntToIdent(TypeInfo(TColor));
ID2Int := FindIdentToInt(TypeInfo(TColor));
if Assigned(Int2ID) then
UnregisterIntegerConsts(TypeInfo(TColor), ID2Int, Int2ID);
end;
procedure RegisterTSColorIdent;
begin
UnregisterCurrentColorConst;
RegisterIntegerConsts(TypeInfo(TColor), TSIdentToColor, TSColorToIdent);
end;
procedure UnregisterTSColorIdent;
begin
UnregisterCurrentColorConst;
RegisterIntegerConsts(TypeInfo(TColor), IdentToColor, ColorToIdent);
end;该单元中的initialization部分：
initialization
RegisterTSColorIdent; //this line is never called.
finalization
UnregisterTSColorIdent;回答 1
Stack Overflow用户
发布于 2022-05-05 21:02:36
正如您在注释中所指出的，单元的initialization部分位于单元的end.之后，这就是为什么initialization没有执行的原因。
我只想指出，您的代码还有其他一些问题：
- 不能保证VCL的
ColorToIdent()/IdentToColor()函数是您要替换的函数。还可以安装其他包来注册自己的颜色转换功能。因此，在注册函数时，首先应该找到当前已注册的函数，并在覆盖它们之前保存它们，然后可以在函数中使用它们作为数组中不存在的值的后备。
- 您不需要为
TColor注销当前注册的转换函数。RTL的整数转换系统允许为同一类型注册多对函数。最后一个注册对将是RTL在运行时使用的活动对。因此，只需取消注册您自己的函数，以恢复前一个函数对的优先级。
- 您可以使用RTL的
IdentToInt()/IntToIdent()函数来简化转换函数。
说到这里，尝试更像这样的东西：
unit TSColors;
interface
uses
Vcl.Graphics;
const
clTSRed = TColor($005652EE); //5657327
clTSYellow = TColor($0080FFFE); //8454143
clTSGreen = TColor($004BF562); //4978017
clTSGray = TColor($00BCBCBD); //12369084
function TSColorToIdent(Color: Longint; var Ident: string): Boolean;
function TSIdentToColor(const Ident: string; var Color: Longint): Boolean;
implementation
uses
System.Classes;
const
TSColorMap: array[0..3] of TIdentMapEntry = (
(Value: clTSRed; Name: 'clTSRed'),
(Value: clTSYellow; Name: 'clTSYellow'),
(Value: clTSGreen; Name: 'clTSGreen'),
(Value: clTSGray; Name: 'clTSGray')
);
var
Int2ID: TIntToIdent;
ID2Int: TIdentToInt;
function TSColorToIdent(Color: Longint; var Ident: string): Boolean;
begin
Result := IntToIdent(Color, Ident, TSColorMap);
if (not Result) and Assigned(Int2ID) then
Result := Int2ID(Color, Ident);
end;
function TSIdentToColor(const Ident: string; var Color: Longint): Boolean;
begin
Result := IdentToInt(Ident, Color, TSColorMap);
if (not Result) and Assigned(ID2Int) then
Result := ID2Int(Ident, Color);
end;
procedure RegisterTSColorIdent;
begin
Int2ID := FindIntToIdent(TypeInfo(TColor));
ID2Int := FindIdentToInt(TypeInfo(TColor));
RegisterIntegerConsts(TypeInfo(TColor), TSIdentToColor, TSColorToIdent);
end;
procedure UnregisterTSColorIdent;
begin
UnregisterIntegerConsts(TypeInfo(TColor), TSIdentToColor, TSColorToIdent);
end;
initialization
RegisterTSColorIdent;
finalization
UnregisterTSColorIdent;
end.页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/72125688
复制相关文章
相似问题
腾讯云开发者
