david
47aaf11578
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@38 05c56307-c608-d34a-929d-697000501d7a
548 lines
18 KiB
ObjectPascal
548 lines
18 KiB
ObjectPascal
{*******************************************************************}
|
|
{ }
|
|
{ Developer Express Visual Component Library }
|
|
{ ExpressPrinting System(tm) 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 dxBkGnd;
|
|
|
|
interface
|
|
|
|
{$I cxVer.inc}
|
|
|
|
uses
|
|
Windows, Classes, SysUtils, Controls, Graphics, dxBase, dxPSGlbl, dxPSUtl;
|
|
|
|
type
|
|
TdxPicturePaintMode = (ppmCenter, ppmStretch, ppmTile, ppmProportional);
|
|
TdxBackgroundMode = (bmNone, bmBrush, bmBrushBitmap, bmPicture);
|
|
TdxBackgroundParam = (bpBkColor, bpBrush, bpMode, bpPictureMode, bpPicture);
|
|
TdxBackgroundParams = set of TdxBackgroundParam;
|
|
TdxPaintSequence = (psBefore, psAfter);
|
|
|
|
TdxBackgroundChangeEvent = procedure(Sender: TObject; AChangeWhat: TdxBackgroundParams) of object;
|
|
|
|
TCustomdxBackgroundPaintEvent = procedure(Sender: TObject; Canvas: TCanvas;
|
|
Rect: TRect; ASequence: TdxPaintSequence; var ADone: Boolean) of object;
|
|
|
|
TCustomdxBackgroundPaintExEvent = procedure(Sender: TObject; Canvas: TCanvas;
|
|
Rect: TRect; ASequence: TdxPaintSequence; PixelsNumerator,
|
|
PixelsDenominator: Integer; var ADone: Boolean) of object;
|
|
|
|
TdxBackgroundClass = class of TdxBackground;
|
|
|
|
TdxBackground = class(TdxBaseObject)
|
|
private
|
|
FBkColor: TColor;
|
|
FBrush: TBrush;
|
|
FIsRepaintNeeded: Boolean;
|
|
FMode: TdxBackgroundMode;
|
|
FPicture: TGraphic;
|
|
FPictureMode: TdxPicturePaintMode;
|
|
FOnApply: TNotifyEvent;
|
|
FOnChange: TdxBackgroundChangeEvent;
|
|
FOnPaint: TCustomdxBackgroundPaintEvent;
|
|
FOnPaintEx: TCustomdxBackgroundPaintExEvent;
|
|
function GetPicture: TGraphic;
|
|
procedure SetBkColor(Value: tColor);
|
|
procedure SetBrush(Value: TBrush);
|
|
procedure SetMode(Value: TdxBackgroundMode);
|
|
procedure SetPicture(Value: TGraphic);
|
|
procedure SetPictureMode(Value: TdxPicturePaintMode);
|
|
|
|
procedure BrushChanged(Sender: TObject);
|
|
procedure PictureChanged(Sender: TObject);
|
|
protected
|
|
procedure DoAssign(Source: TdxBaseObject); override;
|
|
procedure DoRestoreDefaults; override;
|
|
|
|
procedure DoApply; dynamic;
|
|
procedure DoChange(AChangeWhats: TdxBackgroundParams); dynamic;
|
|
procedure DoPaint(ACanvas: TCanvas; Rect: TRect; Sequence: TdxPaintSequence;
|
|
var ADone: Boolean); virtual;
|
|
procedure DoPaintEx(ACanvas: TCanvas; Rect: TRect; Sequence: TdxPaintSequence;
|
|
PixelsNumerator, PixelsDenominator: Integer; var ADone: Boolean); virtual;
|
|
procedure LockUpdate(ALockState : TdxLockState); override;
|
|
function RepaintNeeded(AChangeWhats: TdxBackgroundParams): Boolean; virtual;
|
|
|
|
property OnApply: TNotifyEvent read FOnApply write FOnApply;
|
|
public
|
|
constructor Create; override;
|
|
destructor Destroy; override;
|
|
|
|
procedure Clear; virtual;
|
|
function IsEmpty: Boolean; override;
|
|
function IsEqual(ABaseObject: TdxBaseObject): Boolean; override;
|
|
|
|
procedure Paint(ACanvas: TCanvas; const R: TRect); virtual;
|
|
procedure PaintEx(ACanvas: TCanvas; const R: TRect;
|
|
PixelsNumerator, PixelsDenominator: Integer); virtual;
|
|
|
|
function SetupEffects: Boolean;
|
|
|
|
property IsRepaintNeeded: Boolean read FIsRepaintNeeded;
|
|
property OnChange: TdxBackgroundChangeEvent read FOnChange write FOnChange;
|
|
property OnPaint: TCustomdxBackgroundPaintEvent read FOnPaint write FOnPaint;
|
|
property OnPaintEx: TCustomdxBackgroundPaintExEvent read FOnPaintEx write FOnPaintEx;
|
|
published
|
|
property BkColor: TColor read FBkColor write SetBkColor default clWhite;
|
|
property Brush: TBrush read FBrush write SetBrush;
|
|
property Mode: TdxBackgroundMode read FMode write SetMode default bmNone;
|
|
property Picture: TGraphic read GetPicture write SetPicture;
|
|
property PictureMode: TdxPicturePaintMode read FPictureMode write SetPictureMode default ppmCenter;
|
|
end;
|
|
|
|
procedure DrawPicture(APicture: TGraphic; ACanvas: TCanvas; const ARect: TRect;
|
|
APictureMode: TdxPicturePaintMode; PixelsNumerator, PixelsDenominator: Integer;
|
|
AnOffsetX: Integer = 0; AnOffsetY: Integer = 0);
|
|
|
|
const
|
|
cwAll: TdxBackgroundParams = [bpBkColor..bpPicture];
|
|
|
|
implementation
|
|
|
|
uses
|
|
dxFEFDlg;
|
|
|
|
constructor TdxBackground.Create;
|
|
begin
|
|
inherited;
|
|
FBkColor := clWhite;
|
|
FBrush := TBrush.Create;
|
|
FBrush.OnChange := BrushChanged;
|
|
FMode := bmNone;
|
|
FPictureMode := ppmCenter;
|
|
FPicture := TBitmap.Create;
|
|
FPicture.OnChange := PictureChanged;
|
|
end;
|
|
|
|
destructor TdxBackground.Destroy;
|
|
begin
|
|
FreeAndNil(FPicture);
|
|
FreeAndNil(FBrush);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxBackground.Clear;
|
|
begin
|
|
Brush.Color := clWhite;
|
|
Mode := bmNone;
|
|
Picture := nil;
|
|
end;
|
|
|
|
function TdxBackground.IsEmpty: Boolean;
|
|
begin
|
|
case Mode of
|
|
bmBrush:
|
|
Result := Brush.Style = bsClear;
|
|
bmBrushBitmap,
|
|
bmPicture:
|
|
Result := (Picture = nil) or Picture.Empty;
|
|
else //bmNone
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
function TdxBackground.IsEqual(ABaseObject: TdxBaseObject): Boolean;
|
|
begin
|
|
Result := inherited IsEqual(ABaseObject);
|
|
if Result then
|
|
with TdxBackground(ABaseObject) do
|
|
Result :=
|
|
(Self.BkColor = BkColor) and
|
|
(Self.Mode = Mode) and
|
|
(Self.PictureMode = PictureMode) and
|
|
dxAreBrushesEqual(Self.Brush, Brush) and
|
|
dxAreGraphicsEqual(Self.Picture, Picture);
|
|
end;
|
|
|
|
procedure TdxBackground.Paint(ACanvas: TCanvas; const R: TRect);
|
|
begin
|
|
PaintEx(ACanvas, R, 1, 1);
|
|
end;
|
|
|
|
procedure TdxBackground.PaintEx(ACanvas: TCanvas; const R: TRect;
|
|
PixelsNumerator, PixelsDenominator: Integer);
|
|
var
|
|
PrevColor: COLORREF;
|
|
PrevBkMode: Integer;
|
|
PrevBrush: TBrush;
|
|
Done: Boolean;
|
|
DC: HDC;
|
|
Pattern: TBitmap;
|
|
begin
|
|
Done := False;
|
|
DoPaintEx(ACanvas, R, psBefore, PixelsNumerator, PixelsDenominator, Done);
|
|
if Done then Exit;
|
|
|
|
DC := ACanvas.Handle;
|
|
case Mode of
|
|
bmNone: ;
|
|
bmBrush:
|
|
if Brush.Style <> bsClear then
|
|
begin
|
|
if Brush.Style > bsClear then {hatched brush}
|
|
begin
|
|
PrevBkMode := SetBkMode(DC, Windows.TRANSPARENT);
|
|
PrevColor := Windows.SetBkColor(DC, ColorToRGB(BkColor));
|
|
end
|
|
else {bsSolid}
|
|
begin
|
|
PrevBkMode := GetBkMode(DC);
|
|
PrevColor := COLORREF(0);
|
|
end;
|
|
if (Brush.Style > bsClear) and IsPrinterDC(DC) then {hatched Brush}
|
|
begin
|
|
Pattern := TBitmap.Create;
|
|
with Pattern do
|
|
try
|
|
Width := 8;
|
|
Height := 8;
|
|
Canvas.Brush := Self.Brush;
|
|
SetBkMode(DC, Windows.TRANSPARENT);
|
|
Windows.SetBkColor(DC, ColorToRGB(BkColor));
|
|
Canvas.FillRect(Rect(0, 0, Width, Height));
|
|
DrawPicture(Pattern, ACanvas, R, ppmTile, PixelsNumerator, PixelsDenominator);
|
|
finally
|
|
Free;
|
|
end;
|
|
end
|
|
else
|
|
FillRect(DC, R, Brush.Handle);
|
|
if Brush.Style > bsClear then
|
|
begin
|
|
Windows.SetBkColor(DC, PrevColor);
|
|
SetBkMode(DC, PrevBkMode);
|
|
end;
|
|
end;
|
|
|
|
bmBrushBitmap:
|
|
if Picture <> nil then
|
|
if (Picture.Width <= 8) and (Picture.Height <= 8) and not IsPrinterDC(DC) then
|
|
begin
|
|
PrevBrush := TBrush.Create;
|
|
try
|
|
PrevBrush.Assign(ACanvas.Brush);
|
|
ACanvas.Brush.Bitmap := TBitmap(Picture);
|
|
ACanvas.FillRect(R);
|
|
ACanvas.Brush.Bitmap := nil;
|
|
ACanvas.Brush := PrevBrush;
|
|
finally
|
|
PrevBrush.Free;
|
|
end;
|
|
end
|
|
else
|
|
DrawPicture(Picture, ACanvas, R, ppmTile, PixelsNumerator, PixelsDenominator);
|
|
|
|
bmPicture:
|
|
if Picture <> nil then
|
|
if (PictureMode = ppmTile) and (Picture.Width <= 8) and (Picture.Height <= 8) and not IsPrinterDC(DC) then
|
|
begin
|
|
PrevBrush := TBrush.Create;
|
|
try
|
|
PrevBrush.Assign(ACanvas.Brush);
|
|
ACanvas.Brush.Bitmap := TBitmap(Picture);
|
|
ACanvas.FillRect(R);
|
|
ACanvas.Brush.Bitmap := nil;
|
|
ACanvas.Brush := PrevBrush;
|
|
finally
|
|
PrevBrush.Free;
|
|
end;
|
|
end
|
|
else
|
|
DrawPicture(Picture, ACanvas, R, PictureMode, PixelsNumerator, PixelsDenominator);
|
|
end;
|
|
|
|
DoPaintEx(ACanvas, R, psAfter, PixelsNumerator, PixelsDenominator, Done);
|
|
end;
|
|
|
|
function TdxBackground.SetupEffects: Boolean;
|
|
begin
|
|
Result := dxFEFDialog(Self);
|
|
end;
|
|
|
|
procedure TdxBackground.DoAssign(Source: TdxBaseObject);
|
|
begin
|
|
inherited;
|
|
with Source as TdxBackground do
|
|
begin
|
|
Self.BkColor := BkColor;
|
|
Self.Brush := Brush;
|
|
Self.Mode := Mode;
|
|
Self.PictureMode := PictureMode;
|
|
Self.Picture := Picture;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBackground.DoRestoreDefaults;
|
|
begin
|
|
inherited;
|
|
FBkColor := clWhite;
|
|
FMode := bmNone;
|
|
FPictureMode := ppmCenter;
|
|
end;
|
|
|
|
procedure TdxBackground.DoApply;
|
|
begin
|
|
if Assigned(FOnApply) then FOnApply(Self);
|
|
end;
|
|
|
|
procedure TdxBackground.DoChange(AChangeWhats: TdxBackgroundParams);
|
|
begin
|
|
if not IsLocked then
|
|
begin
|
|
FIsRepaintNeeded := RepaintNeeded(AChangeWhats);
|
|
if Assigned(FOnChange) then FOnChange(Self, AChangeWhats);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBackground.DoPaint(ACanvas: TCanvas; Rect: TRect;
|
|
Sequence: TdxPaintSequence; var ADone: Boolean);
|
|
begin
|
|
if Assigned(FOnPaint) then FOnPaint(Self, ACanvas, Rect, Sequence, ADone);
|
|
end;
|
|
|
|
procedure TdxBackground.DoPaintEx(ACanvas: TCanvas; Rect: TRect;
|
|
Sequence: TdxPaintSequence; PixelsNumerator, PixelsDenominator: Integer;
|
|
var ADone: Boolean);
|
|
begin
|
|
if Assigned(FOnPaintEx) then
|
|
FOnPaintEx(Self, ACanvas, Rect, Sequence, PixelsNumerator, PixelsDenominator, ADone);
|
|
if not ADone then
|
|
DoPaint(ACanvas, Rect, Sequence, ADone);
|
|
end;
|
|
|
|
procedure TdxBackground.LockUpdate(ALockState : TdxLockState);
|
|
begin
|
|
if ALockState = lsUnLock then DoChange(cwAll);
|
|
inherited LockUpdate(ALockState);
|
|
end;
|
|
|
|
function TdxBackground.RepaintNeeded(AChangeWhats: TdxBackgroundParams): Boolean;
|
|
begin
|
|
if bpMode in AChangeWhats then
|
|
Result := True
|
|
else
|
|
case Mode of
|
|
bmBrush:
|
|
Result := (bpBrush in AChangeWhats) or ((bpBkColor in AChangeWhats) and (Brush.Style > bsClear));
|
|
bmBrushBitmap:
|
|
Result := bpPicture in AChangeWhats;
|
|
bmPicture:
|
|
Result := [bpPicture, bpPictureMode] * AChangeWhats <> [];
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBackground.BrushChanged(Sender: TObject);
|
|
begin
|
|
DoChange([bpBrush]);
|
|
end;
|
|
|
|
procedure TdxBackground.PictureChanged(Sender: TObject);
|
|
begin
|
|
DoChange([bpPicture]);
|
|
end;
|
|
|
|
procedure TdxBackground.SetBkColor(Value: tColor);
|
|
begin
|
|
if FBkColor <> Value then
|
|
begin
|
|
FBkColor := Value;
|
|
DoChange([bpBkColor]);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBackground.SetBrush(Value: TBrush);
|
|
begin
|
|
FBrush.Assign(Value);
|
|
end;
|
|
|
|
procedure TdxBackground.SetMode(Value: TdxBackgroundMode);
|
|
begin
|
|
if FMode <> Value then
|
|
begin
|
|
FMode := Value;
|
|
DoChange([bpMode]);
|
|
end;
|
|
end;
|
|
|
|
function TdxBackground.GetPicture: TGraphic;
|
|
begin
|
|
if FPicture = nil then FPicture := TBitmap.Create;
|
|
Result := FPicture;
|
|
end;
|
|
|
|
procedure TdxBackground.SetPicture(Value: TGraphic);
|
|
begin
|
|
if Value <> nil then
|
|
begin
|
|
Picture.Assign(Value);
|
|
TBitmap(Picture).HandleType := bmDIB;
|
|
end
|
|
else
|
|
if FPicture <> nil then
|
|
begin
|
|
TBitmap(FPicture).FreeImage;
|
|
TBitmap(FPicture).ReleaseHandle;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBackground.SetPictureMode(Value: TdxPicturePaintMode);
|
|
begin
|
|
if FPictureMode <> Value then
|
|
begin
|
|
FPictureMode := Value;
|
|
DoChange([bpPictureMode]);
|
|
end;
|
|
end;
|
|
|
|
{ utility routines }
|
|
|
|
function IsGraphicVisible(DC: HDC; const R: TRect): Boolean;
|
|
begin
|
|
Result := IsPrinterDC(DC) or IsMetafileDC(DC) or RectVisible(DC, R);
|
|
end;
|
|
|
|
procedure DrawGraphicCenter(AGraphic: TGraphic; ACanvas: TCanvas; const ARect: TRect;
|
|
PixelsNumerator, PixelsDenominator: Integer);
|
|
var
|
|
DC: HDC;
|
|
W, H: Integer;
|
|
R: TRect;
|
|
begin
|
|
DC := ACanvas.Handle;
|
|
with ARect, AGraphic do
|
|
begin
|
|
W := MulDiv(Width, PixelsNumerator, PixelsDenominator);
|
|
H := MulDiv(Height, PixelsNumerator, PixelsDenominator);
|
|
R := Bounds(Left + (Right - Left - W) div 2, Top + (Bottom - Top - H) div 2, W, H);
|
|
if IsGraphicVisible(DC, R) then
|
|
if (W <> Width) or (H <> Height) then
|
|
ACanvas.StretchDraw(R, AGraphic)
|
|
else
|
|
ACanvas.Draw(R.Left, R.Top, AGraphic);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawGraphicStretch(AGraphic: TGraphic; ACanvas: TCanvas; const ARect: TRect;
|
|
PixelsNumerator, PixelsDenominator: Integer);
|
|
begin
|
|
if IsGraphicVisible(ACanvas.Handle, ARect) then
|
|
ACanvas.StretchDraw(ARect, AGraphic);
|
|
end;
|
|
|
|
procedure DrawGraphicTile(AGraphic: TGraphic; ACanvas: TCanvas; const ARect: TRect;
|
|
PixelsNumerator, PixelsDenominator: Integer; AnOffsetX: Integer = 0; AnOffsetY: Integer = 0);
|
|
var
|
|
DC: HDC;
|
|
I, J, W, H: Integer;
|
|
Rgn: HRGN;
|
|
R: TRect;
|
|
begin
|
|
DC := ACanvas.Handle;
|
|
|
|
with ARect, AGraphic do
|
|
begin
|
|
W := MulDiv(Width, PixelsNumerator, PixelsDenominator);
|
|
H := MulDiv(Height, PixelsNumerator, PixelsDenominator);
|
|
AnOffsetX := AnOffsetX mod W;
|
|
AnOffsetY := AnOffsetY mod H;
|
|
|
|
Rgn := dxPSUtl.IntersectClipRect(DC, ARect);
|
|
|
|
for I := 0 to (Right - Left - AnOffsetX) div W do
|
|
for J := 0 to (Bottom - Top - AnOffsetX) div H do
|
|
begin
|
|
R := Bounds(Left + I * W + AnOffsetX, Top + J * H + AnOffsetY, W, H);
|
|
if IsGraphicVisible(DC, R) then
|
|
if (W <> Width) or (H <> Height) then
|
|
ACanvas.StretchDraw(R, AGraphic)
|
|
else
|
|
ACanvas.Draw(R.Left, R.Top, AGraphic);
|
|
end;
|
|
|
|
dxPSUtl.RestoreClipRgn(DC, Rgn);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawGraphicStretchProportional(AGraphic: TGraphic; ACanvas: TCanvas; const ARect: TRect;
|
|
PixelsNumerator, PixelsDenominator: Integer);
|
|
var
|
|
DC: HDC;
|
|
W, H, V: Integer;
|
|
R: TRect;
|
|
begin
|
|
DC := ACanvas.Handle;
|
|
with ARect, AGraphic do
|
|
begin
|
|
W := Right - Left;
|
|
H := Bottom - Top;
|
|
if Width / Height > W / H then
|
|
begin
|
|
V := MulDiv(Height, W, Width);
|
|
R := Bounds(Left, Top + (H - V) div 2, W, V);
|
|
end
|
|
else
|
|
begin
|
|
V := MulDiv(Width, H, Height);
|
|
R := Bounds(Left + (W - V) div 2, Top, V, H);
|
|
end;
|
|
if IsGraphicVisible(DC, R) then
|
|
ACanvas.StretchDraw(R, AGraphic);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawPicture(APicture: TGraphic; ACanvas: TCanvas; const ARect: TRect;
|
|
APictureMode: TdxPicturePaintMode; PixelsNumerator, PixelsDenominator: Integer;
|
|
AnOffsetX: Integer = 0; AnOffsetY: Integer = 0);
|
|
begin
|
|
if APicture.Empty or (APicture.Width = 0) or (APicture.Height = 0) then Exit;
|
|
case APictureMode of
|
|
ppmCenter:
|
|
DrawGraphicCenter(APicture, ACanvas, ARect, PixelsNumerator, PixelsDenominator);
|
|
ppmStretch:
|
|
DrawGraphicStretch(APicture, ACanvas, ARect, PixelsNumerator, PixelsDenominator);
|
|
ppmTile:
|
|
DrawGraphicTile(APicture, ACanvas, ARect, PixelsNumerator, PixelsDenominator, AnOffsetX, AnOffsetY);
|
|
ppmProportional:
|
|
DrawGraphicStretchProportional(APicture, ACanvas, ARect, PixelsNumerator, PixelsDenominator);
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
RegisterClass(TBitmap);
|
|
|
|
end.
|
|
|