FiveTech Support Forums

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, XPMan, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    XPManifest1: TXPManifest;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  PBS_MARQUEE = 8;
  PBM_SETMARQUEE = WM_USER + 10;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
   SetWindowLong(ProgressBar1.Handle, GWL_STYLE, GetWindowLong(ProgressBar1.Handle, GWL_STYLE) or PBS_MARQUEE);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
   SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, WPARAM(True), 100);
end;

end.

#define PBS_MARQUEE  8
#define PBM_SETMARQUEE  WM_USER + 10
#define GWL_STYLE -16

function MsgRun( cCaption, cTitle, bAction )

   local oDlg, oMeter, oText, oBtn, oFont
   local nVal := 50, Result := .T.

   DEFAULT bAction  := { || nil },;
           cCaption := "Processando...",; 
              cTitle   := "Por favor, aguarde..."

   DEFINE FONT      oFont           ;
             NAME      GetSysFont()    ;
             SIZE      0, -8

   DEFINE DIALOG    oDlg            ;
             FROM      5, 5 TO 10, 45  ;
             TITLE    cTitle          ;
             FONT     oFont
             
   oDlg:lHelpIcon := .F.
                                                
   @ 0.2, 0.5 SAY   oText           ;
           VAR       cCaption        ;
             SIZE      130, 10         ;
             OF        oDlg
             
   @ 1,   0.7 PROGRESS oMeter       ;
           POSITION  nVal            ;
             SIZE      150,10          ;
             OF        oDlg           

   // This block gets evaluated only the first time the DialogBox is painted !!!
   oDlg:bStart = { || SetWindowLong(oMeter:hWnd, GWL_STYLE, GetWindowLong(oMeter:hWnd, GWL_STYLE) .or. PBS_MARQUEE), Result := Eval( bAction) , oDlg:End() }
                      
   ACTIVATE DIALOG oDlg CENTERED ;
            on init (   SendMessage(oMeter:hwnd, PBM_SETMARQUEE, .T. , 10) )

   oFont:End()    

return Result

function MsgRun( cCaption, cTitle, bAction )

   local oDlg, oMeter, oText, oBtn, oFont
   local nVal := 90, Result := .T., oTmr := NIL


   DEFAULT bAction  := { || nil },;
           cCaption := "Processando...",; 
              cTitle   := "Por favor, aguarde..."

   DEFINE FONT      oFont           ;
             NAME      GetSysFont()    ;
             SIZE      0, -8

   DEFINE DIALOG    oDlg            ;
             FROM      5, 5 TO 10, 45  ;
             TITLE    cTitle          ;
             FONT     oFont
             
   DEFINE Timer     oTmr            ;
          Of        oWnd             ;
             Interval  100             ;          
          Action    (SetWindowLong(oMeter:hWnd, GWL_STYLE, nOr( GetWindowLong(oMeter:hWnd, GWL_STYLE), PBS_MARQUEE )) ,;
                       oDlg:Refresh() )
             
   oDlg:lHelpIcon := .F.
                                    
   @ 0.2, 0.5 SAY   oText           ;
           VAR       cCaption        ;
             SIZE      130, 10         ;
             OF        oDlg
             
   @ 1,   0.7 PROGRESS oMeter       ;
           POSITION  nVal            ;
             SIZE      150,10          ;
             OF        oDlg           
    
   //oDlg:bStart = { || oTmr:Activate(), Result := Eval( bAction) , oDlg:End() }
   oDlg:bStart = { || oTmr:Activate() }

   ACTIVATE DIALOG   oDlg           ;
                CENTERED                ;               
            on init  SendMessage(oMeter:hwnd, PBM_SETMARQUEE, .T. , 100)
                          
   oTmr:Deactivate()
   oTmr:End()
   oTmr:= NIL

   oFont:End()    

return Result