Changeset 3 for trunk/UGraphic.pas

Timestamp:

Sep 15, 2014, 11:13:21 PM (10 years ago)

Author:

chronos

Message:

• Modified: Specific TGColor implementation moved to ColorFormats directory.
• Added: Function to clear image with background color.
• Modified: Drawing project image to off screen bitmap to speed up drawing.

File:

• trunk/UGraphic.pas (modified) (11 diffs)

trunk/UGraphic.pas

@@ -30 +30 @@
   TGColorFormatClass = class of TGColorFormat;
 
-  { TGColorFormatRGBA8 }
-
-  TGColorFormatRGBA8 = class(TGColorFormat)
-    function GetPixelSize: Integer; override;
-    function GetBitDepth: Integer; override;
-    function GetName: string; override;
-    function GetChannelBytePos(Channel: TGColorChannel): Integer; override;
-    function GetChannelBitWidth(Channel: TGColorChannel): Integer; override;
-    function ColorToTColor(Color: TGColor): TColor; override;
-    function GetColorClass: TGColorClass; override;
-  end;
-
   { TGColor }
 
   TGColor = class
   private
+    FColorFormat: TGColorFormatClass;
     FData: PByte;
-    FColorFormat: TGColorFormatClass;
     function GetChannel(Channel: TGColorChannel): TGColor;
     procedure SetColorFormat(AValue: TGColorFormatClass);
@@ -56 +44 @@
     procedure Assign(Source: TGColor); virtual;
     property Channels[Channel: TGColorChannel]: TGColor read GetChannel;
+    property Data: PByte read FData;
   published
     property Format: TGColorFormatClass read FColorFormat write SetColorFormat;
@@ -64 +53 @@
   TGBitmap = class
   private
+    FBackgroundColor: TGColor;
     FColorFormat: TGColorFormatClass;
     FDPI: Integer;
@@ -70 +60 @@
     function GetPixel(X, Y: Integer): TGColor;
     function GetSize: TPoint;
+    procedure SetBackgroundColor(AValue: TGColor);
     procedure SetColorFormat(AValue: TGColorFormatClass);
     procedure SetPixel(X, Y: Integer; AValue: TGColor);
@@ -77 +68 @@
     function GetDataSize: Integer;
     procedure PaintToCanvas(Canvas: TCanvas);
+    procedure Clear;
     constructor Create; virtual;
     destructor Destroy; override;
+    property BackgroundColor: TGColor read FBackgroundColor write SetBackgroundColor;
     property DPI: Integer read FDPI write FDPI;
     property ColorFormat: TGColorFormatClass read FColorFormat write SetColorFormat;
@@ -134 +127 @@
 end;
 
-{ TGColorFormatRGBA8 }
-
-function TGColorFormatRGBA8.GetPixelSize: Integer;
-begin
-  Result := 4;
-end;
-
-function TGColorFormatRGBA8.GetBitDepth: Integer;
-begin
-  Result := 32;
-end;
-
-function TGColorFormatRGBA8.GetName: string;
-begin
-  Result := 'RGBA8';
-end;
-
-function TGColorFormatRGBA8.GetChannelBytePos(Channel: TGColorChannel): Integer;
-begin
-  case Channel of
-    ccRed: Result := 0;
-    ccGreen: Result := 1;
-    ccBlue: Result := 2;
-    ccOpacity: Result := 3;
-    else raise Exception.Create('Unsupported color channel');
-  end;
-end;
-
-function TGColorFormatRGBA8.GetChannelBitWidth(Channel: TGColorChannel
-  ): Integer;
-begin
-  if (Channel = ccBlue) or (Channel = ccRed) or (Channel = ccGreen) then
-    Result := 8 else Result := 0;
-end;
-
-function TGColorFormatRGBA8.ColorToTColor(Color: TGColor): TColor;
-begin
-  Result := PByte(Color.FData + GetChannelBytePos(ccRed))^ or
-    (PByte(Color.FData + GetChannelBytePos(ccGreen))^ shl 8) or
-    (PByte(Color.FData + GetChannelBytePos(ccBlue))^ shl 16);
-end;
-
-function TGColorFormatRGBA8.GetColorClass: TGColorClass;
-begin
-  Result := TGColor;
-end;
-
 { TGColorFormat }
 
@@ -286 +232 @@
 end;
 
+procedure TGBitmap.SetBackgroundColor(AValue: TGColor);
+begin
+  if FBackgroundColor = AValue then Exit;
+  FBackgroundColor := AValue;
+end;
+
 procedure TGBitmap.SetColorFormat(AValue: TGColorFormatClass);
 begin
@@ -291 +243 @@
   FColorFormat := AValue;
   ReAllocMem(FData, GetDataSize);
+  FBackgroundColor.Format := ColorFormat;
 end;
 
@@ -328 +281 @@
   Pixel: TGColor;
 begin
+  try
+  Canvas.Lock;
   for Y := 0 to Size.Y - 1 do
     for X := 0 to Size.X - 1 do begin
@@ -334 +289 @@
       Pixel.Free;
     end;
+
+  finally
+    Canvas.Unlock;
+  end;
+end;
+
+procedure TGBitmap.Clear;
+var
+  X, Y: Integer;
+begin
+  for Y := 0 to Size.Y - 1 do
+    for X := 0 to Size.X - 1 do begin
+      Pixels[X, Y] := BackgroundColor;
+    end;
 end;
 
@@ -339 +308 @@
 begin
   FData := GetMem(0);
-  ColorFormat := TGColorFormatRGBA8;
+  FBackgroundColor := TGColor.Create;
+  ColorFormat := TGColorFormat;
+  FBackgroundColor.Format := ColorFormat;
 end;