Changeset 31 for trunk/Forms


Ignore:
Timestamp:
Jan 4, 2017, 11:49:56 PM (8 years ago)
Author:
chronos
Message:
  • Added: Pen tool to draw pixels by mouse with selected color.
  • Added: Mirror and Flip image operation.
Location:
trunk/Forms
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.lfm

    r30 r31  
    55  Width = 920
    66  Caption = 'LibrePaint'
    7   ClientHeight = 615
     7  ClientHeight = 608
    88  ClientWidth = 920
    99  Menu = MainMenu1
    … …  
    1313  OnDestroy = FormDestroy
    1414  OnShow = FormShow
    15   LCLVersion = '1.6.2.0'
     15  LCLVersion = '1.6.0.4'
    1616  object PaintBox1: TPaintBox
    1717    Left = 0
    18     Height = 561
     18    Height = 554
    1919    Top = 26
    2020    Width = 920
    … …  
    3232    Left = 0
    3333    Height = 28
    34     Top = 587
     34    Top = 580
    3535    Width = 920
    3636    Panels = <   
    … …  
    5151      Top = 2
    5252      Action = Core.AFileNew
     53    end
     54    object ColorButton1: TColorButton
     55      Left = 24
     56      Height = 22
     57      Top = 2
     58      Width = 43
     59      BorderWidth = 2
     60      ButtonColorSize = 16
     61      ButtonColor = clMaroon
     62    end
     63    object ToolButton2: TToolButton
     64      Left = 67
     65      Top = 2
     66      Action = Core.AToolMove
     67    end
     68    object ToolButton3: TToolButton
     69      Left = 90
     70      Top = 2
     71      Action = Core.AToolPen
    5372    end
    5473  end
    … …  
    82101      object MenuItem2: TMenuItem
    83102        Action = Core.AExit
     103      end
     104    end
     105    object MenuItem21: TMenuItem
     106      Caption = 'Tool'
     107      object MenuItem23: TMenuItem
     108        Action = Core.AToolMove
     109      end
     110      object MenuItem22: TMenuItem
     111        Action = Core.AToolPen
    84112      end
    85113    end

  • trunk/Forms/UFormMain.pas

    r30 r31  
    1111type
    1212
     13  TImageTool = (itMoveView, itPen);
     14
    1315  { TFormMain }
    1416
    1517  TFormMain = class(TForm)
     18    ColorButton1: TColorButton;
    1619    LastOpenedList1: TLastOpenedList;
    1720    MainMenu1: TMainMenu;
    … …  
    2629    MenuItem19: TMenuItem;
    2730    MenuItem20: TMenuItem;
     31    MenuItem21: TMenuItem;
     32    MenuItem22: TMenuItem;
     33    MenuItem23: TMenuItem;
    2834    MenuItemRecentFiles: TMenuItem;
    2935    MenuItem15: TMenuItem;
    … …  
    4248    ToolBar1: TToolBar;
    4349    ToolButton1: TToolButton;
     50    ToolButton2: TToolButton;
     51    ToolButton3: TToolButton;
    4452    procedure FormActivate(Sender: TObject);
    4553    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    … …  
    6674    StartMousePoint: TPoint;
    6775    StartViewPoint: TPoint;
    68     MoveActive: Boolean;
     76    MouseButtonDown: Boolean;
    6977    MousePos: TPoint;
    7078    Activated: Boolean;
    7179    procedure OpenRecentClick(Sender: TObject);
    7280  public
     81    ImageTool: TImageTool;
    7382    procedure EraseBackground(DC: HDC); override;
    7483    procedure UpdateStatusBar;
    … …  
    8291
    8392uses
    84   UCore;
     93  UCore, UFGraphics;
    8594
    8695{$R *.lfm}
    … …  
    184193procedure TFormMain.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
    185194  Shift: TShiftState; X, Y: Integer);
     195var
     196  P: TPoint;
    186197begin
    187198  if Button = mbLeft then begin
    188     StartMousePoint := Point(X, Y);
    189     StartViewPoint := Core.Project.View.SrcRect.TopLeft;
    190     MoveActive := True;
     199    if ImageTool = itMoveView then begin
     200      StartMousePoint := Point(X, Y);
     201      StartViewPoint := Core.Project.View.SrcRect.TopLeft;
     202    end else
     203    if ImageTool = itPen then begin
     204      P := Core.Project.View.DestToSrcPos(Point(X, Y));
     205      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
     206        Core.Project.Bitmap.Pixels[P.X, P.Y] := TFColor.Create(Core.Project.Bitmap.ColorFormat, ColorButton1.ButtonColor);
     207      Redraw;
     208    end;
     209    MouseButtonDown := True;
    191210  end;
    192211end;
    … …  
    194213procedure TFormMain.PaintBox1MouseLeave(Sender: TObject);
    195214begin
    196   MoveActive := False;
     215  MouseButtonDown := False;
    197216end;
    198217
    199218procedure TFormMain.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
    200219  Y: Integer);
     220var
     221  P: TPoint;
    201222begin
    202223  MousePos := Point(X, Y);
    203   if Assigned(Core.Project) then begin
    204     if MoveActive then
    205     with Core.Project do begin
     224  if MouseButtonDown then
     225  if Assigned(Core.Project) then
     226  with Core.Project do begin
     227    if Imagetool = itMoveView then begin
    206228      View.SrcRect := Bounds(Trunc(StartViewPoint.X + (StartMousePoint.X - X) / View.Zoom),
    207229        Trunc(StartViewPoint.Y + (StartMousePoint.Y - Y) / View.Zoom),
    … …  
    209231        View.SrcRect.Bottom - View.SrcRect.Top);
    210232      Redraw;
     233    end else
     234    if ImageTool = itPen then begin
     235      P := Core.Project.View.DestToSrcPos(Point(X, Y));
     236      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
     237        Core.Project.Bitmap.Pixels[P.X, P.Y] := TFColor.Create(Core.Project.Bitmap.ColorFormat, ColorButton1.ButtonColor);
     238      Redraw;
    211239    end;
    212240  end;
    … …  
    217245  Shift: TShiftState; X, Y: Integer);
    218246begin
    219   MoveActive := False;
     247  MouseButtonDown := False;
    220248end;
    221249
Note: See TracChangeset for help on using the changeset viewer.