📄 rm_rich.pas
字号:
chrg.cpMin := LastChar;
LastChar := SRichEdit.Perform(EM_FORMATRANGE, 0, Integer(@Range));
Fit := (LastChar >= MaxLen) or (LastChar = -1) or (LastChar = 0);
StopRender := ((LastChar < MaxLen) and (LastChar <> -1)) or Fit;
until StopRender;
if Fit then
HighDy := NewDY
else
LowDy := NewDY;
end;
ReleaseDC(0, hdc);
end;
SRichEdit.Perform(EM_FORMATRANGE, 0, 0);
if HighDy < 2 then
HighDy := 8;
Result := HighDy;
end;
{$WARNINGS OFF}
procedure TRMRichView.ShowRich(Render: Boolean);
var
lFormatRange: TFormatRange;
LogX, LogY, liSaveMapMode: Integer;
EMF: TMetafile;
EMFCanvas: TMetafileCanvas;
BMP: TBitmap;
re: TRichEdit;
begin
if Render then
re := RichEdit
else
re := SRichEdit;
FillChar(lFormatRange, SizeOf(TFormatRange), 0);
with lFormatRange do
begin
if Render then
hdc := Canvas.Handle
else
hdc := GetDC(0);
if Render then
begin
if IsPrinting then
begin
if FillColor = clNone then
SetBkMode(hdc, Transparent);
LogX := GetDeviceCaps(hdc, LOGPIXELSX);
LogY := GetDeviceCaps(hdc, LOGPIXELSY);
rc := Rect(DRect.Left * 1440 div LogX, DRect.Top * 1440 div LogY - 10,
DRect.Right * 1440 div LogX, DRect.Bottom * 1440 div LogY);
end
else
begin
LogX := Screen.PixelsPerInch;
LogY := LogX;
rc := Rect(0, 0, Round((SaveDX - SaveGX * 2 - _CalcHFrameWidth(SaveFWLeft, SaveFWRight)) * 1440 / LogX),
Round((SaveDY - SaveGY * 2 - _CalcVFrameWidth(SaveFWTop, SaveFWBottom)) * 1440 / LogY));
EMF := TMetafile.Create;
EMF.Width := SaveDX - SaveGX * 2 - _CalcHFrameWidth(SaveFWLeft, SaveFWRight);
EMF.Height := SaveDY - SaveGY * 2 - _CalcVFrameWidth(SaveFWTop, SaveFWBottom);
EMFCanvas := TMetafileCanvas.Create(EMF, 0);
EMFCanvas.Brush.Style := bsClear;
hdc := EMFCanvas.Handle;
end;
end
else
begin
LogX := Screen.PixelsPerInch;
LogY := LogX;
rc := Rect(0, 0, Round((DX - GapX * 2 - _CalcVFrameWidth(LeftFrame.Width, RightFrame.Width)) * 1440 / LogX),
Round((DY - GapY * 2 - _CalcHFrameWidth(TopFrame.Width, BottomFrame.Width)) * 1440 / LogY));
end;
if RMPrinter.DC <> 0 then
hdcTarget := RMPrinter.DC
else
hdcTarget := hdc;
rcPage := rc;
FLastChar := FCharFrom;
chrg.cpMax := -1;
chrg.cpMin := FLastChar;
liSaveMapMode := SetMapMode(hdc, MM_TEXT);
re.Perform(EM_FORMATRANGE, 0, 0);
try
FLastChar := re.Perform(EM_FORMATRANGE, Integer(Render), Longint(@lFormatRange));
finally
re.Perform(EM_FORMATRANGE, 0, 0);
SetMapMode(hdc, liSaveMapMode);
end;
end;
re.Perform(EM_FORMATRANGE, 0, 0);
if not Render then
ReleaseDC(0, lFormatRange.hdc)
else if not IsPrinting then
begin
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 TRMRichView.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 TRMRichView.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);
RMAssignRich(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 TRMRichView.CalcHeight: Integer;
begin
FLastChar := 0;
FCurChar := 0;
Result := 0;
RMInterpretator.DoScript(Script);
if not Visible then
Exit;
Memo1.Assign(Memo);
CurReport.InternalOnEnterRect(Memo1, Self);
RMAssignRich(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 TRMRichView.MinHeight: Integer;
begin
Result := 8;
end;
function TRMRichView.LostSpace: Integer;
var
n, lc, cc: Integer;
begin
RMAssignRich(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 TRMRichView.RemainHeight: Integer;
begin
Memo1.Assign(Memo);
CurReport.InternalOnEnterRect(Memo1, Self);
RMAssignRich(SRichEdit, RichEdit);
if (Flags and flTextOnly) = 0 then
GetRichData(SRichEdit);
FCharFrom := FLastChar;
Result := DoCalcHeight;
end;
procedure TRMRichView.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 TRMRichView.SaveToStream(Stream: TStream);
var
b: Byte;
n, o: Integer;
re: TRichEdit;
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 TRMRichView.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 TRMRichView.ShowEditor;
var
tmpForm: TRMRichForm;
begin
tmpForm := TRMRichForm.Create(Application);
try
RMAssignRich(tmpForm.Editor, RichEdit);
if tmpForm.ShowModal = mrOK then
begin
RMDesigner.BeforeChange;
RMAssignRich(RichEdit, tmpForm.Editor);
RMDesigner.AfterChange;
end;
finally
tmpForm.Free;
end;
end;
procedure TRMRichView.RichEditor(Sender: TObject);
begin
ShowEditor;
end;
procedure TRMRichView.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 TRMRichView.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 TRMRichView.GetViewCommon: string;
begin
Result := '[Rich]';
end;
procedure TRMRichView.LoadFromRichEdit(aRichEdit: TRichEdit);
begin
RMAssignRich(RichEdit, aRichEdit);
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);
RMSetStrProp(FileSaveAsItem, 'Caption', rmRes + 188);
RMSetStrProp(FileExitItem, 'Caption', rmRes + 162);
RMSetStrProp(EditMenu, 'Caption', rmRes + 163);
RMSetStrProp(EditUndoItem, 'Caption', rmRes + 164);
RMSetStrProp(EditCutItem, 'Caption', rmRes + 166);
RMSetStrProp(EditCopyItem, 'Caption', rmRes + 167);
RMSetStrProp(EditPasteItem, 'Caption', rmRes + 168);
RMSetStrProp(EditInsertFieldItem, 'Caption', rmRes + 575);
RMSetStrProp(EditFontItem, 'Caption', rmRes + 576);
RMSetStrProp(btnSuperscript, 'Hint', rmRes + 580);
RMSetStrProp(btnSubscript, 'Hint', rmRes + 581);
btnOK.Hint := RMLoadStr(rmRes + 573);
btnCancel.Hint := RMLoadStr(rmRes + 574);
end;
procedure TRMRichForm.SelectionChange(Sender: TObject);
begin
with Editor.Paragraph do
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -