?? rm_rxrtf.pas
字號:
{*****************************************}
{ }
{ Report Machine v2.0 }
{ RxRich Add-In Object }
{ }
{*****************************************}
unit RM_rxrtf;
interface
{$I RM.inc}
{$IFDEF RX}
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls, Menus, Db,
Forms, Dialogs, StdCtrls, {$IFDEF Delphi4}ImgList, {$ENDIF}ExtCtrls,
ComCtrls, ClipBrd, RM_DBRel, RM_Class, RM_common, RM_DsgCtrls, RxRiched, ClipMon,
ToolWin{$IFDEF Delphi6}, Variants{$ENDIF};
type
TRMRxRichObject = class(TComponent) // fake component
end;
{ TRMRxRichView }
TRMRxRichView = class(TRMStretcheable)
private
FCurChar, FLastChar, FCharFrom: Integer;
FFlag: Boolean;
procedure GetRichData(ASource: TCustomMemo);
function DoCalcHeight: Integer;
procedure ShowRich(Render: Boolean);
procedure P1Click(Sender: TObject);
procedure RichEditor(Sender: TObject);
protected
function GetViewCommon: string; override;
procedure SetPropValue(Index: string; Value: Variant); override;
function GetPropValue(Index: string): Variant; override;
public
RichEdit: TRxRichEdit;
constructor Create; override;
destructor Destroy; override;
procedure Draw(aCanvas: TCanvas); override;
procedure StreamOut(Stream: TStream); override;
procedure LoadFromStream(Stream: TStream); override;
procedure SaveToStream(Stream: TStream); override;
procedure GetBlob(b: TField); override;
function CalcHeight: Integer; override;
function MinHeight: Integer; override;
function LostSpace: Integer; override;
function RemainHeight: Integer; override;
procedure DefinePopupMenu(Popup: TPopupMenu); override;
procedure DefineProperties; override;
procedure ShowEditor; override;
procedure LoadFromRichEdit(aRichEdit: TRxRichEdit);
end;
{TRMRxRichForm}
TRMRxRichForm = class(TForm)
OpenDialog: TOpenDialog;
SaveDialog: TSaveDialog;
FontDialog: TFontDialog;
StatusBar: TStatusBar;
ImageList1: TImageList;
EditPopupMenu: TPopupMenu;
ItmCut: TMenuItem;
ItmCopy: TMenuItem;
ItmPaste: TMenuItem;
MainMenu: TMainMenu;
MenuFile: TMenuItem;
ItemFileNew: TMenuItem;
ItemFileOpen: TMenuItem;
ItemFileSaveAs: TMenuItem;
MenuItem5: TMenuItem;
ItemFilePrint: TMenuItem;
MenuItem7: TMenuItem;
ItemFileExit: TMenuItem;
MenuEdit: TMenuItem;
ItemEditUndo: TMenuItem;
MenuItem11: TMenuItem;
ItemEditCut: TMenuItem;
ItemEditCopy: TMenuItem;
ItemEditPaste: TMenuItem;
ItemFormatFont: TMenuItem;
MenuItem16: TMenuItem;
ItemInsertField: TMenuItem;
MenuInsert: TMenuItem;
MenuFormat: TMenuItem;
ItemInserObject: TMenuItem;
ItemInsertPicture: TMenuItem;
ItemEditRedo: TMenuItem;
ItemEditPasteSpecial: TMenuItem;
ItemEditSelectAll: TMenuItem;
N20: TMenuItem;
ItemEditFind: TMenuItem;
ItemEditFindNext: TMenuItem;
ItemEditReplace: TMenuItem;
N23: TMenuItem;
ItemEditObjProps: TMenuItem;
PrintDialog: TPrintDialog;
ToolBar1: TToolBar;
ToolBar2: TToolBar;
btnFileNew: TToolButton;
btnFileOpen: TToolButton;
btnFileSave: TToolButton;
ToolButton4: TToolButton;
btnFind: TToolButton;
ToolButton6: TToolButton;
btnCut: TToolButton;
btnCopy: TToolButton;
btnPaste: TToolButton;
ToolButton10: TToolButton;
btnUndo: TToolButton;
btnRedo: TToolButton;
ToolButton13: TToolButton;
btnInsertField: TToolButton;
ToolButton15: TToolButton;
btnOK: TToolButton;
btnCancel: TToolButton;
ToolButton18: TToolButton;
btnFontBold: TToolButton;
btnFontItalic: TToolButton;
btnFontUnderline: TToolButton;
ToolButton22: TToolButton;
ToolButton25: TToolButton;
btnAlignLeft: TToolButton;
btnAlignCenter: TToolButton;
btnAlignRight: TToolButton;
ToolButton29: TToolButton;
btnBullets: TToolButton;
ToolButton31: TToolButton;
btnSuperscript: TToolButton;
btnSubscript: TToolButton;
ItemFormatParagraph: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure RichEditChange(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure EditorProtectChange(Sender: TObject; StartPos,
EndPos: Integer; var AllowChange: Boolean);
procedure EditorTextNotFound(Sender: TObject; const FindText: string);
procedure EditSelectAll(Sender: TObject);
procedure btnFileNewClick(Sender: TObject);
procedure btnFileOpenClick(Sender: TObject);
procedure btnFileSaveClick(Sender: TObject);
procedure btnFindClick(Sender: TObject);
procedure btnCutClick(Sender: TObject);
procedure btnCopyClick(Sender: TObject);
procedure btnPasteClick(Sender: TObject);
procedure btnUndoApplyAlign(Sender: TObject; Align: TAlign;
var Apply: Boolean);
procedure btnRedoClick(Sender: TObject);
procedure btnFontBoldClick(Sender: TObject);
procedure btnFontItalicClick(Sender: TObject);
procedure btnFontUnderlineClick(Sender: TObject);
procedure btnAlignLeftClick(Sender: TObject);
procedure btnBulletsClick(Sender: TObject);
procedure ItemFileSaveAsClick(Sender: TObject);
procedure ItemFilePrintClick(Sender: TObject);
procedure ItemFormatFontClick(Sender: TObject);
procedure ItemInserObjectClick(Sender: TObject);
procedure ItemInsertPictureClick(Sender: TObject);
procedure btnUndoClick(Sender: TObject);
procedure ItemEditPasteSpecialClick(Sender: TObject);
procedure ItemEditFindNextClick(Sender: TObject);
procedure ItemEditReplaceClick(Sender: TObject);
procedure ItemEditObjPropsClick(Sender: TObject);
procedure btnInsertFieldClick(Sender: TObject);
procedure btnSuperscriptClick(Sender: TObject);
procedure ItemEditSelectAllClick(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ItemFormatParagraphClick(Sender: TObject);
private
FFileName: string;
FUpdating: Boolean;
FProtectChanging: Boolean;
FClipboardMonitor: TClipboardMonitor;
FOpenPictureDialog: TOpenDialog;
FcmbFont: TRMFontComboBox;
FcmbFontSize: TComboBox;
FRuler: TRMRuler;
FBtnFontColor: TRMColorPickerButton;
FBtnBackColor: TRMColorPickerButton;
function CurrText: TRxTextAttributes;
procedure SetFileName(const FileName: string);
{$IFDEF OPENPICTUREDLG}
procedure EditFindDialogClose(Sender: TObject; Dialog: TFindDialog);
{$ENDIF}
procedure SetEditRect;
procedure UpdateCursorPos;
procedure FocusEditor;
procedure ClipboardChanged(Sender: TObject);
procedure PerformFileOpen(const AFileName: string);
procedure SetModified(Value: Boolean);
procedure OnCmbFontChange(Sender: TObject);
procedure OnCmbFontSizeChange(Sender: TObject);
procedure SelectionChange(Sender: TObject);
procedure OnColorChangeEvent(Sender: TObject);
procedure Localize;
public
Editor: TRxRichEdit;
end;
{$ENDIF}
implementation
{$IFDEF RX}
uses RM_Pars, RM_Intrp, RM_Utils, RM_Const, RM_Const1, RM_Prntr, RM_CmpReg,
MaxMin, RichEdit, VclUtils, RM_rtfParaFmt
{$IFDEF OPENPICTUREDLG}, ExtDlgs{$ENDIF}
{$IFDEF JPeg}, JPeg{$ENDIF}
{$IFDEF RXGIF}, RxGIF{$ENDIF};
const
RulerAdj = 4 / 3;
GutterWid = 6;
UndoNames: array[TUndoName] of string =
('', 'typing', 'delete', 'drag and drop', 'cut', 'paste');
{$R *.DFM}
var
FRichEdit: TRxRichEdit; // temporary rich used during TRichView drawing
function SRichEdit: TRxRichEdit;
begin
if FRichEdit = nil then
begin
FRichEdit := TRxRichEdit.Create(RMDialogForm);
with FRichEdit do
begin
Parent := RMDialogForm;
end;
end;
Result := FRichEdit;
end;
function GetSpecial(const s: string; Pos: Integer): Integer;
var
i: Integer;
begin
Result := 0;
{ for i := 1 to Pos do
begin
if s[i] in [#10, #13] then
Inc(Result);
end;
}
//WHF Add
i := 1;
while i <= Pos do
begin
if ByteType(s, i) = mbLeadByte then
begin
Result := Result + 2;
Inc(i);
end
else if s[i] in [#10, #13] then
Inc(Result);
Inc(i);
end;
end;
procedure AssignRich(Rich1, Rich2: TRxRichEdit);
var
st: TMemoryStream;
begin
st := TMemoryStream.Create;
Rich2.Lines.SaveToStream(st);
st.Position := 0;
Rich1.Lines.LoadFromStream(st);
st.Free;
end;
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMRxRichView }
constructor TRMRxRichView.Create;
begin
inherited Create;
RichEdit := TRxRichEdit.Create(RMDialogForm);
RichEdit.Parent := RMDialogForm;
RichEdit.Visible := False;
RichEdit.Font.Charset := StrToInt(RMLoadStr(SCharset));
RichEdit.Font.Name := RMLoadStr(SRMDefaultFontName);
RichEdit.Font.Size := 11;
BaseName := 'RxRich';
end;
destructor TRMRxRichView.Destroy;
begin
if RMDialogForm <> nil then
RichEdit.Free;
inherited Destroy;
end;
procedure TRMRxRichView.DefineProperties;
begin
inherited DefineProperties;
AddProperty('Lines', [RMdtHasEditor, RMdtOneObject], RichEditor);
AddProperty('Stretched', [RMdtBoolean], nil);
AddProperty('TextOnly', [RMdtBoolean], nil);
AddProperty('GapX', [RMdtInteger], nil);
AddProperty('GapY', [RMdtInteger], nil);
AddProperty('DataField', [RMdtOneObject, RMdtHasEditor, RMdtString], RMFieldEditor);
AddProperty('OnBeforePrint', [RMdtHasEditor, RMdtOneObject], RMScript_BeforePrintEditor);
AddProperty('OnAfterPrint', [RMdtHasEditor, RMdtOneObject], RMScript_AfterPrintEditor);
end;
procedure TRMRxRichView.SetPropValue(Index: string; Value: Variant);
begin
inherited SetPropValue(Index, Value);
Index := AnsiUpperCase(Index);
if Index = 'TEXTONLY' then
Flags := (Flags and not flTextOnly) or Word(Boolean(Value)) * flTextOnly
end;
function TRMRxRichView.GetPropValue(Index: string): Variant;
begin
Index := AnsiUpperCase(Index);
Result := inherited GetPropValue(Index);
if Result <> Null then
Exit;
if Index = 'TEXTONLY' then
Result := (Flags and flTextOnly) <> 0
end;
procedure TRMRxRichView.GetRichData(ASource: TCustomMemo);
var
R, S: string;
i, j: Integer;
begin
if Flag_TableEmpty then
begin
ASource.Lines.Text := '';
Exit;
end;
with ASource do
begin
try
Lines.BeginUpdate;
i := Pos('[', Text);
while i > 0 do
begin
SelStart := i - 1 - GetSpecial(Text, i) div 2;
R := RMGetBrackedVariable(Text, i, j);
CurReport.InternalOnGetValue(R, S);
SelLength := j - i + 1;
SelText := S;
i := Pos('[', Text);
end;
finally
Lines.EndUpdate;
end;
end;
end;
function TRMRxRichView.DoCalcHeight: Integer;
var
Range: TFormatRange;
LastChar, MaxLen, LogX, LogY: Integer;
begin
FillChar(Range, SizeOf(TFormatRange), 0);
with Range do
begin
hdc := GetDC(0);
hdcTarget := hdc;
LogX := Screen.PixelsPerInch;
LogY := LogX;
rc := Rect(0, 0, Round((DX - GapX * 2 - _CalcHFrameWidth(LeftFrame.Width, RightFrame.Width)) * 1440 / LogX), Round(10000000 * 1440.0 / LogY));
rcPage := rc;
LastChar := FCharFrom;
MaxLen := SRichEdit.GetTextLen;
chrg.cpMin := LastChar;
chrg.cpMax := -1;
SRichEdit.Perform(EM_FORMATRANGE, 0, Integer(@Range));
ReleaseDC(0, hdc);
if MaxLen = 0 then
Result := 0
else if (rcPage.bottom <> rc.bottom) then
Result := Round(rc.bottom / (1440.0 / LogY))
else
Result := 0;
end;
SRichEdit.Perform(EM_FORMATRANGE, 0, 0);
end;
{$WARNINGS OFF}
procedure TRMRxRichView.ShowRich(Render: Boolean);
var
lFormatRange: TFormatRange;
LogX, LogY, liSaveMapMode: Integer;
EMF: TMetafile;
EMFCanvas: TMetafileCanvas;
re: TRxRichEdit;
BMP: TBitmap;
begin
EMF := nil; EMFCanvas := nil;
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
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, Round(DRect.Bottom * 1440 / 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.cpMin := FLastChar;
chrg.cpMax := -1;
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;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -