frxinsp.pas

这个是功能强大的报表软件

{******************************************}
{                                          }
{             FastReport v4.0              }
{             Object Inspector             }
{                                          }
{         Copyright (c) 1998-2008          }
{         by Alexander Tzyganenko,         }
{            Fast Reports Inc.             }
{                                          }
{******************************************}

unit frxInsp;

interface

{$I frx.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, frxDsgnIntf, frxPopupForm,
  frxClass, Menus, ComCtrls
{$IFDEF UseTabset}
, Tabs
{$ENDIF}
{$IFDEF Delphi6}
, Variants
{$ENDIF};
  

type
  TfrxObjectInspector = class(TForm)
    ObjectsCB: TComboBox;
    PopupMenu1: TPopupMenu;
    N11: TMenuItem;
    N21: TMenuItem;
    N31: TMenuItem;
    BackPanel: TPanel;
    Box: TScrollBox;
    PB: TPaintBox;
    Edit1: TEdit;
    EditPanel: TPanel;
    EditBtn: TSpeedButton;
    ComboPanel: TPanel;
    ComboBtn: TSpeedButton;
    HintPanel: TScrollBox;
    Splitter1: TSplitter;
    PropL: TLabel;
    DescrL: TLabel;
    N41: TMenuItem;
    N51: TMenuItem;
    N61: TMenuItem;
    procedure PBPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure PBMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PBMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PBMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure EditBtnClick(Sender: TObject);
    procedure ComboBtnClick(Sender: TObject);
    procedure Edit1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ObjectsCBClick(Sender: TObject);
    procedure ObjectsCBDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    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 FormEndDock(Sender, Target: TObject; X, Y: Integer);
    procedure ComboBtnMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormShow(Sender: TObject);
    procedure TabChange(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure N31Click(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
  private
    { Private declarations }
    FDesigner: TfrxCustomDesigner;
    FDisableDblClick: Boolean;
    FDisableUpdate: Boolean;
    FDown: Boolean;
    FEventList: TfrxPropertyList;
    FHintWindow: THintWindow;
    FItemIndex: Integer;
    FLastPosition: String;
    FList: TfrxPropertyList;
    FPopupForm: TfrxPopupForm;
    FPopupLB: TListBox;
    FPopupLBVisible: Boolean;
    FPropertyList: TfrxPropertyList;
    FPanel: TPanel;
    FRowHeight: Integer;
    FSelectedObjects: TList;
    FSplitterPos: Integer;
{$IFDEF UseTabset}
    FTabs: TTabSet;
{$ELSE}
    FTabs: TTabControl;
{$ENDIF}
    FTempBMP: TBitmap;
    FTempList: TList;
    FTickCount: UInt;
    FUpdatingObjectsCB: Boolean;
    FUpdatingPB: Boolean;
    FOnSelectionChanged: TNotifyEvent;
    FOnModify: TNotifyEvent;

    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 CMMouseLeave(var Msg: TMessage); message CM_MouseLeave;
    procedure DrawOneLine(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);
    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 SetColor(Color: TColor);
    procedure UpdateProperties;
    property Objects: TList write SetObjects;
    property ItemIndex: Integer read FItemIndex write SetItemIndex;
    property SelectedObjects: TList read FSelectedObjects write SetSelectedObjects;
    property SplitterPos: Integer 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

{$R *.DFM}

uses frxUtils, frxRes, frxrcInsp;


type
  TInspPanel = class(TPanel)
  protected
    procedure WMEraseBackground(var Message: TMessage); message WM_ERASEBKGND;
    procedure Paint; override;
  end;

  THackWinControl = class(TWinControl);


{ TInspPanel }

procedure TInspPanel.WMEraseBackground(var Message: TMessage);
begin
// empty method
end;

procedure TInspPanel.Paint;
begin
// empty method
end;


{ TfrxObjectInspector }

constructor TfrxObjectInspector.Create(AOwner: TComponent);
begin
  if not (AOwner is TfrxCustomDesigner) then
    raise Exception.Create('The Owner of the object inspector should be TfrxCustomDesigner');
  inherited Create(AOwner);
  FItemIndex := -1;
  FTempBMP := TBitmap.Create;
  FTempList := TList.Create;
  FDesigner := TfrxCustomDesigner(AOwner);
  FHintWindow := THintWindow.Create(Self);
  FHintWindow.Color := clInfoBk;

  FPanel := TInspPanel.Create(Self);
  with FPanel do
  begin
    Parent := Box;
    BevelInner := bvNone;
    BevelOuter := bvNone;
  end;
  PB.Parent := FPanel;
  ComboPanel.Parent := FPanel;
  EditPanel.Parent := FPanel;
  Edit1.Parent := FPanel;
{$IFDEF UseTabset}
  Box.BevelKind := bkFlat;
  HintPanel.BevelKind := bkFlat;
{$ELSE}
  Box.BorderStyle := bsSingle;
  HintPanel.BorderStyle := bsSingle;
{$IFDEF Delphi7}
  Box.ControlStyle := Box.ControlStyle + [csNeedsBorderPaint];
  HintPanel.ControlStyle := HintPanel.ControlStyle + [csNeedsBorderPaint];
{$ENDIF}
{$ENDIF}

  FRowHeight := Canvas.TextHeight('Wg') + 3;
  with Box.VertScrollBar do
  begin
    Increment := FRowHeight;
    Tracking := True;
  end;

{$IFDEF UseTabset}
  FTabs := TTabSet.Create(Self);
  FTabs.OnClick := TabChange;
  FTabs.ShrinkToFit := True;
  FTabs.Style := tsSoftTabs;
  FTabs.TabPosition := tpTop;
{$ELSE}
  FTabs := TTabControl.Create(Self);
  FTabs.OnChange := TabChange;
{$ENDIF}
  FTabs.Parent := Self;
  FTabs.SendToBack;
  FTabs.Tabs.Add(frxResources.Get('oiProp'));
  FTabs.Tabs.Add(frxResources.Get('oiEvent'));
  FTabs.TabIndex := 0;

  if Screen.PixelsPerInch > 96 then
    ObjectsCB.ItemHeight := 19;
  FSplitterPos := PB.Width div 2;
  AutoScroll := False;

  FormResize(nil);

  Caption := frxGet(2000);
end;

destructor TfrxObjectInspector.Destroy;
begin
  FTempBMP.Free;
  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 := 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.SetColor(Color: TColor);
begin
  ObjectsCB.Color := Color;
  Box.Color := Color;
  PB.Repaint;
end;

procedure TfrxObjectInspector.SetObjects(Value: TList);
var
  i: Integer;
  s: String;
begin
  ObjectsCB.Items.Clear;
  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;
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.Items.AddObject(s, FSelectedObjects[0]);
      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.SetItemIndex(Value: Integer);
var
  p: TfrxPropertyItem;
  s: String;
begin
  PropL.Caption := '';
  DescrL.Caption := '';
  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.Modified then
    begin
      Edit1.Modified := False;
      SetValue(FItemIndex, Edit1.Text);
    end;
  FItemIndex := Value;

  if FItemIndex <> -1 then
  begin
    FLastPosition := GetName(FItemIndex);
    p := GetItem(FItemIndex);
    s := GetName(FItemIndex);
    PropL.Caption := 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.Caption := s;
    end;
  end;

  AdjustControls;
end;

procedure TfrxObjectInspector.SetValue(Index: Integer; Value: String);
begin
  try
    GetItem(Index).Editor.Value := Value;
    DoModify;
    PBPaint(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 (csDocking in ControlState) or FDisableUpdate then Exit;
  if FItemIndex = -1 then
  begin
    EditPanel.Visible := False;
    ComboPanel.Visible := False;
    Edit1.Visible := False;
    FUpdatingPB := False;
    PBPaint(nil);
    Exit;
  end;

  FUpdatingPB := True;
  PropType := GetType(FItemIndex);

  EditPanel.Visible := paDialog in PropType;
  ComboPanel.Visible := paValueList in PropType;
  Edit1.ReadOnly := paReadOnly in PropType;

  ww := PB.Width - FSplitterPos - 2;
  y := FItemIndex * FRowHeight + 1;
  if EditPanel.Visible then