На главную
ПРАВИЛА FAQ Помощь Участники Календарь Избранное DigiMania RSS
msm.ru
В этом разделе можно создавать темы, которые относятся к поколению 32-битных компиляторов.
Здесь решаются вопросы портирования кода из старого доброго Турбо Паскаля в FPC, TMT, VP, GPC компиляторы, а также особенностей программирования на них для Windows/Linux и других ОС.
Указывайте тип компилятора, его версию, а также платформу (Windows/Linux/..) компиляции, другими словами, Target.
Модераторы: volvo877
  
> FPC/FCL/FPImage, canvas.FloodFill/TextOut - как правильно?
    FPC 2.0.4 win32
    ExpandedWrap disabled
      {$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.
    user posted image
      Google выдал первую ссылку: http://lists.freepascal.org/lists/fpc-pascal/2004-April/006915.html
      ExpandedWrap disabled
        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:
        Однако, в исходниках модуля FPImgCanv (а точнее, FPPixlCanv) мною был встречен вот такой фрагмент:

        ExpandedWrap disabled
          procedure TFPPixelCanvas.DoTextOut (x,y:integer;text:string);
          begin
            NotImplemented;
          end;


        А ведь именно эта функция вызывается при попытке вызвать
        ExpandedWrap disabled
          canvas.TextOut(10,10,'Hello');
          Romtek, линии оно и у меня прекрасно рисует если закоментировать вывод текста.. И размер тоже правильно устанавливается...
          А вот с текстом облом получается... Будем ждать новых версий...
          user posted image
            Люди где можно почитать об Этих модулях (fpimage,fpcanvas,fpwritepng, fpwritejpeg,fpimgcanv)??
            иЛИ КАК вы сами ихизучали??? :)
              Цитата itwork @
              иЛИ КАК вы сами ихизучали??? :)

              я по исходникам смотрел...
              user posted image
                КАК на ФРИ сделать генерация чисел в картинку!(обычно такое делается для сайта против ботов(походу ))??? былоб хорошо если у кого есть какой пример
                  Цитата
                  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.

                  есть модули и для паскаля ;)
                  user posted image
                    Цитата itwork @
                    КАК на ФРИ сделать генерация чисел в картинку!(обычно такое делается для сайта против ботов(походу ))??? былоб хорошо если у кого есть какой пример

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

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

                    Сейчас переведем LCL-Help а там и до RTL с FPL доберемся ;) .
                      Hi, here's the correct code for that, sorry for being years late, but I only did it some minutes ago... ;)

                      ExpandedWrap disabled
                        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;
                      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                      0 пользователей:


                      Рейтинг@Mail.ru
                      [ Script Execution time: 0,1213 ]   [ 18 queries used ]   [ Generated: 23.09.19, 09:21 GMT ]