expertcad/SRC/Main/U_Progress.pas
2025-05-12 10:07:51 +03:00

378 lines
9.8 KiB
ObjectPascal

unit U_Progress;
interface
uses
Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxControls, cxContainer, cxEdit, cxLabel, ExtCtrls, RzPanel,
ComCtrls, siComp, siLngLnk, cxGraphics, cxLookAndFeels, cxLookAndFeelPainters;
type
TF_Progress = class(TForm)
pnCaption: TRzPanel;
lbProgressCaption: TcxLabel;
ProgressBar: TProgressBar;
lng_Forms: TsiLangLinked;
Timer_ActiveForm: TTimer;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormActivate(Sender: TObject);
procedure FormDeactivate(Sender: TObject);
procedure CreateParams(var Params: TCreateParams); override;
procedure Timer_ActiveFormTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FCurrProgressPos: Integer;
FMaxProgressPos: Integer;
FLockedFormHandles: TList;
public
{ Public declarations }
FPauseCount: Integer;
procedure Action(var Msg: TMsg; var Handled: boolean);
procedure LockVisibleForms;
procedure UnLockForms;
procedure PauseProgress(APaused: Boolean);
procedure SetTop;
//Tolik
// procedure StartProgress(ACaption: String; AMaxPos: Integer);
procedure StartProgress(ACaption: String; AMaxPos: Integer; MustShowProgress: Boolean = False);
procedure REShowProgress(ACaption: String; AMaxPos: Integer; MustShowProgress: Boolean = False);
//
procedure StepProgress;
procedure StopProgress;
end;
var
F_Progress: TF_Progress;
implementation
uses U_Constants, U_Common, {Tolik--23/11/2016 -- }U_Main;
{$R *.dfm}
procedure TF_Progress.FormShow(Sender: TObject);
begin
//Application.OnMessage := Action;
//Application.RestoreTopMosts;
end;
procedure TF_Progress.FormActivate(Sender: TObject);
begin
if FPauseCount = 0 then
begin
SetTop;
Refresh;
end;
end;
procedure TF_Progress.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//Application.OnMessage := Nil;
end;
procedure TF_Progress.Action(var Msg: TMsg; var Handled: boolean);
var
CurrActiveWindow: THandle;
begin
(*if (Msg.message = WM_LBUTTONDOWN) or (Msg.message = WM_LBUTTONDBLCLK) or
(Msg.message = WM_RBUTTONDOWN) or (Msg.message = WM_RBUTTONDBLCLK) or
(Msg.message = WM_KEYDOWN) or (Msg.message = WM_MOUSEWHEEL) then
begin
if (Msg.wParam <> 9){MK_CONTROL} then
begin
Msg.message := 0;
Msg.wParam := 0;
end;
end;*)
if (Msg.message = WM_LBUTTONDOWN) or (Msg.message = WM_LBUTTONDBLCLK) or
(Msg.message = WM_RBUTTONDOWN) or (Msg.message = WM_RBUTTONDBLCLK) or
//(Msg.message = WM_NCLBUTTONDOWN) or (Msg.message = WM_NCLBUTTONUP) or
(Msg.message = WM_KEYDOWN) or (Msg.message = WM_MOUSEWHEEL) {or
((Msg.message >= WM_KEYFIRST) and (Msg.message <= WM_KEYLAST)) or
((Msg.message >= WM_MOUSEFIRST) and (Msg.message <= WM_MOUSELAST))} {or
(Msg.message = WM_ACTIVATE) or (Msg.message = WM_SETFOCUS)}
then
begin
if (Msg.wParam <> 9){MK_CONTROL} then
begin
Msg.message := 0;
Msg.wParam := 0;
//Handled := true;
end;
end;
end;
procedure TF_Progress.LockVisibleForms;
var
i: integer;
Form: TCustomForm;
begin
FLockedFormHandles.Clear;
for i := 0 to Screen.CustomFormCount - 1 do
begin
Form := Screen.CustomForms[i];
if Form is TForm then
//if Form.ClassName = 'TFSCS_Main' then
//if Form.ClassName <> 'TF_MakeEditCrossConnection' then
if Form <> Self then
if TForm(Form).Visible then
if IsWindowEnabled(Form.Handle) then
begin
FLockedFormHandles.Add(Pointer(Form.Handle));
EnableWindow(Form.Handle, False);
end;
end;
end;
procedure TF_Progress.UnLockForms;
var
i: Integer;
// tolik 28/04/2017 --
function GetFormFromHandle(Handle: HWnd): TForm;
var
wc: TWinControl;
begin
wc := FindControl(Handle);
if (wc is TForm)
then Result := TForm(wc)
else Result := nil;
end;
//
begin
for i := FLockedFormHandles.Count - 1 downto 0 do
begin
if GetFormFromHandle(HWnd(FLockedFormHandles[i])) <> nil then
EnableWindow(HWnd(FLockedFormHandles[i]), true);
end;
//for i := 0 to FLockedFormHandles.Count - 1 do
// EnableWindow(HWnd(FLockedFormHandles[i]), true);
FLockedFormHandles.Clear;
end;
procedure TF_Progress.PauseProgress(APaused: Boolean);
begin
case APaused of
true:
begin
if FPauseCount = 0 then
begin
Application.OnMessage := Nil;
UnLockForms;
end;
Inc(FPauseCount);
//F_Progress.Hide;
end;
false:
begin
if FPauseCount > 0 then
begin
Dec(FPauseCount);
if FPauseCount = 0 then
begin
Application.OnMessage := F_Progress.Action;
LockVisibleForms;
if Not F_Progress.Visible or Not F_Progress.Showing then
F_Progress.Show;
F_Progress.Refresh;
//if GetForegroundWindow <> F_Progress.Handle then
// SetForegroundWindow(F_Progress.Handle);
end;
end;
end;
end;
end;
procedure TF_Progress.SetTop;
begin
//SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
//SetWindowPos(Handle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOACTIVATE or
// SWP_NOOWNERZORDER or SWP_SHOWWINDOW or SWP_NOZORDER);
end;
//Tolik
//procedure TF_Progress.StartProgress(ACaption: String; AMaxPos: Integer);
procedure TF_Progress.StartProgress(ACaption: String; AMaxPos: Integer; MustShowProgress: Boolean = False);
begin
if ACaption <> '' then
begin
//lbProgressCaption.Caption := ACaption;
pnCaption.Caption := ACaption;
end
else
begin
//lbProgressCaption.Caption := cProgress_Mes1;
pnCaption.Caption := cProgress_Mes1;
end;
FCurrProgressPos := 0;
FMaxProgressPos := 0;
ProgressBar.Visible := AMaxPos > 0;
if AMaxPos > 0 then
begin
FMaxProgressPos := AMaxPos + Round((AMaxPos / 100) * 5);
ProgressBar.Position := FCurrProgressPos;
// Application.ProcessMessages;
ProcessMessagesEx;
end;
//SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOZORDER or SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
//SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
//FormStyle := fsStayOnTop;
//Application.RestoreTopMosts;
Application.OnMessage := Action;
//OnDeactivate := FormDeactivate;
//LockVisibleForms;
// Self.Position := poDesktopCenter;
{$IF Not Defined(BASEADM_SCS)}
// if Not ProgressBar.Visible then
if ((Not ProgressBar.Visible) and (not MustShowProgress)) then
Self.Top := -100
else
Self.Position := poMainFormCenter;
{$ELSE}
Self.Position := poMainFormCenter;
{$IFEND}
Show;
{$IF Not Defined(BASEADM_SCS)}
// if Not ProgressBar.Visible then
if ((Not ProgressBar.Visible) and (not MustShowProgress)) then
begin
Self.Top := -100;
Cursor := crHourGlass;
end;
{$ELSE}
{$IFEND}
SetActiveWindow(Self.Handle); //SetForegroundWindow(Self.Handle);
LockVisibleForms;
//Application.ProcessMessages;
ProcessMessagesEx;
end;
//Tolik
procedure TF_Progress.REShowProgress(ACaption: String; AMaxPos: Integer; MustShowProgress: Boolean = False);
begin
//Tolik
//if (Self.Top = -100) then
//
begin
if ACaption <> '' then
begin
pnCaption.Caption := ACaption;
end
else
begin
pnCaption.Caption := cProgress_Mes1;
end;
FCurrProgressPos := 0;
FMaxProgressPos := 0;
//Tolik
ProgressBar.Position := 0;
//
ProgressBar.Visible := AMaxPos > 0;
if AMaxPos > 0 then
begin
FMaxProgressPos := AMaxPos + Round((AMaxPos / 100) * 5);
ProgressBar.Position := FCurrProgressPos;
// Application.ProcessMessages;
ProcessMessagesEx;
end;
Self.Position := poMainFormCenter;
Show;
Cursor := crHourGlass;
ProcessMessagesEx;
//SetActiveWindow(Self.Handle);
// Application.ProcessMessages;
end;
end;
procedure TF_Progress.StepProgress;
begin
Inc(FCurrProgressPos);
ProgressBar.Position := Round(FCurrProgressPos/FMaxProgressPos * 100);
F_Progress.Repaint;
F_Progress.Refresh;
end;
procedure TF_Progress.StopProgress;
begin
//OnDeactivate := nil;
try
if Visible then
begin
if FMaxProgressPos > 0 then
begin
ProgressBar.Position := 100;
Application.ProcessMessages;
Sleep(500);
ProgressBar.Position := 0;
end;
UnLockForms;
//22.08.2012 Close;
Application.OnMessage := Nil;
Application.ProcessMessages;
Close;
end;
finally
UnLockForms;
end;
{$IF Defined(SCS_PE)}
Cursor := crDefault;
{$IFEND}
end;
procedure TF_Progress.FormDeactivate(Sender: TObject);
begin
//if Showing then
// SetForegroundWindow(Handle);
Timer_ActiveForm.Enabled := true;
ProcessMessagesEx;
end;
procedure TF_Progress.CreateParams(var Params: TCreateParams);
begin
Inherited CreateParams(Params);
end;
procedure TF_Progress.Timer_ActiveFormTimer(Sender: TObject);
begin
TTimer(Sender).Enabled := false;
if Visible then
if Screen.ActiveForm <> Self then
SetActiveWindow(Handle);
end;
procedure TF_Progress.FormCreate(Sender: TObject);
begin
FLockedFormHandles := TList.Create;
FPauseCount := 0;
end;
procedure TF_Progress.FormDestroy(Sender: TObject);
begin
FreeAndNil(FLockedFormHandles);
end;
end.