You've already forked lazarus-ccr
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:
@ -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>
|
||||||
|
@ -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
|
||||||
|
@ -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;
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
BIN
components/lazmapviewer/images/tmvrgbgraphicsdrawingengine.png
Normal file
BIN
components/lazmapviewer/images/tmvrgbgraphicsdrawingengine.png
Normal file
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 |
45
components/lazmapviewer/lazmapviewer_rgbgraphics.lpk
Normal file
45
components/lazmapviewer/lazmapviewer_rgbgraphics.lpk
Normal 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>
|
22
components/lazmapviewer/lazmapviewer_rgbgraphics.pas
Normal file
22
components/lazmapviewer/lazmapviewer_rgbgraphics.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_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.
|
@ -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"/>
|
||||||
|
@ -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"/>
|
||||||
|
@ -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.
|
||||||
|
|
@ -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;
|
||||||
|
372
components/lazmapviewer/source/mvde_intfgraphics.pas
Normal file
372
components/lazmapviewer/source/mvde_intfgraphics.pas
Normal 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.
|
||||||
|
|
207
components/lazmapviewer/source/mvde_lcl.pas
Normal file
207
components/lazmapviewer/source/mvde_lcl.pas
Normal 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.
|
||||||
|
|
68
components/lazmapviewer/source/mvdrawingengine.pas
Normal file
68
components/lazmapviewer/source/mvdrawingengine.pas
Normal 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.
|
||||||
|
|
@ -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.
|
||||||
|
|
||||||
|
Binary file not shown.
Reference in New Issue
Block a user