お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
１６番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"タイピング,StringGridの応用例" 





  StringGridとTimerを使った応用例です。
アルファベット２６文字のキータイプ練習ができます。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
　Dialogs, ExtCtrls, Grids, ComCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    UpDown1: TUpDown;
    StringGrid1: TStringGrid;
    StringGrid2: TStringGrid;
    Timer1: TTimer;
    Timer2: TTimer;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure StringGrid2DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
procedure MakeProbrem;
procedure SearchCharactor( Ch: Char; var ACol, ARow: integer);
procedure AllClear;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
  TotalCnt, HitCnt, ErCnt, TimeCnt,
                           StG1Col, ErCol, ErRow : integer;
//打鍵数,ヒット数,エラー数,時間,
                         StringGrid1の列,StringGrid2の列,行
  Ch: array[0..25] of Char;{キャラクタ文字を持つ配列}

procedure TForm1.AllClear;{表示部分を初期化する}
var
  ACol, ARow : integer;
begin
  TotalCnt := 0; HitCnt := 0;
  ErCnt := 0; StG1Col := 0;
  TimeCnt := 0;
  ErCol := -1; ErRow := -1;

  Edit1.Text := '0'; Edit2.Text := '0';
  Edit3.Text := '0'; Edit4.Text := '0';
  StringGrid1.Col := 0;
  SearchCharactor( StringGrid1.Cells[0,0][1], ACol, ARow);
  StringGrid2.Col := ACol;
  StringGrid2.Row := ARow;
end;

procedure TForm1.MakeProbrem;{問題を作る}
var
  i : integer;
begin
  for i := 0 to StringGrid1.ColCount - 1 do
    StringGrid1.Cells[i,0] := Ch[Random( Length( Ch))];
end;

procedure TForm1.SearchCharactor( Ch: Char;
 var ACol, ARow: integer);{キーを探索する}
var
  HitFlg : Boolean;
  i, j, SearchCnt : integer;
begin
  With StringGrid2 do begin
    HitFlg := False;
    i := 0; j := 0; SearchCnt := 0;
    While HitFlg = False do begin
      if Cells[i,j] = Ch then begin
        HitFlg := True;
      end else begin
        Inc( i); Inc( j);
        Inc( SearchCnt);
        if j = RowCount then j := 0;
        if i = ColCount then i := 0;
        if RowCount * ColCount < SearchCnt then Break;
      end;
    end;

    ACol := i;
    ARow := j;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Enabled := False; Timer1.Interval := 300;
  Timer2.Enabled := False;
  Form1.Width := 360; Form1.Height := 240;
  Form1.Font.Size := 14; Form1.Font.Style := [fsBold];
  Form1.Position := poScreenCenter;
  Button1.Left := 5; Button1.Top := 5; Button1.Caption := 'DEMO';
  Button2.Left := 80; Button2.Top := 5; Button2.Caption := 'TRY';
  Label1.Left := 10; Label1.Top := 35; Label1.Caption := 'Hit';
  Label2.Left := 105; Label2.Top := 35; Label2.Caption := 'Error';
  Label3.Left := 215; Label3.Top := 35; Label3.Caption := 'Total';
  Label4.Left := 165; Label4.Top := 5; Label4.Caption := 'Time';
  Edit1.Width := 50; Edit1.Left := 40; Edit1.Top := 35;
  Edit2.Width := 50; Edit2.Left := 155; Edit2.Top := 35;
  Edit3.Width := 50; Edit3.Left := 270; Edit3.Top := 35;
  Edit4.Width := 50; Edit4.Left := 210; Edit4.Top := 5;
  Edit5.Width := 50; Edit5.Left := 260; Edit5.Top := 5;
  UpDown1.Associate := Edit5;
  UpDown1.Increment := 10; UpDown1.Min := 30;

  With StringGrid1 do begin
    Left := 15; Top := 65;
    ColCount := 10; RowCount := 1;
    DefaultColWidth := 30; DefaultRowHeight := 28;
    StringGrid1.Width := 313; StringGrid1.Height := 30;
    Font.Size := 18;
    ScrollBars := ssNone;
    FixedCols := 0; FixedRows := 0;
  end;

  With StringGrid2 do begin
    Left := 15; Top := 100;
    ColCount := 10; RowCount := 3;
    DefaultColWidth := 30; DefaultRowHeight := 28;
    StringGrid2.Width := 313; StringGrid2.Height := 90;
    Font.Size := 18;
    ScrollBars := ssNone;
    FixedCols := 0; FixedRows := 0;
  end;

  Randomize;
  Ch := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';{キャラクタ文字をセット}
  {キーボード配列をセット}
  StringGrid2.Rows[0].CommaText := 'Q,W,E,R,T,Y,U,I,O,P';
  StringGrid2.Rows[1].CommaText := 'A,S,D,F,G,H,J,K,L';
  StringGrid2.Rows[2].CommaText := '" ",Z,X,C,V,B,N,M';

  MakeProbrem;{問題を作る}
  AllClear;{表示部分を初期化}
  ActiveControl := StringGrid1;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin{デモンストレーション用}
  if ActiveControl = StringGrid1 then begin
    Keybd_event( Ord( Stringgrid1.Cells[StG1Col,0][1] ), 0, 0, 0);
    Keybd_event( Ord( StringGrid1.Cells[StG1Col,0][1] ),
                                            0, KEYEVENTF_KEYUP, 0);
  end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin{時間制限でどれだけ打てるか}
  if ActiveControl = StringGrid1 then begin
    Inc( TimeCnt);
    Edit4.Text := IntToStr( TimeCnt);
    if UpDown1.Position <= TimeCnt then begin
      Timer2.Enabled := False;
      if MessageDlg( '続けますか？', mtInformation,
                              [mbYES,mbNO], 0) = mrYES then
        Button2Click( Sender)
      else
        AllClear;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);{デモ}
begin
  if Timer2.Enabled then Timer2.Enabled := False;
  if Timer1.Enabled then
    Timer1.Enabled := False
  else begin
    AllClear;
    StringGrid1.SetFocus;
    Timer1.Enabled := True;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);{ＴＲＹ}
begin
  MakeProbrem;
  AllClear;
  StringGrid1.SetFocus;
  if Timer1.Enabled then Timer1.Enabled := False;
  Timer2.Enabled := True;
end;

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
var
  ACol, ARow : integer;
begin
  Key := UpperCase( Key)[1];{Keyを常に大文字とするため}
  {ヒットかエラーの判定}
  if Key = StringGrid1.Cells[StG1Col,0][1] then begin{ヒット}
    Inc( HitCnt);{ヒット数をカウント}
    Inc( StG1Col);{次の問題へ移る}
    ErCol := -1; ErRow := -1;{エラーきーの表示を消す}
    StringGrid2.invalidate;{エラーきーの表示を消すために必要}
  end else begin{エラー}
    Inc( ErCnt);{エラー数をカウント}
    SearchCharactor( Key, ErCol, ErRow);{エラーキーの列、行を探索}
    StringGrid2.invalidate;{エラーキーを表示するために必要}
  end;

  Inc( TotalCnt);

  Edit1.Text := IntToStr( HitCnt);{ヒット数を表示}
  Edit2.Text := IntToStr( ErCnt);{エラー数を表示}
  Edit3.Text := IntToStr( TotalCnt);{トータルの打鍵数を表示}

  Key := #0;
  {一つの問題が終わったら次の問題を作って表示する}
  if StG1Col = StringGrid1.ColCount then begin
    StG1Col := 0;
    MakeProbrem;
  end;
  {打つべきキーを表示する。}
  SearchCharactor( StringGrid1.Cells[StG1Col,0][1], ACol, ARow);
  StringGrid2.Col := ACol;
  StringGrid2.Row := ARow;
  StringGrid1.Col := StG1Col;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject;
  ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
  With StringGrid1.Canvas do begin
    Brush.Color := clWhite;

    if gdSelected in State then begin{問題のキーを表示}
      Brush.Color := clAqua;
      Font.Color := clNavy;
    end;

    FillRect( Rect );
    OffSetRect( Rect, 2, 2 );  //文字描画位置の調整
    DrawText( Handle, PChar( StringGrid1.Cells[ ACol, ARow ] ),
                                           -1, Rect, DT_CENTER );
  end;
end;

procedure TForm1.StringGrid2DrawCell(Sender: TObject;
  ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
  With StringGrid2.Canvas do begin
    if gdSelected in State then begin{問題のキーを表示}
      Brush.Color := clAqua;
      Font.Color := clNavy;
    end;

    if ( ACol = ErCol) and ( ARow = ErRow) then begin{エラーキー}
      Brush.Color := clYellow;
      Font.Color := clRed;
    end;

    FillRect( Rect);
    OffSetRect( Rect, 2, 2);
    DrawText( Handle, PChar( StringGrid2.Cells[ ACol, ARow]),
                                            -1, Rect, DT_CENTER);
  end;
end;

end.

                                     00/01/16(日)  意津(VEP03671)

Original document by 意津            氏 ID:(VEP03671)

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