lazmapviewer: Add new drawingengine based on BGRABitmap. Kindly provided by forum user jc99 (https://forum.lazarus.freepascal.org/index.php/topic,47164.msg337229.html#msg337229).
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7169 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
parent
7e20dce069
commit
28f7fccd9f
@ -26,16 +26,19 @@
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes Count="0"/>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="3">
|
||||
<RequiredPackages Count="4">
|
||||
<Item1>
|
||||
<PackageName Value="lazmapviewer_rgbgraphics"/>
|
||||
<PackageName Value="lazmapviewer_bgra"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="lazMapViewerPkg"/>
|
||||
<PackageName Value="lazmapviewer_rgbgraphics"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="LCL"/>
|
||||
<PackageName Value="lazMapViewerPkg"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item4>
|
||||
</RequiredPackages>
|
||||
<Units Count="4">
|
||||
<Unit0>
|
||||
|
||||
@ -569,6 +569,7 @@ object MainForm: TMainForm
|
||||
Items.Strings = (
|
||||
'default'
|
||||
'RGBGraphics'
|
||||
'BGRABitmap'
|
||||
)
|
||||
OnChange = CbDrawingEngineChange
|
||||
Style = csDropDownList
|
||||
@ -771,7 +772,7 @@ object MainForm: TMainForm
|
||||
Left = 6
|
||||
Height = 25
|
||||
Top = 216
|
||||
Width = 92
|
||||
Width = 93
|
||||
AutoSize = True
|
||||
BorderSpacing.Top = 8
|
||||
Caption = 'POI text font'
|
||||
@ -785,10 +786,10 @@ object MainForm: TMainForm
|
||||
AnchorSideTop.Side = asrCenter
|
||||
AnchorSideRight.Control = CbDrawingEngine
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 153
|
||||
Left = 154
|
||||
Height = 22
|
||||
Top = 217
|
||||
Width = 108
|
||||
Width = 107
|
||||
NoneColorColor = clWhite
|
||||
Style = [cbStandardColors, cbExtendedColors, cbIncludeNone, cbCustomColor, cbPrettyNames, cbCustomColors]
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
@ -802,7 +803,7 @@ object MainForm: TMainForm
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = BtnPOITextFont
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 106
|
||||
Left = 107
|
||||
Height = 15
|
||||
Top = 221
|
||||
Width = 39
|
||||
|
||||
@ -8,7 +8,7 @@ uses
|
||||
Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs,
|
||||
ExtCtrls, StdCtrls, ComCtrls, Buttons, IntfGraphics, ColorBox,
|
||||
mvGeoNames, mvMapViewer, mvTypes, mvGpsObj, mvDrawingEngine,
|
||||
mvDE_RGBGraphics;
|
||||
mvDE_RGBGraphics, mvDE_BGRA;
|
||||
|
||||
type
|
||||
|
||||
@ -101,6 +101,7 @@ type
|
||||
|
||||
private
|
||||
FRGBGraphicsDrawingEngine: TMvRGBGraphicsDrawingEngine;
|
||||
FBGRADrawingEngine: TMvBGRADrawingEngine;
|
||||
POIImage: TCustomBitmap;
|
||||
procedure ClearFoundLocations;
|
||||
procedure UpdateCoords(X, Y: Integer);
|
||||
@ -122,7 +123,7 @@ implementation
|
||||
{$R *.lfm}
|
||||
|
||||
uses
|
||||
LCLType, IniFiles, Math, FPCanvas, FPImage, FpImgCanv, GraphType,
|
||||
LCLType, IniFiles, Math, FPCanvas, FPImage, GraphType,
|
||||
mvEngine, mvGPX,
|
||||
globals, gpslistform;
|
||||
|
||||
@ -260,6 +261,11 @@ begin
|
||||
FRGBGraphicsDrawingEngine := TMvRGBGraphicsDrawingEngine.Create(self);
|
||||
MapView.DrawingEngine := FRGBGraphicsDrawingEngine;
|
||||
end;
|
||||
2: begin
|
||||
if FBGRADrawingEngine = nil then
|
||||
FBGRADrawingEngine := TMvBGRADrawingEngine.Create(self);
|
||||
MapView.DrawingEngine := FBGRADrawingEngine;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
45
components/lazmapviewer/lazmapviewer_bgra.lpk
Normal file
45
components/lazmapviewer/lazmapviewer_bgra.lpk
Normal file
@ -0,0 +1,45 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<PathDelim Value="\"/>
|
||||
<Name Value="lazmapviewer_bgra"/>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value="source\addons\bgra_drawingengine"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
<Files Count="1">
|
||||
<Item1>
|
||||
<Filename Value="source\addons\bgra_drawingengine\mvde_bgra.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="mvDE_BGRA"/>
|
||||
</Item1>
|
||||
</Files>
|
||||
<RequiredPkgs Count="3">
|
||||
<Item1>
|
||||
<PackageName Value="BGRABitmapPack"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="lazMapViewerPkg"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item3>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<OpenInFileMan Value="True"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<CustomOptions Items="ExternHelp" Version="2">
|
||||
<_ExternHelp Items="Count"/>
|
||||
</CustomOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
22
components/lazmapviewer/lazmapviewer_bgra.pas
Normal file
22
components/lazmapviewer/lazmapviewer_bgra.pas
Normal file
@ -0,0 +1,22 @@
|
||||
{ This file was automatically created by Lazarus. Do not edit!
|
||||
This source is only used to compile and install the package.
|
||||
}
|
||||
|
||||
unit lazmapviewer_bgra;
|
||||
|
||||
{$warn 5023 off : no warning about unused units}
|
||||
interface
|
||||
|
||||
uses
|
||||
mvDE_BGRA, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('mvDE_BGRA', @mvDE_BGRA.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPackage('lazmapviewer_bgra', @Register);
|
||||
end.
|
||||
@ -0,0 +1,390 @@
|
||||
unit mvDE_BGRA;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Types, Graphics, IntfGraphics,
|
||||
mvDrawingEngine,
|
||||
BGRAGraphics, BGRABitmap;
|
||||
|
||||
type
|
||||
|
||||
{ TMvBGRADrawingEngine }
|
||||
|
||||
TMvBGRADrawingEngine = class(TMvCustomDrawingEngine)
|
||||
private
|
||||
FBuffer: TBGRABitmap;
|
||||
FBrushStyle: TBrushStyle;
|
||||
FFontName: String;
|
||||
FFontColor: TColor;
|
||||
FFontSize: Integer;
|
||||
FFontStyle: TFontStyles;
|
||||
protected
|
||||
function GetBrushColor: TColor; override;
|
||||
function GetBrushStyle: TBrushStyle; override;
|
||||
function GetFontColor: TColor; override;
|
||||
function GetFontName: String; override;
|
||||
function GetFontSize: Integer; override;
|
||||
function GetFontStyle: TFontStyles; override;
|
||||
function GetPenColor: TColor; override;
|
||||
function GetPenWidth: Integer; override;
|
||||
procedure SetBrushColor(AValue: TColor); override;
|
||||
procedure SetBrushStyle(AValue: TBrushStyle); override;
|
||||
procedure SetFontColor(AValue: TColor); override;
|
||||
procedure SetFontName(AValue: String); override;
|
||||
procedure SetFontSize(AValue: Integer); override;
|
||||
procedure SetFontStyle(AValue: TFontStyles); override;
|
||||
procedure SetPenColor(AValue: TColor); override;
|
||||
procedure SetPenWidth(AValue: Integer); override;
|
||||
|
||||
public
|
||||
destructor Destroy; override;
|
||||
procedure CreateBuffer(AWidth, AHeight: Integer); override;
|
||||
procedure DrawBitmap(X, Y: Integer; ABitmap: TCustomBitmap;
|
||||
UseAlphaChannel: Boolean); override;
|
||||
procedure DrawLazIntfImage(X, Y: Integer; AImg: TLazIntfImage); override;
|
||||
procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
|
||||
procedure FillRect(X1, Y1, X2, Y2: Integer); override;
|
||||
procedure Line(X1, Y1, X2, Y2: Integer); override;
|
||||
procedure PaintToCanvas(ACanvas: TCanvas); override;
|
||||
procedure Rectangle(X1, Y1, X2, Y2: Integer); override;
|
||||
function SaveToImage(AClass: TRasterImageClass): TRasterImage; override;
|
||||
function TextExtent(const AText: String): TSize; override;
|
||||
procedure TextOut(X, Y: Integer; const AText: String); override;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
GraphType, LCLType, FPImage,
|
||||
mvTypes;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents(PALETTE_PAGE, [TMvBGRADrawingEngine]);
|
||||
end;
|
||||
|
||||
destructor TMvBGRADrawingEngine.Destroy;
|
||||
begin
|
||||
FBuffer.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TMvBGRADrawingEngine.CreateBuffer(AWidth, AHeight: Integer);
|
||||
begin
|
||||
FreeAndNil(FBuffer);
|
||||
FBuffer := TBGRABitmap.Create(AWidth, AHeight);
|
||||
end;
|
||||
|
||||
procedure TMvBGRADrawingEngine.DrawBitmap(X,Y: Integer;
|
||||
ABitmap: TCustomBitmap; UseAlphaChannel: Boolean);
|
||||
var
|
||||
intfImg: TLazIntfImage;
|
||||
i, j: Integer;
|
||||
cimg, cbuf: TFPColor;
|
||||
alpha: Double;
|
||||
begin
|
||||
intfImg := ABitmap.CreateIntfImage;
|
||||
try
|
||||
if UseAlphaChannel then begin
|
||||
for j := 0 to intfImg.Height - 1 do
|
||||
for i := 0 to intfImg.Width - 1 do begin
|
||||
cimg := intfImg.Colors[i, j];
|
||||
alpha := cimg.Alpha / word($FFFF);
|
||||
cbuf := TColorToFPColor(FBuffer.CanvasBGRA.GetPixelColor(i + X, j + Y));
|
||||
cbuf.Red := Round(alpha * cimg.Red + (1 - alpha) * cbuf.Red);
|
||||
cbuf.Green := Round(alpha * cimg.Green + (1 - alpha) * cbuf.Green);
|
||||
cbuf.Blue := Round(alpha * cimg.Blue + (1 - alpha) * cbuf.Blue);
|
||||
FBuffer.CanvasBGRA.SetPixelColor(i + X, j + Y, FPColorToTColor(cbuf));
|
||||
end;
|
||||
end else
|
||||
for j := 0 to intfImg.Height - 1 do
|
||||
for i := 0 to intfImg.Width - 1 do
|
||||
FBuffer.CanvasBGRA.SetPixelColor(i + X, j + Y, FPColorToTColor(intfImg.Colors[i, j]));
|
||||
finally
|
||||
intfimg.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMvBGRADrawingEngine.DrawLazIntfImage(X, Y: Integer;
|
||||
AImg: TLazIntfImage);
|
||||
//http://mantis.freepascal.org/view.php?id=27144
|
||||
var
|
||||
temp: TBGRABitmap;
|
||||
rawImg: TRawImage;
|
||||
intfImg: TLazIntfImage;
|
||||
begin
|
||||
temp:=TBGRABitmap.Create(AImg);
|
||||
try
|
||||
FBuffer.CanvasBGRA.Draw(x,y,temp);
|
||||
finally
|
||||
freeandnil(temp);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMvBGRADrawingEngine.Ellipse(X1, Y1, X2, Y2: Integer);
|
||||
begin
|
||||
FBuffer.CanvasBGRA.Ellipse(X1, Y1, X2, Y2);
|
||||
end;
|
||||
|
||||
procedure TMvBGRADrawingEngine.FillRect(X1, Y1, X2, Y2: Integer);
|
||||
begin
|
||||
FBuffer.CanvasBGRA.FillRect(X1, Y1, X2, Y2);
|
||||
end;
|
||||
|
||||
function TMvBGRADrawingEngine.GetBrushColor: TColor;
|
||||
begin
|
||||
Result := FBuffer.CanvasBGRA.Brush.Color;
|
||||
end;
|
||||
|
||||
function TMvBGRADrawingEngine.GetBrushStyle: TBrushStyle;
|
||||
begin
|
||||
Result := FBrushStyle;
|
||||
end;
|
||||
|
||||
function TMvBGRADrawingEngine.GetFontColor: TColor;
|
||||
begin
|
||||
Result := FFontColor
|
||||
end;
|
||||
|
||||
function TMvBGRADrawingEngine.GetFontName: String;
|
||||
begin
|
||||
Result := FFontName;
|
||||
end;
|
||||
|
||||
function TMvBGRADrawingEngine.GetFontSize: Integer;
|
||||
begin
|
||||
Result := FFontSize;
|
||||
end;
|
||||
|
||||
function TMvBGRADrawingEngine.GetFontStyle: TFontStyles;
|
||||
begin
|
||||
Result := FFontStyle;
|
||||
end;
|
||||
|
||||
function TMvBGRADrawingEngine.GetPenColor: TColor;
|
||||
begin
|
||||
Result := FBuffer.CanvasBGRA.Pen.Color;
|
||||
end;
|
||||
|
||||
function TMvBGRADrawingEngine.GetPenWidth: Integer;
|
||||
begin
|
||||
Result := 1; // No pen width support in Rgb32Bitmap
|
||||
end;
|
||||
|
||||
procedure TMvBGRADrawingEngine.Line(X1, Y1, X2, Y2: Integer);
|
||||
begin
|
||||
FBuffer.CanvasBGRA.Polyline([point(X1, Y1),point( X2, Y2)]);
|
||||
end;
|
||||
|
||||
procedure TMvBGRADrawingEngine.PaintToCanvas(ACanvas: TCanvas);
|
||||
begin
|
||||
FBuffer.Draw(ACanvas, 0, 0);
|
||||
end;
|
||||
|
||||
procedure TMvBGRADrawingEngine.Rectangle(X1, Y1, X2, Y2: Integer);
|
||||
begin
|
||||
FBuffer.CanvasBGRA.Rectangle(X1, Y1, X2, Y2);
|
||||
end;
|
||||
|
||||
function TMvBGRADrawingEngine.SaveToImage(AClass: TRasterImageClass): TRasterImage;
|
||||
begin
|
||||
Result := AClass.Create;
|
||||
Result.Width := FBuffer.Width;
|
||||
Result.Height := FBuffer.Height;
|
||||
Result.Canvas.FillRect(0, 0, FBuffer.Width, FBuffer.Height);
|
||||
FBuffer.Draw(Result.Canvas, 0, 0);
|
||||
end;
|
||||
|
||||
procedure TMvBGRADrawingEngine.SetBrushColor(AValue: TColor);
|
||||
begin
|
||||
FBuffer.CanvasBGRA.Brush.Color := AValue;
|
||||
end;
|
||||
|
||||
procedure TMvBGRADrawingEngine.SetBrushStyle(AValue: TBrushStyle);
|
||||
begin
|
||||
FBrushStyle := AValue;
|
||||
// No direct brush style support in RGB32Bitmap
|
||||
end;
|
||||
|
||||
procedure TMvBGRADrawingEngine.SetFontColor(AValue: TColor);
|
||||
begin
|
||||
FFontColor := AValue;
|
||||
end;
|
||||
|
||||
procedure TMvBGRADrawingEngine.SetFontName(AValue: String);
|
||||
begin
|
||||
FFontName := AValue;
|
||||
end;
|
||||
|
||||
procedure TMvBGRADrawingEngine.SetFontSize(AValue: Integer);
|
||||
begin
|
||||
FFontSize := AValue;
|
||||
end;
|
||||
|
||||
procedure TMvBGRADrawingEngine.SetFontStyle(AValue: TFontStyles);
|
||||
begin
|
||||
FFontStyle := AValue;
|
||||
end;
|
||||
|
||||
procedure TMvBGRADrawingEngine.SetPenColor(AValue: TColor);
|
||||
begin
|
||||
FBuffer.CanvasBGRA.pen.Color := AValue;
|
||||
end;
|
||||
|
||||
procedure TMvBGRADrawingEngine.SetPenWidth(AValue: Integer);
|
||||
begin
|
||||
// Can't set pen width in TBGRABitmap
|
||||
end;
|
||||
|
||||
function TMvBGRADrawingEngine.TextExtent(const AText: String): TSize;
|
||||
var
|
||||
bmp: TBitmap;
|
||||
begin
|
||||
bmp := TBitmap.Create;
|
||||
try
|
||||
bmp.SetSize(1, 1);
|
||||
bmp.Canvas.Font.Name := FFontName;
|
||||
bmp.Canvas.Font.Size := FFontSize;
|
||||
bmp.Canvas.Font.Style := FFontStyle;
|
||||
Result := bmp.Canvas.TextExtent(AText);
|
||||
finally
|
||||
bmp.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
(*
|
||||
procedure TMvBGRADrawingEngine.TextOut(X, Y: Integer; const AText: String);
|
||||
var
|
||||
bmp: TBitmap;
|
||||
ex: TSize;
|
||||
img: TLazIntfImage;
|
||||
brClr: TFPColor;
|
||||
imgClr: TFPColor;
|
||||
i, j: Integer;
|
||||
begin
|
||||
if (AText = '') then
|
||||
exit;
|
||||
|
||||
bmp := TBitmap.Create;
|
||||
try
|
||||
bmp.PixelFormat := pf32Bit;
|
||||
bmp.SetSize(1, 1);
|
||||
bmp.Canvas.Font.Name := FFontName;
|
||||
bmp.Canvas.Font.Size := FFontSize;
|
||||
bmp.Canvas.Font.Style := FFontStyle;
|
||||
bmp.Canvas.Font.Color := FFontColor;
|
||||
ex := bmp.Canvas.TextExtent(AText);
|
||||
bmp.SetSize(ex.CX, ex.CY);
|
||||
bmp.Canvas.Brush.Color := GetBrushColor;
|
||||
if GetBrushStyle = bsClear then
|
||||
bmp.Canvas.Brush.Style := bsSolid
|
||||
else
|
||||
bmp.Canvas.Brush.Style := GetBrushStyle;
|
||||
bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height);
|
||||
bmp.Canvas.TextOut(0, 0, AText);
|
||||
img := bmp.CreateIntfImage;
|
||||
try
|
||||
if GetBrushStyle = bsClear then begin
|
||||
brClr := TColorToFPColor(GetBrushColor);
|
||||
for j := 0 to img.Height - 1 do
|
||||
for i := 0 to img.Width - 1 do begin
|
||||
imgClr := img.Colors[i, j];
|
||||
if (imgClr.Red = brClr.Red) and (imgClr.Green = brClr.Green) and (imgClr.Blue = brClr.Blue) then
|
||||
Continue;
|
||||
FBuffer.Canvas.SetColor(X + i, Y + j, FPColorToTColor(imgClr));
|
||||
end;
|
||||
end else
|
||||
for j := 0 to img.Height - 1 do
|
||||
for i := 0 to img.Width - 1 do
|
||||
FBuffer.Canvas.SetColor(X + i, Y + j, FPColorToTColor(img.Colors[i, j]));
|
||||
finally
|
||||
img.Free;
|
||||
end;
|
||||
finally
|
||||
bmp.Free;
|
||||
end;
|
||||
end;
|
||||
*)
|
||||
|
||||
procedure TMvBGRADrawingEngine.TextOut(X, Y: Integer; const AText: String);
|
||||
var
|
||||
bmp: TBitmap;
|
||||
ex: TSize;
|
||||
img: TLazIntfImage;
|
||||
i, j: Integer;
|
||||
c: TColor;
|
||||
fc, tc: TFPColor;
|
||||
intens, intens0: Int64;
|
||||
alpha: Double;
|
||||
hb, hm: HBitmap;
|
||||
begin
|
||||
if (AText = '') then
|
||||
exit;
|
||||
|
||||
bmp := TBitmap.Create;
|
||||
try
|
||||
bmp.PixelFormat := pf32Bit;
|
||||
bmp.SetSize(1, 1);
|
||||
bmp.Canvas.Font.Name := FFontName;
|
||||
bmp.Canvas.Font.Size := FFontSize;
|
||||
bmp.Canvas.Font.Style := FFontStyle;
|
||||
bmp.Canvas.Font.Color := FFontColor;
|
||||
ex := bmp.Canvas.TextExtent(AText);
|
||||
bmp.SetSize(ex.CX, ex.CY);
|
||||
if GetBrushStyle <> bsClear then begin
|
||||
bmp.Canvas.Brush.Color := GetBrushColor;
|
||||
bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height);
|
||||
bmp.Canvas.TextOut(0, 0, AText);
|
||||
DrawBitmap(X, Y, bmp, false);
|
||||
end else
|
||||
begin
|
||||
if FFontColor = clWhite then
|
||||
bmp.Canvas.Brush.Color := clBlack
|
||||
else
|
||||
bmp.Canvas.Brush.Color := clWhite;
|
||||
bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height);
|
||||
bmp.Canvas.TextOut(0, 0, AText);
|
||||
|
||||
img := bmp.CreateIntfImage;
|
||||
try
|
||||
fc := TColorToFPColor(bmp.Canvas.Font.Color);
|
||||
intens0 := (fc.Red + fc.Green + fc.Blue);
|
||||
for j := 0 to img.Height - 1 do
|
||||
for i := 0 to img.Width - 1 do begin
|
||||
c := bmp.Canvas.Pixels[i, j];
|
||||
tc := TColorToFPColor(c);
|
||||
if c = bmp.Canvas.Brush.Color then
|
||||
tc.Alpha := alphaTransparent
|
||||
else if c = FFontColor then
|
||||
tc.Alpha := alphaOpaque
|
||||
else begin
|
||||
intens := tc.Red + tc.Green + tc.Blue;
|
||||
if intens0 = 0 then
|
||||
alpha := (3 * alphaopaque - intens) / (3 * alphaOpaque - intens0)
|
||||
else
|
||||
alpha := intens / intens0;
|
||||
tc.Alpha := round(alphaOpaque * alpha);
|
||||
end;
|
||||
img.Colors[i, j] := tc;
|
||||
end;
|
||||
img.CreateBitmaps(hb, hm);
|
||||
bmp.Handle := hb;
|
||||
bmp.MaskHandle := hm;
|
||||
DrawBitmap(X, Y, bmp, true);
|
||||
finally
|
||||
img.Free;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
bmp.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user