inspctrl.pas

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

begin
  if Assigned(FPopup) and FPopup.Visible then
  begin
    FPopup.Hide;
    FocusControl;
  end;
end;

function TCustomInspector.IsFocused: Boolean;
begin
  IsFocused:=
    Focused or
    FCheckBox.Focused or
    FEdit.Focused or
    FButton.Focused;
end;

function TCustomInspector.SpecialClick(L: LParam): Boolean;
begin
  Result:=(GetExpandState(ItemIndex)<>esNone) and
    (Abs(LoWord(L))>=GetLevel(ItemIndex)*GetIndent) and
    (Abs(LoWord(L))<=Succ(GetLevel(ItemIndex))*GetIndent+2);
end;

procedure TCustomInspector.WndProc(var Message: TMessage);
var
  R: TRect;
  P: TPoint;
  i,j: Integer;
  IFont: TFont;
  IPen: TPen;
  IBrush: TBrush;

  procedure SaveCanvas(C: TCanvas);
  begin
    with C do
    begin
      IFont.Assign(Font);
      IPen.Assign(Pen);
      IBrush.Assign(Brush);
    end;
  end;

  procedure RestoreCanvas(C: TCanvas);
  begin
    with C do
    begin
      Font.Assign(IFont);
      Pen.Assign(IPen);
      Brush.Assign(IBrush);
    end;
  end;

  procedure ExpandCollapse;
  begin
    case GetExpandState(ItemIndex) of
      esExpand:
      begin
        j:=ItemCount;
        Expand(ItemIndex);
        i:=ItemIndex+ItemCount-j-(ClientHeight div ItemHeight)+1;
        if i>TopIndex then TopIndex:=i;
      end;
      esCollapse:
      begin
        Collapse(ItemIndex);
        SetSelectionPos(ItemIndex,True);
      end;
    end;
  end;

begin
  with Message do
    case Msg of
      CM_ENTER:
      begin
        inherited;
        if FEdit.CanFocus then FEdit.SetFocus;
        if FCheckBox.CanFocus then FCheckBox.SetFocus;
        FocusControl;
      end;
      CM_EXIT:
      begin
        if FPopup.Showing then FPopup.Hide;
        inherited;
      end;
      CM_FONTCHANGED:
      begin
        inherited;
        ItemHeight:=3*Abs(Font.Height) div 2;
        if ItemIndex<>-1 then SetSelectionPos(ItemIndex,True);
      end;
      CM_SHOWINGCHANGED:
      begin
        inherited;
        if FPopup.Showing then FPopup.Hide;
        FFullUpdate:=True;
      end;
      CM_FOCUSCHANGED:
      begin
        with TCmFocusChanged(Message) do
          if (Sender<>FPopup) and FPopup.Showing then FPopup.Hide;
        inherited;
      end;
      WM_CHAR,WM_CHARTOITEM,WM_VKEYTOITEM:;
      WM_KEYDOWN:
        if FPopup.CanFocus then
        begin
          FPopup.SetFocus;
          SendMessage(FPopup.Handle,WM_KEYDOWN,wParam,lParam);
          wParam:=0;
        end
        else
          case Char(wParam) of
            'A'..'Z','0'..'9':
              wParam:=0;
          else inherited;
          end;
      CM_CHILDKEY:
        if not (csDesigning in ComponentState) then
          if FPopup.CanFocus then
          begin
            Result:=1;
            FPopup.SetFocus;
            SendMessage(FPopup.Handle,WM_KEYDOWN,wParam,lParam);
          end
          else
            case wParam of
              VK_RETURN:
              begin
                Result:=1;
                if GetKeyState(VK_MENU) and $80 <> 0 then
                begin
                   if GetButtonType(ItemIndex)=btDropDown then Action(iaButtonClick);
                end
                else
                  if GetKeyState(VK_CONTROL) and $80 <> 0 then
                  begin
                    if GetButtonType(ItemIndex)=btDialog then Action(iaDoubleClick);
                  end
                  else
                  begin
                    FEdit.Modified:=True;
                    ApplyChanges;
                    Update;
                    FEdit.Modified:=False;
                  end;
              end;
              VK_ESCAPE:
              begin
                Result:=1;
                IgnoreChanges;
                Update;
              end;
              VK_UP:
              begin
                Result:=1;
                if ItemIndex>0 then ItemIndex:=Pred(ItemIndex);
              end;
              VK_DOWN:
              begin
                Result:=1;
                if GetKeyState(VK_MENU) and $80 <> 0 then
                begin
                  if GetButtonType(ItemIndex)=btDropDown then Action(iaButtonClick);
                  Exit;
                end;
                if ItemIndex<Pred(Items.Count) then ItemIndex:=Succ(ItemIndex);
              end;
            else inherited;
            end
        else inherited;
      WM_PAINT:
      begin
        inherited;
        if ItemCount>0 then
        begin
          DrawBorders(Canvas,FIndex,ItemRect(FIndex));
          if FButton.Visible then FButton.Invalidate;
        end;
      end;
      WM_SIZE:
      begin
        inherited;
        Splitter:=FSplitter;
        FEdit.Width:=ClientWidth;
        FFullUpdate:=True;
        Update;
      end;
      WM_LBUTTONDOWN:
        if not (csDesigning in ComponentState) then
        begin
          with FPopup do
            if Showing then Hide;
          with FEdit do
            if CanFocus then SetFocus;
          with FCheckBox do
            if CanFocus then SetFocus;
          FocusControl;
          SetCapture(Handle);
          if Abs(LoWord(lParam)-FSplitter)<=2 then
          begin
            FDragKind:=dkSplitter;
            FDragSplitter:=LoWord(lParam);
            DrawDragSplitter;
            SetCapture(Handle);
          end
          else
          begin
            SetMouseItem(lParam);
            if SpecialClick(lParam) then ExpandCollapse
            else
            begin
              FDragKind:=dkItem;
              SetCapture(Handle);
            end;
          end;
        end
        else inherited;
      WM_MOUSEMOVE:
      begin
        if GetCapture=Handle then
          case FDragKind of
            dkSplitter:
            begin
              DrawDragSplitter;
              FDragSplitter:=SmallInt(LoWord(lParam));
              if FDragSplitter<32 then FDragSplitter:=32;
              if FDragSplitter>ClientWidth-48 then FDragSplitter:=ClientWidth-48;
              DrawDragSplitter;
            end;
            dkItem: SetMouseItem(lParam);
          else inherited;
          end
        else inherited;
      end;
      WM_LBUTTONUP:
      begin
        inherited;
        case FDragKind of
          dkSplitter:
          begin
            DrawDragSplitter;
            Splitter:=FDragSplitter;
          end;
        end;
        ReleaseCapture;
        FDragKind:=dkNone;
        if FEdit.Visible and PtInRect(FEdit.BoundsRect,Point(LoWord(lParam),HiWord(lParam)))
          or FCheckBox.Visible and PtInRect(FCheckBox.BoundsRect,Point(LoWord(lParam),HiWord(lParam))) then
        begin
          Clicked:=True;
          mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
          mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
        end;
      end;
      WM_LBUTTONDBLCLK:
        if LParamLo<FSplitter then ExpandCollapse;
      WM_RBUTTONDOWN:
      begin
        SetMouseItem(lParam);
        inherited;
      end;
      WM_NCLBUTTONDOWN..WM_NCMBUTTONDBLCLK:
      begin
        FPopup.Hide;
        inherited;
      end;
      WM_VSCROLL:
      begin
        inherited;
        HidePopup;
        if (Win32Platform=VER_PLATFORM_WIN32_NT) and (FOldScrollPos<>GetScrollPos(Handle,SB_VERT)) then
        begin
          FFullUpdate:=True;
          UpdateControls;
          case WParamLo of
            SB_ENDSCROLL:;
            SB_LINEDOWN,SB_LINEUP,SB_THUMBTRACK:
            begin
              R:=ItemRect(Pred(FIndex));
              Dec(R.Top,2);
              R.Bottom:=Succ(ItemRect(Succ(FIndex)).Bottom);
              InvalidateRect(Handle,@R,True);
            end;
          else Invalidate;
          end;
          FOldScrollPos:=GetScrollPos(Handle,SB_VERT);
        end;
      end;
      {$IFNDEF VERSION3}
      WM_MOUSEWHEEL:
      begin
        inherited;
        HidePopup;
        UpdateControls;
        Invalidate;
      end;
      {$ENDIF}
      LB_SETCURSEL:
      begin
        i:=FIndex;
        DeselectItem(ItemIndex);
        SetSelectionPos(wParam,False);
        inherited;
        R:=ItemRect(i);
        Dec(R.Top,2);
        Inc(R.Bottom);
        InvalidateRect(Handle,@R,True);
        UpdateControls;
        SelectItem(ItemIndex);
      end;
      WM_SETCURSOR:
        if not (csDesigning in ComponentState) and (HiWord(lParam)<>0) then
        begin
          GetCursorPos(P);
          P:=ScreenToClient(P);
          if Abs(P.X-FSplitter)<=2 then SetCursor(Screen.Cursors[crHSplit])
          else inherited;
        end
        else inherited;
      CN_DRAWITEM:
      begin
        IFont:=TFont.Create;
        IPen:=TPen.Create;
        IBrush:=TBrush.Create;
        try
          with PDrawItemStruct(lParam)^ do
            if (ODS_FOCUS and WordRec(LongRec(itemState).Lo).Lo=0) and (Integer(itemID)<>-1) then
              with Canvas do
              begin
                Handle:=hDC;
                Font.Assign(Self.Font);
                Brush.Style:=bsSolid;
                SetBkMode(hDC,TRANSPARENT);
                R:=rcItem;
                R.Right:=R.Left+FSplitter;
                Brush.Color:=Color;
                Font.Color:=clWindowText;
                SaveCanvas(Canvas);
                try
                  DrawPropertyName(Canvas,itemID,R);
                finally
                  RestoreCanvas(Canvas);
                end;
                Font.Color:=clNavy;
                R:=rcItem;
                R.Left:=R.Left+FSplitter+1;
                if csDesigning in ComponentState then DrawPropertyValue(Canvas,itemID,R)
                else
                  if (itemID=DWORD(ItemIndex)) and (GetInplaceEditorType(itemID)<>ieNone) then
                  begin
                    case GetInplaceEditorType(itemID) of
                      ieEdit: Brush.Color:=clWindow;
                      ieCheckBox: Brush.Color:=clWindow;
                    end;
                    Dec(R.Bottom);
                    FillRect(R);
                  end
                  else
                  begin
                    SaveCanvas(Canvas);
                    try
                      DrawPropertyValue(Canvas,itemID,R);
                    finally
                      RestoreCanvas(Canvas);
                    end;
                  end;
                if ItemCount>0 then
                begin
                  DrawHorizontalSeparator(Canvas,itemID,rcItem);
                  if ItemID=DWORD(ItemIndex) then DrawBorders(Canvas,ItemID,rcItem);
                  DrawVerticalSeparator(Canvas,itemID,rcItem);
                end;
              end;
        finally
          IFont.Free;
          IPen.Free;
          IBrush.Free;
        end;
      end;
//      {$IFDEF GOITRIAL}
//      WM_TRIALMESSAGE:
//        Application.MessageBox(
//          'Data cannot be changed in trial version of the component.',
//          'Trial Limitation - Greatis Object Inspector',
//          MB_OK or MB_ICONEXCLAMATION);
//      {$ENDIF}
    else inherited;
    end;
end;

function TCustomInspector.GetDefaultIndex: Integer;
begin
  Result:=0;
end;

procedure TCustomInspector.FullUpdateNeeded;
begin
  FFullUpdate:=True;
end;

function TCustomInspector.GetPopupItemWidth(ListBox: TListBox; TheIndex: Integer): Integer;
var
  i: Integer;
begin
  Result:=0;
  with ListBox do
    for i:=0 to Pred(Items.Count) do
      with Canvas do
        if TextWidth(Items[i])>Result then Result:=TextWidth(Items[i]);
end;

procedure TCustomInspector.DrawPopupItem(ListBox: TListBox; ListItemIndex: Integer; R: TRect; TheIndex: Integer);
begin
  with ListBox,Canvas,R do
  begin
    Inc(Left,2);
    DrawText(Handle,PChar(Items[ListItemIndex]),-1,R,DT_SINGLELINE or DT_VCENTER);
  end;
end;

procedure TCustomInspector.SetEditedText(const AText: string);
begin
  with FEdit do
  begin
    FEditing:=True;
    Text:=AText;
    Modified:=True;
    SelectAll;
  end;
end;

function TCustomInspector.ValidateChar(TheIndex: Integer; var Key: Char): Boolean;
begin
  if Assigned(FOnValidateChar) then Result:=FOnValidateChar(Self,TheIndex,Key)
  else Result:=True;
end;

procedure TCustomInspector.ChangeValue(TheIndex: Integer; Editing: Boolean; const AText: string);
begin
  if Assigned(FOnChangeValue) then FOnChangeValue(Self,TheIndex,Editing,AText);
end;

procedure TCustomInspector.SetSelectionPos(TheIndex: Integer; NeedUpdate: Boolean);
begin
  if not (csDesigning in ComponentState) and
    ((TheIndex<>Index) and (TheIndex<>-1) or NeedUpdate) then
  begin
    Font.Assign(Self.Font);
    FSplitter:=Self.FSplitter;
    try
      if (TheIndex<>-1) and not GetReadOnly(FIndex) and GetAutoApply(FIndex) then ApplyChanges;
      FIndex:=TheIndex;
    except
      ItemIndex:=FIndex;
      raise;
    end;
    FFullUpdate:=True;
    UpdateControls;
    if Assigned(FOnSelect) then FOnSelect(Self,TheIndex);
  end;
end;

procedure TCustomInspector.ApplyChanges;
var
  WasFocused: Boolean;
begin
  WasFocused:=IsFocused;
  if FIndex<>-1 then
    if (GetInplaceEditorType(FIndex)=ieEdit) and FEdit.Modified then
    begin
//      {$IFDEF GOITRIAL}
//      TrialMessage;
//      {$ELSE}
      SetValue(FIndex,FEdit.Text);
//      {$ENDIF}
      FEdit.Modified:=False;
    end;
  if WasFocused then
  begin
    if FEdit.CanFocus then FEdit.SetFocus;
    if FCheckBox.CanFocus then FCheckBox.SetFocus;
  end;
end;

procedure TCustomInspector.IgnoreChanges;
begin
  if FIndex<>-1 then
    case GetInplaceEditorType(FIndex) of
      ieEdit: FEdit.Text:=GetValue(FIndex);
      ieCheckBox: FCheckBox.Checked:=StringToBoolean(GetValue(FIndex));
    end;
end;