rm_dctrl.pas

report machine 2.3 功能强大

            THackControl(TRMStdControl(t).Control).Font.Assign(Font);
        end;
      end;
      RMDesigner.AfterChange;
    end;
  end;
  fd.Free;
end;

procedure TRMStdControl.OnClickEditor(Sender: TObject);
begin
  ShowEditor;
end;

procedure TRMStdControl.OnClick(Sender: TObject);
var
  sl, sl1: TStringList;
begin
  if DocMode = dmDesigning then Exit;
  CurView := Self;
  sl := TStringList.Create;
  sl1 := TStringList.Create;
  RMInterpretator.PrepareScript(Script, sl, sl1);
  RMInterpretator.DoScript(sl);
  sl.Free;
  sl1.Free;
end;

procedure TRMStdControl.AssignControl(AControl: TControl);
begin
  FControl := AControl;
  THackControl(Control).OnClick := OnClick;
end;

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

constructor TRMLabelControl.Create;
begin
  inherited Create;
  FLabel := TLabel.Create(nil);
  FLabel.Parent := RMDialogForm;
  FLabel.Caption := 'Label';
  AssignControl(FLabel);
  BaseName := 'Label';

  RMConsts['taLeftJustify'] := taLeftJustify;
  RMConsts['taRightJustify'] := taRightJustify;
  RMConsts['taCenter'] := taCenter;
end;

destructor TRMLabelControl.Destroy;
begin
  FLabel.Free;
  inherited Destroy;
end;

procedure TRMLabelControl.DefineProperties;
begin
  inherited DefineProperties;
  AddEnumProperty('Alignment',
    'taLeftJustify;taRightJustify;taCenter',
    [taLeftJustify, taRightJustify, taCenter]);
  AddProperty('AutoSize', [RMdtBoolean], nil);
  AddProperty('Caption', [RMdtString], nil);
  AddProperty('WordWrap', [RMdtBoolean], nil);

  RemoveProperty('TabOrder');
end;

procedure TRMLabelControl.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'ALIGNMENT' then
    FLabel.Alignment := Value
  else if Index = 'AUTOSIZE' then
    FLabel.AutoSize := Value
  else if Index = 'CAPTION' then
    FLabel.Caption := Value
  else if Index = 'WORDWRAP' then
    FLabel.WordWrap := Value
end;

function TRMLabelControl.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'ALIGNMENT' then
    Result := FLabel.Alignment
  else if Index = 'AUTOSIZE' then
    Result := FLabel.AutoSize
  else if Index = 'CAPTION' then
    Result := FLabel.Caption
  else if Index = 'WORDWRAP' then
    Result := FLabel.WordWrap
end;

procedure TRMLabelControl.Draw(Canvas: TCanvas);
begin
  BeginDraw(Canvas);
  if Prop['AutoSize'] = True then
  begin
    dx := FLabel.Width;
    dy := FLabel.Height;
  end
  else
  begin
    FLabel.Width := dx;
    FLabel.Height := dy;
  end;
  CalcGaps;
  PaintDesignControl;
  RestoreCoord;
end;

procedure TRMLabelControl.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FLabel.Alignment := TAlignment(RMReadByte(Stream));
  FLabel.AutoSize := RMReadBoolean(Stream);
  FLabel.Caption := RMReadString(Stream);
  FLabel.WordWrap := RMReadBoolean(Stream);
  if Prop['AutoSize'] = True then
  begin
    dx := FLabel.Width;
    dy := FLabel.Height;
  end;
end;

procedure TRMLabelControl.SaveToStream(Stream: TStream);
begin
  LVersion := 0;
  inherited SaveToStream(Stream);
  RMWriteByte(Stream, Byte(FLabel.Alignment));
  RMWriteBoolean(Stream, FLabel.AutoSize);
  RMWriteString(Stream, FLabel.Caption);
  RMWriteBoolean(Stream, FLabel.WordWrap);
end;

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

constructor TRMEditControl.Create;
begin
  inherited Create;
  FEdit := TEdit.Create(nil);
  FEdit.Parent := RMDialogForm;
  FEdit.Text := 'Edit';
  AssignControl(FEdit);
  BaseName := 'Edit';
  dx := 121; dy := 21;
end;

destructor TRMEditControl.Destroy;
begin
  FEdit.Free;
  inherited Destroy;
end;

procedure TRMEditControl.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('Text', [RMdtString], nil);
  AddProperty('ReadOnly', [RMdtBoolean], nil);
end;

procedure TRMEditControl.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'TEXT' then
    FEdit.Text := Value
  else if Index = 'READONLY' then
    FEdit.ReadOnly := Value
end;

function TRMEditControl.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'TEXT' then
    Result := FEdit.Text
  else if Index = 'READONLY' then
    Result := FEdit.ReadOnly
end;

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

procedure TRMEditControl.SaveToStream(Stream: TStream);
begin
  LVersion := 0;
  inherited SaveToStream(Stream);
  RMWriteString(Stream, FEdit.Text);
  RMWriteBoolean(Stream, FEdit.ReadOnly);
end;

{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
{ TRMMemoControl }

constructor TRMMemoControl.Create;
begin
  inherited Create;
  FMemo := TMemo.Create(nil);
  FMemo.Parent := RMDialogForm;
  FMemo.Text := 'Memo';
  AssignControl(FMemo);
  BaseName := 'Memo';
  dx := 185; dy := 89;
end;

destructor TRMMemoControl.Destroy;
begin
  FMemo.Free;
  inherited Destroy;
end;

procedure TRMMemoControl.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('Lines', [RMdtHasEditor, RMdtOneObject], LinesEditor);
  AddProperty('Lines.Count', [], nil);
  AddProperty('ReadOnly', [RMdtBoolean], nil);
  AddProperty('Text', [], nil);
end;

procedure TRMMemoControl.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'READONLY' then
    FMemo.ReadOnly := Value
  else if Index = 'TEXT' then
    FMemo.Text := Value;
end;

function TRMMemoControl.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'READONLY' then
    Result := FMemo.ReadOnly
  else if Index = 'LINES.COUNT' then
    Result := FMemo.Lines.Count
  else if Index = 'TEXT' then
    Result := FMemo.Text
end;

function TRMMemoControl.DoMethod(const MethodName: string; Par1, Par2, Par3: Variant): Variant;
begin
  Result := inherited DoMethod(MethodName, Par1, Par2, Par3);
  if Result = Null then
    Result := LinesMethod(FMemo.Lines, MethodName, 'LINES', Par1, Par2, Par3);
end;

procedure TRMMemoControl.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FMemo.Text := RMReadString(Stream);
  FMemo.ReadOnly := RMReadBoolean(Stream);
end;

procedure TRMMemoControl.SaveToStream(Stream: TStream);
begin
  LVersion := 0;
  inherited SaveToStream(Stream);
  RMWriteString(Stream, FMemo.Text);
  RMWriteBoolean(Stream, FMemo.ReadOnly);
end;

procedure TRMMemoControl.LinesEditor(Sender: TObject);
begin
  with TRMLinesEditorForm.Create(nil) do
  begin
    M1.Text := FMemo.Text;
    if (ShowModal = mrOk) and ((Restrictions and RMrfDontModify) = 0) then
    begin
      RMDesigner.BeforeChange;
      FMemo.Text := M1.Text;
      RMDesigner.AfterChange;
    end;
    Free;
  end;
end;

{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
{ TRMButtonControl }

constructor TRMButtonControl.Create;
begin
  inherited Create;
  FButton := TButton.Create(nil);
  FButton.Parent := RMDialogForm;
  FButton.Caption := 'Button';
  AssignControl(FButton);
  BaseName := 'Button';
  dx := 75; dy := 25;
end;

destructor TRMButtonControl.Destroy;
begin
  FButton.Free;
  inherited Destroy;
end;

procedure TRMButtonControl.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('Cancel', [], nil);
  AddProperty('Caption', [RMdtString], nil);
  AddProperty('Default', [], nil);
  AddEnumProperty('ModalResult',
    'mrNone;mrOk;mrCancel',
    [mrNone, mrOk, mrCancel]);
end;

procedure TRMButtonControl.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'CAPTION' then
    FButton.Caption := Value
  else if Index = 'MODALRESULT' then
  begin
    FButton.ModalResult := Value;
    FButton.Cancel := FButton.ModalResult = mrCancel;
    FButton.Default := FButton.ModalResult = mrOk;
  end
  else if Index = 'CANCEL' then
    FButton.Cancel := Value
  else if Index = 'DEFAULT' then
    FButton.Default := Value
end;

function TRMButtonControl.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'CAPTION' then
    Result := FButton.Caption
  else if Index = 'MODALRESULT' then
    Result := FButton.ModalResult
  else if Index = 'CANCEL' then
    Result := FButton.Cancel
  else if Index = 'DEFAULT' then
    Result := FButton.Default
end;

procedure TRMButtonControl.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FButton.Caption := RMReadString(Stream);
  FButton.ModalResult := RMReadWord(Stream);
  FButton.Cancel := FButton.ModalResult = mrCancel;
  FButton.Default := FButton.ModalResult = mrOk;
end;

procedure TRMButtonControl.SaveToStream(Stream: TStream);
begin
  LVersion := 0;
  inherited SaveToStream(Stream);
  RMWriteString(Stream, FButton.Caption);
  RMWriteWord(Stream, FButton.ModalResult);
end;

{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
{ TRMCheckBoxControl }

constructor TRMCheckBoxControl.Create;
begin
  inherited Create;
  FCheckBox := TCheckBox.Create(nil);
  FCheckBox.Parent := RMDialogForm;
  FCheckBox.Caption := 'CheckBox';
  AssignControl(FCheckBox);
  BaseName := 'CheckBox';
  dx := 97; dy := 17;
end;

destructor TRMCheckBoxControl.Destroy;
begin
  FCheckBox.Free;
  inherited Destroy;
end;

procedure TRMCheckBoxControl.DefineProperties;
begin
  inherited DefineProperties;
  AddEnumProperty('Alignment',
    'taLeftJustify;taRightJustify',
    [taLeftJustify, taRightJustify]);
  AddProperty('Checked', [RMdtBoolean], nil);
  AddProperty('Caption', [RMdtString], nil);
end;

procedure TRMCheckBoxControl.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'ALIGNMENT' then
    FCheckBox.Alignment := Value
  else if Index = 'CHECKED' then
    FCheckBox.Checked := Value
  else if Index = 'CAPTION' then
    FCheckBox.Caption := Value
end;

function TRMCheckBoxControl.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'ALIGNMENT' then
    Result := FCheckBox.Alignment
  else if Index = 'CHECKED' then
    Result := FCheckBox.Checked
  else if Index = 'CAPTION' then
    Result := FCheckBox.Caption
end;

procedure TRMCheckBoxControl.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FCheckBox.Alignment := TAlignment(RMReadByte(Stream));
  FCheckBox.Checked := RMReadBoolean(Stream);
  FCheckBox.Caption := RMReadString(Stream);
end;

procedure TRMCheckBoxControl.SaveToStream(Stream: TStream);
begin
  LVersion := 0;
  inherited SaveToStream(Stream);
  RMWriteByte(Stream, Byte(FCheckBox.Alignment));
  RMWriteBoolean(Stream, FCheckBox.Checked);
  RMWriteString(Stream, FCheckBox.Caption);
end;

{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
{ TRMRadioButtonControl }

constructor TRMRadioButtonControl.Create;
begin
  inherited Create;
  FRadioButton := TRadioButton.Create(nil);
  FRadioButton.Parent := RMDialogForm;
  FRadioButton.Caption := 'RadioButton';
  AssignControl(FRadioButton);
  BaseName := 'RadioButton';
  dx := 113; dy := 17;
end;