Jump to content

pyscripter

Members
  • Content Count

    69
  • Joined

  • Last visited

  • Days Won

    3

pyscripter last won the day on November 10 2019

pyscripter had the most liked content!

Community Reputation

65 Excellent

1 Follower

Technical Information

  • Delphi-Version
    Delphi 10.2 Tokyo

Recent Profile Visitors

The recent visitors block is disabled and is not being shown to other users.

  1. pyscripter

    TButtonedEdit Styles and transparency

    https://quality.embarcadero.com/browse/RSP-26633 The report contains a solution.
  2. Yes indeed. THANK YOU! I am normally including jdbg info into the executable, but for some reason this was not included.
  3. I am getting a bug report with the following stack list. Exception class: EOSError Exception message: System Error. Code: 1400. Invalid window handle. Exception address: 004305B8 Stack list, generated 10/12/2019 10:45:33 AM [004305B3]{PyScripter.exe} Unknown function at __dbk_fcall_wrapper [005F08C1]{PyScripter.exe} Unknown function at TMethodImplementationIntercept [005B6961]{PyScripter.exe} Unknown function at TMethodImplementationIntercept .... TMethodImplementationIntercept is defined in RTTI.pas but it does not appear to be used anywhere and I am not calling this function. { This function has been added to be used from .s .c files in order to avoid use mangled names} procedure TMethodImplementationIntercept(const obj:TMethodImplementation; AFrame: Pointer); cdecl; begin obj.Intercept(AFrame); end; exports TMethodImplementationIntercept; Any idea what might be going on?
  4. pyscripter

    Overrided TForm.DestroyWnd is not executed

    See my post on this very topic.
  5. pyscripter

    High quality bitmap resize with transparency

    Please note that there is a bug in Vcl.Graphics which affects the code above.
  6. The Windows imaging Component contains a wealth of useful features for manipulating images in different formats. Delphi partially encapsulates this functionality into the TWICImage class of Vcl.Graphics which is a TGraphics descendent. The following code resizes pf32bit bitmaps with transparency using TWICImage, at a much better quality than can be achieved with StretchDraw for example or anything else I have tried.. Uses Winapi.Wincodec, Vcl.Graphics; procedure ResizeBitmap(Bitmap: TBitmap; const NewWidth, NewHeight: integer); var Factory: IWICImagingFactory; Scaler: IWICBitmapScaler; Source : TWICImage; begin Bitmap.AlphaFormat := afDefined; Source := TWICImage.Create; try Factory := TWICImage.ImagingFactory; Source.Assign(Bitmap); Factory.CreateBitmapScaler(Scaler); Scaler.Initialize(Source.Handle, NewWidth, NewHeight, WICBitmapInterpolationModeHighQualityCubic); Source.Handle := IWICBitmap(Scaler); Bitmap.Assign(Source); Scaler := nil; Factory := nil; finally Source.Free; end; end; Some key points: Setting the AlphaFormat to alDefined is crucial for maintaining the transparency. If you do not release the ImageFactory before you destroy the TWICImage you will get access violations next time you call this procedure. (Have a look at TWICImage .Destroy).
  7. pyscripter

    Patch a private virtual method

    @Stefan GlienkeWould this approach work with classes derived from TFoo? Wouldn't you have to patch the VMT of derived classes?
  8. In case this of use to anyone: Quite often you find a bug in Delphi RTL and you come up with a fix. Patching involves replacing the RTL procedure with a new patched one. To do that you can use your favorite patching routine or library (I use Detours), but you need the address of the original function/method. a) Patching a non-virtual public method This is quite straight-forward: type TMethodType = procedure ... of object function GetAddress: Pointer; var MethodPtr : TMethodType; begin MethodPtr := TRTLClass(nil).PublicMethod; Result := TMethod(MethodPtr).Code; end; Note the type cast TRTLClass(nil). b) Patching a virtual public method If for example PublicMethod is virtual the above type cast TRTLClass(nil) with result in access violation, since to resolve the virtual method you need to access Self which is nil. You could create a class instance and use that instead of TRTLClass(nil), but apart from not being elegant, in some cases this has side-effects (for example it may require a valid windows handle). The trick is described in this Stackoverflow question. function GetAddress: Pointer; var VMT : NativeInt; MethodPtr: TMethodType; begin VMT := NativeInt(TRTLClass); MethodPtr := TRTLClass(@VMT).PublicMethod; Result := TMethod(MethodPtr).Code; end; This is based on two facts. A class is a pointer to the Virtual Method table (VMT) and an Object structure has as the first field a pointer to the VMT of its class. c) Patching a private virtual method The trick this time involves using a class helper to access the private method of the TRTLClass type TPrivateMethodType = procedure ... of object; TRTLClassHookFix = class helper for TRTLCLass function GetPriveMethodAddr: Pointer; end; function TRTLClassHookFix.GetPriveMethodAddr: Pointer; var VMT : NativeInt; MethodPtr: TPrivateMethodType; begin // Adjust Self to point to the VMT VMT := NativeInt(TRTLCLass); Self := TRTLCLass(@VMT); with Self do MethodPtr := PrivateMethod; Result := TMethod(MethodPtr).Code; end; That's it.
  9. pyscripter

    Delphi 2007 to 10.3 and Windows 10 taskbar issue

    I could reproduce the problem. However I would suggest that you do not auto-create dialog forms. In Project, Options, Forms remove the OKRightDlg from the list of auto-created forms (move it to the right). Replace TForm1.Button1Click with something like this: procedure TForm1.Button1Click(Sender: TObject); begin with TOKRightDlg.Create(Self) do begin PopupParent := Self; ShowModal; Release; end; end;
  10. pyscripter

    Delphi 2007 to 10.3 and Windows 10 taskbar issue

    I do not see this issue with Delphi applications created with Delphi Rio. Application.MainFormOnTaskbar := True; is called before the creation of the main form in the dpr file.
  11. The extended Rtti, available since Delphi XE, is great and has many uses, including serialization and exposing Delphi object to scripting languages. There have been many discussions about whether you should keep a global RttiContext or not and whether you should call TRttiContext Create and Free every time you access extended Rtti. For example this article suggests that keeping it in a global variable is a "very bad idea". However there is a huge performance penalty if you do not do that. For example in the following code Test1 runs about 100 times slower than Test2. The reason is that in Test1, hundreds of Rtti objects are created and destroyed every time you access the rtti. program Project1; {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils, System.Classes, System.Diagnostics, System.Rtti; Const Iterations = 10000; var SL : TStringList; procedure Test1Inner; begin var RttiContext := TRttiContext.Create; var RttiMethod := RttiContext.GetType(SL.ClassType).GetMethod('Clear'); RttiMethod.Invoke(SL, []); RttiContext.Free; end; Procedure Test1; begin for var I := 1 to Iterations do begin Test1Inner; end; end; Procedure Test2; begin var RttiContext := TRttiContext.Create; for var I := 1 to Iterations do begin var RttiMethod := RttiContext.GetType(SL.ClassType).GetMethod('Clear'); RttiMethod.Invoke(SL, []); end; RttiContext.Free; end; begin SL := TStringList.Create; try var SW := TStopwatch.StartNew; Test1; SW.Stop; WriteLn(SW.ElapsedMilliseconds.ToString); SW := TStopwatch.StartNew; Test2; SW.Stop; WriteLn(SW.ElapsedMilliseconds.ToString); finally SL.Free; end; ReadLn; end. There is a middle-of-the-road solution to the performance issue, once you realize that there can be many Rtti Contexts but there is just one Rtti Pool as @Stefan Glienke points out at the bottom of this Stackoverflow topic. (By the way, the bug discussed in this question was fixed in Delphi Rio). So instead of having a global RttiContext you can instead insert the following code at the bottom of one of your units. Var _RttiContext: TRttiContext; procedure _InitRttiPool; begin _RttiContext := TRttiContext.Create; _RttiContext.FindType(''); end; initialization _InitRttiPool; finalization _RttiContext.Free(); Note that _RttiContext is not used anywhere else, but this is enough to keep the rtti pool alive and prevent the performance penalty involved in creating and freeing the RttiContext. @David Heffernan suggests something similar in the StackOverflow topic mentioned above but for a different reason. The downside of course is the memory overhead involved in keeping all these rtti objects alive for the lifetime of the application. Any comments?
  12. pyscripter

    JCL & JEDI in 10.3.2 RIO (no GetIt)

    Works fine here. Are you using the latest versions from GitHub? Are you following the instructions at https://github.com/project-jedi/jcl and https://github.com/project-jedi/jvcl?
  13. pyscripter

    UCS4Strings

    @David Heffernan http://docwiki.embarcadero.com/Libraries/Rio/en/System.UCS4String Your were spot on.
  14. pyscripter

    UCS4Strings

    Does anybody know why WideStringToUCS4String adds 0 zero as the last character? Surprisingly, Length(WideStringToUCS4String('')) returns 1 and Length(WideStringToUCS4String('abc')) returns 4.
  15. http://docwiki.embarcadero.com/RADStudio/Rio/en/Methods_(Delphi)#Class_Static_Methods I think it follows from the fact that static methods have no Self parameter. How could then display polymorphic behaviour?
×