[delphi-users:5185] 描画に時間がかかると無限イベントループ

[oki.miyuki]

みなさん、こんにちわ。
沖と申します。
こちら、久しぶりの投稿になります。

Delphi 10.2 , 10.3 で、描画に時間がかかると
無限イベントループになって、困っています。
プラットフォームは、Win32 です。

C# で同じ事をやってみましたが、Delphi だけで
起こります。
もし、情報を持ってる方がおられましたら、
ヒントをいただけると助かります。

■以下、Delphi, C# 双方のソース
現象を起こすために、'aaa' というテキストを
100 x 100 回、時間をかけて描画させてます。

{* フォームにPaintBoxを貼っただけのシンプルなアプリ }
unit Unit2;
interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
TForm2 = class(TForm)
PaintBox1: TPaintBox;
procedure PaintBox1Paint(Sender: TObject);
end;

var
Form2: TForm2;

implementation

{$R *.dfm}
procedure TForm2.PaintBox1Paint(Sender: TObject);
var
i, j: integer;
begin
for i := 1 to 100 do begin
for j := 1 to 100 do begin
PaintBox1.Canvas.TextOut(i,j, 'aaa');
Sleep(1);
end;
end;
end;

end.

同じように C# でアプリを作成してみましたが、こちらでは
Delphi のような現象は起こりませんでした。
フォームに直接描画しています。

using System;
using System.Drawing;
using System.Windows.Forms;

namespace WindowsFormsApplication3
{
public partial class Form1 : Form
{
public Form1()
{
InitializeComponent();
}

private void Form1_Paint(object sender, PaintEventArgs e)
{
for( int i = 0; i < 100; i++)
{
for( int j = 0; j < 100; j++)
{
e.Graphics.DrawString("aaa", Form1.DefaultFont, Brushes.Blue, (float)i, (float)j);
System.Threading.Thread.Sleep(1);
}
}
}
}
}




MLホームページ: https://www.freeml.com/delphi-users

----------------------------------------------------------------------
【重要】必ずお読みください
■freeml byGMOサービス終了のお知らせ■
2019年12月2日（月）12:00をもちまして、
サービスの提供を終了させていただきます。
詳しくはこちら
http://ck.freeml.com/rd.php?cid=11272
------------------------------------------------------[freeml byGMO]--

あなたの街のチラシがいつでも無料で見放題！
チラシをクリックしてチラシが拡大されたらポイントゲット♪
まずはかんたん登録♪　-ポイントタウン-
https://www.pointtown.com/ptu/rd.cgi?cid=8912
----------------------------------------------------------------------

[hosokawa]

沖さん

こんにちは
細川です。

無限イベントループとはどういうことでしょう？
提示されたソースを動かしましたが、普通に 10000 回 aaa が表示されて処理が完了し
ました。

特に問題が解りませんでしたが、沖さんの想定ではどのような動作になるのが正しい、
もしくは不正なのでしょうか？

Regards,
HOSOKAWA Jun
Application Division 3 Manager
embarcadero MVP for Delphi

[S/G] SERIALGAMES Inc.
TEL: 03-5812-4368
FAX: 03-5812-0970

---------------------------------------------------------------
このメールには、本来の宛先の方のみに限定された機密情報が含まれて
いる場合がございます。お心あたりのない場合は、送信者にご連絡のうえ、
このメールを削除してくださいますようお願い申し上げます。
PLEASE READ：This e-mail is confidential and intended for
the named recipient only. If you are not an intended recipient,
please notify the sender and delete this e-mail.
---------------------------------------------------------------


MLホームページ: https://www.freeml.com/delphi-users

----------------------------------------------------------------------
スマホアプリ版で100万ダウンロード突破の
「キャプテン翼ZERO～決めろ！ミラクルシュート～」
HTML5ゲームプラットフォーム「ゲソてん byGMO」にて、
PCブラウザ版を好評配信中！
https://gesoten.com/games/genre/sports/tsubasa-zero

[oki.miyuki]

沖です。
細川さん、リプライありがとうございます。

もしかしたら、他に何か条件があるのかもしれません。
OS: Windows 10 Pro (x64)
Delphi: 10.3 vcl アプリケーション

自分の環境だと、途中で フォーム右上のバツボタン「閉じる」が
赤くなったまま、フォームが（応答無し）になってしまいます。

　細川さんの環境では、普通に表示されますか・・・。


------------------------------------------
株式会社　ヒューネス　　　　沖　観行
Tel : 011-746-6665
------------------------------------------

[7of9]

7of9です。

Windows 10 v1809
RAD Studio 10.2 Tokyo Update 3

文字が上から下に、右方向へ描画
の処理が「二回」実行されました。

描画が遅いと、この数が増えるのか分かりませんが。

MLホームページ: https://www.freeml.com/delphi-users

----------------------------------------------------------------------
スマホアプリ版で100万ダウンロード突破の
「キャプテン翼ZERO～決めろ！ミラクルシュート～」
HTML5ゲームプラットフォーム「ゲソてん byGMO」にて、
PCブラウザ版を好評配信中！
https://gesoten.com/games/genre/sports/tsubasa-zero

[じゃぺ]

私の環境だとdebug起動してから18秒くらいで描画が終わりました。
(Win10 x64 Delphi 10.2.3／VCL:win32 or win64)

かわかみ

[へぼちゃん]

いつもお世話になっています。ヘボちゃんと申します。

Win8.1 16G、DelphiXE2の環境で実行してみましたが問題無く実行できました。

上から下へ左から右へ10000回実行して止まりました。

[oki.miyuki]

沖です。
みなさん、ありがとうございます。

Delphi の描画に

PaintBox1.Canvas.TextOut(i,j, 'aaa');
Application.ProcessMessages;
Sleep(1);

を挟んでみたら、2回描画される程度で済むように
なりました。

挙動も環境でまちまちですか、何かわかったら、また
ポストします。

[hosokawa]

沖さん

細川です。

こちらの環境（Windows 10 Pro x64, Delphi 10.3.1 Ent VCL Win32 Debug）では、約
90 秒で処理が完了しました。

当然、この処理を実行している間はメインスレッドが停止していますので、メッセージ
処理も停止してしまいます。

ループ内でメッセージを処理してやれば（例えば、ループ中に
Application.ProcessMessages を入れたり、別スレッドでメモリ上の DC に描画したも
のをメインスレッドで PaintBox に BitBlt するなど）×ボタンが赤くなったり応答し
ていない状態を改善できます。

Regards,
HOSOKAWA Jun
Application Division 3 Manager
embarcadero MVP for Delphi

[S/G] SERIALGAMES Inc.
TEL: 03-5812-4368
FAX: 03-5812-0970

---------------------------------------------------------------
このメールには、本来の宛先の方のみに限定された機密情報が含まれて
いる場合がございます。お心あたりのない場合は、送信者にご連絡のうえ、
このメールを削除してくださいますようお願い申し上げます。
PLEASE READ：This e-mail is confidential and intended for
the named recipient only. If you are not an intended recipient,
please notify the sender and delete this e-mail.
---------------------------------------------------------------

[oki.miyuki]

沖です。

みなさん、いろいろとありがとうございました。
メッセージうんぬんというよりも、Windows OS から
停止を食らっているのかな？という感じがしまして、
探してみましたところ、
DisableProcessWindowsGhosting API を
見つけました。

そこで、以下の API を呼び出してから実行するように
したところ、私の環境でも、止まらないで描画が実行されるように
なりました。

　追試してくださった皆様、お礼申し上げます。

procedure DisableProcessWindowsGhosting;
var
PDisableProcessWindowsGhosting: procedure; stdcall;
begin
@PDisableProcessWindowsGhosting
:= GetProcAddress(
GetModuleHandle('user32.dll'),
'DisableProcessWindowsGhosting'
);
if Assigned(PDisableProcessWindowsGhosting) = True then
begin
PDisableProcessWindowsGhosting;
end;
end;
end;

------------------------------------------
株式会社　ヒューネス　　　　沖　観行
Tel : 011-746-6665
------------------------------------------


MLホームページ: https://www.freeml.com/delphi-users

----------------------------------------------------------------------

スマホアプリ版で100万ダウンロード突破の
「キャプテン翼ZERO～決めろ！ミラクルシュート～」
HTML5ゲームプラットフォーム「ゲソてん byGMO」にて、
PCブラウザ版を好評配信中！
https://gesoten.com/games/genre/sports/tsubasa-zero