Functions Delphi

Title: Convert method pointers into function pointers?
//Convertingmethodpointersintofunctionpointers
//Oftenyouneedafunctionpointerforacallbackfunction.Butwhat,ifyouwanttospecifyamethodas
//ancallback?Convertingamethodpointertoafunctionpointerisnotatrivialtask;bothtypesare
//incomatiblewitheachother.Althoughyouhavethepossibilitytoconvertlikethis"@TClass.SomeMethod",
//thisismoreahackthanasolution,becauseitrestrictstheuseofthismethodtosomekindofaclass
//function,whereyoucannotaccessinstancevariables.Ifyoufailtodoso,you'llgetawonderfulgpf.
//Butthereisabettersolution:runtimecodegeneration!Justallocateanexecuteablememoryblock,and
//write4machinecodeinstructionsintoit:2instructionsloadsthetwopointersofthemethodpointer
//(code&data)intotheregisters,onecallsthemethodviathecodepointer,andthelastisjustareturn
//Nowyoucanusethispointertotheallocatedmemoryasaplainfuntionpointer,butinfactyouare
//callingamethodforaspecificinstanceofaClass.
//MethodenzeigerinFunktionszeigerumwandeln
//Oftistesntig,einerAPI-FunktioneinenFunktionszeiger,deraufeineCallbackfunktionzeigt,zu
//bergeben.LeideristeinFunktionszeigermitMethodenzeigerninkompatibel,undsoisteszunchst
//unmglich,eineMethodealsCallbackanzugeben.
//MankannzwareinenMethodenzeigeraufdieArt"@TKlasse.EineMethode"ineinenFunktionszeigercasten,
//allerdingsdarfmandannindieserMethodedannaufkeineVariablen(undauchaufMethoden,diediese
//Variablenbenutzen)derKlassezugreifen,dadieseimmerInstanzgebundensindundmanindiesemFalle
//keineInstanzangegebenhat(hnlicheinerKlassenmethode).
//EsgibtaberauchnocheinenbesserenWeg,denCastzuvollziehen,ohneirgendwelcheEinschrnkungen
//hinzunehmen:
//EinMethodenzeigeristimGrundenichtsanderesalseinrecordauszweiZeigern,einerzeigtaufdie
//MethodeinderKlasse,deranderezeigtaufdieInstanz,frdiedieseMethodeaufgerufenwerdensoll.
//EinMethodenaufruffunktioniertinDelphiso:EswirddieMethodemithilfedeserstenZeigersaufgerufen,
//ganzwieeinnormalerFunktionsaufruf.AllerdingswirdderzweiteZeigerals"versteckter"Parameter
//mitgegeben,erfindetsichauchinderVariable"Self"wieder,dieinjederMethodezurVerfgungsteht.
//JedeZuweisungenanVariablenderInstanzgehenberdiesenZeigeraufdieDatenderInstanz.
//UmnuneineMethodefreinebestimmteInstanzbereinen"normalen"Funktionspointeraufzurufen,
//kannmandaherfolgendestun:ManlegteinenausfhrbarenSpeicherbereichan,undschreibtindiesen
//4Maschinencodeanweisungen:2davonenthaltendiebeidenPointer(alsKonstanten,dieineinRegister
//geschriebenwerden,1denAufrufderMethode,und1dieReturn-Anweisung.DenZeigeraufden
//SpeicherbereichkannmannunalsnormalenFunktionspointerverwenden,derdieMethodefreineganz
//bestimmteInstanzaufruft.
//
//Update19.03.2003:
//NunkanndieseFunktionjedeMethodeineineentsprechendeFunktionoderProzedur
//umwandeln.EsgeltenallerdingsfolgendeEinschrnkungen:
//-DieMethodeMUSSalsSTDCALLdeklariertsein.(DiesmachtinsofernSinn,daalle
//Windows-ApisaufdieseAufrukonventionverwenden.)
//DerresultierendePointerzeigtebensoaufeinemitstdcallaufzurufende
//FunktionoderProzedur.
//-NICHTkompatibelsindMethoden,derenRckgabewertvomtypstring,dynamicarray,
//methodpointer,oderVariantist.
typeTMyMethod=procedureofobject;
functionMakeProcInstance(M:TMethod):Pointer;
begin
//allocatememory
GetMem(Result,15);
asm
//MOVECX,
MOVBYTEPTR[EAX],$B9
MOVECX,M.Data
MOVDWORDPTR[EAX+$1],ECX
//POPEDX
MOVBYTEPTR[EAX+$5],$5A
//PUSHECX
MOVBYTEPTR[EAX+$6],$51
//PUSHEDX
MOVBYTEPTR[EAX+$7],$52
//MOVECX,
MOVBYTEPTR[EAX+$8],$B9
MOVECX,M.Code
MOVDWORDPTR[EAX+$9],ECX
//JMPECX
MOVBYTEPTR[EAX+$D],$FF
MOVBYTEPTR[EAX+$E],$E1
end;
end;
procedureFreeProcInstance(ProcInstance:Pointer);
begin
//freememory
FreeMem(ProcInstance,15);
end;
//AmEndesolltemannatrlichnichtvergessen,denbelegtenSpeicherauchwiederfreizugeben.
//"TMyMethod"kannmannatrlichauchdenBedrfnissenentsprechendabndern,
//z.B.mitParameternfreineWindowProcversehen.
//Afterall,youshouldnotforgettoreleasetheallocatedmemory.
//"TMyMethod"canbemodifiedaccordingyourspecificneeds,e.g.addsomeparametersforaWindowProc.
//N.B.:Yes,Iknow,Delphihasthose"MakeProcInstance"functioninitsformsunit.
//Butthisworksalittlebitdifferent,hasmuchmoreoverhead,
//andmostimportant,youhavetousetheformsunit,whichincreasesthesizeofyourexedrastically,
//ifallothercodedoesn'tusetheVCL(e.g.inafullscreenDirectX/OpenGlapp).
//WernochFragenhat/ifyouhavequestions:Florian.Benz@t-online.de