TImageをベースにコンポーネントを作成しています。
コンポーネント内でスレッド作成しそこでキャンバス上に画像イメージが
流れる様に作ったのですが、実際フォームに作成したコンポーネントを貼り付けて
動かすと、フォームの再描画(フォーム上をマウスが通過するなど)で
作成したコンポーネントの描画がとまってしまいます。
原因がわからず困っています。すぐにどんな状況なのかわかるようにソースを
載せます。動かしたいBMPのファイル名をtStringListにADDしてDriftStart
関数をコールする形式です。
どなたかよろしくお願いします。
unit DriftImage;
// 流れるビットマップを表示するコンポーネントです。
// 作成 2008/09/22 TADA
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms,
Graphics, ComCtrls,ExtCtrls;
type
TDriftImage = class(TImage)
private
F_Rect1 : tRect;
F_Rect2 : tRect;
F_DriftIchi : integer;
F_BmpCount : integer;
F_BmpFiles : tStringList;
B_DriftStart : Boolean;
hBmp1 : tBitmap;
hBmp2 : tBitmap;
hBmpB : tBitmap;
hThread : tThread;
protected
F_DriftSpeed : integer; // 流す速さ
F_DriftPixel : integer; // 流す幅(ピクセル)
F_DriftInterval : integer; // スタート位置で止める間隔
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property DriftSpeed : integer read F_DriftSpeed write F_DriftSpeed;
property DriftPixel : integer read F_DriftPixel write F_DriftPixel;
property DriftInterval : integer read F_DriftInterval write F_DriftInterval;
property Top;
property Left;
property Height;
property Width;
property Enabled;
property Visible;
function DriftStart(bmpfiles:tStringlist):boolean;
procedure DriftStop();
end;
type
tThreader= class(tThread)
private
vSelf:TDriftImage;
protected
procedure Execute; override;
public
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TDriftImage]);
end;
var wSelf:TDriftImage;
bThreadOn:boolean;
//**********************
//スレッドループ
//**********************
procedure tThreader.Execute;
begin
//
vSelf:=wSelf;
bThreadOn:=true;
//
while not Terminated do begin
if vSelf.B_DriftStart then begin
vSelf.F_DriftIchi:=vSelf.F_DriftIchi + vSelf.F_DriftPixel;
if vSelf.F_DriftIchi >= vSelf.Width then
begin
vSelf.F_DriftIchi:=0;
vSelf.hBmp1.Assign(vSelf.hBmp2);
vSelf.hBmp2.LoadFromFile(vSelf.F_BmpFiles.Strings[vSelf.F_BmpCount]);
vSelf.hBmp1.Height:=vSelf.Height;
vSelf.hBmp2.Height:=vSelf.Height;
vSelf.hBmpB.Height:=vSelf.Height;
vSelf.hBmp1.Width:=vSelf.Width;
vSelf.hBmp2.Width:=vSelf.Width;
vSelf.hBmpB.Width:=vSelf.Width;
vSelf.hBmp1.HandleType := bmDIB;
vSelf.hBmp2.HandleType := bmDIB;
vSelf.hBmpB.PixelFormat:=vSelf.hBmp1.PixelFormat;
inc(vSelf.F_BmpCount);
if vSelf.F_BmpFiles.Count <= vSelf.F_BmpCount then vSelf.F_BmpCount:=0;
sleep(vSelf.F_DriftInterval);
end;
vSelf.F_Rect1:=vSelf.hBmp1.Canvas.ClipRect;
vSelf.F_Rect1.Left:=vSelf.F_DriftIchi;
vSelf.F_Rect1.Right:=vSelf.Width;
vSelf.F_Rect2:=vSelf.hBmp2.Canvas.ClipRect;
vSelf.F_Rect2.Left:=0;
vSelf.F_Rect2.Right:=vSelf.F_DriftIchi;
//
if vSelf.Stretch then begin
vSelf.hBmpB.Canvas.CopyRect(Rect(vSelf.F_Rect1.Right - vSelf.F_DriftIchi, 0, vSelf.F_Rect1.Right, vSelf.Height) ,
vSelf.hBmp2.canvas , vSelf.F_Rect2);
vSelf.hBmpB.Canvas.CopyRect(Rect(0, 0, vSelf.F_Rect1.Right - vSelf.F_DriftIchi, vSelf.Height),
vSelf.hBmp1.canvas , vSelf.F_Rect1);
end else begin
vSelf.hBmpB.Canvas.CopyRect(Rect(vSelf.F_Rect1.Right - vSelf.F_DriftIchi, 0, vSelf.F_Rect1.Right, vSelf.F_Rect2.Bottom) ,
vSelf.hBmp2.canvas , vSelf.F_Rect2);
vSelf.hBmpB.Canvas.CopyRect(Rect(0, 0, vSelf.F_Rect1.Right - vSelf.F_DriftIchi, vSelf.F_Rect1.Bottom) ,
vSelf.hBmp1.canvas , vSelf.F_Rect1);
end;
//
vSelf.Canvas.Draw(0, 0, vSelf.hBmpB);
//
sleep(vSelf.F_DriftSpeed);
end;
sleep(1);
end;
end;
//======================
//ドリフト開始
//======================
function TDriftImage.DriftStart(BmpFiles:tStringList):boolean;
var i:integer;
begin
result:=true;
F_BmpFiles.Assign(BmpFiles);
if F_BmpFiles.Count=0 then exit;
for i:=0 to F_BmpFiles.Count - 1 do begin
result:=result And FileExists(F_BmpFiles.Strings[i]);
end;
if not result then exit;
if hThread=nil then begin
wSelf:=self;
bThreadOn:=false;
hThread:=tThreader.Create(bThreadOn);
for i:=0 to Maxword do begin
Application.ProcessMessages;
sleep(2);
if bThreadOn then break;
end;
B_DriftStart:=bThreadOn;
end;
F_DriftIchi:=Self.Width;
F_BmpCount:=0;
result:=B_DriftStart;
end;
//======================
//ドリフト停止
//======================
procedure TDriftImage.DriftStop();
begin
B_DriftStart:=false;
if hThread<>nil then begin
hThread.Terminate;
hThread.Destroy;
hThread:=nil;
end;
end;
//======================
//constructor/destructor
//======================
constructor TDriftImage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
hThread:=nil;
F_DriftSpeed := 100;
F_DriftPixel := 4;
F_DriftInterval := 1000;
hBmp1:=tBitmap.Create;
hBmp2:=tBitmap.Create;
hBmpB:=tBitmap.Create;
F_BmpFiles:=tStringlist.Create;
end;
destructor TDriftImage.Destroy;
begin
if hThread<>nil then begin
hThread.Terminate;
hThread.Destroy;
end;
F_BmpFiles.Destroy;
hBmpB.Destroy;
hBmp2.Destroy;
hBmp1.Destroy;
inherited;
end;
end.
デバイスコンテキスト(TCanvas) に別スレッドでアクセスするのをはじめて見ました。
一般にはVCLはスレッドセーフじゃないので、自前で排他処理するか Synchronize で
同期処理をしなければなりません。数値計算や割り込みポーリングなどと違って
描画だとスレッドのありがたみはほとんどありません。
(以前の質問のスレッドは放置ですか?)
うんとさん いつもご教授ありがとうございます。
>一般にはVCLはスレッドセーフじゃないので、自前で排他処理するか
>Synchronize で
>同期処理をしなければなりません。数値計算や割り込みポーリングなどと違って
>描画だとスレッドのありがたみはほとんどありません。
とのことですが、意味がよく理解できません。
1.>自前で排他処理するかSynchronizeで同期処理をしなければならない。
とは具体的にどのような処理をすればよいのでしょうか?
簡単なソースか参考になるリンクがあれば教えてください。
2.>描画だとスレッドのありがたみはほとんどありません。
このようなコンポーネントは、スレッドではなくMMタイマーを利用したほうが
よいのでしょうか?
また、コンポーネント化するのは間違いなのでしょうか?
Synchronizeを調べて解決です。
うんとさんありがとうございました。
ツイート | ![]() |