?
Solved

Canvas and thread problem :)

Posted on 2004-11-02
8
Medium Priority
?
190 Views
Last Modified: 2012-05-05
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


 



0
Comment
Question by:Murdoc
  • 4
  • 2
  • 2
8 Comments
 
LVL 7

Expert Comment

by:LRHGuy
ID: 12478981
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
 
LVL 7

Expert Comment

by:LRHGuy
ID: 12479007
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
 

Author Comment

by:Murdoc
ID: 12480765
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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 34

Expert Comment

by:Slick812
ID: 12490495
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
 

Author Comment

by:Murdoc
ID: 12490848
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
 

Author Comment

by:Murdoc
ID: 12491051
btw Slick812  while drawing line on the canvas the line is flickering that's why i was creating bitmap


Regards
0
 
LVL 34

Accepted Solution

by:
Slick812 earned 500 total points
ID: 12497884
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
 

Author Comment

by:Murdoc
ID: 12498668
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

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
This Micro Tutorial will teach you how to add a cinematic look to any film or video out there. There are very few simple steps that you will follow to do so. This will be demonstrated using Adobe Premiere Pro CS6.
As many of you are aware about Scanpst.exe utility which is owned by Microsoft itself to repair inaccessible or damaged PST files, but the question is do you really think Scanpst.exe is capable to repair all sorts of PST related corruption issues?
Suggested Courses

850 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