Форум: "Прочее";
Текущий архив: 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