Скачать: CL | DM;

Как сделать прям-к для выделения части картинки, чтобы она не...   Найти похожие ветки 

← →
Hatawa   (2003-07-13 17:49) [0]

Как сделать прям-к для выделения части картинки, чтобы она не мигала при движении мыши????

Я использовала
http://www.delphimaster.ru/cgi-bin/faq.pl?look=1&id=988624269&n=21

но происходит мигание картинки, пока прямоугольник рисуется - ужас!!!

---

← →
Palladin ©   (2003-07-13 17:56) [1]

Ужас, кашмар и пр эмоции
попробуй DoubleBuffered:=true

---

← →
Hatawa   (2003-07-13 17:59) [2]

пробовала, но дочернее окно не дает ничего динамически создавать...

---

← →
Palladin ©   (2003-07-13 18:01) [3]

что что, простите?

---

← →
Hatawa   (2003-07-13 18:05) [4]

Я и делаю дабл-буферинг.
при попытке создания рисунка динамически всё грохается с exeptionом.

---

← →
DVM ©   (2003-07-13 18:09) [5]

ImageList + CreateDragImage = ничего абсолютно не мигает

---

← →
DVM ©   (2003-07-13 18:10) [6]

Сорри, это я, наверное, перепутал, мне показалось, что картинку перетаскивают.

---

← →
Hatawa   (2003-07-13 18:11) [7]

объясни, плиз, поподробнее...

---

← →
Hatawa   (2003-07-13 18:12) [8]

ничего страшного :)

---

← →
Семен Сорокин ©   (2003-07-13 18:15) [9]

2Hatawa
код покажи.
Может стоить рисовать на битмапе, а потом copyrect на канву картинки?

---

← →
Hatawa   (2003-07-13 18:23) [10]

при попытке динамически создать битмап все грохается

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

---

← →
Palladin ©   (2003-07-13 18:27) [11]

У тебя код просят, или плохо просят?
Могу конкретно сказать, нужен тот участок который вызывает exception

---

← →
Hatawa   (2003-07-13 18:38) [12]

procedure TMDIChild.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var tmp: TPicture;
begin
if crop_fl then
begin
if Captured then
begin
tmp.Create;
tmp.bitmap.Width:=Image1.Width;
tmp.bitmap.Height:=Image1.Height;
tmp.Bitmap:=image1.Picture.Bitmap;
tmp.bitmap.Canvas.Brush.Color:=clwhite;
tmp.bitmap.Canvas.DrawFocusRect(MakeRect(StartPlace,EndPlace));

image1.Picture.Bitmap:=tmp.Bitmap;
tmp.Destroy;
end;
StartPlace.x := X;
StartPlace.y := Y;
EndPlace.x := X;
EndPlace.y := Y;

tmp.Create;
tmp.bitmap.Width:=Image1.Width;
tmp.bitmap.Height:=Image1.Height;
tmp.Bitmap:=image1.Picture.Bitmap;
tmp.bitmap.Canvas.Brush.Color:=clwhite;
tmp.bitmap.Canvas.DrawFocusRect(MakeRect(StartPlace,EndPlace));

image1.Picture.Bitmap:=tmp.Bitmap;
tmp.Destroy;

Capturing := true;
Captured := true;
end;
end;

на Creat"е вываливается

---

← →
Palladin ©   (2003-07-13 18:49) [13]

где тебя учили объекты так создавать? или сама придумала?

tmp:=TPicture.Create;
...
tmp.free;

---

← →
Семен Сорокин ©   (2003-07-13 18:50) [14]

var
tmp: TBitmap;
...

tmp := tBitmap.Create;
try

finally
tmp.Free
end

---

← →
Palladin ©   (2003-07-13 18:51) [15]

http://www.delphikingdom.com/helloworld/runtime_comp.htm

---

← →
Семен Сорокин ©   (2003-07-13 18:54) [16]

чё-нить типа этого:
tmp := TBitmap.Create;
with _tmp do
try
Width:=Image1.Width;
Height:=Image1.Height;
Canvas.CopyRect(Canvas.ClipRect, image1.Picture.Bitmap.Canvas, image1.Picture.Bitmap.Canvas.ClipRect);
Canvas.Brush.Color:=clwhite;
Canvas.DrawFocusRect(MakeRect(StartPlace,EndPlace));
StartPlace.x := X;
StartPlace.y := Y;
EndPlace.x := X;
EndPlace.y := Y;
Canvas.DrawFocusRect(MakeRect(StartPlace,EndPlace));
image1.Picture.Bitmap:=tmp;
finally
tmp.Free
end

---

← →
Hatawa   (2003-07-13 19:07) [17]

Thanks за Create, что то я стормозила..

image1.Picture.Bitmap:=tmp.Bitmap;
не помогает..

CopyRect что-нибудь изменит?

---

← →
Hatawa   (2003-07-13 19:12) [18]

2Семен Сорокин:

спасибо, дергается меньше, но дергается.. :(

---

← →
Семен Сорокин ©   (2003-07-13 19:19) [19]

Hatawa (13.07.03 19:12)
можно попробовать отрисовывать только выделяемую область...
image1.Picture.Bitmap:=tmp;
надо тоже CopyRect использовать, попробуй - может еще лучше будет

---

← →
Hatawa   (2003-07-13 19:37) [20]

теперь когда работаем с большим рисунком прорисовка начинает тормозить..

---

← →
Семен Сорокин ©   (2003-07-13 19:43) [21]

Hatawa (13.07.03 19:37)
как вариант: возьми TShape с Brush.Style = bsClear - вообще моргать не будет :))
и растягивай его - будет как выделение

---

← →
Hatawa   (2003-07-13 19:47) [22]

поясни, плиз, как с ним работать?

---

← →
Семен Сорокин ©   (2003-07-13 19:55) [23]

кидаешь на форму TShape, выставляешь Brush.Style = bsClear, делаешь Visible = false
отлавливаешь сообщение нажатия кнопки на рисунке - ставишь SetBounds TShape"а - в эту точку, и делаешь его видимым, по мере перетаскивания изменяешь его размеры (Left, Top, Width, Height) - ведешь за мышкой, как только кнопку отжали - скрываешь и все :)

---

← →
Hatawa   (2003-07-13 20:02) [24]

спасибо, попробую :)

---

← →
Hatawa   (2003-07-13 20:11) [25]

прикольно!!!!! :)

это лучше, вот только он периодически закрашивается...:(

---

← →
Семен Сорокин ©   (2003-07-13 20:13) [26]

чем закрашивается?

---

← →
Hatawa   (2003-07-13 20:17) [27]

черная граница => черным цветом периодически закрашивается при движении мыши..

---

← →
Семен Сорокин ©   (2003-07-13 20:18) [28]

Application.ProcessMessages вставь после изменения размеров

---

← →
Hatawa   (2003-07-13 20:25) [29]

не помогает..

---

← →
Hatawa   (2003-07-13 20:35) [30]

блин, закрашивается и все тут.. что ни делай - не помогает :(

---

← →
Hatawa   (2003-07-14 13:20) [31]

есть ли кроме Application.ProcessMessages еще какой-нить метод борьбы?

---

← →
Семен Сорокин ©   (2003-07-14 13:49) [32]

Hatawa (14.07.03 13:20)
код покажи

---

← →
Hatawa   (2003-07-14 14:10) [33]


Sh.SetBounds(StartPlace.X, StartPlace.Y,
Endplace.X-StartPlace.X, Endplace.Y-StartPlace.Y);

Application.ProcessMessages;

---

← →
Семен Сорокин ©   (2003-07-14 14:14) [34]

Hatawa (14.07.03 14:10)
попробуй выполнять эту процедуру если:
if (Abs(StartPlace.X - Endplace.X) > 1) or
(Abs(StartPlace.Y - Endplace.Y) > 1) then
может поможет

---

← →
Hatawa   (2003-07-14 14:16) [35]

но мигает (закрашивается), когда рисуешь большие прямоуголиники...

---

← →
Семен Сорокин ©   (2003-07-14 14:25) [36]

не поленился - накидал код - ничё не тормозит :))
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Image1: TImage;
Shape1: TShape;
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
OldX, OldY: integer;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
OldX := X;
OldY := Y;
Shape1.SetBounds(X, Y, 1, 1);
Shape1.Visible := true;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
_rect: TRect;
begin
if X > OldX then begin
_rect.Left := OldX;
_rect.Right := X
end
else begin
_rect.Left := X;
_rect.Right := OldX
end;
if Y > OldY then begin
_rect.Top := OldY;
_rect.Bottom := Y
end
else begin
_rect.Top := Y;
_rect.Bottom := OldY
end;
Shape1.SetBounds(_rect.Left, _rect.Top,
_rect.Right - _rect.Left, _rect.Bottom - _rect.Top);
Application.ProcessMessages
end;

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

end.

---

← →
Hatawa   (2003-07-14 14:29) [37]

Спасибки большое!!! :)
сейчас попробую!..

---

← →
Hatawa   (2003-07-14 17:31) [38]

2Семен Сорокин:
Ты будешь смеяться, но мигает по-прежнему...

---

← →
Семен Сорокин ©   (2003-07-14 17:33) [39]

Hatawa (14.07.03 17:31)
буду :)), мыль - посмотрю

---

← →
Hatawa   (2003-07-14 18:41) [40]

Лови!

---

Страницы: 1 2 вся ветка

Скачать: CL | DM;



Память: 0.54 MB
Время: 0.01 c