home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / FR_Insp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-07-29  |  22.4 KB  |  870 lines
  1.  
  2. {******************************************}
  3. {                                          }
  4. {           FastReport CLX v2.4            }
  5. {             Object Inspector             }
  6. {                                          }
  7. { Copyright (c) 1998-2001 by Tzyganenko A. }
  8. {                                          }
  9. {******************************************}
  10.  
  11. unit FR_Insp;
  12.  
  13. interface
  14.  
  15. {$I FR.inc}
  16.  
  17. uses
  18.   SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs,
  19.   QExtCtrls, QStdCtrls, QButtons, FR_Class, FR_Ctrls, FR_Pars, FR_PopupLB;
  20.  
  21. type
  22.   TModifyEvent = procedure(Item: Integer) of object;
  23.   TGetObjectsEvent = procedure(List: TStrings) of object;
  24.   TSelectionChangedEvent = procedure(ObjName: String) of object;
  25.   TfrInspForm = class;
  26.  
  27.   TProp = class(TObject)
  28.   private
  29.     procedure SetValue(Value: Variant);
  30.     function GetValue: Variant;
  31.     function IsEnumNull: Boolean;
  32.   public
  33.     Text: String;
  34.     DataType: TfrDataTypes;
  35.     Editor: TNotifyEvent;
  36.     Enum: TStringList;
  37.     EnumValues: Variant;
  38.     constructor Create(PropValue: Variant; PropType: TfrDataTypes;
  39.       PropEnum: TStringList; PropEnumValues: Variant; PropEditor: TNotifyEvent); virtual;
  40.     destructor Destroy; override;
  41.     property Value: Variant read GetValue write SetValue;
  42.   end;
  43.  
  44.   TfrInspForm = class(TForm)
  45.     CB1: TComboBox;
  46.     Box: TScrollBox;
  47.     PaintBox1: TPaintBox;
  48.     Edit1: TEdit;
  49.     EditPanel: TPanel;
  50.     EditBtn: TfrSpeedButton;
  51.     ComboPanel: TPanel;
  52.     ComboBtn: TfrSpeedButton;
  53.     procedure PaintBox1Paint(Sender: TObject);
  54.     procedure FormCreate(Sender: TObject);
  55.     procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  56.       Shift: TShiftState; X, Y: Integer);
  57.     procedure Edit1KeyDown(Sender: TObject; var Key: Word;
  58.       Shift: TShiftState);
  59.     procedure EditBtnClick(Sender: TObject);
  60.     procedure FormDeactivate(Sender: TObject);
  61.     procedure FormDestroy(Sender: TObject);
  62.     procedure Edit1DblClick(Sender: TObject);
  63.     procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  64.     procedure FormResize(Sender: TObject);
  65.     procedure FormActivate(Sender: TObject);
  66.     procedure CB1DropDown(Sender: TObject);
  67.     procedure CB1Click(Sender: TObject);
  68.     procedure ComboBtnClick(Sender: TObject);
  69.     procedure LB1Click(Sender: TObject);
  70.     procedure Edit1MouseDown(Sender: TObject; Button: TMouseButton;
  71.       Shift: TShiftState; X, Y: Integer);
  72.     procedure FormShow(Sender: TObject);
  73.     procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  74.       Y: Integer);
  75.     procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  76.       Shift: TShiftState; X, Y: Integer);
  77.     procedure CB1DrawItem(Sender: TObject; Index: Integer; ARect: TRect;
  78.       State: TOwnerDrawState; var Handled: Boolean);
  79.   private
  80.     { Private declarations }
  81.     FItems: TStringList;
  82.     FItemIndex: Integer;
  83.     FOnModify: TModifyEvent;
  84.     FRowHeight: Integer;
  85.     w, w1: Integer;
  86.     b: TBitmap;
  87.     BusyFlag, BusyFlag1: Boolean;
  88.     DefHeight: Integer;
  89.     LB1: TfrPopupListBox;
  90. //    FTickCount: Integer;
  91.     Panel1: TPanel;
  92.     FOnHeightChanged: TNotifyEvent;
  93.     FOnGetObjects: TGetObjectsEvent;
  94.     FOnSelectionChanged: TSelectionChangedEvent;
  95.     FDown: Boolean;
  96.     LastProp: String;
  97.     procedure SetItems(Value: TStringList);
  98.     procedure SetItemIndex(Value: Integer);
  99.     function GetCount: Integer;
  100.     procedure DrawOneLine(i: Integer; a: Boolean);
  101.     procedure SetItemValue(Value: String);
  102.     function GetItemValue(i: Integer): String;
  103.     function CurItem: TProp;
  104.     function GetPropValue(Index: Integer): Variant;
  105.     procedure SetPropValue(Index: Integer; Value: Variant);
  106.     function GetClassName(ObjName: String): String;
  107.     procedure Localize;
  108.   public
  109.     { Public declarations }
  110.     CurObject: TObject;
  111.     ObjectName: String;
  112.     HideProperties: Boolean;
  113.     constructor Create(AOwner: TComponent); override;
  114.     procedure ClearProperties;
  115.     procedure AddProperty(PropName: String; PropValue: Variant;
  116.      PropType: TfrDataTypes; PropEnum: TStringList; PropEnumValues: Variant;
  117.      PropEditor: TNotifyEvent);
  118.     procedure ItemsChanged;
  119.     procedure Grow;
  120.     property PropValue[Index: Integer]: Variant read GetPropValue write SetPropValue;
  121.     property Items: TStringList read FItems write SetItems;
  122.     property ItemIndex: Integer read FItemIndex write SetItemIndex;
  123.     property Count: Integer read GetCount;
  124.     property SplitterPos: Integer read w1 write w1;
  125.     property OnModify: TModifyEvent read FOnModify write FOnModify;
  126.     property OnHeightChanged: TNotifyEvent read FOnHeightChanged write FOnHeightChanged;
  127.     property OnGetObjects: TGetObjectsEvent read FOnGetObjects write FOnGetObjects;
  128.     property OnSelectionChanged: TSelectionChangedEvent
  129.       read FOnSelectionChanged write FOnSelectionChanged;
  130.   end;
  131.  
  132.  
  133. implementation
  134.  
  135. {$R *.xfm}
  136.  
  137.  
  138. uses FR_Const, FR_Utils, Variants, Qt;
  139.  
  140. type
  141.   TInspPanel = class(TPanel)
  142.   protected
  143. //    procedure Paint; override;
  144.   end;
  145.  
  146.  
  147. {procedure TInspPanel.Paint;
  148. begin
  149. end;}
  150.  
  151.  
  152. {----------------------------------------------------------------------------}
  153. constructor TProp.Create(PropValue: Variant; PropType: TfrDataTypes;
  154.   PropEnum: TStringList; PropEnumValues: Variant; PropEditor: TNotifyEvent);
  155. begin
  156.   inherited Create;
  157.   DataType := PropType;
  158.   Editor := PropEditor;
  159.   Enum := PropEnum;
  160.   EnumValues := PropEnumValues;
  161.   Value := PropValue;
  162. end;
  163.  
  164. destructor TProp.Destroy;
  165. begin
  166.   EnumValues := 0;
  167.   inherited Destroy;
  168. end;
  169.  
  170. function TProp.IsEnumNull: Boolean;
  171. begin
  172.   Result := TVarData(EnumValues).VType < varArray;
  173. end;
  174.  
  175. procedure TProp.SetValue(Value: Variant);
  176.  
  177.   function ConvertToFloat(s: String): String;
  178.   var
  179.     v: Double;
  180.   begin
  181.     v := StrToFloat(s);
  182.     Result := FloatToStrF(v, ffFixed, 4, 2);
  183.   end;
  184.  
  185.   function ConvertToColor(s: String): String;
  186.   var
  187.     i, v: Integer;
  188.   begin
  189.     v := StrToInt(s);
  190.     Result := '$' + IntToHex(v, 6);
  191.     for i := 0 to 41 do
  192.       if v = frColors[i] then
  193.       begin
  194.         Result := frColorNames[i];
  195.         break;
  196.       end;
  197.   end;
  198.  
  199.   function ConvertToBoolean(s: String): String;
  200.   var
  201.     v: Integer;
  202.   begin
  203.     v := StrToInt(s);
  204.     if v <> 0 then
  205.       Result := 'True' else
  206.       Result := 'False';
  207.   end;
  208.  
  209.   function ConvertFromEnum(s: String): String;
  210.   var
  211.     i: Integer;
  212.   begin
  213.     Result := s;
  214.     for i := 0 to VarArrayHighBound(EnumValues, 1) do
  215.       if EnumValues[i] = StrToInt(s) then
  216.         Result := Enum[i];
  217.   end;
  218.  
  219. begin
  220.   Text := Value;
  221.   if Text <> '' then
  222.     if frdtFloat in DataType then
  223.       Text := ConvertToFloat(Text)
  224.     else if frdtBoolean in DataType then
  225.       Text := ConvertToBoolean(Text)
  226.     else if frdtColor in DataType then
  227.       Text := ConvertToColor(Text)
  228.     else if (frdtEnum in DataType) and not IsEnumNull then
  229.       Text := ConvertFromEnum(Text);
  230. end;
  231.  
  232. function TProp.GetValue: Variant;
  233. var
  234.   n: Integer;
  235.  
  236.   function ConvertFromColor(s: String): Integer;
  237.   var
  238.     i: Integer;
  239.   begin
  240.     for i := 0 to 41 do
  241.       if AnsiCompareText(s, frColorNames[i]) = 0 then
  242.       begin
  243.         Result := frColors[i];
  244.         Exit;
  245.       end;
  246.     Result := StrToInt(s);
  247.   end;
  248.  
  249.   function ConvertFromBoolean(s: String): Boolean;
  250.   begin
  251.     s := AnsiUpperCase(s);
  252.     Result := False;
  253.     if s = 'TRUE' then
  254.       Result := True
  255.     else if s = 'FALSE' then
  256.       Result := False
  257.     else if (s <> '') and (s <> '0') then
  258.       Result := True;
  259.   end;
  260.  
  261. begin
  262.   Result := Null;
  263.   if (frdtString in DataType) or ((frdtEnum in DataType) and IsEnumNull) then
  264.     Result := Text
  265.   else if frdtInteger in DataType then
  266.     Result := StrToInt(Text)
  267.   else if frdtFloat in DataType then
  268.     Result := frStrToFloat(Text)
  269.   else if frdtBoolean in DataType then
  270.     Result := ConvertFromBoolean(Text)
  271.   else if frdtColor in DataType then
  272.     Result := ConvertFromColor(Text)
  273.   else if frdtEnum in DataType then
  274.   begin
  275.     n := Enum.IndexOf(Text);
  276.     if n <> -1 then
  277.       Result := EnumValues[n] else
  278.       Result := StrToInt(Text);
  279.   end;
  280. end;
  281.  
  282. {----------------------------------------------------------------------------}
  283. constructor TfrInspForm.Create(AOwner: TComponent);
  284. begin
  285.   inherited Create(AOwner);
  286.    Parent := AOwner as TWinControl;
  287. end;
  288.  
  289. function TfrInspForm.GetPropValue(Index: Integer): Variant;
  290. begin
  291.   Result := TProp(FItems.Objects[Index]).Value;
  292. end;
  293.  
  294. procedure TfrInspForm.SetPropValue(Index: Integer; Value: Variant);
  295. begin
  296.   TProp(FItems.Objects[Index]).Value := Value;
  297. end;
  298.  
  299. procedure TfrInspForm.ClearProperties;
  300. var
  301.   i: Integer;
  302. begin
  303.   for i := 0 to FItems.Count - 1 do
  304.     TProp(FItems.Objects[i]).Free;
  305.   FItems.Clear;
  306. end;
  307.  
  308. procedure TfrInspForm.AddProperty(PropName: String; PropValue: Variant;
  309.   PropType: TfrDataTypes; PropEnum: TStringList; PropEnumValues: Variant;
  310.   PropEditor: TNotifyEvent);
  311. begin
  312.   FItems.AddObject(PropName, TProp.Create(PropValue, PropType, PropEnum,
  313.     PropEnumValues, PropEditor));
  314. end;
  315.  
  316. function TfrInspForm.CurItem: TProp;
  317. begin
  318.   Result := nil;
  319.   if (FItemIndex <> -1) and (Count > 0) then
  320.     Result := TProp(FItems.Objects[FItemIndex]);
  321. end;
  322.  
  323. procedure TfrInspForm.SetItems(Value: TStringList);
  324. begin
  325.   FItems.Assign(Value);
  326.   FItemIndex := -1;
  327.   PaintBox1.Repaint;
  328.   ItemIndex := 0;
  329. end;
  330.  
  331. procedure TfrInspForm.SetItemValue(Value: String);
  332. var
  333.   p: TProp;
  334.   n: Integer;
  335. begin
  336.   if HideProperties then Exit;
  337.   p := TProp(FItems.Objects[FItemIndex]);
  338.   p.Text := Value;
  339.   n := FItemIndex;
  340.   try
  341.     BusyFlag1 := True;
  342.     if Assigned(FOnModify) then FOnModify(FItemIndex);
  343.     if n >= FItems.Count then
  344.       n := 0;
  345.   finally
  346.     BusyFlag1 := False;
  347.     SetItemIndex(n);
  348.   end;
  349. end;
  350.  
  351. function TfrInspForm.GetItemValue(i: Integer): String;
  352. var
  353.   p: TProp;
  354. begin
  355.   Result := '';
  356.   p := TProp(FItems.Objects[i]);
  357.   if p = nil then Exit;
  358.   Result := p.Text;
  359. end;
  360.  
  361. procedure TfrInspForm.SetItemIndex(Value: Integer);
  362. var
  363.   ww, y: Integer;
  364.   b1, b2: Boolean;
  365. begin
  366.   if BusyFlag1 then Exit;
  367.   if Value > Count - 1 then
  368.     Value := Count - 1;
  369.   Edit1.Visible := (Count > 0) and not HideProperties;
  370.   if Count = 0 then Exit;
  371.   if FItemIndex <> -1 then
  372.     if Edit1.Modified then
  373.       SetItemValue(Edit1.Text);
  374.   FItemIndex := Value;
  375.   EditPanel.Visible := Assigned(CurItem.Editor) and not HideProperties;
  376.   ComboPanel.Visible :=
  377.     ([frdtBoolean, frdtColor, frdtEnum] * CurItem.DataType <> []) and
  378.     not HideProperties;
  379.   LB1.Visible := False;
  380.   b1 := frdtHasEditor in CurItem.DataType;
  381.   b2 := frdtString in CurItem.DataType;
  382.   Edit1.ReadOnly := b1 and not b2;
  383.   ww := w - w1 - 2;
  384.   y := FItemIndex * FRowHeight + 1;
  385.   if EditPanel.Visible then
  386.   begin
  387.     EditPanel.SetBounds(w - 18, y, 14, FRowHeight - 2);
  388.     Dec(ww, 19);
  389.   end;
  390.   Edit1.Text := GetItemValue(FItemIndex);
  391.   if ComboPanel.Visible then
  392.   begin
  393.     ComboPanel.SetBounds(w - 18, y, 14, FRowHeight - 2);
  394.     Dec(ww, 19);
  395.   end;
  396.   Edit1.SetBounds(w1 + 2, y, ww, FRowHeight - 2);
  397.   Edit1.SelectAll;
  398.   Edit1.Modified := False;
  399.  
  400.   if y + FRowHeight > Box.VertScrollBar.Position + Box.ClientHeight then
  401.     Box.VertScrollBar.Position := y - Box.ClientHeight + FRowHeight;
  402.   if y < Box.VertScrollBar.Position then
  403.     Box.VertScrollBar.Position := y - 1;
  404.  
  405.   LastProp := FItems[FItemIndex];
  406.   PaintBox1Paint(nil);
  407. end;
  408.  
  409. function TfrInspForm.GetCount: Integer;
  410. begin
  411.   Result := FItems.Count;
  412. end;
  413.  
  414. procedure TfrInspForm.ItemsChanged;
  415. var
  416.   LastIndex: Integer;
  417. begin
  418.   FItemIndex := -1;
  419.   BusyFlag := True;
  420.   Panel1.Height := Items.Count * FRowHeight;
  421.   Panel1.Width := Box.ClientWidth;
  422.   w := PaintBox1.Width;
  423.   BusyFlag := False;
  424.  
  425.   LastIndex := FItems.IndexOf(LastProp);
  426.   if LastIndex = -1 then
  427.     LastIndex := 0;
  428.   ItemIndex := LastIndex;
  429.   if not HideProperties then
  430.   begin
  431.     if not ((CB1.ItemIndex <> -1) and (CB1.Items[CB1.ItemIndex] = ObjectName)) then
  432.     begin
  433.       CB1DropDown(nil);
  434.       CB1.ItemIndex := CB1.Items.IndexOf(ObjectName);
  435.     end;
  436.   end
  437.   else
  438.     CB1.ItemIndex := -1;
  439. end;
  440.  
  441. procedure TfrInspForm.DrawOneLine(i: Integer; a: Boolean);
  442. var
  443.   R: TRect;
  444.  
  445.   procedure Line(x, y, dx, dy: Integer);
  446.   begin
  447.     b.Canvas.MoveTo(x, y);
  448.     b.Canvas.LineTo(x + dx, y + dy);
  449.   end;
  450.  
  451.   function GetPropName(Index: Integer): String;
  452.   begin
  453.     Result := FItems[Index];
  454.   end;
  455.  
  456. begin
  457.   if Count > 0 then
  458.   with b.Canvas do
  459.   begin
  460.     Brush.Color := clBtnFace;
  461.     Pen.Color := clBtnShadow;
  462.     Font.Color := clText;
  463.     Font.Size := Self.Font.Size;
  464.     R := Rect(5, i * FRowHeight + 1, w1 - 2, i * FRowHeight + FRowHeight - 1);
  465.     if a then
  466.     begin
  467.       Pen.Color := clBtnShadow;
  468.       Line(0, -2 + i * FRowHeight, w, 0);
  469.       Line(w1 - 1, 0 + i * FRowHeight, 0, FRowHeight);
  470.       Pen.Color := clBlack;
  471.       Line(0, -1 + i * FRowHeight, w, 0);
  472.       Line(0, -1 + i * FRowHeight, 0, FRowHeight + 1);
  473.       Pen.Color := clBtnHighlight;
  474.       Line(1, FRowHeight + -1 + i * FRowHeight, w - 1, 0);
  475.       Line(Edit1.Left, 0 + i * FRowHeight, Edit1.Width, 0);
  476.       Line(w1, 0 + i * FRowHeight, 0, FRowHeight);
  477.       Line(w1 + 1, 0 + i * FRowHeight, 0, FRowHeight);
  478.       TextRect(R, 5, 1 + i * FRowHeight, GetPropName(i));
  479.     end
  480.     else
  481.     begin
  482.       Line(0, FRowHeight + -1 + i * FRowHeight, w, 0);
  483.       Line(w1 - 1, 0 + i * FRowHeight, 0, FRowHeight);
  484.       Pen.Color := clBtnHighlight;
  485.       Line(w1, 0 + i * FRowHeight, 0, FRowHeight);
  486.       TextRect(R, 5, 1 + i * FRowHeight, GetPropName(i));
  487.       Font.Color := clNavy;
  488.       TextOut(w1 + 2, 1 + i * FRowHeight, GetItemValue(i));
  489.     end;
  490.   end;
  491. end;
  492.  
  493. procedure TfrInspForm.PaintBox1Paint(Sender: TObject);
  494. var
  495.   i: Integer;
  496.   r: TRect;
  497. begin
  498.   if BusyFlag then Exit;
  499. //  LB1.Hide;
  500.   r := PaintBox1.BoundsRect;
  501.   b.Width := PaintBox1.Width;
  502.   b.Height := PaintBox1.Height;
  503.   b.Canvas.Brush.Color := clBtnFace;
  504.   b.Canvas.FillRect(r);
  505.   if not HideProperties then
  506.   begin
  507.     for i := 0 to Count - 1 do
  508.       if i <> FItemIndex then
  509.         DrawOneLine(i, False);
  510.     if FItemIndex <> -1 then DrawOneLine(FItemIndex, True);
  511.   end;
  512.   PaintBox1.Canvas.Draw(0, 0, b);
  513. end;
  514.  
  515. procedure TfrInspForm.Localize;
  516. begin
  517.   Caption := S53059;
  518. end;
  519.  
  520. procedure TfrInspForm.FormCreate(Sender: TObject);
  521. begin
  522.   Localize;
  523.   Panel1 := TInspPanel.Create(Self);
  524.   Panel1.Parent := Box;
  525.   Panel1.BevelInner := bvNone;
  526.   Panel1.BevelOuter := bvNone;
  527.   PaintBox1.Parent := Panel1;
  528.   ComboPanel.Parent := Panel1;
  529.   EditPanel.Parent := Panel1;
  530.   Edit1.Parent := Panel1;
  531.   w := PaintBox1.Width;
  532.   b := TBitmap.Create;
  533.   FItemIndex := -1;
  534.   FItems := TStringList.Create;
  535.   FRowHeight := Font.Height + 5;
  536.   Box.VertScrollBar.Increment := FRowHeight;
  537.   Box.VertScrollBar.Tracking := True;
  538.   LB1 := TfrPopupListBox.Create(Self);
  539.   DefHeight := Height;
  540.   FormResize(nil);
  541. end;
  542.  
  543. procedure TfrInspForm.FormDestroy(Sender: TObject);
  544. begin
  545.   b.Free;
  546.   LB1.Free;
  547.   ClearProperties;
  548.   FItems.Free;
  549. end;
  550.  
  551. procedure TfrInspForm.FormActivate(Sender: TObject);
  552. begin
  553.   if Edit1.Enabled and Edit1.Visible then
  554.     Edit1.SetFocus;
  555. end;
  556.  
  557. procedure TfrInspForm.FormDeactivate(Sender: TObject);
  558. begin
  559.   if BusyFlag then Exit;
  560.   LB1.Hide;
  561.   if CurItem = nil then Exit;
  562.   if [frdtHasEditor, frdtColor, frdtBoolean, frdtEnum] * CurItem.DataType = [] then
  563.     if Edit1.Modified then SetItemValue(Edit1.Text);
  564. end;
  565.  
  566. procedure TfrInspForm.FormShow(Sender: TObject);
  567. begin
  568.   if ClientHeight < 20 then
  569.     CB1.Hide;
  570. end;
  571.  
  572. procedure TfrInspForm.FormResize(Sender: TObject);
  573. begin
  574.   Box.Width := ClientWidth;
  575.   Box.Height := ClientHeight - CB1.Height - 7;
  576.   CB1.Width := ClientWidth;
  577.  
  578.   Panel1.SetBounds(0, 0, Box.ClientWidth, Items.Count * FRowHeight);
  579.  
  580.   w := PaintBox1.Width;
  581.   SetItemIndex(FItemIndex);
  582. end;
  583.  
  584. procedure TfrInspForm.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  585.   Shift: TShiftState; X, Y: Integer);
  586. begin
  587.   if HideProperties then Exit;
  588.   if PaintBox1.Cursor = crHSplit then
  589.     FDown := True
  590.   else
  591.   begin
  592.     ItemIndex := y div FRowHeight;
  593.     Edit1.SetFocus;
  594. //    FTickCount := GetTickCount;
  595.   end;
  596. end;
  597.  
  598. procedure TfrInspForm.Edit1KeyDown(Sender: TObject; var Key: Word;
  599.   Shift: TShiftState);
  600. begin
  601.   if HideProperties then Exit;
  602.   if Key = key_Up then
  603.   begin
  604.     if ItemIndex > 0 then
  605.       ItemIndex := ItemIndex - 1;
  606.     Key := 0;
  607.   end
  608.   else if Key = key_Down then
  609.   begin
  610.     if ItemIndex < Count - 1 then
  611.       ItemIndex := ItemIndex + 1;
  612.     Key := 0;
  613.   end;
  614. end;
  615.  
  616. procedure TfrInspForm.Edit1KeyPress(Sender: TObject; var Key: Char);
  617. begin
  618.   if Key = #13 then
  619.   begin
  620.     if frdtHasEditor in CurItem.DataType then
  621.       EditBtnClick(nil)
  622.     else
  623.     begin
  624.       if Edit1.Modified then SetItemValue(Edit1.Text);
  625.       Edit1.Modified := False;
  626.     end;
  627.     Edit1.SelectAll;
  628.     Key := #0;
  629.   end;
  630. end;
  631.  
  632. procedure TfrInspForm.EditBtnClick(Sender: TObject);
  633. begin
  634.   if HideProperties then Exit;
  635.   CurItem.Editor(CurObject);
  636.   Edit1.SelectAll;
  637. end;
  638.  
  639. procedure TfrInspForm.Edit1DblClick(Sender: TObject);
  640. var
  641.   p: TProp;
  642.  
  643.   function IndexOf(arr: Variant; val: Variant): Integer;
  644.   var
  645.     i: Integer;
  646.   begin
  647.     Result := -1;
  648.     for i := 0 to varArrayHighBound(arr, 1) do
  649.       if arr[i] = val then
  650.       begin
  651.         Result := i;
  652.         break;
  653.       end;
  654.   end;
  655.  
  656. begin
  657.   p := CurItem;
  658.   if frdtHasEditor in p.DataType then
  659.     EditBtnClick(nil)
  660.   else if frdtColor in p.DataType then
  661.   begin
  662.     with TColorDialog.Create(nil) do
  663.     begin
  664.       Color := p.Value;
  665.       if Execute then
  666.       begin
  667.         p.Value := Color;
  668.         SetItemValue(p.Text);
  669.         Edit1.Modified := False;
  670.         Edit1.SelectAll;
  671.       end;
  672.       Free;
  673.     end;
  674.   end
  675.   else if frdtBoolean in p.DataType then
  676.   begin
  677.     p.Value := not p.Value;
  678.     SetItemValue(p.Text);
  679.     Edit1.Modified := False;
  680.     Edit1.SelectAll;
  681.   end
  682.   else if frdtEnum in p.DataType then
  683.   begin
  684.     if p.IsEnumNull then
  685.     begin
  686.       if p.Enum.Count > 0 then
  687.         if p.Enum.IndexOf(p.Value) >= p.Enum.Count - 1 then
  688.           p.Value := p.Enum[0] else
  689.           p.Value := p.Enum[p.Enum.IndexOf(p.Value) + 1];
  690.     end
  691.     else
  692. {      if p.Value >= p.Enum.Count - 1 then
  693.         p.Value := 0 else
  694.         p.Value := p.Value + 1;}
  695.       if IndexOf(p.EnumValues, p.Value) > varArrayHighBound(p.EnumValues, 1) - 1 then
  696.         p.Value := p.EnumValues[0] else
  697.         p.Value := p.EnumValues[IndexOf(p.EnumValues, p.Value) + 1];
  698.     SetItemValue(p.Text);
  699.     Edit1.Modified := False;
  700.     Edit1.SelectAll;
  701.   end
  702. end;
  703.  
  704. procedure TfrInspForm.CB1DropDown(Sender: TObject);
  705. var
  706.   s: String;
  707. begin
  708.   if CB1.ItemIndex <> -1 then
  709.     s := CB1.Items[CB1.ItemIndex] else
  710.     s := '';
  711.   if Assigned(FOnGetObjects) then
  712.     FOnGetObjects(CB1.Items);
  713.   CB1.ItemIndex := CB1.Items.IndexOf(s);
  714. end;
  715.  
  716. procedure TfrInspForm.CB1Click(Sender: TObject);
  717. begin
  718.   if Assigned(FOnSelectionChanged) then
  719.     FOnSelectionChanged(CB1.Items[CB1.ItemIndex]);
  720.   Edit1.SetFocus;
  721. end;
  722.  
  723. function TfrInspForm.GetClassName(ObjName: String): String;
  724. begin
  725.   if CurObject <> nil then
  726.     Result := CurObject.ClassName else
  727.     Result := '';
  728. end;
  729.  
  730. procedure TfrInspForm.CB1DrawItem(Sender: TObject; Index: Integer;
  731.   ARect: TRect; State: TOwnerDrawState; var Handled: Boolean);
  732. begin
  733.   with CB1.Canvas do
  734.   begin
  735.     if odFocused in State then
  736.       FillRect(ARect);
  737.     Brush.Style := bsClear;
  738.     if CB1.DroppedDown then
  739.       TextOut(ARect.Left + 2, ARect.Top + 1, CB1.Items[Index]) else
  740.       TextOut(ARect.Left + 2, ARect.Top + 1, CB1.Items[Index] + ': ' +
  741.         GetClassName(CB1.Items[Index]));
  742.   end;
  743. end;
  744.  
  745. procedure TfrInspForm.ComboBtnClick(Sender: TObject);
  746. var
  747.   i, wItems, nItems: Integer;
  748.   p: TPoint;
  749. begin
  750.   BusyFlag := True;
  751.   if LB1.Visible then
  752.   begin
  753.     LB1.Hide;
  754.     Edit1.SetFocus;
  755.   end
  756.   else with LB1.ListBox do
  757.   begin
  758.     OnClick := LB1Click;
  759.     Items.Clear;
  760.     Sorted := False;
  761.     if frdtBoolean in CurItem.DataType then
  762.     begin
  763.       Items.Add('False');
  764.       Items.Add('True');
  765.     end
  766.     else if frdtColor in CurItem.DataType then
  767.       for i := 0 to 41 do
  768.         Items.Add(frColorNames[i])
  769.     else if frdtEnum in CurItem.DataType then
  770.       for i := 0 to CurItem.Enum.Count - 1 do
  771.         Items.Add(CurItem.Enum[i]);
  772.  
  773.     if Items.Count > 0 then
  774.     begin
  775.       ItemIndex := Items.IndexOf(CurItem.Text);
  776.       Application.HandleMessage;
  777.       wItems := 0;
  778.       for i := 0 to Items.Count - 1 do
  779.       begin
  780.         if Canvas.TextWidth(Items[i]) > wItems then
  781.           wItems := Canvas.TextWidth(Items[i]);
  782.       end;
  783.  
  784.       Inc(wItems, 10);
  785.       nItems := Items.Count;
  786.       if nItems > 8 then
  787.       begin
  788.         nItems := 8;
  789.         Inc(wItems, 16);
  790.       end;
  791.  
  792.       p := Edit1.ClientToScreen(Point(0, Edit1.Height));
  793.  
  794.       if wItems < w1 then
  795.         LB1.SetBounds(w1 + 1, p.Y,
  796.                   w - w1 - 3, nItems * (ItemHeight + 2) + 2)
  797.       else
  798.         LB1.SetBounds(w - wItems - 2, p.Y,
  799.                   wItems, nItems * (ItemHeight + 2) + 2);
  800.  
  801.       Width := LB1.ClientWidth;
  802.       Height := LB1.ClientHeight;
  803.       LB1.Height := Height;
  804.       p := Self.ClientToScreen(Point(0, 0));
  805.       Inc(p.X, LB1.Left);
  806.       if p.X < 0 then p.X := 0;
  807.       LB1.Left := p.X;
  808.       LB1.Show;
  809.     end;
  810.   end;
  811.   BusyFlag := False;
  812. end;
  813.  
  814. procedure TfrInspForm.LB1Click(Sender: TObject);
  815. begin
  816.   if BusyFlag then Exit;
  817.   Edit1.Text := LB1.ListBox.Items[LB1.ListBox.ItemIndex];
  818.   LB1.Hide;
  819.   Edit1.SetFocus;
  820.   SetItemValue(Edit1.Text);
  821. end;
  822.  
  823. procedure TfrInspForm.Edit1MouseDown(Sender: TObject; Button: TMouseButton;
  824.   Shift: TShiftState; X, Y: Integer);
  825. begin
  826. {  if GetTickCount - FTickCount < GetDoubleClickTime then
  827.     Edit1DblClick(nil);}
  828. end;
  829.  
  830. procedure TfrInspForm.Grow;
  831. begin
  832.   Show;
  833.   if ClientHeight < 20 then
  834.   begin
  835.     Height := DefHeight;
  836.     CB1.Show;
  837.     ItemsChanged;
  838.     Edit1.SelText := Edit1.Text;
  839.     Edit1.Modified := False;
  840.     if Assigned(FOnHeightChanged) then
  841.       FOnHeightChanged(Self);
  842.   end;
  843. end;
  844.  
  845.  
  846. procedure TfrInspForm.PaintBox1MouseMove(Sender: TObject;
  847.   Shift: TShiftState; X, Y: Integer);
  848. begin
  849.   if not FDown then
  850.     if (X > w1 - 2) and (X < w1 + 2) then
  851.       PaintBox1.Cursor := crHSplit else
  852.       PaintBox1.Cursor := crDefault
  853.   else
  854.   begin
  855.     if x > 5 then
  856.       w1 := X;
  857.     FormResize(nil);
  858.   end;
  859. end;
  860.  
  861. procedure TfrInspForm.PaintBox1MouseUp(Sender: TObject;
  862.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  863. begin
  864.   FDown := False;
  865. end;
  866.  
  867.  
  868. end.
  869.  
  870.