frxinsp.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

{******************************************}
{ }
{ FastReport v3.0 }
{ Object Inspector }
{ }
{ Copyright (c) 1998-2005 }
{ 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 Delphi6}
, Variants
{$ENDIF};
  

type
  TfrxObjectInspector = class(TForm)
    ObjectsCB:TComboBox;
    Tab:TTabControl;
    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:TPanel;
    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);
    procedure FormCreate(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;
    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;

{ 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);
  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;

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

  FItemIndex:=-1;
  FSplitterPos:= PB.Width div 2;
  AutoScroll:= False;
  FormResize(nil);

  frxResources.LocalizeForm(Self);
  Tab.Tabs.Clear;
  Tab.Tabs.Add(frxResources.Get('oiProp'));
  Tab.Tabs.Add(frxResources.Get('oiEvent'));
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;
// FTempList.Clear;
// FTempList.Add(AObjects[0]);
  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:= 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 Tab.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;
    ItemIndex:= 0;
  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
      SetValue(FItemIndex, Edit1.Text);
  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
  begin
    EditPanel.SetBounds(PB.Width-15, y-1, 15, 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, FRowHeight-1);