syneditprintheaderfooter.pas

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

      if Roman then
        DoAppend(IntToRoman(NumPages))
      else
        DoAppend(IntToStr(NumPages));
      Exit;
    end;
    if Macro = '$TITLE$' then begin
      DoAppend(Title);
      Exit;
    end;
    if Macro = '$DATE$' then begin
      DoAppend(ADate);
      Exit;
    end;
    if Macro = '$TIME$' then begin
      DoAppend(ATime);
      Exit;
    end;
    if Macro = '$DATETIME$' then begin
      DoAppend(ADate + ' ' + ATime);
      Exit;
    end;
    if Macro = '$TIMEDATE$' then begin
      DoAppend(ATime + ' ' + ADate);
      Exit;
    end;
    Result := FALSE;
  end;

begin
  Result := '';
  AStr := FText;
  if Trim(AStr) = '' then
    Exit;
  // parse the line
  Len := Length(AStr);
  if Len > 0 then begin
      // start with left-aligned text
    Start := 1;
    Run := 1;
    while Run <= Len do begin
          // test for embedded macro
      if AStr[Run] = '$' then begin
        TryAppend(Start, Run);
        Inc(Run);
          // search for next '$' which could mark the end of a macro
        while Run <= Len do begin
          if AStr[Run] = '$' then begin
            // if this is a macro execute it and skip the chars from output
            if TryExecuteMacro then begin
              Inc(Run); // also the '$'
              Start := Run;
              break;
            end else begin
                // this '$' might again be the start of a macro
              TryAppend(Start, Run);
              Inc(Run);                                                         //ek 2001-08-02
            end;
          end else
            Inc(Run);
        end;
      end else
        Inc(Run);
    end;
    TryAppend(Start, Run);
  end;
end;

{begin}                                                                         //gp 2000-06-24
procedure THeaderFooterItem.LoadFromStream(AStream: TStream);
var
  aCharset: TFontCharset;
  aColor: TColor;
  aHeight: Integer;
  aName: TFontName;
  aPitch: TFontPitch;
  aSize: Integer;
  aStyle: TFontStyles;
  bufSize : integer;
  buffer : PChar;
begin
  with AStream do begin
    Read(bufSize, SizeOf(bufSize));
    GetMem(buffer, bufSize+1);
    try
      Read(buffer^, bufSize);
      buffer[bufSize] := #0;
      FText := buffer;
    finally
      FreeMem(buffer);
    end;
    Read(FLineNumber, SizeOf(FLineNumber));
    // 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}
    FFont.Charset := aCharset;
    {$ENDIF}
    FFont.Color   := aColor;
    FFont.Height  := aHeight;
    FFont.Name    := aName;
    FFont.Pitch   := aPitch;
    FFont.Size    := aSize;
    FFont.Style   := aStyle;
    Read(FAlignment, SizeOf(FAlignment));
  end;
end;

procedure THeaderFooterItem.SaveToStream(AStream: TStream);
var
  aCharset: TFontCharset;
  aColor: TColor;
  aHeight: Integer;
  aName: TFontName;
  aPitch: TFontPitch;
  aSize: Integer;
  aStyle: TFontStyles;
  aLen : integer;
begin
  with AStream do begin
    aLen := Length(FText);
    Write(aLen, SizeOf(aLen));
    Write(PChar(FText)^, aLen);
    Write(FLineNumber, SizeOf(FLineNumber));
    // font
    {$IFDEF SYN_COMPILER_3_UP}
    aCharset := FFont.Charset;
    {$ELSE}
    aCharset := DEFAULT_CHARSET;
    {$ENDIF}
    aColor   := FFont.Color;
    aHeight  := FFont.Height;
    aName    := FFont.Name;
    aPitch   := FFont.Pitch;
    aSize    := FFont.Size;
    aStyle   := FFont.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])^, aLen);   // D2 cannot convert ShortStrings to PChar
    {$ELSE}
    Write(PChar(aName)^, aLen);
    {$ENDIF}
    Write(aPitch, SizeOf(aPitch));
    Write(aSize, SizeOf(aSize));
    Write(aStyle, SizeOf(aStyle));
    Write(FAlignment, SizeOf(FAlignment));
  end;
end;

procedure THeaderFooterItem.SetAsString(const Value: string);
var
  s: string;
  sty: TFontStyles;
begin
  s := Value;
  FText := DecodeString(GetFirstEl(s, '/'));
{$IFDEF SYN_COMPILER_3_UP}
{$IFDEF SYN_CLX}
  GetFirstEl(s, '/');
{$ELSE}
  FFont.Charset := StrToIntDef(GetFirstEl(s, '/'), 0);
{$ENDIF}
{$ELSE}
  GetFirstEl(s, '/');
{$ENDIF}
  FFont.Color := StrToIntDef(GetFirstEl(s, '/'), 0);
  FFont.Height := StrToIntDef(GetFirstEl(s, '/'), 0);
  FFont.Name := DecodeString(GetFirstEl(s, '/'));
  FFont.Pitch := TFontPitch(StrToIntDef(GetFirstEl(s, '/'), 0));
  FFont.PixelsPerInch := StrToIntDef(GetFirstEl(s, '/'), 0);
  FFont.Size := StrToIntDef(GetFirstEl(s, '/'), 0);
  byte(sty) := StrToIntDef(GetFirstEl(s, '/'), 0);
  FFont.Style := sty;
  FLineNumber := StrToIntDef(GetFirstEl(s, '/'), 0);
  FAlignment := TAlignment(StrToIntDef(GetFirstEl(s, '/'), 0));
end;
{end}                                                                           //gp 2000-06-24

procedure THeaderFooterItem.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;

{ THeaderFooter }

constructor THeaderFooter.Create;
begin
  inherited;
  FFrameTypes := [ftLine];
  FShadedColor := clSilver;
  FLineColor := clBlack;
  FItems := TList.Create;
  FDefaultFont := TFont.Create;
  FOldPen := TPen.Create;
  FOldBrush := TBrush.Create;
  FOldFont := TFont.Create;
  FRomanNumbers := False;
  FMirrorPosition := False;
  FLineInfo := TList.Create;
  with FDefaultFont do begin
    Name := 'Arial';
    Size := 10;
    Color := clBlack;
  end;
end;

destructor THeaderFooter.Destroy;
var
  i: Integer;
begin
  Clear;
  FItems.Free;
  FDefaultFont.Free;
  FOldPen.Free;
  FOldBrush.Free;
  FOldFont.Free;
  for i := 0 to FLineInfo.Count - 1 do
    TLineInfo(FLineInfo[i]).Free;
  FLineInfo.Free;
  inherited;
end;

function THeaderFooter.Add(Text: string; Font: TFont;
  Alignment: TAlignment; LineNumber: Integer): Integer;
var
  AItem: THeaderFooterItem;
begin
  AItem := THeaderFooterItem.Create;
  if Font = nil then
    AItem.Font := FDefaultFont
  else
    AItem.Font := Font;
  AItem.Alignment := Alignment;
  AItem.LineNumber := LineNumber;
  AItem.FIndex := FItems.Add(AItem);
  AItem.Text := Text;
  Result := AItem.FIndex;
end;

procedure THeaderFooter.Delete(Index: Integer);
var
  i: Integer;
begin
  for i := 0 to FItems.Count - 1 do begin
    if THeaderFooterItem(FItems[Index]).FIndex = Index then begin
      FItems.Delete(i);
      Break;
    end;
  end;
end;

procedure THeaderFooter.Clear;
var
  i: Integer;
begin
  for i := 0 to FItems.Count - 1 do
    THeaderFooterItem(FItems[i]).Free;
  FItems.Clear;
end;

procedure THeaderFooter.SetDefaultFont(const Value: TFont);
begin
  FDefaultFont.Assign(Value);
end;

procedure THeaderFooter.FixLines;
{Counts number of lines in header/footer and changes the line-number so they
 start with 1 (the user might add header/footer items starting at line 2)}
var
  i, CurLine: Integer;
  LineInfo: TLineInfo;
begin
  for i := 0 to FLineInfo.Count - 1 do
    TLineInfo(FLineInfo[i]).Free;
  FLineInfo.Clear;
  CurLine := 0;
  FLineCount := 0;
  for i := 0 to FItems.Count - 1 do begin
    if THeaderFooterItem(FItems[i]).LineNumber <> CurLine then begin
      CurLine := THeaderFooterItem(FItems[i]).LineNumber;
      FLineCount := FLineCount + 1;
      LineInfo := TLineInfo.Create;
      FLineInfo.Add(LineInfo);
    end;
    THeaderFooterItem(FItems[i]).LineNumber := FLineCount;
  end;
end;

procedure THeaderFooter.CalcHeight(ACanvas: TCanvas);
{Calculates the hight of the header/footer, finds the line height for each line
 and calculates the font baseline where text is to be written}
var
  i, CurLine: Integer;
  AItem: THeaderFooterItem;
  FOrgHeight: Integer;
  {************}
{$IFNDEF SYN_CLX}
  TextMetric: TTextMetric;
{$ENDIF}
begin
  FFrameHeight := -1;
  if FItems.Count <= 0 then Exit;

  CurLine := 1;
  FFrameHeight := 0;
  FOrgHeight := FFrameHeight;
  for i := 0 to FItems.Count - 1 do
  begin
    AItem := THeaderFooterItem(FItems[i]);
    if AItem.LineNumber <> CurLine then
    begin
      CurLine := AItem.LineNumber;
      FOrgHeight := FFrameHeight;
    end;
    ACanvas.Font.Assign(AItem.Font);
    {************}
  {$IFNDEF SYN_CLX}
    GetTextMetrics(ACanvas.Handle, TextMetric);
    with TLineInfo(FLineInfo[CurLine - 1]), TextMetric do
    begin
      LineHeight := Max(LineHeight, ACanvas.TextHeight('W'));
      MaxBaseDist := Max(MaxBaseDist, tmHeight - tmDescent);
    end;
  {$ENDIF}