Właściwości dowolnego obiektu

jozkan

2008-05-22 16:52:16
2008-05-23 14:58:08
2 komentarze
1577 odsłon

Jak zmienić Properties dowolnego obiektu? Wrzuć na Formę Memo oraz Button i sprawdź jak procedura SetObjectProperties zmienia Properties Memo i Buttona


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type

   Tfont_def=record
               font_name:string;
               font_size:Integer;
               font_color:TColor;
               font_style:TFontStyles;
            end;

   Tobject_property=(rect_op,align_op,cursor_op,color_op,font_op,caption_op,hint_op);
   Tobject_properties=set of Tobject_property;

   Tobject_properties_values=record
                               properties_exists:Tobject_properties;
                               rect_val:TRect;
                               align_val:TAlign;
                               cursor_val:TCursor;
                               color_val:TColor;
                               font_val:Tfont_def;
                               caption_val:string;
                               hint_val:string;
                            end;


   TForm1 = class(TForm)
     Memo1: TMemo;
     Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   end;

var
   Form1: TForm1;

   procedure SetObjectProperties(a_obj:TObject;prop_types:Tobject_properties;prop_values:Tobject_properties_values);

implementation

{$R *.DFM}

uses TypInfo;

procedure Tfont_def_To_TFont(a_font:Tfont_def;aFont:TFont);
begin
   if aFont=nil then Exit;
   with aFont,a_font do
   begin
      Name:=font_name;
      Size:=font_size;
      Color:=font_color;
      Style:=font_style;
   end;
end;

function AlignToString(val:TAlign):string;
begin
   Result:='';
   case val of
      alNone:Result:='alNone';
      alTop:Result:='alTop';
      alBottom:Result:='alBottom';
      alLeft:Result:='alLeft';
      alRight:Result:='alRight';
      alClient:Result:='alClient';
   end;
end;

function CursorNameToInt(val:TCursor):Integer;
begin
   Result:=0;
   case val of
      crNone:Result:=-1;
      crArrow:Result:=-2;
      crCross:Result:=-3;
      crIBeam:Result:=-4;
      crSizeNESW:Result:=-6;
      crSizeNS:Result:=-7;
      crSizeNWSE:Result:=-8;
      crSizeWE:Result:=-9;
      crUpArrow:Result:=-10;
      crHourGlass:Result:=-11;
      crDrag:Result:=-12;
      crNoDrop:Result:=-13;
      crHSplit:Result:=-14;
      crVSplit:Result:=-15;
      crMultiDrag:Result:=-16;
      crSQLWait:Result:=-17;
      crNo:Result:=-18;
      crAppStart:Result:=-19;
      crHelp:Result:=-20;
      crHandPoint:Result:=-21;
      crSizeAll:Result:=-22;
   end;
end;


procedure SetObjectProperties(a_obj:TObject;prop_types:Tobject_properties;prop_values:Tobject_properties_values);
var
   prop_info:PPropInfo;
   a_font:TFont;
begin
   if prop_types=[] then Exit;if a_obj=nil then Exit;

   if rect_op in prop_types then
   begin
      prop_info:=GetPropInfo(a_obj.ClassInfo,'Left');
      if prop_info<>nil then SetOrdProp(a_obj,prop_info,prop_values.rect_val.Left);

      prop_info:=GetPropInfo(a_obj.ClassInfo,'Top');
      if prop_info<>nil then SetOrdProp(a_obj,prop_info,prop_values.rect_val.Top);

      prop_info:=GetPropInfo(a_obj.ClassInfo,'Width');
      if prop_info<>nil then SetOrdProp(a_obj,prop_info,prop_values.rect_val.Right-prop_values.rect_val.Left);

      prop_info:=GetPropInfo(a_obj.ClassInfo,'Height');
      if prop_info<>nil then SetOrdProp(a_obj,prop_info,prop_values.rect_val.Bottom-prop_values.rect_val.Top);
   end;

   if align_op in prop_types then
   begin
      prop_info:=GetPropInfo(a_obj.ClassInfo,'Align');
      if prop_info<>nil then SetEnumProp(a_obj,prop_info,AlignToString(prop_values.align_val));
   end;

   if cursor_op in prop_types then
   begin
      prop_info:=GetPropInfo(a_obj.ClassInfo,'Cursor');
      if prop_info<>nil then SetOrdProp(a_obj,prop_info,CursorNameToInt(prop_values.cursor_val));
   end;

   if color_op in prop_types then
   begin
      prop_info:=GetPropInfo(a_obj.ClassInfo,'Color');
      if prop_info<>nil then SetOrdProp(a_obj,prop_info,ColorToRgb(prop_values.color_val));
   end;

   if font_op in prop_types then
   begin
      a_font:=TFont.Create;
      try
         prop_info:=GetPropInfo(a_obj.ClassInfo,'Font');
         if prop_info<>nil then
         begin
            Tfont_def_To_TFont(prop_values.font_val,a_font);
            SetObjectProp(a_obj,prop_info,a_font);
         end;
      finally
         a_font.Free;
      end;
   end;

   if caption_op in prop_types then
   begin
      prop_info:=GetPropInfo(a_obj.ClassInfo,'Caption');
      if prop_info<>nil then SetStrProp(a_obj,prop_info,prop_values.caption_val);
   end;

   if hint_op in prop_types then
   begin
      prop_info:=GetPropInfo(a_obj.ClassInfo,'Hint');
      if prop_info<>nil then SetStrProp(a_obj,prop_info,prop_values.hint_val);
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   Memo1.ShowHint:=True;
   Memo1.Hint:='Hint przed zmianą';
   Memo1.Text:='W tym Memie będą zmienione Properties. Wciśnij "Caption przed zmianą". '+
               'Zwróć uwagę że Caption Buttona również ulegnie zmianie, '+
               'sprawdź także Hint Mema obecnie oraz po zmianie';

   Button1.Width:=200;
   Button1.Caption:='Caption przed zmianą';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   a_font:Tfont_def;
   prop_values:Tobject_properties_values;
begin
   with prop_values do
   begin
      rect_val:=Rect(20,20,40+Memo1.Width,40+Memo1.Height);
      align_val:=alClient;
      cursor_val:=crHourGlass;
      color_val:=clYellow;

      with font_val do
      begin
         font_name:='Arial';
         font_size:=12;
         font_color:=clBlue;
         font_style:=[fsBold];
      end;

     caption_val:='Nowy Caption Buttona';
     hint_val:='nowy hint Memo';
   end;

   SetObjectProperties(Button1,[caption_op],prop_values);
   SetObjectProperties(Memo1,[rect_op,align_op,cursor_op,color_op,font_op,hint_op],prop_values);
end;

end.

Jeżeli chcesz odczytać właściwości dowolnego obiektu, zastosuj funkcję GetObjectProperties:


function StringToAlign(val:string):TAlign;
begin
   if val='alNone' then Result:=alNone else
   if val='alTop' then Result:=alTop else
   if val='alBottom' then Result:=alBottom else
   if val='alLeft' then Result:=alLeft else
   if val='alRight' then Result:=alRight else
   if val='alClient' then Result:=alClient;
end;

function CursorIntToName(val:TCursor):Integer;
begin
   Result:=crDefault;
   case val of
      -1:Result:=crNone;
      -2:Result:=crArrow;
      -3:Result:=crCross;
      -4:Result:=crIBeam;
      -6:Result:=crSizeNESW;
      -7:Result:=crSizeNS;
      -8:Result:=crSizeNWSE;
      -9:Result:=crSizeWE;
      -10:Result:=crUpArrow;
      -11:Result:=crHourGlass;
      -12:Result:=crDrag;
      -13:Result:=crNoDrop;
      -14:Result:=crHSplit;
      -15:Result:=crVSplit;
      -16:Result:=crMultiDrag;
      -17:Result:=crSQLWait;
      -18:Result:=crNo;
      -19:Result:=crAppStart;
      -20:Result:=crHelp;
      -21:Result:=crHandPoint;
      -22:Result:=crSizeAll;
   end;
end;

procedure TFont_to_Tfont_def(aFont:TFont;var a_font:Tfont_def);
begin
   if aFont=nil then Exit;

   with aFont,a_font do
   begin
      font_name:=Name;
      font_size:=Size;
      font_color:=Color;
      font_style:=Style;
   end;
end;

function GetObjectProperties(a_obj:TObject;prop_types:Tobject_properties):Tobject_properties_values;

var
   prop_info:PPropInfo;
   prop_exists:Boolean;
   a_font:TFont;

begin
   with Result do
   begin
      properties_exists:=[];
      rect_val:=Rect(0,0,0,0);
      align_val:=alNone;
      cursor_val:=crDefault;
      color_val:=clWhite;
      with font_val do
      begin
         font_name:='Arial';
         font_size:=10;
         font_color:=clBlack;
         font_style:=[];
      end;
      caption_val:='';
      hint_val:='';
   end;
   if prop_types=[] then Exit;if a_obj=nil then Exit;

   if rect_op in prop_types then
   begin
      prop_exists:=True;
      prop_info:=GetPropInfo(a_obj.ClassInfo,'Left');if prop_info<>nil then
      Result.rect_val.Left:=GetOrdProp(a_obj,prop_info) else prop_exists:=False;

      //if prop_info^.PropType^.Kind=tkInteger...
      //(tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString, tkVariant, tkArray, tkRecord, tkInterface, tkDynArray);

      if prop_exists then
      begin
         prop_info:=GetPropInfo(a_obj.ClassInfo,'Top');if prop_info<>nil then
         Result.rect_val.Top:=GetOrdProp(a_obj,prop_info) else prop_exists:=False;
      end;

      if prop_exists then
      begin
         prop_info:=GetPropInfo(a_obj.ClassInfo,'Width');if prop_info<>nil then
         Result.rect_val.Right:=Result.rect_val.Left+GetOrdProp(a_obj,prop_info) else prop_exists:=False;
      end;

      if prop_exists then
      begin
         prop_info:=GetPropInfo(a_obj.ClassInfo,'Height');if prop_info<>nil then
         Result.rect_val.Bottom:=Result.rect_val.Top+GetOrdProp(a_obj,prop_info) else prop_exists:=False;
      end;

      if prop_exists then Include(Result.properties_exists,rect_op);
   end;

   if align_op in prop_types then
   begin
      prop_info:=GetPropInfo(a_obj.ClassInfo,'Align');if prop_info<>nil then
      begin
         Result.align_val:=StringToAlign(GetEnumProp(a_obj,prop_info));
         Include(Result.properties_exists,align_op);
      end;
   end;

   if cursor_op in prop_types then
   begin
      prop_info:=GetPropInfo(a_obj.ClassInfo,'Cursor');if prop_info<>nil then
      begin
         Result.cursor_val:=CursorIntToName(GetOrdProp(a_obj,prop_info));
         Include(Result.properties_exists,cursor_op);
      end;
   end;

   if color_op in prop_types then
   begin
      prop_info:=GetPropInfo(a_obj.ClassInfo,'Color');if prop_info<>nil then
      begin
         Result.color_val:=GetOrdProp(a_obj,prop_info);
         Include(Result.properties_exists,color_op);
      end;
   end;

   if font_op in prop_types then
   begin
      prop_info:=GetPropInfo(a_obj.ClassInfo,'Font');
      if prop_info<>nil then
      begin
         a_font:=GetObjectProp(a_obj,prop_info) as TFont;
         TFont_to_Tfont_def(a_font,Result.font_val);
         Include(Result.properties_exists,font_op);
      end;
   end;

   if caption_op in prop_types then
   begin
      prop_info:=GetPropInfo(a_obj.ClassInfo,'Caption');if prop_info<>nil then
      begin
         Result.caption_val:=GetStrProp(a_obj,prop_info);
         Include(Result.properties_exists,caption_op);
      end;
   end;

   if hint_op in prop_types then
   begin
      prop_info:=GetPropInfo(a_obj.ClassInfo,'Hint');if prop_info<>nil then
      begin
         Result.hint_val:=GetStrProp(a_obj,prop_info);
         Include(Result.properties_exists,hint_op);
      end;
   end;
end;

Integers
• 2009-03-24 19:42

Rzuciłem okiem i kod wygląda super tym bardziej, że niedawno się z tą tematyka zmagałem.
w Dynamiczne ustawianie właściwości
zamieściłem pytanie i tu mam część jego rozwiązania.

A czy możliwe jest pobranie własności komponentu ale w sposób bez rozdzielania na [b]Tobject_property[/b].

pobrać własność z listy i automatycznie jakimś Self...... albo ukrytego Uses uzyskać dostęp do własność,
zapisać to w postaci TStrings ( coś na wzór Form.dfm)

lukasz1235
• 2008-05-23 12:07

Jak zmienić Properties dowolnego obiektu?

Label1.Color:=clWhite;

Właściwości dowolnego obiektu

jozkan

2 komentarzy

Praca dla programistów

Forum dyskusyjne

Sprawy administracyjne

O nas

Skontaktuj się z nami