処理の流れを一時停止するには？
解決処理の一時停止の件を教えて頂けませんか。
環境はWindows XP Delphi6 Personalです。
スライドショーを作成しています。
スペースバーを押されるまで待機して、押されたら次のファイルを表示するようにしています。
これでも動くのですが、待機中ＣＰＵ使用率を見ると１００％で気になります。
キーを押されるまで処理の流れを停止しておく何か他の方法はないかと調べたらコンソールアプリで Readln;の例がありましたが、
コンソールアプリでないのでI/Oエラー６がでます。
よろしくお願いいたします。
repeat
ImageDisp(ListBox1.Items[ListNo]);//指定した画像ファイルを表示する
・・
・・
Sleep(400); //チャタリング防止
//スペースキーを押されるまで待っている
while (GetAsyncKeyState(VK_SPACE) = 0) do
begin
Application.ProcessMessages;
if GetAsyncKeyState(VK_ESCAPE)<>0 then
begin SlideStop:=true;break;end;//ESCキーが押されたら終了
end;
・・
if GetAsyncKeyState(VK_SPACE) <> 0 then
ListNo:=ListNo+1; //スペースキーなら次の画像ファイルを指定
・・
until SlideStop=true;//終了フラグで抜け出す。
ループで待機するのではなく
TForm のOnKeyDown イベントなどを使ったら、どうでしょう。
え〜とさん、さっそく教えて頂いてありがとうございます。
実際はPageControlにTabsheetを貼り付けてそこにImageを動的に貼り付けて表示させています。
スライドショーはやってみると意外に難しくわたしの実力には荷が重いですが、動画があったときはImageにではなく、WindowsMediaPlayerを起動するようにしていますが、このときフォームにフォーカスはないのですがOnkeyDownが効くのか、動画再生中でもかまわず次の画像を指定するときなど、作用するのか判りませんが、いまからトライしてみます。
ありがとうございました。
また何かありましたら教えてください。
さっそくやってみましたが反応しません。何か基本的なことを忘れているのでしょう。
procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
ShowMessage('キーが押されました');
end;
PageControlにもImageにもOnkeyDownイベントがありませんでした。
引き続きトライしてみます。
> さっそくやってみましたが反応しません。
すみません。OnKeyPressでした。
> このときフォームにフォーカスはないのですが
TFormのイベントでは無理ですね。
Form.KeyPreview = True ってのは？
えーとねさん、ｏｒｚさんさっそく教えて頂いてありがとうございます。
OnkeyPress でトライしてみます。
また、Form.KeyPreview = True は初めて知りましたが、OnkeyPressなどと組み合わせてできないがトライしてみます。
ただ、ヘルプによるとアスキーコード以外は発生しないと書いてありますから定番の矢印キーなど使えないのではと想像しますが文字キーなどに割り当てればいいのかなと考えます。
これらを工夫しながらトライしてみます。
今まで、ビューワーソフトにはさんざんお世話になっていたのですが、「ぱっぱっとファイルを切り替えるだけじゃないか」と軽く考えていました。
また何かあったら教えてください。
では。
例えば
procedure TForm1.FormKeyUp(Sender: TObject;
var Key: Word;
Shift: TShiftState);
begin
Case Key of
VK_Space: Timer1.Interval := 500;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
// NextImage を表示するコード
end;
これは連続して次から次へ表示する場合です。
一つ一つ手動で表示したいのなら（質問ではそう読める）
TTimer は使用せず、Timer1.Interval := 500;
の行の変わりに、次の画像を表示するコードを入れます。
TEdit 等のように優先的にフォーカスを取り込むコントロールがある場合には、
Form1.KeyPreview := true にして FormKeyUp を有効にします。
さどやまさん、ありがとうございました。
未だ解決せず悪戦苦闘しています。
おっしゃるとおり手動で表示する場合です。
さっそくトライします。
では。
さどやまさん、結果報告をいたします。
スライドショーですからEditのようなコントロールはないのですが、ShellTreeView1でフォルダを選択させてフォルダにフォーカスが当たるので、
実行すると最初の一回は実行しますが次回は実行しませんでした。
procedure TformMDI.ShellTreeView1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Case Key of
VK_Space: ShowMessage('キーが押されました');
end;
end;
以前、TRichEditの欠陥問題でTabキーが効かない対策として、どこかのサイトで見つけたものがあります。
理屈は判りませんが、たしかに、Tabキーが正常に作動します。
private
procedure CMDialogKey(var Msg: TMessage); message CM_DIALOGKEY;
・・・
procedure TformRich.CMDialogKey(var Msg: TMessage);
begin
if (Msg.WParam = VK_TAB) and (ActiveControl = RichEdit1) then
Msg.Result := 0
else Inherited;
end;
これも毎回キーを押されたのを監視しているので使えないかと試して見たのですが、Tabキー、矢印キー以外は検知しないようです。
文字キーや他のキーを検知するMessageでもあるのかなとトライしています。
では。
また、何かありましたら教えてください。
> 未だ解決せず悪戦苦闘しています。
戦闘場所がどこか不明ですが、単純なコード例を示します。（Delphi3)
これにいろいろ加えていくとどこかで実現しなくなるのでしょう。
そこが本当の戦闘地域です。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
private
FileList: TStringList;
CurrentID: Integer;
public
end;
var
Form1: TForm1;
implementation
procedure TForm1.FormCreate(Sender: TObject);
begin
FileList := TStringList.Create;
// KeyPreview := true; // 必要に応じ
FileList.Add('000.bmp');
FileList.Add('001.bmp');
FileList.Add('002.bmp');
CurrentID := 0; // 必要ないが
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FileList.Free;
end;
procedure TForm1.FormKeyUp(Sender: TObject;
var Key: Word;
Shift: TShiftState);
begin
Case Key of
VK_Space:
begin
Image1.Picture.LoadFromFile(FileList[CurrentID]);
Inc(CurrentID);
if CurrentID = FileList.Count then CurrentID := 0;
end;
end;
end;
end.
> 「ぱっぱっとファイルを切り替えるだけじゃないか」と軽く考えていました
スライドショーに関して言えば、そう軽く考えていただいて結構です。
ShellTreeView を使った事がないのですが、試してみました。
Button1 をクリックすると MainPath に、現在選択されているフォルダが得られます。(Delphi7)
unit Unit3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, ExtCtrls, ComCtrls, ShellCtrls, StdCtrls;
type
TForm1 = class(TForm)
ShellTreeView1: TShellTreeView;
Image1: TImage;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
FileList: TStringList;
CurrentID: Integer;
MainPath: String;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
FileList := TStringList.Create;
KeyPreview := true; // 必要に応じ
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FileList.Free;
end;
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Case Key of
VK_Space:
begin
Image1.Picture.LoadFromFile(FileList[CurrentID]);
Inc(CurrentID);
if CurrentID = FileList.Count then CurrentID := 0;
Key := 0; // Button1.Click を無効にする
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
MainPath := ShellTreeView1.Path + '\';
// MainPath とFindFirst,Nextを使ってFileListにファイル名を
// リストアップしたとする
FileList.Add('000.bmp');
FileList.Add('001.bmp');
FileList.Add('002.bmp');
end;
end.
さどやまさん、ありがとうございました。
解決しました。
わたくしも、いろいろ、ない知識をかきむしりながら、なにかキーアクションを捕まえる方法がないものかと、ふと思い出して過去ログの
「WebBrowserでの入力が・・・」のなかに
本来、WebBrowser1で表示したページのテキストボックスの入力バグ対策があります。苦し紛れに考えたことですが
PageControlにWeb表示をしたり、Imageを表示したりするのだからと考え
procedure TForm1.MsgHandler(var Msg: TMsg; var Handled: Boolean);
の頭に取り出し口をもうけて
if (PageControl1.ActivePage as TTabSheet).Caption='スライドショー') then
begin
if (GetAsyncKeyState(VK_SPACE) <> 0) then
begin Sleep(300);SlideShowDisp(1);end;//自前描画処理手続きへ
end;
まことに無粋な方法ですが、上に動画ソフトが被さっていても実行しました。
しかしこれでは何か問題が起こるかもしれません。
助かりました。
ありがとうございました。
| ツイート |  |