rm_ole.pas

这是一个功能强大

    end;
    ShowFrame;
    RestoreCoord;
  finally
    Windows.SelectClipRgn(aCanvas.Handle, 0);
  end;
end;

procedure TRMOLEView.LoadFromStream(aStream: TStream);
var
  b: Byte;
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  SizeMode := TSizeMode(RMReadByte(aStream));
  FPrintType := TRMPrintMethodType(RMReadByte(aStream));
  b := RMReadByte(aStream);
  if b = 1 then
    FOleContainer.LoadFromStream(aStream);
end;

procedure TRMOLEView.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteByte(aStream, Byte(SizeMode));
  RMWriteByte(aStream, Byte(FPrintType));
  if FOleContainer.OleObjectInterface <> nil then
  begin
    RMWriteByte(aStream, 1);
    FOleContainer.SaveToStream(aStream);
  end
  else
    RMWriteByte(aStream, 0);
end;

procedure TRMOLEView.GetBlob;
var
  lStream: TMemoryStream;
begin
  if ParentReport.Flag_TableEmpty or FDataSet.FieldIsNull(FDataFieldName) then
  begin
    FOleContainer.DestroyObject;
    Exit;
  end;

  lStream := TMemoryStream.Create;
  try
    FDataSet.AssignBlobFieldTo(FDataFieldName, lStream);
    FOleContainer.LoadFromStream(lStream);
  finally
    lStream.Free;
  end;
end;

procedure TRMOLEView.DefinePopupMenu(Popup: TRMCustomMenuItem);
begin
end;

procedure TRMOLEView.ShowEditor;
var
  tmpForm: TRMOleForm;
begin
  tmpForm := TRMOleForm.Create(Application);
  try
    AssignOle(tmpForm.OleContainer1, FOleContainer);
    if tmpForm.ShowModal = mrOK then
    begin
      RMDesigner.BeforeChange;
      AssignOle(FOleContainer, tmpForm.OleContainer1);
      tmpForm.OleContainer1.DestroyObject;
      RMDesigner.AfterChange;
    end;
  finally
    tmpForm.Free;
  end;
end;

function TRMOleView.GetSizeMode: TSizeMode;
begin
  Result := FOleContainer.SizeMode;
end;

procedure TRMOleView.LoadFromOle(aOle: TOleContainer);
begin
  AssignOle(FOleContainer, aOle);
end;

procedure TRMOleView.SetSizeMode(Value: TSizeMode);
begin
  FOleContainer.SizeMode := Value;
end;

function TRMOleView.GetDirectDraw: Boolean;
begin
  Result := (FFlags and flOleDirectDraw) = flOleDirectDraw;
end;

procedure TRMOleView.SetDirectDraw(Value: Boolean);
begin
  FFlags := (FFlags and not flOleDirectDraw);
  if Value then
    FFlags := FFlags + flOleDirectDraw;
end;

function TRMOleView.GetViewCommon: string;
begin
  Result := '[Ole]';
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMOLEForm}

procedure TRMOleForm.Localize;
begin
  Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  RMSetStrProp(Self, 'Caption', rmRes + 550);
  RMSetStrProp(btnInsert, 'Caption', rmRes + 551);
  RMSetStrProp(btnEdit, 'Caption', rmRes + 552);
  RMSetStrProp(ItmInsertObject, 'Caption', rmRes + 554);
  RMSetStrProp(ItmObjectProp, 'Caption', rmRes + 558);

  btnOk.Caption := RMLoadStr(rmRes + 553);
end;

procedure TRMOleForm.btnInsertClick(Sender: TObject);
begin
  with OleContainer1 do
  begin
    Screen.Cursor := crHourGlass;
    try
      if InsertObjectDialog then
        DoVerb(PrimaryVerb);
    finally
      Screen.Cursor := crDefault;
    end;
  end;
end;

procedure TRMOleForm.btnEditClick(Sender: TObject);
begin
  if OleContainer1.OleObjectInterface <> nil then
    OleContainer1.DoVerb(ovPrimary);
end;

type
  THackOleContainer = class(TOleContainer)
  end;

procedure TRMOleForm.PopupVerbMenuClick(Sender: TObject);
begin
  OleContainer1.DoVerb((Sender as TMenuItem).Tag);
end;

procedure TRMOleForm.OnCopyObject(Sender: TObject);
begin
  OleContainer1.Copy;
end;

procedure TRMOleForm.OnDeleteObject(Sender: TObject);
begin
  OleContainer1.DestroyObject;
end;

procedure TRMOleForm.OnPasteObject(Sender: TObject);
begin
  OleContainer1.PasteSpecialDialog;
end;

procedure TRMOleForm.OnEditObjectProp(Sender: TObject);
begin
  OleContainer1.ObjectPropertiesDialog;
end;

procedure TRMOleForm.PopupMenu1Popup(Sender: TObject);
var
  I: Integer;
  Item: TMenuItem;
begin
  while PopupMenu1.Items.Count > 0 do
    PopupMenu1.Items.Delete(0);
  with OleContainer1 do
  begin
    if (OleObjectInterface <> nil) and (ObjectVerbs.Count > 0) then
    begin
      for I := 0 to ObjectVerbs.Count - 1 do
      begin
        Item := TMenuItem.Create(Self);
        Item.Caption := ObjectVerbs[I];
        Item.Tag := I;
        Item.OnClick := PopupVerbMenuClick;
        PopupMenu1.Items.Add(Item);
      end;
      Item := TMenuItem.Create(Self);
      Item.Caption := '-';
      PopupMenu1.Items.Add(Item);
    end;

    Item := TMenuItem.Create(Self);
    RMSetStrProp(Item, 'Caption', rmRes + 554);
    Item.OnClick := btnInsertClick;
    PopupMenu1.Items.Add(Item);

    if CanPaste then
    begin
      Item := TMenuItem.Create(Self);
      RMSetStrProp(Item, 'Caption', rmRes + 555);
      Item.OnClick := onPasteObject;
      PopupMenu1.Items.Add(Item);
    end;
    if OleObjectInterface <> nil then
    begin
      Item := TMenuItem.Create(Self);
      RMSetStrProp(Item, 'Caption', rmRes + 556);
      Item.OnClick := OnCopyObject;
      PopupMenu1.Items.Add(Item);

      Item := TMenuItem.Create(Self);
      RMSetStrProp(Item, 'Caption', rmRes + 557);
      Item.OnClick := OnDeleteObject;
      PopupMenu1.Items.Add(Item);

      Item := TMenuItem.Create(Self);
      RMSetStrProp(Item, 'Caption', rmRes + 558);
      Item.OnClick := OnEditObjectProp;
      PopupMenu1.Items.Add(Item);
    end;
  end;
end;

procedure TRMOleForm.FormCreate(Sender: TObject);
begin
  Localize;
end;

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

procedure TRMOleView_LoadFromOle(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TRMOleView(Args.Obj).LoadFromOle(TOleContainer(V2O(Args.Values[0])));
end;

procedure TRMPictureView_LoadFromFile(var Value: Variant; Args: TJvInterpreterArgs);
var
  lFileName: string;
begin
  lFileName := Args.Values[0];
  if (lFileName <> '') and FileExists(lFileName) then
    TRMOleView(Args.Obj).OleContainer.CreateObjectFromFile(ExpandFileName(lFileName), False)
  else
    TRMOleView(Args.Obj).OleContainer.DestroyObject;
end;

procedure TOleContainer_LoadFromFile(var Value: Variant; Args: TJvInterpreterArgs);
var
  lFileName: string;
begin
  lFileName := Args.Values[0];
  if (lFileName <> '') and FileExists(lFileName) then
    TOleContainer(Args.Obj).LoadFromFile(ExpandFileName(lFileName))
  else
    TOleContainer(Args.Obj).DestroyObject;
end;

procedure RM_RegisterRAI2Adapter(RAI2Adapter: TJvInterpreterAdapter);
begin
  with RAI2Adapter do
  begin
    AddClass('ReportMachine', TOleContainer, 'TOleContainer');
    AddClass('ReportMachine', TRMOLEView, 'TRMOLEView');

    // TSizeMode
    AddConst('ReportMachine', 'smClip', smClip);
    AddConst('ReportMachine', 'smCenter', smCenter);
    AddConst('ReportMachine', 'smScale', smScale);
    AddConst('ReportMachine', 'smStretch', smStretch);
    AddConst('ReportMachine', 'smAutoSize', smAutoSize);

    AddGet(TRMOleView, 'LoadFromOle', TRMOleView_LoadFromOle, 1, [0], varEmpty);
    AddGet(TRMOleView, 'LoadFromFile', TRMPictureView_LoadFromFile, 1, [0], varEmpty);
    AddGet(TRMOleView, 'Assign', TRMOleView_LoadFromOle, 1, [0], varEmpty);
    //AddGet(TRMOleView, 'AssignBlobFieldName', TRMPictureView_AssignBlobFieldName, 1, [0], varEmpty);

    AddGet(TOleContainer, 'LoadFromFile', TOleContainer_LoadFromFile, 1, [0], varEmpty);
  end;
end;

initialization
  RMRegisterObjectByRes(TRMOLEView, 'RM_OLEObject', RMLoadStr(SInsOLEObject), TRMOleForm);

  RM_RegisterRAI2Adapter(GlobalJvInterpreterAdapter);

finalization

end.