как сделать ТImage круглым....

[firmwares]

Доброе время суток...

Собственно вопрос!
Как модно сделать ТImage круглым?
Или как можно сохранять из ТImage круглое изобрежение
с заданными размерами?

Всем заранее большое спасибо!!!

[mihali4]

Впишите саму картинку в круг на прозрачном фоне...

[Altera]

А я вообще не понял что значит "круглое изображение". Изображение не может быть круглым. Просто может быть область за изображением круга, пиксели которой имеют значение альфа канала равное 255

[SERG1980]

Можно так попробовать

procedure TForm1.Button1Click(Sender: TObject);
begin
image1.Canvas.Brush.Style:=bsClear;
image1.Canvas.Pen.Color:=clred;
image1.Canvas.Ellipse(5,5,image1.Width-5,image1.Height-5);
image1.Canvas.Brush.Style:=bsSolid;
image1.Canvas.FloodFill(3,3,clred,fsborder);
image1.Transparent:=true;
image1.Picture.SaveToFile('d:\1.bmp');
end;

[firmwares]

Доброго времени суток!
Чтобы все встало на свои места, я решил уточнить, что именно необходимо получить!
Дело в том, что мне необходимо сделвть захват изображения и потом его распечатать. Если я буду делать снимок в квадратном варианте, то у меня получаются черные углы, которые мне ни к чему в связи с большим расходом тонера. Так вот как можно сделать так, чтобы этих углов у меня небыло???

Всем заранее спасибо!

[firmwares]

Вот пример того, что я хочу получить!!!!
За фото прошу прощения (понимаю, что отвратитульно)

[raxp]

...способ конечно не ахти, Вован-бы думаю чего-нить лучше предложил, но... вот как вариант - расположите панель (цвет- белый), на ней ваш image и обрежьте панель регионом:

procedure MakeRounded(Control: TWinControl);
var R: TRect;
    Rgn: HRGN;
begin
 with Control do begin
  R := ClientRect;
  rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, width, width); // для окружности поиграйтесь p5,p6
  Perform(EM_GETRECT, 0, lParam(@r));
  InflateRect(r, 0, 0);
  Perform(EM_SETRECTNP, 0, lParam(@r));
  SetWindowRgn(Handle, rgn, True);
  Invalidate
 end
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
 MakeRounded(panel2);
end;

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

[Kotofff]

Еще как вариант. Прикрепил.

[raxp]

Kotofff, +1...
...и генерить маску можно сразу на ходу.

[DeKot]

Вот еще вариант:

var
  Form1: TForm1;
  fRgn:  HRGN;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  fRgn:= CreateEllipticRgn(0,0,500,500);
//В CreateEllipticRgn(0,0,500,500);  можно вставить любой регион
end;

procedure TForm1.FormPaint(Sender: TObject);
var bmp: TBitmap;
begin
bmp := TBitmap.Create;
try
  bmp.LoadFromFile ('Screen.bmp');
  Canvas.Brush.Bitmap := bmp;
  PaintRgn (Canvas.Handle, fRgn);
  FrameRgn (Canvas.Handle, fRgn, Canvas.Brush.Handle, 2, 2);
finally
   Canvas.Brush.Color := clBlack;
   Canvas.Brush.Bitmap := nil;
   bmp.Free;
end;
end;

end.

Скрин:

Есно, файл 'Screen.bmp' подставляете свой.