高分求教（在线等待）

Question

1、OnKeyDown事件
2、一行用TLabel，一行用TEdit不就完事了。

Answer 1

我以前写的一个打字测试的，和你的要求一样，不过评分的就很简单。
unit TiForm;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  QForm, StdCtrls, RxRichEdit, ExtCtrls, Db, ADODB, CheckLst, math, ActnList,
  ComCtrls, Buttons, MySpeedButton;type
  TTiData =packed record
     No:integer;
     Text:array [0..4096] of char;
  end;
  
type
  TFrmTextInput = class(TForm)
    Label1: TLabel;
    ADOQuery1: TADOQuery;
    ActionList1: TActionList;
    ADOQuery2: TADOQuery;
    RdtContent: TRichEdit;
    Label2: TLabel;
    Action1: TAction;
    Action2: TAction;
    Action3: TAction;
    Action4: TAction;
    sbtScore: TMySpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure RdtContentChange(Sender: TObject);
    procedure RdtContentMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure RdtContentSelectionChange(Sender: TObject);
    procedure RdtContentKeyPress(Sender: TObject; var Key: Char);
    procedure RdtContentKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure sbtScoreClick(Sender: TObject);
  private
    { Private declarations }
    ArGroup: integer;                          ///答题RadioGroup
    UserInput: Tstrings;                                  ///正确答案
    QText:TStrings;
    Credit:real;
    procedure ReLoadQuestion;
    procedure LoadNewQuestion;
    procedure GetQuestionData;
    procedure DisplayQuestion;        ///显示Text到RxRichedit
    function GetALineDiffChar(const S1, S2: string): integer;
    procedure AdjustLines;
    procedure SaveUserInput;
  public
    { Public declarations }
    procedure SaveResult(Stream: TStream);
    function GetScore: real;
  end;var
  FrmTextInput   : TFrmTextInput;implementationuses MainForm;{$R *.DFM}procedure TFrmTextInput.FormCreate(Sender: TObject);
resourcestring
  MSG_TI            = '文字输入题：共 %d 题，每题 %3.2f 分。';
  MSG_ORDER         = '(%d).';
begin
  inherited;  sbtScore.Visible :=FrmMain.CanSee;
  
  Parent:=FrmMain.Panel4;
  Top :=0;
  Left :=0;
  Align :=alClient;
  
  Randomize;
  QText:=TStringList.Create;
  UserInput :=TStringList.Create;
  ADOQuery2.Connection := FrmMain.KSDB;
  ADOQuery1.Connection := FrmMain.KSDB;
  with FrmMain do
  begin
    Credit := TiCredit / TiCount;                           ///每一个小题分数
    Self.Label1.Caption := Format(MSG_Ti, [TiCount, Credit]);
    if ReLogin then
      ReLoadQuestion
    else
      LoadNewQuestion;
  end;
  RdtContent.SelStart := 0;
end;procedure TFrmTextInput.GetQuestionData;
begin
    with ADOQuery1 do
    begin
      Close;
      SQL.Text := 'select n_No,s_Content from TextInput where n_No=' +
        IntToStr(ArGroup);
      Open;      if RecordCount <= 0 then raise Exception.Create('无法载入文字输入考试数据');
      QText.Text :=FieldByName('s_Content').AsString;
    end;
  DisplayQuestion;
end;function TFrmTextInput.GetScore: real;
var
  i                 : integer;
  TotalDiff         : integer;
begin
  TotalDiff := 0;
  for i := 0 to QText.Count - 1 do
    Inc(TotalDiff, GetALineDiffChar(QText.Strings[i],UserInput.Strings[i]));
///  Result:=TotalDiff/Length(BufQuestion.Text) * ConfigInfo.n_TextInputCredit;
  Result := 100 - (TotalDiff / Length(StringReplace(QText.Text, #13#10, '',
    [rfReplaceAll])) * 100);
  if Result < 0 then Result := 0;
  Result:=FrmMain.TiCredit*Result/100;
end;

Answer 2

procedure TFrmTextInput.LoadNewQuestion;
begin
  With ADOQuery2 do
  begin
    Close;
    SQL.Text := Format('select n_No from TextInput where n_Level=%d', [FrmMain.Level]);
    Open;
    MoveBy(Random(ADOQuery2.RecordCount));
    ArGroup:= FieldByName('n_No').AsInteger;
  end;
  GetQuestionData;
end;procedure TFrmTextInput.ReLoadQuestion;
var
  Buff              : TTiData;
begin
  FrmMain.ResultStream.Read(Buff, SizeOf(Buff));
  ArGroup:= Buff.No;
  UserInput.Text:= Buff.Text;
  GetQuestionData;
end;procedure TFrmTextInput.SaveResult(Stream: TStream);
var
  Buf               : TTiData;
begin
  inherited;
  SaveUserInput;
  Buf.No := ArGroup;
  StrpCopy(Buf.Text,UserInput.Text);
  Stream.Write(Buf, SizeOf(Buf));
end;procedure TFrmTextInput.FormDestroy(Sender: TObject);
begin
  inherited;
  UserInput.Free;
  QText.Free;
end;procedure TFrmTextInput.DisplayQuestion;
var
  i                 : integer;
begin
  with RdtContent do
  begin
    Clear;
    try
      OnChange := nil;
      for i := 0 to QText.Count - 1 do
      begin
        SelAttributes.Color := clBlue;
        Lines.Add(QText.Strings[i]); // Load question Content
        SelAttributes.Color := clWindowText;
        if FrmMain.ReLogin then
          Lines.Add(UserInput.Strings[i])
        else
          Lines.Add('');
      end;
      SelStart := SendMessage(Handle, EM_LINEINDEX, 1, 0);
    finally
      OnChange := RdtContentChange;
    end;
  end;
end;function TFrmTextInput.GetALineDiffChar(const S1, S2: string): integer;
var
  MinLen            : integer;
  i, L1, L2         : integer;
begin
  Result := 0;
  L1 := Length(s1);
  L2 := Length(s2);
  if L1 <= L2 then
    MinLen := L1
  else
    MinLen := L2;
  Inc(Result, abs(L1 - L2));
  for i := 1 to MinLen do
    if s1[i] <> s2[i] then
      Inc(Result);
end;procedure TFrmTextInput.RdtContentChange(Sender: TObject);
begin
  inherited;
  try
    RdtContent.OnChange := nil;
    LockWindowUpdate(RdtContent.Handle);
    AdjustLines;
//    SaveUserInput;
  finally
    RdtContent.OnChange := RdtContentChange;
    LockWindowUpdate(0);
  end;
end;
procedure TFrmTextInput.AdjustLines;
var
  i, sep            : integer;
  buf               : string;
  Curr              : integer;
begin
  inherited;
  with RdtContent do
  begin
    Curr := SelStart;
    i:=0;
    while i<Lines.Count div 2+1 do
//    for i := 0 to Lines.Count - 1 do
    begin
      sep := Length(Lines.Strings[i]);
      if Length(Lines.Strings[i + 1]) > sep then
      begin
        Buf := Lines.Strings[i + 1];
        if ByteType(Buf, Sep) = mbLeadByte then inc(sep);
        Lines.Strings[i + 1] := Copy(Buf, 1, sep);
        Lines.Strings[i + 3] := Copy(Buf, sep + 1, Length(Buf) - Sep) +
          Lines.Strings[i + 3];
      end;
      inc(i,2);
    end;
    SelStart := Curr;
  end;
end;procedure TFrmTextInput.RdtContentMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if RdtContent.SelLength > 0 then
    RdtContent.SelLength := 0;
end;procedure TFrmTextInput.RdtContentSelectionChange(Sender: TObject);
var
  Old               : integer;
begin
  inherited;
  with RdtContent do  ///移动光标，禁止移动到偶数行，偶数行是试题内容
  begin
    Old := CaretPos.x;
    if CaretPos.y mod 2 = 0 then
    begin
      SelStart := SendMessage(Handle, EM_LINEINDEX, CaretPos.Y + 1, 0);
      if Old > Length(Lines.Strings[CaretPos.Y]) then
        Old := Length(Lines.Strings[CaretPos.Y]);
      SelStart := SelStart + Old;
    end;
  end;
end;procedure TFrmTextInput.RdtContentKeyPress(Sender: TObject; var Key: Char);
begin
  inherited;
  with RdtContent do
  begin
    if CaretPos.y mod 2 = 0 then
    begin
      Key := #0;
      exit;
    end;
    if Key = #13 then
    begin
      Key := #0;
      SelStart := SendMessage(Handle, EM_LINEINDEX, CaretPos.Y + 2, 0);
      Perform(EM_SCROLLCARET, 0, 0);
    end;
  end;
end;procedure TFrmTextInput.RdtContentKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  Old               : integer;
begin
  inherited;
  with RdtContent do
  begin
    if CaretPos.y mod 2 = 0 then exit;
    case Key of
      VK_UP:
        begin
          Old := CaretPos.x;
          SelStart := SendMessage(Handle, EM_LINEINDEX, CaretPos.Y - 2, 0);
          if Old > Length(Lines.Strings[CaretPos.Y]) then
            Old := Length(Lines.Strings[CaretPos.Y]);
          SelStart := SelStart + Old;
        end;
      VK_BACK:  ///退格
        begin
          if CaretPos.x = 0 then  //如果在行首，那么要回到上一行的末尾
          begin
            Key := 0;
            SelStart := SendMessage(Handle, EM_LINEINDEX, CaretPos.Y - 2, 0);
            SelStart := SelStart + Length(Lines.Strings[CaretPos.Y]);
          end;
        end;
      VK_DELETE:    ///如果是删除
      begin
        if CaretPos.x = Length(Lines.Strings[CaretPos.Y]) then Key := 0;
      end;
    end;
  end;
end;procedure TFrmTextInput.SaveUserInput;
var
  i                 : integer;
begin
  UserInput.Clear;
  for i := 0 to QText.Count - 1 do
    UserInput.Add(RdtContent.Lines.Strings[i * 2 + 1]);
end;procedure TFrmTextInput.sbtScoreClick(Sender: TObject);
begin
  SaveUserInput;
  MessageBox(GetActiveWindow,pchar(FloatToStr(GetScore)),'信息',MB_OK+MB_ICONINFORMATION);
end;end.