Componentes.Terceros.DevExp.../internal/x.48/1/ExpressPrinting System/Sources/dxPSEdgePatterns.pas
2010-01-18 18:37:26 +00:00

466 lines
14 KiB
ObjectPascal

{*******************************************************************}
{ }
{ Developer Express Visual Component Library }
{ ExpressPrinting System COMPONENT SUITE }
{ }
{ Copyright (C) 1998-2009 Developer Express Inc. }
{ ALL RIGHTS RESERVED }
{ }
{ The entire contents of this file is protected by U.S. and }
{ International Copyright Laws. Unauthorized reproduction, }
{ reverse-engineering, and distribution of all or any portion of }
{ the code contained in this file is strictly prohibited and may }
{ result in severe civil and criminal penalties and will be }
{ prosecuted to the maximum extent possible under the law. }
{ }
{ RESTRICTIONS }
{ }
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
{ LICENSED TO DISTRIBUTE THE EXPRESSPRINTINGSYSTEM AND }
{ ALL ACCOMPANYING VCL CONTROLS AS PART OF AN }
{ EXECUTABLE PROGRAM ONLY. }
{ }
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
{ }
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
{ ADDITIONAL RESTRICTIONS. }
{ }
{*******************************************************************}
unit dxPSEdgePatterns;
interface
{$I cxVer.inc}
uses
Classes, Windows, Graphics, dxCore, dxPSSngltn, dxBase, dxPSCore;
type
TdxPSCellEdgePatternOrientation = (cepoHorizontal, cepoVertical);
TdxPSEdgePattern = class(TdxPSCustomCellBorder)
public
class procedure Register; override;
class procedure Unregister; override;
class function Bits(Index: Integer): DWORD; virtual;
class function Name: string; virtual;
class function RequiredBrushOrigin: Boolean; virtual;
class function RequiredScaling: Boolean; virtual;
class function SignificantBitCount: Integer; virtual;
class function Solid: Boolean; override;
class function Thickness: Integer; override;
end;
TdxPSEdgePatternClass = class of TdxPSEdgePattern;
TdxPSSolidEdgePattern = class(TdxPSEdgePattern)
public
class function Bits(Index: Integer): DWORD; override;
class function Name: string; override;
class function RequiredBrushOrigin: Boolean; override;
class function RequiredScaling: Boolean; override;
class function SignificantBitCount: Integer; override;
class function Solid: Boolean; override;
class function Thickness: Integer; override;
end;
TdxPSEdgePatternItem = class
private
FBitmaps: array[TdxPSCellEdgePatternOrientation] of TBitmap;
FBrushes: array[TdxPSCellEdgePatternOrientation] of TBrush;
function GetBitmap(Orientation: TdxPSCellEdgePatternOrientation): TBitmap;
function GetBrush(Orientation: TdxPSCellEdgePatternOrientation): TBrush;
protected
procedure Initialize(APattern: TdxPSEdgePatternClass; AIsPrinting: Boolean); virtual;
public
constructor Create(APattern: TdxPSEdgePatternClass; AIsPrinting: Boolean);
destructor Destroy; override;
property Bitmaps[Orientation: TdxPSCellEdgePatternOrientation]: TBitmap read GetBitmap;
property Brushes[Orientation: TdxPSCellEdgePatternOrientation]: TBrush read GetBrush;
end;
TdxPSEdgePatternFactory = class(TBasedxPSSingleton)
private
FItems: TList;
FPatterns: TdxClassList;
FPrintItems: TList;
function GetCount: Integer;
function GetInternalItem(Index: Integer; IsPrinting: Boolean): TdxPSEdgePatternItem;
function GetItem(Pattern: TdxPSEdgePatternClass; IsPrinting: Boolean): TdxPSEdgePatternItem;
function GetPattern(Index: Integer): TdxPSEdgePatternClass;
procedure SetInternalItem(Index: Integer; IsPrinting: Boolean; Value: TdxPSEdgePatternItem);
procedure AddPattern(APattern: TdxPSEdgePatternClass);
procedure RemovePattern(APattern: TdxPSEdgePatternClass);
function HasItem(APattern: TdxPSEdgePatternClass): Boolean;
function HasPrintItem(APattern: TdxPSEdgePatternClass): Boolean;
procedure RemovePatternItem(APattern: TdxPSEdgePatternClass);
procedure RemovePatternPrintItem(APattern: TdxPSEdgePatternClass);
protected
procedure FinalizeInstance; override;
procedure InitializeInstance; override;
function IndexOf(APattern: TdxPSEdgePatternClass): Integer;
property InternalItems[Index: Integer; IsPrinting: Boolean]: TdxPSEdgePatternItem read GetInternalItem write SetInternalItem;
public
class function Instance: TdxPSEdgePatternFactory; reintroduce; overload;
procedure Register(APattern: TdxPSEdgePatternClass);
procedure Unregister(APattern: TdxPSEdgePatternClass);
procedure ResetPrintItems;
property Count: Integer read GetCount;
property Items[Pattern: TdxPSEdgePatternClass; IsPrinting: Boolean]: TdxPSEdgePatternItem read GetItem; default;
property Patterns[Index: Integer]: TdxPSEdgePatternClass read GetPattern;
end;
function dxPSEdgePatternFactory: TdxPSEdgePatternFactory;
implementation
uses
SysUtils, Forms, cxClasses, dxPSRes, dxPrnDev, dxPSUtl;
function dxPSEdgePatternFactory: TdxPSEdgePatternFactory;
begin
Result := TdxPSEdgePatternFactory.Instance;
end;
{ TcxPSEdgePattern }
class procedure TdxPSEdgePattern.Register;
begin
inherited;
dxPSEdgePatternFactory.Register(Self);
end;
class procedure TdxPSEdgePattern.Unregister;
begin
inherited;
dxPSEdgePatternFactory.Unregister(Self);
end;
class function TdxPSEdgePattern.Bits(Index: Integer): DWORD;
begin
Result := 0;
end;
class function TdxPSEdgePattern.Name: string;
begin
Result := '';
end;
class function TdxPSEdgePattern.RequiredBrushOrigin: Boolean;
begin
Result := True;
end;
class function TdxPSEdgePattern.RequiredScaling: Boolean;
begin
Result := True;
end;
class function TdxPSEdgePattern.SignificantBitCount: Integer;
begin
Result := 0;
end;
class function TdxPSEdgePattern.Solid: Boolean;
begin
Result := False;
end;
class function TdxPSEdgePattern.Thickness: Integer;
begin
Result := 0;
end;
{ TdxPSSolidEdgePattern }
class function TdxPSSolidEdgePattern.Bits(Index: Integer): DWORD;
begin
Result := $FFFFFFFF;
end;
class function TdxPSSolidEdgePattern.Name: string;
begin
Result := cxGetResourceString(@sdxSolidEdgePattern);
end;
class function TdxPSSolidEdgePattern.RequiredBrushOrigin: Boolean;
begin
Result := False;
end;
class function TdxPSSolidEdgePattern.RequiredScaling: Boolean;
begin
Result := False;
end;
class function TdxPSSolidEdgePattern.SignificantBitCount: Integer;
begin
Result := 8;
end;
class function TdxPSSolidEdgePattern.Solid: Boolean;
begin
Result := True;
end;
class function TdxPSSolidEdgePattern.Thickness: Integer;
begin
Result := 1;
end;
{ TdxPSEdgePatternItem }
constructor TdxPSEdgePatternItem.Create(APattern: TdxPSEdgePatternClass; AIsPrinting: Boolean);
begin
inherited Create;
FBitmaps[cepoHorizontal] := TBitmap.Create;
FBitmaps[cepoVertical] := TBitmap.Create;
FBrushes[cepoHorizontal] := TBrush.Create;
FBrushes[cepoVertical] := TBrush.Create;
Initialize(APattern, AIsPrinting);
end;
destructor TdxPSEdgePatternItem.Destroy;
begin
FBrushes[cepoVertical].Free;
FBrushes[cepoHorizontal].Free;
FBitmaps[cepoVertical].Free;
FBitmaps[cepoHorizontal].Free;
inherited Destroy;
end;
procedure TdxPSEdgePatternItem.Initialize(APattern: TdxPSEdgePatternClass; AIsPrinting: Boolean);
procedure ScaleBitmap(ABitmap: TBitmap);
var
H, W, Numerator, Denominator: Integer;
TempBitmap: TBitmap;
begin
H := ABitmap.Height;
W := ABitmap.Width;
Numerator := GetDeviceCaps(dxPrintDevice.Handle, LOGPIXELSY);
Denominator := Screen.PixelsPerInch;
TempBitmap := TBitmap.Create;
try
TempBitmap.HandleType := bmDIB;
TempBitmap.Assign(ABitmap);
ABitmap.Height := H * Numerator div Denominator;
ABitmap.Height := ABitmap.Height - ABitmap.Height mod H;
ABitmap.Width := W * Numerator div Denominator;
ABitmap.Width := ABitmap.Width - ABitmap.Width mod W;
ABitmap.Canvas.StretchDraw(MakeRect(0, 0, ABitmap.Width, ABitmap.Height), TempBitmap);
finally
TempBitmap.Free;
end;
end;
procedure InitializeOrientation(AOrientation: TdxPSCellEdgePatternOrientation);
const
Colors: array[Boolean] of TColor = (clWhite, clBlack);
var
Size, I, J: Integer;
Color: TColor;
begin
Size := APattern.SignificantBitCount;
with FBitmaps[AOrientation] do
begin
Width := Size;
Height := Size;
Monochrome := True;
HandleType := bmDIB;
for I := 0 to Size - 1 do
for J := 0 to Size - 1 do
begin
Color := Colors[APattern.Bits(Ord(Odd(J))) and (1 shl I) <> 0];
if AOrientation = cepoVertical then
Canvas.Pixels[J, I] := Color
else
Canvas.Pixels[I, J] := Color;
end;
end;
if AIsPrinting and APattern.RequiredScaling then
ScaleBitmap(FBitmaps[AOrientation]);
FBrushes[AOrientation].Bitmap := FBitmaps[AOrientation];
end;
begin
InitializeOrientation(cepoHorizontal);
InitializeOrientation(cepoVertical);
end;
function TdxPSEdgePatternItem.GetBitmap(Orientation: TdxPSCellEdgePatternOrientation): TBitmap;
begin
Result := FBitmaps[Orientation];
end;
function TdxPSEdgePatternItem.GetBrush(Orientation: TdxPSCellEdgePatternOrientation): TBrush;
begin
Result := FBrushes[Orientation];
end;
{ TdxPSEdgePatternFactory }
class function TdxPSEdgePatternFactory.Instance: TdxPSEdgePatternFactory;
begin
Result := inherited Instance as TdxPSEdgePatternFactory;
end;
procedure TdxPSEdgePatternFactory.Register(APattern: TdxPSEdgePatternClass);
begin
if IndexOf(APattern) = -1 then AddPattern(APattern);
end;
procedure TdxPSEdgePatternFactory.Unregister(APattern: TdxPSEdgePatternClass);
begin
RemovePattern(APattern);
end;
procedure TdxPSEdgePatternFactory.ResetPrintItems;
var
I: Integer;
begin
for I := 0 to FPrintItems.Count - 1 do
begin
TObject(FPrintItems[I]).Free;
FPrintItems[I] := nil;
end;
end;
procedure TdxPSEdgePatternFactory.FinalizeInstance;
procedure FreeObjectList(AList: TList);
var
I: Integer;
begin
for I := 0 to AList.Count - 1 do
TObject(AList[I]).Free;
AList.Free;
end;
begin
FreeObjectList(FItems);
FreeObjectList(FPrintItems);
FreeAndNil(FPatterns);
inherited;
end;
procedure TdxPSEdgePatternFactory.InitializeInstance;
begin
inherited;
FItems := TList.Create;
FPatterns := TdxClassList.Create;
FPrintItems := TList.Create;
end;
function TdxPSEdgePatternFactory.IndexOf(APattern: TdxPSEdgePatternClass): Integer;
begin
Result := FPatterns.IndexOf(APattern);
end;
function TdxPSEdgePatternFactory.GetCount: Integer;
begin
Result := FPatterns.Count;
end;
function TdxPSEdgePatternFactory.GetInternalItem(Index: Integer;
IsPrinting: Boolean): TdxPSEdgePatternItem;
begin
if IsPrinting then
Result := TdxPSEdgePatternItem(FPrintItems[Index])
else
Result := TdxPSEdgePatternItem(FItems[Index]);
end;
function TdxPSEdgePatternFactory.GetItem(Pattern: TdxPSEdgePatternClass;
IsPrinting: Boolean): TdxPSEdgePatternItem;
var
Index: Integer;
begin
if Pattern <> nil then
begin
Index := IndexOf(Pattern);
if Index = -1 then
raise EdxException.CreateFmt(cxGetResourceString(@sdxPatternIsNotRegistered), [Pattern.ClassName]);
if InternalItems[Index, IsPrinting] = nil then
InternalItems[Index, IsPrinting] := TdxPSEdgePatternItem.Create(Pattern, IsPrinting);
Result := InternalItems[Index, IsPrinting];
end
else
Result := nil;
end;
function TdxPSEdgePatternFactory.GetPattern(Index: Integer): TdxPSEdgePatternClass;
begin
Result := TdxPSEdgePatternClass(FPatterns[Index]);
end;
procedure TdxPSEdgePatternFactory.SetInternalItem(Index: Integer; IsPrinting: Boolean;
Value: TdxPSEdgePatternItem);
begin
if IsPrinting then
FPrintItems[Index] := Value
else
FItems[Index] := Value;
end;
procedure TdxPSEdgePatternFactory.AddPattern(APattern: TdxPSEdgePatternClass);
begin
FPatterns.Add(APattern);
FItems.Add(nil);
FPrintItems.Add(nil);
end;
procedure TdxPSEdgePatternFactory.RemovePattern(APattern: TdxPSEdgePatternClass);
begin
if HasItem(APattern) then RemovePatternItem(APattern);
if HasPrintItem(APattern) then RemovePatternPrintItem(APattern);
FPatterns.Remove(APattern)
end;
function TdxPSEdgePatternFactory.HasItem(APattern: TdxPSEdgePatternClass): Boolean;
begin
Result := InternalItems[IndexOf(APattern), False] <> nil;
end;
function TdxPSEdgePatternFactory.HasPrintItem(APattern: TdxPSEdgePatternClass): Boolean;
begin
Result := InternalItems[IndexOf(APattern), True] <> nil;
end;
procedure TdxPSEdgePatternFactory.RemovePatternItem(APattern: TdxPSEdgePatternClass);
var
Item: TdxPSEdgePatternItem;
begin
Item := Items[APattern, False];
FItems.Remove(Item);
Item.Free;
end;
procedure TdxPSEdgePatternFactory.RemovePatternPrintItem(APattern: TdxPSEdgePatternClass);
var
Item: TdxPSEdgePatternItem;
begin
Item := Items[APattern, True];
FPrintItems.Remove(Item);
Item.Free;
end;
initialization
TdxPSSolidEdgePattern.Register;
end.