unit NewImagePanel;
interface
uses
Windows,SysUtils, Classes, Controls, ExtCtrls,Graphics,Dialogs;
type
RMRect=record
A:TRect;
B:TRect;
C:TRect;
D:TRect;
AB:TRect;
AC:TRect;
BD:TRect;
CD:TRect;
X,Y,W,H:Integer;
end;
TNewFrameimage = class(TImage)
private
FrameBrokenRect:TRect;
MLeftDown,MUp:Boolean;
MPoint:TPoint;
{ Private declarations }
protected
{ Protected declarations }
procedure FrameMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
procedure FrameMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure FrameMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
public
{ Public declarations }
published
{ Published declarations }
constructor Create(Aowner:TComponent);override;
destructor Destroy;override;
end;
TNewimage = class(TImage)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
constructor Create(Aowner:TComponent);override;
destructor Destroy;override;
end;
TNewimagePanel = class(TWinControl)
private
{ Private declarations }
NewFrameimage:TNewFrameimage;
Newimage:TNewimage;
FFrameRect: TRect;
PicImageRect:TRect;
Cbmp:TBitmap;
FPicture:TPicture;
procedure CanvasRec(CR:TRect;CCanvas:Tcanvas);
procedure SetPicture(const Value:TPicture);
procedure SetFrameRect(const Value:TRect);
procedure PaintPic(ACanvas: TCanvas; Bitmap: TBitmap);
protected
{ Protected declarations }
public
{ Public declarations }
property FrameRect:TRect read FFrameRect write SetFrameRect;
procedure Refresh;
published
{ Published declarations }
constructor Create(Aowner:TComponent);override;
destructor Destroy;override;
property Picture: TPicture read FPicture write SetPicture;
end;
var
Cmr:RMRect;
const
FOCUS_FRAME=15;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TNewimagePanel]);
end;
{ TNewimage }
constructor TNewimage.Create(Aowner: TComponent);
begin
inherited;
end;
destructor TNewimage.Destroy;
begin
inherited;
;
end;
constructor TNewFrameimage.Create(Aowner: TComponent);
begin
inherited;
end;
destructor TNewFrameimage.Destroy;
begin
inherited;
end;
procedure TNewFrameimage.FrameMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MLeftDown:=true;
MPoint:=Point(x,y);
if (PtInRect(Cmr.A,Point(x,Y))) or (PtInRect(Cmr.AB,Point(x,Y))) or (PtInRect(Cmr.B,Point(x,Y)))
or (PtInRect(Cmr.AC,Point(x,Y))) then
MUp:=true
else
MUp:=false
end;
procedure TNewFrameimage.FrameMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
Spoint:TPoint;
cx,cy:integer;
Sleft,STop,SWidth,SHeight:integer;
begin
if MLeftDown then
begin
if Owner.ClassName = 'TNewimagePanel' then
begin
Sleft:=TNewimagePanel(Owner).PicImageRect.Left;
STop:=TNewimagePanel(Owner).PicImageRect.Top;
SWidth:=TNewimagePanel(Owner).PicImageRect.Right;
SHeight:=TNewimagePanel(Owner).PicImageRect.Bottom;
end;
if Cursor=crSizeAll then
FrameBrokenRect := Rect(x-MPoint.x+Cmr.X,Y-(MPoint.Y-Cmr.Y),x-MPoint.x+Cmr.X+(Cmr.w-Cmr.x),Y-(MPoint.Y-Cmr.Y)+(Cmr.h-Cmr.y));
if Cursor=crSizeNWSE then
if MUp then
FrameBrokenRect := Rect(x-MPoint.x+Cmr.X,Y-(MPoint.Y-Cmr.Y),Cmr.w,Cmr.h)
else
FrameBrokenRect := Rect(Cmr.X,Cmr.Y,x-MPoint.x+Cmr.X+(Cmr.w-Cmr.x),Y-(MPoint.Y-Cmr.Y)+(Cmr.h-Cmr.y)) ;
if Cursor=crSizeNESW then
if MUp then
FrameBrokenRect := Rect(Cmr.X,Y-(MPoint.Y-Cmr.Y),x-MPoint.x+Cmr.X+(Cmr.w-Cmr.x),Cmr.h)
else
FrameBrokenRect := Rect(x-MPoint.x+Cmr.X,Cmr.Y,Cmr.w,Y-(MPoint.Y-Cmr.Y)+(Cmr.h-Cmr.y)) ;
if Cursor=crSizeNS then
if MUp then
FrameBrokenRect := Rect(Cmr.X,Y-(MPoint.Y-Cmr.Y),Cmr.w,Cmr.h)
else
FrameBrokenRect := Rect(Cmr.X,Cmr.Y,Cmr.w,Y-(MPoint.Y-Cmr.Y)+(Cmr.h-Cmr.y)) ;
if self.Cursor=crSizeWE then
if MUp then
FrameBrokenRect := Rect(x-MPoint.x+Cmr.X,Cmr.Y,Cmr.W,Cmr.h)
else
FrameBrokenRect := Rect(Cmr.X,Cmr.Y,x-MPoint.x+Cmr.X+(Cmr.w-Cmr.x),Cmr.h) ;
if FrameBrokenRect.Left<SLeft then FrameBrokenRect.Left:=SLeft-1;
if FrameBrokenRect.Top<STop then FrameBrokenRect.Top:=STop-1;
if FrameBrokenRect.Right>SWidth then FrameBrokenRect.Right:=SWidth+1;
if FrameBrokenRect.Bottom>SHeight then FrameBrokenRect.Bottom:=SHeight+1;
if Cursor<>crSizeAll then
begin
if FrameBrokenRect.Right-FrameBrokenRect.Left<FOCUS_FRAME then
if FrameBrokenRect.Left+1=Sleft then
FrameBrokenRect.Right:=FrameBrokenRect.Left+FOCUS_FRAME
else
if Mup then
if Cursor=crSizeNESW then
FrameBrokenRect.Right:=FrameBrokenRect.Left+FOCUS_FRAME
else
FrameBrokenRect.Left:=FrameBrokenRect.Right-FOCUS_FRAME
else
if Cursor=crSizeNESW then
FrameBrokenRect.Left:=FrameBrokenRect.Right-FOCUS_FRAME
else
FrameBrokenRect.Right:=FrameBrokenRect.Left+FOCUS_FRAME;
if FrameBrokenRect.Bottom-FrameBrokenRect.Top<FOCUS_FRAME then
if FrameBrokenRect.Top+1=STop then
FrameBrokenRect.Bottom:=FrameBrokenRect.Top+FOCUS_FRAME
else
if Mup then
FrameBrokenRect.Top:=FrameBrokenRect.Bottom-FOCUS_FRAME
else
FrameBrokenRect.Bottom:=FrameBrokenRect.Top+FOCUS_FRAME;
end
else
begin
if FrameBrokenRect.Bottom-FrameBrokenRect.Top<Cmr.H-Cmr.Y then
if FrameBrokenRect.Top=STop-1 then
FrameBrokenRect.Bottom:=Cmr.H-Cmr.Y+STop-1
else
FrameBrokenRect.Top:=FrameBrokenRect.Bottom-Cmr.H+Cmr.Y;
if FrameBrokenRect.Right-FrameBrokenRect.Left<Cmr.W-Cmr.X then
if FrameBrokenRect.Left=SLeft-1 then
FrameBrokenRect.Right:=SLeft+Cmr.W-Cmr.X-1
else
FrameBrokenRect.Left:=FrameBrokenRect.Right-Cmr.W+Cmr.X;
end;
canvas.FillRect(Rect(0, 0, Width, Height));
DrawFocusRect(Canvas.Handle, FrameBrokenRect);
end
else
begin
Cursor:=crDefault;
if PtInRect(Rect(Cmr.X,Cmr.Y,Cmr.W,Cmr.H),Point(x,Y)) then
Cursor:=crSizeAll;
if (PtInRect(Cmr.A,Point(x,Y))) or (PtInRect(Cmr.D,Point(x,Y))) then
Cursor:=crSizeNWSE;
if (PtInRect(Cmr.B,Point(x,Y))) or (PtInRect(Cmr.C,Point(x,Y))) then
Cursor:=crSizeNESW;
if (PtInRect(Cmr.AC,Point(x,Y))) or (PtInRect(Cmr.BD,Point(x,Y))) then
Cursor:=crSizeWE;
if (PtInRect(Cmr.AB,Point(x,Y))) or (PtInRect(Cmr.CD,Point(x,Y))) then
Cursor:=crSizeNS;
end;
end;
procedure TNewFrameimage.FrameMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MLeftDown:=False;
canvas.FillRect(Rect(0, 0, Width, Height));
if Owner.ClassName = 'TNewimagePanel' then
TNewimagePanel(Owner).FrameRect:=FrameBrokenRect;
end;
{ TNewimagePanel }
procedure TNewimagePanel.CanvasRec(CR: TRect; CCanvas: Tcanvas);
var
x,y,w,h:integer;
begin
with CCanvas do
begin
Pen.Color := clRed;
Brush.Color := clRed;
x:=CR.Left;
y:=CR.Top;
w:=CR.Right-CR.Left;
h:=CR.Bottom-CR.Top;
Cmr.X:=x;
Cmr.Y:=y;
Cmr.W:=x+ w;
Cmr.H:=y+h;
FrameRect(CR);
Rectangle(x-3,y-3, X+1,Y+1);
Cmr.A:=Rect(x-3,y-3, X+1,Y+1);
Rectangle(x-3,y+h-1, x+1,y+h+3);
Cmr.C:=Rect(x-3,y+h-1, x+1,y+h+3);
Rectangle(x+w-1,y-3, x+w+3,Y+1);
Cmr.B:=Rect(x+w-1,y-3, x+w+3,Y+1);
Rectangle(x+w-1,y+h-1, x+w+3,y+h+3);
Cmr.D:=Rect(x+w-1,y+h-1, x+w+3,y+h+3);
Rectangle(x-3,y+(h div 2)-2, x+1,y+(h div 2)+2);
Cmr.AC:=Rect(x-3,y+(h div 2)-2, x+1,y+(h div 2)+2);
Rectangle(x+w-1,y+(h div 2)-1, x+w+3,y+(h div 2)+3);
Cmr.BD:=Rect(x+w-1,y+(h div 2)-1, x+w+3,y+(h div 2)+3);
Rectangle(x+(w div 2)-2,y-3, x+(w div 2)+2,Y+1);
Cmr.AB:=Rect(x+(w div 2)-2,y-3, x+(w div 2)+2,Y+1);
Rectangle(x+(w div 2)-2,y+h-1, x+(w div 2)+2,y+h+3);
Cmr.CD:=Rect(x+(w div 2)-2,y+h-1, x+(w div 2)+2,y+h+3);
end;
end;
constructor TNewimagePanel.Create(Aowner: TComponent);
begin
inherited;
Width:=250;
Height:=50;
Color:=clWindow;
DoubleBuffered:=true;
FPicture := TPicture.Create;
Newimage:=TNewimage.Create(self);
Newimage.Parent:=self;
Newimage.Align:=alClient;
Newimage.Left:=Left;
Newimage.Top:=Left;
Newimage.Width:=Width;
Newimage.Height:=Height;
Newimage.Center:=true;
NewFrameimage:=TNewFrameimage.Create(self);
NewFrameimage.Parent:=self;
NewFrameimage.Align:=alClient;
NewFrameimage.Left:=Left;
NewFrameimage.Top:=Top;
NewFrameimage.Width:=Width;
NewFrameimage.Height:=Height;
NewFrameimage.Transparent:=true;
NewFrameimage.OnMouseMove:=NewFrameimage.FrameMouseMove;
NewFrameimage.OnMouseDown:=NewFrameimage.FrameMouseDown;
NewFrameimage.OnMouseUp:=NewFrameimage.FrameMouseUp;
end;
destructor TNewimagePanel.Destroy;
begin
inherited;
FPicture.Free;
end;
procedure TNewimagePanel.Refresh;
var
Buf,BufB,BufC:TBitmap;
begin
Buf:=TBitmap.Create;
BufB:=TBitmap.Create;
BufC:=TBitmap.Create;
Buf:=Picture.Bitmap;
if (Buf.Width<=Width-10) and (Buf.Height<=Height-10) then
begin
BufB.Width:=Buf.Width;
BufB.Height:=Buf.Height;
end
else
begin
if (Buf.Width<=Width-10) and (Buf.Height>Height-10) then
begin
BufB.Width:=Trunc(Buf.Width*(Height-10)/Buf.Height);
BufB.Height:=Height-10;
end;
if (Buf.Height<=Height-10) and (Buf.Width>Width-10) then
begin
BufB.Width:=Width-10;
BufB.Height:=Trunc(Buf.Height*(Width-10)/Buf.Width);
end;
if (Buf.Height>Height-10) and (Buf.Width>Width-10) then
begin
if Buf.Width>Buf.Height then
begin
if Buf.Height<Height-10 then
begin
BufB.Width:=Width-10;
BufB.Height:=Trunc(Buf.Height*(Width-10)/Buf.Width);
end
else
begin
BufB.Width:=Trunc(Buf.Width*(Height-10)/Buf.Height);
BufB.Height:=Height-10;
end;
end;
if Buf.Width<Buf.Height then
begin
if Buf.Width<Width-10 then
begin
BufB.Width:=Width-10;
BufB.Height:=Trunc(Buf.Height*(Width-10)/Buf.Width);
end
else
begin
BufB.Width:=Trunc(Buf.Width*(Height-10)/Buf.Height);
BufB.Height:=Height-10;
end;
end;
if Buf.Width=Buf.Height then
begin
BufB.Width:=Width-10;
BufB.Height:=Width-10;
end;
end;
end;
BufB.Canvas.StretchDraw(BufB.Canvas.ClipRect,Buf);
BufC.Width:=Width;
BufC.Height:=Height;
BitBlt(BufC.Canvas.Handle, (Width-BufB.Width) div 2, (Height-BufB.Height) div 2, BufB.Width, BufB.Height, BufB.Canvas.Handle, 0, 0, SRCCOPY);
Newimage.Picture.Graphic:=BufC;
PicImageRect:=Rect((Width-BufB.Width) div 2,(Height-BufB.Height) div 2,BufB.Width+(Width-BufB.Width) div 2,BufB.Height+(Height-BufB.Height) div 2);
end;
procedure TNewimagePanel.SetFrameRect(const Value: TRect);
begin
FFrameRect:=Value;
Refresh;
CanvasRec(FFrameRect,Newimage.Canvas);
end;
procedure TNewimagePanel.SetPicture(const Value: TPicture);
begin
FPicture.Assign(Value);
end;
procedure TNewimagePanel.PaintPic(ACanvas: TCanvas; Bitmap: TBitmap); //画透明图标
var
ImageList : TImageList;
TransColor : TColor;
begin
if (Bitmap.Width = 0) or (Bitmap.Height = 0) then
Exit;
TransColor := Bitmap.Canvas.Pixels[0, 5];
ImageList := TImageList.CreateSize(Bitmap.Width, Bitmap.Height);
try
ImageList.AddMasked(Bitmap, TransColor);
ImageList.Draw(ACanvas, 0, 0, 0, Enabled);
finally
ImageList.Free();
end;
end;
end.
