-
Content Count
2563 -
Joined
-
Last visited
-
Days Won
134
Everything posted by Anders Melander
-
I'm not the OP. My example with MsgWaitForMulpitleObjects used QS_PAINT and DispatchMessage. The OP's use of QS_ALLINPUT is probably based on not understanding the problems associated with it. The circumstances where it's safe to Application.ProcessMessages are so rare that one might just as well not use it. Your example uses it in a button click handler where it's definitely not safe.
-
Oh no, you didn't!
-
I don't understand what you're asking about but you'll probably want to loop around MsgWaitForMultipleObjects - and process the messages somehow since you're using that variant of WaitForMultipleObjects. Don't fall into the trap of calling Application.ProcessMessages to handle the messages. I posted an example of MsgWaitForMultipleObjects yesterday:
-
I have no idea about how TRzLauncher is implemented, but regardless I would just use a thin wrapper around ShellExecuteEx. Here's the implementation I usually use: unit amShell; (* * Copyright © 2006 Anders Melander * * This Source Code Form is subject to the terms of the Mozilla Public * License, v. 2.0. If a copy of the MPL was not distributed with this * file, You can obtain one at http://mozilla.org/MPL/2.0/. *) interface uses Windows, Controls; type Shell = class private public class procedure DisplayURL(const URL: string; Parent: TWinControl = nil; const AdditionalParams: string = ''); class function DisplayFile(const Filename: string; Parent: TWinControl = nil): boolean; class function Execute(const Filename: string; const Parameters: string = ''; Parent: TWinControl = nil; Wait: boolean = False): boolean; overload; class function Execute(Parent: TWinControl; const FileName: string; const Operation: string = 'open'; const Parameters: string = ''; ShowCmd: Integer = SW_SHOWNORMAL; Wait: boolean = False): boolean; overload; static; end; resourcestring sShellExecuteBrowseError = 'Failed to open the homepage in your default browser.'+#13#13+ 'Homepage: %s'+#13+ 'Error: %s'; sShellExecuteFileOpenError = 'Failed to open the file.'+#13#13+ 'Filename: %s'+#13+ 'Error: %s'; implementation uses ActiveX, ShellAPI, SysUtils, IOUtils, Forms, Dialogs, StrUtils, Classes, Types, Messages, IdURI, amCursorService, amDialogs; class function Shell.DisplayFile(const Filename: string; Parent: TWinControl): boolean; var Error: integer; begin Result := Execute(Parent, Filename); if (not Result) then begin Error := GetLastError; MessageDlgEx(Format(sShellExecuteFileOpenError, [Filename, SysErrorMessage(Error)]), mtWarning, [mbOk], 0); end; end; class function Shell.Execute(const Filename, Parameters: string; Parent: TWinControl; Wait: boolean): boolean; var Error: integer; begin Result := Execute(Parent, Filename, '', Parameters, SW_SHOWNORMAL, Wait); if (not Result) then begin Error := GetLastError; MessageDlgEx(Format(sShellExecuteFileOpenError, [Filename, SysErrorMessage(Error)]), mtWarning, [mbOk], 0); end; end; class procedure Shell.DisplayURL(const URL: string; Parent: TWinControl; const AdditionalParams: string); var Error: integer; URI: TIdURI; FinalURL: string; FinalParams: string; ParamList: TStringDynArray; s: string; Params: TStringList; n: integer; Name, Value: string; begin try URI := TIdURI.Create(URL); try // Note that we use TIdURI even with no additional params as we would still like to get the original params encoded (' '->'%20'). if (AdditionalParams <> '') then begin Params := TStringList.Create; try Params.CaseSensitive := False; // Create a Key/Value list of original parameters ParamList := SplitString(URI.Params, '&'); for s in ParamList do Params.Add(s); // Add additional parameters, overriding the original values if there are duplicates ParamList := SplitString(AdditionalParams, '&'); for s in ParamList do begin n := Pos('=', s); if (n <> 0) then begin // Key/Value pair Name := Copy(s, 1, n-1); Value := Copy(s, n+1, MaxInt); Params.Values[Name] := Value; end else // No value, just key Params.Values[s] := ''; end; // Build parameter string FinalParams := ''; for s in Params do if (FinalParams = '') then FinalParams := s else FinalParams := FinalParams + '&' + s; finally Params.Free; end; URI.Params := FinalParams; end; FinalURL := URI.URI; finally URI.Free; end; except on E: EIdURIException do begin s := URL; if (AdditionalParams <> '') then s := s + '(' + AdditionalParams + ')'; MessageDlgEx(Format('Invalid URL: %s'#13'%s', [s, E.Message]), mtWarning, [mbOk], 0); exit; end; end; if (not Execute(Parent, 'rundll32.exe', 'open', 'url.dll,FileProtocolHandler '+FinalURL)) then begin Error := GetLastError; MessageDlgEx(Format(sShellExecuteBrowseError, [FinalURL, SysErrorMessage(Error)]), mtWarning, [mbOk], 0); end; end; class function Shell.Execute(Parent: TWinControl; const FileName, Operation, Parameters: string; ShowCmd: Integer; Wait: boolean): boolean; var Handle: HWND; ShellExecuteInfo: TShellExecuteInfo; Error: integer; Res: Cardinal; Msg: TMsg; begin if (Parent <> nil) then Handle := Parent.Handle else Handle := Application.MainForm.Handle; FillChar(ShellExecuteInfo, SizeOf(ShellExecuteInfo), 0); ShellExecuteInfo.cbSize := SizeOf(ShellExecuteInfo); ShellExecuteInfo.fMask := SEE_MASK_FLAG_NO_UI or SEE_MASK_HMONITOR or SEE_MASK_NOZONECHECKS;// or SEE_MASK_NOCLOSEPROCESS; if (Wait) then ShellExecuteInfo.fMask := ShellExecuteInfo.fMask or SEE_MASK_NOCLOSEPROCESS or SEE_MASK_NOASYNC; ShellExecuteInfo.Wnd := Handle; ShellExecuteInfo.hMonitor := THandle(Application.MainForm.Monitor.Handle); // Cast to avoind range check error if (Operation <> '') then ShellExecuteInfo.lpVerb := PChar(Operation); if (FileName <> '') then ShellExecuteInfo.lpFile := PChar(FileName); if (Parameters <> '') then ShellExecuteInfo.lpParameters := PChar(Parameters); ShellExecuteInfo.lpDirectory := PChar(TPath.GetDirectoryName(Filename)); ShellExecuteInfo.nShow := ShowCmd; SaveCursor(crAppStart); Result := ShellAPI.ShellExecuteEx(@ShellExecuteInfo); if (not Result) then begin Error := GetLastError; if (Error = ERROR_ACCESS_DENIED) then begin // See: // * https://support.microsoft.com/en-us/kb/287087 // * http://wellsr.com/vba/2016/excel/use-vba-shellexecute-to-open-url-in-default-browser/ if (ShellAPI.ShellExecute(Handle, ShellExecuteInfo.lpVerb, ShellExecuteInfo.lpFile, ShellExecuteInfo.lpParameters, nil, CmdShow) > SE_ERR_DLLNOTFOUND) then Result := True else SetLastError(Error); end; end else if (Wait) then begin try while (True) do begin Res := MsgWaitForMultipleObjects(1, ShellExecuteInfo.hProcess, False, INFINITE, QS_PAINT); case Res of WAIT_OBJECT_0: break; WAIT_OBJECT_0+1: while (PeekMessage(Msg, 0, QS_PAINT shl 16, QS_PAINT shl 16, PM_REMOVE)) do begin if (Msg.message = WM_QUIT) then begin PostQuitMessage(Msg.wParam); exit; end; TranslateMessage(Msg); DispatchMessage(Msg); end; else break; end; end; finally CloseHandle(ShellExecuteInfo.hProcess); end; end; end; var NeedCoUninitialize: boolean = False; initialization // ShellExecute needs CoInitialize NeedCoUninitialize := Succeeded(CoInitializeEx(nil, COINIT_APARTMENTTHREADED or COINIT_DISABLE_OLE1DDE)); finalization if (NeedCoUninitialize) then CoUninitialize; end.
-
On the use of Interposers
Anders Melander replied to FPiette's topic in RTL and Delphi Object Pascal
Yeah. It's amazing, given how far web software has come, that web forums (fora?) still can't match 20 years old newsreaders. Sure, there are some things a forum does better (rich content for example) but I still prefer newsreaders. (let's see how many times we can branch this thread 🙂 ) -
using Delphi and working with Maps
Anders Melander replied to alnickels's topic in Algorithms, Data Structures and Class Design
Have you read the documentation? https://developer.here.com/documentation/vector-tiles-api/dev_guide/topics/send-request.html or are you asking what curl is? -
using Delphi and working with Maps
Anders Melander replied to alnickels's topic in Algorithms, Data Structures and Class Design
My point was that if we're talking about VCL then the platform must be Windows. If the platform is Windows then the FMX TMapView control can't be used since it only supports iOS and Android. -
using Delphi and working with Maps
Anders Melander replied to alnickels's topic in Algorithms, Data Structures and Class Design
Since he's asking about VCL I think we can assume that it will not be running on iOS or Android. -
using Delphi and working with Maps
Anders Melander replied to alnickels's topic in Algorithms, Data Structures and Class Design
I would be very careful with basing something on Google Maps. They have already deprecated their API several times and it appears that there's currently no official public API. https://stackoverflow.com/questions/44520345/how-do-i-enable-google-maps-tile-api https://stackoverflow.com/questions/58846393/how-to-apply-api-key-to-google-maps-tile-server-url https://supportcenter.devexpress.com/ticket/details/t817015/can-i-use-google-or-naver-maps-from-the-map-control-or-dashboard-map-in-winform https://cloud.google.com/maps-platform/terms/ DevExpress has a map control that supports OpenStreetMap and Bing Maps. OpenStreetMap: http://wiki.openstreetmap.org/wiki/Tile_usage_policy http://wiki.openstreetmap.org/wiki/Legal_FAQ Bing Maps (most of the links you'll find with Google are currently dead for some reason): http://www.mapslicensing.com/ -
You should only get conflicts when trying to apply a stash if the files you've stashed have changed since you stashed them. If you haven't changed them then something's broken. If you have, well, then there's your conflict. I really would suggest that you try to use a GUI Git client. That would make it much more clear what's going on.
-
I don't understand why you have all these "pull ...resolve conflict". When you are doing a pull you shouldn't have any local changes that aren't pushed so there should be nothing to resolve. Ordinarily I only have conflicts when I merge two local branches. There's never a conflict on pull and I don't even think my tool (SourceTree) allows me to do a pull if there are conflicts. Also, if I had to interrupt my work to change context I would stash my changes, not commit them. Because it's possible to break the rules. For example by doing rebase on a branch that has already been pushed. See: Peter Parker Principle.
-
How do get all strings from a version resource
Anders Melander replied to dummzeuch's topic in Windows API
As far as I remember there's no API for that. I think you will have to parse the resource block yourself. If you're lucky the memory layout is the same as the RES layout but even then many of the structures in the VERSIONINFO RES format are undocumented or very poorly documented. The only suggestion I have is to have a look at the source of Collin Willson's old resource editor and see how he did it (with regard to the RES format). -
looking for UI design ideas for tracking a process
Anders Melander replied to David Schwartz's topic in VCL
They're alpha blended so you'd have to either give that up or use GDI+, Graphics32 or something like it. If I were to implement it as a custom control but I would probably use bitmaps and maybe draw them as 9-patch images so it could be resized. The colors could be applied with a simple HUE filter. -
looking for UI design ideas for tracking a process
Anders Melander replied to David Schwartz's topic in VCL
Building on your concept I would suggest something like this: I've attached the 14 image segments used to create the above. progress arrow elements.zip -
Hrmph!
-
Use of Ansistring in Unicode world?
Anders Melander replied to Mike Torrettinni's topic in General Help
Do you need them to be faster? -
I would suggest you do all these tests without 3rd party add-ons involved. It hard to know where to place the blame otherwise.
-
First of all: Get a GUI Git client. I rarely use the command line during my daily work. I came from Svn and found the transition to Git very confusing because the terminology is different and because you're basically working with two repositories (the local and the one on the server) at once. What Git server do you use? A pull request is just a request to merge a branch into another. The "pull" is from the perspective of the target so it's a request that the target pull the supplied changes. I'm guessing the way you work now is something like this: Create a local branch. Work on the files in the branch. Commit changes to the branch. Merge the branch into Master. Push Master to the server. With a pull request you would work like this: Create a branch (either locally or on the server, doesn't matter). Work on the files in the branch. Commit changes to the branch. Push the branch to the server. Create a pull request on the server. Review the pull request on the server (should be done by someone else). Accept or Reject the pull request. Apply the pull request on the server thereby merging the branch into Master. I'm still not sure I understand the problem but I'll try with a solution anyway. Let's say your main project is in the Projects repository and that you have this mapped locally to C:\Project. Your client data is in the Clients repository and you have this mapped to I:\. Within the Projects repository you have a branch for each client and the same for the Clients repository. The Master branch of each repositories contains the changes that are common for all clients and the individual client branches contains the client specific stuff. When you make changes to Master you will have to merge that back into each of the client branches to keep them up to date. You can create a script that automates this task. Now if you make Clients a submodule of Projects then you can make the individual project branches track the corresponding branch in Clients. This means that when you check out a Projects branch then the corresponding Clients branch will automatically be checked out as well so your I:\ data will contain the correct files.
-
Delphi 10.4.1 LIBSUFFIX AUTO
Anders Melander replied to pyscripter's topic in RTL and Delphi Object Pascal
When did you get that message? On package install? I don't have 10.4.1 installed at the moment (tested the uninstaller yesterday and haven't had time to install again) so I can't try myself. -
I can't see anything in what you describe that is out of the ordinary. Looks like a pretty standard workflow to me. One thing I would do is make sure that very few people have rights to push to Master or whatever you call your primary branch. Instead use pull requests to merge into Master. This avoids the situation where someone forces a push and rewrite history and then later claim that "git must have messed something up". I'm not sure what to do about your I: drive if you really want to have all the files there at all time, regardless of the branch you're working on. If you're okay with pulling the files for a given branch to I: when you work on that branch, then you could reference you I: repository as a submodule in your main Git project. Then each customer could get their own branch in the I: repository. HTH
-
10.4.1 Released today
Anders Melander replied to Darian Miller's topic in Tips / Blogs / Tutorials / Videos
I believe this is mentioned in the release notes: -
10.4.1 Released today
Anders Melander replied to Darian Miller's topic in Tips / Blogs / Tutorials / Videos
Well that's what I get for actually reading the installation instructions. -
10.4.1 Released today
Anders Melander replied to Darian Miller's topic in Tips / Blogs / Tutorials / Videos
I'm positive I didn't get that one. I just now tried running the 10.4.1 uninstaller to see if that dialog would appear. First I get an UAC warning because the uninstaller is unsigned. Then I get this one: And clicking on Yes starts the uninstall so now I have to install again. Damned! Was I meant to just run the 10.4.1 installer and have that perform the uninstall? Here's what the 10.4.1 release notes say: Strictly speaking, the first sentence states that I should uninstall 10.4 and then install 10.4 again, but I'm assuming that wasn't what they meant. -
10.4.1 Released today
Anders Melander replied to Darian Miller's topic in Tips / Blogs / Tutorials / Videos
No. It's just very easy to miss. Bad installer UI. The 10.4.1 release notes stated that there would be an option in the 10.4 uninstaller to keep the settings, but I didn't see any.