TImageをベースにコンポーネントを作るには？ (ID：31743)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

TImageをベースにコンポーネントを作成しています。
コンポーネント内でスレッド作成しそこでキャンバス上に画像イメージが
流れる様に作ったのですが、実際フォームに作成したコンポーネントを貼り付けて
動かすと、フォームの再描画（フォーム上をマウスが通過するなど）で
作成したコンポーネントの描画がとまってしまいます。
原因がわからず困っています。すぐにどんな状況なのかわかるようにソースを
載せます。動かしたいＢＭＰのファイル名を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.

←解決時は質問者本人がここをチェックしてください。

戻る