| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Снова потоки

Ябеда ©   (2008-08-07 15:49:00) 

Здравствуйте. Чет неполучается чуть. Создаю один поток. Работает. Но как-то через раз. Этот поток по идее должен рисовать на канве главной формы. Вроде рисует, но стоит пошевелить курсором по форме он умирает. Повидимому из-за перерисовки формы. Посмотрите плз код - где я ошибся или чего не добавил.



unit Unit1;

interface

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

type
 TNewThread = class(TThread)
   Text, FontName: string;
   FontSize, Speed, Width, Height, i: Integer;
   ColorText: TColor;
   bitmap, bit: tbitmap;
 private
   procedure SetBitmap;
 protected
   procedure Execute; override;
 end;

type
 TForm1 = class(TForm)
 procedure StartThread;
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

{ TNewThread }

procedure TNewThread.Execute;
var
 x, a, b: integer;
begin

 bit.Canvas.Font.Name := FontName;
 bit.Canvas.Font.Size := FontSize;
 bit.Canvas.Font.Color := ColorText;
 bit.Canvas.Brush.Style := bsclear;
 bit.Width := width;
 bit.Height := bit.Canvas.TextHeight('W') + 5;
 b := -bit.Canvas.TextWidth(Text);

 while 1 = 1 do
 begin
   x := width;
   while x > b do
   begin
     bit.canvas.Draw(0, 0, bitmap);
     bit.Canvas.TextOut(x, 0, Text);
     Synchronize(SetBitmap);
     sleep(speed);
     dec(x, 1);
   end;
 end;

 bitmap.Free;
 bit.Free;
end;

procedure TNewThread.SetBitmap;
begin
 form1.canvas.Draw(0, 0, bit);
end;

procedure TForm1.StartThread;
var
 NewThread: TNewThread;
 bitmap:tbitmap;
begin
bitmap:=tbitmap.Create;
bitmap.Width:=Width;
bitmap.Height:=Height;

 NewThread := TNewThread.Create(true);
 NewThread.FreeOnTerminate := true;
 NewThread.Priority := tpLower;
 NewThread.Text := 'Бла-бла-бла-бла-бла-бла';
 NewThread.FontName := 'Arial';
 NewThread.FontSize := 40;
 NewThread.Speed := 40;
 NewThread.Width := width;
 NewThread.Height := height;
 NewThread.ColorText := clred;
 NewThread.bitmap := tbitmap.Create;
 NewThread.Bit := tbitmap.Create;
 NewThread.bitmap.Assign(bitmap);
 NewThread.Resume;

bitmap.Free;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 StartThread;
end;

end.


---

Игорь Шевченко   (2008-08-07 16:01:00) [1]

Учимся оформлять тему вопроса

---

Palladin   (2008-08-07 15:54:00) [2]

:)

---

Наверх