shineworld

I'm converting a complex Python PySimpleGUI based program to Python using delphivcl module. In my initial test, the gained speed on UI things sees delphivcl as a very winner. But I need to add some missing features in delphivcl controls as well as the possibility to modify an Image (TImage) content sending it as an array of bitmap (NumPy arrays) instead to have to create a file.bmp and then load it with Image.Picture.LoadFromFile. Also, I need to add OnMouseDown/OnMouseUp in buttons. Gitting delphivcl, or delphifmx, I was not able to find the delphi building project, only the final files. Where I can find sources and projects to make delphivcl module and so to add new features?

Thanks for the info. I remember your suggestion to report the request in github in the issue department. I haven't done it yet because first I would like to try to do something myself, both because I started studying P4D sources and making some modules, and to actually understand how many things are necessary to cover my needs and that they are then useful to everyone. . The project I'm converting from PySimpleGUI is a real-time object recognition system that uses OpenCV and other AI technologies with complicated UIs that need to be really fast, hence the choice of switching to DelphiVCL and / or DelphiFMX. Thanks again for the support.

GetIt is a very useful tool, just a click to install, but if you want to be always on the piece and aligned to the latest changes is better to work directly with sources in github.

I have not yet found a fast way to load TImage contents starting from a NumPy array... this method is enough fast BUT require a file support (at 30FPS SSD will suffer a lot): # gets and shows frame image storing it in a support file bmp_image = cv2.imencode('.bmp', frame)[1].tobytes() stream = BytesIO(bmp_image) with open("f:\output_a.bmp", "wb") as f: f.write(stream.getbuffer()) f.close() self.imgFrameI.Picture.LoadFromFile("f:\output_a.bmp") this method access to TImage canvas but is VERY SLOW: self.imgFrameI.Picture.Bitmap.SetSize(640, 480) canvas = self.imgFrameI.Picture.Bitmap.Canvas rgb_im = PIL_Image.fromarray(frame) for x in range(640): for y in range(480): b, g, r = rgb_im.getpixel((x, y)) rgb = b * 65536 + g * 256 + r canvas.SetPixel(x, y, rgb) There is some other way to set Picture of a Image() object from a image array ?

I was not able to update image content directly from data in memory, but only passing from a support file: def __on_timer_update(self, sender): # gets frame frame = cvc.video_capture_get_frame() bmp_image = cv2.imencode('.bmp', frame)[1].tobytes() # shows frame image storing it in a support file stream = BytesIO(bmp_image) with open("output.bmp", "wb") as f: f.write(stream.getbuffer()) f.close() self.imgFrame.Picture.LoadFromFile("output.bmp") This works but I would like to avoid working with files because 60 FPS are dangerous for SSD devices. There is some other way to assign the image, in this case a BMP to be simple, directly to an Image() object using python + DelphiVCL library module ?

Hi all. I'm trying to create a Python Extension Module with Delphi Sydney. I'm adding an IPC Engine Client to access to one or more IPC Engine Server (either based on Windows Messages). It works and is very a good tool. I've only a question about the resulting python class that does not have a list of properties/methods, not in all cases. Looking at xxx.__dir__ I can get the list of available methods: But if I use the code completion of PyScripter only base TPyDelphiPersistent are available: Strangely if I create a pre-made istance TPyIPCEngineClient object and I add it to the module as SetVar('myIPC', xxxx, xxx) all TPyIPCEngineClient are showed. What I'm mistaking ? Thank you in advance for replies. pycncipc1.zip

My preferred: Image32 SynEdit GLScene

The hard thing with a new environment, eg: Sydney vs Alexandria, is to move all 3rd parties libraries (often to re-buy), but overall learn workaround on always present IDE issues. The time to discover a problem with an IDE and tool-chain and learn the right workarounds to continue to work is a long activity. Back from new created file project to old, in case of very critical issues are a very waste of time.

@pyscripter I will do it surely! I'm trying initially to use the tools as they are. In the second phase, I will try to put my hands on it!

Hi all. I'm new to JSON frameworks and I'm getting lost in a spoonful of water. In the Sydney help I've found this code: JSONValue := TJSONObject.ParseJSONValue('{"colors":[{"name":"red", "hex":"#f00"}]}'); Memo1.Lines.Add('READER:'); if JSONValue is TJSONArray then //... else if JSONVAlue is TJSONObject then Memo1.Lines.Add('colors'); Memo1.Lines.Add('name: '+ JSONValue.GetValue<string>('colors[0].name')); Memo1.Lines.Add('hex: '+ JSONValue.GetValue<string>('colors[0].hex')); Now this works fine but I need to read a client request so formatted: var Text: string; Command: string; JsonValue: TJSONValue; JsonValueArg: TJSONValue; begin // parse json JSONValue := TJSONObject.ParseJSONValue('{"cmd":"program.add.text", "txt":"for I := 0 to 100 do"}'); if not (JSONValue is TJSONObject) then Exit; // gets command type (in Command I've found the "cmd" value "program.add.text". ALL RIGHT!!!) if JSONValue.TryGetValue('cmd', Command) then Exit; // gets command argument txt (does not found the "txt" value and program EXITS!!!) if JSONValue.TryGetValue('txt', Text) then Exit; //... I can't change the JSON request string to contain an array as well as in the Embarcardero sample because reach from a customer program and I've checked with only JSON validator and seem to be fine. What was I've mistaken? Thank you in advance for your replies.

I'm not aware of that, I'm an occasional user of Indy classes. So on TIdTTCPServerContex.Execute is better do not manage exceptions on WriteLn because are correctly managed in TidTCPServer.Execute caller? To be honest I've got some issues during close application when I do TIdTCPServer.Active := False and TIdTCPServer.Free; with connected clients... Could be because I catch the exceptions on Execute().... and the caller doesn't manage the right closing states. I've changed to: procedure TIPCTCPServerContext.Execute; type TRequestType = ( rqtpCmd, rqtpGet, rqtpSet ); var ArgS: string; ArgI: Integer; Command: string; Request: string; Response: string; JsonValue: TJSONValue; RequestType: TRequestType; begin // sets default response Response := RES_NULL; // extracts request from tcp stack Request := Trim(Connection.IOHandler.ReadLn); try // gets request type JSONValue := TJSONObject.ParseJSONValue(Request); try if not (JSONValue is TJSONObject) then Exit; 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; Exit; end; // evaluates request type case RequestType of rqtpCmd: begin if Command = 'cnc.homing' then begin if not JSONValue.TryGetValue<Integer>('["axes.mask"]', ArgI) then Exit; Response := DoCmdCNCHoming(ArgI); end else if Command = 'cnc.mdi.command' then begin if not JSONValue.TryGetValue('command', ArgS) then Exit; 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 Exit; 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 Exit; Response := DoCmdProgramGCodeSetText(ArgS); end else if Command = 'program.load' then begin if not JSONValue.TryGetValue('name', ArgS) then Exit; 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 Exit; end; rqtpGet: begin if Command = 'axes.info' then Response := DoGetAxesInfo else if Command = 'cnc.info' then Response := DoGetCNCInfo else if Command = 'compile.info' then Response := DoGetCompileInfo else if Command = 'system.info' then Response := DoGetSystemInfo else Exit; end; rqtpSet: begin //## end; end; finally JSONValue.Free; end; finally Connection.IOHandler.WriteLn(Response); end; end; Should be more right now...

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: