Форум: "Прочее";
Текущий архив: 2008.08.31;
Скачать: [xml.tar.bz2];
Внизредактирование свойств как в Object Inspector e Найти похожие ветки
← →
@!!ex © (2008-07-12 18:57) [0]Как сделать?
Есть ValueListEditor, но там только редактирование строк.
← →
VirEx © (2008-07-12 19:15) [1]примерно так:
uses TypInfo;
procedure TfrmEdit.GetInfo(obj: TObject; Props, PropsLang: array of string; IsIgnore: Boolean);
function find(strings: array of string; str: string): integer;
var
i: integer;
begin
result := -1;
for i := low(strings) to high(strings) do
if strings[i] = str then begin
result := i;
exit;
end;
end;
function ColorToString(Color: Integer): string;
begin
result := format("RGB (%d:%d:%d)", [GetRValue(Color), GetGValue(Color), GetBValue(Color)]);
end;
function FontToString(font: TFont): string;
var
style_: string;
begin
style_ := SetToString(GetPropInfo(font, "Style"), byte(font.Style), false);
if style_ = "" then style_ := "";
with font do
result := format("%s, %d, [%s]", [name, size, style_]);
end;
procedure AddColor(Key: string; Color: Integer);
begin
with vlProp.ItemProps[vlProp.InsertRow(key, ColorToString(Color), true)] do
begin
EditStyle := esEllipsis;
ReadOnly := true;
end;
end;
procedure AddFont(Key: string; Font: TFont);
begin
with vlProp.ItemProps[vlProp.InsertRow(key, FontToString(font), true)] do
begin
EditStyle := esEllipsis;
ReadOnly := true;
end;
end;
procedure AddEnumeration(KeyLang, Key, Val: string; Obj_: TObject);
var
i: integer;
list: TStrings;
PropInfo: PPropInfo;
TypeInfo: PTypeInfo;
T: PTypeData;
begin
list := TStringList.Create;
PropInfo := GetPropInfo(Obj_, Key);
TypeInfo := PropInfo^.PropType^;
T := GetTypeData(GetTypeData(TypeInfo)^.BaseType^);
for i := T.MinValue to T.MaxValue do list.add(GetEnumName(TypeInfo, i));
with vlProp do
with ItemProps[InsertRow(keyLang, Val, true)] do
begin
EditStyle := esPickList;
ReadOnly := true;
for i := 0 to list.Count - 1 do PickList.Add(list[i]);
end;
list.Free;
end;
procedure AddStrings(Key, Val: string);
begin
with vlProp.ItemProps[vlProp.InsertRow(Key, Val, True)] do
begin
EditStyle := esEllipsis;
ReadOnly := true;
end;
end;
var
pp: PPropList;
pt: PTypeData;
i: integer;
obj_: TPersistent;
begin
with vlProp do while rowcount > 1 do deleterow(rowcount - 1);
vlProp.Cells[0, 0] := ""; vlProp.Cells[1, 0] := "";
propNames.Clear;
propNamesLang.Clear;
pt := GetTypeData(Obj.ClassInfo);
GetMem(pp, pt^.PropCount * SizeOf(Pointer));
try
GetPropInfos(Obj.ClassInfo, pp);
for i := 0 to pt^.PropCount - 1 do
case IsIgnore of
True: if find(Props, pp^[i].Name) = -1 then begin propNames.Add(pp^[i].Name); propNamesLang.Add(PropsLang[find(Props, pp^[i].Name)]); end;
False: if find(Props, pp^[i].Name) > -1 then begin propNames.Add(pp^[i].Name); propNamesLang.Add(PropsLang[find(Props, pp^[i].Name)]); end;
end;
finally
FreeMem(pp);
end;
for i := 0 to propNames.Count - 1 do
case typinfo.PropType(Obj, propNames[i]) of
tkString, tkLString: vlProp.InsertRow(propNamesLang[i], GetStrProp(Obj, propNames[i]), True);
tkInteger:
if GetPropInfo(Obj.ClassType, propNames[i])^.PropType^^.Name = "TColor" then AddColor(propNamesLang[i], GetOrdProp(Obj, propNames[i]))
else
vlProp.InsertRow(propNamesLang[i], IntToStr(GetOrdProp(Obj, propNames[i])), True);
tkClass: begin
Obj_ := TPersistent(GetOrdProp(Obj, propNames[i]));
if Obj_ is TFont then AddFont(propNamesLang[i], TFont(Obj_))
else
if Obj_ is TStrings then AddStrings(propNamesLang[i], "(TStrings)");
//if Obj_ is TStrings then mStatusMask.Text:=TStrings(Obj_).Text;//AddStrings(propNames[i],TStrings(Obj_).Text);
end;
tkEnumeration: AddEnumeration(propNamesLang[i], propNames[i], GetEnumProp(Obj, propNames[i]), Obj);
end;
end;
CODE>
← →
VirEx © (2008-07-12 19:16) [2]
procedure TfrmEdit.vlPropValidate(Sender: TObject; ACol, ARow: Integer;
const KeyName, KeyValue: string);
var
Obj: TObject;
i: integer;
Key: string;
begin
Key := propNames[ARow];
//сохраняем отредактированное свойство
for i := 0 to lbUnits.Count - 1 do
if lbUnits.Selected[i] then begin
Obj := TWinControl(CurrentContainer.Controls[i]);
try
case typinfo.PropType(Obj, Key) of
tkString, tkLString: SetStrProp(Obj, Key, KeyValue);
tkInteger: SetOrdProp(Obj, Key, StrToInt(KeyValue));
tkEnumeration: SetEnumProp(Obj, Key, KeyValue);
end;
frmMain.SetSchemaModified;
except end;
end;
end;
procedure TfrmEdit.vlPropEditButtonClick(Sender: TObject);
var
Obj: TObject;
KeyName: string;
i: integer;
f: TFont;
begin
KeyName := propNames[vlProp.Row];
Obj := CurrentControl;
case typinfo.PropType(Obj, KeyName) of
tkClass: begin
Obj := TPersistent(GetOrdProp(Obj, KeyName));
if Obj is TFont then begin
FontDialog.Font.Assign(TFont(Obj));
if FontDialog.Execute then
TFont(Obj).Assign(FontDialog.Font);
f := TFont.Create;
f.Assign(TFont(Obj));
for i := 0 to lbUnits.Count - 1 do
if lbUnits.Selected[i] then begin
Obj := TWinControl(CurrentContainer.Controls[i]);
Obj := TPersistent(GetOrdProp(Obj, KeyName));
TFont(Obj).Assign(f);
end;
f.Free;
end else
if Obj is TStrings then exit; //мы редактируем строки отдельно
end;
tkInteger:
if GetPropInfo(Obj.ClassType, KeyName)^.PropType^^.Name = "TColor" then begin
ColorDialog.Color := TColor(GetOrdProp(Obj, KeyName));
if ColorDialog.Execute then SetOrdProp(Obj, KeyName, ColorDialog.Color);
for i := 0 to lbUnits.Count - 1 do
if lbUnits.Selected[i] then begin
Obj := TWinControl(CurrentContainer.Controls[i]);
SetOrdProp(Obj, KeyName, ColorDialog.Color);
end;
end;
end;
i := vlProp.Row;
lbUnitsMouseUp(Sender, TMouseButton(nil), [], 0, 0);
vlProp.Row := i; //выделяем заново
frmMain.SetSchemaModified;
end;
procedure TfrmEdit.vlPropSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
var
Obj: TObject;
begin
//выводим для редактирования отдельно TStrings в мемо
mStrings.Text := "";
Obj := CurrentControl;
case typinfo.PropType(Obj, propNames[ARow]) of
tkClass: if TPersistent(GetOrdProp(Obj, propNames[ARow])) is TStrings then begin
Obj := TPersistent(GetOrdProp(Obj, propNames[ARow]));
mStrings.Text := TStrings(Obj).Text;
end;
end;
end;
procedure TfrmEdit.mStringsKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
Obj: TObject;
i: integer;
begin
//сохраняем из мемо
for i := 0 to lbUnits.Count - 1 do
if lbUnits.Selected[i] then begin
Obj := TWinControl(CurrentContainer.Controls[i]);
try
case typinfo.PropType(Obj, propNames[vlProp.Row]) of
tkClass: if TPersistent(GetOrdProp(Obj, propNames[vlProp.Row])) is TStrings then begin
Obj := TPersistent(GetOrdProp(Obj, propNames[vlProp.Row]));
//TStrings(Obj).Clear;
if mStrings.Text <> TStrings(Obj).Text then frmMain.SetSchemaModified;
TStrings(Obj).Text := mStrings.Text;
end;
end;
except
end;
end;
end;
← →
VirEx © (2008-07-12 19:19) [3]доступные свойства, и их рашн названия
примерноconst
TAdminUnitProps: array[0..16] of string = ("Alignment", "Active", "Top", "Left", "Font", "Caption", "Host", "MAC", "TTL", "Interval", "StatusMask", "ConnectionColor", "UnitType", "ImageFileName", "Width", "Height", "Connections");
TAdminUnitPropsLang: array[0..16] of string = ("Выравнивание", "Пинг в работе", "Верх", "Слева", "Шрифт", "Наименование", "Хост(IP)", "MAC", "TTL", "Интервал", "Статус (Маска)", "Цвет соединения", "Тип", "Имя файла рисунка", "Ширина", "Высота", "Соединения (не изменяется)");
← →
VirEx © (2008-07-12 19:24) [4]Вобще конечно проще переписать класс TValueListEditor и добавить чтонибудь типа SetCurrentObj(Obj : TObject)
← →
VirEx © (2008-07-13 11:26) [5]хоть бы спасибо сказал =\
← →
@!!ex © (2008-07-13 11:29) [6]Спасибо!
Я просто в эту тему не заглядывал...
← →
VirEx © (2008-07-13 12:05) [7]Не ну нормально да?
Задал вопрос и не заглядывал :)
← →
Loginov Dmitry © (2008-07-13 13:18) [8]> Вобще конечно проще переписать класс TValueListEditor и
> добавить чтонибудь типа SetCurrentObj(Obj : TObject)
Гораздо проще сделать на основе TStringGrid / TDrawGrid. Конечно можно и TValueListEditor заюзать, но столкнешься с различными его недоделками и в итоге будет дольше.
Еще можно найти готовые решения в виде сторонних библиотек (раньше попадались, но благополучно забылись :)
Страницы: 1 вся ветка
Форум: "Прочее";
Текущий архив: 2008.08.31;
Скачать: [xml.tar.bz2];
Память: 0.49 MB
Время: 0.006 c