syneditprint.pas

SynEditStudio delphi 代码编辑器

procedure TSynEditPrint.SetHighlighter(const Value: TSynCustomHighlighter);
begin
  FHighlighter := Value;
  FRangesOK := False;
  FPagesCounted := False;
end;

procedure TSynEditPrint.InitPrint;
{ Initialize Font.PixelsPerInch, Character widths, Margins, Total Page count,
  headers and footers}
var
  TmpSize: Integer;
{$IFNDEF SYN_CLX}
  TmpTextMetrics: TTextMetric;
{$ENDIF}
begin
//  FDefaultBG := FCanvas.Brush.Color;                                          // djlp 2000-09-20
  fFontColor := FFont.Color;                                                    // djlp 2000-09-20
  FCanvas.Font.Assign(FFont);
  if not FPrinting then
  begin
    SetPixelsPrInch;
    TmpSize := FCanvas.Font.Size;
    FCanvas.Font.PixelsPerInch := FFont.PixelsPerInch;
    FCanvas.Font.Size := TmpSize;
  end;
  {************}
  // Calculate TextMetrics with the (probably) most wider text styles so text is
  // never clipped (although potentially wasting space)
  FCanvas.Font.Style := [fsBold, fsItalic, fsUnderline, fsStrikeOut];
{$IFDEF SYN_CLX}
  CharWidth := FCanvas.TextWidth( 'W' );
  FLineHeight := FCanvas.TextHeight( 'Wp? );
{$ELSE}
  GetTextMetrics(FCanvas.Handle, TmpTextMetrics);
  CharWidth := TmpTextMetrics.tmAveCharWidth;
  FLineHeight := TmpTextMetrics.tmHeight + TmpTextMetrics.tmExternalLeading;
{$ENDIF}
  FCanvas.Font.Style := FFont.Style;
  FMargins.InitPage(FCanvas, 1, FPrinterInfo, FLineNumbers, FLineNumbersInMargin,
    FLines.Count - 1 + FLineOffset);
  CalcPages;
  FHeader.InitPrint(FCanvas, FPageCount, FTitle, FMargins);
  FFooter.InitPrint(FCanvas, FPageCount, FTitle, FMargins);
  FSynOK := Highlight and Assigned(FHighLighter) and (FLines.Count > 0);
end;

procedure TSynEditPrint.SetPixelsPrInch;
var
  TmpSize: Integer;
begin
  FHeader.SetPixPrInch(FPrinterInfo.YPixPrInch);
  FFooter.SetPixPrInch(FPrinterInfo.YPixPrInch);
  //This should be necessary - else size would be changed...
  TmpSize := FFont.Size;
  FFont.PixelsPerInch := FPrinterInfo.YPixPrInch;
  FFont.Size := TmpSize;
end;

procedure TSynEditPrint.InitRanges;
//Initialize ranges in Highlighter
var
  i: Integer;
begin
  if (not FRangesOK) and Assigned(FHighlighter) and (Lines.Count > 0) then begin
    FHighlighter.ResetRange;
    FLines.Objects[0] := fHighlighter.GetRange;
    i := 1;
    while (i < Lines.Count) do begin
      FHighlighter.SetLine(FLines[i - 1], i - 1);
      FHighlighter.NextToEol;
      FLines.Objects[i] := FHighlighter.GetRange;
      Inc(i);
    end;
    FRangesOK := True;
  end;
end;

procedure TSynEditPrint.CalcPages;
{Calculates the total number of pages.}
var
  AStr, Text: string;
  StrWidth, i: Integer;
  j: Integer;
  AList: TList;
  YPos: Integer;
  PageLine: TPageLine;

  procedure CountWrapped;
  //Counts the number of lines a line is wrapped to
  var
    j: Integer;
  begin
    for j := 0 to AList.Count - 1 do
      YPos := YPos + FLineHeight;
  end;

var
  iStartLine, iEndLine: integer;
  iSelStart, iSelLen: integer;
begin
  InitRanges;
  for i := 0 to FPages.Count - 1 do
    TPageLine(FPages[i]).Free;
  FPages.Clear;
  FMaxWidth := FMargins.PRight - FMargins.PLeft;
  AStr := '';
  FMaxCol := 0;
  while FCanvas.TextWidth(AStr) < FMaxWidth do begin
    AStr := AStr + 'W';
    FMaxCol := FMaxCol + 1;
  end;
  FMaxCol := FMaxCol - 1;
  {FTestString is used to Calculate MaxWidth when prewiewing and printing -
   else the length is not calculated correctly when prewiewing and the
   zoom is different from 0.25,0.5,1,2,4 (as for example 1.20) - WHY???}
//  fTestString := StringOfChar('W', FMaxCol);
  AStr := StringOfChar('W', FMaxCol);
  FMaxWidth := FCanvas.TextWidth(AStr);
  {************}
  FPageCount := 1;
  PageLine := TPageLine.Create;
  PageLine.FirstLine := 0;
  FPages.Add(PageLine);
  YPos := FMargins.PTop;
  if SelectedOnly then
  begin
    iStartLine := fBlockBegin.Line -1;
    iEndLine := fBlockEnd.Line -1;
  end
  else begin
    iStartLine := 0;
    iEndLine := Lines.Count -1;
  end;
  for i := iStartLine to iEndLine do
  begin
    if (not fSelectedOnly or (fSelMode = smLine)) then
      Text := Lines[i]
    else
    begin
      if (fSelMode = smColumn) or (i = fBlockBegin.Line -1) then
        iSelStart := fBlockBegin.Char
      else
        iSelStart := 1;
      if (fSelMode = smColumn) or (i = fBlockEnd.Line -1) then
        iSelLen := fBlockEnd.Char  - iSelStart
      else
        iSelLen := MaxInt;
      Text := Copy( Lines[i], iSelStart, iSelLen );
    end;
      {if new page then increase FPageCount and save the top-line number in
       FPages}
    if (YPos + FLineHeight > FMargins.PBottom) then
    begin
      YPos := FMargins.PTop;
      FPageCount := FPageCount + 1;
      PageLine := TPageLine.Create;
      PageLine.FirstLine := i;
      FPages.Add(PageLine);
    end;
    StrWidth := FCanvas.TextWidth(Text);
    {Check for wrap}
    if Wrap and (StrWidth > FMaxWidth) then
    begin
      AList := TList.Create;
      //修正 只使用一只换行函数就可以
      if WrapTextEx(Text, [], FMaxCol, AList) then
        CountWrapped;
//      if WrapTextEx(Text, [' ', '-', #9, ','], FMaxCol, AList) then
//        CountWrapped
//      else begin
              {If WrapTextToList didn't succed with the first set of breakchars
               then try this one:}
//        if WrapTextEx(Text, [';', ')', '.'], FMaxCol, AList) then
//          CountWrapped
//        else begin
                  {If WrapTextToList didn't succed at all, then do it the
                   primitive way}
//          while Length(Text) > 0 do begin
//            AStr := Copy(Text, 1, FMaxCol);
//            Delete(Text, 1, FMaxCol);
//            if Length(Text) > 0 then
//              YPos := YPos + FLineHeight;
//          end;
//       end;
//      end;
      for j := 0 to AList.Count - 1 do
        TWrapPos(AList[j]).Free;
      AList.Free;
    end;
    YPos := YPos + FLineHeight;
  end;
  FPagesCounted := True;
end;

procedure TSynEditPrint.WriteLineNumber;
{Writes the line number. FMargins. PLeft is the position of the left margin
 (which is automatically incremented by the length of the linenumber text, if
  the linenumbers should not be placed in the margin)}
var
  AStr: string;
begin
  SaveCurrentFont;
  AStr := IntToStr(FLineNumber + FLineOffset) + ': ';
  FCanvas.Brush.Color := FDefaultBG; 
  FCanvas.Font.Style := [];
  FCanvas.Font.Color := clBlack;
  FCanvas.TextOut(FMargins.PLeft - FCanvas.TextWidth(AStr), FYPos, AStr);
  RestoreCurrentFont;
end;

procedure TSynEditPrint.HandleWrap(Text: string; MaxWidth: Integer);
//Handles wrapping when printing
var
//  AStr: string;
  AList: TList;
  j: Integer;
{
  procedure WrapPrimitive;
  var
    i: Integer;
    WrapPos: TWrapPos;
  begin
    i := 1;
    while i <= Length(Text) do begin
      AStr := '';
      while (Length(AStr) < FMaxCol) and (i <= Length(Text)) do begin
        AStr := AStr + Text[i];
        i := i + 1;
      end;
      WrapPos := TWrapPos.Create;
      WrapPos.Index := i - 1;
      AList.Add(WrapPos);
      if (Length(AStr) - i) <= FMaxCol then
        Break;
    end;
  end;
}
begin
//  AStr := '';
  //First try to break the string at the following chars:
  AList := TList.Create;
  //修正 只使用一只换行函数就可以
  if WrapTextEx(Text, [], FMaxCol, AList) then
    TextOut(Text, AList);
//  if WrapTextEx(Text, [' ', '-', #9, ','], FMaxCol, AList) then
//    TextOut(Text, AList)
//  else begin
      //Then try to break the string at the following chars:
//    if WrapTextEx(Text, [';', ')', '.'], FMaxCol, AList) then
//      TextOut(Text, AList)
//    else begin
//      WrapPrimitive;
///        TextOut(Text, AList)
//    end;
//  end;
  for j := 0 to AList.Count - 1 do
    TWrapPos(Alist[j]).Free;
  AList.Free;
end;

procedure TSynEditPrint.SaveCurrentFont;
//Used to temporarely save the font of the canvas
begin
  FOldFont.Assign(FCanvas.Font);
end;

procedure TSynEditPrint.RestoreCurrentFont;
//Used to restore the font of the canvas
begin
  FCanvas.Font.Assign(FOldFont);
end;

function TSynEditPrint.ClipLineToRect(S: string; R: TRect): string;
begin
 while FCanvas.TextWidth(S) > FMaxWidth do
    SetLength(S, Length(S) - 1);  

  Result := S;
end;

procedure TSynEditPrint.TextOut(Text: string; AList: TList);
//Does the actual printing
var
  Token: string;
  TokenPos: Integer;
  Attr: TSynHighlighterAttributes;
  AColor: TColor;
  TokenStart: Integer;
  LCount: Integer;
  Handled: Boolean;
  aStr: string;
  i, WrapPos, OldWrapPos: Integer;
  Lines: TStringList;
  ClipRect: TRect;

  procedure ClippedTextOut(X, Y: Integer; Text: string);
  begin
    Text := ClipLineToRect(Text, ClipRect);
    {$IFDEF SYN_CLX}
    FCanvas.TextOut(X, Y, Text);
    {$ELSE}
    ExtTextOut(FCanvas.Handle, X, Y, 0, nil, PChar(Text), Length(Text), @FETODist[0]);
    {$ENDIF}
  end;

  procedure SplitToken;
  var
    AStr: string;
    Last: Integer;
    FirstPos: Integer;
    TokenEnd: Integer;
  begin
    Last := TokenPos;
    FirstPos := TokenPos;
    TokenEnd := TokenPos + Length(Token);
    while (LCount < AList.Count) and (TokenEnd > TWrapPos(AList[LCount]).Index) do begin
//      AStr := Copy(Text, Last + 1, TWrapPos(AList[LCount]).Index - Last);       //DDH 10/16/01 added fix from Oliver Grahl
      AStr := Copy(Text, Last + 1, TWrapPos(AList[LCount]).Index - Last + 1);       //DDH 10/16/01 added fix from Oliver Grahl
      Last := TWrapPos(AList[LCount]).Index;                                    //DDH 10/16/01 added fix from Oliver Grahl
      {************}
      ClippedTextOut(FMargins.PLeft + FirstPos * FCharWidth, FYPos, AStr);
      FirstPos := 0;
      LCount := LCount + 1;
      FYPos := FYPos + FLineHeight;
    end;
    AStr := Copy(Text, Last + 1, TokenEnd - Last);                              //DDH 10/16/01 added fix from Oliver Grahl
    {************}
    ClippedTextOut(FMargins.PLeft + FirstPos * FCharWidth, FYPos, AStr);
    //Ready for next token:
    TokenStart := TokenPos + Length(Token) - Length(AStr);
  end;
begin
  with FMargins do
    ClipRect := Rect(PLeft, PTop, PRight, PBottom);

  if FSynOK then
  begin
    SaveCurrentFont;
    FHighlighter.SetRange(FLines.Objects[FLineNumber - 1]);
    FHighlighter.SetLine(Text, FLineNumber);
    Token := '';
    TokenStart := 0;
    LCount := 0;
    while not FHighLighter.GetEol do
    begin
      Token := FHighLighter.GetToken;
      TokenPos := FHighLighter.GetTokenPos;

      //网友 包伟
      if (ByteType(Token, 1) = mbLeadByte ) and (length(token) = 1) then //bw 20061014
      begin
        FHighLighter.Next;//把后面的半个汉字接上
        token := token + FHighlighter.GetToken;
      end;