{

    Copyright 2004 Marianne Wartoft, marianne at wartoft dot nu
    http://www.wartoft.nu, http://www.aw.nu

    This file is part of Sebran.

    Sebran is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    Sebran is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with Sebran; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

}


unit Generell;
{ This module contains general purpose functions and 'global' variables
  and constants}

interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, Fileread, MPlayer, ShellAPI;

type
Posi = record
     X,Y: Longint
end;

type
TPic = record
     Singular: WideString;
     Plural: WideString;
     Color: Longint;
     Ready: Boolean;
     ASCII: Integer;
end;

HangString = record
     Word: WideString;
     Used: Boolean;
end;

Const NrOfPics = 119;
      HURMANGA = 1;
      ADDITION = 2;
      SUBTRAKTION = 3;
      MULTIPLIKATION = 4;
      FORSTABOKST = 5;
      RATTBILD = 6;
      MEMORYY = 7;
      ORDMEMORY = 8;
      BOKSTAVSREGN = 9;
      MATTEREGN = 10;
      ALFABETSREGN = 11;
      AntalSprak = 32;
      MaxAntalLangStrangar = 33;
      MaxAntalHangmanStrangar = 200;
      SADFACE = 255;
      HAPPYFACE = 254;
      THINBORDER = 1;
      THICKBORDER = 2;
      NOBORDER = 3;

Var
  Sprak: Integer;
  fPlaySongs: Boolean;
  fPlaySounds: Boolean;
  intRainSpeed: Integer;
  intCapital: Integer;
  Spraknamn: Array[1..AntalSprak ] of  String[50];
  Pics: Array[1..NrOfPics ] of TPic;
  RefFontSize, ButtonFontSize: Integer;
  strLang: array[1..MaxAntalLangStrangar] of String[80];
  strHangman: array[1..MaxAntalHangmanStrangar] of HangString;
  NrOfstrHangman : Integer;
  fRepeatSong: Boolean;
  intBitsPerPixel: Integer;
  TYPEFACE: String[50];
  SYMBOLTYPEFACE: String[50];
const
  IsPreRegistered = true;

var
   Bitmap: TBitmap;

Procedure FixForm(Frm: TForm);
Procedure DrawChar(X,Y: Longint; Im: TImage; Text: String; Col: Longint; Font: String; FSize: Integer);
Procedure DrawCharCenter(X,Y: Longint; Im: TImage; Text: String; Col: Longint; Font: String; FSize: Integer);
Procedure DrawButton(Im: TImage; Text: String; Col: Longint; Font: String; FSize: Integer; PCent: Integer; BStyle: Integer);
Function FontSize(Pixels: Integer; Font: String; Canv: TCanvas): integer;
Procedure SetPalette(Im: TImage);
Procedure ReadPicFile;
Procedure GetAlts(var Arr: Array of Integer; NrOfOptions, CorrValue, Min, Max: Integer);
Function AppPath: String;
Procedure ShowLang(Form: TForm);
Procedure GetLang;
Procedure GetHangman;
Procedure PlaySong(FileName: String; Pos: Integer; Rep: Boolean);
Procedure PlaySound(FileName: String; PlayerNr: Integer);
Procedure StopSong;
Procedure ShowHelp(Handle: HWND);
Function SongPosition: Integer;
Function CorrCase(Str: String):String;


implementation
uses
    Message, Hmeny;

Procedure FixForm(Frm: TForm);
{ This procedure strectches all components on the form to
 fit the current screen resoplution}
var
   i: Integer;
COnst
   STDWIDTH = 640;
   STDHEIGHT = 480;
begin
   With Frm do begin
     Height := screen.height;
     Width := screen.width;
     color := clBlack;
     Top := 0;
     Left := 0;
     For i := 0 to ComponentCount-1 do begin
         if Components[i] is TImage then begin
            TImage(Components[i]).Top := Round(TImage(Components[i]).Top * (ClientHeight / STDHEIGHT));
            TImage(Components[i]).Left := Round(TImage(Components[i]).Left * (ClientWidth / STDWIDTH));
            TImage(Components[i]).Height := Round(TImage(Components[i]).Height * (ClientHeight / STDHEIGHT));
            TImage(Components[i]).Width := Round(TImage(Components[i]).Width * (ClientWidth / STDWIDTH));
         end;
         if Components[i] is TShape then begin
            TShape(Components[i]).Top := Round(TShape(Components[i]).Top * (ClientHeight / STDHEIGHT));
            TShape(Components[i]).Left := Round(TShape(Components[i]).Left * (ClientWidth / STDWIDTH));
            TShape(Components[i]).Height := Round(TShape(Components[i]).Height * (ClientHeight / STDHEIGHT));
            TShape(Components[i]).Width := Round(TShape(Components[i]).Width * (ClientWidth / STDWIDTH));
            TShape(Components[i]).Pen.Width := Round(TShape(Components[i]).Pen.Width * (ClientWidth / STDWIDTH));
         end;
         if Components[i] is TLabel then begin
            TLabel(Components[i]).Top := Round(TLabel(Components[i]).Top * (ClientHeight / STDHEIGHT));
            TLabel(Components[i]).Left := Round(TLabel(Components[i]).Left * (ClientWidth / STDWIDTH));
            TLabel(Components[i]).Height := Round(TLabel(Components[i]).Height * (ClientHeight / STDHEIGHT));
            TLabel(Components[i]).Width := Round(TLabel(Components[i]).Width * (ClientWidth / STDWIDTH));
            TLabel(Components[i]).Font.Size := Round(TLabel(Components[i]).Font.Size * (ClientWidth / STDWIDTH));
            {if  (TLabel(Components[i]).Font.Name = TYPEFACE) and (TLabel(Components[i]).Font.Size < 18) then
                TLabel(Components[i]).Font.Name := 'Arial';  }
         end;
         if Components[i] is TPanel then begin
            TPanel(Components[i]).Top := Round(TPanel(Components[i]).Top * (ClientHeight / STDHEIGHT));
            TPanel(Components[i]).Left := Round(TPanel(Components[i]).Left * (ClientWidth / STDWIDTH));
            TPanel(Components[i]).Height := Round(TPanel(Components[i]).Height * (ClientHeight / STDHEIGHT));
            TPanel(Components[i]).Width := Round(TPanel(Components[i]).Width * (ClientWidth / STDWIDTH));
         end;
     end;
   end;
   ShowLang(Frm);
end;

Procedure DrawCharCenter(X,Y: Longint; Im: TImage; Text: String; Col: Longint; Font: String; FSize: Integer);
{ Draws a character or text centered on a specified location}
var
   NX, NY: Integer;
begin
       {If (Font = TYPEFACE) and (FSize < 15) then Font := 'Arial';     }
       Im.Canvas.Font.Size := FSize;
       Im.Canvas.Font.Name := Font;
       Im.Canvas.Font.Style := [];
       NY := Y - Trunc(Im.Canvas.TextHeight(Text)) div 2;
       NX := X -(Im.Canvas.TextWidth(Text)) div 2;
       DrawChar(NX, NY, Im, Text, Col, Font, FSize);

end;
Procedure DrawChar(X,Y: Longint;  Im: TImage; Text: String; Col: Longint; Font: String; FSize: Integer);
var
   logFont: TLogFont;
   wtext: Widestring;

begin
  { Draw the character }

  GetObject(Im.Canvas.Font.Handle, SizeOf(LogFont), Addr(LogFont));
  logFont.lfQuality:=ANTIALIASED_QUALITY;
  Im.Canvas.Font.Handle:=CreateFontIndirect(logFont);

  Im.Canvas.Font.Size := FSize;
  Im.Canvas.Font.Name := Font;
  Im.Canvas.Font.Style := [];
  Im.Canvas.Brush.Style := bsClear;
  Im.Canvas.Font.Color := (02 shl 24) or Col;
  Im.Canvas.TextOut(X,Y, text);

end;

Procedure DrawButton(Im: TImage; Text: String; Col: Longint; Font: String; FSize: Integer; PCent: Integer; BStyle: Integer);
{ Fills the image with a rounded rectangle border, and a centered text}
var
   X, Y: Integer;
begin
  {Draw a rounded rectangle }
  {If (Font = TYPEFACE) and (FSize < 15) then Font := 'Arial';   }
  With Im do begin
       Canvas.Brush.Color := (02 shl 24) or clBlack;
       Canvas.Brush.Style := bsSolid;
       Canvas.Pen.Width := 2 * (Screen.Height div 480);
       Canvas.FillRect(Rect(0, 0, Width, Height)) ;

       Canvas.Brush.Style := bsClear;
       Case BStyle of
          THICKBORDER: begin
              Canvas.Pen.Width := 2 * (Screen.Height div 480) + 1;
              Canvas.Pen.Color := (02 shl 24) or clGray;
              Canvas.RoundRect( 2, 2, Width - 3, Height - 3,
                      Trunc(Width * (PCent / 100)) , Trunc(Width * (PCent / 100)) ) ;
              Canvas.Pen.Width := 2 * (Screen.Height div 480);
              Canvas.Pen.Color := (02 shl 24) or clWhite;
              Canvas.RoundRect( 2, 2, Width - 3, Height - 3,
                  Trunc(Width * (PCent / 100)) , Trunc(Width * (PCent / 100)) ) ;
          end;
          THINBORDER: begin
              Canvas.Pen.Width := 1;
              Canvas.Pen.Color := clGray;
              Canvas.RoundRect( 2, 2, Width - 3, Height - 3,
                  Trunc(Width * (PCent / 100)) , Trunc(Width * (PCent / 100)) ) ;
          end;
       end;
       { Draw the text }
       Canvas.Font.Name := Font;
       Canvas.Font.Size := FSize;
       Im.Canvas.Font.Style := [];
       {If Font = TYPEFACE then
          Y := Trunc((Height - Canvas.TextHeight('x') * 1.2)) div 2
       else   }
          Y := Trunc((Height - Canvas.TextHeight(Text) )) div 2;
       X := (Width - Canvas.TextWidth(Text)) div 2;
       DrawChar(X, Y, Im, Text, Col, Font, FSize);
  end;
end;


Function FontSize(Pixels: Integer; Font: String; Canv: TCanvas): integer;
{ Returns the maximum font size to be used if the text must not be
  higher than the specified number of pixels }
begin
  Canv.Font.Name := Font;
  Canv.Font.Size := 1;
  While Canv.TextHeight(chr(Pics[1].Ascii)) < Pixels do begin
        Canv.Font.Size := Canv.Font.Size + 1;
  end;
  FontSize := Canv.Font.Size;
end;

Procedure SetPalette(Im: TImage);

begin
     Application.ProcessMessages;

     if intBitsPerPixel < 16 then begin
          Im.Canvas.Draw( 0, 0, Bitmap );
          Im.Picture.Bitmap := Bitmap;
          Im.Picture.Bitmap.Width := Im.Width;
          Im.Picture.Bitmap.Height := Im.Height;
     end;    

     Im.Canvas.Brush.Color := clBlack;
     Im.Canvas.Brush.Style := bsSolid;
     Im.Canvas.FillRect( Rect( 0 ,0, Im.Width, Im.Height ) );

end;

Procedure ReadPicFile;
{Reads in the file with words and colors for each of the pictures}
var
    r,g,b: Longint;
    BIO: TByteFile;
    ID: Integer;
    i: Integer;
    strDummy: String;
    strTempSingular: Array[1..AntalSprak] of string;
    strTempPlural: Array[1..AntalSprak] of string;

begin
     screen.Cursor := crHourglass;
     for i:=1 to NrOfPics do begin
         Pics[i].Singular := 'foo';
         Pics[i].Plural := 'foobar';
         Pics[i].Color := clSilver;
     end;

     BIO := TByteFile.Create(Concat(AppPath, '\bilder.crp'));
     While not BIO.eof do begin
           ID := BIO.ReadSmallInt;
           Pics[ID].ASCII := BIO.ReadSmallInt;
           For i:=1 to AntalSprak do begin
               BIO.ReadString(strTempSingular[i]);
               BIO.ReadString(strTempPlural[i]);
           end;
           Pics[ID].Singular := strTempSingular[Sprak];
           Pics[ID].Plural := strTempPlural[Sprak];

           R := BIO.ReadSmallInt;
           G := BIO.ReadSmallInt;
           B := BIO.ReadSmallInt;
           Pics[ID].Color := (b shl 16) or (g shl 8) or r;
     end;
     BIO.Destroy;
     screen.Cursor := crDefault;
end;

Procedure GetAlts(var Arr: Array of Integer; NrOfOptions, CorrValue, Min, Max: Integer);
{ Fills in the array Arr with alternatives between Min and Max, but
not CorrValue.}
var
   i,j: Integer;
   Krock: Boolean;
begin
     Randomize;
     For i:=0 to NrOfOptions-1 do begin
         repeat
           Arr[i] := Trunc(Random * (Max - Min)) + Min;
           Krock := False;
           if i > 0 then for j:=0 to i-1 do begin
              if Arr[i]=Arr[j] then Krock := True
           end;
           if Arr[i]=CorrValue then Krock := True;
         until not krock;
     end;

end;


function AppPath : string;
{Returns the path where the .EXE file is located}
var
   strExeName: string;
   intPos: Integer;
   i: Integer;

begin
     strExeName:=Application.ExeName;
     {Find the last backslash}
     intPos := 1;
     For i:=1 to length(strExeName) do begin
         If strExeName[Length(strExeName)-i] = '\' then begin
            intPos := Length(strExeName) - i;
            Break;
         end;
     end;
     AppPath := Copy(strExeName, 1, intPos - 1);

end;

Procedure GetLang;
{Reads instructions in different languages from a file}
var
   BIO: TByteFile;
   ID: Integer;
   i: Integer;
   strTemp: array[1..AntalSprak] of string;
begin
     screen.Cursor := crHourglass;
     BIO := TByteFile.Create(Concat(AppPath, '\lang.crp'));
     While not BIO.eof do begin
           ID := BIO.ReadSmallInt;
           For i := 1 to AntalSprak do begin
               BIO.ReadString(strTemp[i]);
           end;
           strLang[ID] := strTemp[sprak];

     end;
     BIO.Destroy;
     screen.Cursor := crDefault;

end;

Procedure ShowLang(Form: TForm);
{Byter ut texter på ett formulär till text på rätt språk}
var
   i: Integer;

begin
    if (Sprak=16) or (Sprak=19) or (Sprak=20) or (Sprak=21) or (Sprak=24) or (Sprak=26) or (Sprak=27) or (Sprak=28)  then begin   {use Arial for Polish, Icelandic, Greek, Turkish, Czech, Slovak}
         TYPEFACE := 'Arial';
         SYMBOLTYPEFACE := 'Sebran Symbols';
    end else begin
         TYPEFACE := 'Sebran3';
         SYMBOLTYPEFACE := 'Sebran Symbols';
    end;
    GetLang;
    {Exchange texts on controls.}
     For i := 0 to Form.ComponentCount - 1 do begin
         If Form.Components[i].Tag <> 0 then begin
            if Form.Components[i] is TButton then begin
               TButton(Form.Components[i]).Caption := strLang[Form.Components[i].Tag];
            end;
            if Form.Components[i] is TLabel then begin
               TLabel(Form.Components[i]).Caption := strLang[Form.Components[i].Tag];
               if (Form.Components[i].Tag <> 7) and (Form.Components[i].Tag <> 15) then
               TLabel(Form.Components[i]).Font.Name := TYPEFACE;
            end;
         end;
     end;
     {Change the form caption.}
     If Form.Tag <> 0 then begin
        Form.Caption := strLang[Form.Tag];
     end;
end;

Procedure GetHangman;
{Read Hangman-proverbs from a file.}
var
   BIO: TByteFile;
   ID: Integer;
   i: Integer;
   strDummy: string;

   txt : TextFile;
   buf : String;

begin
     if FileExists(Concat(AppPath, '\hangman.txt')) then begin
          i:=0;
          AssignFile(txt, Concat(AppPath, '\hangman.txt'));
          Reset(txt);
          while NOT EOF(txt) and ((i+1) <= MaxAntalHangmanStrangar) do begin
                ReadLn(txt, buf);
                if buf<>'' then begin
                   i:=i + 1;
                   strHangman[i].Word := buf;
                end;
          end;
          NrOfstrHangman := i;
          CloseFile(txt);



     end else begin
         i := 0;
         BIO := TByteFile.Create(Concat(AppPath, '\hangman.crp'));
         While not BIO.eof do begin
               ID := BIO.ReadSmallInt;
               If ID = Sprak then begin
                  i := i + 1;
                  BIO.ReadString(strDummy);
                  strHangman[i].Word := strDummy;
               end else
                  BIO.ReadString(strDummy);
               end;
               BIO.Destroy;
               NrOfstrHangman := i;
     end;

end;

Procedure PlaySong(FileName: String; Pos: Integer; Rep: Boolean);
{Plays a song, starting at the given position. If Rep is true,
the music will be repeated indefinitely}
begin
     screen.cursor := crHourglass   ;
     try
     if fPlaySongs then begin
        fRepeatSong := Rep;
        frmHuvudmeny.mplMIDI.FileName := Concat(AppPath, '\', FileName);
        frmHuvudmeny.mplMIDI.Notify := False;
        frmHuvudmeny.mplMIDI.Open;
        frmHuvudmeny.mplMIDI.Position := Pos;
        if Rep then frmHuvudmeny.mplMIDI.Notify := True;
        frmHuvudmeny.mplMIDI.Play;
     end;
     except
     end;
     screen.cursor := crDefault;
end;

Procedure PlaySound(FileName: String; PlayerNr: Integer);
{Plays a sound effect}
var
   mpl: TMediaPlayer;
begin
     try
          mpl := frmHuvudmeny.mplWAV1;
          if fPlaySounds then begin
          if mpl.FileName <> Concat(AppPath, '\', FileName) then begin
             mpl.FileName := Concat(AppPath, '\', FileName);
             mpl.Open;
             end;
             mpl.Play;
          end;
     except
     end;
end;

Procedure StopSong;
{ Stops playing the current song.}
begin
     try
        if fPlaySongs then begin
           fRepeatSong := False;
           frmHuvudmeny.mplMIDI.Notify := False;
           frmHuvudmeny.mplMIDI.Stop;
        end;
     except
     end;
end;

Function SongPosition: Integer;
{ Returns the current postition of the music}
begin
     try
        if fPlaySongs then
           SongPosition := frmHuvudmeny.mplMIDI.Position
        else
           SongPosition := 0;
     except
     end;
end;

Function CorrCase(Str: String):String;
begin
     if (intCapital = 1) and (Sprak <> 20) then
        CorrCase := AnsiUppercase(Str)

     else if (intCapital = 2) and (Sprak <> 20) then
        CorrCase := AnsiLowercase(Str)
     else
        CorrCase := str;
end;

Procedure ShowHelp(Handle: HWND);
var
   MyStr: Array[0..255] of char;
   strFileName: String;
begin
          strFileName := Concat(AppPath, '\SEBRAN.chm');

          StrPCopy(MyStr, strFileName);
          ShellExecute(Handle, Nil, MyStr, Nil, Nil, SW_RESTORE);

end;
end.
