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

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

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

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

Сообщение itwork » 02.04.2007 18:11:07

КАК на ФРИ сделать генерация чисел в картинку!(обычно такое делается для сайта против ботов(походу :)))??? былоб хорошо если у кого есть какой пример
itwork
новенький
 
Сообщения: 41
Зарегистрирован: 28.12.2006 14:32:28

Сообщение shade » 02.04.2007 18:46:42

С помошью лазаря можно было бы сделать что-то вроде этого
Код: Выделить всё
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...
Аватара пользователя
shade
энтузиаст
 
Сообщения: 879
Зарегистрирован: 21.02.2006 20:15:48
Откуда: http://shamangrad.net/

Сообщение itwork » 02.04.2007 19:11:44

:) Круто! Только еще хотелось бы узнать как на FREEpascal'e
itwork
новенький
 
Сообщения: 41
Зарегистрирован: 28.12.2006 14:32:28

Сообщение shade » 02.04.2007 20:29:49

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

Сообщение shade » 02.04.2007 21:29:35

Решил сам поковыряться с 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.
Аватара пользователя
shade
энтузиаст
 
Сообщения: 879
Зарегистрирован: 21.02.2006 20:15:48
Откуда: http://shamangrad.net/

Сообщение itwork » 03.04.2007 18:30:39

где можно почитать об Этих модулях (fpimage,fpcanvas,fpwritepng, fpwritejpeg,fpimgcanv)??
иЛИ КАК вы сами их изучали???
itwork
новенький
 
Сообщения: 41
Зарегистрирован: 28.12.2006 14:32:28

Сообщение shade » 03.04.2007 19:07:50

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 )
Аватара пользователя
shade
энтузиаст
 
Сообщения: 879
Зарегистрирован: 21.02.2006 20:15:48
Откуда: http://shamangrad.net/


Вернуться в Free Pascal Compiler

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2

Рейтинг@Mail.ru