View Issue Details

IDProjectCategoryView StatusLast Update
0035131FPCFCLpublic2019-03-02 15:52
ReporterOndrej PokornyAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityN/A
Status closedResolutionfixed 
Product Version3.3.1Product Build 
Target Version3.2.0Fixed in Version3.3.1 
Summary0035131: fcl-image TFPColor param optimalization with const parameter
DescriptionThe attached patch adds CONST to TFPColor parameters. That reduces execution overhead.
TagsNo tags attached.
Fixed in Revision41550
FPCOldBugId
FPCTarget
Attached Files
  • fpimage-color-const-01.patch (7,823 bytes)
    Index: packages/fcl-image/src/ellipses.pp
    ===================================================================
    --- packages/fcl-image/src/ellipses.pp	(revision 41351)
    +++ packages/fcl-image/src/ellipses.pp	(working copy)
    @@ -19,11 +19,11 @@
     
     uses classes, FPImage, FPCanvas;
     
    -procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
    -procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Width:integer; c:TFPColor);
    -procedure DrawPatternEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TPenPattern; c:TFPColor);
    -procedure FillEllipseColor (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
    -procedure FillEllipsePattern (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TBrushPattern; c:TFPColor);
    +procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; const c:TFPColor);
    +procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Width:integer; const c:TFPColor);
    +procedure DrawPatternEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TPenPattern; const c:TFPColor);
    +procedure FillEllipseColor (Canv:TFPCustomCanvas; const Bounds:TRect; const c:TFPColor);
    +procedure FillEllipsePattern (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TBrushPattern; const c:TFPColor);
     procedure FillEllipseHashHorizontal (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
     procedure FillEllipseHashVertical (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
     procedure FillEllipseHashDiagonal (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
    @@ -317,7 +317,7 @@
     { The drawing routines }
     
     type
    -  TPutPixelProc = procedure (Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
    +  TPutPixelProc = procedure (Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
       TLinePoints = array[0..PatternBitCount-1] of boolean;
       PLinePoints = ^TLinePoints;
     
    @@ -334,31 +334,31 @@
       LinePoints^[0] := (APattern and i) <> 0;
     end;
     
    -procedure PutPixelCopy(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
    +procedure PutPixelCopy(Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
     begin
       with Canv do
         DrawPixel(x,y,color);
     end;
     
    -procedure PutPixelXor(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
    +procedure PutPixelXor(Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
     begin
       with Canv do
         Colors[x,y] := Colors[x,y] xor color;
     end;
     
    -procedure PutPixelOr(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
    +procedure PutPixelOr(Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
     begin
       with Canv do
         Colors[x,y] := Colors[x,y] or color;
     end;
     
    -procedure PutPixelAnd(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
    +procedure PutPixelAnd(Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
     begin
       with Canv do
         Colors[x,y] := Colors[x,y] and color;
     end;
     
    -procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
    +procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; const c:TFPColor);
     var info : TEllipseInfo;
         r, y : integer;
         MyPutPix : TPutPixelProc;
    @@ -387,7 +387,7 @@
         end;
     end;
     
    -procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Width:integer; c:TFPColor);
    +procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Width:integer; const c:TFPColor);
     var infoOut, infoIn : TEllipseInfo;
         r, y : integer;
         id : PEllipseInfoData;
    @@ -430,7 +430,7 @@
         end;
     end;
     
    -procedure DrawPatternEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TPenPattern; c:TFPColor);
    +procedure DrawPatternEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TPenPattern; const c:TFPColor);
     var info : TEllipseInfo;
         xx, y : integer;
         LinePoints : TLinePoints;
    @@ -496,7 +496,7 @@
         end;
     end;
     
    -procedure FillEllipseColor (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
    +procedure FillEllipseColor (Canv:TFPCustomCanvas; const Bounds:TRect; const c:TFPColor);
     var info : TEllipseInfo;
         r, y : integer;
         id : PEllipseInfoData;
    @@ -514,7 +514,7 @@
       end;
     end;
     
    -procedure FillEllipsePattern (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TBrushPattern; c:TFPColor);
    +procedure FillEllipsePattern (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TBrushPattern; const c:TFPColor);
     begin
     end;
     
    Index: packages/fcl-image/src/fpcolcnv.inc
    ===================================================================
    --- packages/fcl-image/src/fpcolcnv.inc	(revision 41351)
    +++ packages/fcl-image/src/fpcolcnv.inc	(working copy)
    @@ -296,7 +296,7 @@
     end;
     *)
     
    -function AlphaBlend(color1, color2: TFPColor): TFPColor;
    +function AlphaBlend(const color1, color2: TFPColor): TFPColor;
     var
       factor1, factor2: single;
     begin
    Index: packages/fcl-image/src/fpimage.pp
    ===================================================================
    --- packages/fcl-image/src/fpimage.pp	(revision 41351)
    +++ packages/fcl-image/src/fpimage.pp	(working copy)
    @@ -286,7 +286,7 @@
     function ConvertColor (const From : TDeviceColor; Fmt : TColorFormat) : TDeviceColor;
     *)
     
    -function AlphaBlend(color1, color2: TFPColor): TFPColor;
    +function AlphaBlend(const color1, color2: TFPColor): TFPColor;
     
     function FPColor (r,g,b,a:word) : TFPColor;
     function FPColor (r,g,b:word) : TFPColor;
    @@ -561,7 +561,7 @@
     { HTML Color support. RRGGBB or color name. Only W3 color names s are supported}
     
     function TryHtmlToFPColor(const S: String; out FPColor: TFPColor): Boolean;
    -function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; Def: TFPColor): TFPColor;
    +function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; const Def: TFPColor): TFPColor;
     function HtmlToFPColor(const S: String): TFPColor;
     
     
    @@ -613,12 +613,12 @@
                 (c.Alpha = d.Alpha);
     end;
     
    -function GetFullColorData (color:TFPColor) : TColorData;
    +function GetFullColorData (const color:TFPColor) : TColorData;
     begin
       result := PColorData(@color)^;
     end;
     
    -function SetFullColorData (color:TColorData) : TFPColor;
    +function SetFullColorData (const color:TColorData) : TFPColor;
     begin
       result := PFPColor (@color)^;
     end;
    @@ -760,7 +760,7 @@
       end;
     end;
     
    -function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; Def: TFPColor): TFPColor;
    +function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; const Def: TFPColor): TFPColor;
     begin
       if not TryHtmlToFPColor(S, Result) then
         Result := Def;
    Index: packages/fcl-image/src/fpwritexpm.pp
    ===================================================================
    --- packages/fcl-image/src/fpwritexpm.pp	(revision 41351)
    +++ packages/fcl-image/src/fpwritexpm.pp	(working copy)
    @@ -28,7 +28,7 @@
           FColorShift : word;
           FColorSize : byte;
           procedure SetColorSize (AValue : byte);
    -      function ColorToHex (c:TFPColor) : string;
    +      function ColorToHex (const c:TFPColor) : string;
         protected
           procedure InternalWrite (Str:TStream; Img:TFPCustomImage); override;
         public
    @@ -61,7 +61,7 @@
         FColorSize := AValue;
     end;
     
    -function TFPWriterXPM.ColorToHex (c:TFPColor) : string;
    +function TFPWriterXPM.ColorToHex (const c:TFPColor) : string;
     var r,g,b : word;
     begin
       with c do
    Index: packages/fcl-image/src/ftfont.pp
    ===================================================================
    --- packages/fcl-image/src/ftfont.pp	(revision 41351)
    +++ packages/fcl-image/src/ftfont.pp	(working copy)
    @@ -349,7 +349,7 @@
     
     procedure TFreeTypeFont.DrawChar (x,y:integer; data:PByteArray; pitch, width, height:integer);
     
    -  procedure Combine (canv:TFPCustomCanvas; x,y:integer; c : TFPColor; t:longword);
    +  procedure Combine (canv:TFPCustomCanvas; x,y:integer; const c : TFPColor; t:longword);
       var
         pixelcolor: TFPColor;
       begin
    

Activities

Ondrej Pokorny

2019-02-21 14:37

developer  

fpimage-color-const-01.patch (7,823 bytes)
Index: packages/fcl-image/src/ellipses.pp
===================================================================
--- packages/fcl-image/src/ellipses.pp	(revision 41351)
+++ packages/fcl-image/src/ellipses.pp	(working copy)
@@ -19,11 +19,11 @@
 
 uses classes, FPImage, FPCanvas;
 
-procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
-procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Width:integer; c:TFPColor);
-procedure DrawPatternEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TPenPattern; c:TFPColor);
-procedure FillEllipseColor (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
-procedure FillEllipsePattern (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TBrushPattern; c:TFPColor);
+procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; const c:TFPColor);
+procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Width:integer; const c:TFPColor);
+procedure DrawPatternEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TPenPattern; const c:TFPColor);
+procedure FillEllipseColor (Canv:TFPCustomCanvas; const Bounds:TRect; const c:TFPColor);
+procedure FillEllipsePattern (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TBrushPattern; const c:TFPColor);
 procedure FillEllipseHashHorizontal (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
 procedure FillEllipseHashVertical (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
 procedure FillEllipseHashDiagonal (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
@@ -317,7 +317,7 @@
 { The drawing routines }
 
 type
-  TPutPixelProc = procedure (Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+  TPutPixelProc = procedure (Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
   TLinePoints = array[0..PatternBitCount-1] of boolean;
   PLinePoints = ^TLinePoints;
 
@@ -334,31 +334,31 @@
   LinePoints^[0] := (APattern and i) <> 0;
 end;
 
-procedure PutPixelCopy(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+procedure PutPixelCopy(Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
 begin
   with Canv do
     DrawPixel(x,y,color);
 end;
 
-procedure PutPixelXor(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+procedure PutPixelXor(Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
 begin
   with Canv do
     Colors[x,y] := Colors[x,y] xor color;
 end;
 
-procedure PutPixelOr(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+procedure PutPixelOr(Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
 begin
   with Canv do
     Colors[x,y] := Colors[x,y] or color;
 end;
 
-procedure PutPixelAnd(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+procedure PutPixelAnd(Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
 begin
   with Canv do
     Colors[x,y] := Colors[x,y] and color;
 end;
 
-procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
+procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; const c:TFPColor);
 var info : TEllipseInfo;
     r, y : integer;
     MyPutPix : TPutPixelProc;
@@ -387,7 +387,7 @@
     end;
 end;
 
-procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Width:integer; c:TFPColor);
+procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Width:integer; const c:TFPColor);
 var infoOut, infoIn : TEllipseInfo;
     r, y : integer;
     id : PEllipseInfoData;
@@ -430,7 +430,7 @@
     end;
 end;
 
-procedure DrawPatternEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TPenPattern; c:TFPColor);
+procedure DrawPatternEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TPenPattern; const c:TFPColor);
 var info : TEllipseInfo;
     xx, y : integer;
     LinePoints : TLinePoints;
@@ -496,7 +496,7 @@
     end;
 end;
 
-procedure FillEllipseColor (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
+procedure FillEllipseColor (Canv:TFPCustomCanvas; const Bounds:TRect; const c:TFPColor);
 var info : TEllipseInfo;
     r, y : integer;
     id : PEllipseInfoData;
@@ -514,7 +514,7 @@
   end;
 end;
 
-procedure FillEllipsePattern (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TBrushPattern; c:TFPColor);
+procedure FillEllipsePattern (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TBrushPattern; const c:TFPColor);
 begin
 end;
 
Index: packages/fcl-image/src/fpcolcnv.inc
===================================================================
--- packages/fcl-image/src/fpcolcnv.inc	(revision 41351)
+++ packages/fcl-image/src/fpcolcnv.inc	(working copy)
@@ -296,7 +296,7 @@
 end;
 *)
 
-function AlphaBlend(color1, color2: TFPColor): TFPColor;
+function AlphaBlend(const color1, color2: TFPColor): TFPColor;
 var
   factor1, factor2: single;
 begin
Index: packages/fcl-image/src/fpimage.pp
===================================================================
--- packages/fcl-image/src/fpimage.pp	(revision 41351)
+++ packages/fcl-image/src/fpimage.pp	(working copy)
@@ -286,7 +286,7 @@
 function ConvertColor (const From : TDeviceColor; Fmt : TColorFormat) : TDeviceColor;
 *)
 
-function AlphaBlend(color1, color2: TFPColor): TFPColor;
+function AlphaBlend(const color1, color2: TFPColor): TFPColor;
 
 function FPColor (r,g,b,a:word) : TFPColor;
 function FPColor (r,g,b:word) : TFPColor;
@@ -561,7 +561,7 @@
 { HTML Color support. RRGGBB or color name. Only W3 color names s are supported}
 
 function TryHtmlToFPColor(const S: String; out FPColor: TFPColor): Boolean;
-function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; Def: TFPColor): TFPColor;
+function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; const Def: TFPColor): TFPColor;
 function HtmlToFPColor(const S: String): TFPColor;
 
 
@@ -613,12 +613,12 @@
             (c.Alpha = d.Alpha);
 end;
 
-function GetFullColorData (color:TFPColor) : TColorData;
+function GetFullColorData (const color:TFPColor) : TColorData;
 begin
   result := PColorData(@color)^;
 end;
 
-function SetFullColorData (color:TColorData) : TFPColor;
+function SetFullColorData (const color:TColorData) : TFPColor;
 begin
   result := PFPColor (@color)^;
 end;
@@ -760,7 +760,7 @@
   end;
 end;
 
-function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; Def: TFPColor): TFPColor;
+function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; const Def: TFPColor): TFPColor;
 begin
   if not TryHtmlToFPColor(S, Result) then
     Result := Def;
Index: packages/fcl-image/src/fpwritexpm.pp
===================================================================
--- packages/fcl-image/src/fpwritexpm.pp	(revision 41351)
+++ packages/fcl-image/src/fpwritexpm.pp	(working copy)
@@ -28,7 +28,7 @@
       FColorShift : word;
       FColorSize : byte;
       procedure SetColorSize (AValue : byte);
-      function ColorToHex (c:TFPColor) : string;
+      function ColorToHex (const c:TFPColor) : string;
     protected
       procedure InternalWrite (Str:TStream; Img:TFPCustomImage); override;
     public
@@ -61,7 +61,7 @@
     FColorSize := AValue;
 end;
 
-function TFPWriterXPM.ColorToHex (c:TFPColor) : string;
+function TFPWriterXPM.ColorToHex (const c:TFPColor) : string;
 var r,g,b : word;
 begin
   with c do
Index: packages/fcl-image/src/ftfont.pp
===================================================================
--- packages/fcl-image/src/ftfont.pp	(revision 41351)
+++ packages/fcl-image/src/ftfont.pp	(working copy)
@@ -349,7 +349,7 @@
 
 procedure TFreeTypeFont.DrawChar (x,y:integer; data:PByteArray; pitch, width, height:integer);
 
-  procedure Combine (canv:TFPCustomCanvas; x,y:integer; c : TFPColor; t:longword);
+  procedure Combine (canv:TFPCustomCanvas; x,y:integer; const c : TFPColor; t:longword);
   var
     pixelcolor: TFPColor;
   begin

Michael Van Canneyt

2019-03-02 13:14

administrator   ~0114559

Applied the patch, thank you very much !

Ondrej Pokorny

2019-03-02 15:52

developer   ~0114570

Thank you!

Issue History

Date Modified Username Field Change
2019-02-21 14:37 Ondrej Pokorny New Issue
2019-02-21 14:37 Ondrej Pokorny File Added: fpimage-color-const-01.patch
2019-02-21 15:02 Michael Van Canneyt Assigned To => Michael Van Canneyt
2019-02-21 15:02 Michael Van Canneyt Status new => assigned
2019-03-02 13:14 Michael Van Canneyt Fixed in Revision => 41550
2019-03-02 13:14 Michael Van Canneyt Note Added: 0114559
2019-03-02 13:14 Michael Van Canneyt Status assigned => resolved
2019-03-02 13:14 Michael Van Canneyt Fixed in Version => 3.3.1
2019-03-02 13:14 Michael Van Canneyt Resolution open => fixed
2019-03-02 13:14 Michael Van Canneyt Target Version => 3.2.0
2019-03-02 15:52 Ondrej Pokorny Note Added: 0114570
2019-03-02 15:52 Ondrej Pokorny Status resolved => closed