JackT

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.

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

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.

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 ?

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

I have a DynamicLoader dll which uses the unit Xml.XmlIntf. unit In Delphi 12.1 the dll loaded find. I have now upgraded to Delphi 12.3 and the dll falls over on program start with the following error. The 32 bit version works fine. I am assuming there is a missing dependency somewhere or it's not linked correctly. Thanks for any help in advance Jack T

I think I sorted it an old version xmlrtl290.bpl was in the same directory as the executable.

I am creating a string list on a thread inside a function like this class AQNI : public TThread { //Some definitions } AQNI * mythread; bool AQNI::ReadXMLData { TStringList * ATB = new TStringList(); //Access violation occurs here the 2nd time the thread is created { //DO SOME STUFF } __finally { delete ATB; } return true; } The first time the thread is created everything runs fine. After I have finished with threaded object I destroy the thread and wait for a command and to start a data collection loop at which point I Free and delete mythread. However when I recreate my thread and call the ReadXMLData function when I try to create a fresh string list the whole thing falls over with an access violation. I am surprised the code is broken because it was previously working. The exception is ocuring in BorlndMM ( Borland Memory Manager ) :69d29df9 BORLNDMM.@Borlndmm@SysGetMem$qqri + 0x3d

I wish to use some thing like a TMesh component and be able to assign a color value dynamically to each vertex for the purpose of producing a color map for data cluster visualisation. Is there an easy way to do this in firemonkey ? Thanks for any help in advance. Jack T

Update I have managed to make my own TMaterial(s) and TMaterialSource(s) for direct X11 and write my own rudimentary shaders in hlsl. The only problem I have found is with the example code is where TCustomDX9Context / TCustomDx11Context etc is defined so I have had to comment some checks out in order to get the materials to work. I don't know where these classes have been moved to in Rad Studio 12. I am working purely on the windows platform so this isn't a big issue. Thanks for your help Best Regards Jack T

I have a grid of 64 sensors that are measuring magnetic fields in the range 0 to 150 Hz. The grid is non rectelinear. The idea was to build a mesh in the shape of the grid and then use a shader to set positive values red and negative values blue in real time. So all I really need to do is to pass a float in along with each vertex. I have started learning high level shader language to try to accomplish this. Best Regards, Jack T

Thanks for the reply. That code looks like the kind of think I need to do. So as you said there don't seem to be any built in materials or shaders in firemonkey that are set up to do this. I found an article that goes through the steps you need to create custom TMaterial and shaders so you are right it looks like I can have a go at coding it myself. https://blog.grijjy.com/2021/01/14/shader-programming/ I will give it a go and report back.

I am trying to hide console input when a user has to enter a password in a command prompt window. I had the bright idea of redirecting the output of the command prompt to the NUL file but this code does not work even though you can execute the function without error. I am sure there used to be an easy way to do this! Do forget to include windows in the uses clause. Thanks for any help in advance Jack T function GetPassWordInput:String; var C:Char; S:String; H,HNULL:Cardinal; B:BOOL; begin HNULL := CreateFile('NUL',GENERIC_WRITE,FILE_SHARE_WRITE,nil, OPEN_EXISTING, FILE_ATTRIBUTE_SYSTEM,0); Assert(HNULL <> 0,'CREATING NUL FILE FAILED'); H:= GetStdHandle(STD_OUTPUT_HANDLE); B:=SetStdHandle(STD_OUTPUT_HANDLE,HNULL); Assert(B,'Set standhard handle failed to assign HNULL'); try begin repeat Read(C); if C=#8 then begin if Length(S)>1 then begin S:=LeftStr(S,Length(S)-1); end; end else if C<>#13 then begin S:=S+C; end; until C=#13; end finally begin SetStdHandle(STD_OUTPUT_HANDLE,H); CloseHandle(HNULL); end; end; Result := S; end;

Hi I found a solution on stack overflow. https://stackoverflow.com/questions/3671042/mask-password-input-in-a-console-app I improved the function so it deletes it's input if you back space function GetPassword(const InputMask: Char = '*'): string; var OldMode: Cardinal; c: char; I,L:Integer; begin GetConsoleMode(GetStdHandle(STD_INPUT_HANDLE), OldMode); SetConsoleMode(GetStdHandle(STD_INPUT_HANDLE), OldMode and not (ENABLE_LINE_INPUT or ENABLE_ECHO_INPUT)); I:=0; try while not Eof do begin Read(c); if c = #8 then begin L:=Length(Result); if L>0 then begin Write(#8' '#8); Result := LeftStr(Result,L-1); continue; end; end else if C=#13 then begin break; end else begin Result := Result + C; Write(InputMask); end; end; finally SetConsoleMode(GetStdHandle(STD_INPUT_HANDLE), OldMode); end; end;

Thanks that was helpful.

I have been looking for a list of existing property editor classes supported in FireMonkey. I am specifically looking for the property editor that generates the combobox of styles using the StyleLook up property in the ObjectInspector. I don't know where the property editor for StylelLook up is registered ? I wish to use the property editor with my own components with one or more style settings. Thanks for any help in advance.

function FMXMessageDialog(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; const ADefaultButton: TMsgDlgBtn): Integer; var mr: TModalResult; begin mr:=mrNone; // standart call with callback anonimous method TDialogService.MessageDialog(AMessage, ADialogType, AButtons, ADefaultButton, 0, procedure (const AResult: TModalResult) begin mr:=AResult end); while mr = mrNone do // wait for modal result Application.ProcessMessages; Result:=mr; end; The code works fine. However depending on which monitor the dialog spawns on, on my system the text is clipped. Dragging the dialog back to monitor 1 from monitor 2 makes the dialog draw correctly. Delphi Alex 11.3. The scale on monitor 1 is 150% and and on monitor 2 it's 100%.

I solved the problem by writing my own implementation of IFMXDialogServiceAsync and IFMXDialogService for windows.

Is there an easy way to change the formatting of the text in a TSpinBox ? I would like my TSpinBox to display a number with a leading 0 for a 24 hour clock format So instead of showing 9 it would show 09 as in "zero nine hundred hours". I am aware there is a TTimeEdit, but it puts it's spinner in an up down configuration not it in a side to side configuration like the TSpinBox. I am using TSpinBox to set YEAR - MONTH - DAY so I would like everything to look the same,

Thanks for the reply. Unfortunately I forgot to mention I am developing a Firemonkey application so TNumberBox has a different implementation to the VCL component with the same name, although I did post the question in the FMX group.

I am writing a program that process data from 196+ channels in real time. I will have to employ digital filter(s) of one sort or another on all 196+ channels simultaneously. It occurred to me that a digital signal processing pipeline on a GPU would be an ideal solution. The data is sampled at 1200 Hz. My question is - Is there a parallel digital signal processing pipeline library for Delphi or C++ builder out there that takes advantage of GPU architecture ? If there is no such library should I code one using NVIDA's CUDA or AMD ROCm ?

I'm trying to follow Dave Millington's code rage example from 2016 on how to use a Delphi abstract class to make an abstract class for use in a C++ Builder bpl library where you need to link to a lib file that is only available in C. https://learndelphi.org/this-is-how-to-use-c-builder-to-extend-the-reach-of-delphi/ https://github.com/Embarcadero/CodeRage2016 I made a function called about in my concrete class called TBridge::About derived for a pure abstract delphi class which I can call sucessfully. However when I do so Application->MessageBox falls over as it doesn't seem able to create a font resource or lacks resources. I am assuming in am not linking some sort of necessary resource file into my C++ BPL ? The question is I don't know which files I should be linking into the BPL to get it to display standard VCL dialogs. MessageDlg doesn't work either. //--------------------------------------------------------------------------- #pragma hdrstop #include "SolidBridge.h" //--------------------------------------------------------------------------- #pragma package(smart_init) #include <windows.h> #include <vcl.h> #include <Vcl.Controls.hpp> #include <Vcl.stdCtrls.hpp> #include <Vcl.Forms.hpp> #include <Dialogs.hpp> #include <Vcl.Dialogs.hpp> void __fastcall TBridge::About() { //Application->MessageBox('Hello world!','About',MB_OK); UnicodeString txt = "Hello world"; Application->MessageBox(L"Hello world",L"About", MB_OKCANCEL); //MessageDlg(txt,mtInformation,TMsgDlgButtons() << mbOK,0); } TAbstractBridge* __stdcall SolidBridgeFactory() { return (TAbstractBridge*)new TBridge(); } ResData is passed in a zero so the first line ResHash := VCL.Graphics.GetHashCode(ResData, ResDataSize); throws an exception in VCL.Graphics {$IF NOT DEFINED(CLR)} function TResourceManager.AllocResource(const ResData): PResource; var ResHash: Word; LOwner: TThreadID; begin ResHash := Vcl.Graphics.GetHashCode(ResData, ResDataSize); Lock; try LOwner := TThread.CurrentThread.ThreadID; Result := ResList; while (Result <> nil) and ((Result^.Owner <> LOwner) or (Result^.HashCode <> ResHash) or not CompareMem(@Result^.Data, @ResData, ResDataSize)) do Result := Result^.Next; if Result = nil then begin GetMem(Result, ResDataSize + ResInfoSize); with Result^ do begin Next := ResList; RefCount := 0; Handle := TResData(ResData).Handle; HashCode := ResHash; Owner := LOwner; Move(ResData, Data, ResDataSize); end; ResList := Result; end; Inc(Result^.RefCount); finally Unlock; end; end; {$ENDIF}

Thanks for the advice - much appreciated. I think I just assumed that the pointer for interfaces were going to be the same sorts in Delphi.

Thanks Remy, Thanks for taking the time to reply to my questions. I haven't done a lot of C++ Builder programming so I didn't realise I had to use smart pointers for interfaces and I didn't know I wasn't supposed to throw New exception objects. I actually switched out my code to use the microsoft xmllite library in the mean time, but at least in the future I will know how to properly handle interfaces in C++ builder. I still have a few grey areas how memory clean up happens in C++ Builder such as should I be setting dynamic arrays to NULL to destroy them or does the C++ Compiler handle it. For example will WSA get destroyed correctly when it goes out of scope or do I need to do something else ? typedef DynamicArray<WideString> DynArrayWideString; DynArrayWideString WSA; WSA.Length = 4; WSA[0] = "A STRING"; WSA[1] = "ANOTHER STRING"; WSA[2] = "STRING 3"; WSA[3] = "END OF LIST";

I'm generally having problems using VCL objects in a Win32 C++ Builder command line programs. I am also having trouble with TXMLDocument and IXMLNODE. I can use TXMLDocument in a VCL builder application and Delphi without a problem but as soon as I try to use it in a C++ Builder command line program I get silent failures THIS CODE IN IT'S OWN THREAD CRASHES TXMLDocument * pMEGConfig = NULL; TDOMVendor *vendor; if(CoInitializeEx(0,COINIT_SPEED_OVER_MEMORY) != S_OK) { return; } pMEGConfig = new TXMLDocument(NULL); vendor = DOMVendors->Find("MSXML"); if( vendor == NULL) { throw new Exception("vendor MSXML XML wasn't found'"); } if(pMEGConfig->Active) { pMEGConfig->Active = false; } pMEGConfig->DOMVendor = vendor; pMEGConfig->LoadFromFile("An XML FILE"); pMEGConfig->Active = true; IXMLNode * ROOT = pMEGConfig->DocumentElement; //THIS LINE CAUSE THE THREAD AND DEBUGGER TO EXIT IMMEDIAETLY AND SILENTLY I am assuming I am some how not linking to the correct lib files and or my compiler / linker settings are wrong