"Sean McCall" <NoSpam@nowhere.com> wrote in message
news:A64D1695-F072-4584-8CBA-AD5EDAA5D8B2@news.elevatesoft.com...
> Darren,
>
> Sounds like this might be what I need. Couldn't find the PegtopProgressBar
> on the site. Could you give me a hint on where to find it?
>
> BTW, are you the author?
>
> Sean
>

Hi Sean,

firstly no, I'm not the author. I happened across it and because it does
"snake" mode I've held on to it. I'm pretty conservative on what I pull into
an app, so I haven't used it - but I don't actually have anything that will
do the snake mode thing either, so either I'll have to rework something or
pull the pegtop stuff in. Haven't had to make a decision yet - but its an
option.

Regarding the download, you can not download it individually - you'll need
to download the full pegtop "common" components. Download pegtopcommon.zip.
There are about 4 tabs worth of components - and although some are pretty
impressive - most I wouldn't have use for at this point in time.

Regards

Darren.

Roy,

>
> That's pretty much the same as I posted. The problem is Sean wants the
> progress indicator to continue even if the MAIN thread is sleeping or
> doing something very intense eg running a procedure from a 3rd party DLL
> where he has no influence over it.

Yes you are correct, i misunderstood the real problem.
If Sean wants to show some progress he might try the following. It only
shows a rectangle which switches from black to white so for a real program
you have to draw something more sophisticated. The drawing is even done
while the main thread is sleeping.
But there are also a problem:
As soon as an other program is in front of this window it stops working.
Thats why i set formStyle to fsStayOnTop.


Bernd Kuhlmann



unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   Button1: TButton;
   Memo1: TMemo;
   Button2: TButton;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
 private
   { Private-Deklarationen }
   progress: Integer;
   fLock: TRTLCriticalSection;
   procedure ThreadDone(Sender: TObject);
   procedure ShowProgress(sender: TObject);
 public
   { Public-Deklarationen }
 end;

 TMyThread = class (TThread)
 private
   fonAlarm: TNotifyEvent;
   counter: Integer;
 protected
   procedure Execute; override;
 public

   constructor Create;
   property OnAlarm: TNotifyEvent read fOnAlarm write fOnAlarm;
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

{ TAThread }

constructor TMyThread.Create;
begin
 inherited Create(true);
 counter:=0;
 FreeOnTerminate := True;
end;

procedure TMyThread.Execute;
begin
 while counter<=1000 do
 begin
   sleep(500);
   fOnAlarm(nil);
   inc(counter);
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var thread: TMyThread;
begin
 thread:=TMyThread.Create;
 thread.OnAlarm:=ShowProgress;
 thread.OnTerminate:=ThreadDone;
 thread.resume;
 button1.enabled:=false;
 progress:=0;
end;

procedure TForm1.ThreadDone(Sender: TObject);
begin
 button1.Enabled:=true;
end;

procedure TForm1.ShowProgress(sender: TObject);
begin
 EnterCriticalSection(fLock);
 try
   if progress MOD 2 = 0 then
   begin
     canvas.Brush.Color:=clBlack;
   end else begin
     canvas.Brush.Color:=clWhite;
   end;
   canvas.FillRect(Rect(100,100,200,200));
   progress:=progress+1;
   update;
 finally
   LeaveCriticalSection(fLock);
 end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 memo1.lines.Add('Start of sleep');
 sleep(10000);
 memo1.lines.Add('End of sleep');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 formStyle:=fsStayOnTop;
 InitializeCriticalSection(fLock);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 DeleteCriticalSection(fLock);
end;

end.

Bernd,

That looks like it will work because it bypasses the
messaging system. Since I just want a moving meter of some
sort I can create a new component that will do this by just
drawing.

I think the issue with the bar no longer moving is XP
windows ghosting. This tells you how to disable it for your
application:

http://qc.borland.com/wc/qcmain.aspx?d=3730

Thanks,

Sean

Bernd Kuhlmann wrote:

> Roy,
>
>
>>That's pretty much the same as I posted. The problem is Sean wants the
>>progress indicator to continue even if the MAIN thread is sleeping or
>>doing something very intense eg running a procedure from a 3rd party DLL
>>where he has no influence over it.
>
>
> Yes you are correct, i misunderstood the real problem.
> If Sean wants to show some progress he might try the following. It only
> shows a rectangle which switches from black to white so for a real program
> you have to draw something more sophisticated. The drawing is even done
> while the main thread is sleeping.
> But there are also a problem:
> As soon as an other program is in front of this window it stops working.
> Thats why i set formStyle to fsStayOnTop.
>
>
> Bernd Kuhlmann
>
>
>
> unit Unit1;
>
> interface
>
> uses
>   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
>   Dialogs, StdCtrls, ExtCtrls, ComCtrls;
>
> type
>   TForm1 = class(TForm)
>     Button1: TButton;
>     Memo1: TMemo;
>     Button2: TButton;
>     procedure Button1Click(Sender: TObject);
>     procedure Button2Click(Sender: TObject);
>     procedure FormCreate(Sender: TObject);
>     procedure FormDestroy(Sender: TObject);
>   private
>     { Private-Deklarationen }
>     progress: Integer;
>     fLock: TRTLCriticalSection;
>     procedure ThreadDone(Sender: TObject);
>     procedure ShowProgress(sender: TObject);
>   public
>     { Public-Deklarationen }
>   end;
>
>   TMyThread = class (TThread)
>   private
>     fonAlarm: TNotifyEvent;
>     counter: Integer;
>   protected
>     procedure Execute; override;
>   public
>
>     constructor Create;
>     property OnAlarm: TNotifyEvent read fOnAlarm write fOnAlarm;
>   end;
>
> var
>   Form1: TForm1;
>
> implementation
>
> {$R *.dfm}
>
> { TAThread }
>
> constructor TMyThread.Create;
> begin
>   inherited Create(true);
>   counter:=0;
>   FreeOnTerminate := True;
> end;
>
> procedure TMyThread.Execute;
> begin
>   while counter<=1000 do
>   begin
>     sleep(500);
>     fOnAlarm(nil);
>     inc(counter);
>   end;
> end;
>
> procedure TForm1.Button1Click(Sender: TObject);
> var thread: TMyThread;
> begin
>   thread:=TMyThread.Create;
>   thread.OnAlarm:=ShowProgress;
>   thread.OnTerminate:=ThreadDone;
>   thread.resume;
>   button1.enabled:=false;
>   progress:=0;
> end;
>
> procedure TForm1.ThreadDone(Sender: TObject);
> begin
>   button1.Enabled:=true;
> end;
>
> procedure TForm1.ShowProgress(sender: TObject);
> begin
>   EnterCriticalSection(fLock);
>   try
>     if progress MOD 2 = 0 then
>     begin
>       canvas.Brush.Color:=clBlack;
>     end else begin
>       canvas.Brush.Color:=clWhite;
>     end;
>     canvas.FillRect(Rect(100,100,200,200));
>     progress:=progress+1;
>     update;
>   finally
>     LeaveCriticalSection(fLock);
>   end;
> end;
>
> procedure TForm1.Button2Click(Sender: TObject);
> begin
>   memo1.lines.Add('Start of sleep');
>   sleep(10000);
>   memo1.lines.Add('End of sleep');
> end;
>
> procedure TForm1.FormCreate(Sender: TObject);
> begin
>   formStyle:=fsStayOnTop;
>   InitializeCriticalSection(fLock);
> end;
>
> procedure TForm1.FormDestroy(Sender: TObject);
> begin
>   DeleteCriticalSection(fLock);
> end;
>
> end.
>
>
>