unit UPoll;
{ ********************************************************************************* }
{ (c) GNU                                                                           }
{ author: Heiko Tietze                                                              }
{ version: 1.0                                                                      }
{ date: 11.12.2004                                                                  }
{ description: in network mode all players have to ask for unknown words, a new     }
{              game and so on; the player who ask have to wait for answers (and     }
{              a form is shown) with WaitForAnswers(); the others are informed      }
{              by an icon in the statusbar which is updated by AnswerToBitmap()     }
{ ********************************************************************************* }

{$I Def.inc}

interface

uses Messages, Classes, SysUtils, Inifiles,
     {$IFDEF VCL}
     Windows, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, ImgList,
     {$ELSE}
     QGraphics, QControls, QForms, QDialogs, QExtCtrls, QStdCtrls, QImgList,
     {$ENDIF}
     UNetwork, UTools;

type TPoll = class(TForm)
         btnOK       : TButton;
         lbPlayer1   : TLabel;
         lbPlayer2   : TLabel;
         lbPlayer3   : TLabel;
         lbPlayer4   : TLabel;
         cbAutoClose : TCheckBox;
         ImageList: TImageList;
         bvSmall: TBevel;
         procedure btnOKClick(Sender: TObject);
         procedure FormPaint(Sender: TObject);
       private
         FPlayerCount : Byte;
         FAnswers     : array of TModalResult;
         procedure SetPlayerCount(const Value: Byte);
         function GetState:TModalResult;
         procedure SetAnswer(index: Byte; const Value: boolean);
       public
         procedure Clear;
         procedure AnswerToBitmap(var bmp:TBitmap);
         function WaitForAnswers(Value:string): Integer; reintroduce;
         property PlayerCount : Byte read FPlayerCount write SetPlayerCount;
         property Answer[index : Byte] : boolean write SetAnswer;
       end;

var Poll : TPoll;

implementation

{$IFDEF VCL}
  {$R *.dfm}
{$ELSE}
  {$R *.xfm}
{$ENDIF}

{ TPoll }

procedure TPoll.AnswerToBitmap(var bmp: TBitmap);
const ArcPos:array[2..4,0..3,0..3] of Byte=(((2,4,2,0),(2,0,2,4),(0,0,0,0),(0,0,0,0)),
                                            ((4,3,2,0),(2,0,0,3),(0,3,4,3),(0,0,0,0)),
                                            ((4,0,0,0),(0,4,4,4),(4,4,4,0),(0,0,0,4)));
var i:integer;
begin
  with bmp do
  begin
    Canvas.Brush.Color:=clBtnFace;
    Canvas.Brush.Style:=bsSolid;
    Canvas.FillRect(Bounds(0,0,bmp.Width,bmp.Height));
    if FPlayerCount>1 then Canvas.Pen.Color:=clBlack
                      else Canvas.Pen.Color:=clGray;
    Canvas.Ellipse(0,0,bmp.Width,bmp.Width);
    if FPlayerCount<=1 then
    begin
       Canvas.MoveTo(bmp.Width div 2,0);
       Canvas.LineTo(bmp.Width div 2,bmp.Height);
       Canvas.MoveTo(0,bmp.Height div 2);
       Canvas.LineTo(bmp.Width, bmp.Height div 2);
    end else
    for i:=0 to FPlayerCount-1 do
    begin
      case FAnswers[i] of
       mrRetry : Canvas.Brush.Color:=clBtnFace;
       mrYes   : Canvas.Brush.Color:=clGreen;
       mrNo    : Canvas.Brush.Color:=clRed;
      end;
      {$IFDEF VCL}
      Canvas.Pie(0, 0, bmp.Width, bmp.Width, ArcPos[FPlayerCount, i, 0]*(Width div 4),
                                             ArcPos[FPlayerCount, i, 1]*(Width div 4),
                                             ArcPos[FPlayerCount, i, 2]*(Width div 4),
                                             ArcPos[FPlayerCount, i, 3]*(Width div 4));
      {$ELSE}
      Canvas.Pie(0, 0, bmp.Width, bmp.Height,i*(16*(360 div FPlayerCount)),16*(360 div FPlayerCount));
      {$ENDIF}
    end; //FPlayerCound
  end;
end;

procedure TPoll.Clear;
var i:integer;
begin
   for i:=0 to FPlayerCount-1 do FAnswers[i]:=mrRetry;
end;

procedure TPoll.SetPlayerCount(const Value: Byte);
begin
  if Value<>FPlayerCount then
  begin
    FPlayerCount:=Value;
    setlength(FAnswers,FPlayerCount);
    Clear;
  end;
end;

function TPoll.WaitForAnswers(Value: string): Integer;
begin
   with TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini')) do
   try
      cbAutoClose.Checked:=ReadBool('Poll','AutoClose',false);
   finally
      Free;
   end;
   Show;
   Clear;
   if FPlayerCount<4 then lbPlayer4.Enabled:=false;
   if FPlayerCount<3 then lbPlayer3.Enabled:=false;
   if FPlayerCount<2 then lbPlayer2.Enabled:=false;
   btnOK.Enabled:=false;
   Network.OnSendMessage(nmAnswer, Network.LocalPlayer,255, BoolToStr(true,true));
   Network.OnSendMessage(nmAsk, Network.LocalPlayer, 255, Value);
   repeat Application.ProcessMessages until not Visible;
   Result:=GetState;
end;

function TPoll.GetState: TModalResult;
var i:integer;
begin
   Result:=mrYes;
   for i:=0 to FPlayerCount-1 do
     case FAnswers[i] of
      mrRetry : Result:=mrRetry;
      mrNo    : if Result=mrYes then Result:=mrNo;
     end;
end;

procedure TPoll.SetAnswer(index: Byte; const Value: boolean);
begin
  if (index<FPlayerCount) then
    case Value of
     true  : FAnswers[index]:=mrYes;
     false : FAnswers[index]:=mrNo;
    end;
  btnOK.Enabled:=(GetState<>mrRetry);
  if btnOK.Enabled and cbAutoClose.Checked then btnOKClick(self);
  Repaint;
end;

procedure TPoll.btnOKClick(Sender: TObject);
begin
   with TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini')) do
   try
      WriteBool('Poll','AutoClose',cbAutoClose.Checked);
   finally
      Free;
   end;
   Close;
end;

procedure TPoll.FormPaint(Sender: TObject);
var i:integer;
begin
   for i:=0 to FPLayerCount-1 do
     case FAnswers[i] of
       mrNo    : ImageList.Draw(Canvas,100,3+i*18,0);
       mrYes   : ImageList.Draw(Canvas,100,3+i*18,1);
       mrRetry : ImageList.Draw(Canvas,100,3+i*18,2);
     end;
end;

end.