300分寻求源代码(300分)

  • 主题发起人 主题发起人 chaofan201
  • 开始时间 开始时间
C

chaofan201

Unregistered / Unconfirmed
GUEST, unregistred user!
要求:在Panel1上放Scrollbox1,在Scrollbox1上放IMage1(有特殊用途)
实现:1.在IMage1上选择图片出现矩形框。
2.实现矩形框的剪切、复制、粘贴功能。

我搜索了大富翁所有帖子没能找出有用的代码,清各位大侠指正。
 
建议参考 C:/Program Files/Borland/Delphi?/Demos/Doc/Graphex的demo
 
怎样在图片上画矩形框呢?
 
canvas.brush.Style := bsDiagCross;
canvas.FrameRect(rect_ll);//画矩形框
 
窗体代码:GraphWin.dfm
object Form1: TForm1
Left = 51
Top = 159
Width = 575
Height = 334
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
Position = poDefault
OnCreate = FormCreate
OnMouseDown = FormMouseDown
OnMouseMove = FormMouseMove
OnMouseUp = FormMouseUp
PixelsPerInch = 96
TextHeight = 13
object StatusBar1: TStatusBar
Left = 0
Top = 289
Width = 567
Height = 18
Panels = <
item
Width = 150
end
item
Width = 50
end>
end
object ScrollBox1: TScrollBox
Left = 0
Top = 0
Width = 567
Height = 289
Align = alClient
TabOrder = 1
object Source_Image: TImage
Left = 0
Top = 0
Width = 297
Height = 285
Align = alLeft
AutoSize = True
OnMouseDown = FormMouseDown
OnMouseMove = FormMouseMove
OnMouseUp = FormMouseUp
end
object Dest_Image: TImage
Left = 297
Top = 0
Width = 264
Height = 285
Align = alLeft
end
end
end

单元代码:GraphWin.pas
unit GraphWin;

interface

uses
SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, ExtCtrls, StdCtrls, ComCtrls;

type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
ScrollBox1: TScrollBox;
Source_Image: TImage;
Dest_Image: TImage;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Drawing: Boolean;
StarPoint, MovePt: TPoint;
procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
end;

var
Form1: TForm1;

implementation

uses Clipbrd;

{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Drawing := True;
Source_Image.Canvas.MoveTo(X, Y);
StarPoint := Point(X, Y);
MovePt := StarPoint;
StatusBar1.Panels[0].Text := Format('起点坐标: (%d, %d)', [X, Y]);
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Width,Height : Integer;
NewBitmap : TBitmap;
begin
if Drawing then
begin
DrawShape(StarPoint, Point(X, Y), pmCopy);
Drawing := False;
Dest_Image.Canvas.Rectangle(X,Y,StarPoint.X,StarPoint.Y);
Width := abs(StarPoint.X-X);
Height := abs(StarPoint.Y-Y);
Dest_Image.Width := Width;
Dest_Image.Height := Height;
NewBitmap:=Tbitmap.create;
NewBitmap.Width := Width; //设置NewBitmap的长宽
NewBitmap.Height := Height;
NewBitmap.Canvas.CopyRect
(Rect(0,0,Width,Height),Source_Image.Canvas,
Rect(StarPoint.X,StarPoint.Y,X,Y));//拷贝Source_Image中的矩形区域
Dest_Image.Picture.Bitmap := NewBitmap;//放到的Dest_Image上
Clipboard.Assign(Dest_Image.Picture);//把Dest_Image中的图象复制到剪贴板
//把图片从剪贴板粘贴到Dest_Image
//Dest_Image.Picture.LoadFromClipBoardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap),0);
NewBitmap.Free; //释放Bitmap
end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Source_Image.Canvas.Brush.Style :=bsClear;
if Drawing then
begin
DrawShape(StarPoint, MovePt, pmNotXor);
MovePt := Point(X, Y);
DrawShape(StarPoint, MovePt, pmNotXor);
end;
StatusBar1.Panels[1].Text := Format('目前坐标: (%d, %d)', [X, Y]);
end;

procedure TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
begin
Source_Image.Canvas.Pen.Mode := AMode;
Source_Image.Canvas.Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X, BottomRight.Y);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Source_Image.Canvas.Brush.Style :=bsClear;
Source_Image.Picture.LoadFromFile('C:/xx.bmp');
end;

end.
 
我认为实现这样的功能不应该 用 Image (不知道你要求用 image)有什么用途,
当Image 里面 包含 bitmap ,image 的 canvas 是不能 画的。当然也可以有方法解决,不够方法不够简练。

我认为用 paintBox,opaint 里面画 选定框, 用全局变量 xs, ys, xe,ye 表示 选定框的坐标
至于 copy, cut, paste 也不复杂,你自己写些,如果还有疑问,我有时间给你写个demo。

谁帮我解决下面这个问题,我给他1000分
http://www.delphibbs.com/delphibbs/dispq.asp?lid=3297371
 
谢谢各位
to xfast
在此表示衷心感谢,还有一问题:
在选择了图片后出现矩形框,但重新选择,怎样去除前面前面的现矩形框?
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
mouseDown:=false;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
xs:=x;
ys:=y;
xe:=x;
ye:=y;
mousedown:=true;
image1.repaint;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
xs:=0; ys:=0; xe:=0; ye:=0;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if mousedown then
begin
image1.canvas.Pen.Mode:= pmNot; //可以消除前面画的矩形
image1.canvas.Brush.Style:=bsClear;
image1.canvas.Rectangle(xs, ys, xe, ye); //可以消除前面画的矩形
xe:=x;
ye:=y;
image1.canvas.Rectangle(xs, ys, xe, ye);
end;

end;
 
问题解决。
谢谢各位! 分分
 
后退
顶部