Jump to content

Anders Melander

Members
 View Profile  See their activity

  • Content Count

    2848

  • Joined

  • Last visited

  • Days Won

    155

Posts posted by Anders Melander

  4. Posted

    4 minutes ago, FPiette said:

    Sure I did since the poster (You !)

    1. I'm not the OP.
    2. My example with MsgWaitForMulpitleObjects used QS_PAINT and DispatchMessage.
    3. The OP's use of QS_ALLINPUT is probably based on not understanding the problems associated with it.
    4. 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.

  6. Posted

    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:

     

  7. Posted

    On 9/11/2020 at 9:40 AM, David Schwartz said:

    Any thoughts?

    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.

     

    • Like 3

  8. Posted

    39 minutes ago, Uwe Raabe said:

    (Sigh! Sometimes I miss the automatic branching in NNTP readers...)

    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 🙂 )

  12. Posted

    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:

    Bing Maps (most of the links you'll find with Google are currently dead for some reason):

    Quote

     

    The ExpressMap Control allows you to embed multi-layered maps into your VCL applications (be it raster maps provided by popular web mapping resources, vector maps built with elements stored in map files, or a combination of both), add image and text overlays, and pinpoint specific locations on your map with indicators of your choice. With a comprehensive set of customization options, built-in navigation tools and animation support, the ExpressMap Control helps you create interactive map interfaces with ease.
    image.thumb.png.27845ac1f385f87c68829b05d5794eec.png
    Main features include:

    • Capability to simultaneously display an unlimited number of layers painted with image tiles (Image Tile Layer), vector items (Item Layer), and/or shapes loaded from the Esri shapefiles and KML map files (Item File Layer);
    • Support for the Bing Maps™ and OpenStreetMap online map providers (see the licensing information below);
    • A set of UI elements that allow your end-users to scroll, zoom in and out, and see detailed information about the current view;
    • Smooth scroll and zoom animation;
    • Map element highlighting;
    • Support for skins provided with the ExpressSkins Library.

     

    •  

  13. Posted

    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.

    • Like 1

  14. Posted

    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.

     

    11 hours ago, David Schwartz said:

    If someone else is misusing a tool, why should you be impacted by it?

    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.

  15. Posted

    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).

    • Thanks 1

  16. Posted

    7 minutes ago, aehimself said:

    it could be custom-drawn on a TWinControl-descendant and call it a component.

    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.

    image.thumb.png.828711a33fbbed58c391d66d9a9159e3.png

  20. Posted

    10 minutes ago, luebbe said:

    Dock another window (TestInsight) onto the messages window

    I would suggest you do all these tests without 3rd party add-ons involved. It hard to know where to place the blame otherwise.

  21. Posted

    3 hours ago, David Schwartz said:

    I think in pictures, and I've never seen any good illustrations about what goes on when you're working in git.

    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?

     

    4 hours ago, David Schwartz said:

    I don't understand what's meant by "use pull requests to merge into Master".

    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:

    1. Create a local branch.
    2. Work on the files in the branch.
    3. Commit changes to the branch.
    4. Merge the branch into Master.
    5. Push Master to the server.

    With a pull request you would work like this:

    1. Create a branch (either locally or on the server, doesn't matter).
    2. Work on the files in the branch.
    3. Commit changes to the branch.
    4. Push the branch to the server.
    5. Create a pull request on the server.
    6. Review the pull request on the server (should be done by someone else). Accept or Reject the pull request.
    7. Apply the pull request on the server thereby merging the branch into Master.

     

    4 hours ago, David Schwartz said:

    Nobody likes that we do work in one folder and git is constantly shuffling around files in other folders, and throwing up conflicts because someone else is in the middle of doing some work that has nothing to do with what you're working on

    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.

    • Like 1

  23. Posted

    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

    • Like 1

  24. Posted

    1 hour ago, ntavendale said:

    Strangely though, they left Classic Undocked as an option in the drop down used to select the layout, both in the Min IDE form and in the options

    I believe this is mentioned in the release notes:

    Quote

    Desktop layouts which cannot be applied (i.e. are floating layouts, no longer supported, see above) will be listed in gray in the Desktop Layout combo box in the title bar. When a floating layout is applied, the IDE will instead show a dialog.

     

×