delphi - Can I somehow "instrument" Graphics.TBitmapCanvas with overriden GetPixel/SetPixel methods, which are specific to TBitmap's canvas? -
as know, working tbitmap
's pixels (bitmap.canvas.pixels[x,y]
) slow in out-of-box vcl. has been caused getter , setter of pixels
property inherited tcanvas
, encapsulates general wingdi dc object , not specific memdc of bitmap.
for dib section-based bitmaps (bmdib
) well-known workaround exists, not see way integrate proper getter/setter in vcl tbitmap class (besides direct modification of library code, proven real pain in stern when comes compiling against different vcl versions).
please advise if there hackish way reach tbitmapcanvas
class , inject overriden methods it.
i'm sure done more elegantly, here's ask implemented using class helper crack private members:
unit bitmapcanvascracker; interface uses sysutils, windows, graphics; implementation procedure fail; begin raise eassertionfailed.create('fixup failed.'); end; procedure patchcode(address: pointer; const newcode; size: integer); var oldprotect: dword; begin if not virtualprotect(address, size, page_execute_readwrite, oldprotect) begin fail; end; move(newcode, address^, size); flushinstructioncache(getcurrentprocess, nil, 0); if not virtualprotect(address, size, oldprotect, @oldprotect) begin fail; end; end; type pinstruction = ^tinstruction; tinstruction = packed record opcode: byte; offset: integer; end; procedure redirectprocedure(oldaddress, newaddress: pointer); var newcode: tinstruction; begin newcode.opcode := $e9;//jump relative newcode.offset := nativeint(newaddress)-nativeint(oldaddress)-sizeof(newcode); patchcode(oldaddress, newcode, sizeof(newcode)); end; type tbitmapcanvas = class(tcanvas) // need implement class end; type tbitmaphelper = class helper tbitmap function newgetcanvas: tcanvas; class procedure patch; end; function tbitmaphelper.newgetcanvas: tcanvas; begin if self.fcanvas = nil begin self.handleneeded; if self.fcanvas = nil begin self.fcanvas := tbitmapcanvas.create; self.fcanvas.onchange := self.changed; self.fcanvas.onchanging := self.changing; end; end; result := self.fcanvas; end; class procedure tbitmaphelper.patch; begin redirectprocedure(@tbitmap.getcanvas, @tbitmap.newgetcanvas); end; initialization tbitmap.patch; end.
include unit in project , tbitmap
class patched getcanvas
method redirects newgetcanvas
, allows implement own tcanvas
subclass.
i don't think code work if using runtime packages sort out need use more capable hooking code.
Comments
Post a Comment