Версия для печати
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум на Исходниках.RU > 32-битные компиляторы > FPC/FCL/FPImage


Автор: e-moe 04.01.07, 10:34
FPC 2.0.4 win32
<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>
    {$mode objfpc}{$H+}
     
    uses FPWritePNG,
         {$ifndef UseFile}classes,{$endif}
         FPImage,FPImgCanv, sysutils;
     
    var Img : TFPMemoryImage;
        Canvas : TFPImageCanvas;
        Writer : TFPCustomimageWriter;
     
    procedure Init;
    begin
      Writer := TFPWriterPNG.Create;
      img := TFPMemoryImage.Create(0,0);
      img.UsePalette:=false;
      img.SetSize(100,100);
      canvas := TFPImageCanvas.Create(img);
     
      canvas.brush := canvas.CreateBrush;
      canvas.brush.fpcolor:=FPColor(255,0,255);
      canvas.FloodFill(50,50); // Как залить поле заданным цветом?
     
      canvas.pen := canvas.createpen;
      canvas.pen.fpcolor := colGreen;
      canvas.line(0,0,10,10);
     
      canvas.font := canvas.CreateFont;
      canvas.font.name := 'Arial';
      canvas.font.size := 10;
      canvas.font.FPColor := colBlue;
      canvas.TextOut(10,10,'Hello'); // На этой строке runtime error :(
    end;
     
    procedure WriteImage;
    var t: string;
    begin
      t := ''; // параметры для сохранения файла
      with (Writer as TFPWriterPNG) do
        begin
          Grayscale := pos ('G', t) > 0;
          Indexed := pos ('I', t) > 0;
          WordSized := pos('W', t) > 0;
          UseAlpha := pos ('A', t) > 0;
        end;
      img.SaveToFile ('tmp.png', Writer);
    end;
     
    procedure Clean;
    begin
      Writer.Free;
      Canvas.Free;
      Img.Free;
    end;
     
    begin
        try
          Init;
          WriteImage;
          Clean;
        except
          on e : exception do
            writeln ('Error: ',e.message);
        end;
    end.

Автор: Romtek 05.01.07, 14:10
Google выдал первую ссылку: http://lists.freepascal.org/lists/fpc-pascal/2004-April/006915.html
<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>
    uses fpimage,fpcanvas,fpwritepng, fpwritejpeg,fpimgcanv;
     
    Var
      Image : TFPMemoryImage;
      Canvas : TFPimageCanvas;
     
    begin
      // Create image,
      Image:=TFPMemoryImage.Create(640,480);  // установка размера здесь
      Image.UsePalette:=False;
      // Create canvas.
      Canvas:=TFPImageCanvas.Create(Image);
      Canvas.Pen.Color:=colRed;
      Canvas.Ellipse(50,50,150,150);
      Canvas.Rectangle(50,50,150,150);
      // Free canvas
      Canvas.Free;
      Image.SaveToFile('myfile.png',TFPWriterPNG.Create); // Write as png
      Image.SaveToFile('myfile.jpg',TFPWriterPNG.Create); // Alternatively, write as jpg
      // Free Image.
      Image.Free;
    end.

Думаю, что установка фона делается проще, чем сложным алгоритмом заливки FloodFill...
Что-то не нашёл в документации описания класса TFPImageCanvas. :unsure:

Автор: volvo877 05.01.07, 15:17
Однако, в исходниках модуля FPImgCanv (а точнее, FPPixlCanv) мною был встречен вот такой фрагмент:

<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>
    procedure TFPPixelCanvas.DoTextOut (x,y:integer;text:string);
    begin
      NotImplemented;
    end;


А ведь именно эта функция вызывается при попытке вызвать
<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>
    canvas.TextOut(10,10,'Hello');

Автор: e-moe 05.01.07, 18:09
Romtek, линии оно и у меня прекрасно рисует если закоментировать вывод текста.. И размер тоже правильно устанавливается...
А вот с текстом облом получается... Будем ждать новых версий...

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

Автор: e-moe 03.04.07, 14:41
Цитата itwork @
иЛИ КАК вы сами ихизучали??? :)

я по исходникам смотрел...

Автор: itwork 03.04.07, 14:53
КАК на ФРИ сделать генерация чисел в картинку!(обычно такое делается для сайта против ботов(походу ))??? былоб хорошо если у кого есть какой пример

Автор: e-moe 03.04.07, 17:46
Цитата
What is the GD library? GD is an open source code library for the dynamic creation of images by programmers. GD is written in C, and "wrappers" are available for Perl, PHP and other languages. GD creates PNG, JPEG and GIF images, among other formats. GD is commonly used to generate charts, graphics, thumbnails, and most anything else, on the fly. While not restricted to use on the web, the most common applications of GD involve web site development.

есть модули и для паскаля ;)

Автор: tm2studio 11.04.07, 13:58
Цитата itwork @
КАК на ФРИ сделать генерация чисел в картинку!(обычно такое делается для сайта против ботов(походу ))??? былоб хорошо если у кого есть какой пример

У меня есть пример на РНР, если нужен - могу выложить.

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

Сейчас переведем LCL-Help а там и до RTL с FPL доберемся ;) .

Автор: apexcol 18.12.17, 03:13
Hi, here's the correct code for that, sorry for being years late, but I only did it some minutes ago... ;)

<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>
    procedure TForm1.Button5Click(Sender: TObject);
    var
      CY: TFPImageBitmap;
      i, j: Integer;
      Intf: TLazIntfImage;
    begin
      CY := TPNGImage.Create;
      CY.PixelFormat := pf32bit;
      CY.Canvas.Brush.FPColor:=colTransparent;
      CY.SetSize(300,300);
      CY.Canvas.FillRect(0,0,CY.Width-1,CY.Height-1);
      try
    //    CY.LoadFromFile('c:\proof.png');
        CY.Canvas.Brush.Style := bsClear;
        CY.Canvas.Pen.FPColor := ColRed;
        CY.Canvas.Pen.Width := 10;
        CY.Canvas.Ellipse(10,10,100,100);
        with CY.Canvas.Font do begin
            FPColor := ColBlue;
            PixelsPerInch := 300; /// always before height!
            Height := 32;
            Orientation := 1800;
            Name := 'PlayBill';
            Quality := fqCleartypeNatural;
        end;
     
        CY.Canvas.Brush.Style := bsImage;
        CY.Canvas.TextOut(230,230,'apexcol@gmail.com!');
     
        /// The plain bitmap has no Alpha, so we have
        /// to create an IntfImage, which passes the
        /// actual Canvas into an ABGR format that we
        /// control with TColors property.  After putting
        /// all the painted things the $FF on the Alpha
        /// position, we pass it back to the CY.Canvas
        Intf:=CY.CreateIntfImage;
        for i:=0 to pred(CY.Width) do
          for j:=0 to pred(CY.Height) do
            if Intf.TColors[i,j] > 0 then
              Intf.TColors[i,j]:=Intf.TColors[i,j] or $FF000000;
        CY.LoadFromIntfImage(Intf);
     
        Canvas.Draw(510,10,CY);
        CY.SaveToFile('pruebaPNG.png');
      finally
        CY.Free;
        Intf.Free;
      end;
    end;

Powered by Invision Power Board (https://www.invisionboard.com)
© Invision Power Services (https://www.invisionpower.com)