kjkim
/
BSOne.SFC
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
BSOne.SFC/EM.Lib/ImageEn_SRC/Source/ieXCanvasUtils.pas

2504 lines
101 KiB
Plaintext
Raw Blame History

(* ImageEn Build 7.0.0.06.2637 @ 7-4-17 14:58:42.679 *)
(*
Copyright (c) 1998-2017 by Carlotta Calandra. All rights reserved.
Copyright (c) 2011-2017 by Xequte Software.
This software comes without express or implied warranty.
In no case shall the author be liable for any damage or unwanted behavior of any
computer hardware and/or software.
Author grants you the right to include the component
in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE.
ImageEn, IEvolution and ImageEn ActiveX may not be included in any
commercial, shareware or freeware libraries or components.
www.ImageEn.com
*)
unit iexCanvasUtils;
(*
File version 1006
*)
{$I ie.inc}
interface
uses
Windows, Messages, SysUtils, Classes, {$ifdef IEHASTYPES}Types,{$endif} Graphics, Controls, stdctrls, hyiedefs,
iegdiplus;
type
{!!
<FS>TIEBooleanEx
<FM>Declaration<FC>
}
TIEBooleanEx = (iebFalse, iebTrue, iebDefault);
{!!}
{!!
<FS>TWallpaperEffect
<FM>Declaration<FC>
}
TWallpaperEffect = (
wpSolid, // A color fill
wpLeftLine, // A single line on left
wpTopLine, // A single line along top
wpDoubleLeftLines, // Two lines on left
wpDoubleTopLines, // Two lines along top
wpDoubleVariedLeftLines, // Two lines of decreasing widths on left
wpDoubleVariedTopLines, // Two lines of decreasing widths along top
wpTripleLeftLines, // Three lines on left
wpTripleTopLines, // Three lines along top
wpTripleVariedLeftLines, // Three lines of decreasing widths on left
wpTripleVariedTopLines, // Three lines of decreasing widths along top
wpLeftDashes, // Short lines of a uniform sizes on left
wpTopDashes, // Short lines of a uniform sizes along top
wpDoubleLeftDashes, // Short lines of two sizes on left
wpDoubleTopDashes, // Short lines of two sizes along top
wpTripleLeftDashes, // Short lines of three sizes on left
wpTripleTopDashes, // Short lines of three sizes along top
wpLeftZigZag, // Shark tooth pattern on left
wpTopZigZag, // Shark tooth pattern along top
wpLeftGradient, // Color gradient on left
wpTopGradient, // Color gradient along top
wpHorzPinStripe, // Horizontal lines across image
wpVertPinStripe, // Vertical lines down image
wpDiagPinStripe, // Diagonal lines across image
wpDiagPinStripe2, // Diagonal lines across image (alternative direction)
wpCrossHatch, // Horizontal and vertical lines
wpDiagCrossHatch, // Diagonal lines in two directions
wpHorzStripes, // Horizontal stripes across image
wpVertStripes, // Vertical stripes down image
wpDiagStripes, // Diagonal stripes down image
wpDiagStripes2, // Diagonal stripes down image (alternative direction)
wpCheckers, // Alternativing blocks of color
wpDiagCheckers, // Alternativing diagonal blocks of color
wpRain, // Diagonal dashes
wpRain2, // Diagonal dashes (alternative direction)
wpRivets, // Circles over page
wpHearts, // Hearts over page
wpStars, // Stars over page
wpLightning, // Lightning over page
wpRuledPage); // Similar to standard ruled page (with red line along side)
{!!}
procedure IEDrawShape(Canvas: TCanvas; Shape: TIEShape; iLeft, iTop, iWidth, iHeight: Integer; MaintainAspect: TIEBooleanEx = iebDefault); overload;
procedure IEDrawShape(Canvas: TCanvas; Shape: TIEShape;
iLeft, iTop, iWidth, iHeight: Integer; MaintainAspect: TIEBooleanEx;
BorderColor: TColor; BorderWidth: Integer;
FillColor: TColor; FillColor2: TColor = clNone; GradientDir: TIEGradientDir = gdVertical;
Angle: Integer = 0; ShapeModifier: Integer = 0); overload;
{$ifdef IEIncludeDeprecatedInV6}
// Deprecated in 7.0.0 (2016-11-1)
type TXCustomShape = (xcsStar5, xcsStar6, xcsArrowNW, xcsArrowNE, xcsArrowSW, xcsArrowSE, xcsLightningLeft, xcsLightningRight,
xcsExplosion, xcsExplosion_2, xcsCross, xcsArrowNW2, xcsArrowNE2, xcsArrowSW2, xcsArrowSE2, xcsHeart, xcsDoubleHeart);
procedure DrawCustomShape(Canvas: TCanvas; Shape: TXCustomShape; iLeft, iTop, iWidth, iHeight: Integer); {$ifdef IEWarningForDeprecated} deprecated {$ifdef IESupportDeprecatedDescription} 'Use IEDrawShape instead - http://imageen.com/help/Compatibility.html' {$endif}; {$endif}
function CreateCustomShapeRegion(Shape: TXCustomShape; iLeft, iTop, iWidth, iHeight: Integer): Hrgn; {$ifdef IEWarningForDeprecated} deprecated {$ifdef IESupportDeprecatedDescription} 'Use IECreateShapeRegion instead - http://imageen.com/help/Compatibility.html' {$endif}; {$endif}
{$endif}
function IEShapePreferredAspectRatio(Shape: TIEShape): Double;
function IECreateShapeRegion(Shape: TIEShape; iLeft, iTop, iWidth, iHeight: Integer; MaintainAspect: TIEBooleanEx = iebDefault;
Angle: Integer = 0; ShapeModifier: Integer = 0): Hrgn; overload;
function IECreateShapeRegion(Shape: TIEShape; ARect: TRect; MaintainAspect: TIEBooleanEx = iebDefault;
Angle: Integer = 0; ShapeModifier: Integer = 0): HRgn; overload;
function CreateWallpaperBitmap(Effect : TWallpaperEffect; Color1 : TColor; Color2 : TColor; iSize : Integer = -1; iSpacing : integer = -1; iThickness: Integer = -1) : TBitmap;
Procedure TileBitmapOntoCanvas(Canvas : TCanvas; iWidth, iHeight : Integer; Bitmap : TBitmap); overload;
Procedure TileBitmapOntoCanvas(Canvas : TCanvas; iWidth, iHeight : Integer; Graphic : TGraphic); overload;
// Pass PointArray as "Array[ 0 .. Shape_Array_Max_Points ] of TPoint;"
procedure IEGenerateShapePoints(out PointArray: Array of TPoint; out PointArrayCount: Integer;
Shape: TIEShape; iLeft, iTop, iWidth, iHeight: Integer;
Angle: Integer = 0; MaintainAROnRotate: Boolean = False;
ShapeModifier: Integer = 0);
function ShapeToString(Shape: TIEShape): string;
procedure IEDrawShapeToComboListBoxItem(ControlCanvas : TCanvas;
CanvasRect : TRect;
ControlEnabled : Boolean;
Shape: TIEShape;
Color: TColor;
ShowText : Boolean= True);
const
Shape_Array_Max_Points = 102;
{!!
<FS>Supported_Generate_Points_Shapes
<FM>Declaration<FC>
}
Supported_Generate_Points_Shapes = [ iesRectangle, iesTriangle, iesCorner, iesDiamond, iesStar5, iesStar6, iesArrowLeft, iesArrowRight,
iesArrowUp, iesArrowDown, iesFatArrowUp, iesFatArrowLeft, iesFatArrowRight, iesFatArrowDown,
iesArrowLeftRight, iesArrowUpDown, iesArrowNW, iesArrowNE, iesArrowSW, iesArrowSE,
iesShootingArrowNW, iesShootingArrowNE, iesShootingArrowSW, iesShootingArrowSE, iesLightningLeft,
iesLightningRight, iesExplosion, iesCross, iesShield, iesBadge, iesNamePlate, iesPentagon,
iesHexagon, iesHeptagon, iesOctagon, iesCustomShape, iesCustomStar, iesCustomExplosion ];
{!!}
implementation
uses
Math, iesettings, iexHelperFunctions, hyieutils;
// Returns closest of 0, 90, 180, 270
function RoundTo90(value: Integer) : integer;
begin
Result := 90 * Round( value / 90 );
if Result = 360 then
Result := 0;
end;
// Create square canvas to maintain the Aspect Ratio of the shape
procedure KeepAspectRatioForDimensions(var iLeft, iTop, iWidth, iHeight: integer);
var
iShortSide: Integer;
begin
if iWidth < iHeight then
iShortSide := iWidth
else
iShortSide := iHeight;
Inc(iLeft, (iWidth - iShortSide) div 2);
Inc(iTop, (iHeight - iShortSide) div 2);
iWidth := iShortSide;
iHeight := iShortSide;
end;
// Note: Angle is rounded to nearest 90
function CreateHeartRegion(iLeft, iTop, iWidth, iHeight: Integer; Angle: Integer = 0): Hrgn;
const
Triangle_Start_Point_On_Circle = 0.69; // start trinagle 62% down the circle
Top_Circle_Bulge = 2; // two pixels bigger
LHS_Circle_Intersect_Deg = 233.14; // Start triangle 1.5% in from edge
RHS_Circle_Intersect_Deg = 360 - LHS_Circle_Intersect_Deg; //126.86;
LHS_Circle_Middle_Touch_Deg = 83;
RHS_Circle_Middle_Touch_Deg = 360 - LHS_Circle_Middle_Touch_Deg;
var
origWidth, origHeight, origLeft, origTop : Integer;
Function FindPointOnCircleEdge(Center: Tpoint; Angle: Real; Radius: Word): TPoint;
Begin
Result.X := Round(center.x + Radius*cos((angle-90)*pi/180));
Result.Y := round(center.y + Radius*sin((angle-90)*pi/180));
End;
function _FlipVert(value: Integer): integer;
begin
if ( Angle = 180 ) or ( Angle = 90 ) then
Result := origHeight - Value
else
Result := Value;
end;
var
rgn1, rgn2, rgn3, rgn4 : Hrgn;
iCircleSize: Integer;
poly: array[0..2] of TPoint;
iCircleRadius: Integer;
LeftCircleIntersectPt: TPoint;
RightCircleIntersectPt: TPoint;
iHalfWidth: Integer;
iQuarterWidth: Integer;
invertDir: Boolean;
begin
Angle := RoundTo90( Angle );
origLeft := iLeft;
origTop := iTop;
origHeight := iHeight;
origWidth := iWidth;
iLeft := 0;
iTop := 0;
// Must maintain the Aspect Ratio of the Heart!
KeepAspectRatioForDimensions( iLeft, iTop, iWidth, iHeight );
invertDir := ( Angle = 90 ) or ( Angle = 270 );
if invertDir then
begin
IESwap( iWidth, iHeight );
IESwap( iLeft, iTop );
origHeight := origWidth;
end;
iHalfWidth := iWidth div 2;
iQuarterWidth := iWidth div 4;
iCircleSize := iHalfWidth + Top_Circle_Bulge;
iCircleRadius := iCircleSize div 2;
LeftCircleIntersectPt := FindPointOnCircleEdge( Point( iQuarterWidth, iQuarterWidth), LHS_Circle_Intersect_Deg, iCircleRadius - 1 );
RightCircleIntersectPt := FindPointOnCircleEdge( Point( iWidth - iQuarterWidth, iQuarterWidth), RHS_Circle_Intersect_Deg, iCircleRadius - 1 );
if invertDir then
begin
Result := CreateEllipticRgn( iTop, iLeft, iHeight, iWidth ); // Not used
// Circles
rgn1 := CreateEllipticRgn( origLeft + _FlipVert( iTop ),
origTop + iLeft,
origLeft + _FlipVert( iTop + iCircleSize ),
origTop + iLeft + iCircleSize );
rgn2 := CreateEllipticRgn( origLeft + _FlipVert( iTop ),
origTop + iLeft + iWidth - iCircleSize,
origLeft + _FlipVert( iTop + iCircleSize ),
origTop + iLeft + iWidth );
CombineRgn( Result, rgn1, rgn2, RGN_OR );
// Bottom Triangle
poly[0] := point( origLeft + _FlipVert( iTop + LeftCircleIntersectPt.Y ), origTop + iLeft + LeftCircleIntersectPt.X );
poly[1] := point( origLeft + _FlipVert( iTop + RightCircleIntersectPt.Y ), origTop + iLeft + RightCircleIntersectPt.X );
poly[2] := point( origLeft + _FlipVert( iTop + iHeight ), origTop + iLeft + iHalfWidth ); // Bottom point
rgn3 := Windows.CreatePolygonRgn( poly, 3, WINDING );
CombineRgn( Result, Result, rgn3, RGN_OR );
// Fill Hole
rgn4 := Windows.CreateRectRgn( origLeft + _FlipVert( iTop + iCircleRadius ), origTop + iLeft + iCircleRadius,
origLeft + _FlipVert( iTop + iCircleSize ), origTop + iLeft + iWidth - iCircleRadius );
CombineRgn( Result, Result, rgn4, RGN_OR );
end
else
begin
Result := CreateEllipticRgn( iLeft, iTop, iWidth, iHeight ); // Not used
// Circles
rgn1 := CreateEllipticRgn( origLeft + iLeft,
origTop + _FlipVert( iTop ),
origLeft + iLeft + iCircleSize,
origTop + _FlipVert( iTop + iCircleSize ));
rgn2 := CreateEllipticRgn( origLeft + iLeft + iWidth - iCircleSize ,
origTop + _FlipVert( iTop ),
origLeft + iLeft + iWidth,
origTop + _FlipVert( iTop + iCircleSize ));
CombineRgn( Result, rgn1, rgn2, RGN_OR );
// Bottom Triangle
poly[0] := point( origLeft + iLeft + LeftCircleIntersectPt.X, origTop + _FlipVert( iTop + LeftCircleIntersectPt.Y ));
poly[1] := point( origLeft + iLeft + RightCircleIntersectPt.X, origTop + _FlipVert( iTop + RightCircleIntersectPt.Y ));
poly[2] := point( origLeft + iLeft + iHalfWidth, origTop + _FlipVert( iTop + iHeight )); // Bottom point
rgn3 := Windows.CreatePolygonRgn( poly, 3, WINDING );
CombineRgn( Result, Result, rgn3, RGN_OR );
// Fill Hole
rgn4 := Windows.CreateRectRgn( origLeft + iLeft + iCircleRadius, origTop + _FlipVert( iTop + iCircleRadius ),
origLeft + iLeft + iWidth - iCircleRadius, origTop + _FlipVert( iTop + iCircleSize ));
CombineRgn( Result, Result, rgn4, RGN_OR );
end;
DeleteObject(rgn4);
DeleteObject(rgn3);
DeleteObject(rgn2);
DeleteObject(rgn1);
end;
// Note: Angle is rounded to nearest 90
function CreateDoubleHeartRegion(iLeft, iTop, iWidth, iHeight: Integer; Angle: Integer = 0): Hrgn;
const
Dbl_Heart_Size = 66;
Dbl_Heart_Offset = 5;
var
Rgn2 : Hrgn;
begin
Angle := RoundTo90( Angle );
if ( Angle = 90 ) or ( Angle = 270 ) then
begin
// Left heart - Lower
Result := CreateHeartRegion(iLeft + MulDiv(iWidth, 100 - Dbl_Heart_Size, 100),
iTop + MulDiv(iHeight, Dbl_Heart_Offset, 100) - MulDiv(iHeight, Dbl_Heart_Offset, 100),
MulDiv(iWidth, Dbl_Heart_Size, 100),
MulDiv(iHeight, Dbl_Heart_Size, 100),
Angle);
// Right heart - Higher
Rgn2 := CreateHeartRegion(iLeft,
iTop + MulDiv(iHeight, 100 - Dbl_Heart_Size, 100),
MulDiv(iWidth, Dbl_Heart_Size, 100),
MulDiv(iHeight, Dbl_Heart_Size, 100),
Angle);
end
else
begin
// Left heart - Higher
Result := CreateHeartRegion(iLeft,
iTop + MulDiv(iHeight, Dbl_Heart_Offset, 100),
MulDiv(iWidth, Dbl_Heart_Size, 100),
MulDiv(iHeight, Dbl_Heart_Size, 100),
Angle);
// Right heart - Lower
Rgn2 := CreateHeartRegion(iLeft + MulDiv(iWidth, 100 - Dbl_Heart_Size, 100),
iTop + MulDiv(iHeight, 100 - Dbl_Heart_Size, 100) - MulDiv(iHeight, Dbl_Heart_Offset, 100),
MulDiv(iWidth, Dbl_Heart_Size, 100),
MulDiv(iHeight, Dbl_Heart_Size, 100),
Angle);
end;
CombineRgn(Result, Result, Rgn2, RGN_OR);
DeleteObject(Rgn2);
end;
const
Max_Custom_Polygon_Points = 102;
// Supported range for PointCount is 3 .. 50
procedure GetCustomPolygonPoints(out PointArray: Array of TPoint; out PointArrayCount: Integer;
iLeft, iTop, iWidth, iHeight: Integer; Shape: TIEShape; PointCount : Integer;
Angle: Integer = 0);
const
Random_Nrs: array[0 .. 29] of Double = ( 0.82, 0.74, 0.62, 0.99, 0.52, 0.43, 0.99, 0.46, 0.98, 0.70,
0.56, 0.76, 0.95, 0.59, 0.35, 0.98, 0.84, 0.44, 0.72, 0.79,
0.17, 0.96, 0.07, 0.84, 0.35, 0.58, 0.39, 0.55, 0.27, 0.62 );
var
xCenter, yCenter,
xRadius, yRadius,
I : Integer;
CurrAngle : Double;
rotation: Double;
begin
if PointCount <= 3 then
begin
if Shape = iesCustomExplosion then
PointCount := 12
else
PointCount := 10;
end;
if PointCount > 50 then
PointCount := 50;
xCenter := iWidth div 2;
yCenter := iHeight div 2;
rotation := 360 / PointCount;
case Shape of
iesCustomExplosion : PointArrayCount := 2 * PointCount + 1;
iesCustomStar : PointArrayCount := 2 * PointCount;
else PointArrayCount := PointCount;
end;
for I := 0 to PointArrayCount - 1 do
begin
if ( Shape in [ iesCustomStar, iesCustomExplosion ]) and (( I mod 2 ) = 0 ) then
begin
// Inner point
xRadius := Round( xCenter / 2 );
yRadius := Round( yCenter / 2 );
end
else
if ( Shape = iesCustomExplosion ) and (( I mod 4 ) = 3 ) then
begin
// High outer point
xRadius := Round( xCenter / 2 + 1.000 * xCenter / 2 - Random_Nrs[ I mod 30 ] * xCenter / 20 );
yRadius := Round( yCenter / 2 + 1.000 * yCenter / 2 - Random_Nrs[ I mod 30 ] * yCenter / 20 );
end
else
if Shape = iesCustomExplosion then
begin
// Low outer point
xRadius := Round( xCenter / 2 + 0.7 * xCenter / 2 - Random_Nrs[ I mod 30 ] * xCenter / 10 );
yRadius := Round( yCenter / 2 + 0.7 * yCenter / 2 - Random_Nrs[ I mod 30 ] * yCenter / 10 );
end
else
begin
// Outer point
xRadius := xCenter;
yRadius := yCenter;
end;
if Shape in [ iesCustomStar, iesCustomExplosion ] then
CurrAngle := (( I * rotation / 2 ) + 270 - Angle) * PI / 180
else
CurrAngle := ((I * rotation) + 90 - Angle) * PI / 180;
PointArray[I].X := iLeft + xCenter + Round(cos(CurrAngle) * xRadius);
PointArray[I].Y := iTop + yCenter - Round(sin(CurrAngle) * yRadius);
end;
end;
// Note: Angle is rounded to nearest 90
function CreateHalfCircleRegion(iLeft, iTop, iWidth, iHeight: Integer; MoonShape: Boolean= False; Angle: Integer = 0): Hrgn;
var
rgn2, rgn3: Hrgn;
adjLeft, adjTop, adjWidth, adjHeight: integer;
moonLeft, moonTop: integer;
begin
Angle := RoundTo90( Angle );
adjLeft := iLeft;
if Angle = 0 then
dec( adjLeft, iWidth );
adjTop := iTop;
if Angle = 90 then
dec( adjTop, iHeight );
adjWidth := iWidth ;
if ( Angle = 0 ) or ( Angle = 180 ) then
inc( adjWidth, iWidth );
adjHeight := iHeight ;
if ( Angle = 90 ) or ( Angle = 270 ) then
inc( adjHeight, iHeight );
Result := CreateEllipticRgn( adjLeft, adjTop, adjLeft + adjWidth, adjTop + adjHeight );
rgn2 := CreateRectRgn(iLeft, iTop, iLeft + iWidth, iTop + iHeight);
combineRgn(Result, Result, rgn2, RGN_AND);
DeleteObject( rgn2 );
if MoonShape then
begin
moonLeft := adjLeft;
if ( Angle = 0 ) or ( Angle = 180 ) then
inc( moonLeft, iWidth div 2 );
moonTop := adjTop;
if ( Angle = 90 ) or ( Angle = 270 ) then
inc( moonTop, iHeight div 2 );
// Take bite out of it
rgn3 := CreateEllipticRgn(moonLeft, moonTop, moonLeft + iWidth, moonTop + iHeight);
combineRgn(Result, Result, rgn3, RGN_DIFF);
DeleteObject( rgn3 );
end;
end;
// SegmentWidth must be <= 90
function CreateQuarterCircleRegion(iLeft, iTop, iWidth, iHeight: Integer; Angle: Integer; SegmentWidth: Integer): Hrgn;
var
rgn2: Hrgn;
adjWidth, adjHeight, centerX, centerY: Integer;
largeSide, adjLargeSide, NewWidth, NewHeight: integer;
needL, needR, needT, needB: Boolean;
Poly : Array[ 0 .. 8 ] of TPoint;
PointCount: Integer;
rgnRect: TRect ;
px, py: double;
procedure _AddPoint(X, Y: Integer);
begin
poly[ PointCount ] := point( X, Y );
inc( PointCount );
end;
begin
if SegmentWidth <= 0 then
SegmentWidth := 45
else
if SegmentWidth > 90 then
SegmentWidth := 90;
if iWidth > iHeight then
largeSide := iWidth
else
largeSide := iHeight;
if ( Angle mod 90 = 0 ) or ( Angle mod 90 + SegmentWidth < 90 ) then
adjLargeSide := largeSide
else
begin
px := largeSide;
py := 0;
IEDRotatePoint( px, py, - SegmentWidth, 0, 0 );
IECalcRotatedBitmapSizes( largeSide, Round( Max( px, py )), IE2DPoint( 0, 0 ), ( Angle mod 90 ), NewWidth, NewHeight );
adjLargeSide := Max( NewWidth, NewHeight );
end;
needL := ( Angle >= 180 ) or ( Angle + SegmentWidth > 180 );
needR := ( Angle < 180 ) or ( Angle + SegmentWidth > 360 );
needT := (( Angle >= 270 ) or ( Angle < 90 )) or
( Angle + SegmentWidth > 270 );
needB := (( Angle >= 90 ) and ( Angle < 180 )) or
(( Angle < 270 ) and ( Angle + SegmentWidth > 90 ));
adjWidth := Round( iWidth * 2 * largeSide / adjLargeSide );
adjHeight := Round( iHeight * 2 * largeSide / adjLargeSide );
centerX := adjWidth div 2;
centerY := adjHeight div 2;
// Circle
Result := CreateEllipticRgn( 0, 0, adjWidth, adjHeight );
PointCount := 0;
// Center
_AddPoint( centerX, centerY );
// Start of slice
_AddPoint( Round( centerx - adjWidth / 2 * cos(( angle + 90) * pi / 180 )),
round( centery - adjHeight / 2 * sin(( angle + 90) * pi / 180 )));
// TR
if ( Angle <= 90 ) and needT and needR then
_AddPoint( adjWidth, 0 );
// BR
if needB and needR then
_AddPoint( adjWidth, adjHeight );
// BL
if needB and needL then
_AddPoint( 0, adjHeight );
// TL
if needT and needL then
_AddPoint( 0, 0 );
// TR #2
if ( Angle >= 270 ) and needT and needR then
_AddPoint( adjWidth, 0 );
// End of slice
_AddPoint( Round( centerx - adjWidth / 2 * cos(( Angle + SegmentWidth + 90) * pi / 180 )),
round( centery - adjHeight / 2 * sin(( Angle + SegmentWidth + 90) * pi / 180 )));
rgn2 := Windows.CreatePolygonRgn( poly, PointCount, WINDING );
combineRgn( Result, Result, rgn2, RGN_AND );
// Center the region
GetRgnBox( Result, rgnRect );
iLeft := iLeft + ( iWidth - rgnRect.Right + rgnRect.Left ) div 2;
iTop := iTop + ( iHeight - rgnRect.Bottom + rgnRect.Top ) div 2;
OffsetRgn( Result, iLeft - rgnRect.Left, iTop - rgnRect.Top );
DeleteObject( rgn2 );
end;
// Note: Angle is rounded to nearest 90
function CreateSpeechBubbleRegion(iLeft, iTop, iWidth, iHeight: Integer; Shape: TIEShape; Angle: Integer = 0): Hrgn;
const
Long_Bubble_Bottom_Excl_Circle = 0.35;
Long_Bubble_Circle_Round = 0.1;
Short_Bubble_Bottom_Excl_Circle = 0.15;
Short_Bubble_Circle_Round = 0.45;
Triangle_Buffer = 0.05;
var
rgn1, rgn2, rgn3, rgn4, rgn5, rgn6, rgn7: Hrgn;
circleSz: integer;
halfCircleSz: integer;
bubbleHeight: integer;
poly: array [ 0 .. 2 ] of TPoint;
trianglePointLeft, triangleTopLeft, triangleTopRight: integer;
triangleBottom: integer;
invertDir, flipHorz: Boolean;
function _FlipVert(value: Integer): integer;
begin
if ( Angle = 180 ) or ( Angle = 90 ) then
Result := iHeight - Value
else
Result := Value;
end;
begin
Angle := RoundTo90( Angle );
flipHorz := ( Angle = 180 ) or ( Angle = 270 );
invertDir := ( Angle = 90 ) or ( Angle = 270 );
if flipHorz then
case Shape of
iesSpeechBubbleLeftInShort : Shape := iesSpeechBubbleRightInShort;
iesSpeechBubbleLeftOutShort : Shape := iesSpeechBubbleRightOutShort;
iesSpeechBubbleRightInShort : Shape := iesSpeechBubbleLeftInShort;
iesSpeechBubbleRightOutShort : Shape := iesSpeechBubbleLeftOutShort;
iesSpeechBubbleLeftInLong : Shape := iesSpeechBubbleRightInLong;
iesSpeechBubbleLeftOutLong : Shape := iesSpeechBubbleRightOutLong;
iesSpeechBubbleRightInLong : Shape := iesSpeechBubbleLeftInLong;
iesSpeechBubbleRightOutLong : Shape := iesSpeechBubbleLeftOutLong;
end;
if invertDir then
begin
IESwap( iWidth, iHeight );
IESwap( iLeft, iTop );
end;
if Shape in [ iesSpeechBubbleLeftInLong, iesSpeechBubbleLeftOutLong, iesSpeechBubbleRightInLong, iesSpeechBubbleRightOutLong ] then
begin
circleSz := round(iWidth * Long_Bubble_Circle_Round);
bubbleHeight := round(iHeight * Long_Bubble_Bottom_Excl_Circle) + circleSz
end
else
begin
circleSz := min(round(iWidth * Short_Bubble_Circle_Round), round(iHeight * Short_Bubble_Circle_Round));
bubbleHeight := round(iHeight * Short_Bubble_Bottom_Excl_Circle) + circleSz;
end;
halfcircleSz := circleSz div 2;
triangleBottom := iHeight - 1;
case Shape of
iesSpeechBubbleLeftInLong,
iesSpeechBubbleLeftInShort:
Begin
triangleTopLeft := round(iWidth * 0.18);
triangleTopRight := round(iWidth * 0.30);
trianglePointLeft := round(iWidth * 0.45);
end;
iesSpeechBubbleLeftOutLong,
iesSpeechBubbleLeftOutShort:
Begin
triangleTopLeft := round(iWidth * 0.18);
triangleTopRight := round(iWidth * 0.30);
trianglePointLeft := round(iWidth * 0.08);
end;
iesSpeechBubbleRightInLong,
iesSpeechBubbleRightInShort:
Begin
triangleTopLeft := round(iWidth * 0.70);
triangleTopRight := round(iWidth * 0.82);
trianglePointLeft := round(iWidth * 0.55);
end;
iesSpeechBubbleRightOutLong,
iesSpeechBubbleRightOutShort:
Begin
triangleTopLeft := round(iWidth * 0.70);
triangleTopRight := round(iWidth * 0.82);
trianglePointLeft := round(iWidth * 0.92);
end;
else
raise Exception.Create('Unknown shape');
end;
if invertDir then
begin
result := CreateEllipticRgn( _FlipVert( iTop ), iLeft, _FlipVert( iTop + iHeight ), iLeft + iWidth );
// Top Circles
rgn1 := CreateEllipticRgn( _FlipVert( iTop ), iLeft, _FlipVert( iTop + circleSz ), iLeft + circleSz );
rgn2 := CreateEllipticRgn( _FlipVert( iTop ), iLeft + iWidth - circleSz, _FlipVert( iTop + circleSz ), iLeft + iWidth );
combineRgn(result, rgn1, rgn2, RGN_OR);
// Bottom Circles
rgn3 := CreateEllipticRgn( _FlipVert( iTop + bubbleHeight - circleSz ), iLeft, _FlipVert( iTop + bubbleHeight ), iLeft + circleSz );
combineRgn(result, result, rgn3, RGN_OR);
rgn4 := CreateEllipticRgn( _FlipVert( iTop + bubbleHeight - circleSz ), iLeft + iWidth - circleSz, _FlipVert( iTop + bubbleHeight ), iLeft + iWidth );
combineRgn(result, result, rgn4, RGN_OR);
// Box fills
rgn5 := CreateRectRgn( _FlipVert( iTop ),
iLeft + halfCircleSz,
_FlipVert( iTop + bubbleHeight ),
iLeft + iWidth - halfCircleSz);
combineRgn(result, result, rgn5, RGN_OR);
rgn6 := CreateRectRgn( _FlipVert( iTop + halfCircleSz ),
iLeft,
_FlipVert( iTop + bubbleHeight - halfCircleSz ),
iLeft + iWidth);
combineRgn(result, result, rgn6, RGN_OR);
// Draw Triangle
poly[ 0 ] := point( _FlipVert( iTop + bubbleHeight - Round( Triangle_Buffer * iHeight )), iLeft + triangleTopLeft );
poly[ 1 ] := point( _FlipVert( iTop + bubbleHeight - Round( Triangle_Buffer * iHeight )), iLeft + triangleTopRight );
poly[ 2 ] := point( _FlipVert( iTop + triangleBottom ), iLeft + trianglePointLeft );
end
else
begin
result := CreateEllipticRgn( iLeft, _FlipVert( iTop ), iLeft + iWidth, _FlipVert( iTop + iHeight ));
// Top Circles
rgn1 := CreateEllipticRgn(iLeft, _FlipVert( iTop ), iLeft + circleSz, _FlipVert( iTop + circleSz ));
rgn2 := CreateEllipticRgn(iLeft + iWidth - circleSz, _FlipVert( iTop ), iLeft + iWidth, _FlipVert( iTop + circleSz ));
combineRgn(result, rgn1, rgn2, RGN_OR);
// Bottom Circles
rgn3 := CreateEllipticRgn(iLeft, _FlipVert( iTop + bubbleHeight - circleSz ), iLeft + circleSz, _FlipVert( iTop + bubbleHeight ));
combineRgn(result, result, rgn3, RGN_OR);
rgn4 := CreateEllipticRgn(iLeft + iWidth - circleSz, _FlipVert( iTop + bubbleHeight - circleSz ), iLeft + iWidth, _FlipVert( iTop + bubbleHeight ));
combineRgn(result, result, rgn4, RGN_OR);
// Box fills
rgn5 := CreateRectRgn( iLeft + halfCircleSz,
_FlipVert( iTop ),
iLeft + iWidth - halfCircleSz,
_FlipVert( iTop + bubbleHeight ));
combineRgn(result, result, rgn5, RGN_OR);
rgn6 := CreateRectRgn( iLeft,
_FlipVert( iTop + halfCircleSz ),
iLeft + iWidth,
_FlipVert( iTop + bubbleHeight - halfCircleSz ));
combineRgn(result, result, rgn6, RGN_OR);
// Draw Triangle
poly[ 0 ] := point( iLeft + triangleTopLeft, _FlipVert( iTop + bubbleHeight - Round( Triangle_Buffer * iHeight )));
poly[ 1 ] := point( iLeft + triangleTopRight, _FlipVert( iTop + bubbleHeight - Round( Triangle_Buffer * iHeight )));
poly[ 2 ] := point( iLeft + trianglePointLeft, _FlipVert( iTop + triangleBottom ));
end;
rgn7 := Windows.CreatePolygonRgn(poly, 3, WINDING);
combineRgn(Result, result, rgn7, RGN_OR);
DeleteObject(rgn1);
DeleteObject(rgn2);
DeleteObject(rgn3);
DeleteObject(rgn4);
DeleteObject(rgn5);
DeleteObject(rgn6);
DeleteObject(rgn7);
end;
// Note: Angle is rounded to nearest 90
function CreateThoughtBubbleRegion(iLeft, iTop, iWidth, iHeight: Integer; Shape: TIEShape; Angle: Integer = 0): Hrgn;
const
Max_X = 1000;
Thought_Bubble_Max_Y = 1000;
Cloud_Max_Y = 817;
Last_Cloud_Rect = 8;
Thought_Bubble_Ellipses : array[0 .. 11] of TRect = ( (Left: 160; Top: 142; Right: 845; Bottom: 718),
(Left: 0; Top: 229; Right: 323; Bottom: 573),
(Left: 160; Top: 73; Right: 482; Bottom: 404),
(Left: 411; Top: 0; Right: 743; Bottom: 431),
(Left: 630; Top: 133; Right: 942; Bottom: 460),
(Left: 776; Top: 351; Right: 1000; Bottom: 595),
(Left: 689; Top: 509; Right: 875; Bottom: 740),
(Left: 394; Top: 513; Right: 727; Bottom: 817),
(Left: 138; Top: 396; Right: 496; Bottom: 754),
(Left: 783; Top: 758; Right: 880; Bottom: 862),
(Left: 860; Top: 873; Right: 919; Bottom: 935),
(Left: 910; Top: 960; Right: 950; Bottom: 1000));
var
rgn2: Hrgn;
I, ellipseLeft, ellipseRight, ellipseTop, ellipseBottom, MaxY: integer;
invertDir, flipHorz, flipVert: Boolean;
function _FlipHorz(value: Integer): integer;
begin
if flipHorz then
Result := iWidth - Value
else
Result := Value;
end;
function _FlipVert(value: Integer): integer;
begin
if flipVert then
Result := iHeight - Value
else
Result := Value;
end;
begin
Result := 0;
Angle := RoundTo90( Angle );
invertDir := ( Angle = 90 ) or ( Angle = 270 );
if Shape = iesThoughtBubbleLeft then
begin
flipVert := ( Angle = 180 ) or ( Angle = 90 );
flipHorz := ( Angle = 0 ) or ( Angle = 90 );
end
else
begin
flipVert := ( Angle = 180 ) or ( Angle = 270 );
flipHorz := ( Angle = 180 ) or ( Angle = 90 );
end;
if Shape <> iesCloud then
MaxY := Thought_Bubble_Max_Y
else
begin
MaxY := Cloud_Max_Y;
flipVert := not flipVert;
end;
for I := Low( Thought_Bubble_Ellipses ) to High( Thought_Bubble_Ellipses ) do
begin
if invertDir then
begin
ellipseLeft := _FlipHorz( Round( iWidth * ( Thought_Bubble_Ellipses[ I ].Bottom / MaxY )));
ellipseTop := _FlipVert( Round( iHeight * ( Thought_Bubble_Ellipses[ I ].Left / Max_X )));
ellipseRight := _FlipHorz( Round( iWidth * ( Thought_Bubble_Ellipses[ I ].Top / MaxY )));
ellipseBottom := _FlipVert( Round( iHeight * ( Thought_Bubble_Ellipses[ I ].Right / Max_X )));
end
else
begin
ellipseLeft := _FlipHorz( Round( iWidth * ( Thought_Bubble_Ellipses[ I ].Left / Max_X )));
ellipseTop := _FlipVert( Round( iHeight * ( Thought_Bubble_Ellipses[ I ].Top / MaxY )));
ellipseRight := _FlipHorz( Round( iWidth * ( Thought_Bubble_Ellipses[ I ].Right / Max_X )));
ellipseBottom := _FlipVert( Round( iHeight * ( Thought_Bubble_Ellipses[ I ].Bottom / MaxY )));
end;
if I = Low( Thought_Bubble_Ellipses ) then
result := CreateEllipticRgn( iLeft + ellipseLeft, iTop + ellipseTop,
iLeft + ellipseRight, iTop + ellipseBottom )
else
begin
rgn2 := CreateEllipticRgn( iLeft + ellipseLeft, iTop + ellipseTop,
iLeft + ellipseRight, iTop + ellipseBottom );
combineRgn(result, result, rgn2, RGN_OR);
DeleteObject(rgn2);
if ( Shape = iesCloud ) and ( I = Last_Cloud_Rect ) then
Break;
end;
end;
end;
function CreateCircularFrameRegion(iLeft, iTop, iWidth, iHeight: Integer; Angle: Integer = 0): Hrgn;
var
rgn2: Hrgn;
begin
Result := CreateEllipticRgn(iLeft, iTop, iLeft + iWidth, iTop + iHeight);
rgn2 := CreateEllipticRgn(iLeft + iWidth div 8, iTop + iHeight div 8, iLeft + iWidth - iWidth div 8, iTop + iHeight - iHeight div 8);
combineRgn(Result, Result, rgn2, RGN_XOR);
DeleteObject(rgn2);
end;
// Note: Angle is not used
function CreateFrameRegion(iLeft, iTop, iWidth, iHeight: Integer; Shape: TIEShape; Angle: Integer = 0): Hrgn;
var
rgn2: Hrgn;
dw: integer;
begin
case Shape of
iesFatFrame : dw := min(iWidth div 4, iHeight div 4);
iesNarrowFrame : dw := min(iWidth div 16, iHeight div 16);
else { iesFrame } dw := min(iWidth div 8, iHeight div 8);
end;
result := CreateRectRgn(iLeft, iTop, iLeft + iWidth, iTop + iHeight );
rgn2 := CreateRectRgn(iLeft + dw, iTop + dw, iLeft + iWidth - dw, iTop + iHeight - dw);
combineRgn(result, result, rgn2, RGN_XOR);
DeleteObject(rgn2);
end;
{!!
<FS>IEShapePreferredAspectRatio
<FM>Declaration<FC>
function IEShapePreferredAspectRatio(Shape: <A TIEShape>): Double;
<FM>Description<FN>
Some shapes are best displayed at the ratio they were designed (typically 1:1). This method returns that preferred aspect ratio (equating to Height / Width ) or 0 if the shape has no preferred ratio.
Note: Defined in iexCanvasUtils unit
<FM>Example<FC>
aspectRatio := IEShapePreferredAspectRatio( iesHeart ); // Returns 1
!!}
function IEShapePreferredAspectRatio(Shape: TIEShape): Double;
begin
Result := 0;
if Shape in [ iesMoon ] then
Result := 0.5
else
if Shape in [ iesStar5 ,
iesStar6 ,
iesCustomStar,
iesArrowNW ,
iesArrowNE ,
iesArrowSW ,
iesArrowSE ,
iesShootingArrowNW,
iesShootingArrowNE,
iesShootingArrowSW,
iesShootingArrowSE,
iesHeart ,
iesDoubleHeart ,
iesLightningLeft,
iesLightningRight,
iesCustomStar ,
iesTriangle ,
iesCorner ,
iesDiamond,
iesPentagon ,
iesHexagon ,
iesHeptagon ,
iesOctagon ,
iesCustomShape ,
iesCross ] then
Result := 1;
end;
const
Max_Shape_Region_Points = 31;
Rect_Pts : array[0 .. 4] of TDPoint = ((X: 0; Y: 0), (X: 1; Y: 0), (X: 1; Y: 1), (X: 0; Y: 1), (X: 0; Y: 0));
Triangle_Pts : array[0 .. 3] of TDPoint = ((X: 0.5; Y: 0), (X: 1; Y: 1), (X: 0; Y: 1), (X: 0.5; Y: 0));
Corner_Pts : array[0 .. 3] of TDPoint = ((X: 0; Y: 0), (X: 1; Y: 0), (X: 0; Y: 1), (X: 0; Y: 0));
Star_5_Pts : array[0 .. 10] of TDPoint = ( (X: 0.5; Y: 0),
(X: 0.62; Y: 0.38),
(X: 1; Y: 0.38),
(X: 0.7; Y: 0.62),
(X: 0.81; Y: 1.00),
(X: 0.5; Y: 0.77),
(X: 0.19; Y: 1.00),
(X: 0.31; Y: 0.62),
(X: 0; Y: 0.38),
(X: 0.39; Y: 0.38),
(X: 0.5; Y: 0) );
Star_6_Pts : array[0 .. 12] of TDPoint = ((X: 0.5; Y: 0), (X: 0.625; Y: 0.25), (X: 0.9; Y: 0.25), (X: 0.75; Y: 0.5), (X: 0.9; Y: 0.75), (X: 0.625; Y: 0.75), (X: 0.5; Y: 1), (X: 0.375; Y: 0.75), (X: 0.1; Y: 0.75), (X: 0.25; Y: 0.5), (X: 0.1; Y: 0.25), (X: 0.375; Y: 0.25), (X: 0.5; Y: 0));
Arrow_NW_Pts : array[0 .. 7] of TDPoint = ((X: 0; Y: 0), (X: 0.4; Y: 0), (X: 0.3; Y: 0.1), (X: 1; Y: 0.8), (X: 0.8; Y: 1), (X: 0.1; Y: 0.3), (X: 0; Y: 0.4), (X: 0; Y: 0));
Shooting_Arrow_NW_Pts : array[0 .. 30] of TDPoint = ((X: 0.85; Y: 1), (X: 0.8; Y: 0.95), (X: 0.8; Y: 0.85), (X: 0.775; Y: 0.825), (X: 0.775; Y: 0.925), (X: 0.725; Y: 0.875), (X: 0.725; Y: 0.775), (X: 0.7; Y: 0.75), (X: 0.7; Y: 0.85), (X: 0.65; Y: 0.8), (X: 0.65; Y: 0.7), (X: 0.15; Y: 0.2), (X: 0.15; Y: 0.3), (X: 0; Y: 0.15), (X: 0; Y: 0), (X: 0.15; Y: 0), (X: 0.3; Y: 0.15), (X: 0.2; Y: 0.15), (X: 0.7; Y: 0.65), (X: 0.8; Y: 0.65), (X: 0.85; Y: 0.7), (X: 0.75; Y: 0.7), (X: 0.775; Y: 0.725), (X: 0.875; Y: 0.725), (X: 0.925; Y: 0.775), (X: 0.825; Y: 0.775), (X: 0.85; Y: 0.8), (X: 0.95; Y: 0.8), (X: 1; Y: 0.85), (X: 0.85; Y: 0.85), (X: 0.85; Y: 1));
Lightning_Left_Pts : array[0 .. 11] of TDPoint = ((X: 1; Y: 0.19), (X: 0.61; Y: 0.01), (X: 0.41; Y: 0.29), (X: 0.49; Y: 0.31), (X: 0.23; Y: 0.55), (X: 0.33; Y: 0.6), (X: 0; Y: 1), (X: 0.51; Y: 0.69), (X: 0.46; Y: 0.65), (X: 0.78; Y: 0.45), (X: 0.66; Y: 0.39), (X: 1; Y: 0.19));
Explosion_Pts : array[0 .. 24] of TDPoint = ((X: 0.33; Y: 0), (X: 0.5; Y: 0.26), (X: 0.62; Y: 0.11), (X: 0.67; Y: 0.28), (X: 0.99; Y: 0.1), (X: 0.78; Y: 0.35), (X: 1; Y: 0.39), (X: 0.84; Y: 0.54), (X: 0.99; Y: 0.66), (X: 0.75; Y: 0.64), (X: 0.78; Y: 0.81), (X: 0.65; Y: 0.71), (X: 0.61; Y: 1), (X: 0.51; Y: 0.69), (X: 0.38; Y: 0.89), (X: 0.35; Y: 0.66), (X: 0.17; Y: 0.83), (X: 0.22; Y: 0.59), (X: 0; Y: 0.61), (X: 0.19; Y: 0.48), (X: 0.04; Y: 0.37), (X: 0.22; Y: 0.34), (X: 0.16; Y: 0.2), (X: 0.35; Y: 0.25), (X: 0.33; Y: 0.01));
Badge_Pts : array[0 .. 5] of TDPoint = ( (X: 0.25; Y: 0),
(X: 0.75; Y: 0),
(X: 1.00; Y: 0.25),
(X: 0.50; Y: 1),
(X: 0.00; Y: 0.25),
(X: 0.25; Y: 0) );
Diamond_Pts : array[0 .. 4] of TDPoint = ( (X: 0.50; Y: 0.00),
(X: 1.00; Y: 0.50),
(X: 0.50; Y: 1.00),
(X: 0.00; Y: 0.50),
(X: 0.50; Y: 0.00) );
Arrow_Head_Size = 0.40;
Arrow_Offset = 0.33;
Arrow_Up_Pts : array[0 .. 6] of TDPoint = ( (X: Arrow_Offset; Y: 1.00),
(X: Arrow_Offset; Y: Arrow_Head_Size),
(X: 0.00; Y: Arrow_Head_Size),
(X: 0.50; Y: 0.00),
(X: 1.00; Y: Arrow_Head_Size),
(X: 1 - Arrow_Offset; Y: Arrow_Head_Size),
(X: 1 - Arrow_Offset; Y: 1.00) );
Double_Arrow_Head_Size = 0.30;
Double_Vert_Arrow_Pts : array[0 .. 9] of TDPoint = ( (X: 0.50; Y: 0.00), // Top point
(X: 0.00; Y: Double_Arrow_Head_Size),
(X: 0.33; Y: Double_Arrow_Head_Size),
(X: 0.33; Y: 1 - Double_Arrow_Head_Size),
(X: 0.00; Y: 1 - Double_Arrow_Head_Size),
(X: 0.50; Y: 1.00), // bottom point
(X: 1.00; Y: 1 - Double_Arrow_Head_Size),
(X: 0.67; Y: 1 - Double_Arrow_Head_Size),
(X: 0.67; Y: Double_Arrow_Head_Size),
(X: 1.00; Y: Double_Arrow_Head_Size) );
Fat_Arrow_Head_Size = 0.40;
Fat_Arrow_Offset = 0.16;
Fat_Arrow_Up_Pts : array[0 .. 6] of TDPoint = ( (X: Fat_Arrow_Offset; Y: 1.00),
(X: Fat_Arrow_Offset; Y: Fat_Arrow_Head_Size),
(X: 0.00; Y: Fat_Arrow_Head_Size),
(X: 0.50; Y: 0.00),
(X: 1.00; Y: Fat_Arrow_Head_Size),
(X: 1 - Fat_Arrow_Offset; Y: Fat_Arrow_Head_Size),
(X: 1 - Fat_Arrow_Offset; Y: 1.00) );
Shield_Pts : array[0 .. 15] of TDPoint = ( (X: 0.00; Y: 0.00),
(X: 0.25; Y: 0.125),
(X: 0.50; Y: 0.00),
(X: 0.75; Y: 0.125),
(X: 1.00; Y: 0.00),
(X: 0.875; Y: 0.25),
(X: 1.00; Y: 0.50),
(X: 0.875; Y: 0.75),
(X: 1.00; Y: 1.00),
(X: 0.75; Y: 0.875),
(X: 0.50; Y: 1.00),
(X: 0.25; Y: 0.875),
(X: 0.00; Y: 1.00),
(X: 0.125; Y: 0.75),
(X: 0.00; Y: 0.50),
(X: 0.125; Y: 0.25) );
Name_Plate_Corner_Width = 0.12;
Name_Plate_Pts : array[0 .. 20] of TDPoint = ( (X: 0.00; Y: 0.00 ),
(X: -(2 * Name_Plate_Corner_Width); Y: 0.00 ),
(X: -(2 * Name_Plate_Corner_Width); Y: -(Name_Plate_Corner_Width) ),
(X: -(1 - 2 * Name_Plate_Corner_Width); Y: -(Name_Plate_Corner_Width) ),
(X: -(1 - 2 * Name_Plate_Corner_Width); Y: 0.00 ),
(X: 1.00; Y: 0.00 ),
(X: 1.00; Y: -(2 * Name_Plate_Corner_Width) ),
(X: -(1 - Name_Plate_Corner_Width); Y: -(2 * Name_Plate_Corner_Width) ),
(X: -(1 - Name_Plate_Corner_Width); Y: -(1 - 2 * Name_Plate_Corner_Width) ),
(X: 1.00; Y: -(1 - 2 * Name_Plate_Corner_Width) ),
(X: 1.00; Y: 1.00 ),
(X: -(1 - 2 * Name_Plate_Corner_Width); Y: 1.00 ),
(X: -(1 - 2 * Name_Plate_Corner_Width); Y: -(1 - Name_Plate_Corner_Width) ),
(X: -(2 * Name_Plate_Corner_Width); Y: -(1 - Name_Plate_Corner_Width) ),
(X: -(2 * Name_Plate_Corner_Width); Y: 1.00 ),
(X: 0.00; Y: 1.00 ),
(X: 0.00; Y: -(1 - 2 * Name_Plate_Corner_Width) ),
(X: -(Name_Plate_Corner_Width); Y: -(1 - 2 * Name_Plate_Corner_Width) ),
(X: -(Name_Plate_Corner_Width); Y: -(2 * Name_Plate_Corner_Width) ),
(X: 0.00; Y: -(2 * Name_Plate_Corner_Width) ),
(X: 0.00; Y: 0.00 ) );
Cross_Inset_Width = 0.33;
Cross_Pts : array[0 .. 12] of TDPoint = ( (X: Cross_Inset_Width; Y: 0.00),
(X: 1.00 - Cross_Inset_Width; Y: 0.00),
(X: 1.00 - Cross_Inset_Width; Y: Cross_Inset_Width),
(X: 1.00; Y: Cross_Inset_Width),
(X: 1.00; Y: 1.00 - Cross_Inset_Width),
(X: 1.00 - Cross_Inset_Width; Y: 1.00 - Cross_Inset_Width),
(X: 1.00 - Cross_Inset_Width; Y: 1.00 ),
(X: Cross_Inset_Width; Y: 1.00),
(X: Cross_Inset_Width; Y: 1.00 - Cross_Inset_Width),
(X: 0.00; Y: 1.00 - Cross_Inset_Width ),
(X: 0.00; Y: Cross_Inset_Width),
(X: Cross_Inset_Width; Y: Cross_Inset_Width),
(X: Cross_Inset_Width; Y: 0.00) );
procedure IEGenerateShapePoints(out PointArray: Array of TPoint; out PointArrayCount: Integer;
Shape: TIEShape; iLeft, iTop, iWidth, iHeight: Integer;
Angle: Integer = 0; MaintainAROnRotate: Boolean = False;
ShapeModifier: Integer = 0);
var
flipHorz, flipVert, invertDir: Boolean;
procedure _GetShapePoints(SrcPointArray: array of TDPoint; bFlipHorz, bFlipVert, bInvertDir: Boolean);
var
i: Integer;
iShortSide: Integer;
iX, iY: Double;
begin
if (Shape in [ iesLightningLeft, iesLightningRight ]) and ( iWidth > iHeight ) then
begin
// Maintain the Aspect Ratio
iShortSide := iHeight;
Inc(iLeft, (iWidth - iShortSide) div 2);
iWidth := iShortSide;
end;
dec( iWidth );
dec( iHeight );
PointArrayCount := 1 + High(SrcPointArray) - Low(SrcPointArray);
for i := 0 to PointArrayCount - 1 do
begin
iX := abs( SrcPointArray[i].x );
// Negative values mean to average height and width
if iWidth > iHeight then
begin
if SrcPointArray[i].x < -0.50 then
iX := 1 - ( ( 1 - iX ) * iHeight / iWidth )
else
if SrcPointArray[i].x < -0.00 then
iX := iX * iHeight / iWidth;
end;
iY := abs( SrcPointArray[i].y );
// Negative values mean to average height and width
if iHeight > iWidth then
begin
if SrcPointArray[i].y < -0.50 then
iY := 1 - ( ( 1 - iY ) * iWidth / iHeight )
else
if SrcPointArray[i].y < -0.00 then
iY := iY * iWidth / iHeight;
end;
// FLIP HORZ
if bFlipHorz then
iX := 1 - iX;
// FLIP VERT
if bFlipVert then
iY := 1 - iY;
if bInvertDir then
begin
PointArray[i].x := iLeft + round(iY * (iWidth - 1));
PointArray[i].y := iTop + round(iX * (iHeight - 1));
end
else
begin
PointArray[i].x := iLeft + round(iX * (iWidth - 1));
PointArray[i].y := iTop + round(iY * (iHeight - 1));
end;
end;
if Angle mod 90 <> 0 then
begin
IERotatePoints( PointArray, PointArrayCount, - Angle, iLeft + iWidth div 2, iTop + iHeight div 2 );
IEScalePoints( PointArray, PointArrayCount, iLeft, iTop, iLeft + iWidth, iTop + iHeight, MaintainAROnRotate );
end;
end;
procedure _GetCustomPolygonPoints(Shape: TIEShape; PointCount : Integer);
begin
GetCustomPolygonPoints( PointArray, PointArrayCount, iLeft, iTop, iWidth, iHeight, Shape, PointCount, Angle );
end;
begin
// for 90 degree rotates, do flip/inversions for speed
flipHorz := ( Angle = 180 ) or ( Angle = 270 );
flipVert := ( Angle = 90 ) or ( Angle = 180 );
invertDir := (Angle = 90) or ( Angle = 270 );
// Note: Ensure aligns with Supported_Generate_Points_Shapes
case Shape of
iesRectangle,
iesRoundRect : _GetShapePoints( Rect_Pts, False, False, False );
iesTriangle : _GetShapePoints( Triangle_Pts, flipHorz, flipVert, invertDir );
iesCorner : _GetShapePoints( Corner_Pts, flipHorz, flipVert, invertDir );
iesDiamond : _GetShapePoints( Diamond_Pts, flipHorz, flipVert, invertDir );
iesStar5 : _GetShapePoints( Star_5_Pts, flipHorz, flipVert, invertDir );
iesStar6 : _GetShapePoints( Star_6_Pts, flipHorz, flipVert, invertDir );
iesArrowLeft : _GetShapePoints( Arrow_Up_Pts, flipHorz, flipVert, not invertDir );
iesArrowRight : _GetShapePoints( Arrow_Up_Pts, flipHorz, not flipVert, not invertDir );
iesArrowUp : _GetShapePoints( Arrow_Up_Pts, flipHorz, flipVert, invertDir );
iesArrowDown : _GetShapePoints( Arrow_Up_Pts, flipHorz, not flipVert, invertDir );
iesFatArrowUp : _GetShapePoints( Fat_Arrow_Up_Pts, flipHorz, flipVert, invertDir );
iesFatArrowLeft : _GetShapePoints( Fat_Arrow_Up_Pts, flipHorz, flipVert, not invertDir );
iesFatArrowRight : _GetShapePoints( Fat_Arrow_Up_Pts, flipHorz, not flipVert, not invertDir );
iesFatArrowDown : _GetShapePoints( Fat_Arrow_Up_Pts, flipHorz, not flipVert, invertDir );
iesArrowLeftRight : _GetShapePoints( Double_Vert_Arrow_Pts, flipHorz, flipVert, not invertDir );
iesArrowUpDown : _GetShapePoints( Double_Vert_Arrow_Pts, flipHorz, flipVert, invertDir );
iesArrowNW : _GetShapePoints( Arrow_NW_Pts, flipHorz, flipVert, invertDir );
iesArrowNE : _GetShapePoints( Arrow_NW_Pts, not flipHorz, flipVert, invertDir );
iesArrowSW : _GetShapePoints( Arrow_NW_Pts, flipHorz, not flipVert, invertDir );
iesArrowSE : _GetShapePoints( Arrow_NW_Pts, not flipHorz, not flipVert, invertDir );
iesShootingArrowNW : _GetShapePoints( Shooting_Arrow_NW_Pts, flipHorz, flipVert, invertDir );
iesShootingArrowNE : _GetShapePoints( Shooting_Arrow_NW_Pts, not flipHorz, flipVert, invertDir );
iesShootingArrowSW : _GetShapePoints( Shooting_Arrow_NW_Pts, flipHorz, not flipVert, invertDir );
iesShootingArrowSE : _GetShapePoints( Shooting_Arrow_NW_Pts, not flipHorz, not flipVert, invertDir );
iesLightningLeft : _GetShapePoints( Lightning_Left_Pts, flipHorz, flipVert, invertDir );
iesLightningRight : _GetShapePoints( Lightning_Left_Pts, not flipHorz, flipVert, invertDir );
iesExplosion : _GetShapePoints( Explosion_Pts, flipHorz, flipVert, invertDir );
iesCross : _GetShapePoints( Cross_Pts, flipHorz, flipVert, invertDir );
iesShield : _GetShapePoints( Shield_Pts, flipHorz, flipVert, invertDir );
iesBadge : _GetShapePoints( Badge_Pts, flipHorz, flipVert, invertDir );
iesNamePlate : _GetShapePoints( Name_Plate_Pts, flipHorz, flipVert, invertDir );
iesPentagon : _GetCustomPolygonPoints( iesCustomShape, 5 );
iesHexagon : _GetCustomPolygonPoints( iesCustomShape, 6 );
iesHeptagon : _GetCustomPolygonPoints( iesCustomShape, 7 );
iesOctagon : _GetCustomPolygonPoints( iesCustomShape, 8 );
iesCustomShape : _GetCustomPolygonPoints( iesCustomShape, ShapeModifier );
iesCustomStar : _GetCustomPolygonPoints( iesCustomStar, ShapeModifier );
iesCustomExplosion : _GetCustomPolygonPoints( iesCustomExplosion, ShapeModifier );
else raise EIEException.create( 'Unexpected Shape' );
end;
end;
{!!
<FS>IECreateShapeRegion
<FM>Declaration<FC>
function IECreateShapeRegion(Shape: <A TIEShape>; iLeft, iTop, iWidth, iHeight: Integer;
Angle: Integer = 0; ShapeModifier: Integer = 0): HRgn; overload;
function IECreateShapeRegion(Shape: <A TIEShape>; ARect: TRect; MaintainAspect: TIEBooleanEx = iebDefault;
Angle: Integer = 0; ShapeModifier: Integer = 0): HRgn; overload;
<FM>Description<FN>
Create an HRGN of a <A TIEShape> at the specified position and size.
If MaintainAspect is <FC>iebDefault<FN>, then shapes are output at the aspect ratio they were designed (if <FC>iebTrue<FN> then a 1:1 aspect ratio is enforced even if it was not designed with one).
<FC>Angle<FN> is the amount of rotation to apply (degrees counter-clockwise). The following shapes can only be rotated in 90 degree increments: iesHalfEllipse, iesRoundRect, iesHeart, iesDoubleHeart, iesCloud, iesMoon, iesSpeechBubble*, iesThoughtBubble*, iesFrame, iesNarrowFrame, iesFatFrame
<FC>ShapeModifier<FN> has the following effect:
<TABLE>
<R> <H>Shape</H> <H>Effect</H> <H>Range</H> <H>Default</H> </R>
<R> <C><FC>iesCustomShape<FN></C> <C> Specifies the number of sides of the shape </C> <C>3 - 50</C> <C>10</C> </R>
<R> <C><FC>iesCustomStar<FN></C> <C> Specifies the number of points of the star </C> <C>3 - 50</C> <C>10</C> </R>
<R> <C><FC>iesCustomExplosion<FN></C> <C> Specifies the number of points of the explosion </C> <C>3 - 50</C><C>12</C> </R>
<R> <C><FC>iesEllipseSegment<FN></C> <C> Specifies the width of the ellipse segment (in degrees) </C> <C>1 - 90</C> <C>45</C> </R>
</TABLE>
Note: Defined in iexCanvasUtils unit
<FM>Example<FC>
// Create a heart HRGN
aRgn := IECreateShapeRegion( iesExplosion, 0, 0, 200, 200 );
!!}
function IECreateShapeRegion(Shape: TIEShape; iLeft, iTop, iWidth, iHeight: Integer; MaintainAspect: TIEBooleanEx = iebDefault;
Angle: Integer = 0; ShapeModifier: Integer = 0): HRgn;
var
maintainAR: Boolean;
function _CreateCustomPolygonRegion(Shape: TIEShape; InPointCount : Integer): HRgn;
var
arPts : Array[ 0 .. Max_Custom_Polygon_Points ] of TPoint;
pts: Integer;
begin
GetCustomPolygonPoints( arPts, pts, iLeft, iTop, iWidth, iHeight, Shape, InPointCount, Angle );
Result := CreatePolygonRgn(arPts, pts, WINDING);
end;
function _CreateShapeRegionEx(): HRgn;
var
arPts : Array[ 0 .. Max_Shape_Region_Points ] of TPoint;
pts: Integer;
begin
IEGenerateShapePoints( arPts, pts, Shape, iLeft, iTop, iWidth, iHeight, Angle, maintainAr );
Result := CreatePolygonRgn(arPts, pts, WINDING);
end;
begin
// ImageEn angles are counter-clockwise
Angle := 360 - Angle;
while Angle >= 360 do
Dec( Angle, 360 );
while Angle < 0 do
Inc( Angle, 360 );
// Should object be drawn 1:1
maintainAR := MaintainAspect = iebTrue;
if MaintainAspect = iebDefault then
maintainAR := IEShapePreferredAspectRatio( Shape ) <> 0;
if maintainAR then
begin
KeepAspectRatioForDimensions( iLeft, iTop, iWidth, iHeight );
if Shape in [ iesHalfEllipse, iesMoon ] then
begin
// Moon needs to be scaled 1:2
if ( Angle = 90 ) or ( Angle = 270 ) then
begin
inc( iTop, iHeight div 4 );
iHeight := iHeight div 2;
end
else
begin
inc( iLeft, iWidth div 4 );
iWidth := iWidth div 2;
end;
end;
end;
case Shape of
iesEllipse : Result := CreateEllipticRgn( iLeft, iTop, iLeft + iWidth, iTop + iHeight );
iesHalfEllipse : Result := CreateHalfCircleRegion(iLeft, iTop, iWidth, iHeight, False, Angle);
iesQuarterEllipse : Result := CreateQuarterCircleRegion(iLeft, iTop, iWidth, iHeight, Angle, 90 );
iesEllipseSegment : Result := CreateQuarterCircleRegion(iLeft, iTop, iWidth, iHeight, Angle, ShapeModifier );
iesRectangle : if Angle mod 90 = 0 then
Result := CreateRectRgn( iLeft, iTop, iLeft + iWidth, iTop + iHeight )
else
Result := _CreateShapeRegionEx();
iesRoundRect : begin
// Note: Angle is not supported
Result := CreateRoundRectRgn( iLeft, iTop, iLeft + iWidth, iTop + iHeight, min( iWidth div 4, iHeight div 4 ), min( iWidth div 4, iHeight div 4 ));
end;
iesSpeechBubbleLeftInLong,
iesSpeechBubbleLeftOutLong,
iesSpeechBubbleRightInLong,
iesSpeechBubbleRightOutLong,
iesSpeechBubbleLeftInShort,
iesSpeechBubbleLeftOutShort,
iesSpeechBubbleRightInShort,
iesSpeechBubbleRightOutShort : Result := CreateSpeechBubbleRegion(iLeft, iTop, iWidth, iHeight, Shape, Angle);
iesCloud,
iesThoughtBubbleLeft,
iesThoughtBubbleRight : Result := CreateThoughtBubbleRegion(iLeft, iTop, iWidth, iHeight, Shape, Angle);
iesFrame,
iesNarrowFrame,
iesFatFrame : Result := CreateFrameRegion(iLeft, iTop, iWidth, iHeight, Shape, Angle);
iesCircularFrame : Result := CreateCircularFrameRegion(iLeft, iTop, iWidth, iHeight, Angle);
iesPentagon : Result := _CreateCustomPolygonRegion( iesCustomShape, 5 );
iesHexagon : Result := _CreateCustomPolygonRegion( iesCustomShape, 6 );
iesHeptagon : Result := _CreateCustomPolygonRegion( iesCustomShape, 7 );
iesOctagon : Result := _CreateCustomPolygonRegion( iesCustomShape, 8 );
iesCustomShape : Result := _CreateCustomPolygonRegion( iesCustomShape, ShapeModifier );
iesCustomStar : Result := _CreateCustomPolygonRegion( iesCustomStar, ShapeModifier );
iesCustomExplosion : Result := _CreateCustomPolygonRegion( iesCustomExplosion, ShapeModifier );
iesHeart : Result := CreateHeartRegion(iLeft, iTop, iWidth, iHeight, Angle);
iesDoubleHeart : Result := CreateDoubleHeartRegion(iLeft, iTop, iWidth, iHeight, Angle);
iesMoon : Result := CreateHalfCircleRegion(iLeft, iTop, iWidth, iHeight, True, Angle);
else Result := _CreateShapeRegionEx();
end;
end;
function IECreateShapeRegion(Shape: TIEShape; ARect: TRect; MaintainAspect: TIEBooleanEx = iebDefault;
Angle: Integer = 0; ShapeModifier: Integer = 0): HRgn;
var
iLeft, iTop, iWidth, iHeight: Integer;
begin
iLeft := ARect.Left;
iTop := ARect.Top;
iWidth := ARect.Right - ARect.Left;
iHeight := ARect.Bottom - ARect.Top;
Result := IECreateShapeRegion( Shape, iLeft, iTop, iWidth, iHeight, MaintainAspect, Angle, ShapeModifier );
end;
{$ifdef IEIncludeDeprecatedInV6}
function CreateCustomShapeRegion(Shape: TXCustomShape; iLeft, iTop, iWidth, iHeight: Integer): Hrgn;
begin
case Shape of
xcsStar5 : result := IECreateShapeRegion( iesStar5 , iLeft, iTop, iWidth, iHeight, iebTrue );
xcsStar6 : result := IECreateShapeRegion( iesStar6 , iLeft, iTop, iWidth, iHeight, iebTrue );
xcsArrowNW : result := IECreateShapeRegion( iesArrowNW , iLeft, iTop, iWidth, iHeight, iebTrue );
xcsArrowNE : result := IECreateShapeRegion( iesArrowNE , iLeft, iTop, iWidth, iHeight, iebTrue );
xcsArrowSW : result := IECreateShapeRegion( iesArrowSW , iLeft, iTop, iWidth, iHeight, iebTrue );
xcsArrowSE : result := IECreateShapeRegion( iesArrowSE , iLeft, iTop, iWidth, iHeight, iebTrue );
xcsLightningLeft : result := IECreateShapeRegion( iesLightningLeft , iLeft, iTop, iWidth, iHeight, iebTrue );
xcsLightningRight : result := IECreateShapeRegion( iesLightningRight, iLeft, iTop, iWidth, iHeight, iebTrue );
xcsExplosion : result := IECreateShapeRegion( iesExplosion , iLeft, iTop, iWidth, iHeight, iebTrue );
xcsExplosion_2 : result := IECreateShapeRegion( iesExplosion , iLeft, iTop, iWidth, iHeight, iebTrue, 180 );
xcsCross : result := IECreateShapeRegion( iesCross , iLeft, iTop, iWidth, iHeight, iebTrue );
xcsArrowNW2 : result := IECreateShapeRegion( iesShootingArrowNW, iLeft, iTop, iWidth, iHeight, iebTrue );
xcsArrowNE2 : result := IECreateShapeRegion( iesShootingArrowNE, iLeft, iTop, iWidth, iHeight, iebTrue );
xcsArrowSW2 : result := IECreateShapeRegion( iesShootingArrowSW, iLeft, iTop, iWidth, iHeight, iebTrue );
xcsArrowSE2 : result := IECreateShapeRegion( iesShootingArrowSE, iLeft, iTop, iWidth, iHeight, iebTrue );
xcsHeart : result := IECreateShapeRegion( iesHeart , iLeft, iTop, iWidth, iHeight, iebTrue );
xcsDoubleHeart : result := IECreateShapeRegion( iesDoubleHeart , iLeft, iTop, iWidth, iHeight, iebTrue );
else raise Exception.create( 'Unknown shape' );
end;
end;
{$endif}
{!!
<FS>IEDrawShape
<FM>Declaration<FC>
procedure IEDrawShape(Canvas: TCanvas; Shape: <A TIEShape>; iLeft, iTop, iWidth, iHeight: Integer; MaintainAspect: <A TIEBooleanEx> = iebDefault); overload;
procedure IEDrawShape(Canvas: TCanvas; Shape: <A TIEShape>;
iLeft, iTop, iWidth, iHeight: Integer; MaintainAspect: <A TIEBooleanEx>;
BorderColor: TColor; BorderWidth: Integer;
FillColor: TColor; FillColor2: TColor = clNone; GradientDir: <A TIEGradientDir> = gdVertical
Angle: Integer = 0; ShapeModifier: Integer = 0); overload;
<FM>Description<FN>
Draw a <A TIEShape> onto a canvas at the specified size and position.
If MaintainAspect is <FC>iebDefault<FN>, then shapes are output at the aspect ratio they were designed (if <FC>iebTrue<FN> then a 1:1 aspect ratio is enforced even if it was not designed with one).
For the first overload, the Canvas Brush is used for color and fill.
For the second, the colors you specify will override the canvas brush.
<FC>Angle<FN> is the amount of rotation to apply (degrees counter-clockwise). The following shapes can only be rotated in 90 degree increments: iesHalfEllipse, iesRoundRect, iesHeart, iesDoubleHeart, iesCloud, iesMoon, iesSpeechBubble*, iesThoughtBubble*, iesFrame, iesNarrowFrame, iesFatFrame
<FC>ShapeModifier<FN> has the following effect:
<TABLE>
<R> <H>Shape</H> <H>Effect</H> <H>Range</H> <H>Default</H> </R>
<R> <C><FC>iesCustomShape<FN></C> <C> Specifies the number of sides of the shape </C> <C>3 - 50</C> <C>10</C> </R>
<R> <C><FC>iesCustomStar<FN></C> <C> Specifies the number of points of the star </C> <C>3 - 50</C> <C>10</C> </R>
<R> <C><FC>iesCustomExplosion<FN></C> <C> Specifies the number of points of the explosion </C> <C>3 - 50</C><C>12</C> </R>
<R> <C><FC>iesEllipseSegment<FN></C> <C> Specifies the width of the ellipse segment (in degrees) </C> <C>1 - 90</C> <C>45</C> </R>
</TABLE>
Note: Defined in iexCanvasUtils unit
<FM>Example<FC>
// Draw a heart onto the centre of the current image
IEDrawShape( ImageEnView1.IEBitmap.Canvas, iesExplosion, Width div 2 - 100, Height div 2 - 100, 200, 200 );
ImageEnView1.Update;
!!}
procedure IEDrawShape(Canvas: TCanvas; Shape: TIEShape; iLeft, iTop, iWidth, iHeight: Integer; MaintainAspect: TIEBooleanEx = iebDefault);
var
rgnMain: HRGN;
begin
rgnMain := IECreateShapeRegion( Shape, iLeft, iTop, iWidth, iHeight, MaintainAspect );
try
SelectClipRgn(Canvas.handle, rgnMain);
Canvas.FillRect(Rect(iLeft, iTop, iLeft + iWidth, iTop + iHeight));
SelectClipRgn(Canvas.handle, 0);
finally
DeleteObject(rgnMain);
end;
end;
procedure IEDrawShape(Canvas: TCanvas; Shape: TIEShape;
iLeft, iTop, iWidth, iHeight: Integer; MaintainAspect: TIEBooleanEx;
BorderColor: TColor; BorderWidth: Integer;
FillColor: TColor; FillColor2: TColor = clNone; GradientDir: TIEGradientDir = gdVertical;
Angle: Integer = 0; ShapeModifier: Integer = 0);
var
rgnMain: HRGN;
begin
rgnMain := IECreateShapeRegion( Shape, iLeft, iTop, iWidth, iHeight, MaintainAspect, Angle, ShapeModifier );
try
SelectClipRgn( Canvas.handle, rgnMain );
// FILL
if ( FillColor2 <> clNone ) and ( FillColor <> FillColor2 ) then
IEDrawGradient(Rect(iLeft, iTop, iLeft + iWidth, iTop + iHeight),
Canvas.handle,
FillColor, FillColor2, GradientDir = gdVertical)
else
if FillColor <> clNone then
begin
Canvas.Brush.Color := FillColor;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(Rect(iLeft, iTop, iLeft + iWidth, iTop + iHeight));
end;
// BORDER
if ( BorderColor <> clNone ) and ( BorderWidth > 0 ) then
begin
Canvas.Brush.Color := BorderColor;
Canvas.Brush.Style := bsSolid;
FrameRgn(Canvas.Handle, rgnMain, Canvas.Brush.Handle, BorderWidth, BorderWidth);
end;
SelectClipRgn(Canvas.handle, 0);
finally
DeleteObject(rgnMain);
end;
end;
{$ifdef IEIncludeDeprecatedInV6}
procedure DrawCustomShape(Canvas: TCanvas; Shape: TXCustomShape; iLeft, iTop, iWidth, iHeight: Integer);
var
rgnMain: HRGN;
begin
rgnMain := CreateCustomShapeRegion( Shape, iLeft, iTop, iWidth, iHeight );
try
SelectClipRgn(Canvas.handle, rgnMain);
Canvas.FillRect(Rect(iLeft, iTop, iLeft + iWidth, iTop + iHeight));
SelectClipRgn(Canvas.handle, 0);
finally
DeleteObject(rgnMain);
end;
end;
{$endif}
{!!
<FS>CreateWallpaperBitmap
<FM>Declaration<FC>
function CreateWallpaperBitmap(Effect : <A TWallpaperEffect>; Color1 : TColor; Color2 : TColor; iSize : Integer = -1; iSpacing : integer = -1; iThickness: Integer = -1) : TBitmap;
<FM>Description<FN>
Create a bitmap suitable for use as HTML wallpaper (i.e. which can be tiled). Result is a TBitmap if the method succeeds. You MUST FREE the bitmap.
Note: Defined in iexCanvasUtils unit
<FM>Example<FC>
// Create a checkered wallpaper image
WPBmp := CreateWallpaperBitmap( wpDiagCheckers, clRed, clWhite );
TileBitmapOntoCanvas( DestBmp.Canvas, DestBmp.Width, DestBmp.Height, WPBmp );
WPBmp.Free;
<FM>See Also<FN>
- <A TileBitmapOntoCanvas>
!!}
//
// Returns a bitmap if succesful which must be freed after usage
function CreateWallpaperBitmap(Effect : TWallpaperEffect; Color1 : TColor; Color2 : TColor; iSize : Integer = -1; iSpacing : integer = -1; iThickness: Integer = -1) : TBitmap;
const
Full_Page_Wallpaper_Width = 4000;
Full_Page_Wallpaper_Height = 3000;
Small_Width = 5;
Small_Height = 5;
procedure _InitBitmap(iWidth, iHeight : Integer);
begin
Result := TBitmap.create;
Result.PixelFormat := pf24bit;
Result.Width := iWidth;
Result.Height := iHeight;
Result.Canvas.Brush.Color := Color2;
Result.Canvas.FillRect(Rect(0, 0, iWidth, iHeight));
end;
var
I: Integer;
AShape: TIEShape;
begin
Result := nil;
case Effect of
wpSolid :
// A color fill
begin
// iSize : Not used
// iSpacing : Not used
// iThickness : Not used
_InitBitmap(Small_Width, Small_Height);
end;
wpLeftLine :
// A single line on left
begin
// iSize : Not used
// iSpacing : Not used
// iThickness : Width of line (3)
if iThickness < 1 then
iThickness := 3;
_InitBitmap(Full_Page_Wallpaper_Width, 1);
for I := 0 to iThickness - 1 do
Result.Canvas.Pixels[I, 0] := Color1;
end;
wpTopLine :
// A single line along top
begin
// iSize : Not used
// iSpacing : Not used
// iThickness : Width of line (3)
if iThickness < 1 then
iThickness := 3;
_InitBitmap(1, Full_Page_Wallpaper_Height);
for I := 0 to iThickness - 1 do
Result.Canvas.Pixels[0, I] := Color1;
end;
wpDoubleLeftLines :
// Two lines on left
begin
// iSize : Not used
// iSpacing : Space between lines (3 x iThickness)
// iThickness : Width of line (2)
if iThickness < 1 then
iThickness := 2;
if iSpacing < 1 then
iSpacing := iThickness * 3;
_InitBitmap(Full_Page_Wallpaper_Width, 1);
for I := 0 to iThickness - 1 do
begin
Result.Canvas.Pixels[I, 0] := Color1;
Result.Canvas.Pixels[I + iSpacing, 0] := Color1;
end;
end;
wpDoubleTopLines :
// Two lines along top
begin
// iSize : Not used
// iSpacing : Space between lines (3 x iThickness)
// iThickness : Width of line (2)
if iThickness < 1 then
iThickness := 2;
if iSpacing < 1 then
iSpacing := iThickness * 3;
_InitBitmap(1, Full_Page_Wallpaper_Height);
for I := 0 to iThickness - 1 do
begin
Result.Canvas.Pixels[0, I] := Color1;
Result.Canvas.Pixels[0, I + iSpacing] := Color1;
end;
end;
wpDoubleVariedLeftLines :
// Two lines of decreasing widths on left
begin
// iSize : Not used
// iSpacing : Space between lines (3 x iThickness)
// iThickness : Width of thinnest line (2)
if iThickness < 1 then
iThickness := 2;
if iSpacing < 1 then
iSpacing := iThickness * 3;
_InitBitmap(Full_Page_Wallpaper_Width, 1);
for I := 0 to iThickness - 1 do
begin
Result.Canvas.Pixels[I, 0] := Color1;
Result.Canvas.Pixels[I + iThickness, 0] := Color1;
Result.Canvas.Pixels[I + iThickness + iSpacing, 0] := Color1;
end;
end;
wpDoubleVariedTopLines :
// Two lines of decreasing widths along top
begin
// iSize : Not used
// iSpacing : Space between lines (3 x iThickness)
// iThickness : Width of thinnest line (2)
if iThickness < 1 then
iThickness := 2;
if iSpacing < 1 then
iSpacing := iThickness * 3;
_InitBitmap(1, Full_Page_Wallpaper_Height);
for I := 0 to iThickness - 1 do
begin
Result.Canvas.Pixels[0, I] := Color1;
Result.Canvas.Pixels[0, I + iThickness] := Color1;
Result.Canvas.Pixels[0, I + iThickness + iSpacing] := Color1;
end;
end;
wpTripleLeftLines :
// Three lines on left
begin
// iSize : Not used
// iSpacing : Space between lines (3 x iThickness)
// iThickness : Width of line (2)
if iThickness < 1 then
iThickness := 2;
if iSpacing < 1 then
iSpacing := iThickness * 3;
_InitBitmap(Full_Page_Wallpaper_Width, 1);
for I := 0 to iThickness - 1 do
begin
Result.Canvas.Pixels[I, 0] := Color1;
Result.Canvas.Pixels[I + iSpacing, 0] := Color1;
Result.Canvas.Pixels[I + 2 * iSpacing, 0] := Color1;
end;
end;
wpTripleTopLines :
// Three lines along top
begin
// iSize : Not used
// iSpacing : Space between lines (3 x iThickness)
// iThickness : Width of line (2)
if iThickness < 1 then
iThickness := 2;
if iSpacing < 1 then
iSpacing := iThickness * 3;
_InitBitmap(1, Full_Page_Wallpaper_Height);
for I := 0 to iThickness - 1 do
begin
Result.Canvas.Pixels[0, I] := Color1;
Result.Canvas.Pixels[0, I + iSpacing] := Color1;
Result.Canvas.Pixels[0, I + 2 * iSpacing] := Color1;
end;
end;
wpTripleVariedLeftLines :
// Three lines of decreasing widths on left
begin
// iSize : Not used
// iSpacing : Space between lines (3 x iThickness)
// iThickness : Width of thinnest line (2)
if iThickness < 1 then
iThickness := 2;
if iSpacing < 1 then
iSpacing := iThickness * 3;
_InitBitmap(Full_Page_Wallpaper_Width, 1);
for I := 0 to iThickness - 1 do
begin
// Line 1
Result.Canvas.Pixels[I, 0] := Color1;
Result.Canvas.Pixels[I + iThickness, 0] := Color1;
Result.Canvas.Pixels[I + 2 * iThickness, 0] := Color1;
// Line 2
Result.Canvas.Pixels[I + 2 * iThickness + iSpacing, 0] := Color1;
Result.Canvas.Pixels[I + 3 * iThickness + iSpacing, 0] := Color1;
// Line 3
Result.Canvas.Pixels[I + 3 * iThickness + 2 * iSpacing, 0] := Color1;
end;
end;
wpTripleVariedTopLines :
// Three lines of decreasing widths along top
begin
// iSize : Not used
// iSpacing : Not used
// iThickness : Not used
if iThickness < 1 then
iThickness := 2;
if iSpacing < 1 then
iSpacing := iThickness * 3;
_InitBitmap(1, Full_Page_Wallpaper_Height);
for I := 0 to iThickness - 1 do
begin
// Line 1
Result.Canvas.Pixels[0, I] := Color1;
Result.Canvas.Pixels[0, I + iThickness] := Color1;
Result.Canvas.Pixels[0, I + 2 * iThickness] := Color1;
// Line 2
Result.Canvas.Pixels[0, I + 2 * iThickness + iSpacing] := Color1;
Result.Canvas.Pixels[0, I + 3 * iThickness + iSpacing] := Color1;
// Line 3
Result.Canvas.Pixels[0, I + 3 * iThickness + 2 * iSpacing] := Color1;
end;
end;
wpLeftDashes :
// Short lines of a uniform sizes on left
begin
// iSize : Length of dash (18)
// iSpacing : Space between dashes (3)
// iThickness : Thickness of dashes (1)
if iSize < 1 then
iSize := 18;
if iThickness < 1 then
iThickness := 1;
if iSpacing < 1 then
iSpacing := 3;
_InitBitmap(Full_Page_Wallpaper_Width, iSpacing + iThickness);
Result.Canvas.Pen.Color := Color1;
for I := 0 to iThickness - 1 do
begin
Result.Canvas.MoveTo(0, I);
Result.Canvas.LineTo(iSize, I);
end;
end;
wpTopDashes :
// Short lines of a uniform sizes along top
begin
// iSize : Length of dash (18)
// iSpacing : Space between dashes (3)
// iThickness : Thickness of dashes (1)
if iSize < 1 then
iSize := 18;
if iThickness < 1 then
iThickness := 1;
if iSpacing < 1 then
iSpacing := 3;
_InitBitmap(iSpacing + iThickness, Full_Page_Wallpaper_Height);
Result.Canvas.Pen.Color := Color1;
for I := 0 to iThickness - 1 do
begin
Result.Canvas.MoveTo(I, 0);
Result.Canvas.LineTo(I, iSize);
end;
end;
wpDoubleLeftDashes :
// Short lines of two sizes on left
begin
// iSize : Length of longest dash (15)
// iSpacing : Space between dashes (3)
// iThickness : Thickness of dashes (1)
if iSize < 1 then
iSize := 15;
if iThickness < 1 then
iThickness := 1;
if iSpacing < 1 then
iSpacing := 3;
_InitBitmap(Full_Page_Wallpaper_Width, 2 * (iSpacing + iThickness));
Result.Canvas.Pen.Color := Color1;
for I := 0 to iThickness - 1 do
begin
// Short Line
Result.Canvas.MoveTo(0, I);
Result.Canvas.LineTo(MulDiv(iSize, 2, 3), I);
// Long Line
Result.Canvas.MoveTo(0, I + iSpacing + iThickness);
Result.Canvas.LineTo(iSize, I + iSpacing + iThickness);
end;
end;
wpDoubleTopDashes :
// Short lines of two sizes along top
begin
// iSize : Length of longest dash (15)
// iSpacing : Space between dashes (3)
// iThickness : Thickness of dashes (1)
if iSize < 1 then
iSize := 15;
if iThickness < 1 then
iThickness := 1;
if iSpacing < 1 then
iSpacing := 3;
_InitBitmap(2 * (iSpacing + iThickness), Full_Page_Wallpaper_Height);
Result.Canvas.Pen.Color := Color1;
for I := 0 to iThickness - 1 do
begin
// Short Line
Result.Canvas.MoveTo(I, 0);
Result.Canvas.LineTo(I, MulDiv(iSize, 2, 3));
// Long Line
Result.Canvas.MoveTo(I + iSpacing + iThickness, 0);
Result.Canvas.LineTo(I + iSpacing + iThickness, iSize);
end;
end;
wpTripleLeftDashes :
// Short lines of three sizes on left
begin
// iSize : Length of longest dash (15)
// iSpacing : Space between dashes (4)
// iThickness : Thickness of dashes (1)
if iSize < 1 then
iSize := 15;
if iThickness < 1 then
iThickness := 1;
if iSpacing < 1 then
iSpacing := 4;
_InitBitmap(Full_Page_Wallpaper_Width, 4 * (iSpacing + iThickness));
Result.Canvas.Pen.Color := Color1;
for I := 0 to iThickness - 1 do
begin
// Short Line
Result.Canvas.MoveTo(0, I);
Result.Canvas.LineTo(MulDiv(iSize, 1, 3), I);
// Middle Line
Result.Canvas.MoveTo(0, I + iSpacing + iThickness);
Result.Canvas.LineTo(MulDiv(iSize, 2, 3), I + iSpacing + iThickness);
// Long Line
Result.Canvas.MoveTo(0, I + 2 * (iSpacing + iThickness));
Result.Canvas.LineTo(iSize, I + 2 * (iSpacing + iThickness));
// Second Middle Line
Result.Canvas.MoveTo(0, I + 3 * (iSpacing + iThickness));
Result.Canvas.LineTo(MulDiv(iSize, 2, 3), I + 3 * (iSpacing + iThickness));
end;
end;
wpTripleTopDashes :
// Short lines of three sizes along top
begin
// iSize : Length of longest dash (15)
// iSpacing : Space between dashes (4)
// iThickness : Thickness of dashes (1)
if iSize < 1 then
iSize := 15;
if iThickness < 1 then
iThickness := 1;
if iSpacing < 1 then
iSpacing := 4;
_InitBitmap(4 * (iSpacing + iThickness), Full_Page_Wallpaper_Height);
Result.Canvas.Pen.Color := Color1;
for I := 0 to iThickness - 1 do
begin
// Short Line
Result.Canvas.MoveTo(I, 0);
Result.Canvas.LineTo(I, MulDiv(iSize, 1, 3));
// Middle Line
Result.Canvas.MoveTo(I + iSpacing + iThickness, 0);
Result.Canvas.LineTo(I + iSpacing + iThickness, MulDiv(iSize, 2, 3));
// Long Line
Result.Canvas.MoveTo(I + 2 * (iSpacing + iThickness), 0);
Result.Canvas.LineTo(I + 2 * (iSpacing + iThickness), iSize);
// Second Middle Line
Result.Canvas.MoveTo(I + 3 * (iSpacing + iThickness), 0);
Result.Canvas.LineTo(I + 3 * (iSpacing + iThickness), MulDiv(iSize, 2, 3));
end;
end;
wpLeftZigZag :
// Shark tooth pattern on left
begin
// iSize : The solid area of the border (10)
// iSpacing : The height of the "peak" (15)
// iThickness : Not used
if iSize < 1 then
iSize := 10;
if iSpacing < 1 then
iSpacing := 15;
_InitBitmap(Full_Page_Wallpaper_Width, 2 * iSpacing);
Result.Canvas.Pen.Color := Color1;
for I := 0 to 2 * iSpacing - 1 do
begin
Result.Canvas.MoveTo(0, I);
if I <= iSpacing then
Result.Canvas.LineTo(iSize + I, I)
else
Result.Canvas.LineTo(iSize + 2 * iSpacing - I, I);
end;
end;
wpTopZigZag :
// Shark tooth pattern along top
begin
// iSize : The solid area of the border (10)
// iSpacing : The height of the "peak" (15)
// iThickness : Not used
if iSize < 1 then
iSize := 10;
if iSpacing < 1 then
iSpacing := 15;
// iSize : Not used
// iSpacing : Not used
// iThickness : Not used
_InitBitmap(2 * iSpacing, Full_Page_Wallpaper_Height);
Result.Canvas.Pen.Color := Color1;
for I := 0 to 2 * iSpacing - 1 do
begin
Result.Canvas.MoveTo(I, 0);
if I <= iSpacing then
Result.Canvas.LineTo(I, iSize + I)
else
Result.Canvas.LineTo(I, iSize + 2 * iSpacing - I);
end;
end;
wpLeftGradient :
// Color gradient on left
begin
// iSize : Width of gradient area (20)
// iSpacing : Not used
// iThickness : Not used
if iSize < 1 then
iSize := 30;
_InitBitmap(Full_Page_Wallpaper_Width, Small_Height);
IEDrawGradient(Rect(0, 0, iSize, Result.Height), Result.Canvas.handle, Color1, Color2, False);
end;
wpTopGradient :
// Color gradient along top
begin
// iSize : Width of gradient area (20)
// iSpacing : Not used
// iThickness : Not used
if iSize < 1 then
iSize := 30;
_InitBitmap(Small_Width, Full_Page_Wallpaper_Height);
IEDrawGradient(Rect(0, 0, Result.Width, iSize), Result.Canvas.handle, Color1, Color2, True);
end;
wpHorzPinStripe :
// Horizontal lines across image
begin
// iSize : Not used
// iSpacing : Space between lines (10)
// iThickness : Thickness of lines (1)
if iThickness < 1 then
iThickness := 1;
if iSpacing < 1 then
iSpacing := 10;
iSize := iSpacing + iThickness;
_InitBitmap(Small_Width, iSize);
Result.Canvas.Pen.Color := Color1;
for I := 1 to iThickness do
begin
Result.Canvas.MoveTo(0, iSize - I);
Result.Canvas.LineTo(Small_Width, iSize - I);
end;
end;
wpVertPinStripe :
// Vertical lines down image
begin
// iSize : Not used
// iSpacing : Space between lines (10)
// iThickness : Thickness of lines (1)
if iThickness < 1 then
iThickness := 1;
if iSpacing < 1 then
iSpacing := 10;
iSize := iSpacing + iThickness;
_InitBitmap(iSize, Small_Height);
Result.Canvas.Pen.Color := Color1;
for I := 1 to iThickness do
begin
Result.Canvas.MoveTo(iSize - I, 0);
Result.Canvas.LineTo(iSize - I, Small_Height);
end;
end;
wpDiagPinStripe, wpDiagPinStripe2 :
// Diagonal lines across image
begin
// iSize : Not used
// iSpacing : Space between lines (20)
// iThickness : Thickness of lines. Always 1
iThickness := 1;
if iSpacing < 1 then
iSpacing := 20;
iSize := iSpacing + iThickness;
_InitBitmap(iSize, iSize);
Result.Canvas.Pen.Color := Color1;
Result.Canvas.Pen.Width := iThickness;
if Effect = wpDiagPinStripe then
begin
Result.Canvas.MoveTo(0, 0);
Result.Canvas.LineTo(iSize, iSize);
end
else
begin
Result.Canvas.MoveTo(iSize - 1, 0);
Result.Canvas.LineTo(-1, iSize);
end;
end;
wpCrossHatch :
// Horizontal and vertical lines
begin
// iSize : Not used
// iSpacing : Space between lines (14)
// iThickness : Thickness of lines (1)
if iThickness < 1 then
iThickness := 1;
if iSpacing < 1 then
iSpacing := 14;
iSize := iSpacing + iThickness;
_InitBitmap(iSize, iSize);
Result.Canvas.Pen.Color := Color1;
for I := 1 to iThickness do
begin
// Horizontal
Result.Canvas.MoveTo(0, iSize - I);
Result.Canvas.LineTo(iSize, iSize - I);
// Vertical
Result.Canvas.MoveTo(iSize - I, 0);
Result.Canvas.LineTo(iSize - I, iSize);
end;
end;
wpDiagCrossHatch :
// Diagonal lines in two directions
begin
// iSize : Not used
// iSpacing : Space between lines (25). Always odd
// iThickness : Thickness of lines. Always 1
iThickness := 1;
if iSpacing < 1 then
iSpacing := 25;
iSpacing := iSpacing div 2 * 2 + 1; // must be odd
iSize := iSpacing + iThickness;
_InitBitmap(iSize, iSize);
Result.Canvas.Pen.Color := Color1;
Result.Canvas.Pen.Width := iThickness;
Result.Canvas.MoveTo(0, 0);
Result.Canvas.LineTo(iSize, iSize);
Result.Canvas.MoveTo(iSize, 0);
Result.Canvas.LineTo(0, iSize);
end;
wpHorzStripes :
// Horizontal stripes across image
begin
// iSize : Same as two * iThickness
// iSpacing : Not used
// iThickness : Width of stripes (60)
if iThickness < 1 then
iThickness := iSize div 2;
if iThickness < 1 then
iThickness := 60;
_InitBitmap(iThickness * 2, 1);
Result.Canvas.Brush.Style := bsSolid;
Result.Canvas.Brush.Color := Color1;
Result.Canvas.FillRect(Rect(iThickness, 0, 2 * iThickness, iThickness));
end;
wpVertStripes :
// Vertical stripes down image
begin
// iSize : Same as two * iThickness
// iSpacing : Not used
// iThickness : Width of stripes (60)
if iThickness < 1 then
iThickness := iSize div 2;
if iThickness < 1 then
iThickness := 60;
_InitBitmap(1, iThickness * 2);
Result.Canvas.Brush.Style := bsSolid;
Result.Canvas.Brush.Color := Color1;
Result.Canvas.FillRect(Rect(0, iThickness, iThickness, 2 * iThickness));
end;
wpDiagStripes, wpDiagStripes2 :
// Diagonal stripes down image
begin
// iSize : Same as two * iThickness
// iSpacing : Not used
// iThickness : Width of stripes (60)
if iThickness < 1 then
iThickness := iSize div 2;
if iThickness < 1 then
iThickness := 60;
_InitBitmap(2 * iThickness, 2 * iThickness);
Result.Canvas.Pen.Style := psClear;
Result.Canvas.Brush.Style := bsSolid;
Result.Canvas.Brush.Color := Color1;
if Effect = wpDiagStripes then
begin
Result.Canvas.Polygon([ Point(0, 0),
Point(2 * iThickness, 2 * iThickness),
Point(iThickness, 2 * iThickness),
Point(0, iThickness) ]);
Result.Canvas.Polygon([ Point(iThickness, 0),
Point(2 * iThickness, 0),
Point(2 * iThickness, iThickness) ]);
end
else
begin
Result.Canvas.Polygon([ Point(2 * iThickness, 0),
Point(0, 2 * iThickness),
Point(iThickness, 2 * iThickness),
Point(2 * iThickness, iThickness) ]);
Result.Canvas.Polygon([ Point(iThickness, 0),
Point(0, 0),
Point(0, iThickness) ]);
end
end;
wpCheckers :
// Alternativing blocks of color
begin
// iSize : Same as two * iThickness
// iSpacing : Not used
// iThickness : Width of stripes (60)
if iThickness < 1 then
iThickness := iSize div 2;
if iThickness < 1 then
iThickness := 60;
_InitBitmap(iThickness * 2, iThickness * 2);
Result.Canvas.Brush.Style := bsSolid;
Result.Canvas.Brush.Color := Color1;
Result.Canvas.FillRect(Rect(iThickness, 0, 2 * iThickness, iThickness));
Result.Canvas.FillRect(Rect(0, iThickness, iThickness, 2 * iThickness));
end;
wpDiagCheckers :
// Alternativing diagonal blocks of color
begin
// iSize : Same as two * iThickness
// iSpacing : Not used
// iThickness : Width of stripes (60)
if iThickness < 1 then
iThickness := iSize div 2;
if iThickness < 1 then
iThickness := 60;
_InitBitmap(iThickness * 2, iThickness * 2);
Result.Canvas.Pen.Style := psSolid;
Result.Canvas.Pen.Color := Color1;
Result.Canvas.Brush.Style := bsSolid;
Result.Canvas.Brush.Color := Color1;
Result.Canvas.Polygon([ Point(iThickness, 0),
Point(2 * iThickness, iThickness),
Point(iThickness, 2 * iThickness),
Point(0, iThickness) ]);
end;
wpRain, wpRain2 :
// Diagonal dashes
begin
// iSize : Not used
// iSpacing : Space between dashes (20)
// iThickness : Thickness of dashes (5)
if iThickness < 1 then
iThickness := 5;
if iSpacing < 1 then
iSpacing := 20;
iSize := iSpacing + iThickness;
_InitBitmap(iSize, iSize);
Result.Canvas.Pen.Color := Color1;
Result.Canvas.Pen.Width := iThickness;
if Effect = wpRain then
begin
Result.Canvas.MoveTo(MulDiv(iSize, 1, 5), MulDiv(iSize, 1, 5));
Result.Canvas.LineTo(MulDiv(iSize, 4, 5), MulDiv(iSize, 4, 5));
end
else
begin
Result.Canvas.MoveTo(MulDiv(iSize, 4, 5), MulDiv(iSize, 1, 5));
Result.Canvas.LineTo(MulDiv(iSize, 1, 5), MulDiv(iSize, 4, 5));
end
end;
wpRivets :
// Circles over page
begin
// iSize : Size of circle, Min: 4 (5)
// iSpacing : Spacing between shapes, Min: iSize Div 2 (3)
// iThickness : not used
if iSize < 1 then
iSize := 5;
if iSize < 4 then
iSize := 4;
if iSpacing < 1 then
iSpacing := 3;
if iSpacing < iSize div 2 + 1 then
iSpacing := iSize div 2 + 1;
_InitBitmap(2 * iSpacing + 2 * iSize , 2 * iSize);
Result.Canvas.Pen.Style := psClear;
Result.Canvas.Brush.Style := bsClear;
Result.Canvas.Brush.Color := Color1;
Result.Canvas.Ellipse(iSpacing, 0,
iSpacing + iSize, iSize);
Result.Canvas.Ellipse(2 * iSpacing + iSize, iSize,
2 * iSpacing + 2 * iSize, 2 * iSize);
end;
wpHearts :
// Hearts over page
begin
// iSize : Size of heart, Min: 5 (78)
// iSpacing : Spacing between shapes, Min: iSize Div 2 (5)
// iThickness : not used
if iSize < 1 then
iSize := 78;
if iSize < 4 then
iSize := 4;
if iSpacing < 1 then
iSpacing := 5;
if iSpacing < iSize div 2 + 1 then
iSpacing := iSize div 2 + 1;
_InitBitmap(2 * iSpacing + 2 * iSize , 2 * iSize);
Result.Canvas.Pen.Style := psClear;
Result.Canvas.Brush.Style := bsClear;
Result.Canvas.Brush.Color := Color1;
IEDrawShape(Result.Canvas, iesHeart, iSpacing, 0, iSize, iSize);
IEDrawShape(Result.Canvas, iesHeart, 2 * iSpacing + iSize, iSize, iSize, iSize);
end;
wpStars , // Stars over page
wpLightning : // Lightning over page
begin
// iSize : Size of star/lightning, Min: 5 (50)
// iSpacing : Spacing between shapes (10)
// iThickness : not used
if iSize < 1 then
iSize := 50;
if iSize < 5 then
iSize := 5;
if iSpacing < 1 then
iSpacing := 10;
_InitBitmap(iSize + iSpacing, iSize + iSpacing);
Result.Canvas.Pen.Style := psClear;
Result.Canvas.Brush.Style := bsClear;
Result.Canvas.Brush.Color := Color1;
if Effect = wpStars then
AShape := iesStar5
else
AShape := iesLightningLeft;
IEDrawShape(Result.Canvas, AShape, iSpacing div 2, iSpacing div 2, iSize, iSize);
end;
wpRuledPage:
// Similar to standard ruled page (with red line along side)
begin
// iSize : Not used
// iSpacing : Space between lines (24)
// iThickness : Thickness of lines (1)
if iThickness < 1 then
iThickness := 1;
if iSpacing < 1 then
iSpacing := 24;
iSize := iSpacing + iThickness;
_InitBitmap(Full_Page_Wallpaper_Width, iSize);
Result.Canvas.Pen.Color := Color1;
for I := 1 to iThickness do
begin
Result.Canvas.MoveTo(0, iSize - I);
Result.Canvas.LineTo(Full_Page_Wallpaper_Width, iSize - I);
end;
Result.Canvas.Pen.Color := clRed;
for I := 1 to iThickness do
begin
Result.Canvas.MoveTo(iSpacing * 3 + I, 0);
Result.Canvas.LineTo(iSpacing * 3 + I, iSize);
end;
end;
end;
end;
{!!
<FS>TileBitmapOntoCanvas
<FM>Declaration<FC>
Procedure TileBitmapOntoCanvas(Canvas : TCanvas; iWidth, iHeight : Integer; Bitmap : TBitmap); overload;
Procedure TileBitmapOntoCanvas(Canvas : TCanvas; iWidth, iHeight : Integer; Graphic : TGraphic); overload;
<FM>Description<FN>
Fill the canvas by tiling the specified bitmap (i.e. for wallpaper type effects)
Note: Defined in iexCanvasUtils unit
<FM>Example<FC>
// Create a checkered wallpaper image
WPBmp := CreateWallpaperBitmap( wpDiagCheckers, clRed, clWhite );
TileBitmapOntoCanvas( DestBmp.Canvas, DestBmp.Width, DestBmp.Height, WPBmp );
WPBmp.Free;
<FM>See Also<FN>
- <A CreateWallpaperBitmap>
!!}
//
Procedure TileBitmapOntoCanvas(Canvas : TCanvas; iWidth, iHeight : Integer; Bitmap : TBitmap);
var
X, Y: LongInt;
begin
if not assigned( Bitmap ) or ( Bitmap.Width = 0 ) or ( Bitmap.Height = 0 ) then
exit;
Y := 0;
while Y < iHeight do
begin
X := 0;
while X < iWidth do
begin
Canvas.Draw( X, Y, Bitmap );
Inc( X, Bitmap.Width );
end;
Inc( Y, Bitmap.Height );
end;
end;
//
Procedure TileBitmapOntoCanvas(Canvas : TCanvas; iWidth, iHeight : Integer; Graphic : TGraphic);
var
X, Y: LongInt;
begin
if not assigned( Graphic ) or ( Graphic.Width = 0 ) or ( Graphic.Height = 0 ) then
exit;
Y := 0;
while Y < iHeight do
begin
X := 0;
while X < iWidth do
begin
Canvas.Draw( X, Y, Graphic );
Inc( X, Graphic.Width );
end;
Inc( Y, Graphic.Height );
end;
end;
function ShapeToString(Shape: TIEShape): string;
begin
Result := '';
case Shape of
iesEllipse : Result := 'Ellipse';
iesHalfEllipse : Result := 'Half Ellipse';
iesQuarterEllipse : Result := 'Quarter Ellipse';
iesEllipseSegment : Result := 'Ellipse Segment';
iesRectangle : Result := 'Rectangle';
iesRoundRect : Result := 'Round Rectangle';
iesTriangle : Result := 'Triangle';
iesCorner : Result := 'Corner';
iesDiamond : Result := 'Diamond';
iesPentagon : Result := 'Pentagon';
iesHexagon : Result := 'Hexagon';
iesHeptagon : Result := 'Heptagon';
iesOctagon : Result := 'Octagon';
iesCustomShape : Result := 'Custom Shape';
iesStar5 : Result := '5-Point Star';
iesStar6 : Result := '6-Point Star';
iesCustomStar : Result := 'Custom Star';
iesArrowLeft : Result := 'Arrow Left';
iesArrowRight : Result := 'Arrow Right';
iesArrowUp : Result := 'Arrow Up';
iesArrowDown : Result := 'Arrow Down';
iesArrowLeftRight : Result := 'Arrow Left and Right';
iesArrowUpDown : Result := 'Arrow Up and Down';
iesArrowNW : Result := 'Arrow NW';
iesArrowNE : Result := 'Arrow NE';
iesArrowSW : Result := 'Arrow SW';
iesArrowSE : Result := 'Arrow SE';
iesFatArrowLeft : Result := 'Fat Arrow Left';
iesFatArrowRight : Result := 'Fat Arrow Right';
iesFatArrowUp : Result := 'Fat Arrow Up';
iesFatArrowDown : Result := 'Fat Arrow Down';
iesShootingArrowNW : Result := 'Shooting Arrow NW';
iesShootingArrowNE : Result := 'Shooting Arrow NE';
iesShootingArrowSW : Result := 'Shooting Arrow SW';
iesShootingArrowSE : Result := 'Shooting Arrow SE';
iesLightningLeft : Result := 'Lightning Left';
iesLightningRight : Result := 'Lightning Right';
iesExplosion : Result := 'Explosion';
iesCustomExplosion : Result := 'Custom Explosion';
iesCross : Result := 'Cross';
iesHeart : Result := 'Heart';
iesDoubleHeart : Result := 'Double Heart';
iesCloud : Result := 'Cloud';
iesMoon : Result := 'Moon';
iesSpeechBubbleLeftInShort : Result := 'Small Left Speech Bubble In';
iesSpeechBubbleLeftOutShort : Result := 'Small Left Speech Bubble Out';
iesSpeechBubbleRightInShort : Result := 'Small Right Speech Bubble In';
iesSpeechBubbleRightOutShort : Result := 'Small Right Speech Bubble Out';
iesSpeechBubbleLeftInLong : Result := 'Wide Left Speech Bubble In';
iesSpeechBubbleLeftOutLong : Result := 'Wide Left Speech Bubble Out';
iesSpeechBubbleRightInLong : Result := 'Wide Right Speech Bubble In';
iesSpeechBubbleRightOutLong : Result := 'Wide Right Speech Bubble Out';
iesThoughtBubbleLeft : Result := 'Left Thought Bubble';
iesThoughtBubbleRight : Result := 'Right Thought Bubble';
iesShield : Result := 'Shield';
iesBadge : Result := 'Badge';
iesNamePlate : Result := 'NamePlate';
iesFrame : Result := 'Frame';
iesNarrowFrame : Result := 'Narrow Frame';
iesFatFrame : Result := 'Fat Frame';
iesCircularFrame : Result := 'Circular Frame';
end;
end;
{
Example usage:
procedure Tfmain.cmbShapeDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
IEDrawShapeToComboListBoxItem( TComboBox( Control ).Canvas, Rect, Control.Enabled, TIEShape( Index ), clRed );
end;
}
procedure IEDrawShapeToComboListBoxItem(ControlCanvas : TCanvas;
CanvasRect : TRect;
ControlEnabled : Boolean;
Shape: TIEShape;
Color: TColor;
ShowText : Boolean= True);
const
DRAW_SHAPE_MARGIN = 3;
DRAW_SHAPE_TEXT_MARGIN = 3;
var
textX : Integer;
textY : Integer;
shapeX : Integer;
shapeY : Integer;
shapeSize: Integer;
Text: string;
begin
Text := ShapeToString( Shape );
shapeSize := min( CanvasRect.Right - CanvasRect.Left - 2 * DRAW_SHAPE_MARGIN, CanvasRect.Bottom - CanvasRect.Top - 2 * DRAW_SHAPE_MARGIN );
textX := DRAW_SHAPE_MARGIN + shapeSize + DRAW_SHAPE_TEXT_MARGIN;
textY := ((CanvasRect.Bottom - CanvasRect.Top) - ControlCanvas.TextHeight(Text)) div 2;
shapeX := DRAW_SHAPE_MARGIN;
shapeY := ((CanvasRect.Bottom - CanvasRect.Top) - shapeSize) div 2;
ControlCanvas.FillRect( CanvasRect );
// is it enabled?
if ControlEnabled = False then
ControlCanvas.font.color := clGrayText;
ControlCanvas.TextOut( CanvasRect.left + textX, CanvasRect.top + textY, Text);
if ControlEnabled then
ControlCanvas.Brush.Color := Color
else
ControlCanvas.Brush.Color := clGrayText;
ControlCanvas.Brush.Style := bsSolid;
IEDrawShape( ControlCanvas, Shape, CanvasRect.left + shapeX, CanvasRect.Top + shapeY, shapeSize, shapeSize );
end;
end.
Reference in New Issue View Git Blame Copy Permalink