rm_rxrtf.pas.~2~

胜天进销存源码,国产优秀的进销存

    EMFCanvas.Free;
    if DocMode <> dmDesigning then
      Canvas.StretchDraw(DRect, EMF)
    else
    begin
      BMP := TBitmap.Create;
      BMP.Width := DRect.Right - DRect.Left + 1;
      BMP.Height := DRect.Bottom - DRect.Top + 1;
      BMP.Canvas.StretchDraw(Rect(0, 0, BMP.Width, BMP.Height), EMF);
      Canvas.Draw(DRect.Left, DRect.Top, BMP);
      BMP.Free;
    end;
    EMF.Free;
  end;
end;
{$WARNINGS ON}

procedure TRMRxRichView.Draw(aCanvas: TCanvas);
begin
  BeginDraw(aCanvas);
  CalcGaps;
  with aCanvas do
  begin
    ShowBackground;
    FCharFrom := 0;
    InflateRect(DRect, -gapx, -gapy);
    if (dx > 0) and (dy > 0) then
      ShowRich(True);
    ShowFrame;
  end;
  RestoreCoord;
end;

procedure TRMRxRichView.StreamOut(Stream: TStream);
var
  SaveTag: string;
  n: integer;
begin
  BeginDraw(Canvas);
  Memo1.Assign(Memo);
  CurReport.InternalOnEnterRect(Memo1, Self);
  RMInterpretator.DoScript(Script);
  if not Visible then
    Exit;

  SaveTag := Tag;
  if (Tag <> '') and (Pos('[', Tag) <> 0) then
    ExpandVariables(Tag);

  AssignRich(SRichEdit, RichEdit);
  if (Flags and flTextOnly) = 0 then
    GetRichData(SRichEdit);

  if DrawMode = drPart then
  begin
    FCharFrom := FLastChar;
    ShowRich(False);
    n := SRichEdit.GetTextLen - FLastChar + 1;
    if n > 0 then
    begin
      SRichEdit.SelStart := FLastChar;
      SRichEdit.SelLength := n;
      SRichEdit.SelText := '';
    end;

    SRichEdit.SelStart := 0;
    SRichEdit.SelLength := FCurChar;
    SRichEdit.SelText := '';

    FCurChar := FLastChar;
  end;

  Stream.Write(Typ, 1);
  RMWriteString(Stream, ClassName);
  FFlag := True;
  SaveToStream(Stream);
  FFlag := False;

  RMInterpretator.DoScript(Script_AfterPrint);
  Tag := SaveTag;
end;

function TRMRxRichView.CalcHeight: Integer;
begin
  FLastChar := 0;
  FCurChar := 0;
  Result := 0;
  RMInterpretator.DoScript(Script);
  if not Visible then
    Exit;

  Memo1.Assign(Memo);
  CurReport.InternalOnEnterRect(Memo1, Self);
  AssignRich(SRichEdit, RichEdit);
  if (Flags and flTextOnly) = 0 then
    GetRichData(SRichEdit);

  RMInterpretator.DoScript(Script_AfterPrint);
  FCharFrom := 0;
  Result := DoCalcHeight + GapY + GapY + _CalcVFrameWidth(TopFrame.Width, BottomFrame.Width);
end;

function TRMRxRichView.MinHeight: Integer;
begin
  Result := 8;
end;

function TRMRxRichView.LostSpace: Integer;
var
  n, lc, cc: Integer;
begin
  AssignRich(SRichEdit, RichEdit);
  if (Flags and flTextOnly) = 0 then
    GetRichData(SRichEdit);

  lc := FLastChar;
  cc := FCurChar;
  FCharFrom := 0;

  SRichEdit.SelStart := 0;
  SRichEdit.SelLength := FLastChar;
  SRichEdit.SelText := '';

  ShowRich(False);
  n := SRichEdit.GetTextLen - FLastChar + 1;
  if n > 0 then
  begin
    SRichEdit.SelStart := FLastChar;
    SRichEdit.SelLength := n;
    SRichEdit.SelText := '';
  end;

  FCharFrom := 0;
//  Result := Round(Abs(dy - DoCalcHeight)) + gapy * 2 + Round(FrameWidth * 2);
  Result := 0;
  FLastChar := lc;
  FCurChar := cc;
end;

function TRMRxRichView.RemainHeight: Integer;
begin
  Memo1.Assign(Memo);
  CurReport.InternalOnEnterRect(Memo1, Self);
  AssignRich(SRichEdit, RichEdit);
  if (Flags and flTextOnly) = 0 then
    GetRichData(SRichEdit);

  FCharFrom := FLastChar;
  Result := DoCalcHeight;
end;

procedure TRMRxRichView.LoadFromStream(Stream: TStream);
var
  b: Byte;
  n: Integer;
begin
  inherited LoadFromStream(Stream);
  Stream.Read(b, 1);
  Stream.Read(n, 4);
  if b <> 0 then
    RichEdit.Lines.LoadFromStream(Stream);
  Stream.Seek(n, soFromBeginning);
end;

procedure TRMRxRichView.SaveToStream(Stream: TStream);
var
  b: Byte;
  n, o: Integer;
  re: TRxRichEdit;
begin
  LVersion := 0;
  inherited SaveToStream(Stream);
  re := RichEdit;
  if FFlag then
    re := SRichEdit;
  b := 0;
  if re.Lines.Count <> 0 then
    b := 1;
  Stream.Write(b, 1);
  n := Stream.Position;
  Stream.Write(n, 4);
  if b <> 0 then
    re.Lines.SaveToStream(Stream);
  o := Stream.Position;
  Stream.Seek(n, soFromBeginning);
  Stream.Write(o, 4);
  Stream.Seek(0, soFromEnd);
end;

procedure TRMRxRichView.GetBlob(b: TField);
var
  s: TMemoryStream;
begin
  s := TMemoryStream.Create;
  if not Flag_TableEmpty then
    RMAssignBlobTo(b, s);
  RichEdit.Lines.LoadFromStream(s);
  s.Free;
end;

procedure TRMRxRichView.ShowEditor;
var
  tmpForm: TRMRxRichForm;
begin
  tmpForm := TRMRxRichForm.Create(Application);
  try
    AssignRich(tmpForm.Editor, RichEdit);
    if tmpForm.ShowModal = mrOK then
    begin
      RMDesigner.BeforeChange;
      AssignRich(RichEdit, tmpForm.Editor);
      RMDesigner.AfterChange;
    end;
  finally
    tmpForm.Free;
  end;
end;

procedure TRMRxRichView.RichEditor(Sender: TObject);
begin
  ShowEditor;
end;

procedure TRMRxRichView.DefinePopupMenu(Popup: TPopupMenu);
var
  m: TMenuItem;
begin
  inherited DefinePopupMenu(Popup);
  m := TMenuItem.Create(Popup);
  m.Caption := RMLoadStr(STextOnly);
  m.OnClick := P1Click;
  m.Checked := (Flags and flTextOnly) <> 0;
  Popup.Items.Add(m);
end;

procedure TRMRxRichView.P1Click(Sender: TObject);
var
  i: Integer;
  t: TRMView;
begin
  RMDesigner.BeforeChange;
  with Sender as TMenuItem do
  begin
    Checked := not Checked;
    for i := 0 to RMDesigner.Page.Objects.Count - 1 do
    begin
      t := RMDesigner.Page.Objects[i];
      if t.Selected then
        t.Flags := (t.Flags and not flTextOnly) + Word(Checked) * flTextOnly;
    end;
  end;
  RMDesigner.AfterChange;
end;

function TRMRxRichView.GetViewCommon: string;
begin
  Result := '[Rx Rich]';
end;

procedure TRMRxRichView.LoadFromRichEdit(aRichEdit: TRxRichEdit);
begin
  AssignRich(RichEdit, aRichEdit);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMRxRichForm}

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

//  Caption := RMLoadStr(rmRes + 560);
  RMSetStrProp(btnFileNew, 'Hint', rmRes + 155);
  RMSetStrProp(btnFileOpen, 'Hint', rmRes + 561);
  RMSetStrProp(btnFileSave, 'Hint', rmRes + 562);
  RMSetStrProp(btnUndo, 'Hint', rmRes + 94);
  RMSetStrProp(btnRedo, 'Hint', rmRes + 95);
  RMSetStrProp(btnFind, 'Hint', rmRes + 582);
  RMSetStrProp(btnFontBold, 'Hint', rmRes + 564);
  RMSetStrProp(btnFontItalic, 'Hint', rmRes + 565);
  RMSetStrProp(btnFontUnderline, 'Hint', rmRes + 569);
  RMSetStrProp(btnAlignLeft, 'Hint', rmRes + 566);
  RMSetStrProp(btnAlignCenter, 'Hint', rmRes + 567);
  RMSetStrProp(btnAlignRight, 'Hint', rmRes + 568);
  RMSetStrProp(btnBullets, 'Hint', rmRes + 570);
  RMSetStrProp(btnInsertField, 'Hint', rmRes + 575);
  RMSetStrProp(btnCut, 'Hint', rmRes + 91);
  RMSetStrProp(btnCopy, 'Hint', rmRes + 92);
  RMSetStrProp(btnPaste, 'Hint', rmRes + 93);
  RMSetStrProp(btnSuperscript, 'Hint', rmRes + 580);
  RMSetStrProp(btnSubscript, 'Hint', rmRes + 581);

  ItmCut.Caption := btnCut.Hint;
  ItmCopy.Caption := btnCopy.Hint;
  ItmPaste.Caption := btnPaste.Hint;
  RMSetStrProp(MenuFile, 'Caption', rmRes + 154);
  RMSetStrProp(ItemFileNew, 'Caption', rmRes + 155);
  RMSetStrProp(ItemFileOpen, 'Caption', rmRes + 156);
  RMSetStrProp(ItemFileSaveAs, 'Caption', rmRes + 188);
  RMSetStrProp(ItemFilePrint, 'Caption', rmRes + 159);
  RMSetStrProp(ItemFileExit, 'Caption', rmRes + 162);
  RMSetStrProp(MenuEdit, 'Caption', rmRes + 163);
  RMSetStrProp(ItemEditUndo, 'Caption', rmRes + 164);
  RMSetStrProp(ItemEditRedo, 'Caption', rmRes + 165);
  RMSetStrProp(ItemEditCut, 'Caption', rmRes + 166);
  RMSetStrProp(ItemEditCopy, 'Caption', rmRes + 167);
  RMSetStrProp(ItemEditPaste, 'Caption', rmRes + 168);
  RMSetStrProp(ItemEditPasteSpecial, 'Caption', rmRes + 572);
  RMSetStrProp(ItemEditSelectAll, 'Caption', rmRes + 170);
  RMSetStrProp(ItemEditFind, 'Caption', rmRes + 582);
  RMSetStrProp(ItemEditFindNext, 'Caption', rmRes + 583);
  RMSetStrProp(ItemEditReplace, 'Caption', rmRes + 584);
  RMSetStrProp(ItemEditObjProps, 'Caption', rmRes + 585);
  RMSetStrProp(MenuInsert, 'Caption', rmRes + 586);
  RMSetStrProp(ItemInserObject, 'Caption', rmRes + 587);
  RMSetStrProp(ItemInsertPicture, 'Caption', rmRes + 588);
  RMSetStrProp(ItemInsertField, 'Caption', rmRes + 575);
  RMSetStrProp(MenuFormat, 'Caption', rmRes + 589);
  RMSetStrProp(ItemFormatFont, 'Caption', rmRes + 576);
  RMSetStrProp(ItemFormatParagraph, 'Caption', rmRes + 852);

  btnOK.Hint := RMLoadStr(rmRes + 573);
  btnCancel.Hint := RMLoadStr(rmRes + 574);
end;

procedure TRMRxRichForm.FocusEditor;
begin
  with Editor do
  begin
    if CanFocus then
      SetFocus;
  end;
end;

procedure TRMRxRichForm.SelectionChange(Sender: TObject);
begin
  with Editor.Paragraph do
  begin
    try
      FUpdating := True;
      FRuler.UpdateInd;
      BtnFontBold.Down := fsBold in CurrText.Style;
      BtnFontItalic.Down := fsItalic in CurrText.Style;
      BtnFontUnderline.Down := fsUnderline in CurrText.Style;
      BtnBullets.Down := Boolean(Numbering);
      BtnSuperscript.Down := CurrText.SubscriptStyle = ssSuperscript;
      BtnSubscript.Down := CurrText.SubscriptStyle = ssSubscript;
      RMSetFontSize(TComboBox(FCmbFontSize), CurrText.Size);
      FCmbFont.FontName := CurrText.Name;
      case Ord(Alignment) of
        0: BtnAlignLeft.Down := True;
        1: BtnAlignRight.Down := True;
        2: BtnAlignCenter.Down := True;
      end;
      UpdateCursorPos;
    finally
      FUpdating := False;
    end;
  end;
end;

function TRMRxRichForm.CurrText: TRxTextAttributes;
begin
  if Editor.SelLength > 0 then
    Result := Editor.SelAttributes
  else
    Result := Editor.WordAttributes;
end;

procedure TRMRxRichForm.SetFileName(const FileName: string);
begin
  FFileName := FileName;
  Editor.Title := ExtractFileName(FileName);
end;

procedure TRMRxRichForm.SetEditRect;
var
  R: TRect;
  Offs: Integer;
begin
  with Editor do
  begin
    if SelectionBar then
      Offs := 3
    else
      Offs := 0;
    R := Rect(GutterWid + Offs, 0, ClientWidth - GutterWid, ClientHeight);
    SendMessage(Handle, EM_SETRECT, 0, Longint(@R));
  end;
end;

{ Event Handlers }

procedure TRMRxRichForm.FormCreate(Sender: TObject);
var
  i, liOffset: Integer;
  s, s1: string;
begin
  Localize;
  Editor := TRxRichEdit.Create(Self);
  with Editor do
  begin
    Parent := Self;
    Align := alClient;
    HideSelection := False;
    Editor.PopupMenu := Self.EditPopupMenu;
    WantTabs := False;
    ScrollBars := ssBoth;

    OnTextNotFound := EditorTextNotFound;
    OnSelectionChange := SelectionChange;
    OnProtectChange := EditorProtectChange;
    OnChange := RichEditChange;
  end;

  FcmbFont := TRMFontComboBox.Create(ToolBar2);
  with FcmbFont do
  begin
    Parent := ToolBar2;
    Left := 0;
    Top := 0;
    Height := 21;
    Width := 150;
    Tag := 7;
//    Device := rmfdPrinter;
    OnChange := OnCmbFontChange;
  end;
  FcmbFontSize := TComboBox.Create(ToolBar2);
  with FcmbFontSize do
  begin
    Parent := ToolBar2;
    Left := 150;
    Top := 0;
    Height := 21;
    Width := 59;
    Tag := 8;
    DropDownCount := 12;
    if RMIsChineseGB then
      liOffset := 0
    else
      liOffset := 13;
    for i := Low(RMDefaultFontSizeStr) + liOffset to High(RMDefaultFontSizeStr) do
      Items.Add(RMDefaultFontSizeStr[i]);
    OnChange := OnCmbFontSizeChange;
  end;
  FBtnFontColor := TRMColorPickerButton.Create(ToolBar2);
  with FBtnFontColor do
  begin
    Parent := ToolBar2;
    Left := ToolButton18.Left + ToolButton18.Width;
    Top := 0;
    ColorType := rmptFont;
    OnColorChange := OnColorChangeEvent;
  end;
  FBtnBackColor := TRMColorPickerButton.Create(ToolBar2);
  with FBtnBackColor do
  begin
    Parent := ToolBar2;
    Left := FBtnFontColor.Left + FBtnFontColor.Width;
    Top := 0;
    ColorType := rmptFill;
    OnColorChange := OnColorChangeEvent;
  end;

  FRuler := TRMRuler.Create(Self);
  with FRuler do
  begin
    Top := ToolBar2.Top + ToolBar2.Height;
    RichEdit := TCustomRichEdit(Editor);
    Align := alTop;
    Height := 26;
    OnIndChanged := SelectionChange;
  end;