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 + -
显示快捷键?