LazMapViewer: Add drawing engine based on RGBGraphics package. Register in palette. Add units missing from previous commits.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6925 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-05-18 21:26:38 +00:00
parent 0418e4b8d4
commit 1049b25f44
18 changed files with 1098 additions and 43 deletions

View File

@ -26,13 +26,16 @@
<FormatVersion Value="2"/> <FormatVersion Value="2"/>
<Modes Count="0"/> <Modes Count="0"/>
</RunParams> </RunParams>
<RequiredPackages Count="2"> <RequiredPackages Count="3">
<Item1> <Item1>
<PackageName Value="lazMapViewerPkg"/> <PackageName Value="lazmapviewer_rgbgraphics"/>
</Item1> </Item1>
<Item2> <Item2>
<PackageName Value="LCL"/> <PackageName Value="lazMapViewerPkg"/>
</Item2> </Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages> </RequiredPackages>
<Units Count="4"> <Units Count="4">
<Unit0> <Unit0>

View File

@ -41,9 +41,9 @@ object MainForm: TMainForm
Height = 640 Height = 640
Top = 0 Top = 0
Width = 275 Width = 275
ActivePage = PgData ActivePage = PgConfig
Align = alRight Align = alRight
TabIndex = 0 TabIndex = 1
TabOrder = 1 TabOrder = 1
object PgData: TTabSheet object PgData: TTabSheet
Caption = 'Data' Caption = 'Data'
@ -573,6 +573,7 @@ object MainForm: TMainForm
Items.Strings = ( Items.Strings = (
'default' 'default'
'LCL' 'LCL'
'RGBGraphics'
) )
OnChange = CbDrawingEngineChange OnChange = CbDrawingEngineChange
Style = csDropDownList Style = csDropDownList

View File

@ -7,7 +7,8 @@ interface
uses uses
Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs,
ExtCtrls, StdCtrls, ComCtrls, Buttons, ExtCtrls, StdCtrls, ComCtrls, Buttons,
mvGeoNames, mvMapViewer, mvTypes, mvGpsObj, mvDrawingEngine, mvDE_LCL; mvGeoNames, mvMapViewer, mvTypes, mvGpsObj, mvDrawingEngine,
mvDE_LCL, mvDE_RGBGraphics;
type type
@ -92,6 +93,7 @@ type
private private
FLCLDrawingEngine: TLCLDrawingEngine; FLCLDrawingEngine: TLCLDrawingEngine;
FRGBGraphicsDrawingEngine: TRGBGraphicsDrawingEngine;
procedure ClearFoundLocations; procedure ClearFoundLocations;
procedure UpdateCoords(X, Y: Integer); procedure UpdateCoords(X, Y: Integer);
procedure UpdateDropdownWidth(ACombobox: TCombobox); procedure UpdateDropdownWidth(ACombobox: TCombobox);
@ -242,6 +244,11 @@ begin
if FLCLDrawingEngine = nil then FLCLDrawingEngine := TLCLDrawingEngine.Create(self); if FLCLDrawingEngine = nil then FLCLDrawingEngine := TLCLDrawingEngine.Create(self);
MapView.DrawingEngine := FLCLDrawingEngine; MapView.DrawingEngine := FLCLDrawingEngine;
end; end;
2: begin
if FRGBGraphicsDrawingEngine = nil then
FRGBGraphicsDrawingEngine := TRGBGraphicsDrawingEngine.Create(self);
MapView.DrawingEngine := FRGBGraphicsDrawingEngine;
end;
end; end;
end; end;

View File

@ -10,3 +10,6 @@ tmvdefpc_200.png
tmvdesynapse.png tmvdesynapse.png
tmvdesynapse_150.png tmvdesynapse_150.png
tmvdesynapse_200.png tmvdesynapse_200.png
tmvrgbgraphicsdrawingengine.png
tmvrgbgraphicsdrawingengine_150.png
tmvrgbgraphicsdrawingengine_200.png

Binary file not shown.

After

Width:  |  Height:  |  Size: 979 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

View File

@ -0,0 +1,45 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<PathDelim Value="\"/>
<Name Value="lazmapviewer_rgbgraphics"/>
<Type Value="RunAndDesignTime"/>
<Author Value="ti_dic, Werner Pamler"/>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<OtherUnitFiles Value="source\addons\rgbgraphics_drawingengine"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Description Value="Add-on to LazMapViewer: Contains the drawing engine based on the RGBGraphics package."/>
<License Value="GPL2 or later"/>
<Version Minor="1"/>
<Files Count="1">
<Item1>
<Filename Value="source\addons\rgbgraphics_drawingengine\mvde_rgbgraphics.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="mvDE_RGBGraphics"/>
</Item1>
</Files>
<RequiredPkgs Count="3">
<Item1>
<PackageName Value="lazMapViewerPkg"/>
</Item1>
<Item2>
<PackageName Value="rgb_graphics"/>
</Item2>
<Item3>
<PackageName Value="FCL"/>
</Item3>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
</Package>
</CONFIG>

View 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_rgbgraphics;
{$warn 5023 off : no warning about unused units}
interface
uses
mvDE_RGBGraphics, LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('mvDE_RGBGraphics', @mvDE_RGBGraphics.Register);
end;
initialization
RegisterPackage('lazmapviewer_rgbgraphics', @Register);
end.

View File

@ -4,6 +4,7 @@
<PathDelim Value="\"/> <PathDelim Value="\"/>
<Name Value="lazMapViewer_Synapse"/> <Name Value="lazMapViewer_Synapse"/>
<Type Value="RunAndDesignTime"/> <Type Value="RunAndDesignTime"/>
<Author Value="ti_dic, Werner Pamler"/>
<CompilerOptions> <CompilerOptions>
<Version Value="11"/> <Version Value="11"/>
<PathDelim Value="\"/> <PathDelim Value="\"/>
@ -12,6 +13,9 @@
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths> </SearchPaths>
</CompilerOptions> </CompilerOptions>
<Description Value="Add-on to LazMapViewer: Contains the download engine based on the Synapse library."/>
<License Value="GPL2 or later"/>
<Version Minor="1"/>
<Files Count="1"> <Files Count="1">
<Item1> <Item1>
<Filename Value="source\addons\synapse_downloadengine\mvdlesynapse.pas"/> <Filename Value="source\addons\synapse_downloadengine\mvdlesynapse.pas"/>

View File

@ -14,6 +14,7 @@
<Description Value="Component for viewing maps (Google, OpenStreetMap, etc). <Description Value="Component for viewing maps (Google, OpenStreetMap, etc).
This is a fork of MapViewer by ti_dic (https://sourceforge.net/p/roadbook/code/ci/master/tree/mapviewer/) which itself is based on the MapViewer by Maciej Kaczkowski (https://github.com/maciejkaczkowski/mapviewer)."/> This is a fork of MapViewer by ti_dic (https://sourceforge.net/p/roadbook/code/ci/master/tree/mapviewer/) which itself is based on the MapViewer by Maciej Kaczkowski (https://github.com/maciejkaczkowski/mapviewer)."/>
<License Value="GPL2 or later"/> <License Value="GPL2 or later"/>
<Version Minor="1"/>
<Files Count="18"> <Files Count="18">
<Item1> <Item1>
<Filename Value="source/mvcache.pas"/> <Filename Value="source/mvcache.pas"/>

View File

@ -0,0 +1,291 @@
unit mvDE_RGBGraphics;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Types, Graphics, IntfGraphics,
mvDrawingEngine,
rgbGraphics;
type
{ TMvRGBGraphicsDrawingEngine }
TMvRGBGraphicsDrawingEngine = class(TMvCustomDrawingEngine)
private
FBuffer: TRGB32Bitmap;
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 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, FPImage,
mvTypes;
procedure Register;
begin
RegisterComponents(PALETTE_PAGE, [TMvRGBGraphicsDrawingEngine]);
end;
destructor TMvRGBGraphicsDrawingEngine.Destroy;
begin
FBuffer.Free;
inherited;
end;
procedure TMvRGBGraphicsDrawingEngine.CreateBuffer(AWidth, AHeight: Integer);
begin
FreeAndNil(FBuffer);
FBuffer := TRGB32Bitmap.Create(AWidth, AHeight);
end;
procedure TMvRGBGraphicsDrawingEngine.DrawLazIntfImage(X, Y: Integer;
AImg: TLazIntfImage);
//http://mantis.freepascal.org/view.php?id=27144
var
temp: TRGB32Bitmap;
rawImg: TRawImage;
intfImg: TLazIntfImage;
begin
rawImg.Init;
{$IFDEF DARWIN}
rawImg.Description.Init_BPP32_A8R8G8B8_BIO_TTB(FBuffer.Width, FBuffer.Height);
{$ELSE}
rawImg.Description.Init_BPP32_B8G8R8_BIO_TTB(FBuffer.Width, FBuffer.Height);
{$ENDIF}
rawImg.Description.Init_BPP32_B8G8R8A8_BIO_TTB(FBuffer.Width, FBuffer.Height);
rawImg.Data := FBuffer.Pixels;
intfImg := TLazIntfImage.Create(rawImg, false);
try
intfImg.CopyPixels(AImg, X, Y);
// rawImg.Init; // ???
finally
intfImg.Free;
end;
end;
procedure TMvRGBGraphicsDrawingEngine.Ellipse(X1, Y1, X2, Y2: Integer);
begin
FBuffer.Canvas.Ellipse(X1, Y1, X2, Y2);
end;
procedure TMvRGBGraphicsDrawingEngine.FillRect(X1, Y1, X2, Y2: Integer);
begin
FBuffer.Canvas.FillRect(X1, Y1, X2, Y2);
end;
function TMvRGBGraphicsDrawingEngine.GetBrushColor: TColor;
begin
Result := FBuffer.Canvas.FillColor;
end;
function TMvRGBGraphicsDrawingEngine.GetBrushStyle: TBrushStyle;
begin
Result := FBrushStyle;
end;
function TMvRGBGraphicsDrawingEngine.GetFontColor: TColor;
begin
Result := FFontColor
end;
function TMvRGBGraphicsDrawingEngine.GetFontName: String;
begin
Result := FFontName;
end;
function TMvRGBGraphicsDrawingEngine.GetFontSize: Integer;
begin
Result := FFontSize;
end;
function TMvRGBGraphicsDrawingEngine.GetFontStyle: TFontStyles;
begin
Result := FFontStyle;
end;
function TMvRGBGraphicsDrawingEngine.GetPenColor: TColor;
begin
Result := FBuffer.Canvas.OutlineColor;
end;
function TMvRGBGraphicsDrawingEngine.GetPenWidth: Integer;
begin
Result := 1; // No pen width support in Rgb32Bitmap
end;
procedure TMvRGBGraphicsDrawingEngine.Line(X1, Y1, X2, Y2: Integer);
begin
FBuffer.Canvas.Line(X1, Y1, X2, Y2);
end;
procedure TMvRGBGraphicsDrawingEngine.PaintToCanvas(ACanvas: TCanvas);
begin
FBuffer.Canvas.DrawTo(ACanvas, 0, 0);
end;
procedure TMvRGBGraphicsDrawingEngine.Rectangle(X1, Y1, X2, Y2: Integer);
begin
FBuffer.Canvas.Rectangle(X1, Y1, X2, Y2);
end;
function TMvRGBGraphicsDrawingEngine.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.Canvas.DrawTo(Result.Canvas, 0, 0);
end;
procedure TMvRGBGraphicsDrawingEngine.SetBrushColor(AValue: TColor);
begin
FBuffer.Canvas.FillColor := AValue;
end;
procedure TMvRGBGraphicsDrawingEngine.SetBrushStyle(AValue: TBrushStyle);
begin
FBrushStyle := AValue;
// No direct brush style support in RGB32Bitmap
end;
procedure TMvRGBGraphicsDrawingEngine.SetFontColor(AValue: TColor);
begin
FFontColor := AValue;
end;
procedure TMvRGBGraphicsDrawingEngine.SetFontName(AValue: String);
begin
FFontName := AValue;
end;
procedure TMvRGBGraphicsDrawingEngine.SetFontSize(AValue: Integer);
begin
FFontSize := AValue;
end;
procedure TMvRGBGraphicsDrawingEngine.SetFontStyle(AValue: TFontStyles);
begin
FFontStyle := AValue;
end;
procedure TMvRGBGraphicsDrawingEngine.SetPenColor(AValue: TColor);
begin
FBuffer.Canvas.OutlineColor := AValue;
end;
procedure TMvRGBGraphicsDrawingEngine.SetPenWidth(AValue: Integer);
begin
// Can't set pen width in TRGB32Bitmap
end;
function TMvRGBGraphicsDrawingEngine.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 TMvRGBGraphicsDrawingEngine.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;
end.

View File

@ -27,9 +27,9 @@ uses
type type
{ TMVDESynapse } { TMvDESynapse }
TMVDESynapse = class(TMvCustomDownloadEngine) TMvDESynapse = class(TMvCustomDownloadEngine)
private private
FProxyHost: string; FProxyHost: string;
FProxyPassword: string; FProxyPassword: string;
@ -56,13 +56,13 @@ uses
procedure Register; procedure Register;
begin begin
RegisterComponents(PALETTE_PAGE, [TMVDESynapse]); RegisterComponents(PALETTE_PAGE, [TMvDESynapse]);
end; end;
{ TMVDESynapse } { TMvDESynapse }
procedure TMVDESynapse.DownloadFile(const Url: string; str: TStream); procedure TMvDESynapse.DownloadFile(const Url: string; str: TStream);
var var
FHttp: THTTPSend; FHttp: THTTPSend;
realURL: String; realURL: String;

View File

@ -0,0 +1,372 @@
unit mvDE_IntfGraphics;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Graphics, Types, LazVersion,
FPImage, FPCanvas, IntfGraphics,
mvDrawingEngine;
type
TIntfGraphicsDrawingEngine = class(TMvCustomDrawingEngine)
private
FBuffer: TLazIntfImage;
FCanvas: TFPCustomCanvas;
FFontName: String;
FFontColor: TColor;
FFontSize: Integer;
FFontStyle: TFontStyles;
procedure CreateLazIntfImageAndCanvas(out ABuffer: TLazIntfImage;
out ACanvas: TFPCustomCanvas; AWidth, AHeight: Integer);
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 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;
implementation
uses
FPImgCanv, GraphType;
{$IF Laz_FullVersion < 1090000}
// Workaround for http://mantis.freepascal.org/view.php?id=27144
procedure CopyPixels(ASource, ADest: TLazIntfImage;
XDst: Integer = 0; YDst: Integer = 0;
AlphaMask: Boolean = False; AlphaTreshold: Word = 0);
var
SrcHasMask, DstHasMask: Boolean;
x, y, xStart, yStart, xStop, yStop: Integer;
c: TFPColor;
SrcRawImage, DestRawImage: TRawImage;
begin
ASource.GetRawImage(SrcRawImage);
ADest.GetRawImage(DestRawImage);
if DestRawImage.Description.IsEqual(SrcRawImage.Description) and (XDst = 0) and (YDst = 0) then
begin
// same description -> copy
if DestRawImage.Data <> nil then
System.Move(SrcRawImage.Data^, DestRawImage.Data^, DestRawImage.DataSize);
if DestRawImage.Mask <> nil then
System.Move(SrcRawImage.Mask^, DestRawImage.Mask^, DestRawImage.MaskSize);
Exit;
end;
// copy pixels
XStart := IfThen(XDst < 0, -XDst, 0);
YStart := IfThen(YDst < 0, -YDst, 0);
XStop := IfThen(ADest.Width - XDst < ASource.Width, ADest.Width - XDst, ASource.Width) - 1;
YStop := IfTHen(ADest.Height - YDst < ASource.Height, ADest.Height - YDst, ASource.Height) - 1;
SrcHasMask := SrcRawImage.Description.MaskBitsPerPixel > 0;
DstHasMask := DestRawImage.Description.MaskBitsPerPixel > 0;
if DstHasMask then begin
for y:= yStart to yStop do
for x:=xStart to xStop do
ADest.Masked[x+XDst,y+YDst] := SrcHasMask and ASource.Masked[x,y];
end;
for y:=yStart to yStop do
for x:=xStart to xStop do
begin
c := ASource.Colors[x,y];
if not DstHasMask and SrcHasMask and (c.alpha = $FFFF) then // copy mask to alpha channel
if ASource.Masked[x,y] then
c.alpha := 0;
ADest.Colors[x+XDst,y+YDst] := c;
if AlphaMask and (c.alpha < AlphaTreshold) then
ADest.Masked[x+XDst,y+YDst] := True;
end;
end;
{$IFEND}
destructor TIntfGraphicsDrawingEngine.Destroy;
begin
FCanvas.Free;
FBuffer.Free;
inherited;
end;
procedure TIntfGraphicsDrawingEngine.CreateBuffer(AWidth, AHeight: Integer);
begin
FCanvas.Free;
FBuffer.Free;
CreateLazIntfImageAndCanvas(FBuffer, FCanvas, AWidth, AHeight);
end;
procedure TIntfGraphicsDrawingEngine.CreateLazIntfImageAndCanvas(
out ABuffer: TLazIntfImage;
out ACanvas: TFPCustomCanvas; AWidth, AHeight: Integer);
var
rawImg: TRawImage;
begin
rawImg.Init;
{$IFDEF DARWIN}
rawImg.Description.Init_BPP32_A8R8G8B8_BIO_TTB(AWidth, AHeight);
{$ELSE}
rawImg.Description.Init_BPP32_B8G8R8_BIO_TTB(AWidth, AHeight);
{$ENDIF}
rawImg.CreateData(True);
ABuffer := TLazIntfImage.Create(rawImg, true);
ACanvas := TFPImageCanvas.Create(ABuffer);
ACanvas.Brush.FPColor := colWhite;
ACanvas.FillRect(0, 0, AWidth, AHeight);
end;
procedure TIntfGraphicsDrawingEngine.DrawLazIntfImage(X, Y: Integer;
AImg: TLazIntfImage);
begin
{$IF Laz_FullVersion < 1090000}
{ Workaround for //http://mantis.freepascal.org/view.php?id=27144 }
CopyPixels(AImg, Buffer, X, Y);
{$ELSE}
FBuffer.CopyPixels(AImg, X, Y);
{$IFEND}
end;
procedure TIntfGraphicsDrawingEngine.Ellipse(X1, Y1, X2, Y2: Integer);
begin
if FCanvas <> nil then
FCanvas.Ellipse(X1,Y1, X2, Y2);
end;
procedure TIntfGraphicsDrawingEngine.FillRect(X1, Y1, X2, Y2: Integer);
begin
if FCanvas <> nil then
FCanvas.FillRect(X1,Y1, X2, Y2);
end;
function TIntfGraphicsDrawingEngine.GetBrushColor: TColor;
begin
if FCanvas <> nil then
Result := FPColorToTColor(FCanvas.Brush.FPColor)
else
Result := 0;
end;
function TIntfGraphicsDrawingEngine.GetBrushStyle: TBrushStyle;
begin
if FCanvas <> nil then
Result := FCanvas.Brush.Style
else
Result := bsSolid;
end;
function TIntfGraphicsDrawingEngine.GetFontColor: TColor;
begin
Result := FFontColor
end;
function TIntfGraphicsDrawingEngine.GetFontName: String;
begin
Result := FFontName;
end;
function TIntfGraphicsDrawingEngine.GetFontSize: Integer;
begin
Result := FFontSize;
end;
function TIntfGraphicsDrawingEngine.GetFontStyle: TFontStyles;
begin
Result := FFontStyle;
end;
function TIntfGraphicsDrawingEngine.GetPenColor: TColor;
begin
if FCanvas <> nil then
Result := FPColorToTColor(FCanvas.Pen.FPColor)
else
Result := 0;
end;
function TIntfGraphicsDrawingEngine.GetPenWidth: Integer;
begin
if FCanvas <> nil then
Result := FCanvas.Pen.Width
else
Result := 0;
end;
procedure TIntfGraphicsDrawingEngine.Line(X1, Y1, X2, Y2: Integer);
begin
if FCanvas <> nil then
FCanvas.Line(X1, Y1, X2, Y2);
end;
procedure TIntfGraphicsDrawingEngine.PaintToCanvas(ACanvas: TCanvas);
var
bmp: TBitmap;
begin
if FCanvas <> nil then begin
bmp := TBitmap.Create;
try
bmp.PixelFormat := pf32Bit;
bmp.SetSize(FBuffer.Width, FBuffer.Height);
bmp.LoadFromIntfImage(FBuffer);
ACanvas.Draw(0, 0, bmp);
finally
bmp.Free;
end;
end;
end;
procedure TIntfGraphicsDrawingEngine.Rectangle(X1, Y1, X2, Y2: Integer);
begin
if FCanvas <> nil then
FCanvas.Rectangle(X1,Y1, X2, Y2);
end;
function TIntfGraphicsDrawingEngine.SaveToImage(AClass: TRasterImageClass): TRasterImage;
begin
Result := AClass.Create;
Result.Width := FBuffer.Width;
Result.Height := FBuffer.Height;
Result.Canvas.FillRect(0, 0, Result.Width, Result.Height);
Result.LoadFromIntfImage(FBuffer);
end;
procedure TIntfGraphicsDrawingEngine.SetBrushColor(AValue: TColor);
begin
if FCanvas <> nil then
FCanvas.Brush.FPColor := TColorToFPColor(AValue);
end;
procedure TIntfGraphicsDrawingEngine.SetBrushStyle(AValue: TBrushStyle);
begin
if FCanvas <> nil then
FCanvas.Brush.Style := AValue;
end;
procedure TIntfGraphicsDrawingEngine.SetFontColor(AValue: TColor);
begin
FFontColor := AValue;
end;
procedure TIntfGraphicsDrawingEngine.SetFontName(AValue: String);
begin
FFontName := AValue;
end;
procedure TIntfGraphicsDrawingEngine.SetFontSize(AValue: Integer);
begin
FFontSize := AValue;
end;
procedure TIntfGraphicsDrawingEngine.SetFontStyle(AValue: TFontStyles);
begin
FFontStyle := AValue;
end;
procedure TIntfGraphicsDrawingEngine.SetPenColor(AValue: TColor);
begin
if FCanvas <> nil then
FCanvas.Pen.FPColor := TColorToFPColor(AValue);
end;
procedure TIntfGraphicsDrawingEngine.SetPenWidth(AValue: Integer);
begin
if FCanvas <> nil then
FCanvas.Pen.Width := AValue;
end;
function TIntfGraphicsDrawingEngine.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 TIntfGraphicsDrawingEngine.TextOut(X, Y: Integer; const AText: String);
var
bmp: TBitmap;
ex: TSize;
img: TLazIntfImage;
brClr: TFPColor;
imgClr: TFPColor;
i, j: Integer;
begin
if (FCanvas = nil) or (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;
FCanvas.Colors[X + i, Y + j] := imgClr;
end;
end else
FCanvas.Draw(X, Y, img);
finally
img.Free;
end;
finally
bmp.Free;
end;
end;
end.

View File

@ -0,0 +1,207 @@
unit mvDE_LCL;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Graphics, Types, IntfGraphics,
mvDrawingEngine;
type
TLCLDrawingEngine = class(TMvCustomDrawingEngine)
private
FBuffer: TBitmap;
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 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;
implementation
destructor TLCLDrawingEngine.Destroy;
begin
FBuffer.Free;
inherited;
end;
procedure TLCLDrawingEngine.CreateBuffer(AWidth, AHeight: Integer);
begin
FBuffer.Free;
FBuffer := TBitmap.Create;
FBuffer.PixelFormat := pf32Bit;
FBuffer.SetSize(AWidth, AHeight);
end;
procedure TLCLDrawingEngine.DrawLazIntfImage(X, Y: Integer;
AImg: TLazIntfImage);
var
bmp: TBitmap;
h, mh: THandle;
begin
bmp := TBitmap.Create;
try
bmp.PixelFormat := pf32Bit;
bmp.SetSize(AImg.Width, AImg.Height);
AImg.CreateBitmaps(h, mh);
bmp.Handle := h;
bmp.MaskHandle := mh;
FBuffer.Canvas.Draw(X, Y, bmp);
finally
bmp.Free;
end;
end;
procedure TLCLDrawingEngine.Ellipse(X1, Y1, X2, Y2: Integer);
begin
FBuffer.Canvas.Ellipse(X1,Y1, X2, Y2);
end;
procedure TLCLDrawingEngine.FillRect(X1, Y1, X2, Y2: Integer);
begin
FBuffer.Canvas.FillRect(X1,Y1, X2, Y2);
end;
function TLCLDrawingEngine.GetBrushColor: TColor;
begin
Result := FBuffer.Canvas.Brush.Color;
end;
function TLCLDrawingEngine.GetBrushStyle: TBrushStyle;
begin
Result := FBuffer.Canvas.Brush.Style
end;
function TLCLDrawingEngine.GetFontColor: TColor;
begin
Result := FBuffer.Canvas.Font.Color
end;
function TLCLDrawingEngine.GetFontName: String;
begin
Result := FBuffer.Canvas.Font.Name;
end;
function TLCLDrawingEngine.GetFontSize: Integer;
begin
Result := FBuffer.Canvas.Font.Size;
end;
function TLCLDrawingEngine.GetFontStyle: TFontStyles;
begin
Result := FBuffer.Canvas.Font.Style;
end;
function TLCLDrawingEngine.GetPenColor: TColor;
begin
Result := FBuffer.Canvas.Pen.Color;
end;
function TLCLDrawingEngine.GetPenWidth: Integer;
begin
Result := FBuffer.Canvas.Pen.Width;
end;
procedure TLCLDrawingEngine.Line(X1, Y1, X2, Y2: Integer);
begin
FBuffer.Canvas.Line(X1, Y1, X2, Y2);
end;
procedure TLCLDrawingEngine.PaintToCanvas(ACanvas: TCanvas);
begin
ACanvas.Draw(0, 0, FBuffer);
end;
procedure TLCLDrawingEngine.Rectangle(X1, Y1, X2, Y2: Integer);
begin
FBuffer.Canvas.Rectangle(X1,Y1, X2, Y2);
end;
function TLCLDrawingEngine.SaveToImage(AClass: TRasterImageClass): TRasterImage;
begin
Result := AClass.Create;
Result.Width := FBuffer.Width;
Result.Height := FBuffer.Height;
Result.Canvas.FillRect(0, 0, Result.Width, Result.Height);
Result.Canvas.Draw(0, 0, FBuffer);
end;
procedure TLCLDrawingEngine.SetBrushColor(AValue: TColor);
begin
FBuffer.Canvas.Brush.Color := AValue;
end;
procedure TLCLDrawingEngine.SetBrushStyle(AValue: TBrushStyle);
begin
FBuffer.Canvas.Brush.Style := AValue;
end;
procedure TLCLDrawingEngine.SetFontColor(AValue: TColor);
begin
FBuffer.Canvas.Font.Color := AValue;
end;
procedure TLCLDrawingEngine.SetFontName(AValue: String);
begin
FBuffer.Canvas.Font.Name := AValue;
end;
procedure TLCLDrawingEngine.SetFontSize(AValue: Integer);
begin
FBuffer.Canvas.Font.Size := AValue;
end;
procedure TLCLDrawingEngine.SetFontStyle(AValue: TFontStyles);
begin
FBuffer.Canvas.Font.Style := AValue;
end;
procedure TLCLDrawingEngine.SetPenColor(AValue: TColor);
begin
FBuffer.Canvas.Pen.Color := AValue;
end;
procedure TLCLDrawingEngine.SetPenWidth(AValue: Integer);
begin
FBuffer.Canvas.Pen.Width := AValue;
end;
function TLCLDrawingEngine.TextExtent(const AText: String): TSize;
begin
Result := FBuffer.Canvas.TextExtent(AText)
end;
procedure TLCLDrawingEngine.TextOut(X, Y: Integer; const AText: String);
begin
if (AText <> '') then
FBuffer.Canvas.TextOut(X, Y, AText);
end;
end.

View File

@ -0,0 +1,68 @@
unit mvDrawingEngine;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Graphics, Types, IntfGraphics;
type
TMvCustomDrawingEngine = class(TComponent)
protected
function GetBrushColor: TColor; virtual; abstract;
function GetBrushStyle: TBrushStyle; virtual; abstract;
function GetFontColor: TColor; virtual; abstract;
function GetFontName: String; virtual; abstract;
function GetFontSize: Integer; virtual; abstract;
function GetFontStyle: TFontStyles; virtual; abstract;
function GetPenColor: TColor; virtual; abstract;
function GetPenWidth: Integer; virtual; abstract;
procedure SetBrushColor(AValue: TColor); virtual; abstract;
procedure SetBrushStyle(AValue: TBrushStyle); virtual; abstract;
procedure SetFontColor(AValue: TColor); virtual; abstract;
procedure SetFontName(AValue: String); virtual; abstract;
procedure SetFontSize(AValue: Integer); virtual; abstract;
procedure SetFontStyle(AValue: TFontStyles); virtual; abstract;
procedure SetPenColor(AValue: TColor); virtual; abstract;
procedure SetPenWidth(AValue: Integer); virtual; abstract;
public
procedure CreateBuffer(AWidth, AHeight: Integer); virtual; abstract;
procedure DrawLazIntfImage(X, Y: Integer; AImg: TLazIntfImage); virtual; abstract;
procedure Ellipse(X1, Y1, X2, Y2: Integer); virtual; abstract;
procedure FillRect(X1, Y1, X2, Y2: Integer); virtual; abstract;
procedure Line(X1, Y1, X2, Y2: Integer); virtual; virtual; abstract;
procedure PaintToCanvas(ACanvas: TCanvas); virtual; abstract;
procedure Rectangle(X1, Y1, X2, Y2: Integer); virtual; abstract;
function SaveToImage(AClass: TRasterImageClass): TRasterImage; virtual; abstract;
function TextExtent(const AText: String): TSize; virtual; abstract;
function TextHeight(const AText: String): Integer;
procedure TextOut(X, Y: Integer; const AText: String); virtual; abstract;
function TextWidth(const AText: String): Integer;
property BrushColor: TColor read GetBrushColor write SetBrushColor;
property BrushStyle: TBrushStyle read GetBrushStyle write SetBrushStyle;
property FontColor: TColor read GetFontColor write SetFontColor;
property FontName: String read GetFontName write SetFontName;
property FontSize: Integer read GetFontSize write SetFontSize;
property FontStyle: TFontStyles read GetFontStyle write SetFontStyle;
property PenColor: TColor read GetPenColor write SetPenColor;
property PenWidth: Integer read GetPenWidth write SetPenWidth;
end;
implementation
function TMvCustomDrawingEngine.TextHeight(const AText: String): Integer;
begin
Result := TextExtent(AText).CX;
end;
function TMvCustomDrawingEngine.TextWidth(const AText: String): Integer;
begin
Result := TextExtent(AText).CY;
end;
end.

View File

@ -24,7 +24,7 @@ unit mvMapViewer;
interface interface
uses uses
Classes, SysUtils, Controls, Graphics, IntfGraphics, Classes, SysUtils, Controls, Graphics, IntfGraphics, Forms,
MvTypes, MvGPSObj, MvEngine, MvMapProvider, MvDownloadEngine, MvDrawingEngine; MvTypes, MvGPSObj, MvEngine, MvMapProvider, MvDownloadEngine, MvDrawingEngine;
Type Type
@ -58,6 +58,7 @@ Type
FDebugTiles: Boolean; FDebugTiles: Boolean;
FDefaultTrackColor: TColor; FDefaultTrackColor: TColor;
FDefaultTrackWidth: Integer; FDefaultTrackWidth: Integer;
FFont: TFont;
procedure CallAsyncInvalidate; procedure CallAsyncInvalidate;
procedure DoAsyncInvalidate({%H-}Data: PtrInt); procedure DoAsyncInvalidate({%H-}Data: PtrInt);
procedure DrawObjects(const {%H-}TileId: TTileId; aLeft, aTop, aRight,aBottom: integer); procedure DrawObjects(const {%H-}TileId: TTileId; aLeft, aTop, aRight,aBottom: integer);
@ -74,6 +75,7 @@ Type
function GetOnZoomChange: TNotifyEvent; function GetOnZoomChange: TNotifyEvent;
function GetUseThreads: boolean; function GetUseThreads: boolean;
function GetZoom: integer; function GetZoom: integer;
function IsFontStored: Boolean;
procedure SetActive(AValue: boolean); procedure SetActive(AValue: boolean);
procedure SetCacheOnDisk(AValue: boolean); procedure SetCacheOnDisk(AValue: boolean);
procedure SetCachePath({%H-}AValue: String); procedure SetCachePath({%H-}AValue: String);
@ -83,6 +85,7 @@ Type
procedure SetDefaultTrackWidth(AValue: Integer); procedure SetDefaultTrackWidth(AValue: Integer);
procedure SetDownloadEngine(AValue: TMvCustomDownloadEngine); procedure SetDownloadEngine(AValue: TMvCustomDownloadEngine);
procedure SetDrawingEngine(AValue: TMvCustomDrawingEngine); procedure SetDrawingEngine(AValue: TMvCustomDrawingEngine);
procedure SetFont(AValue: TFont);
procedure SetInactiveColor(AValue: TColor); procedure SetInactiveColor(AValue: TColor);
procedure SetMapProvider(AValue: String); procedure SetMapProvider(AValue: String);
procedure SetOnCenterMove(AValue: TNotifyEvent); procedure SetOnCenterMove(AValue: TNotifyEvent);
@ -90,6 +93,7 @@ Type
procedure SetOnZoomChange(AValue: TNotifyEvent); procedure SetOnZoomChange(AValue: TNotifyEvent);
procedure SetUseThreads(AValue: boolean); procedure SetUseThreads(AValue: boolean);
procedure SetZoom(AValue: integer); procedure SetZoom(AValue: integer);
procedure UpdateFont(Sender: TObject);
protected protected
AsyncInvalidate : boolean; AsyncInvalidate : boolean;
@ -137,6 +141,7 @@ Type
property DefaultTrackWidth: Integer read FDefaultTrackWidth write SetDefaultTrackWidth default 1; property DefaultTrackWidth: Integer read FDefaultTrackWidth write SetDefaultTrackWidth default 1;
property DownloadEngine: TMvCustomDownloadEngine read GetDownloadEngine write SetDownloadEngine; property DownloadEngine: TMvCustomDownloadEngine read GetDownloadEngine write SetDownloadEngine;
property DrawingEngine: TMvCustomDrawingEngine read GetDrawingEngine write SetDrawingEngine; property DrawingEngine: TMvCustomDrawingEngine read GetDrawingEngine write SetDrawingEngine;
property Font: TFont read FFont write SetFont stored IsFontStored;
property Height default 150; property Height default 150;
property InactiveColor: TColor read FInactiveColor write SetInactiveColor; property InactiveColor: TColor read FInactiveColor write SetInactiveColor;
property MapProvider: String read GetMapProvider write SetMapProvider; property MapProvider: String read GetMapProvider write SetMapProvider;
@ -337,6 +342,12 @@ begin
result := Engine.Zoom; result := Engine.Zoom;
end; end;
function TMapView.IsFontStored: Boolean;
begin
Result := SameText(FFont.Name, 'default') and (FFont.Size = 0) and
(FFont.Style = []) and (FFont.Color = clBlack);
end;
procedure TMapView.SetCacheOnDisk(AValue: boolean); procedure TMapView.SetCacheOnDisk(AValue: boolean);
begin begin
Engine.CacheOnDisk := AValue; Engine.CacheOnDisk := AValue;
@ -388,7 +399,13 @@ begin
FBuiltinDrawingEngine.CreateBuffer(0, 0); FBuiltinDrawingEngine.CreateBuffer(0, 0);
FDrawingEngine.CreateBuffer(ClientWidth, ClientHeight); FDrawingEngine.CreateBuffer(ClientWidth, ClientHeight);
end; end;
Engine.Redraw; UpdateFont(nil);
end;
procedure TMapView.SetFont(AValue: TFont);
begin
FFont.Assign(AValue);
UpdateFont(nil);
end; end;
procedure TMapView.SetInactiveColor(AValue: TColor); procedure TMapView.SetInactiveColor(AValue: TColor);
@ -789,45 +806,43 @@ end;
constructor TMapView.Create(AOwner: TComponent); constructor TMapView.Create(AOwner: TComponent);
begin begin
Active := false;
FGPSItems := TGPSObjectList.Create;
FGPSItems.OnModified := @OnGPSItemsModified;
FInactiveColor := clWhite;
FEngine := TMapViewerEngine.Create(self);
FBuiltinDownloadEngine := TMvDEFpc.Create(self);
FBuiltinDownloadEngine.Name := 'BuiltInDLE';
FDefaultTrackColor := clRed;
FDefaultTrackWidth := 1;
(*
{$IFDEF USE_RGBGRAPHICS}
Buffer := TRGB32Bitmap.Create(Width, Height);
{$ENDIF}
{$IFDEF USE_LAZINTFIMAGE}
CreateLazIntfImageAndCanvas(Buffer, BufferCanvas, Width, Height);
{$ENDIF}
*)
Engine.CachePath := 'cache/';
Engine.CacheOnDisk := true;
Engine.OnDrawTile := @DoDrawTile;
Engine.DrawTitleInGuiThread := false;
Engine.DownloadEngine := FBuiltinDownloadEngine;
inherited Create(AOwner); inherited Create(AOwner);
Width := 150; Width := 150;
Height := 150; Height := 150;
FActive := false;
FDefaultTrackColor := clRed;
FDefaultTrackWidth := 1;
FInactiveColor := clWhite;
FGPSItems := TGPSObjectList.Create;
FGPSItems.OnModified := @OnGPSItemsModified;
FBuiltinDownloadEngine := TMvDEFpc.Create(self);
FBuiltinDownloadEngine.Name := 'BuiltInDLE';
FEngine := TMapViewerEngine.Create(self);
FEngine.CachePath := 'cache/';
FEngine.CacheOnDisk := true;
FEngine.OnDrawTile := @DoDrawTile;
FEngine.DrawTitleInGuiThread := false;
FEngine.DownloadEngine := FBuiltinDownloadEngine;
FBuiltinDrawingEngine := TIntfGraphicsDrawingEngine.Create(self); FBuiltinDrawingEngine := TIntfGraphicsDrawingEngine.Create(self);
FBuiltinDrawingEngine.Name := 'BuiltInDE'; FBuiltinDrawingEngine.Name := 'BuiltInDE';
FbuiltinDrawingEngine.CreateBuffer(Width, Height); FBuiltinDrawingEngine.CreateBuffer(Width, Height);
FFont := TFont.Create;
FFont.Name := 'default';
FFont.Size := 0;
FFont.Style := [];
FFont.Color := clBlack;
FFont.OnChange := @UpdateFont;
end; end;
destructor TMapView.Destroy; destructor TMapView.Destroy;
begin begin
FBuiltinDrawingEngine.Free; FFont.Free;
{
{$IFDEF USE_LAZINTFIMAGE}
BufferCanvas.Free;
{$ENDIF}
Buffer.Free;
}
FreeAndNil(FGPSItems); FreeAndNil(FGPSItems);
inherited Destroy; inherited Destroy;
end; end;
@ -939,5 +954,21 @@ begin
*) *)
end; end;
procedure TMapView.UpdateFont(Sender: TObject);
begin
if SameText(FFont.Name, 'default') then
DrawingEngine.FontName := Screen.SystemFont.Name
else
DrawingEngine.FontName := FFont.Name;
if FFont.Size = 0 then
DrawingEngine.FontSize := Screen.SystemFont.Size
else
DrawingEngine.FontSize := FFont.Size;
DrawingEngine.FontStyle := FFont.Style;
DrawingEngine.FontColor := ColorToRGB(FFont.Color);
Engine.Redraw;
end;
end. end.