aboutsummaryrefslogblamecommitdiffstats
path: root/Game/Code/Menu/UMenuText.pas
blob: adf58840556db117d3cca690326343209d4a03a7 (plain) (tree)
1
2
3
4
5
6
7
8
9








                                           

                                     


                              


                    

                                                                                        
                                                                        

                      










                                                                  




                                                               


                                                               
                                                                                                                                                              


               
                                  



                                           



                                  

     

                                        





























































                                                                                              
      
                   

                       










                            




                         
       
 
 




                        
            














                                                                                                                    
 




                                                                                             
            










                                                                                    
           

                   
       


                                        
 
           
             

                                  
                                         

                                                              
                                          













                                                                                                   
 
                                                                     
             
         
       
 











































































































                                                                                                                           


                                  














                             

                      
                    
                  
                   



                         
                          
                                             











                                        
                                                           
          
                                               













                                                  
         
                                      
                       

                                       
                                                                             


                                       
 
                      


                                                            
             
 







                                           









                                                     
                                             

     
                                                                                                                                                    



                    
             













                       
unit UMenuText;

interface
uses TextGL, UTexture, OpenGL12, SysUtils;

type
  TText = class
    private
      SelectBool:   boolean;
      TextString:   String;
      TextTiles:    Array of String;

      STicks:       Cardinal;
      SelectBlink:  Boolean;
    public
      X:      real;
      Y:      real;
      MoveX:  real;       //Some Modifier for X - Position that don't Affect the Real Y
      MoveY:  real;       //Some Modifier for Y - Position that don't Affect the Real Y
      W:      real;       // if text is wider than W then it is breaked
//      H:      real;
      Size:   real;
      ColR:   real;
      ColG:   real;
      ColB:   real;
      Int:    real;
      Style:  integer;
      Visible:  boolean;
      Align:    integer; // 0 = left, 1 = center, 2 = right

      procedure SetSelect(Value: Boolean);
      property Selected: Boolean read SelectBool write SetSelect;

      procedure SetText(Value: String);
      property  Text: String read TextString write SetText;

      procedure DeleteLastL; //Procedure to Delete Last Letter

      procedure Draw;
      constructor Create; overload;
      constructor Create(X, Y: real; Tekst: string); overload;
      constructor Create(ParX, ParY, ParW: real; ParStyle: integer; ParSize, ParColR, ParColG, ParColB: real; ParAlign: integer; ParTekst: string); overload;
  end;

implementation
uses UGraphic, StrUtils, Windows;

procedure TText.SetSelect(Value: Boolean);
begin
  SelectBool := Value;
  
  //Set Cursor Visible
  SelectBlink := True;
  STicks := GettickCount div 550;
end;

procedure TText.SetText(Value: String);
var
  NextPos: Cardinal;    //NextPos of a Space etc.
  LastPos: Cardinal;    //LastPos "
  LastBreak: Cardinal;  //Last Break
  isBreak: Boolean;     //True if the Break is not Caused because the Text is out of the area
  FirstWord: Word;      //Is First Word after Break?
  Len:       Word;      //Length of the Tiles Array
  Function Smallest(const A, B: Cardinal):Cardinal;
  begin
    if (A < B) then
      Result := A
    else
      Result := B;
  end;

  Function GetNextPos: Boolean;
  var
    T1, T2, T3: Cardinal;
  begin
    LastPos := NextPos;

    //Next Space (If Width is given)
    if (W > 0) then
      T1 := PosEx(' ', Value, LastPos + 1)
    else T1 := Length(Value);

    {//Next -
    T2 := PosEx('-', Value, LastPos + 1);}

    //Next Break
    T3 := PosEx('\n', Value, LastPos + 1);

    if T1 = 0 then
      T1 := Length(Value);
    {if T2 = 0 then
      T2 := Length(Value); }
    if T3 = 0 then
      T3 := Length(Value);

    //Get Nearest Pos
    NextPos := Smallest(T1, T3{Smallest(T2, T3)});

    if (LastPos = Length(Value)) then
      NextPos := 0;

    isBreak := (NextPos = T3) AND (NextPos <> Length(Value));
    Result := (NextPos <> 0);
  end;
  procedure AddBreak(const From, bTo: Cardinal);
  begin
    if (isBreak) OR (bTo - From > 1) then
    begin
      Inc(Len);
      SetLength (TextTiles, Len);
      TextTiles[Len-1] := Trim(Copy(Value, From, bTo - From));

      if isBreak then
        LastBreak := bTo + 2
      else
        LastBreak := bTo + 1;
      FirstWord := 0;
    end;
  end;
begin
  //Set TExtstring
  TextString := Value;

  //Create Tiles
  //Reset Text Array
  SetLength (TextTiles, 0);
  Len := 0;

  //Reset Counter Vars
  LastPos := 1;
  NextPos := 1;
  LastBreak := 1;
  FirstWord := 1;

  if (W > 0) then
  begin
    //Set Font Propertys
    SetFontStyle(Style);
    SetFontSize(Size);
  end;


  //go Through Text
  While (GetNextPos) do
  begin
      //Break in Text
      if isBreak then
      begin
        //Look for Break before the Break
        if (glTextWidth(PChar(Copy(Value, LastBreak, NextPos - LastBreak + 1))) > W) AND (NextPos-LastPos > 1) then
        begin
          //Not the First word after Break, so we don't have to break within a word
          if (FirstWord > 1) then
          begin
            //Add Break before actual Position, because there the  Text fits the Area
            AddBreak(LastBreak, LastPos);
          end
          else //First Word after Break Break within the Word
          begin
            //ToDo
            //AddBreak(LastBreak, LastBreak + 155);
          end;
        end;

        //Add Break from Text
        AddBreak(LastBreak, NextPos);
      end
      //Text comes out of the Text Area -> CreateBreak
      else if (glTextWidth(PChar(Copy(Value, LastBreak, NextPos - LastBreak + 1))) > W) then
      begin
        //Not the First word after Break, so we don't have to break within a word
        if (FirstWord > 1) then
        begin
          //Add Break before actual Position, because there the  Text fits the Area
          AddBreak(LastBreak, LastPos);
        end
        else //First Word after Break -> Break within the Word
        begin
          //ToDo
          //AddBreak(LastBreak, LastBreak + 155);
        end;
      end;
    //end;
    Inc(FirstWord)
  end;
  //Add Ending
  AddBreak(LastBreak, Length(Value)+1);


  {I := 0;
  // \n Hack
  While (I <= High(TextTiles)) do
  begin
    LastPos := Pos ('\n', TextTiles[I]);
    if (LastPos = 0) then //No /n Tags -> Search in next Tile
      Inc(I)
    else //Found \n Tag -> Create a Break
    begin
      //Add a new Tile and move all Tiles behind actual Tile to the right
      L := Length(TextTiles);
      SetLength(TextTiles, L+1);
      For L := L-1 downto I + 1 do
      begin
        TextTiles[L+1] := TextTiles[L];
      end;

      //Write Text to new Tile
      TextTiles[I+1] := Trim(Copy(TextTiles[I], LastPos + 2, Length(TextTiles[I]) - LastPos - 1));
      //Delete Text that now is in new Tile from cur. Tile
      Delete(TextTiles[I], LastPos, Length(TextTiles[I]) - LastPos + 1);
      TextTiles[I] := Trim (TextTiles[I]);

      //Goto next Tile because cur. Tile can not have another /n Tag
      Inc(I)
    end;
  end;

  //Create Page Breaks if width is given and the Text overlapps the width
  if (W > 0) then
  begin
    //Set Font Propertys
    SetFontStyle(Style);
    SetFontSize(Size);

    {//Create New TextTiles Array
    SetLength (TextTiles, 0);}{
    I := 0;

    //Go Through all Tiles
    While (I <= High(TextTiles)) do
    begin
      LastPos := 0;
      CurPos := Pos (' ', TextTiles[I]);

      //Go through all Spaces
      While (CurPos <> 0) do
      begin
        //Text is too long for given Width and not the First Word(That means that the Given Word don't Fit the given Width
        if (glTextWidth(PChar(Copy (TextTiles[I],1,CurPos-1))) > W) AND (LastPos <> 1) then
        begin
          //Add a new Tile and move all Tiles behind actual Tile to the right
          L := Length(TextTiles);
          SetLength(TextTiles, L+1);
          For L := L-1 downto I + 1 do
          begin
            TextTiles[L+1] := TextTiles[L];
          end;

          //Write Text to new Tile
          TextTiles[I+1] := Trim(Copy(TextTiles[I], LastPos + 1, Length(TextTiles[I]) - LastPos));
          //Delete Text that now is in new Tile from cur. Tile
          Delete(TextTiles[I], LastPos, Length(TextTiles[I]) - LastPos + 1);
          TextTiles[I] := Trim (TextTiles[I]);

          //Goto next Tile because cur. Tile can not have another Space
          Inc(I)
        end;
        //Set LastPos and Cur Pos
        LastPos := CurPos;
        CurPos := PosEx (' ', TextTiles[I], LastPos+1);
      end;

      //Look for PageBreak in Last Part of the Tile
      CurPos := Length(TextTiles[I]);
      if (glTextWidth(PChar(Copy (TextTiles[I],1,CurPos))) > W) AND (LastPos <> 1) then
      begin
        //Add a new Tile and move all Tiles behind actual Tile to the right
        L := Length(TextTiles);
        SetLength(TextTiles, L+1);
        For L := L-1 downto I + 1 do
        begin
          TextTiles[L+1] := TextTiles[L];
        end;

        //Write Text to new Tile
        TextTiles[I+1] := Trim(Copy(TextTiles[I], LastPos + 1, CurPos - LastPos));
        //Delete Text from cur. Tile that now is in new Tile
        Delete(TextTiles[I], LastPos, CurPos - LastPos + 1);
        TextTiles[I] := Trim (TextTiles[I]);
        //Goto next Tile because cur. Tile can not have another Space
        Inc(I)
      end;

      //Inc I if Current Tile has no more Spaces
      Inc(I)
    end;

    I := high(TextTiles);

      {LastPos := 1;
      LastBreak := 0;
      I := Pos (' ', Value);
      While (I <> 0) do
      begin
        if (glTextWidth(PChar(Copy (Value,LastBreak + 1,I - LastBreak))) > W) AND (LastPos <> 1) then
        begin
          //new Break
          SetLength (TextTiles, L+1);
          TextTiles[L] := Copy (Value, LastBreak + 1, LastPos - LastBreak);

          Inc(L);
          LastBreak := LastPos;
        end;

        LastPos := I;
        I := PosEx (' ', Value, I+1);
      end;

      //Last Break
      if (glTextWidth(PChar(Copy (Value,LastBreak + 1,Length(Value) - LastBreak))) > W) AND (LastPos <> 1) then
      begin
        //new Break
        SetLength (TextTiles, L+1);
        TextTiles[L] := Copy (Value, LastBreak + 1, LastPos - LastBreak);

        Inc(L);
        LastBreak := LastPos;
      end;

      //last Part
      SetLength (TextTiles, L+1);
      TextTiles[L] := Copy (Value, LastBreak + 1, Length(Value) - LastBreak);

  end;    }

  //Set Cursor Visible
  SelectBlink := True;
  STicks := GettickCount div 550;
end;

Procedure TText.DeleteLastL;
var
  S: String;
  L: Integer;
begin
  S := TextString;
  L := Length(S);
  if (L > 0) then
    SetLength(S, L-1);

  SetText(S);
end;

procedure TText.Draw;
var
  X2, Y2:     real;
  Text2:  string;
  I:      Integer;
begin
  if Visible then begin
    SetFontStyle(Style);
    SetFontSize(Size);
    SetFontItalic(False);
    glColor3f(ColR*Int, ColG*Int, ColB*Int);

    //If Selected Set Blink...
    if SelectBool then
    begin
      I := Gettickcount div 550;
      if I <> STicks then
      begin //Change Visability
        STicks := I;
        SelectBlink := Not SelectBlink;
      end;
    end;

    if (False) then //No Width set Draw as one Long String
    begin
      if not (SelectBool AND SelectBlink) then
        Text2 := Text
      else
        Text2 := Text + '|';

      case Align of
        0: X2 := X;
        1: X2 := X - glTextWidth(pchar(Text2))/2;
        2: X2 := X - glTextWidth(pchar(Text2));
      end;

      SetFontPos(X2, Y);
      glPrint(PChar(Text2));
      SetFontStyle(0); // reset to default
    end
    else
    begin //Draw Text as Many Strings
      Y2 := Y + MoveY;
      for I := 0 to high(TextTiles) do
      begin
        if (not (SelectBool AND SelectBlink)) OR (I <> high(TextTiles)) then
          Text2 := TextTiles[I]
        else
          Text2 := TextTiles[I] + '|';

        case Align of
          0: X2 := X + MoveX;
          1: X2 := X + MoveX - glTextWidth(pchar(Text2))/2;
          2: X2 := X + MoveX - glTextWidth(pchar(Text2));
        end;

        SetFontPos(X2, Y2);
        glPrint(PChar(Text2));

        Y2 := Y2 + Size * 1.7;
      end;
      SetFontStyle(0); // reset to default

    end;
  end;
end;

constructor TText.Create;
begin
  Create(0, 0, '');
end;

constructor TText.Create(X, Y: real; Tekst: string);
begin
  Create(X, Y, 0, 0, 10, 0, 0, 0, 0, Tekst);
end;

constructor TText.Create(ParX, ParY, ParW: real; ParStyle: integer; ParSize, ParColR, ParColG, ParColB: real; ParAlign: integer; ParTekst: string);
begin
  inherited Create;
  X := ParX;
  Y := ParY;
  W := ParW;
  Style := ParStyle;
  Size := ParSize;
  Text := ParTekst;
  ColR := ParColR;
  ColG := ParColG;
  ColB := ParColB;
  Int := 1;
  Align := ParAlign;
  SelectBool := false;
  Visible := true;
end;


end.