rm_dctrl.pas

report machine 2.3 功能强大

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

unit RM_DCtrl;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, RM_Class, StdCtrls,
  Controls, Forms, Menus, Dialogs, Comctrls
{$IFDEF RX}
  , Mask, DateUtil, ToolEdit
{$ENDIF}
{$IFDEF Delphi6}, Variants{$ENDIF};

const
  csLookup = csOwnerDrawFixed;

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

  { TRMStdControl }
  TRMStdControl = class(TRMControl)
  private
  	FTabOrder: Integer;
    procedure FontEditor(Sender: TObject);
    procedure OnClickEditor(Sender: TObject);
    procedure OnClick(Sender: TObject);
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
    function DoMethod(const MethodName: string; Par1, Par2, Par3: Variant): Variant; override;
  public
    constructor Create; override;
    procedure AssignControl(AControl: TControl);
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefineProperties; override;
    procedure ShowEditor; override;
    property TabOrder: Integer read FTabOrder write FTabOrder;
  end;

  { TRMLabelControl }
  TRMLabelControl = class(TRMStdControl)
  private
    FLabel: TLabel;
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Draw(Canvas: TCanvas); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefineProperties; override;
    property LabelCtl: TLabel read FLabel;
  end;

  { TRMEditControl }
  TRMEditControl = class(TRMStdControl)
  private
    FEdit: TEdit;
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefineProperties; override;
    property Edit: TEdit read FEdit;
  end;

  { TRMMemoControl }
  TRMMemoControl = class(TRMStdControl)
  private
    FMemo: TMemo;
    procedure LinesEditor(Sender: TObject);
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
    function DoMethod(const MethodName: string; Par1, Par2, Par3: Variant): Variant; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefineProperties; override;
    property MemoCtrl: TMemo read FMemo;
  end;

  { TRMButtonControl }
  TRMButtonControl = class(TRMStdControl)
  private
    FButton: TButton;
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefineProperties; override;
    property Button: TButton read FButton;
  end;

  { TRMCheckBoxControl }
  TRMCheckBoxControl = class(TRMStdControl)
  private
    FCheckBox: TCheckBox;
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefineProperties; override;
    property CheckBox: TCheckBox read FCheckBox;
  end;

  { TRMRadioButtonControl }
  TRMRadioButtonControl = class(TRMStdControl)
  private
    FRadioButton: TRadioButton;
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefineProperties; override;
    property RadioButton: TRadioButton read FRadioButton;
  end;

  { TRMListBoxControl }
  TRMListBoxControl = class(TRMStdControl)
  private
    FListBox: TListBox;
    procedure LinesEditor(Sender: TObject);
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
    function DoMethod(const MethodName: string; Par1, Par2, Par3: Variant): Variant; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefineProperties; override;
    property ListBox: TListBox read FListBox;
  end;

  { TRMComboBoxControl }
  TRMComboBoxControl = class(TRMStdControl)
  private
    FComboBox: TComboBox;
    procedure ComboBoxDrawItem(Control: TWinControl;
      Index: Integer; Rect: TRect; State: TOwnerDrawState);
    procedure LinesEditor(Sender: TObject);
    procedure OnKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
    function DoMethod(const MethodName: string; Par1, Par2, Par3: Variant): Variant; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefineProperties; override;
    property ComboBox: TComboBox read FComboBox;
  end;

{$IFNDEF Delphi2}
  TRMDateEditControl = class(TRMStdControl)
  private
    FDateEdit: TDateTimePicker;
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefineProperties; override;
    property DateEdit: TDateTimePicker read FDateEdit;
  end;
{$ENDIF}

{$IFDEF RX}
  TRMRXDateEditControl = class(TRMStdControl)
  private
    FDateEdit: TDateEdit;
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefineProperties; override;
    property DateEdit: TDateEdit read FDateEdit;
  end;
{$ENDIF}

function RMGetShortCuts: string;

implementation

uses RM_CmpReg, RM_Utils, RM_Const, RM_LEdit;

{$R RM_DCtrl.RES}
{$R RM_LNG4.RES}

type
  THackControl = class(TControl)
  end;

const
  ShortCuts: array[0..81] of TShortCut = (
    Byte('A') or scCtrl,
    Byte('B') or scCtrl,
    Byte('C') or scCtrl,
    Byte('D') or scCtrl,
    Byte('E') or scCtrl,
    Byte('F') or scCtrl,
    Byte('G') or scCtrl,
    Byte('H') or scCtrl,
    Byte('I') or scCtrl,
    Byte('J') or scCtrl,
    Byte('K') or scCtrl,
    Byte('L') or scCtrl,
    Byte('M') or scCtrl,
    Byte('N') or scCtrl,
    Byte('O') or scCtrl,
    Byte('P') or scCtrl,
    Byte('Q') or scCtrl,
    Byte('R') or scCtrl,
    Byte('S') or scCtrl,
    Byte('T') or scCtrl,
    Byte('U') or scCtrl,
    Byte('V') or scCtrl,
    Byte('W') or scCtrl,
    Byte('X') or scCtrl,
    Byte('Y') or scCtrl,
    Byte('Z') or scCtrl,
    VK_F1,
    VK_F2,
    VK_F3,
    VK_F4,
    VK_F5,
    VK_F6,
    VK_F7,
    VK_F8,
    VK_F9,
    VK_F10,
    VK_F11,
    VK_F12,
    VK_F1 or scCtrl,
    VK_F2 or scCtrl,
    VK_F3 or scCtrl,
    VK_F4 or scCtrl,
    VK_F5 or scCtrl,
    VK_F6 or scCtrl,
    VK_F7 or scCtrl,
    VK_F8 or scCtrl,
    VK_F9 or scCtrl,
    VK_F10 or scCtrl,
    VK_F11 or scCtrl,
    VK_F12 or scCtrl,
    VK_F1 or scShift,
    VK_F2 or scShift,
    VK_F3 or scShift,
    VK_F4 or scShift,
    VK_F5 or scShift,
    VK_F6 or scShift,
    VK_F7 or scShift,
    VK_F8 or scShift,
    VK_F9 or scShift,
    VK_F10 or scShift,
    VK_F11 or scShift,
    VK_F12 or scShift,
    VK_F1 or scShift or scCtrl,
    VK_F2 or scShift or scCtrl,
    VK_F3 or scShift or scCtrl,
    VK_F4 or scShift or scCtrl,
    VK_F5 or scShift or scCtrl,
    VK_F6 or scShift or scCtrl,
    VK_F7 or scShift or scCtrl,
    VK_F8 or scShift or scCtrl,
    VK_F9 or scShift or scCtrl,
    VK_F10 or scShift or scCtrl,
    VK_F11 or scShift or scCtrl,
    VK_F12 or scShift or scCtrl,
    VK_INSERT,
    VK_INSERT or scShift,
    VK_INSERT or scCtrl,
    VK_DELETE,
    VK_DELETE or scShift,
    VK_DELETE or scCtrl,
    VK_BACK or scAlt,
    VK_BACK or scShift or scAlt);

function RMGetShortCuts: string;
var
  i: Word;
begin
  Result := RMLoadStr(SNotAssigned);
  for i := Low(ShortCuts) to High(ShortCuts) do
    Result := Result + ';' + ShortCutToText(ShortCuts[i]);
  SetLength(Result, Length(Result) - 1);
end;

{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
{ TRMStdControl }

constructor TRMStdControl.Create;
begin
	Inherited Create;
  FTabOrder := -1;
end;

procedure TRMStdControl.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('Color', [RMdtColor], nil);
  AddProperty('Enabled', [RMdtBoolean], nil);
  AddProperty('Font', [RMdtHasEditor], FontEditor);
  AddProperty('Font.Name', [], nil);
  AddProperty('Font.Size', [], nil);
  AddProperty('Font.Style', [], nil);
  AddProperty('Font.Color', [], nil);
  AddProperty('OnClick', [RMdtHasEditor, RMdtOneObject], OnClickEditor);
  AddProperty('TabOrder', [rmdtInteger], nil);
end;

procedure TRMStdControl.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  SetFontProp(THackControl(Control).Font, Index, Value);
  if Index = 'COLOR' then
    THackControl(Control).Color := Value
  else if Index = 'ENABLED' then
    Control.Enabled := Value
  else if Index = 'LEFT' then
  begin
    if DocMode = dmPrinting then
      Control.Left := Value;
  end
  else if Index = 'TOP' then
  begin
    if DocMode = dmPrinting then
      Control.Top := Value;
  end
  else if Index = 'WIDTH' then
  begin
    if DocMode = dmPrinting then
      Control.Width := Value;
  end
  else if Index = 'HEIGHT' then
  begin
    if DocMode = dmPrinting then
      Control.Height := Value;
  end
  else if Index = 'VISIBLE' then
  begin
    if DocMode = dmPrinting then
      Control.Visible := Value;
  end
  else if Index = 'TABORDER' then
  begin
  	FTabOrder := Value;
  end;
end;

function TRMStdControl.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'COLOR' then
    Result := THackControl(Control).Color
  else if Index = 'ENABLED' then
    Result := Control.Enabled
  else if Index = 'TABORDER' then
  begin
  	Result := FTabOrder;
  end;
end;

function TRMStdControl.DoMethod(const MethodName: string; Par1, Par2, Par3: Variant): Variant;
begin
  Result := inherited DoMethod(MethodName, Par1, Par2, Par3);
  if MethodName = 'SETFOCUS' then
  begin
    if Control is TWinControl then
      TWinControl(Control).SetFocus;
  end;
end;

procedure TRMStdControl.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  THackControl(Control).Color := RMReadInteger(Stream);
  Control.Enabled := RMReadBoolean(Stream);
  RMReadFont(Stream, THackControl(Control).Font);
  if RMVersion >= 39 then
  begin
		FTabOrder := RMReadInteger(Stream);
  end;
end;

procedure TRMStdControl.SaveToStream(Stream: TStream);
begin
  HVersion := 0;
  inherited SaveToStream(Stream);
  RMWriteInteger(Stream, THackControl(Control).Color);
  RMWriteBoolean(Stream, Control.Enabled);
  RMWriteFont(Stream, THackControl(Control).Font);
	RMWriteInteger(Stream, FTabOrder);
end;

procedure TRMStdControl.ShowEditor;
begin
  RMScript_BeforePrintEditor(nil);
//  RMMemoEditor(nil);
end;

procedure TRMStdControl.FontEditor(Sender: TObject);
var
  i: Integer;
  t: TRMView;
  fd: TFontDialog;
begin
  fd := TFontDialog.Create(nil);
  with fd do
  begin
    Font.Assign(THackControl(Control).Font);
    if Execute then
    begin
      RMDesigner.BeforeChange;
      for i := 0 to RMDesigner.Page.Objects.Count - 1 do
      begin
        t := RMDesigner.Page.Objects[i];
        if t.Selected and (t is TRMStdControl) then
        begin
          if (t.Restrictions and RMrfDontModify) = 0 then