teeinspector.pas

BCB第三方组件

{**********************************************}
{   TeeChart Office / TeeTree                  }
{   Inspector object.                          }
{   Copyright (c) 2001-2007 by David Berneda   }
{**********************************************}
unit TeeInspector;
{$I TeeDefs.inc}

interface

Uses {$IFNDEF LINUX}
     Windows, Messages,
     {$ENDIF}
     {$IFDEF D6}
     Types,
     {$ENDIF}
     {$IFDEF CLX}
     QGrids, QGraphics, QStdCtrls, QMenus, QForms, QControls, Qt,
     {$ELSE}
     Grids, Graphics, Controls, Forms, StdCtrls, Menus,
     {$ENDIF}

     {$IFDEF D6}
     Variants,
     {$ENDIF}
     {$IFDEF LCL}
     Variants,
     TeeTranslate, // <-- due to StripHotKey function
     {$ENDIF}

     Classes, SysUtils, TeCanvas, TeeProcs;

type
  TInspectorItemStyle=( iiBoolean, iiString, iiSelection, iiColor, iiPen,
                        iiGradient, iiBrush, iiFont, iiImage, iiButton,
                        iiInteger, iiDouble );

  TInspectorItem=class;

  TGetItemProc=procedure(Const S:String; AObject:TObject=nil) of object;
  TGetInspectorItems=procedure(Sender:TInspectorItem; Proc:TGetItemProc) of object;
  TGetItemIndex=procedure(Sender:TInspectorItem; var Index:Integer) of object;
  TSetItemIndex=procedure(Sender:TInspectorItem; Index:Integer) of object;

  TTeeInspector=class;

  TInspectorItem=class(TCollectionItem)
  private
    FCaption  : String;
    FData     : TObject;
    FEnabled  : Boolean;
    FExpanded : Boolean;
    FOwner    : TObject;
    FStyle    : TInspectorItemStyle;
    FValue    : Variant;
    FVisible  : Boolean;

    IData     : TObject;
    IParent   : TInspectorItem;

    FOnChange   : TNotifyEvent;
    FOnGetItemIndex : TGetItemIndex;
    FOnGetItems : TGetInspectorItems;
    FOnSetItemIndex : TSetItemIndex;

    Procedure Changed;
    Procedure RebuildInspector;
    procedure SetCaption(const Value: String);
    procedure SetVisible(const Value: Boolean);
    procedure SetValue(const Value: Variant);
    procedure SetData(const Value: TObject);
    procedure SetStyle(const Value: TInspectorItemStyle);
  protected
    procedure FillItems(Items:TStrings);
    function GetSelectedIndex(Items:TStrings):Integer; virtual;
    Function StyleToInt:Integer;
  public
    Constructor Create(Collection:TCollection); override;
    Function Inspector:TTeeInspector;

    property Data:TObject read FData write SetData;
    property Owner:TObject read FOwner write FOwner;
    property Parent:TInspectorItem read IParent write IParent;

    {$IFDEF LCL}  // Published Variants not supported by FPC
    property Value:Variant read FValue write SetValue;
    {$ENDIF}
  published
    property Caption:String read FCaption write SetCaption;
    property Enabled:Boolean read FEnabled write FEnabled default True;

    property Expanded:Boolean read FExpanded write FExpanded;

    property Style:TInspectorItemStyle read FStyle write SetStyle default iiBoolean;

    {$IFNDEF LCL}  // Published Variants not supported by FPC
    property Value:Variant read FValue write SetValue;
    {$ENDIF}

    property Visible:Boolean read FVisible write SetVisible default True;

    property OnChange:TNotifyEvent read FOnChange write FOnChange;
    property OnGetItemIndex:TGetItemIndex read FOnGetItemIndex write FOnGetItemIndex;
    property OnGetItems:TGetInspectorItems read FOnGetItems write FOnGetItems;
    property OnSetItemIndex:TSetItemIndex read FOnSetItemIndex write FOnSetItemIndex;
  end;

  TInspectorItems=class(TOwnedCollection)
  private
    Function Get(Index:Integer):TInspectorItem;
    Procedure Put(Index:Integer; Const Value:TInspectorItem);
  protected
    procedure Update(Item: TCollectionItem); override;
  public
    Inspector : TTeeInspector;

    Function Add( AStyle:TInspectorItemStyle; Const ACaption:String;
                  AData:TObject):TInspectorItem; overload;

    Function Add( AStyle:TInspectorItemStyle; Const ACaption:String;
                  AData:TObject; AOnChange:TNotifyEvent):TInspectorItem; overload;

    Function Add( AStyle:TInspectorItemStyle; Const ACaption:String;
                  AOnChange:TNotifyEvent):TInspectorItem; overload;

    Function Add( AStyle:TInspectorItemStyle; Const ACaption:String;
                  InitialValue:Variant; AOnChange:TNotifyEvent):TInspectorItem; overload;

    Function Add( AStyle:TInspectorItemStyle; Const ACaption:String;
                  InitialValue:Variant):TInspectorItem; overload;

    Function Add( AStyle:TInspectorItemStyle; Const ACaption:String;
                  InitialValue:Variant; AData:TObject;
                  AOnChange:TNotifyEvent):TInspectorItem; overload;

    Function Add( AStyle:TInspectorItemStyle; Const ACaption:String;
                  InitialValue:Variant; AData:TObject):TInspectorItem; overload;

    property Item[Index:Integer]:TInspectorItem read Get write Put; default;
  end;

  TComboFlatGrid=class(TComboFlat)
  {$IFNDEF CLX}
  private
    {$IFNDEF CLR}
    {$IFNDEF LCL}
    procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
    {$ENDIF}
    {$ENDIF}
  {$ELSE}
  protected
    function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; override;
  {$ENDIF}
  end;

  TEditGrid=class(TEdit)
  {$IFNDEF CLX}
  private
    {$IFNDEF CLR}
    {$IFNDEF LCL}
    procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
    {$ENDIF}
    {$ENDIF}
  {$ELSE}
  protected
    function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; override;
  {$ENDIF}
  end;

  TInspectorHeader=class(TPersistent)
  private
    FFont    : TFont;
    FVisible : Boolean;
    Procedure CanvasChanged(Sender:TObject);
    procedure SetFont(const Value: TFont);
    procedure SetVisible(const Value: Boolean);
  public
    Inspector : TTeeInspector;
    Constructor Create;
    Destructor Destroy; override;

    Procedure Update;
  published
    property Font:TFont read FFont write SetFont;
    property Visible:Boolean read FVisible write SetVisible default True;
  end;

  TTeeInspector=class(TStringGrid)
  private
    FHeader    : TInspectorHeader;
    FItems     : TInspectorItems;
    FOnExpandCollapse : TNotifyEvent;

    IComboGrid : TComboFlatGrid;
    IEditGrid  : TEditGrid;

    function CanDrawEllipsi(ARow:Integer):Boolean;
    Function CellType(ARow:Integer):Integer;
    function ClickedCross(X,Y:Integer):Integer;
    procedure ComboChange(Sender: TObject);
    procedure ComboKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    Procedure CreateCombo;
    Procedure CreateEdit;
    procedure DrawCross(const R:TRect; Plus:Boolean);
    procedure EditChange(Sender: TObject);
    procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ExpandCollapse(ARow:Integer);
    Procedure HideCombos;
    procedure InternalSetHeader;
    function ItemCrossRect(const R:TRect):TRect;
    function ItemOffset(ARow:Integer):Integer;
    Function MinRow:Integer;
    Procedure SetComboIndex;
    procedure SetHeader(Const Value:TInspectorHeader);
    Procedure SetItems(const Value:TInspectorItems);
    Function ValidRow(ARow:Integer):Boolean;
  protected
    procedure AddComboItem(Const S:String; AObject:TObject);

    {$IFNDEF CLX}
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    {$ENDIF}

    procedure DrawCell(ACol, ARow: Integer; ARect: TRect;
      AState: TGridDrawState); override;
    Procedure DoPositionCombos(WhenVisible:Boolean);
    Function Item(ARow:Integer):TInspectorItem;
    function ItemExpandable(ARow:Integer):Boolean; virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Loaded; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
                      X, Y: Integer); override;
    function RecalcRowCount:Integer; // 7.02
    procedure Resize; override;
    function SelectCell(ACol, ARow: Integer): Boolean; override;
    {$IFDEF CLX}
    Procedure SetParent(const Value: TWidgetControl); override;
    {$ELSE}
    Procedure SetParent(AParent: TWinControl); override;
    {$ENDIF}
    procedure TopLeftChanged; override;
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    Procedure Clear;
    procedure Rebuild;
    Procedure SetProperties(const AMenu:TPopupMenu);

    property OnExpandCollapse:TNotifyEvent read FOnExpandCollapse
                                           write FOnExpandCollapse;
  published
    property Items:TInspectorItems read FItems write SetItems;
    property Color default clBtnFace;
    property ColCount default 2;
    property DefaultColWidth default 82;
    property DefaultRowHeight default 19;
    property FixedCols default 0;
    property GridLineWidth default 0;
    property RowCount default 1;
    property Header:TInspectorHeader read FHeader write SetHeader;
    {$IFDEF CLX}
    property ScrollBars default ssAutoBoth;
    {$ENDIF}
  end;

implementation

Uses
  TeeConst, TeePenDlg, Math, TeeEdiGrad, TeeBrushDlg, TeeEdiFont, TeeBackImage;

{$IFNDEF D6}
function VarIsStr(const Value:Variant):Boolean;
var tmp : Word;
begin
  tmp:=TVarData(Value).VType; 
  result:=(tmp = varOleStr) or (tmp = varString);
end;
{$ENDIF}

{ TInspectorItems }
procedure TInspectorItem.Changed;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

constructor TInspectorItem.Create(Collection: TCollection);
begin
  inherited;
  FVisible:=True;
  FEnabled:=True;
  if csDesigning in Inspector.ComponentState then
     RebuildInspector;
end;

Procedure TInspectorItem.RebuildInspector;
begin
  if not (csLoading in Inspector.ComponentState) then
     Inspector.Rebuild;
end;

Function TInspectorItem.Inspector:TTeeInspector;
begin
  result:=TInspectorItems(Collection).Inspector;
end;

procedure TInspectorItem.SetCaption(const Value: String);
begin
  if FCaption<>Value then
  begin
    FCaption:=Value;
    RebuildInspector;
  end;
end;

procedure TInspectorItem.SetData(const Value: TObject);
begin
  if FData<>Value then
  begin
    FData:=Value;

    if Style=iiSelection then
    with Inspector do
         if Item(Row)=Self then
         begin
           SetComboIndex;
           Self.Value:=IComboGrid.CurrentItem;
         end;
  end;
end;

procedure TInspectorItem.SetValue(const Value: Variant);
begin
  FValue:=Value;
  Inspector.Invalidate;
end;

procedure TInspectorItem.SetVisible(const Value: Boolean);
begin
  if FVisible<>Value then
  begin
    FVisible:=Value;
    RebuildInspector;
  end;
end;

Function TInspectorItem.StyleToInt:Integer;
begin
  case FStyle of
    iiButton    : result:=0;
    iiBoolean   : result:=1;
    iiPen       : result:=3;
    iiGradient  : result:=4;
    iiColor     : result:=2;
    iiInteger,
    iiDouble,
    iiString    : result:=10;
    iiSelection : result:=0;
    iiFont      : result:=7;
    iiImage     : result:=8;
    iiBrush     : result:=9;
  else
    result:=-1;
  end;
end;

{ TInspectorItems }
Function TInspectorItems.Get(Index:Integer):TInspectorItem;
begin
  result:=TInspectorItem(inherited Items[Index]);
end;

Procedure TInspectorItems.Put(Index:Integer; Const Value:TInspectorItem);
begin
  inherited Items[Index]:=Value;
end;

Function TInspectorItems.Add( AStyle:TInspectorItemStyle; Const ACaption:String;
                              InitialValue:Variant; AData:TObject):TInspectorItem;
var c : TNotifyEvent;
begin
  c:=nil;
  result:=Add(AStyle,ACaption,InitialValue,AData,c);
end;

Function TInspectorItems.Add( AStyle:TInspectorItemStyle; Const ACaption:String;
                              AData:TObject):TInspectorItem;
var c : TNotifyEvent;
begin
  c:=nil;
  result:=Add(AStyle,ACaption,{$IFDEF CLR}varNull{$ELSE}vaNull{$ENDIF},AData,c);
end;

Function TInspectorItems.Add( AStyle:TInspectorItemStyle; Const ACaption:String;
                              AData:TObject; AOnChange:TNotifyEvent):TInspectorItem;
begin
  result:=Add(AStyle,ACaption,{$IFDEF CLR}varNull{$ELSE}vaNull{$ENDIF},AData,AOnChange);
end;

Function TInspectorItems.Add( AStyle:TInspectorItemStyle; Const ACaption:String;
                              AOnChange:TNotifyEvent):TInspectorItem;
begin
  result:=Add(AStyle,ACaption,{$IFDEF CLR}varNull{$ELSE}vaNull{$ENDIF},nil,AOnChange);
end;

Function TInspectorItems.Add( AStyle:TInspectorItemStyle; Const ACaption:String;
                              InitialValue:Variant; AOnChange:TNotifyEvent):TInspectorItem;
begin
  result:=Add(AStyle,ACaption,InitialValue,nil,AOnChange);
end;

Function TInspectorItems.Add( AStyle:TInspectorItemStyle; Const ACaption:String;
                               InitialValue:Variant):TInspectorItem;
var c : TNotifyEvent;
begin
  c:=nil;
  result:=Add(AStyle,ACaption,InitialValue,nil,c);
end;

Function TInspectorItems.Add(AStyle:TInspectorItemStyle; Const ACaption:String;
                              InitialValue:Variant; AData:TObject;
                              AOnChange:TNotifyEvent):TInspectorItem;
begin
  result:=TInspectorItem(inherited Add);

  with result do
  begin
    FStyle:=AStyle;
    FCaption:=ACaption;
    FValue:=InitialValue;
    FData:=AData;
    FOnChange:=AOnChange;
  end;

  with Inspector do
  begin
    RecalcRowCount;
    Cells[0,RowCount-1]:=ACaption;
    Objects[0,RowCount-1]:=result;
  end;
end;

procedure TInspectorItems.Update(Item: TCollectionItem);
begin
  if not (csLoading in Inspector.ComponentState) then
     Inspector.Rebuild;
end;

{ TTeeInspector }
Constructor TTeeInspector.Create(AOwner:TComponent);
begin
  inherited;

  FHeader:=TInspectorHeader.Create;
  FHeader.Inspector:=Self;
  FHeader.Font.Color:=clNavy;

  FItems:=TInspectorItems.Create(Self,TInspectorItem);
  FItems.Inspector:=Self;

  Color:=clBtnFace;
  ColCount:=2;
  DefaultColWidth:=82;
  DefaultRowHeight:=19;

  FixedCols:=0;
  RowCount:=1;
  GridLineWidth:=0;
  Options:=[goFixedVertLine, goVertLine, goHorzLine, goColSizing, goThumbTracking];

  {$IFDEF CLX}
  ScrollBars:=ssAutoBoth;
  {$ENDIF}

  Header.Update;

  CreateCombo;
  CreateEdit;
end;

Destructor TTeeInspector.Destroy;
begin
  FItems.Free;
  FHeader.Free;
  inherited;
end;

Procedure TTeeInspector.SetItems(const Value:TInspectorItems);
begin
  FItems.Assign(Value);
end;

procedure TTeeInspector.SetHeader(Const Value:TInspectorHeader);
begin
  FHeader.Assign(Value);
end;

Procedure TTeeInspector.InternalSetHeader;
begin { set header cells text }
  if Header.Visible then
  begin
    Cells[0,0]:=TeeMsg_Property;
    Cells[1,0]:=TeeMsg_Value;
  end
  else Rows[0].Clear;
end;

Procedure TTeeInspector.CreateEdit;
begin { create edit box }
  IEditGrid:=TEditGrid.Create(Self);

  with IEditGrid do
  begin
    Name:='IEditGrid'; // Do not localize
    Visible:=False;

    {$IFNDEF CLX}
    {$IFNDEF LCL}
    BevelInner:=bvNone;
    BevelKind:=bkFlat;
    {$ENDIF}
    {$ENDIF}

    BorderStyle:=bsNone;

    OnChange:=Self.EditChange;
    OnKeyDown:=Self.EditKeyDown;
  end;
end;

Procedure TTeeInspector.SetComboIndex;
begin
  Item(Row).FillItems(IComboGrid.Items);
  IComboGrid.ItemIndex:=Item(Row).GetSelectedIndex(IComboGrid.Items);
end;

// Create combobox
Procedure TTeeInspector.CreateCombo;
begin
  IComboGrid:=TComboFlatGrid.Create(Self);

  with IComboGrid do
  begin
    Name:='IComboGrid'; // Do not localize

    Style:=csDropDownList;
    DropDownCount:=12;
    ItemHeight:=21;
    Visible:=False;

    OnChange:=Self.ComboChange;
    IComboGrid.OnKeyDown:=Self.ComboKeyDown;
  end;
end;

Procedure TTeeInspector.Resize;
begin
  inherited;

  if ColCount>0 then
     {$IFDEF CLX}
     if (not Assigned(Owner)) or (not (csReading in Owner.ComponentState)) then
     {$ENDIF}
        ColWidths[1]:=ClientWidth-ColWidths[0];

  // resize combobox width (if visible)