rm_richedit.pas

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

{$IFNDEF TntUnicode}
  liNewDY, liLowDy, liHighDy: Integer;
  liFit: Boolean;
{$ENDIF}
  liPixelsPerInchX: Integer;
  liPixelsPerInchY: Integer;
  lTextMetric: TTextMetric;
  liTolerance: Integer;
  liPrinter: TRMPrinter;
  liDC: HDC;
  liPrinterWidth: Integer;
  liFont: TFont;
begin
  liPrinter := GetPrinter;
  if (liPrinter <> nil) and (liPrinter.DC <> 0) then
    liDC := liPrinter.DC
  else
    liDC := GetDC(0);

  try
    FillChar(liFormatRange, SizeOf(TFormatRange), 0);
    liFormatRange.hdc := liDC;
    liFormatRange.hdcTarget := liFormatRange.hdc;
    liPixelsPerInchX := GetDeviceCaps(liDC, LOGPIXELSX);
    liPixelsPerInchY := GetDeviceCaps(liDC, LOGPIXELSY);

    if (liPrinter <> nil) and (liPrinter.DC <> 0) then
    begin
      liFont := TFont.Create;
      liFont.Assign(SRichEdit.SelAttributes);
      liPrinter.Canvas.Font := liFont;
      GetTextMetrics(liPrinter.Canvas.Handle, lTextMetric);
      liFont.Free;
    end
    else
      lTextMetric.tmDescent := 0;

    liPrinterWidth := Round(RMFromMMThousandths_Printer(
      (mmSaveWidth - mmSaveGapX * 2 - _CalcHFrameWidth(mmSaveFWLeft, mmSaveFWRight)),
      rmrtHorizontal, liPrinter));
    liPrinterWidth := Round(liPrinterWidth * 1440.0 / liPixelsPerInchX);
    liTolerance := Round(Abs(SRichEdit.SelAttributes.Size) * liPixelsPerInchY / 72);

{$IFDEF TntUnicode}
    liFormatRange.rc := Rect(0, 0, liPrinterWidth, Round(10000000 * 1440.0 / liPixelsPerInchY));
    liFormatRange.rcPage := liFormatRange.rc;
    liLastChar := FStartCharPos;
    liMaxLen := SRichEdit.GetTextLen;
    liFormatRange.chrg.cpMin := liLastChar;
    liFormatRange.chrg.cpMax := -1;
    SRichEdit.Perform(EM_FORMATRANGE, 0, Integer(@liFormatRange));
    if liMaxLen = 0 then
      Result := 0
    else if (liFormatRange.rcPage.bottom <> liFormatRange.rc.bottom) then
      Result := Round(liFormatRange.rc.bottom / (1440.0 / liPixelsPerInchY))
    else
      Result := 0;

    SRichEdit.Perform(EM_FORMATRANGE, 0, 0);
    Result := Result + lTextMetric.tmDescent + liTolerance;
    Result := Round(RMToMMThousandths_Printer(Result, rmrtVertical, liPrinter) + 0.5);
{$ELSE}
    liLowDy := 0;
    liHighDY := 1000000;
    while liHighDy - liLowDy > liTolerance do
    begin
      liNewDY := liLowDy + (liHighDy - liLowDy) div 2;
      liFormatRange.rc := Rect(0, 0, liPrinterWidth, Round(liNewDY * 1440.0 / liPixelsPerInchY));
      liFormatRange.rcPage := liFormatRange.rc;
      liLastChar := FStartCharPos;
      liMaxLen := SRichEdit.GetTextLen;
      liFormatRange.chrg.cpMax := -1;
      repeat
        liFormatRange.chrg.cpMin := liLastChar;
        liLastChar := SRichEdit.Perform(EM_FORMATRANGE, 0, Integer(@liFormatRange));
        liFit := (liLastChar >= liMaxLen) or (liLastChar = -1) or (liLastChar = 0);
      until ((liLastChar < liMaxLen) and (liLastChar <> -1)) or liFit;

      if liFit then
        liHighDy := liNewDY
      else
        liLowDy := liNewDY;
    end;

    SRichEdit.Perform(EM_FORMATRANGE, 0, 0);
    liHighDy := liHighDy + lTextMetric.tmDescent;
    if liHighDy < liTolerance then
      liHighDy := liTolerance;

    Result := Round(RMToMMThousandths_Printer(liHighDy, rmrtVertical, liPrinter) + 0.5);
{$ENDIF}
  finally
    if (liPrinter = nil) or (liPrinter.DC = 0) then
      ReleaseDC(liDC, 0);
  end;
end;

{$WARNINGS OFF}

function TRMRichView.FormatRange(aDC: HDC; aFormatDC: HDC; const aRect: TRect;
  aCharRange: TCharRange; aRender: Boolean): Integer;
var
  liFormatRange: TFormatRange;
  liSaveMapMode: Integer;
  liPixelsPerInchX: Integer;
  liPixelsPerInchY: Integer;
  liRender: Integer;
  liRichEdit: TRMRichEdit;
begin
  if aRender then liRichEdit := FRichEdit else liRichEdit := SRichEdit;

  FillChar(liFormatRange, SizeOf(TFormatRange), 0);
  liFormatRange.hdc := aDC;
  liFormatRange.hdcTarget := aFormatDC;

  liPixelsPerInchX := GetDeviceCaps(aDC, LOGPIXELSX);
  liPixelsPerInchY := GetDeviceCaps(aDC, LOGPIXELSY);

  liFormatRange.rc.left := Round(aRect.Left * 1440.0 / liPixelsPerInchX) + 45;
  liFormatRange.rc.right := Round(aRect.Right * 1440.0 / liPixelsPerInchX);
  liFormatRange.rc.top := Round(aRect.Top * 1440.0 / liPixelsPerInchY);
  liFormatRange.rc.bottom := Round(aRect.Bottom * 1440.0 / liPixelsPerInchY);
  liFormatRange.rcPage := liFormatRange.rc;
  liFormatRange.chrg.cpMin := aCharRange.cpMin;
  liFormatRange.chrg.cpMax := aCharRange.cpMax;

  if aRender then
    liRender := 1
  else
    liRender := 0;

  liSaveMapMode := SetMapMode(liFormatRange.hdc, MM_TEXT);
  liRichEdit.Perform(EM_FORMATRANGE, 0, 0); { flush buffer}
  try
    Result := liRichEdit.Perform(EM_FORMATRANGE, liRender, Longint(@liFormatRange));
  finally
    liRichEdit.Perform(EM_FORMATRANGE, 0, 0);
    SetMapMode(liFormatRange.hdc, liSaveMapMode);
  end;
end;

procedure TRMRichView.ShowRichText(aRender: Boolean);
var
  lCharRange: TCharRange;

  procedure _ShowRichOnPrinter;
  begin
    FormatRange(Canvas.Handle, Canvas.Handle, RealRect, lCharRange, True);
  end;

  procedure _ShowRichOnScreen;
  var
    lMetaFile: TMetaFile;
    lMetaFileCanvas: TMetaFileCanvas;
    lDC: HDC;
    lPrinter: TRMPrinter;
    lBitmap: TBitmap;
    lCanvasRect: TRect;
    lWidth, lHeight: Integer;
  begin
    lPrinter := GetPrinter;
    if lPrinter.DC <> 0 then
    begin
      lDC := lPrinter.DC;
      FPixelsPerInch := lPrinter.PixelsPerInch;
    end
    else
    begin
      lDC := GetDC(0);
      FPixelsPerInch.X := 96;
      FPixelsPerInch.Y := 96;
    end;

    lMetaFile := TMetaFile.Create;
    try
      if aRender then
      begin
        lWidth := mmSaveWidth - mmSaveGapX * 2 - _CalcHFrameWidth(mmSaveFWLeft, mmSaveFWRight);
        lHeight := mmSaveHeight - mmSaveGapY * 2 - _CalcVFrameWidth(mmSaveFWTop, mmSaveFWBottom);
      end
      else
      begin
        lWidth := mmWidth - mmGapLeft * 2 - _CalcHFrameWidth(LeftFrame.mmWidth, RightFrame.mmWidth);
        lHeight := mmHeight - mmGapTop * 2 - _CalcVFrameWidth(TopFrame.mmWidth, BottomFrame.mmWidth);
      end;

      lCanvasRect := Rect(0, 0,
        Round(RMFromMMThousandths_Printer(lWidth, rmrtHorizontal, lPrinter)) + 1,
        Round(RMFromMMThousandths_Printer(lHeight, rmrtVertical, lPrinter)));
      lMetaFile.Width := lCanvasRect.Right - lCanvasRect.Left;
      lMetaFile.Height := lCanvasRect.Bottom - lCanvasRect.Top;

      lMetaFileCanvas := TMetaFileCanvas.Create(lMetaFile, lDC);
      lMetaFileCanvas.Brush.Style := bsClear;

      FEndCharPos := FormatRange(lMetaFileCanvas.Handle, lDC, lCanvasRect, lCharRange, aRender);

      lMetaFileCanvas.Free;
      if lPrinter.DC = 0 then
        ReleaseDC(0, lDC);

      if aRender then
      begin
        if DocMode = rmdmDesigning then
        begin
          lBitmap := TBitmap.Create;
          lBitmap.Width := RealRect.Right - RealRect.Left + 1;
          lBitmap.Height := RealRect.Bottom - RealRect.Top + 1;
          lBitmap.Canvas.StretchDraw(Rect(0, 0, lBitmap.Width, lBitmap.Height), lMetaFile);
          Canvas.Draw(RealRect.Left, RealRect.Top, lBitmap);
          lBitmap.Free;
        end
        else
          Canvas.StretchDraw(RealRect, lMetaFile);
      end;
    finally
      lMetaFile.Free;
    end;
  end;

begin
  FEndCharPos := FStartCharPos;
  lCharRange.cpMax := -1;
  lCharRange.cpMin := FEndCharPos;
  if (DocMode = rmdmPrinting) and (GetPrinter.PixelsPerInch.X = FPixelsPerInch.X) and
     (GetPrinter.PixelsPerInch.Y = FPixelsPerInch.Y) then
    _ShowRichOnPrinter
  else
    _ShowRichOnScreen;
end;

{$WARNINGS ON}

procedure TRMRichView.Draw(aCanvas: TCanvas);
begin
  BeginDraw(aCanvas);
  CalcGaps;
  with aCanvas do
  begin
    ShowBackground;
    InflateRect(RealRect, -RMToScreenPixels(mmGapLeft, rmutMMThousandths),
      -RMToScreenPixels(mmGapTop, rmutMMThousandths));
    if (spWidth > 0) and (spHeight > 0) then
      ShowRichText(True);
    ShowFrame;
  end;
  RestoreCoord;
end;

procedure TRMRichView.Prepare;
begin
  inherited Prepare;
  FStartCharPos := 0;
end;

procedure TRMRichView.GetMemoVariables;
begin
  if DrawMode = rmdmAll then
  begin
    Memo1.Assign(Memo);
    if Assigned(OnBeforePrint) then
      OnBeforePrint(Self);
    InternalOnBeforePrint(Memo1, Self);
    RMAssignRich(SRichEdit, FRichEdit);
    if not TextOnly then
      GetRichData(SRichEdit);
  end;
end;

procedure TRMRichView.PlaceOnEndPage(aStream: TStream);
var
  liTextLen: Integer;
begin
  BeginDraw(Canvas);
  if not Visible then Exit;

  GetMemoVariables;
  if DrawMode = rmdmPart then
  begin
    FStartCharPos := FEndCharPos;
    ShowRichText(False);
    liTextLen := SRichEdit.GetTextLen - FEndCharPos + 1;
    if liTextLen > 0 then
    begin
      SRichEdit.SelStart := FEndCharPos;
      SRichEdit.SelLength := liTextLen;
      SRichEdit.SelText := '';
    end;

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

    FSaveCharPos := FEndCharPos;
  end;

  aStream.Write(Typ, 1);
  RMWriteString(aStream, ClassName);
  FUseSRichEdit := True;
  try
    SaveToStream(aStream);
  finally
    FUseSRichEdit := False;
  end;
end;

function TRMRichView.CalcHeight: Integer;
begin
  FEndCharPos := 0;
  FSaveCharPos := 0;
  CalculatedHeight := 0; Result := 0;
  if not Visible then Exit;

  CalcGaps;
  DrawMode := rmdmAll;
  GetMemoVariables;
//  DrawMode := rmdmAfterCalcHeight;

  FStartCharPos := 0;
  CalculatedHeight := RMToMMThousandths(spGapTop * 2 + _CalcVFrameWidth(TopFrame.spWidth, BottomFrame.spWidth), rmutScreenPixels) +
    DoCalcHeight;
  RestoreCoord;
  Result := CalculatedHeight;
end;

function TRMRichView.RemainHeight: Integer;
begin
  DrawMode := rmdmAll;
  GetMemoVariables;
//  DrawMode := rmdmAfterCalcHeight;

  FStartCharPos := FEndCharPos;
  ActualHeight := RMToMMThousandths(spGapTop * 2 + _CalcVFrameWidth(TopFrame.spWidth, BottomFrame.spWidth), rmutScreenPixels) +
    DoCalcHeight;
  Result := ActualHeight;
end;

procedure TRMRichView.LoadFromStream(aStream: TStream);
var
  b: Byte;
  liSavePos: Integer;
  lVersion: Integer;
begin
  inherited LoadFromStream(aStream);
  lVersion := RMReadWord(aStream);
  b := RMReadByte(aStream);
  liSavePos := RMReadInt32(aStream);
  if b > 0 then
    FRichEdit.Lines.LoadFromStream(aStream);
  aStream.Seek(liSavePos, soFromBeginning);
  if lVersion >= 1 then
  begin
    FPixelsPerInch.X := RMReadInt32(aStream);
    FPixelsPerInch.Y := RMReadInt32(aStream);
  end;
end;

procedure TRMRichView.SaveToStream(aStream: TStream);
var
  b: Byte;
  lSavePos, lPos: Integer;
  lRichEdit: TRMRichEdit;
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 1);
  if FUseSRichEdit then
    lRichEdit := SRichEdit
  else
    lRichEdit := FRichEdit;

  if lRichEdit.Lines.Count <> 0 then b := 1 else b := 0;
  RMWriteByte(aStream, b);

  lSavePos := aStream.Position;
  RMWriteInt32(aStream, lSavePos);
  if b > 0 then
    lRichEdit.Lines.SaveToStream(aStream);

  lPos := aStream.Position;
  aStream.Seek(lSavePos, soFromBeginning);
  RMWriteInt32(aStream, lPos);
  aStream.Seek(lPos, soFromBeginning);

  RMWriteInt32(aStream, FPixelsPerInch.X);
  RMWriteInt32(aStream, FPixelsPerInch.Y);
end;

procedure TRMRichView.GetBlob;
var
  liStream: TMemoryStream;
begin
  liStream := TMemoryStream.Create;
  try
    if not ParentReport.Flag_TableEmpty then
      FDataSet.AssignBlobFieldTo(FDataFieldName, liStream);
    FRichEdit.Lines.LoadFromStream(liStream);
  finally
    liStream.Free;
  end;
end;

procedure TRMRichView.ShowEditor;
var
  tmpForm: TRMRichForm;
begin
  tmpForm := TRMRichForm.Create(Application);
  try
    RMAssignRich(tmpForm.Editor, FRichEdit);
    if tmpForm.ShowModal = mrOK then
    begin
      RMDesigner.BeforeChange;
      RMAssignRich(FRichEdit, tmpForm.Editor);
      RMDesigner.AfterChange;
    end;
  finally
    tmpForm.Free;
  end;
end;

procedure TRMRichView.DefinePopupMenu(aPopup: TRMCustomMenuItem);
begin
  inherited DefinePopupMenu(aPopup);
end;

procedure TRMRichView.LoadFromRichEdit(aRichEdit: TRMRichEdit);
begin
  RMAssignRich(FRichEdit, aRichEdit);
end;

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

procedure TRMRichView.ClearContents;
begin
  FRichEdit.Clear;
  inherited;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMRichForm}

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

//  Caption := RMLoadStr(rmRes + 560);
  RMSetStrProp(btnFileOpen, 'Hint', rmRes + 561);
  RMSetStrProp(btnFileSave, 'Hint', rmRes + 562);
  RMSetStrProp(btnFilePrint, 'Hint', rmRes + 159);
  RMSetStrProp(btnUndo, 'Hint', rmRes + 563);
  RMSetStrProp(btnCut, 'Hint', rmRes + 91);
  RMSetStrProp(btnCopy, 'Hint', rmRes + 92);
  RMSetStrProp(btnPaste, 'Hint', rmRes + 93);
  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(btnFont, 'Hint', rmRes + 571);
  RMSetStrProp(btnInsertField, 'Hint', rmRes + 575);

  RMSetStrProp(FileMenu, 'Caption', rmRes + 154);
  RMSetStrProp(FileNewItem, 'Caption', rmRes + 155);
  RMSetStrProp(FileOpenItem, 'Caption', rmRes + 156);