Changeset 13 for trunk


Ignore:
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:
9 edited

Legend:

Unmodified
Added
Removed
  • trunk/Forms/UFormMain.lfm

    r10 r13  
    102102        Action = Core.AImageGradient
    103103      end
     104      object MenuItem20: TMenuItem
     105        Action = Core.AImageNegative
     106      end
    104107    end
    105108  end
  • trunk/Forms/UFormMain.pas

    r10 r13  
    2424    MenuItem18: TMenuItem;
    2525    MenuItem19: TMenuItem;
     26    MenuItem20: TMenuItem;
    2627    MenuItemRecentFiles: TMenuItem;
    2728    MenuItem15: TMenuItem;
  • trunk/LibrePaint.lpi

    r11 r13  
    105105        <Filename Value="ColorFormats/UColorRGBA8.pas"/>
    106106        <IsPartOfProject Value="True"/>
     107        <UnitName Value="UColorRGBA8"/>
    107108      </Unit5>
    108109      <Unit6>
     
    126127        <Filename Value="UMemory.pas"/>
    127128        <IsPartOfProject Value="True"/>
     129        <UnitName Value="UMemory"/>
    128130      </Unit9>
    129131      <Unit10>
  • trunk/LibrePaint.lpr

    r11 r13  
    88  {$ENDIF}{$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   Forms, UCore, UGraphic, UProject, UBitStream, UMemory, UFormNew, UFormMain,
     10  Forms, UCore, UGraphic, UProject, UMemory, UFormNew, UFormMain,
    1111  UColorRGBA8, UColorGray8, UColorGray1, UColorGray4, UColorRGB565
    1212  { you can add units after this };
  • trunk/UCore.lfm

    r10 r13  
    4949      Category = 'File'
    5050      Caption = 'Open...'
     51      OnExecute = AFileOpenExecute
    5152    end
    5253    object AFileClose: TAction
    5354      Category = 'File'
    5455      Caption = 'Close'
     56      OnExecute = AFileCloseExecute
    5557    end
    5658    object AFileSave: TAction
    5759      Category = 'File'
    5860      Caption = 'Save'
     61      OnExecute = AFileSaveExecute
    5962    end
    6063    object AFileSaveAs: TAction
    6164      Category = 'File'
    6265      Caption = 'Save as...'
     66      OnExecute = AFileSaveAsExecute
    6367    end
    6468    object AImageRandom: TAction
     
    8286      OnExecute = AImageGradientExecute
    8387    end
     88    object AImageNegative: TAction
     89      Category = 'Image'
     90      Caption = 'Negative'
     91      OnExecute = AImageNegativeExecute
     92    end
    8493  end
    8594  object ImageList1: TImageList
     
    8796    top = 240
    8897  end
     98  object OpenPictureDialog1: TOpenPictureDialog
     99    left = 462
     100    top = 126
     101  end
     102  object SavePictureDialog1: TSavePictureDialog
     103    left = 462
     104    top = 208
     105  end
    89106end
  • trunk/UCore.pas

    r11 r13  
    66
    77uses
    8   Classes, SysUtils, FileUtil, ActnList, UProject, UGraphic, Controls, Graphics;
     8  Classes, SysUtils, FileUtil, ActnList, UProject, UGraphic, Controls, Graphics,
     9  ExtDlgs, ExtCtrls;
    910
    1011const
     
    1920
    2021  TCore = class(TDataModule)
     22    AImageNegative: TAction;
    2123    AImageGradient: TAction;
    2224    AImageMirror: TAction;
     
    3638    ActionList1: TActionList;
    3739    ImageList1: TImageList;
     40    OpenPictureDialog1: TOpenPictureDialog;
     41    SavePictureDialog1: TSavePictureDialog;
    3842    procedure AExitExecute(Sender: TObject);
     43    procedure AFileCloseExecute(Sender: TObject);
     44    procedure AFileOpenExecute(Sender: TObject);
     45    procedure AFileSaveAsExecute(Sender: TObject);
     46    procedure AFileSaveExecute(Sender: TObject);
    3947    procedure AImageClearExecute(Sender: TObject);
    4048    procedure AImageFlipExecute(Sender: TObject);
    4149    procedure AImageGradientExecute(Sender: TObject);
    4250    procedure AImageMirrorExecute(Sender: TObject);
     51    procedure AImageNegativeExecute(Sender: TObject);
    4352    procedure AImageRandomExecute(Sender: TObject);
    4453    procedure AFileNewExecute(Sender: TObject);
     
    146155end;
    147156
     157procedure TCore.AFileCloseExecute(Sender: TObject);
     158begin
     159  if not Project.Saved then AFileSave.Execute;
     160  Project.Free;
     161  FormMain.Redraw;
     162end;
     163
     164procedure TCore.AFileOpenExecute(Sender: TObject);
     165var
     166  Image: TImage;
     167begin
     168  if OpenPictureDialog1.Execute then begin
     169    Image := TImage.Create(nil);
     170    Image.Picture.LoadFromFile(OpenPictureDialog1.FileName);
     171    Image.Picture.Bitmap.BeginUpdate(True);
     172    Project.Bitmap.LoadFromCanvas(Image.Picture.Bitmap.Canvas,
     173      Point(Image.Picture.Bitmap.Width, Image.Picture.Bitmap.Height));
     174    Image.Picture.Bitmap.EndUpdate;
     175    Image.Free;
     176    FormMain.Redraw;
     177    Project.FileName := OpenPictureDialog1.FileName;
     178  end;
     179end;
     180
     181procedure TCore.AFileSaveAsExecute(Sender: TObject);
     182begin
     183  SavePictureDialog1.FileName := Project.FileName;
     184  if SavePictureDialog1.Execute then begin
     185    Project.FileName := SavePictureDialog1.FileName;
     186    AFileSave.Execute;
     187  end;
     188end;
     189
     190procedure TCore.AFileSaveExecute(Sender: TObject);
     191var
     192  Image: TImage;
     193begin
     194  if Project.FileName = '' then AFileSaveAs.Execute
     195  else begin
     196    Image := TImage.Create(nil);
     197    Image.Picture.Bitmap.SetSize(Project.Bitmap.Size.X, Project.Bitmap.Size.Y);
     198    Project.Bitmap.PaintToCanvas(Image.Picture.Bitmap.Canvas,
     199      Rect(0, 0, Image.Picture.Bitmap.Width, Image.Picture.Bitmap.Height));
     200    Image.Picture.SaveToFile(SavePictureDialog1.FileName);
     201    Image.Free;
     202    Project.Saved := True;
     203  end;
     204end;
     205
    148206procedure TCore.AImageClearExecute(Sender: TObject);
    149207begin
     
    174232end;
    175233
     234procedure TCore.AImageNegativeExecute(Sender: TObject);
     235begin
     236  Project.Bitmap.Negative;
     237  FormMain.Redraw;
     238end;
     239
    176240procedure TCore.AImageRandomExecute(Sender: TObject);
    177241begin
  • trunk/UGraphic.pas

    r10 r13  
    4444    function ToTColor: TColor;
    4545    procedure FromTColor(Color: TColor);
     46    procedure Invert;
    4647    procedure Assign(Source: TGColor); virtual;
    4748    constructor Create;
     
    7172    procedure CheckLimits(X, Y: Integer);
    7273  public
     74    procedure LoadFromCanvas(Canvas: TCanvas; ASize: TPoint);
    7375    function GetDataSize: Integer;
    7476    procedure PaintToCanvas(Canvas: TCanvas; Rect: TRect);
     
    7880    procedure Flip;
    7981    procedure Mirror;
     82    procedure Negative;
    8083    constructor Create; virtual;
    8184    destructor Destroy; override;
     
    368371end;
    369372
     373procedure TGColor.Invert;
     374var
     375  Channel: TBitMemory;
     376begin
     377  Channel := TBitMemory.Create;
     378
     379  if Format.GetChannelBitWidth(ccRed) > 0 then begin
     380    Channel.Size := Format.GetChannelBitWidth(ccRed);
     381    Data.ReadBlock(Channel, Format.GetChannelBitPos(ccRed));
     382    Channel.Invert;
     383    Data.WriteBlock(Channel, Format.GetChannelBitPos(ccRed));
     384  end;
     385
     386  if Format.GetChannelBitWidth(ccGreen) > 0 then begin
     387    Channel.Size := Format.GetChannelBitWidth(ccGreen);
     388    Data.ReadBlock(Channel, Format.GetChannelBitPos(ccGreen));
     389    Channel.Invert;
     390    Data.WriteBlock(Channel, Format.GetChannelBitPos(ccGreen));
     391  end;
     392
     393  if Format.GetChannelBitWidth(ccBlue) > 0 then begin
     394    Channel.Size := Format.GetChannelBitWidth(ccBlue);
     395    Data.ReadBlock(Channel, Format.GetChannelBitPos(ccBlue));
     396    Channel.Invert;
     397    Data.WriteBlock(Channel, Format.GetChannelBitPos(ccBlue));
     398  end;
     399
     400  if Format.GetChannelBitWidth(ccGray) > 0 then begin
     401    Channel.Size := Format.GetChannelBitWidth(ccGray);
     402    Data.ReadBlock(Channel, Format.GetChannelBitPos(ccGray));
     403    Channel.Invert;
     404    Data.WriteBlock(Channel, Format.GetChannelBitPos(ccGray));
     405  end;
     406
     407  Channel.Free;
     408end;
     409
    370410procedure TGColor.Assign(Source: TGColor);
    371411begin
     
    429469  if (X < 0) or (Y < 0) or (X >= Size.X) or (Y >= Size.Y) then
    430470    raise Exception.Create('Out of range');
     471end;
     472
     473procedure TGBitmap.LoadFromCanvas(Canvas: TCanvas; ASize: TPoint);
     474var
     475  X, Y: Integer;
     476  Pixel: TGColor;
     477begin
     478  Pixel := TGColor.Create;
     479  Pixel.Format := ColorFormat;
     480  Size := ASize;
     481  try
     482  Canvas.Lock;
     483  for Y := 0 to Size.Y - 1 do
     484    for X := 0 to Size.X do
     485    if (X >= 0) and (X < Size.X) and (Y >= 0) and (Y < Size.Y) then begin
     486      Pixel.FromTColor(Canvas.Pixels[X, Y]);
     487      Pixels[X, Y] := Pixel;
     488    end;
     489
     490  finally
     491    Canvas.Unlock;
     492  end;
     493  Pixel.Free;
    431494end;
    432495
     
    536599end;
    537600
     601procedure TGBitmap.Negative;
     602var
     603  X, Y: Integer;
     604  Color: TGColor;
     605begin
     606  for Y := 0 to Size.Y - 1 do
     607    for X := 0 to Size.X - 1 do begin
     608      Color := Pixels[X, Y];
     609      Color.Invert;
     610      Pixels[X, Y] := Color;
     611      Color.Free;
     612    end;
     613end;
     614
    538615constructor TGBitmap.Create;
    539616begin
  • trunk/UMemory.pas

    r9 r13  
    6767    procedure SetSize(AValue: Integer); virtual;
    6868  public
     69    procedure Invert; virtual;
    6970    function GetInteger: Integer; virtual;
    7071    procedure SetInteger(Value: Integer); virtual;
     
    8384    FData: PByte;
    8485    FSize: Integer;
    85     function GetInteger: Integer; override;
    86     procedure SetInteger(Value: Integer); override;
    8786    function GetSize: Integer; override;
    8887    procedure SetSize(AValue: Integer); override;
     
    9089    procedure SetItem(Index: Integer; AValue: Byte); override;
    9190  public
     91    function GetInteger: Integer; override;
     92    procedure SetInteger(Value: Integer); override;
     93    procedure Clear(Value: Byte = 0); override;
     94    procedure ReadBlock(Block: TBitBlock; Position: Integer); override;
     95    procedure WriteBlock(Block: TBitBlock; Position: Integer); override;
     96    property Data: PByte read FData;
     97    procedure Invert; override;
    9298  end;
    9399
     
    96102
    97103{ TBitMemory }
     104
     105procedure TBitMemory.Clear(Value: Byte);
     106begin
     107  if (Size and 7) = 0 then begin
     108    if Value = 0 then FillChar(FData^, Size shr 3, 0)
     109      else FillChar(FData^, Size shr 3, $ff);
     110  end else inherited;
     111end;
     112
     113procedure TBitMemory.ReadBlock(Block: TBitBlock; Position: Integer);
     114begin
     115  if Block is TBitMemory then begin
     116    if (Position and 7) = 0 then begin
     117      if (Block.Size and 7) = 0 then
     118        Move(PByte(FData + Position shr 3)^, TBitMemory(Block).Data^, Block.Size shr 3)
     119        else inherited;
     120    end else inherited;
     121  end else inherited;
     122end;
     123
     124procedure TBitMemory.WriteBlock(Block: TBitBlock; Position: Integer);
     125begin
     126  if Block is TBitMemory then begin
     127    if (Position and 7) = 0 then begin
     128      if (Block.Size and 7) = 0 then
     129        Move(TBitMemory(Block).Data^, PByte(FData + Position shr 3)^, Block.Size shr 3)
     130        else inherited;
     131    end else inherited;
     132  end else inherited;
     133end;
     134
     135procedure TBitMemory.Invert;
     136var
     137  I: Integer;
     138begin
     139  if (Size and 7) = 0 then begin
     140    for I := 0 to (Size shr 3) - 1 do
     141      PByte(FData + I)^ := PByte(FData + I)^ xor $ff;
     142  end
     143  else inherited;
     144
     145end;
    98146
    99147function TBitMemory.GetInteger: Integer;
     
    176224end;
    177225
     226procedure TBitBlock.Invert;
     227var
     228  I: Integer;
     229begin
     230  for I := 0 to Size - 1 do
     231    Items[I] := not Items[I];
     232end;
     233
    178234function TBitBlock.GetInteger: Integer;
    179235begin
  • trunk/UProject.pas

    r10 r13  
    3636    Bitmap: TGBitmap;
    3737    View: TView;
     38    Saved: Boolean;
    3839    constructor Create;
    3940    destructor Destroy; override;
Note: See TracChangeset for help on using the changeset viewer.