cxvgriddxinspconverter.pas

delphi的的三方控件

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressVerticalGrid                                          }
{                                                                    }
{       Copyright (c) 1998-2007 Developer Express Inc.               }
{       ALL RIGHTS RESERVED                                          }
{                                                                    }
{   The entire contents of this file is protected by U.S. and        }
{   International Copyright Laws. Unauthorized reproduction,         }
{   reverse-engineering, and distribution of all or any portion of   }
{   the code contained in this file is strictly prohibited and may   }
{   result in severe civil and criminal penalties and will be        }
{   prosecuted to the maximum extent possible under the law.         }
{                                                                    }
{   RESTRICTIONS                                                     }
{                                                                    }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES            }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE     }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSVERTICALGRID AND ALL           }
{   ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
{                                                                    }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED       }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE         }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE        }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT   }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                       }
{                                                                    }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON        }
{   ADDITIONAL RESTRICTIONS.                                         }
{                                                                    }
{********************************************************************}
unit cxVGridDXInspConverter;

{$I cxVer.inc}

interface

uses
  SysUtils, cxConverterFactory, cxVGridConverter, cxVGrid, cxDBVGrid, Classes,
  cxConverterUtils, cxLookAndFeels, cxInplaceContainer, DB, cxStyles,
  Graphics, cxCustomData, cxCustomConverter, cxBlobEdit, cxPropertiesConverters,
  cxButtonEdit, cxCalc, cxCheckBox, cxDropDownEdit, cxCurrencyEdit, cxCalendar,
  cxDBLookupComboBox, cxHyperLinkEdit, cxImage, cxImageComboBox, cxMaskEdit, cxMemo,
  cxMRUEdit, cxSpinEdit, cxTextEdit, cxTimeEdit, cxVariants, cxOI;

type
  TcxCustomVerticalGridAccess = class(TcxCustomVerticalGrid);
  TcxUnboundVerticalGridAccess = class(TcxUnboundVerticalGrid);

  { TcxCustomDXInspConverter }

  TcxCustomDXInspConverter = class(TcxCustomVerticalGridConverter)
  private
    FcxRowCache: TStringList;
    FdxRowCache: TStringList;
    FDefaultRowHeight: Integer;
    FSeparatorString: string;
    function GetAccess: TcxCustomVerticalGridAccess;
    function GetComponent: TComponent;
  protected
    function AddRow(AcxRowParent: TcxCustomRow; const AdxRowName: string): TcxCustomRow;
    procedure AssignCaptionProperties(AdxRow: TObject; AProperties: TcxCaptionRowProperties);
    procedure AssignEditorDataBinding(AdxRow: TObject; AProperties: TcxCustomEditorRowProperties); virtual;
    procedure AssignEditorProperties(AdxRow: TObject; AProperties: TcxCustomEditorRowProperties);
    procedure AssignVerticalGrid; virtual;
    procedure AssignVerticalGridOptions; virtual;
    procedure ConvertPaintStyle;
    function CreateMultiEditorRowItem(
      AcxRow: TcxCustomRow): TcxCollectionItemEditorRowProperties; virtual;
    procedure DoRealImport; override;
    function GetConvertorIndex(AdxRow: TObject): Integer; virtual;
    function GetRowClassType(AdxRow: TObject): TcxCustomRowClass; virtual;
    procedure ImportCategoryRow(AdxRow: TObject; AcxRow: TcxCustomRow);
    procedure ImportEditorRow(AdxRow: TObject; AcxRow: TcxCustomRow); virtual;
    procedure ImportLayout;
    procedure ImportMultiEditorRow(AdxRow: TObject; AcxRow: TcxCustomRow); virtual;
    procedure ImportRow(AcxRow: TcxCustomRow; AdxRow: TObject);
    procedure ImportRows; virtual;
    procedure SetRowName(AcxRow: TcxCustomRow); virtual;
    property Access: TcxCustomVerticalGridAccess read GetAccess;
    property Component: TComponent read GetComponent;
  public
    constructor Create(ADestination: TObject); override;
    destructor Destroy; override;
  end;

  { TcxDXInspConverter }

  TcxDXInspConverter = class(TcxCustomDXInspConverter)
  private
    function GetDestination: TcxUnboundVerticalGridAccess;
  protected
    procedure AssignEditorDataBinding(AdxRow: TObject; AProperties: TcxCustomEditorRowProperties); override;
    procedure AssignVerticalGridOptions; override;
    function CreateMultiEditorRowItem(
      AcxRow: TcxCustomRow): TcxCollectionItemEditorRowProperties; override;
    function GetRowClassType(AdxRow: TObject): TcxCustomRowClass; override;
  public
    class function GetSourceClassName: string; override;
    property Destination: TcxUnboundVerticalGridAccess read GetDestination;
  end;

  { TcxDXDBInspConverter }

  TcxDXDBInspConverter = class(TcxCustomDXInspConverter)
  private
    function GetDestination: TcxDBVerticalGrid;
  protected
    procedure AssignEditorDataBinding(AdxRow: TObject; AProperties: TcxCustomEditorRowProperties); override;
    procedure AssignVerticalGrid; override;
    procedure AssignVerticalGridOptions; override;
    function CreateMultiEditorRowItem(
      AcxRow: TcxCustomRow): TcxCollectionItemEditorRowProperties; override;
    function GetConvertorIndex(AdxRow: TObject): Integer; override;
    function GetRowClassType(AdxRow: TObject): TcxCustomRowClass; override;
    procedure SetRowName(AcxRow: TcxCustomRow); override;
  public
    class function GetSourceClassName: string; override;
    property Destination: TcxDBVerticalGrid read GetDestination;
  end;

  { TcxDXRTTIConverter }

  TcxDXRTTIConverter = class(TcxDXInspConverter)
  protected
    procedure DoRealImport; override;
    procedure ImportRows; override;
  public
    class function GetSourceClassName: string; override;
  end;

implementation

uses
  Controls, cxDesignWindows, cxControls, cxEdit, cxDataStorage;

type
  TcxCustomRowAccess = class(TcxCustomRow);
  TcxCustomEditorRowAccess = class(TcxCustomEditorRow);
  TcxCustomEditorRowPropertiesAccess = class(TcxCustomEditorRowProperties);
  TcxCustomMultiEditorRowAccess = class(TcxCustomMultiEditorRow);
  TcxCustomPropertiesConverterClass = class of TcxCustomPropertiesConverter;

const
  ConvertorTable: array[0..17] of record
    RowClassName: string;
    DBRowClassName: string;
    PropertiesClass: TcxCustomEditPropertiesClass;
    ConvertorClass: TcxCustomPropertiesConverterClass;
    ValueType: TcxValueTypeClass;
  end = (
  (RowClassName: 'TdxInspectorTextRow';
    DBRowClassName: 'TdxInspectorDBRow';
    PropertiesClass: TcxTextEditProperties;
    ConvertorClass: TcxTextEditPropertiesConverter;
    ValueType: nil),
  (RowClassName: 'TdxInspectorTextMaskRow';
    DBRowClassName: 'TdxInspectorDBMaskRow';
    PropertiesClass: TcxMaskEditProperties;
    ConvertorClass: TcxMaskEditPropertiesConverter;
    ValueType: nil),
  (RowClassName: 'TdxInspectorTextDateRow';
    DBRowClassName: 'TdxInspectorDBDateRow';
    PropertiesClass: TcxDateEditProperties;
    ConvertorClass: TcxDateEditPropertiesConverter;
    ValueType: TcxDateTimeValueType),
  (RowClassName: 'TdxInspectorTextCheckRow';
    DBRowClassName: 'TdxInspectorDBCheckRow';
    PropertiesClass: TcxCheckBoxProperties;
    ConvertorClass: TcxCheckBoxPropertiesConverter;
    ValueType: TcxVariantValueType),
  (RowClassName: 'TdxInspectorTextCalcRow';
    DBRowClassName: 'TdxInspectorDBCalcRow';
    PropertiesClass: TcxCalcEditProperties;
    ConvertorClass: TcxCalcEditPropertiesConverter;
    ValueType: TcxFloatValueType),
  (RowClassName: 'TdxInspectorTextButtonRow';
    DBRowClassName: 'TdxInspectorDBButtonRow';
    PropertiesClass: TcxButtonEditProperties;
    ConvertorClass: TcxButtonEditPropertiesConverter;
    ValueType: nil),
  (RowClassName: 'TdxInspectorTextSpinRow';
    DBRowClassName: 'TdxInspectorDBSpinRow';
    PropertiesClass: TcxSpinEditProperties;
    ConvertorClass: TcxSpinEditPropertiesConverter;
    ValueType: TcxFloatValueType),
  (RowClassName: 'TdxInspectorTextPickRow';
    DBRowClassName: 'TdxInspectorDBPickRow';
    PropertiesClass: TcxComboBoxProperties;
    ConvertorClass: TcxComboBoxPropertiesConverter;
    ValueType: nil),
  (RowClassName: 'TdxInspectorTextImageRow';
    DBRowClassName: 'TdxInspectorDBImageRow';
    PropertiesClass: TcxImageComboBoxProperties;
    ConvertorClass: TcxImageComboBoxPropertiesConverter;
    ValueType: TcxVariantValueType),
  (RowClassName: 'TdxInspectorTextTimeRow';
    DBRowClassName: 'TdxInspectorDBTimeRow';
    PropertiesClass: TcxTimeEditProperties;
    ConvertorClass: TcxTimeEditPropertiesConverter;
    ValueType: TcxDateTimeValueType),
  (RowClassName: 'TdxInspectorTextCurrencyRow';
    DBRowClassName: 'TdxInspectorDBCurrencyRow';
    PropertiesClass: TcxCurrencyEditProperties;
    ConvertorClass: TcxCurrencyEditPropertiesConverter;
    ValueType: TcxCurrencyValueType),
  (RowClassName: 'TdxInspectorTextHyperLinkRow';
    DBRowClassName: 'TdxInspectorDBHyperLinkRow';
    PropertiesClass: TcxHyperLinkEditProperties;
    ConvertorClass: TcxHyperLinkEditPropertiesConverter;
    ValueType: nil),
  (RowClassName: 'TdxInspectorTextBlobRow';
    DBRowClassName: 'TdxInspectorBlobRow';
    PropertiesClass: TcxBlobEditProperties;
    ConvertorClass: TcxBlobEditPropertiesConverter;
    ValueType: TcxVariantValueType),
  (RowClassName: 'TdxInspectorTextMRURow';
    DBRowClassName: 'TdxInspectorDBMRURow';
    PropertiesClass: TcxMRUEditProperties;
    ConvertorClass: TcxMRUEditPropertiesConverter;
    ValueType: nil),
  (RowClassName: 'TdxInspectorTextPopupRow';
    DBRowClassName: 'TdxInspectorDBPopupRow';
    PropertiesClass: TcxPopupEditProperties;
    ConvertorClass: TcxPopupEditPropertiesConverter;
    ValueType: nil),
  (RowClassName: 'TdxInspectorTextMemoRow';
    DBRowClassName: 'TdxInspectorDBMemoRow';
    PropertiesClass: TcxMemoProperties;
    ConvertorClass: TcxMemoPropertiesConverter;
    ValueType: nil),
  (RowClassName: 'TdxInspectorTextGraphicRow';
    DBRowClassName: 'TdxInspectorDBGraphicRow';
    PropertiesClass: TcxImageProperties;
    ConvertorClass: TcxImagePropertiesConverter;
    ValueType: TcxVariantValueType),
  (RowClassName: '';
    DBRowClassName: 'TdxInspectorLookupRow';
    PropertiesClass: TcxLookupComboBoxProperties;
    ConvertorClass: TcxLookupComboBoxPropertiesConverter;
    ValueType: nil)
  );

{$IFNDEF DELPHI5}
function SameText(const S1, S2: string): Boolean; assembler;
asm
        CMP     EAX,EDX
        JZ      @1
        OR      EAX,EAX
        JZ      @2
        OR      EDX,EDX
        JZ      @3
        MOV     ECX,[EAX-4]
        CMP     ECX,[EDX-4]
        JNE     @3
        CALL    CompareText
        TEST    EAX,EAX
        JNZ     @3
@1:     MOV     AL,1
@2:     RET
@3:     XOR     EAX,EAX
end;
{$ENDIF}

function InheritsFromEx(AObject: TObject; const AParentClassName: string): Boolean;
var
  AClass: TClass;
begin
  Result := False;
  AClass := AObject.ClassType;
  while AClass <> nil do
    if SameText(AClass.ClassName, AParentClassName) then
    begin
      Result := True;
      break;
    end
    else
      AClass := AClass.ClassParent;
end;

{ TcxCustomDXInspConverter }

constructor TcxCustomDXInspConverter.Create(ADestination: TObject);
begin
  inherited Create(ADestination);
  FcxRowCache := TStringList.Create;
  FcxRowCache.Sorted := True;
  FdxRowCache := TStringList.Create;
  FdxRowCache.Sorted := True;
end;

destructor TcxCustomDXInspConverter.Destroy;
begin
  FcxRowCache.Free;
  FdxRowCache.Free;
  inherited Destroy;
end;

function TcxCustomDXInspConverter.AddRow(AcxRowParent: TcxCustomRow;
  const AdxRowName: string): TcxCustomRow;
var
  ARowClass: TcxCustomRowClass;
  AdxRow: TObject;
begin
  AdxRow := Component.Owner.FindComponent(AdxRowName);
  ARowClass := GetRowClassType(AdxRow);
  if ARowClass <> nil then
  begin
    Result := Destination.AddChild(AcxRowParent, ARowClass);
    ImportRow(Result, AdxRow);
    SetRowName(Result);
  end
  else
    Result := nil;
end;

procedure TcxCustomDXInspConverter.AssignCaptionProperties(AdxRow: TObject;
  AProperties: TcxCaptionRowProperties);
begin
  AProperties.Caption := GetStringProperty(AdxRow, 'Caption');
  AProperties.Hint := GetStringProperty(AdxRow, 'Hint');
  AProperties.ImageIndex := GetIntegerProperty(AdxRow, 'ImageIndex', -1);
end;

procedure TcxCustomDXInspConverter.AssignEditorDataBinding(
  AdxRow: TObject; AProperties: TcxCustomEditorRowProperties);
begin
end;

procedure TcxCustomDXInspConverter.AssignEditorProperties(
  AdxRow: TObject; AProperties: TcxCustomEditorRowProperties);
var
  AConverter: TcxCustomPropertiesConverter;
  Index: Integer;
begin
  Index := GetConvertorIndex(AdxRow);
  if Index < 0 then Exit;
  AProperties.EditPropertiesClass := ConvertorTable[Index].PropertiesClass;
  AConverter := ConvertorTable[Index].ConvertorClass.Create(AProperties.EditProperties);
  try
    AConverter.ImportFrom(AdxRow);
  finally
    AConverter.Free;
  end;
  AssignEditorDataBinding(AdxRow, AProperties);
end;

procedure TcxCustomDXInspConverter.AssignVerticalGrid;
var
  AFont: TFont;
begin
  ConvertPaintStyle;
  AFont := GetClassProperty(Source, 'Font') as TFont;
  Access.Font.Assign(AFont);
  with Destination do
  begin
    if SameText(GetEnumProperty(Source, 'BorderStyle'), 'bsNone') then
      BorderStyle := cxcbsNone
    else
      BorderStyle := cxcbsDefault;
    FDefaultRowHeight := GetIntegerProperty(Source, 'RowHeight', 17);
    FSeparatorString := GetStringProperty(Source, 'ComplexRowSeparator');
    StoringName := GetStringProperty(Source, 'RegistryPath');
    Images := TImageList(GetClassProperty(Source, 'Images'));
  end;
end;

procedure TcxCustomDXInspConverter.AssignVerticalGridOptions;
begin
  with Destination.OptionsView do
  begin
    if FDefaultRowHeight <> 17 then RowHeight := FDefaultRowHeight;
    CellTextMaxLineCount := GetIntegerProperty(Source, 'MaxRowTextLineCount', 0);
    RowHeaderMinWidth := GetIntegerProperty(Source, 'MinColumnWidth', 24);
    RowHeaderWidth := GetIntegerProperty(Source, 'DividerPos', 100);
    ValueWidth := GetIntegerProperty(Source, 'BandWidth', 150) - RowHeaderWidth;
    GridLineColor := GetIntegerProperty(Source, 'GridColor', clBtnFace);
  end;
end;

procedure TcxCustomDXInspConverter.ConvertPaintStyle;
var
  S: string;
begin
  S := GetEnumProperty(Source, 'PaintStyle');
  if SameText(S, 'ipsNet') or SameText(S, 'ipsCategorized') then
    Destination.OptionsView.PaintStyle := psdotNet
  else
    Destination.OptionsView.PaintStyle := psDelphi;
  if GetBooleanProperty(Source, 'Flat') then
    Destination.LookAndFeel.Kind := lfFlat
  else
    Destination.LookAndFeel.Kind := lfStandard;
end;

function TcxCustomDXInspConverter.CreateMultiEditorRowItem(
  AcxRow: TcxCustomRow): TcxCollectionItemEditorRowProperties;
begin
  Result := nil;
end;

procedure TcxCustomDXInspConverter.DoRealImport;
begin
  AssignVerticalGrid;
  AssignVerticalGridOptions;
  ImportRows;
end;

function TcxCustomDXInspConverter.GetConvertorIndex(AdxRow: TObject): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to 16 do
    if SameText(AdxRow.ClassName, ConvertorTable[I].RowClassName) then
    begin
      Result := I;
      break
    end;
end;

function TcxCustomDXInspConverter.GetRowClassType(
  AdxRow: TObject): TcxCustomRowClass;
begin
  Result := nil;
end;

type
  TComponentAccess = class(TComponent);

  PdxRowNodeInfo = ^TdxRowNodeInfo;
  TdxRowNodeInfo = packed record
    Count: Integer;
    StrLen: Integer;
    Str: record end;
  end;

  TcxConverterFiler = class(TFiler)
  private
    FHasData: Boolean;
    FReadDataProc: TStreamProc;
    FWriteDataProc: TStreamProc;