Jump to content

JackT

Members
  • Content Count

    28
  • Joined

  • Last visited

Community Reputation

0 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

    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.
  2. 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.
  3. 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.
  4. 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.
  5. 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
  6. JackT

    FIPS 140

    Ok thanks for the reply -I will try to ask a sales engineer at Embarcadero.
  7. 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 ?
  8. I think I sorted it an old version xmlrtl290.bpl was in the same directory as the executable.
  9. 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
  10. 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
  11. JackT

    Firemonkey 3D vertex and fragment shading

    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
  12. JackT

    Firemonkey 3D vertex and fragment shading

    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
  13. JackT

    Firemonkey 3D vertex and fragment shading

    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.
  14. 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
  15. 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;
×