Ian Branch

35 minutes ago, Remy Lebeau said:

But then why use a thread at all?

Because I still want them to be able to move and resize the App/Form while the thread is running.

If I do it in the main thread the form becomes unresponsive.

Hi Team,

Books have been written about what I don't know about threading... 😉

I have experimented with Anonympus threads.

Is it possible to prevent the App doing anything except being moved, and parhas resized, while a thread is running?

Regards & TIA,

Ian

Well done to Uwe, Peter, & any others, for seeing this issue through.

Ian

11 minutes ago, Dalija Prasnikar said:

There are also tools that can help in writing those, so you don't have to do that manually, like https://devjetsoftware.com/products/documentation-insight/

They don't appear to have a D12 version yet.  😞

Excellent!  Thanks Dalija.

Regards,

Ian

Hi Team,

Like most of us I have my own local pattern procedure/function library.

I have been commenting them like this:

Quote

/// <summary>
/// Determines whether any of the specified bits are set in a given bitmask.
/// </summary>
/// <param name="bits">The bitmask to check.</param>
/// <param name="positions">An array of bit positions to check.</param>
/// <returns>True if any of the specified bits are set, False otherwise.</returns>
/// <remarks>
/// - Validates inputs to ensure meaningful results.
/// - Efficiently iterates through positions using a for loop.
/// - Uses bitwise AND and left-shift operations to check individual bits.
/// - Exits early if a matching bit is found, optimizing performance.
/// </remarks>

What this gives me then is a dropdown when I hover over the procedure/finction in my code that looks something like this:

All very handy and a useful reminder of the procedure/function definition.

I forget where I got this from.   😞

Can somebody point me to where this style of documentation/technique is documented please?

Regards & TIA,

Ian

Quote

To mitigate the impact of long-term server downtime,

Of course, all of this is dictated by available Budget and/or Risk/Impact analysis.

Here's a thought.

What impact, if any, has this outage had on the next update to D12??

Hi Jon,

Tks.  The code is in the MainForm.FormShow Event.

The App is accessed by multiple Users via ThinFinity (WEB), RDP & LAN.

If one of the App has the GlobalSemaphore created, I don't want any of the other Apps running this piece of code.

I don't know that I need to use Acquire at all?

If WaitFor(1) works as suggested, I will be fine.

Regards,

Ian

Hi Team,

Delphi 12.

I am trying my hand at Semaphores.  Never touched them before this.

ATT I have the following code:

  //
  // Create the named semaphore (if it doesn't already exist)
  GlobalSemaphore := TSemaphore.Create(nil, 1, 1, 'DBiAdminSemaphore');
  //
  try
    //
    if GlobalSemaphore.Acquire then
    begin

I understand that if the Semaphore 'DBiAdminSemaphore' already exists, it won't be created again.

If it already exists, I want to test for its existance, hence the thought of Acquire, but it seems Acquire doesn't return a Boolean.

How do I test if the Semaphore already exists?

The objective here is to prevent the following code exceuting if the Semaphore exists.

Regards & TIA,

Ian

Hi Guys,

FWIW, I am using both without issue in D12.

Ian

Getting to be a habit... 😞

No need to apologise, we have all done something like that in our lifetimes.....

Hi Team,

I came across this code and it works straight-up.  I just need to do some tweaks:

procedure ScreenShot(activeWindow: bool; destBitmap: TBitmap);
var
  w, h: integer;
  DC: HDC;
  hWin: Cardinal;
  r: TRect;
begin
  if activeWindow then
  begin
    hWin := GetForegroundWindow;
    dc := GetWindowDC(hWin);
    GetWindowRect(hWin, r);
    w := r.Right - r.Left;
    h := r.Bottom - r.Top;
  end
  else
  begin
    hWin := GetForegroundWindow;
    dc := GetDC(hWin);
    w := GetDeviceCaps(DC, HORZRES);
    h := GetDeviceCaps(DC, VERTRES);
  end;

  try
    destBitmap.Width := w;
    destBitmap.Height := h;
    BitBlt(destBitmap.Canvas.Handle, 0, 0, destBitmap.Width, destBitmap.Height, DC, 0, 0, SRCCOPY);
  finally
    ReleaseDC(hWin, DC);
  end;
end;

procedure TMainForm.Button1Click(Sender: TObject);
var
  path: string;
  b: TBitmap;
begin
  //
  b := TBitmap.Create;
  try
    ScreenShot(TRUE, b);
    Clipboard.SetAsHandle(CF_BITMAP, b.Handle);
    b.SaveToFile(GetDesktopPath + 'Screenshot_1.bmp');
  finally
    b.FreeImage;
    FreeAndNil(b);
  end;
  //
end;

Thank you all for your input.  Appreciated.

Regards,

Ian

Yes, I am playing with it att with mixed results.

Hi Team,

I'm not having much luck here.  I now have this code:

procedure TMainForm.CaptureDialog(WindowHandle: HWND; SaveToClipboard: Boolean; FileName: string = '');
var
  dcWindow: HDC;
  dcMem: HDC;
  bmp: TBitmap;
begin
  dcWindow := GetDC(WindowHandle);
  try
    dcMem := CreateCompatibleDC(dcWindow);
    try
      bmp := TBitmap.Create;
      try
        bmp.Width := GetSystemMetrics(SM_CXSCREEN);
        bmp.Height := GetSystemMetrics(SM_CYSCREEN);
        SelectObject(dcMem, bmp.Canvas.Handle);
        // Adjust PrintWindow options as needed
        PrintWindow(WindowHandle, dcMem, $1);

        if SaveToClipboard then
        begin
          Clipboard.SetAsHandle(CF_BITMAP, bmp.Handle);
        end;

        if FileName <> '' then
        begin
          bmp.SaveToFile(FileName);
        end;
      finally
        bmp.Free;
      end;
    finally
      DeleteDC(dcMem);
    end;
  finally
    ReleaseDC(WindowHandle, dcWindow);
  end;
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
  CaptureDialog(Application.ActiveFormHandle, False, GetDesktopPath+'ScreenCapture2015.bmp');
end;

When I click the button on the form I get an 'image' saved OK but it is all white and looks suspiciously like an all white screen. 😞

Thoughts/suggestions appreciated.

Regards & TIA,

Ian

Hi Team,

Need some help.  Using D12, 32bit App.

I would like to capture just the current form, in some format, and send it to the clipboard, so the User can then paste it into an email.

I found this code:

procedure TMainForm.CaptureDialogToClipboard(WindowHandle: HWND);
var
  dcWindow: HDC;
  dcMem: HDC;
  bmp: TBitmap;
begin
  dcWindow := GetDC(WindowHandle);
  try
    dcMem := CreateCompatibleDC(dcWindow);
    try
      bmp := TBitmap.Create;
      try
        bmp.Width := GetSystemMetrics(SM_CXSCREEN);
        bmp.Height := GetSystemMetrics(SM_CYSCREEN);
        SelectObject(dcMem, bmp.Canvas.Handle);
        PrintWindow(WindowHandle, dcMem, PW_CLIENTONLY); // Adjust options as needed
        Clipboard.SetAsHandle(CF_BITMAP, bmp.Handle);
      finally
        bmp.Free;
      end;
    finally
      DeleteDC(dcMem);
    end;
  finally
    ReleaseDC(WindowHandle, dcWindow);
  end;
end;

Which I think will do the job, but I can't find out where/how PW_CLIENTONLY is declared/defined.

What unit do I need to add???

Regards & TIA,

Ian

Thanks Guys,

It's surprising I have operated under this missunderstanding for so long.... 😞

All good now.

Again, thank you.

Regards,

Ian

Hi Stano,

Tks for the reference.

OK, so it doesn't cause the step.

I need to review a few other pieces of code.  😞

Rightly or wrongly, I have always worked on it stepping.

Dowloaded and installed the latest rev 4182.

After 20 minutes of testing, all good so far.

Hi Team,

Using D12.

It may be my missunderstanding but..

I have the following code:

    Suppliers.First;
    //
    while not Suppliers.eof do
    begin
      //
      sSelected := Suppliers.FieldByName('SupplierCode').AsString;
      sDescription := Suppliers.FieldByName('SupplName').AsString;
      //
      Parts.Close;
      Parts.SQL.Clear;
      Parts.SQL.Text := 'Select * from Parts where SupplierCode = ' + quotedStr(sSelected) + ' and BusCode = ' + QuotedStr(sBusCode);
      Parts.Prepare;
      Parts.Open;
      //
      if Parts.eof then
      begin
        //        TaskMessageDlg('No parts available!', 'There are no Parts on record for Supplier - ' + sDescription + ' at location ' + sLocation + '.',
        //          mtInformation, [mbOK], 0)
        Label1.Caption := 'There are no Parts on record for Supplier - ' + sDescription + ' at location ' + sLocation + '.';
        //
        Suppliers.Next;
        //
        Continue;
        //
      end
      else
      begin
        //

Omitting the Suppliers.Next for the moment, I allways thought that a Continue would have automatically caused Suppliers to move to the next record by virtue of the 'while not Suppliers.eof do'.

In my case of the code above, it doesn't, I had to insert the Suppliers.Next; line.

Was my understand incorrect or is there some other explanation?

Regards & TIA,

Ian

Downloaded and installed.  What specifically would you like tested?

Disregard - All sorted.

Happy New Year...

Hi Team,

I can't find any worked examples of the above.

Anybody got any experience?

Appreciate any examples.

Regards & TIA,

Ian

Hi Daniel,

Thank you for all the work & effort you have put in to this valuable tool.

Very much appreciated.

Regards,

Ian