rm_dialogctls.pas

这是一个功能强大

{******************************************}
{                                          }
{  Report Machine v2.0 - Dialog designer   }
{         Standard Dialog controls         }
{                                          }
{******************************************}

unit RM_DialogCtls;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, RM_Class, StdCtrls,
  Controls, Forms, Menus, Dialogs, Comctrls, Extctrls, Mask, CheckLst,
  Buttons,
  RM_Common
  {$IFDEF USE_INTERNAL_JVCL}
  , rm_JvTypes, rm_JvInterpreter, rm_JvInterpreter_StdCtrls, rm_JvInterpreter_Controls
  {$ELSE}
  , JvTypes, JvInterpreter, JvInterpreter_StdCtrls, JvInterpreter_Controls
  {$ENDIF}
  {$IFDEF JVCLCTLS}
  , JvToolEdit
  {$ENDIF}
  {$IFDEF COMPILER6_UP}, Variants{$ENDIF};

type
  TRMDialogControls = class(TComponent) // fake component
  end;

  { TRMCustomControl }
  TRMCustomControl = class(TRMDialogControl)
  private
    function GetColor: TColor;
    procedure SetColor(Value: TColor);
    function GetEnabled: Boolean;
    procedure SetEnabled(Value: Boolean);
    function GetShowHint: Boolean;
    procedure SetShowHint(Value: Boolean);
    function GetHint: string;
    procedure SetHint(Value: string);
    function GetOnClickEvent: TNotifyEvent;
    procedure SetOnClickEvent(Value: TNotifyEvent);
    function GetOnDblClickEvent: TNotifyEvent;
    procedure SetOnDblClickEvent(Value: TNotifyEvent);
  protected
    function GetFont: TFont; override;
    procedure SetFont(Value: TFont); override;
    function GetPropValue(aObject: TObject; aPropName: string; var aValue: Variant;
      Args: array of Variant): Boolean; override;
  public
    constructor Create; override;
    procedure AssignControl(AControl: TControl);
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
    procedure ShowEditor; override;

    property Control: TControl read FControl;
  published
    //    property ParentFont;
    property Left;
    property Top;
    property Width;
    property Height;
    property ShowHint: Boolean read GetShowHint write SetShowHint;
    property Hint: string read GetHint write SetHint;
    property Color: TColor read GetColor write SetColor;
    property Enabled: Boolean read GetEnabled write SetEnabled;
    property OnClick: TNotifyEvent read GetOnClickEvent write SetOnClickEvent;
    property OnDblClick: TNotifyEvent read GetOnDblClickEvent write SetOnDblClickEvent;
  end;

  { TRMLabelControl }
  TRMLabelControl = class(TRMCustomControl)
  private
    FLabel: TLabel;
    function GetCaption: string;
    procedure SetCaption(Value: string);
    function GetAutoSize: Boolean;
    procedure SetAutoSize(Value: Boolean);
    function GetAlignment: TAlignment;
    procedure SetAlignment(Value: TAlignment);
    function GetWordwrap: Boolean;
    procedure SetWordwrap(Value: Boolean);
  protected
  public
    class procedure DefaultSize(var aKx, aKy: Integer); override;
    constructor Create; override;
    destructor Destroy; override;
    procedure Draw(aCanvas: TCanvas); override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
  published
    property Font;
    property Caption: string read GetCaption write SetCaption;
    property AutoSize: Boolean read GetAutoSize write SetAutoSize;
    property Wordwrap: Boolean read GetWordwrap write SetWordwrap;
    property Alignment: TAlignment read GetAlignment write SetAlignment;
    //    property LabelCtl: TLabel read FLabel;
  end;

  { TRMEditControl }
  TRMEditControl = class(TRMCustomControl)
  private
    FEdit: TEdit;

    function GetText: string;
    procedure SetText(Value: string);
    function GetReadOnly: Boolean;
    procedure SetReadOnly(Value: Boolean);
  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;
  published
    property Font;
    property TabOrder;
    property Text: string read GetText write SetText;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
    //    property EditCtl: TEdit read FEdit;
  end;

  { TRMMaskEditControl }
  TRMMaskEditControl = class(TRMCustomControl)
  private
    FEdit: TMaskEdit;

    function GetEditMask: string;
    procedure SetEditMask(Value: string);
    function GetText: string;
    procedure SetText(Value: string);
    function GetReadOnly: Boolean;
    procedure SetReadOnly(Value: Boolean);
  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 MaskEdit: TMaskEdit read FEdit;
  published
    property Font;
    property TabOrder;
    property EditMask: string read GetEditMask write SetEditMask;
    property Text: string read GetText write SetText;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
    //    property EditCtl: TMaskEdit read FEdit;
  end;

  { TRMMemoControl }
  TRMMemoControl = class(TRMCustomControl)
  private
    FMemo: TMemo;

    function GetLines: TStrings;
    procedure SetLines(Value: TStrings);
    function GetReadOnly: Boolean;
    procedure SetReadOnly(Value: Boolean);
  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;
  published
    property Font;
    property TabOrder;
    property Lines: TStrings read GetLines write SetLines;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
    //    property MemoCtrl: TMemo read FMemo;
  end;

  { TRMButtonControl }
  TRMButtonControl = class(TRMCustomControl)
  private
    FButton: TButton;

    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);
  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;
  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 ButtonCtl: TButton read FButton;
  end;

  { TRMCheckBoxControl }
  TRMCheckBoxControl = class(TRMCustomControl)
  private
    FCheckBox: TCheckBox;

    function GetChecked: Boolean;
    procedure SetChecked(Value: Boolean);
    function GetCaption: string;
    procedure SetCaption(Value: string);
    function GetAlignment: TAlignment;
    procedure SetAlignment(Value: TAlignment);
  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;
  published
    property Font;
    property TabOrder;
    property Checked: Boolean read GetChecked write SetChecked;
    property Caption: string read GetCaption write SetCaption;
    property Alignment: TAlignment read GetAlignment write SetAlignment;
    //    property CheckBoxCtl: TCheckBox read FCheckBox;
  end;

  { TRMRadioButtonControl }
  TRMRadioButtonControl = class(TRMCustomControl)
  private
    FRadioButton: TRadioButton;

    function GetChecked: Boolean;
    procedure SetChecked(Value: Boolean);
    function GetCaption: string;
    procedure SetCaption(Value: string);
    function GetAlignment: TAlignment;
    procedure SetAlignment(Value: TAlignment);
  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;
  published
    property Font;
    property TabOrder;
    property Checked: Boolean read GetChecked write SetChecked;
    property Caption: string read GetCaption write SetCaption;
    property Alignment: TAlignment read GetAlignment write SetAlignment;
    //    property RadioButtonCtl: TRadioButton read FRadioButton;
  end;

  { TRMListBoxControl }
  TRMListBoxControl = class(TRMCustomControl)
  private
    FListBox: TListBox;

    function GetItems: TStrings;
    procedure SetItems(Value: TStrings);
    function GetItemIndex: Integer;
    procedure SetItemIndex(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;
  published
    property Font;
    property TabOrder;
    property Items: TStrings read GetItems write SetItems;
    property ItemIndex: Integer read GetItemIndex write SetItemIndex;
    //    property ListBoxCtl: TListBox read FListBox;
  end;

  TRMComboBoxStyle = (rmcsDropDown, rmcsDropDownList, rmcsLookup);

  { TRMComboBoxControl }
  TRMComboBoxControl = class(TRMCustomControl)
  private
    FComboBox: TComboBox;
    FStyle: TRMComboBoxStyle;

    procedure ComboBoxDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    procedure OnKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

    function GetItems: TStrings;
    procedure SetItems(Value: TStrings);
    function GetItemIndex: Integer;
    procedure SetItemIndex(Value: Integer);
    function GetText: string;
    procedure SetText(Value: string);
    procedure SetStyle(Value: TRMComboBoxStyle);
  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;
  published
    property Font;
    property TabOrder;
    property Items: TStrings read GetItems write SetItems;
    property ItemIndex: Integer read GetItemIndex write SetItemIndex;
    property Text: string read GetText write SetText;
    property Style: TRMComboBoxStyle read FStyle write SetStyle;
    //    property ComboBoxCtl: TComboBox read FComboBox;
  end;

  TRMDateEditControl = class(TRMCustomControl)
  private
    FDateEdit: TDateTimePicker;

    function GetDate: TDate;
    procedure SetDate(Value: TDate);
    function GetTime: TTime;
    procedure SetTime(Value: TTime);
    function GetDateFormat: TDTDateFormat;
    procedure SetDateFormat(Value: TDTDateFormat);
    function GetKind: TDateTimeKind;
    procedure SetKind(Value: TDateTimeKind);
  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;
  published
    property Font;
    property TabOrder;
    property Date: TDate read GetDate write SetDate;
    property Time: TTime read GetTime write SetTime;
    property DateFormat: TDTDateFormat read GetDateFormat write SetDateFormat;
    property Kind: TDateTimeKind read GetKind write SetKind;
    //    property DateEditCtl: TDateTimePicker read FDateEdit;
  end;

  {$IFDEF JVCLCTLS}
  TRMRXDateEditControl = class(TRMCustomControl)
  private
    FDateEdit: TJvDateEdit;

    function GetText: string;
    procedure SetText(Value: string);
    function GetDialogTitle: string;
    procedure SetDialogTitle(Value: string);
    function GetStartOfWeek: TDayOfWeekName;
    procedure SetStartOfWeek(Value: TDayOfWeekName);
    function GetYearDigits: TYearDigits;
    procedure SetYearDigits(Value: TYearDigits);
    function GetClickKey: TShortCut;
    procedure SetClickKey(Value: TShortCut);
    function GetCalendarStyle: TCalendarStyle;
    procedure SetCalendarStyle(Value: TCalendarStyle);
    function GetDefaultToday: Boolean;
    procedure SetDefaultToday(Value: Boolean);
  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;
    function GetPropValue(aObject: TObject; aPropName: string; var aValue: Variant; Args: array of Variant): Boolean; override;
    function SetPropValue(aObject: TObject; aPropName: string; aValue: Variant): Boolean; override;
  published
    //    property DateEditCtl: TJvDateEdit read FDateEdit;
    property Font;
    property TabOrder;
    property Text: string read GetText write SetText;
    property DialogTitle: string read GetDialogTitle write SetDialogTitle;
    property StartOfWeek: TDayOfWeekName read GetStartOfWeek write SetStartOfWeek;
    property YearDigits: TYearDigits read GetYearDigits write SetYearDigits;
    property ClickKey: TShortCut read GetClickKey write SetClickKey;
    property CalendarStyle: TCalendarStyle read GetCalendarStyle write SetCalendarStyle;
    property DefaultToday: Boolean read GetDefaultToday write SetDefaultToday;
  end;
  {$ENDIF}

  { TRMCheckListBoxControl }
  TRMCheckListBoxControl = class(TRMCustomControl)
  private
    FCheckListBox: TCheckListBox;

    function GetItems: TStrings;
    procedure SetItems(Value: TStrings);
    function GetItemIndex: Integer;
    procedure SetItemIndex(Value: Integer);
  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 CheckListBox: TCheckListBox read FCheckListBox;
  published
    property Font;
    property TabOrder;
    property Items: TStrings read GetItems write SetItems;
    property ItemIndex: Integer read GetItemIndex write SetItemIndex;
  end;

  { TRMPanelControl }
  TRMPanelControl = class(TRMCustomControl)
  private
    FPanel: TPanel;

    function GetBevelInner: TPanelBevel;
    procedure SetBevelInner(Value: TPanelBevel);
    function GetBevelOuter: TPanelBevel;
    procedure SetBevelOuter(Value: TPanelBevel);
    function GetBevelWidth: Integer;
    procedure SetBevelWidth(Value: Integer);
    function GetBorderStyle: TBorderStyle;
    procedure SetBorderStyle(Value: TBorderStyle);
    function GetBorderWidth: Integer;
    procedure SetBorderWidth(Value: Integer);
    function GetCaption: string;
    procedure SetCaption(Value: string);
  protected
    function GetPropValue(aObject: TObject; aPropName: string; var aValue: Variant;
      Args: array of Variant): Boolean; override;
    function IsContainer: 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 Panel: TPanel read FPanel;
  published
    property Font;
    property TabOrder;
    property BevelInner: TPanelBevel read GetBevelInner write SetBevelInner;
    property BevelOuter: TPanelBevel read GetBevelOuter write SetBevelOuter;
    property BevelWidth: Integer read GetBevelWidth write SetBevelWidth;
    property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle;
    property BorderWidth: Integer read GetBorderWidth write SetBorderWidth;
    property Caption: string read GetCaption write SetCaption;
  end;

  { TRMGroupBoxControl }
  TRMGroupBoxControl = class(TRMCustomControl)
  private
    FGroupBox: TGroupBox;
  protected
    function GetPropValue(aObject: TObject; aPropName: string; var aValue: Variant;
      Args: array of Variant): Boolean; override;
    function IsContainer: Boolean; override;
  public
    class procedure DefaultSize(var aKx, aKy: Integer); override;
    constructor Create; override;
    destructor Destroy; override;