如何在Image上用canvas画选择框,及如何去除上一次所画的选择框(100分)

  • 主题发起人 主题发起人 sagitary
  • 开始时间 开始时间
S

sagitary

Unregistered / Unconfirmed
GUEST, unregistred user!
1、我在Image(已装入一幅bmp)上用image.canvas画选取范围的选择框,可是由于将
strech属性设为true,画时,mouse移动范围越大,画出的框偏移越多,请问如何在strech
设为true下画出正确的选择框?
2、如何去除mouse上一次所画的选择框,用image.repaint或refresh都不行。
恳请高手回答。
 
前面我回答了一个画“橡皮筋”选择框的问题,有原码的,去看看把。

另:第一个问题和你是否Stretch无关。
 
to 吕雪松:
很高兴遇见你。
你上次回答的问题我已看过,并且照做,但在image上画框确实会出现偏移情况,如果把
Autosize设为true,stretch设为false就正确,请问如何解决?
第二个擦除问题又怎么办?我是用canvas.rectangle画的。
另外,在mouseup事件中如何画出黑白相间的dash线型,如acdsee一样?
谢谢!
 
把你的代码给我一份把,我帮你看看。

擦除没有问题。你用rectangle的话,Brush.Style要设为bsclear;

dash线形用pen.style = psDotDash等可以搞定。
 
to 吕雪松:
谢谢。请问你的email是?
待我整理好后就发给你。
 
leisure.lv@263.net
 
程序刚刚发出,如果收不到,下面是代码,需要一个image,一个button用于装jpg格式的图像
,一个opendiag;

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, jpeg, StdCtrls, AxCtrls, OleCtrlsComCtrls;

type
TForm1 = class(TForm)
Imagebmp: TImage;
Button1: TButton;
Opend: TOpenDialog;
procedure ImagebmpMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImageBmpMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ImageBmpMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;


var
Form1: TForm1;
Down : Boolean;
FtPt,CurPt : TPoint;


implementation

{$R *.DFM}

procedure TForm1.ImageBmpMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
k:Tpoint;

begin

K:=mouse.CursorPos;//绝对座标
down := TRUE;
Ftpt:=Imagebmp.screentoclient(k);
curpt:=Imagebmp.screentoclient(k);
with Imagebmp do
begin
Canvas.Pen.Mode := pmnot;
Canvas.Pen.color:=clblack;
Canvas.Brush.Style := bsClear;
Canvas.pen.Style:=psdot;
end;

end;

procedure TForm1.ImageBmpMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
k:Tpoint;
begin
k:=mouse.CursorPos;

if down=false then exit;

with Imagebmp do
begin
Canvas.Rectangle(FtPt.X,FtPt.Y,CurPt.X,CurPt.Y);
end;
curpt:=Imagebmp.screentoclient(k);
ImageBmp.Canvas.Rectangle(FtPt.X,FtPt.Y,CurPt.X,CurPt.Y);


end;

procedure TForm1.ImageBmpMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);

begin
Down := FALSE;
with Imagebmp do
begin

Canvas.pen.Style:=psdashdot;
Canvas.Pen.Mode := pmcopy;
Canvas.Rectangle(FtPt.X,FtPt.Y,CurPt.X,CurPt.Y);
end;


end;



procedure TForm1.Button1Click(Sender: TObject);
var
jpg:Tjpegimage;
bmp:Tbitmap;
begin
if opend.Execute then
begin
jpg:=Tjpegimage.Create;
bmp:=Tbitmap.Create;
jpg.LoadFromFile(opend.filename);
bmp.Assign(jpg);
imagebmp.picture.Assign(bmp);
end;
end;

end.
 
对不起,上网时间到了,希望明天见!
 
to sagitary:
如果Autosize设为true,算一下比例就行了,
就是这个比例
Image1.Picture.Height/Image1.Height
Image1.Picture.Width/Image1.Width

to 吕雪松:
有个问题正好问一下你:如何在一个黑白图象(2bit)划红色的(宽度大于1)的线
分数我会单独给的(至少100)


 
呵,我正在想写一个计算比例的代码就好了,mafan你真快。

你的问题是什么意思呢?直接用pen.width := 2/3/4不行吗,还有什么条件?
 
当pen.width>1时,定义的PEN.COLOR不起作用(见delphi帮助),
关键是在2bit上如何划其他颜色的线
 
to mafan
搞错了吧,TPen.Width > 1 时是Pen.Style失效。

可不可以这样:
先把BMP.PixelFormat 设为pf1bit,然后画完你要的二值图,然后再改PixelFormat为
pf16bit等,再画彩色的图形?

如果不允许改,那么就只好把你的二值图Bitblt到另外一个DC上去画彩色了。

我们还是另外开一个帖子讨论这个问题把,不然对sagitary朋友很不礼貌。
 
OK
在这里
http://www.delphibbs.com/delphibbs/DispQ.asp?LID=515109

 
请问计算比例的具体代码如何实现呢?我自己试了一下,由于涉及到整型和实型的换算,
还是有偏差。另外我仔细看了一个acdsee的实现办法,发现acdsee是将图片尺寸shrink
后才实现选择框的,acdsee并没有在zoom情况下提供选择框,我是不是也要照做呢?

另外画出选择框后,用copyrect拷出所选择范围,生成图片后为何色彩与原图片相比失真
呢?希望有人能回答。谢谢!
 
的确我发现用TImage很不方便,Streth后他直接将DC坐标转换了,这样,就算你能对齐,
画出来的线条也很难看。
能不能换个思路:不要用TImage,就用PaintBox或直接用Form搞定,同样可以用CopyRect
实现图片的放大和缩小。
 
谢谢两位的回答,经过我自己的研究,已找到方法,即用stretchdraw来在image上画图,
这样画出的选择框就不会偏移,当然要用stretchdraw时要经过比例计算,不然图像不
合比例,最后问一个小问题,为何原图像是24b的,用copyrect截下的图是15b的呢?
如果实在无人回答,只好结束此问题讨论了。
 
多人接受答案了。
 
后退
顶部