virtualtreesreg.pas

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

  I: Integer;
  Tree: TBaseVirtualTree;

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

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

{$ifdef COMPILER_5_UP}

  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);
      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);
    end;
  end;

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

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

  begin
    // Nothing to do here.
  end;

{$endif COMPILER_5_UP}

{$ifdef COMPILER_5}

//----------------- TVTPaintingCategory --------------------------------------------------------------------------------

  class function TVTPaintingCategory.Name: string;

  begin
    Result := 'Custom Painting';
  end;

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

  class function TVTPaintingCategory.Description: string;

  begin
    Result := 'Custom Painting';
  end;

//----------------- TVTHeaderCategory ----------------------------------------------------------------------------------

  class function TVTHeaderCategory.Name: string;

  begin
    Result := 'Header';
  end;

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

  class function TVTHeaderCategory.Description: string;

  begin
    Result := 'Header';
  end;

//----------------- TVTIncrementalSearchCategory -----------------------------------------------------------------------

  class function TVTIncrementalSearchCategory.Name: string;

  begin
    Result := 'Incremental Search';
  end;

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

  class function TVTIncrementalSearchCategory.Description: string;

  begin
    Result := 'Incremental Search';
  end;

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

{$endif COMPILER_5}

//----------------- TCheckImageKindProperty ----------------------------------------------------------------------------

{$ifdef COMPILER_5_UP}

  const
    cCheckImageKindComboItemBorder   = 0;
    cCheckImageKindComboItemSpacing  = 2;
    cCheckImageKindComboBitmapHeight = 16;
    cCheckImageKindComboBitmapWidth  = 16;

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

  {$ifdef COMPILER_6_UP}

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

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

  {$endif}

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

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

  begin
    if GetVisualValue <> '' then
      ListDrawValue(GetVisualValue, ACanvas, ARect, ASelected)
    else
      {$ifdef COMPILER_6_UP}
        DefaultPropertyDrawValue(Self, ACanvas, ARect);
      {$else}
        inherited PropDrawValue(ACanvas, ARect, ASelected);
      {$endif}
  end;

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

  procedure TCheckImageKindProperty.ListDrawValue(const Value: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);

  var
    RighPosition: Integer;
    OldPenColor: TColor;
    CheckKind: TCheckImageKind;
    ImageList: TCustomImageList;
    RemainingRect: TRect;

  begin
    RighPosition := ARect.Left + cCheckImageKindComboBitmapWidth;
    with ACanvas do
    try
      OldPenColor := Pen.Color;
      Pen.Color := Brush.Color;
      Rectangle(ARect.Left, ARect.Top, RighPosition, ARect.Bottom);

      CheckKind := TCheckImageKind(GetEnumValue(GetPropInfo^.PropType^, Value));
      ImageList := TVirtualTreeCast.GetCheckImageListFor(CheckKind);
      if ImageList <> nil then
      begin
        ImageList_DrawEx(ImageList.Handle, ckCheckCheckedNormal, ACanvas.Handle, ARect.Left + cCheckImageKindComboItemBorder,
          ARect.Top + cCheckImageKindComboItemBorder, 0, 0, CLR_NONE, CLR_NONE, ILD_TRANSPARENT);
      end;

      Pen.Color := OldPenColor;
    finally
      RemainingRect := Rect(RighPosition, ARect.Top, ARect.Right, ARect.Bottom);
      {$ifdef COMPILER_6_UP}
        DefaultPropertyListDrawValue(Value, ACanvas, RemainingRect, ASelected);
      {$else}
        inherited ListDrawValue(Value, ACanvas, RemainingRect, ASelected);
      {$endif}
    end;
  end;

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

  procedure TCheckImageKindProperty.ListMeasureHeight(const Value: string; Canvas: TCanvas; var AHeight: Integer);

  begin
    AHeight := cCheckImageKindComboBitmapHeight;
  end;

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

  procedure TCheckImageKindProperty.ListMeasureWidth(const Value: string; ACanvas: TCanvas; var AWidth: Integer);

  begin
    AWidth := AWidth + cCheckImageKindComboBitmapWidth;
  end;

{$endif COMPILER_5_UP}

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

procedure Register;

begin
  RegisterComponents('Virtual Controls', [TVirtualStringTree, TVirtualDrawTree, TVTHeaderPopupMenu]);
  RegisterComponentEditor(TVirtualStringTree, TVirtualTreeEditor);
  RegisterComponentEditor(TVirtualDrawTree, TVirtualTreeEditor);
  RegisterPropertyEditor(TypeInfo(TClipboardFormats), nil, '', TClipboardFormatsProperty);
  RegisterPropertyEditor(TypeInfo(TCheckImageKind), nil, '', TCheckImageKindProperty);  

  // Categories:
  {$ifdef COMPILER_5_UP}
    RegisterPropertiesInCategory({$ifdef COMPILER_5} TActionCategory, {$endif} {$ifdef COMPILER_6_UP} sActionCategoryName, {$endif COMPILER_6_UP}
      TBaseVirtualTree,
      ['ChangeDelay',
       'EditDelay']);

    RegisterPropertiesInCategory({$ifdef COMPILER_5} TDataCategory, {$endif} {$ifdef COMPILER_6_UP} sDataCategoryName, {$endif COMPILER_6_UP}
      TBaseVirtualTree,
      ['NodeDataSize',
       'RootNodeCount',
       'OnCompareNodes',
       'OnGetNodeDataSize',
       'OnInitNode',
       'OnInitChildren',
       'OnFreeNode',
       'OnGetNodeWidth',
       'OnGetPopupMenu',
       'OnLoadNode',
       'OnSaveNode',
       'OnResetNode',
       'OnNodeMov*',
       'OnStructureChange',
       'OnUpdating',
       'OnGetText',
       'OnNewText',
       'OnShortenString']);

    RegisterPropertiesInCategory({$ifdef COMPILER_5} TLayoutCategory, {$endif} {$ifdef COMPILER_6_UP} slayoutCategoryName, {$endif COMPILER_6_UP}
      TBaseVirtualTree,
      ['AnimationDuration',
       'AutoExpandDelay',
       'AutoScroll*',
       'ButtonStyle',
       'DefaultNodeHeight',
       '*Images*', 'OnGetImageIndex',
       'Header',
       'Indent',
       'LineStyle', 'OnGetLineStyle',
       'CheckImageKind',
       'Options',
       'Margin',
       'NodeAlignment',
       'ScrollBarOptions',
       'SelectionCurveRadius',
       'TextMargin']);

    RegisterPropertiesInCategory({$ifdef COMPILER_5} TVisualCategory, {$endif} {$ifdef COMPILER_6_UP} sVisualCategoryName, {$endif COMPILER_6_UP}
      TBaseVirtualTree,
      ['Background*',
       'ButtonFillMode',
       'CustomCheckimages',
       'Colors',
       'LineMode']);

    RegisterPropertiesInCategory({$ifdef COMPILER_5} THelpCategory, {$endif} {$ifdef COMPILER_6_UP} sHelpCategoryName, {$endif COMPILER_6_UP}
      TBaseVirtualTree,
      ['Hint*', 'On*Hint*', 'On*Help*']);

    RegisterPropertiesInCategory({$ifdef COMPILER_5} TDragNDropCategory, {$endif} {$ifdef COMPILER_6_UP} sDragNDropCategoryName, {$endif COMPILER_6_UP}
      TBaseVirtualTree,
      ['ClipboardFormats',
       'DefaultPasteMode',
       'OnCreateDataObject',
       'OnCreateDragManager',
       'OnGetUserClipboardFormats',
       'OnNodeCop*',
       'OnDragAllowed',
       'OnRenderOLEData']);

    RegisterPropertiesInCategory({$ifdef COMPILER_5} TInputCategory, {$endif} {$ifdef COMPILER_6_UP} sInputCategoryName, {$endif COMPILER_6_UP}
      TBaseVirtualTree,
      ['DefaultText',
       'DrawSelectionMode',
       'WantTabs',
       'OnChang*',
       'OnCollaps*',
       'OnExpand*',
       'OnCheck*',
       'OnEdit*',
       'On*Click',
       'OnFocus*',
       'OnCreateEditor',
       'OnScroll',
       'OnHotChange']);

    RegisterPropertiesInCategory({$ifdef COMPILER_5} TVTHeaderCategory, {$endif} {$ifdef COMPILER_6_UP} sVTHeaderCategoryName, {$endif COMPILER_6_UP}
      TBaseVirtualTree,
      ['OnHeader*', 'OnGetHeader*']);

    RegisterPropertiesInCategory({$ifdef COMPILER_5} TVTPaintingCategory, {$endif} {$ifdef COMPILER_6_UP} sVTPaintingCategoryName, {$endif COMPILER_6_UP}
      TBaseVirtualTree,
      ['On*Paint*',
       'OnDraw*',
       'On*Erase*']);

    RegisterPropertiesInCategory({$ifdef COMPILER_5} TVTIncrementalSearchCategory, {$endif} {$ifdef COMPILER_6_UP} sVTIncremenalCategoryName, {$endif COMPILER_6_UP}
      TBaseVirtualTree,
      ['*Incremental*']);
  {$endif COMPILER_5_UP}
end;

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

end.