Changeset 30

Timestamp:

Dec 23, 2016, 10:07:39 AM (7 years ago)

Author:

chronos

Message:

• Modified: Drawing and loading using bitmap rawimage improvement.

Location:

trunk

Files:

• Forms/UFormMain.lfm (modified) (2 diffs)
• Forms/UFormMain.pas (modified) (2 diffs)
• Forms/UFormNew.pas (modified) (1 diff)
• LibrePaint.lpi (modified) (1 diff)
• LibrePaint.lpr (modified) (1 diff)
• Packages/FastGraphics/ColorFormats/UColorGray1.pas (modified) (2 diffs)
• Packages/FastGraphics/ColorFormats/UColorGray2.pas (modified) (2 diffs)
• Packages/FastGraphics/ColorFormats/UColorGray4.pas (modified) (3 diffs)
• Packages/FastGraphics/UGGraphics.pas (modified) (2 diffs)
• UCore.lfm (modified) (3 diffs)
• UCore.pas (modified) (2 diffs)

trunk/Forms/UFormMain.lfm

@@ -16 +16 @@
   object PaintBox1: TPaintBox
     Left = 0
-    Height = 587
-    Top = 0
+    Height = 561
+    Top = 26
     Width = 920
     Align = alClient
@@ -39 +39 @@
       end>
     SimplePanel = False
+  end
+  object ToolBar1: TToolBar
+    Left = 0
+    Height = 26
+    Top = 0
+    Width = 920
+    Caption = 'ToolBar1'
+    TabOrder = 1
+    object ToolButton1: TToolButton
+      Left = 1
+      Top = 2
+      Action = Core.AFileNew
+    end
   end
   object MainMenu1: TMainMenu

trunk/Forms/UFormMain.pas

@@ -40 +40 @@
     StatusBar1: TStatusBar;
     Timer1: TTimer;
+    ToolBar1: TToolBar;
+    ToolButton1: TToolButton;
     procedure FormActivate(Sender: TObject);
     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
@@ -134 +136 @@
     View.DestRect := Bounds(0, 0, PaintBox1.Width, PaintBox1.Height);
     //Bitmap.PaintToCanvas(TempBitmap.Canvas, View.SrcRect);
-    //Bitmap.PaintToBitmap(TempBitmap, View.SrcRect);
+    Bitmap.PaintToBitmap(TempBitmap, View.SrcRect);
     //TempBitmap.EndUpdate(False);
     PaintBox1.Canvas.StretchDraw(View.DestRect, TempBitmap);

trunk/Forms/UFormNew.pas

@@ -74 +74 @@
 
   // Default
-  SpinEditWidth.Value := 200;
-  SpinEditHeight.Value := 100;
+  if Assigned(Core.Project) then begin
+    SpinEditWidth.Value := Core.Project.Bitmap.Size.X;
+    SpinEditHeight.Value := Core.Project.Bitmap.Size.Y;
+  end else begin
+    SpinEditWidth.Value := 200;
+    SpinEditHeight.Value := 100;
+  end;
   SpinEditDPI.Value := 72;
 end;

trunk/LibrePaint.lpi

@@ -141 +141 @@
         <StackChecks Value="True"/>
       </Checks>
+      <VerifyObjMethodCallValidity Value="True"/>
     </CodeGeneration>
     <Linking>
-      <Debugging>
-        <UseHeaptrc Value="True"/>
-      </Debugging>
       <Options>
         <Win32>

trunk/LibrePaint.lpr

@@ -22 +22 @@
   // Heap trace
   DeleteFile(ExtractFilePath(ParamStr(0)) + HeapTraceLog);
-  SetHeapTraceOutput(ExtractFilePath(ParamStr(0)) + HeapTraceLog);
+  //SetHeapTraceOutput(ExtractFilePath(ParamStr(0)) + HeapTraceLog);
   {$ENDIF}
 

trunk/Packages/FastGraphics/ColorFormats/UColorGray1.pas

@@ -50 +50 @@
     procedure PaintToCanvas(Canvas: TCanvas); override;
     procedure PaintToCanvas(Canvas: TCanvas; Rect: TRect); override;
+    procedure PaintToBitmap(Bitmap: TBitmap; Rect: TRect); override;
     procedure LoadFromCanvas(Canvas: TCanvas); override;
+    procedure LoadFromBitmap(Bitmap: TBitmap); override;
     function GetDataSize: Integer; override;
     constructor Create; override;
@@ -158 +160 @@
 end;
 
+procedure TBPixmapGray1.PaintToBitmap(Bitmap: TBitmap; Rect: TRect);
+begin
+  Pixmap.PaintToBitmap(Bitmap, Rect, Pixmap.Gray1ToColor);
+end;
+
 procedure TBPixmapGray1.LoadFromCanvas(Canvas: TCanvas);
 begin
   Pixmap.LoadFromCanvas(Canvas, Pixmap.ColorToGray1);
+end;
+
+procedure TBPixmapGray1.LoadFromBitmap(Bitmap: TBitmap);
+begin
+  Pixmap.LoadFromBitmap(Bitmap, Pixmap.ColorToGray1);
 end;
 

trunk/Packages/FastGraphics/ColorFormats/UColorGray2.pas

@@ -50 +50 @@
     procedure PaintToCanvas(Canvas: TCanvas); override;
     procedure PaintToCanvas(Canvas: TCanvas; Rect: TRect); override;
+    procedure PaintToBitmap(Bitmap: TBitmap; Rect: TRect); override;
     procedure LoadFromCanvas(Canvas: TCanvas); override;
+    procedure LoadFromBitmap(Bitmap: TBitmap); override;
     function GetDataSize: Integer; override;
     constructor Create; override;
@@ -148 +150 @@
 end;
 
+procedure TBPixmapGray2.PaintToBitmap(Bitmap: TBitmap; Rect: TRect);
+begin
+  Pixmap.PaintToBitmap(Bitmap, Rect, Pixmap.Gray2ToColor);
+end;
+
 procedure TBPixmapGray2.LoadFromCanvas(Canvas: TCanvas);
 begin
   Pixmap.LoadFromCanvas(Canvas, Pixmap.ColorToGray2);
+end;
+
+procedure TBPixmapGray2.LoadFromBitmap(Bitmap: TBitmap);
+begin
+  Pixmap.LoadFromBitmap(Bitmap, Pixmap.ColorToGray2);
 end;
 

trunk/Packages/FastGraphics/ColorFormats/UColorGray4.pas

@@ -17 +17 @@
   TColorGray4 = Byte;
 
+  { TPixmapGray4 }
+
   TPixmapGray4 = class(TGPixmapBit<TColorGray4>)
     function Gray4ToColor(Value: TColorGray4): TColor;
+    function ColorToGray4(Value: TColor): TColorGray4;
+  end;
+
+  { TBColorGray4 }
+
+  TBColorGray4 = class(TBColor)
+    Value: TColorGray4;
+    constructor Create(Color: TColorGray4);
+    procedure SetColorName(ColorName: TColorName); override;
+    procedure SetRandom; override;
+  end;
+
+  { TBPixmapGray4 }
+
+  TBPixmapGray4 = class(TBImage)
+  private
+    FillCallBack: TGetColorPos;
+    function FillGetColor(Position: TPoint): TColorGray4;
+  protected
+    procedure SetSize(AValue: TPoint); override;
+    function GetPixel(X, Y: Integer): IBColor;  override;
+    procedure SetPixel(X, Y: Integer; AValue: IBColor); override;
+  public
+    Pixmap: TPixmapGray4;
+    procedure Fill(Color: IBColor); override;
+    procedure Fill(Func: TGetColorPos); override;
+    procedure Line(P1, P2: TPoint; Color: IBColor); override;
+    procedure PaintToCanvas(Canvas: TCanvas); override;
+    procedure PaintToCanvas(Canvas: TCanvas; Rect: TRect); override;
+    procedure PaintToBitmap(Bitmap: TBitmap; Rect: TRect); override;
+    procedure LoadFromCanvas(Canvas: TCanvas); override;
+    procedure LoadFromBitmap(Bitmap: TBitmap); override;
+    function GetDataSize: Integer; override;
+    constructor Create; override;
+    destructor Destroy; override;
   end;
 
@@ -32 +69 @@
   Name := 'Gray 4-bit';
   BitDepth := 4;
+  BackendColorClass := TBColorGray4;
+  BackendImageClass := TBPixmapGray4;
   AddChannel('Gray', 0, 4);
 end;
@@ -43 +82 @@
 end;
 
+function TPixmapGray4.ColorToGray4(Value: TColor): TColorGray4;
+begin
+  Result := Trunc((((Value shr 16) and $ff) + ((Value shr 8) and $ff) + ((Value shr 0) and $ff)) / $300 * 16);
+end;
+
+{ TBColorGray2 }
+
+constructor TBColorGray4.Create(Color: TColorGray4);
+begin
+  Value := Color;
+end;
+
+procedure TBColorGray4.SetColorName(ColorName: TColorName);
+begin
+  case ColorName of
+    cnBlack: Value := 0;
+    cnGray: Value := 6;
+    cnSilver: Value := 10;
+    cnWhite: Value := 15;
+    else Value := 0;
+  end;
+end;
+
+procedure TBColorGray4.SetRandom;
+begin
+  Value := Random(16);
+end;
+
+{ TBPixmapGray2 }
+
+function TBPixmapGray4.FillGetColor(Position: TPoint): TColorGray4;
+begin
+  Result := (FillCallBack(Position) as TBColorGray4).Value;
+end;
+
+procedure TBPixmapGray4.SetSize(AValue: TPoint);
+begin
+  inherited;
+  Pixmap.Size := AValue;
+end;
+
+function TBPixmapGray4.GetPixel(X, Y: Integer): IBColor;
+begin
+  Result := TBColorGray4.Create(Pixmap.Pixels[X, Y]);
+end;
+
+procedure TBPixmapGray4.SetPixel(X, Y: Integer; AValue: IBColor);
+begin
+  Pixmap.Pixels[X, Y] := (AValue as TBColorGray4).Value;
+end;
+
+procedure TBPixmapGray4.Fill(Color: IBColor);
+begin
+  if Color is TBColorGray4 then
+    Pixmap.Fill((Color as TBColorGray4).Value);
+end;
+
+procedure TBPixmapGray4.Fill(Func: TGetColorPos);
+begin
+  FillCallBack := Func;
+  Pixmap.Fill(FillGetColor);
+end;
+
+procedure TBPixmapGray4.Line(P1, P2: TPoint; Color: IBColor);
+begin
+  Pixmap.Canvas.Pen.Color := (Color as TBColorGray4).Value;
+  Pixmap.Canvas.Pen.MoveTo(P1);
+  Pixmap.Canvas.Pen.LineTo(P2);
+end;
+
+procedure TBPixmapGray4.PaintToCanvas(Canvas: TCanvas);
+begin
+  Pixmap.PaintToCanvas(Canvas, Pixmap.Gray4ToColor);
+end;
+
+procedure TBPixmapGray4.PaintToCanvas(Canvas: TCanvas; Rect: TRect);
+begin
+  Pixmap.PaintToCanvas(Canvas, Rect, Pixmap.Gray4ToColor);
+end;
+
+procedure TBPixmapGray4.PaintToBitmap(Bitmap: TBitmap; Rect: TRect);
+begin
+  Pixmap.PaintToBitmap(Bitmap, Rect, Pixmap.Gray4ToColor);
+end;
+
+procedure TBPixmapGray4.LoadFromCanvas(Canvas: TCanvas);
+begin
+  Pixmap.LoadFromCanvas(Canvas, Pixmap.ColorToGray4);
+end;
+
+procedure TBPixmapGray4.LoadFromBitmap(Bitmap: TBitmap);
+begin
+  Pixmap.LoadFromBitmap(Bitmap, Pixmap.ColorToGray4);
+end;
+
+function TBPixmapGray4.GetDataSize: Integer;
+begin
+  Result := Pixmap.GetDataSize;
+end;
+
+constructor TBPixmapGray4.Create;
+begin
+  Pixmap := TPixmapGray4.Create;
+  Pixmap.BitsPerPixel := 4;
+end;
+
+destructor TBPixmapGray4.Destroy;
+begin
+  FreeAndNil(Pixmap);
+  inherited;
+end;
+
+
 end.
 

trunk/Packages/FastGraphics/UGGraphics.pas

@@ -199 +199 @@
   PixelPtr: PInteger;
   PixelPtrMax: PInteger;
+  PixelPtrMin: PInteger;
   PixelRowPtr: PInteger;
   P: TPixelFormat;
@@ -209 +210 @@
     PixelRowPtr := PInteger(RawImage.Data);
     BytePerPixel := RawImage.Description.BitsPerPixel div 8;
+    PixelPtrMin := PixelRowPtr;
     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
+        if (X >= 0) and (X < FSize.X) and (Y >= 0) and (Y < FSize.Y) and
+        (PixelPtr < PixelPtrMax) and (PixelPtr > PixelPtrMin) then
           PixelPtr^ := ColorConvertFunc(Pixels[X, Y]);
         Inc(PByte(PixelPtr), BytePerPixel);

trunk/UCore.lfm

@@ -11 +11 @@
     left = 201
     top = 160
-    object AFileNew: TAction
-      Category = 'File'
-      Caption = 'New...'
-      OnExecute = AFileNewExecute
-    end
     object AExit: TAction
       Caption = 'Exit'
@@ -47 +42 @@
       OnExecute = AZoomNormalExecute
     end
+    object AFileNew: TAction
+      Category = 'File'
+      Caption = 'New...'
+      OnExecute = AFileNewExecute
+      ShortCut = 16462
+    end
     object AFileOpen: TAction
       Category = 'File'
       Caption = 'Open...'
       OnExecute = AFileOpenExecute
+      ShortCut = 16463
     end
     object AFileClose: TAction
@@ -61 +63 @@
       Caption = 'Save'
       OnExecute = AFileSaveExecute
+      ShortCut = 16467
     end
     object AFileSaveAs: TAction

trunk/UCore.pas

@@ -43 +43 @@
     SavePictureDialog1: TSavePictureDialog;
     procedure AExitExecute(Sender: TObject);
+    procedure AFileNewExecute(Sender: TObject);
     procedure AFileCloseExecute(Sender: TObject);
     procedure AFileOpenExecute(Sender: TObject);
@@ -53 +54 @@
     procedure AImageNegativeExecute(Sender: TObject);
     procedure AImageRandomExecute(Sender: TObject);
-    procedure AFileNewExecute(Sender: TObject);
     procedure AZoomAllExecute(Sender: TObject);
     procedure AZoomInExecute(Sender: TObject);