Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.11.27;
Скачать: CL | DM;

Вниз

TPropertyEditor -> TOrdinalProperty   Найти похожие ветки 

 
Mutex   (2005-04-02 10:40) [0]

Я уже замучался с этими редакторами свойств, т.к. ведут они себя несколько странно. Допустим у меня есть редактор свойства с типом LongWord, но при регистрации, если указать этот самый LongWord, то свойство не будет связано с компонентом! Но с integer, как это ни странно все работает. Сейчас проблема с другим свойством имеющим тип HKEY(Cardinal). Разработаный эдитор ни как не хочет связываться со свойством!!!! Вот его простейший код:

 TRegistryKeysProperty = class(TOrdinalProperty)
 public
   function GetAttributes: TPropertyAttributes; override;
   function GetValue: string; override;
   procedure GetValues(Proc: TGetStrProc); override;
   procedure SetValue(const Value: string); override;
 end;

 procedure Register;

implemetation

procedure Register;
begin
 RegisterPropertyEditor(TypeInfo(Cardinal), TRegistrySerializer, "RootKey",
   TRegistryKeysProperty);
end;

const
 S_HCR = "HKEY_CLASSES_ROOT";
 S_HCU = "HKEY_CURRENT_USER";
 S_HLM = "HKEY_LOCAL_MACHINE";
 S_HU  = "HKEY_USERS";
 S_HPD = "HKEY_PERFOMANCE_DATA";
 S_HCC = "HKEY_CURRENT_CONFIG";
 S_HDD = "HKEY_DYN_DATA";

function TRegistryKeysProperty.GetAttributes: TPropertyAttributes;
begin
 Result := [paValueList, paMultiSelect]
end;

function TRegistryKeysProperty.GetValue: string;
var
 OrdVal: Cardinal;
begin
 OrdVal := GetOrdValue;
 case OrdVal of
   Windows.HKEY_CLASSES_ROOT: Result := S_HCR;
   Windows.HKEY_CURRENT_USER: Result := S_HCU;
   Windows.HKEY_LOCAL_MACHINE: Result := S_HLM;
   Windows.HKEY_USERS: Result := S_HU;
   Windows.HKEY_PERFORMANCE_DATA: Result := S_HPD;
   Windows.HKEY_CURRENT_CONFIG: Result := S_HCC;
   Windows.HKEY_DYN_DATA: Result := S_HDD;
 else
   Result := S_HCR
 end;
end;

procedure TRegistryKeysProperty.GetValues(Proc: TGetStrProc);
begin
 Proc(S_HCR);
 Proc(S_HCU);
 Proc(S_HLM);
 Proc(S_HU);
 Proc(S_HPD);
 Proc(S_HCC);
 Proc(S_HDD);
end;

procedure TRegistryKeysProperty.SetValue(const Value: string);
begin
 if Value = S_HCR then
   SetOrdValue(Integer(Windows.HKEY_CLASSES_ROOT))
 else if Value = S_HCU then
   SetOrdValue(Integer(Windows.HKEY_CURRENT_USER))
 else if Value = S_HLM then
   SetOrdValue(Integer(Windows.HKEY_LOCAL_MACHINE))
 else if Value = S_HU then
   SetOrdValue(Integer(Windows.HKEY_USERS))
 else if Value = S_HPD then
   SetOrdValue(Integer(Windows.HKEY_PERFORMANCE_DATA))
 else if Value = S_HCC then
   SetOrdValue(Integer(Windows.HKEY_CURRENT_CONFIG))
 else if Value = S_HDD then
   SetOrdValue(Integer(Windows.HKEY_DYN_DATA))
 else
   SetOrdValue(Integer(Windows.HKEY_CURRENT_USER));
end;


Кто нибудь прояснить, плз, ситуацию. Что нужно сделать чтобы редактор заработал(я уже n-ое количество времени не могу это сделать :( )????


 
Юрий Зотов ©   (2005-04-02 16:09) [1]

С LongWord все нормально работает, c HKEY - нет. Похоже, что для HKEY не генерится RTTI, но это совершенно неважно, вместо HKEY можно использовать любой 4-байтовый беззнаковый тип (а при отключенном Range Checking даже и знаковый).

Вот слегка подправленный код, проверялся в D7.


unit MyComp; // В run-time пакете

interface

uses
 Windows, SysUtils, Classes;

type
 TRegistrySerializer = class(TComponent)
 private
   FRootKey: LongWord;
   procedure SetRootKey(const Value: LongWord);
 public
   constructor Create(AOwner: TComponent); override;
 published
   property RootKey: LongWord read FRootKey write SetRootKey default HKEY_CLASSES_ROOT;
 end;

implementation

{ TRegistrySerializer }

constructor TRegistrySerializer.Create(AOwner: TComponent);
begin
 inherited;
 FRootKey := HKEY_CLASSES_ROOT
end;

procedure TRegistrySerializer.SetRootKey(const Value: LongWord);
begin
 if (Value < HKEY_CLASSES_ROOT) or (Value > HKEY_DYN_DATA) then
   raise Exception.CreateFmt("$%x is invalid root key value", [Value]);
 FRootKey := Value;
end;

end.

============================================================

unit MyCompReg; // В design-time пакете

interface

uses
 Windows, SysUtils, Classes, MyComp, DesignIntf, DesignEditors;

type
 TRootKeyProperty = class(TOrdinalProperty)
 public
   function GetAttributes: TPropertyAttributes; override;
   function GetValue: string; override;
   procedure GetValues(Proc: TGetStrProc); override;
   procedure SetValue(const Value: string); override;
 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents("Examples", [TRegistrySerializer]);
 RegisterPropertyEditor(TypeInfo(LongWord), TRegistrySerializer, "RootKey", TRootKeyProperty);
end;

const
 sRootKey: array[HKEY_CLASSES_ROOT..HKEY_DYN_DATA] of string =
    ("HKEY_CLASSES_ROOT", "HKEY_CURRENT_USER", "HKEY_LOCAL_MACHINE", "HKEY_USERS",
     "HKEY_PERFOMANCE_DATA", "HKEY_CURRENT_CONFIG", "HKEY_DYN_DATA");

{ TRootKeyProperty }

function TRootKeyProperty.GetAttributes: TPropertyAttributes;
begin
 Result := inherited GetAttributes + [paValueList, paSortList]
end;

function TRootKeyProperty.GetValue: string;
begin
 Result := sRootKey[GetOrdValue]
end;

procedure TRootKeyProperty.GetValues(Proc: TGetStrProc);
var
 i: LongWord;
begin
 for i := Low(sRootKey) to High(sRootKey) do
   Proc(sRootKey[i])
end;

procedure TRootKeyProperty.SetValue(const Value: string);
var
 i: LongWord;
begin
 for i := Low(sRootKey) to High(sRootKey) do
   if AnsiSameText(Value, sRootKey[i]) then
   begin
     SetOrdValue(Integer(i));
     Exit
   end;
 raise Exception.CreateFmt(""%s" is invalid root key name", [Value])
end;

end.


 
Mutex   (2005-04-02 17:06) [2]

Большое спасибо:) Действительно, смена типа в классе - это решение проблемы :)



Страницы: 1 вся ветка

Текущий архив: 2005.11.27;
Скачать: CL | DM;

Наверх




Память: 0.48 MB
Время: 0.029 c
14-1130911527
Ega23
2005-11-02 09:05
2005.11.27
С днем рождения! 2 ноября


2-1131363541
root
2005-11-07 14:39
2005.11.27
ADO


2-1131103736
syte_ser78
2005-11-04 14:28
2005.11.27
как сохранить изменения в базе? BDE.


3-1129253591
fedor
2005-10-14 05:33
2005.11.27
Инсталляция вместе с драйверами InterBase


11-1112330908
DeimosX7
2005-04-01 08:48
2005.11.27
PaintBox