From 28f7fccd9f817306917e6b7991643f173c110491 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 24 Oct 2019 13:03:45 +0000 Subject: [PATCH] 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 --- .../lazmapviewer/example/MapViewer_Demo.lpi | 11 +- components/lazmapviewer/example/main.lfm | 9 +- components/lazmapviewer/example/main.pas | 10 +- components/lazmapviewer/lazmapviewer_bgra.lpk | 45 ++ components/lazmapviewer/lazmapviewer_bgra.pas | 22 + .../addons/bgra_drawingengine/mvde_bgra.pas | 390 ++++++++++++++++++ 6 files changed, 477 insertions(+), 10 deletions(-) create mode 100644 components/lazmapviewer/lazmapviewer_bgra.lpk create mode 100644 components/lazmapviewer/lazmapviewer_bgra.pas create mode 100644 components/lazmapviewer/source/addons/bgra_drawingengine/mvde_bgra.pas diff --git a/components/lazmapviewer/example/MapViewer_Demo.lpi b/components/lazmapviewer/example/MapViewer_Demo.lpi index 503cad270..df03d1c59 100644 --- a/components/lazmapviewer/example/MapViewer_Demo.lpi +++ b/components/lazmapviewer/example/MapViewer_Demo.lpi @@ -26,16 +26,19 @@ - + - + - + - + + + + diff --git a/components/lazmapviewer/example/main.lfm b/components/lazmapviewer/example/main.lfm index 1ba18c62e..d148e2857 100644 --- a/components/lazmapviewer/example/main.lfm +++ b/components/lazmapviewer/example/main.lfm @@ -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 diff --git a/components/lazmapviewer/example/main.pas b/components/lazmapviewer/example/main.pas index 6fc8365af..0912adefb 100644 --- a/components/lazmapviewer/example/main.pas +++ b/components/lazmapviewer/example/main.pas @@ -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; diff --git a/components/lazmapviewer/lazmapviewer_bgra.lpk b/components/lazmapviewer/lazmapviewer_bgra.lpk new file mode 100644 index 000000000..d0090b347 --- /dev/null +++ b/components/lazmapviewer/lazmapviewer_bgra.lpk @@ -0,0 +1,45 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + <_ExternHelp Items="Count"/> + + + diff --git a/components/lazmapviewer/lazmapviewer_bgra.pas b/components/lazmapviewer/lazmapviewer_bgra.pas new file mode 100644 index 000000000..c7ebea1ff --- /dev/null +++ b/components/lazmapviewer/lazmapviewer_bgra.pas @@ -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. diff --git a/components/lazmapviewer/source/addons/bgra_drawingengine/mvde_bgra.pas b/components/lazmapviewer/source/addons/bgra_drawingengine/mvde_bgra.pas new file mode 100644 index 000000000..db6120928 --- /dev/null +++ b/components/lazmapviewer/source/addons/bgra_drawingengine/mvde_bgra.pas @@ -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. +