この発言に対し以下のコメントが寄せられています

#01187　Fermion         さん　Fiber （ファイバ） 関数・手続き宣言







■説明
　ファイバ使用法のサンプルです。
　本サンプルでは２つのファイバを切り替えながら、２つの PaintBox
にグラデーションを描画させます。（マルチスレッド擬  ^^;）

■コンポーネント
　Form1 に PaintBox1, PaintBox2, および Button1 を適当に配置して
下さい。

■注意事項
　・Windows 98, NT4.0 以降で使用可。
　・Delphi上で実行させた場合例外が発生しますので、実行ファイルを
　　直接実行するようにして下さい。
　・Delphi で宣言されている Fiber 関連の関数および手続きには一部
　　誤りがありますので Fiber.pas を使用して下さい。(この発言への
　　コメントを参照。)

■その他
　・ファイバ（ Fiber ）についての詳細は、 Win32 API のヘルプ等で
　　ご確認下さい。

■サンプルコード
//=========================================================================
{...略...}
implementation

uses Fiber;

{$R *.DFM}

type
  {* FiberProcへ渡すファイバデータ型の宣言 *}
  PFiberData = ^TFiberData;
  TFiberData = record
    PntBx      : TPaintBox;               // 描画対象PaintBox
    StartColor,                           // グラデーション開始色
    EndColor   : TColor;                  //       〃      終了色
    FiberIdx   : Integer;                 // ファイバの Index
    EndFlag    : Boolean;                 // 処理完了フラグ
  end;{TFiberData}

var
  FiberData : array[0..1] of TFiberData;  // ファイバデータ配列
  pFiber    : array[0..1] of Pointer;     // ファイバ配列
  pMainFiber: Pointer;                    // メインファイバ
{*************************************************************************
   FiberProc
//***********************************************************************}
procedure FiberProc( lpParam: Pointer ); stdcall;
type
  TRGB = packed record
    case Boolean of
      False:( Color     : TColor );
      True :( R, G, B, P: Byte   );
  end;{TRGB}
var
  i,                                      // Loopカウンタ
  NextFiberIdx    : Integer;              // 切り替え先ファイバ指定用
  CurrR, CurrG, CurrB,                    // 描画色
  RStep, GStep, BStep: Extended;          // 描画色増分
begin
  with PFiberData( lpParam )^ do begin
    {* 切り替え先ファイバの Index を求める *}
    NextFiberIdx := ( FiberIdx + 1 ) mod 2;
    CurrR := TRGB( StartColor ).R;
    CurrG := TRGB( StartColor ).G;
    CurrB := TRGB( StartColor ).B;
    RStep := ( TRGB( EndColor ).R - CurrR ) / PntBx.Height;
    GStep := ( TRGB( EndColor ).G - CurrG ) / PntBx.Height;
    BStep := ( TRGB( EndColor ).B - CurrB ) / PntBx.Height;
    with PntBx.Canvas do begin
      FillRect( PntBx.ClientRect );
      with Pen do begin
        Mode  := pmCopy;
        Style := psSolid;
        Width := 1;
      end;{with Pen do}
      for i := 0 to PntBx.Height do begin
        MoveTo( 0, i );
        Pen.Color := TColor( RGB(Trunc(CurrR + 0.5),
                                 Trunc(CurrG + 0.5),
                                 Trunc(CurrB + 0.5)) );
        LineTo( PntBx.Width, i );
        CurrR := CurrR + RStep;
        CurrG := CurrG + GStep;
        CurrB := CurrB + BStep;
        {* 遅延（本来不要）*}
        Sleep(50);
        {* ファイバを切り替える（カレントファイバ状態情報が保存され *}
        {* 指定ファイバの状態情報が復元される）                     *}
        if not FiberData[ NextFiberIdx ].EndFlag then
          SwitchToFiber( pFiber[ NextFiberIdx ] );
      end;{for i := 0 to PntBx.Height do}
    end;{with PntBx.Canvas do}
    EndFlag := True;
    if FiberData[ NextFiberIdx ].EndFlag then
      SwitchToFiber( pMainFiber )
    else
      SwitchToFiber( pFiber[ NextFiberIdx ] );
  end;{with PFiberData( lpParam )^ do}
end;
{*************************************************************************
   Main Fiber
//***********************************************************************}
procedure MainFiber;
var
  i: Integer;
begin
  for i := 0 to 1 do begin
    FiberData[i].EndFlag := False;
    {* ファイバオブジェクトを生成→そのオブジェクトにスタックを割り当て *}
    {* 指定された開始アドレス(通常は Fiber Procedure)から実行を開始する *}
    {* ための準備を行う                                                 *}
    pFiber[i] := CreateFiber( 0, @FiberProc, @FiberData[i] );
  end;{for i := 0 to 1 do}
  try
    {* 現在のスレッドをファイバに変換しファイバの状態情報格納領域を作成 *}
    pMainFiber := ConvertThreadToFiber( nil );
    {* ファイバを切り替える(スケジューリング.カレントファイバの状態情報 *}
    {* は保存される）                                                   *}
    SwitchToFiber( pFiber[0] );
  finally
    {* ファイバを破棄 *}
    for i := 1 downto 0 do DeleteFiber( pFiber[i] );
  end;{try..finally..}
end;
{*************************************************************************
   Button1Click
   ・ファイバサンプルを実行する。
//***********************************************************************}
procedure TForm1.Button1Click(Sender: TObject);
var
  FrmCaption: String;
begin
  FrmCaption      := Form1.Caption;
  Form1.Caption   := 'グラデーション描画中...';
  Button1.Enabled := False;
  MainFiber;
  Button1.Enabled := True;
  Form1.Caption   := FrmCaption;
end;
{*************************************************************************
   FormCreate
   ・FiberProc に渡すための各ファイバデータを設定する。
//***********************************************************************}
procedure TForm1.FormCreate(Sender: TObject);
begin
  with FiberData[0] do begin
    PntBx := Form1.PaintBox1;
    StartColor := clAqua;
    EndColor   := clYellow;
    FiberIdx   := 0;
  end;{with FiberData[0] do}
  with FiberData[1] do begin
    PntBx := Form1.PaintBox2;
    StartColor := clYellow;
    EndColor   := clRed;
    FiberIdx   := 1;
  end;{with FiberData[1] do}
end;
{...略...}
//=========================================================================

                              00/10/23(Mon) 06:32pm  Fermion [KHF03264]

 


Original document by Fermion         氏 ID:(KHF03264)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。