source: trunk/Packages/bgracontrols/bgraimagemanipulation.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 67.4 KB
Line 
1unit BGRAImageManipulation;
2
3{ ============================================================================
4 BGRAImageManipulation Unit
5
6 Copyright (C) 2011 - Emerson Cavalcanti <emersoncavalcanti at googlesites>
7
8 This library is free software; you can redistribute it and/or modify it
9 under the terms of the GNU Library General Public License as published by
10 the Free Software Foundation; either version 2 of the License, or (at your
11 option) any later version.
12
13 This program is distributed in the hope that it will be useful, but WITHOUT
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
16 for more details.
17
18 You should have received a copy of the GNU Library General Public License
19 along with this library; if not, write to the Free Software Foundation,
20 Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
21
22 ============================================================================
23 Description:
24
25 TBGRAImageManipulation is a component designed to make simple changes in an
26 image while maintaining the aspect ratio of the final image and allow it to
27 cut to reduce the unnecessary edges. The selected area is painted with a
28 different transparency level for easy viewing of what will be cut.
29
30 ============================================================================
31 History:
32
33 2011-05-03 - Emerson Cavalcanti
34 - Initial version
35
36 2011-06-01 - Emerson Cavalcanti
37 - Fixed aspect ratio when the image has a dimension smaller than
38 the size of the component.
39 - Fixed memory leak on temporary bitmaps.
40 - Fixed unecessary release of bitmap.
41 - Inserted Anchor and Align property on component.
42 - Implemented 'Keep aspect Ratio' property. Now you can select an
43 area without maintaining the aspect ratio.
44
45 2011-06-03 - Emerson Cavalcanti
46 - Improved selection when don't use aspect ratio.
47 - Improved response when resize component.
48 - Fixed memory leak on resample bitmap.
49
50 2011-06-04 - Circular
51 - Fixed divide by zero when calculate aspect ratio on
52 getImageRect.
53
54 2011-06-07 - Emerson Cavalcanti
55 - Improved function of aspect ratio including a variable to
56 provide the value directly in the component, instead of using
57 the dimensions of the component as the source of this value.
58 - Improved exhibition of anchors on selection.
59 - Improved mouse cursor.
60 - Included function to get the aspect ratio from image size.
61 - Included rotate Left and Right functions.
62
63 ============================================================================
64}
65
66{$mode objfpc}{$H+}
67
68interface
69
70uses
71 Classes, SysUtils, LResources, Forms, Controls, BGRABitmap, BGRABitmapTypes,
72 Graphics, Dialogs, LCLIntf, BGRAGradientScanner;
73
74{$INCLUDE DataType.inc}
75
76type
77 TBGRAImageManipulation = class(TGraphicControl)
78 private
79 { Private declarations }
80
81 fAnchorSize: byte;
82 fAnchorSelected: TDirection;
83 fBorderSize: byte;
84 fAspectRatio: string;
85 fAspectX: integer;
86 fAspectY: integer;
87 fKeepAspectRatio: boolean;
88 fMinHeight: integer;
89 fMinWidth: integer;
90 fMouseCaught: boolean;
91 fStartPoint: TPoint;
92 fEndPoint: TPoint;
93
94 fGCD: integer;
95 fRatio: TRatio;
96 fSizeLimits: TSizeLimits;
97
98 fImageBitmap, fResampledBitmap, fBackground, fVirtualScreen: TBGRABitmap;
99
100 fCropArea: TRect;
101 fDeltaX, fDeltaY: integer;
102
103 function getAnchorSize: byte;
104 procedure setAnchorSize(const Value: byte);
105 function getEmpty: boolean;
106 procedure setBitmap(const Value: TBGRABitmap);
107 procedure setBorderSize(const Value: byte);
108 procedure setAspectRatio(const Value: string);
109 procedure setKeepAspectRatio(const Value: boolean);
110 procedure setMinHeight(const Value: integer);
111 procedure setMinWidth(const Value: integer);
112 protected
113 { Protected declarations }
114
115 function ApplyDimRestriction(Coords: TCoord; Direction: TDirection;
116 Bounds: TRect): TCoord;
117 function ApplyRatioToAxes(Coords: TCoord; Direction: TDirection;
118 Bounds: Trect): TCoord;
119 procedure CalcMaxSelection;
120 procedure findSizeLimits;
121 function getDirection(const Point1, Point2: TPoint): TDirection;
122 function getGCD(Nr1, Nr2: longint): longint;
123 function getLCM(Nr1, Nr2: longint): longint;
124 function getImageRect(Picture: TBGRABitmap): TRect;
125 function getWorkRect: TRect;
126 function isOverAnchor(Point: TPoint; Corner: TPoint): boolean;
127
128 procedure Paint; override;
129 procedure RepaintBackground;
130 procedure Resize; override;
131 procedure Render;
132
133 procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
134 X, Y: integer); override;
135 procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
136 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
137 public
138 { Public declarations }
139
140 constructor Create(AOwner: TComponent); override;
141 destructor Destroy; override;
142 procedure Invalidate; override;
143 function getAspectRatioFromImage(const Value: TBGRABitmap): string;
144 function getBitmap: TBGRABitmap;
145
146 procedure rotateLeft;
147 procedure rotateRight;
148 published
149 { Published declarations }
150
151 property Align;
152 property Anchors;
153
154 property AnchorSize: byte Read getAnchorSize Write setAnchorSize default 5;
155 property Bitmap: TBGRABitmap Read fImageBitmap Write setBitmap;
156 property BorderSize: byte Read fBorderSize Write setBorderSize default 2;
157 property AspectRatio: string Read fAspectRatio Write setAspectRatio;
158 property KeepAspectRatio: boolean Read fKeepAspectRatio
159 Write setKeepAspectRatio default True;
160 property MinHeight: integer Read fMinHeight Write setMinHeight;
161 property MinWidth: integer Read fMinWidth Write setMinWidth;
162 property Empty: boolean Read getEmpty;
163 end;
164
165procedure Register;
166
167implementation
168
169uses Math, ExtCtrls;
170
171resourcestring
172 SAnchorSizeIsTooLarge =
173 'Anchor size is too large. %d is not within the valid range of %d..%d';
174 SAnchorSizeIsTooSmall =
175 'Anchor size is too small. %d is not within the valid range of %d..%d';
176 SAnchorSizeIsNotOdd = 'Anchor size is invalid. %d is not an odd number.';
177
178 SBorderSizeIsTooLarge =
179 'Border size is too large. %d is not within the valid range of %d..%d';
180 SBorderSizeIsTooSmall =
181 'Border size is too small. %d is not within the valid range of %d..%d';
182
183 SAspectRatioIsNotValid = 'Aspect ratio value is invalid. %s contain invalid number.';
184
185 { ============================================================================ }
186 { =====[ Auxiliary Functions ]================================================ }
187 { ============================================================================ }
188
189{ Applies the given size constraint on the coordinates along both axes }
190function TBGRAImageManipulation.ApplyDimRestriction(Coords: TCoord;
191 Direction: TDirection; Bounds: TRect): TCoord;
192var
193 newCoords: TCoord;
194 calcWidth, calcHeight: integer;
195 recalculateHeight: boolean;
196begin
197 // Gets coordinates
198 newCoords := Coords;
199 recalculateHeight := False;
200
201 // Calculated width
202 calcWidth := abs(newCoords.x2 - newCoords.x1);
203 calcHeight := abs(newCoords.y2 - newCoords.y1);
204
205 // Checks if the width is smaller than the minimum value
206 if (Abs(calcWidth) < MinWidth) and (MinWidth < fImageBitmap.Width) then
207 begin
208 // Resizes the width based on the minimum value
209 calcWidth := MinWidth;
210
211 if (EAST in Direction) then
212 begin
213 // If the motion is in a positive direction, make sure we're not going out
214 // of bounds
215 if ((newCoords.x1 + calcWidth) > Bounds.Right) then
216 begin
217 // Moves the horizontal coordinates
218 newCoords.x1 := Bounds.Right - calcWidth;
219 newCoords.x2 := Bounds.Right;
220 end
221 else
222 begin
223 // Moves the last horizontal coordinate
224 newCoords.x2 := newCoords.x1 + calcWidth;
225 end;
226 end
227 else
228 begin
229 // If the motion is in a negative direction, make sure we're not going out
230 // of bounds
231 if ((newCoords.x1 - calcWidth) < Bounds.Left) then
232 begin
233 // Moves the horizontal coordinates
234 newCoords.x1 := Bounds.Left + calcWidth;
235 newCoords.x2 := Bounds.Left;
236 end
237 else
238 begin
239 // Moves the last horizontal coordinate
240 newCoords.x2 := newCoords.x1 - calcWidth;
241 end;
242 end;
243
244 if (fKeepAspectRatio) then
245 begin
246 // Resizes the height based on the minimum value
247 recalculateHeight := True;
248 end;
249 end;
250
251 // Checks if the height is smaller than the minimum value
252 if (((Abs(calcHeight) < MinHeight) and (MinHeight < fImageBitmap.Height)) or
253 recalculateHeight) then
254 begin
255 // Resizes the height based on the minimum value
256 calcHeight := MinHeight;
257
258 if (SOUTH in Direction) then
259 begin
260 // If the motion is in a positive direction, make sure we're not going out
261 // of bounds
262 if ((newCoords.y1 + calcHeight) > Bounds.Bottom) then
263 begin
264 // Moves the vertical coordinates
265 newCoords.y1 := Bounds.Bottom - calcHeight;
266 newCoords.y2 := Bounds.Bottom;
267 end
268 else
269 begin
270 // Moves the last horizontal coordinate
271 newCoords.y2 := newCoords.y1 + calcHeight;
272 end;
273 end
274 else
275 begin
276 // If the motion is in a negative direction, make sure we're not going out
277 // of bounds
278 if ((newCoords.y1 - calcHeight) < Bounds.Top) then
279 begin
280 // Moves the vertical coordinates
281 newCoords.y1 := Bounds.Top + calcHeight;
282 newCoords.y2 := Bounds.Top;
283 end
284 else
285 begin
286 // Moves the last horizontal coordinate
287 newCoords.y2 := newCoords.y1 - calcHeight;
288 end;
289 end;
290 end;
291
292 Result := newCoords;
293end;
294
295 { Applies the provided ratio to the coordinates based on direction and bounds }
296 { on both axes. }
297function TBGRAImageManipulation.ApplyRatioToAxes(Coords: TCoord;
298 Direction: TDirection; Bounds: TRect): TCoord;
299var
300 newCoords: TCoord;
301 calcWidth, calcHeight: integer;
302 RecalculatesOtherAxis: boolean;
303begin
304 // Gets coordinates
305 newCoords := Coords;
306
307 // Check if movement is only vertical
308 if ((fAnchorSelected = [NORTH]) or (fAnchorSelected = [SOUTH])) then
309 begin
310 // Vertical movement: keep current width
311 if (fKeepAspectRatio) then
312 begin
313 // Calculate height
314 calcHeight := newCoords.y2 - newCoords.y1;
315
316 // Make sure we're not going out of bounds
317 if (SOUTH in Direction) then
318 begin
319 if ((newCoords.y1 + calcHeight) > Bounds.Bottom) then
320 begin
321 calcHeight := Bounds.Bottom - newCoords.y1; // Limite height dimension
322 newCoords.y2 := Bounds.Bottom;
323 end;
324 end
325 else
326 begin
327 if ((newCoords.y1 + calcHeight) < Bounds.Top) then
328 begin
329 calcHeight := -(newCoords.y1 - Bounds.Top); // Limite height dimension
330 newCoords.y2 := Bounds.Top;
331 end;
332 end;
333
334 // Calculate the new width based on the proportion of height
335 calcWidth := Trunc(abs(calcHeight) * (fRatio.Horizontal / fRatio.Vertical));
336
337 // Make sure we're not going out of bounds
338 if (fAnchorSelected = [NORTH]) then
339 begin
340 if ((newCoords.x1 - calcWidth) < Bounds.Left) then
341 begin
342 calcWidth := newCoords.x1 - Bounds.Left; // Limite width dimension
343 newCoords.x2 := Bounds.Left;
344 RecalculatesOtherAxis := True;
345 end;
346 end
347 else
348 begin
349 if ((newCoords.x1 + calcWidth) > Bounds.Right) then
350 begin
351 calcWidth := Bounds.Right - newCoords.x1; // Limite width dimension
352 newCoords.x2 := Bounds.Right;
353 RecalculatesOtherAxis := True;
354 end;
355 end;
356
357 // Apply calculated dimensions of width on height
358 if (RecalculatesOtherAxis) then
359 begin
360 if (calcHeight > 0) then
361 calcHeight := Trunc(calcWidth * (fRatio.Vertical / fRatio.Horizontal))
362 else
363 calcHeight := -Trunc(calcWidth * (fRatio.Vertical / fRatio.Horizontal));
364
365 newCoords.y2 := newCoords.y1 + calcHeight;
366 end;
367 end
368 else
369 begin
370 // Calculate height
371 calcHeight := newCoords.y2 - newCoords.y1;
372
373 // Make sure we're not going out of bounds
374 if (SOUTH in Direction) then
375 begin
376 if ((newCoords.y1 + calcHeight) > Bounds.Bottom) then
377 begin
378 calcHeight := Bounds.Bottom - newCoords.y1; // Limite height dimension
379 newCoords.y2 := Bounds.Bottom;
380 end;
381 end
382 else
383 begin
384 if ((newCoords.y1 + calcHeight) < Bounds.Top) then
385 begin
386 calcHeight := -(newCoords.y1 - Bounds.Top); // Limite height dimension
387 newCoords.y2 := Bounds.Top;
388 end;
389 end;
390
391 // Calculate width
392 calcWidth := abs(fCropArea.Right - fCropArea.Left);
393 end;
394
395 if (fAnchorSelected = [NORTH]) then
396 newCoords.x2 := newCoords.x1 - calcWidth
397 else
398 newCoords.x2 := newCoords.x1 + calcWidth;
399 end
400 else
401 // Check if movement is only horizontal
402 if ((fAnchorSelected = [EAST]) or (fAnchorSelected = [WEST])) then
403 begin
404 // Horizontal movement: keep current height
405 if (fKeepAspectRatio) then
406 begin
407 // Calculate width
408 calcWidth := newCoords.x2 - newCoords.x1;
409
410 // Make sure we're not going out of bounds
411 if (EAST in Direction) then
412 begin
413 if ((newCoords.x1 + calcWidth) > Bounds.Right) then
414 begin
415 calcWidth := Bounds.Right - newCoords.x1; // Limite width dimension
416 newCoords.x2 := Bounds.Right;
417 end;
418 end;
419
420 if (WEST in Direction) then
421 begin
422 if ((newCoords.x1 + calcWidth) < Bounds.Left) then
423 begin
424 calcWidth := -(newCoords.x1 - Bounds.Left); // Limite width dimension
425 newCoords.x2 := Bounds.Left;
426 end;
427 end;
428
429 // Calculate the new height based on the proportion of width
430 calcHeight := Trunc(abs(calcWidth) * (fRatio.Vertical / fRatio.Horizontal));
431
432 // Make sure we're not going out of bounds
433 if (fAnchorSelected = [WEST]) then
434 begin
435 if ((newCoords.y1 - calcHeight) < Bounds.Top) then
436 begin
437 calcHeight := newCoords.y1 - Bounds.Top; // Limite height dimension
438 newCoords.y2 := Bounds.Top;
439 RecalculatesOtherAxis := True;
440 end;
441 end
442 else
443 begin
444 if ((newCoords.y1 + calcHeight) > Bounds.Bottom) then
445 begin
446 calcHeight := Bounds.Bottom - newCoords.y1; // Limite height dimension
447 newCoords.y2 := Bounds.Bottom;
448 RecalculatesOtherAxis := True;
449 end;
450 end;
451
452 // Apply calculated dimensions of height on width
453 if (RecalculatesOtherAxis) then
454 begin
455 if (calcWidth > 0) then
456 calcWidth := Trunc(calcHeight * (fRatio.Horizontal / fRatio.Vertical))
457 else
458 calcWidth := -Trunc(calcHeight * (fRatio.Horizontal / fRatio.Vertical));
459
460 newCoords.x2 := newCoords.x1 + calcWidth;
461 end;
462 end
463 else
464 begin
465 // Calculate width
466 calcWidth := newCoords.x2 - newCoords.x1;
467
468 // Make sure we're not going out of bounds
469 if (EAST in Direction) then
470 begin
471 if ((newCoords.x1 + calcWidth) > Bounds.Right) then
472 begin
473 calcWidth := Bounds.Right - newCoords.x1; // Limite width dimension
474 newCoords.x2 := Bounds.Right;
475 end;
476 end;
477
478 if (WEST in Direction) then
479 begin
480 if ((newCoords.x1 + calcWidth) < Bounds.Left) then
481 begin
482 calcWidth := -(newCoords.x1 - Bounds.Left); // Limite width dimension
483 newCoords.x2 := Bounds.Left;
484 end;
485 end;
486
487 // Calculate height
488 calcHeight := abs(fCropArea.Bottom - fCropArea.Top);
489 end;
490
491 if (fAnchorSelected = [WEST]) then
492 newCoords.y2 := newCoords.y1 - calcHeight
493 else
494 newCoords.y2 := newCoords.y1 + calcHeight;
495 end
496 else
497 begin
498 // Diagonal movement
499 if (fKeepAspectRatio) then
500 begin
501 // Calculate width
502 calcWidth := newCoords.x2 - newCoords.x1;
503
504 // Make sure we're not going out of bounds
505 if (EAST in Direction) then
506 begin
507 if ((newCoords.x1 + calcWidth) > Bounds.Right) then
508 begin
509 calcWidth := Bounds.Right - newCoords.x1; // Limite width dimension
510 newCoords.x2 := Bounds.Right;
511 end;
512 end;
513
514 if (WEST in Direction) then
515 begin
516 if ((newCoords.x1 + calcWidth) < Bounds.Left) then
517 begin
518 calcWidth := -(newCoords.x1 - Bounds.Left); // Limite width dimension
519 newCoords.x2 := Bounds.Left;
520 end;
521 end;
522
523 // Calculate the new height based on the proportion of width
524 if ((newCoords.y2 - newCoords.y1) > 0) then
525 calcHeight := Trunc(abs(calcWidth) * (fRatio.Vertical / fRatio.Horizontal))
526 else
527 calcHeight := -Trunc(abs(calcWidth) * (fRatio.Vertical / fRatio.Horizontal));
528
529 // Make sure we're not going out of bounds
530 if (calcHeight > 0) then
531 begin
532 if (SOUTH in Direction) then
533 begin
534 if ((newCoords.y1 + calcHeight) > Bounds.Bottom) then
535 begin
536 calcHeight := Bounds.Bottom - newCoords.y1; // Limite height dimension
537 newCoords.y2 := Bounds.Bottom;
538 RecalculatesOtherAxis := True;
539 end;
540 end
541 else
542 begin
543 if ((newCoords.y1 - calcHeight) < Bounds.Top) then
544 begin
545 calcHeight := newCoords.y1 - Bounds.Top; // Limite height dimension
546 newCoords.y2 := Bounds.Top;
547 RecalculatesOtherAxis := True;
548 end;
549 end;
550 end
551 else
552 begin
553 if (SOUTH in Direction) then
554 begin
555 if ((newCoords.y1 - calcHeight) > Bounds.Bottom) then
556 begin
557 calcHeight := newCoords.y1 - Bounds.Bottom; // Limite height dimension
558 newCoords.y2 := Bounds.Bottom;
559 RecalculatesOtherAxis := True;
560 end;
561 end
562 else
563 begin
564 if ((newCoords.y1 + calcHeight) < Bounds.Top) then
565 begin
566 calcHeight := Bounds.Top - newCoords.y1; // Limite height dimension
567 newCoords.y2 := Bounds.Top;
568 RecalculatesOtherAxis := True;
569 end;
570 end;
571 end;
572
573 // Apply calculated dimensions of height on width
574 if (RecalculatesOtherAxis) then
575 begin
576 if (calcWidth > 0) then
577 calcWidth := Trunc(abs(calcHeight) * (fRatio.Horizontal / fRatio.Vertical))
578 else
579 calcWidth := -Trunc(abs(calcHeight) * (fRatio.Horizontal / fRatio.Vertical));
580
581 newCoords.x2 := newCoords.x1 + calcWidth;
582 end;
583 end
584 else
585 begin
586 // Calculate width
587 calcWidth := newCoords.x2 - newCoords.x1;
588
589 // Make sure we're not going out of bounds
590 if (EAST in Direction) then
591 begin
592 if ((newCoords.x1 + calcWidth) > Bounds.Right) then
593 begin
594 calcWidth := Bounds.Right - newCoords.x1; // Limite width dimension
595 newCoords.x2 := Bounds.Right;
596 end;
597 end;
598
599 if (WEST in Direction) then
600 begin
601 if ((newCoords.x1 + calcWidth) < Bounds.Left) then
602 begin
603 calcWidth := -(newCoords.x1 - Bounds.Left); // Limite width dimension
604 newCoords.x2 := Bounds.Left;
605 end;
606 end;
607
608 // Calculate height
609 calcHeight := newCoords.y2 - newCoords.y1;
610
611 // Make sure we're not going out of bounds
612 if (SOUTH in Direction) then
613 begin
614 if ((newCoords.y1 + calcHeight) > Bounds.Bottom) then
615 begin
616 calcHeight := Bounds.Bottom - newCoords.y1; // Limite height dimension
617 newCoords.y2 := Bounds.Bottom;
618 end;
619 end;
620
621 if (NORTH in Direction) then
622 begin
623 if ((newCoords.y1 + calcHeight) < Bounds.Top) then
624 begin
625 calcHeight := -(newCoords.y1 - Bounds.Top); // Limite height dimension
626 newCoords.y2 := Bounds.Top;
627 end;
628 end;
629 end;
630
631 newCoords.x2 := newCoords.x1 + calcWidth;
632 newCoords.y2 := newCoords.y1 + calcHeight;
633 end;
634
635 Result := newCoords;
636end;
637
638{ Calculate the maximun selection allowed }
639procedure TBGRAImageManipulation.CalcMaxSelection;
640var
641 ImageRect: TRect;
642 newCoords: TCoord;
643 Direction: TDirection;
644 Bounds: TRect;
645begin
646 ImageRect := getImageRect(fImageBitmap);
647
648 // Initiates coord
649 with newCoords do
650 begin
651 x1 := 0;
652 y1 := 0;
653
654 x2 := ImageRect.Right - ImageRect.Left;
655 y2 := ImageRect.Bottom - ImageRect.Top;
656 end;
657
658 // Determine direction
659 Direction := getDirection(Point(newCoords.x1, newCoords.y1),
660 Point(newCoords.x2, newCoords.y2));
661
662 // Determines limite values
663 with newCoords do
664 begin
665 x1 := 0;
666 y1 := 0;
667 x2 := ImageRect.Right - ImageRect.Left;
668 y2 := ImageRect.Bottom - ImageRect.Top;
669 end;
670 Bounds := getImageRect(fResampledBitmap);
671
672 // Apply the ratio
673 newCoords := ApplyRatioToAxes(newCoords, Direction, Bounds);
674
675 // Determines minimum value on both axes
676 newCoords := ApplyDimRestriction(newCoords, Direction, Bounds);
677
678 fCropArea := Rect(newCoords.x1, newCoords.y1, newCoords.x2, newCoords.y2);
679end;
680
681{ Calculate the Aspect Ratio for size limits}
682procedure TBGRAImageManipulation.findSizeLimits;
683var
684 WorkRect: TRect;
685begin
686 // Find the working area of the component
687 WorkRect := getWorkRect;
688
689 with fSizeLimits do
690 begin
691 minWidth := fAspectX;
692 maxWidth := WorkRect.Right - WorkRect.Left;
693 minHeight := fAspectY;
694 maxHeight := WorkRect.Bottom - WorkRect.Top;
695 end;
696end;
697
698{ Get the direction of movement }
699function TBGRAImageManipulation.getDirection(const Point1, Point2: TPoint): TDirection;
700begin
701 Result := [];
702
703 if (Point1.X > Point2.X) then
704 Result := Result + [WEST];
705
706 if (Point1.X < Point2.X) then
707 Result := Result + [EAST];
708
709 if (Point1.Y > Point2.Y) then
710 Result := Result + [NORTH];
711
712 if (Point1.Y < Point2.Y) then
713 Result := Result + [SOUTH];
714end;
715
716{ Calculate the Greatest Common Divisor (GCD) using the algorithm of Euclides }
717function TBGRAImageManipulation.getGCD(Nr1, Nr2: longint): longint;
718begin
719 if Nr2 = 0 then
720 Result := Nr1
721 else
722 Result := getGCD(Nr2, Nr1 mod Nr2);
723end;
724
725{ Calculate the Lowest Common Multiple (LCM) using the algorithm of Euclides }
726function TBGRAImageManipulation.getLCM(Nr1, Nr2: longint): longint;
727begin
728 Result := (Nr1 * Nr2) div getGCD(Nr1, Nr2);
729end;
730
731{ Get image rectangle }
732function TBGRAImageManipulation.getImageRect(Picture: TBGRABitmap): TRect;
733var
734 calcWidth, calcHeight, finalWidth, finalHeight, imageWidth, imageHeight: integer;
735 WorkRect: TRect;
736begin
737 // Determine picture size
738 imageWidth := Picture.Width;
739 imageHeight := Picture.Height;
740
741 // Determine Work rectangle to final size
742 WorkRect := getWorkRect;
743 finalWidth := WorkRect.Right - WorkRect.Left;
744 finalHeight := WorkRect.Bottom - WorkRect.Top;
745
746 // Recalculate image dimensions
747 calcHeight := (finalWidth * imageHeight) div imageWidth;
748 calcWidth := finalWidth;
749
750 if (calcHeight > finalHeight) then
751 begin
752 calcHeight := finalHeight;
753 calcWidth := (calcHeight * imageWidth) div imageHeight;
754 end;
755
756 with Result do
757 begin
758 Left := 0;
759 Top := 0;
760 Right := calcWidth;
761 Bottom := calcHeight;
762 end;
763end;
764
765{ Get work area rectangle }
766function TBGRAImageManipulation.getWorkRect: TRect;
767var
768 // Number of units to remove from left, right, top, and bottom to get the
769 // work rectangle
770 Delta: integer;
771begin
772 // Start with the border size
773 Delta := fBorderSize;
774
775 // Get the coordinates of the control
776 if (fVirtualScreen <> nil) then
777 Result := Rect(0, 0, fVirtualScreen.Width, fVirtualScreen.Height)
778 else
779 Result := GetClientRect;
780
781 // Remove the non-work areas from our work rectangle
782 InflateRect(Result, -Delta, -Delta);
783end;
784
785{ Check if mouse is over any anchor }
786function TBGRAImageManipulation.isOverAnchor(Point: TPoint; Corner: TPoint): boolean;
787begin
788 Result := ((Point.X >= (Corner.X - AnchorSize)) and
789 (Point.X <= (Corner.X + AnchorSize)) and (Point.Y >= (Corner.Y - AnchorSize)) and
790 (Point.Y <= (Corner.Y + AnchorSize)));
791end;
792
793
794 { ============================================================================ }
795 { =====[ Component Definition ]=============================================== }
796 { ============================================================================ }
797
798constructor TBGRAImageManipulation.Create(AOwner: TComponent);
799begin
800 inherited Create(AOwner);
801
802 // Set default component values
803 inherited Width := 320;
804 inherited Height := 240;
805
806 // Default property values
807 fAnchorSize := 5;
808 fAnchorSelected := [];
809 fBorderSize := 2;
810 fAspectRatio := '3:4';
811 fAspectX := 3;
812 fAspectY := 4;
813 fKeepAspectRatio := True;
814
815 // Default control values
816 ControlStyle := ControlStyle + [csReplicatable];
817 Cursor := crDefault;
818
819 // Calculate the ratio
820 fGCD := getGCD(fAspectX, fAspectY);
821
822
823 // Determine the ratio of scale per axle
824 with fRatio do
825 begin
826 Horizontal := fAspectX div fGCD;
827 Vertical := fAspectY div fGCD;
828 end;
829
830 // Find size limits
831 findSizeLimits;
832
833 // Create the Image Bitmap
834 fImageBitmap := TBGRABitmap.Create;
835
836 // Create the Resampled Bitmap
837 fResampledBitmap := TBGRABitmap.Create;
838
839 // Create the Background
840 fBackground := TBGRABitmap.Create(Width, Height);
841
842 // Create render surface
843 fVirtualScreen := TBGRABitmap.Create(Width, Height);
844
845 // Force Render Struct
846 RepaintBackground;
847 Render;
848
849 // Initialize crop area
850 fCropArea := Rect(0, 0, 0, 0);
851 fDeltaX := 0;
852 fDeltaY := 0;
853end;
854
855destructor TBGRAImageManipulation.Destroy;
856begin
857 fImageBitmap.Free;
858 fResampledBitmap.Free;
859 fBackground.Free;
860 fVirtualScreen.Free;
861 inherited Destroy;
862end;
863
864procedure TBGRAImageManipulation.Invalidate;
865begin
866 inherited Invalidate;
867end;
868
869procedure TBGRAImageManipulation.Paint;
870begin
871 inherited Paint;
872 fVirtualScreen.Draw(Canvas, 0, 0, True);
873end;
874
875{ This function repaint the background only when necessary to avoid unnecessary
876 redraws. Contain a function called DrawCheckers that draws the Background like
877 checkers game. Also included was a function that draws 3D effects changed to
878 allow color changes. }
879procedure TBGRAImageManipulation.RepaintBackground;
880
881 procedure DrawCheckers(bmp: TBGRABitmap; ARect: TRect);
882 const
883 tx = 8;
884 ty = 8;
885 var
886 xb, yb, xdest, ydest, nbx, nby: integer;
887 oddColor, evenColor: TBGRAPixel;
888 begin
889 oddColor := BGRA(220, 220, 220);
890 evenColor := BGRA(255, 255, 255);
891 bmp.ClipRect := ARect;
892 xdest := ARect.Left;
893 nbx := ((ARect.Right - ARect.Left) + tx - 1) div tx;
894 nby := ((ARect.Bottom - ARect.Top) + ty - 1) div ty;
895 for xb := 0 to nbx - 1 do
896 begin
897 ydest := ARect.Top;
898 for yb := 0 to nby - 1 do
899 begin
900 if odd(xb + yb) then
901 bmp.FillRect(xdest, ydest, xdest + tx, ydest + ty, oddColor, dmSet)
902 else
903 bmp.FillRect(xdest, ydest, xdest + tx, ydest + ty, evenColor, dmSet);
904 Inc(ydest, ty);
905 end;
906 Inc(xdest, tx);
907 end;
908 bmp.NoClip;
909 end;
910
911var
912 Border: TRect;
913 Grad: TBGRAGradientScanner;
914begin
915 // Resize background
916 fBackground.SetSize(fVirtualScreen.Width, fVirtualScreen.Height);
917
918 // Draw the outer bevel
919 Border := Rect(0, 0, fVirtualScreen.Width, fVirtualScreen.Height);
920
921 // Draw the rectangle around image
922 if (fBorderSize > 2) then
923 begin
924 // Draw the border gradient
925 Grad := TBGRAGradientScanner.Create(BGRA(245, 245, 245),
926 BGRA(205, 204, 203), gtLinear, PointF(0, 0), PointF(0, fBackground.Height));
927 fBackground.FillRect(0, 0, fBackground.Width, fBorderSize - 2, Grad, dmSet);
928 fBackground.FillRect(0, fBorderSize - 2, fBorderSize - 2,
929 fBackground.Height - fBorderSize + 2, Grad, dmSet);
930 fBackground.FillRect(fBackground.Width - fBorderSize + 2, fBorderSize - 2,
931 fBackground.Width, fBackground.Height - fBorderSize + 2,
932 Grad, dmSet);
933 fBackground.FillRect(0, fBackground.Height - fBorderSize + 2,
934 fBackground.Width, fBackground.Height, Grad, dmSet);
935 Grad.Free;
936 InflateRect(Border, -(fBorderSize - 2), -(fBorderSize - 2));
937 end;
938
939 // Draw 3D border
940 fBackground.CanvasBGRA.Frame3D(Border, 1, bvLowered,
941 ColorToBGRA(ColorToRGB(clBtnHighlight)), ColorToBGRA(ColorToRGB(cl3DDkShadow)));
942 fBackground.CanvasBGRA.Frame3D(Border, 1, bvLowered,
943 ColorToBGRA(ColorToRGB(cl3DLight)), ColorToBGRA(ColorToRGB(clBtnShadow)));
944
945 DrawCheckers(fBackground, Border);
946end;
947
948{ Resize the component, recalculating the proportions }
949procedure TBGRAImageManipulation.Resize;
950
951 function min(const Value: integer; const MinValue: integer): integer;
952 begin
953 if (Value < MinValue) then
954 Result := MinValue
955 else
956 Result := Value;
957 end;
958
959var
960 OriginalRect, SourceRect, DestinationRect: TRect;
961 xRatio, yRatio: double;
962 ResampledBitmap: TBGRACustomBitmap;
963begin
964 inherited Resize;
965
966 if (fVirtualScreen <> nil) then
967 begin
968 fVirtualScreen.SetSize(min(Self.Width, (fBorderSize * 2 + fAnchorSize + fMinWidth)),
969 min(Self.Height, (fBorderSize * 2 + fAnchorSize + fMinHeight)));
970 fVirtualScreen.InvalidateBitmap;
971
972 // Resample the image
973 if (not (fImageBitmap.Empty)) then
974 begin
975 // Get the resampled dimensions to scale image for draw in component
976 DestinationRect := getImageRect(fImageBitmap);
977
978 // Resize crop area
979 if ((abs(fCropArea.Right - fCropArea.Left) > 0) and
980 (abs(fCropArea.Bottom - fCropArea.Top) > 0)) then
981 begin
982 // Calculate scale from original size and destination size
983 with OriginalRect do
984 begin
985 Left := 0;
986 Right := fResampledBitmap.Width;
987 Top := 0;
988 Bottom := fResampledBitmap.Height;
989 end;
990 xRatio := fImageBitmap.Width / (OriginalRect.Right - OriginalRect.Left);
991 yRatio := fImageBitmap.Height / (OriginalRect.Bottom - OriginalRect.Top);
992
993 // Calculate source rectangle in original scale
994 with SourceRect do
995 begin
996 Left := Round(fCropArea.Left * xRatio);
997 Right := Round(fCropArea.Right * xRatio);
998 Top := Round(fCropArea.Top * yRatio);
999 Bottom := Round(fCropArea.Bottom * yRatio);
1000 end;
1001
1002 // Calculate destination rectangle in new scale
1003 xRatio := fImageBitmap.Width / (DestinationRect.Right - DestinationRect.Left);
1004 yRatio := fImageBitmap.Height / (DestinationRect.Bottom - DestinationRect.Top);
1005 with fCropArea do
1006 begin
1007 Left := Round(SourceRect.Left / xRatio);
1008 ;
1009 Right := Round(SourceRect.Right / xRatio);
1010 Top := Round(SourceRect.Top / yRatio);
1011 Bottom := Round(SourceRect.Bottom / yRatio);
1012 end;
1013 end;
1014
1015 // Recreate resampled bitmap
1016 try
1017 fResampledBitmap.Free;
1018 fResampledBitmap := TBGRABitmap.Create(DestinationRect.Right -
1019 DestinationRect.Left, DestinationRect.Bottom - DestinationRect.Top);
1020 ResampledBitmap := fImageBitmap.Resample(DestinationRect.Right -
1021 DestinationRect.Left, DestinationRect.Bottom -
1022 DestinationRect.Top, rmFineResample);
1023 fResampledBitmap.PutImage(0, 0,
1024 ResampledBitmap,
1025 dmDrawWithTransparency);
1026 finally
1027 ResampledBitmap.Free;
1028 end;
1029 end;
1030
1031 // Force Render Struct
1032 RepaintBackground;
1033 Render;
1034 end;
1035
1036 Invalidate;
1037end;
1038
1039{ Function responsible for rendering the content of the component, including
1040 the selection border and anchors. The selected area is painted with a
1041 different transparency level for easy viewing of what will be cut. }
1042procedure TBGRAImageManipulation.Render;
1043var
1044 WorkRect: TRect;
1045 Mask: TBGRABitmap;
1046 BorderColor, SelectColor, FillColor: TBGRAPixel;
1047begin
1048 // This procedure render main feature of engine
1049
1050 // Render background
1051 fVirtualScreen.PutImage(0, 0,
1052 fBackground,
1053 dmDrawWithTransparency);
1054
1055 // Render the image
1056 if (not (fImageBitmap.Empty)) then
1057 begin
1058 // Check if crop selection is empty
1059 if ((fCropArea.Left = fCropArea.Right) and
1060 (fCropArea.Top = fCropArea.Bottom)) then
1061 CalcMaxSelection;
1062
1063 // Find the working area of the component
1064 WorkRect := getWorkRect;
1065
1066 try
1067 // Draw image
1068 fVirtualScreen.PutImage(WorkRect.Left, WorkRect.Top,
1069 fResampledBitmap,
1070 dmDrawWithTransparency);
1071
1072 // Render the selection background area
1073 BorderColor := BGRAWhite;
1074 FillColor := BGRA(0, 0, 0, 128);
1075 Mask := TBGRABitmap.Create(WorkRect.Right - WorkRect.Left,
1076 WorkRect.Bottom - WorkRect.Top, FillColor);
1077 Mask.EraseRectAntialias(fCropArea.Left + fDeltaX, fCropArea.Top + fDeltaY,
1078 fCropArea.Right + fDeltaX - 1,
1079 fCropArea.Bottom + fDeltaY - 1,
1080 255);
1081
1082 // Draw a selection box
1083 with Rect(fCropArea.Left + fDeltaX, fCropArea.Top + fDeltaY,
1084 fCropArea.Right + fDeltaX - 1, fCropArea.Bottom + fDeltaY - 1) do
1085 Mask.DrawPolyLineAntialias([Point(Left, Top), Point(Right, Top),
1086 Point(Right, Bottom), Point(Left, Bottom), Point(Left, Top)],
1087 BorderColor, BGRAPixelTransparent, 1, False);
1088
1089 // Draw anchors
1090 BorderColor := BGRABlack;
1091 SelectColor := BGRA(255, 255, 0, 255);
1092 FillColor := BGRA(255, 255, 0, 128);
1093
1094 // NW
1095 Mask.Rectangle(fCropArea.Left + fDeltaX - fAnchorSize,
1096 fCropArea.Top + fDeltaY - fAnchorSize,
1097 fCropArea.Left + fDeltaX + fAnchorSize + 1,
1098 fCropArea.Top + fDeltaY + fAnchorSize + 1,
1099 BorderColor, FillColor, dmSet);
1100
1101 // W
1102 Mask.Rectangle(fCropArea.Left + fDeltaX - fAnchorSize,
1103 (fCropArea.Top + fDeltaY + ((fCropArea.Bottom - fCropArea.Top) div 2)) -
1104 fAnchorSize,
1105 fCropArea.Left + fDeltaX + fAnchorSize + 1,
1106 (fCropArea.Top + fDeltaY + ((fCropArea.Bottom - fCropArea.Top) div 2)) +
1107 fAnchorSize + 1,
1108 BorderColor, FillColor, dmSet);
1109
1110 // SW
1111 Mask.Rectangle(fCropArea.Left + fDeltaX - fAnchorSize,
1112 fCropArea.Bottom + fDeltaY - fAnchorSize - 1,
1113 fCropArea.Left + fDeltaX + fAnchorSize + 1,
1114 fCropArea.Bottom + fDeltaY + fAnchorSize,
1115 BorderColor, FillColor, dmSet);
1116
1117 // S
1118 if ((fAnchorSelected = [NORTH]) and (fCropArea.Top < fCropArea.Bottom) and
1119 (fStartPoint.Y = fCropArea.Top)) or ((fAnchorSelected = [NORTH]) and
1120 (fCropArea.Top > fCropArea.Bottom) and (fStartPoint.Y = fCropArea.Top)) or
1121 ((fAnchorSelected = [SOUTH]) and (fCropArea.Top < fCropArea.Bottom) and
1122 (fStartPoint.Y = fCropArea.Top)) or ((fAnchorSelected = [SOUTH]) and
1123 (fCropArea.Top > fCropArea.Bottom) and (fStartPoint.Y = fCropArea.Top)) then
1124 Mask.Rectangle((fCropArea.Left + fDeltaX +
1125 ((fCropArea.Right - fCropArea.Left) div 2)) - fAnchorSize,
1126 fCropArea.Bottom + fDeltaY - fAnchorSize - 1,
1127 (fCropArea.Left + fDeltaX +
1128 ((fCropArea.Right - fCropArea.Left) div 2)) + fAnchorSize + 1,
1129 fCropArea.Bottom + fDeltaY + fAnchorSize,
1130 BorderColor, SelectColor, dmSet)
1131 else
1132 Mask.Rectangle((fCropArea.Left + fDeltaX +
1133 ((fCropArea.Right - fCropArea.Left) div 2)) - fAnchorSize,
1134 fCropArea.Bottom + fDeltaY - fAnchorSize - 1,
1135 (fCropArea.Left + fDeltaX +
1136 ((fCropArea.Right - fCropArea.Left) div 2)) + fAnchorSize + 1,
1137 fCropArea.Bottom + fDeltaY + fAnchorSize,
1138 BorderColor, FillColor, dmSet);
1139
1140 // SE
1141 if ((fAnchorSelected = [NORTH, WEST]) and
1142 ((fCropArea.Left > fCropArea.Right) and (fCropArea.Top > fCropArea.Bottom))) or
1143 ((fAnchorSelected = [NORTH, WEST]) and
1144 ((fCropArea.Left < fCropArea.Right) and (fCropArea.Top < fCropArea.Bottom))) or
1145 ((fAnchorSelected = [NORTH, WEST]) and
1146 ((fCropArea.Left > fCropArea.Right) and (fCropArea.Top < fCropArea.Bottom))) or
1147 ((fAnchorSelected = [NORTH, WEST]) and
1148 ((fCropArea.Left < fCropArea.Right) and (fCropArea.Top > fCropArea.Bottom))) or
1149 ((fAnchorSelected = [NORTH, EAST]) and
1150 ((fCropArea.Left < fCropArea.Right) and (fCropArea.Top > fCropArea.Bottom))) or
1151 ((fAnchorSelected = [NORTH, EAST]) and
1152 ((fCropArea.Left > fCropArea.Right) and (fCropArea.Top < fCropArea.Bottom))) or
1153 ((fAnchorSelected = [NORTH, EAST]) and
1154 ((fCropArea.Left < fCropArea.Right) and (fCropArea.Top < fCropArea.Bottom))) or
1155 ((fAnchorSelected = [NORTH, EAST]) and
1156 ((fCropArea.Left > fCropArea.Right) and (fCropArea.Top > fCropArea.Bottom))) or
1157 ((fAnchorSelected = [SOUTH, EAST]) and
1158 ((fCropArea.Left > fCropArea.Right) and (fCropArea.Top > fCropArea.Bottom))) or
1159 ((fAnchorSelected = [SOUTH, EAST]) and
1160 ((fCropArea.Left < fCropArea.Right) and (fCropArea.Top < fCropArea.Bottom))) or
1161 ((fAnchorSelected = [SOUTH, EAST]) and
1162 ((fCropArea.Left > fCropArea.Right) and (fCropArea.Top < fCropArea.Bottom))) or
1163 ((fAnchorSelected = [SOUTH, EAST]) and
1164 ((fCropArea.Left < fCropArea.Right) and (fCropArea.Top > fCropArea.Bottom))) or
1165 ((fAnchorSelected = [SOUTH, WEST]) and
1166 ((fCropArea.Left > fCropArea.Right) and (fCropArea.Top < fCropArea.Bottom))) or
1167 ((fAnchorSelected = [SOUTH, WEST]) and
1168 ((fCropArea.Left < fCropArea.Right) and (fCropArea.Top > fCropArea.Bottom))) or
1169 ((fAnchorSelected = [SOUTH, WEST]) and
1170 ((fCropArea.Left > fCropArea.Right) and (fCropArea.Top > fCropArea.Bottom))) or
1171 ((fAnchorSelected = [SOUTH, WEST]) and
1172 ((fCropArea.Left < fCropArea.Right) and (fCropArea.Top < fCropArea.Bottom))) then
1173 Mask.Rectangle(fCropArea.Right + fDeltaX - fAnchorSize - 1,
1174 fCropArea.Bottom + fDeltaY - fAnchorSize - 1,
1175 fCropArea.Right + fDeltaX + fAnchorSize,
1176 fCropArea.Bottom + fDeltaY + fAnchorSize,
1177 BorderColor, SelectColor, dmSet)
1178 else
1179 Mask.Rectangle(fCropArea.Right + fDeltaX - fAnchorSize - 1,
1180 fCropArea.Bottom + fDeltaY - fAnchorSize - 1,
1181 fCropArea.Right + fDeltaX + fAnchorSize,
1182 fCropArea.Bottom + fDeltaY + fAnchorSize,
1183 BorderColor, FillColor, dmSet);
1184
1185 // E
1186 if ((fAnchorSelected = [EAST]) and (fCropArea.Left < fCropArea.Right) and
1187 (fStartPoint.X = fCropArea.Left)) or ((fAnchorSelected = [EAST]) and
1188 (fCropArea.Left > fCropArea.Right) and (fStartPoint.X = fCropArea.Left)) or
1189 ((fAnchorSelected = [WEST]) and (fCropArea.Left < fCropArea.Right) and
1190 (fStartPoint.X = fCropArea.Left)) or ((fAnchorSelected = [WEST]) and
1191 (fCropArea.Left > fCropArea.Right) and (fStartPoint.X = fCropArea.Left)) then
1192 Mask.Rectangle(fCropArea.Right + fDeltaX - fAnchorSize - 1,
1193 (fCropArea.Top + fDeltaY + ((fCropArea.Bottom - fCropArea.Top) div 2)) -
1194 fAnchorSize,
1195 fCropArea.Right + fDeltaX + fAnchorSize,
1196 (fCropArea.Top + fDeltaY + ((fCropArea.Bottom - fCropArea.Top) div 2)) +
1197 fAnchorSize + 1,
1198 BorderColor, SelectColor, dmSet)
1199 else
1200 Mask.Rectangle(fCropArea.Right + fDeltaX - fAnchorSize - 1,
1201 (fCropArea.Top + fDeltaY + ((fCropArea.Bottom - fCropArea.Top) div 2)) -
1202 fAnchorSize,
1203 fCropArea.Right + fDeltaX + fAnchorSize,
1204 (fCropArea.Top + fDeltaY + ((fCropArea.Bottom - fCropArea.Top) div 2)) +
1205 fAnchorSize + 1,
1206 BorderColor, FillColor, dmSet);
1207
1208 // NE
1209 Mask.Rectangle(fCropArea.Right + fDeltaX - fAnchorSize - 1,
1210 fCropArea.Top + fDeltaY - fAnchorSize,
1211 fCropArea.Right + fDeltaX + fAnchorSize,
1212 fCropArea.Top + fDeltaY + fAnchorSize + 1,
1213 BorderColor, FillColor, dmSet);
1214
1215 // N
1216 Mask.Rectangle((fCropArea.Left + fDeltaX +
1217 ((fCropArea.Right - fCropArea.Left) div 2)) - fAnchorSize,
1218 fCropArea.Top + fDeltaY - fAnchorSize,
1219 (fCropArea.Left + fDeltaX + ((fCropArea.Right - fCropArea.Left) div 2)) +
1220 fAnchorSize + 1,
1221 fCropArea.Top + fDeltaY + fAnchorSize + 1,
1222 BorderColor, FillColor, dmSet);
1223 finally
1224 fVirtualScreen.PutImage(WorkRect.Left, WorkRect.Top,
1225 Mask,
1226 dmDrawWithTransparency);
1227 Mask.Free;
1228 end;
1229 end;
1230end;
1231
1232
1233 { ============================================================================ }
1234 { =====[ Properties Manipulation ]============================================ }
1235 { ============================================================================ }
1236
1237function TBGRAImageManipulation.getAnchorSize: byte;
1238begin
1239 Result := fAnchorSize * 2 + 1;
1240end;
1241
1242procedure TBGRAImageManipulation.setAnchorSize(const Value: byte);
1243const
1244 MinSize = 3;
1245 MaxSize = 9;
1246begin
1247 if (Value <> getAnchorSize) then
1248 begin
1249 if (Value < MinSize) then
1250 begin
1251 raise ERangeError.CreateFmt(SAnchorSizeIsTooSmall,
1252 [Value, MinSize, MaxSize]);
1253 end
1254 else
1255 begin
1256 if (Value > MaxSize) then
1257 begin
1258 raise ERangeError.CreateFmt(SAnchorSizeIsTooLarge,
1259 [Value, MinSize, MaxSize]);
1260 end
1261 else
1262 begin
1263 if ((Value mod 2) = 0) then
1264 begin
1265 raise EInvalidArgument.CreateFmt(SAnchorSizeIsNotOdd, [Value]);
1266 end
1267 else
1268 begin
1269 fAnchorSize := (Value div 2);
1270 Render;
1271 Refresh;
1272 end;
1273 end;
1274 end;
1275 end;
1276end;
1277
1278function TBGRAImageManipulation.getEmpty: boolean;
1279begin
1280 Result := fImageBitmap.Empty;
1281end;
1282
1283function TBGRAImageManipulation.getBitmap: TBGRABitmap;
1284var
1285 ResampledBitmap: TBGRACustomBitmap;
1286 CropBitmap: TBGRABitmap;
1287 FinalBitmap: TBGRABitmap;
1288 xRatio, yRatio: double;
1289 OriginalRect, SourceRect, DestRect: Trect;
1290begin
1291 if not (fImageBitmap.Empty) then
1292 begin
1293 try
1294 // Calculate scale from original size and destination size
1295 OriginalRect := getImageRect(fImageBitmap);
1296 xRatio := fImageBitmap.Width / (OriginalRect.Right - OriginalRect.Left);
1297 yRatio := fImageBitmap.Height / (OriginalRect.Bottom - OriginalRect.Top);
1298
1299 // Calculate source rectangle in original scale
1300 with SourceRect do
1301 begin
1302 Left := Round(fCropArea.Left * xRatio);
1303 Right := Round(fCropArea.Right * xRatio);
1304 Top := Round(fCropArea.Top * yRatio);
1305 Bottom := Round(fCropArea.Bottom * yRatio);
1306 end;
1307
1308 // Calculate destination rectangle in original scale
1309 with DestRect do
1310 begin
1311 Left := 0;
1312 Right := SourceRect.Right - SourceRect.Left;
1313 Top := 0;
1314 Bottom := SourceRect.Bottom - SourceRect.Top;
1315 end;
1316
1317 // Create a new bitmap for cropped region in original scale
1318 CropBitmap := TBGRABitmap.Create(SourceRect.Right - SourceRect.Left,
1319 SourceRect.Bottom - SourceRect.Top);
1320
1321 // Get the cropped image on selected region in original scale
1322 CropBitmap.Canvas.CopyRect(DestRect, fImageBitmap.Canvas, SourceRect);
1323
1324 // Create bitmap to put image on final scale
1325 FinalBitmap := TBGRABitmap.Create(fCropArea.Right - fCropArea.Left,
1326 fCropArea.Bottom - fCropArea.Top);
1327
1328 // Resize the cropped image to final scale
1329 try
1330 ResampledBitmap := CropBitmap.Resample(fCropArea.Right -
1331 fCropArea.Left, fCropArea.Bottom - fCropArea.Top, rmFineResample);
1332 FinalBitmap.PutImage(0, 0,
1333 ResampledBitmap,
1334 dmDrawWithTransparency);
1335 finally
1336 ResampledBitmap.Free
1337 end;
1338 finally
1339 Result := FinalBitmap;
1340
1341 CropBitmap.Free;
1342 end;
1343 end
1344 else
1345 begin
1346 Result := fImageBitmap;
1347 end;
1348end;
1349
1350procedure TBGRAImageManipulation.setBitmap(const Value: TBGRABitmap);
1351
1352 function min(const Value: integer; const MinValue: integer): integer;
1353 begin
1354 if (Value < MinValue) then
1355 Result := MinValue
1356 else
1357 Result := Value;
1358 end;
1359
1360var
1361 SourceRect, OriginalRect, DestinationRect: TRect;
1362 ResampledBitmap: TBGRACustomBitmap;
1363 xRatio, yRatio: double;
1364begin
1365 if (Value <> fImageBitmap) then
1366 begin
1367 try
1368 // Clear actual image
1369 fImageBitmap.Free;
1370 fImageBitmap := TBGRABitmap.Create(Value.Width, Value.Height);
1371
1372 // Prevent empty image
1373 if Value.Empty then
1374 exit;
1375
1376 // Prevent null image
1377 if (Value.Width = 0) or (Value.Height = 0) then
1378 exit;
1379
1380 // Associate the new bitmap
1381 fImageBitmap.Assign(Value);
1382
1383 // Get the resampled dimensions to scale image for draw in component
1384 DestinationRect := getImageRect(fImageBitmap);
1385
1386 // Recreate resampled bitmap
1387 try
1388 fResampledBitmap.Free;
1389 fResampledBitmap := TBGRABitmap.Create(DestinationRect.Right -
1390 DestinationRect.Left, DestinationRect.Bottom - DestinationRect.Top);
1391 ResampledBitmap := fImageBitmap.Resample(DestinationRect.Right -
1392 DestinationRect.Left, DestinationRect.Bottom -
1393 DestinationRect.Top, rmFineResample);
1394 fResampledBitmap.PutImage(0, 0,
1395 ResampledBitmap,
1396 dmDrawWithTransparency);
1397 finally
1398 ResampledBitmap.Free;
1399 end;
1400
1401 // Resize crop area
1402 if ((abs(fCropArea.Right - fCropArea.Left) > 0) and
1403 (abs(fCropArea.Bottom - fCropArea.Top) > 0)) then
1404 begin
1405 // Calculate scale from original size and destination size
1406 with OriginalRect do
1407 begin
1408 Left := 0;
1409 Right := fResampledBitmap.Width;
1410 Top := 0;
1411 Bottom := fResampledBitmap.Height;
1412 end;
1413 xRatio := fImageBitmap.Width / (OriginalRect.Right - OriginalRect.Left);
1414 yRatio := fImageBitmap.Height / (OriginalRect.Bottom - OriginalRect.Top);
1415
1416 // Calculate source rectangle in original scale
1417 with SourceRect do
1418 begin
1419 Left := Round(fCropArea.Left * xRatio);
1420 Right := Round(fCropArea.Right * xRatio);
1421 Top := Round(fCropArea.Top * yRatio);
1422 Bottom := Round(fCropArea.Bottom * yRatio);
1423 end;
1424
1425 // Calculate destination rectangle in new scale
1426 xRatio := fImageBitmap.Width / (DestinationRect.Right - DestinationRect.Left);
1427 yRatio := fImageBitmap.Height / (DestinationRect.Bottom - DestinationRect.Top);
1428 with fCropArea do
1429 begin
1430 Left := Round(SourceRect.Left / xRatio);
1431 ;
1432 Right := Round(SourceRect.Right / xRatio);
1433 Top := Round(SourceRect.Top / yRatio);
1434 Bottom := Round(SourceRect.Bottom / yRatio);
1435 end;
1436 end
1437 else
1438 begin
1439 // Calculates maximum crop selection
1440 CalcMaxSelection;
1441 end;
1442 finally
1443 // Force Render Struct
1444 Render;
1445 inherited Invalidate;
1446 end;
1447 end;
1448end;
1449
1450procedure TBGRAImageManipulation.rotateLeft;
1451var
1452 SourceRect, OriginalRect, DestinationRect: TRect;
1453 TempBitmap, ResampledBitmap: TBGRACustomBitmap;
1454 xRatio, yRatio: double;
1455begin
1456 try
1457 // Prevent empty image
1458 if fImageBitmap.Empty then
1459 exit;
1460
1461 // Rotate bitmap
1462 TempBitmap := fImageBitmap.RotateCCW;
1463 fImageBitmap.Assign(TempBitmap);
1464
1465 // Get the resampled dimensions to scale image for draw in component
1466 DestinationRect := getImageRect(fImageBitmap);
1467
1468 // Recreate resampled bitmap
1469 try
1470 fResampledBitmap.Free;
1471 fResampledBitmap := TBGRABitmap.Create(DestinationRect.Right -
1472 DestinationRect.Left, DestinationRect.Bottom - DestinationRect.Top);
1473 ResampledBitmap := fImageBitmap.Resample(DestinationRect.Right -
1474 DestinationRect.Left, DestinationRect.Bottom - DestinationRect.Top,
1475 rmFineResample);
1476 fResampledBitmap.PutImage(0, 0,
1477 ResampledBitmap,
1478 dmDrawWithTransparency);
1479 finally
1480 ResampledBitmap.Free;
1481 end;
1482
1483 // Resize crop area
1484 if ((abs(fCropArea.Right - fCropArea.Left) > 0) and
1485 (abs(fCropArea.Bottom - fCropArea.Top) > 0)) then
1486 begin
1487 // Calculate scale from original size and destination size
1488 with OriginalRect do
1489 begin
1490 Left := 0;
1491 Right := fResampledBitmap.Width;
1492 Top := 0;
1493 Bottom := fResampledBitmap.Height;
1494 end;
1495 xRatio := fImageBitmap.Width / (OriginalRect.Right - OriginalRect.Left);
1496 yRatio := fImageBitmap.Height / (OriginalRect.Bottom - OriginalRect.Top);
1497
1498 // Calculate source rectangle in original scale
1499 with SourceRect do
1500 begin
1501 Left := Round(fCropArea.Left * xRatio);
1502 Right := Round(fCropArea.Right * xRatio);
1503 Top := Round(fCropArea.Top * yRatio);
1504 Bottom := Round(fCropArea.Bottom * yRatio);
1505 end;
1506
1507 // Calculate destination rectangle in new scale
1508 xRatio := fImageBitmap.Width / (DestinationRect.Right - DestinationRect.Left);
1509 yRatio := fImageBitmap.Height / (DestinationRect.Bottom - DestinationRect.Top);
1510 with fCropArea do
1511 begin
1512 Left := Round(SourceRect.Left / xRatio);
1513 ;
1514 Right := Round(SourceRect.Right / xRatio);
1515 Top := Round(SourceRect.Top / yRatio);
1516 Bottom := Round(SourceRect.Bottom / yRatio);
1517 end;
1518 end
1519 else
1520 begin
1521 // Calculates maximum crop selection
1522 CalcMaxSelection;
1523 end;
1524 finally
1525 // Force Render Struct
1526 Render;
1527 inherited Invalidate;
1528 TempBitmap.Free;
1529 end;
1530end;
1531
1532procedure TBGRAImageManipulation.rotateRight;
1533var
1534 SourceRect, OriginalRect, DestinationRect: TRect;
1535 TempBitmap, ResampledBitmap: TBGRACustomBitmap;
1536 xRatio, yRatio: double;
1537begin
1538 try
1539 // Prevent empty image
1540 if fImageBitmap.Empty then
1541 exit;
1542
1543 // Rotate bitmap
1544 TempBitmap := fImageBitmap.RotateCW;
1545 fImageBitmap.Assign(TempBitmap);
1546
1547 // Get the resampled dimensions to scale image for draw in component
1548 DestinationRect := getImageRect(fImageBitmap);
1549
1550 // Recreate resampled bitmap
1551 try
1552 fResampledBitmap.Free;
1553 fResampledBitmap := TBGRABitmap.Create(DestinationRect.Right -
1554 DestinationRect.Left, DestinationRect.Bottom - DestinationRect.Top);
1555 ResampledBitmap := fImageBitmap.Resample(DestinationRect.Right -
1556 DestinationRect.Left, DestinationRect.Bottom - DestinationRect.Top,
1557 rmFineResample);
1558 fResampledBitmap.PutImage(0, 0,
1559 ResampledBitmap,
1560 dmDrawWithTransparency);
1561 finally
1562 ResampledBitmap.Free;
1563 end;
1564
1565 // Resize crop area
1566 if ((abs(fCropArea.Right - fCropArea.Left) > 0) and
1567 (abs(fCropArea.Bottom - fCropArea.Top) > 0)) then
1568 begin
1569 // Calculate scale from original size and destination size
1570 with OriginalRect do
1571 begin
1572 Left := 0;
1573 Right := fResampledBitmap.Width;
1574 Top := 0;
1575 Bottom := fResampledBitmap.Height;
1576 end;
1577 xRatio := fImageBitmap.Width / (OriginalRect.Right - OriginalRect.Left);
1578 yRatio := fImageBitmap.Height / (OriginalRect.Bottom - OriginalRect.Top);
1579
1580 // Calculate source rectangle in original scale
1581 with SourceRect do
1582 begin
1583 Left := Round(fCropArea.Left * xRatio);
1584 Right := Round(fCropArea.Right * xRatio);
1585 Top := Round(fCropArea.Top * yRatio);
1586 Bottom := Round(fCropArea.Bottom * yRatio);
1587 end;
1588
1589 // Calculate destination rectangle in new scale
1590 xRatio := fImageBitmap.Width / (DestinationRect.Right - DestinationRect.Left);
1591 yRatio := fImageBitmap.Height / (DestinationRect.Bottom - DestinationRect.Top);
1592 with fCropArea do
1593 begin
1594 Left := Round(SourceRect.Left / xRatio);
1595 ;
1596 Right := Round(SourceRect.Right / xRatio);
1597 Top := Round(SourceRect.Top / yRatio);
1598 Bottom := Round(SourceRect.Bottom / yRatio);
1599 end;
1600 end
1601 else
1602 begin
1603 // Calculates maximum crop selection
1604 CalcMaxSelection;
1605 end;
1606 finally
1607 // Force Render Struct
1608 Render;
1609 inherited Invalidate;
1610 TempBitmap.Free;
1611 end;
1612end;
1613
1614procedure TBGRAImageManipulation.setBorderSize(const Value: byte);
1615const
1616 MinSize = 2;
1617 MaxSize = 10;
1618begin
1619 if (Value <> fBorderSize) then
1620 begin
1621 if (Value < MinSize) then
1622 begin
1623 raise ERangeError.CreateFmt(SBorderSizeIsTooSmall,
1624 [Value, MinSize, MaxSize]);
1625 end
1626 else
1627 begin
1628 if (Value > MaxSize) then
1629 begin
1630 raise ERangeError.CreateFmt(SBorderSizeIsTooLarge,
1631 [Value, MinSize, MaxSize]);
1632 end
1633 else
1634 begin
1635 fBorderSize := Value;
1636
1637 Resize;
1638 end;
1639 end;
1640 end;
1641end;
1642
1643procedure TBGRAImageManipulation.setKeepAspectRatio(const Value: boolean);
1644begin
1645 if (Value <> fKeepAspectRatio) then
1646 begin
1647 fKeepAspectRatio := Value;
1648 if (fKeepAspectRatio) then
1649 begin
1650 if (not (fImageBitmap.Empty)) then
1651 begin
1652 // Check if crop selection is not empty
1653 if not ((fCropArea.Left = fCropArea.Right) and
1654 (fCropArea.Top = fCropArea.Bottom)) then
1655 CalcMaxSelection;
1656 Render;
1657 end;
1658 end;
1659
1660 Refresh;
1661 end;
1662end;
1663
1664function TBGRAImageManipulation.getAspectRatioFromImage(
1665 const Value: TBGRABitmap): string;
1666var
1667 GCD: integer;
1668begin
1669 GCD := getGCD(Value.Width, Value.Height);
1670
1671 Result := IntToStr(Value.Width div GCD) + ':' + IntToStr(Value.Height div GCD);
1672end;
1673
1674procedure TBGRAImageManipulation.setAspectRatio(const Value: string);
1675const
1676 ValidChars = ['0'..'9', ':'];
1677var
1678 Count, XValue, YValue: integer;
1679 AspectRatioText: string;
1680begin
1681 if (Value <> fAspectRatio) then
1682 begin
1683 // Check if value contain a valid string
1684 if ((pos(':', Value) > 0) and (pos(':', Value) < Length(Value))) then
1685 begin
1686 // Check if value is valid
1687 XValue := 0;
1688 YValue := 0;
1689 AspectRatioText := '';
1690 for Count := 1 to Length(Value) do
1691 begin
1692 if (Value[Count] in ValidChars) then
1693 begin
1694 if ((Value[Count] = ':') and (Length(AspectRatioText) > 0) and
1695 (XValue = 0)) then
1696 begin
1697 XValue := StrToInt(AspectRatioText);
1698 end;
1699
1700 AspectRatioText := AspectRatioText + Value[Count];
1701 end
1702 else
1703 begin
1704 // Value contain invalid characters
1705 raise EInvalidArgument.CreateFmt(SAspectRatioIsNotValid, [Value]);
1706 end;
1707 end;
1708 YValue := StrToInt(Copy(AspectRatioText, Pos(':', AspectRatioText) + 1,
1709 Length(AspectRatioText)));
1710 end
1711 else
1712 begin
1713 // Value contain invalid characters
1714 raise EInvalidArgument.CreateFmt(SAspectRatioIsNotValid, [Value]);
1715 end;
1716
1717 // Set new Aspect Ratio
1718 fAspectRatio := AspectRatioText;
1719 fAspectX := XValue;
1720 fAspectY := YValue;
1721
1722 // Calculate the ratio
1723 fGCD := getGCD(fAspectX, fAspectY);
1724
1725 // Determine the ratio of scale per axle
1726 with fRatio do
1727 begin
1728 Horizontal := fAspectX div fGCD;
1729 Vertical := fAspectY div fGCD;
1730 end;
1731
1732 // Set minimun size
1733 if ((fRatio.Horizontal < fAnchorSize + 10) or
1734 (fRatio.Vertical < fAnchorSize + 10)) then
1735 begin
1736 fMinWidth := fRatio.Horizontal * 10;
1737 fMinHeight := fRatio.Vertical * 10;
1738 end
1739 else
1740 begin
1741 fMinWidth := fRatio.Horizontal;
1742 fMinHeight := fRatio.Vertical;
1743 end;
1744
1745 if (not (fImageBitmap.Empty)) then
1746 begin
1747 // Check if crop selection is not empty
1748 if not ((fCropArea.Left = fCropArea.Right) and
1749 (fCropArea.Top = fCropArea.Bottom)) then
1750 CalcMaxSelection;
1751 Render;
1752 end;
1753
1754 Invalidate;
1755 end;
1756end;
1757
1758procedure TBGRAImageManipulation.setMinHeight(const Value: integer);
1759begin
1760 if (Value <> fMinHeight) then
1761 begin
1762 if (Value < fSizeLimits.minHeight) then
1763 begin
1764 fMinHeight := fSizeLimits.minHeight;
1765 end
1766 else
1767 begin
1768 if (Value > fSizeLimits.maxHeight) then
1769 begin
1770 fMinHeight := fSizeLimits.maxHeight;
1771 end
1772 else
1773 begin
1774 fMinHeight := Value;
1775 end;
1776 end;
1777
1778 if (fKeepAspectRatio) then
1779 begin
1780 // Recalculates the width value based on height
1781 fMinWidth := Trunc(fMinHeight * (fRatio.Horizontal / fRatio.Vertical));
1782 end;
1783
1784 Render;
1785 Invalidate;
1786 end;
1787end;
1788
1789procedure TBGRAImageManipulation.setMinWidth(const Value: integer);
1790begin
1791 if (Value <> fMinWidth) then
1792 begin
1793 if (Value < fSizeLimits.minWidth) then
1794 begin
1795 fMinWidth := fSizeLimits.minWidth;
1796 end
1797 else
1798 begin
1799 if (Value > fSizeLimits.maxWidth) then
1800 begin
1801 fMinWidth := fSizeLimits.maxWidth;
1802 end
1803 else
1804 begin
1805 fMinWidth := Value;
1806 end;
1807 end;
1808
1809 if (fKeepAspectRatio) then
1810 begin
1811 // Recalculates the height value based on width
1812 fMinHeight := Trunc(fMinWidth * (fRatio.Vertical / fRatio.Horizontal));
1813 end;
1814
1815 Render;
1816 Invalidate;
1817 end;
1818end;
1819
1820
1821 { ============================================================================ }
1822 { =====[ Event Control ]====================================================== }
1823 { ============================================================================ }
1824
1825procedure TBGRAImageManipulation.MouseDown(Button: TMouseButton;
1826 Shift: TShiftState; X, Y: integer);
1827var
1828 WorkRect: TRect;
1829 overControl: boolean;
1830begin
1831 // Call the inherited MouseDown() procedure
1832 inherited MouseDown(Button, Shift, X, Y);
1833
1834 // Find the working area of the control
1835 WorkRect := getWorkRect;
1836
1837 // See if the mouse is inside the pressable part of the control
1838 overControl := ((X >= WorkRect.Left) and (X <= WorkRect.Right) and
1839 (Y >= WorkRect.Top) and (Y <= WorkRect.Bottom));
1840
1841 // If over control
1842 if ((overControl) and (Button = mbLeft) and (not (ssDouble in Shift))) then
1843 begin
1844 // If this was the left mouse button and nor double click
1845 fMouseCaught := True;
1846 fStartPoint := Point(X - WorkRect.Left, Y - WorkRect.Top);
1847
1848 if (fAnchorSelected <> []) then
1849 begin
1850 // Resize the cropping area from cornes
1851
1852 // Get the coordinate corresponding to the opposite quadrant and
1853 // set into fStartPoint
1854 if ((fAnchorSelected = [NORTH]) or (fAnchorSelected = [WEST]) or
1855 (fAnchorSelected = [NORTH, WEST])) then
1856 fStartPoint := Point(fCropArea.Right, fCropArea.Bottom);
1857
1858 if (fAnchorSelected = [SOUTH, WEST]) then
1859 fStartPoint := Point(fCropArea.Right, fCropArea.Top);
1860
1861 if ((fAnchorSelected = [SOUTH]) or (fAnchorSelected = [EAST]) or
1862 (fAnchorSelected = [SOUTH, EAST])) then
1863 fStartPoint := Point(fCropArea.Left, fCropArea.Top);
1864
1865 if (fAnchorSelected = [NORTH, EAST]) then
1866 fStartPoint := Point(fCropArea.Left, fCropArea.Bottom);
1867 end;
1868 end;
1869end;
1870
1871procedure TBGRAImageManipulation.MouseMove(Shift: TShiftState; X, Y: integer);
1872var
1873 needRepaint: boolean;
1874 WorkRect: TRect;
1875 newCoords: TCoord;
1876 Direction: TDirection;
1877 Bounds: TRect;
1878 overControl: boolean;
1879begin
1880 // Call the inherited MouseMove() procedure
1881 inherited MouseMove(Shift, X, Y);
1882
1883 // Set default cursor
1884 Cursor := crDefault;
1885
1886 // Assume we don't need to repaint the control
1887 needRepaint := False;
1888
1889 // Find the working area of the component
1890 WorkRect := GetWorkRect;
1891
1892 // See if the mouse is inside the pressable part of the control
1893 overControl := ((X >= WorkRect.Left) and (X <= WorkRect.Right) and
1894 (Y >= WorkRect.Top) and (Y <= WorkRect.Bottom));
1895
1896 // If image empty
1897 if (fImageBitmap.Empty) then
1898 exit;
1899
1900 // If the mouse was originally clicked on the control
1901 if (fMouseCaught) then
1902 begin
1903 // If no anchor selected
1904 if (fAnchorSelected = []) then
1905 begin
1906 // Starts a new selection of cropping area
1907 try
1908 Cursor := crCross;
1909 fEndPoint := Point(X - WorkRect.Left, Y - WorkRect.Top);
1910
1911 // Copy coord
1912 with newCoords do
1913 begin
1914 x1 := fStartPoint.X;
1915 y1 := fStartPoint.Y;
1916
1917 x2 := fEndPoint.X;
1918 y2 := fEndPoint.Y;
1919 end;
1920
1921 // Determine direction
1922 Direction := getDirection(fStartPoint, fEndPoint);
1923
1924 // Determines limite values
1925 Bounds := getImageRect(fResampledBitmap);
1926
1927 // Apply the ratio, if necessary
1928 newCoords := ApplyRatioToAxes(newCoords, Direction, Bounds);
1929
1930 // Determines minimum value on both axes
1931 newCoords := ApplyDimRestriction(newCoords, Direction, Bounds);
1932
1933 fCropArea := Rect(newCoords.x1, newCoords.y1, newCoords.x2, newCoords.y2);
1934 finally
1935 needRepaint := True;
1936 end;
1937 end
1938 else
1939 begin
1940 // Get the actual point
1941 fEndPoint := Point(X - WorkRect.Left, Y - WorkRect.Top);
1942
1943 // Check what the anchor was dragged
1944 if (fAnchorSelected = [NORTH, SOUTH, EAST, WEST]) then
1945 begin
1946 Cursor := crSizeAll;
1947
1948 // Move the cropping area
1949 try
1950 // Gets the offset
1951 fDeltaX := fEndPoint.X - fStartPoint.X;
1952 fDeltaY := fEndPoint.Y - fStartPoint.Y;
1953
1954 // Determines limite values
1955 Bounds := getImageRect(fResampledBitmap);
1956
1957 if ((fCropArea.Left + fDeltaX) < Bounds.Left) then
1958 begin
1959 fDeltaX := fDeltaX + Abs(fCropArea.Left + fDeltaX);
1960 end;
1961
1962 if ((fCropArea.Right + fDeltaX) > Bounds.Right) then
1963 begin
1964 fDeltaX := fDeltaX - Abs(fCropArea.Right + fDeltaX) + Bounds.Right;
1965 end;
1966
1967 if ((fCropArea.Top + fDeltaY) < Bounds.Top) then
1968 begin
1969 fDeltaY := fDeltaY + Abs(fCropArea.Top + fDeltaY);
1970 end;
1971
1972 if ((fCropArea.Bottom + fDeltaY) > Bounds.Bottom) then
1973 begin
1974 fDeltaY := fDeltaY - Abs(fCropArea.Bottom + fDeltaY) + Bounds.Bottom;
1975 end;
1976 finally
1977 needRepaint := True;
1978 end;
1979 end;
1980
1981 if ((fAnchorSelected = [NORTH]) or (fAnchorSelected = [SOUTH]) or
1982 (fAnchorSelected = [EAST]) or (fAnchorSelected = [WEST]) or
1983 (fAnchorSelected = [NORTH, WEST]) or (fAnchorSelected = [SOUTH, WEST]) or
1984 (fAnchorSelected = [SOUTH, EAST]) or (fAnchorSelected =
1985 [NORTH, EAST])) then
1986 begin
1987 // Resize the cropping area
1988 try
1989 if ((fAnchorSelected = [NORTH]) or (fAnchorSelected = [SOUTH])) then
1990 Cursor := crSizeNS
1991 else
1992 if ((fAnchorSelected = [WEST]) or (fAnchorSelected = [EAST])) then
1993 Cursor := crSizeWE
1994 else
1995 if ((fAnchorSelected = [NORTH, WEST]) or
1996 (fAnchorSelected = [SOUTH, EAST])) then
1997 Cursor := crSizeNWSE
1998 else
1999 Cursor := crSizeNESW;
2000
2001 // Copy coord
2002 with newCoords do
2003 begin
2004 x1 := fStartPoint.X;
2005 y1 := fStartPoint.Y;
2006
2007 if (fAnchorSelected = [NORTH]) then
2008 begin
2009 x2 := fEndPoint.X - Abs(fCropArea.Right - fCropArea.Left) div 2;
2010 y2 := fEndPoint.Y;
2011 end
2012 else if (fAnchorSelected = [SOUTH]) then
2013 begin
2014 x2 := fEndPoint.X + Abs(fCropArea.Right - fCropArea.Left) div 2;
2015 y2 := fEndPoint.Y;
2016 end
2017 else if (fAnchorSelected = [EAST]) then
2018 begin
2019 x2 := fEndPoint.X;
2020 y2 := fEndPoint.Y + Abs(fCropArea.Bottom - fCropArea.Top) div 2;
2021 end
2022 else if (fAnchorSelected = [WEST]) then
2023 begin
2024 x2 := fEndPoint.X;
2025 y2 := fEndPoint.Y - Abs(fCropArea.Bottom - fCropArea.Top) div 2;
2026 end
2027 else
2028 begin
2029 x2 := fEndPoint.X;
2030 y2 := fEndPoint.Y;
2031 end;
2032 end;
2033
2034 // Determine direction
2035 Direction := getDirection(fStartPoint, fEndPoint);
2036
2037 // Determines limite values
2038 Bounds := getImageRect(fResampledBitmap);
2039
2040 // Apply the ratio, if necessary
2041 newCoords := ApplyRatioToAxes(newCoords, Direction, Bounds);
2042
2043 // Determines minimum value on both axes
2044 newCoords := ApplyDimRestriction(newCoords, Direction, Bounds);
2045
2046 fCropArea := Rect(newCoords.x1, newCoords.y1, newCoords.x2, newCoords.y2);
2047 finally
2048 needRepaint := True;
2049 end;
2050 end;
2051 end;
2052 end
2053 else
2054 begin
2055 // If the mouse is just moving over the control, and wasn't originally click
2056 // in the control
2057 if (overControl) then
2058 begin
2059 // Mouse is inside the pressable part of the control
2060 Cursor := crCross;
2061 fAnchorSelected := [];
2062 fEndPoint := Point(X - WorkRect.Left, Y - WorkRect.Top);
2063
2064 // Verifies that is positioned on an anchor
2065 // NW
2066 if (isOverAnchor(fEndPoint, fCropArea.TopLeft)) then
2067 begin
2068 fAnchorSelected := [NORTH, WEST];
2069 Cursor := crSizeNWSE;
2070 end;
2071
2072 // W
2073 if (isOverAnchor(fEndPoint, Point(fCropArea.Left, fCropArea.Top +
2074 (fCropArea.Bottom - fCropArea.Top) div 2))) then
2075 begin
2076 fAnchorSelected := [WEST];
2077 Cursor := crSizeWE;
2078 end;
2079
2080 // SW
2081 if (isOverAnchor(fEndPoint, Point(fCropArea.Left, fCropArea.Bottom))) then
2082 begin
2083 fAnchorSelected := [SOUTH, WEST];
2084 Cursor := crSizeNESW;
2085 end;
2086
2087 // S
2088 if (isOverAnchor(fEndPoint, Point(fCropArea.Left +
2089 ((fCropArea.Right - fCropArea.Left) div 2), fCropArea.Bottom))) then
2090 begin
2091 fAnchorSelected := [SOUTH];
2092 Cursor := crSizeNS;
2093 end;
2094
2095 // SE
2096 if (isOverAnchor(fEndPoint, fCropArea.BottomRight)) then
2097 begin
2098 fAnchorSelected := [SOUTH, EAST];
2099 Cursor := crSizeNWSE;
2100 end;
2101
2102 // E
2103 if (isOverAnchor(fEndPoint, Point(fCropArea.Right, fCropArea.Top +
2104 ((fCropArea.Bottom - fCropArea.Top) div 2)))) then
2105 begin
2106 fAnchorSelected := [EAST];
2107 Cursor := crSizeWE;
2108 end;
2109
2110 // NE
2111 if (isOverAnchor(fEndPoint, Point(fCropArea.Right, fCropArea.Top))) then
2112 begin
2113 fAnchorSelected := [NORTH, EAST];
2114 Cursor := crSizeNESW;
2115 end;
2116
2117 // N
2118 if (isOverAnchor(fEndPoint, Point(fCropArea.Left +
2119 ((fCropArea.Right - fCropArea.Left) div 2), fCropArea.Top))) then
2120 begin
2121 fAnchorSelected := [NORTH];
2122 Cursor := crSizeNS;
2123 end;
2124
2125 // Verifies that is positioned on a cropping area
2126 if (fAnchorSelected = []) then
2127 begin
2128 if ((fEndPoint.X >= fCropArea.Left) and (fEndPoint.X <= fCropArea.Right) and
2129 (fEndPoint.Y >= fCropArea.Top) and (fEndPoint.Y <= fCropArea.Bottom)) then
2130 begin
2131 fAnchorSelected := [NORTH, SOUTH, EAST, WEST];
2132 Cursor := crSizeAll;
2133 end;
2134 end;
2135 end;
2136 end;
2137
2138 // If we need to repaint
2139 if needRepaint then
2140 begin
2141 // Invalidate the control for repainting
2142 Render;
2143 Refresh;
2144 end;
2145end;
2146
2147procedure TBGRAImageManipulation.MouseUp(Button: TMouseButton;
2148 Shift: TShiftState; X, Y: integer);
2149var
2150 needRepaint: boolean;
2151 temp: integer;
2152begin
2153 // Call the inherited MouseUp() procedure
2154 inherited MouseUp(Button, Shift, X, Y);
2155
2156 // Assume we don't need to repaint the control
2157 needRepaint := False;
2158
2159 // If the mouse was originally clicked over the control
2160 if (fMouseCaught) then
2161 begin
2162 // Show that the mouse is no longer caught
2163 fMouseCaught := False;
2164
2165 // Check what the anchor was dragged
2166 if (fAnchorSelected = [NORTH, SOUTH, EAST, WEST]) then
2167 begin
2168 // Move the cropping area
2169 try
2170 OffsetRect(fCropArea, fDeltaX, fDeltaY);
2171 fDeltaX := 0;
2172 fDeltaY := 0;
2173 finally
2174 needRepaint := True;
2175 end;
2176 end
2177 else
2178 begin
2179 // Ends a new selection of cropping area
2180 if (fCropArea.Left > fCropArea.Right) then
2181 begin
2182 // Swap left and right coordinates
2183 temp := fCropArea.Left;
2184 fCropArea.Left := fCropArea.Right;
2185 fCropArea.Right := temp;
2186 end;
2187
2188 if (fCropArea.Top > fCropArea.Bottom) then
2189 begin
2190 // Swap left and right coordinates
2191 temp := fCropArea.Top;
2192 fCropArea.Top := fCropArea.Bottom;
2193 fCropArea.Bottom := temp;
2194 end;
2195
2196 needRepaint := True;
2197 end;
2198
2199 fAnchorSelected := [];
2200 end;
2201
2202 // If we need to repaint
2203 if needRepaint then
2204 begin
2205 // Invalidate the control for repainting
2206 Render;
2207 Refresh;
2208 end;
2209end;
2210
2211
2212 { ============================================================================ }
2213 { =====[ Register Function ]================================================== }
2214 { ============================================================================ }
2215
2216procedure Register;
2217begin
2218 {$I BGRAImageManipulation_icon.lrs}
2219 RegisterComponents('BGRA Controls', [TBGRAImageManipulation]);
2220end;
2221
2222end.
Note: See TracBrowser for help on using the repository browser.