Nu jeg sådan set også fået lavet det helt selv. Jeg fulgte dette hint til at få samme grund ide som du (hermansen) nævner:
http://www.undu.com/DN960901/00000007.htmDet er blot fordi at alt det tjek med om man er inden for de områder hvor der skal resize's synes jeg er en lille smule besværligt. Men jeg har fået det til at virke, og da du ikke direkte kommer med en komponent (som sandsynligvis havde lavet det mere effektivit en mig), så tror jeg at jeg trækker spørgsmålet tilbage.
Jeg smider lige min kode op hvis andre skulle få brug for noget lignende. I er også velkomne ti lat komme med optimeringsforslag:
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, RectBox, StdCtrls, jpeg, Menus, Blur;
type
TState = (stIdle, stSelecting, stSelected, stMoving, stResizing);
TSelection = class
private
pTolerance: Byte;
pResizeMargin: Byte;
pCursorArea: Byte;
pCanvas: TCanvas;
pVisible: Boolean;
pState: TState;
pSelectionDown: TPoint;
function InSelection(X, Y: Integer): Boolean;
function GetCursorArea(X, Y: Integer): Byte;
procedure SetTheCursor;
procedure SwapNumbers(var Nr1, Nr2: Integer; Size: Integer);
public
pRect: TRect;
constructor Create(ACanvas: TCanvas);
procedure MouseDown(X, Y: Integer);
procedure MouseMove(X, Y: Integer);
procedure MouseUp(X, Y: Integer);
procedure DrawIt;
procedure UnSelect;
procedure SetSelection(aRect: TRect);
end;
TEditForm = class(TForm)
ScrollBox: TScrollBox;
IEdit: TImage;
PBSelect: TPaintBox;
Button4: TButton;
PopupMenu: TPopupMenu;
popCrop: TMenuItem;
popClear: TMenuItem;
Indsttekst1: TMenuItem;
popBlur: TMenuItem;
lTextInsert: TLabel;
SaveDialog1: TSaveDialog;
procedure PBSelectMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure PBSelectMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure PBSelectMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PBSelectPaint(Sender: TObject);
procedure popCutClick(Sender: TObject);
procedure popClearClick(Sender: TObject);
procedure popBlurClick(Sender: TObject);
procedure popCropClick(Sender: TObject);
procedure PopupMenuPopup(Sender: TObject);
procedure Indsttekst1Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
EditForm: TEditForm;
Selection: TSelection;
MovingText: Boolean;
implementation
uses Types, Unit3, Unit4;
{$R *.dfm}
{ TSelection }
constructor TSelection.Create(ACanvas: TCanvas);
begin
inherited Create;
pCanvas := ACanvas;
pCanvas.Pen.Mode := pmXOr;
pCanvas.Pen.Style := psDot;
pTolerance := 5;
pResizeMargin := 2;
pState := stIdle;
pVisible := false;
end;
procedure TSelection.DrawIt;
begin
if pVisible then
begin
pCanvas.PolyLine([pRect.TopLeft, Point(pRect.Right,pRect.Top), pRect.BottomRight]);
pCanvas.PolyLine([pRect.TopLeft, Point(pRect.Left,pRect.Bottom), pRect.BottomRight]);
end;
end;
function TSelection.GetCursorArea(X, Y: Integer): Byte;
begin
Result := 0;
if (InSelection(X, Y)) then
begin
Result := 9;
end;
if (Y >= pRect.Top - pResizeMargin) and (Y <= pRect.Top + pResizeMargin) then
begin
if (X >= pRect.Left) and (X <= pRect.Left + pTolerance) then
Result := 1;
if (X > pRect.Left + pTolerance) and (X < pRect.Right - pTolerance) then
Result := 2;
if (X <= pRect.Right) and (X >= pRect.Right - pTolerance) then
Result := 3;
end;
if (X >= pRect.Right - pResizeMargin) and (X <= pRect.Right + pResizeMargin) then
begin
if (Y >= pRect.Top) and (Y <= pRect.Top + pTolerance) then
Result := 3;
if (Y > pRect.Top + pTolerance) and (Y < pRect.Bottom - pTolerance) then
Result := 4;
if (Y <= pRect.Bottom) and (Y >= pRect.Bottom - pTolerance) then
Result := 5;
end;
if (Y >= pRect.Bottom - pResizeMargin) and (Y <= pRect.Bottom + pResizeMargin) then
begin
if (X >= pRect.Left) and (X <= pRect.Left + pTolerance) then
Result := 7;
if (X > pRect.Left + pTolerance) and (X < pRect.Right - pTolerance) then
Result := 6;
if (X <= pRect.Right) and (X >= pRect.Right - pTolerance) then
Result := 5;
end;
if (X >= pRect.Left - pResizeMargin) and (X <= pRect.Left + pResizeMargin) then
begin
if (Y >= pRect.Top) and (Y <= pRect.Top + pTolerance) then
Result := 1;
if (Y > pRect.Top + pTolerance) and (Y < pRect.Bottom - pTolerance) then
Result := 8;
if (Y <= pRect.Bottom) and (Y >= pRect.Bottom - pTolerance) then
Result := 7;
end;
end;
function TSelection.InSelection(X, Y: Integer): Boolean;
begin
Result := PtInRect(Rect(pRect.Left + 1 + pResizeMargin, pRect.Top + 1 + pResizeMargin, pRect.Right - pResizeMargin, pRect.Bottom - pResizeMargin), Point(X, Y));
end;
procedure TSelection.MouseDown(X, Y: Integer);
begin
pCursorArea := GetCursorArea(X, Y);
if (pCursorArea = 0) then
begin
DrawIt;
pRect.TopLeft := Point(X, Y);
pRect.BottomRight := Point(X, Y);
pState := stSelecting;
pVisible := true;
end;
if (pCursorArea > 0) and (pCursorArea < 9) then
begin
pState := stResizing;
end;
if (pCursorArea = 9) then
begin
pState := stMoving;
pSelectionDown := Point(X - pRect.Left, Y - pRect.Top);
end;
end;
procedure TSelection.MouseMove(X, Y: Integer);
begin
if pState = stSelecting then
begin
DrawIt;
pRect.Right := X;
pRect.Bottom := Y;
DrawIt;
end;
if pState = stSelected then
begin
pCursorArea := GetCursorArea(X, Y);
SetTheCursor;
end;
if pState = stMoving then
begin
DrawIt;
pRect.Right := X - pSelectionDown.X + (pRect.Right - pRect.Left);
pRect.Left := X - pSelectionDown.X;
pRect.Bottom := Y - pSelectionDown.Y + (pRect.Bottom - pRect.Top);
pRect.Top := Y - pSelectionDown.Y;
DrawIt;
end;
if pState = stResizing then
begin
DrawIt;
case pCursorArea of
1: pRect.TopLeft := Point(X, Y);
2: pRect.Top := Y;
3:
begin
pRect.Right := X;
pRect.Top := Y;
end;
4: pRect.Right := X;
5: pRect.BottomRight := Point(X, Y);
6: pRect.Bottom := Y;
7:
begin
pRect.Left := X;
pRect.Bottom := Y;
end;
8: pRect.Left := X;
end;
DrawIt;
end;
end;
procedure TSelection.MouseUp(X, Y: Integer);
begin
DrawIt;
if (pRect.Left > pRect.Right) then
SwapNumbers(pRect.Left, pRect.Right, SizeOf(Integer));
if (pRect.Top > pRect.Bottom) then
SwapNumbers(pRect.Top, pRect.Bottom, SizeOf(Integer));
DrawIt;
pState := stSelected;
if (pRect.Bottom - pRect.Top = 0) or (pRect.Right - pRect.Left = 0) then
begin
DrawIt;
pState := stIdle;
pVisible := false;
end;
end;
procedure TSelection.SetSelection(aRect: TRect);
begin
DrawIt;
pRect := aRect;
DrawIt;
end;
procedure TSelection.SetTheCursor;
begin
case pCursorArea of
0: Screen.Cursor := crDefault;
1,5: Screen.Cursor := crSizeNWSE;
2,6: Screen.Cursor := crSizeNS;
3,7: Screen.Cursor := crSizeNESW;
4,8: Screen.Cursor := crSizeWE;
9: Screen.Cursor := crSizeAll;
end;
end;
procedure TSelection.SwapNumbers(var Nr1, Nr2: Integer; Size: Integer);
var
x: Pointer;
begin
GetMem(x, Size);
try
System.move(Nr1, x^, Size);
System.move(Nr2, Nr1, Size);
System.move(x^, Nr2, Size);
finally
FreeMem(x);
end;
end;
procedure TSelection.UnSelect;
begin
DrawIt;
pVisible := false;
pState := stIdle;
end;
{ TEditForm }
procedure TEditForm.FormCreate(Sender: TObject);
begin
Selection := TSelection.Create(PBSelect.Canvas);
MovingText := false;
end;
procedure TEditForm.PBSelectMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if ssLeft in Shift then
begin
Selection.MouseDown(X, Y);
end;
end;
procedure TEditForm.PBSelectMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if MovingText then
begin
lTextInsert.Left := X;
lTextInsert.Top := Y;
end
else
Selection.MouseMove(X, Y);
end;
procedure TEditForm.PBSelectMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
Selection.MouseUp(X, Y);
end;
procedure TEditForm.PBSelectPaint(Sender: TObject);
begin
Selection.DrawIt;
end;
procedure TEditForm.popCutClick(Sender: TObject);
begin
showmessage('hej')
end;
procedure TEditForm.popClearClick(Sender: TObject);
begin
IEdit.Canvas.Pen.Color := clBlack;
IEdit.Canvas.Brush.Color := clBlack;
IEdit.Canvas.Rectangle(Selection.pRect);
end;
procedure TEditForm.popBlurClick(Sender: TObject);
var
BlurBitmap: TBitmap;
begin
BlurBitmap := TBitmap.Create;
BlurBitmap.Width := Selection.pRect.Right - Selection.pRect.Left;
BlurBitmap.Height := Selection.pRect.Bottom - Selection.pRect.Top;
BlurBitmap.Canvas.CopyRect(Rect(0, 0, BlurBitmap.Width, BlurBitmap.Height), IEdit.Canvas, Selection.pRect);
BlurBitmap.PixelFormat := pf24bit;
BitmapBlurGaussian(BlurBitmap, 2.5);
IEdit.Canvas.Draw(Selection.pRect.Left, Selection.pRect.Top, BlurBitmap);
BlurBitmap.Free
end;
procedure TEditForm.popCropClick(Sender: TObject);
var
CropBitmap: TBitmap;
begin
CropBitmap := TBitmap.Create;
CropBitmap.Width := Selection.pRect.Right - Selection.pRect.Left;
CropBitmap.Height := Selection.pRect.Bottom - Selection.pRect.Top;
CropBitmap.Canvas.CopyRect(Rect(0, 0, Selection.pRect.Right - Selection.pRect.Left, Selection.pRect.Bottom - Selection.pRect.Top), IEdit.Canvas, Selection.pRect);
IEdit.Picture.Bitmap.Assign(CropBitmap);
Selection.SetSelection(Rect(0, 0, CropBitmap.Width, CropBitmap.Height));
CropBitmap.Free;
end;
procedure TEditForm.PopupMenuPopup(Sender: TObject);
begin
if Selection.pState = stSelected then
begin
popCrop.Enabled := true;
popClear.Enabled := true;
popBlur.Enabled := true;
end
else
begin
popCrop.Enabled := false;
popClear.Enabled := false;
popBlur.Enabled := false;
end;
end;
procedure TEditForm.Indsttekst1Click(Sender: TObject);
begin
TextForm.ShowModal;
end;
procedure TEditForm.Button4Click(Sender: TObject);
begin
SaveForm.OriginalBitmap := TBitmap.Create;
SaveForm.OriginalBitmap.Assign(IEdit.Picture.Bitmap);
SaveForm.ShowJpeg;
SaveForm.ShowModal;
end;
end.
