rm_dialogctls.pas

这是一个功能强大

    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;

    property GroupBox: TGroupBox read FGroupBox;
  published
    property Font;
    property TabOrder;
    function GetCaption: string;
    procedure SetCaption(Value: string);
    property Caption: string read GetCaption write SetCaption;
  end;

  { TRMImageControl }
  TRMImageControl = class(TRMCustomControl)
  private
    FImage: TImage;

    function GetPicture: TPicture;
    procedure SetPicture(Value: TPicture);
    function GetAutoSize(Index: Integer): Boolean;
    procedure SetAutoSize(Index: Integer; Value: Boolean);
  protected
    function GetPropValue(aObject: TObject; aPropName: string; var aValue: Variant;
      Args: array of Variant): Boolean; override;
  public
    class procedure DefaultSize(var aKx, aKy: Integer); override;
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;

    property Image: TImage read FImage;
  published
    property Picture: TPicture read GetPicture write SetPicture;
    property AutoSize: Boolean index 0 read GetAutoSize write SetAutoSize;
    property Center: Boolean index 1 read GetAutoSize write SetAutoSize;
    property Stretch: Boolean index 2 read GetAutoSize write SetAutoSize;
    property Transparent: Boolean index 3 read GetAutoSize write SetAutoSize;
  end;

  { TRMBevelControl }
  TRMBevelControl = class(TRMCustomControl)
  private
    FBevel: TBevel;
  protected
    function GetPropValue(aObject: TObject; aPropName: string; var aValue: Variant;
      Args: array of Variant): Boolean; override;
  public
    class procedure DefaultSize(var aKx, aKy: Integer); override;
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;

    property Bevel: TBevel read FBevel;
  published
  end;

  { TRMSpeedButtonControl }
  TRMSpeedButtonControl = class(TRMCustomControl)
  private
    FSpeedButton: TSpeedButton;

    function GetCaption: string;
    procedure SetCaption(Value: string);
  protected
  public
    class procedure DefaultSize(var aKx, aKy: Integer); override;
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;

    property SpeedButton: TSpeedButton read FSpeedButton;
  published
    property Font;
    property TabOrder;
    property Caption: string read GetCaption write SetCaption;
  end;

  { TRMBitBtnControl }
  TRMBitBtnControl = class(TRMCustomControl)
  private
    FBitBtn: TBitBtn;

    function GetCaption: string;
    procedure SetCaption(Value: string);
    function GetCancel: Boolean;
    procedure SetCancel(Value: Boolean);
    function GetDefault: Boolean;
    procedure SetDefault(Value: Boolean);
    function GetModalResult: TModalResult;
    procedure SetModalResult(Value: TModalResult);
    function GetGlyph: TBitmap;
    procedure SetGlyph(Value: TBitmap);
    function GetKind: TBitBtnKind;
    procedure SetKind(Value: TBitBtnKind);
    function GetLayout: TButtonLayout;
    procedure SetLayout(Value: TButtonLayout);
    function GetNumGlyphs: Integer;
    procedure SetNumGlyphs(Value: Integer);
    function GetSpacing: Integer;
    procedure SetSpacing(Value: Integer);
  protected
  public
    class procedure DefaultSize(var aKx, aKy: Integer); override;
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;

    property BitBtn: TBitBtn read FBitBtn;
  published
    property Font;
    property TabOrder;
    property Caption: string read GetCaption write SetCaption;
    property Cancel: Boolean read GetCancel write SetCancel;
    property Default: Boolean read GetDefault write SetDefault;
    property ModalResult: TModalResult read GetModalResult write SetModalResult;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property Kind: TBitBtnKind read GetKind write SetKind;
    property Layout: TButtonLayout read GetLayout write SetLayout;
    property NumGlyphs: Integer read GetNumGlyphs write SetNumGlyphs;
    property Spacing: Integer read GetSpacing write SetSpacing;
  end;

implementation

uses RM_Utils, RM_Const, RM_EditorStrings;

{$R RM_DialogCtls.RES}
{$R RM_LNG4.RES}

type
  THackControl = class(TControl)
  end;

  {-----------------------------------------------------------------------------}
  {-----------------------------------------------------------------------------}
  { TRMCustomControl }

constructor TRMCustomControl.Create;
begin
  inherited Create;
end;

function TRMCustomControl.GetPropValue(aObject: TObject; aPropName: string;
  var aValue: Variant; Args: array of Variant): Boolean;
begin
  Result := True;
  if aPropName = 'CONTROL' then
  begin
    aValue := O2V(FControl);
  end
  else if aPropName = 'BUTTONCTL' then
    aValue := O2V(FControl)
  else if aPropName = 'LABELCTL' then
    aValue := O2V(FControl)
  else if aPropName = 'EDITCTL' then
    aValue := O2V(FControl)
  else if aPropName = 'MEMOCTL' then
    aValue := O2V(FControl)
  else if aPropName = 'CHECKBOXCTL' then
    aValue := O2V(FControl)
  else if aPropName = 'RADIOBUTTONXCTL' then
    aValue := O2V(FControl)
  else if aPropName = 'LISTBOXCTL' then
    aValue := O2V(FControl)
  else if aPropName = 'COMBOBOXCTL' then
    aValue := O2V(FControl)
  else if aPropName = 'DATEEDITCTL' then
    aValue := O2V(FControl)
  else
    Result := inherited GetPropValue(aObject, aPropName, aValue, Args);
end;

procedure TRMCustomControl.LoadFromStream(aStream: TStream);
var
  lVersion: Integer;
begin
  inherited LoadFromStream(aStream);
  lVersion := RMReadWord(aStream);
  Color := RMReadInt32(aStream);
  Enabled := RMReadBoolean(aStream);
  RMReadFont(aStream, Font);
  TabOrder := RMReadInt32(aStream);
  if lVersion >=5 then
  begin
    ShowHint := RMReadBoolean(aStream);
    Hint := RMReadString(aStream);
  end;
end;

procedure TRMCustomControl.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 5);
  RMWriteInt32(aStream, Color);
  RMWriteBoolean(aStream, Enabled);
  RMWriteFont(aStream, Font);
  RMWriteInt32(aStream, TabOrder);
  RMWriteBoolean(aStream, ShowHint);
  RMWriteString(aStream, Hint);
end;

procedure TRMCustomControl.ShowEditor;
begin
end;

procedure TRMCustomControl.AssignControl(AControl: TControl);
begin
  FControl := AControl;
end;

function TRMCustomControl.GetFont: TFont;
begin
  Result := THackControl(FControl).Font;
end;

procedure TRMCustomControl.SetFont(Value: TFont);
begin
  THackControl(FControl).Font.Assign(Value);
end;

function TRMCustomControl.GetColor: TColor;
begin
  Result := THackControl(FControl).Color;
end;

procedure TRMCustomControl.SetColor(Value: TColor);
begin
  THackControl(FControl).Color := Value;
end;

function TRMCustomControl.GetEnabled: Boolean;
begin
  Result := FControl.Enabled;
end;

procedure TRMCustomControl.SetEnabled(Value: Boolean);
begin
  FControl.Enabled := Value;
end;

function TRMCustomControl.GetShowHint: Boolean;
begin
  Result := FControl.ShowHint;
end;

procedure TRMCustomControl.SetShowHint(Value: Boolean);
begin
  FControl.ShowHint := Value;
end;

function TRMCustomControl.GetHint: string;
begin
  Result := FControl.Hint;
end;

procedure TRMCustomControl.SetHint(Value: string);
begin
  FControl.Hint := Value;
end;

function TRMCustomControl.GetOnClickEvent: TNotifyEvent;
begin
  Result := THackControl(FControl).OnClick;
end;

procedure TRMCustomControl.SetOnClickEvent(Value: TNotifyEvent);
begin
  THackControl(FControl).OnClick := Value;
end;

function TRMCustomControl.GetOnDblClickEvent: TNotifyEvent;
begin
  Result := THackControl(FControl).OnDblClick;
end;

procedure TRMCustomControl.SetOnDblClickEvent(Value: TNotifyEvent);
begin
  THackControl(FControl).OnDblClick := Value;
end;

{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
{ TRMLabelControl }

class procedure TRMLabelControl.DefaultSize(var aKx, aKy: Integer);
begin
  aKx := 65;
  aKy := 17;
end;

constructor TRMLabelControl.Create;
begin
  inherited Create;
  BaseName := 'Label';

  FLabel := TLabel.Create(nil);
  FLabel.Parent := RMDialogForm;
  FLabel.Caption := 'Label';
  AssignControl(FLabel);
end;

destructor TRMLabelControl.Destroy;
begin
  FreeAndNil(FLabel);
  inherited Destroy;
end;

procedure TRMLabelControl.Draw(aCanvas: TCanvas);
begin
  BeginDraw(aCanvas);
  if AutoSize then
  begin
    spWidth := FLabel.Width;
    spHeight := FLabel.Height;
  end
  else
  begin
    FLabel.Width := spWidth;
    FLabel.Height := spHeight;
  end;
  CalcGaps;
  PaintDesignControl;
  RestoreCoord;
end;

procedure TRMLabelControl.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  Alignment := TAlignment(RMReadByte(aStream));
  AutoSize := RMReadBoolean(aStream);
  Caption := RMReadString(aStream);
  WordWrap := RMReadBoolean(aStream);
end;

procedure TRMLabelControl.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteByte(aStream, Byte(Alignment));
  RMWriteBoolean(aStream, AutoSize);
  RMWriteString(aStream, Caption);
  RMWriteBoolean(aStream, WordWrap);
end;

function TRMLabelControl.GetCaption: string;
begin
  Result := FLabel.Caption;
end;

procedure TRMLabelControl.SetCaption(Value: string);
begin
  FLabel.Caption := Value;
end;

function TRMLabelControl.GetAutoSize: Boolean;
begin
  Result := FLabel.AutoSize;
end;

procedure TRMLabelControl.SetAutoSize(Value: Boolean);
begin
  FLabel.AutoSize := Value;
end;

function TRMLabelControl.GetAlignment: TAlignment;
begin
  Result := FLabel.Alignment;
end;

procedure TRMLabelControl.SetAlignment(Value: TAlignment);
begin
  FLabel.Alignment := Value;
end;

function TRMLabelControl.GetWordwrap: Boolean;
begin
  Result := FLabel.Wordwrap;
end;

procedure TRMLabelControl.SetWordwrap(Value: Boolean);
begin
  FLabel.Wordwrap := Value;
end;

{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
{ TRMEditControl }

class procedure TRMEditControl.DefaultSize(var aKx, aKy: Integer);
begin
  aKx := 121;
  aKy := 21;
end;

constructor TRMEditControl.Create;
begin
  inherited Create;
  BaseName := 'Edit';

  FEdit := TEdit.Create(nil);
  FEdit.Parent := RMDialogForm;
  FEdit.Text := 'Edit';
  AssignControl(FEdit);
end;

destructor TRMEditControl.Destroy;
begin
  FreeAndNil(FEdit);
  inherited Destroy;
end;

procedure TRMEditControl.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  Text := RMReadString(aStream);
  ReadOnly := RMReadBoolean(aStream);
end;

procedure TRMEditControl.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteString(aStream, Text);
  RMWriteBoolean(aStream, ReadOnly);
end;

function TRMEditControl.GetText: string;
begin
  Result := FEdit.Text;
end;

procedure TRMEditControl.SetText(Value: string);
begin
  FEdit.Text := Value;
end;

function TRMEditControl.GetReadOnly: Boolean;
begin
  Result := FEdit.ReadOnly;
end;

procedure TRMEditControl.SetReadOnly(Value: Boolean);
begin
  FEdit.ReadOnly := Value;
end;

{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
{ TRMMaskEditControl }

class procedure TRMMaskEditControl.DefaultSize(var aKx, aKy: Integer);
begin
  aKx := 121;
  aKy := 21;
end;

constructor TRMMaskEditControl.Create;
begin
  inherited Create;
  BaseName := 'MaskEdit';

  FEdit := TMaskEdit.Create(nil);
  FEdit.Parent := RMDialogForm;
  FEdit.Text := 'MaskEdit';
  AssignControl(FEdit);
end;

destructor TRMMaskEditControl.Destroy;