Changeset 35

Timestamp:

May 4, 2018, 12:56:52 PM (7 years ago)

Author:

chronos

Message:

• Fixed: Do not allocate big temp image for drawing on screen of zoomed out image.

Location:

trunk

Files:

• Forms/UFormMain.lfm (modified) (3 diffs)
• Forms/UFormMain.pas (modified) (3 diffs)
• LibrePaint.lpi (modified) (2 diffs)
• LibrePaint.res (modified) ( previous)
• Packages/FastGraphics/UGGraphics.pas (modified) (10 diffs)

trunk/Forms/UFormMain.lfm

@@ -1 +1 @@
 object FormMain: TFormMain
-  Left = 664
+  Left = 648
   Height = 640
-  Top = 382
+  Top = 323
   Width = 920
   Caption = 'LibrePaint'
-  ClientHeight = 608
+  ClientHeight = 615
   ClientWidth = 920
+  DesignTimePPI = 120
   Menu = MainMenu1
   OnActivate = FormActivate
@@ -13 +14 @@
   OnDestroy = FormDestroy
   OnShow = FormShow
-  LCLVersion = '1.6.0.4'
+  LCLVersion = '1.8.2.0'
   object PaintBox1: TPaintBox
     Left = 0
-    Height = 554
+    Height = 561
     Top = 26
     Width = 920
@@ -32 +33 @@
     Left = 0
     Height = 28
-    Top = 580
+    Top = 587
     Width = 920
     Panels = <    
       item
-        Width = 200
+        Width = 300
       end    
       item

trunk/Forms/UFormMain.pas

@@ -135 +135 @@
     StatusBar1.Panels[0].Text := '[' + IntToStr(Pos.X) + ', ' + IntToStr(Pos.Y) + '] Zoom:' +
       FloatToStr(Core.Project.View.Zoom);
-    StatusBar1.Panels[1].Text := 'Src: ' + IntToStr(View.SrcRect.Right - View.SrcRect.Left) + ', ' +
+    StatusBar1.Panels[1].Text := 'Src: ' + IntToStr(View.SrcRect.Left) + ', ' +
+      IntToStr(View.SrcRect.Top) + ', ' +
+      IntToStr(View.SrcRect.Right - View.SrcRect.Left) + ', ' +
       IntToStr(View.SrcRect.Bottom - View.SrcRect.Top);
-    StatusBar1.Panels[2].Text := 'Dst: ' + IntToStr(View.DestRect.Right - View.DestRect.Left) + ', ' +
+    StatusBar1.Panels[2].Text := 'Dst: ' + IntToStr(View.DestRect.Left) + ', ' +
+      IntToStr(View.DestRect.Top) + ', ' +
+      IntToStr(View.DestRect.Right - View.DestRect.Left) + ', ' +
       IntToStr(View.DestRect.Bottom - View.DestRect.Top);
   end;
@@ -150 +154 @@
 begin
   with Core.Project do begin
-    TempBitmap.SetSize(View.SrcRect.Right - View.SrcRect.Left,
-      View.SrcRect.Bottom - View.SrcRect.Top);
+    //TempBitmap.SetSize(View.SrcRect.Right - View.SrcRect.Left,
+    //  View.SrcRect.Bottom - View.SrcRect.Top);
+    TempBitmap.SetSize(PaintBox1.Width, PaintBox1.Height);
     //TempBitmap.BeginUpdate(True);
     TempBitmap.Canvas.Brush.Color := clBlack;
@@ -158 +163 @@
    // Bitmap.PaintToCanvas(TempBitmap.Canvas, View.SrcRect);
    // if EnableDraw then
-      Bitmap.PaintToBitmap(TempBitmap, View.SrcRect);
+    Bitmap.PaintToBitmap(TempBitmap, View.SrcRect);
+      //StatusBar1.Panels[0].Text := IntToStr(TempBitmap.Width) + ', ' + IntToStr(TempBitmap.Height);
     //TempBitmap.EndUpdate(False);
-    PaintBox1.Canvas.StretchDraw(View.DestRect, TempBitmap);
+    PaintBox1.Canvas.Draw(0, 0, TempBitmap);
     //PaintBox1.Canvas.Draw(0, 0, TempBitmap);
   end;

trunk/LibrePaint.lpi

@@ -2 +2 @@
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="10"/>
     <General>
       <SessionStorage Value="InProjectDir"/>
@@ -14 +14 @@
       <EnableI18N LFM="False"/>
     </i18n>
-    <VersionInfo>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
     <BuildModes Count="2">
       <Item1 Name="Debug" Default="True"/>

trunk/Packages/FastGraphics/UGGraphics.pas

@@ -51 +51 @@
       TGConvertFromColor = function (Color: TColor): TGColor of object;
       TGGetColor = function (Position: TPoint): TGColor of object;
+      PGColor = ^TGColor;
   protected
     FData: PByte;
     FSize: TPoint;
     FCanvas: TGCanvas<TGColor>;
+    FBytesPerLine: Integer;
+    FBytesPerPixel: Integer;
     function GetPixel(X, Y: Integer): TGColor; virtual;
     function GetSize: TPoint; virtual;
@@ -66 +69 @@
     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 PaintToBitmap(Bitmap: TBitmap; Pos: TPoint; ColorConvertFunc: TGConvertColor); overload;
+    procedure PaintToBitmap(Bitmap: TBitmap; Rect: TRect; ColorConvertFunc: TGConvertColor); overload;
     procedure LoadFromCanvas(Canvas: TCanvas; ColorConvertFunc: TGConvertFromColor); overload;
     procedure LoadFromBitmap(Bitmap: TBitmap; ColorConvertFunc: TGConvertFromColor);
@@ -96 +100 @@
   end;
 
+  { TPixelPointer }
+
+  TPixelPointer = record
+    Base: Pointer;
+    Pixel: Pointer;
+    Line: Pointer;
+    BytesPerPixel: Integer;
+    BytesPerLine: Integer;
+    procedure NextLine; inline; // Move pointer to start of new base line
+    procedure NextPixel; inline; // Move pointer to next pixel
+    procedure SetXY(X, Y: Integer); inline; // Set pixel position relative to base
+    procedure SetX(X: Integer); inline; // Set horizontal pixel position relative to base
+    procedure Init(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0); inline; overload;
+    procedure Init(Base: Pointer; BytesPerLine, BytesPerPixel: Integer; BaseX: Integer = 0; BaseY: Integer = 0); inline; overload;
+ end;
+
 
 implementation
 
+{ TPixelPointer }
+
+procedure TPixelPointer.NextLine; inline;
+begin
+  Line := Pointer(Line) + BytesPerLine;
+  Pixel := Line;
+end;
+
+procedure TPixelPointer.NextPixel; inline;
+begin
+  Pixel := Pointer(Pixel) + BytesPerPixel;
+end;
+
+procedure TPixelPointer.SetXY(X, Y: integer); inline;
+begin
+  Line := Pointer(Base) + Y * BytesPerLine;
+  SetX(X);
+end;
+
+procedure TPixelPointer.SetX(X: Integer); inline;
+begin
+  Pixel := Pointer(Line) + X * BytesPerPixel;
+end;
+
+procedure TPixelPointer.Init(Bitmap: TRasterImage; BaseX: Integer = 0;
+  BaseY: Integer = 0); inline;
+begin
+  Init(Bitmap.RawImage.Data, Bitmap.RawImage.Description.BytesPerLine, Bitmap.RawImage.Description.BitsPerPixel shr 3, BaseX, BaseY);
+end;
+
+procedure TPixelPointer.Init(Base: Pointer; BytesPerLine, BytesPerPixel: Integer; BaseX: Integer = 0; BaseY: Integer = 0); inline; overload;
+begin
+  Self.BytesPerLine := BytesPerLine;
+  Self.BytesPerPixel := BytesPerPixel;
+  Self.Base := Pointer(Base + BaseX * BytesPerPixel + BaseY * BytesPerLine);
+  SetXY(0, 0);
+end;
+
 { TGPixmap }
 
@@ -104 +162 @@
 begin
   CheckLimits(X, Y);
-  Move(PByte(FData + (X + Y * FSize.X) * SizeOf(TGColor))^, Result, SizeOf(TGColor));
+  Move(PByte(FData + X * FBytesPerPixel + Y * FBytesPerLine)^, Result, SizeOf(TGColor));
 end;
 
@@ -110 +168 @@
 begin
   CheckLimits(X, Y);
-  Move(AValue, PByte(FData + (X + Y * FSize.X) * SizeOf(TGColor))^, SizeOf(TGColor));
+  Move(AValue, PByte(FData + X * FBytesPerPixel + Y * FBytesPerLine)^, SizeOf(TGColor));
 end;
 
@@ -122 +180 @@
   if (FSize.X <> AValue.X) and (FSize.Y <> AValue.Y) then begin
     FSize := AValue;
-    ReAllocMem(FData, FSize.X * FSize.Y * SizeOf(TGColor));
+    FBytesPerPixel := SizeOf(TGColor);
+    FBytesPerLine := AValue.X * FBytesPerPixel;
+    ReAllocMem(FData, FSize.X * FBytesPerLine);
   end;
 end;
@@ -128 +188 @@
 constructor TGPixmap<TGColor>.Create;
 begin
+  Size := Point(0, 0);
   FCanvas := TGCanvas<TGColor>.Create;
   FCanvas.Bitmap := Self;
@@ -195 +256 @@
 end;
 
+procedure TGPixmap<TGColor>.PaintToBitmap(Bitmap: TBitmap; Pos: TPoint;
+  ColorConvertFunc: TGConvertColor);
+var
+  X, Y: Integer;
+  DstPtr: TPixelPointer;
+  SrcPtr: TPixelPointer;
+begin
+  try
+    Bitmap.BeginUpdate(False);
+    DstPtr.Init(Bitmap);
+    SrcPtr.Init(FData, FBytesPerLine, FBytesPerPixel, Pos.X, Pos.Y);
+    for Y := 0 to Bitmap.Height - 1 do begin
+      for X := 0 to Bitmap.Width - 1 do begin
+        if ((X + Pos.X) >= 0) and ((X + Pos.X) < FSize.X) and
+        ((Y + Pos.Y) >= 0) and ((Y + Pos.Y) < FSize.Y) then begin
+          PInteger(DstPtr.Pixel)^ := ColorConvertFunc(PGColor(SrcPtr.Pixel)^);
+        end;
+        DstPtr.NextPixel;
+        SrcPtr.NextPixel;
+      end;
+      DstPtr.NextLine;
+      SrcPtr.NextLine;
+    end;
+  finally
+    Bitmap.EndUpdate(False);
+  end;
+end;
+
 procedure TGPixmap<TGColor>.PaintToBitmap(Bitmap: TBitmap; Rect: TRect;
   ColorConvertFunc: TGConvertColor);
 var
   X, Y: Integer;
-  PixelPtr: PInteger;
-  PixelPtrMax: PInteger;
-  PixelPtrMin: PInteger;
-  PixelRowPtr: PInteger;
-  RawImage: TRawImage;
-  BytePerPixel: Integer;
+  DstPtr: TPixelPointer;
+  ZoomX: Single;
+  ZoomY: Single;
+  SrcX: Integer;
+  SrcY: Integer;
 begin
   try
     Bitmap.BeginUpdate(False);
-    RawImage := Bitmap.RawImage;
-    PixelRowPtr := PInteger(RawImage.Data);
-    BytePerPixel := RawImage.Description.BitsPerPixel div 8;
-    PixelPtrMin := PixelRowPtr;
-    PixelPtrMax := PixelRowPtr + RawImage.Description.Width * RawImage.Description.Height * BytePerPixel;
+    DstPtr.Init(Bitmap);
+    ZoomX := Bitmap.Width / (Rect.Right - Rect.Left);
+    ZoomY := Bitmap.Height / (Rect.Bottom - Rect.Top);
     for Y := 0 to Bitmap.Height - 1 do begin
-      PixelPtr := PixelRowPtr;
+      SrcY := Trunc(Y / ZoomY + Rect.Top);
       for X := 0 to Bitmap.Width - 1 do begin
-        if ((X + Rect.Left) >= 0) and ((X + Rect.Left) < FSize.X) and
-        ((Y + Rect.Top) >= 0) and ((Y + Rect.Top) < FSize.Y) and
-        (PixelPtr < PixelPtrMax) and (PixelPtr >= PixelPtrMin) then begin
-          PixelPtr^ := ColorConvertFunc(Pixels[X + Rect.Left, Y + Rect.Top]);
+        SrcX := Trunc(X / ZoomX + Rect.Left);
+        if (SrcX >= 0) and (SrcX < FSize.X) and
+        (SrcY >= 0) and (SrcY < FSize.Y) then begin
+          PInteger(DstPtr.Pixel)^ := ColorConvertFunc(Pixels[SrcX, SrcY]);
         end;
-        Inc(PByte(PixelPtr), BytePerPixel);
+        DstPtr.NextPixel;
       end;
-      Inc(PByte(PixelRowPtr), RawImage.Description.BytesPerLine);
+      DstPtr.NextLine;
     end;
   finally
@@ -248 +334 @@
 var
   X, Y: Integer;
-  PixelPtr: PInteger;
-  PixelPtrMax: PInteger;
-  PixelRowPtr: PInteger;
-  P: TPixelFormat;
-  RawImage: TRawImage;
-  BytePerPixel: Integer;
+  SrcPtr: TPixelPointer;
+  DstPtr: TPixelPointer;
 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;
+    SrcPtr.Init(Bitmap);
+    DstPtr.Init(FData, FBytesPerLine, FBytesPerPixel);
     for Y := 0 to FSize.Y - 1 do begin
-      PixelPtr := PixelRowPtr;
       for X := 0 to FSize.X - 1 do begin
-        if (X >= 0) and (X < FSize.X) and (Y >= 0) and (Y < FSize.Y) and (PixelPtr < PixelPtrMax) then
-          Pixels[X, Y] := ColorConvertFunc(PixelPtr^);
-        Inc(PByte(PixelPtr), BytePerPixel);
+        if (X >= 0) and (X < FSize.X) and (Y >= 0) and (Y < FSize.Y) then
+          PInteger(DstPtr.Pixel)^ := ColorConvertFunc(PInteger(SrcPtr.Pixel)^);
+        SrcPtr.NextPixel;
+        DstPtr.NextPixel;
       end;
-      Inc(PByte(PixelRowPtr), RawImage.Description.BytesPerLine);
+      SrcPtr.NextLine;
+      DstPtr.NextLine;
     end;
   finally
@@ -277 +358 @@
 function TGPixmap<TGColor>.GetDataSize: Int64;
 begin
-  Result := FSize.X * FSize.Y * SizeOf(TGColor);
+  Result := FSize.Y * FBytesPerLine;
 end;