Changeset 31

Timestamp:

Jan 4, 2017, 11:49:56 PM (7 years ago)

Author:

chronos

Message:

• Added: Pen tool to draw pixels by mouse with selected color.
• Added: Mirror and Flip image operation.

Location:

trunk

Files:

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

trunk/Forms/UFormMain.lfm

@@ -5 +5 @@
   Width = 920
   Caption = 'LibrePaint'
-  ClientHeight = 615
+  ClientHeight = 608
   ClientWidth = 920
   Menu = MainMenu1
@@ -13 +13 @@
   OnDestroy = FormDestroy
   OnShow = FormShow
-  LCLVersion = '1.6.2.0'
+  LCLVersion = '1.6.0.4'
   object PaintBox1: TPaintBox
     Left = 0
-    Height = 561
+    Height = 554
     Top = 26
     Width = 920
@@ -32 +32 @@
     Left = 0
     Height = 28
-    Top = 587
+    Top = 580
     Width = 920
     Panels = <    
@@ -51 +51 @@
       Top = 2
       Action = Core.AFileNew
+    end
+    object ColorButton1: TColorButton
+      Left = 24
+      Height = 22
+      Top = 2
+      Width = 43
+      BorderWidth = 2
+      ButtonColorSize = 16
+      ButtonColor = clMaroon
+    end
+    object ToolButton2: TToolButton
+      Left = 67
+      Top = 2
+      Action = Core.AToolMove
+    end
+    object ToolButton3: TToolButton
+      Left = 90
+      Top = 2
+      Action = Core.AToolPen
     end
   end
@@ -82 +101 @@
       object MenuItem2: TMenuItem
         Action = Core.AExit
+      end
+    end
+    object MenuItem21: TMenuItem
+      Caption = 'Tool'
+      object MenuItem23: TMenuItem
+        Action = Core.AToolMove
+      end
+      object MenuItem22: TMenuItem
+        Action = Core.AToolPen
       end
     end

trunk/Forms/UFormMain.pas

@@ -11 +11 @@
 type
 
+  TImageTool = (itMoveView, itPen);
+
   { TFormMain }
 
   TFormMain = class(TForm)
+    ColorButton1: TColorButton;
     LastOpenedList1: TLastOpenedList;
     MainMenu1: TMainMenu;
@@ -26 +29 @@
     MenuItem19: TMenuItem;
     MenuItem20: TMenuItem;
+    MenuItem21: TMenuItem;
+    MenuItem22: TMenuItem;
+    MenuItem23: TMenuItem;
     MenuItemRecentFiles: TMenuItem;
     MenuItem15: TMenuItem;
@@ -42 +48 @@
     ToolBar1: TToolBar;
     ToolButton1: TToolButton;
+    ToolButton2: TToolButton;
+    ToolButton3: TToolButton;
     procedure FormActivate(Sender: TObject);
     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
@@ -66 +74 @@
     StartMousePoint: TPoint;
     StartViewPoint: TPoint;
-    MoveActive: Boolean;
+    MouseButtonDown: Boolean;
     MousePos: TPoint;
     Activated: Boolean;
     procedure OpenRecentClick(Sender: TObject);
   public
+    ImageTool: TImageTool;
     procedure EraseBackground(DC: HDC); override;
     procedure UpdateStatusBar;
@@ -82 +91 @@
 
 uses
-  UCore;
+  UCore, UFGraphics;
 
 {$R *.lfm}
@@ -184 +193 @@
 procedure TFormMain.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
+var
+  P: TPoint;
 begin
   if Button = mbLeft then begin
-    StartMousePoint := Point(X, Y);
-    StartViewPoint := Core.Project.View.SrcRect.TopLeft;
-    MoveActive := True;
+    if ImageTool = itMoveView then begin
+      StartMousePoint := Point(X, Y);
+      StartViewPoint := Core.Project.View.SrcRect.TopLeft;
+    end else
+    if ImageTool = itPen then begin
+      P := Core.Project.View.DestToSrcPos(Point(X, Y));
+      if (P.X >= 0) and (P.X < Core.Project.Bitmap.Size.X) and (P.Y >= 0) and (P.Y < Core.Project.Bitmap.Size.Y) then
+        Core.Project.Bitmap.Pixels[P.X, P.Y] := TFColor.Create(Core.Project.Bitmap.ColorFormat, ColorButton1.ButtonColor);
+      Redraw;
+    end;
+    MouseButtonDown := True;
   end;
 end;
@@ -194 +213 @@
 procedure TFormMain.PaintBox1MouseLeave(Sender: TObject);
 begin
-  MoveActive := False;
+  MouseButtonDown := False;
 end;
 
 procedure TFormMain.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
   Y: Integer);
+var
+  P: TPoint;
 begin
   MousePos := Point(X, Y);
-  if Assigned(Core.Project) then begin
-    if MoveActive then
-    with Core.Project do begin
+  if MouseButtonDown then
+  if Assigned(Core.Project) then
+  with Core.Project do begin
+    if Imagetool = itMoveView then begin
       View.SrcRect := Bounds(Trunc(StartViewPoint.X + (StartMousePoint.X - X) / View.Zoom),
         Trunc(StartViewPoint.Y + (StartMousePoint.Y - Y) / View.Zoom),
@@ -209 +231 @@
         View.SrcRect.Bottom - View.SrcRect.Top);
       Redraw;
+    end else
+    if ImageTool = itPen then begin
+      P := Core.Project.View.DestToSrcPos(Point(X, Y));
+      if (P.X >= 0) and (P.X < Core.Project.Bitmap.Size.X) and (P.Y >= 0) and (P.Y < Core.Project.Bitmap.Size.Y) then
+        Core.Project.Bitmap.Pixels[P.X, P.Y] := TFColor.Create(Core.Project.Bitmap.ColorFormat, ColorButton1.ButtonColor);
+      Redraw;
     end;
   end;
@@ -217 +245 @@
   Shift: TShiftState; X, Y: Integer);
 begin
-  MoveActive := False;
+  MouseButtonDown := False;
 end;
 

trunk/Packages/FastGraphics/ColorFormats/UColorRGB8.pas

@@ -37 +37 @@
     constructor Create(Color: TColorRGB8);
     procedure SetColorName(ColorName: TColorName); override;
+    procedure SetColor(Color: TColor); override;
     procedure SetRandom; override;
   end;
@@ -47 +48 @@
     function FillGetColor(Position: TPoint): TColorRGB8;
   protected
+    function GetPixel(X, Y: Integer): IBColor;  override;
+    procedure SetPixel(X, Y: Integer; AValue: IBColor); override;
     procedure SetSize(AValue: TPoint); override;
   public
     Pixmap: TPixmapRGB8;
+    procedure Mirror; override;
+    procedure Flip; override;
     procedure Fill(Color: IBColor); override;
     procedure Fill(Func: TGetColorPos); override;
@@ -121 +126 @@
 end;
 
+procedure TBColorRGB8.SetColor(Color: TColor);
+begin
+  Value := TColorRGB8.Create((Color shr 0) and $ff, (Color shr 8) and $ff, (Color shr 16) and $ff);
+end;
+
 procedure TBColorRGB8.SetRandom;
 begin
@@ -131 +141 @@
 begin
   Result := (FillCallBack(Position) as TBColorRGB8).Value;
+end;
+
+function TBPixmapRGB8.GetPixel(X, Y: Integer): IBColor;
+begin
+  Result := TBColorRGB8.Create(Pixmap.Pixels[X, Y]);
+end;
+
+procedure TBPixmapRGB8.SetPixel(X, Y: Integer; AValue: IBColor);
+begin
+  Pixmap.Pixels[X, Y] := (AValue as TBColorRGB8).Value;
 end;
 
@@ -139 +159 @@
 end;
 
+procedure TBPixmapRGB8.Mirror;
+begin
+  Pixmap.Mirror;
+end;
+
+procedure TBPixmapRGB8.Flip;
+begin
+  Pixmap.Flip;
+end;
+
 procedure TBPixmapRGB8.Fill(Color: IBColor);
 begin

trunk/Packages/FastGraphics/UFGraphics.pas

@@ -13 +13 @@
   IBColor = interface
     procedure SetColorName(ColorName: TColorName);
+    procedure SetColor(Color: TColor);
     procedure SetRandom;
   end;
@@ -20 +21 @@
   TBColor = class(TInterfacedObject, IBColor)
     procedure SetColorName(ColorName: TColorName); virtual;
+    procedure SetColor(Color: TColor); virtual;
     procedure SetRandom; virtual;
   end;
@@ -38 +40 @@
     procedure SetSize(AValue: TPoint); virtual;
   public
+    procedure Mirror; virtual;
+    procedure Flip; virtual;
     procedure Fill(Color: IBColor); virtual; overload;
     procedure Fill(Func: TGetColorPos); virtual; overload;
@@ -110 +114 @@
     constructor Create; overload;
     constructor Create(ColorFormat: TColorFormat; ColorName: TColorName); overload;
+    constructor Create(ColorFormat: TColorFormat; Color: TColor); overload;
     destructor Destroy; override;
   end;
@@ -239 +244 @@
 end;
 
+procedure TBColor.SetColor(Color: TColor);
+begin
+end;
+
 procedure TBColor.SetRandom;
 begin
@@ -334 +343 @@
 end;
 
+constructor TFColor.Create(ColorFormat: TColorFormat; Color: TColor);
+begin
+  Self.ColorFormat := ColorFormat;
+  Backend.SetColor(Color);
+end;
+
 destructor TFColor.Destroy;
 begin
@@ -355 +370 @@
   if (FSize.X = AValue.X) and (FSize.Y = AValue.Y) then Exit;
   FSize := AValue;
+end;
+
+procedure TBImage.Mirror;
+begin
+
+end;
+
+procedure TBImage.Flip;
+begin
 end;
 
@@ -449 +473 @@
 procedure TFPixmap.Flip;
 begin
-
+  FBackend.Flip;
 end;
 
 procedure TFPixmap.Mirror;
 begin
-
+  FBackend.Mirror;
 end;
 

trunk/Packages/FastGraphics/UGGraphics.pas

@@ -71 +71 @@
     procedure Fill(Color: TGColor); overload;
     procedure Fill(Func: TGGetColor); overload;
+    procedure Mirror;
+    procedure Flip;
     function GetDataSize: Int64; virtual;
     property Canvas: TGCanvas<TGColor> read FCanvas;
@@ -278 +280 @@
 end;
 
+procedure TGPixmap<TGColor>.Mirror;
+var
+  X, Y: Integer;
+  Color: TGColor;
+begin
+  for Y := 0 to FSize.Y - 1 do
+    for X := 0 to FSize.X div 2 - 1 do begin
+      Color := Pixels[X, Y];
+      Pixels[X, Y] := Pixels[Size.X - 1 - X, Y];
+      Pixels[Size.X - 1 - X, Y] := Color;
+    end;
+end;
+
+procedure TGPixmap<TGColor>.Flip;
+var
+  X, Y: Integer;
+  Color: TGColor;
+begin
+  for Y := 0 to FSize.Y div 2 - 1 do
+    for X := 0 to FSize.X - 1 do begin
+      Color := Pixels[X, Y];
+      Pixels[X, Y] := Pixels[X, Size.Y - 1 - Y];
+      Pixels[X, Size.Y - 1 - Y] := Color;
+    end;
+end;
+
 { TGPen }
 

trunk/UCore.lfm

@@ -95 +95 @@
       OnExecute = AImageNegativeExecute
     end
+    object AToolPen: TAction
+      Category = 'Tool'
+      Caption = 'Pen'
+      OnExecute = AToolPenExecute
+    end
+    object AToolMove: TAction
+      Category = 'Tool'
+      Caption = 'Move'
+      OnExecute = AToolMoveExecute
+    end
   end
   object ImageList1: TImageList

trunk/UCore.pas

@@ -20 +20 @@
 
   TCore = class(TDataModule)
+    AToolMove: TAction;
+    AToolPen: TAction;
     AImageNegative: TAction;
     AImageGradient: TAction;
@@ -54 +56 @@
     procedure AImageNegativeExecute(Sender: TObject);
     procedure AImageRandomExecute(Sender: TObject);
+    procedure AToolMoveExecute(Sender: TObject);
+    procedure AToolPenExecute(Sender: TObject);
     procedure AZoomAllExecute(Sender: TObject);
     procedure AZoomInExecute(Sender: TObject);
@@ -291 +295 @@
 end;
 
+procedure TCore.AToolMoveExecute(Sender: TObject);
+begin
+  FormMain.ImageTool := itMoveView;
+end;
+
+procedure TCore.AToolPenExecute(Sender: TObject);
+begin
+  FormMain.ImageTool := itPen;
+end;
+
 end.