paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-11 13:19:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

customdrawnws: A small fix for XCreateImage and adds a profiler: The profiler shows that XPutImage is so slow as to be unusable

Browse Source 
git-svn-id: trunk@33697 -
This commit is contained in:
sekelsenmat 2011-11-22 16:22:17 +00:00
parent 81705e60b8
commit 62709dc69a
3 changed files with 32 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
lcl/interfaces/customdrawn/customdrawnproc.pas
View File

@ -14,6 +14,7 @@ uses
GraphType, Controls, LCLMessageGlue, WSControls, LCLType, LCLProc;
procedure UpdateControlLazImageAndCanvas(var AImage: TLazIntfImage; var ACanvas: TLazCanvas; AWidth, AHeight: Integer);
function DateTimeToMilliseconds(aDateTime: TDateTime): Int64;
implementation
@ -47,5 +48,15 @@ begin
{$ENDIF}
end;
function DateTimeToMilliseconds(aDateTime: TDateTime): Int64;
var
TimeStamp: TTimeStamp;
begin
{Call DateTimeToTimeStamp to convert DateTime to TimeStamp:}
TimeStamp:= DateTimeToTimeStamp (aDateTime);
{Multiply and add to complete the conversion:}
Result:= TimeStamp.Time;
end;
end.

2
lcl/interfaces/customdrawn/customdrawnwsforms.pp
View File

@ -35,6 +35,8 @@ uses
{$ifdef CD_Windows}Windows, WinProc,{$endif}
{$ifdef CD_Cocoa}MacOSAll, CocoaAll, CocoaPrivate, CocoaUtils,{$endif}
{$ifdef CD_X11}X, XLib, XUtil, XAtom, x11proc,{unitxft, Xft font support}{$endif}
// LazUtils
lazutf8sysutils,
// LCL
Controls, LCLType, Forms, LCLProc, GraphType, IntfGraphics, lazcanvas,
// Widgetset

19
lcl/interfaces/customdrawn/customdrawnwsforms_x11.inc
View File

@ -241,7 +241,13 @@ class procedure TCDWSCustomForm.DrawRawImageToGC(ARawImage: TRawImage;
ADestWindowInfo: TX11WindowInfo; ADestX, ADestY, ADestWidth, ADestHeight: Integer);
var
Image: XLib.PXImage;
{$IFDEF VerboseCDPaintProfiler}
lTimeStart: TDateTime;
{$ENDIF}
begin
{$IFDEF VerboseCDPaintProfiler}
lTimeStart := NowUTC();
{$ENDIF}
(* {$IFDEF VerboseFPGUI}
WriteLn('>: DoDrawImageRect');
{$ENDIF}*)
@ -285,6 +291,9 @@ begin
// FreeMem(Image^.data);
// Image^.data := nil;
// XDestroyImage(Image);
{$IFDEF VerboseCDPaintProfiler}
DebugLn(Format('[TCDWSCustomForm.DrawRawImageToGC] Paint duration: %d ms', [DateTimeToMilliseconds(NowUTC() - lTimeStart)]));
{$ENDIF}
end;
class procedure TCDWSCustomForm.EvPaint(const AWinControl: TWinControl; AWindowInfo: TX11WindowInfo);
@ -293,7 +302,13 @@ var
lWidth, lHeight: Integer;
lBitmap, lMask: HBITMAP;
lRawImage: TRawImage;
{$IFDEF VerboseCDPaintProfiler}
lTimeStart: TDateTime;
{$ENDIF}
begin
{$IFDEF VerboseCDPaintProfiler}
lTimeStart := NowUTC();
{$ENDIF}
{$IFDEF VerboseCDWindow}
DebugLn(Format('[TCDWSCustomForm.EvPaint] AWindowInfo: %x', [PtrInt(AWindowInfo)]));
{$ENDIF}
@ -336,6 +351,10 @@ begin
// Now render it into the control
AWindowInfo.Image.GetRawImage(lRawImage);
DrawRawImageToGC(lRawImage, AWindowInfo, 0, 0, lWidth, lHeight);
{$IFDEF VerboseCDPaintProfiler}
DebugLn(Format('[TCDWSCustomForm.EvPaint] Paint duration: %d ms', [DateTimeToMilliseconds(NowUTC() - lTimeStart)]));
{$ENDIF}
end;
{------------------------------------------------------------------------------