Changeset 27 for trunk

Timestamp:

Dec 22, 2016, 5:35:25 PM (8 years ago)

Author:

chronos

Message:

• Modified: Use faster drawing to TBitmap RawImage.

Location:

trunk

Files:

• Forms/UFormMain.pas (modified) (2 diffs)
• Packages/FastGraphics/ColorFormats/UColorRGB8.pas (modified) (3 diffs)
• Packages/FastGraphics/UFGraphics.pas (modified) (4 diffs)
• Packages/FastGraphics/UGGraphics.pas (modified) (3 diffs)
• UCore.pas (modified) (1 diff)

trunk/Forms/UFormMain.pas

@@ -64 +64 @@
     MousePos: TPoint;
     Activated: Boolean;
+  public
     procedure EraseBackground(DC: HDC); override;
-  public
     procedure UpdateStatusBar;
     procedure Redraw;
@@ -120 +120 @@
     TempBitmap.SetSize(View.SrcRect.Right - View.SrcRect.Left,
       View.SrcRect.Bottom - View.SrcRect.Top);
-    TempBitmap.BeginUpdate(True);
+    //TempBitmap.BeginUpdate(True);
     TempBitmap.Canvas.Brush.Color := clBlack;
     TempBitmap.Canvas.FillRect(0, 0, TempBitmap.Width, TempBitmap.Height);
     View.DestRect := Bounds(0, 0, PaintBox1.Width, PaintBox1.Height);
-    Bitmap.PaintToCanvas(TempBitmap.Canvas, View.SrcRect);
-    TempBitmap.EndUpdate(False);
+    //Bitmap.PaintToCanvas(TempBitmap.Canvas, View.SrcRect);
+    Bitmap.PaintToBitmap(TempBitmap, View.SrcRect);
+    //TempBitmap.EndUpdate(False);
     PaintBox1.Canvas.StretchDraw(View.DestRect, TempBitmap);
     //PaintBox1.Canvas.Draw(0, 0, TempBitmap);

trunk/Packages/FastGraphics/ColorFormats/UColorRGB8.pas

@@ -54 +54 @@
     procedure PaintToCanvas(Canvas: TCanvas); override;
     procedure PaintToCanvas(Canvas: TCanvas; Rect: TRect); override;
+    procedure PaintToBitmap(Bitmap: TBitmap; Rect: TRect); override;
     procedure LoadFromCanvas(Canvas: TCanvas); override;
     function GetDataSize: Integer; override;
@@ -91 +92 @@
 function TPixmapRGB8.RGB8ToColor(Value: TColorRGB8): TColor;
 begin
-  Result := (Value.R shl 16) or (Value.G shl 8) or (Value.B shl 0);
+  Result := (Value.B shl 16) or (Value.G shl 8) or (Value.R shl 0);
 end;
 
@@ -159 +160 @@
 end;
 
+procedure TBPixmapRGB8.PaintToBitmap(Bitmap: TBitmap; Rect: TRect);
+begin
+  Pixmap.PaintToBitmap(Bitmap, Rect, Pixmap.RGB8ToColor);
+end;
+
 procedure TBPixmapRGB8.LoadFromCanvas(Canvas: TCanvas);
 begin

trunk/Packages/FastGraphics/UFGraphics.pas

@@ -43 +43 @@
     procedure PaintToCanvas(Canvas: TCanvas); virtual; overload;
     procedure PaintToCanvas(Canvas: TCanvas; Rect: TRect); virtual; overload;
+    procedure PaintToBitmap(Bitmap: TBitmap; Rect: TRect); virtual;
     procedure LoadFromCanvas(Canvas: TCanvas); virtual;
     function GetDataSize: Integer; virtual;
@@ -171 +172 @@
     procedure PaintToCanvas(Canvas: TCanvas); overload;
     procedure PaintToCanvas(Canvas: TCanvas; Rect: TRect); overload;
+    procedure PaintToBitmap(Bitmap: TBitmap; Rect: TRect); overload;
     procedure LoadFromCanvas(Canvas: TCanvas);
     function GetDataSize: Integer;
@@ -373 +375 @@
 end;
 
+procedure TBImage.PaintToBitmap(Bitmap: TBitmap; Rect: TRect);
+begin
+end;
+
 procedure TBImage.LoadFromCanvas(Canvas: TCanvas);
 begin
@@ -479 +485 @@
 begin
   FBackend.PaintToCanvas(Canvas, Rect);
+end;
+
+procedure TFPixmap.PaintToBitmap(Bitmap: TBitmap; Rect: TRect);
+begin
+  FBackend.PaintToBitmap(Bitmap, Rect);
 end;
 

trunk/Packages/FastGraphics/UGGraphics.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Graphics;
+  Classes, SysUtils, Graphics, GraphType;
 
 type
@@ -66 +66 @@
     procedure PaintToCanvas(Canvas: TCanvas; ColorConvertFunc: TGConvertColor); overload;
     procedure PaintToCanvas(Canvas: TCanvas; Rect: TRect; ColorConvertFunc: TGConvertColor); overload;
+    procedure PaintToBitmap(Bitmap: TBitmap; Rect: TRect; ColorConvertFunc: TGConvertColor);
     procedure LoadFromCanvas(Canvas: TCanvas; ColorConvertFunc: TGConvertFromColor); overload;
     procedure Fill(Color: TGColor); overload;
@@ -191 +192 @@
 end;
 
+procedure TGPixmap<TGColor>.PaintToBitmap(Bitmap: TBitmap; Rect: TRect;
+  ColorConvertFunc: TGConvertColor);
+var
+  X, Y: Integer;
+  PixelPtr: PInteger;
+  PixelPtrMax: PInteger;
+  PixelRowPtr: PInteger;
+  P: TPixelFormat;
+  RawImage: TRawImage;
+  BytePerPixel: Integer;
+begin
+  try
+    Bitmap.BeginUpdate(False);
+    RawImage := Bitmap.RawImage;
+    PixelRowPtr := PInteger(RawImage.Data);
+    BytePerPixel := RawImage.Description.BitsPerPixel div 8;
+    PixelPtrMax := PixelRowPtr + RawImage.Description.Width * RawImage.Description.Height * BytePerPixel;
+    for Y := Rect.Top to Rect.Bottom - 1 do begin
+      PixelPtr := PixelRowPtr;
+      for X := Rect.Left to Rect.Right - 1 do begin
+        if (X >= 0) and (X < FSize.X) and (Y >= 0) and (Y < FSize.Y) and (PixelPtr < PixelPtrMax) then
+          PixelPtr^ := ColorConvertFunc(Pixels[X, Y]);
+        Inc(PByte(PixelPtr), BytePerPixel);
+
+      end;
+      Inc(PByte(PixelRowPtr), RawImage.Description.BytesPerLine);
+    end;
+  finally
+    Bitmap.EndUpdate(False);
+  end;
+end;
+
 procedure TGPixmap<TGColor>.LoadFromCanvas(Canvas: TCanvas; ColorConvertFunc: TGConvertFromColor); overload;
 var

trunk/UCore.pas

@@ -207 +207 @@
 begin
   Project.Bitmap.Clear;
-  TFColor(Project.Bitmap.Canvas.Pen.Color).ColorFormat := Project.Bitmap.ColorFormat;
-  TFColor(Project.Bitmap.Canvas.Pen.Color).SetColorName(cnWhite);
+  (Project.Bitmap.Canvas.Pen.Color as TFColor).ColorFormat := Project.Bitmap.ColorFormat;
+  (Project.Bitmap.Canvas.Pen.Color as TFColor).SetColorName(cnWhite);
   Project.Bitmap.Canvas.Pen.MoveTo(Point(80, 80));
   Project.Bitmap.Canvas.Pen.LineTo(Point(50, 20));