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

components/lazmapviewer/example/MapViewer_Demo.lpi

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

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

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;
 

components/lazmapviewer/lazmapviewer_bgra.lpk

@@ -0,0 +1,45 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <Package Version="4">
+    <PathDelim Value="\"/>
+    <Name Value="lazmapviewer_bgra"/>
+    <Type Value="RunAndDesignTime"/>
+    <CompilerOptions>
+      <Version Value="11"/>
+      <PathDelim Value="\"/>
+      <SearchPaths>
+        <OtherUnitFiles Value="source\addons\bgra_drawingengine"/>
+        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+      </SearchPaths>
+    </CompilerOptions>
+    <Files Count="1">
+      <Item1>
+        <Filename Value="source\addons\bgra_drawingengine\mvde_bgra.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="mvDE_BGRA"/>
+      </Item1>
+    </Files>
+    <RequiredPkgs Count="3">
+      <Item1>
+        <PackageName Value="BGRABitmapPack"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="lazMapViewerPkg"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="FCL"/>
+      </Item3>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+      <OpenInFileMan Value="True"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <CustomOptions Items="ExternHelp" Version="2">
+      <_ExternHelp Items="Count"/>
+    </CustomOptions>
+  </Package>
+</CONFIG>

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.

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.
+