Solved

Using D4-TThreads while using WinApi & Sleeping?

Posted on 1998-09-28
9
300 Views
Last Modified: 2010-04-06
Expert help needed!
Problem: When using tthread and some winapi stuff, Sleep(x)  and SleepEx(x,Boolean) seem to be short changed when using small small x's, E.g. 2-8 msecs. Larger x's are not an option. In the following sample of the problem; I start a graphic moving accross the screen(button1), then start a mci midi thing(button2). As soon as the midi file is loaded and starts the image peels out as if the sleep function is no longer valid? I've used HDC's, bitblt, etc. and mci trying to stay away from the vcl's main thread, but I'm lost.

 In my application I play avi's, waves, etc. while moving lots of graphics without using components with the same peel out result. Question? why is the Bitblt peeling out?  

Thanks in advance!
steve
sbsullivan@ucdavis.edu

//** This Sample code is just a sample without the proper cleanup **
//To see it, paste the following into a EXISTING form with 2 buttons on it

unit unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,mmsystem;
type
TAthread = class(TThread)
Protected
procedure execute; override;
Procedure MakeBm;
Procedure MoveBm;
end;
type
    TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    end;
var
  Form1: TForm1;
  Image:Hbitmap;
  OrgHDC:HDC;
implementation
{$R *.DFM}
procedure TAthread.execute;
begin
  Priority:=tpnormal;
  MakeBm;
  MoveBm
end;
procedure TAthread.makebm;
var Text:Pchar;
    begin
    text:='Test';
    OrgHDC:=createcompatibleDC(0);
    //make non-vcl bitmap
    image:=SelectObject(OrgHDC,CreateCompatibleBitmap(OrgHDC,64,64));
    //write some text on the non-vcl bitmap
    textOut(OrgHDC,10,10,text,4);
    end;
procedure TAthread.moveBM;
var I:integer;
begin
    for i:= 0 to form1.width-64 do
    begin
    BitBlt(getDc(form1.handle),i,100,64,64,OrgHDC,0,0,SRCCOPY);
    Sleep(2);
    end;
    Terminate;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TAThread.Create(false);
end;
procedure TForm1.Button2Click(Sender: TObject);
Type
Tmciopen=Record
    dwCallback:DWORD;
    wDeviceID:MCIDEVICEID;
    lpstrDeviceType:Pchar;    lpstrElementName:Pchar;    lpstrAlias:Pchar;    end;Tmciplay=Record
    dwCallback:DWORD;
    dwFrom:DWORD;
    dwTo:DWORD;    end;var
mciplay:Tmciplay;
mciopen:Tmciopen;
begin
mciopen.lpstrDeviceType:='C:\winnt\media\canyon.mid';
mciSendCommand(mciopen.wDeviceID,MCI_OPEN,MCI_OPEN_TYPE,DWORD(@mciopen));
mciSendCommand(mciopen.wDeviceID,MCI_PLAY,MCI_Notify,DWORD(@mciplay));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
button1.caption:='Graphic';
button2.caption:='Midi';
form1.windowState:=wsMaximized;
end;
end.
0
Comment
Question by:sz3905
  • 4
  • 3
  • 2
9 Comments
 
LVL 10

Expert Comment

by:Lischke
Comment Utility
Hi sz3905,

from what I can see in your code I recommend the following:

- always free a DC before you allocate it again (MoveBM)
- store the DC of the form's handle into a local variable of the thread and free on termination (btw. you don't need to call terminate, a thread is automatically terminated when Execute returns)
- access to any VCL resource (even the form's window handle) has to be synchronized! (another reason to store the DC in a local variable)
- short sleep times have sometimes a bad side effect because of the time needed to switch the thread context so often; sleep just gives back all remaining CPU time back to other threads
- use a while loop instead of a for loop:

type
TAthread = class(TThread)
Protected
  FSteps,
  FStep : Integer;
  FFormDC: HDC;
procedure FreeFormDC;
procedure GetFormDC: HDC;
procedure execute; override;
Procedure MakeBm;
Procedure MoveBm;
end;

procedure FreeFormDC;
begin
  ReleaseDC(Form1.Handle,FFormDC);
end;

function GetFormDC: HDC;
begin
  FFormDC:=GetDC(Form1.Handle);
  FSteps:=form1.width-64;
end;

procedure TAthread.moveBM;
begin
  Synchronize(GetFormDC);
  FStep:=0;
  while not Terminated and (FStep < FSteps) do
  begin
    BitBlt(FFormDC,FStep,100,64,64,OrgHDC,0,0,SRCCOPY);
    Sleep(10);
    Inc(FStep);
  end;
  Synchronize(FreeFormDC);
end;

0
 

Author Comment

by:sz3905
Comment Utility
Greetings Lischke,
After adjusting you suggested code (see  GetFormDC syntax), the result is the same, I've still got the image peeling out when using 2-8 msecs sleep. You said:"short sleep times have sometimes a bad side effect" I need more of an answer.The short sleep is meant to be a stabilizer of sorts to prevent peeling out. Thank you very much for your help and suggestions.
Steve
0
 
LVL 10

Expert Comment

by:Lischke
Comment Utility
Steve,

as you might know each thread in a multithreaded environment gets a certain amount of CPU time to execute its code. If a thread doesn't need all the time it can "give back" the rest to be used in other threads. In 16bit environments this had to be done in a cooperative fashion (mostly by calling GetMessage).

Under WIn95/WinNT this isn't necessary, but considered as a good programming style to supply not needed time to other processes/threads.

To switch between several threads the system also needs a bit time (depending on the CPU sped) to switch the contexts of the threads. That is, the CPU registers, stack and other resources.

A sleep time of 2msecs is very near to that switching time and can cause more traffic than wanted, preventing threads with lower priority to execute.

What I have problems with to understand is, what do you mean with "peeling out"? Is it that the image isn't shown at all or only partly visible?

You should also keep in mind that the media player and the like use own threads to fullfill their tasks. So it might be necessary to change your code that the BitBlt is executed in the context of the main thread and lauchned by a message of TAThread, while this threads uses an Event (and WaitFor SingleObject(...)) to initiate the blit only when the main thread is ready to.

I used this for slider windows, which set an event (a Windows event, not the Delphi one, see CreateEvent in the help), whenever they are ready to slide a step further. Then the thread returns from a WaitForSIngleObject call and posts a message to the slider (in this case a WM_TIMER, but it can also be a self defined one). After this the thread enters again the WaitFor... call and the main thread becomes active and the slider can actually slide a bit by responding to the WM_TIMER message.

Hope this helps

Ciao, Mike
0
 

Author Comment

by:sz3905
Comment Utility
Hello Mike,
Thanks for the info, very helpful.
I should have better explained "peeling out", here is it is:
When you click the first button("Graphic"), the image starts  moving left to right.
After it has started moving, click the 2nd button("midi").
As soon as the midi file is loaded, MCI starts playing, and the image
then peels out (moves much faster from left to right). I'd say it triples it's speed,
as if the sleep(x) function is being ignored.

Possibly the sleep function is being skipped because of the switching time you
spoke about.
What I'm trying to do is prevent the image from changing motion speed while playing MCI
when using a sleep(2) or Sleep(8), etc.
Sleep(10+) will stabilize the image speed, but it's to slow.
Thanks again Ciao, Mike for your insight!
Steve

 
0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 
LVL 12

Expert Comment

by:rwilson032697
Comment Utility
From reading the discussion here it appears that you want to step your image by a certain number of pixels in uniform time steps. What you could do is have your thread create a TTimer (or API equivalent if you are more familier with that) which fires every x milli-seconds. In the OnTimer event have your code to synchronise with the main VCL thread and draw the bitmap.

Hope this helps,

Raymond.
0
 

Author Comment

by:sz3905
Comment Utility
Greetings Raymond,
I think you are right. If you can post a working example using  
a non vcl timer and the poor example I used, the points are yours.

BTW; I tried wm_timer,setevent, etc but did not have much luck
because of message events causing application malfunctions.
The actual app is much larger and more involved than the sample
but I can fit a "working" concept  into the code.
Thank You Raymond for your thoughts!
Steve
     
0
 
LVL 12

Expert Comment

by:rwilson032697
Comment Utility
Well, I can reproduce it with your code now so I'll let you know how it goes!
0
 
LVL 12

Accepted Solution

by:
rwilson032697 earned 300 total points
Comment Utility
Hi sz3905,

Well, the answer is to use multi-media timers... Below is the code I copied from your question and modified to use these timers... Unfortunately there has been a side effect that 'test' is not drawn properly, only the black square is drawn. I fiddled with this for a bit with no result :-(. Anyway you should be able to pick out what I did and use it.

unit unit1;
    interface
    uses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      StdCtrls,mmsystem;

    type
    TAthread = class(TThread)
    Protected
    procedure execute; override;
    Procedure MakeBm;
    Procedure MoveBm;
    public
      Pos : Integer;
      Timer : MMResult;
      OrgHDC:HDC;
      Image:Hbitmap;
    end;

    type
        TForm1 = class(TForm)
        Button1: TButton;
        Button2: TButton;
        procedure Button1Click(Sender: TObject);
        procedure Button2Click(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        end;
    var
      Form1: TForm1;

    implementation
    {$R *.DFM}

procedure DoIT(uTimerID, uMessage: UINT;
               dwUser, dw1, dw2: DWORD) stdcall;

    begin
      with TAthread(dwUser) do
        begin
        BitBlt(getDc(form1.handle),Pos,100,64,64,OrgHDC,0,0,SRCCOPY);
        inc(pos);
        if pos = form1.width-64 then
          begin
            timeKillEvent(Timer);
            Terminate;
          end
        end;
     end;


    procedure TAthread.execute;
    begin
      Priority:=tpnormal;
      MakeBm;
      MoveBm
    end;

    procedure TAthread.makebm;
    var Text:Pchar;
        begin
        text:='Test';
        OrgHDC:=createcompatibleDC(0);
        //make non-vcl bitmap
        image:=SelectObject(OrgHDC,CreateCompatibleBitmap(OrgHDC,64,64));
        //write some text on the non-vcl bitmap
        textOut(OrgHDC,10,10,text,4);
        end;
    procedure TAthread.moveBM;
    begin
      pos := 0;
      timer := timeSetEvent(10, 3, @Doit, Integer(Self), TIME_PERIODIC);
      Suspend;
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    begin
    TAThread.Create(false);
    end;
    procedure TForm1.Button2Click(Sender: TObject);
    Type
    Tmciopen=Record
        dwCallback:DWORD;
        wDeviceID:MCIDEVICEID;
        lpstrDeviceType:Pchar;
        lpstrElementName:Pchar;
        lpstrAlias:Pchar;
        end;

        Tmciplay=Record
        dwCallback:DWORD;
        dwFrom:DWORD;
        dwTo:DWORD;
        end;

  var
    mciplay:Tmciplay;
    mciopen:Tmciopen;
    begin
    mciopen.lpstrDeviceType:='E:\winnt\media\canyon.mid';
    mciSendCommand(mciopen.wDeviceID,MCI_OPEN,MCI_OPEN_TYPE,DWORD(@mciopen));
    mciSendCommand(mciopen.wDeviceID,MCI_PLAY,MCI_Notify,DWORD(@mciplay));
    end;
    procedure TForm1.FormCreate(Sender: TObject);
    begin
    button1.caption:='Graphic';
    button2.caption:='Midi';
    form1.windowState:=wsMaximized;
    end;
    end.


0
 

Author Comment

by:sz3905
Comment Utility
Greetings and thanks Rwilson!
You provided an easy answer, I usually over do it and get myself in trouble.
Thanks for the lesson in "keepin-it-simple".

Steve:-}
 
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now