Componentes.Terceros.TRichView/12.0.4/Demos/DelphiUnicode/Assorted/PlanetQuiz/Unit1.pas

{==============================================================================}
{ This demo shows how to work with tables, mouse events, GetItemAt method      }
{==============================================================================}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, RVTable, RVScroll, RichView, RVStyle, CRVFData, StdCtrls, MMSystem;

type
  TForm1 = class(TForm)
    RVStyle1: TRVStyle;
    RichView1: TRichView;
    procedure FormCreate(Sender: TObject);
    procedure RichView1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure RichView1RVMouseUp(Sender: TCustomRichView;
      Button: TMouseButton; Shift: TShiftState; ItemNo, X, Y: Integer);
    procedure RichView1Jump(Sender: TObject; id: Integer);
  private
    { Private declarations }
    HighlightedRVData: TCustomRVFormattedData; // highlighted cell
    AnsweredCount: Integer; // number of answered count
    Ready: Boolean; // "ready!" is clicked
    procedure AddTable(const Question: String; Answers: TStringList; CorrectAnswer: Integer);
    procedure HighlightCell(RVData: TCustomRVFormattedData);
    procedure SelectCell(RVData: TCustomRVFormattedData);
    procedure FillQuestion(sl: TStringList; const arr: array of String; var CorrectAnswer: Integer);
    procedure BuildQuiz;
  public
    { Public declarations }

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// Sorted array of answers.
const Answers : array [0..3, 0..8] of String =
 (
  ('Mercury', 'Venus', 'Earth', 'Mars', 'Jupiter', 'Saturn', 'Uranus', 'Neptune', 'Pluto'),
  ('Pluto', 'Neptune', 'Uranus', 'Saturn', 'Jupiter', 'Mars', 'Earth', 'Venus', 'Mercury'),
  ('Pluto', 'Mercury', 'Mars', 'Venus', 'Earth', 'Neptune', 'Uranus', 'Saturn', 'Jupiter'),
  ('Jupiter', 'Saturn', 'Uranus', 'Neptune', 'Earth', 'Venus', 'Mars', 'Mercury', 'Pluto')
 );

// Array of questions
const Questions: array [0..3] of String =
  ( 'Which of these planets is closest to the Sun?',
    'Which of these planets is the most distant from the Sun?',
    'Which of these planets is the smallest?',
    'Which of these planets is the largest?'
   );


{ TForm1 }

const
  TABLECOLOR = $CCFFFF;
  HEADCOLOR  = $990033;//$CCFF33;
  HLTCOLOR   = $66CCFF;
  SELCOLOR   = $3399CC;
  PASSCOLOR  = $00FF33;
  FAILCOLOR  = $0033FF;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;
  BuildQuiz;
end;
{------------------------------------------------------------------------------}
// Filling RichView. Preparing the quiz
procedure TForm1.BuildQuiz;
var sl: TStringList;
    i, CorrectAnswer: Integer;
begin
  RichView1.Clear;
  AnsweredCount := 0;
  sl := TStringList.Create;
  for i := 0 to High(Questions) do begin
    // adding questions. one question is one table
    FillQuestion(sl, Answers[i], CorrectAnswer);
    AddTable(Questions[i], sl, CorrectAnswer);
    RichView1.AddNL('',0,0);
  end;
  sl.Free;
  // adding hypertext "button"
  RichView1.AddNL('Ready!', 2, 1);
  RichView1.Format;
  Ready := False;
  RVStyle1.TextStyles[2].HoverBackColor := FAILCOLOR;
end;
{------------------------------------------------------------------------------}
// This function chooses 3 answers from ARR and add them in SL.
// Index of the correct answer is returned in CORRECTANSWER
procedure TForm1.FillQuestion(sl: TStringList; const arr: array of String;
  var CorrectAnswer: Integer);
var i,j,v: Integer;
var Options: array [0..2] of Integer;
begin
  sl.Clear;
  // Choosing 3 different random answers
  for i := 0 to High(Options) do
    repeat
      v := Random(High(arr)+1);
      for j := 0 to i-1 do
        if Options[j]=v then begin
          v := -1;
          break;
        end;
      if v>=0 then begin
        Options[i] := v;
        sl.Add(arr[v]);
      end;
    until v>=0;
  // Finding the correct answer. arr is sorted so that the correct answer
  // is an answer with smaller index
  CorrectAnswer := -1;
  j := High(arr)+1;
  for i := 0 to High(Options) do begin
    if Options[i]<j then begin
      j := Options[i];
      CorrectAnswer := i;
    end;
  end;
end;
{------------------------------------------------------------------------------}
// Adding one question
// The 0-th table row will contain the question. Other rows - answers.
// Index of the correct answer is stored in invisible table caption
procedure TForm1.AddTable(const Question: String; Answers: TStringList;
  CorrectAnswer: Integer);
var table: TRVTableItemInfo;
    i: Integer;
begin
  table := TRVTableItemInfo.CreateEx(Answers.Count+1, 1, RichView1.RVData);
  table.BestWidth := -80;
  table.ParaNo := 1;
  table.Color := TABLECOLOR;
  table.Cells[0,0].Clear;
  table.Cells[0,0].AddNL(Question,1,0);
  table.Cells[0,0].Color := HEADCOLOR;
  for i := 0 to Answers.Count-1 do begin
    table.Cells[i+1,0].Clear;
    table.Cells[i+1,0].AddNL(Answers[i],0,0);
  end;
  table.BorderVSpacing := 5;
  table.BorderHSpacing := 10;
  table.CellPadding := 4;
  table.BorderWidth := 2;
  table.CellBorderWidth := 0;
  table.BorderStyle := rvtbColor;
  table.CellBorderStyle := rvtbColor;
  RichView1.AddItem(IntToStr(CorrectAnswer), table);
end;
{------------------------------------------------------------------------------}
// If RVData is a table cell, this function highlights this cell.
// Removes highlighting from the previously highlighted cell (stored in HighlightedRVData)
// Updates HighlightedRVData
// Highlighted cell has color = HLTCOLOR, others - clNone.
procedure TForm1.HighlightCell(RVData: TCustomRVFormattedData);
var r,c: Integer;
begin
  if HighlightedRVData=RVData then
    exit;
  if HighlightedRVData<>nil then begin
    TRVTableCellData(HighlightedRVData).Color := clNone;
    HighlightedRVData.Invalidate;
    HighlightedRVData := nil;
  end;
  if not (RVData is TRVTableCellData) or (TRVTableCellData(RVData).Color=SELCOLOR) then
    exit;
  TRVTableCellData(RVData).GetTable.GetCellPosition(TRVTableCellData(RVData),r,c);
  if r=0 then
    exit;
  TRVTableCellData(RVData).Color := HLTCOLOR;
  RVData.Invalidate;
  HighlightedRVData := RVData;
end;
{------------------------------------------------------------------------------}
// If RVData is a table cell, this function selects this cell.
// Selected cell has color = SELCOLOR.
// Updates number of answered questions (AnsweredCount).
// If all questions are answered, changes highlight of hypertext jump from
// red to green.
procedure TForm1.SelectCell(RVData: TCustomRVFormattedData);
var r,c: Integer;
    table: TRVTableItemInfo;
begin
  if not (RVData is TRVTableCellData) then
    exit;
  table := TRVTableCellData(RVData).GetTable;
  table.GetCellPosition(TRVTableCellData(RVData),r,c);
  if r=0 then
    exit;
  for r := 1 to table.Rows.Count-1 do begin
    if table.Cells[r,0].Color=SELCOLOR then
      dec(AnsweredCount);
    table.Cells[r,0].Color := clNone;
  end;
  TRVTableCellData(RVData).Color := SELCOLOR;
  inc(AnsweredCount);
  TRVTableCellData(RVData).Invalidate;
  if HighlightedRVData=RVData then
    HighlightedRVData := nil;
  if AnsweredCount=High(Questions)+1 then
    RVStyle1.TextStyles[2].HoverBackColor := PASSCOLOR;
end;
{------------------------------------------------------------------------------}
// OnMouseMove event - highlighting cell
procedure TForm1.RichView1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var RVData: TCustomRVFormattedData;
    a,b: Integer;
begin
  if Ready then
    exit;
  inc(X, RichView1.HScrollPos);
  inc(Y, RichView1.VScrollPos*RichView1.VSmallStep);
  RichView1.GetItemAt(X, Y, RVData, a, b, False);
  HighlightCell(RVData);
end;
{------------------------------------------------------------------------------}
// OnRVMouseUP event - selecting cell
procedure TForm1.RichView1RVMouseUp(Sender: TCustomRichView;
  Button: TMouseButton; Shift: TShiftState; ItemNo, X, Y: Integer);
var RVData: TCustomRVFormattedData;
    a,b: Integer;
begin
  if Ready then
    exit;
  inc(X, RichView1.HScrollPos);
  inc(Y, RichView1.VScrollPos*RichView1.VSmallStep);
  RichView1.GetItemAt(X, Y, RVData, a, b, False);
  SelectCell(RVData);
end;
{------------------------------------------------------------------------------}
// On hyperlink click.
procedure TForm1.RichView1Jump(Sender: TObject; id: Integer);
var i,r: Integer;
    table: TRVTableItemInfo;
    Score: Integer;
begin
  if not Ready then begin // clicking on "Ready!"
    if AnsweredCount<High(Questions)+1 then begin
      Beep;
      exit;
    end;
    Ready := True;
    HighlightCell(RichView1.RVData);
    Score := 0;
    for i := 0 to RichView1.ItemCount-1 do
      if RichView1.GetItemStyle(i)=rvsTable then begin
        table := RichView1.GetItem(i) as TRVTableItemInfo;
         for r := 1 to table.Rows.Count-1 do
           if table.Cells[r,0].Color=SELCOLOR then begin
             if IntToStr(r-1)=RichView1.GetItemText(i) then begin
               table.Cells[0,0].AddNL(' (passed)', 1,-1);
               table.Cells[r,0].Color := PASSCOLOR;
               inc(Score);
               end
             else begin
               table.Cells[0,0].AddNL(' (failed)', 1,-1);
               table.Cells[r,0].Color := FAILCOLOR;
             end;
           break;
         end;
      end;
    RichView1.SetItemText(RichView1.ItemCount-1, 'Try again');
    Caption := Format('PlanetQuiz : %d of %d', [Score, High(Questions)+1]);
    RichView1.Format;
    RichView1.Update;
    if Score<>High(Questions)+1 then
      SndPlaySound('CHORD.WAV', SND_SYNC or SND_NODEFAULT)
    else
      SndPlaySound('TADA.WAV', SND_SYNC or SND_NODEFAULT);
    end
  else begin // clicking on "Try Again"
    BuildQuiz;
    RichView1.ScrollTo(0);
    Caption := 'PlanetQuiz';
  end;
end;


end.