paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-06 11:59:37 +01:00
Code Issues Packages Projects Releases Wiki Activity

CairoCanvas: refactored TranslateBufferByIntfImage->GraphicToARGB32 to be useful in other parts

Browse Source 
git-svn-id: trunk@40983 -
This commit is contained in:
jesus 2013-05-02 00:14:14 +00:00
parent 26c321819a
commit 807058aba7
1 changed files with 31 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
components/cairocanvas/cairocanvas.pas
View File

@ -160,6 +160,8 @@ type
procedure UpdatePageSize; override; procedure UpdatePageSize; override;
end; end;
function GraphicToARGB32(Source: TGraphic; buf: PByte): Boolean;
implementation implementation
uses uses
@ -181,6 +183,34 @@ begin
result := CAIRO_STATUS_WRITE_ERROR; result := CAIRO_STATUS_WRITE_ERROR;
end; end;
function GraphicToARGB32(Source: TGraphic; buf: PByte): Boolean;
var
p: PDWord;
x, y: Integer;
c: TFPColor;
Img: TLazIntfImage;
begin
Img := TRasterImage(Source).CreateIntfImage;
try
if Img.DataDescription.Format=ricfNone then begin
Result := False;
Exit;
end;
p := Pointer(buf);
for y := 0 to Source.Height-1 do begin
for x := 0 to Source.Width-1 do begin
c := Img.Colors[x, y];
p^ := Hi(c.alpha) shl 24 + Hi(c.red) shl 16 + Hi(c.green) shl 8 + Hi(c.blue);
inc(p);
end;
end;
finally
Img.Free;
end;
Result := True;
end;
{ TCairoPrinterCanvas } { TCairoPrinterCanvas }
procedure TCairoPrinterCanvas.SetPenProperties; procedure TCairoPrinterCanvas.SetPenProperties;
@ -1223,34 +1253,6 @@ begin
end; end;
procedure TCairoPrinterCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); procedure TCairoPrinterCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic);
function TranslateBufferByIntfImage(buf: PByte; W, H: Integer): Boolean;
var
p: PDWord;
x, y: Integer;
c: TFPColor;
Img: TLazIntfImage;
begin
Img := TRasterImage(SrcGraphic).CreateIntfImage;
try
if Img.DataDescription.Format=ricfNone then begin
Result := False;
Exit;
end;
p := Pointer(buf);
for y := 0 to H-1 do begin
for x := 0 to W-1 do begin
c := Img.Colors[x, y];
p^ := Hi(c.alpha) shl 24 + Hi(c.red) shl 16 + Hi(c.green) shl 8 + Hi(c.blue);
inc(p);
end;
end;
finally
Img.Free;
end;
Result := True;
end;
var var
sf: Pcairo_surface_t; sf: Pcairo_surface_t;
buf: PByte; buf: PByte;
@ -1271,7 +1273,7 @@ begin
try try
cairo_save(cr); cairo_save(cr);
//FillDWord(buf^, W*H, $00000000); //FillDWord(buf^, W*H, $00000000);
if not TranslateBufferByIntfImage(buf, W, H) then if not GraphicToARGB32(SrcGraphic, buf) then
Exit; Exit;
sf := cairo_image_surface_create_for_data(buf, CAIRO_FORMAT_ARGB32, W, H, W*4); sf := cairo_image_surface_create_for_data(buf, CAIRO_FORMAT_ARGB32, W, H, W*4);