Canvas and thread problem :)

Hi

I'm trying to develope simple application that will simulate scanning on the monitor display. i did it allready but if i'm checkin CPU consumption while programm is running i'm getting headache  
(70 to 80 %) ......any ideas ??

The code:

--------------------------thread---------------------------------
procedure obraz.xx(k:integer);
var cn:Tcanvas;
tb:Tbitmap;
w,h,i,t:integer;
begin
cn:=tcanvas.Create;
Cn.Handle:=GetWindowDC(GetDesktopWindow);
w:= Screen.Width;
h:= Screen.Height;
        tb:=tbitmap.Create;
        tb.Height:=h;
        tb.width:=w;
        tb.Canvas.Brush.Color:=clblack;
        tb.Canvas.pen.Color:=clwhite;
        tb.canvas.FillRect(rect(0,0,w,h));
        tb.canvas.Pen.Width:=10;
        tb.canvas.MoveTo(k,0);
        tb.canvas.lineto(k,h);
        Cn.Draw(0,0,tb);
        tb.Free;
        cn.Free;
        if t=w then
        begin
        ShowCursor(true);
        //cn.Free;
        UpdateWindow(GetDesktopWindow);
        terminate;
        end;
        end;


end.
--------------------end of thread ----------------------


..and in main listening:


procedure TForm1.timerTimer(Sender: TObject);
var
a:integer;
fv:array [0..2] of obraz;
begin

inc(s);
if s<screen.Width then
begin
a:=1;
//fv.FreeOnTerminate:=true;
fv[0].xx(s);
inc(s);
fv[1].xx(s);
inc(s);
fv[2].xx(s);
s:=s
end
else
begin
timer.Enabled:=false;
application.Terminate;
end;
end;




thank you in advance


 



MurdocAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

LRHGuyCommented:
Maybe I just don't see it, but where does "t" get it's value in the thread routine?

        if t=w then

If t is random or zero, you might not be getting the expected results.
0
LRHGuyCommented:
In the timer routine you show a local variable of fv, but you don't show the assignment. Are you creating them on every timer trigger?

Maybe you're just not showing enough code, but I don't see the threads in action. It looks like it'a all happening serially.
0
MurdocAuthor Commented:
Propably there will be better LRHGuy if i will post whole code here :


----------------------thread-----------------------------------
unit Unit2;

interface

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

type
  obraz = class(TThread)
  private

  procedure dawaj;

  public
    can:Tcanvas;
  bit:tbitmap;
  procedure xx(k:integer);
    { Private declarations }
  protected
    procedure Execute; override;
  end;

implementation
uses unit1;
var
s:integer;


procedure obraz.Execute;
begin
freeonterminate:=true;
synchronize(dawaj);  { Place thread code here }

end;
procedure obraz.dawaj;
var
w,h,i,t:integer;


begin

ShowCursor(False);
w:= Screen.Width;
h:= Screen.Height;
t:=-1;
for i:=0 to w do
        begin
        can:=tcanvas.Create;
Can.Handle:=GetWindowDC(GetDesktopWindow);
        inc(t);
        bit:=tbitmap.Create;
        bit.Height:=h;
        bit.width:=w;
        bit.Canvas.Brush.Color:=clblack;
        bit.Canvas.pen.Color:=clwhite;
        bit.canvas.FillRect(rect(0,0,w,h));
        bit.canvas.Pen.Width:=10;
        bit.canvas.MoveTo(t,0);
        bit.canvas.lineto(t,h);
        Can.Draw(100,100,bit);
        can.Free;
        bit.free;
        if t=w then
        begin
        ShowCursor(true);
        UpdateWindow(GetDesktopWindow);
        terminate;
        end;
        end;


end;

procedure obraz.xx(k:integer);
var cn:Tcanvas;
tb:Tbitmap;
w,h,i,t:integer;
begin
cn:=tcanvas.Create;
Cn.Handle:=GetWindowDC(GetDesktopWindow);
w:= Screen.Width;
h:= Screen.Height;
        tb:=tbitmap.Create;
        tb.Height:=h;
        tb.width:=w;
        tb.Canvas.Brush.Color:=clblack;
        tb.Canvas.pen.Color:=clwhite;
        tb.canvas.FillRect(rect(0,0,w,h));
        tb.canvas.Pen.Width:=10;
        tb.canvas.MoveTo(k,0);
        tb.canvas.lineto(k,h);
        Cn.Draw(0,0,tb);
        tb.Free;
        cn.Free;
        if t=w then
        begin
        ShowCursor(true);
        UpdateWindow(GetDesktopWindow);
        terminate;
        end;
        end;


end.

-----------------------------------------end of thread---------------


-------------------------Main code--------------------------------

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    timer: TTimer;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure timerTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
   s:integer;
implementation

{$R *.dfm}



procedure TForm1.Button2Click(Sender: TObject);
var
f:obraz;
begin
f:=obraz.Create(false);
end;

procedure TForm1.Button1Click(Sender: TObject);

begin
s:=-1;
timer.Enabled:=true;
end;

procedure TForm1.timerTimer(Sender: TObject);
var
fv:array [0..2] of obraz;
begin
inc(s);
if s<screen.Width then
begin
fv[0].xx(s);
inc(s);
fv[1].xx(s);
inc(s);
fv[2].xx(s);
s:=s
end
else
begin
timer.Enabled:=false;
application.Terminate;
end;
end;

end.

---------------------------end of main code------------------------

Regards
0
Cloud Class® Course: Microsoft Windows 7 Basic

This introductory course to Windows 7 environment will teach you about working with the Windows operating system. You will learn about basic functions including start menu; the desktop; managing files, folders, and libraries.

Slick812Commented:
hello  Murdoc , , I can not understand your question - -

" application that will simulate scanning on the monitor display"

what do you mean by scanning, , , , , I looked at your code and I can not see anthing in it that I would think of as Scanning?

I am wondering why you are doing a thread for this, is it nessarry for this type of thing?

and your

procedure obraz.xx(k:integer);

procedure, , as far as I can tell it creates a  TBitmap and then paints that bitmap Black, and then draws a single vertical line (10 pixels wide) from top to bottom at the  K location, and then paints (draws) this Bitmap onto the screen. . . But I do not know what you are trying to do with this? ? ? Does this have something to do with scanning? Whatever you mean by that? ? ?
as far as I can tell a black screen is shown, and a 10 pixel line moves across the screen at the timer interval, if you use a 10 pixel line, why move it only one pixel?

for me,  I do not think you need the bitmap at all , why don't you just draw directly on the screen?
and I do not think that the GetWindoDC( ) function is correct for this, the Desktop window is a virtual window, kind of left over from the win 16 bit days. .


procedure obraz.xx(k:integer);
var cn:Tcanvas;
w,h,i,t:integer;
begin
w:= Screen.Width;
h:= Screen.Height;
cn:=tcanvas.Create;
Cn.Handle:=GetDC(0);
 cn.Canvas.Brush.Color:=clblack;
 cn.Canvas.pen.Color:=clwhite;
 cn.canvas.FillRect(rect(0,0,w,h));
 cn.canvas.Pen.Width:=10;
 cn.canvas.MoveTo(k,0);
 cn.canvas.lineto(k,h);
 cn.Free;
 //if t=w then  // where is t assigned any value ? ? ?
 if k=w then
   begin
   ShowCursor(true);
   terminate;
   end;
end;

 - - - - - - - -  - - - -

anyway, I might ask, what are you trying to do? ?
0
MurdocAuthor Commented:
I'm trying do develope application that will run automatically with windows , then the application will show message on the black screen ("Touch the screen.You fingertips will be scanning"), some kind of scanning simulation (that's why on the black screen white line moves pixel by pixel)  :) and finally appllication will terminate allowing user to to his job on the computer.
Reasumming:  application is just for fun, to laugh on somebody
:)))

Regards
0
MurdocAuthor Commented:
btw Slick812  while drawing line on the canvas the line is flickering that's why i was creating bitmap


Regards
0
Slick812Commented:
there are certanly several many different ways to do this sort of thing, here is some code that I used to do a scanner swipe looking effect. I did not use a thread, I did not think I needed that, (but there may be something I do not know about that might use a thread to be better).

There is a button Click procedure in

procedure TForm1.sbut_ScreenSwipeClick(Sender: TObject);

it will paint the screen Black and call the ScreenSwipe  procedure, which will create a bitmap and move it across the screen, I see no reason for paint black the entire screen for each move paint, since only an area 2 pixels wide need to be covered.
So I make a bitmap 3 pixels wider than the scan move distance of 2 pixels, so when you paint it on screen the left 3 black bitmap pixels will cover (erase) the previuos draw.

code examples - - - - - -


procedure ScreenSwipe;
var
X, screenDC: Integer;
Bmp1: TBitmap;
begin
Bmp1 := TBitmap.Create;
try
{I try to make an edge fade bitmap to look more like a scanner}
  Bmp1.Canvas.Brush.Color := $C8EAF4;
  Bmp1.Height := Screen.Height;
  Bmp1.Width := 15;
  Bmp1.Canvas.Brush.Color := 0;
  Bmp1.Canvas.FillRect(Rect(0,0,3,Bmp1.Height));
{I need to Erase the previous scan paint so I add 3 pixels of black
 on the left of bitmap with FillRect}
  Bmp1.Canvas.Pen.color := $606060;
  Bmp1.Canvas.MoveTo(3,0);// make egde fade
  Bmp1.Canvas.LineTo(3,Bmp1.Height);
  Bmp1.Canvas.MoveTo(14,0);
  Bmp1.canvas.LineTo(14,Bmp1.Height);
  Bmp1.Canvas.Pen.color := $909A9F;
  Bmp1.Canvas.MoveTo(4,0);
  Bmp1.canvas.LineTo(4,Bmp1.Height);
  Bmp1.Canvas.MoveTo(13,0);
  Bmp1.Canvas.LineTo(13,Bmp1.Height);
  Bmp1.Canvas.Pen.color := $A0AAAF;
  Bmp1.Canvas.MoveTo(5,0);
  Bmp1.canvas.LineTo(5,Bmp1.Height);
  Bmp1.Canvas.MoveTo(12,0);
  Bmp1.Canvas.LineTo(12,Bmp1.Height);

  for X := -1 to (Screen.Width div 2) -1 do
    begin
    screenDC := GetDC(0);
    // move 2 pixels to right each time
    BitBlt(screenDC, X * 2, 0, 15, Bmp1.Height, Bmp1.Canvas.Handle,
           0, 0, SRCCOPY);
    ReleaseDC(0,screenDC);
    Sleep(8);
    Application.ProcessMessages;
    end;

  Sleep(1000);
  InvalidateRect(0,nil,True);// recover screen view
  finally
  FreeAndNil(Bmp1);
  end;

end;


procedure TForm1.sbut_ScreenSwipeClick(Sender: TObject);
var
screenDC: Integer;
begin
Application.ProcessMessages;
screenDC := GetDC(0);
PatBlt(screenDC,0,0, Screen.width, Screen.Height, BLACKNESS);
// paint screen Black with PatBlt
ReleaseDC(0,screenDC);

ScreenSwipe;
end;

 = = = = = = = =  = = = = = = = = = = = = =  = = = =  = = = = = =

maybe this will give you some ideas for doing this
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
MurdocAuthor Commented:
Slick812  --->>> you're code is what i was looking for.

One more time thanks
btw. you're code is exactly what i was trying to do :)

Regards
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.