Текущий архив: 2008.09.21;
Скачать: CL | DM;

Вниз

Снова потоки   Найти похожие ветки 

← →
Ябеда   (2008-08-07 15:49) [0]

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



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.


---

← →
Palladin ©   (2008-08-07 15:54) [1]

:)

---

← →
Игорь Шевченко ©   (2008-08-07 16:01) [2]

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

---

Страницы: 1 вся ветка

Текущий архив: 2008.09.21;
Скачать: CL | DM;

Наверх

Память: 0.47 MB
Время: 0.015 c