[lmikle]

Ну, например, это делается примерно так:

Базовые классы:

Код:

unit Questions;

interface

uses
  Windows, SysUtils, Classes, Contnrs;

type
  TQuestion = class
  private
    FText : String;
    FItems : TStringList;
    FRight : Integer;
    procedure SetRight(const Value: Integer);
  protected
    function ReadString(AStream : TStream) : String;
    procedure WriteString(AStream : TStream; AData : String);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Save(AStream : TStream);
    procedure Load(AStream : TStream);

    property Text : String read FText write FText;
    property Items : TStringList read FItems;
    property Right : Integer read FRight write SetRight;
  end;

  TTest = class
  private
    FItems : TObjectList;
    function GetCount: Integer;
    function GetItem(Index: Integer): TQuestion;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Save(AFileName : String);
    procedure Load(AFileName : String);

    procedure Add(AQuestion : TQuestion);
    procedure Delete(AIndex : Integer);
    procedure Remove(AQuestion : TQuestion);

    function Check : Boolean;

    property Count : Integer read GetCount;
    property Items[Index : Integer] : TQuestion read GetItem;
  end;


implementation

{ TQuestion }

constructor TQuestion.Create;
begin
  inherited;
  FItems := TStringList.Create;
end;

destructor TQuestion.Destroy;
begin
  FItems.Free;
  inherited;
end;

procedure TQuestion.Load(AStream: TStream);
begin
  FText := ReadString(AStream);
  FItems.Text := ReadString(AStream);
  AStream.ReadBuffer(FRight,SizeOf(Integer));
end;

function TQuestion.ReadString(AStream: TStream): String;
var
  N : Integer;
begin
  AStream.ReadBuffer(N,SizeOf(Integer));
  If N > 0 Then
    Begin
      SetLength(Result,N);
      AStream.ReadBuffer(Result[1],N);
    End;
end;

procedure TQuestion.Save(AStream: TStream);
begin
  WriteString(AStream,FText);
  WriteString(AStream,FItems.Text);
  AStream.WriteBuffer(FRight,SizeOf(Integer));
end;

procedure TQuestion.SetRight(const Value: Integer);
begin
  If (Value <> 0) And (Value >= FItems.Count) Then
    Raise Exception.Create('Номер правильного ответа больше, чем их общее кол-во.');
  FRight := Value;
end;

procedure TQuestion.WriteString(AStream: TStream; AData: String);
var
  N : Integer;
begin
  N := Length(AData);
  AStream.WriteBuffer(N,SizeOf(Integer));
  If N > 0 Then
    AStream.WriteBuffer(AData[1],N);
end;

{ TTest }

procedure TTest.Add(AQuestion: TQuestion);
begin
  FItems.Add(AQuestion);
end;

constructor TTest.Create;
begin
  inherited;
  FItems := TObjectList.Create(True);
end;

procedure TTest.Delete(AIndex: Integer);
begin
  FItems.Delete(AIndex);
end;

procedure TTest.Remove(AQuestion: TQuestion);
begin
  FItems.Remove(AQuestion);
end;

destructor TTest.Destroy;
begin
  FItems.Free;
  inherited;
end;

function TTest.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TTest.GetItem(Index: Integer): TQuestion;
begin
  Result := FItems[Index] As TQuestion;
end;

procedure TTest.Load(AFileName: String);
var
  N, I : Integer;
  AStream : TFileStream;
  AQuestion : TQuestion;
begin
  FItems.Clear;
  AStream := TFileStream.Create(AFileName,fmOpenRead);
  Try
    N := 0;
    AStream.ReadBuffer(N,SizeOf(Integer));
    For I := 0 To N-1 Do
      Begin
        AQuestion := TQuestion.Create;
        AQuestion.Load(AStream);
        FItems.Add(AQuestion);
      End;
  Finally
    AStream.Free;
  End;
end;

procedure TTest.Save(AFileName: String);
var
  N, I : Integer;
  AStream : TFileStream;
begin
  AStream := TFileStream.Create(AFileName,fmCreate);
  Try
    N := Count;
    AStream.WriteBuffer(N,SizeOf(Integer));
    For I := 0 To N-1 Do
      Items[i].Save(AStream);
  Finally
    AStream.Free;
  End;
end;

function TTest.Check: Boolean;
var
  I : Integer;
begin
  Result := True;
  For I := 0 To FItems.Count-1 Do
    Begin
      Result := (Items[i].Items.Count > 0) And
                (Items[i].Right >= 0) And (Items[i].Right < Items[i].Items.Count);
      If Not Result Then Exit;
    End;
end;

end.

Собственно программа (главная форма):

Код:

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, XPMan, Questions;

type
  TMainForm = class(TForm)
    pcBody: TPageControl;
    tsBegin: TTabSheet;
    tsQuestions: TTabSheet;
    tsResult: TTabSheet;
    lbGreeting: TLabel;
    edName: TEdit;
    lbButtons: TLabel;
    btBegin: TButton;
    btClose: TButton;
    XPManifest1: TXPManifest;
    gbQuestion: TGroupBox;
    gbAnswers: TRadioGroup;
    btNext: TButton;
    lbText: TLabel;
    lbConfirm: TLabel;
    btYes: TButton;
    btNo: TButton;
    lbResult: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btCloseClick(Sender: TObject);
    procedure edNameChange(Sender: TObject);
    procedure gbAnswersClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btBeginClick(Sender: TObject);
    procedure btNextClick(Sender: TObject);
    procedure btNoClick(Sender: TObject);
    procedure btYesClick(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
    FTest : TTest;
    FRightAns : Integer;
    FCurrQuestion : Integer;
    procedure ShowQuestion;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
var
  AFileName : String;
begin
  FTest := TTest.Create;
  AFileName := ExtractFilePath(Application.ExeName) + 'SimpleTest.db';
  If FileExists(AFileName)
    Then FTest.Load(AFileName)
    Else
      Begin
        MessageDlg('Файл базы вопросов SimpleTest.db не найден. Выполнение программы невозможно.',mtError,[mbOK],0);
        Halt(1);
      End;
  If FTest.Count = 0 Then
    Begin
      MessageDlg('Файл базы вопросов SimpleTest.db содержит 0 вопросов. Выполнение программы невозможно.',mtError,[mbOK],0);
      Halt(2);
    End;

  pcBody.ActivePage := tsBegin;
  tsBegin.TabVisible := True;
  tsQuestions.TabVisible := False;
  tsResult.TabVisible := False;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  If pcBody.ActivePage = tsQuestions
    Then CanClose := MessageDlg('Вы действительно хотите прервать тест?',mtConfirmation,[mbYes,mbNo],0) = mrYes
    Else CanClose := True;
end;

procedure TMainForm.btCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.edNameChange(Sender: TObject);
begin
  btBegin.Enabled := edName.Text <> '';
end;

procedure TMainForm.gbAnswersClick(Sender: TObject);
begin
  btNext.Enabled := gbAnswers.ItemIndex > -1;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FTest.Free;
end;

procedure TMainForm.btBeginClick(Sender: TObject);
begin
  FRightAns := 0;
  FCurrQuestion := -1;
  tsQuestions.TabVisible := True;
  pcBody.ActivePage := tsQuestions;
  tsBegin.TabVisible := False;
  ShowQuestion;
end;

procedure TMainForm.ShowQuestion;
begin
  If FCurrQuestion > -1 Then
    Begin
      If gbAnswers.ItemIndex = -1 Then Exit;
      If gbAnswers.ItemIndex = FTest.Items[FCurrQuestion].Right Then Inc(FRightAns);
    End;

  Inc(FCurrQuestion);
  If FCurrQuestion >= FTest.Count
    Then
      Begin
        tsResult.TabVisible := True;
        pcBody.ActivePage := tsResult;
        tsQuestions.TabVisible := False;
        lbResult.Caption := 'Тестируемый: '+edName.Text+#13#10+
                            'Всего задано вопросов: ' + IntToStr(FTest.Count)+#13#10+
                            'Отвечено правильно: ' + IntToStr(FRightAns)+#13#10+
                            'Отвечено неправильно: ' + IntToStr(FTest.Count - FRightAns)+#13#10+
                            Format('Процент правильных ответов: %.2f%%',[100*FRightAns/FTest.Count]);
      End
    Else
      Begin
        tsQuestions.Caption := Format('Вопрос %d из %d',[FCurrQuestion + 1,FTest.Count]);
        lbText.Caption := FTest.Items[FCurrQuestion].Text;
        gbAnswers.ItemIndex := -1;
        gbAnswers.Items.Text := FTest.Items[FCurrQuestion].Items.Text;
        btNext.Enabled := gbAnswers.ItemIndex <> -1;
      End;
end;

procedure TMainForm.btNextClick(Sender: TObject);
begin
  ShowQuestion;
end;

procedure TMainForm.btNoClick(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.btYesClick(Sender: TObject);
begin
  tsBegin.TabVisible := True;
  tsQuestions.TabVisible := False;
  tsResult.TabVisible := False;
  pcBody.ActivePage := tsBegin;  
end;

procedure TMainForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
  If Key = #13 Then
    Begin
      If (pcBody.ActivePage = tsQuestions) And
         (btNext.Enabled) Then btNextClick(Sender); 
    End;
end;

end.

Делал для одного человека...
Оценка, кажется, не считается (не помню уже), но это дописать не сложно.