Browse Source

add support for FCL Image

Ugochukwu Mmaduekwe 5 years ago
parent
commit
1fcbcaa7c6

+ 17 - 0
QRCodeGenLib/src/Include/QRCodeGenLib.inc

@@ -49,6 +49,18 @@
    {$OPTIMIZATION USERBP}
 {$ENDIF}
 
+{$DEFINE Framework_FCL} // enable to force FCL mode
+{$IFDEF Framework_FCL}
+   {$UNDEF LCL}
+   {$DEFINE FCL}
+{$ELSE}
+   {$DEFINE LCL}
+{$ENDIF}
+
+{$IFDEF LCL}
+   {$DEFINE VCL_OR_LCL}
+{$ENDIF LCL}
+
 {$ENDIF FPC}
 
 (* &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& *)
@@ -93,11 +105,16 @@
 
 {.$DEFINE Framework_FMX} // enable to force FMX mode
 {$IFDEF Framework_FMX}
+   {$UNDEF VCL}
    {$DEFINE FMX}
 {$ELSE}
    {$DEFINE VCL}
 {$ENDIF}
 
+{$IFDEF VCL}
+   {$DEFINE VCL_OR_LCL}
+{$ENDIF VCL}
+
 {$ENDIF DELPHI}
 
 (* &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& *)

+ 2 - 2
QRCodeGenLib/src/Interfaces/QlpIQrCode.pas

@@ -75,7 +75,7 @@ type
     /// </remarks>
     function ToBmpImage(AScale, ABorder: Int32): TQRCodeGenLibBitmap;
 
-{$IFNDEF FMX}
+{$IF DEFINED(VCL_OR_LCL)}
     /// <summary>
     /// Returns a jpeg image depicting this QR Code, with the specified
     /// module scale and border modules. For example, ToJpegImage(scale=10,
@@ -131,7 +131,7 @@ type
     /// object.</b>
     /// </remarks>
     function ToPngImage(AScale, ABorder: Int32): TQRCodeGenLibPNGImage;
-{$ENDIF FMX}
+{$IFEND VCL_OR_LCL}
     /// <summary>
     /// Returns a string of SVG code for an image depicting this QR Code,
     /// with the specified number of border modules. The string always uses

+ 3 - 6
QRCodeGenLib/src/Packages/FPC/QRCodeGenLib4PascalPackage.lpk

@@ -22,7 +22,7 @@
     <Description Value="QRCodeGenLib4Pascal is a Delphi/FPC compatible library that provides an easy to use interface for generating QR Codes.
 "/>
     <License Value="MIT License"/>
-    <Version Major="1" Minor="7"/>
+    <Version Major="1" Minor="8"/>
     <Files Count="18">
       <Item1>
         <Filename Value="..\..\QRCodeGen\QlpBitBuffer.pas"/>
@@ -98,13 +98,10 @@
       </Item18>
     </Files>
     <LazDoc PackageName="(default)"/>
-    <RequiredPkgs Count="2">
+    <RequiredPkgs Count="1">
       <Item1>
-        <PackageName Value="LCL"/>
-      </Item1>
-      <Item2>
         <PackageName Value="FCL"/>
-      </Item2>
+      </Item1>
     </RequiredPkgs>
     <UsageOptions>
       <UnitPath Value="$(PkgOutDir)"/>

+ 50 - 7
QRCodeGenLib/src/QRCodeGen/QlpQrCode.pas

@@ -186,6 +186,9 @@ type
 {$IFDEF LCL}
     function ToBmpImageInternalLCL(AScale, ABorder: Int32): TQRCodeGenLibBitmap;
 {$ENDIF LCL}
+{$IFDEF FCL}
+    function ToBmpImageInternalFCL(AScale, ABorder: Int32): TQRCodeGenLibBitmap;
+{$ENDIF FCL}
 {$IFDEF VCL}
     function ToBmpImageInternalVCL(AScale, ABorder: Int32): TQRCodeGenLibBitmap;
 {$ENDIF VCL}
@@ -328,7 +331,7 @@ type
     /// </remarks>
     function ToBmpImage(AScale, ABorder: Int32): TQRCodeGenLibBitmap;
 
-{$IFNDEF FMX}
+{$IF DEFINED(VCL_OR_LCL)}
     /// <summary>
     /// Returns a jpeg image depicting this QR Code, with the specified
     /// module scale and border modules. For example, ToJpegImage(scale=10,
@@ -384,7 +387,7 @@ type
     /// object.</b>
     /// </remarks>
     function ToPngImage(AScale, ABorder: Int32): TQRCodeGenLibPNGImage;
-{$ENDIF FMX}
+{$IFEND VCL_OR_LCL}
     /// <summary>
     /// Returns a string of SVG code for an image depicting this QR Code,
     /// with the specified number of border modules. The string always uses
@@ -1060,6 +1063,43 @@ begin
   end;
 end;
 {$ENDIF LCL}
+{$IFDEF FCL}
+
+function TQrCode.ToBmpImageInternalFCL(AScale, ABorder: Int32)
+  : TQRCodeGenLibBitmap;
+var
+  LColumn, LRow: Int32;
+  LDoColor: Boolean;
+  LBrushColor, LForegroundColor, LBackgroundColor: TQRCodeGenLibColor;
+begin
+  Result := TQRCodeGenLibBitmap.Create((FSize + (ABorder * 2)) * AScale,
+    (FSize + (ABorder * 2)) * AScale);
+
+  Result.UsePalette := True;
+
+  LForegroundColor := FForegroundColor;
+  LBackgroundColor := FBackgroundColor;
+
+  for LColumn := 0 to System.Pred(Result.Height) do
+  begin
+    for LRow := 0 to System.Pred(Result.Width) do
+    begin
+      LDoColor := GetModule((LRow div AScale) - ABorder,
+        (LColumn div AScale) - ABorder);
+      if LDoColor then
+      begin
+        LBrushColor := LForegroundColor;
+      end
+      else
+      begin
+        LBrushColor := LBackgroundColor;
+      end;
+      Result.Colors[LRow, LColumn] := LBrushColor;
+    end;
+
+  end;
+end;
+{$ENDIF FCL}
 {$IFDEF VCL}
 
 function TQrCode.ToBmpImageInternalVCL(AScale, ABorder: Int32)
@@ -1164,15 +1204,18 @@ begin
   ValidateImageDimensions(AScale, ABorder);
 {$IF DEFINED(LCL)}
   Result := ToBmpImageInternalLCL(AScale, ABorder);
+{$ELSEIF DEFINED(FCL)}
+  Result := ToBmpImageInternalFCL(AScale, ABorder);
 {$ELSEIF DEFINED(VCL)}
   Result := ToBmpImageInternalVCL(AScale, ABorder);
 {$ELSEIF DEFINED(FMX)}
   Result := ToBmpImageInternalFMX(AScale, ABorder);
 {$ELSE}
-{$MESSAGE ERROR 'This UI Framework is not supported at the moment.'}
+{$MESSAGE ERROR 'This Framework is not supported at the moment.'}
 {$IFEND}
 end;
-{$IFNDEF FMX}
+
+{$IF DEFINED(VCL_OR_LCL)}
 
 function TQrCode.ToJpegImage(AScale, ABorder: Int32): TQRCodeGenLibJPEGImage;
 var
@@ -1200,7 +1243,7 @@ begin
     LBitmap.Free;
   end;
 end;
-{$ENDIF FMX}
+{$IFEND VCL_OR_LCL}
 
 function TQrCode.ToSvgString(ABorder: Int32): String;
 var
@@ -1215,8 +1258,8 @@ begin
   end;
   LBorder := ABorder;
 
-  LForegroundColor := TConverters.ColorToHTMLColorHex(FForegroundColor);
-  LBackgroundColor := TConverters.ColorToHTMLColorHex(FBackgroundColor);
+  LForegroundColor := TConverters.QRCodeGenLibColorToHTMLHexColor(FForegroundColor);
+  LBackgroundColor := TConverters.QRCodeGenLibColorToHTMLHexColor(FBackgroundColor);
 
   LStringList := TStringList.Create;
   LStringList.LineBreak := '';

+ 118 - 14
QRCodeGenLib/src/Utils/QlpConverters.pas

@@ -14,6 +14,8 @@ uses
 {$ELSEIF DEFINED(LCL)}
   Graphics,
   Interfaces, // Added so that the LCL will Initialize the WidgetSet
+{$ELSEIF DEFINED(FCL)}
+  FPImage, // For FCL Image Support
 {$IFEND}
   SysUtils,
   QlpGuard,
@@ -26,7 +28,7 @@ type
   TConverters = class sealed(TObject)
 
   strict private
-{$IFNDEF FMX}
+{$IF DEFINED(VCL_OR_LCL)}
     /// <summary>
     /// Convert a Delphi/Lazarus <c>TColor</c> to <c>HTML</c> Color code in
     /// Hex <c>.</c>
@@ -41,7 +43,10 @@ type
     class function TColorToHTMLColorHex(const AColor: TQRCodeGenLibColor)
       : String; inline;
 
-{$ELSE}
+    class function HTMLColorHexToTColor(const AHTMLHexColor: String)
+      : TQRCodeGenLibColor; inline;
+
+{$ELSEIF DEFINED(FMX)}
     /// <summary>
     /// Convert a Delphi FireMonkey <c>TAlphaColor</c> to <c>HTML</c> Color code in
     /// Hex <c>.</c>
@@ -56,22 +61,46 @@ type
     class function TAlphaColorToHTMLColorHex(const AColor: TQRCodeGenLibColor)
       : String; inline;
 
-{$ENDIF FMX}
+    class function HTMLColorHexToTAlphaColor(const AHTMLHexColor: String)
+      : TQRCodeGenLibColor; inline;
+
+{$ELSEIF DEFINED(FCL)}
+    /// <summary>
+    /// Convert an FPC <c>TFPColor</c> to <c>HTML</c> Color code in
+    /// Hex <c>.</c>
+    /// </summary>
+    /// <param name="AColor">
+    /// the <c>TFPColor</c> to convert
+    /// </param>
+    /// <returns>
+    /// returns a string containing the <c>HTML</c> Color code representation
+    /// of the <c>TColor</c> parameter in Hex
+    /// </returns>
+    class function TFPColorToHTMLColorHex(const AColor: TQRCodeGenLibColor)
+      : String; inline;
+
+    class function HTMLColorHexToTFPColor(const AHTMLHexColor: String)
+      : TQRCodeGenLibColor; inline;
+{$IFEND VCL_OR_LCL}
   public
 
-{$IFNDEF FMX}
+{$IFDEF VCL_OR_LCL}
     class function GetRValue(Argb: UInt32): Byte; static; inline;
     class function GetGValue(Argb: UInt32): Byte; static; inline;
     class function GetBValue(Argb: UInt32): Byte; static; inline;
-{$ENDIF FMX}
+    class function RGB(Ar, Ag, Ab: Byte): TQRCodeGenLibColor; static; inline;
+{$ENDIF VCL_OR_LCL}
     class function ConvertStringToBytes(const AInput: String;
       const AEncoding: TEncoding): TQRCodeGenLibByteArray; static;
 
     class function ConvertBytesToString(const AInput: TQRCodeGenLibByteArray;
       const AEncoding: TEncoding): String; static;
 
-    class function ColorToHTMLColorHex(const AColor: TQRCodeGenLibColor)
-      : String; inline;
+    class function QRCodeGenLibColorToHTMLHexColor(const AColor
+      : TQRCodeGenLibColor): String; inline;
+
+    class function HTMLHexColorToQRCodeGenLibColor(const AHTMLHexColor: String)
+      : TQRCodeGenLibColor; inline;
   end;
 
 implementation
@@ -100,7 +129,7 @@ begin
 {$ENDIF FPC}
 end;
 
-{$IFNDEF FMX}
+{$IF DEFINED(VCL_OR_LCL)}
 
 class function TConverters.GetRValue(Argb: UInt32): Byte;
 begin
@@ -117,6 +146,11 @@ begin
   result := Byte(Argb shr 16);
 end;
 
+class function TConverters.RGB(Ar, Ag, Ab: Byte): TQRCodeGenLibColor;
+begin
+  result := (Ar or (Ag shl 8) or (Ab shl 16));
+end;
+
 class function TConverters.TColorToHTMLColorHex(const AColor
   : TQRCodeGenLibColor): String;
 begin
@@ -124,7 +158,21 @@ begin
     GetGValue(ColorToRGB(AColor)), GetBValue(ColorToRGB(AColor))]);
 end;
 
-{$ELSE}
+class function TConverters.HTMLColorHexToTColor(const AHTMLHexColor: String)
+  : TQRCodeGenLibColor;
+var
+  R, G, B: Byte;
+begin
+{$IFDEF DEBUG}
+  System.Assert(System.Length(AHTMLHexColor) = 6);
+{$ENDIF DEBUG}
+  R := StrToInt('$' + System.Copy(AHTMLHexColor, 1, 2));
+  G := StrToInt('$' + System.Copy(AHTMLHexColor, 3, 2));
+  B := StrToInt('$' + System.Copy(AHTMLHexColor, 5, 2));
+  result := TQRCodeGenLibColor(RGB(R, G, B));
+end;
+
+{$ELSEIF DEFINED(FMX)}
 
 class function TConverters.TAlphaColorToHTMLColorHex(const AColor
   : TQRCodeGenLibColor): String;
@@ -133,16 +181,72 @@ begin
     TAlphaColorRec(AColor).G, TAlphaColorRec(AColor).B]);
 end;
 
-{$ENDIF FMX}
+class function TConverters.HTMLColorHexToTAlphaColor(const AHTMLHexColor
+  : String): TQRCodeGenLibColor;
+var
+  R, G, B: Byte;
+  rec: TAlphaColorRec;
+begin
+{$IFDEF DEBUG}
+  System.Assert(System.Length(AHTMLHexColor) = 6);
+{$ENDIF DEBUG}
+  R := StrToInt('$' + System.Copy(AHTMLHexColor, 1, 2));
+  G := StrToInt('$' + System.Copy(AHTMLHexColor, 3, 2));
+  B := StrToInt('$' + System.Copy(AHTMLHexColor, 5, 2));
+  rec.A := $FF; // for transparency
+  rec.R := R;
+  rec.G := G;
+  rec.B := B;
+  result := rec.Color;
+end;
+
+{$ELSEIF DEFINED(FCL)}
 
-class function TConverters.ColorToHTMLColorHex(const AColor
+class function TConverters.TFPColorToHTMLColorHex(const AColor
   : TQRCodeGenLibColor): String;
 begin
-{$IFNDEF FMX}
+  result := Format('%.2x%.2x%.2x', [AColor.Red shr 8, AColor.Green shr 8,
+    AColor.Blue shr 8]);
+end;
+
+class function TConverters.HTMLColorHexToTFPColor(const AHTMLHexColor: String)
+  : TQRCodeGenLibColor;
+var
+  R, G, B: Byte;
+begin
+{$IFDEF DEBUG}
+  System.Assert(System.Length(AHTMLHexColor) = 6);
+{$ENDIF DEBUG}
+  R := StrToInt('$' + System.Copy(AHTMLHexColor, 1, 2));
+  G := StrToInt('$' + System.Copy(AHTMLHexColor, 3, 2));
+  B := StrToInt('$' + System.Copy(AHTMLHexColor, 5, 2));
+  result := FPColor(R shl 8, G shl 8, B shl 8);
+end;
+
+{$IFEND VCL_OR_LCL}
+
+class function TConverters.QRCodeGenLibColorToHTMLHexColor
+  (const AColor: TQRCodeGenLibColor): String;
+begin
+{$IF DEFINED(VCL_OR_LCL)}
   result := TConverters.TColorToHTMLColorHex(AColor);
-{$ELSE}
+{$ELSEIF DEFINED(FMX)}
   result := TConverters.TAlphaColorToHTMLColorHex(AColor);
-{$ENDIF FMX}
+{$ELSEIF DEFINED(FCL)}
+  result := TConverters.TFPColorToHTMLColorHex(AColor);
+{$IFEND VCL_OR_LCL}
+end;
+
+class function TConverters.HTMLHexColorToQRCodeGenLibColor(const AHTMLHexColor
+  : String): TQRCodeGenLibColor;
+begin
+{$IF DEFINED(VCL_OR_LCL)}
+  result := TConverters.HTMLColorHexToTColor(AHTMLHexColor);
+{$ELSEIF DEFINED(FMX)}
+  result := TConverters.HTMLColorHexToTAlphaColor(AHTMLHexColor);
+{$ELSEIF DEFINED(FCL)}
+  result := TConverters.HTMLColorHexToTFPColor(AHTMLHexColor);
+{$IFEND VCL_OR_LCL}
 end;
 
 end.

+ 24 - 7
QRCodeGenLib/src/Utils/QlpQRCodeGenLibTypes.pas

@@ -16,6 +16,9 @@ uses
 {$ELSEIF DEFINED(LCL)}
   Graphics,
   Interfaces, // Added so that the LCL will Initialize the WidgetSet
+{$ELSEIF DEFINED(FCL)}
+  FPWriteBMP,
+  FPImage, // For FCL Image Support
 {$IFEND}
   SysUtils;
 
@@ -94,27 +97,41 @@ type
   TQRCodeGenLibMatrixInt32Array = array of TQRCodeGenLibInt32Array;
 
 {$ENDIF DELPHIXE_UP}
-  TQRCodeGenLibColor = {$IFNDEF FMX}TColor{$ELSE}TAlphaColor{$ENDIF FMX};
+  TQRCodeGenLibColor =
+{$IF DEFINED(VCL_OR_LCL)}TColor{$ELSEIF DEFINED(FCL)}TFPColor{$ELSEIF DEFINED(FMX)}TAlphaColor{$IFEND VCL_OR_LCL};
+{$IFDEF FCL}
+  TQRCodeGenLibBitmap = TFPCompactImgRGB16Bit;
+{$ELSE}
   TQRCodeGenLibBitmap = TBitmap;
 {$IFNDEF FMX}
-  TQRCodeGenLibPNGImage =
-{$IFDEF FPC}TPortableNetworkGraphic{$ELSE}TPngImage{$ENDIF FPC};
   TQRCodeGenLibJPEGImage = TJPEGImage;
+  TQRCodeGenLibPNGImage =
+{$IFDEF LCL}TPortableNetworkGraphic{$ELSE}TPngImage{$ENDIF LCL};
 {$ELSE}
   TQRCodeGenLibBitmapData = TBitmapData;
   TQRCodeGenLibMapAccess = TMapAccess;
 {$ENDIF FMX}
+{$ENDIF FCL}
+{$IFDEF VCL}
 
 const
-  QRCodeGenLibWhiteColor = {$IFNDEF FMX}clWhite{$ELSE}claWhite{$ENDIF FMX};
-  QRCodeGenLibBlackColor = {$IFNDEF FMX}clBlack{$ELSE}claBlack{$ENDIF FMX};
-
-{$IFDEF VCL}
   TwentyFourBitPixelFormat = pf24bit;
 {$ENDIF VCL}
+function QRCodeGenLibWhiteColor: TQRCodeGenLibColor; inline;
+function QRCodeGenLibBlackColor: TQRCodeGenLibColor; inline;
 
 implementation
 
+function QRCodeGenLibWhiteColor: TQRCodeGenLibColor;
+begin
+  Result := {$IF DEFINED(VCL_OR_LCL)}clWhite{$ELSEIF DEFINED(FCL)}colWhite{$ELSEIF DEFINED(FMX)}claWhite{$IFEND VCL_OR_LCL};
+end;
+
+function QRCodeGenLibBlackColor: TQRCodeGenLibColor;
+begin
+  Result := {$IF DEFINED(VCL_OR_LCL)}clBlack{$ELSEIF DEFINED(FCL)}colBlack{$ELSEIF DEFINED(FMX)}claBlack{$IFEND VCL_OR_LCL};
+end;
+
 {$IFDEF FPC}
 
 initialization