| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
необходимо выделить фрагмент изображения [D7]
stud © (2004-09-16 17:56:00)на TImage. он выделяется, но происходит перерисовка компонента и соответсвенно "мерцание". как избавиться от этой проблемы?
stud (2004-09-17 15:27:00) [1]все. разобрался. все св-ва по дефолту оставил - вроде нормально
olookin (2004-09-17 15:09:00) [2]Я так понял, мой вариант вас не устраивает по каким-то причинам? Или в чем проблема еще остается??
stud (2004-09-17 13:16:00) [3]2
> stud © (17.09.04 09:11) [10]
stud (2004-09-17 13:15:00) [4]размер картинки 640х480 и при выделении области
1 тормоза
2
olookin (2004-09-17 12:29:00) [5][16] stud © (17.09.04 11:48)
И что?
stud (2004-09-17 11:48:00) [6]у меня код такой:
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
olookin (2004-09-17 11:17:00) [7]Ничего не понимаю, в чем проблема?
Вот это работает?
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.
stud (2004-09-17 09:52:00) [8]
> Image1.Canvas.DrawFocusRect
а вот тут начинается все по старому - моргание
_student (2004-09-17 09:44:00) [9]
Image1.Canvas.DrawFocusRect
stud (2004-09-17 09:30:00) [10]работает, но на имадже нет прямоугольника который ограничивает выделяемое изображение
_student (2004-09-17 09:18:00) [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:11:00) [12]кода перерисовки никакого нет. я уже взял шейп и при движении мышкой по изображения меняю его размеры : faceselect.BoundsRect:=nr;
но при движении мышки область шейпа закрашивается в цвет фона и становится прозрачным при завершении опреции выделения. плюс непиятные тормоза.
может кто может подсказать как реализовать выделение картинки?
_student (2004-09-16 20:04:00) [13]
> stud ©
Покажи код перерисовки
jack128 (2004-09-16 20:01:00) [14]wl (16.09.04 19:19) [7]
а я бы не использовал TImage и не парился, TPaintBox не будет мерцать
Это смотря как его (PaintBox) использовать. Если на каждый чих делать PaintBox1.Invalidate - то таже фигня будет.. Мерцание можно уменьшить если у радителя выставить DoubleBuffered := True(правда fps уменьшутся, конечно :-)) . Но в данном случае я не уверен в этот подходе, потому, что TImage - он сам себе дает буфферизацию, и то у чела мерцает.. В общем не понятно..
wl (2004-09-16 19:19:00) [15]а я бы не использовал TImage и не парился, TPaintBox не будет мерцать
olookin (2004-09-16 18:48:00) [16]Я бы, во-первых, рамку не рисовал, а изменял ее размеры. В качестве рамки использовал бы какой-нибудь TBevel. А во-вторых, я бы форме, на которой этот TImage, присвоил DoubleBuffered:=true;
default (2004-09-16 18:46:00) [17]jack128 © (16.09.04 18:33) [4]
мдя...
jack128 (2004-09-16 18:33:00) [18]default © (16.09.04 18:19) [3]
потому, что так работает Image. При любом изменении Canvas'а он себя полностью перерисовывает.
default (2004-09-16 18:19:00) [19]stud © (16.09.04 18:15) [2]
хм...почему интересно рисунок моргает?если мы рисуем только линии...участки вне их мы же не трогаем...нафиг они перерисовываются(не по делу)
stud (2004-09-16 18:15:00) [20]так и рисую. только при выделении фрагмента - движении мышки постоянно происходит перерисовка и соотв. моргание самого рисунка. как избавиться от этого моргания
| |
Страницы: 