W
wbamboo
Unregistered / Unconfirmed
GUEST, unregistred user!
有一张大图,用image显示,在图中画一矩形框将选中区域裁剪下来,但裁剪下来的小图始终含有裁剪时的矩形框,请问在生成小图时如何将裁剪矩形框去掉?
代码是抄的网上的,如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Menus;
type
TForm1 = class(TForm)
Image1: TImage;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Button1: TButton;
PopupMenu1: TPopupMenu;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
Bmp : TBitmap;
rFrom, rTo : TRect;
CanSelect : boolean;
MenuItemSaveAs : TMenuItem;
procedure SelectedSaveAs(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Caption := '演示:导入一幅BMP后,拖动鼠标左键选择一块区域,右键另存为';
Button1.Caption := '导入BMP';
Image1.Left := 0;
Image1.Top := 0;
Image1.AutoSize := True;
OpenDialog1.FileName := '*.BMP';
OpenDialog1.Filter := 'Windows位图文件';
//SaveDialog1.FileName := '*.BMP';
SaveDialog1.Filter := '请输入欲存为的BMP文件名';
MenuItemSaveAs := TMenuItem.Create(PopupMenu1);
MenuItemSaveAs.Caption := '选区另存为BMP文件';
MenuItemSaveAs.OnClick := SelectedSaveAs;
PopupMenu1.Items.Add(MenuItemSaveAs);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then begin
if Bmp<>nil then FreeAndNil(Bmp);
Bmp := TBitmap.Create;
Bmp.LoadFromFile(OpenDialog1.FileName);
with Image1 do begin
Picture.Bitmap := Bmp;
Canvas.Pen.Mode := pmNot;
Canvas.Brush.Style := bsClear;
OnMouseDown := Image1MouseDown;
OnMouseMove := Image1MouseMove;
OnMouseUp := Image1MouseUp;
end;
rFrom := Rect(0, 0, 0, 0);
end;
end;
procedure TForm1.SelectedSaveAs(Sender: TObject);
var
TempBmp : TBitmap;
begin
if SaveDialog1.Execute then begin
TempBmp := TBitmap.Create;
try
TempBmp.Width := rFrom.Right-rFrom.Left;
TempBmp.Height := rFrom.Bottom-rFrom.Top;
rTo := Rect(0, 0, TempBmp.Width, TempBmp.Height);
TempBmp.Canvas.CopyRect(rTo, Bmp.Canvas, rFrom);//拷贝选中区域
TempBmp.SaveToFile(SaveDialog1.FileName);
finally
TempBmp.Free;
end;
end;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then begin
CanSelect := True;
if (rFrom.Left<>rFrom.Right) and (rFrom.Top<>rFrom.Bottom) then
Image1.Canvas.Rectangle(rFrom);
rFrom.Left := X;
rFrom.Top := Y;
rFrom.Right := X;
rFrom.Bottom := Y;
end;
if Button = mbRight then
if (rFrom.Left<>rFrom.Right) and (rFrom.Top<>rFrom.Bottom) then
PopupMenu1.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if CanSelect then begin
Image1.Canvas.Rectangle(rFrom);
rFrom.Right := X;
rFrom.Bottom := Y;
Image1.Canvas.Rectangle(rFrom);
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
CanSelect := False;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Bmp<>nil then FreeAndNil(Bmp);
if MenuItemSaveAs<>nil then FreeAndNil(MenuItemSaveAs);
end;
end.
代码是抄的网上的,如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Menus;
type
TForm1 = class(TForm)
Image1: TImage;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Button1: TButton;
PopupMenu1: TPopupMenu;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
Bmp : TBitmap;
rFrom, rTo : TRect;
CanSelect : boolean;
MenuItemSaveAs : TMenuItem;
procedure SelectedSaveAs(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Caption := '演示:导入一幅BMP后,拖动鼠标左键选择一块区域,右键另存为';
Button1.Caption := '导入BMP';
Image1.Left := 0;
Image1.Top := 0;
Image1.AutoSize := True;
OpenDialog1.FileName := '*.BMP';
OpenDialog1.Filter := 'Windows位图文件';
//SaveDialog1.FileName := '*.BMP';
SaveDialog1.Filter := '请输入欲存为的BMP文件名';
MenuItemSaveAs := TMenuItem.Create(PopupMenu1);
MenuItemSaveAs.Caption := '选区另存为BMP文件';
MenuItemSaveAs.OnClick := SelectedSaveAs;
PopupMenu1.Items.Add(MenuItemSaveAs);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then begin
if Bmp<>nil then FreeAndNil(Bmp);
Bmp := TBitmap.Create;
Bmp.LoadFromFile(OpenDialog1.FileName);
with Image1 do begin
Picture.Bitmap := Bmp;
Canvas.Pen.Mode := pmNot;
Canvas.Brush.Style := bsClear;
OnMouseDown := Image1MouseDown;
OnMouseMove := Image1MouseMove;
OnMouseUp := Image1MouseUp;
end;
rFrom := Rect(0, 0, 0, 0);
end;
end;
procedure TForm1.SelectedSaveAs(Sender: TObject);
var
TempBmp : TBitmap;
begin
if SaveDialog1.Execute then begin
TempBmp := TBitmap.Create;
try
TempBmp.Width := rFrom.Right-rFrom.Left;
TempBmp.Height := rFrom.Bottom-rFrom.Top;
rTo := Rect(0, 0, TempBmp.Width, TempBmp.Height);
TempBmp.Canvas.CopyRect(rTo, Bmp.Canvas, rFrom);//拷贝选中区域
TempBmp.SaveToFile(SaveDialog1.FileName);
finally
TempBmp.Free;
end;
end;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then begin
CanSelect := True;
if (rFrom.Left<>rFrom.Right) and (rFrom.Top<>rFrom.Bottom) then
Image1.Canvas.Rectangle(rFrom);
rFrom.Left := X;
rFrom.Top := Y;
rFrom.Right := X;
rFrom.Bottom := Y;
end;
if Button = mbRight then
if (rFrom.Left<>rFrom.Right) and (rFrom.Top<>rFrom.Bottom) then
PopupMenu1.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if CanSelect then begin
Image1.Canvas.Rectangle(rFrom);
rFrom.Right := X;
rFrom.Bottom := Y;
Image1.Canvas.Rectangle(rFrom);
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
CanSelect := False;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Bmp<>nil then FreeAndNil(Bmp);
if MenuItemSaveAs<>nil then FreeAndNil(MenuItemSaveAs);
end;
end.