Jump to content

TiGü

Members
  • Content Count

    44
  • Joined

  • Last visited

  • Days Won

    2

Posts posted by TiGü


  1. And when you break the boolean check for the correct method and argument types into two different variables?

     

    function executeInstanceMethod(Reference: Pointer; const AName: string;
      const Args: array of TValue): TValue;
    var
      context: TRttiContext;
      instType: TRttiInstanceType;
      obj: TObject;
      meth: TRttiMethod;
      parameters: TArray<TRttiParameter>;
      MethodIsFound, ArgumentTypesAreEqual: Boolean;
      index: Integer;
    begin
      context := TRttiContext.Create;
      try
        meth := nil;
        MethodIsFound := false;
        obj := TObject(Reference);
        instType := (context.GetType(obj.ClassType) as TRttiInstanceType);
    
        for meth in instType.GetMethods do
        begin
          MethodIsFound := SameText(meth.Name, AName);
          if MethodIsFound then
          begin
            parameters := meth.GetParameters;
            ArgumentTypesAreEqual := False;
            if Length(Args) = Length(parameters) then
            begin
              for Index := 0 to Length(parameters) - 1 do
              begin
                ArgumentTypesAreEqual := parameters[Index].ParamType.Handle.Kind = Args[Index].TypeInfo.Kind;
    
                if not ArgumentTypesAreEqual then
                begin
                    raise Exception.CreateFmt('Argument type of %s is not %s, is %s', [parameters[Index].Name, parameters[Index].ParamType.Name, Args[Index].TypeInfo.NameFld.ToString]);
                    Break;
                end;
              end;
            end;
    
            if MethodIsFound then
              Break;
          end;
        end;
    
        if (meth <> nil) and MethodIsFound and ArgumentTypesAreEqual then
        begin
          result := meth.Invoke(obj, Args);
        end
        else
          raise Exception.CreateFmt('method %s not found', [AName]);
    
      finally
        context.Free;
      end;
    end;

     


  2. 1 hour ago, Andre1 said:

    procedure TForm1.Button1Click(Sender: TObject); var MyBitmap: TBitmap; black_card: Cardinal; begin MyBitmap := TBitmap.Create(256, 256); try // if you set a breakpoint in FMX.Graphics.TBitmap.Clear, you will see that the Clear() method is called twice MyBitmap.Clear(TAlphaColorRec.Black); black_card := TAlphaColorRec.Black; executeInstanceMethod(MyBitmap, 'Clear', [black_card]); finally MyBitmap.Free; end; end;

    Hm, for me it works in Win64 Debug with Delphi 11.3 with the direct use of a Cardinal/UInt32 variable.
    Do you get other results when you call from the C context?

     

    Call Stack

    FMX.Graphics.TBitmap.Clear(4278190080)
    System.Rtti.RawInvoke(???,???)
    System.Rtti.Invoke($E35330,(($E1DF70, Pointer($13D40A0) as IValueData, 0, 6656, 4038203904, $26BF0B21A00, TClass($26BF0B21A00), 0, 6656, -256763392, -4,40958110556075e+29, 1,31551053242737e-311, 1,31551053242737e-311, 2662622960128, 266262296,0128, 2662622960128, 2662622960128, ($26BF0B21A00, nil), $26BF0B21A00), ($C74CA0, Pointer($13D40A0) as IValueData, 0, 0, 4278190080, $FF000000, TClass($FF000000), 0, 0, -16777216, -1,70141183460469e+38, 2,11370674490681e-314, 2,11370674490681e-314, 4278190080, 427819,008, 4278190080, 4278190080, ($FF000000, nil), $FF000000)),ccReg,nil,False,False)
    System.Rtti.TRttiInstanceMethodEx.DispatchInvoke(($E1DF70, Pointer($13D40A0) as IValueData, 0, 6656, 4038203904, $26BF0B21A00, TClass($26BF0B21A00), 0, 6656, -256763392, -4,40958110556075e+29, 1,31551053242737e-311, 1,31551053242737e-311, 2662622960128, 266262296,0128, 2662622960128, 2662622960128, ($26BF0B21A00, nil), $26BF0B21A00),(...))
    System.Rtti.TRttiMethod.Invoke($26BF0B21A00,(...))
    Unit1.executeInstanceMethod($26BF0B21A00,'Clear',(...))
    Unit1.TForm1.Button1Click(???)



     


  3. Are you sure? Did you debug it properly?


    Because the line 

    if parameters[Index].ParamType.Handle <> Args[Index].TypeInfo then

    works for me but because of the following line

    if Args[Index].IsObject AND Args[Index].AsObject.InheritsFrom (parameters[Index].ParamType.AsInstance.MetaclassType) then

    the Found variable is set to false.

     

    So, if you added a new if-condition (or just comment out the IsObject-condition), you will see, that the TRttiMethod is there and can be called:
     

    Full Example with a FMX form and a button:

     

    unit Unit1;
    
    interface
    
    uses
      System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
      FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls,
      System.Rtti;
    
    type
      TForm1 = class(TForm)
        Button1: TButton;
        procedure Button1Click(Sender: TObject);
      private
      public
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.fmx}
    
    function executeInstanceMethod(Reference: Pointer; const AName: string;
      const Args: array of TValue): TValue;
    var
      context: TRttiContext;
      instType: TRttiInstanceType;
      obj: TObject;
      meth: TRttiMethod;
      parameters: TArray<TRttiParameter>;
      Found: Boolean;
      index: Integer;
    begin
      context := TRttiContext.Create;
      try
        meth := nil;
        Found := false;
        obj := TObject(Reference);
        instType := (context.GetType(obj.ClassType) as TRttiInstanceType);
    
        for meth in instType.GetMethods do
        begin
          if SameText(meth.Name, AName) then
          begin
            parameters := meth.GetParameters;
    
            if Length(Args) = Length(parameters) then
            begin
              Found := True;
              for Index := 0 to Length(parameters) - 1 do
              begin
                if parameters[Index].ParamType.Handle <> Args[Index].TypeInfo then
                begin
    
                  if Args[Index].IsObject AND Args[Index].AsObject.InheritsFrom
                    (parameters[Index].ParamType.AsInstance.MetaclassType) then
                  begin
    
                  end  // I added this line, because TAlphaColor ist obviously a Ordninal and not a class
                  else if Args[Index].IsOrdinal then
                  begin
                    // everything is okay, Found is still True
                  end else
                  begin
                    Found := false;
                    Break;
                  end;
                end;
              end;
            end;
    
            if Found then
              Break;
          end;
        end;
    
        if (meth <> nil) and Found then
        begin
          result := meth.Invoke(obj, Args);
        end
        else
          raise Exception.CreateFmt('method %s not found', [AName]);
    
      finally
        context.Free;
      end;
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    var
        MyBitmap: TBitmap;
    begin
        MyBitmap := TBitmap.Create(256, 256);
        try
            // if you set a breakpoint in FMX.Graphics.TBitmap.Clear, you will see that the Clear() method is called twice
            MyBitmap.Clear(TAlphaColorRec.Black);
            executeInstanceMethod(MyBitmap, 'Clear', [TAlphaColorRec.Black]);
        finally
            MyBitmap.Free;
        end;
    end;
    
    end.

     


  4. I can just de-select unit nodes via folders, but not the DPR-File itself.

    Like, that's no meaningful information, if you had 2000 units in your project, so in the resulting graph are 2000 lines to the project name node.

    But you already know, that your units are included in the project file.

     

    Example:

    image.thumb.png.7090a8918f89949107e37dd6b532e66e.png

    I want to hide the RESTDebugger.dpr Node. At this moment, there is no possibiltity to do that.

     

     


  5. First, maybe that helps: https://stackoverflow.com/a/6616121

     

    Do you use this?

    https://github.com/maerlyn/old-delphi-codes/blob/master/_KOMPONENSEK/Comms.pas 

     

    Check for Mainthread with a construct like 

     

    procedure TForm62.comportclient1Receive(Sender: TObject; InQue: Integer);
    begin
        if TThread.Current.ThreadID = MainThreadID then
        begin
            SendMessage(handle, pm_ProcessBarcodeScan, WPARAM(0), LPARAM(0));
            Application.ProcessMessages;
        end;
    end;

     

     


  6. Check TNotificationWinRT.Create.

    I assume your lNotification is freed before it used here.

     

    constructor TNotificationWinRT.Create(const ANotificationCenter: TNotificationCenterWinRT;
      const ANotification: TNotification);
    var
      DeleateActivate: TNotificationCenterDelegateActivated;
      DelegateDismiss: TNotificationCenterDelegateDismiss;
      DelegateFailed: TNotificationCenterDelegateFailed;
    begin
      FToast := TToastNotification.Factory.CreateToastNotification(TToastTemplateGenerator.GetXMLDoc(ANotification));
      DeleateActivate := TNotificationCenterDelegateActivated.Create(ANotification);
      FDelegateActivatedToken := FToast.add_Activated(DeleateActivate);
    
      DelegateDismiss := TNotificationCenterDelegateDismiss.Create(ANotificationCenter, ANotification.Name);
      FDelegateDismissToken := FToast.add_Dismissed(DelegateDismiss);
    
      DelegateFailed := TNotificationCenterDelegateFailed.Create(ANotificationCenter, ANotification.Name);
      FDelegateFailedToken := FToast.add_Failed(DelegateFailed);
    end;

     


  7. 14 hours ago, david_navigator said:

    but the only place I can find GetTemplateContent is in Winapi.UI.Notifications class function TToastNotificationManager which won't accept a break point

    The "Debug DCU" option is checked in the project options?

    Only with this you can debug in VCL and RTL source code (System, Winapi, etc.).

     

    Anyway, the use of Application.ProcessMessages looks like a code flaw and is the wrong approach in most cases.


  8. unit REST.Types // Delphi 10.4
    
    ...
    
    type //at line 123
      /// <summary>
      /// Content
      /// </summary>
      TRESTContentType = (ctNone, ctAPPLICATION_ATOM_XML, ctAPPLICATION_ECMASCRIPT, ctAPPLICATION_EDI_X12,
        ctAPPLICATION_EDIFACT, ctAPPLICATION_JSON, ctAPPLICATION_JAVASCRIPT, ctAPPLICATION_OCTET_STREAM, ctAPPLICATION_OGG,
        ctAPPLICATION_PDF,... // <-------

     


  9. I know, this thread is a little bit dated, but I take a look to your github repository.

    https://github.com/fpiette/OvbImgOrganizer/blob/main/Source/Direct2D_1/Vcl.Direct2D_1.pas

     

    Have you ever tried to change your SwapEffect in DXGI_SWAP_CHAIN_DESC1?

    You use DXGI_SWAP_EFFECT_DISCARD in Line 1207 but the most recent examples recommend DXGI_SWAP_EFFECT_FLIP_DISCARD or  DXGI_SWAP_EFFECT_SEQUENTIAL_DISCARD.

    https://docs.microsoft.com/en-us/windows/win32/api/dxgi/ne-dxgi-dxgi_swap_effect

     

    Maybe you should use just the normal Present-Method of the Swap Chain.

    So, just write DXGISwapChain.Present instead DXGISwapChain.Present1 and get rid of the PresentParams : PDXGIPresentParameters because you don't use it anyway.

     

    https://social.msdn.microsoft.com/Forums/en-US/4737f4f6-68a4-45eb-8941-13f68802153a/why-direct2d-idxgiswapchain1present1-is-much-slower-than-directdraw?forum=windowssdk

     

    https://walbourn.github.io/care-and-feeding-of-modern-swapchains/

     

     

    Are you familiar with the DirectX debug layers?

    So, if you do something fishy with your DirectX stuff, the Debug Layers will tell you in the (Debug) Event Log (you must read both links).

    It's a great help during development:

     

    https://docs.microsoft.com/en-us/windows/win32/direct3d11/using-the-debug-layer-to-test-apps

    https://docs.microsoft.com/en-us/windows/win32/Direct2D/direct2ddebuglayer-overview

     

    Please add D2D1_DEBUG_LEVEL_INFORMATION to FactoryOptions.DebugLevel before calling D2D1CreateFactory and D3D11_CREATE_DEVICE_DEBUG to the CreationFlags before calling D3D11CreateDevice.

    If you wrap it between {$IFDEF DEBUG} and {$ENDIF}, you have a clean Release code.

     

    image.thumb.png.74de50ad74d110490689ec09cfa87dc7.png

    • Like 2
    • Thanks 1

  10. You can check if your normal ID2D1RenderTarget/ID2D1HwndRenderTarget/ID2D1DCRenderTarget from the TDirect2DCanvas supports the newer Direct2D 1.1 ID2D1DeviceContext.

    Something like this:

      // Self.Handle is the HWND of your Form...
      FVCLCanvas := TDirect2DCanvas.Create(Self.Handle);
      var DeviceContext: ID2D1DeviceContext;
      if Supports(FVCLCanvas.RenderTarget, ID2D1DeviceContext, DeviceContext) then
      begin
        var YourPointer: Pointer;
        var DontForgetThePitch := 1024;
        var AllImportantBitmapProperties: D2D1_BITMAP_PROPERTIES1;
        var D2D1Bitmap: ID2D1Bitmap1;
        DeviceContext.CreateBitmap(SizeU(1024,1024), YourPointer, DontForgetThePitch, @AllImportantBitmapProperties, D2D1Bitmap);
        DeviceContext.DrawImage(D2D1Bitmap, nil, nil, D2D1_INTERPOLATION_MODE_HIGH_QUALITY_CUBIC);
      end;

    I assume you will find out the details on your own (Fill the Pointer to your Data, Pitch, Bitmap props).

     

    Or you build the entire Direct 2D 1.1 - 1.3 thing by yourself and forget the crappy TDirect2DCanvas.

    Microsoft had a lot of DirectX samples and all of them have a abstract class called "DirectXBase" (e.g. https://github.com/microsoft/VCSamples/blob/master/VC2012Samples/Windows 8 samples/C%2B%2B/Windows 8 app samples/Direct2D interpolation modes sample (Windows 8)/C%2B%2B/DirectXBase.cpp).

     

    You can use the attachment pascal unit as a starting point.

    I recommend the header translations from MfPack (https://github.com/FactoryXCode/MfPack) for this.

    DirectXBase.pas

    • Like 1
    • Thanks 1

  11. I had the same problem today in my Delphi 10.4.
    After some searching and comparing with a newly created registry key for Delphi, I found out that it is due to the disabled entries in the IDEInsight key.

     

    Example:

    [HKEY_CURRENT_USER\SOFTWARE\Embarcadero\BDS\21.0\IDEInsight]
    "Disabled0"="Project Options"
    "Disabled1"="Components"
    "Disabled2"="Object Inspector"
    "Disabled3"="New Items"
    "Disabled4"="Open Files"
    "Disabled5"="Recent Files"
    "Disabled6"="Recent Projects"
    "Disabled7"="Component Palette"
    "Disabled8"="Code Templates"
    "Disabled9"="Desktop SpeedSettings"
    "Disabled10"="Projects"
    "Disabled11"="Files"
    "Disabled12"="Forms"
    "Disabled13"="Commands"
    "Disabled14"="Preferences"

    After deleting the complete key in the registry and restarting Delphi, IDE Insight worked again.

    • Like 1

  12. Please stop to wonder about the font(s). It does not matter!

    The problem is the text rendering itself in the editor of the Delphi IDE.

     

    In the screenshot you can see a few examples in the Delphi IDE and in Visual Studio Code.

    In both cases, the font is the famous Consolas from Microsoft (https://en.wikipedia.org/wiki/Consolas). 

     

    Most european languages like German, Swedish or Hungarian are well rendered. Even Greek is displayed nice.

    But all others looks like a pile of shit. Arabic is broken, Thai has to much space between the symbols.

    The same problem occours in Khmer and Sinhala (mispelled as Shinghal in the source code).

    Chinese look okay, but not perfect.

     

    Conclusion:

    The Delphi IDE Editor is designed for European character sets only.

     

    image.thumb.png.7e3fe7163f11e7813e0bc3721d2d1438.png

    • Like 1

  13. 2 minutes ago, Der schöne Günther said:

    I still don't get quite behind that language server thing. I see that they will be able to delegate things like Code Completion and Error Insight to some external process in the background.

    Same here. Perhaps it's a important thing, but what exactly is the benefit for a single dev like you and me?

    Besides, a working error insight would be almost like heresy. There's never been anything like this for Delphi before! 😈

    • Haha 1

  14.  

    2 hours ago, Schokohase said:

    It is also pointless to place a pull request if you know that it will break code for Versions < XE3 while the library clearly states

     

    The contributer knows it, but did not provide a solution in code

     

    2 hours ago, ByteJuggler said:

    Especially with new contributors to open source (but also in general) it's usually advisable in the interests of friendly cooperation to exercise some patience and politeness and give contributors some friendly feedback about their pull requests if they should accidentally miss this or any other type of requirement that change requests should comply with (and to do so in the context where the pull request was submitted.)  If the JCL/JVCL maintainers are not giving at least this feedback to people trying to contribute then that's rather a shame.  😞

    Especially when younger pull requests are commented and this one is simply ignored.
    The maintainers can say: "Ok, that was nice, but come back when you have a version that works with Delphi 6".
    But ignoring it completely is not cool. You know the German proverb: "Kannste man so machen, aber dann ist halt K*cke!"

    My motivation to ever participate again for the JCL or JVCL is at a minimum.

×