Changeset 13 for trunk

Timestamp:

Sep 22, 2014, 5:25:11 PM (10 years ago)

Author:

chronos

Message:

• Added: Image operation Negative image.
• Added: Partialy implemented Image load from and save to file.

Location:

trunk

Files:

• Forms/UFormMain.lfm (modified) (1 diff)
• Forms/UFormMain.pas (modified) (1 diff)
• LibrePaint.lpi (modified) (2 diffs)
• LibrePaint.lpr (modified) (1 diff)
• UCore.lfm (modified) (3 diffs)
• UCore.pas (modified) (5 diffs)
• UGraphic.pas (modified) (6 diffs)
• UMemory.pas (modified) (5 diffs)
• UProject.pas (modified) (1 diff)

trunk/Forms/UFormMain.lfm

@@ -102 +102 @@
         Action = Core.AImageGradient
       end
+      object MenuItem20: TMenuItem
+        Action = Core.AImageNegative
+      end
     end
   end

trunk/Forms/UFormMain.pas

@@ -24 +24 @@
     MenuItem18: TMenuItem;
     MenuItem19: TMenuItem;
+    MenuItem20: TMenuItem;
     MenuItemRecentFiles: TMenuItem;
     MenuItem15: TMenuItem;

trunk/LibrePaint.lpi

@@ -105 +105 @@
         <Filename Value="ColorFormats/UColorRGBA8.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="UColorRGBA8"/>
       </Unit5>
       <Unit6>
@@ -126 +127 @@
         <Filename Value="UMemory.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="UMemory"/>
       </Unit9>
       <Unit10>

trunk/LibrePaint.lpr

@@ -8 +8 @@
   {$ENDIF}{$ENDIF}
   Interfaces, // this includes the LCL widgetset
-  Forms, UCore, UGraphic, UProject, UBitStream, UMemory, UFormNew, UFormMain,
+  Forms, UCore, UGraphic, UProject, UMemory, UFormNew, UFormMain,
   UColorRGBA8, UColorGray8, UColorGray1, UColorGray4, UColorRGB565
   { you can add units after this };

trunk/UCore.lfm

@@ -49 +49 @@
       Category = 'File'
       Caption = 'Open...'
+      OnExecute = AFileOpenExecute
     end
     object AFileClose: TAction
       Category = 'File'
       Caption = 'Close'
+      OnExecute = AFileCloseExecute
     end
     object AFileSave: TAction
       Category = 'File'
       Caption = 'Save'
+      OnExecute = AFileSaveExecute
     end
     object AFileSaveAs: TAction
       Category = 'File'
       Caption = 'Save as...'
+      OnExecute = AFileSaveAsExecute
     end
     object AImageRandom: TAction
@@ -82 +86 @@
       OnExecute = AImageGradientExecute
     end
+    object AImageNegative: TAction
+      Category = 'Image'
+      Caption = 'Negative'
+      OnExecute = AImageNegativeExecute
+    end
   end
   object ImageList1: TImageList
@@ -87 +96 @@
     top = 240
   end
+  object OpenPictureDialog1: TOpenPictureDialog
+    left = 462
+    top = 126
+  end
+  object SavePictureDialog1: TSavePictureDialog
+    left = 462
+    top = 208
+  end
 end

trunk/UCore.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, FileUtil, ActnList, UProject, UGraphic, Controls, Graphics;
+  Classes, SysUtils, FileUtil, ActnList, UProject, UGraphic, Controls, Graphics,
+  ExtDlgs, ExtCtrls;
 
 const
@@ -19 +20 @@
 
   TCore = class(TDataModule)
+    AImageNegative: TAction;
     AImageGradient: TAction;
     AImageMirror: TAction;
@@ -36 +38 @@
     ActionList1: TActionList;
     ImageList1: TImageList;
+    OpenPictureDialog1: TOpenPictureDialog;
+    SavePictureDialog1: TSavePictureDialog;
     procedure AExitExecute(Sender: TObject);
+    procedure AFileCloseExecute(Sender: TObject);
+    procedure AFileOpenExecute(Sender: TObject);
+    procedure AFileSaveAsExecute(Sender: TObject);
+    procedure AFileSaveExecute(Sender: TObject);
     procedure AImageClearExecute(Sender: TObject);
     procedure AImageFlipExecute(Sender: TObject);
     procedure AImageGradientExecute(Sender: TObject);
     procedure AImageMirrorExecute(Sender: TObject);
+    procedure AImageNegativeExecute(Sender: TObject);
     procedure AImageRandomExecute(Sender: TObject);
     procedure AFileNewExecute(Sender: TObject);
@@ -146 +155 @@
 end;
 
+procedure TCore.AFileCloseExecute(Sender: TObject);
+begin
+  if not Project.Saved then AFileSave.Execute;
+  Project.Free;
+  FormMain.Redraw;
+end;
+
+procedure TCore.AFileOpenExecute(Sender: TObject);
+var
+  Image: TImage;
+begin
+  if OpenPictureDialog1.Execute then begin
+    Image := TImage.Create(nil);
+    Image.Picture.LoadFromFile(OpenPictureDialog1.FileName);
+    Image.Picture.Bitmap.BeginUpdate(True);
+    Project.Bitmap.LoadFromCanvas(Image.Picture.Bitmap.Canvas,
+      Point(Image.Picture.Bitmap.Width, Image.Picture.Bitmap.Height));
+    Image.Picture.Bitmap.EndUpdate;
+    Image.Free;
+    FormMain.Redraw;
+    Project.FileName := OpenPictureDialog1.FileName;
+  end;
+end;
+
+procedure TCore.AFileSaveAsExecute(Sender: TObject);
+begin
+  SavePictureDialog1.FileName := Project.FileName;
+  if SavePictureDialog1.Execute then begin
+    Project.FileName := SavePictureDialog1.FileName;
+    AFileSave.Execute;
+  end;
+end;
+
+procedure TCore.AFileSaveExecute(Sender: TObject);
+var
+  Image: TImage;
+begin
+  if Project.FileName = '' then AFileSaveAs.Execute
+  else begin
+    Image := TImage.Create(nil);
+    Image.Picture.Bitmap.SetSize(Project.Bitmap.Size.X, Project.Bitmap.Size.Y);
+    Project.Bitmap.PaintToCanvas(Image.Picture.Bitmap.Canvas,
+      Rect(0, 0, Image.Picture.Bitmap.Width, Image.Picture.Bitmap.Height));
+    Image.Picture.SaveToFile(SavePictureDialog1.FileName);
+    Image.Free;
+    Project.Saved := True;
+  end;
+end;
+
 procedure TCore.AImageClearExecute(Sender: TObject);
 begin
@@ -174 +232 @@
 end;
 
+procedure TCore.AImageNegativeExecute(Sender: TObject);
+begin
+  Project.Bitmap.Negative;
+  FormMain.Redraw;
+end;
+
 procedure TCore.AImageRandomExecute(Sender: TObject);
 begin

trunk/UGraphic.pas

@@ -44 +44 @@
     function ToTColor: TColor;
     procedure FromTColor(Color: TColor);
+    procedure Invert;
     procedure Assign(Source: TGColor); virtual;
     constructor Create;
@@ -71 +72 @@
     procedure CheckLimits(X, Y: Integer);
   public
+    procedure LoadFromCanvas(Canvas: TCanvas; ASize: TPoint);
     function GetDataSize: Integer;
     procedure PaintToCanvas(Canvas: TCanvas; Rect: TRect);
@@ -78 +80 @@
     procedure Flip;
     procedure Mirror;
+    procedure Negative;
     constructor Create; virtual;
     destructor Destroy; override;
@@ -368 +371 @@
 end;
 
+procedure TGColor.Invert;
+var
+  Channel: TBitMemory;
+begin
+  Channel := TBitMemory.Create;
+
+  if Format.GetChannelBitWidth(ccRed) > 0 then begin
+    Channel.Size := Format.GetChannelBitWidth(ccRed);
+    Data.ReadBlock(Channel, Format.GetChannelBitPos(ccRed));
+    Channel.Invert;
+    Data.WriteBlock(Channel, Format.GetChannelBitPos(ccRed));
+  end;
+
+  if Format.GetChannelBitWidth(ccGreen) > 0 then begin
+    Channel.Size := Format.GetChannelBitWidth(ccGreen);
+    Data.ReadBlock(Channel, Format.GetChannelBitPos(ccGreen));
+    Channel.Invert;
+    Data.WriteBlock(Channel, Format.GetChannelBitPos(ccGreen));
+  end;
+
+  if Format.GetChannelBitWidth(ccBlue) > 0 then begin
+    Channel.Size := Format.GetChannelBitWidth(ccBlue);
+    Data.ReadBlock(Channel, Format.GetChannelBitPos(ccBlue));
+    Channel.Invert;
+    Data.WriteBlock(Channel, Format.GetChannelBitPos(ccBlue));
+  end;
+
+  if Format.GetChannelBitWidth(ccGray) > 0 then begin
+    Channel.Size := Format.GetChannelBitWidth(ccGray);
+    Data.ReadBlock(Channel, Format.GetChannelBitPos(ccGray));
+    Channel.Invert;
+    Data.WriteBlock(Channel, Format.GetChannelBitPos(ccGray));
+  end;
+
+  Channel.Free;
+end;
+
 procedure TGColor.Assign(Source: TGColor);
 begin
@@ -429 +469 @@
   if (X < 0) or (Y < 0) or (X >= Size.X) or (Y >= Size.Y) then
     raise Exception.Create('Out of range');
+end;
+
+procedure TGBitmap.LoadFromCanvas(Canvas: TCanvas; ASize: TPoint);
+var
+  X, Y: Integer;
+  Pixel: TGColor;
+begin
+  Pixel := TGColor.Create;
+  Pixel.Format := ColorFormat;
+  Size := ASize;
+  try
+  Canvas.Lock;
+  for Y := 0 to Size.Y - 1 do
+    for X := 0 to Size.X do
+    if (X >= 0) and (X < Size.X) and (Y >= 0) and (Y < Size.Y) then begin
+      Pixel.FromTColor(Canvas.Pixels[X, Y]);
+      Pixels[X, Y] := Pixel;
+    end;
+
+  finally
+    Canvas.Unlock;
+  end;
+  Pixel.Free;
 end;
 
@@ -536 +599 @@
 end;
 
+procedure TGBitmap.Negative;
+var
+  X, Y: Integer;
+  Color: TGColor;
+begin
+  for Y := 0 to Size.Y - 1 do
+    for X := 0 to Size.X - 1 do begin
+      Color := Pixels[X, Y];
+      Color.Invert;
+      Pixels[X, Y] := Color;
+      Color.Free;
+    end;
+end;
+
 constructor TGBitmap.Create;
 begin

trunk/UMemory.pas

@@ -67 +67 @@
     procedure SetSize(AValue: Integer); virtual;
   public
+    procedure Invert; virtual;
     function GetInteger: Integer; virtual;
     procedure SetInteger(Value: Integer); virtual;
@@ -83 +84 @@
     FData: PByte;
     FSize: Integer;
-    function GetInteger: Integer; override;
-    procedure SetInteger(Value: Integer); override;
     function GetSize: Integer; override;
     procedure SetSize(AValue: Integer); override;
@@ -90 +89 @@
     procedure SetItem(Index: Integer; AValue: Byte); override;
   public
+    function GetInteger: Integer; override;
+    procedure SetInteger(Value: Integer); override;
+    procedure Clear(Value: Byte = 0); override;
+    procedure ReadBlock(Block: TBitBlock; Position: Integer); override;
+    procedure WriteBlock(Block: TBitBlock; Position: Integer); override;
+    property Data: PByte read FData;
+    procedure Invert; override;
   end;
 
@@ -96 +102 @@
 
 { TBitMemory }
+
+procedure TBitMemory.Clear(Value: Byte);
+begin
+  if (Size and 7) = 0 then begin
+    if Value = 0 then FillChar(FData^, Size shr 3, 0)
+      else FillChar(FData^, Size shr 3, $ff);
+  end else inherited;
+end;
+
+procedure TBitMemory.ReadBlock(Block: TBitBlock; Position: Integer);
+begin
+  if Block is TBitMemory then begin
+    if (Position and 7) = 0 then begin
+      if (Block.Size and 7) = 0 then
+        Move(PByte(FData + Position shr 3)^, TBitMemory(Block).Data^, Block.Size shr 3)
+        else inherited;
+    end else inherited;
+  end else inherited;
+end;
+
+procedure TBitMemory.WriteBlock(Block: TBitBlock; Position: Integer);
+begin
+  if Block is TBitMemory then begin
+    if (Position and 7) = 0 then begin
+      if (Block.Size and 7) = 0 then
+        Move(TBitMemory(Block).Data^, PByte(FData + Position shr 3)^, Block.Size shr 3)
+        else inherited;
+    end else inherited;
+  end else inherited;
+end;
+
+procedure TBitMemory.Invert;
+var
+  I: Integer;
+begin
+  if (Size and 7) = 0 then begin
+    for I := 0 to (Size shr 3) - 1 do
+      PByte(FData + I)^ := PByte(FData + I)^ xor $ff;
+  end
+  else inherited;
+
+end;
 
 function TBitMemory.GetInteger: Integer;
@@ -176 +224 @@
 end;
 
+procedure TBitBlock.Invert;
+var
+  I: Integer;
+begin
+  for I := 0 to Size - 1 do
+    Items[I] := not Items[I];
+end;
+
 function TBitBlock.GetInteger: Integer;
 begin

trunk/UProject.pas

@@ -36 +36 @@
     Bitmap: TGBitmap;
     View: TView;
+    Saved: Boolean;
     constructor Create;
     destructor Destroy; override;