winform2.pas

一个开源软件

unit WinForm2;

{ delphi.win32 by [e-mail]  :2005  loc:299
  enhanced with multilang text game integration :2007  locs: 325
  just uncomment the line 272 to fix the language
  wanna play with numbers, just switch line 134 or 135}

interface


uses
  Windows, SysUtils, Classes, Graphics, Controls, Forms, 
  StdCtrls, MultilangTranslator, Menus;

type
 	TMyLabel = class(TLabel)
    procedure Label1Click(Sender: TObject);
  private
  	lblx,lbly,okx,oky: integer;
		place: Boolean;
	end;

  TwinForm = class(TForm)
    PopupMenu1: TPopupMenu;
    testpop1: TMenuItem;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    maxx,
    maxy,
    maxtot: Byte;
   	psize,
		freex,
    freey: integer;
    ttest, patternmode: shortstring;
    ini_language: integer;
    lbllabels: TList;
    procedure moveCube(o: TMyLabel);
    procedure verify;
    procedure Melt2Test;
    procedure Melt;
    procedure SpeakV(const sText: string; bWithVoice: Boolean = True);
    procedure TVCLForm_Load;
  protected
    objMultilang: TMultiLangSC;
    pattern: string;
    procedure Init;
    procedure defFileRead;
  end;


  var winForm: TwinForm;

implementation

// to hear the voice of speechAPI
uses comObj;

resourcestring
  StrReslang2dll = 'reslang2.dll';
  StrPatternWordMust = 'Pattern word must have the size of the puzzle: ';

{$R *.dfm}

procedure TwinForm.FormCreate(Sender: TObject);
begin
  TVCLForm_Load;
  objMultilang:= TMultiLangSC.Create(self);
  objMultilang.ResDLL:= StrReslang2dll;
  //objMultilang.ResDLL:= '';
  objMultilang.LanguageOffset:=  ini_language;
  //look at language in puzzledef.ini;
end;

procedure TwinForm.FormDestroy(Sender: TObject);
begin
  objMultilang.Free;
end;

procedure TWinForm.TVCLForm_Load;
begin
  Self.Text := 'PuzzleMax';
  //range of puzzle stones, ex. 4*5
  maxx:= 3;
  maxy:= 3;
  psize:= 64;
  defFileRead;
  maxtot:= maxx * maxy;
  maxtot:= maxtot -1;
  Init();
end;

procedure TWinForm.Init;
var
  i,x,y: integer;
  lbllabel1: TMyLabel;
begin
  lbllabels:= TList.Create;
  Self.width:= (maxx*psize)+ 12;
  self.Height:= (maxy*psize)+ 34;
	x:= 1;
  y:= 1;
  for i:=1 to maxtot do begin
    lbllabel1:= TMyLabel.Create(self);
    with lbllabel1 do begin
      Parent:= winForm;
      Color:= clcream;
      AutoSize:= false;
      layout:= tlcenter;
      alignment:= tacenter;
      font.Size:= maxx * maxy;
      font.Style:= [fsbold];
      font.Color:= clpurple;
      Width:= psize;
      Height:= psize;
      lblx:= x;
      okx:= x;
      lbly:= y;
      oky:= y;
    end;
    if (i mod maxx=0) then begin
      x:=1;
      inc(y);
    end else
      inc(x);
    if uppercase(patternmode) = uppercase('YES') then begin
      if length(pattern) = maxtot then
        lbllabel1.caption:= pattern[i] else begin
          messageBox(0,pchar(StrPatternWordMust + inttoStr(maxtot)),'MT',MB_OK);
          exit;
        end
    end else
      //just to test dynamics in translation
      lbllabel1.tag:= i + 9;
    //lbllabel1.caption:= IntToStr(i);
    lbllabel1.OnClick:= lbllabel1.Label1Click;
    lbllabels.Add(lbllabel1);
  end;
  //melt2test is to test verify
  if uppercase(ttest) = uppercase('YES') then
    Melt2Test else
    Melt;
end;


procedure TWinForm.moveCube(o: TMyLabel);
begin
  if (o.lblx + 1 = freex) and (o.lbly = freey) then begin
    //right
    o.lblx:= o.lblx +1;
    o.Left:= o.Left + psize +1;
    o.Top:= o.Top;
    freex:= freex -1;
  end else
  if (o.lblx - 1 = freex) and (o.lbly = freey) then begin
      //left
      o.lblx:= o.lblx -1;
      o.Left:= o.Left - psize -1;
      o.Top:= o.Top;
      freex:= freex +1;
  end else
  if (o.lblx = freex) and (o.lbly - 1 = freey) then begin
      //top means up
      o.lbly:= o.lbly -1;
      o.Left:= o.Left;
      o.Top:= o.Top - psize -1;
      freey:= freey + 1;
  end else
  if (o.lblx = freex) and (o.lbly + 1 = freey) then begin
      //bottom means down
      o.lbly:= o.lbly +1;
      o.Left:= o.Left;
      o.Top:= o.Top + psize +1;
      freey:= freey - 1;
   end;
 end;


procedure TWinForm.Melt;
var
  i,nbplace,x,y: integer;
begin
  nbplace:= 0;
  x:= 1;
  y:= 1;
  for i:= 1 to maxtot do begin
    TMyLabel(lbllabels[i-1]).place:= false;
    TMyLabel(lbllabels[i-1]).Visible:= false;
  end;
  RANDOMIZE;
  while (nbplace < maxtot) do begin
    i:= random(maxtot);
    if not(TMyLabel(lbllabels[i]).place) then begin
      inc(nbplace);
      with TMyLabel(lbllabels[i]) do begin
        place:= true;
        Visible:= true;
        lblx:= x;
        lbly:= y;
        Left:= (x-1)*(psize + 1);
        Top:= (y-1)*(psize + 1);
      end;
      inc(x);
      if (x mod maxx=1) then begin
        x:= 1;
        inc(y);
      end;
    end;
  end;
  freex:= maxx;
  freey:= maxy;
end;

procedure TWinForm.Melt2Test;
var
  i,nbplace,x,y:integer;
begin
  nbplace:=0;
  x:=1;
  y:=1;
  for i:= 1 to maxtot do begin
    TMyLabel(lbllabels[i-1]).place:= false;
    TMyLabel(lbllabels[i-1]).Visible:= false;
  end;
  i:= 0;
  while (nbplace < maxtot) do begin
    if not(TMyLabel(lbllabels[i]).place) then begin
      inc(nbplace);
      with TMyLabel(lbllabels[i]) do begin
        place:= true;
        Visible:= true;
        Left:= (x-1)*(psize + 1);
        Top:= (y-1)*(psize + 1);
      end;
      inc(x);
      inc(i);
      if (x mod maxx=1) then begin
        x:=1;
        inc(y);
      end;
    end;
  end;
  freex:= maxx;
  freey:= maxy;
end;


procedure TWinForm.Verify;
var
  i,nbok: integer;
  o: TMyLabel;
begin
  nbok:= 0;
  for i:= 1 to maxtot do begin
    o:= TMyLabel(lbllabels[i-1]);
    if ((o.lblx=o.okx) and (o.lbly=o.oky)) then
      inc(nbok);
  end;
  if (nbok=maxtot) then
    //showmessage('Congralutations'#13#10'You win with Max Delphi.Win32 !');
    SpeakV(objMultilang.GetResourceString(5));
end;

{ TMyLabel }
procedure TMyLabel.Label1Click(Sender: TObject);
begin
  if (Sender is TMyLabel) then begin
    winForm.moveCube(TMyLabel(Sender));
    winForm.verify;
  end;
  //dynamic test of multilang
  winForm.objMultilang.LanguageOffset:=(random(3) * 1000);
end;

// ex. of read some text with a voice
procedure TwinForm.SpeakV(const sText: String; bWithVoice: Boolean);
const
  SVSFDefault = $00000001;
  SVSFlagsAsync = $00000001;
var
  oVoice: OLEVariant;
begin
   if bWithVoice then begin
     oVoice:= CreateOLEObject('SAPI.SpVoice');
     oVoice.Speak(sText, SVSFlagsAsync);
   end;
   messagebox(0, pchar(sText), 'the maxland translator', MB_OK);
   //disadvantage is Showmessage(sText);
   //oVoice:= NIL; oVoice:= Unassigned;
end;

procedure TwinForm.defFileRead;
var deflist: TStringlist;
    filepath, fN: string;
begin
deflist:= TStringlist.create;
filepath:= ExtractFilePath(Application.ExeName);
  try
    fN:= filepath+ 'puzzledef.ini';
    if fileexists(fN) then begin
      deflist.LoadFromFile(fN);
      maxx:= strtoInt(deflist.Values['SIZE_X']);
      maxy:= strtoInt(deflist.values['SIZE_Y']);
      psize:= strToInt(deflist.values['PSIZE']);
      ttest:= deflist.values['TEST'];
      patternmode:= deflist.values['PATTERNMODE'];
      pattern:= deflist.values['PATTERN'];
      ini_language:= strtoInt(deflist.values['LANGUAGE']);
    end else begin
      deflist.add('//Definitions for multilang puzzle game');
      deflist.values['SIZE_X']:= '3';
      deflist.values['SIZE_Y']:= '3';
      deflist.values['PSIZE']:= '64';
      deflist.values['TEST']:= 'YES';
      deflist.values['PATTERNMODE']:= 'NO';
      deflist.values['PATTERN']:= 'MAXLANDS';
      deflist.values['LANGUAGE']:= '1000';
      deflist.SaveToFile(fN);
    end;
  finally
    deflist.Free
 end;
end;

end.