virtualtreesreg.pas

Last change: 2008-02-03 This is the source code of KCeasy。

unit 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}

{$ifdef COMPILER_7_UP}
  // For some things to work we need code, which is classified as being unsafe for .NET.
  {$warn UNSAFE_TYPE off}
  {$warn UNSAFE_CAST off}
  {$warn UNSAFE_CODE off}
{$endif COMPILER_7_UP}

{$ifdef COMPILER_4}
  {$R '..\Design\VirtualTrees.dcr'}
{$endif COMPILER_4}

uses
  Windows, Classes,
  {$ifdef COMPILER_6_UP}
    DesignIntf, DesignEditors, VCLEditors, PropertyCategories,
  {$else}
    DsgnIntf,
  {$endif}                       
  ColnEdit,
  VirtualTrees, VTHeaderPopup;

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

procedure Register;

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

implementation

uses
  {$ifdef COMPILER_5_UP}
    StrEdit,
  {$else}
    StrEditD4,
  {$endif COMPILER_5_UP}
  Dialogs, TypInfo, SysUtils, Graphics, CommCtrl, ImgList, Controls;

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

  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;

    {$ifdef COMPILER_5_UP}
      {$ifdef COMPILER_6_UP}
        procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
      {$endif COMPILER_6_UP}
      procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
        {$ifndef COMPILER_6_UP} override; {$endif COMPILER_6_UP}
    {$endif COMPILER_5_UP}
  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.

  {$ifdef COMPILER_6_UP}
    TGetPropEditProc = TGetPropProc;
  {$endif}

  TClipboardFormatsProperty = class(TStringListProperty {$ifdef COMPILER_6_UP}, ICustomPropertyDrawing {$endif COMPILER_6_UP})
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetProperties(Proc: TGetPropEditProc); override;
    {$ifdef COMPILER_5_UP}
      procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
        {$ifndef COMPILER_6_UP} override; {$endif}
      procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
        {$ifndef COMPILER_6_UP} override; {$endif}
    {$endif}
  end;

  // Property categories. They are defined this way only for Delphi 5 & BCB 5.
  {$ifdef COMPILER_5}
    TVTHeaderCategory = class(TPropertyCategory)
    public
      class function Name: string; override;
      class function Description: string; override;
    end;

    TVTPaintingCategory = class(TPropertyCategory)
    public
      class function Name: string; override;
      class function Description: string; override;
    end;

    TVTIncrementalSearchCategory = class(TPropertyCategory)
    public
      class function Name: string; override;
      class function Description: string; override;
    end;
  {$endif COMPILER_5}

  TCheckImageKindProperty = class(TEnumProperty {$ifdef COMPILER_6_UP}, ICustomPropertyDrawing, ICustomPropertyListDrawing {$endif COMPILER_6_UP})
  public
    {$ifdef COMPILER_5_UP}
      procedure ListMeasureHeight(const Value: string; Canvas: TCanvas; var AHeight: Integer);
        {$ifndef COMPILER_6_UP} override; {$endif}
      procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas; var AWidth: Integer);
        {$ifndef COMPILER_6_UP} override; {$endif}
      procedure ListDrawValue(const Value: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
        {$ifndef COMPILER_6_UP} override; {$endif}
      {$ifdef COMPILER_6_UP}
      procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
      {$endif}
      procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
        {$ifndef COMPILER_6_UP} override; {$endif}
    {$endif}
  end;

  {$ifdef COMPILER_6_UP}
    resourcestring
      sVTHeaderCategoryName = 'Header';
      sVTPaintingCategoryName = 'Custom painting';
      sVTIncremenalCategoryName = 'Incremental search';
  {$endif}

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

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(GetOrdValue);
    V := List.Find(FElement, Index);
    for I := 1 to PropCount - 1 do
    begin
      List := TClipboardFormats(GetOrdValue);
      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(GetOrdValue);
  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(GetOrdValueAt(I));
      List.Add(FElement);
    end;
  end
  else
  begin
    for I := 0 to PropCount - 1 do
    begin
      List := TClipboardFormats(GetOrdValueAt(I));
      if List.Find(FElement, Index) then
        List.Delete(Index);
    end;
  end;
  Modified;
end;

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

{$ifdef COMPILER_5_UP}

  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;

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

  {$ifdef COMPILER_6_UP}

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

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

  {$endif COMPILER_6_UP}

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

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

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

{$endif COMPILER_5_UP}

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

function TClipboardFormatsProperty.GetAttributes: TPropertyAttributes;

begin
  Result := inherited GetAttributes + [paSubProperties {$ifdef COMPILER_5_UP}, paFullWidthName {$endif COMPILER_5_UP}];
end;

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

procedure TClipboardFormatsProperty.GetProperties(Proc: TGetPropEditProc);

var
  List: TStringList;