unit DelphiGems.VirtualControls.VirtualTreesReg;

// This unit is an addendum to VirtualTrees.pas and contains code of design time editors as well as
// for theirs and the tree's registration.

interface

{$include Compilers.inc}

uses
  Windows,
  Classes,
  Borland.Vcl.Design.DesignIntf,
  DesignEditors,
  //Borland.Vcl.Design.VCLEditors,
//  Borland.Vcl.Design.PropertyCategories,
  DelphiGems.VirtualControls.VirtualTrees;

type
  TVirtualTreeEditor = class (TDefaultEditor)
  public
    procedure Edit; override;
  end;

procedure Register;

//----------------------------------------------------------------------------------------------------------------------

implementation

uses
  Borland.Vcl.Design.ColnEdit,
  Borland.Vcl.Design.StrEdit,
  Borland.Vcl.Types,
  Dialogs, TypInfo, SysUtils, Graphics;

type
  TClipboardElement = class(TNestedProperty {$ifdef COMPILER_6_UP}, ICustomPropertyDrawing {$endif COMPILER_6_UP})
  private
    FElement: string;
  protected
    constructor Create(Parent: TPropertyEditor; AElement: string); reintroduce;
  public
    function AllEqual: Boolean; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetName: string; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;

    procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
    procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
  end;

  // This is a special property editor to make the strings in the clipboard format string list
  // being shown as subproperties in the object inspector. This way it is shown what formats are actually available
  // and the user can pick them with a simple yes/no choice.

  TGetPropEditProc = TGetPropProc;

  TClipboardFormatsProperty = class(TStringListProperty, ICustomPropertyDrawing)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetProperties(Proc: TGetPropEditProc); override;
    procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
    procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
  end;

    resourcestring
      sVTHeaderCategoryName = 'Header';
      sVTPaintingCategoryName = 'Custom painting';
      sVTIncremenalCategoryName = 'Incremental search';

//----------------------------------------------------------------------------------------------------------------------

type
  // The usual trick to make a protected property accessible in the ShowCollectionEditor call below.
  TVirtualTreeCast = class(TBaseVirtualTree)
  public
    property Header;
  end;
  
procedure TVirtualTreeEditor.Edit;

begin
  ShowCollectionEditor(Designer, Component, TVirtualTreeCast(Component).Header.Columns, 'Columns');
end;

//----------------------------------------------------------------------------------------------------------------------

constructor TClipboardElement.Create(Parent: TPropertyEditor; AElement: string);

begin
  inherited Create(Parent);
  FElement := AElement;
end;

//----------------------------------------------------------------------------------------------------------------------

function TClipboardElement.AllEqual: Boolean;

// Determines if this element is included or excluded in all selected components it belongs to.

var
  I, Index: Integer;
  List: TClipboardFormats;
  V: Boolean;

begin
  Result := False;
  if PropCount > 1 then
  begin
    List := TClipboardFormats(GetObjValue);
    V := List.Find(FElement, Index);
    for I := 1 to PropCount - 1 do
    begin
      List := TClipboardFormats(GetObjValue);
      if List.Find(FElement, Index) <> V then
        Exit;
    end;
  end;
  Result := True;
end;

//----------------------------------------------------------------------------------------------------------------------

function TClipboardElement.GetAttributes: TPropertyAttributes;

begin
  Result := [paMultiSelect, paValueList, paSortList];
end;

//----------------------------------------------------------------------------------------------------------------------

function TClipboardElement.GetName: string;

begin
  Result := FElement;
end;

//----------------------------------------------------------------------------------------------------------------------

function TClipboardElement.GetValue: string;

var
  List: TClipboardFormats;

begin
  List := TClipboardFormats(GetObjValue);
  Result := BooleanIdents[List.IndexOf(FElement) > -1];
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TClipboardElement.GetValues(Proc: TGetStrProc);

begin
  Proc(BooleanIdents[False]);
  Proc(BooleanIdents[True]);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TClipboardElement.SetValue(const Value: string);

var
  List: TClipboardFormats;
  I, Index: Integer;

begin
  if CompareText(Value, 'True') = 0 then
  begin
    for I := 0 to PropCount - 1 do
    begin
      List := TClipboardFormats(GetObjValueAt(I));
      List.Add(FElement);
    end;
  end
  else
  begin
    for I := 0 to PropCount - 1 do
    begin
      List := TClipboardFormats(GetObjValueAt(I));
      if List.Find(FElement, Index) then
        List.Delete(Index);
    end;
  end;
  Modified;
end;

//----------------------------------------------------------------------------------------------------------------------

  procedure DrawBoolean(Checked: Boolean; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);

  var
    BoxSize,
    EntryWidth: Integer;
    R: TRect;
    State: Cardinal;

  begin
    with ACanvas do
    begin
      FillRect(ARect);

      BoxSize := ARect.Bottom - ARect.Top;
      EntryWidth := ARect.Right - ARect.Left;

      R := Rect(ARect.Left + (EntryWidth - BoxSize) div 2, ARect.Top, ARect.Left + (EntryWidth + BoxSize) div 2,
        ARect.Bottom);
      InflateRect(R, -1, -1);
      State := DFCS_BUTTONCHECK;
      if Checked then
        State := State or DFCS_CHECKED;
      DrawFrameControl(Handle, R, DFC_BUTTON, State);
    end;
  end;

//----------------------------------------------------------------------------------------------------------------------

  procedure TClipboardElement.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);

  begin
    DefaultPropertyDrawName(Self, ACanvas, ARect);
  end;

//----------------------------------------------------------------------------------------------------------------------

  procedure TClipboardElement.PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);

  begin
    DrawBoolean(CompareText(GetVisualValue, 'True') = 0, ACanvas, ARect, ASelected);
  end;

//----------------- TClipboardFormatsProperty --------------------------------------------------------------------------

function TClipboardFormatsProperty.GetAttributes: TPropertyAttributes;

begin
  Result := inherited GetAttributes + [paSubProperties, paFullWidthName];
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TClipboardFormatsProperty.GetProperties(Proc: TGetPropEditProc);

var
  List: TStringList;
  I: Integer;
  Tree: TBaseVirtualTree;

begin
  List := TStringList.Create;
  Tree := TClipboardFormats(GetObjValue).Owner;
  EnumerateVTClipboardFormats(TVirtualTreeClass(Tree.ClassType), List);
  for I := 0 to List.Count - 1 do
    Proc(TClipboardElement.Create(Self, List[I]));
end;

//----------------------------------------------------------------------------------------------------------------------

  procedure TClipboardFormatsProperty.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);

  var
    S: string;
    Width: Integer;
    R: TRect;

  begin
    with ACanvas do
    begin
      Font.Name := 'Arial';
      R := ARect;
      Font.Color := clBlack;
      S := GetName;
      Width := TextWidth(S);
      TextRect(R, R.Left + 1, R.Top + 1, S);

      Inc(R.Left, Width + 8);
      Font.Height := 14;
      Font.Color := clBtnHighlight;
      S := '(OLE drag and clipboard)';
      SetBkMode(Handle, TRANSPARENT);
{$IFDEF DELPHI.NET}
      ExtTextOut(Handle, R.Left + 1, R.Top + 1, ETO_CLIPPED, R, S, Length(S), nil);
      Font.Color := clBtnShadow;
      ExtTextOut(Handle, R.Left, R.Top, ETO_CLIPPED, R, S, Length(S), nil);
{$ELSE DELPHI.NET}
      ExtTextOut(Handle, R.Left + 1, R.Top + 1, ETO_CLIPPED, @R, PChar(S), Length(S), nil);
      Font.Color := clBtnShadow;
      ExtTextOut(Handle, R.Left, R.Top, ETO_CLIPPED, @R, PChar(S), Length(S), nil);
{$ENDIF DELPHI.NET}
    end;
  end;

//----------------------------------------------------------------------------------------------------------------------

  procedure TClipboardFormatsProperty.PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);

  begin
    // Nothing to do here.
  end;


procedure Register;

begin
  RegisterComponents('Virtual Controls', [TVirtualStringTree, TVirtualDrawTree{.sm not now, TVTHeaderPopupMenu}]);
  RegisterComponentEditor(TVirtualStringTree, TVirtualTreeEditor);
  RegisterComponentEditor(TVirtualDrawTree, TVirtualTreeEditor);
  RegisterPropertyEditor(TypeInfo(TClipboardFormats), nil, '', TClipboardFormatsProperty);

  // Categories:
    RegisterPropertiesInCategory(sActionCategoryName,
      TBaseVirtualTree,
      ['ChangeDelay',
       'EditDelay']);

    RegisterPropertiesInCategory(sDataCategoryName,
      TBaseVirtualTree,
      ['NodeDataSize',
       'RootNodeCount',
       'OnCompareNodes',
       'OnGetNodeDataSize',
       'OnInitNode',
       'OnInitChildren',
       'OnFreeNode',
       'OnGetNodeWidth',
       'OnGetPopupMenu',
       'OnLoadNode',
       'OnSaveNode',
       'OnResetNode',
       'OnNodeMov*',
       'OnStructureChange',
       'OnUpdating',
       'OnGetText',
       'OnNewText',
       'OnShortenString']);

    RegisterPropertiesInCategory(slayoutCategoryName,
      TBaseVirtualTree,
      ['AnimationDuration',
       'AutoExpandDelay',
       'AutoScroll*',
       'ButtonStyle',
       'DefaultNodeHeight',
       '*Images*', 'OnGetImageIndex',
       'Header',
       'Indent',
       'LineStyle', 'OnGetLineStyle',
       'CheckImageKind',
       'Options',
       'Margin',
       'NodeAlignment',
       'ScrollBarOptions',
       'SelectionCurveRadius',
       'TextMargin']);

    RegisterPropertiesInCategory(sVisualCategoryName,
      TBaseVirtualTree,
      ['Background*',
       'ButtonFillMode',
       'CustomCheckimages',
       'Colors',
       'LineMode']);

    RegisterPropertiesInCategory(sHelpCategoryName,
      TBaseVirtualTree,
      ['Hint*', 'On*Hint*', 'On*Help*']);

    RegisterPropertiesInCategory(sDragNDropCategoryName,
      TBaseVirtualTree,
      ['ClipboardFormats',
       'DefaultPasteMode',
       'OnCreateDataObject',
       'OnCreateDragManager',
       'OnGetUserClipboardFormats',
       'OnNodeCop*',
       'OnDragAllowed',
       'OnRenderOLEData']);

    RegisterPropertiesInCategory(sInputCategoryName,
      TBaseVirtualTree,
      ['DefaultText',
       'DrawSelectionMode',
       'WantTabs',
       'OnChang*',
       'OnCollaps*',
       'OnExpand*',
       'OnCheck*',
       'OnEdit*',
       'On*Click',
       'OnFocus*',
       'OnCreateEditor',
       'OnScroll',
       'OnHotChange']);

    RegisterPropertiesInCategory(sVTHeaderCategoryName,
      TBaseVirtualTree,
      ['OnHeader*', 'OnGetHeader*']);

    RegisterPropertiesInCategory(sVTPaintingCategoryName,
      TBaseVirtualTree,
      ['On*Paint*',
       'OnDraw*',
       'On*Erase*']);

    RegisterPropertiesInCategory(sVTIncremenalCategoryName,
      TBaseVirtualTree,
      ['*Incremental*']);
end;

//----------------------------------------------------------------------------------------------------------------------

end.