Рамка в Image и цвет пикселя в точке

← →
Дмитрий_177 (2006-01-27 20:40) [0]

У меня на форме лежит Image, свойство Center := true;, т.е. изображение рисуется в центре... Загружаю в Image изображение:
if OpenDialog1.Execute then begin Image1.Picture.LoadFromFile(OpenDialog1.FileName); end;
у меня два вопроса:
1. как мне загруженное изображение обвести рамкой церным цветом в Image?
2. как сделать так, чтобы если кликнуть мышкой по изображению в Image узнать цвет пикселя, по которому мы кликнули? и еще чтобы это было только по изображению... если по той же рамке(которой обводим изображение) или по Image, но где нету изображения, чтобы не определялся цвет...

← →
Eraser © (2006-01-27 21:56) [1]

> Дмитрий_177 (27.01.06 20:40)

> 1. как мне загруженное изображение обвести рамкой церным
> цветом в Image?

Image1.Picture.Bitmap.Canvas.Brush.Style := bsClear; Image1.Picture.Bitmap.Canvas.Rectangle(0, 0, Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Height);

> 2. как сделать так, чтобы если кликнуть мышкой по изображению
> в Image узнать цвет пикселя, по которому мы кликнули? и
> еще чтобы это было только по изображению... если по той
> же рамке(которой обводим изображение) или по Image, но где
> нету изображения, чтобы не определялся цвет...

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var MyColor: TColor; w, h: integer; begin w := Image1.Picture.Bitmap.Width; h := Image1.Picture.Bitmap.Height; if (x > (Image1.Width div 2 - w div 2)) and (x < (Image1.Width div 2 + w div 2)) and (y > (Image1.Height div 2 - h div 2)) and (y < (Image1.Height div 2 + h div 2)) then begin MyColor := Image1.Picture.Bitmap.Canvas.Pixels[x - Image1.Width div 2 + w div 2, y - Image1.Height div 2 + h div 2]; end; end;

← →
Дмитрий_177 (2006-01-27 22:32) [2]

Спасибо большое! Но вот насчет рамки... рисуется она всетаки поверх изображения которое уже загружено, точнее поверх крайних точек, но надо чтобы как-бы за ними... т.к.
Image1.Picture.Bitmap.Canvas.Rectangle(0, 0, Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Height);
а по идее нужно:
Image1.Picture.Bitmap.Canvas.Rectangle(-1, -1, Image1.Picture.Bitmap.Width+1, Image1.Picture.Bitmap.Height+1);
но так рамка вообще не рисуется...
следственно от сюда когда начинаем определять цвет пикселя в каком-то месте, рамка тоже "считается" как изображение и если кликнуть по рамке выдает черный цвет, что бы не хотелось... И еще вопрос в тему... Как бы менять сам курсор на любой другой, когда он находится именно над изображением?

← →
Eraser © (2006-01-27 23:45) [3]

> Дмитрий_177 (27.01.06 22:32) [2]

Значит надо вручную прорисовывать через OnPaint...
думаю реализовать сможешь, а то у меня энтузиазм закончился )

← →
Eraser © (2006-01-27 23:48) [4]

> Дмитрий_177 (27.01.06 22:32) [2]

> И еще вопрос в тему... Как бы менять сам курсор на любой
> другой, когда он находится именно над изображением?

OnMouseMove
Screen.Cursor

← →
Дмитрий_177 (2006-01-28 17:58) [5]

А события OnPaint нету в Image. Как бы мне его сделать? А еще я заметил этот код не работает с jpg изображениями, хотя модуль Jpeg я прописал в uses. Хотелось что бы и с jpg изображениями так же было...

← →
Eraser © (2006-01-28 20:03) [6]

> Дмитрий_177 (28.01.06 17:58) [5]

> А события OnPaint нету в Image.

А где есть? :)

> А еще я заметил этот код не работает с jpg изображениями,
> хотя модуль Jpeg я прописал в uses.

Вывод?

← →
Дмитрий_177 (2006-01-28 23:53) [7]

попробовал сделать так, создать свой компонент:
type TBorderImage = class(TImage) protected procedure WMPaint(var Message: TWMPAINT); Message WM_PAINT; end; procedure TBorderImage.WMPaint(var message: TWMPaint); begin if Picture <> nil then begin Picture.Bitmap.Canvas.Rectangle(- 1, - 1, Picture.Bitmap.Width + 1, Picture.Bitmap.Height + 1); end; end;
но как только я ложу на форму такой Image, он постоянно перерисовывается в момент проектирования формы, это заметно сразу... подскажите что я не так сделал?

← →
Eraser © (2006-01-29 01:31) [8]

> Дмитрий_177 (28.01.06 23:53) [7]

ну зачем же свой компонент? )
просто в OnPaint формы необходимо вписать код, который будет рисовать прямоугольник вокруг изображения в TImage.

← →
Дмитрий_177 (2006-01-29 02:25) [9]

procedure TForm1.FormPaint(Sender: TObject);
begin
if Image1.Picture <> nil then
begin
Image1.Picture.Bitmap.Canvas.Brush.Style := bsClear;
Image1.Picture.Bitmap.Canvas.Rectangle(- 1, - 1, Image1.Picture.Bitmap.Width + 1, Image1.Picture.Bitmap.Height + 1);
end;
end;

а так тоже постоянно перерисовыватся Image... и еще почему-то кнопки которые на форме тоже не рисуются... но если кликнуть по тому месту где примерно находится кнопка, то она срабатывает, точнее ее событие OnClick

← →
Дмитрий_177 (2006-01-29 16:51) [10]

Мне кажется это из за того, что сначала происходит перерисовка при нарисовке изображения:
if OpenDialog1.Execute then begin Image1.Picture.LoadFromFile(OpenDialog1.FileName); end;
а потом когда мы рисуем рамку, опять происходит перерисовка... И что делать?

← →
Набережных С. © (2006-01-29 18:14) [11]

> Дмитрий_177 (29.01.06 16:51) [10]

> И что делать?

Сначала загрузить из файла в отдельный Bmp: TBitmap. Затем у Image.Picture.Bitmap установить размеры, равные размерам Bmp + поля на рамку. Затем в Image.Picture.Bitmap нарисовать рамку и скопировать в него рисунок из Bmp в прямоугольник внутри нарисованной рамки. Потом промежуточный Bmp можно уничтожить, а можно оставить для дальнейших подобных действий.

← →
Дмитрий_177 (2006-01-29 19:42) [12]

procedure TForm1.Button1Click(Sender: TObject); var Bmp: TBitmap; begin if OpenDialog1.Execute then begin Bmp := TBitmap.Create; Bmp.LoadFromFile(OpenDialog1.FileName); Image1.Picture.Bitmap.Width := Bmp.Width + 2; Image1.Picture.Bitmap.Height := Bmp.Height + 2; Image1.Picture.Bitmap.Rectangle(0, 0, Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Height);
начал делать так... а какой функцией скопировать bmp?

Bitmap.Canvas.Draw
Bitmap.Canvas.CopyRect
BitBlt(), передав в качестве параметров HDC Bitmap.Canvas.Handle.
Думаю, в данном случае первая - самая подходящая.

← →
Дмитрий_177 (2006-01-29 21:33) [14]

Что-то наподобии сотворил что хотел... Прошу любить и жаловать:
uses Jpeg; var l, r, t, b: integer; procedure TForm1.Button1Click(Sender: TObject); var Pict: TPicture; w, h: integer; begin if OpenDialog1.Execute then begin Pict := TPicture.Create; Pict.LoadFromFile(OpenDialog1.FileName); with Image1.Picture.Bitmap do begin Width := Pict.Graphic.Width + 2; Height := Pict.Graphic.Height + 2; Canvas.Rectangle(0, 0, Width, Height); Canvas.Draw(1, 1, Pict.Graphic); end; Pict.Free; with Image1 do begin w := Picture.Bitmap.Width - 2; h := Picture.Bitmap.Height - 2; l := (ClientWidth - w) div 2 - 1; r := l + w + 1; t := (ClientHeight - h) div 2 - 1; b := t + h + 1; end; end; end; procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if (x > l) and (x < r) and (y > t) and (y < b) then Screen.Cursor := crCross else Screen.Cursor := crDefault; end; procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (x > l) and (x < r) and (y > t) and (y < b) then Panel1.Color := Image1.Picture.Bitmap.Canvas.Pixels[x - l, y - t]; end;

так и с bmp и с jpg работает, если я чтонибудь неправильно сделал подскажите пожалуйста...)))

> Дмитрий_177 (29.01.06 21:33) [14]

> if (x > l) and (x < r) and (y > t) and (y < b)

PtInRect :)

← →
Дмитрий_177 (2006-01-31 00:03) [16]

с этой функцией быстрее работать будет?

> с этой функцией быстрее работать будет?

Нет. Но смотрится куда красивее.

> l, r, t, b: integer;

Старайся давать переменным понятные имена. Чем понятнее, тем лучше.

> Pict := TPicture.Create;
> Pict.LoadFromFile(OpenDialog1.FileName);
>
...
>
> Pict.Free;

В таких случаях нужно применять try.finally, чтобы память, выделенная под объект корректно освободилась, даже в случае, если произойдет исключение.
Pict := TPicture.Create; try Pict.LoadFromFile(OpenDialog1.FileName); ... finally Pict.Free; end;

Ну и компонентам тоже нужно давать нормальные имена.

Рамка в Image и цвет пикселя в точке Найти похожие ветки