
![]() |
Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
|
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[3.239.2.192] |
![]() |
|
Сообщ.
#1
,
|
|
|
FPC 2.0.4 win32
![]() ![]() {$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. |
![]() |
Сообщ.
#2
,
|
|
Google выдал первую ссылку: http://lists.freepascal.org/lists/fpc-pascal/2004-April/006915.html
![]() ![]() 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. ![]() |
![]() |
Сообщ.
#3
,
|
|
Однако, в исходниках модуля FPImgCanv (а точнее, FPPixlCanv) мною был встречен вот такой фрагмент:
![]() ![]() procedure TFPPixelCanvas.DoTextOut (x,y:integer;text:string); begin NotImplemented; end; А ведь именно эта функция вызывается при попытке вызвать ![]() ![]() canvas.TextOut(10,10,'Hello'); |
Сообщ.
#4
,
|
|
|
Romtek, линии оно и у меня прекрасно рисует если закоментировать вывод текста.. И размер тоже правильно устанавливается...
А вот с текстом облом получается... Будем ждать новых версий... |
Сообщ.
#5
,
|
|
|
Люди где можно почитать об Этих модулях (fpimage,fpcanvas,fpwritepng, fpwritejpeg,fpimgcanv)??
иЛИ КАК вы сами ихизучали??? ![]() |
Сообщ.
#6
,
|
|
|
Цитата itwork @ иЛИ КАК вы сами ихизучали??? ![]() я по исходникам смотрел... |
Сообщ.
#7
,
|
|
|
КАК на ФРИ сделать генерация чисел в картинку!(обычно такое делается для сайта против ботов(походу ))??? былоб хорошо если у кого есть какой пример
|
Сообщ.
#8
,
|
|
|
Цитата 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. есть модули и для паскаля ![]() |
Сообщ.
#9
,
|
|
|
Цитата itwork @ КАК на ФРИ сделать генерация чисел в картинку!(обычно такое делается для сайта против ботов(походу ))??? былоб хорошо если у кого есть какой пример У меня есть пример на РНР, если нужен - могу выложить. -Added Цитата itwork @ Люди где можно почитать об Этих модулях (fpimage,fpcanvas,fpwritepng, fpwritejpeg,fpimgcanv)?? иЛИ КАК вы сами ихизучали??? ![]() Сейчас переведем LCL-Help а там и до RTL с FPL доберемся ![]() |
Сообщ.
#10
,
|
|
|
Hi, here's the correct code for that, sorry for being years late, but I only did it some minutes ago...
![]() ![]() ![]() 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; |