1
0
mirror of synced 2024-11-14 23:13:50 +00:00
x2cl/Source/X2CLGraphics.pas
Mark van Renswoude 18b17e3487 Added: image index to graphiclist editor
Added: gradient support to unaMenuBarPainter
Added: ImageOffset support to unaMenuBarPainter
2008-06-06 14:22:00 +00:00

367 lines
9.9 KiB
ObjectPascal

{
:: Implements various graphics-related classes and functions.
::
:: Part of the X2Software Component Library
:: http://www.x2software.net/
::
:: Last changed: $Date$
:: Revision: $Rev$
:: Author: $Author$
}
unit X2CLGraphics;
interface
uses
Classes,
Graphics,
Windows;
type
TX2Color32 = type TColor;
TDrawTextClipStyle = (csNone, csEllipsis, csPathEllipsis);
{$IFNDEF VER180}
TVerticalAlignment = (taTop, taBottom, taVerticalCenter);
{$ENDIF}
PRGBAArray = ^TRGBAArray;
TRGBAArray = array[Word] of TRGBQuad;
function Color32(AColor: TColor; AAlpha: Byte = 255): TX2Color32;
function DelphiColor(AColor: TX2Color32): TColor;
function RedValue(AColor: TX2Color32): Byte;
function GreenValue(AColor: TX2Color32): Byte;
function BlueValue(AColor: TX2Color32): Byte;
function AlphaValue(AColor: TX2Color32): Byte;
function Blend(ABackground: TColor; AForeground: TX2Color32): TColor;
{
:$ Provides a wrapper for the DrawText API.
}
procedure DrawText(ACanvas: TCanvas; const AText: String;
const ABounds: TRect;
AHorzAlignment: TAlignment = taLeftJustify;
AVertAlignment: TVerticalAlignment = taVerticalCenter;
AMultiLine: Boolean = False;
AClipStyle: TDrawTextClipStyle = csNone);
{
:$ Returns a pointer to the first physical scanline.
:: In bottom-up bitmaps, the most common kind, the Scanline property
:: compensates for this by returning the last physical row for Scanline[0];
:: the first visual row. For most effects, the order in which the rows are
:: processed is not important; speed is. This function returns the first
:: physical scanline, which can be used as a single big array for the whole
:: bitmap.
:! Note that every scanline is padded until it is a multiple of 4 bytes
:! (32 bits). For true lineair access, ensure the bitmap has a PixelFormat
:! of pf32bit.
}
function GetScanlinePointer(ABitmap: Graphics.TBitmap): Pointer;
{
:$ Wrapper for DrawFocusRect.
:: Ensures the canvas is set up correctly for a standard focus rectangle.
}
procedure DrawFocusRect(ACanvas: TCanvas; const ABounds: TRect);
{
:$ Draws one bitmap over another with the specified Alpha transparency.
:: Both bitmaps must be the same size.
}
procedure DrawBlended(ABackground, AForeground: Graphics.TBitmap; AAlpha: Byte);
{
:$ Draws a rectangle with a vertical gradient.
}
procedure GradientFillRect(ACanvas: TCanvas; ARect: TRect; AStartColor, AEndColor: TColor);
{
:$ Darkens a color with the specified value
}
function DarkenColor(const AColor: TColor; const AValue: Byte): TColor;
{
:$ Lightens a color with the specified value
}
function LightenColor(const AColor: TColor; const AValue: Byte): TColor;
implementation
function Color32(AColor: TColor; AAlpha: Byte): TX2Color32;
begin
Result := (ColorToRGB(AColor) and $00FFFFFF) or (AAlpha shl 24);
end;
function DelphiColor(AColor: TX2Color32): TColor;
begin
Result := (AColor and $00FFFFFF);
end;
function RedValue(AColor: TX2Color32): Byte;
begin
Result := (AColor and $000000FF);
end;
function GreenValue(AColor: TX2Color32): Byte;
begin
Result := (AColor and $0000FF00) shr 8;
end;
function BlueValue(AColor: TX2Color32): Byte;
begin
Result := (AColor and $00FF0000) shr 16;
end;
function AlphaValue(AColor: TX2Color32): Byte;
begin
Result := (AColor and $FF000000) shr 24;
end;
function Blend(ABackground: TColor; AForeground: TX2Color32): TColor;
var
backColor: TX2Color32;
backAlpha: Integer;
foreAlpha: Integer;
begin
foreAlpha := AlphaValue(AForeground);
if foreAlpha = 0 then
Result := ABackground
else if foreAlpha = 255 then
Result := DelphiColor(AForeground)
else
begin
backColor := Color32(ABackground);
backAlpha := 256 - foreAlpha;
Result := RGB(((RedValue(backColor) * backAlpha) +
(RedValue(AForeground) * foreAlpha)) shr 8,
((GreenValue(backColor) * backAlpha) +
(GreenValue(AForeground) * foreAlpha)) shr 8,
((BlueValue(backColor) * backAlpha) +
(BlueValue(AForeground) * foreAlpha)) shr 8);
end;
end;
procedure DrawText(ACanvas: TCanvas; const AText: String;
const ABounds: TRect; AHorzAlignment: TAlignment;
AVertAlignment: TVerticalAlignment;
AMultiLine: Boolean; AClipStyle: TDrawTextClipStyle);
const
HorzAlignmentFlags: array[TAlignment] of Cardinal =
(DT_LEFT, DT_RIGHT, DT_CENTER);
VertAlignmentFlags: array[TVerticalAlignment] of Cardinal =
(DT_TOP, DT_BOTTOM, DT_VCENTER);
MultiLineFlags: array[Boolean] of Cardinal =
(DT_SINGLELINE, 0);
ClipStyleFlags: array[TDrawTextClipStyle] of Cardinal =
(0, DT_END_ELLIPSIS, DT_PATH_ELLIPSIS);
var
flags: Cardinal;
bounds: TRect;
begin
flags := HorzAlignmentFlags[AHorzAlignment] or
VertAlignmentFlags[AVertAlignment] or
MultiLineFlags[AMultiLine] or
ClipStyleFlags[AClipStyle];
if AMultiLine and (AClipStyle <> csNone) then
flags := flags or DT_EDITCONTROL;
bounds := ABounds;
Windows.DrawText(ACanvas.Handle, PChar(AText), Length(AText), bounds, flags);
end;
function GetScanlinePointer(ABitmap: Graphics.TBitmap): Pointer;
var
firstScanline: Pointer;
lastScanline: Pointer;
begin
firstScanline := ABitmap.ScanLine[0];
lastScanline := ABitmap.ScanLine[Pred(ABitmap.Height)];
if Cardinal(firstScanline) > Cardinal(lastScanline) then
Result := lastScanline
else
Result := firstScanline;
end;
procedure DrawFocusRect(ACanvas: TCanvas; const ABounds: TRect);
begin
SetTextColor(ACanvas.Handle, ColorToRGB(clBlack));
Windows.DrawFocusRect(ACanvas.Handle, ABounds);
end;
procedure DrawBlended(ABackground, AForeground: Graphics.TBitmap; AAlpha: Byte);
var
sourcePixels: PRGBAArray;
destPixels: PRGBAArray;
sourcePixel: PRGBQuad;
pixelCount: Integer;
pixelIndex: Integer;
backAlpha: Integer;
foreAlpha: Integer;
begin
backAlpha := AAlpha;
foreAlpha := 256 - AAlpha;
pixelCount := AForeground.Width * AForeground.Height;
sourcePixels := GetScanlinePointer(AForeground);
destPixels := GetScanlinePointer(ABackground);
for pixelIndex := Pred(pixelCount) downto 0 do
with destPixels^[pixelIndex] do
begin
sourcePixel := @sourcePixels^[pixelIndex];
rgbRed := ((rgbRed * backAlpha) +
(sourcePixel^.rgbRed * foreAlpha)) shr 8;
rgbGreen := ((rgbGreen * backAlpha) +
(sourcePixel^.rgbGreen * foreAlpha)) shr 8;
rgbBlue := ((rgbBlue * backAlpha) +
(sourcePixel^.rgbBlue * foreAlpha)) shr 8;
end;
end;
procedure GradientFillRect(ACanvas: TCanvas; ARect: TRect; AStartColor, AEndColor: TColor);
function FixValue(AValue: Single): Single;
begin
Result := AValue;
if Result < 0 then
Result := 0;
if Result > 255 then
Result := 255;
end;
var
startColor: Cardinal;
endColor: Cardinal;
stepCount: Integer;
redValue: Single;
greenValue: Single;
blueValue: Single;
redStep: Single;
greenStep: Single;
blueStep: Single;
line: Integer;
begin
startColor := ColorToRGB(AStartColor);
endColor := ColorToRGB(AEndColor);
if startColor = endColor then
begin
ACanvas.Brush.Style := bsSolid;
ACanvas.Brush.Color := startColor;
ACanvas.FillRect(ARect);
end else
begin
redValue := GetRValue(startColor);
greenValue := GetGValue(startColor);
blueValue := GetBValue(startColor);
stepCount := ARect.Bottom - ARect.Top;
redStep := (GetRValue(endColor) - redValue) / stepCount;
greenStep := (GetGValue(endColor) - greenValue) / stepCount;
blueStep := (GetBValue(endColor) - blueValue) / stepCount;
ACanvas.Pen.Style := psSolid;
for line := ARect.Top to ARect.Bottom do
begin
ACanvas.Pen.Color := RGB(Trunc(redValue), Trunc(greenValue), Trunc(blueValue));
ACanvas.MoveTo(ARect.Left, line);
ACanvas.LineTo(ARect.Right, line);
redValue := FixValue(redValue + redStep);
greenValue := FixValue(greenValue + greenStep);
blueValue := FixValue(blueValue + blueStep);
end;
end;
end;
function DarkenColor(const AColor: TColor; const AValue: Byte): TColor;
var
cColor: Cardinal;
iRed: Integer;
iGreen: Integer;
iBlue: Integer;
begin
cColor := ColorToRGB(AColor);
iRed := (cColor and $FF0000) shr 16;;
iGreen := (cColor and $00FF00) shr 8;
iBlue := cColor and $0000FF;
Dec(iRed, AValue);
Dec(iGreen, AValue);
Dec(iBlue, AValue);
if iRed < 0 then iRed := 0;
if iGreen < 0 then iGreen := 0;
if iBlue < 0 then iBlue := 0;
Result := (iRed shl 16) + (iGreen shl 8) + iBlue;
end;
function LightenColor(const AColor: TColor; const AValue: Byte): TColor;
var
cColor: Cardinal;
iRed: Integer;
iGreen: Integer;
iBlue: Integer;
begin
cColor := ColorToRGB(AColor);
iRed := (cColor and $FF0000) shr 16;;
iGreen := (cColor and $00FF00) shr 8;
iBlue := cColor and $0000FF;
Inc(iRed, AValue);
Inc(iGreen, AValue);
Inc(iBlue, AValue);
if iRed > 255 then iRed := 255;
if iGreen > 255 then iGreen := 255;
if iBlue > 255 then iBlue := 255;
Result := (iRed shl 16) + (iGreen shl 8) + iBlue;
end;
end.