mirror of
https://github.com/HeidiSQL/HeidiSQL.git
synced 2025-08-06 18:24:26 +08:00
1017 lines
28 KiB
ObjectPascal
1017 lines
28 KiB
ObjectPascal
{-------------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: SynEditPrintHeaderFooter.pas, released 2000-06-01.
|
|
|
|
The Initial Author of the Original Code is Morten J. Skovrup.
|
|
Portions written by Morten J. Skovrup are copyright 2000 Morten J. Skovrup.
|
|
Portions written by Michael Hieke are copyright 2000 Michael Hieke.
|
|
Unicode translation by Maël Hörz.
|
|
All Rights Reserved.
|
|
|
|
Contributors to the SynEdit project are listed in the Contributors.txt file.
|
|
|
|
Alternatively, the contents of this file may be used under the terms of the
|
|
GNU General Public License Version 2 or later (the "GPL"), in which case
|
|
the provisions of the GPL are applicable instead of those above.
|
|
If you wish to allow use of your version of this file only under the terms
|
|
of the GPL and not to allow others to use your version of this file
|
|
under the MPL, indicate your decision by deleting the provisions above and
|
|
replace them with the notice and other provisions required by the GPL.
|
|
If you do not delete the provisions above, a recipient may use your version
|
|
of this file under either the MPL or the GPL.
|
|
|
|
$Id: SynEditPrintHeaderFooter.pas,v 1.10.2.7 2008/09/23 14:02:08 maelh Exp $
|
|
|
|
You may retrieve the latest version of this file at the SynEdit home page,
|
|
located at http://SynEdit.SourceForge.net
|
|
|
|
Known Issues:
|
|
-------------------------------------------------------------------------------}
|
|
|
|
|
|
{-------------------------------------------------------------------------------
|
|
CONTENTS:
|
|
Classes handling info about headers and footers.
|
|
|
|
THeaderFooterItem:
|
|
Class handling an item in a header or footer. An item has a text,Font,
|
|
LineNumber and Alignment (i.e. two items can be on the same line but have
|
|
different fonts). Used internally.
|
|
|
|
THeaderFooter:
|
|
Collection of THeaderFooterItem's
|
|
Design-time properties:
|
|
FrameTypes : Frame around header or footer - can be any combination of:
|
|
ftLine : Line under header or line above footer
|
|
ftBox : Box around header or footer
|
|
ftShaded : Filled box (without frame) around header or footer.
|
|
ShadedColor : Fill color if ftShaded is in FrameTypes
|
|
LineColor : Color of line or box if ftLine or ftBox is in FrameTypes
|
|
DefaultFont : Default font for THeaderFooterItem's. This can be used to
|
|
set the header/footer font once for all items.
|
|
RomanNumbers : Print page numbers as Roman numbers.
|
|
MirrorPosition : Mirror position of left/right aligned THeaderFooterItem's
|
|
Can be used when printing 2-sided.
|
|
Run-time methods:
|
|
function Add(Text: UnicodeString; Font: TFont;
|
|
Alignment: TAlignment;
|
|
LineNumber: Integer) : Integer;
|
|
Add a THeaderFooterItem. If Font is nil or not specified then DefaultFont
|
|
is used. Returned value is the index of the added item.
|
|
The Text parameter can contain the following macros:
|
|
$PAGECOUNT$ : Print total number of pages
|
|
$PAGENUM$ : Print current page number
|
|
$TITLE$ : Print the title
|
|
$DATE$ : Print the date
|
|
$TIME$ : Print the time
|
|
$DATETIME$ : Print the date and then the time
|
|
$TIMEDATE$ : Print the time and then the date
|
|
procedure Delete(Index : Integer);
|
|
Delete THeaderFooterItem with index Index.
|
|
procedure Clear;
|
|
Clear all THeaderFooterItems.
|
|
function Count : Integer;
|
|
Returns number of THeaderFooterItems.
|
|
function Get(Index : Integer) : THeaderFooterItem;
|
|
Returns THeaderFooterItem with Index.
|
|
procedure SetPixPrInch(Value : Integer);
|
|
Corrects the PixPerInch property of fonts. Used internally by
|
|
TSynEditPrint.
|
|
procedure InitPrint(ACanvas : TCanvas;NumPages : Integer; Title : UnicodeString;
|
|
Margins : TSynEditPrintMargins);
|
|
Prepares the header or footer for printing. Used internally by
|
|
TSynEditPrint.
|
|
procedure Print(ACanvas : TCanvas; PageNum : Integer = 0);
|
|
Prints the header or footer. Used internally by TSynEditPrint.
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
{$IFNDEF QSYNEDITPRINTHEADERFOOTER}
|
|
unit SynEditPrintHeaderFooter;
|
|
{$ENDIF}
|
|
{$M+}
|
|
|
|
{$I SynEdit.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF SYN_COMPILER_17_UP}
|
|
UITypes,
|
|
{$ENDIF}
|
|
Windows,
|
|
SynEditPrintTypes,
|
|
SynEditPrintMargins,
|
|
SynUnicode,
|
|
Graphics,
|
|
Classes,
|
|
SysUtils;
|
|
|
|
type
|
|
//An item in a header or footer. An item has a text,Font,LineNumber and
|
|
//Alignment (i.e. two items can be on the same line but have different
|
|
//fonts).
|
|
THeaderFooterItem = class
|
|
private
|
|
FText: UnicodeString;
|
|
FFont: TFont;
|
|
FLineNumber: Integer;
|
|
FAlignment: TAlignment;
|
|
{Used to store the original Index when the item was added - the index
|
|
might change when the list is sorted}
|
|
FIndex: Integer;
|
|
function GetAsString: UnicodeString;
|
|
procedure SetAsString(const Value: UnicodeString);
|
|
procedure SetFont(const Value: TFont);
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function GetText(NumPages, PageNum: Integer; Roman: Boolean;
|
|
Title, ATime, ADate: UnicodeString): UnicodeString;
|
|
procedure LoadFromStream(AStream: TStream);
|
|
procedure SaveToStream(AStream: TStream);
|
|
public
|
|
property Alignment: TAlignment read FAlignment write FAlignment;
|
|
property AsString: UnicodeString read GetAsString write SetAsString;
|
|
property Font: TFont read FFont write SetFont;
|
|
property LineNumber: Integer read FLineNumber write FLineNumber;
|
|
property Text: UnicodeString read FText write FText;
|
|
end;
|
|
|
|
THeaderFooterType = (hftHeader, hftFooter);
|
|
|
|
//Used internally to calculate line height and font-base-line for header and
|
|
//footer
|
|
TLineInfo = class
|
|
public
|
|
LineHeight: Integer;
|
|
MaxBaseDist: Integer;
|
|
end;
|
|
|
|
//The header/footer class
|
|
THeaderFooter = class(TPersistent)
|
|
private
|
|
FType: THeaderFooterType; // Indicates if header or footer
|
|
FFrameTypes: TFrameTypes;
|
|
FShadedColor: TColor;
|
|
FLineColor: TColor;
|
|
FItems: TList;
|
|
FDefaultFont: TFont;
|
|
FDate, FTime: UnicodeString;
|
|
FNumPages: Integer;
|
|
FTitle: UnicodeString;
|
|
FMargins: TSynEditPrintMargins;
|
|
FFrameHeight: Integer;
|
|
FOldPen: TPen;
|
|
FOldBrush: TBrush;
|
|
FOldFont: TFont;
|
|
FRomanNumbers: Boolean;
|
|
FLineInfo: TList;
|
|
FLineCount: Integer;
|
|
FMirrorPosition: Boolean;
|
|
procedure SetDefaultFont(const Value: TFont);
|
|
procedure DrawFrame(ACanvas: TCanvas);
|
|
procedure CalcHeight(ACanvas: TCanvas);
|
|
procedure SaveFontPenBrush(ACanvas: TCanvas);
|
|
procedure RestoreFontPenBrush(ACanvas: TCanvas);
|
|
function GetAsString: UnicodeString;
|
|
procedure SetAsString(const Value: UnicodeString);
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function Add(Text: UnicodeString; Font: TFont; Alignment: TAlignment;
|
|
LineNumber: Integer): Integer;
|
|
procedure Delete(Index: Integer);
|
|
procedure Clear;
|
|
function Count: Integer;
|
|
function Get(Index: Integer): THeaderFooterItem;
|
|
procedure SetPixPrInch(Value: Integer);
|
|
procedure InitPrint(ACanvas: TCanvas; NumPages: Integer; Title: UnicodeString;
|
|
Margins: TSynEditPrintMargins);
|
|
procedure Print(ACanvas: TCanvas; PageNum: Integer);
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure FixLines;
|
|
property AsString: UnicodeString read GetAsString write SetAsString;
|
|
procedure LoadFromStream(AStream: TStream);
|
|
procedure SaveToStream(AStream: TStream);
|
|
published
|
|
property FrameTypes: TFrameTypes read FFrameTypes write FFrameTypes
|
|
default [ftLine];
|
|
property ShadedColor: TColor read FShadedColor write FShadedColor
|
|
default clSilver;
|
|
property LineColor: TColor read FLineColor write FLineColor default clBlack;
|
|
property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
|
|
property RomanNumbers: Boolean read FRomanNumbers write FRomanNumbers
|
|
default False;
|
|
property MirrorPosition: Boolean read FMirrorPosition write FMirrorPosition
|
|
default False;
|
|
end;
|
|
|
|
//The header and footer - does nothing but set the value of FType in
|
|
//THeaderFooter
|
|
THeader = class(THeaderFooter)
|
|
public
|
|
constructor Create;
|
|
end;
|
|
|
|
TFooter = class(THeaderFooter)
|
|
public
|
|
constructor Create;
|
|
end;
|
|
|
|
{$IFNDEF SYN_COMPILER_3_UP}
|
|
TFontCharSet = 0..255;
|
|
{$ENDIF}
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF SYN_COMPILER_4_UP}
|
|
Math,
|
|
{$ENDIF}
|
|
SynEditMiscProcs;
|
|
|
|
// Helper routine for AsString processing.
|
|
function GetFirstEl(var Value: UnicodeString; Delim: WideChar): UnicodeString;
|
|
var
|
|
p: Integer;
|
|
begin
|
|
p := Pos(Delim, Value);
|
|
if p = 0 then
|
|
p := Length(Value) + 1;
|
|
Result := Copy(Value, 1, p - 1);
|
|
Delete(Value, 1, p);
|
|
end;
|
|
|
|
|
|
{ THeaderFooterItem }
|
|
|
|
constructor THeaderFooterItem.Create;
|
|
begin
|
|
inherited;
|
|
FFont := TFont.Create;
|
|
end;
|
|
|
|
destructor THeaderFooterItem.Destroy;
|
|
begin
|
|
inherited;
|
|
FFont.Free;
|
|
end;
|
|
|
|
// Returns string representation of THeaderFooterItem to alleviate storing
|
|
// items into external storage (registry, ini file).
|
|
function THeaderFooterItem.GetAsString: UnicodeString;
|
|
begin
|
|
Result :=
|
|
EncodeString(FText) + '/' +
|
|
{$IFDEF SYN_COMPILER_3_UP}
|
|
IntToStr(FFont.Charset) + '/' +
|
|
{$ELSE}
|
|
IntToStr(DEFAULT_CHARSET)+'/' +
|
|
{$ENDIF}
|
|
IntToStr(FFont.Color) + '/' +
|
|
IntToStr(FFont.Height) + '/' +
|
|
EncodeString(FFont.Name) + '/' +
|
|
IntToStr(Ord(FFont.Pitch)) + '/' +
|
|
IntToStr(FFont.PixelsPerInch) + '/' +
|
|
IntToStr(FFont.Size) + '/' +
|
|
IntToStr(byte(FFont.Style)) + '/' +
|
|
IntToStr(FLineNumber) + '/' +
|
|
IntToStr(Ord(FAlignment));
|
|
end;
|
|
|
|
|
|
{ This is basically copied from original SynEditPrint.pas. Returns the
|
|
header/footer text with macros expanded }
|
|
function THeaderFooterItem.GetText(NumPages, PageNum: Integer;
|
|
Roman: Boolean; Title, ATime, ADate: UnicodeString): UnicodeString;
|
|
var
|
|
Len, Start, Run: Integer;
|
|
AStr: UnicodeString;
|
|
|
|
procedure DoAppend(AText: UnicodeString);
|
|
begin
|
|
Result := Result + AText;
|
|
end;
|
|
procedure TryAppend(var First: Integer; After: Integer);
|
|
begin
|
|
if After > First then
|
|
begin
|
|
DoAppend(Copy(AStr, First, After - First));
|
|
First := After;
|
|
end;
|
|
end;
|
|
function TryExecuteMacro: Boolean;
|
|
var
|
|
Macro: UnicodeString;
|
|
begin
|
|
Result := True;
|
|
Macro := SynWideUpperCase(Copy(FText, Start, Run - Start + 1));
|
|
if Macro = '$PAGENUM$' then
|
|
begin
|
|
if Roman then
|
|
DoAppend(IntToRoman(PageNum))
|
|
else
|
|
DoAppend(IntToStr(PageNum));
|
|
Exit;
|
|
end;
|
|
if Macro = '$PAGECOUNT$' then
|
|
begin
|
|
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 WideTrim(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;
|
|
|
|
procedure THeaderFooterItem.LoadFromStream(AStream: TStream);
|
|
var
|
|
aCharset: TFontCharset;
|
|
aColor: TColor;
|
|
aHeight: Integer;
|
|
aName: TFontName;
|
|
aPitch: TFontPitch;
|
|
aSize: Integer;
|
|
aStyle: TFontStyles;
|
|
Len, BufferSize: Integer;
|
|
Buffer: Pointer;
|
|
begin
|
|
with AStream do
|
|
begin
|
|
Read(Len, sizeof(Len));
|
|
BufferSize := Len * sizeof(WideChar);
|
|
GetMem(Buffer, BufferSize + sizeof(WideChar));
|
|
try
|
|
Read(Buffer^, BufferSize);
|
|
PWideChar(Buffer)[BufferSize div sizeof(WideChar)] := #0;
|
|
FText := PWideChar(Buffer);
|
|
finally
|
|
FreeMem(Buffer);
|
|
end;
|
|
Read(FLineNumber, sizeof(FLineNumber));
|
|
// font
|
|
Read(aCharset, sizeof(aCharset));
|
|
Read(aColor, sizeof(aColor));
|
|
Read(aHeight, sizeof(aHeight));
|
|
Read(BufferSize, sizeof(BufferSize));
|
|
GetMem(Buffer, BufferSize + 1);
|
|
try
|
|
Read(Buffer^, BufferSize);
|
|
PAnsiChar(Buffer)[BufferSize div sizeof(AnsiChar)] := #0;
|
|
aName := string(PAnsiChar(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(PWideChar(FText)^, aLen * sizeof(WideChar));
|
|
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(PAnsiChar(@aName[1])^, aLen); // D2 cannot convert ShortStrings to PAnsiChar
|
|
{$ELSE}
|
|
Write(PAnsiChar(AnsiString(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: UnicodeString);
|
|
var
|
|
s: UnicodeString;
|
|
sty: TFontStyles;
|
|
begin
|
|
s := Value;
|
|
FText := DecodeString(GetFirstEl(s, '/'));
|
|
{$IFDEF SYN_COMPILER_3_UP}
|
|
FFont.Charset := StrToIntDef(GetFirstEl(s, '/'), 0);
|
|
{$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;
|
|
|
|
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: UnicodeString; 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[i]).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;
|
|
|
|
{ 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) }
|
|
procedure THeaderFooter.FixLines;
|
|
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;
|
|
|
|
{ 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 }
|
|
procedure THeaderFooter.CalcHeight(ACanvas: TCanvas);
|
|
var
|
|
i, CurLine: Integer;
|
|
AItem: THeaderFooterItem;
|
|
FOrgHeight: Integer;
|
|
TextMetric: TTextMetric;
|
|
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);
|
|
GetTextMetrics(ACanvas.Handle, TextMetric);
|
|
with TLineInfo(FLineInfo[CurLine - 1]), TextMetric do
|
|
begin
|
|
LineHeight := Max(LineHeight, TextHeight(ACanvas, 'W'));
|
|
MaxBaseDist := Max(MaxBaseDist, tmHeight - tmDescent);
|
|
end;
|
|
FFrameHeight := Max(FFrameHeight, FOrgHeight + TextHeight(ACanvas, '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;
|
|
if Result = 0 then
|
|
Result := Integer(Item1) - Integer(Item2);
|
|
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: UnicodeString;
|
|
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);
|
|
var
|
|
i, X, Y, CurLine: Integer;
|
|
AStr: UnicodeString;
|
|
AItem: THeaderFooterItem;
|
|
OldAlign: UINT;
|
|
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 - TextWidth(ACanvas, AStr);
|
|
taCenter: X := (PLeftHFTextIndent + PRightHFTextIndent - TextWidth(ACanvas, AStr)) div 2;
|
|
end;
|
|
end;
|
|
{Aligning at base line - Fonts can have different size in headers and footers}
|
|
OldAlign := SetTextAlign(ACanvas.Handle, TA_BASELINE);
|
|
ExtTextOutW(ACanvas.Handle, X, Y + TLineInfo(FLineInfo[CurLine - 1]).MaxBaseDist,
|
|
0, nil, PWideChar(AStr), Length(AStr), nil);
|
|
SetTextAlign(ACanvas.Handle, OldAlign);
|
|
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;
|
|
|
|
function THeaderFooter.GetAsString: UnicodeString;
|
|
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: UnicodeString);
|
|
var
|
|
item: THeaderFooterItem;
|
|
s: UnicodeString;
|
|
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;
|
|
finally
|
|
item.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure THeaderFooter.LoadFromStream(AStream: TStream);
|
|
var
|
|
Num, i: Integer;
|
|
aCharset: TFontCharset;
|
|
aColor: TColor;
|
|
aHeight: Integer;
|
|
aName: TFontName;
|
|
aPitch: TFontPitch;
|
|
aSize: Integer;
|
|
aStyle: TFontStyles;
|
|
bufSize: Integer;
|
|
buffer: PAnsiChar;
|
|
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 := string(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
|
|
i := Add('', nil, taLeftJustify, 1);
|
|
Get(i).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(PAnsiChar(@aName[1])^, Length(aName)); // D2 cannot convert ShortStrings to PAnsiChar
|
|
{$ELSE}
|
|
Write(PAnsiChar(AnsiString(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.
|
|
|