необходимо выделить фрагмент изображения

← →
stud © (2004-09-16 17:56) [0]

на TImage. он выделяется, но происходит перерисовка компонента и соответсвенно "мерцание". как избавиться от этой проблемы?

← →
default © (2004-09-16 18:13) [1]

а как рисуешь рамку выделения?
нужно отрезки прямых стирать путём их вывода в режиме xor
перерисовывать ничего не нужно
P.S. или я не понял вопроса...

← →
stud © (2004-09-16 18:15) [2]

так и рисую. только при выделении фрагмента - движении мышки постоянно происходит перерисовка и соотв. моргание самого рисунка. как избавиться от этого моргания

← →
default © (2004-09-16 18:19) [3]

stud © (16.09.04 18:15) [2]
хм...почему интересно рисунок моргает?если мы рисуем только линии...участки вне их мы же не трогаем...нафиг они перерисовываются(не по делу)

← →
jack128 © (2004-09-16 18:33) [4]

default © (16.09.04 18:19) [3]
потому, что так работает Image. При любом изменении Canvas"а он себя полностью перерисовывает.

← →
default © (2004-09-16 18:46) [5]

jack128 © (16.09.04 18:33) [4]
мдя...

← →
olookin © (2004-09-16 18:48) [6]

Я бы, во-первых, рамку не рисовал, а изменял ее размеры. В качестве рамки использовал бы какой-нибудь TBevel. А во-вторых, я бы форме, на которой этот TImage, присвоил DoubleBuffered:=true;

← →
wl (2004-09-16 19:19) [7]

а я бы не использовал TImage и не парился, TPaintBox не будет мерцать

← →
jack128 © (2004-09-16 20:01) [8]

wl (16.09.04 19:19) [7]
а я бы не использовал TImage и не парился, TPaintBox не будет мерцать
Это смотря как его (PaintBox) использовать. Если на каждый чих делать PaintBox1.Invalidate - то таже фигня будет.. Мерцание можно уменьшить если у радителя выставить DoubleBuffered := True(правда fps уменьшутся, конечно :-)) . Но в данном случае я не уверен в этот подходе, потому, что TImage - он сам себе дает буфферизацию, и то у чела мерцает.. В общем не понятно..

← →
_student (2004-09-16 20:04) [9]

> stud ©

Покажи код перерисовки

← →
stud © (2004-09-17 09:11) [10]

кода перерисовки никакого нет. я уже взял шейп и при движении мышкой по изображения меняю его размеры : faceselect.BoundsRect:=nr;
но при движении мышки область шейпа закрашивается в цвет фона и становится прозрачным при завершении опреции выделения. плюс непиятные тормоза.
может кто может подсказать как реализовать выделение картинки?

← →
_student (2004-09-17 09:18) [11]

Попробуй это

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) 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); private { Private declarations } public { Public declarations } end; var Form1: TForm1; md: boolean; rec: trect; dc: hdc; implementation {$R *.dfm} procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin md := true; rec.TopLeft := point(x, y); end; procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin md := false; end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var d: integer; begin dc := getdc(form1.Handle); if rec.Left > rec.Right then begin rec.TopLeft := point(x, y); end else rec.BottomRight := point(x, y); if md = true then begin form1.Refresh; DrawFocusRect(dc, rec); end; end; end.

← →
stud © (2004-09-17 09:30) [12]

работает, но на имадже нет прямоугольника который ограничивает выделяемое изображение

← →
_student (2004-09-17 09:44) [13]

Image1.Canvas.DrawFocusRect

← →
stud © (2004-09-17 09:52) [14]

> Image1.Canvas.DrawFocusRect

а вот тут начинается все по старому - моргание

← →
olookin © (2004-09-17 11:17) [15]

Ничего не понимаю, в чем проблема?

Вот это работает?

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Image1: TImage;
Shape1: TShape;
procedure FormShow(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);
private
{ Private declarations }
public
{ Public declarations }
end;

var Form1: TForm1;
oldx,oldy: integer;
move: boolean=false;

implementation

{$R *.DFM}

procedure TForm1.FormShow(Sender: TObject);
var i,j: integer;
begin
for i:=0 to image1.width-1 do
for j:=0 to image1.height-1 do
// iMAGE1.cANVAS.Brush.Color:=clWhite;
image1.Canvas.Pixels[i,j]:=RGB(i,j,i+j);
//Fillrect(rect(0,0,Image1.width,Image1.Height));
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
move:=true; Shape1.width:=0; Shape1.height:=0; Shape1.Visible:=true;
oldx:=x; oldy:=y;
shape1.left:=image1.left+oldx;
shape1.top:=image1.top+oldy;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if move then begin shape1.width:=x-oldx; shape1.height:=y-oldy; end;

end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
move:=false; Shape1.Visible:=false;
end;

end.

у меня код такой:
procedure Tnewclientf.docfotoMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if ssleft in shift then
begin
faceselect.Visible:=true;
oldx:=x;
oldy:=y;
r.TopLeft:=point(x,y);
r.BottomRight:=point(x,y);
end;
end;

procedure Tnewclientf.docfotoMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if ssleft in shift then
begin
if oldx<x then
begin
r.Left:=oldx; r.Right:=x;
end
else
begin
r.Left:=x;
r.Right:=oldx;
end;
if oldy<y then
begin
r.Top:=oldy;
r.Bottom:=y;
end
else
begin
r.Top:=y;
r.Bottom:=oldy;
end;
nr.Left:=r.Left+504;
nr.Top:=r.Top+8;
nr.Right:=r.Right+504;
nr.Bottom:=r.Bottom+8;
faceselect.BoundsRect:=nr;
end;
end;

procedure Tnewclientf.docfotoMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
nr : trect;
begin
nr.Left:=0;
nr.Top:=0;
nr.Bottom:=r.Bottom-r.Top+1;
nr.Right:=r.Right-r.Left+1;
face:=tbitmap.Create;
face.Canvas.BrushCopy(r, docfoto.Picture.Bitmap, r, clBlack);
face.Width:=nr.Right;
face.Height:=nr.Bottom;
face.Canvas.CopyRect(nr,docfoto.Picture.Bitmap.canvas,r);
newclientf.facefoto.Picture.Bitmap.assign(face);
face.Free;
faceselect.Visible:=false;
faceselect.Width:=1;
faceselect.Height:=1;
end;

faceselect - TShape

размер картинки 640х480 и при выделении области
1 тормоза
2

Я так понял, мой вариант вас не устраивает по каким-то причинам? Или в чем проблема еще остается??

все. разобрался. все св-ва по дефолту оставил - вроде нормально

необходимо выделить фрагмент изображения Найти похожие ветки