rm_dialogctls.pas

这是一个功能强大

procedure TRMPanelControl.SetCaption(Value: string);
begin
  FPanel.Caption := Value;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMGroupBoxControl }

class procedure TRMGroupBoxControl.DefaultSize(var aKx, aKy: Integer);
begin
  aKx := 185;
  aKy := 105;
end;

constructor TRMGroupBoxControl.Create;
begin
  inherited Create;
  BaseName := 'GroupBox';

  FGroupBox := TGroupBox.Create(nil);
  FGroupBox.Parent := RMDialogForm;

  AssignControl(FGroupBox);
end;

destructor TRMGroupBoxControl.Destroy;
begin
  FreeChildViews;
  FreeAndNil(FGroupBox);
  inherited Destroy;
end;

function TRMGroupBoxControl.IsContainer: Boolean;
begin
  Result := True;
end;

function TRMGroupBoxControl.GetPropValue(aObject: TObject; aPropName: string; var aValue: Variant;
  Args: array of Variant): Boolean;
begin
  Result := True;
  if aPropName = 'GROUPBOX' then
    aValue := O2V(FGroupBox)
  else
    Result := inherited GetPropValue(aObject, aPropName, aValue, Args);
end;

procedure TRMGroupBoxControl.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  Caption := RMReadString(aStream);
end;

procedure TRMGroupBoxControl.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteString(aStream, Caption);
end;

function TRMGroupBoxControl.GetCaption: string;
begin
  Result := FGroupBox.Caption;
end;

procedure TRMGroupBoxControl.SetCaption(Value: string);
begin
  FGroupBox.Caption := Value;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMImageControl }

class procedure TRMImageControl.DefaultSize(var aKx, aKy: Integer);
begin
  aKx := 105;
  aKy := 105;
end;

constructor TRMImageControl.Create;
begin
  inherited Create;
  BaseName := 'Image';

  FImage := TImage.Create(nil);
  FImage.Parent := RMDialogForm;

  AssignControl(FImage);
end;

destructor TRMImageControl.Destroy;
begin
  FreeAndNil(FImage);
  inherited Destroy;
end;

function TRMImageControl.GetPropValue(aObject: TObject; aPropName: string; var aValue: Variant;
  Args: array of Variant): Boolean;
begin
  Result := True;
  if aPropName = 'IMAGE' then
    aValue := O2V(FImage)
  else
    Result := inherited GetPropValue(aObject, aPropName, aValue, Args);
end;

procedure TRMImageControl.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  AutoSize := RMReadBoolean(aStream);
  Center := RMReadBoolean(aStream);
  Stretch := RMReadBoolean(aStream);
  Transparent := RMReadBoolean(aStream);
  RMLoadPicture(aStream, Picture);
end;

procedure TRMImageControl.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteBoolean(aStream, AutoSize);
  RMWriteBoolean(aStream, Center);
  RMWriteBoolean(aStream, Stretch);
  RMWriteBoolean(aStream, Transparent);
  RMWritePicture(aStream, Picture);
end;

function TRMImageControl.GetPicture: TPicture;
begin
  Result := FImage.Picture;
end;

procedure TRMImageControl.SetPicture(Value: TPicture);
begin
  FImage.Picture.Assign(Value);
end;

function TRMImageControl.GetAutoSize(Index: Integer): Boolean;
begin
  case Index of
    0: Result := FImage.AutoSize;
    1: Result := FImage.Center;
    2: Result := FImage.Stretch;
    4: Result := FImage.Transparent;
  else
    Result := False;
  end;
end;

procedure TRMImageControl.SetAutoSize(Index: Integer; Value: Boolean);
begin
  case Index of
    0: FImage.AutoSize := Value;
    1: FImage.Center := Value;
    2: FImage.Stretch := Value;
    4: FImage.Transparent := Value;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMBevelControl }

class procedure TRMBevelControl.DefaultSize(var aKx, aKy: Integer);
begin
  aKx := 50;
  aKy := 50;
end;

constructor TRMBevelControl.Create;
begin
  inherited Create;
  BaseName := 'Bevel';

  FBevel := TBevel.Create(nil);
  FBevel.Parent := RMDialogForm;

  AssignControl(FBevel);
end;

destructor TRMBevelControl.Destroy;
begin
  FreeAndNil(FBevel);
  inherited Destroy;
end;

function TRMBevelControl.GetPropValue(aObject: TObject; aPropName: string; var aValue: Variant;
  Args: array of Variant): Boolean;
begin
  Result := True;
  if aPropName = 'BEVEL' then
    aValue := O2V(FBevel)
  else
    Result := inherited GetPropValue(aObject, aPropName, aValue, Args);
end;

procedure TRMBevelControl.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
end;

procedure TRMBevelControl.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
end;

{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
{ TRMSpeedButtonControl }

class procedure TRMSpeedButtonControl.DefaultSize(var aKx, aKy: Integer);
begin
  aKx := 23;
  aKy := 22;
end;

constructor TRMSpeedButtonControl.Create;
begin
  inherited Create;
  BaseName := 'SpeedButton';

  FSpeedButton := TSpeedButton.Create(nil);
  FSpeedButton.Parent := RMDialogForm;
  AssignControl(FSpeedButton);
end;

destructor TRMSpeedButtonControl.Destroy;
begin
  FreeAndNil(FSpeedButton);
  inherited Destroy;
end;

procedure TRMSpeedButtonControl.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  Caption := RMReadString(aStream);
end;

procedure TRMSpeedButtonControl.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteString(aStream, Caption);
end;

function TRMSpeedButtonControl.GetCaption: string;
begin
  Result := FSpeedButton.Caption;
end;

procedure TRMSpeedButtonControl.SetCaption(Value: string);
begin
  FSpeedButton.Caption := Value;
end;

{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
{ TRMBitBtnControl }

class procedure TRMBitBtnControl.DefaultSize(var aKx, aKy: Integer);
begin
  aKx := 75;
  aKy := 25;
end;

constructor TRMBitBtnControl.Create;
begin
  inherited Create;
  BaseName := 'BitBtn';

  FBitBtn := TBitBtn.Create(nil);
  FBitBtn.Parent := RMDialogForm;
  FBitBtn.Caption := 'Button';
  AssignControl(FBitBtn);
end;

destructor TRMBitBtnControl.Destroy;
begin
  FreeAndNil(FBitBtn);
  inherited Destroy;
end;

procedure TRMBitBtnControl.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  Caption := RMReadString(aStream);
  ModalResult := RMReadWord(aStream);
  Cancel := RMReadBoolean(aStream);
  Default := RMReadBoolean(aStream);
  Kind := TBitBtnKind(RMReadByte(aStream));
  Layout := TButtonLayout(RMReadByte(aStream));
  NumGlyphs := RMReadInt32(aStream);
  Spacing := RMReadInt32(aStream);
  RMLoadBitmap(aStream, Glyph);
end;

procedure TRMBitBtnControl.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteString(aStream, Caption);
  RMWriteWord(aStream, ModalResult);
  RMWriteBoolean(aStream, Cancel);
  RMWriteBoolean(aStream, Default);
  RMWriteByte(aStream, Byte(Kind));
  RMWriteByte(aStream, Byte(Layout));
  RMWriteInt32(aStream, NumGlyphs);
  RMWriteInt32(aStream, Spacing);
  RMSaveBitmap(aStream, Glyph);
end;

function TRMBitBtnControl.GetCaption: string;
begin
  Result := FBitBtn.Caption;
end;

procedure TRMBitBtnControl.SetCaption(Value: string);
begin
  FBitBtn.Caption := Value;
end;

function TRMBitBtnControl.GetCancel: Boolean;
begin
  Result := FBitBtn.Cancel;
end;

procedure TRMBitBtnControl.SetCancel(Value: Boolean);
begin
  FBitBtn.Cancel := Value;
end;

function TRMBitBtnControl.GetDefault: Boolean;
begin
  Result := FBitBtn.Default;
end;

procedure TRMBitBtnControl.SetDefault(Value: Boolean);
begin
  FBitBtn.Default := Value;
end;

function TRMBitBtnControl.GetModalResult: TModalResult;
begin
  Result := FBitBtn.ModalResult;
end;

procedure TRMBitBtnControl.SetModalResult(Value: TModalResult);
begin
  FBitBtn.ModalResult := Value;
end;

function TRMBitBtnControl.GetGlyph: TBitmap;
begin
  Result := FBitBtn.Glyph;
end;

procedure TRMBitBtnControl.SetGlyph(Value: TBitmap);
begin
  FBitBtn.Glyph.Assign(Value);
end;

function TRMBitBtnControl.GetKind: TBitBtnKind;
begin
  Result := FBitBtn.Kind;
end;

procedure TRMBitBtnControl.SetKind(Value: TBitBtnKind);
begin
  FBitBtn.Kind := Value;
end;

function TRMBitBtnControl.GetLayout: TButtonLayout;
begin
  Result := FBitBtn.Layout;
end;

procedure TRMBitBtnControl.SetLayout(Value: TButtonLayout);
begin
  FBitBtn.Layout := Value;
end;

function TRMBitBtnControl.GetNumGlyphs: Integer;
begin
  Result := FBitBtn.NumGlyphs;
end;

procedure TRMBitBtnControl.SetNumGlyphs(Value: Integer);
begin
  FBitBtn.NumGlyphs := Value;
end;

function TRMBitBtnControl.GetSpacing: Integer;
begin
  Result := FBitBtn.Spacing;
end;

procedure TRMBitBtnControl.SetSpacing(Value: Integer);
begin
  FBitBtn.Spacing := Value;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

procedure TRMCheckListBox_Read_Checked(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TRMCheckListBoxControl(Args.Obj).CheckListBox.Checked[Args.Values[0]];
end;

procedure TRMCheckListBox_Write_Checked(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TRMCheckListBoxControl(Args.Obj).CheckListBox.Checked[Args.Values[0]] := Value;
end;

procedure TCheckListBox_Create(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(TCheckListBox.Create(V2O(Args.Values[0]) as TComponent));
end;

procedure TCheckListBox_Read_Checked(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TCheckListBox(Args.Obj).Checked[Args.Values[0]];
end;

procedure TCheckListBox_Write_Checked(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TCheckListBox(Args.Obj).Checked[Args.Values[0]] := Value;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

const
	cReportMachine = 'RM_DialogCtls';

procedure RM_RegisterRAI2Adapter(RAI2Adapter: TJvInterpreterAdapter);
begin
  with RAI2Adapter do
  begin
    AddClass('CheckLst', TCheckListBox, 'TCheckListBox');
    AddGet(TCheckListBox, 'Create', TCheckListBox_Create, 1, [varEmpty], varEmpty);
    AddIGet(TCheckListBox, 'Checked', TCheckListBox_Read_Checked, 1, [0], varEmpty);
    AddISet(TCheckListBox, 'Checked', TCheckListBox_Write_Checked, 1, [1]);

    AddClass(cReportMachine, TRMCustomControl, 'TRMCustomControl');
    AddClass(cReportMachine, TRMLabelControl, 'TRMLabelControl');
    AddClass(cReportMachine, TRMEditControl, 'TRMEditControl');
    AddClass(cReportMachine, TRMMemoControl, 'TRMMemoControl');
    AddClass(cReportMachine, TRMButtonControl, 'TRMButtonControl');
    AddClass(cReportMachine, TRMCheckBoxControl, 'TRMCheckBoxControl');
    AddClass(cReportMachine, TRMRadioButtonControl, 'TRMRadioButtonControl');
    AddClass(cReportMachine, TRMListBoxControl, 'TRMListBoxControl');
    AddClass(cReportMachine, TRMDateEditControl, 'TRMDateEditControl');
    {$IFDEF JVCLCTLS}
    AddClass(cReportMachine, TRMRXDateEditControl, 'TRMRXDateEditControl');
    {$ENDIF}
    AddClass(cReportMachine, TRMCheckListBoxControl, 'TRMCheckListBoxControl');
    AddClass(cReportMachine, TRMPanelControl, 'TRMPanelControl');
    AddClass(cReportMachine, TRMGroupBoxControl, 'TRMGroupBoxControl');
    AddClass(cReportMachine, TRMImageControl, 'TRMImageControl');
    AddClass(cReportMachine, TRMBevelControl, 'TRMBevelControl');
    AddClass(cReportMachine, TRMSpeedButtonControl, 'TRMSpeedButtonControl');
    AddClass(cReportMachine, TRMBitBtnControl, 'TRMBitBtnControl');

    AddIGet(TRMCh