Форум: "Основная";
Текущий архив: 2003.07.28;
Скачать: [xml.tar.bz2];
Вниз
Как сделать прям-к для выделения части картинки, чтобы она не... Найти похожие ветки
← →
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 вся ветка
Форум: "Основная";
Текущий архив: 2003.07.28;
Скачать: [xml.tar.bz2];
Память: 0.53 MB
Время: 0.01 c
