Browse Source

Crop Area/ScaledArea is relative to unscaled/scaled image; rewriting of Render, Mouse Events, get cropped Bitmaps

- the CropArea.Area property is relative to the unscaled image (unused in render/mouse events)
- added CropArea.ScaledArea property relative to the scaled image (used in render/mouse events)
- removed the use of DeltaX, DeltaY in render/mouse/etc
- CropAreas Area and ScaledArea property is updated during the mouse events
- rewriting of the methods for taking cropped images
Massimo Magnano 2 years ago
parent
commit
1a327f8e4b

File diff suppressed because it is too large
+ 317 - 358
bgraimagemanipulation.pas


+ 6 - 4
test/test_bgraimagemanipulation/ProjectBGRAImageManipulationDemo.lpi

@@ -1,10 +1,12 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="11"/>
+    <Version Value="12"/>
     <General>
+      <Flags>
+        <CompatibilityMode Value="True"/>
+      </Flags>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
       <XPManifest>
@@ -58,13 +60,13 @@
     </PublishOptions>
     <RunParams>
       <local>
-        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
       <FormatVersion Value="2"/>
       <Modes Count="1">
         <Mode0 Name="default">
           <local>
-            <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+            <LaunchingApplication PathPlusParams="/usr/bin/xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
           </local>
         </Mode0>
       </Modes>

+ 4 - 1
test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.lfm

@@ -6,9 +6,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
   Caption = 'Demonstration of TBGRAImageManipulation'
   ClientHeight = 460
   ClientWidth = 847
+  OnCloseQuery = FormCloseQuery
   OnCreate = FormCreate
   ShowHint = True
-  LCLVersion = '2.0.10.0'
+  LCLVersion = '2.2.6.0'
   object Background: TBCPanel
     Left = 627
     Height = 460
@@ -1382,6 +1383,8 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       Top = 288
       Width = 152
       Caption = 'Save Original Size picture'
+      Checked = True
+      State = cbChecked
       TabOrder = 3
     end
   end

+ 24 - 13
test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.pas

@@ -118,6 +118,7 @@ type
     procedure btnSavePictureClick(Sender: TObject);
     procedure btnSetAspectRatioClick(Sender: TObject);
     procedure edNameChange(Sender: TObject);
+    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     procedure KeepAspectRatioClick(Sender: TObject);
 
     procedure btBox_AddClick(Sender: TObject);
@@ -139,7 +140,7 @@ type
   private
     { private declarations }
     lastNewBoxNum :Word;
-    changingAspect:Boolean;
+    changingAspect, closing:Boolean;
 
     procedure FillBoxUI(ABox :TCropArea);
     procedure SaveCallBack(Bitmap :TBGRABitmap; CropArea: TCropArea);
@@ -170,11 +171,11 @@ begin
     // Finally, associate the image into component
     BGRAImageManipulation.Bitmap := Bitmap;
     Bitmap.Free;
-    edLeft.MaxValue:=BGRAImageManipulation.Width;
-    edTop.MaxValue:=BGRAImageManipulation.Height;
-    edWidth.MaxValue:=BGRAImageManipulation.Width;
-    edHeight.MaxValue:=BGRAImageManipulation.Height;
-    BGRAImageManipulation.addCropArea(Rect(0,0,120,160));
+    edLeft.MaxValue:=BGRAImageManipulation.Bitmap.Width;
+    edTop.MaxValue:=BGRAImageManipulation.Bitmap.Height;
+    edWidth.MaxValue:=BGRAImageManipulation.Bitmap.Width;
+    edHeight.MaxValue:=BGRAImageManipulation.Bitmap.Height;
+    BGRAImageManipulation.addCropArea(Rect(100,100,220,260));
   end;
 end;
 
@@ -230,8 +231,8 @@ begin
       // Compress
       JpegImage := TJpegImage.Create;
       if (chkFullSize.Checked)
-      then JpegImage.Assign(BGRAImageManipulation.getBitmapFullSize)
-      else JpegImage.Assign(BGRAImageManipulation.getBitmap);
+      then JpegImage.Assign(BGRAImageManipulation.getBitmap)
+      else JpegImage.Assign(BGRAImageManipulation.getResampledBitmap);
       JpegImage.CompressionQuality := RateCompression.Position;
 
       // And save to file
@@ -264,8 +265,8 @@ begin
   if SelectDirectoryDialog1.Execute then
   begin
     if (chkFullSize.Checked)
-    then Self.BGRAImageManipulation.getAllBitmapsFullSize(@SaveCallBack)
-    else Self.BGRAImageManipulation.getAllBitmaps(@SaveCallBack);
+    then Self.BGRAImageManipulation.getAllBitmaps(@SaveCallBack)
+    else Self.BGRAImageManipulation.getAllResampledBitmaps(@SaveCallBack);
   end;
 end;
 
@@ -291,6 +292,12 @@ begin
   CropArea.Name :=edName.Text;
 end;
 
+procedure TFormBGRAImageManipulationDemo.FormCloseQuery(Sender: TObject;
+  var CanClose: Boolean);
+begin
+     closing :=True;
+end;
+
 procedure TFormBGRAImageManipulationDemo.KeepAspectRatioClick(Sender: TObject);
 begin
   BGRAImageManipulation.KeepAspectRatio := KeepAspectRatio.Checked;
@@ -381,6 +388,7 @@ var
    i :Integer;
 
 begin
+   closing :=False;
    changingAspect :=False;
    lastNewBoxNum :=0;
    TStringList(cbBoxList.Items).OwnsObjects:=False;
@@ -433,9 +441,12 @@ var
    delIndex :Integer;
 begin
   try
-     delIndex :=cbBoxList.Items.IndexOfObject(CropArea);
-     if (delIndex<>-1)
-     then cbBoxList.Items.Delete(delIndex);
+    if not(closing) then
+    begin
+         delIndex :=cbBoxList.Items.IndexOfObject(CropArea);
+         if (delIndex<>-1)
+         then cbBoxList.Items.Delete(delIndex);
+    end;
   except
   end;
   //MessageDlg('Deleting Crop Area', 'Deleting '+CropArea.Name, mtInformation, [mbOk], 0);

Some files were not shown because too many files changed in this diff