1152 lines
29 KiB
ObjectPascal
1152 lines
29 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport v4.0 }
|
|
{ Object Inspector }
|
|
{ }
|
|
{ Copyright (c) 1998-2008 }
|
|
{ by Alexander Tzyganenko, }
|
|
{ Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit FMX.frxInsp;
|
|
|
|
interface
|
|
|
|
{$I frx.inc}
|
|
|
|
uses
|
|
System.SysUtils, System.Classes, System.UITypes, FMX.Controls, FMX.Forms,
|
|
FMX.Dialogs, FMX.ExtCtrls, FMX.frxDsgnIntf, System.Types, System.UIConsts,
|
|
FMX.frxClass, FMX.Menus, FMX.Types, FMX.Edit, FMX.Objects, FMX.Layouts,
|
|
FMX.ListBox, FMX.TabControl, FMX.Platform, System.Variants, FMX.TreeView
|
|
{$IFDEF DELPHI18}
|
|
,FMX.StdCtrls
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI19}
|
|
, FMX.Graphics
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI28}
|
|
, FMX.BaseTypeAliases, FMX.FormTypeAliases
|
|
{$ENDIF};
|
|
|
|
|
|
type
|
|
TfrxObjectInspector = class(TForm)
|
|
PopupMenu1: TPopupMenu;
|
|
N11: TMenuItem;
|
|
N21: TMenuItem;
|
|
N31: TMenuItem;
|
|
N41: TMenuItem;
|
|
N51: TMenuItem;
|
|
N61: TMenuItem;
|
|
MainPanel: TPanel;
|
|
BackPanel: TPanel;
|
|
Splitter1: TSplitter;
|
|
Box: TFramedScrollBox;
|
|
PB: TPaintBox;
|
|
Edit1: TEdit;
|
|
EditPanel: TPanel;
|
|
EditBtn: TSpeedButton;
|
|
ComboPanel: TPanel;
|
|
ComboBtn: TSpeedButton;
|
|
HintPanel: TPanel;
|
|
PropL: TLabel;
|
|
DescrL: TLabel;
|
|
ObjectsCB: TComboBox;
|
|
Label1: TLabel;
|
|
Rectangle1: TRectangle;
|
|
StyleBook1: TStyleBook;
|
|
procedure FormResize(Sender: TObject);
|
|
procedure PBPaint(Sender: TObject; ACanvas: TCanvas);
|
|
procedure PBMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Single);
|
|
procedure PBMouseUp(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Single);
|
|
procedure PBMouseMove(Sender: TObject; Shift: TShiftState;
|
|
X, Y: Single);
|
|
procedure Edit1KeyDown(Sender: TObject; var Key: Word;
|
|
var KeyChar: WideChar; Shift: TShiftState);
|
|
procedure EditBtnClick(Sender: TObject);
|
|
procedure ComboBtnClick(Sender: TObject);
|
|
procedure ObjectsCBClick(Sender: TObject);
|
|
procedure PBDblClick(Sender: TObject);
|
|
procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
|
|
MousePos: TPoint; var Handled: Boolean);
|
|
procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
|
|
MousePos: TPoint; var Handled: Boolean);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure TabChange(Sender: TObject);
|
|
procedure N11Click(Sender: TObject);
|
|
procedure N21Click(Sender: TObject);
|
|
procedure N31Click(Sender: TObject);
|
|
procedure FormDeactivate(Sender: TObject);
|
|
procedure FormKeyDown(Sender: TObject; var Key: Word;
|
|
var KeyChar: WideChar; Shift: TShiftState);
|
|
private
|
|
{ Private declarations }
|
|
FDesigner: TfrxCustomDesigner;
|
|
FDisableDblClick: Boolean;
|
|
FDisableUpdate: Boolean;
|
|
FDown: Boolean;
|
|
FEventList: TfrxPropertyList;
|
|
//FHintWindow: THintWindow; todo
|
|
FItemIndex: Integer;
|
|
FLastPosition: String;
|
|
FList: TfrxPropertyList;
|
|
FPopupForm: TPopup;
|
|
FPopupLB: TListBox;
|
|
// FPopupLBVisible: Boolean;
|
|
FPropertyList: TfrxPropertyList;
|
|
FPanel: TPanel;
|
|
FRowHeight: Single;
|
|
FSelectedObjects: TList;
|
|
FSplitterPos: Single;
|
|
FTabs: TTabControl;
|
|
FTempList: TList;
|
|
FUpdatingObjectsCB: Boolean;
|
|
FUpdatingPB: Boolean;
|
|
FOnSelectionChanged: TNotifyEvent;
|
|
FOnModify: TNotifyEvent;
|
|
// FPopupCloseTime: Extended;
|
|
FFastCanvas: TCanvas;
|
|
function Count: Integer;
|
|
function GetItem(Index: Integer): TfrxPropertyItem;
|
|
function GetName(Index: Integer): String;
|
|
function GetOffset(Index: Integer): Integer;
|
|
function GetType(Index: Integer): TfrxPropertyAttributes;
|
|
function GetValue(Index: Integer): String;
|
|
procedure AdjustControls;
|
|
procedure DrawOneLine(Canvas: TCanvas; i: Integer; Selected: Boolean);
|
|
procedure DoModify;
|
|
procedure SetObjects(Value: TList);
|
|
procedure SetItemIndex(Value: Integer);
|
|
procedure SetSelectedObjects(Value: TList);
|
|
procedure SetValue(Index: Integer; Value: String);
|
|
procedure LBClick(Sender: TObject);
|
|
procedure ClosePopup(Sender: TObject);
|
|
function GetSplitter1Pos: Integer;
|
|
procedure SetSplitter1Pos(const Value: Integer);
|
|
public
|
|
{ Public declarations }
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure DisableUpdate;
|
|
procedure EnableUpdate;
|
|
procedure Inspect(AObjects: array of TPersistent);
|
|
procedure UpdateProperties;
|
|
procedure DoResize;
|
|
property Objects: TList write SetObjects;
|
|
property ItemIndex: Integer read FItemIndex write SetItemIndex;
|
|
property SelectedObjects: TList read FSelectedObjects write SetSelectedObjects;
|
|
property SplitterPos: Single read FSplitterPos write FSplitterPos;
|
|
property Splitter1Pos: Integer read GetSplitter1Pos write SetSplitter1Pos;
|
|
property OnModify: TNotifyEvent read FOnModify write FOnModify;
|
|
property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write FOnSelectionChanged;
|
|
end;
|
|
|
|
|
|
implementation
|
|
{$IFDEF DELPHI23}
|
|
{$R FMX.frxInsp_D23.FMX}
|
|
{$ELSE}
|
|
{$R *.FMX}
|
|
{$ENDIF}
|
|
|
|
uses FMX.frxFMX, FMX.frxUtils, FMX.frxRes, FMX.frxrcInsp;
|
|
{ TfrxObjectInspector }
|
|
|
|
constructor TfrxObjectInspector.Create(AOwner: TComponent);
|
|
var
|
|
aTab: TTabItem;
|
|
begin
|
|
inherited Create(AOwner);
|
|
FItemIndex := -1;
|
|
FTempList := TList.Create;
|
|
FDesigner := TfrxCustomDesigner(AOwner);
|
|
Box.ShowScrollBars := True;
|
|
{$IFNDEF MSWINDOWS}
|
|
{$IFDEF DELPHI18}
|
|
Box.AutoHide := false;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI19}
|
|
Box.AniCalculations.AutoShowing := false;
|
|
{$ENDIF}
|
|
FPanel := TPanel.Create(Self);
|
|
FPanel.StyleLookup := 'backgroundstyle';
|
|
FPanel.Parent := Box;
|
|
PB.Parent := FPanel;
|
|
ComboPanel.Parent := FPanel;
|
|
EditPanel.Parent := FPanel;
|
|
Edit1.Parent := FPanel;
|
|
Edit1.Font.Size := 11;
|
|
|
|
FRowHeight := Round(Canvas.TextHeight('Wg') + 3);
|
|
|
|
MainPanel.StyleLookup := 'backgroundstyle';
|
|
BackPanel.StyleLookup := 'backgroundstyle';
|
|
FTabs := TTabControl.Create(Self);
|
|
FTabs.OnChange := TabChange;
|
|
FTabs.Parent := MainPanel;
|
|
{$IFDEF Delphi17}
|
|
FTabs.TabHeight := 21;
|
|
{$ENDIF}
|
|
|
|
aTab := TTabItem.Create(Self);
|
|
aTab.Text := frxResources.Get('oiProp');
|
|
FTabs.AddObject(aTab);
|
|
aTab := TTabItem.Create(Self);
|
|
aTab.Text := frxResources.Get('oiEvent');
|
|
FTabs.AddObject(aTab);
|
|
FTabs.TabIndex := 0;
|
|
|
|
FSplitterPos := Round(PB.Width) div 2;
|
|
|
|
FPopupForm := TPopup.Create(Self);
|
|
FPopupForm.Placement := TPlacement.plAbsolute;
|
|
FPopupForm.Parent := Self;
|
|
FPopupForm.OnClosePopup := ClosePopup;
|
|
|
|
FPopupLB := TListBox.Create(FPopupForm);
|
|
with FPopupLB do
|
|
begin
|
|
Parent := FPopupForm;
|
|
Align := TAlignLayout.alClient;
|
|
ItemHeight := FRowHeight;
|
|
OnClick := LBClick;
|
|
end;
|
|
FormResize(nil);
|
|
|
|
Label1.Text := frxGet(2000);
|
|
FFastCanvas := nil;
|
|
if frxCanvasClass <> nil then
|
|
FFastCanvas := frxCanvasClass.Create;
|
|
end;
|
|
|
|
destructor TfrxObjectInspector.Destroy;
|
|
begin
|
|
DisableUpdate;
|
|
if frxCanvasClass <> nil then
|
|
FreeAndNil(FFastCanvas);
|
|
FTempList.Free;
|
|
if FPropertyList <> nil then
|
|
FPropertyList.Free;
|
|
if FEventList <> nil then
|
|
FEventList.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.UpdateProperties;
|
|
begin
|
|
SetSelectedObjects(FSelectedObjects);
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.Inspect(AObjects: array of TPersistent);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
FTempList.Clear;
|
|
for i := Low(AObjects) to High(AObjects) do
|
|
FTempList.Add(AObjects[i]);
|
|
Objects := FTempList;
|
|
SelectedObjects := FTempList;
|
|
end;
|
|
|
|
function TfrxObjectInspector.GetSplitter1Pos: Integer;
|
|
begin
|
|
Result := Round(HintPanel.Height);
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.SetSplitter1Pos(const Value: Integer);
|
|
begin
|
|
HintPanel.Height := Value;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.DisableUpdate;
|
|
begin
|
|
FDisableUpdate := True;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.EnableUpdate;
|
|
begin
|
|
FDisableUpdate := False;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.SetObjects(Value: TList);
|
|
var
|
|
i: Integer;
|
|
s: String;
|
|
begin
|
|
ObjectsCB.BeginUpdate;
|
|
{$IFDEF DELPHI23}
|
|
ObjectsCB.Clear;
|
|
{$ELSE}
|
|
ObjectsCB.Items.Clear;
|
|
{$ENDIF}
|
|
for i := 0 to Value.Count - 1 do
|
|
begin
|
|
if TObject(Value[i]) is TComponent then
|
|
s := TComponent(Value[i]).Name + ': ' + TComponent(Value[i]).ClassName else
|
|
s := '';
|
|
ObjectsCB.Items.AddObject(s, Value[i]);
|
|
end;
|
|
ObjectsCB.EndUpdate;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.SetSelectedObjects(Value: TList);
|
|
var
|
|
i: Integer;
|
|
s: String;
|
|
|
|
procedure CreateLists;
|
|
var
|
|
i: Integer;
|
|
p: TfrxPropertyItem;
|
|
s: String;
|
|
begin
|
|
if FPropertyList <> nil then
|
|
FPropertyList.Free;
|
|
if FEventList <> nil then
|
|
FEventList.Free;
|
|
FEventList := nil;
|
|
|
|
FPropertyList := frxCreatePropertyList(Value, FDesigner);
|
|
if FPropertyList <> nil then
|
|
begin
|
|
FEventList := TfrxPropertyList.Create(FDesigner);
|
|
|
|
i := 0;
|
|
while i < FPropertyList.Count do
|
|
begin
|
|
p := FPropertyList[i];
|
|
s := String(p.Editor.PropInfo.PropType^.Name);
|
|
if (Pos('Tfrx', s) = 1) and (Pos('Event', s) = Length(s) - 4) then
|
|
p.Collection := FEventList else
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
|
|
if FTabs.TabIndex = 0 then
|
|
FList := FPropertyList else
|
|
FList := FEventList;
|
|
end;
|
|
|
|
begin
|
|
FSelectedObjects := Value;
|
|
CreateLists;
|
|
|
|
FUpdatingObjectsCB := True;
|
|
if FSelectedObjects.Count = 1 then
|
|
begin
|
|
ObjectsCB.ItemIndex := ObjectsCB.Items.IndexOfObject(FSelectedObjects[0]);
|
|
if ObjectsCB.ItemIndex = -1 then
|
|
begin
|
|
s := TComponent(FSelectedObjects[0]).Name + ': ' +
|
|
TComponent(FSelectedObjects[0]).ClassName;
|
|
ObjectsCB.BeginUpdate;
|
|
ObjectsCB.Items.AddObject(s, FSelectedObjects[0]);
|
|
ObjectsCB.EndUpdate;
|
|
ObjectsCB.ItemIndex := ObjectsCB.Items.IndexOfObject(FSelectedObjects[0]);
|
|
end;
|
|
end
|
|
else
|
|
ObjectsCB.ItemIndex := -1;
|
|
FUpdatingObjectsCB := False;
|
|
|
|
FItemIndex := -1;
|
|
FormResize(nil);
|
|
if Count > 0 then
|
|
begin
|
|
for i := 0 to Count - 1 do
|
|
if GetName(i) = FLastPosition then
|
|
begin
|
|
ItemIndex := i;
|
|
Exit;
|
|
end;
|
|
s := FLastPosition;
|
|
ItemIndex := 0;
|
|
FLastPosition := s;
|
|
end;
|
|
end;
|
|
|
|
function TfrxObjectInspector.Count: Integer;
|
|
|
|
function EnumProperties(p: TfrxPropertyList): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := 0;
|
|
for i := 0 to p.Count - 1 do
|
|
begin
|
|
Inc(Result);
|
|
if (p[i].SubProperty <> nil) and p[i].Expanded then
|
|
Inc(Result, EnumProperties(p[i].SubProperty));
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if FList <> nil then
|
|
Result := EnumProperties(FList) else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TfrxObjectInspector.GetItem(Index: Integer): TfrxPropertyItem;
|
|
|
|
function EnumProperties(p: TfrxPropertyList; var Index: Integer): TfrxPropertyItem;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := nil;
|
|
for i := 0 to p.Count - 1 do
|
|
begin
|
|
Dec(Index);
|
|
if Index < 0 then
|
|
begin
|
|
Result := p[i];
|
|
break;
|
|
end;
|
|
if (p[i].SubProperty <> nil) and p[i].Expanded then
|
|
Result := EnumProperties(p[i].SubProperty, Index);
|
|
if Index < 0 then
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if (Index >= 0) and (Index < Count) then
|
|
Result := EnumProperties(FList, Index) else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TfrxObjectInspector.GetOffset(Index: Integer): Integer;
|
|
var
|
|
p: TfrxPropertyList;
|
|
begin
|
|
Result := 0;
|
|
p := TfrxPropertyList(GetItem(Index).Collection);
|
|
while p.Parent <> nil do
|
|
begin
|
|
Inc(Result);
|
|
p := p.Parent;
|
|
end;
|
|
end;
|
|
|
|
function TfrxObjectInspector.GetName(Index: Integer): String;
|
|
begin
|
|
Result := GetItem(Index).Editor.GetName;
|
|
end;
|
|
|
|
function TfrxObjectInspector.GetType(Index: Integer): TfrxPropertyAttributes;
|
|
begin
|
|
Result := GetItem(Index).Editor.GetAttributes;
|
|
end;
|
|
|
|
function TfrxObjectInspector.GetValue(Index: Integer): String;
|
|
begin
|
|
Result := GetItem(Index).Editor.Value;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.DoModify;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if FSelectedObjects.Count = 1 then
|
|
begin
|
|
i := ObjectsCB.Items.IndexOfObject(FSelectedObjects[0]);
|
|
if TObject(FSelectedObjects[0]) is TComponent then
|
|
ObjectsCB.Items.Strings[i] := TComponent(FSelectedObjects[0]).Name + ': ' +
|
|
TComponent(FSelectedObjects[0]).ClassName;
|
|
ObjectsCB.ItemIndex := ObjectsCB.Items.IndexOfObject(FSelectedObjects[0]);
|
|
end;
|
|
|
|
if Assigned(FOnModify) then
|
|
FOnModify(Self);
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.DoResize;
|
|
begin
|
|
FormResize(Self);
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.SetItemIndex(Value: Integer);
|
|
var
|
|
p: TfrxPropertyItem;
|
|
s: String;
|
|
begin
|
|
PropL.Text := '';
|
|
DescrL.Text := '';
|
|
if Value > Count - 1 then
|
|
Value := Count - 1;
|
|
if Value < 0 then
|
|
Value := -1;
|
|
|
|
Edit1.Visible := Count > 0;
|
|
if Count = 0 then Exit;
|
|
|
|
if FItemIndex <> -1 then
|
|
if Edit1.Typing then
|
|
begin
|
|
Edit1.Typing := False;
|
|
SetValue(FItemIndex, Edit1.Text);
|
|
end;
|
|
FItemIndex := Value;
|
|
|
|
if FItemIndex <> -1 then
|
|
begin
|
|
FLastPosition := GetName(FItemIndex);
|
|
p := GetItem(FItemIndex);
|
|
s := GetName(FItemIndex);
|
|
PropL.Text := s;
|
|
if TfrxPropertyList(p.Collection).Component <> nil then
|
|
begin
|
|
s := 'prop' + s + '.' + TfrxPropertyList(p.Collection).Component.ClassName;
|
|
if frxResources.Get(s) = s then
|
|
s := frxResources.Get('prop' + GetName(FItemIndex)) else
|
|
s := frxResources.Get(s);
|
|
DescrL.Text := s;
|
|
end;
|
|
end;
|
|
|
|
AdjustControls;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.SetValue(Index: Integer; Value: String);
|
|
var
|
|
pItem: TfrxPropertyItem;
|
|
vIdx: Integer;
|
|
begin
|
|
pItem := GetItem(Index);
|
|
try
|
|
if True then
|
|
begin
|
|
if paValueList in pItem.Editor.GetAttributes then
|
|
begin
|
|
pItem.Editor.GetValues;
|
|
vIdx := pItem.Editor.Values.IndexOf(Value);
|
|
if vIdx <> -1 then
|
|
Value := pItem.Editor.Values[vIdx];
|
|
end;
|
|
pItem.Editor.Value := Value;
|
|
end;
|
|
DoModify;
|
|
PB.Repaint;
|
|
/// PBPaint(nil, nil);
|
|
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
frxErrorMsg(E.Message);
|
|
Edit1.Text := GetItem(Index).Editor.Value;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.AdjustControls;
|
|
var
|
|
PropType: TfrxPropertyAttributes;
|
|
y, ww: Integer;
|
|
begin
|
|
if FDisableUpdate then Exit;
|
|
if FItemIndex = -1 then
|
|
begin
|
|
EditPanel.Visible := False;
|
|
ComboPanel.Visible := False;
|
|
Edit1.Visible := False;
|
|
FUpdatingPB := False;
|
|
BackPanel.Repaint;
|
|
Exit;
|
|
end;
|
|
|
|
FUpdatingPB := True;
|
|
PropType := GetType(FItemIndex);
|
|
|
|
EditPanel.Visible := paDialog in PropType;
|
|
ComboPanel.Visible := paValueList in PropType;
|
|
Edit1.ReadOnly := paReadOnly in PropType;
|
|
|
|
ww := Round(PB.Width - FSplitterPos - 2);
|
|
y := Round(FItemIndex * FRowHeight + 1);
|
|
if EditPanel.Visible then
|
|
begin
|
|
EditPanel.SetBounds(PB.Width - 15, y - 1, 15, Round(FRowHeight) - 1);
|
|
EditBtn.SetBounds(0, 0, EditPanel.Width, EditPanel.Height);
|
|
Dec(ww, 15);
|
|
end;
|
|
if ComboPanel.Visible then
|
|
begin
|
|
ComboPanel.SetBounds(PB.Width - 15, y - 1, 15, Round(FRowHeight) - 1);
|
|
ComboBtn.SetBounds(0, 0, ComboPanel.Width, ComboPanel.Height);
|
|
Dec(ww, 15);
|
|
end;
|
|
|
|
Edit1.Text := GetValue(FItemIndex);
|
|
Edit1.Typing := False;
|
|
Edit1.SetBounds(FSplitterPos + 2, y, ww, FRowHeight - 2);
|
|
Edit1.SelectAll;
|
|
{$IFDEF DELPHI18}
|
|
if y + FRowHeight > Box.ViewportPosition.Y + Box.ClientHeight then
|
|
Box.ViewportPosition := PointF(Box.ViewportPosition.X, y - Box.ClientHeight + FRowHeight);
|
|
if y < Box.ViewportPosition.Y then
|
|
Box.ViewportPosition := PointF(Box.ViewportPosition.X, y - 1);
|
|
{$ELSE}
|
|
if y + FRowHeight > Box.VScrollBar.Value + Box.ClientHeight then
|
|
Box.VScrollBar.Value := y - Box.ClientHeight + FRowHeight;
|
|
if y < Box.VScrollBar.Value then
|
|
Box.VScrollBar.Value := y - 1;
|
|
{$ENDIF}
|
|
FUpdatingPB := False;
|
|
BackPanel.Repaint;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.DrawOneLine(Canvas: TCanvas; i: Integer; Selected: Boolean);
|
|
var
|
|
s: String;
|
|
p: TfrxPropertyItem;
|
|
offs, add: Integer;
|
|
|
|
procedure Line(x, y, dx, dy: Single);
|
|
begin
|
|
Canvas.DrawLine(PointF(Round(x) + 0.5, Round(y) + 0.5),
|
|
PointF(Round(x + dx) + 0.5, Round(y + dy) + 0.5), 1);
|
|
end;
|
|
|
|
procedure DrawProperty;
|
|
var
|
|
x, y: Single;
|
|
begin
|
|
x := offs + GetOffset(i) * (12 + add);
|
|
y := 1 + i * FRowHeight;
|
|
|
|
with Canvas do
|
|
begin
|
|
Stroke.Color := claGray;
|
|
|
|
if offs < 12 then
|
|
begin
|
|
DrawRect(RectF(Round(x) + 1.5, Round(y) + 2.5 + add, Round(x) + 9.5, Round(y) + 10.5 + add), 1, 1, AllCorners, 1);
|
|
Line(x + 3, y + 6 + add, 4, 0);
|
|
if s[1] = '+' then
|
|
Line(x + 5, y + 4 + add, 0, 4);
|
|
|
|
s := Copy(s, 2, 255);
|
|
x := x + 12 + add;
|
|
end;
|
|
|
|
Fill.Color := claBlack;
|
|
Font.Style := [];
|
|
if ((s = 'Name') or (s = 'Width') or (s = 'Height') or (s = 'Left') or (s = 'Top'))
|
|
and (GetOffset(i) = 0) then
|
|
Font.Style := [TFontStyle.fsBold];
|
|
FFastCanvas.FillText(RectF(x, y, FSplitterPos - 1, y + FRowHeight), s, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if Count > 0 then
|
|
with Canvas do
|
|
begin
|
|
Stroke.Color := claLightGray;
|
|
Stroke.Kind := TBrushKind.bkSolid;
|
|
Font.Family := 'Segoe UI';
|
|
Font.Size := 8 * 96 / 72;
|
|
Font.Style := [];
|
|
|
|
//if Screen.PixelsPerInch > 96 then
|
|
// add := 2
|
|
//else
|
|
add := 0;
|
|
p := GetItem(i);
|
|
s := GetName(i);
|
|
if p.SubProperty <> nil then
|
|
begin
|
|
offs := 1 + add;
|
|
if p.Expanded then
|
|
s := '-' + s else
|
|
s := '+' + s;
|
|
end
|
|
else
|
|
offs := 13 + add;
|
|
|
|
p.Editor.ItemHeight := Round(FRowHeight);
|
|
|
|
if Selected then
|
|
begin
|
|
Line(0, FRowHeight + -1 + i * FRowHeight, PB.Width, 0);
|
|
Fill.Color := claLightGray;
|
|
FillRect(RectF(0, Round(i * FRowHeight), FSplitterPos, Round(i * FRowHeight + FRowHeight - 1)), 1, 1, AllCorners, 1);
|
|
DrawProperty;
|
|
end
|
|
else
|
|
begin
|
|
|
|
Line(0, FRowHeight + -1 + i * FRowHeight, PB.Width, 0);
|
|
Line(FSplitterPos - 1, 0 + i * FRowHeight, 0, FRowHeight);
|
|
DrawProperty;
|
|
Fill.Color := claNavy;
|
|
Font.Style := [];
|
|
if paOwnerDraw in p.Editor.GetAttributes then
|
|
p.Editor.OnDrawItem(Canvas, RectF(FSplitterPos + 2, 1 + i * FRowHeight, PB.Width, 1 + (i + 1) * FRowHeight))
|
|
else
|
|
FFastCanvas.FillText(RectF(FSplitterPos + 2, 1 + i * FRowHeight, PB.Width + 2, 1 + i * FRowHeight + FRowHeight), GetValue(i), False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ Form events }
|
|
|
|
procedure TfrxObjectInspector.FormShow(Sender: TObject);
|
|
begin
|
|
AdjustControls;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.FormResize(Sender: TObject);
|
|
var
|
|
h: Integer;
|
|
begin
|
|
if FTabs = nil then Exit;
|
|
//if Screen.PixelsPerInch > 96 then
|
|
// h := 26
|
|
//else
|
|
h := 21;
|
|
FTabs.SetBounds(0, ObjectsCB.Position.Y + ObjectsCB.Height + 4, MainPanel.Width, h);
|
|
|
|
BackPanel.Position.Y := FTabs.Position.Y + FTabs.Height;
|
|
|
|
BackPanel.Width := MainPanel.Width;
|
|
BackPanel.Height := MainPanel.Height - BackPanel.Position.Y + 1;
|
|
ObjectsCB.Width := MainPanel.Width;
|
|
|
|
FPanel.Height := Count * FRowHeight;
|
|
FPanel.Width := Box.ClientWidth;
|
|
AdjustControls;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.TabChange(Sender: TObject);
|
|
begin
|
|
if FDesigner.IsPreviewDesigner then
|
|
begin
|
|
FTabs.TabIndex := 0;
|
|
Exit;
|
|
end;
|
|
if FTabs.TabIndex = 0 then
|
|
FList := FPropertyList else
|
|
{$IFNDEF FR_VER_BASIC}
|
|
FList := FEventList;
|
|
{$ELSE}
|
|
FTabs.TabIndex := 0;
|
|
{$ENDIF}
|
|
FItemIndex := -1;
|
|
FormResize(nil);
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.N11Click(Sender: TObject);
|
|
begin
|
|
if Edit1.Visible then
|
|
Edit1.CutToClipboard;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.N21Click(Sender: TObject);
|
|
begin
|
|
if Edit1.Visible then
|
|
Edit1.PasteFromClipboard;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.N31Click(Sender: TObject);
|
|
begin
|
|
if Edit1.Visible then
|
|
Edit1.CopyToClipboard;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.FormDeactivate(Sender: TObject);
|
|
begin
|
|
if FDisableUpdate then Exit;
|
|
SetItemIndex(FItemIndex);
|
|
end;
|
|
|
|
|
|
{ PB events }
|
|
|
|
|
|
procedure TfrxObjectInspector.PBPaint(Sender: TObject; ACanvas: TCanvas);
|
|
var
|
|
i: Integer;
|
|
r: TRectF;
|
|
begin
|
|
FUpdatingPB := FUpdatingPB or (Assigned(FPropertyList) and (FSelectedObjects.IndexOf(FPropertyList.Component) < 0));
|
|
if FUpdatingPB then Exit;
|
|
if ACanvas = nil then Exit;
|
|
if FFastCanvas is TfrxFastCanvasLayer then
|
|
begin
|
|
TfrxFastCanvasLayer(FFastCanvas).UpdateHandle(FDesigner);
|
|
TfrxFastCanvasLayer(FFastCanvas).Canvas := ACanvas;
|
|
end
|
|
else
|
|
FFastCanvas := ACanvas;
|
|
r := PB.BoundsRect;
|
|
with ACanvas do
|
|
begin
|
|
Fill.Color := claWhite;
|
|
Fill.Kind := TBrushKind.bkSolid;
|
|
FillRect(RectF(1, 1, r.Right, r.Bottom), 1, 1, AllCorners, 1);
|
|
end;
|
|
|
|
if not FDisableUpdate then
|
|
begin
|
|
for i := 0 to Count - 1 do
|
|
begin
|
|
{ do not draw outbound items }
|
|
{$IFDEF DELPHI18}
|
|
if (Box.ViewportPosition.Y > (FRowHeight * i) + FRowHeight) then
|
|
Continue;
|
|
if (Box.ViewportPosition.Y + Box.Height < (FRowHeight * i) + FRowHeight) then
|
|
break;
|
|
{$ELSE}
|
|
if (Box.VScrollBar.Value > (FRowHeight * i) + FRowHeight) then
|
|
Continue;
|
|
if (Box.VScrollBar.Value + Box.Height < (FRowHeight * i) + FRowHeight) then
|
|
break;
|
|
{$ENDIF}
|
|
if i <> ItemIndex then
|
|
DrawOneLine(ACanvas, i, False);
|
|
if FItemIndex <> -1 then
|
|
DrawOneLine(ACanvas, ItemIndex, True);
|
|
end;
|
|
end;
|
|
|
|
if not (FFastCanvas is TfrxFastCanvasLayer) then
|
|
FFastCanvas := nil;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.PBMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
|
var
|
|
p: TfrxPropertyItem;
|
|
n, x1: Integer;
|
|
begin
|
|
FDisableDblClick := False;
|
|
if Count = 0 then Exit;
|
|
if PB.Cursor = crHSplit then
|
|
FDown := True
|
|
else
|
|
begin
|
|
n := Trunc(Y / FRowHeight);
|
|
|
|
if (X > FSplitterPos) and (X < FSplitterPos + 15) and
|
|
(n >= 0) and (n < Count) then
|
|
begin
|
|
p := GetItem(n);
|
|
if p.Editor.ClassName = 'TfrxBooleanProperty' then
|
|
begin
|
|
p.Editor.Edit;
|
|
DoModify;
|
|
PB.Repaint;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
ItemIndex := n;
|
|
Edit1.SetFocus;
|
|
SetFocused(Edit1);
|
|
|
|
p := GetItem(ItemIndex);
|
|
x1 := GetOffset(ItemIndex) * 12;
|
|
if (X > x1) and (X < x1 + 13) and (p.SubProperty <> nil) then
|
|
begin
|
|
p.Expanded := not p.Expanded;
|
|
FormResize(nil);
|
|
FDisableDblClick := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.PBMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
|
begin
|
|
FDown := False;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.PBMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
|
|
var
|
|
n: Integer;
|
|
// OffsetX: Single;
|
|
s: String;
|
|
begin
|
|
if not FDown then
|
|
begin
|
|
if (X > FSplitterPos - 4) and (X < FSplitterPos + 2) then
|
|
PB.Cursor := crHSplit
|
|
else
|
|
begin
|
|
PB.Cursor := crDefault;
|
|
|
|
{ hint window }
|
|
n := Round(Y / FRowHeight);
|
|
if (X > 12) and (n >= 0) and (n < Count) then
|
|
begin
|
|
if X <= FSplitterPos - 4 then
|
|
begin
|
|
// OffsetX := (GetOffset(n) + 1) * 12;
|
|
s := GetName(n);
|
|
//MaxWidth := FSplitterPos - OffsetX;
|
|
end
|
|
else
|
|
begin
|
|
// OffsetX := FSplitterPos + 1;
|
|
s := GetValue(n);
|
|
// MaxWidth := PB.Width - FSplitterPos;
|
|
// if n = ItemIndex then
|
|
// MaxWidth := 1000;
|
|
end;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if (x > 30) and (x < PB.Width - 30) then
|
|
FSplitterPos := X;
|
|
AdjustControls;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.PBDblClick(Sender: TObject);
|
|
var
|
|
p: TfrxPropertyItem;
|
|
begin
|
|
if (Count = 0) or FDisableDblClick then Exit;
|
|
|
|
p := GetItem(ItemIndex);
|
|
if (p <> nil) and (p.SubProperty <> nil) then
|
|
begin
|
|
p.Expanded := not p.Expanded;
|
|
FormResize(nil);
|
|
end;
|
|
end;
|
|
|
|
|
|
{ Edit1 events }
|
|
|
|
procedure TfrxObjectInspector.Edit1KeyDown(Sender: TObject; var Key: Word;
|
|
var KeyChar: WideChar; Shift: TShiftState);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if Count = 0 then Exit;
|
|
if Key = vkReturn then
|
|
begin
|
|
if paDialog in GetType(ItemIndex) then
|
|
EditBtnClick(nil)
|
|
else
|
|
if Edit1.Typing then
|
|
begin
|
|
Edit1.Typing := False;
|
|
SetValue(ItemIndex, Edit1.Text);
|
|
end;
|
|
Edit1.SelectAll;
|
|
Key := 0;
|
|
Exit;
|
|
end;
|
|
|
|
if Key = vkEscape then
|
|
begin
|
|
Edit1.Typing := False;
|
|
ItemIndex := ItemIndex;
|
|
Key := 0;
|
|
end;
|
|
if (Key = vkDelete) or (Key = vkBack) then
|
|
begin
|
|
Edit1.Typing := True;
|
|
end;
|
|
|
|
if Key = vkUp then
|
|
begin
|
|
if ItemIndex > 0 then
|
|
ItemIndex := ItemIndex - 1;
|
|
Key := 0;
|
|
end
|
|
else if Key = vkDown then
|
|
begin
|
|
if ItemIndex < Count - 1 then
|
|
ItemIndex := ItemIndex + 1;
|
|
Key := 0;
|
|
end
|
|
else if Key = vkPrior then
|
|
begin
|
|
i := Round(Box.Height / FRowHeight);
|
|
i := ItemIndex - i;
|
|
if i < 0 then
|
|
i := 0;
|
|
ItemIndex := i;
|
|
Key := 0;
|
|
end
|
|
else if Key = vkNext then
|
|
begin
|
|
i := Round(Box.Height / FRowHeight);
|
|
i := ItemIndex + i;
|
|
ItemIndex := i;
|
|
Key := 0;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ EditBtn and ComboBtn events }
|
|
|
|
procedure TfrxObjectInspector.EditBtnClick(Sender: TObject);
|
|
begin
|
|
if GetItem(ItemIndex).Editor.Edit then
|
|
begin
|
|
ItemIndex := FItemIndex;
|
|
DoModify;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.ClosePopup(Sender: TObject);
|
|
begin
|
|
ComboBtn.Enabled := True;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.ComboBtnClick(Sender: TObject);
|
|
var
|
|
i, wItems, nItems, wItem: Integer;
|
|
p: TPoint;
|
|
f: TCommonCustomForm;
|
|
begin
|
|
ComboBtn.Enabled := False;
|
|
with FPopupLB do
|
|
begin
|
|
GetItem(FItemIndex).Editor.GetValues;
|
|
Items.Assign(GetItem(FItemIndex).Editor.Values);
|
|
|
|
if Items.Count > 0 then
|
|
begin
|
|
ItemIndex := Items.IndexOf(GetValue(FItemIndex));
|
|
wItems := 0;
|
|
for i := 0 to Items.Count - 1 do
|
|
begin
|
|
if paOwnerDraw in GetItem(FItemIndex).Editor.GetAttributes then
|
|
ListItems[i].OnPaint := GetItem(FItemIndex).Editor.OnDrawLBItem;
|
|
wItem := Round(Canvas.TextWidth(Items[i]));
|
|
if wItem > wItems then
|
|
wItems := wItem;
|
|
end;
|
|
|
|
Inc(wItems, 8);
|
|
if paOwnerDraw in GetItem(FItemIndex).Editor.GetAttributes then
|
|
Inc(wItems, GetItem(FItemIndex).Editor.GetExtraLBSize);
|
|
nItems := Items.Count;
|
|
if nItems > 8 then
|
|
begin
|
|
nItems := 8;
|
|
Inc(wItems, 8);
|
|
end;
|
|
f := GetComponentForm(MainPanel);
|
|
if f = nil then f := Self;
|
|
|
|
p := f.ClientToScreen(PointF(Edit1.AbsoluteRect.Left, Edit1.AbsoluteRect.Top + Position.Y + Edit1.Height)).Round;
|
|
|
|
if wItems < PB.Width - FSplitterPos then
|
|
begin
|
|
FPopupForm.Width := Round(PB.Width - FSplitterPos) + 1;
|
|
FPopupForm.Height := Round(nItems * ItemHeight) + 2;
|
|
with FPopupForm.PlacementRectangle do
|
|
begin
|
|
Left := p.X - 3;
|
|
Top := p.Y;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
FPopupForm.Width := wItems;
|
|
FPopupForm.Height := Round(nItems * ItemHeight) + 2;
|
|
with FPopupForm.PlacementRectangle do
|
|
begin
|
|
Left := p.X + Round(PB.Width - FSplitterPos - wItems) - 2;
|
|
Top := p.Y;
|
|
end;
|
|
end;
|
|
if FPopupForm.PlacementRectangle.Left < 0 then
|
|
FPopupForm.PlacementRectangle.Left := 0;
|
|
|
|
FDisableUpdate := True;
|
|
// Popup doesnt work in many cases ?!
|
|
//FPopupForm.Popup;
|
|
{$IFDEF LINUX}
|
|
FPopupForm.Popup;
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI25}
|
|
FPopupLB.RecalcSize;
|
|
{$ENDIF}
|
|
FPopupForm.PopupModal;
|
|
FDisableUpdate := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.LBClick(Sender: TObject);
|
|
var
|
|
S: String;
|
|
begin
|
|
s := Edit1.Text;
|
|
if FPopupLB.Selected <> nil then
|
|
s := FPopupLB.Selected.Text;
|
|
FPopupForm.IsOpen := False;
|
|
Edit1.Text := s;
|
|
|
|
Edit1.SetFocus;
|
|
SetFocused(Edit1);
|
|
Edit1.SelectAll;
|
|
SetValue(ItemIndex, Edit1.Text);
|
|
end;
|
|
|
|
|
|
{ ObjectsCB events }
|
|
|
|
procedure TfrxObjectInspector.ObjectsCBClick(Sender: TObject);
|
|
begin
|
|
if FUpdatingObjectsCB then Exit;
|
|
|
|
FSelectedObjects.Clear;
|
|
if ObjectsCB.ItemIndex <> -1 then
|
|
FSelectedObjects.Add(ObjectsCB.Items.Objects[ObjectsCB.ItemIndex]);
|
|
SetSelectedObjects(FSelectedObjects);
|
|
Edit1.SetFocus;
|
|
SetFocused(Edit1);
|
|
if Assigned(FOnSelectionChanged) then
|
|
FOnSelectionChanged(Self);
|
|
end;
|
|
|
|
|
|
{ Mouse wheel }
|
|
|
|
procedure TfrxObjectInspector.FormMouseWheelDown(Sender: TObject;
|
|
Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
|
|
begin
|
|
{$IFDEF DELPHI18}
|
|
with Box.ViewportPosition do
|
|
Box.ViewportPosition := PointF(X, Y + FRowHeight);
|
|
{$ELSE}
|
|
with Box.VScrollBar do
|
|
Value := Value + FRowHeight;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.FormMouseWheelUp(Sender: TObject;
|
|
Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
|
|
begin
|
|
{$IFDEF DELPHI18}
|
|
with Box.ViewportPosition do
|
|
Box.ViewportPosition := PointF(X, Y - FRowHeight);
|
|
{$ELSE}
|
|
with Box.VScrollBar do
|
|
Value := Value - FRowHeight;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrxObjectInspector.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
|
begin
|
|
if Assigned(FDesigner.OnKeyDown) then
|
|
FDesigner.OnKeyDown(Sender, Key, KeyChar, Shift);
|
|
end;
|
|
|
|
end.
|