prndbgeh.pas
来自「EHlib CN For Delphi2009」· PAS 代码 · 共 1,912 行 · 第 1/5 页
PAS
1,912 行
else
TextType := SF_RTF;
SendGetStructMessage(RichEdit.Handle, EM_STREAMOUT, TextType, EditStream, True);
if EditStream.dwError <> 0 then
raise EOutOfResources.Create(sRichEditSaveFail);
finally
Handle.Free;
end;
finally
if FConverter = nil then Converter.Free;
end;
end;
procedure TRichEditStrings.SaveToFile(const FileName: string; Encoding: System.Text.Encoding);
begin
inherited LoadFromFile(FileName, Encoding);
end;
procedure TRichEditStrings.LoadFromFile(const FileName: string; Encoding: System.Text.Encoding);
begin
inherited SaveToFile(FileName, Encoding);
end;
{$ELSE}
//StreamSave StreamLoad TRichEditStrings.SaveToStream TRichEditStrings.SaveToStream
function AdjustLineBreaks(Dest, Source: PChar): Integer; assembler;
asm
PUSH ESI
PUSH EDI
MOV EDI,EAX
MOV ESI,EDX
MOV EDX,EAX
CLD
@@1: LODSB
@@2: OR AL,AL
JE @@4
CMP AL,0AH
JE @@3
STOSB
CMP AL,0DH
JNE @@1
MOV AL,0AH
STOSB
LODSB
CMP AL,0AH
JE @@1
JMP @@2
@@3: MOV EAX,0A0DH
STOSW
JMP @@1
@@4: STOSB
LEA EAX,[EDI-1]
SUB EAX,EDX
POP EDI
POP ESI
end;
function StreamSave(dwCookie: Longint; pbBuff: PByte;
cb: Longint; var pcb: Longint): Longint; stdcall;
var
StreamInfo: PRichEditStreamInfo;
begin
Result := NoError;
StreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
try
pcb := 0;
if StreamInfo^.Converter <> nil then
pcb := StreamInfo^.Converter.ConvertWriteStream(StreamInfo^.Stream, Pointer(pbBuff), cb);
except
Result := WriteError;
end;
end;
function StreamLoad(dwCookie: Longint; pbBuff: PByte;
cb: Longint; var pcb: Longint): Longint; stdcall;
var
Buffer, pBuff: PChar;
StreamInfo: PRichEditStreamInfo;
begin
Result := NoError;
StreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
Buffer := StrAlloc(cb + 1);
try
cb := cb div 2;
pcb := 0;
pBuff := Buffer + cb;
try
if StreamInfo^.Converter <> nil then
pcb := StreamInfo^.Converter.ConvertReadStream(StreamInfo^.Stream, Pointer(pBuff), cb);
if pcb > 0 then
begin
pBuff[pcb] := #0;
if pBuff[pcb - 1] = #13 then pBuff[pcb - 1] := #0;
pcb := AdjustLineBreaks(Buffer, pBuff);
Move(Buffer^, pbBuff^, pcb);
end;
except
Result := ReadError;
end;
finally
StrDispose(Buffer);
end;
end;
procedure TRichEditStrings.LoadFromStream(Stream: TStream);
var
EditStream: TEditStream;
Position: Longint;
TextType: Longint;
StreamInfo: TRichEditStreamInfo;
Converter: TConversion;
begin
StreamInfo.Stream := Stream;
if FConverter <> nil then Converter := FConverter
else Converter := RichEdit.DefaultConverter.Create;
StreamInfo.Converter := Converter;
try
with EditStream do
begin
dwCookie := LongInt(Pointer(@StreamInfo));
pfnCallBack := @StreamLoad;
dwError := 0;
end;
Position := Stream.Position;
if PlainText
then TextType := SF_TEXT
else TextType := SF_RTF;
SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, Longint(@EditStream));
if (TextType = SF_RTF) and (EditStream.dwError <> 0) then
begin
Stream.Position := Position;
if PlainText
then TextType := SF_RTF
else TextType := SF_TEXT;
SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, Longint(@EditStream));
if EditStream.dwError <> 0 then
raise EOutOfResources.Create(sRichEditLoadFail);
end;
finally
if FConverter = nil then Converter.Free;
end;
end;
procedure TRichEditStrings.SaveToStream(Stream: TStream);
var
EditStream: TEditStream;
TextType: Longint;
StreamInfo: TRichEditStreamInfo;
Converter: TConversion;
begin
if FConverter <> nil then Converter := FConverter
else Converter := RichEdit.DefaultConverter.Create;
StreamInfo.Stream := Stream;
StreamInfo.Converter := Converter;
try
with EditStream do
begin
dwCookie := LongInt(Pointer(@StreamInfo));
pfnCallBack := @StreamSave;
dwError := 0;
end;
if PlainText then TextType := SF_TEXT
else TextType := SF_RTF;
SendMessage(RichEdit.Handle, EM_STREAMOUT, TextType, Longint(@EditStream));
if EditStream.dwError <> 0 then
raise EOutOfResources.Create(sRichEditSaveFail);
finally
if FConverter = nil then Converter.Free;
end;
end;
procedure TRichEditStrings.LoadFromFile(const FileName: string);
begin
inherited LoadFromFile(FileName);
end;
procedure TRichEditStrings.SaveToFile(const FileName: string);
begin
inherited SaveToFile(FileName);
end;
{$ENDIF}
//type TColCellParamsEhCra cker = class(TColCellParamsEh) end;
{ TPrintDBGridEh }
constructor TPrintDBGridEh.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPage := TPageParams.Create;
FPageFooter := TPageColontitle.Create;
FPageHeader := TPageColontitle.Create;
FTitle := TStringList.Create;
FColCellParamsEh := TColCellParamsEh.Create;
end;
destructor TPrintDBGridEh.Destroy;
begin
FreeAndNil(FColCellParamsEh);
FreeAndNil(FPage);
FreeAndNil(FPageFooter);
FreeAndNil(FPageHeader);
FreeAndNil(FTitle);
FreeAndNil(FBeforeGridText);
FreeAndNil(FAfterGridText);
if FSubstitutesNames <> nil then FreeAndNil(FSubstitutesNames);
if FSubstitutesValues <> nil then FreeAndNil(FSubstitutesValues);
inherited Destroy;
end;
procedure TPrintDBGridEh.Preview;
begin
if Assigned(OnPrinterSetupDialog) then
PrinterPreview.OnPrinterSetupDialog := OnPrinterSetupDialog
else
PrinterPreview.OnPrinterSetupDialog := PrinterSetupDialogPreview;
PrinterPreview.PrinterSetupOwner := Self;
PrintTo(PrinterPreview);
end;
var
MacroValues: array[0..5] of String = ('', '', '', '', '', '');
procedure TPrintDBGridEh.PrintTo(VPrinter: TVirtualPrinter);
type
TPolyBookmark = record
bm: TBookmark;
InDS: Boolean;
EOF: Boolean;
end;
// TFooterValues = array[0..MaxListSize - 1] of Currency;
// PFooterValues = ^TFooterValues;
TFooterValues = array of Currency;
var
PrnRowHeights, ColsToPages, PrnColWIdths: array of Integer;
// ColsToPages, PrnRowHeights, PrnColWIdths: TList;
GridWidth, RealRight, RealLeft, MinRowHeight: Integer;
fPrnPhysOffSetX, fPrnPhysOffSetY: Integer;
fPrnHorsRes, fPrnVertRes, PrnTitlEh, PenW, PrnTitleTextH: Integer;
DataPrintRec, PrintRec: TRect;
PrintOffset: Integer;
fLogPelsX1, fLogPelsY1, fLogPelsX2, fLogPelsY2, fScaleX, fScaleY: Double;
SavedBookMark: TBookmark;
PBm1, PBm2: TPolyBookmark;
PSX1, PSY1, PSX2, PSY2: Integer;
FirstPage, AWordWrap: Boolean;
PolyPolyPoints: array of TPoint;//TList;
PolyLengths: array of DWORD;
TitleRect, FooterRect: TRect;
PrnColumns: TColumnsEhList;
// PrnColumnWidths: TList;
PrnColumnWidths: array of Integer;
FooterValues: TFooterValues;
FSubstituted: Boolean;
BeforeGridTextStream, AfterGridTextStream: TStream;
CalcInfoMode: Boolean;
PageCount: Integer;
ACursor: TCursor;
RenderMetafie: TMetafile;
RenderCanvas: TMetafileCanvas;
VPrinter_Canvas: TCanvas;
const Macros: array[0..5] of String = ('&[Page]', '&[ShortDate]', '&[Date]',
'&[LongDate]', '&[Time]', '&[Pages]');
procedure CreateRenderCanvas;
begin
RenderMetafie := TMetafile.Create;
RenderCanvas := TMetafileCanvas.Create(RenderMetafie, VPrinter.Canvas.Handle);
RenderCanvas.Font.PixelsPerInch := VPrinter.Canvas.Font.PixelsPerInch;
VPrinter_Canvas := RenderCanvas;
end;
procedure FreeRenderCanvas;
begin
VPrinter_Canvas := VPrinter.Canvas;
FreeAndNil(RenderCanvas);
FreeAndNil(RenderMetafie);
end;
procedure InitMacroValues;
begin
MacroValues[1] := DateToStr(Now);
MacroValues[2] := DateToStr(Now);
MacroValues[3] := FormatDateTime(LongDateFormat, Now);
MacroValues[4] := TimeToStr(Now);
MacroValues[5] := IntToStr(PageCount);
end;
procedure InitPolyBookmark(var APBm: TPolyBookmark);
var idx: Integer;
begin
if DBGridEh.DataSource.DataSet.Eof then
begin
APBm.InDS := False;
APBm.bm := nil; //nil;
if (DBGridEh.FooterRowCount = 0)
then APBm.EOF := True
else
begin
APBm.bm := Pointer(0); //Pointer(0);
APBm.EOF := False;
end;
end else
begin
if DBGridEh.Selection.SelectionType = gstRecordBookmarks then
begin
if DBGridEh.SelectedRows.Find(DBGridEh.DataSource.DataSet.Bookmark, idx) then
APBm.bm := DBGridEh.DataSource.DataSet.Bookmark
else
begin
APBm.bm := DBGridEh.SelectedRows[0];
DBGridEh.DataSource.DataSet.Bookmark := DBGridEh.SelectedRows[0];
end
end else if DBGridEh.Selection.SelectionType = gstRectangle then
begin
APBm.bm := DBGridEh.Selection.Rect.TopRow;
DBGridEh.DataSource.DataSet.Bookmark := DBGridEh.Selection.Rect.TopRow;
end else
begin
APBm.bm := DBGridEh.DataSource.DataSet.Bookmark;
end;
APBm.InDS := True;
APBm.EOF := False;
end;
end;
procedure GotoPolyBookmark(var APBm: TPolyBookmark);
begin
if (APBm.InDS = True) then
DBGridEh.DataSource.DataSet.Bookmark := APBm.bm;
end;
procedure SetNextPolyBookmark(var APBm: TPolyBookmark);
var idx: Integer;
begin
if APBm.EOF then Exit;
if (APBm.InDS = True) then
begin
if DBGridEh.Selection.SelectionType = gstRecordBookmarks then
begin
if DBGridEh.SelectedRows.Find(DBGridEh.DataSource.DataSet.Bookmark, idx) then
if idx = DBGridEh.SelectedRows.Count - 1 then
begin
APBm.InDS := False;
APBm.bm := nil; //nil;
if (DBGridEh.FooterRowCount = 0)
then APBm.EOF := True
else begin
APBm.bm := Pointer(0); //Pointer(0);
APBm.EOF := False;
end;
end
else
begin
DBGridEh.DataSource.DataSet.Bookmark := DBGridEh.SelectedRows[idx + 1];
APBm.bm := DBGridEh.DataSource.DataSet.Bookmark;
APBm.EOF := False;
end
else
begin
DBGridEh.DataSource.DataSet.Bookmark := DBGridEh.SelectedRows[0];
APBm.bm := DBGridEh.DataSource.DataSet.Bookmark;
APBm.EOF := False;
end;
end else if DBGridEh.Selection.SelectionType = gstRectangle then
begin
DBGridEh.DataSource.DataSet.Next;
// if (DBGridEh.DataSource.DataSet.CompareBookmarks(Pointer(DBGridEh.Selection.Rect.BottomRow),
if (DataSetCompareBookmarks(
DBGridEh.DataSource.DataSet,
DBGridEh.Selection.Rect.BottomRow,
DBGridEh.DataSource.DataSet.Bookmark) < 0) or
DBGridEh.DataSource.DataSet.Eof then
begin
APBm.InDS := False;
APBm.bm := nil; //nil;
if (DBGridEh.FooterRowCount = 0) then APBm.EOF := True
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?