pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
60140bfdc5005a9b220bdad833c796bbebca992c
lazarus-ccr/components/tvplanit/source/vpprtfmt.pas

2934 lines
98 KiB
ObjectPascal
Raw Normal View History

Initial import git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@338 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2008-02-03 12:05:55 +00:00
{*********************************************************}
{* VPPRTFMT.PAS 1.03 *}
{*********************************************************}
{* ***** BEGIN LICENSE BLOCK ***** *}
{* Version: MPL 1.1 *}
{* *}
{* 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 TurboPower Visual PlanIt *}
{* *}
{* The Initial Developer of the Original Code is TurboPower Software *}
{* *}
{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *}
{* TurboPower Software Inc. All Rights Reserved. *}
{* *}
{* Contributor(s): *}
{* *}
{* ***** END LICENSE BLOCK ***** *}
{
This unit contains everything there is to define Visual PlanIt print
formats. Print formats are bit complicated. Before looking in this unit,
read the documentation on the print formats. It will help things make
sense here.
The print formats are built as nested TCollections.
The TVpPrinter class contains a TCollection descendent (TVpPrintFormat) that
contains all the print formats. Each item in this collection
(TVpPrintFormatItem) contains a TCollection descendent
(TVpPrintFormatElement) that contains all of the elements (DayViews,
WeekViews, static text and the like) that make up the specific print format.
The print element is defined in the TVpPrintFormatElementItem class.
Shape and Caption elements are special - They do not use a Visual PlanIt
control to handle their rendering. The TVpPrintShape and TVpPrintCaption
are used to store captions and elements as well as render them. Each
print element has a shape and caption class defined, even if that class
is not used.
When printing, appropriate components are found on the form to handle the
rendering (this allows the user to print what they see). However, if the
components cannot be found, or UseFormComponents if false), internally
cached copies of all the components are used.
When printing the component, the print formats use the RenderToCanvas
method of the Visual PlanIt visual controls. It is important that
RenderToCanvas properly handles rotation and rendering to arbitrary
rectangles.
-----------------------------------------------------------------------------
Enabling printing for a new component is fairly complex. These steps should
handle it:
1) Add the new component to the TVpItemType enumeration
2) Add an internal cached version of the component in the TVpPrinter's
private section. Expose this as a published property. Create the
component in CreateWorkControls and free it in DestroyWorkControls.
3) Modify RenderItem inside of TVpPrinter.PaintToCanvasRect to
set the LinkableControl to the cached component for the appropriate
value of the TVpItemType enumeration.
4) If the component is date base (calendar, dayview, weekview and the
like), set HaveDate to true at the end of RenderItem in
TVpPrinter.PaintToCanvasRect. Other changes may be required in
RenderItem.
5) Modify TVpPrinter.SaveToFile to save the definition of this element
in XML.
6) Modify TVpPrinter.xmlPrintFormatStartElement to handle loading this
element from an XML configuration file.
Examine how the other components are integrated into the printing system.
Of course, the print format editor should be updated to contain the new
element.
}
{$I Vp.INC}
unit VpPrtFmt;
interface
uses
{$IFDEF LCL}
LMessages,LCLProc,LCLType,LCLIntf,
{$ELSE}
Windows,
{$ENDIF}
Classes,
Dialogs,
SysUtils,
Graphics,
StdCtrls,
VpBase,
VpMisc,
VpData,
VpXParsr,
VpCanvasUtils,
VpSR,
VpException,
Forms,
Printers;
type
TVpChangeVar = (cvRemove, cvIgnore, cvChange);
TVpDayUnits = (duDay, duWeek, duMonth, duYear);
TVpShapeType = (ustRectangle, ustTopLine, ustBottomLine,
ustLeftLine, ustRightLine, ustTLToBRLine,
ustBLToTRLine, ustEllipse);
TVpWatcher = record
Handle : THandle;
end;
PVpWatcher = ^TVpWatcher;
{ TVpAttributes and TVpAttributeItem
a collection of attributes collected when parsing the xml file.
This is also used to store variables }
TVpAttributes = class;
TVpAttributeItem = class (TVpCollectionItem)
private
FCollection : TVpAttributes;
FName : string;
FValue : string;
protected
public
constructor Create (Collection : TCollection); override;
destructor Destroy; override;
published
property Collection : TVpAttributes read FCollection write FCollection;
property Name : string read FName write FName;
property Value : string read FValue write FValue;
end;
TVpAttributes = class (TCollection)
private
FOwner : TPersistent;
protected
function GetItem (Index : Integer) : TVpAttributeItem;
function GetOwner : TPersistent; override;
procedure SetItem (Index : Integer; Value : TVpAttributeItem);
public
constructor Create (AOwner : TPersistent);
{$IFNDEF VERSION5}
procedure Delete (Item : integer);
{$ENDIF}
property Items[Index : Integer] : TVpAttributeItem
read GetItem write SetItem;
end;
{ Print Formats }
TVpPrintShape = class (TPersistent)
private
FOwner : TPersistent;
FShape : TVpShapeType;
FBrush : TBrush;
FPen : TPen;
protected
function GetOwner : TPersistent; override;
procedure SetBrush (const v : TBrush);
procedure SetPen (const v : TPen);
public
constructor Create (AOwner : TPersistent);
destructor Destroy; override;
procedure PaintToCanvas (ACanvas : TCanvas;
ARect : TRect;
Angle : TVpRotationAngle;
Viewport : TRect);
published
property Brush : TBrush read FBrush write SetBrush;
property Pen : TPen read FPen write SetPen;
property Shape : TVpShapeType read FShape write FShape;
end;
TVpPrintCaption = class (TPersistent)
private
FOwner : TPersistent;
FCaption : string;
FFont : TFont;
protected
function GetOwner : TPersistent; override;
procedure SetFont (const v : TFont);
public
constructor Create (AOwner : TPersistent);
destructor Destroy; override;
procedure PaintToCanvas (ACanvas : TCanvas;
ARect : TRect;
Angle : TVpRotationAngle;
Viewport : TRect;
RealString : string);
published
property Caption : string read FCaption write FCaption;
property Font : TFont read FFont write SetFont;
end;
TVpPrintFormatElement = class;
TVpPrintFormatElementItem = class (TVpCollectionItem)
private
FCollection : TVpPrintFormatElement;
FRotation : TVpRotationAngle;
FItemType : TVpItemType;
FMeasurement : TVpItemMeasurement;
FHeight : Extended;
FLeft : Extended;
FTop : Extended;
FWidth : Extended;
FDayOffset : Integer;
FDayOffsetUnits : TVpDayUnits;
FElementName : string;
FShape : TVpPrintShape;
FCaption : TVpPrintCaption;
FVisible : Boolean;
protected
function GetDisplayName : string; override;
procedure SetCaption (const v : TVpPrintCaption);
procedure SetDayOffset (const v : Integer);
procedure SetDayOffsetUnits (const v : TVpDayUnits);
procedure SetElementName (const v : string);
procedure SetHeight (const v : Extended);
procedure SetItemType (const v : TVpItemType);
procedure SetLeft (const v : Extended);
procedure SetMeasurement (const v : TVpItemMeasurement);
procedure SetRotation (const v : TVpRotationAngle);
procedure SetShape (const v : TVpPrintShape);
procedure SetTop (const v : Extended);
procedure SetWidth (const v : Extended);
procedure SetVisible (const v : Boolean);
public
constructor Create (Collection : TCollection); override;
destructor Destroy; override;
property Collection : TVpPrintFormatElement
read FCollection write FCollection;
published
property Caption : TVpPrintCaption read FCaption write SetCaption;
property DayOffset : Integer read FDayOffset write SetDayOffset;
property DayOffsetUnits : TVpDayUnits
read FDayOffsetUnits write SetDayOffsetUnits;
property ElementName : string read FElementName write SetElementName;
property Height : Extended read FHeight write SetHeight nodefault;
property ItemType : TVpItemType read FItemType write SetItemType
default itDayView;
property Left : Extended read FLeft write SetLeft nodefault;
property Measurement : TVpItemMeasurement
read FMeasurement write SetMeasurement default imPercent;
property Rotation : TVpRotationAngle read FRotation write SetRotation
default ra0;
property Shape : TVpPrintShape read FShape write SetShape;
property Top : Extended read FTop write SetTop nodefault;
property Width : Extended read FWidth write SetWidth nodefault;
property Visible : Boolean read FVisible write SetVisible default True;
end;
TVpPrintFormatElement = class (TCollection)
private
FOwner : TPersistent;
protected
function GetItem (Index : Integer) : TVpPrintFormatElementItem;
function GetOwner : TPersistent; override;
procedure NotifyAll (Item : TCollectionItem);
{$IFDEF VERSION6}
procedure Notify (Item : TCollectionItem;
Action : TCollectionNotification); override;
{$ENDIF}
procedure SetItem (Index : Integer; Value : TVpPrintFormatElementItem);
procedure Update (Item : TCollectionItem); override;
public
constructor Create (AOwner : TPersistent);
property Items[Index : Integer] : TVpPrintFormatElementItem
read GetItem write SetItem;
end;
TVpPrintFormat = class;
TVpPrintFormatItem = class (TVpCollectionItem)
private
FCollection : TVpPrintFormat;
FElements : TVpPrintFormatElement;
FFormatName : string;
FDescription : string;
FDayInc : Integer;
FDayIncUnits : TVpDayUnits;
FVisible : Boolean;
protected
function GetDisplayName : string; override;
procedure SetDayInc (const v : Integer);
procedure SetDayIncUnits (const v : TVpDayUnits);
procedure SetDescription (const v : string);
procedure SetElements (const v : TVpPrintFormatElement);
procedure SetFormatName (const v : string);
procedure SetVisible (const v : Boolean);
public
constructor Create (Collection : TCollection); override;
destructor Destroy; override;
property Collection : TVpPrintFormat
read FCollection write FCollection;
published
property DayInc : Integer read FDayInc write SetDayInc;
property DayIncUnits : TVpDayUnits read FDayIncUnits write SetDayIncUnits;
property Description : string read FDescription write SetDescription;
property Elements : TVpPrintFormatElement
read FElements write SetElements;
property FormatName : string read FFormatName write SetFormatName;
property Visible : Boolean read FVisible write SetVisible default True;
end;
TVpPrintFormat = class (TCollection)
private
FOwner : TPersistent;
protected
function GetItem (Index : Integer) : TVpPrintFormatItem;
function GetOwner : TPersistent; override;
procedure NotifyAll (Item : TCollectionItem);
{$IFDEF VERSION6}
procedure Notify (Item : TCollectionItem;
Action : TCollectionNotification); override;
{$ENDIF}
procedure SetItem (Index : Integer; Value : TVpPrintFormatItem);
procedure Update (Item : TCollectionItem); override;
public
constructor Create (AOwner : TPersistent);
property Items[Index : Integer] : TVpPrintFormatItem
read GetItem write SetItem;
end;
TVpPrinter = class (TPersistent)
private
FOwner : TPersistent;
FPrintFormats : TVpPrintFormat;
FCurFormat : Integer;
FAttributes : TVpAttributes;
FLoadingIndex : Integer;
FElementIndex : Integer;
FVariables : TVpAttributes;
FDayStart : TVpHours;
FDayEnd : TVpHours;
FGranularity : TVpGranularity;
FPrintJob : Boolean;
FHaveDate : Boolean;
FHaveTaskList : Boolean;
FLastTask : Integer;
FHaveContactGrid : Boolean;
FLastContact : Integer;
FLeftMargin : Extended;
FRightMargin : Extended;
FTopMargin : Extended;
FBottomMargin : Extended;
FMarginUnits : TVpItemMeasurement;
FUseFormComponents : Boolean;
{ Work copies of all the components - used if the components cannot
be located when printing }
FParentHandle : THandle;
FDayView : TComponent;
FWeekView : TComponent;
FMonthView : TComponent;
FCalendar : TComponent;
FContactGrid : TComponent;
FTaskList : TComponent;
{ Notification Handles }
FNotifiers : TList;
FDefaultXMLFileName: string;
protected
procedure CreateWorkControls;
procedure DestroyWorkControls;
function GetOwner : TPersistent; override;
function ReplaceVariables (const s : string) : string;
procedure SetBottomMargin (const v : Extended);
procedure SetCurFormat (const v : Integer);
procedure SetDefaultXMLFileName (const v : string);
procedure SetLeftMargin (const v : Extended);
procedure SetMarginUnits (const v : TVpItemMeasurement);
procedure SetPrintFormats (const v : TVpPrintFormat);
procedure SetRightMargin (const v : Extended);
procedure SetTopMargin (const v : Extended);
procedure SetUseFormComponents (const v : Boolean);
procedure xmlPrintFormatAttribute (oOwner : TObject;
sName,
sValue : DOMString;
bSpecified : Boolean);
procedure xmlPrintFormatEndElement (oOwner : TObject;
sValue : DOMString);
procedure xmlPrintFormatStartElement (oOwner : TObject;
sValue : DOMString);
public
constructor Create (AOwner : TComponent);
destructor Destroy; override;
procedure AddDefaultVariables (Date : TDateTime);
procedure AddVariable (VarName : string; Value : string);
procedure ChangeVariable (VarName : string; NewValue : string);
procedure CheckPrintFormat;
procedure ClearVariables;
function DeleteVariable (VarName : string) : Boolean;
procedure DeregisterAllWatchers;
procedure DeregisterWatcher (Watcher : THandle);
function Find (const v : string) : Integer;
function HaveVariable (VarName : string) : Boolean;
procedure LoadFromFile (FileName : string; Append : Boolean);
function LookupVariable (VarName : string) : string;
procedure NotifyLinked;
procedure PaintToCanvasRect (ACanvas : TCanvas;
ARect : TRect;
ADate : TDateTime);
procedure Print (APrinter : TPrinter;
StartDate : TDateTime;
EndDate : TDateTime);
procedure RegisterWatcher (Watcher : THandle);
procedure RenderPage ( ACanvas : TCanvas;
ARect : TRect;
PageNum : Integer;
var ADate : TDateTime;
EndDate : TDateTime;
var StartContact : Integer;
var StartTask : Integer;
var LastPage : Boolean);
procedure SaveToFile (FileName : string);
procedure UpdateDateVariables (Date : TDateTime);
function ValidFormat (const v : Integer) : Boolean;
property Calendar : TComponent read FCalendar write FCalendar;
property ContactGrid : TComponent read FContactGrid write FContactGrid;
property CurFormat : Integer read FCurFormat write SetCurFormat;
property DayView : TComponent read FDayView write FDayView;
property DefaultXMLFileName : string
read FDefaultXMLFileName write SetDefaultXMLFileName;
property HaveDate : Boolean read FHaveDate;
property HaveTaskList : Boolean read FHaveTaskList;
property LastTask : Integer read FLastTask;
property HaveContactGrid : Boolean read FHaveContactGrid;
property LastContact : Integer read FLastContact;
property MonthView : TComponent read FMonthView write FMonthView;
property Printing : Boolean read FPrintJob;
property TaskList : TComponent read FTaskList write FTaskList;
property UseFormComponents : Boolean
read FUseFormComponents write SetUseFormComponents default True;
property WeekView : TComponent read FWeekView write FWeekView;
published
property BottomMargin : Extended
read FBottomMargin write SetBottomMargin;
property DayStart : TVpHours read FDayStart Write FDayStart;
property DayEnd : TVpHours read FDayEnd write FDayEnd;
property Granularity : TVpGranularity
read FGranularity write FGranularity;
property LeftMargin : Extended
read FLeftMargin write SetLeftMargin;
property MarginUnits : TVpItemMeasurement
read FMarginUnits write SetMarginUnits default imInches;
property PrintFormats : TVpPrintFormat
read FPrintFormats write SetPrintFormats;
property RightMargin : Extended
read FRightMargin write SetRightMargin;
property TopMargin : Extended
read FTopMargin write SetTopMargin;
end;
implementation
uses
VpBaseDS,
VpPrtFmtCBox,
VpPrtPrv,
VpDayView,
VpWeekView,
VpMonthView,
VpCalendar,
VpTaskList,
VpContactGrid;
function XMLizeString (const s : string) : string;
var
i : integer;
begin
result := '';
for i := 1 to Length (s) do
case s[i] of
'<' : result := result + '&lt;';
'>' : result := result + '&gt;';
{' ' : result := result + '&nbsp;';}
'&' : result := result + '&amp;';
'"' : result := result + '&quot;';
else
result := result + copy (s, i, 1);
end;
end;
// TVpAttributeItem **********************************************************
constructor TVpAttributeItem.Create (Collection : TCollection);
begin
inherited Create (Collection);
FCollection := TVpAttributes.Create (TVpAttributes (Collection).FOwner);
FName := '';
FValue := '';
end;
{=====}
destructor TVpAttributeItem.Destroy;
begin
FCollection.Free;
FCollection := nil;
inherited Destroy;
end;
{=====}
// TVpAttributes *************************************************************
constructor TVpAttributes.Create(AOwner : TPersistent);
begin
inherited Create (TVpAttributeItem);
FOwner := AOwner;
end;
{=====}
{$IFNDEF VERSION5}
procedure TVpAttributes.Delete(Item: integer);
begin
GetItem(Item).Free;
end;
{=====}
{$ENDIF}
function TVpAttributes.GetItem (Index : Integer) : TVpAttributeItem;
begin
Result := TVpAttributeItem (inherited GetItem (Index));
end;
{=====}
function TVpAttributes.GetOwner : TPersistent;
begin
Result := FOwner;
end;
{=====}
procedure TVpAttributes.SetItem (Index : Integer; Value : TVpAttributeItem);
begin
inherited SetItem (Index, Value);
end;
{=====}
// TVpPrintShape *************************************************************
constructor TVpPrintShape.Create (AOwner : TPersistent);
begin
inherited Create;
FOwner := AOwner;
FPen := TPen.Create;
FBrush := TBrush.Create;
FShape := ustRectangle;
end;
{=====}
destructor TVpPrintShape.Destroy;
begin
FPen.Free;
FPen := nil;
FBrush.Free;
FBrush := nil;
inherited Destroy;
end;
{=====}
function TVpPrintShape.GetOwner : TPersistent;
begin
Result := FOwner;
end;
{=====}
procedure TVpPrintShape.PaintToCanvas (ACanvas : TCanvas;
ARect : TRect;
Angle : TVpRotationAngle;
Viewport : TRect);
var
OldPen : TPen;
OldBrush : TBrush;
begin
OldPen := TPen.Create;
try
OldBrush := TBrush.Create;
try
OldPen.Assign (ACanvas.Pen);
OldBrush.Assign (ACanvas.Brush);
case FShape of
ustRectangle :
{$IFDEF VERSION5}
ACanvas.Rectangle (ARect);
{$ELSE}
ACanvas.Rectangle (ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
{$ENDIF}
ustTopLine : begin
ACanvas.MoveTo (ARect.Left, ARect.Top);
ACanvas.LineTo (ARect.Right, ARect.Top);
end;
ustBottomLine : begin
ACanvas.MoveTo (ARect.Left, ARect.Bottom);
ACanvas.LineTo (ARect.Right, ARect.Bottom);
end;
ustLeftLine : begin
ACanvas.MoveTo (ARect.Left, ARect.Top);
ACanvas.LineTo (ARect.Left, ARect.Bottom);
end;
ustRightLine : begin
ACanvas.MoveTo (ARect.Right, ARect.Top);
ACanvas.LineTo (ARect.Right, ARect.Bottom);
end;
ustTLToBRLine : begin
ACanvas.MoveTo (ARect.Left, ARect.Top);
ACanvas.LineTo (ARect.Right, ARect.Bottom);
end;
ustBLToTRLine : begin
ACanvas.MoveTo (ARect.Left, ARect.Bottom);
ACanvas.LineTo (ARect.Right, ARect.Top);
end;
ustEllipse :
ACanvas.Ellipse (ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
end;
ACanvas.Pen.Assign (OldPen);
ACanvas.Brush.Assign (OldBrush);
finally
OldBrush.Free;
end;
finally
OldPen.Free;
end;
end;
{=====}
procedure TVpPrintShape.SetBrush (const v : TBrush);
begin
FBrush.Assign (v);
end;
{=====}
procedure TVpPrintShape.SetPen (const v : TPen);
begin
FPen.Assign (v);
end;
{=====}
// TVpPrintCaption ***********************************************************
constructor TVpPrintCaption.Create (AOwner : TPersistent);
begin
inherited Create;
FOwner := AOwner;
FFont := TFont.Create;
FCaption := '';
end;
{=====}
destructor TVpPrintCaption.Destroy;
begin
FFont.Free;
FFont := nil;
inherited Destroy;
end;
{=====}
function TVpPrintCaption.GetOwner : TPersistent;
begin
Result := FOwner;
end;
{=====}
procedure TVpPrintCaption.PaintToCanvas (ACanvas : TCanvas;
ARect : TRect;
Angle : TVpRotationAngle;
Viewport : TRect;
RealString : string);
var
OldFont : TFont;
begin
OldFont := ACanvas.Font;
ACanvas.Font := FFont;
try
TPSTextOutAtPoint (ACanvas, Angle, Viewport, ARect.Left, ARect.Top, RealString);
finally
ACanvas.Font := OldFont;
end;
end;
{=====}
procedure TVpPrintCaption.SetFont (const v : TFont);
begin
FFont.Assign (v);
end;
{=====}
// TVpPrintFormatElementItem *************************************************
constructor TVpPrintFormatElementItem.Create (Collection : TCollection);
begin
inherited Create (Collection);
FCollection := TVpPrintFormatElement.Create (TVpPrintFormatElement (Collection).FOwner);
FShape := TVpPrintShape.Create (Self);
FCaption := TVpPrintCaption.Create (Self);
FRotation := ra0;
FElementName := '';
FItemType := itDayView;
FMeasurement := imPercent;
FHeight := 100;
FLeft := 0;
FTop := 0;
FWidth := 100;
FDayOffset := 0;
FDayOffsetUnits := duDay;
FVisible := True;
end;
{=====}
destructor TVpPrintFormatElementItem.Destroy;
begin
FCollection.Free;
FCollection := nil;
FShape.Free;
FShape := nil;
FCaption.Free;
FCaption := nil;
inherited Destroy;
end;
{=====}
function TVpPrintFormatElementItem.GetDisplayName : string;
begin
if FElementName <> '' then
Result := '(' + FElementName + ') ' + inherited GetDisplayName
else
Result := inherited GetDisplayName;
end;
{=====}
procedure TVpPrintFormatElementItem.SetCaption (const v : TVpPrintCaption);
begin
if Assigned (FCollection) then begin
FCollection.BeginUpdate;
try
FCaption.Assign (v);
finally
FCollection.EndUpdate;
end;
end else
FCaption.Assign (v);
end;
{=====}
procedure TVpPrintFormatElementItem.SetDayOffset (const v : Integer);
begin
if v = FDayOffset then
Exit;
if Assigned (FCollection) then begin
FCollection.BeginUpdate;
FDayOffset := v;
FCollection.EndUpdate;
if Assigned (Collection) then
Collection.NotifyAll (Self);
end else
FDayOffset := v;
end;
{=====}
procedure TVpPrintFormatElementItem.SetDayOffsetUnits (const v : TVpDayUnits);
begin
if v = FDayOffsetUnits then
Exit;
if Assigned (FCollection) then begin
FCollection.BeginUpdate;
FDayOffsetUnits := v;
FCollection.EndUpdate;
if Assigned (Collection) then
Collection.NotifyAll (Self);
end else
FDayOffsetUnits := v;
end;
{=====}
procedure TVpPrintFormatElementItem.SetElementName (const v : string);
begin
if v = FElementName then
Exit;
if Assigned (FCollection) then begin
FCollection.BeginUpdate;
FElementName := v;
FCollection.EndUpdate;
if Assigned (Collection) then
Collection.NotifyAll (Self);
end else
FElementName := v;
end;
{=====}
procedure TVpPrintFormatElementItem.SetHeight (const v : Extended);
begin
if v = FHeight then
Exit;
if Assigned (FCollection) then begin
FCollection.BeginUpdate;
FHeight := v;
FCollection.EndUpdate;
if Assigned (Collection) then
Collection.NotifyAll (Self);
end else
FHeight := v;
end;
{=====}
procedure TVpPrintFormatElementItem.SetItemType (const v : TVpItemType);
begin
if v = FItemType then
Exit;
if Assigned (FCollection) then begin
FCollection.BeginUpdate;
FItemType := v;
FCollection.EndUpdate;
if Assigned (Collection) then
Collection.NotifyAll (Self);
end else
FItemType := v;
end;
{=====}
procedure TVpPrintFormatElementItem.SetLeft (const v : Extended);
begin
if v = FLeft then
Exit;
if Assigned (FCollection) then begin
FCollection.BeginUpdate;
FLeft := v;
FCollection.EndUpdate;
if Assigned (Collection) then
Collection.NotifyAll (Self);
end else
FLeft := v;
end;
{=====}
procedure TVpPrintFormatElementItem.SetMeasurement (const v : TVpItemMeasurement);
begin
if v = FMeasurement then
Exit;
if Assigned (FCollection) then begin
FCollection.BeginUpdate;
FMeasurement := v;
FCollection.EndUpdate;
if Assigned (Collection) then
Collection.NotifyAll (Self);
end else
FMeasurement := v;
end;
{=====}
procedure TVpPrintFormatElementItem.SetRotation (const v : TVpRotationAngle);
begin
if v = FRotation then
Exit;
if Assigned (FCollection) then begin
FCollection.BeginUpdate;
FRotation := v;
FCollection.EndUpdate;
if Assigned (Collection) then
Collection.NotifyAll (Self);
end else
FRotation := v;
end;
{=====}
procedure TVpPrintFormatElementItem.SetShape (const v : TVpPrintShape);
begin
if Assigned (FCollection) then begin
FCollection.BeginUpdate;
try
FShape.Assign (v);
finally
FCollection.EndUpdate;
end;
if Assigned (Collection) then
Collection.NotifyAll (Self);
end else
FShape.Assign (v);
end;
{=====}
procedure TVpPrintFormatElementItem.SetTop (const v : Extended);
begin
if v = FTop then
Exit;
if Assigned (FCollection) then begin
FCollection.BeginUpdate;
FTop := v;
FCollection.EndUpdate;
if Assigned (Collection) then begin
Collection.NotifyAll (Self);
end;
end else
FTop := v;
end;
{=====}
procedure TVpPrintFormatElementItem.SetWidth (const v : Extended);
begin
if v = FWidth then
Exit;
if Assigned (FCollection) then begin
FCollection.BeginUpdate;
FWidth := v;
FCollection.EndUpdate;
if Assigned (Collection) then
Collection.NotifyAll (Self);
end else
FWidth := v;
end;
{=====}
procedure TVpPrintFormatElementItem.SetVisible (const v : Boolean);
begin
if v = FVisible then
Exit;
if Assigned (FCollection) then begin
FCollection.BeginUpdate;
FVisible := v;
FCollection.EndUpdate;
if Assigned (Collection) then
Collection.NotifyAll (Self);
end else
FVisible := v;
end;
{=====}
// TVpPrintFormatElement *****************************************************
constructor TVpPrintFormatElement.Create(AOwner : TPersistent);
begin
inherited Create (TVpPrintFormatElementItem);
FOwner := AOwner;
end;
{=====}
function TVpPrintFormatElement.GetItem (Index : Integer) : TVpPrintFormatElementItem;
begin
Result := TVpPrintFormatElementItem (inherited GetItem (Index));
end;
function TVpPrintFormatElement.GetOwner : TPersistent;
begin
Result := FOwner;
end;
{=====}
procedure TVpPrintFormatElement.NotifyAll (Item : TCollectionItem);
var
Notifier : TPersistent;
begin
if not Assigned (FOwner) then
Exit;
if FOwner is TVpPrintFormatItem then begin
if Assigned (TVpPrintFormatItem (FOwner).FCollection) then
TVpPrintFormatItem (FOwner).FCollection.NotifyAll ((TVpPrintFormatItem (FOwner)));
end;
if FOwner is TVpPrintFormatItem then
Notifier := (FOwner as TVpPrintFormatItem).GetOwner
else if FOwner is TVpPrintFormat then
Notifier := (FOwner as TVpPrintFormat).GetOwner
else
Notifier := nil;
if not Assigned (Notifier) then
Exit;
if Notifier is TVpPrintFormat then
Notifier := (Notifier as TVpPrintFormat).GetOwner;
if Notifier is TVpPrinter then
(Notifier as TVpPrinter).NotifyLinked
else if Notifier is TVpControlLink then begin
if not Assigned ((Notifier as TVpControlLink).Printer) then
Exit;
(Notifier as TVpControlLink).Printer.NotifyLinked;
end;
end;
{=====}
{$IFDEF VERSION6}
procedure TVpPrintFormatElement.Notify (Item : TCollectionItem;
Action : TCollectionNotification);
begin
inherited Notify (Item, Action);
NotifyAll (Item);
end;
{$ENDIF}
{=====}
procedure TVpPrintFormatElement.SetItem (Index : Integer;
Value : TVpPrintFormatElementItem);
begin
inherited SetItem (Index, Value);
end;
{=====}
procedure TVpPrintFormatElement.Update (Item : TCollectionItem);
var
Notifier : TPersistent;
begin
inherited Update (Item);
if not Assigned (FOwner) then
Exit;
if FOwner is TVpPrintFormatItem then
Notifier := (FOwner as TVpPrintFormatItem).GetOwner
else if FOwner is TVpPrintFormat then
Notifier := (FOwner as TVpPrintFormat).GetOwner
else
Notifier := nil;
if not Assigned (Notifier) then
Exit;
if Notifier is TVpPrintFormat then
Notifier := (Notifier as TVpPrintFormat).GetOwner;
if Notifier is TVpPrinter then
(Notifier as TVpPrinter).NotifyLinked
else if Notifier is TVpControlLink then begin
if not Assigned ((Notifier as TVpControlLink).Printer) then
Exit;
(Notifier as TVpControlLink).Printer.NotifyLinked;
end;
end;
{=====}
// TVpPrintFormatItem *************************************************
constructor TVpPrintFormatItem.Create (Collection : TCollection);
begin
inherited Create (Collection);
FCollection := TVpPrintFormat.Create (TVpPrintFormat (Collection).FOwner);
FElements := TVpPrintFormatElement.Create (Self);
FFormatName := 'Unknown';
FDescription := '';
FDayInc := 0;
FDayIncUnits := duDay;
FVisible := True;
end;
{=====}
destructor TVpPrintFormatItem.Destroy;
begin
FElements.Free;
FElements := nil;
FCollection.Free;
FCollection := nil;
inherited Destroy;
end;
{=====}
function TVpPrintFormatItem.GetDisplayName : string;
begin
if FFormatName <> '' then
Result := '(' + FFormatName + ') ' + inherited GetDisplayName
else
Result := inherited GetDisplayName;
end;
{=====}
procedure TVpPrintFormatItem.SetDayInc (const v : Integer);
begin
if v = FDayInc then
Exit;
if Assigned (FCollection) then begin
FCollection.BeginUpdate;
FDayInc := v;
FCollection.EndUpdate;
if Assigned (Collection) then
Collection.NotifyAll (Self);
end else
FDayInc := v;
end;
{=====}
procedure TVpPrintFormatItem.SetDayIncUnits (const v : TVpDayUnits);
begin
if v = FDayIncUnits then
Exit;
if Assigned (FCollection) then begin
FCollection.BeginUpdate;
FDayIncUnits := v;
FCollection.EndUpdate;
if Assigned (Collection) then
Collection.NotifyAll (Self);
end else
FDayIncUnits := v;
end;
{=====}
procedure TVpPrintFormatItem.SetDescription (const v : string);
begin
if v = FDescription then
Exit;
if Assigned (FCollection) then begin
FCollection.BeginUpdate;
FDescription := v;
FCollection.EndUpdate;
end else
FDescription := v;
end;
{=====}
procedure TVpPrintFormatItem.SetElements (const v : TVpPrintFormatElement);
begin
FElements.Assign (v);
if Assigned (Collection) then
Collection.NotifyAll (Self);
end;
{=====}
procedure TVpPrintFormatItem.SetFormatName (const v : string);
begin
if v = '' then
raise EVpPrintFormatError.Create (RSNeedFormatName);
if v = FFormatName then
Exit;
if Assigned (FCollection) then begin
FCollection.BeginUpdate;
FFormatName := v;
FCollection.EndUpdate;
end else
FFormatName := v;
end;
{=====}
procedure TVpPrintFormatItem.SetVisible (const v : Boolean);
begin
if v = FVisible then
Exit;
if Assigned (FCollection) then begin
FCollection.BeginUpdate;
FVisible := v;
FCollection.EndUpdate;
if Assigned (Collection) then
Collection.NotifyAll (Self);
end else
FVisible := v;
end;
{=====}
// TVpPrintFormat ************************************************************
constructor TVpPrintFormat.Create (AOwner : TPersistent);
begin
inherited Create (TVpPrintFormatItem);
FOwner := AOwner;
end;
{=====}
function TVpPrintFormat.GetItem (Index : Integer) : TVpPrintFormatItem;
begin
Result := TVpPrintFormatItem (inherited GetItem (Index));
end;
{=====}
function TVpPrintFormat.GetOwner : TPersistent;
begin
Result := FOwner;
end;
{=====}
procedure TVpPrintFormat.NotifyAll (Item : TCollectionItem);
begin
if not Assigned (FOwner) then
Exit;
if FOwner is TVpPrinter then
(FOwner as TVpPrinter).NotifyLinked
else if FOwner is TVpControlLink then begin
if not Assigned ((FOwner as TVpControlLink).Printer) then
Exit;
(FOwner as TVpControlLink).Printer.NotifyLinked;
end;
end;
{=====}
{$IFDEF VERSION6}
procedure TVpPrintFormat.Notify (Item : TCollectionItem;
Action : TCollectionNotification);
begin
inherited Notify (Item, Action);
NotifyAll (Item);
end;
{$ENDIF}
{=====}
procedure TVpPrintFormat.SetItem (Index : Integer;
Value : TVpPrintFormatItem);
begin
inherited SetItem (Index, Value);
end;
{=====}
procedure TVpPrintFormat.Update (Item : TCollectionItem);
begin
inherited Update (Item);
if not Assigned (FOwner) then
Exit;
if FOwner is TVpPrinter then
(FOwner as TVpPrinter).NotifyLinked
else if FOwner is TVpControlLink then begin
if not Assigned ((FOwner as TVpControlLink).Printer) then
Exit;
(FOwner as TVpControlLink).Printer.NotifyLinked;
end;
end;
{=====}
// TVpPrinter ****************************************************************
constructor TVpPrinter.Create (AOwner : TComponent);
begin
inherited Create;
FPrintJob := False;
FPrintFormats := TVpPrintFormat.Create (AOwner);
FAttributes := TVpAttributes.Create (Self);
FVariables := TVpAttributes.Create (Self);
FNotifiers := TList.Create;
FOwner := AOwner;
FLoadingIndex := -1;
FElementIndex := -1;
FDayStart := h_08;
FDayEnd := h_05;
FGranularity := gr30Min;
FUseFormComponents := True;
CreateWorkControls;
end;
{=====}
destructor TVpPrinter.Destroy;
begin
DeregisterAllWatchers;
FPrintFormats.Free;
FAttributes.Free;
FVariables.Free;
FNotifiers.Free;
DestroyWorkControls;
inherited;
end;
{=====}
procedure TVpPrinter.AddDefaultVariables (Date : TDateTime);
tvplanit: Refactor granularity-related code git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4782 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2016-06-20 11:00:59 +00:00
Initial import git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@338 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2008-02-03 12:05:55 +00:00
function HourToStr (Hour : TVpHours; Mil : Boolean) : string;
begin
if Mil then
Result := IntToStr(ord(Hour))
else
tvplanit: Refactor granularity-related code git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4782 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2016-06-20 11:00:59 +00:00
if ord(Hour) mod 12 = 0 then
Result := '12'
else
Result := IntToStr(ord(Hour) mod 12);
{
Initial import git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@338 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2008-02-03 12:05:55 +00:00
case Hour of
h_00 : Result := '12';
h_01 : Result := '1';
h_02 : Result := '2';
h_03 : Result := '3';
h_04 : Result := '4';
h_05 : Result := '5';
h_06 : Result := '6';
h_07 : Result := '7';
h_08 : Result := '8';
h_09 : Result := '9';
h_10 : Result := '10';
h_11 : Result := '11';
h_12 : Result := '12';
h_13 : Result := '1';
h_14 : Result := '2';
h_15 : Result := '3';
h_16 : Result := '4';
h_17 : Result := '5';
h_18 : Result := '6';
h_19 : Result := '7';
h_20 : Result := '8';
h_21 : Result := '9';
h_22 : Result := '10';
h_23 : Result := '11';
end;
tvplanit: Refactor granularity-related code git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4782 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2016-06-20 11:00:59 +00:00
}
Initial import git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@338 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2008-02-03 12:05:55 +00:00
end;
tvplanit: Refactor granularity-related code git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4782 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2016-06-20 11:00:59 +00:00
function GranularityToStr(Gran: TVpGranularity): string;
Initial import git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@338 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2008-02-03 12:05:55 +00:00
begin
tvplanit: Refactor granularity-related code git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4782 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2016-06-20 11:00:59 +00:00
Result := IntToStr(GranularityMinutes[Gran]);
Initial import git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@338 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2008-02-03 12:05:55 +00:00
end;
tvplanit: Refactor granularity-related code git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4782 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2016-06-20 11:00:59 +00:00
function HourToAMPM(Hour: TVpHours): string;
Initial import git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@338 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2008-02-03 12:05:55 +00:00
begin
if (Hour >= H_00) and (Hour <= h_11) then
Result := 'AM'
else
Result := 'PM';
end;
procedure AddDataStoreVars;
var
DataStore : TVpCustomDataStore;
i : Integer;
TopLevel : TComponent;
begin
if not Assigned (FOwner) then
Exit;
if not (FOwner is TVpControlLink) then
Exit;
TopLevel := (FOwner as TVpControlLink).Owner;
if not Assigned (TopLevel) then
Exit;
DataStore := nil;
for i := 0 to pred (TopLevel.ComponentCount) do
if (TopLevel.Components[i] is TVpCustomDataStore) then begin
DataStore := TVpCustomDataStore (TopLevel.Components[i]);
end;
if Assigned (DataStore) then begin
AddVariable ('ResourceID', IntToStr (DataStore.ResourceID));
if Assigned (DataStore.Resource) then begin
AddVariable ('Resource', DataStore.Resource.Description);
AddVariable ('ResourceNotes', DataStore.Resource.Notes);
end;
end;
end;
begin
{ Variables for the date }
UpdateDateVariables (Date);
{ Variables for the starting name }
AddVariable ('StartHour12', HourToStr (FDayStart, False));
AddVariable ('StartHour24', HourToStr (FDayStart, True));
AddVariable ('StartHourAMPM', HourToAMPM (FDayStart));
{ Variables for the ending time }
AddVariable ('StopHour12', HourToStr (FDayEnd, False));
AddVariable ('StopHour24', HourToStr (FDayEnd, False));
AddVariable ('StopHourAMPM', HourToAMPM (FDayEnd));
{ Variables for granularity }
AddVariable ('Granularity', GranularityToStr (Granularity));
AddDataStoreVars;
end;
{=====}
procedure TVpPrinter.AddVariable (VarName : string; Value : string);
var
i : Integer;
NewVar : TVpAttributeItem;
begin
for i := 0 to FVariables.Count - 1 do
if FVariables.Items[i].Name = VarName then begin
FVariables.Items[i].Value := Value;
Exit;
end;
NewVar := TVpAttributeItem (FVariables.Add);
NewVar.Name := VarName;
NewVar.Value := Value;
end;
{=====}
procedure TVpPrinter.ChangeVariable (VarName : string; NewValue : string);
begin
AddVariable (VarName, NewValue);
end;
{=====}
procedure TVpPrinter.CheckPrintFormat;
begin
if PrintFormats.Count = 0 then
raise EVpPrintFormatError.Create (RSNoPrintFormats)
else if (CurFormat < 0) or
(CurFormat >= PrintFormats.Count) then
raise EVpPrintFormatError.Create (RSBadPrintFormat);
end;
{=====}
procedure TVpPrinter.ClearVariables;
begin
FVariables.Clear;
end;
{=====}
procedure TVpPrinter.CreateWorkControls;
begin
{$IFNDEF LCL}
FParentHandle := AllocateHWnd (nil);
FDayView := TVpDayView.CreateParented (FParentHandle);
FWeekView := TVpWeekView.CreateParented (FParentHandle);
FMonthView := TVpMonthView.CreateParented (FParentHandle);
FCalendar := TVpCalendar.CreateParented (FParentHandle);
FContactGrid := TVpContactGrid.CreateParented (FParentHandle);
FTaskList := TVpTaskList.CreateParented (FParentHandle);
{$ENDIF}
end;
{=====}
procedure TVpPrinter.DestroyWorkControls;
begin
{$IFNDEF LCL}
DeallocateHWnd (FParentHandle);
FDayView.Free;
FWeekView.Free;
FMonthView.Free;
FCalendar.Free;
FContactGrid.Free;
FTaskList.Free;
{$ENDIF}
end;
{=====}
function TVpPrinter.DeleteVariable (VarName : string) : Boolean;
var
i : Integer;
begin
Result := True;
for i := 0 to FVariables.Count - 1 do
if FVariables.Items[i].Name = VarName then begin
FVariables.Delete(i);
Exit;
end;
Result := False;
end;
{=====}
procedure TVpPrinter.DeregisterAllWatchers;
var
i : Integer;
begin
for i := FNotifiers.Count - 1 downto 0 do
if Assigned (FNotifiers[i]) then begin
FreeMem (FNotifiers[i]);
FNotifiers.Delete (i);
end;
end;
{=====}
procedure TVpPrinter.DeregisterWatcher (Watcher : THandle);
var
i : Integer;
begin
for i := FNotifiers.Count - 1 downto 0 do
if Assigned (FNotifiers[i]) then
if PVpWatcher (FNotifiers[i]).Handle = Watcher then begin
FreeMem (FNotifiers[i]);
FNotifiers.Delete (i);
Exit;
end;
end;
{=====}
function TVpPrinter.HaveVariable (VarName : string) : Boolean;
var
i : Integer;
begin
Result := True;
for i := 0 to FVariables.Count - 1 do
if FVariables.Items[i].Name = VarName then
Exit;
Result := False;
end;
{=====}
function TVpPrinter.Find (const v : string) : Integer;
var
i : Integer;
begin
Result := -1;
for i := 0 to FPrintFormats.Count - 1 do
if v = FPrintFormats.Items[i].FormatName then begin
Result := i;
Exit;
end;
end;
{=====}
function TVpPrinter.GetOwner: TPersistent;
begin
Result := FOwner;
end;
{=====}
procedure TVpPrinter.LoadFromFile (FileName : string;
Append : Boolean);
var
Parser : TVpParser;
begin
if FileName = '' then
FileName := DefaultXMLFileName;
if not Append then
FPrintFormats.Clear;
FLoadingIndex := -1;
FElementIndex := -1;
Parser := TVpParser.Create (nil);
Parser.OnAttribute := xmlPrintFormatAttribute;
Parser.OnStartElement := xmlPrintFormatStartElement;
Parser.OnEndElement := xmlPrintFormatEndElement;
try
Parser.ParseDataSource (FileName);
finally
Parser.Free;
end;
FLoadingIndex := -1;
FElementIndex := -1;
NotifyLinked;
end;
{=====}
function TVpPrinter.LookupVariable (VarName : string) : string;
var
i : Integer;
begin
Result := '';
for i := 0 to FVariables.Count - 1 do
if FVariables.Items[i].Name = VarName then begin
Result := FVariables.Items[i].Value;
Break;
end;
end;
{=====}
procedure TVpPrinter.NotifyLinked;
var
i : Integer;
begin
for i := 0 to FNotifiers.Count - 1 do
if Assigned (FNotifiers[i]) then
PostMessage (PVpWatcher (FNotifiers[i]).Handle,
Vp_PrintFormatChanged, 0, 0);
end;
{=====}
procedure TVpPrinter.PaintToCanvasRect (ACanvas : TCanvas;
ARect : TRect;
ADate : TDateTime);
var
WidthInPixels : Integer;
HeightInPixels : Integer;
PixelsPerInchX : Integer;
PixelsPerInchY : Integer;
StartX : Integer;
StartY : Integer;
StopX : Integer;
StopY : Integer;
Scale : Extended;
StartLine : Integer;
EndLine : Integer;
procedure GetMeasurements;
begin
WidthInPixels := ARect.Right - ARect.Left;
HeightInPixels := ARect.Bottom - ARect.Top;
PixelsPerInchX := GetDeviceCaps (ACanvas.Handle, LOGPIXELSX);
PixelsPerInchY := GetDeviceCaps (ACanvas.Handle, LOGPIXELSY);
Scale := PixelsPerInchY / Screen.PixelsPerInch;
StartLine := HourToLine (DayStart, Granularity);
EndLine := HourToLine (DayEnd, Granularity);
end;
procedure GetPrintRectangle (Element : TVpPrintFormatElementItem);
begin
case Element.Measurement of
imAbsolutePixel : begin
StartX := Round (Element.Left);
StartY := Round (Element.Top);
StopX := Round (Element.Left + Element.Width);
StopY := Round (Element.Top + Element.Height);
end;
imPercent : begin
StartX := Round (Element.Left * WidthInPixels / 100);
StartY := Round (Element.Top * HeightInPixels / 100);
StopX := Round ((Element.Left + Element.Width) * WidthInPixels / 100);
StopY := Round ((Element.Top + Element.Height) * HeightInPixels / 100);
end;
imInches : begin
StartX := Round (Element.Left * PixelsPerInchX);
StartY := Round (Element.Top * PixelsPerInchX);
StopX := Round ((Element.Left + Element.Width) * PixelsPerInchX);
StopY := Round ((Element.Top + Element.Height) * PixelsPerInchX);
end;
end;
Inc (StartX, ARect.Left);
Inc (StartY, ARect.Top);
Inc (StopX, ARect.Left);
Inc (StopY, ARect.Top);
end;
function GetDate (Element : TVpPrintFormatElementItem) : TDateTime;
begin
Result := ADate;
if Element.DayOffset <> 0 then begin
case Element.DayOffsetUnits of
duDay : Result := Result + Element.DayOffset;
duWeek : Result := Result + Element.DayOffset * 7;
duMonth : Result := IncMonth (Result, Element.DayOffset);
duYear : Result := IncYear (Result, Element.DayOffset);
end;
end;
end;
procedure RenderItem (Element : TVpPrintFormatElementItem);
var
i : Integer;
DI : TVpDependentInfo;
DependentList : TList;
RenderControl : TVpLinkableControl;
begin
if not Element.Visible then
Exit;
RenderControl := nil;
DependentList := (FOwner as TVpControlLink).GetDependentList;
if FUseFormComponents then
for i := 0 to DependentList.Count - 1 do begin
DI := TVpDependentInfo (DependentList.List^[I]);
if TVpLinkableControl (DI.Component).GetControlType = Element.ItemType then begin
RenderControl := TVpLinkableControl (DI.Component);
Break;
end;
end;
if not Assigned (RenderControl) then begin
case Element.ItemType of
itDayView : RenderControl := TVpLinkableControl (FDayView);
itWeekView : RenderControl := TVpLinkableControl (FWeekView);
itMonthView : RenderControl := TVpLinkableControl (FMonthView);
itCalendar : RenderControl := TVpLinkableControl (FCalendar);
itContacts : RenderControl := TVpLinkableControl (FContactGrid);
itTasks : RenderControl := TVpLinkableControl (FTaskList);
end;
if FOwner is TVpControlLink then
RenderControl.DataStore := (FOwner as TVPControlLink).DataStore;
end;
if Assigned (RenderControl) then
case Element.ItemType of
itTasks : begin
FHaveTaskList := True;
RenderControl.RenderToCanvas (ACanvas,
Rect (StartX, StartY, StopX, StopY),
Element.Rotation,
Scale,
GetDate (Element),
FLastTask,
EndLine,
Granularity,
True);
FLastTask := RenderControl.GetLastPrintLine;
end;
itContacts : begin
FHaveContactGrid := True;
RenderControl.RenderToCanvas (ACanvas,
Rect (StartX, StartY, StopX, StopY),
Element.Rotation,
Scale,
GetDate (Element),
FLastContact,
EndLine,
Granularity,
True);
FLastContact := RenderControl.GetLastPrintLine;
end;
else
RenderControl.RenderToCanvas (ACanvas,
Rect (StartX, StartY, StopX, StopY),
Element.Rotation,
Scale,
GetDate (Element),
StartLine,
EndLine,
Granularity,
True);
end;
case Element.ItemType of
itDayView,
itMonthView,
itWeekView,
itCalendar : FHaveDate := True;
end;
end;
var
i : Integer;
begin
CheckPrintFormat;
if not (FPrintJob) then begin
FLastTask := 0;
FLastContact := 0;
end;
AddDefaultVariables (ADate);
if not (FOwner is TVpControlLink) then
raise EVpPrintFormatError.Create (RSPrtControlOwner);
GetMeasurements;
if not ValidFormat (CurFormat) then
raise EVpPrintFormatError.Create (RSBadPrintFormat + IntToStr (CurFormat));
for i := 0 to FPrintFormats.Items[CurFormat].Elements.Count - 1 do begin
GetPrintRectangle (FPrintFormats.Items[CurFormat].Elements.Items[i]);
if FPrintFormats.Items[CurFormat].Elements.Items[i].ItemType = itCaption then begin
if FPrintFormats.Items[CurFormat].Elements.Items[i].Visible then begin
UpdateDateVariables (GetDate (FPrintFormats.Items[CurFormat].Elements.Items[i]));
ACanvas.Font.Assign (FPrintFormats.Items[CurFormat].Elements.Items[i].FCaption.Font);
FPrintFormats.Items[CurFormat].Elements.Items[i].FCaption.PaintToCanvas (ACanvas,
Rect (StartX, StartY, StopX, StopY),
FPrintFormats.Items[CurFormat].Elements.Items[i].Rotation,
ARect,
ReplaceVariables (FPrintFormats.Items[CurFormat].Elements.Items[i].FCaption.Caption));
end;
end else if FPrintFormats.Items[CurFormat].Elements.Items[i].ItemType = itShape then begin
if FPrintFormats.Items[CurFormat].Elements.Items[i].Visible then begin
ACanvas.Pen.Assign (FPrintFormats.Items[CurFormat].Elements.Items[i].FShape.Pen);
ACanvas.Brush.Assign (FPrintFormats.Items[CurFormat].Elements.Items[i].FShape.Brush);
FPrintFormats.Items[CurFormat].Elements.Items[i].FShape.PaintToCanvas (ACanvas,
Rect (StartX, StartY, StopX, StopY),
FPrintFormats.Items[CurFormat].Elements.Items[i].Rotation,
ARect)
end;
end else
RenderItem (FPrintFormats.Items[CurFormat].Elements.Items[i]);
end;
end;
{=====}
procedure TVpPrinter.Print (APrinter : TPrinter;
StartDate : TDateTime;
EndDate : TDateTime);
var
ARect : TRect;
WidthInPixels : Integer;
HeightInPixels : Integer;
PixelsPerInchX : Integer;
PixelsPerInchY : Integer;
Scale : Extended;
procedure GetMeasurements;
begin
ARect.Left := 0;
ARect.Top := 0;
ARect.Right := APrinter.PageWidth;
ARect.Bottom := APrinter.PageHeight;
WidthInPixels := ARect.Right - ARect.Left;
HeightInPixels := ARect.Bottom - ARect.Top;
PixelsPerInchX := GetDeviceCaps (APrinter.Canvas.Handle, LOGPIXELSX);
PixelsPerInchY := GetDeviceCaps (APrinter.Canvas.Handle, LOGPIXELSY);
Scale := PixelsPerInchY / Screen.PixelsPerInch;
end;
procedure CalculateMargins;
begin
case MarginUnits of
imAbsolutePixel : begin
ARect.Left := Round (LeftMargin);
ARect.Top := Round (TopMargin);
ARect.Right := ARect.Right - Round (RightMargin);
ARect.Bottom := ARect.Bottom - Round (BottomMargin);
end;
imPercent : begin
ARect.Left := Round (LeftMargin * WidthInPixels / 100);
ARect.Top := Round (TopMargin * HeightInPixels / 100);
ARect.Right := ARect.Right - Round (RightMargin * WidthInPixels / 100);
ARect.Bottom := ARect.Bottom - Round (BottomMargin * HeightInPixels / 100);
end;
imInches : begin
ARect.Left := Round (LeftMargin * PixelsPerInchX);
ARect.Top := Round (TopMargin * PixelsPerInchX);
ARect.Right := ARect.Right - Round (RightMargin * PixelsPerInchX);
ARect.Bottom := ARect.Bottom - Round (BottomMargin * PixelsPerInchX);
end;
end;
end;
function GetNextDate (ADate : TDateTime) : TDateTime;
begin
Result := ADate;
if PrintFormats.Items[CurFormat].DayInc <> 0 then begin
case PrintFormats.Items[CurFormat].DayIncUnits of
duDay : Result := Result + PrintFormats.Items[CurFormat].DayInc;
duWeek : Result := Result + PrintFormats.Items[CurFormat].DayInc * 7;
duMonth : Result := IncMonth (Result, PrintFormats.Items[CurFormat].DayInc);
duYear : Result := IncYear (Result, PrintFormats.Items[CurFormat].DayInc);
end;
end else
Result := Result + 1;
end;
var
CurDate : TDateTime;
RealStartDate : TDateTime;
RealEndDate : TDateTime;
PageNum : Integer;
Done : Boolean;
begin
CheckPrintFormat;
FHaveDate := False;
FHaveContactGrid := False;
FHaveTaskList := False;
FPrintJob := True;
try
AddDefaultVariables (StartDate);
PageNum := 1;
if not (FOwner is TVpControlLink) then
raise EVpPrintFormatError.Create (RSPrtControlOwner);
if not ValidFormat (CurFormat) then
raise EVpPrintFormatError.Create (RSBadPrintFormat + IntToStr (CurFormat));
GetMeasurements;
CalculateMargins;
CurDate := GetNextDate (StartDate);
RealStartDate := StartDate;
RealEndDate := EndDate;
if CurDate < StartDate then begin
if StartDate < EndDate then begin
RealStartDate := EndDate;
RealEndDate := StartDate;
end;
end else begin
if StartDate > EndDate then begin
RealStartDate := EndDate;
RealEndDate := StartDate;
end;
end;
CurDate := RealStartDate;
Done := False;
while not Done do begin
{ Update variables to reflect the current date }
UpdateDateVariables (CurDate);
ChangeVariable ('Page', IntToStr (PageNum));
{ Paint the page }
if FOwner is TVpControlLink then
with FOwner as TVpControlLink do
TriggerOnPageStart (Self, PageNum, CurDate);
PaintToCanvasRect (Printer.Canvas, ARect, CurDate);
{ Get the next date }
CurDate := GetNextDate (CurDate);
{ Determine if the printing is done or not.
This is a bit involved. If only dates, captions and shapes are in the
print format, doneness is determined when the date passes the end date.
If task lists or contact grids are on the format, then doneness occurs
when the date has bumped pass the last date and all the tasks and
contacts have been printed.
}
Done := True;
if (FHaveDate) and (CurDate <= RealEndDate) then
Done := False;
if (FHaveTaskList) and (FLastTask >= 0) then
Done := False;
if (FHaveContactGrid) and (FLastContact >= 0) then
Done := False;
if FOwner is TVpControlLink then
with FOwner as TVpControlLink do
TriggerOnPageEnd (Self, PageNum, CurDate, Done);
{ Go to the next page if not done }
if not Done then begin
Printer.NewPage;
Inc (PageNum);
end;
end;
finally
FPrintJob := False;
end;
end;
{=====}
procedure TVpPrinter.RegisterWatcher (Watcher : THandle);
var
i : Integer;
NewHandle : PVpWatcher;
begin
for i := 0 to FNotifiers.Count - 1 do
if Assigned (FNotifiers[i]) then
if PVpWatcher (FNotifiers[i]).Handle = Watcher then
Exit;
GetMem (NewHandle, SizeOf (TVpWatcher));
NewHandle.Handle := Watcher;
FNotifiers.Add (NewHandle);
end;
{=====}
procedure TVpPrinter.RenderPage ( ACanvas : TCanvas;
ARect : TRect;
PageNum : Integer;
var ADate : TDateTime;
EndDate : TDateTime;
var StartContact : Integer;
var StartTask : Integer;
var LastPage : Boolean);
var
WidthInPixels : Integer;
HeightInPixels : Integer;
PixelsPerInchX : Integer;
PixelsPerInchY : Integer;
Scale : Extended;
procedure GetMeasurements;
begin
WidthInPixels := ARect.Right - ARect.Left;
HeightInPixels := ARect.Bottom - ARect.Top;
PixelsPerInchX := GetDeviceCaps (ACanvas.Handle, LOGPIXELSX);
PixelsPerInchY := GetDeviceCaps (ACanvas.Handle, LOGPIXELSY);
Scale := PixelsPerInchY / Screen.PixelsPerInch;
end;
procedure CalculateMargins;
begin
case MarginUnits of
imAbsolutePixel : begin
ARect.Left := Round (LeftMargin);
ARect.Top := Round (TopMargin);
ARect.Right := ARect.Right - Round (RightMargin);
ARect.Bottom := ARect.Bottom - Round (BottomMargin);
end;
imPercent : begin
ARect.Left := Round (LeftMargin * WidthInPixels / 100);
ARect.Top := Round (TopMargin * HeightInPixels / 100);
ARect.Right := ARect.Right - Round (RightMargin * WidthInPixels / 100);
ARect.Bottom := ARect.Bottom - Round (BottomMargin * HeightInPixels / 100);
end;
imInches : begin
ARect.Left := Round (LeftMargin * PixelsPerInchX);
ARect.Top := Round (TopMargin * PixelsPerInchX);
ARect.Right := ARect.Right - Round (RightMargin * PixelsPerInchX);
ARect.Bottom := ARect.Bottom - Round (BottomMargin * PixelsPerInchX);
end;
end;
end;
function GetNextDate (ADate : TDateTime) : TDateTime;
begin
Result := ADate;
if PrintFormats.Items[CurFormat].DayInc <> 0 then begin
case PrintFormats.Items[CurFormat].DayIncUnits of
duDay : Result := Result + PrintFormats.Items[CurFormat].DayInc;
duWeek : Result := Result + PrintFormats.Items[CurFormat].DayInc * 7;
duMonth : Result := IncMonth (Result, PrintFormats.Items[CurFormat].DayInc);
duYear : Result := IncYear (Result, PrintFormats.Items[CurFormat].DayInc);
end;
end else
Result := Result + 1;
end;
var
OldTask : Integer;
OldContact : Integer;
begin
CheckPrintFormat;
FHaveDate := False;
FHaveContactGrid := False;
FHaveTaskList := False;
OldTask := FLastTask;
OldContact := FLastContact;
FPrintJob := True;
try
AddDefaultVariables (ADate);
if not (FOwner is TVpControlLink) then
raise EVpPrintFormatError.Create (RSPrtControlOwner);
if FPrintFormats.Count = 0 then
raise EVpPrintFormatError.Create (RSNeedFormatName)
else if not ValidFormat (CurFormat) then
raise EVpPrintFormatError.Create (RSBadPrintFormat + IntToStr (CurFormat));
GetMeasurements;
CalculateMargins;
ChangeVariable ('Page', IntToStr (PageNum));
FLastTask := StartTask;
FLastContact := StartContact;
PaintToCanvasRect (ACanvas, ARect, ADate);
ADate := GetNextDate (ADate);
LastPage := True;
if (FHaveDate) and (ADate < EndDate) then
LastPage := False;
if (FHaveTaskList) and (FLastTask >= 0) then
LastPage := False;
if (FHaveContactGrid) and (FLastContact >= 0) then
LastPage := False;
finally
FLastTask := OldTask;
FLastContact := OldContact;
end;
end;
{=====}
function TVpPrinter.ReplaceVariables (const s : string) : string;
type
TVpVariableState = (vsPlainText, vsCollectVarName, vsHaveVarName);
var
State : TVpVariableState;
SLen : Integer;
i : Integer;
VarName : string;
ForceTerm : Boolean;
VarsOk : Boolean;
Value : string;
Found : Boolean;
Change : TVpChangeVar;
begin
State := vsPlainText;
SLen := Length (s);
i := 1;
Result := '';
VarsOk := True;
ForceTerm := False;
while (i <= SLen) do begin
case State of
vsCollectVarName :
case s[i] of
'A'..'Z', 'a'..'z', '0'..'9', '_' :
VarName := VarName + s[i];
';' : begin
State := vsHaveVarName;
ForceTerm := True;
end;
else begin
State := vsHaveVarName;
ForceTerm := False;
end;
end;
vsHaveVarName : begin
State := vsPlainText;
VarsOk := True;
Found := HaveVariable (VarName);
if Found then begin
Change := cvChange;
Value := LookupVariable (VarName);
end else
Change := cvRemove;
if FOwner is TVpControlLink then
with FOwner as TVpControlLink do
TriggerOnGetVariable (Self, VarName, Found, Value, Change);
case Change of
cvChange :
if ForceTerm then
Result := Result + Value + s[i]
else
Result := Result + Value + s[i - 1] + s[i];
cvIgnore :
Result := Result + '$' + VarName + s[i - 1] + s[i];
cvRemove : begin
end;
end;
end;
vsPlainText :
case s[i] of
'$' : begin
VarsOk := False;
State := vsCollectVarName;
VarName := '';
end;
else
Result := Result + s[i];
end;
end;
Inc (i);
end;
if not VarsOk then begin
Found := HaveVariable (VarName);
if Found then begin
Change := cvChange;
Value := LookupVariable (VarName);
end else
Change := cvRemove;
if FOwner is TVpControlLink then
with FOwner as TVpControlLink do
TriggerOnGetVariable (Self, VarName, Found, Value, Change);
case Change of
cvChange :
Result := Result + LookupVariable (VarName);
cvIgnore :
Result := Result + '$' + VarName + s[i - 1];
cvRemove : begin
end;
end;
end;
end;
{=====}
procedure TVpPrinter.SaveToFile (FileName : string);
var
fpOut : TextFile;
i : Integer;
j : Integer;
begin
if FileName = '' then
FileName := DefaultXMLFileName;
AssignFile (fpOut, FileName);
Rewrite (fpOut);
try
Writeln (fpOut, '<?xml version="1.0" encoding="UTF-8"?>');
Writeln (fpOut, '<VpPrintFormats');
Writeln (fpOut, ' Version = "0.0.1">');
for i := 0 to FPrintFormats.Count - 1 do begin
Writeln (fpOut, ' <PrintFormat');
Writeln (fpOut, ' Name="' + XMLizeString (FPrintFormats.Items[i].FormatName) + '"');
Writeln (fpOut, ' Description="' + XMLizeString (FPrintFormats.Items[i].Description) + '"');
Writeln (fpOut, ' DayIncrement="' + IntToStr (FPrintFormats.Items[i].DayInc) + '"');
if FPrintFormats.Items[i].Visible then
Writeln (fpOut, ' Visble="True"')
else
Writeln (fpOut, ' Visble="False"');
case FPrintFormats.Items[i].DayIncUnits of
duDay : Writeln (fpOut, ' DayIncrementUnits="Day">');
duWeek : Writeln (fpOut, ' DayIncrementUnits="Week">');
duMonth : Writeln (fpOut, ' DayIncrementUnits="Month">');
duYear : Writeln (fpOut, ' DayIncrementUnits="Year">');
end;
for j := 0 to FPrintFormats.Items[i].Elements.Count - 1 do begin
Writeln (fpOut, ' <Element');
Writeln (fpOut, ' Name="' +
FPrintFormats.Items[i].Elements.Items[j].ElementName +
'"');
if FPrintFormats.Items[i].Elements.Items[j].Visible then
Writeln (fpOut, ' Visible="True"')
else
Writeln (fpOut, ' Visible="False"');
case FPrintFormats.Items[i].Elements.Items[j].Rotation of
ra0 : Writeln (fpOut, ' Rotation="0"');
ra90 : Writeln (fpOut, ' Rotation="90"');
ra180 : Writeln (fpOut, ' Rotation="180"');
ra270 : Writeln (fpOut, ' Rotation="270"');
end;
case FPrintFormats.Items[i].Elements.Items[j].ItemType of
itDayView : Writeln (fpOut, ' Item="DayView"');
itWeekView : Writeln (fpOut, ' Item="WeekView"');
itMonthView : Writeln (fpOut, ' Item="MonthView"');
itCalendar : Writeln (fpOut, ' Item="Calendar"');
itShape : Writeln (fpOut, ' Item="Shape"');
itCaption : Writeln (fpOut, ' Item="Caption"');
itTasks : Writeln (fpOut, ' Item="Tasks"');
itContacts : Writeln (fpOut, ' Item="Contacts"');
end;
case FPrintFormats.Items[i].Elements.Items[j].Measurement of
imAbsolutePixel : Writeln (fpOut, ' Measurement="AbsolutePixel"');
imPercent : Writeln (fpOut, ' Measurement="Percent"');
imInches : Writeln (fpOut, ' Measurement="Inches"');
end;
Writeln (fpOut, ' Left="' + FloatToStr (FPrintFormats.Items[i].Elements.Items[j].Left) + '"');
Writeln (fpOut, ' Top="' + FloatToStr (FPrintFormats.Items[i].Elements.Items[j].Top) + '"');
Writeln (fpOut, ' Width="' + FloatToStr (FPrintFormats.Items[i].Elements.Items[j].Width) + '"');
Writeln (fpOut, ' Height="' + FloatToStr (FPrintFormats.Items[i].Elements.Items[j].Height) + '"');
Writeln (fpOut, ' DayOffset="' + IntToStr (FPrintFormats.Items[i].Elements.Items[j].DayOffset) + '"');
case FPrintFormats.Items[i].Elements.Items[j].DayOffsetUnits of
duDay : Writeln (fpOut, ' DayOffsetUnits="Day">');
duWeek : Writeln (fpOut, ' DayOffsetUnits="Week">');
duMonth : Writeln (fpOut, ' DayOffsetUnits="Month">');
duYear : Writeln (fpOut, ' DayOffsetUnits="Year">');
end;
if FPrintFormats.Items[i].Elements.Items[j].ItemType = itShape then begin
Writeln (fpOut, ' <Shape');
case FPrintFormats.Items[i].Elements.Items[j].FShape.Shape of
ustRectangle : Writeln (fpOut, ' Type="Rectangle">');
ustTopLine : Writeln (fpOut, ' Type="TopLine">');
ustBottomLine : Writeln (fpOut, ' Type="BottomLine">');
ustLeftLine : Writeln (fpOut, ' Type="LeftLine">');
ustRightLine : Writeln (fpOut, ' Type="RightLine">');
ustTLToBRLine : Writeln (fpOut, ' Type="TLToBRLine">');
ustBLToTRLine : Writeln (fpOut, ' Type="BLToTRLine">');
ustEllipse : Writeln (fpOut, ' Type="Ellipse">');
end;
Writeln (fpOut, ' <Brush');
Writeln (fpOut, ' Color="' +
IntToStr (FPrintFormats.Items[i].Elements.Items[j].FShape.Brush.Color) +
'"');
case FPrintFormats.Items[i].Elements.Items[j].FShape.Brush.Style of
bsSolid : Writeln (fpOut, ' Style="Solid"/>');
bsClear : Writeln (fpOut, ' Style="Clear"/>');
bsHorizontal : Writeln (fpOut, ' Style="Horizontal"/>');
bsVertical : Writeln (fpOut, ' Style="Vertical"/>');
bsFDiagonal : Writeln (fpOut, ' Style="FDiagonal"/>');
bsBDiagonal : Writeln (fpOut, ' Style="BDiagonal"/>');
bsCross : Writeln (fpOut, ' Style="Cross"/>');
bsDiagCross : Writeln (fpOut, ' Style="DiagCross"/>');
end;
Writeln (fpOut, ' <Pen');
Writeln (fpOut, ' Color="' +
IntToStr (FPrintFormats.Items[i].Elements.Items[j].FShape.Pen.Color) +
'"');
case FPrintFormats.Items[i].Elements.Items[j].FShape.Pen.Style of
psSolid : Writeln (fpOut, ' Style="Solid"');
psDash : Writeln (fpOut, ' Style="Dash"');
psDot : Writeln (fpOut, ' Style="Dot"');
psDashDot : Writeln (fpOut, ' Style="DashDot"');
psDashDotDot : Writeln (fpOut, ' Style="DashDotDot"');
psClear : Writeln (fpOut, ' Style="Clear"');
psInsideFrame : Writeln (fpOut, ' Style="InsideFrame"');
end;
Writeln (fpOut, ' Width="' +
IntToStr (FPrintFormats.Items[i].Elements.Items[j].FShape.Pen.Width) +
'"/>');
Writeln (fpOut, ' </Shape>');
end;
if FPrintFormats.Items[i].Elements.Items[j].ItemType = itCaption then begin
Writeln (fpOut, ' <Caption');
Writeln (fpOut, ' Caption="' +
XMLizeString (FPrintFormats.Items[i].Elements.Items[j].Caption.Caption) + '">');
Writeln (fpOut, ' <Font');
case FPrintFormats.Items[i].Elements.Items[j].Caption.Font.Charset of
ANSI_CHARSET : Writeln (fpOut, ' CharSet="ANSI"');
DEFAULT_CHARSET : Writeln (fpOut, ' CharSet="Default"');
SYMBOL_CHARSET : Writeln (fpOut, ' CharSet="Symbol"');
{$IFNDEF LCL}
MAC_CHARSET : Writeln (fpOut, ' CharSet="Mac"');
{$ENDIF}
SHIFTJIS_CHARSET : Writeln (fpOut, ' CharSet="ShiftJIS"');
HANGEUL_CHARSET : Writeln (fpOut, ' CharSet="Hangeul"');
{$IFNDEF LCL}
JOHAB_CHARSET : Writeln (fpOut, ' CharSet="Johab"');
{$ENDIF}
GB2312_CHARSET : Writeln (fpOut, ' CharSet="GB2312"');
CHINESEBIG5_CHARSET : Writeln (fpOut, ' CharSet="ChineseBig5"');
GREEK_CHARSET : Writeln (fpOut, ' CharSet="Greek"');
TURKISH_CHARSET : Writeln (fpOut, ' CharSet="Turkish"');
{$IFNDEF LCL}
VIETNAMESE_CHARSET : Writeln (fpOut, ' CharSet="Vietnamese"');
{$ENDIF}
HEBREW_CHARSET : Writeln (fpOut, ' CharSet="Hebrew"');
ARABIC_CHARSET : Writeln (fpOut, ' CharSet="Arabic"');
BALTIC_CHARSET : Writeln (fpOut, ' CharSet="Baltic"');
RUSSIAN_CHARSET : Writeln (fpOut, ' CharSet="Russian"');
THAI_CHARSET : Writeln (fpOut, ' CharSet="Thai"');
EASTEUROPE_CHARSET : Writeln (fpOut, ' CharSet="EastEurope"');
OEM_CHARSET : Writeln (fpOut, ' CharSet="OEM"');
end;
Writeln (fpOut, ' Color="' +
IntToStr (FPrintFormats.Items[i].Elements.Items[j].Caption.Font.Color) +
'"');
Writeln (fpOut, ' Height="' +
IntToStr (FPrintFormats.Items[i].Elements.Items[j].Caption.Font.Height) +
'"');
Writeln (fpOut, ' Name="' +
XMLizeString (FPrintFormats.Items[i].Elements.Items[j].Caption.Font.Name) +
'"');
case FPrintFormats.Items[i].Elements.Items[j].Caption.Font.Pitch of
fpDefault : Writeln (fpOut, ' Pitch="Default"');
fpVariable : Writeln (fpOut, ' Pitch="Variable"');
fpFixed : Writeln (fpOut, ' Pitch="Fixed"');
end;
if fsBold in FPrintFormats.Items[i].Elements.Items[j].Caption.Font.Style then
Writeln (fpOut, ' Bold="True"')
else
Writeln (fpOut, ' Bold="False"');
if fsItalic in FPrintFormats.Items[i].Elements.Items[j].Caption.Font.Style then
Writeln (fpOut, ' Italic="True"')
else
Writeln (fpOut, ' Italic="False"');
if fsUnderline in FPrintFormats.Items[i].Elements.Items[j].Caption.Font.Style then
Writeln (fpOut, ' Underline="True"')
else
Writeln (fpOut, ' Underline="False"');
if fsStrikeout in FPrintFormats.Items[i].Elements.Items[j].Caption.Font.Style then
Writeln (fpOut, ' Strikeout="True"/>')
else
Writeln (fpOut, ' Strikeout="False"/>');
Writeln (fpOut, ' </Caption>');
end;
Writeln (fpOut, ' </Element>');
end;
Writeln (fpOut, ' </PrintFormat>');
end;
Writeln (fpOut, '</VpPrintFormats>');
finally
CloseFile (fpOut);
end;
end;
{=====}
procedure TVpPrinter.SetBottomMargin (const v : Extended);
begin
if v <> FBottomMargin then begin
FBottomMargin := v;
NotifyLinked;
end;
end;
{=====}
procedure TVpPrinter.SetCurFormat (const v : Integer);
begin
if FPrintFormats.Count = 0 then
raise EVpPrintFormatError.Create (RSNoPrintFormats);
if v <> FCurFormat then begin
if (v < 0) or (v >= FPrintFormats.Count) then
raise EVpPrintFormatError.Create (RSBadPrintFormat + IntToStr (v));
FCurFormat := v;
NotifyLinked;
end;
end;
{=====}
procedure TVpPrinter.SetDefaultXMLFileName (const v : string);
begin
if v <> FDefaultXMLFileName then
FDefaultXMLFileName := v;
end;
{=====}
procedure TVpPrinter.SetLeftMargin (const v : Extended);
begin
if v <> FLeftMargin then begin
FLeftMargin := v;
NotifyLinked;
end;
end;
{=====}
procedure TVpPrinter.SetMarginUnits (const v : TVpItemMeasurement);
begin
if v <> FMarginUnits then begin
FMarginUnits := v;
NotifyLinked;
end;
end;
{=====}
procedure TVpPrinter.SetPrintFormats (const v : TVpPrintFormat);
begin
FPrintFormats.Assign (v);
NotifyLinked;
end;
{=====}
procedure TVpPrinter.SetRightMargin (const v : Extended);
begin
if v <> FRightMargin then begin
FRightMargin := v;
NotifyLinked;
end;
end;
{=====}
procedure TVpPrinter.SetTopMargin (const v : Extended);
begin
if v <> FTopMargin then begin
FTopMargin := v;
NotifyLinked;
end;
end;
{=====}
procedure TVpPrinter.SetUseFormComponents (const v : Boolean);
begin
if v <> FUseFormComponents then begin
FUseFormComponents := v;
NotifyLinked;
end;
end;
{=====}
procedure TVpPrinter.UpdateDateVariables (Date : TDateTime);
begin
AddVariable ('DayNumber', FormatDateTime ('d', Date));
AddVariable ('DayNumber0', FormatDateTime ('dd', Date));
AddVariable ('DayAbbrev', FormatDateTime ('ddd', Date));
AddVariable ('DayName', FormatDateTime ('dddd', Date));
AddVariable ('ShortDate', FormatDateTime ('ddddd', Date));
AddVariable ('LongDate', FormatDateTime ('dddddd', Date));
AddVariable ('Era', FormatDateTime ('e', Date));
AddVariable ('Era0', FormatDateTime ('ee', Date));
AddVariable ('EraAbbrev', FormatDateTime ('g', Date));
AddVariable ('EraName', FormatDateTime ('gg', Date));
AddVariable ('Month', FormatDateTime ('m', Date));
AddVariable ('Month0', FormatDateTime ('mm', Date));
AddVariable ('MonthAbbv', FormatDateTime ('mmm', Date));
AddVariable ('MonthName', FormatDateTime ('mmmm', Date));
AddVariable ('ShortYear', FormatDateTime ('yy', Date));
AddVariable ('LongYear', FormatDateTime ('yyyy', Date));
AddVariable ('DateSep', FormatDateTime ('/', Date));
AddVariable ('d', FormatDateTime ('d', Date));
AddVariable ('dd', FormatDateTime ('dd', Date));
AddVariable ('ddd', FormatDateTime ('ddd', Date));
AddVariable ('dddd', FormatDateTime ('dddd', Date));
AddVariable ('ddddd', FormatDateTime ('ddddd', Date));
AddVariable ('dddddd', FormatDateTime ('dddddd', Date));
AddVariable ('e', FormatDateTime ('e', Date));
AddVariable ('ee', FormatDateTime ('ee', Date));
AddVariable ('g', FormatDateTime ('g', Date));
AddVariable ('gg', FormatDateTime ('gg', Date));
AddVariable ('m', FormatDateTime ('m', Date));
AddVariable ('mm', FormatDateTime ('mm', Date));
AddVariable ('mmm', FormatDateTime ('mmm', Date));
AddVariable ('mmmm', FormatDateTime ('mmmm', Date));
AddVariable ('yy', FormatDateTime ('yy', Date));
AddVariable ('yyyy', FormatDateTime ('yyyy', Date));
AddVariable ('/', FormatDateTime ('/', Date));
end;
{=====}
function TVpPrinter.ValidFormat (const v : Integer) : Boolean;
begin
Result := (v >= 0) and (v < FPrintFormats.Count);
end;
{=====}
procedure TVpPrinter.xmlPrintFormatAttribute (oOwner : TObject;
sName,
sValue : DOMString;
bSpecified : Boolean);
var
Item : TVpAttributeItem;
begin
Item := TVpAttributeItem (FAttributes.Add);
Item.Name := sName;
Item.Value := sValue;
end;
{=====}
procedure TVpPrinter.xmlPrintFormatEndElement (oOwner : TObject;
sValue : DOMString);
begin
if (sValue = 'PrintFormat') or (sValue = 'VpPrintFormats') then begin
FLoadingIndex := -1;
FElementIndex := -1;
end else if sValue = 'Element' then
FElementIndex := -1;
FAttributes.Clear;
end;
{=====}
procedure TVpPrinter.xmlPrintFormatStartElement (oOwner : TObject;
sValue : DOMString);
var
i : Integer;
NewItem : TVpPrintFormatItem;
NewElement : TVpPrintFormatElementItem;
begin
if sValue = 'VpPrintFormats' then begin
FLoadingIndex := -1;
FElementIndex := -1;
end else if sValue = 'PrintFormat' then begin
{ Search for either missing names or duplicate names }
{ Missing names will be replaced with Unknown. Duplicate names
are not allowed. }
for i := 0 to FAttributes.Count - 1 do
if FAttributes.Items[i].Name = 'Name' then begin
if FAttributes.Items[i].Value = '' then
FAttributes.Items[i].Value := 'Unknown'
else if Find (FAttributes.Items[i].Value) >= 0 then
Exit;
end;
{ If we've gotten this far, the name is good. Add the element }
NewItem := TVpPrintFormatItem (FPrintFormats.Add);
for i := 0 to FAttributes.Count - 1 do begin
if (FAttributes.Items[i].Name = 'Name') and
(Fattributes.Items[i].Value <> '') then
NewItem.FormatName := FAttributes.Items[i].Value
else if FAttributes.Items[i].Name = 'Description' then
NewItem.Description := FAttributes.Items[i].Value
else if FAttributes.Items[i].Name = 'Visible' then begin
if FAttributes.Items[i].Value = 'True' then
NewItem.Visible := True
else if FAttributes.Items[i].Value = 'False' then
NewItem.Visible := False;
end else if FAttributes.Items[i].Name = 'DayIncrementUnits' then begin
if FAttributes.Items[i].Value = 'Day' then
NewItem.DayIncUnits := duDay
else if FAttributes.Items[i].Value = 'Week' then
NewItem.DayIncUnits := duWeek
else if FAttributes.Items[i].Value = 'Month' then
NewItem.DayIncUnits := duMonth
else if FAttributes.Items[i].Value = 'Year' then
NewItem.DayIncUnits := duYear;
end;
end;
FLoadingIndex := NewItem.Index;
end else if sValue = 'Element' then begin
if FLoadingIndex < 0 then
Exit;
NewElement := TVpPrintFormatElementItem (FPrintFormats.Items[FLoadingIndex].Elements.Add);
try
FElementIndex := NewElement.Index;
for i := 0 to FAttributes.Count - 1 do begin
if FAttributes.Items[i].Name = 'Name' then
NewElement.ElementName := FAttributes.Items[i].Value
else if FAttributes.Items[i].Name = 'Visible' then begin
if FAttributes.Items[i].Value = 'False' then
NewElement.Visible := False
else if FAttributes.Items[i].Value = 'True' then
NewElement.Visible := True;
end else if FAttributes.Items[i].Name = 'Rotation' then begin
if FAttributes.Items[i].Value = '90' then
NewElement.Rotation := ra90
else if FAttributes.Items[i].Value = '180' then
NewElement.Rotation := ra180
else if FAttributes.Items[i].Value = '270' then
NewElement.Rotation := ra270
else
NewElement.Rotation := ra0;
end else if FAttributes.Items[i].Name = 'Item' then begin
if FAttributes.Items[i].Value = 'DayView' then
NewElement.ItemType := itDayView
else if FAttributes.Items[i].Value = 'WeekView' then
NewElement.ItemType := itWeekView
else if FAttributes.Items[i].Value = 'MonthView' then
NewElement.ItemType := itMonthView
else if FAttributes.Items[i].Value = 'Shape' then
NewElement.ItemType := itShape
else if FAttributes.Items[i].Value = 'Caption' then
NewElement.ItemType := itCaption
else if FAttributes.Items[i].Value = 'Calendar' then
NewElement.ItemType := itCalendar
else if FAttributes.Items[i].Value = 'Tasks' then
NewElement.ItemType := itTasks
else if FAttributes.Items[i].Value = 'Contacts' then
NewElement.ItemType := itContacts
else
raise EVpPrintFormatError.Create (RSBadItemType + FAttributes.Items[i].Value);
end else if FAttributes.Items[i].Name = 'Measurement' then begin
if FAttributes.Items[i].Value = 'AbsolutePixel' then
NewElement.Measurement := imAbsolutePixel
else if FAttributes.Items[i].Value = 'Percent' then
NewElement.Measurement := imPercent
else if FAttributes.Items[i].Value = 'Inches' then
NewElement.Measurement := imInches
else
raise EVpPrintFormatError.Create (RSBadMeasurement + FAttributes.Items[i].Value);
end else if FAttributes.Items[i].Name = 'Left' then
NewElement.Left := StrToFloat (FAttributes.Items[i].Value)
else if FAttributes.Items[i].Name = 'Top' then
NewElement.Top := StrToFloat (FAttributes.Items[i].Value)
else if FAttributes.Items[i].Name = 'Width' then
NewElement.Width := StrToFloat (FAttributes.Items[i].Value)
else if FAttributes.Items[i].Name = 'Height' then
NewElement.Height := StrToFloat (FAttributes.Items[i].Value)
else if FAttributes.Items[i].Name = 'DayOffset' then
NewElement.DayOffset:= StrToInt (FAttributes.Items[i].Value)
else if FAttributes.Items[i].Name = 'DayOffsetUnits' then begin
if FAttributes.Items[i].Value = 'Day' then
NewElement.DayOffsetUnits := duDay
else if FAttributes.Items[i].Value = 'Week' then
NewElement.DayOffsetUnits := duWeek
else if FAttributes.Items[i].Value = 'Month' then
NewElement.DayOffsetUnits := duMonth
else if FAttributes.Items[i].Value = 'Year' then
NewElement.DayOffsetUnits := duYear;
end;
end;
except
on EConvertError do begin
end;
end;
end else if sValue = 'Shape' then begin
if (FLoadingIndex < 0) or (FElementIndex < 0) then
Exit;
for i := 0 to FAttributes.Count - 1 do
if FAttributes.Items[i].Name = 'Type' then begin
if FAttributes.Items[i].Value = 'Rectangle' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Shape := ustRectangle
else if FAttributes.Items[i].Value = 'TopLine' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Shape := ustTopLine
else if FAttributes.Items[i].Value = 'BottomLine' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Shape := ustBottomLine
else if FAttributes.Items[i].Value = 'LeftLine' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Shape := ustLeftLine
else if FAttributes.Items[i].Value = 'RightLine' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Shape := ustRightLine
else if FAttributes.Items[i].Value = 'TLToBRLine' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Shape := ustTLToBRLine
else if FAttributes.Items[i].Value = 'BLToTRLine' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Shape := ustBLToTRLine
else if FAttributes.Items[i].Value = 'Ellipse' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Shape := ustEllipse;
end;
end else if sValue = 'Caption' then begin
if (FLoadingIndex < 0) or (FElementIndex < 0) then
Exit;
for i := 0 to FAttributes.Count - 1 do
if FAttributes.Items[i].Name = 'Caption' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Caption :=
FAttributes.Items[i].Value;
end else if sValue = 'Pen' then begin
if (FLoadingIndex < 0) or (FElementIndex < 0) then
Exit;
try
for i := 0 to FAttributes.Count - 1 do
if FAttributes.Items[i].Name = 'Color' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Pen.Color :=
StrToInt (FAttributes.Items[i].Value)
else if FAttributes.Items[i].Name = 'Style' then begin
if FAttributes.Items[i].Value = 'Solid' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Pen.Style := psSolid
else if FAttributes.Items[i].Value = 'Dash' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Pen.Style := psDash
else if FAttributes.Items[i].Value = 'Dot' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Pen.Style := psDot
else if FAttributes.Items[i].Value = 'DashDot' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Pen.Style := psDashDot
else if FAttributes.Items[i].Value = 'DashDotDot' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Pen.Style := psDashDotDot
else if FAttributes.Items[i].Value = 'Clear' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Pen.Style := psClear
else if FAttributes.Items[i].Value = 'InsideFrame' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Pen.Style := psInsideFrame;
end else if FAttributes.Items[i].Name = 'Width' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Pen.Width :=
StrToInt (FAttributes.Items[i].Value);
except
on EConvertError do begin
end;
end;
end else if sValue = 'Brush' then begin
if (FLoadingIndex < 0) or (FElementIndex < 0) then
Exit;
try
for i := 0 to FAttributes.Count - 1 do
if FAttributes.Items[i].Name = 'Color' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Brush.Color :=
StrToInt (FAttributes.Items[i].Value)
else if FAttributes.Items[i].Name = 'Style' then begin
if FAttributes.Items[i].Value = 'Solid' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Brush.Style := bsSolid
else if FAttributes.Items[i].Value = 'Clear' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Brush.Style := bsClear
else if FAttributes.Items[i].Value = 'Horizontal' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Brush.Style := bsHorizontal
else if FAttributes.Items[i].Value = 'Vertical' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Brush.Style := bsVertical
else if FAttributes.Items[i].Value = 'FDiagonal' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Brush.Style := bsFDiagonal
else if FAttributes.Items[i].Value = 'BDiagonal' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Brush.Style := bsBDiagonal
else if FAttributes.Items[i].Value = 'Cross' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Brush.Style := bsCross
else if FAttributes.Items[i].Value = 'DiagCross' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Brush.Style := bsDiagCross;
end;
except
on EConvertError do begin
end;
end;
end else if sValue = 'Font' then begin
if (FLoadingIndex < 0) or (FElementIndex < 0) then
Exit;
try
for i := 0 to FAttributes.Count - 1 do
if FAttributes.Items[i].Name = 'CharSet' then begin
if FAttributes.Items[i].Value = 'ANSI' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := ANSI_CHARSET
else if FAttributes.Items[i].Value = 'Default' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := DEFAULT_CHARSET
else if FAttributes.Items[i].Value = 'Symbol' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := SYMBOL_CHARSET
{$IFNDEF LCL}
else if FAttributes.Items[i].Value = 'Mac' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := MAC_CHARSET
{$ENDIF}
else if FAttributes.Items[i].Value = 'ShiftJIS' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := SHIFTJIS_CHARSET
else if FAttributes.Items[i].Value = 'Hangeul' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := HANGEUL_CHARSET
{$IFNDEF LCL}
else if FAttributes.Items[i].Value = 'Johab' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := JOHAB_CHARSET
{$ENDIF}
else if FAttributes.Items[i].Value = 'GB2313' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := GB2312_CHARSET
else if FAttributes.Items[i].Value = 'ChineseBig5' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := CHINESEBIG5_CHARSET
else if FAttributes.Items[i].Value = 'Greek' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := GREEK_CHARSET
else if FAttributes.Items[i].Value = 'Turkish' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := TURKISH_CHARSET
{$IFNDEF LCL}
else if FAttributes.Items[i].Value = 'Vietnamese' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := VIETNAMESE_CHARSET
{$ENDIF}
else if FAttributes.Items[i].Value = 'Hebrew' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := HEBREW_CHARSET
else if FAttributes.Items[i].Value = 'Arabic' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := ARABIC_CHARSET
else if FAttributes.Items[i].Value = 'Baltic' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := BALTIC_CHARSET
else if FAttributes.Items[i].Value = 'Russian' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := RUSSIAN_CHARSET
else if FAttributes.Items[i].Value = 'Thai' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := THAI_CHARSET
else if FAttributes.Items[i].Value = 'EastEurope' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := EASTEUROPE_CHARSET
else if FAttributes.Items[i].Value = 'OEM' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := OEM_CHARSET
end else if FAttributes.Items[i].Name = 'Color' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Color :=
StrToInt (FAttributes.Items[i].Value)
else if FAttributes.Items[i].Name = 'Height' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Height:=
StrToInt (FAttributes.Items[i].Value)
else if FAttributes.Items[i].Name = 'Name' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Name :=
FAttributes.Items[i].Value
else if FAttributes.Items[i].Name = 'Color' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Color :=
StrToInt (FAttributes.Items[i].Value)
else if FAttributes.Items[i].Name = 'Pitch' then begin
if FAttributes.Items[i].Value = 'Default' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Pitch := fpDefault
else if FAttributes.Items[i].Value = 'Variable' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Pitch := fpVariable
else if FAttributes.Items[i].Value = 'Fixed' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Pitch := fpFixed;
end else if FAttributes.Items[i].Name = 'Bold' then begin
if FAttributes.Items[i].Value = 'True' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style :=
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style + [fsBold]
else
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style :=
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style - [fsBold];
end else if FAttributes.Items[i].Name = 'Italic' then begin
if FAttributes.Items[i].Value = 'True' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style :=
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style + [fsItalic]
else
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style :=
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style - [fsItalic];
end else if FAttributes.Items[i].Name = 'Underline' then begin
if FAttributes.Items[i].Value = 'True' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style :=
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style + [fsUnderline]
else
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style :=
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style - [fsUnderline];
end else if FAttributes.Items[i].Name = 'Strikeout' then begin
if FAttributes.Items[i].Value = 'True' then
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style :=
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style + [fsStrikeout]
else
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style :=
FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style - [fsStrikeout];
end;
except
on EConvertError do begin
end;
end;
end;
FAttributes.Clear;
end;
{=====}
end.
Reference in New Issue Copy Permalink