836 lines
24 KiB
ObjectPascal
836 lines
24 KiB
ObjectPascal
unit UnitBGRAImageManipulationDemo;
|
|
|
|
{ ============================================================================
|
|
BGRAImageManipulation Demon Unit
|
|
|
|
originally written in 2011 by - Emerson Cavalcanti
|
|
|
|
This program is free software; you can redistribute it and/or modify it
|
|
under the terms of the GNU Library General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or (at your
|
|
option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful, but WITHOUT
|
|
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
|
|
for more details.
|
|
|
|
You should have received a copy of the GNU Library General Public License
|
|
along with this library; if not, write to the Free Software Foundation,
|
|
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
|
|
|
============================================================================
|
|
Description:
|
|
|
|
TFormBGRAImageManipulationDemo is a sample form to use the component
|
|
TBGRAImageManipulation.
|
|
|
|
============================================================================
|
|
History:
|
|
|
|
2011-05-06 - Emerson Cavalcanti
|
|
- Initial version
|
|
|
|
2011-06-01 - Emerson Cavalcanti
|
|
- Relayout of form.
|
|
- Add control to toggle the option 'Keep Aspect Ratio' in
|
|
component
|
|
|
|
2011-06-18 - Emerson Cavalcanti
|
|
- Relayout of form for expand component on resize.
|
|
- Add control to rotate image
|
|
|
|
2013-10-13 - Massimo Magnano
|
|
- Add multi crop demo
|
|
2023-08 - Resolution, Save in various formats, Z Order
|
|
|
|
============================================================================
|
|
}
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
|
Buttons, ExtDlgs, ComCtrls, ExtCtrls, Menus, Spin,
|
|
{$IFDEF FPC} FPImage,{$ENDIF} BGRAImageManipulation,
|
|
BGRABitmap, BGRABitmapTypes, BCPanel, BCButton, BGRASpeedButton, BCLabel, Laz2_XMLCfg;
|
|
|
|
type
|
|
|
|
{ TFormBGRAImageManipulationDemo }
|
|
|
|
TFormBGRAImageManipulationDemo = class(TForm)
|
|
Background: TBCPanel;
|
|
BCLabel1: TBCLabel;
|
|
BCLabel2: TBCLabel;
|
|
BCLabel3: TBCLabel;
|
|
BCLabel4: TBCLabel;
|
|
BCLabel5: TBCLabel;
|
|
BCLabel6: TBCLabel;
|
|
BCLabel7: TBCLabel;
|
|
BCPanelCropAreaLoad: TBCPanel;
|
|
BCPanelCropArea: TBCPanel;
|
|
BCPanelCropAreas: TBCPanel;
|
|
btApplyAspectRatio: TSpeedButton;
|
|
btBox_Add: TBGRASpeedButton;
|
|
btBox_Del: TBGRASpeedButton;
|
|
btCFlipHLeft: TSpeedButton;
|
|
btCFlipHRight: TSpeedButton;
|
|
btCFlipVUp: TSpeedButton;
|
|
btCFlipVDown: TSpeedButton;
|
|
btCropDuplicate: TSpeedButton;
|
|
btnEmptyImage: TBCButton;
|
|
btnLoadCropList: TBCButton;
|
|
btnSaveCropList: TBCButton;
|
|
btnSavePictureAll: TBCButton;
|
|
btnShape: TBCButton;
|
|
btnOpenPicture: TBCButton;
|
|
BGRAImageManipulation: TBGRAImageManipulation;
|
|
btnGetAspectRatioFromImage: TBCButton;
|
|
btnSavePicture: TBCButton;
|
|
btnSetAspectRatio: TBCButton;
|
|
btnRotateLeft: TBCButton;
|
|
btnRotateRight: TBCButton;
|
|
btCRotateRight: TSpeedButton;
|
|
btCRotateLeft: TSpeedButton;
|
|
cbBoxList: TComboBox;
|
|
chkFullSize: TCheckBox;
|
|
cbSaveFormat: TComboBox;
|
|
chkCopyProperties: TCheckBox;
|
|
edAspectPersonal: TEdit;
|
|
edAspectRatio: TEdit;
|
|
edHeight: TFloatSpinEdit;
|
|
edLeft: TFloatSpinEdit;
|
|
edName: TEdit;
|
|
edTop: TFloatSpinEdit;
|
|
edUnit_Type: TComboBox;
|
|
edWidth: TFloatSpinEdit;
|
|
KeepAspectRatio: TCheckBox;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
Label3: TLabel;
|
|
lbResolution: TLabel;
|
|
lbAspectRatio: TLabel;
|
|
lbOptions: TLabel;
|
|
lbCompression: TLabel;
|
|
lbOptions1: TLabel;
|
|
OpenCropList: TOpenDialog;
|
|
OpenPictureDialog: TOpenPictureDialog;
|
|
rgAspect: TRadioGroup;
|
|
SaveCropList: TSaveDialog;
|
|
SavePictureDialog: TSavePictureDialog;
|
|
RateCompression: TTrackBar;
|
|
SelectDirectoryDialog1: TSelectDirectoryDialog;
|
|
SpeedButton1: TSpeedButton;
|
|
btZFront: TSpeedButton;
|
|
btZBack: TSpeedButton;
|
|
btZDown: TSpeedButton;
|
|
btZUp: TSpeedButton;
|
|
btCropDuplicateOp: TSpeedButton;
|
|
procedure btCFlipHLeftClick(Sender: TObject);
|
|
procedure btCFlipHRightClick(Sender: TObject);
|
|
procedure btCFlipVDownClick(Sender: TObject);
|
|
procedure btCFlipVUpClick(Sender: TObject);
|
|
procedure btCropDuplicateClick(Sender: TObject);
|
|
procedure btCRotateLeftClick(Sender: TObject);
|
|
procedure btCRotateRightClick(Sender: TObject);
|
|
procedure btnEmptyImageClick(Sender: TObject);
|
|
procedure btnGetAspectRatioFromImageClick(Sender: TObject);
|
|
procedure btnLoadCropListClick(Sender: TObject);
|
|
procedure btnOpenPictureClick(Sender: TObject);
|
|
procedure btnRotateLeftClick(Sender: TObject);
|
|
procedure btnRotateRightClick(Sender: TObject);
|
|
procedure btnSaveCropListClick(Sender: TObject);
|
|
procedure btnSavePictureAllClick(Sender: TObject);
|
|
procedure btnSavePictureClick(Sender: TObject);
|
|
procedure btnSetAspectRatioClick(Sender: TObject);
|
|
procedure btZBackClick(Sender: TObject);
|
|
procedure btZDownClick(Sender: TObject);
|
|
procedure btZFrontClick(Sender: TObject);
|
|
procedure btZUpClick(Sender: TObject);
|
|
procedure edNameChange(Sender: TObject);
|
|
procedure edUnit_TypeChange(Sender: TObject);
|
|
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
procedure KeepAspectRatioClick(Sender: TObject);
|
|
|
|
procedure btBox_AddClick(Sender: TObject);
|
|
procedure btBox_DelClick(Sender: TObject);
|
|
procedure cbBoxListChange(Sender: TObject);
|
|
procedure edHeightChange(Sender: TObject; AByUser: boolean);
|
|
procedure edLeftChange(Sender: TObject; AByUser: boolean);
|
|
procedure edTopChange(Sender: TObject; AByUser: boolean);
|
|
procedure edWidthChange(Sender: TObject; AByUser: boolean);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure rgAspectSelectionChanged(Sender: TObject);
|
|
procedure btApplyAspectRatioClick(Sender: TObject);
|
|
|
|
procedure AddedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);
|
|
procedure DeletedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);
|
|
procedure ChangedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);
|
|
procedure SelectedChangedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);
|
|
procedure SpeedButton1Click(Sender: TObject);
|
|
private
|
|
{ private declarations }
|
|
lastNewBoxNum :Word;
|
|
changingAspect, closing,
|
|
inFillBoxUI :Boolean;
|
|
|
|
function GetCurrentCropArea: TCropArea;
|
|
procedure FillBoxUI(ABox :TCropArea);
|
|
procedure SaveCallBack(Bitmap :TBGRABitmap; CropArea: TCropArea; AUserData:Integer);
|
|
procedure UpdateBoxList;
|
|
public
|
|
{ public declarations }
|
|
end;
|
|
|
|
var
|
|
FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
uses BGRAWriteBMP, BGRAReadWriteConfig;
|
|
|
|
const
|
|
ResUnitStr :array[TResolutionUnit] of String = ('ruNone', 'ruPixelsPerInch', 'ruPixelsPerCentimeter');
|
|
|
|
{ TFormBGRAImageManipulationDemo }
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btnOpenPictureClick(Sender: TObject);
|
|
var
|
|
Bitmap: TBGRABitmap;
|
|
test:Integer;
|
|
// reader:TFPCustomImageReader;
|
|
|
|
begin
|
|
// To put a new image in the component, you will simply need execute open
|
|
// picture dialog to locate an image...
|
|
if OpenPictureDialog.Execute then
|
|
begin
|
|
// ...and create a new TBGRABitmap and load to it
|
|
Bitmap := TBGRABitmap.Create;
|
|
Bitmap.LoadFromFile(OpenPictureDialog.FileName);
|
|
// Finally, associate the image into component
|
|
BGRAImageManipulation.Bitmap := Bitmap;
|
|
Bitmap.Free;
|
|
|
|
lbResolution.Caption:='Resolution : '+#13#10+' '+
|
|
FloatToStrF(BGRAImageManipulation.Bitmap.ResolutionX, ffFixed, 15, 3)+' x '+
|
|
FloatToStrF(BGRAImageManipulation.Bitmap.ResolutionY, ffFixed, 15, 3)+' '+ResUnitStr[BGRAImageManipulation.Bitmap.ResolutionUnit]+#13#10+
|
|
' '+FloatToStr(BGRAImageManipulation.Bitmap.ResolutionWidth)+' x '+FloatToStr(BGRAImageManipulation.Bitmap.ResolutionHeight)+#13#10+
|
|
' pixels '+IntToStr(BGRAImageManipulation.Bitmap.Width)+' x '+IntToStr(BGRAImageManipulation.Bitmap.Height);
|
|
|
|
if (BGRAImageManipulation.SelectedCropArea=nil)
|
|
then begin
|
|
edUnit_Type.ItemIndex:=Integer(BGRAImageManipulation.Bitmap.ResolutionUnit);
|
|
edLeft.MaxValue:=BGRAImageManipulation.Bitmap.ResolutionWidth;
|
|
edTop.MaxValue:=BGRAImageManipulation.Bitmap.ResolutionHeight;
|
|
edWidth.MaxValue:=BGRAImageManipulation.Bitmap.ResolutionWidth;
|
|
edHeight.MaxValue:=BGRAImageManipulation.Bitmap.ResolutionHeight;
|
|
end
|
|
else FillBoxUI(BGRAImageManipulation.SelectedCropArea);
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btnRotateLeftClick(Sender: TObject);
|
|
begin
|
|
BGRAImageManipulation.rotateLeft;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btnRotateRightClick(Sender: TObject);
|
|
begin
|
|
BGRAImageManipulation.rotateRight;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btnGetAspectRatioFromImageClick(
|
|
Sender: TObject);
|
|
begin
|
|
if not (BGRAImageManipulation.Empty) then
|
|
begin
|
|
edAspectRatio.Text := BGRAImageManipulation.getAspectRatioFromImage(
|
|
BGRAImageManipulation.Bitmap);
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btnEmptyImageClick(Sender: TObject);
|
|
var
|
|
emptyImg :TBGRABitmap;
|
|
|
|
begin
|
|
try
|
|
emptyImg :=TBGRABitmap.Create(0, 0);
|
|
BGRAImageManipulation.Bitmap :=emptyImg;
|
|
finally
|
|
emptyImg.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btCRotateLeftClick(Sender: TObject);
|
|
var
|
|
CropArea :TCropArea;
|
|
|
|
begin
|
|
CropArea :=GetCurrentCropArea;
|
|
if CropArea<>nil then
|
|
begin
|
|
if btCropDuplicateOp.Down then
|
|
begin
|
|
CropArea :=TCropArea.Create(BGRAImageManipulation, CropArea, True);
|
|
BGRAImageManipulation.SelectedCropArea :=CropArea;
|
|
end;
|
|
CropArea.RotateLeft;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btCFlipVDownClick(Sender: TObject);
|
|
var
|
|
CropArea :TCropArea;
|
|
|
|
begin
|
|
CropArea :=GetCurrentCropArea;
|
|
if CropArea<>nil then
|
|
begin
|
|
if btCropDuplicateOp.Down then
|
|
begin
|
|
CropArea :=TCropArea.Create(BGRAImageManipulation, CropArea, True);
|
|
BGRAImageManipulation.SelectedCropArea :=CropArea;
|
|
end;
|
|
CropArea.FlipVDown;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btCFlipHLeftClick(Sender: TObject);
|
|
var
|
|
CropArea :TCropArea;
|
|
|
|
begin
|
|
CropArea :=GetCurrentCropArea;
|
|
if CropArea<>nil then
|
|
begin
|
|
if btCropDuplicateOp.Down then
|
|
begin
|
|
CropArea :=TCropArea.Create(BGRAImageManipulation, CropArea, True);
|
|
BGRAImageManipulation.SelectedCropArea :=CropArea;
|
|
end;
|
|
CropArea.FlipHLeft;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btCFlipHRightClick(Sender: TObject);
|
|
var
|
|
CropArea :TCropArea;
|
|
|
|
begin
|
|
CropArea :=GetCurrentCropArea;
|
|
if CropArea<>nil then
|
|
begin
|
|
if btCropDuplicateOp.Down then
|
|
begin
|
|
CropArea :=TCropArea.Create(BGRAImageManipulation, CropArea, True);
|
|
BGRAImageManipulation.SelectedCropArea :=CropArea;
|
|
end;
|
|
CropArea.FlipHRight;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btCFlipVUpClick(Sender: TObject);
|
|
var
|
|
CropArea :TCropArea;
|
|
|
|
begin
|
|
CropArea :=GetCurrentCropArea;
|
|
if CropArea<>nil then
|
|
begin
|
|
if btCropDuplicateOp.Down then
|
|
begin
|
|
CropArea :=TCropArea.Create(BGRAImageManipulation, CropArea, True);
|
|
BGRAImageManipulation.SelectedCropArea :=CropArea;
|
|
end;
|
|
CropArea.FlipVUp;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btCropDuplicateClick(Sender: TObject);
|
|
var
|
|
newCropArea :TCropArea;
|
|
|
|
begin
|
|
if BGRAImageManipulation.SelectedCropArea<>nil then
|
|
begin
|
|
newCropArea :=TCropArea.Create(BGRAImageManipulation, BGRAImageManipulation.SelectedCropArea, True);
|
|
BGRAImageManipulation.SelectedCropArea :=newCropArea;
|
|
newCropArea.BorderColor :=VGALime;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btCRotateRightClick(Sender: TObject);
|
|
var
|
|
CropArea :TCropArea;
|
|
|
|
begin
|
|
CropArea :=GetCurrentCropArea;
|
|
if CropArea<>nil then
|
|
begin
|
|
if btCropDuplicateOp.Down then
|
|
begin
|
|
CropArea :=TCropArea.Create(BGRAImageManipulation, CropArea, True);
|
|
BGRAImageManipulation.SelectedCropArea :=CropArea;
|
|
end;
|
|
CropArea.RotateRight;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btnLoadCropListClick(Sender: TObject);
|
|
begin
|
|
try
|
|
if OpenCropList.Execute
|
|
then BGRAImageManipulation.CropAreas.LoadFromFile(OpenCropList.FileName);
|
|
except
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btnSaveCropListClick(Sender: TObject);
|
|
begin
|
|
try
|
|
if SaveCropList.Execute
|
|
then BGRAImageManipulation.CropAreas.SaveToFile(SaveCropList.FileName);
|
|
except
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btnSavePictureClick(Sender: TObject);
|
|
var
|
|
curBitmap :TBGRABitmap;
|
|
|
|
begin
|
|
if SavePictureDialog.Execute then
|
|
begin
|
|
try
|
|
if (chkFullSize.Checked)
|
|
then curBitmap :=BGRAImageManipulation.getBitmap(Nil, chkCopyProperties.Checked)
|
|
else curBitmap :=BGRAImageManipulation.getResampledBitmap(Nil, chkCopyProperties.Checked);
|
|
|
|
curBitmap.SaveToFile(SavePictureDialog.FileName);
|
|
finally
|
|
curBitmap.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.SaveCallBack(Bitmap: TBGRABitmap; CropArea: TCropArea; AUserData: Integer);
|
|
var
|
|
ext:String;
|
|
i:Integer;
|
|
|
|
begin
|
|
ext:=ImageHandlers.Extensions[cbSaveFormat.Items[cbSaveFormat.ItemIndex]];
|
|
i :=Pos(';', ext);
|
|
if (i>0) then ext :=Copy(ext, 1, i-1);
|
|
Bitmap.SaveToFile(SelectDirectoryDialog1.FileName+DirectorySeparator+CropArea.Name+'.'+ext);
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.UpdateBoxList;
|
|
var
|
|
i :Integer;
|
|
CropArea,
|
|
SelArea:TCropArea;
|
|
|
|
begin
|
|
cbBoxList.OnChange:=nil;
|
|
|
|
//SelArea :=BGRAImageManipulation.SelectedCropArea;
|
|
cbBoxList.Clear;
|
|
for i:=0 to BGRAImageManipulation.CropAreas.Count-1 do
|
|
begin
|
|
CropArea :=BGRAImageManipulation.CropAreas.items[i];
|
|
cbBoxList.AddItem(CropArea.Name, CropArea);
|
|
end;
|
|
//BGRAImageManipulation.SelectedCropArea :=SelArea;
|
|
cbBoxList.ItemIndex:=cbBoxList.Items.IndexOfObject(BGRAImageManipulation.SelectedCropArea);
|
|
|
|
cbBoxList.OnChange:=@cbBoxListChange;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btnSavePictureAllClick(Sender: TObject);
|
|
begin
|
|
if SelectDirectoryDialog1.Execute then
|
|
begin
|
|
if (chkFullSize.Checked)
|
|
then Self.BGRAImageManipulation.getAllBitmaps(@SaveCallBack, 0, chkCopyProperties.Checked)
|
|
else Self.BGRAImageManipulation.getAllResampledBitmaps(@SaveCallBack, 0, chkCopyProperties.Checked);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btnSetAspectRatioClick(Sender: TObject);
|
|
begin
|
|
try
|
|
BGRAImageManipulation.AspectRatio := edAspectRatio.Text;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
ShowMessage('This aspect ratio is invalid');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btZBackClick(Sender: TObject);
|
|
var
|
|
CropArea :TCropArea;
|
|
|
|
begin
|
|
CropArea :=GetCurrentCropArea;
|
|
if CropArea<>nil
|
|
then begin
|
|
CropArea.BringToBack;
|
|
UpdateBoxList;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btZDownClick(Sender: TObject);
|
|
var
|
|
CropArea :TCropArea;
|
|
|
|
begin
|
|
CropArea :=GetCurrentCropArea;
|
|
if CropArea<>nil
|
|
then begin
|
|
CropArea.BringBackward;
|
|
UpdateBoxList;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btZFrontClick(Sender: TObject);
|
|
var
|
|
CropArea :TCropArea;
|
|
|
|
begin
|
|
CropArea :=GetCurrentCropArea;
|
|
if CropArea<>nil
|
|
then begin
|
|
CropArea.BringToFront;
|
|
UpdateBoxList;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btZUpClick(Sender: TObject);
|
|
var
|
|
CropArea :TCropArea;
|
|
|
|
begin
|
|
CropArea :=GetCurrentCropArea;
|
|
if CropArea<>nil
|
|
then begin
|
|
CropArea.BringForward;
|
|
UpdateBoxList;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.edNameChange(Sender: TObject);
|
|
var
|
|
CropArea :TCropArea;
|
|
|
|
begin
|
|
CropArea :=GetCurrentCropArea;
|
|
if CropArea<>nil
|
|
then CropArea.Name :=edName.Text;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.edUnit_TypeChange(Sender: TObject);
|
|
var
|
|
CropArea :TCropArea;
|
|
|
|
begin
|
|
CropArea :=GetCurrentCropArea;
|
|
if CropArea<>nil then
|
|
begin
|
|
CropArea.AreaUnit:=TResolutionUnit(edUnit_Type.ItemIndex);
|
|
FillBoxUI(CropArea);
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.FormCloseQuery(Sender: TObject;
|
|
var CanClose: Boolean);
|
|
begin
|
|
closing :=True;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.KeepAspectRatioClick(Sender: TObject);
|
|
begin
|
|
BGRAImageManipulation.KeepAspectRatio := KeepAspectRatio.Checked;
|
|
edAspectRatio.Enabled := KeepAspectRatio.Checked;
|
|
btnSetAspectRatio.Enabled := KeepAspectRatio.Checked;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btBox_AddClick(Sender: TObject);
|
|
var
|
|
newCropArea :TCropArea;
|
|
|
|
begin
|
|
if edUnit_Type.ItemIndex=0
|
|
then newCropArea :=BGRAImageManipulation.addCropArea(RectF(50, 50, 100, 100))
|
|
else newCropArea :=BGRAImageManipulation.addCropArea(RectF(1, 1, 2, 2), TResolutionUnit(edUnit_Type.ItemIndex));
|
|
|
|
newCropArea.BorderColor :=VGALime;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btBox_DelClick(Sender: TObject);
|
|
var
|
|
CropArea :TCropArea;
|
|
curIndex :Integer;
|
|
|
|
begin
|
|
curIndex :=cbBoxList.ItemIndex;
|
|
if (curIndex>-1) then
|
|
begin
|
|
CropArea :=TCropArea(cbBoxList.Items.Objects[curIndex]);
|
|
BGRAImageManipulation.delCropArea(CropArea);
|
|
cbBoxList.ItemIndex:=cbBoxList.Items.IndexOfObject(BGRAImageManipulation.SelectedCropArea);
|
|
end;
|
|
FillBoxUI(BGRAImageManipulation.SelectedCropArea);
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.cbBoxListChange(Sender: TObject);
|
|
begin
|
|
BGRAImageManipulation.SelectedCropArea :=TCropArea(cbBoxList.Items.Objects[cbBoxList.ItemIndex]);
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.edHeightChange(Sender: TObject; AByUser: boolean);
|
|
var
|
|
CropArea :TCropArea;
|
|
|
|
begin
|
|
if inFillBoxUI then exit;
|
|
|
|
CropArea :=GetCurrentCropArea;
|
|
if (CropArea<>nil)
|
|
then CropArea.Height:=edHeight.Value;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.edLeftChange(Sender: TObject; AByUser: boolean);
|
|
var
|
|
CropArea :TCropArea;
|
|
|
|
begin
|
|
if inFillBoxUI then exit;
|
|
|
|
CropArea :=GetCurrentCropArea;
|
|
if (CropArea<>nil)
|
|
then CropArea.Left :=edLeft.Value;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.edTopChange(Sender: TObject; AByUser: boolean);
|
|
var
|
|
CropArea :TCropArea;
|
|
|
|
begin
|
|
if inFillBoxUI then exit;
|
|
|
|
CropArea :=GetCurrentCropArea;
|
|
if (CropArea<>nil)
|
|
then CropArea.Top :=edTop.Value;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.edWidthChange(Sender: TObject; AByUser: boolean);
|
|
var
|
|
CropArea :TCropArea;
|
|
|
|
begin
|
|
if inFillBoxUI then exit;
|
|
|
|
CropArea :=GetCurrentCropArea;
|
|
if (CropArea<>nil)
|
|
then CropArea.Width:=edWidth.Value;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.FormCreate(Sender: TObject);
|
|
var
|
|
i,j :Integer;
|
|
t,e:String;
|
|
|
|
begin
|
|
closing :=False;
|
|
changingAspect :=False;
|
|
inFillBoxUI :=False;
|
|
lastNewBoxNum :=0;
|
|
TStringList(cbBoxList.Items).OwnsObjects:=False;
|
|
j:=0;
|
|
for i :=0 to ImageHandlers.Count-1 do
|
|
begin
|
|
t :=ImageHandlers.TypeNames[i];
|
|
e :=ImageHandlers.Extensions[t];
|
|
if (ImageHandlers.ImageWriter[t]<>nil) then
|
|
begin
|
|
cbSaveFormat.Items.Add(t);
|
|
if (Pos('jpg', e)>0) then j:=i;
|
|
end;
|
|
end;
|
|
cbSaveFormat.ItemIndex:=j-1;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.rgAspectSelectionChanged(Sender: TObject);
|
|
begin
|
|
if changingAspect then Exit;
|
|
|
|
Case rgAspect.ItemIndex of
|
|
0 : BGRAImageManipulation.SelectedCropArea.KeepAspectRatio:=bParent;
|
|
1 : BGRAImageManipulation.SelectedCropArea.KeepAspectRatio:=bFalse;
|
|
2 : begin
|
|
BGRAImageManipulation.SelectedCropArea.KeepAspectRatio:=bTrue;
|
|
BGRAImageManipulation.SelectedCropArea.AspectRatio:=edAspectPersonal.Text;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.btApplyAspectRatioClick(Sender: TObject);
|
|
begin
|
|
if BGRAImageManipulation.SelectedCropArea.KeepAspectRatio=bTrue
|
|
then BGRAImageManipulation.SelectedCropArea.AspectRatio:=edAspectPersonal.Text
|
|
else begin
|
|
BGRAImageManipulation.SelectedCropArea.KeepAspectRatio:=bTrue;
|
|
BGRAImageManipulation.SelectedCropArea.AspectRatio:=edAspectPersonal.Text;
|
|
changingAspect :=True;
|
|
rgAspect.ItemIndex :=2;
|
|
changingAspect :=False;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.AddedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);
|
|
var
|
|
curIndex :Integer;
|
|
|
|
begin
|
|
curIndex :=BGRAImageManipulation.CropAreas.IndexOf(CropArea);
|
|
|
|
if (CropArea.Name='')
|
|
then CropArea.Name:='Name '+IntToStr(curIndex);
|
|
|
|
cbBoxList.AddItem(CropArea.Name, CropArea);
|
|
cbBoxList.ItemIndex:=cbBoxList.Items.IndexOfObject(CropArea);
|
|
//CropArea.AreaUnit:=BGRAImageManipulation.Bitmap.ResolutionUnit;
|
|
FillBoxUI(CropArea);
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.DeletedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);
|
|
var
|
|
delIndex :Integer;
|
|
begin
|
|
try
|
|
if not(closing) then
|
|
begin
|
|
delIndex :=cbBoxList.Items.IndexOfObject(CropArea);
|
|
if (delIndex<>-1)
|
|
then cbBoxList.Items.Delete(delIndex);
|
|
BCPanelCropArea.Enabled:=(cbBoxList.Items.Count>0);
|
|
end;
|
|
except
|
|
end;
|
|
//MessageDlg('Deleting Crop Area', 'Deleting '+CropArea.Name, mtInformation, [mbOk], 0);
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.ChangedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);
|
|
begin
|
|
if (cbBoxList.Items.Objects[cbBoxList.ItemIndex] = CropArea) then
|
|
begin
|
|
FillBoxUI(CropArea);
|
|
|
|
//if the Name is Changed change in the comboListbox
|
|
if (CropArea.Name<>cbBoxList.Items.Strings[cbBoxList.ItemIndex])
|
|
then cbBoxList.Items.Strings[cbBoxList.ItemIndex] :=CropArea.Name;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.SelectedChangedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);
|
|
var
|
|
newIndex :Integer;
|
|
begin
|
|
if (BGRAImageManipulation.SelectedCropArea <> nil)
|
|
then newIndex :=cbBoxList.Items.IndexOfObject(BGRAImageManipulation.SelectedCropArea) //BGRAImageManipulation.SelectedCropArea.Index;
|
|
else newIndex :=-1;
|
|
|
|
cbBoxList.ItemIndex:=newIndex;
|
|
FillBoxUI(BGRAImageManipulation.SelectedCropArea);
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.SpeedButton1Click(Sender: TObject);
|
|
var
|
|
img, img2:TBGRABitmap;
|
|
wr:TBGRAWriterBMP;
|
|
wp:TFPPalette;
|
|
ReadWriteConfig, ReadWriteConfig2: TBGRAReadWriteConfig;
|
|
|
|
begin
|
|
//BGRAImageManipulation.SetEmptyImageSizeToCropAreas(False);
|
|
(*
|
|
img:=TBGRABitmap.Create('c:\Programming\Lazarus\tmp\test_0_gray.bmp');
|
|
wp:=img.Palette;
|
|
wr:=TBGRAWriterBMP.Create;
|
|
wr.BitsPerPixel:=8;
|
|
img2 :=img.GetPart(Rect(0,0,1176,1176));
|
|
wp:=img2.Palette;
|
|
img2.SaveToFile('test_a.bmp', wr);
|
|
wr.Free;
|
|
img.Free;
|
|
img2.Free;
|
|
*)
|
|
end;
|
|
|
|
function TFormBGRAImageManipulationDemo.GetCurrentCropArea: TCropArea;
|
|
begin
|
|
if (cbBoxList.ItemIndex<0)
|
|
then Result :=nil
|
|
else Result :=TCropArea(cbBoxList.Items.Objects[cbBoxList.ItemIndex]);
|
|
end;
|
|
|
|
procedure TFormBGRAImageManipulationDemo.FillBoxUI(ABox: TCropArea);
|
|
begin
|
|
if (ABox<>nil)
|
|
then begin
|
|
inFillBoxUI :=True;
|
|
BCPanelCropArea.Enabled :=True;
|
|
edName.Text :=ABox.Name;
|
|
edUnit_Type.ItemIndex :=Integer(ABox.AreaUnit);
|
|
|
|
if (ABox.AreaUnit=ruNone)
|
|
then begin
|
|
edLeft.DecimalPlaces:=0;
|
|
edTop.DecimalPlaces:=0;
|
|
edWidth.DecimalPlaces:=0;
|
|
edHeight.DecimalPlaces:=0;
|
|
end
|
|
else begin
|
|
edLeft.DecimalPlaces:=3;
|
|
edTop.DecimalPlaces:=3;
|
|
edWidth.DecimalPlaces:=3;
|
|
edHeight.DecimalPlaces:=3;
|
|
end;
|
|
edLeft.MaxValue:=ABox.MaxWidth;
|
|
edTop.MaxValue:=ABox.MaxHeight;
|
|
edWidth.MaxValue:=edLeft.MaxValue;
|
|
edHeight.MaxValue:=edTop.MaxValue;
|
|
|
|
edLeft.Value :=ABox.Left;
|
|
edTop.Value :=ABox.Top;
|
|
edWidth.Value :=ABox.Width;
|
|
edHeight.Value :=ABox.Height;
|
|
|
|
//Aspect Ratio
|
|
changingAspect :=True;
|
|
Case ABox.KeepAspectRatio of
|
|
bParent :rgAspect.ItemIndex:=0;
|
|
bFalse :rgAspect.ItemIndex:=1;
|
|
bTrue :rgAspect.ItemIndex:=2;
|
|
end;
|
|
edAspectPersonal.Text:=ABox.AspectRatio;
|
|
changingAspect:=False;
|
|
inFillBoxUI :=False;
|
|
end
|
|
else BCPanelCropArea.Enabled :=False;
|
|
end;
|
|
|
|
|
|
end.
|