Как сделать буквы жирными

[noveek]

Здраствуйте, как сделать буквы или цифры или всё вместе на изображении толще или пожирнее ?

[Pavia]

У шрифта установить шрифт жирный и размер покрупнее.

 canvas.Font.Style:=[fsBold];

[noveek]

Сообщение от Pavia

У шрифта установить шрифт жирный и размер покрупнее.

 canvas.Font.Style:=[fsBold];

Это не то что я имею ввиду изображение уже содержит буквы или цифры нужно как то обрабатывать например

Из такого:

Сделать такое:

[BDA]

Гуглить в сторону dilate фильтра (https://docs.gimp.org/2.10/en/plug-in-dilate.html).

[noveek]

Сообщение от BDA

Гуглить в сторону dilate фильтра (https://docs.gimp.org/2.10/en/plug-in-dilate.html).

Нагуглил только одну обработка ну очень долгая даже похоже бесконечная =(

procedure Dilate(Bitmap:TBitmap;NoNeighbourhood:Integer);
var
X, Y: Integer;
Grayshade: Byte;
x1,y1,x2,y2,i,j :Integer;
begin
for Y:=0 to Bitmap.Height -1 do
for X:=0 to Bitmap.Height -1 do
begin
Grayshade := ColorToRGB(Bitmap.Canvas.Pixels[X, Y]);
if Grayshade = 255 then
begin
Y1:=Y-NoNeighbourhood;
Y2:=Y+NoNeighbourhood;
if Y1 <0 then Y1 :=0;
if Y2>=Bitmap.Height then Y2:=Bitmap.Height;
for i:=Y1 to Y2 do Bitmap.Canvas.Pixels[i, Y] :=
RGB(255,255,255);
end;
end;
X:=0;Y:=0;
with Bitmap do
while Y<=Height - 1 do
begin
X:=0;
while X<=Width - 1 do
begin
Grayshade := ColorToRGB(Canvas.Pixels[X, Y]);
if Grayshade = 255 then
begin
X1:=X-NoNeighbourhood;
X2:=X+NoNeighbourhood;
if X1 <0 then X1 :=0;
if X2>=Width then X2:=Width;
for i:=X1 to X2 do Bitmap.Canvas.Pixels[i, Y] :=RGB(255,255,255);
X:=X+NoNeighbourhood div 2 + 1;
end;
end;
Y:=Y+1;
end;
end;

[digitalis]

Не вникал сильно, но похоже, что "бесконечно" заложено в самом алгоритме. Я бы новый рисунок организовывал на новой битмапе, исходную использовал только как источник обсчитываемых точек.
Затея понятна: сделать более чёткой каптчу, чтоб потом её легче было распознавать программно. Я сам их тоже не люблю

[Arigato]

Сообщение от noveek

Из такого:
Сделать такое:

Набросал пример:

procedure BoldPixel(Canvas: TCanvas; x, y: Integer);
const r=3;
begin
  Canvas.Ellipse(x-r, y-r, x+r, y+r);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  bmp1, bmp2: TBitmap;
  x,y: integer;
begin
  bmp1:=TBitmap.Create;
  bmp1.LoadFromFile('992.bmp');
  bmp2 := TBitmap.Create;
  bmp2.Width:=bmp1.Width;
  bmp2.Height:=bmp1.Height;

  with bmp2.Canvas do begin
    Pen.Color := clBlack;
    Brush.Color := clBlack;
    Brush.Style := bsSolid;
  end;

  for x:=0 to bmp1.Width-1 do
    for y:=0 to bmp1.Height-1 do
      if bmp1.Canvas.Pixels[x,y]=clBlack then
        BoldPixel(bmp2.Canvas, x, y);

  bmp1.Free;
  bmp2.SaveToFile('993.bmp');
  bmp2.Free;

  ShowMessage('OK');
end;

[noveek]

Сообщение от digitalis

Не вникал сильно, но похоже, что "бесконечно" заложено в самом алгоритме. Я бы новый рисунок организовывал на новой битмапе, исходную использовал только как источник обсчитываемых точек.
Затея понятна: сделать более чёткой каптчу, чтоб потом её легче было распознавать программно. Я сам их тоже не люблю

Абсолютно точно работа с капчей и ИИ

[noveek]

Сообщение от Arigato

procedure BoldPixel(Canvas: TCanvas; x, y: Integer);
const r=3;
begin
Canvas.Ellipse(x-r, y-r, x+r, y+r);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
bmp1, bmp2: TBitmap;
x,y: integer;
begin
bmp1:=TBitmap.Create;
bmp1.LoadFromFile('992.bmp');
bmp2 := TBitmap.Create;
bmp2.Width:=bmp1.Width;
bmp2.Height:=bmp1.Height;

with bmp2.Canvas do begin
Pen.Color := clBlack;
Brush.Color := clBlack;
Brush.Style := bsSolid;
end;

for x:=0 to bmp1.Width-1 do
for y:=0 to bmp1.Height-1 do
if bmp1.Canvas.Pixels[x,y]=clBlack then
BoldPixel(bmp2.Canvas, x, y);

bmp1.Free;
bmp2.SaveToFile('993.bmp');
bmp2.Free;

ShowMessage('OK');
end;

Ерунда какая то и не работает

[BDA]

Сообщение от noveek

не работает

Работает и результирующая картинка очень близка к примеру.