dxreg.pas

delphi中很有名的delphiX组件。传奇2客户端源代码也是用这个组件。

unit DXReg;

interface

uses
  Windows, SysUtils, Classes, DesignIntf, DesignEditors, Forms, Dialogs,
  Graphics, TypInfo, DXDraws, DXSounds, DIB, Wave, DXInput, DXPlay, DXSprite,
  DXClass;

type

  {  TDXDrawDisplayProperty  }

  TDXDrawDisplayProperty = class(TClassProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  {  TDIBProperty  }

  TDIBProperty = class(TPropertyEditor)
  public
    procedure Edit; override;
    function GetValue: string; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

  {  TDXDIBEditor  }

  TDXDIBEditor = class(TComponentEditor)
  public
    procedure Edit; override;
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

  {  TPictureCollectionItem_PictureProperty  }

  TPictureCollectionItem_PictureProperty = class(TPropertyEditor)
  public
    procedure Edit; override;
    function GetValue: string; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

  {  TDXImageListEditor  }

  TDXImageListEditor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

  {  TWaveProperty  }

  TWaveProperty = class(TPropertyEditor)
  public
    procedure Edit; override;
    function GetValue: string; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

  {  TDXWaveEditor  }

  TDXWaveEditor = class(TComponentEditor)
  public
    procedure Edit; override;
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

  {  TDXWaveListEditor  }

  TDXWaveListEditor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

  {  TForceFeedbackEffectsProperty  }

  TForceFeedbackEffectsProperty = class(TClassProperty)
  public
    procedure Edit; override;
    function GetValue: string; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

  {  TDXInputEditor  }

  TDXInputEditor = class(TComponentEditor)
  public
    procedure Edit; override;
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

  {  TGUIDProperty  }

  TGUIDProperty = class(TStringProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

procedure Register;

implementation

uses DXPictEdit, DXWaveEdit, DXFFBEdit, DXInptEdit, DXGUIDEdit;

const
  SNone = '(None)';

  SSettingImage = '&Image...';
  SSettingWave = '&Wave...';
  SDXGFileFilter = 'DXG file(*.dxg)|*.dxg|All files(*.*)|*.*';
  SDXGOpenFileFilter = 'DXG file(*.dxg)|*.dxg|Bitmap file(*.bmp)|*.bmp|All files(*.*)|*.*';
  SDXWFileFilter = 'DXW file(*.dxw)|*.dxg|All files(*.*)|*.*';
  SDXWOpenFileFilter = 'DXW file(*.dxw)|*.dxw|Wave file(*.wav)|*.wav|All files(*.*)|*.*';
  SSinglePlayer = '&Single player';
  SMultiPlayer1 = 'Multi player &1';
  SMultiPlayer2 = 'Multi player &2';

  SOpen = '&Open...';
  SSave = '&Save..';

procedure Register;
begin
  RegisterPropertyEditor(TypeInfo(TDXDrawDisplay), nil, '',
    TDXDrawDisplayProperty);

  RegisterPropertyEditor(TypeInfo(TDIB), nil, '', TDIBProperty);
  RegisterComponentEditor(TCustomDXDIB, TDXDIBEditor);

  RegisterPropertyEditor(TypeInfo(TPicture), TPictureCollectionItem, 'Picture', TPictureCollectionItem_PictureProperty);
  RegisterComponentEditor(TCustomDXImageList, TDXImageListEditor);

  RegisterPropertyEditor(TypeInfo(TWave), nil, '', TWaveProperty);
  RegisterComponentEditor(TCustomDXWave, TDXWaveEditor);

  RegisterComponentEditor(TCustomDXWaveList, TDXWaveListEditor);

  RegisterPropertyEditor(TypeInfo(TForceFeedbackEffects), nil, '', TForceFeedbackEffectsProperty);

  RegisterComponentEditor(TCustomDXInput, TDXInputEditor);

  RegisterPropertyEditor(TypeInfo(string), TCustomDXPlay, 'GUID', TGUIDProperty);

  RegisterComponents('DelphiX',
    [TDXDraw,
    TDXDIB,
    TDXImageList,
    TDX3D,
    TDXSound,
    TDXWave,
    TDXWaveList,
    TDXInput,
    TDXPlay,
    TDXSpriteEngine,
    TDXTimer,
    TDXPaintBox]);
end;

{ TDXDrawDisplayProperty }

function TDXDrawDisplayProperty.GetAttributes: TPropertyAttributes;
begin
  Result := inherited GetAttributes + [paValueList] - [paReadOnly];
end;

const
  SDisplayMode = '%dx%dx%d';

function TDXDrawDisplayProperty.GetValue: string;
begin
  with TDXDrawDisplay(GetOrdValue) do
    Result := Format(SDisplayMode, [Width, Height, BitCount]);
end;

procedure TDXDrawDisplayProperty.GetValues(Proc: TGetStrProc);
const             
  List: array[0..2] of TPoint = (
  (X:  640; Y:  480),
  (X:  800; Y:  600),
  (X: 1024; Y:  768));
var
  BitCount, i: Integer;
begin
  for i:=Low(List) to High(List) do
    for BitCount:=1 to 3 do
      Proc(Format(SDisplayMode, [List[i].x, List[i].y, BitCount*8]));
end;

procedure TDXDrawDisplayProperty.SetValue(const Value: string);
var
  s: string;
  i, AWidth, AHeight, ABitCount: Integer;
begin
  s := Value;

  i := Pos('x', s);
  AWidth := StrToInt(Copy(s, 1, i-1));
  s := Copy(s, i+1, Length(s));

  i := Pos('x', s);
  AHeight := StrToInt(Copy(s, 1, i-1));
  s := Copy(s, i+1, Length(s));

  ABitCount := StrToInt(s);

  with TDXDrawDisplay(GetOrdValue) do
  begin
    Width := AWidth;
    Height := AHeight;
    BitCount := ABitCount;
  end;

  SetOrdValue(GetOrdValue);
end;

{  TDIBProperty  }

procedure TDIBProperty.Edit;
var
  Form: TDelphiXPictureEditForm;
begin
  Form := TDelphiXPictureEditForm.Create(nil);
  try
    Form.ViewBox.Picture.Assign(TDIB(GetOrdValue));
    Form.DIBClassOnly := True;
    Form.ShowModal;
    if Form.Tag<>0 then
    begin
      SetOrdValue(Integer(Form.ViewBox.Picture.Graphic));
      Designer.Modified;
    end;
  finally
    Form.Free;
  end;
end;

function TDIBProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly];
end;

function TDIBProperty.GetValue: string;
begin
  if TDIB(GetOrdValue).Size=0 then
    Result := SNone
  else
    Result := Format('(%s)', [TObject(GetOrdValue).ClassName]);
end;

{  TDXDIBEditor  }

procedure TDXDIBEditor.Edit;
var
  Form: TDelphiXPictureEditForm;
begin
  Form := TDelphiXPictureEditForm.Create(nil);
  try
    Form.ViewBox.Picture.Assign(TCustomDXDIB(Component).DIB);
    Form.DIBClassOnly := True;
    Form.ShowModal;
    if Form.Tag<>0 then
    begin
      TCustomDXDIB(Component).DIB.Assign(TGraphic(Form.ViewBox.Picture.Graphic));
      Designer.Modified;
    end;
  finally
    Form.Free;
  end;
end;

procedure TDXDIBEditor.ExecuteVerb(Index: Integer);
begin
  case Index of
    0: Edit;
  end;
end;

function TDXDIBEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := SSettingImage;
  end;
end;

function TDXDIBEditor.GetVerbCount: Integer;
begin
  Result := 1;
end;

{  TPictureCollectionItem_PictureProperty  }

procedure TPictureCollectionItem_PictureProperty.Edit;
var
  Form: TDelphiXPictureEditForm;
  Item: TPictureCollectionItem;
  TempDIB: TDIB;
begin
  Form := TDelphiXPictureEditForm.Create(nil);
  try
    Form.ViewBox.Picture := TPicture(GetOrdValue);
    Form.ShowModal;
    if Form.Tag<>0 then
    begin
      SetOrdValue(Integer(Form.ViewBox.Picture));

      Item := GetComponent(0) as TPictureCollectionItem;
      if Item.Picture.Graphic<>nil then
      begin
        TempDIB := TDIB.Create;
        try
          TempDIB.SetSize(1, 1, 24);
          TempDIB.Canvas.Draw(0, 0, Item.Picture.Graphic);
          Item.TransparentColor := TempDIB.Pixels[0, 0];
        finally
          TempDIB.Free;
        end;
      end;
      Designer.Modified;
    end;
  finally
    Form.Free;
  end;
end;

function TPictureCollectionItem_PictureProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly];
end;

function TPictureCollectionItem_PictureProperty.GetValue: string;