syneditprintheaderfooter.pas

一个非常好的c++编译器

    FFrameHeight := Max(FFrameHeight, FOrgHeight + ACanvas.TextHeight('W'));
  end;
  FFrameHeight := FFrameHeight + 2 * FMargins.PHFInternalMargin;
end;

function CompareItems(Item1, Item2: Pointer): Integer;
//Used to sort header/footer items
begin
  Result := THeaderFooterItem(Item1).LineNumber - THeaderFooterItem(Item2).LineNumber;
end;

procedure THeaderFooter.SetPixPrInch(Value: Integer);
var
  i, TmpSize: Integer;
  AFont: TFont;
begin
  for i := 0 to FItems.Count - 1 do begin
    AFont := THeaderFooterItem(FItems[i]).Font;
    TmpSize := AFont.Size;
    AFont.PixelsPerInch := Value;
    AFont.Size := TmpSize;
  end;
end;

procedure THeaderFooter.InitPrint(ACanvas: TCanvas; NumPages: Integer; Title: string;
  Margins: TSynEditPrintMargins);
begin
  SaveFontPenBrush(ACanvas);
  FDate := DateToStr(Now);
  FTime := TimeToStr(Now);
  FNumPages := NumPages;
  FMargins := Margins;
  FTitle := Title;
  FItems.Sort(CompareItems);
  FixLines;
  CalcHeight(ACanvas);
  RestoreFontPenBrush(ACanvas);
end;

procedure THeaderFooter.SaveFontPenBrush(ACanvas: TCanvas);
begin
  FOldFont.Assign(ACanvas.Font);
  FOldPen.Assign(ACanvas.Pen);
  FOldBrush.Assign(ACanvas.Brush);
end;

procedure THeaderFooter.RestoreFontPenBrush(ACanvas: TCanvas);
begin
  ACanvas.Font.Assign(FOldFont);
  ACanvas.Pen.Assign(FOldPen);
  ACanvas.Brush.Assign(FOldBrush);
end;

procedure THeaderFooter.DrawFrame(ACanvas: TCanvas);
//Draws frame around header/footer
begin
  if (FrameTypes = []) then Exit;
  with ACanvas, FMargins do begin
    Pen.Color := LineColor;
    Brush.Color := ShadedColor;
    if ftShaded in FrameTypes then
      Brush.Style := bsSolid
    else
      Brush.Style := bsClear;
    if ftBox in FrameTypes then
      Pen.Style := psSolid
    else
      Pen.Style := psClear;
    if FrameTypes * [ftBox, ftShaded] <> [] then begin
      if FType = hftHeader then
        Rectangle(PLeft, PHeader - FFrameHeight, PRight, PHeader)
      else
        Rectangle(PLeft, PFooter, PRight, PFooter + FFrameHeight);
    end;
    if ftLine in FrameTypes then begin
      Pen.Style := psSolid;
      if FType = hftHeader then begin
        MoveTo(PLeft, PHeader);
        LineTo(PRight, PHeader);
      end
      else begin
        MoveTo(PLeft, PFooter);
        LineTo(PRight, PFooter);
      end
    end;
  end;
end;

procedure THeaderFooter.Print(ACanvas: TCanvas; PageNum: Integer);
//Prints the header/footer
var
  i, X, Y, CurLine: Integer;
  AStr: string;
  AItem: THeaderFooterItem;
{$IFNDEF SYN_CLX}
  OldAlign: UINT;
{$ENDIF}
  TheAlignment: TAlignment;
begin
  if (FFrameHeight <= 0) then Exit; //No header/footer
  SaveFontPenBrush(ACanvas);
  DrawFrame(ACanvas);
  ACanvas.Brush.Style := bsClear;
  if FType = hftHeader then
    Y := FMargins.PHeader - FFrameHeight
  else
    Y := FMargins.PFooter;
  Y := Y + FMargins.PHFInternalMargin; //Add the specified internal margin

  CurLine := 1;
  for i := 0 to FItems.Count - 1 do begin
    AItem := THeaderFooterItem(FItems[i]);
    ACanvas.Font := AItem.Font;
    if AItem.LineNumber <> CurLine then begin
      Y := Y + TLineInfo(FLineInfo[CurLine - 1]).LineHeight;
      CurLine := AItem.LineNumber;
    end;
    AStr := AItem.GetText(FNumPages, PageNum, FRomanNumbers, FTitle, FTime, FDate);
      //Find the alignment of the header/footer item - check for MirrorPosition
    TheAlignment := AItem.Alignment;
    if MirrorPosition and ((PageNum mod 2) = 0) then begin
      case AItem.Alignment of
        taRightJustify: TheAlignment := taLeftJustify;
        taLeftJustify: TheAlignment := taRightJustify;
      end;
    end;
      //Find X-position of text
    with FMargins do begin
      X := PLeftHFTextIndent;
      case TheAlignment of
        taRightJustify: X := PRightHFTextIndent - ACanvas.TextWidth(AStr);
        taCenter: X := (PLeftHFTextIndent + PRightHFTextIndent - ACanvas.TextWidth(AStr)) div 2;
      end;
    end;
      {Aligning at base line - Fonts can have different size in headers and footers}
    {************}
  {$IFNDEF SYN_CLX}
    OldAlign := SetTextAlign(ACanvas.Handle, TA_BASELINE);
  {$ENDIF}
    ACanvas.TextOut(X, Y + TLineInfo(FLineInfo[CurLine - 1]).MaxBaseDist, AStr);
    {************}
  {$IFNDEF SYN_CLX}
    SetTextAlign(ACanvas.Handle, OldAlign);
  {$ENDIF}
  end;
  RestoreFontPenBrush(ACanvas);
end;

procedure THeaderFooter.Assign(Source: TPersistent);
var
  Src: THeaderFooter;
  i: Integer;
begin
  if (Source <> nil) and (Source is THeaderFooter) then begin
    Src := THeaderFooter(Source);
    Clear;
    FType := Src.FType;
    FFrameTypes := Src.FFrameTypes;
    FShadedColor := Src.FShadedColor;
    FLineColor := Src.FLineColor;
    for i := 0 to Src.FItems.Count - 1 do begin
      with THeaderFooterItem(Src.FItems[i]) do
        Add(Text, Font, Alignment, LineNumber);
    end;
    FDefaultFont.Assign(Src.FDefaultFont);
    FRomanNumbers := Src.FRomanNumbers;
    FMirrorPosition := Src.FMirrorPosition;
  end else
    inherited Assign(Source);
end;

function THeaderFooter.Count: Integer;
begin
  Result := FItems.Count;
end;

function THeaderFooter.Get(Index: Integer): THeaderFooterItem;
begin
  Result := THeaderFooterItem(FItems[Index]);
end;

{begin}                                                                         //gp 2000-06-24
function THeaderFooter.GetAsString: string;
var
  i: integer;
begin
  FixLines;
  Result := '';
  for i := 0 to FItems.Count - 1 do begin
    if Result <> '' then Result := Result + '/';
    Result := Result + EncodeString(THeaderFooterItem(FItems[i]).AsString);
  end; //for
end;

procedure THeaderFooter.SetAsString(const Value: string);
var
  item: THeaderFooterItem;
  s: string;
begin
  Clear;
  item := THeaderFooterItem.Create;
  try
    s := Value;
    while s <> '' do begin
      item.AsString := DecodeString(GetFirstEl(s, '/'));
      Add(item.Text, item.Font, item.Alignment, item.LineNumber);
    end; //while
  finally
    item.Free;
  end;
end;
{end}                                                                           //gp 2000-06-24

procedure THeaderFooter.LoadFromStream(AStream: TStream);
var
  Num, idx: integer;
  aCharset: TFontCharset;
  aColor: TColor;
  aHeight: Integer;
  aName: TFontName;
  aPitch: TFontPitch;
  aSize: Integer;
  aStyle: TFontStyles;
  bufSize : integer;
  buffer : PChar;
begin
  with AStream do begin
    // read header/footer properties first
    Read(FFrameTypes, SizeOf(FFrameTypes));
    Read(FShadedColor, SizeOf(FShadedColor));
    Read(FLineColor, SizeOf(FLineColor));
    Read(FRomanNumbers, SizeOf(FRomanNumbers));
    Read(FMirrorPosition, SizeOf(FMirrorPosition));
    // font
    Read(aCharset, SizeOf(aCharset));
    Read(aColor, SizeOf(aColor));
    Read(aHeight, SizeOf(aHeight));
    Read(bufSize, SizeOf(bufSize));
    GetMem(buffer, bufSize+1);
    try
      Read(buffer^, bufSize);
      buffer[bufSize] := #0;
      aName := buffer;
    finally
      FreeMem(buffer);
    end;
    Read(aPitch, SizeOf(aPitch));
    Read(aSize, SizeOf(aSize));
    Read(aStyle, SizeOf(aStyle));
    {$IFDEF SYN_COMPILER_3_UP}
    FDefaultFont.Charset := aCharset;
    {$ENDIF}
    FDefaultFont.Color   := aColor;
    FDefaultFont.Height  := aHeight;
    FDefaultFont.Name    := aName;
    FDefaultFont.Pitch   := aPitch;
    FDefaultFont.Size    := aSize;
    FDefaultFont.Style   := aStyle;
    // now read in the items
    Read(Num, SizeOf(Num));
    while Num > 0 do begin
      // load headerfooter items from stream
      idx := Add('', nil, taLeftJustify, 1);
      Get(idx).LoadFromStream(AStream);
      Dec(Num);
    end;
  end;
end;

procedure THeaderFooter.SaveToStream(AStream: TStream);
var
  i, Num: integer;
  aCharset: TFontCharset;
  aColor: TColor;
  aHeight: Integer;
  aName: TFontName;
  aPitch: TFontPitch;
  aSize: Integer;
  aStyle: TFontStyles;
  aLen : integer;
begin
  with AStream do begin
    // write the header/footer properties first
    Write(FFrameTypes, SizeOf(FFrameTypes));
    Write(FShadedColor, SizeOf(FShadedColor));
    Write(FLineColor, SizeOf(FLineColor));
    Write(FRomanNumbers, SizeOf(FRomanNumbers));
    Write(FMirrorPosition, SizeOf(FMirrorPosition));
    // font
    {$IFDEF SYN_COMPILER_3_UP}
    aCharset := FDefaultFont.Charset;
    {$ELSE}
    aCharSet := DEFAULT_CHARSET;
    {$ENDIF}
    aColor   := FDefaultFont.Color;
    aHeight  := FDefaultFont.Height;
    aName    := FDefaultFont.Name;
    aPitch   := FDefaultFont.Pitch;
    aSize    := FDefaultFont.Size;
    aStyle   := FDefaultFont.Style;
    Write(aCharset, SizeOf(aCharset));
    Write(aColor, SizeOf(aColor));
    Write(aHeight, SizeOf(aHeight));
    aLen := Length(aName);
    Write(aLen, SizeOf(aLen));
    {$IFDEF SYN_COMPILER_2}                    // In D2 TFontName is a ShortString
    Write(PChar(@aName[1])^, Length(aName));   // D2 cannot convert ShortStrings to PChar
    {$ELSE}
    Write(PChar(aName)^, Length(aName));
    {$ENDIF}
    Write(aPitch, SizeOf(aPitch));
    Write(aSize, SizeOf(aSize));
    Write(aStyle, SizeOf(aStyle));

    // now write the items
    Num := Count;
    Write(Num, SizeOf(Num));
    for i := 0 to Num - 1 do
      Get(i).SaveToStream(AStream);
  end;
end;

{ THeader }

constructor THeader.Create;
begin
  inherited;
  FType := hftHeader;
end;

{ TFooter }

constructor TFooter.Create;
begin
  inherited;
  FType := hftFooter;
end;

end.