генерация чисел в картинку???

Вопросы программирования на Free Pascal, использования компилятора и утилит.

Модератор: Модераторы

Ответить
itwork
новенький
Сообщения: 41
Зарегистрирован: 28.12.2006 13:32:28

генерация чисел в картинку???

Сообщение itwork »

КАК на ФРИ сделать генерация чисел в картинку!(обычно такое делается для сайта против ботов(походу :)))??? былоб хорошо если у кого есть какой пример
Аватара пользователя
shade
энтузиаст
Сообщения: 879
Зарегистрирован: 21.02.2006 19:15:48
Откуда: http://shamangrad.net/
Контактная информация:

Сообщение shade »

С помошью лазаря можно было бы сделать что-то вроде этого

Код: Выделить всё

uses Classes, Graphics;

var
  bmp: TBitmap;
  strm: TStringStream;
begin
  bmp := TBitmap.Create;
  bmp.Width := 100;
  bmp.Height := 40;
  with bmp, Canvas do
  begin
    Brush.Color := clWhite;
    Brush.Style := bsSolid;
    FillRect(0, 0, 100, 100);
    font.Color := clBlack;
    font.Height := - 20;
    TextOut(10, 10, '123456');
  end;
  strm := TStringStream.Create;
  bmp.SaveToStream(strm);
  writeln('Content-type: image/bmp');
  writeln;
  write( strm.DataString );
  bmp.free;
  strm.free;
end.

Но вместо bmp лучше использовать какой-нибудь другой формат, например PNG...
itwork
новенький
Сообщения: 41
Зарегистрирован: 28.12.2006 13:32:28

Сообщение itwork »

:) Круто! Только еще хотелось бы узнать как на FREEpascal'e
Аватара пользователя
shade
энтузиаст
Сообщения: 879
Зарегистрирован: 21.02.2006 19:15:48
Откуда: http://shamangrad.net/
Контактная информация:

Сообщение shade »

Почти также, только см. fcl: fpimage или что-то типа того...
Аватара пользователя
shade
энтузиаст
Сообщения: 879
Зарегистрирован: 21.02.2006 19:15:48
Откуда: http://shamangrad.net/
Контактная информация:

Сообщение shade »

Решил сам поковыряться с fpimage
TextOut пока (у меня fpc 2.1.1) не реализован, поэтому отрисовку текста прийдеться эмулировать, ну или дописывать fppixlcanv.pp

Так что ограничился примитивной графикой (отрисовка элипса оставляет желать лучшего :( )

Код: Выделить всё

program test;

{$MODE OBJFPC}

uses SysUtils, Classes, fpimage, fpwritepng, FPCanvas, FPImgCanv;

procedure SavePNGToStream(Stream: TStream; img: TFPCustomImage);
var writer: TFPWriterPNG;
begin
  writer := TFPWriterPNG.Create;;
  try
    writer.indexed := false;
    writer.wordsized := false;
    writer.UseAlpha := false;
    writer.GrayScale := false;
    img.SaveToStream(Stream, writer);
  finally
    writer.free;
  end;
end;

procedure SavePNGToFile(const FileName: string; img: TFPCustomImage);
var Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SavePNGToStream(Stream, img);
  finally
    Stream.Free;
  end;
end;

var
  img: TFPMemoryImage;
  Canvas: TFPImageCanvas;
begin
  img := TFPMemoryImage.Create(100, 40);
  Canvas := TFPImageCanvas.Create (img);

  with Canvas do
  begin
    Pen.Style := psSolid;
    Pen.Width := 1;
    Pen.FPColor := colBlack;
    Brush.FPColor := colWhite;
    Brush.Style := bsSolid;
    font.FPColor := colBlack;
    font.Size := 20;

    Rectangle(0, 0, 99, 39);
    Ellipse(0,0, 99, 39);
  end;

  img.Colors[10, 10] := colWhite;

  SavePNGToFile('test.png', img);

  Canvas.free;
  img.Free;
end.
itwork
новенький
Сообщения: 41
Зарегистрирован: 28.12.2006 13:32:28

Сообщение itwork »

где можно почитать об Этих модулях (fpimage,fpcanvas,fpwritepng, fpwritejpeg,fpimgcanv)??
иЛИ КАК вы сами их изучали???
Аватара пользователя
shade
энтузиаст
Сообщения: 879
Зарегистрирован: 21.02.2006 19:15:48
Откуда: http://shamangrad.net/
Контактная информация:

Сообщение shade »

itwork писал(а):где можно почитать об Этих модулях (fpimage,fpcanvas,fpwritepng, fpwritejpeg,fpimgcanv)??
иЛИ КАК вы сами их изучали???

Я их не изучал, приведенный листинг это мой первы опыт работы с данными модулями, а узнал я о них на этом же форуме ( http://freepascal.ru/forum/viewtopic.php?t=2154 )
А дальше копался в исходниках FPC 2.1.1 ( Download Daily Source Snapshot of Development Tree http://freepascal.org/develop.var )
Ответить