Jump to content

JackT

Members
  • Content Count

    35
  • Joined

  • Last visited

Community Reputation

1 Neutral

Technical Information

  • Delphi-Version
    Delphi 12 Athens

Recent Profile Visitors

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

  1. JackT

    procedure of class

    Thanks for the replies. I appreciate the effort you have all put into answering my question.
  2. JackT

    procedure of class

    This is is what I am attempting to do. I have a hardware controller that is running two threads The outer threads accepts commands through a pipe from a controlling program UI. When commanded to do the outer thread spawns a generic controller program on the inner thread, so as not to block the control pipe. From the outer thread I specify a control module, that the inner thread is going to use to do the actual controlling. I don't want to pass an actual object across threads because this is bad thing to do as it can lead to objects getting destroyed at the wrong time therefore I pass a class reference and create that object in the controlling thread. The referenced class is an interfaced object that may or not support specific interfaces, but generally the first object creates a very basic hardware interface that just queries the hardware firmware details. When the initial interfaced object gets the results of the hardware query interface it looks up a specific controller from an internal list and if it is present it creates another controller in the internal thread and sets this to the current controller interface. This destroys the original controller interface and the new controller carries on. If a specific controller isn't found the inner thread throws an exception, stores the error result and terminates. That aside there are circumstances where it is handy to know in the outer thread the current class reference of the controller. So I want to be able to pass back the class reference of the current loaded controller and then use class functions in that class reference to retrieve meta data and helper routines from the class reference that can be used to prepare data before pushing information to the inner thread. There is no language mechanism to declare a procedure of a class, or a function of a class. Even though you can declare class procedures as virtual. I can however get the method address of a virtual class function but I can not cast it to a suitable function Type. I thought class function would all be static in nature so I just tried casting it to a standard module procedure some thing like this. type TMyproc = function(P1,P2:Variant):Variant; class function (P1,P2:Variant):Variant;virtual; can not be cast to a suitable method pointer because there is no language mechanism to do this class function DoSomething():Integer;static; can be cast to TMyProc pointer type because the static key word removes the self reference This means that it is not possible to get a function pointer in a class function or procedure that has been declared virtual and then call it because the function call isn't being fixed up correctly. If the novel language mechanism "procedure / function of class" were implemented then this might be possible. This would then be a handy way of passing metadata between threads, for example it could pass a list of supported commands or a data decompression routine without having to instantiate an object an actual object, which could be overridden with updated versions in descendant classes. ------>OUTER THREAD--------> START INNER THREAD(INIITAL CLASSREF) CREATE BASIC CONTROLLER HERE USING CLASSREF QUERY HARDWARE REPLACE CONTROLLER WITH DESENDANT CONTROLLER THAT INHERITS FROM BASIC CONTROLLER ASK FOR INNER CLASS REF --> LOOP DO CONTROLLER ACTIONS UNTIL TERMINATED ------>OUTER THREAD-------->INNER THREAD
  3. JackT

    procedure of class

    Cheers! That worked, so getting the address of a class function that has been declared as a virtual function causes the parameters to that function to be passed incorrectly. This is ok for me but it means you can't use inherit code from ancestor classes I guess.
  4. JackT

    procedure of class

    Thanks for the reply there isn't a procedure of class function but that is what I am trying to do. It's a bit crazy complicated - I have a class reference to an interfaced object which I pass into a threaded object that creates that class. Somewhere down the line I read a string from a piece of hardware and then load up a new class interface to replace the original one depending on the hardware system. This is because there might be multiple versions of the hardware firmware out in the wild. I then want to issue commands to the discovered piece of hardware, but I need to get back the new class reference, so I can call class functions to prepare data for other calls without knowing the specifics of the class I am dealing with. I was using virtual methods, but this doesn't look like it is possible so I will try with static methods and remove the function from the base class.
  5. I am trying to cast a class function to a pointer as opposed to a procedure of object. For example TProcReportError = function(Sender:Tobject;const CrashMsg:String) of object; creates a pointer to a function of an object. I want do the same thing with a class function - for example TProcReportError = procedure(Sender:TObject;const CrashMsg:String) of class; I tried this and then used TProcReportError = procedure(Sender:TObject;const CrashMsg:String); In this real example type TPrepareNewState = function(Sender, Commander: TObject): String; function TN1.ControllerCommand: AnsiString; var CRef:TClass; NS:String; P:Pointer; PNS:TPrepareNewState; Z:TN1; begin if Assigned(Commander) then begin // Commander.PrepareNewState(Self,Commander); NS:=''; CRef := Commander.ControllerClass; if CRef <> nil then begin if CRef.InheritsFrom(TN1BaseAutoCommander) then begin P:= Cref.MethodAddress('PrepareNewState'); if P = nil then begin //raise Exception.Create(CRef.ClassName + ' does not implement PrepareNewState'); RESULT := 'ERROR '+CRef.ClassName + ' does not implement PrepareNewState'; exit; end; ODS('Attempting call on ' + CRef.ClassName); PNS:=P; Z:=Self as TN1; NS:=PNS(Z,Commander); ODS(NS); Commander.TrySwitchState(NS); RESULT := 'OK'; end; end else begin RESULT :='ERROR COMMANDER DOES NOT HAVE A CONTROLLER CLASS'; end; end else begin RESULT := 'ERROR UNASSIGNED COMMANDER'; end; end; It calls this command. The line N1:=Sender As TN1 throws an exception as it doesn't think Sender is a class of TN1, but in the previous procedure we tested this assertion by setting Z := Self As TN1; The only thing I can think is happening is that parameters are being passed incorrectly ? I assumed a class function would behave like a module level function for casting purposes ?
  6. JackT

    GRPC Client

    I am trying to link to an instrument that another company has made that uses GRPC to send data back to a controlling computer. I have managed to do this in C# but it has been a nightmare in C++ Builder and Delphi. GRPC is supposed to be 10 years old now but so you would have thought it would be fairly stable at this point. However if you go on the news group https://groups.google.com/g/grpc-io you can see that this trouble shooting group is very active with daily posts from people having problems with it. I guess GRPC was designed for interoperability between microservices in data centres where you have a lot of coders working on a distributed architecture on many machines. The fact that GRPC has to author it's own code from proto files for each implementation makes it very hard for 3rd party providers to keep up. In my opinion GRPC is a bad technology in that it promises ease of interoperability, but delivers complexity, bloat and obfuscation by the truck load. It's also a poorly documented project with out of date help files and examples that no longer work. However if I can get things working natively in Delphi it will be a real triumph.
  7. JackT

    GRPC Client

    Did you ever get GRCP working with the sgc libraries. I tried to do a grpc call with TsgHTTP2Client which is partially successful in that it calls the server but I got an error in the response //NON WORKING INCOMPLETE CODE FOR ILLUSTRATION PURPOSE ONLY type TGRPCFrameHeader = packed record B1:Byte; Size:Cardinal; end; var FH:TGRPCFrameHeader; httP:=TsgcHTTP2Client.Create(nil); http.request.TransferEncoding:='grpc-encoding'; http.request.AcceptEncoding :='grpc-accept-encoding'; http.request.AcceptEncoding :=''; http.request.ContentType:='application/grpc+proto'; http.ConnectTimeout:=10000; http.ReadTimeout:=10000; http.WriteTimeout:=10000; //http.request.CustomHeaders.AddPair('grpc-encoding','gzip'); http.request.CustomHeaders.AddPair('TE','trailers'); //Write header FH.B1 :=0; FH.Size := Length(BA); //Prepare byte array BA write 5 byte header then write message data outstream.write(FH,SizeOf(FH)); outstream.Write(BA,Length(BA)); http.post('http://127.0.0.1:50051/helloworld.Greeter/SayHello',outstream,memstream); Finally I try to call the HelloWorld c plus plus server example in GRPC examples from git hub where BA = When I do the call I get a list of strings back in http.reponse.headers one of which is grpc-message=Couldn't initialize byte buffer reader Process myGRPC.exe (21704) I suspect my http2 headers are wrong. I have to say GRPC is one of the worst things I have ever come across to try to work with. I have managed to make a rudimentary framework which can read most proto files and to create a structures so that data can be stored against proto file data members in the correct format. However I can not figure out how to make GRPC call over HTTP2. I don't know if I have to set some header flags
  8. JackT

    Has the toolbar problem been fixed?

    It still does it. I saved a default layout and it does matter what layout I goto all my buttons are missing. The bug is not fixed, at least on my computer anyway.
  9. JackT

    Has the toolbar problem been fixed?

    I have the latest version of the Delphi IDE 12.3 with all the patches and I am sorry to say this bug is worse than ever. I am working with the IDE under windows 11. I think it might have something to do with the IDE not coping with it's windows getting resized on different screens with different resolutions and scaling. I am using a laptop as my work computer so I often move the Delphi IDE off the laptop screen on to the bigger monitor. Also of annoyance is when I run a program in Debug mode it moves the IDE window back to the smaller laptop monitor rather than staying put, even though the "Always keep IDE on the same screen feature" is enabled. This triggers resizing events in the IDE causing the toolbars to get resized. I tried the new windows 11 snap feature but that doesn't keep the IDE in place either. This should be an easy bug to sort out.
  10. JackT

    Styled controls registering

    I have made an extended rectangle class TRoundRectExt in a unit called RoundedRectExt I register it like this in the initialization section initialization begin RegisterFMXClasses([TRoundRectExt]); end; TRoundRectExt lives in a package with other custom controls. I then refer to TRoundRectExt inside a custom style file. The problem comes when I apply that style to a new form and run my program I get the exception Class TRoundRectExt not found because TRoundRectExt has not been registered because the initialization section for TRoundRectExt hasn't been run. Adding RounderRectExt to the uses clause of the form fixes the problem. Am I registering my custom component in the right way ? is there any way I can tell a style file that it needs to load a package first ? Thanks for any help in advance Jack T unit RoundedRectExt; interface uses FMX.Objects,FMX.Types,Classes,FMX.Graphics; type TRoundRectExt=class(TRoundRect) private FCornerType:TCornerType; FDisabledFill:TBrush; FDisabledStroke:TStrokeBrush; FDisabledOpacity:Single; FXRadius,FYRadius:Single; procedure SetCornerType(CT:TCornerType); procedure SetDisabledOpacity(NV:Single); procedure SetXRadius(NV:Single); procedure SetYRadius(NV:Single); procedure SetDisabledStroke(NB:TStrokeBrush); procedure SetDisabledFill(NB:TBrush); protected procedure Paint;override; public constructor Create(AOwner:TComponent);override; destructor Destroy();override; published property CornerType:TCornerType read FCOrnerType write SetCornerType; property DisabledOpacity:Single read FDisabledOpacity Write SetDisabledOpacity; property DisabledFill:TBrush read FDisabledFill write SetDisabledFill; property DisabledStroke:TStrokeBrush read FDisabledStroke write SetDisabledStroke; property XRadius:Single read FXRadius write SetXRadius; property YRadius:Single read FYRadius write SetYRadius; end; procedure Register; implementation { TRoundRectExt } uses System.Types,Math,UITypes,FMXCommonFunc,FMX.Controls,SysUtils; procedure Register; begin RegisterComponents('JPTCerca', [TRoundRectExt]); end; function GetDrawingShapeRectAndSetThickness(const AShape: TShape; const Fit: Boolean; var FillShape, DrawShape: Boolean; var StrokeThicknessRestoreValue: Single): TRectF; const MinRectAreaSize = 0.01; begin FillShape := (AShape.Fill <> nil) and (AShape.Fill.Kind <> TBrushKind.None); DrawShape := (AShape.Stroke <> nil) and (AShape.Stroke.Kind <> TBrushKind.None); if Fit then Result := TRectF.Create(0, 0, 1, 1).FitInto(AShape.LocalRect) else Result := AShape.LocalRect; if DrawShape then begin if Result.Width < AShape.Stroke.Thickness then begin StrokeThicknessRestoreValue := AShape.Stroke.Thickness; FillShape := False; AShape.Stroke.Thickness := Min(Result.Width, Result.Height); Result.Left := (Result.Right + Result.Left) * 0.5; Result.Right := Result.Left + MinRectAreaSize; end else Result.Inflate(-AShape.Stroke.Thickness * 0.5, 0); if Result.Height < AShape.Stroke.Thickness then begin if StrokeThicknessRestoreValue < 0.0 then StrokeThicknessRestoreValue := AShape.Stroke.Thickness; FillShape := False; AShape.Stroke.Thickness := Min(Result.Width, Result.Height); Result.Top := (Result.Bottom + Result.Top) * 0.5; Result.Bottom := Result.Top + MinRectAreaSize; end else Result.Inflate(0, -AShape.Stroke.Thickness * 0.5); end; end; constructor TRoundRectExt.Create(AOwner: TComponent); begin FXRadius :=-1; FYRadius :=-1; FDisabledOpacity :=0.5; FCornerType := TCornerType.Round; FDisabledFill:=TBrush.Create(TBrushKind.Solid,TAlphaColorRec.Slategray); FDisabledStroke:=TStrokeBrush.Create(TBrushKind.Solid,TAlphaColorRec.Grey); inherited; end; destructor TRoundRectExt.Destroy; begin if Assigned(FDisabledFill) then FreeAndNil(DisabledFill); if Assigned(FDisabledStroke) then FreeAndNil(FDisabledStroke); inherited; end; procedure TRoundRectExt.Paint; var Radius: Single; R: TRectF; StrokeThicknessRestoreValue: Single; FillShape, DrawShape: Boolean; XR:Single; //XRadius YR:Single; //YRadius; HalfWidth:Single; HAlfHeight:Single; Level:Integer; UseFill:TBrush; UseStroke:TStrokeBrush; UseOpacity:Single; C:TControl; begin StrokeThicknessRestoreValue := Stroke.Thickness; try R := GetDrawingShapeRectAndSetThickness(Self, False, FillShape, DrawShape, StrokeThicknessRestoreValue); HalfWidth := R.Width/2; HalfHeight := R.Height /2; if Height < Width then Radius := HalfHeight else Radius := HalfWidth; //Set the X Radius to the Correct Value if FXRadius < 0 then begin XR := Radius; end else begin if FXRadius > HalfWidth then XR := HalfWidth else XR := FXRadius; end; if FYRadius < 0 then begin YR := Radius; end else begin if FYRadius > HalfHeight then XR := HalfHeight else YR := FYRadius; end; C:=Self As TControl; if ControlDisabledAtLevel(C,Level) then begin UseFill := FDisabledFill; UseStroke := FDisabledStroke; UseOpacity := FDisabledOpacity; end else begin UseFill := Fill; UseStroke := Stroke; UseOpacity := AbsoluteOpacity; end; if FillShape then Canvas.FillRect(R, XR, YR, Corners, UseOpacity, UseFill,FCornerType); if DrawShape then Canvas.DrawRect(R, XR, YR, Corners, UseOpacity, UseStroke,FCornerType); finally if StrokeThicknessRestoreValue <> Stroke.Thickness then Stroke.Thickness := StrokeThicknessRestoreValue; end; end; procedure TRoundRectExt.SetCornerType(CT: TCornerType); begin if CT <> FCornerType then begin FCornerType := CT; repaint; end; end; procedure TRoundRectExt.SetDisabledFill(NB: TBrush); begin FDisabledFill.Assign(NB); end; procedure TRoundRectExt.SetDisabledOpacity(NV: Single); begin if NV<0 then NV:=0; if NV>1 then NV:=1; FDisabledOpacity := NV; end; procedure TRoundRectExt.SetDisabledStroke(NB: TStrokeBrush); begin FDisabledStroke.Assign(NB); end; procedure TRoundRectExt.SetXRadius(NV: Single); begin FXRadius := NV; Repaint; end; procedure TRoundRectExt.SetYRadius(NV: Single); begin FYRadius := NV; RePaint; end; initialization begin RegisterFMXClasses([TRoundRectExt]); end; end.
  11. JackT

    Firemonkey Style Problems ( editstyle )

    I just cracked the problem. For some reason editstyle has a FixedHeight of 32 which does not affect the original editstyle. If I set fixed height height in the duplicate ( editstyle 2) to zero it then begins to behave as expected. However I don't know why the original editstyle behaves differently.
  12. I am trying to make a custom style to apply a uniform company themed UI style across all the components in the firemonkey desktop application. I am starting with WindowModernUI and then modifying it by copying a style entry in the style book such as editstyle and pasting it to create a second entry. I then change the style name of the 2nd entry to editstyle2 and tweak it until it looks correct for the new style. However even if I create a copy of editstyle and rename it to editstyle2 without doing any tweaking, when I apply this style to a TEdit box back in my test form I can no longer vertically resize the editbox, although horizontal resizing works just fine. I don't know what I am doing wrong or if there is some sort of bug ? Version - Delphi 12.3 with April patch Thanks For Any help in advance Jack T
  13. JackT

    FIPS 140

    Ok thanks for the reply -I will try to ask a sales engineer at Embarcadero.
  14. JackT

    FIPS 140

    I have a requirement for my software that it should support the FIPS 140-3 cryptographic standard. I am writing a medical device application and all the personal private data goes into an encrypted database. My question is are there any databases supported by Delphi which currently implement the FIPS 140-3 standard ?
  15. I think I sorted it an old version xmlrtl290.bpl was in the same directory as the executable.
×