inspctrl.pas

类似Delphi Ide的对象查看器 可以在RUNTIME时使用

procedure TCustomInspector.DrawPropertyName(TheCanvas: TCanvas; TheIndex: Integer; R: TRect);
begin
  TheCanvas.Brush.Color:=GetNameColor(TheIndex);
  GetNameFont(TheIndex,TheCanvas.Font);
  if Assigned(FOnDrawName) then FOnDrawName(Self,TheIndex,TheCanvas,R)
  else DrawPropertyNameDefault(TheCanvas,TheIndex,R);
end;

procedure TCustomInspector.DrawPropertyNameDefault(TheCanvas: TCanvas; TheIndex: Integer; R: TRect);

var
  X,S,E: Integer;
  EB: TBitmap;
  FR: TRect;

  function FindItem(Start,Level: Integer): Boolean;
  var
    i: Integer;
  begin
    Result:=False;
    for i:=Succ(Start) to Pred(Items.Count) do
    begin
      Result:=GetLevel(i)=Level;
      if Result then Break;
    end;
  end;

begin
  case GetExpandState(TheIndex) of
    esExpand: EB:=FExpand;
    esCollapse: EB:=FCollapse;
  else EB:=nil;
  end;
  with TheCanvas,R do
    case FPaintStyle of
      psClassic:
      begin
        FillRect(R);
        if Assigned(EB) then
          Draw(Left+GetLevel(TheIndex)*GetIndent+2,Top+(Bottom-Top-FExpand.Height) div 2,EB);
        Inc(Left,Succ(GetLevel(TheIndex))*GetIndent+4);
        DrawText(Handle,PChar(GetName(TheIndex)),-1,R,DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS);
      end;
      psTree:
      begin
        Pen.Color:=clWhite;
        Pen.Color:=clBtnShadow;
        for X:=0 to GetLevel(TheIndex) do
        begin
          S:=Top-2;
          E:=Bottom;
          if TheIndex=0 then Inc(S,ItemHeight div 2+2);
          if not FindItem(TheIndex,X) then
            if GetLevel(TheIndex)=X then Dec(E,ItemHeight div 2)
            else Continue;
          MoveTo(Left+X*(GetIndent+2)+GetIndent div 2,S);
          LineTo(PenPos.X,E);
        end;
        MoveTo(Left+GetLevel(TheIndex)*(GetIndent+2)+GetIndent div 2,(Top+Bottom) div 2);
        LineTo(Left+Pred(Succ(GetLevel(TheIndex))*(GetIndent+2)),PenPos.Y);
        if Assigned(EB) then
          Draw(Left+GetLevel(TheIndex)*(GetIndent+2)+2,Top+(Bottom-Top) div 2-(FExpand.Height) div 2,EB);
        Inc(Left,Succ(GetLevel(TheIndex))*(GetIndent+2)+2);
        Dec(Bottom);
        Inc(Top);
        Dec(Right);
        DrawText(Handle,PChar(GetName(TheIndex)),-1,R,DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS or DT_CALCRECT);
        FR:=R;
        InflateRect(FR,2,0);
        FillRect(FR);
        DrawText(Handle,PChar(GetName(TheIndex)),-1,R,DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS);
      end;
      psGreatis:
      begin
        FillRect(
          Rect(
            Left+Pred(GetLevel(TheIndex)*(GetIndent+2)),
            Top,Right,Bottom));
        if Assigned(EB) then
          Draw(Left+GetLevel(TheIndex)*(GetIndent+2)+2,Top+(Bottom-Top-FExpand.Height) div 2,EB);
        Pen.Color:=clWhite;
        Pen.Color:=clBtnShadow;
        if GetExpandState(TheIndex)<>esNone then
        begin
          MoveTo(Left+Pred(Succ(GetLevel(TheIndex))*(GetIndent+2)),Top);
          LineTo(PenPos.X,Bottom);
        end;
        MoveTo(Left+Pred(Getlevel(TheIndex)*(GetIndent+2)),Top);
        LineTo(PenPos.X,Bottom);
        Inc(Left,Succ(GetLevel(TheIndex))*(GetIndent+2)+2);
        DrawText(Handle,PChar(GetName(TheIndex)),-1,R,DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS);
      end;
    end;
end;

procedure TCustomInspector.DrawPropertyValue(TheCanvas: TCanvas; TheIndex: Integer; R: TRect);
begin
  TheCanvas.Brush.Color:=GetValueColor(TheIndex);
  GetValueFont(TheIndex,TheCanvas.Font);
  if Assigned(FOnDrawValue) then FOnDrawValue(Self,TheIndex,TheCanvas,R)
  else DrawPropertyValueDefault(TheCanvas,TheIndex,R);
end;

procedure TCustomInspector.DrawPropertyValueDefault(TheCanvas: TCanvas; TheIndex: Integer; R: TRect);
var
  S: Integer;
  IR: TRect;
begin
  with TheCanvas do
  begin
    FillRect(R);
    Dec(R.Bottom);
    case GetInplaceEditorType(TheIndex) of
      ieNone,ieEdit:
      begin
        Inc(R.Left);
        DrawText(Handle,PChar(GetValue(TheIndex)),-1,R,DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS or DT_NOPREFIX);
      end;
      ieCheckBox:
      begin
        IR:=R;
        with IR do
        begin
          Right:=Left+GetSystemMetrics(SM_CXMENUCHECK);
          Bottom:=Top+Right-Left;
          OffsetRect(IR,1,((R.Bottom-R.Top+1)-(Bottom-Top)) div 2);
        end;
        S:=DFCS_BUTTONCHECK;
        if StringToBoolean(GetValue(TheIndex)) then S:=S or DFCS_CHECKED;
        DrawFrameControl(Handle,IR,DFC_BUTTON,S);
      end;
    end;
  end;
end;

procedure TCustomInspector.DrawBorders(TheCanvas: TCanvas; TheIndex: Integer; R: TRect);
begin
  with TheCanvas,R do
    case FPaintStyle of
      psClassic:
      begin
        Pen.Color:=clBlack;
        MoveTo(Left,Bottom-1);
        LineTo(Left,Top-2);
        LineTo(Right,Top-2);
        Pen.Color:=clBtnHighlight;
        LineTo(Right,Bottom-1);
        LineTo(Pred(Left),Bottom-1);
        InflateRect(R,-1,-1);
        Pen.Color:=clBtnShadow;
        MoveTo(Left,Bottom-2);
        LineTo(Left,Top-2);
        LineTo(Succ(Right),Top-2);
        Pen.Color:=cl3DLight;
        MoveTo(Left+1,Bottom-1);
        LineTo(Right+1,Bottom-1);
      end;
    end;
end;

procedure TCustomInspector.DrawVerticalSeparator(TheCanvas: TCanvas; TheIndex: Integer; R: TRect);
var
  B: Integer;
begin
  with TheCanvas,R do
    case FPaintStyle of
      psClassic:
      begin
        if TheIndex=ItemIndex then B:=Bottom-2
        else B:=Bottom;
        Pen.Color:=clBtnShadow;
        MoveTo(Pred(FSplitter),Top);
        LineTo(Pred(FSplitter),B);
        Pen.Color:=clBtnHighlight;
        MoveTo(FSplitter,Top);
        LineTo(FSplitter,B);
      end;
      psGreatis,psTree:
      begin
        Pen.Color:=clWhite;
        Pen.Color:=clBtnShadow;
        MoveTo(FSplitter,Top);
        LineTo(FSplitter,Bottom);
      end;
    end;
end;

procedure TCustomInspector.DrawHorizontalSeparator(TheCanvas: TCanvas; TheIndex: Integer; R: TRect);
var
  i: Integer;
begin
  with TheCanvas,R do
    case FPaintStyle of
      psClassic:
        for i:=Left to Pred(Right) do
          if not Odd(i) then
            SetPixel(Handle,i,Pred(Bottom),ColorToRGB(clBtnShadow));
      psTree:
      begin
        if TheIndex<Pred(Items.Count) then Pen.Color:=GetValueColor(TheIndex)
        else Pen.Color:=Self.Color;
        MoveTo(Left+FSplitter,Pred(Bottom));
        LineTo(Right,Pred(Bottom));
      end;
      psGreatis:
      begin
        Pen.Color:=clWhite;
        Pen.Color:=clBtnShadow;
        i:=GetLevel(TheIndex);
        if (TheIndex<Pred(ItemCount)) and (GetLevel(Succ(TheIndex))<i) then
          i:=GetLevel(Succ(TheIndex));
        MoveTo(Left+Pred(i*(GetIndent+2)),Pred(Bottom));
        LineTo(Right,Pred(Bottom));
      end;
    end;
end;

function TCustomInspector.GetName(TheIndex: Integer): string;
begin
  Result:='';
  if Assigned(FOnGetName) then FOnGetName(Self,TheIndex,Result);
end;

function TCustomInspector.GetValue(TheIndex: Integer): string;
begin
  Result:='';
  if Assigned(FOnGetValue) then FOnGetValue(Self,TheIndex,Result);
end;

function TCustomInspector.GetNextValue(TheIndex: Integer): string;
begin
  Result:='';
  if Assigned(FOnGetNextValue) then FOnGetNextValue(Self,TheIndex,Result);
end;

procedure TCustomInspector.SetValue(TheIndex: Integer; const Value: string);
begin
  if Assigned(FOnSetValue) then FOnSetValue(Self,TheIndex,Value);
end;

procedure TCustomInspector.DragValue(TheIndex,Offset: Integer);
begin
  if Assigned(FOnDragValue) then FOnDragValue(Self,TheIndex,Offset);
end;

function TCustomInspector.GetButtonType(TheIndex: Integer): TButtonType;
begin
  Result:=btNone;
  if Assigned(FOnGetButtonType) then FOnGetButtonType(Self,TheIndex,Result);
end;

function TCustomInspector.GetInplaceEditorType(TheIndex: Integer): TInplaceEditorType;
begin
  Result:=ieEdit;
  if Assigned(FOnGetInplaceEditorType) then FOnGetInplaceEditorType(Self,TheIndex,Result);
end;

function TCustomInspector.GetMaxLength(TheIndex: Integer): Integer;
begin
  Result:=0;
  if Assigned(FOnGetMaxLength) then FOnGetMaxLength(Self,TheIndex,Result);
end;

function TCustomInspector.GetEditMask(TheIndex: Integer): string;
begin
  Result:='';
  if Assigned(FOnGetEditMask) then FOnGetEditMask(Self,TheIndex,Result);
end;

function TCustomInspector.GetEnableExternalEditor(TheIndex: Integer): Boolean;
begin
  Result:=False;
  if Assigned(FOnGetEnableExternalEditor) then FOnGetEnableExternalEditor(Self,TheIndex,Result);
end;

function TCustomInspector.GetReadOnly(TheIndex: Integer): Boolean;
begin
  Result:=False;
  if Assigned(FOnGetReadOnly) then FOnGetReadOnly(Self,TheIndex,Result);
end;

function TCustomInspector.GetExpandState(TheIndex: Integer): TExpandState;
begin
  Result:=esNone;
  if Assigned(FOnGetExpandState) then FOnGetExpandState(Self,TheIndex,Result);
end;

function TCustomInspector.GetLevel(TheIndex: Integer): Integer;
begin
  Result:=0;
  if Assigned(FOnGetLevel) then FOnGetLevel(Self,TheIndex,Result);
end;

function TCustomInspector.GetData(TheIndex: Integer): Pointer;
begin
  Result:=nil;
  if Assigned(FOnGetData) then FOnGetData(Self,TheIndex,Result);
end;

procedure TCustomInspector.GetValuesList(TheIndex: Integer; const Strings: TStrings);
begin
  if Assigned(Strings) and Assigned(FOnGetValuesList) then
  begin
    Strings.Clear;
    FOnGetValuesList(Self,TheIndex,Strings);
  end;
end;

function TCustomInspector.GetSortValuesList(TheIndex: Integer): Boolean;
begin
  Result:=False;
  if Assigned(FOnGetSortValuesList) then FOnGetSortValuesList(Self,TheIndex,Result);
end;

function TCustomInspector.GetSelectedValue(TheIndex: Integer): string;
begin
  Result:=Values[TheIndex];
  if Assigned(FOnGetSelectedValue) then FOnGetSelectedValue(Self,TheIndex,Result);
end;

function TCustomInspector.GetAutoApply(TheIndex: Integer): Boolean;
begin
  Result:=False;
  if Assigned(FOnGetAutoApply) then FOnGetAutoApply(Self,TheIndex,Result);
end;

procedure TCustomInspector.GetNameFont(TheIndex: Integer; TheFont: TFont);
begin
  case FPaintStyle of
    psGreatis,psTree:
      if TheIndex=ItemIndex then TheFont.Color:=clHighlightText
  end;
  if Assigned(FOnGetNameFont) then FOnGetNameFont(Self,TheIndex,TheFont);
end;

function TCustomInspector.GetNameColor(TheIndex: Integer): TColor;
begin
  case FPaintStyle of
    psGreatis,psTree:
      if TheIndex=ItemIndex then Result:=clHighlight
      else Result:=Color;
  else Result:=Color;
  end;
  if Assigned(FOnGetNameColor) then FonGetNameColor(Self,TheIndex,Result);
end;

procedure TCustomInspector.GetValueFont(TheIndex: Integer; TheFont: TFont);
begin
  if Assigned(FOnGetValueFont) then FOnGetValueFont(Self,TheIndex,TheFont);
end;

function TCustomInspector.GetValueColor(TheIndex: Integer): TColor;
begin
  Result:=Color;
  if Assigned(FOnGetValueColor) then FonGetValueColor(Self,TheIndex,Result);
end;

function TCustomInspector.GetIndent: Integer;
begin
  Result:=FExpand.Width;
  case FPaintStyle of
    psGreatis: Inc(Result,3);
    psTree: Inc(Result,4);
  end;
end;

function TCustomInspector.CallEditor(TheIndex: Integer): Boolean;
begin
  if Assigned(FOnCallEditor) then Result:=FOnCallEditor(Self,TheIndex)
  else Result:=False;
end;

procedure TCustomInspector.Expand(TheIndex: Integer);
begin
  if Assigned(FOnExpand) then FOnExpand(Self,TheIndex);
end;

procedure TCustomInspector.Collapse(TheIndex: Integer);
begin
  if Assigned(FOnCollapse) then FOnCollapse(Self,TheIndex);
end;

procedure TCustomInspector.SelectItem(TheIndex: Integer);
begin
  if Assigned(FOnSelectItem) then FOnSelectItem(Self,TheIndex);
end;

procedure TCustomInspector.DeselectItem(TheIndex: Integer);
begin
  if Assigned(FOnDeselectItem) then FOnDeselectItem(Self,TheIndex);
end;

constructor TCustomInspector.Create(AOwner: TComponent);
begin
  inherited;
  Style:=lbOwnerDrawFixed;
  Color:=clBtnFace;
  FSplitter:=100;
  FEdit:=TInspectorEdit.Create(Self);
  with FEdit do
  begin
    BorderStyle:=bsNone;
    Visible:=False;
    if not (csDesigning in ComponentState) then Parent:=Self;
  end;
  FCheckBox:=TInspectorCheckBox.Create(Self);
  with FCheckBox do
  begin
    ParentColor:=False;
    Color:=clWindow;
    Visible:=False;
    if not (csDesigning in ComponentState) then Parent:=Self;
  end;
  FButton:=TInspectorButton.Create(Self);
  if not (csDesigning in ComponentState) then FButton.Parent:=Self;
  FPopup:=TInspectorPopup.Create(Self);
  FPopup.ItemHeight:=ItemHeight;
  FExpand:=TBitmap.Create;
  FExpand.Handle:=LoadBitmap(HInstance,'EXPAND');
  with FExpand,Canvas do
  begin
    PixelFormat:=pf4bit;
    Brush.Color:=clWindow;
    FloodFill(2,2,clBlack,fsBorder);
  end;
  FCollapse:=TBitmap.Create;
  FCollapse.Handle:=LoadBitmap(HInstance,'COLLAPSE');
  with FCollapse,Canvas do
  begin
    PixelFormat:=pf4bit;
    Brush.Color:=clWindow;
    FloodFill(2,2,clBlack,fsBorder);
  end;
  {$IFDEF GOITRIAL}
  if not (csDesigning in ComponentState) then
    Application.MessageBox(
      'You are using trial version of GREATIS OBJECT INSPECTOR     components'#13'with some functional limitations.',
      'GREATIS OBJECT INSPECTOR  - Trial Version',
      MB_OK or MB_ICONEXCLAMATION);
  {$ENDIF}
end;

destructor TCustomInspector.Destroy;
begin
  FExpand.Free;
  FCollapse.Free;
  inherited;
end;

procedure TCustomInspector.Update;
var
  R: TRect;
begin
  if not Locked then
  begin
    if Assigned(FPopup) then FPopup.Hide;
    RedrawWindow(Handle,nil,0,RDW_NOERASE or RDW_INVALIDATE);
    if not FFullUpdate then
    begin
      R:=ItemRect(ItemIndex);                   
      R.Right:=FSplitter;
      ValidateRect(Handle,@R);
    end;
    FFullUpdate:=False;
    UpdateControls;
    if Assigned(FOnUpdate) then FOnUpdate(Self);
  end;
end;

procedure TCustomInspector.Lock;
begin
  Inc(FLockCounter);
end;

procedure TCustomInspector.Unlock;
begin
  if Locked then Dec(FLockCounter);
end;

procedure TCustomInspector.CreateWnd;
begin
  inherited;
  ItemCount:=FItemCount;
  FOldWidth:=0;
  FOldHeight:=0;
  FOldSplitter:=0;
  UpdateControls;
end;

initialization
  Screen.Cursors[crUpDown]:=LoadCursor(HInstance,'UPDOWN');
end.