commonUnit.Wait2.pas

unit commonUnit.Wait2;

interface

type
  TWait = class
    /// <summary>
    /// Показывает диалог ожидания.
    /// </summary>
    /// <param name="_title">
    /// Жирный текст сверху, по умолчанию 'Идет выбор данных...'.
    /// </param>
    /// <param name="_text">
    /// Мелкий текст снизу, по умолчанию 'ждите...'.
    /// </param>
    class procedure Show(const _title: string = 'Идет выбор данных...';
      const _text: string = 'ждите...'); static;
    /// <summary>
    /// Отображает прогресс выполнения операции.
    /// </summary>
    /// <param name="currentValue">
    /// Текущее значение прогресса.
    /// </param>
    /// <param name="maxValue">
    /// Максимальное значение прогресса.
    /// </param>
    class procedure Progress(_currentValue, _maxValue: real); static;
    /// <summary>
    /// Скрывает диалог ожидания.
    /// </summary>
    class procedure Hide; static;
  end;

implementation

uses
  Windows, SysUtils, ExtCtrls, Math, Forms, Winapi.MultiMon, Winapi.Messages,
  Vcl.Graphics, Controls, Classes, pngimage;

type
  TWaitFormThread = class(TThread)
  public
    procedure Execute; override;
  end;

const
  windowWidth: integer = 483;
  windowHeight: integer = 79;
  className: string = '809819320171410FB2FBA1E60F4055CE';

var
  waitWindow: HWND;
  thread: TWaitFormThread;
  [VolatileAttribute] title: string;
  [VolatileAttribute] text: string;
  [VolatileAttribute] currentValue: real;
  [VolatileAttribute] maxValue: real;
  progressGlow: TPngImage;
  progressGlowLeft: TPngImage;
  progressGlowRight: TPngImage;
  progressPoint: TPngImage;

{$region 'images'}
const
PROGRESS_GLOW : TBytes = [
$89, $50, $4E, $47, $0D, $0A, $1A, $0A, $00, $00, $00, $0D, $49, $48, $44, $52, $00, $00, $00, $01, $00, $00, $00,
$12, $08, $06, $00, $00, $00, $9A, $57, $B4, $BC, $00, $00, $00, $06, $62, $4B, $47, $44, $00, $FF, $00, $FF, $00,
$FF, $A0, $BD, $A7, $93, $00, $00, $00, $09, $70, $48, $59, $73, $00, $00, $0B, $13, $00, $00, $0B, $13, $01, $00,
$9A, $9C, $18, $00, $00, $00, $07, $74, $49, $4D, $45, $07, $E1, $0A, $19, $09, $2B, $1C, $1B, $CD, $F8, $9A, $00,
$00, $00, $1D, $69, $54, $58, $74, $43, $6F, $6D, $6D, $65, $6E, $74, $00, $00, $00, $00, $00, $43, $72, $65, $61,
$74, $65, $64, $20, $77, $69, $74, $68, $20, $47, $49, $4D, $50, $64, $2E, $65, $07, $00, $00, $00, $3A, $49, $44,
$41, $54, $08, $D7, $05, $C1, $21, $12, $82, $00, $00, $00, $C1, $E5, $02, $8D, $42, $A0, $32, $F8, $38, $9F, $0D,
$63, $35, $50, $68, $04, $65, $D7, $FB, $6F, $08, $85, $31, $4C, $61, $09, $6B, $78, $85, $2D, $CC, $41, $38, $C3,
$11, $F6, $F0, $09, $DF, $70, $85, $3B, $FC, $1E, $2B, $8F, $09, $89, $EE, $28, $FC, $A2, $00, $00, $00, $00, $49,
$45, $4E, $44, $AE, $42, $60, $82];
PROGRESS_GLOW_LEFT : TBytes = [
$89, $50, $4E, $47, $0D, $0A, $1A, $0A, $00, $00, $00, $0D, $49, $48, $44, $52, $00, $00, $00, $0A, $00, $00, $00,
$12, $08, $06, $00, $00, $00, $62, $B7, $4F, $4B, $00, $00, $00, $06, $62, $4B, $47, $44, $00, $FF, $00, $FF, $00,
$FF, $A0, $BD, $A7, $93, $00, $00, $00, $09, $70, $48, $59, $73, $00, $00, $0B, $13, $00, $00, $0B, $13, $01, $00,
$9A, $9C, $18, $00, $00, $00, $07, $74, $49, $4D, $45, $07, $E1, $0A, $19, $09, $2A, $24, $2A, $D4, $71, $45, $00,
$00, $00, $1D, $69, $54, $58, $74, $43, $6F, $6D, $6D, $65, $6E, $74, $00, $00, $00, $00, $00, $43, $72, $65, $61,
$74, $65, $64, $20, $77, $69, $74, $68, $20, $47, $49, $4D, $50, $64, $2E, $65, $07, $00, $00, $00, $B1, $49, $44,
$41, $54, $28, $CF, $95, $D2, $ED, $4A, $03, $31, $10, $85, $E1, $27, $D9, $AD, $5D, $FB, $61, $D1, $42, $2F, $B1,
$D7, $2F, $08, $DA, $52, $ED, $F6, $CF, $44, $06, $BA, $AC, $35, $70, $C8, $90, $79, $39, $99, $4C, $A6, $98, $59,
$C7, $51, $69, $71, $99, $49, $E6, $5C, $29, $13, $50, $53, $CD, $71, $99, $80, $2A, $3A, $F4, $A1, $EE, $17, $4C,
$50, $03, $96, $49, $4F, $58, $F4, $A9, $9E, $1A, $D0, $80, $15, $36, $A1, $15, $86, $3E, $15, $5F, $B1, $C0, $33,
$76, $78, $C5, $5B, $C4, $EB, $EC, $D8, $05, $38, $60, $8B, $3D, $0E, $B1, $BF, $64, $B0, $24, $D7, $65, $5C, $B9,
$0D, $C7, $5D, $F5, $E0, $6A, $8E, $63, $E8, $8A, $0B, $CE, $F8, $C4, $47, $BC, $7A, $CC, $E0, $4F, $40, $A7, $00,
$FA, $38, $3F, $E1, $BD, $F5, $B1, $A6, $FA, $A6, $DB, $93, $1C, $AF, $F8, $0E, $87, $31, $E2, $AF, $D6, $F0, $FF,
$7D, $E1, $1F, $43, $51, $EF, $A6, $E7, $E1, $31, $9B, $1B, $DC, $1B, $24, $00, $28, $16, $6A, $D7, $DA, $BF, $00,
$00, $00, $00, $49, $45, $4E, $44, $AE, $42, $60, $82
];
PROGRESS_GLOW_RIGHT : TBytes = [
$89, $50, $4E, $47, $0D, $0A, $1A, $0A, $00, $00, $00, $0D, $49, $48, $44, $52, $00, $00, $00, $0A, $00, $00, $00,
$12, $08, $06, $00, $00, $00, $62, $B7, $4F, $4B, $00, $00, $00, $06, $62, $4B, $47, $44, $00, $FF, $00, $FF, $00,
$FF, $A0, $BD, $A7, $93, $00, $00, $00, $09, $70, $48, $59, $73, $00, $00, $0B, $13, $00, $00, $0B, $13, $01, $00,
$9A, $9C, $18, $00, $00, $00, $07, $74, $49, $4D, $45, $07, $E1, $0A, $19, $0B, $32, $00, $97, $48, $D9, $A3, $00,
$00, $00, $1D, $69, $54, $58, $74, $43, $6F, $6D, $6D, $65, $6E, $74, $00, $00, $00, $00, $00, $43, $72, $65, $61,
$74, $65, $64, $20, $77, $69, $74, $68, $20, $47, $49, $4D, $50, $64, $2E, $65, $07, $00, $00, $00, $DD, $49, $44,
$41, $54, $28, $CF, $8D, $D2, $4B, $4A, $83, $41, $10, $04, $E0, $6F, $92, $89, $0F, $14, $14, $C1, $9D, $B8, $F0,
$70, $39, $54, $0E, $E7, $42, $DC, $09, $A2, $C6, $67, $4C, $32, $2E, $AC, $09, $BF, $12, $89, $0D, $BD, $A9, $A9,
$AE, $AA, $1E, $BA, $4C, $9B, $22, $35, $2B, $9A, $3F, $AA, $4C, $9B, $31, $3F, $08, $6D, $DB, $D0, $08, $7B, $98,
$A0, $62, $1C, $AC, $0C, $9D, $3A, $F1, $28, $7D, $98, $A1, $BA, $8D, $3C, $C2, $39, $CE, $70, $82, $E3, $0C, $4C,
$A2, $BE, $21, $57, $5C, $E0, $1D, $AF, $78, $4E, $97, $60, $0D, $6B, $B4, $8A, $2B, $BC, $E0, $11, $F7, $51, $6A,
$58, $A5, $D7, $D3, $A6, $54, $5C, $E2, $09, $07, $51, $5A, $46, $ED, $03, $9F, $21, $B7, $8A, $D3, $10, $16, $B1,
$DD, $4F, $C6, $51, $F0, $D2, $97, $F9, $57, $55, $3C, $C4, $7A, $9E, $85, $BA, $E5, $3A, $59, $5B, $27, $DE, $FC,
$5A, $66, $9E, $8C, $9B, $7C, $9D, $78, $BD, $E5, $7B, $DE, $06, $AA, $66, $E5, $7B, $99, $DB, $80, $8B, $D8, $F6,
$5E, $0E, $EC, $55, $DC, $05, $58, $E5, $71, $D9, $FF, $0F, $AD, $1F, $47, $4D, $BE, $36, $98, $DE, $2C, $31, $BC,
$A0, $1A, $CB, $9D, $67, $56, $7B, $E0, $5D, $87, $FB, $05, $E8, $47, $62, $BC, $84, $A9, $57, $0D, $00, $00, $00,
$00, $49, $45, $4E, $44, $AE, $42, $60, $82
];
PROGRESS_POINT : TBytes = [
$89, $50, $4E, $47, $0D, $0A, $1A, $0A, $00, $00, $00, $0D, $49, $48, $44, $52, $00, $00, $00, $18, $00, $00, $00,
$18, $08, $06, $00, $00, $00, $E0, $77, $3D, $F8, $00, $00, $00, $06, $62, $4B, $47, $44, $00, $FF, $00, $FF, $00,
$FF, $A0, $BD, $A7, $93, $00, $00, $00, $09, $70, $48, $59, $73, $00, $00, $0B, $13, $00, $00, $0B, $13, $01, $00,
$9A, $9C, $18, $00, $00, $00, $07, $74, $49, $4D, $45, $07, $E1, $0A, $19, $09, $26, $34, $9B, $D6, $2E, $2D, $00,
$00, $00, $1D, $69, $54, $58, $74, $43, $6F, $6D, $6D, $65, $6E, $74, $00, $00, $00, $00, $00, $43, $72, $65, $61,
$74, $65, $64, $20, $77, $69, $74, $68, $20, $47, $49, $4D, $50, $64, $2E, $65, $07, $00, $00, $01, $D2, $49, $44,
$41, $54, $48, $C7, $BD, $96, $4B, $4A, $03, $41, $14, $45, $4F, $B5, $9D, $18, $63, $C0, $0F, $7E, $10, $9D, $0B,
$8E, $DC, $41, $A6, $AE, $C1, $05, $08, $D9, $81, $4B, $70, $05, $06, $B2, $12, $A7, $6E, $42, $C8, $5C, $11, $3F,
$C4, $08, $B1, $ED, $24, $DA, $ED, $E4, $3E, $2D, $8A, $4E, $62, $07, $4D, $C1, $25, $45, $D1, $EF, $DE, $57, $EF,
$57, $81, $12, $EB, $2C, $C7, $9D, $E5, $B8, $32, $36, $6E, $16, $E1, $94, $6F, $73, $DB, $74, $DC, $CF, $FE, $57,
$02, $1E, $B1, $2B, $80, $91, $87, $28, $14, $72, $13, $C8, $0D, $11, $B0, $24, $44, $02, $40, $26, $7C, $0A, $99,
$09, $85, $22, $6E, $02, $79, $04, $C4, $42, $55, $88, $25, $84, $48, $3F, $80, $91, $F0, $21, $64, $A1, $88, $9B,
$42, $BE, $0C, $AC, $00, $AB, $40, $1D, $A8, $E9, $1C, $91, $A5, $40, $02, $BC, $01, $EF, $C0, $B0, $48, $24, $2E,
$08, $D9, $92, $C8, $57, $81, $35, $60, $5D, $68, $E8, $1C, $91, $0D, $80, $3E, $F0, $AA, $5F, $5B, $63, $BF, $00,
$5C, $E0, $BD, $91, $37, $80, $0D, $60, $1B, $D8, $05, $B6, $24, $56, $93, $5D, $2A, $E2, $67, $E0, $01, $78, $02,
$5E, $24, $3A, $54, $08, $F3, $8E, $23, $8F, $0B, $BC, $AF, $CA, $FB, $75, $91, $EF, $03, $7B, $C0, $A6, $42, $85,
$42, $D3, $F3, $6E, $34, $0E, $F2, $61, $49, $67, $92, $40, $5D, $02, $5B, $22, $3F, $68, $D2, $3A, $3A, $E1, $FC,
$10, $E0, $8A, $8B, $EE, $35, $ED, $9B, $20, $5C, $03, $E5, $C3, $72, $81, $2F, $E0, $27, $B8, $A2, $50, $34, $14,
$96, $CD, $26, $AD, $A3, $53, $2E, $8F, $CD, $C8, $F6, $D7, $B4, $13, $85, $A6, $21, $9B, $8A, $9C, $34, $BE, $3C,
$0A, $9A, $2A, $F2, $AA, $A8, $2A, $A3, $9A, $79, $EE, $2F, $9D, $59, $75, $F9, $65, $EC, $FC, $DC, $46, $FC, $F3,
$8A, $BC, $A6, $C8, $BD, $0E, $B5, $26, $4A, $81, $F4, $8A, $8B, $6E, $68, $A8, $B3, $44, $DF, $58, $72, $3F, $C3,
$D1, $11, $07, $B3, $25, $53, $45, $A4, $4A, $DA, $2B, $D0, $B3, $84, $16, $24, $B9, $A7, $6F, $06, $B2, $19, $87,
$22, $7E, $1F, $58, $82, $EB, $EA, $81, $1D, $E0, $60, $46, $99, $DE, $03, $77, $C0, $2D, $F0, $A8, $84, $27, $12,
$CA, $C2, $3E, $C8, $A5, $3E, $52, $B9, $F5, $25, $68, $A5, $F8, $32, $A5, $D1, $FA, $B2, $19, $79, $37, $28, $9C,
$45, $56, $41, $B5, $39, $46, $85, $F5, $C0, $B7, $F7, $45, $B3, $C8, $6E, $31, $F4, $C6, $F2, $48, $64, $BF, $1D,
$76, $73, $8F, $EB, $4A, $30, $AE, $C7, $A5, $C6, $F5, $42, $1E, $9C, $85, $3C, $99, $7F, $FD, $E8, $97, $5A, $F3,
$FC, $6D, $F9, $02, $81, $2F, $EB, $17, $99, $D8, $E3, $F3, $00, $00, $00, $00, $49, $45, $4E, $44, $AE, $42, $60,
$82];
{$endregion}

function WaitFormProc(HWND: HWND; Msg: UINT; wParam: wParam; lParam: lParam)
  : LRESULT; stdcall;
var
  canvas: TCanvas;
  canvasHandle: HDC;
  ps: PAINTSTRUCT;
  r, clientRect: TRect;
  fullWidth, progressWidth: integer;
begin
  Result := 0;
  case Msg of
    WM_PAINT:
      begin
        canvasHandle := BeginPaint(HWND, ps);
        try
          canvas := TCanvas.Create;
          try
            GetClientRect(HWND, clientRect);
            canvas.Handle := canvasHandle;

            // Рамка
            canvas.Brush.Color := clGray;
            canvas.FillRect(Rect(0, 0, clientRect.Width, clientRect.Height));
            canvas.Brush.Color := clWhite;
            canvas.FillRect(Bounds(2, 2, clientRect.Width - 4,
              clientRect.Height - 4));
            canvas.Brush.Color := clGray;
            canvas.FillRect(Bounds(4, 4, clientRect.Width - 8,
              clientRect.Height - 8));

            // Заголовок
            canvas.Font.Color := clWhite;
            canvas.Font.Height := -19;
            canvas.Font.Name := 'MS Sans Serif';
            canvas.Font.Style := [fsBold];
            r := Bounds(4, 4, clientRect.Width - 8, 33);
            canvas.TextRect(r, title, [TTextFormats.tfBottom,
              TTextFormats.tfCenter, TTextFormats.tfWordBreak,
              TTextFormats.tfCalcRect]);
            if r.Height >= 33 then
              r := Bounds(4, 4, clientRect.Width - 8, 33)
            else
              r := Bounds(4, 4 + 33 - r.Height, clientRect.Width - 8, r.Height);
            canvas.TextRect(r, title, [TTextFormats.tfBottom,
              TTextFormats.tfCenter, TTextFormats.tfWordBreak]);

            // Текст
            canvas.Font.Color := clWhite; //clYellow;
            canvas.Font.Height := -15;
            canvas.Font.Name := 'MS Sans Serif';
            canvas.Font.Style := [];
            r := Rect(4, 40, clientRect.Width - 4, clientRect.Height - 4);
            canvas.TextRect(r, text, [TTextFormats.tfTop, TTextFormats.tfCenter,
              TTextFormats.tfWordBreak]);

            if maxValue > 0 then
            begin
              fullWidth := clientRect.Width - 68;
              progressWidth := Round(currentValue * fullWidth / maxValue);
              canvas.Brush.Color := $c4c4c4;
              canvas.FillRect(Bounds(clientRect.Left + 34,
                  clientRect.Bottom - 17, fullWidth, 2));
              if assigned(progressGlowLeft) then
              begin
                canvas.StretchDraw(Bounds(clientRect.Left + 34 + 1 - progressGlowLeft.Width,
                      clientRect.Bottom - 17 + 1 - Round(progressGlowLeft.Height / 2),
                      progressGlowLeft.Width - IfThen(progressWidth = 0, 1, 0),
                      progressGlowLeft.Height),
                    progressGlowLeft);
                canvas.StretchDraw(Bounds(clientRect.Left + 34 + progressWidth - 1 + IfThen(progressWidth <= 1, 1, 0),
                      clientRect.Bottom - 17 + 1 - Round(progressGlowRight.Height / 2),
                      progressGlowRight.Width - IfThen(progressWidth <= 1, 1, 0),
                      progressGlowRight.Height),
                    progressGlowRight);
                if progressWidth >= 3 then
                  canvas.StretchDraw(Bounds(clientRect.Left + 34 + 1,
                      clientRect.Bottom - 17 + 1 - Round(progressGlow.Height / 2),
                      progressWidth - 2, progressGlow.Height),
                      progressGlow);
                canvas.Draw(clientRect.Left + 34 + progressWidth - Round(progressPoint.Width / 2),
                    clientRect.Bottom - 17 + 1 - Round(progressPoint.Height / 2),
                    progressPoint);
              end;
              canvas.Brush.Color := $e1ffed;
              canvas.FillRect(Bounds(clientRect.Left + 34,
                  clientRect.Bottom - 17, progressWidth - 2, 2));
            end;
          finally
            canvas.Free;
          end;
        finally
          EndPaint(HWND, ps);
        end;
      end;
    WM_CLOSE:
      begin
        Result := 0;
      end;
    WM_USER + 1:
      begin
        DestroyWindow(waitWindow);
      end;
    WM_DESTROY:
      begin
        PostQuitMessage(0);
        Result := 0;
      end
  else
    Result := DefWindowProc(HWND, Msg, wParam, lParam);
  end;
end;

procedure TWaitFormThread.Execute;
var
  Msg: TMsg;
  wnd: TWndClass;
begin
  FillChar(wnd, SizeOf(WNDCLASS), 0);
  wnd.lpfnWndProc := @WaitFormProc;
  wnd.lpszClassName := PWideChar(className);
  wnd.hCursor := LoadCursor(0, IDC_WAIT);
  if Windows.RegisterClass(wnd) = 0 then
    raise Exception.Create('Ошибка при регистрации класса: ' +
      SysErrorMessage(GetLastError));
  FreeOnTerminate := true;
  waitWindow := CreateWindowEx(WS_EX_NOACTIVATE or WS_EX_TOPMOST,
    PWideChar(className), 'WaitForm', WS_POPUP, 0, 0, windowWidth, windowHeight,
    0, 0, HInstance, nil);
  if waitWindow = 0 then
    raise Exception.Create('Ошибка при создании окна: ' +
      SysErrorMessage(GetLastError));

  while GetMessage(Msg, waitWindow, 0, 0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
  Windows.UnregisterClass(PWideChar(className), HInstance);
end;

class procedure TWait.Show(const _title: string = 'Идет выбор данных...';
  const _text: string = 'ждите...');
var
  r: TRect;
begin
  title := _title;
  text := _text;
  if Screen.ActiveCustomForm <> nil then
    r := Screen.ActiveCustomForm.Monitor.WorkareaRect
  else
    r := Screen.PrimaryMonitor.WorkareaRect;
  SetWindowPos(waitWindow, 0, r.Left + ((r.Width - windowWidth) div 2),
    r.Top + ((r.Height - windowHeight) div 2), windowWidth, windowHeight,
    SWP_ASYNCWINDOWPOS or SWP_NOACTIVATE or SWP_SHOWWINDOW);

  // если мы мы изменим текст окна ожидания не скрывая окна
  InvalidateRect(waitWindow, nil, false);

  ShowWindow(waitWindow, SW_SHOWNOACTIVATE);
  UpdateWindow(waitWindow);
  Screen.Cursor := crHourGlass;
end;

{class procedure TWait.Progress(_currentValue, _maxValue: real);
var
  pct: integer;
begin
  pct := 0;
  if not SameValue(maxValue, 0.0) then
    pct := Min(Max(trunc(currentValue * 100.0 / maxValue), 0), 100);
  if pct <> progressVal then
  begin
    progressVal := pct;
    InvalidateRect(waitWindow, nil, false);
  end;
end;}

class procedure TWait.Progress(_currentValue, _maxValue: real);
begin
  _maxValue := Max(0, _maxValue);
  _currentValue := Min(Max(0, _currentValue), _maxValue);
  if (currentValue <> _currentValue) or (maxValue <> _maxValue) then
  begin
    currentValue := _currentValue;
    maxValue := _maxValue;
    InvalidateRect(waitWindow, nil, false);
  end;
end;

class procedure TWait.Hide;
begin
  maxValue := 0;
  currentValue := 0;
  Screen.Cursor := crDefault;
  ShowWindow(waitWindow, SW_HIDE);
end;

procedure LoadPngFromBytes(png: TPngImage; bytes: TBytes);
var stream: TMemoryStream;
begin
    stream := TMemoryStream.create;
    try
        stream.Write(bytes, Length(bytes));
        stream.Position := 0;
        png.LoadFromStream(stream);
    finally
        FreeAndNil(stream);
    end;
end;

procedure RegisterNecessity;
begin
  maxValue := 0;
  currentValue := 0;
  thread := TWaitFormThread.Create;
  progressGlow := TPngImage.Create;
  progressGlowLeft := TPngImage.Create;
  progressGlowRight := TPngImage.Create;
  progressPoint := TPngImage.Create;
  try
    LoadPngFromBytes(progressGlow,      PROGRESS_GLOW);
    LoadPngFromBytes(progressGlowLeft,  PROGRESS_GLOW_LEFT);
    LoadPngFromBytes(progressGlowRight, PROGRESS_GLOW_RIGHT);
    LoadPngFromBytes(progressPoint,     PROGRESS_POINT);
  except
    FreeAndNil(progressGlow);
    FreeAndNil(progressGlowLeft);
    FreeAndNil(progressGlowRight);
    FreeAndNil(progressPoint);
  end;
end;

procedure UnregisterNecessity;
begin
  SendMessage(waitWindow, WM_USER + 1, 0, 0);
  FreeAndNil(progressGlow);
  FreeAndNil(progressGlowLeft);
  FreeAndNil(progressGlowRight);
  FreeAndNil(progressPoint);
end;

initialization

RegisterNecessity;

finalization

UnregisterNecessity;

end.