shineworld

Yes Remy, I've made procedure TIPCTCPServerContext.Execute; type TRequestType = ( rqtpCmd, rqtpGet, rqtpSet ); var ArgS: string; ArgI: Integer; Command: string; Request: string; Response: string; JsonValue: TJSONValue; RequestType: TRequestType; begin try // sets default response Response := RES_NULL; // extracts request from tcp stack Request := Trim(Connection.IOHandler.ReadLn); // gets request type JSONValue := TJSONObject.ParseJSONValue(Request); try if not (JSONValue is TJSONObject) then AbortFast; while True do begin if JSONValue.TryGetValue(REQ_CMD, Command) then begin RequestType := rqtpCmd; Break; end; if JSONValue.TryGetValue(REQ_GET, Command) then begin RequestType := rqtpGet; Break; end; if JSONValue.TryGetValue(REQ_SET, Command) then begin RequestType := rqtpSet; Break; end; AbortFast; end; // evaluates request type case RequestType of rqtpCmd: begin if Command = 'cnc.homing' then begin if not JSONValue.TryGetValue<Integer>('["axes.mask"]', ArgI) then AbortFast; Response := DoCmdCNCHoming(ArgI); end else if Command = 'cnc.mdi.command' then begin if not JSONValue.TryGetValue('command', ArgS) then AbortFast; Response := DoCmdCNCMDICommand(ArgS); end else if Command = 'cnc.pause' then Response := DoCmdCNCPause else if Command = 'cnc.resume.after.pause' then Response := DoCmdCNCResumeAfterPause else if Command = 'cnc.resume.after.stop' then begin if JSONValue.TryGetValue<Integer>('line', ArgI) then Response := DoCmdCNCResumeAfterStop(ArgI) else Response := DoCmdCNCResumeAfterStop(0); end else if Command = 'cnc.start' then begin if JSONValue.TryGetValue<Integer>('line', ArgI) then Response := DoCmdCNCStart(ArgI) else Response := DoCmdCNCStart(0); end else if Command = 'cnc.stop' then Response := DoCmdCNCStop else if Command = 'program.analysis' then begin if JSONValue.TryGetValue('mode', ArgS) then Response := DoCmdProgramAnalysis(ArgS) else Response := DoCmdProgramAnalysis(''); end else if Command = 'program.analysis.abort' then Response := DoCmdProgramAnalysisAbort else if Command = 'program.gcode.add.text' then begin if not JSONValue.TryGetValue('text', ArgS) then AbortFast; Response := DoCmdProgramGCodeAddText(ArgS); end else if Command = 'program.gcode.clear' then Response := DoCmdProgramGCodeClear else if Command = 'program.gcode.set.text' then begin if not JSONValue.TryGetValue('text', ArgS) then AbortFast; Response := DoCmdProgramGCodeSetText(ArgS); end else if Command = 'program.load' then begin if not JSONValue.TryGetValue('name', ArgS) then AbortFast; Response := DoCmdProgramLoad(ArgS); end else if Command = 'program.new' then Response := DoCmdProgramNew else if Command = 'program.save' then begin if JSONValue.TryGetValue('name', ArgS) then Response := DoCmdProgramSave(ArgS) else Response := DoCmdProgramSave('') end else AbortFast; end; rqtpGet: begin if Command = 'system.info' then Response := DoGetSystemInfo else if Command = 'axes.info' then Response := DoGetAxesInfo else AbortFast; end; rqtpSet: begin //## end; end; finally JSONValue.Free; end; // sends response as json contents Connection.IOHandler.WriteLn(Response); except try Connection.IOHandler.WriteLn(Response) except end; end; end;

Hi all, I'm trying to use TTask to perform some parallel code with Sydney 10.4.1 looking at the sample code in Help System, so it should be supported by 10.4.1: but I've got always the error: [dcc32 Error] osIPCTCPServerContext.pas(423): E2250 There is no overloaded version of 'Create' that can be called with these arguments Have you any idea about it? Thank you in advance for replies.

Works perfectly !!! The only issue is on Delphi LSP which seems unable to elaborate pascal code for anonymous procedures on TTask( proc or TThread.Synchronize( Self, proc..,

Same of mine:

WOW compile but IDE signs as error. Perhaps is a bug in LSP...

You are RIGHT !!! Very sorry for this typo....

In a project file usually, I add that: // checks if application is already running AppplicationID := '{BFA11B69-B59C-40BA-BABB-724F2BF3AFE4}'; RunOnceMutex := CreateMutex(nil, True, @ApplicationID[1]); if RunOnceMutex <> 0 then begin if GetLastError = ERROR_ALREADY_EXISTS then begin ShowErrorMessage ( _('Application already running'), _('Press OK button to quit application'), _('Instance of this application is already running !'), _('For each computer, or virtual machine, is allowed to start a single instance of the Control Software. ' + 'If you see this message it means that an application instance is already loaded and running.') ); CloseHandle(RunOnceMutex); Halt; end end; Take care to create a different UUID for every singleton application. You can fastly create a new UUID pressing CTRL + SHIFT + G in Delphi IDE.

You can get any info with WMI support. WMI covers a very very incredible set of infos. This is a sample that I use to recover some system info. unit osSystemInfo; interface type TSystemInfoMode = ( simdCompact, simdFull ); TMotherBoardInfo = ( mbiSerialNumber, mbiManufacturer, mbiProduct, mbiModel ); TMotherBoardInfos = set of TMotherBoardInfo; TOSInfo = ( osiBuildNumber, osiBuildType, osiManufacturer, osiName, osiSerialNumber, osiVersion ); TOSInfos = set of TOSInfo; TProcessorInfo = ( priDescription, priManufacturer, priName, priProcessorId, priUniqueId, priSystemName ); TProcessorInfos = set of TProcessorInfo; type TSystemInfo = class private FBuffer: AnsiString; FMotherBoardInfos: TMotherBoardInfos; FNeedUninitialize: Boolean; FOSInfos: TOSInfos; FProcessorInfos: TProcessorInfos; private procedure Clear; public function GenerateInfo(Mode: TSystemInfoMode = simdCompact): Boolean; public property Buffer: AnsiString read FBuffer; property MotherBoardInfos: TMotherBoardInfos read FMotherBoardInfos write FMotherBoardInfos; property OSInfos: TOSInfos read FOSInfos write FOSInfos; property ProcessorInfos: TProcessorInfos read FProcessorInfos write FProcessorInfos; public constructor Create; destructor Destroy; override; end; implementation uses ComObj, ActiveX, SysUtils, Variants, osExceptionUtils; var MotherBoardInfoText: array[TMotherBoardInfo] of AnsiString = ( 'SerialNumber', 'Manufacturer', 'Product', 'Model' ); OSInfoText: array [TOSInfo] of AnsiString = ( 'BuildNumber', 'BuildType', 'Manufacturer', 'Name', 'SerialNumber', 'Version' ); ProcessorInfoText: array [TProcessorInfo] of AnsiString = ( 'Description', 'Manufacturer', 'Name', 'ProcessorId', 'UniqueId', 'SystemName' ); procedure TSystemInfo.Clear; begin FBuffer := ''; end; constructor TSystemInfo.Create; begin inherited; FBuffer := ''; FMotherBoardInfos := []; FNeedUninitialize := False; FOSInfos := []; FProcessorInfos := []; FNeedUninitialize := CoInitialize(nil) = S_OK; end; destructor TSystemInfo.Destroy; begin if FNeedUninitialize then CoUninitialize; inherited; end; function TSystemInfo.GenerateInfo(Mode: TSystemInfoMode): Boolean; var S: AnsiString; OSInfo: TOSInfo; IValue: LongWord; OSInfos: TOSInfos; OEnum: IEnumvariant; OWmiObject: OLEVariant; ObjWMIService: OLEVariant; ObjSWbemLocator: OLEVariant; objWbemObjectSet: OLEVariant; ProcessorInfo: TProcessorInfo; ProcessorInfos: TProcessorInfos; MotherBoardInfo: TMotherBoardInfo; MotherBoardInfos: TMotherBoardInfos; function VarArrayToStr(const vArray: Variant): AnsiString; function _VarToStr(const V: Variant): AnsiString; var Vt: Integer; begin Vt := VarType(V); case Vt of varSmallint, varInteger : Result := AnsiString(IntToStr(Integer(V))); varSingle, varDouble, varCurrency : Result := AnsiString(FloatToStr(Double(V))); varDate : Result := AnsiString(VarToStr(V)); varOleStr : Result := AnsiString(WideString(V)); varBoolean : Result := AnsiString(VarToStr(V)); varVariant : Result := AnsiString(VarToStr(Variant(V))); varByte : Result := AnsiChar(Byte(V)); varString : Result := AnsiString(V); varArray : Result := VarArrayToStr(Variant(V)); end; end; var I: Integer; begin Result := '['; if (VarType(vArray) and VarArray) = 0 then Result := _VarToStr(vArray) else begin for I := VarArrayLowBound(vArray, 1) to VarArrayHighBound(vArray, 1) do begin if I = VarArrayLowBound(vArray, 1) then Result := Result + _VarToStr(vArray[I]) else Result := Result + '|' + _VarToStr(vArray[I]); end; end; Result:=Result + ']'; end; function VarStrNull(const V: OleVariant): AnsiString; begin Result := ''; if not VarIsNull(V) then begin if VarIsArray(V) then Result := VarArrayToStr(V) else Result := AnsiString(VarToStr(V)); end; end; begin Clear; try ObjSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator'); if VarIsNull(ObjSWbemLocator) then AbortFast; ObjWMIService := objSWbemLocator.ConnectServer('localhost','root\cimv2', '',''); if VarIsNull(ObjWMIService) then AbortFast; if FMotherBoardInfos <> [] then begin MotherBoardInfos := FMotherBoardInfos; ObjWbemObjectSet := objWMIService.ExecQuery('SELECT * FROM Win32_BaseBoard', 'WQL', 0); OEnum := IUnknown(ObjWbemObjectSet._NewEnum) as IEnumVariant; while OEnum.Next(1, OWmiObject, IValue) = 0 do begin if MotherBoardInfos = [] then Break; for MotherBoardInfo := Low(TMotherBoardInfo) to High(TMotherBoardInfo) do begin if MotherBoardInfo in FMotherBoardInfos then begin S := VarStrNull(OWmiObject.Properties_.Item(MotherBoardInfoText[MotherBoardInfo]).Value); Exclude(MotherBoardInfos, MotherBoardInfo); case Mode of simdCompact: FBuffer := FBuffer + S; simdFull: FBuffer := FBuffer + MotherBoardInfoText[MotherBoardInfo] + ' = ' + S + #13#10; end; end; end; OWmiObject := Unassigned; end; end; if FOSInfos <> [] then begin OSInfos := FOSInfos; ObjWbemObjectSet := objWMIService.ExecQuery('SELECT * FROM Win32_OperatingSystem', 'WQL', 0); OEnum := IUnknown(ObjWbemObjectSet._NewEnum) as IEnumVariant; while OEnum.Next(1, OWmiObject, IValue) = 0 do begin if OSInfos = [] then Break; for OSInfo := Low(TOSInfo) to High(TOSInfo) do begin if OSInfo in OSInfos then begin S := VarStrNull(OWmiObject.Properties_.Item(OSInfoText[OSInfo]).Value); Exclude(OSInfos, OSInfo); case Mode of simdCompact: FBuffer := FBuffer + S; simdFull: FBuffer := FBuffer + OSInfoText[OSInfo] + ' = ' + S + #13#10; end; end; end; OWmiObject := Unassigned; end; end; if FProcessorInfos <> [] then begin ProcessorInfos := FProcessorInfos; ObjWbemObjectSet := objWMIService.ExecQuery('SELECT * FROM Win32_Processor', 'WQL', 0); OEnum := IUnknown(ObjWbemObjectSet._NewEnum) as IEnumVariant; while OEnum.Next(1, OWmiObject, IValue) = 0 do begin if ProcessorInfos = [] then Break; for ProcessorInfo := Low(TProcessorInfo) to High(TProcessorInfo) do begin if ProcessorInfo in ProcessorInfos then begin S := VarStrNull(OWmiObject.Properties_.Item(ProcessorInfoText[ProcessorInfo]).Value); Exclude(ProcessorInfos, ProcessorInfo); case Mode of simdCompact: FBuffer := FBuffer + S; simdFull: FBuffer := FBuffer + ProcessorInfoText[ProcessorInfo] + ' = ' + S + #13#10; end; end; end; OWmiObject := Unassigned; end; end; Result := True; except Clear; Result := False; end; end; end. There is also a WMI Delphi Code Generator in which you can brose the interesting data and it creates code for you: https://github.com/RRUZ/wmi-delphi-code-creator

I will try surely! Thank you again. Python extension and support on our products were strong requirements from customers. Happy to know how simple is to do with py4d.

Hi all. Some days ago I've installed the CnWizards_1.2.0.1035 to try the remove unused units for uses sections. Saw that it does not work as aspected I've uninstalled the software. After this, the right mouse click mouse disappears and at now only the following pop-up appears: How to restore original popup with Evaluate, etc etc?

Hi all, there is a fast way to identify and so remove the unused uses units ? During the development process, often, I add the required uses to compile, but after months of development, some units could become unused and I would like to remove them. At moment, I need to comment one by one and check if the compiler raises an error for the missing unit. Thank you in advance for reply!

Tried Peganza Analyzer Lite and that is what I need 🙂

Hi all, I've already used Themes, with satisfaction, on some little applications. In a big application, I haven't used the TStyleManager.Engine because too hard to re-design the entire application, but I would like to have a way to style only the scrollbars colors of a TSynEdit component. It is, in some way, possible to add ONLY the TScrollingStyleHook behavior in a program without the Style engine running? Thank you for your suggenstions!

In the end, I've solved placing two external TScrollbars (TAdvSmoothScroolbars from TMS), they permit a deep control of colors and removing Windows SCROLLBAR created by TSynEdit. - The SynEdit.ScrollBars := ssNone; - The SynEdit.UpdateScrollbars from private to protected and of dynamic type. - A helper class in my editor frame class: unit osGCodeEditorFrame; interface uses ... type TGCodeEditor = class(SynEdit.TSynEdit) private procedure EditorVBarPositionChanged(Sender: TObject; Position: Integer); procedure EditorHBarPositionChanged(Sender: TObject; Position: Integer); protected procedure UpdateScrollBars; override; private FInUpdateScrollBars: Boolean; public EditorHBar: TAdvSmoothScrollBar; EditorVBar: TAdvSmoothScrollBar; end; ... ... // creates and sets gcode editor FGCodeEditor := TSynEdit.Create(Self); FGCodeEditor.Parent := Self; FGCodeEditor.Align := alClient; FGCodeEditor.Visible := True; FGCodeEditor.ScrollBars := ssNone; // creates and sets gcode editor horizontal scroll bar FGCodeEditor.EditorHBar := TAdvSmoothScrollBar.Create(Self); FGCodeEditor.EditorHBar.Parent := Self; FGCodeEditor.EditorHBar.Align := alBottom; FGCodeEditor.EditorHBar.Kind := sbHorizontal; FGCodeEditor.EditorHBar.OnPositionChanged := FGCodeEditor.EditorHBarPositionChanged; // creates and sets gcode editor vertical scroll bar FGCodeEditor.EditorVBar := TAdvSmoothScrollBar.Create(Self); FGCodeEditor.EditorVBar.Parent := Self; FGCodeEditor.EditorVBar.Align := alRight; FGCodeEditor.EditorVBar.Kind := sbVertical; FGCodeEditor.EditorVBar.OnPositionChanged := FGCodeEditor.EditorVBarPositionChanged; ... { TGCodeEditor } procedure TGCodeEditor.EditorHBarPositionChanged(Sender: TObject; Position: Integer); begin if FInUpdateScrollBars then Exit; LeftChar := EditorHBar.Position; end; procedure TGCodeEditor.EditorVBarPositionChanged(Sender: TObject; Position: Integer); begin if FInUpdateScrollBars then Exit; TopLine := EditorVBar.Position; end; procedure TGCodeEditor.UpdateScrollBars; var MaxScroll: Integer; ScrollInfo: TScrollInfo; begin inherited; // checks if standard scroll bars enabled if ScrollBars <> ssNone then Exit; // check if custom scroll bars enabled if (EditorVBar = nil) or (EditorHBar = nil) then Exit; FInUpdateScrollBars := True; try // evaluates for custom horizontal scrollbar if EditorHBar <> nil then begin MaxScroll := Max(TSynEditStringList(Lines).LengthOfLongestLine, 1); ScrollInfo.nMin := 1; ScrollInfo.nMax := MaxScroll; ScrollInfo.nPage := CharsInWindow; ScrollInfo.nPos := LeftChar; EditorHBar.Min := ScrollInfo.nMin; EditorHBar.Max := ScrollInfo.nMax; EditorHBar.PageSize := ScrollInfo.nPage; EditorHBar.Position := ScrollInfo.nPos; EditorHBar.Visible := ScrollInfo.nMax > CharsInWindow; end else EditorHBar.Visible := False; // evaluates for custom vertical scrollbar if EditorVBar <> nil then begin MaxScroll := DisplayLineCount; ScrollInfo.nMin := 1; ScrollInfo.nMax := Max(1, MaxScroll); ScrollInfo.nPage := LinesInWindow; ScrollInfo.nPos := TopLine; EditorVBar.Min := ScrollInfo.nMin; EditorVBar.Max := ScrollInfo.nMax; EditorVBar.PageSize := ScrollInfo.nPage; EditorVBar.Position := ScrollInfo.nPos; EditorVBar.Visible := ScrollInfo.nMax > LinesInWindow; end else EditorVBar.Visible := False; finally FInUpdateScrollBars := False; end; end; In this way is possible to use standard scrollbars or custom and use the already available and called in TSynEdit.UpdateScrollbars, which does nothing is ScrollBars = ssNone to manage update of external custom scrollbars. Works perfectly:

Hi all, I'm using Sydney 10.4.1 and I'm used to works with ProjectGroups formed by 8-12 projects. A project could have only WIN32 version and other have either WIN32 and WIN64 versions. A WIN32 build outputs an exe as <project_name>.32.exe. A WIN64 build outputs an exe as <project_name>.64.exe There is a way to say to IDE: Build all projects versions (Win32 or Win32/Win64 when projects have either) in a single click? At this moment I need to continue to switch manually the active Target Platform from WIN32 to WIN64 and it is a great waste of time. Thank you in advance for your replies.

Thanks Uwe Raabe, the Build Groups is what I need!!!

I'm using a cleaned gnugettext version from dxgettext-code-r131-trunk in sourceforge: https://sourceforge.net/p/dxgettext/code/HEAD/tree/ - I'm using an update manager in EXE so when the update copies the new locale.mo files from the server they are named locale.mo_NEW. This is because you can't overwrite a loaded locale.po when EXE is running, so in its restart, after an online update, the gnugettext.pas finds any locale.mo_NEW and renames to locale.mo before loading them. - I've added a {$INCLUDE Settings.inc} where the USES_LOCALE_ON_USER_DATA_PATH define is used, when not set, during debugging, to SWITCH locale path from %APPDATA%\... to development project path. This permits me to keep all locale.po/mo in the development sources git. The final program will use the locale path on %APPDATA%\myprogram\locale how must be. - Cleaned sources removing LINUX parts. osCustomize.pas, not added in attached files, just define LOCALE_NAME which can be the string 'locale' or 'locale-ppv' to have more locale libraries for two versions of same project (normal and vertical touch version, where more text are all uppercaese or short than normal version). gnugettext.pas languagecodes.pas osGNUGetTextUtils.pas osSysPath.pas gnugettext.pas-original

I haven't followed this way but another way for Action Caption and also for Combobox items and so on. The issue is that translations work one time, when contents are in English (starting language) to any other language (for eg: EN to IT) because they are initially copied from DFM to object fields. When I try to switch EN to IT and then to CZ for objects which don't recover data from DFM translations obviously doesn't work. But there is a solution that I use: TPageProjectWorkFrame = class(TFrame) ... private procedure ReTranslateEvent(Sender: TObject); ... end; uses gnugettext, ... osGNUGetTextUtils; constructor TPageProjectWorkFrame.Create(AOwner: TComponent); begin inherited; ... // links object/event to translate manager and re-translate GNURetranslateManager.Add(Self, ReTranslateEvent); GNURetranslateManager.ReTranslate; end; destructor TPageProjectWorkFrame.Destroy; begin // unlinks object/event from translate manager GNURetranslateManager.Remove(Self, ReTranslateEvent); ... end; procedure TPageProjectWorkFrame.ReTranslateEvent(Sender: TObject); begin AnalysisAction.Caption := _('ANALYSIS'); BackAction.Caption := _('BACK'); CoordinatesModeAction.Caption := _('WCS MODE') HomingAAction.Caption := _('HOMING A'); HomingAction.Caption := _('HOMING'); HomingAllAction.Caption := _('HOMING ALL'); HomingBAction.Caption := _('HOMING B'); HomingCAction.Caption := _('HOMING C'); HomingXAction.Caption := _('HOMING X'); HomingYAction.Caption := _('HOMING Y'); HomingZAction.Caption := _('HOMING Z'); JogAction.Caption := _('JOG'); MacroAction.Caption := _('MACRO'); ShowWork3DAction.Caption := _('WORK 3D'); ShowWorkSimulateAction.Caption := _('SIMULATE'); end; The GNURetranslateManager is a singleton object which call registered objects RetranslateEvent every time a language change. GNURetranslateManager call internally TranslateComponents (first call) or ReTranslateComponents (next call) automatically for all objects which starts always from DFM english texts (as Label, Panels, etc). Usually I keep Actions Caption empty in the designer (but not necessary) and when RetranslateEvent is called I add _('xxx') with original English language to translate. This automatically update linked action objects. It works perfectly with Frame and Forms (VCL, never tried FMX applications). osGNUGetTextUtils.pas

dxgettext works for 32 and 64-bit VLC applications with Sydney 10.4.1 I build either version of the same big application. Never tried FMX. These are the files that I've used with either. extra.zip

I'm using dxgettext for at least 10 years, and I can say "IT WORKS" but you have to manage many things... I've never tried other ways, however... and this is my limit. Any languages have its rules for plurals, and the same term could change meanings depending on the place where it is used. You have to spend a lot of time creating simple but clear initial English texts. https://youtu.be/Ac3xV1X7uzE For dxgettext you can use PoEdit editor which helps a lot for initial translations using Google or MS online translations servicies.

There are some very good things in FMX that I would like to have in VCL.... Migrate a full application from VCL to FMX is a nightmare and to have a way to do is not so bad. For new projects, I will plan to TRY the FMX world.

Look at this github project on how to embedded FMX form in a VCL application: https://github.com/vintagedave/firemonkey-container https://parnassus.co/open-source/tfiremonkeycontainer/ I will try next week to embed a FMX 3D Opengl form in my VCL App...

I'm in the same situation. I've solved that using git branches feature.

Any idea on how to "force" the scrollbar colors? With dark mode are very very ugly: I've googled a lot searching for a way to use TThemeManager forcing it only to a component without results...

I've already added Style in TSynEdit and it is very simple to do. For example, to add the Scrollbar style is only necessary to add this line: uses Vcl.Themes; {$R *.dfm} procedure TForm8.FormCreate(Sender: TObject); begin TStyleManager.Engine.RegisterStyleHook(TCustomSynEdit, TScrollingStyleHook); end; But I don't would to enable styling in all my project BUT only to SynEdit scrollbar so this is not a way to follow. Perhaps I need to study a way to "extract" what Vcl.Theme manager does for TScrollingStyleHook and to apply only to my version of TCustomSynEdit... Unfortunately, the entire project already living with an old theme system (Light/Dark), and now I can't change it.