{* UltraStar Deluxe - Karaoke Game
*
* UltraStar Deluxe is the legal property of its developers, whose names
* are too numerous to list here. Please refer to the COPYRIGHT
* file distributed with this source distribution.
*
* This program 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.
*
* This program 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 this program; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
* Boston, MA 02110-1301, USA.
*
* $URL$
* $Id$
*}
unit UMenu;
interface
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
{$I switches.inc}
uses
SysUtils,
Math,
gl,
SDL,
UPath,
UMenuBackground,
UMenuButton,
UMenuButtonCollection,
UMenuInteract,
UMenuSelectSlide,
UMenuStatic,
UMenuText,
UMusic,
UTexture,
UThemes;
type
{ Int16 = SmallInt;}
PMenu = ^TMenu;
TMenu = class
protected
Background: TMenuBackground;
Interactions: array of TInteract;
SelInteraction: integer;
ButtonPos: integer;
Button: array of TButton;
SelectsS: array of TSelectSlide;
ButtonCollection: array of TButtonCollection;
public
Text: array of TText;
Statics: array of TStatic;
StaticsList: array of TStatic;
mX: integer; // mouse X
mY: integer; // mouse Y
Fade: integer; // fade type
ShowFinish: boolean; // true if there is no fade
RightMbESC: boolean; // true to simulate ESC keypress when RMB is pressed
destructor Destroy; override;
constructor Create; overload; virtual;
//constructor Create(Back: string); overload; virtual; // Back is a JPG resource name for background
//constructor Create(Back: string; W, H: integer); overload; virtual; // W and H are the number of overlaps
// interaction
procedure AddInteraction(Typ, Num: integer);
procedure SetInteraction(Num: integer); virtual;
property Interaction: integer read SelInteraction write SetInteraction;
// procedure load bg, texts, statics and button collections from themebasic
procedure LoadFromTheme(const ThemeBasic: TThemeBasic);
procedure PrepareButtonCollections(const Collections: AThemeButtonCollection);
procedure AddButtonCollection(const ThemeCollection: TThemeButtonCollection; const Num: byte);
// background
procedure AddBackground(ThemedSettings: TThemeBackground);
// static
function AddStatic(ThemeStatic: TThemeStatic): integer; overload;
function AddStatic(X, Y, W, H: real; const TexName: IPath): integer; overload;
function AddStatic(X, Y, W, H: real; const TexName: IPath; Typ: TTextureType): integer; overload;
function AddStatic(X, Y, W, H: real; ColR, ColG, ColB: real; const TexName: IPath; Typ: TTextureType): integer; overload;
function AddStatic(X, Y, W, H, Z: real; ColR, ColG, ColB: real; const TexName: IPath; Typ: TTextureType): integer; overload;
function AddStatic(X, Y, W, H: real; ColR, ColG, ColB: real; const TexName: IPath; Typ: TTextureType; Color: integer): integer; overload;
function AddStatic(X, Y, W, H, Z: real; ColR, ColG, ColB: real; const TexName: IPath; Typ: TTextureType; Color: integer): integer; overload;
function AddStatic(X, Y, W, H, Z: real; ColR, ColG, ColB: real; TexX1, TexY1, TexX2, TexY2: real; const TexName: IPath; Typ: TTextureType; Color: integer; Reflection: boolean; ReflectionSpacing: real): integer; overload;
{ for later additions
function AddStatic(X, Y, W, H, Z: real; ColR, ColG, ColB: real; TexX1, TexY1, TexX2, TexY2: real; Alpha: real; const TexName: IPath; Typ: TTextureType; Color: integer; Reflection: boolean; ReflectionSpacing: real): integer; overload;
// list
function AddListItem(X, Y, W, H, Z: real; ColR, ColG, ColB: real; DColR, DColG, DColB: real; const TexName: IPath; const DTexName: IPath; Typ: TTextureType; Reflection: boolean; ReflectionSpacing: real): integer;
}
// text
function AddText(ThemeText: TThemeText): integer; overload;
function AddText(X, Y: real; const Text_: UTF8String): integer; overload;
function AddText(X, Y: real; Style: integer; Size, ColR, ColG, ColB: real; const Text: UTF8String): integer; overload;
function AddText(X, Y, W: real; Style: integer; Size, ColR, ColG, ColB: real; Align: integer; const Text_: UTF8String; Reflection_: boolean; ReflectionSpacing_: real; Z : real; Writable: boolean): integer; overload;
// button
procedure SetButtonLength(Length: cardinal); //Function that Set Length of Button Array in one Step instead of register new Memory for every Button
function AddButton(ThemeButton: TThemeButton): integer; overload;
function AddButton(X, Y, W, H: real; const TexName: IPath): integer; overload;
function AddButton(X, Y, W, H: real; const TexName: IPath; Typ: TTextureType; Reflection: boolean): integer; overload;
function AddButton(X, Y, W, H, ColR, ColG, ColB, Int, DColR, DColG, DColB, DInt: real; const TexName: IPath; Typ: TTextureType; Reflection: boolean; ReflectionSpacing, DeSelectReflectionSpacing: real): integer; overload;
procedure ClearButtons;
procedure AddButtonText(AddX, AddY: real; const AddText: UTF8String); overload;
procedure AddButtonText(AddX, AddY: real; ColR, ColG, ColB: real; const AddText: UTF8String); overload;
procedure AddButtonText(AddX, AddY: real; ColR, ColG, ColB: real; Font: integer; Size: integer; Align: integer; const AddText: UTF8String); overload;
procedure AddButtonText(CustomButton: TButton; AddX, AddY: real; ColR, ColG, ColB: real; Font: integer; Size: integer; Align: integer; const AddText: UTF8String); overload;
// select slide
function AddSelectSlide(ThemeSelectS: TThemeSelectSlide; var Data: integer; const Values: array of UTF8String): integer; overload;
function AddSelectSlide(X, Y, W, H, SkipX, SBGW, ColR, ColG, ColB, Int, DColR, DColG, DColB, DInt,
TColR, TColG, TColB, TInt, TDColR, TDColG, TDColB, TDInt,
SBGColR, SBGColG, SBGColB, SBGInt, SBGDColR, SBGDColG, SBGDColB, SBGDInt,
STColR, STColG, STColB, STInt, STDColR, STDColG, STDColB, STDInt: real;
const TexName: IPath; Typ: TTextureType; const SBGName: IPath; SBGTyp: TTextureType;
const Caption: UTF8String; var Data: integer): integer; overload;
procedure AddSelectSlideOption(const AddText: UTF8String); overload;
procedure AddSelectSlideOption(SelectNo: cardinal; const AddText: UTF8String); overload;
procedure UpdateSelectSlideOptions(ThemeSelectSlide: TThemeSelectSlide; SelectNum: integer; const Values: array of UTF8String; var Data: integer);
// function AddWidget(X, Y : UInt16; WidgetSrc : PSDL_Surface): Int16;
// procedure ClearWidgets(MinNumber : Int16);
procedure FadeTo(Screen: PMenu); overload;
procedure FadeTo(Screen: PMenu; aSound: TAudioPlaybackStream); overload;
//popup hack
procedure CheckFadeTo(Screen: PMenu; Msg: UTF8String);
function DrawBG: boolean; virtual;
function DrawFG: boolean; virtual;
function Draw: boolean; virtual;
function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown : boolean): boolean; virtual;
function ParseMouse(MouseButton: integer; BtnDown: boolean; X, Y: integer): boolean; virtual;
function InRegion(X, Y: real; A: TMouseOverRect): boolean;
function InRegionX(X: real; A: TMouseOverRect): boolean;
function InRegionY(Y: real; A: TMouseOverRect): boolean;
function InteractAt(X, Y: real): integer;
function CollectionAt(X, Y: real): integer;
procedure OnShow; virtual;
procedure OnShowFinish; virtual;
procedure OnHide; virtual;
procedure SetAnimationProgress(Progress: real); virtual;
function IsSelectable(Int: cardinal): boolean;
procedure InteractNext; virtual;
procedure InteractCustom(CustomSwitch: integer); virtual;
procedure InteractPrev; virtual;
procedure InteractInc; virtual;
procedure InteractDec; virtual;
procedure InteractNextRow; virtual; // this is for the options screen, so button down makes sense
procedure InteractPrevRow; virtual; // this is for the options screen, so button up makes sense
procedure AddBox(X, Y, W, H: real);
end;
function RGBFloatToInt(R, G, B: double): cardinal;
const
MENU_MDOWN = 8;
MENU_MUP = 0;
pmMove = 1;
pmClick = 2;
pmUnClick = 3;
iButton = 0; // interaction type
iText = 2;
iSelectS = 3;
iBCollectionChild = 5;
// fBlack = 0; // fade type
// fWhite = 1;
implementation
uses
UCommon,
UCovers,
UDisplay,
UDrawTexture,
UGraphic,
ULog,
UMain,
USkins,
UTime,
//Background types
UMenuBackgroundNone,
UMenuBackgroundColor,
UMenuBackgroundTexture,
UMenuBackgroundVideo,
UMenuBackgroundFade;
destructor TMenu.Destroy;
var
I: integer;
begin
for I := 0 to High(Button) do
Button[I].Free;
for I := 0 to High(ButtonCollection) do
ButtonCollection[I].Free;
for I := 0 to High(SelectsS) do
SelectsS[I].Free;
for I := 0 to High(Text) do
Text[I].Free;
for I := 0 to High(Statics) do
Statics[I].Free;
Background.Free;
//Log.LogError('Unloaded Succesful: ' + ClassName);
inherited;
end;
constructor TMenu.Create;
begin
inherited;
Fade := 0;//fWhite;
SetLength(Statics, 0);
SetLength(Button, 0);
//Set ButtonPos to Autoset Length
ButtonPos := -1;
Background := nil;
RightMbESC := true;
end;
{
constructor TMenu.Create(Back: string);
begin
inherited Create;
if Back <> '' then
begin
// BackImg := Texture.GetTexture(true, Back, TEXTURE_TYPE_PLAIN, 0);
BackImg := Texture.GetTexture(Back, TEXTURE_TYPE_PLAIN, 0); // new theme system
BackImg.W := 800;//640;
BackImg.H := 600;//480;
BackW := 1;
BackH := 1;
end
else
BackImg.TexNum := 0;
//Set ButtonPos to Autoset Length
ButtonPos := -1;
end;
constructor TMenu.Create(Back: string; W, H: integer);
begin
Create(Back);
BackImg.W := BackImg.W / W;
BackImg.H := BackImg.H / H;
BackW := W;
BackH := H;
end; }
function RGBFloatToInt(R, G, B: double): cardinal;
begin
Result := (Trunc(255 * R) shl 16) or
(Trunc(255 * G) shl 8) or
Trunc(255 * B);
end;
procedure TMenu.AddInteraction(Typ, Num: integer);
var
IntNum: integer;
begin
IntNum := Length(Interactions);
SetLength(Interactions, IntNum+1);
Interactions[IntNum].Typ := Typ;
Interactions[IntNum].Num := Num;
Interaction := 0;
end;
procedure TMenu.SetInteraction(Num: integer);
var
OldNum, OldTyp: integer;
NewNum, NewTyp: integer;
begin
// set inactive
OldNum := Interactions[Interaction].Num;
OldTyp := Interactions[Interaction].Typ;
NewNum := Interactions[Num].Num;
NewTyp := Interactions[Num].Typ;
case OldTyp of
iButton: Button[OldNum].Selected := false;
iText: Text[OldNum].Selected := false;
iSelectS: SelectsS[OldNum].Selected := false;
//Button Collection Mod
iBCollectionChild:
begin
Button[OldNum].Selected := false;
// deselect collection if next button is not from collection
if (NewTyp <> iButton) or (Button[NewNum].Parent <> Button[OldNum].Parent) then
ButtonCollection[Button[OldNum].Parent-1].Selected := false;
end;
end;
// set active
SelInteraction := Num;
case NewTyp of
iButton: Button[NewNum].Selected := true;
iText: Text[NewNum].Selected := true;
iSelectS: SelectsS[NewNum].Selected := true;
//Button Collection Mod
iBCollectionChild:
begin
Button[NewNum].Selected := true;
ButtonCollection[Button[NewNum].Parent-1].Selected := true;
end;
end;
end;
//----------------------
//LoadFromTheme - Load BG, Texts, Statics and
//Button Collections from ThemeBasic
//----------------------
procedure TMenu.LoadFromTheme(const ThemeBasic: TThemeBasic);
var
I: integer;
begin
//Add Button Collections (Set Button CollectionsLength)
//Button Collections are Created when the first ChildButton is Created
PrepareButtonCollections(ThemeBasic.ButtonCollection);
//Add Background
AddBackground(ThemeBasic.Background);
//Add Statics and Texts
for I := 0 to High(ThemeBasic.Statics) do
AddStatic(ThemeBasic.Statics[I]);
for I := 0 to High(ThemeBasic.Text) do
AddText(ThemeBasic.Text[I]);
end;
procedure TMenu.AddBackground(ThemedSettings: TThemeBackground);
var
FileExt: string;
function IsInArray(const Piece: string; const A: array of string): boolean;
var
I: integer;
begin
Result := false;
for I := 0 to High(A) do
if (A[I] = Piece) then
begin
Result := true;
Exit;
end;
end;
function TryBGCreate(Typ: cMenuBackground): boolean;
begin
Result := true;
try
Background := Typ.Create(ThemedSettings);
except
on E: EMenuBackgroundError do
begin //Background failes to create
Freeandnil(Background);
Result := false;
end;
end;
end;
begin
FreeAndNil(Background);
case ThemedSettings.BGType of
bgtAuto: begin //Automaticly choose one out of BGT_Texture, BGT_Video or BGT_Color
if (Length(ThemedSettings.Tex) > 0) then
begin
//At first some intelligent try to decide which BG to load
FileExt := LowerCase(Skin.GetTextureFileName(ThemedSettings.Tex).GetExtension.ToUTF8);
if IsInArray(FileExt, SUPPORTED_EXTS_BACKGROUNDTEXTURE) then
TryBGCreate(TMenuBackgroundTexture)
else if IsInArray(FileExt, SUPPORTED_EXTS_BACKGROUNDVIDEO) then
TryBGCreate(TMenuBackgroundVideo);
//If the intelligent method don't succeed
//do it by trial and error
if (Background = nil) then
begin
//Try Textured Bg
if not TryBGCreate(TMenuBackgroundTexture) then
TryBgCreate(TMenuBackgroundVideo); //Try Video BG
//Color is fallback if Background = nil
end;
end;
end;
bgtColor: begin
try
Background := TMenuBackgroundColor.Create(ThemedSettings);
except
on E: EMenuBackgroundError do
begin
Log.LogError(E.Message);
freeandnil(Background);
end;
end;
end;
bgtTexture: begin
try
Background := TMenuBackgroundTexture.Create(ThemedSettings);
except
on E: EMenuBackgroundError do
begin
Log.LogError(E.Message);
freeandnil(Background);
end;
end;
end;
bgtVideo: begin
try
Background := TMenuBackgroundVideo.Create(ThemedSettings);
except
on E: EMenuBackgroundError do
begin
Log.LogError(E.Message);
freeandnil(Background);
end;
end;
end;
bgtNone: begin
try
Background := TMenuBackgroundNone.Create(ThemedSettings);
except
on E: EMenuBackgroundError do
begin
Log.LogError(E.Message);
freeandnil(Background);
end;
end;
end;
bgtFade: begin
try
Background := TMenuBackgroundFade.Create(ThemedSettings);
except
on E: EMenuBackgroundError do
begin
Log.LogError(E.Message);
freeandnil(Background);
end;
end;
end;
end;
//Fallback to None Background or Colored Background
if (Background = nil) then
begin
if (ThemedSettings.BGType = bgtColor) then
Background := TMenuBackgroundNone.Create(ThemedSettings)
else
Background := TMenuBackgroundColor.Create(ThemedSettings)
end;
end;
//----------------------
//PrepareButtonCollections:
//Add Button Collections (Set Button CollectionsLength)
//----------------------
procedure TMenu.PrepareButtonCollections(const Collections: AThemeButtonCollection);
var
I: integer;
begin
SetLength(ButtonCollection, Length(Collections));
for I := 0 to High(ButtonCollection) do
AddButtonCollection(Collections[I], I);
end;
//----------------------
//AddButtonCollection:
//Create a Button Collection;
//----------------------
procedure TMenu.AddButtonCollection(const ThemeCollection: TThemeButtonCollection; const Num: byte);
var
BT, BTLen: integer;
TempCol, TempDCol: cardinal;
begin
if (Num > High(ButtonCollection)) then
exit;
TempCol := 0;
// colorize hack
if (ThemeCollection.Style.Typ = TEXTURE_TYPE_COLORIZED) then
begin
TempCol := RGBFloatToInt(ThemeCollection.Style.ColR, ThemeCollection.Style.ColG, ThemeCollection.Style.ColB);
TempDCol := RGBFloatToInt(ThemeCollection.Style.DColR, ThemeCollection.Style.DColG, ThemeCollection.Style.DColB);
// give encoded color to GetTexture()
ButtonCollection[Num] := TButtonCollection.Create(
Texture.GetTexture(Skin.GetTextureFileName(ThemeCollection.Style.Tex), TEXTURE_TYPE_COLORIZED, TempCol),
Texture.GetTexture(Skin.GetTextureFileName(ThemeCollection.Style.Tex), TEXTURE_TYPE_COLORIZED, TempDCol));
end
else
begin
ButtonCollection[Num] := TButtonCollection.Create(Texture.GetTexture(
Skin.GetTextureFileName(ThemeCollection.Style.Tex), ThemeCollection.Style.Typ));
end;
//Set Parent menu
ButtonCollection[Num].ScreenButton := @Self.Button;
//Set Attributes
ButtonCollection[Num].FirstChild := ThemeCollection.FirstChild;
ButtonCollection[Num].CountChilds := ThemeCollection.ChildCount;
ButtonCollection[Num].Parent := Num + 1;
//Set Style
ButtonCollection[Num].X := ThemeCollection.Style.X;
ButtonCollection[Num].Y := ThemeCollection.Style.Y;
ButtonCollection[Num].W := ThemeCollection.Style.W;
ButtonCollection[Num].H := ThemeCollection.Style.H;
if (ThemeCollection.Style.Typ <> TEXTURE_TYPE_COLORIZED) then
begin
ButtonCollection[Num].SelectColR := ThemeCollection.Style.ColR;
ButtonCollection[Num].SelectColG := ThemeCollection.Style.ColG;
ButtonCollection[Num].SelectColB := ThemeCollection.Style.ColB;
ButtonCollection[Num].DeselectColR := ThemeCollection.Style.DColR;
ButtonCollection[Num].DeselectColG := ThemeCollection.Style.DColG;
ButtonCollection[Num].DeselectColB := ThemeCollection.Style.DColB;
end;
ButtonCollection[Num].SelectInt := ThemeCollection.Style.Int;
ButtonCollection[Num].DeselectInt := ThemeCollection.Style.DInt;
ButtonCollection[Num].Texture.TexX1 := 0;
ButtonCollection[Num].Texture.TexY1 := 0;
ButtonCollection[Num].Texture.TexX2 := 1;
ButtonCollection[Num].Texture.TexY2 := 1;
ButtonCollection[Num].SetSelect(false);
ButtonCollection[Num].Reflection := ThemeCollection.Style.Reflection;
ButtonCollection[Num].Reflectionspacing := ThemeCollection.Style.ReflectionSpacing;
ButtonCollection[Num].DeSelectReflectionspacing := ThemeCollection.Style.DeSelectReflectionSpacing;
ButtonCollection[Num].Z := ThemeCollection.Style.Z;
//Some Things from ButtonFading
ButtonCollection[Num].SelectH := ThemeCollection.Style.SelectH;
ButtonCollection[Num].SelectW := ThemeCollection.Style.SelectW;
ButtonCollection[Num].Fade := ThemeCollection.Style.Fade;
ButtonCollection[Num].FadeText := ThemeCollection.Style.FadeText;
if (ThemeCollection.Style.Typ = TEXTURE_TYPE_COLORIZED) then
begin
ButtonCollection[Num].FadeTex := Texture.GetTexture(
Skin.GetTextureFileName(ThemeCollection.Style.FadeTex), TEXTURE_TYPE_COLORIZED, TempCol)
end
else
begin
ButtonCollection[Num].FadeTex := Texture.GetTexture(
Skin.GetTextureFileName(ThemeCollection.Style.FadeTex), ThemeCollection.Style.Typ);
end;
ButtonCollection[Num].FadeTexPos := ThemeCollection.Style.FadeTexPos;
BTLen := Length(ThemeCollection.Style.Text);
for BT := 0 to BTLen-1 do
begin
AddButtonText(ButtonCollection[Num], ThemeCollection.Style.Text[BT].X, ThemeCollection.Style.Text[BT].Y,
ThemeCollection.Style.Text[BT].ColR, ThemeCollection.Style.Text[BT].ColG, ThemeCollection.Style.Text[BT].ColB,
ThemeCollection.Style.Text[BT].Font, ThemeCollection.Style.Text[BT].Size, ThemeCollection.Style.Text[BT].Align,
ThemeCollection.Style.Text[BT].Text);
end;
end;
function TMenu.AddStatic(ThemeStatic: TThemeStatic): integer;
begin
Result := AddStatic(ThemeStatic.X, ThemeStatic.Y, ThemeStatic.W, ThemeStatic.H, ThemeStatic.Z,
ThemeStatic.ColR, ThemeStatic.ColG, ThemeStatic.ColB,
ThemeStatic.TexX1, ThemeStatic.TexY1, ThemeStatic.TexX2, ThemeStatic.TexY2,
// add when using alpha
// ThemeStatic.TexX1, ThemeStatic.TexY1, ThemeStatic.TexX2, ThemeStatic.TexY2, ThemeStatic.Alpha,
Skin.GetTextureFileName(ThemeStatic.Tex),
ThemeStatic.Typ, $FFFFFF, ThemeStatic.Reflection, ThemeStatic.Reflectionspacing);
end;
function TMenu.AddStatic(X, Y, W, H: real; const TexName: IPath): integer;
begin
Result := AddStatic(X, Y, W, H, TexName, TEXTURE_TYPE_PLAIN);
end;
function TMenu.AddStatic(X, Y, W, H: real;
ColR, ColG, ColB: real;
const TexName: IPath;
Typ: TTextureType): integer;
begin
Result := AddStatic(X, Y, W, H, ColR, ColG, ColB, TexName, Typ, $FFFFFF);
end;
function TMenu.AddStatic(X, Y, W, H, Z: real;
ColR, ColG, ColB: real;
const TexName: IPath;
Typ: TTextureType): integer;
begin
Result := AddStatic(X, Y, W, H, Z, ColR, ColG, ColB, TexName, Typ, $FFFFFF);
end;
function TMenu.AddStatic(X, Y, W, H: real;
const TexName: IPath;
Typ: TTextureType): integer;
var
StatNum: integer;
begin
// adds static
StatNum := Length(Statics);
SetLength(Statics, StatNum + 1);
Statics[StatNum] := TStatic.Create(Texture.GetTexture(TexName, Typ, $FF00FF)); // new skin
// configures static
Statics[StatNum].Texture.X := X;
Statics[StatNum].Texture.Y := Y;
Statics[StatNum].Texture.W := W;
Statics[StatNum].Texture.H := H;
Statics[StatNum].Visible := true;
Result := StatNum;
end;
function TMenu.AddStatic(X, Y, W, H: real;
ColR, ColG, ColB: real;
const TexName: IPath;
Typ: TTextureType;
Color: integer): integer;
begin
Result := AddStatic(X, Y, W, H, 0, ColR, ColG, ColB, TexName, Typ, Color);
end;
function TMenu.AddStatic(X, Y, W, H, Z: real;
ColR, ColG, ColB: real;
const TexName: IPath;
Typ: TTextureType;
Color: integer): integer;
begin
Result := AddStatic(X, Y, W, H, Z, ColR, ColG, ColB, 0, 0, 1, 1, TexName, Typ, Color, false, 0);
// Result := AddStatic(X, Y, W, H, Z, ColR, ColG, ColB, 0, 0, 1, 1, 1, TexName, Typ, Color, false, 0);
end;
function TMenu.AddStatic(X, Y, W, H, Z: real;
ColR, ColG, ColB: real;
TexX1, TexY1, TexX2, TexY2: real;
// TexX1, TexY1, TexX2, TexY2: real; Alpha: real;
const TexName: IPath;
Typ: TTextureType;
Color: integer;
Reflection: boolean;
ReflectionSpacing: real): integer;
var
StatNum: integer;
begin
// adds static
StatNum := Length(Statics);
SetLength(Statics, StatNum + 1);
// colorize hack
if (Typ = TEXTURE_TYPE_COLORIZED) then
begin
// give encoded color to GetTexture()
Statics[StatNum] := TStatic.Create(Texture.GetTexture(TexName, Typ, RGBFloatToInt(ColR, ColG, ColB)));
end
else
begin
Statics[StatNum] := TStatic.Create(Texture.GetTexture(TexName, Typ, Color)); // new skin
end;
// configures static
Statics[StatNum].Texture.X := X;
Statics[StatNum].Texture.Y := Y;
//Set height and width via sprite size if omitted
if(H = 0) then
Statics[StatNum].Texture.H := Statics[StatNum].Texture.H
else
Statics[StatNum].Texture.H := H;
if(W = 0) then
Statics[StatNum].Texture.W := Statics[StatNum].Texture.W
else
Statics[StatNum].Texture.W := W;
Statics[StatNum].Texture.Z := Z;
if (Typ <> TEXTURE_TYPE_COLORIZED) then
begin
Statics[StatNum].Texture.ColR := ColR;
Statics[StatNum].Texture.ColG := ColG;
Statics[StatNum].Texture.ColB := ColB;
end;
Statics[StatNum].Texture.TexX1 := TexX1;
Statics[StatNum].Texture.TexY1 := TexY1;
Statics[StatNum].Texture.TexX2 := TexX2;
Statics[StatNum].Texture.TexY2 := TexY2;
Statics[StatNum].Texture.Alpha := 1;
// add with alpha
// Statics[StatNum].Texture.Alpha := Alpha;
Statics[StatNum].Visible := true;
//ReflectionMod
Statics[StatNum].Reflection := Reflection;
Statics[StatNum].ReflectionSpacing := ReflectionSpacing;
Result := StatNum;
end;
{ for later addition
function TMenu.AddListItem(X, Y, W, H, Z: real;
ColR, ColG, ColB: real;
DColR, DColG, DColB: real;
const TexName: IPath;
const DTexName: IPath;
Typ: TTextureType;
Reflection: boolean;
ReflectionSpacing: real): integer;
var
StatNum: integer;
begin
// adds static
StatNum := Length(StaticsList);
SetLength(StaticsList, StatNum + 1);
StaticsList[StatNum] := TStatic.Create(Texture.GetTexture(TexName, Typ, RGBFloatToInt(ColR, ColG, ColB)));
StaticsList[StatNum].TextureSelect := Texture.GetTexture(TexName, Typ, RGBFloatToInt(ColR, ColG, ColB));
StaticsList[StatNum].TextureDeselect := Texture.GetTexture(DTexName, Typ, RGBFloatToInt(DColR, DColG, DColB));
// configures static
StaticsList[StatNum].Texture.X := X;
StaticsList[StatNum].Texture.Y := Y;
//Set height and width via sprite size if omitted
if(H = 0) then
StaticsList[StatNum].Texture.H := StaticsList[StatNum].Texture.H
else
StaticsList[StatNum].Texture.H := H;
if(W = 0) then
StaticsList[StatNum].Texture.W := StaticsList[StatNum].Texture.W
else
StaticsList[StatNum].Texture.W := W;
StaticsList[StatNum].Texture.Z := Z;
if (Typ <> TEXTURE_TYPE_COLORIZED) then
begin
StaticsList[StatNum].Texture.ColR := ColR;
StaticsList[StatNum].Texture.ColG := ColG;
StaticsList[StatNum].Texture.ColB := ColB;
end;
StaticsList[StatNum].Texture.Alpha := 1;
StaticsList[StatNum].Visible := true;
//ReflectionMod
StaticsList[StatNum].Reflection := Reflection;
StaticsList[StatNum].ReflectionSpacing := ReflectionSpacing;
Result := StatNum;
end;
}
function TMenu.AddText(ThemeText: TThemeText): integer;
begin
Result := AddText(ThemeText.X, ThemeText.Y, ThemeText.W, ThemeText.Font, ThemeText.Size,
ThemeText.ColR, ThemeText.ColG, ThemeText.ColB, ThemeText.Align, ThemeText.Text, ThemeText.Reflection, ThemeText.ReflectionSpacing, ThemeText.Z, ThemeText.Writable);
end;
function TMenu.AddText(X, Y: real; const Text_: UTF8String): integer;
var
TextNum: integer;
begin
// adds text
TextNum := Length(Text);
SetLength(Text, TextNum + 1);
Text[TextNum] := TText.Create(X, Y, Text_);
Result := TextNum;
end;
function TMenu.AddText(X, Y: real;
Style: integer;
Size, ColR, ColG, ColB: real;
const Text: UTF8String): integer;
begin
Result := AddText(X, Y, 0, Style, Size, ColR, ColG, ColB, 0, Text, false, 0, 0, false);
end;
function TMenu.AddText(X, Y, W: real;
Style: integer;
Size, ColR, ColG, ColB: real;
Align: integer;
const Text_: UTF8String;
Reflection_: boolean;
ReflectionSpacing_: real;
Z : real;
Writable: boolean): integer;
var
TextNum: integer;
begin
// adds text
TextNum := Length(Text);
SetLength(Text, TextNum + 1);
Text[TextNum] := TText.Create(X, Y, W, Style, Size, ColR, ColG, ColB, Align, Text_, Reflection_, ReflectionSpacing_, Z, Writable);
Result := TextNum;
end;
//Function that Set Length of Button boolean in one Step instead of register new Memory for every Button
procedure TMenu.SetButtonLength(Length: cardinal);
begin
if (ButtonPos = -1) and (Length > 0) then
begin
//Set Length of Button
SetLength(Button, Length);
//Set ButtonPos to start with 0
ButtonPos := 0;
end;
end;
// Method to add a button in our TMenu. It returns the assigned ButtonNumber
function TMenu.AddButton(ThemeButton: TThemeButton): integer;
var
BT: integer;
BTLen: integer;
begin
Result := AddButton(ThemeButton.X, ThemeButton.Y, ThemeButton.W, ThemeButton.H,
ThemeButton.ColR, ThemeButton.ColG, ThemeButton.ColB, ThemeButton.Int,
ThemeButton.DColR, ThemeButton.DColG, ThemeButton.DColB, ThemeButton.DInt,
Skin.GetTextureFileName(ThemeButton.Tex), ThemeButton.Typ,
ThemeButton.Reflection, ThemeButton.Reflectionspacing, ThemeButton.DeSelectReflectionspacing);
Button[Result].Z := ThemeButton.Z;
//Button Visibility
Button[Result].Visible := ThemeButton.Visible;
//Some Things from ButtonFading
Button[Result].SelectH := ThemeButton.SelectH;
Button[Result].SelectW := ThemeButton.SelectW;
Button[Result].Fade := ThemeButton.Fade;
Button[Result].FadeText := ThemeButton.FadeText;
if (ThemeButton.Typ = TEXTURE_TYPE_COLORIZED) then
begin
Button[Result].FadeTex := Texture.GetTexture(
Skin.GetTextureFileName(ThemeButton.FadeTex), TEXTURE_TYPE_COLORIZED,
RGBFloatToInt(ThemeButton.ColR, ThemeButton.ColG, ThemeButton.ColB));
end
else
begin
Button[Result].FadeTex := Texture.GetTexture(
Skin.GetTextureFileName(ThemeButton.FadeTex), ThemeButton.Typ);
end;
Button[Result].FadeTexPos := ThemeButton.FadeTexPos;
BTLen := Length(ThemeButton.Text);
for BT := 0 to BTLen-1 do
begin
AddButtonText(ThemeButton.Text[BT].X, ThemeButton.Text[BT].Y,
ThemeButton.Text[BT].ColR, ThemeButton.Text[BT].ColG, ThemeButton.Text[BT].ColB,
ThemeButton.Text[BT].Font, ThemeButton.Text[BT].Size, ThemeButton.Text[BT].Align,
ThemeButton.Text[BT].Text);
end;
// bautton collection mod
if (ThemeButton.Parent <> 0) then
begin
// if collection exists then change interaction to child button
if (@ButtonCollection[ThemeButton.Parent-1] <> nil) then
begin
Interactions[High(Interactions)].Typ := iBCollectionChild;
Button[Result].Visible := false;
for BT := 0 to BTLen-1 do
Button[Result].Text[BT].Alpha := 0;
Button[Result].Parent := ThemeButton.Parent;
if (ButtonCollection[ThemeButton.Parent-1].Fade) then
Button[Result].Texture.Alpha := 0;
end;
end;
end;
function TMenu.AddButton(X, Y, W, H: real; const TexName: IPath): integer;
begin
Result := AddButton(X, Y, W, H, TexName, TEXTURE_TYPE_PLAIN, false);
end;
function TMenu.AddButton(X, Y, W, H: real; const TexName: IPath; Typ: TTextureType; Reflection: boolean): integer;
begin
Result := AddButton(X, Y, W, H, 1, 1, 1, 1, 1, 1, 1, 0.5, TexName, TEXTURE_TYPE_PLAIN, Reflection, 15, 15);
end;
function TMenu.AddButton(X, Y, W, H, ColR, ColG, ColB, Int, DColR, DColG, DColB, DInt: real;
const TexName: IPath;
Typ: TTextureType;
Reflection: boolean;
ReflectionSpacing, DeSelectReflectionSpacing: real): integer;
begin
// adds button
//SetLength is used once to reduce Memory usement
if (ButtonPos <> -1) then
begin
Result := ButtonPos;
Inc(ButtonPos)
end
else //Old Method -> Reserve new Memory for every Button
begin
Result := Length(Button);
SetLength(Button, Result + 1);
end;
// colorize hack
if (Typ = TEXTURE_TYPE_COLORIZED) then
begin
// give encoded color to GetTexture()
Button[Result] := TButton.Create(Texture.GetTexture(TexName, Typ, RGBFloatToInt(ColR, ColG, ColB)),
Texture.GetTexture(TexName, Typ, RGBFloatToInt(DColR, DColG, DColB)));
end
else
begin
Button[Result] := TButton.Create(Texture.GetTexture(TexName, Typ));
end;
// configures button
Button[Result].X := X;
Button[Result].Y := Y;
Button[Result].W := W;
Button[Result].H := H;
if (Typ <> TEXTURE_TYPE_COLORIZED) then
begin
Button[Result].SelectColR := ColR;
Button[Result].SelectColG := ColG;
Button[Result].SelectColB := ColB;
Button[Result].DeselectColR := DColR;
Button[Result].DeselectColG := DColG;
Button[Result].DeselectColB := DColB;
end;
Button[Result].SelectInt := Int;
Button[Result].DeselectInt := DInt;
Button[Result].Texture.TexX1 := 0;
Button[Result].Texture.TexY1 := 0;
Button[Result].Texture.TexX2 := 1;
Button[Result].Texture.TexY2 := 1;
Button[Result].SetSelect(false);
Button[Result].Reflection := Reflection;
Button[Result].Reflectionspacing := ReflectionSpacing;
Button[Result].DeSelectReflectionspacing := DeSelectReflectionSpacing;
// button collection mod
Button[Result].Parent := 0;
// adds interaction
AddInteraction(iButton, Result);
Interaction := 0;
end;
procedure TMenu.ClearButtons;
begin
Setlength(Button, 0);
end;
// method to draw our tmenu and all his child buttons
function TMenu.DrawBG: boolean;
begin
Background.Draw;
Result := true;
end;
function TMenu.DrawFG: boolean;
var
J: integer;
begin
// We don't forget about newly implemented static for nice skin ...
for J := 0 to High(Statics) do
Statics[J].Draw;
// ... and slightly implemented menutext unit
for J := 0 to High(Text) do
Text[J].Draw;
// Draw all ButtonCollections
for J := 0 to High(ButtonCollection) do
ButtonCollection[J].Draw;
// Second, we draw all of our buttons
for J := 0 to High(Button) do
Button[J].Draw;
for J := 0 to High(SelectsS) do
SelectsS[J].Draw;
// Third, we draw all our widgets
// for J := 0 to Length(WidgetsSrc) - 1 do
// SDL_BlitSurface(WidgetsSrc[J], nil, ParentBackBuf, WidgetsRect[J]);
Result := true;
end;
function TMenu.Draw: boolean;
begin
DrawBG;
DrawFG;
Result := true;
end;
{
function TMenu.GetNextScreen(): PMenu;
begin
Result := NextScreen;
end;
}
{
function TMenu.AddWidget(X, Y: UInt16; WidgetSrc: PSDL_Surface): Int16;
var
WidgetNum: Int16;
begin
if (Assigned(WidgetSrc)) then
begin
WidgetNum := Length(WidgetsSrc);
SetLength(WidgetsSrc, WidgetNum + 1);
SetLength(WidgetsRect, WidgetNum + 1);
WidgetsSrc[WidgetNum] := WidgetSrc;
WidgetsRect[WidgetNum] := new(PSDL_Rect);
WidgetsRect[WidgetNum]^.x := X;
WidgetsRect[WidgetNum]^.y := Y;
WidgetsRect[WidgetNum]^.w := WidgetSrc^.w;
WidgetsRect[WidgetNum]^.h := WidgetSrc^.h;
Result := WidgetNum;
end
else
Result := -1;
end;
}
{
procedure TMenu.ClearWidgets(MinNumber: Int16);
var
J: Int16;
begin
for J := MinNumber to (Length(WidgetsSrc) - 1) do
begin
SDL_FreeSurface(WidgetsSrc[J]);
dispose(WidgetsRect[J]);
end;
SetLength(WidgetsSrc, MinNumber);
SetLength(WidgetsRect, MinNumber);
end;
}
function TMenu.IsSelectable(Int: cardinal): boolean;
begin
Result := true;
case Interactions[Int].Typ of
//Button
iButton: Result := Button[Interactions[Int].Num].Visible and Button[Interactions[Int].Num].Selectable;
//Select Slide
iSelectS: Result := SelectsS[Interactions[Int].Num].Visible;
//ButtonCollection Child
iBCollectionChild:
Result := (ButtonCollection[Button[Interactions[Int].Num].Parent - 1].FirstChild - 1 = Int) and ((Interactions[Interaction].Typ <> iBCollectionChild) or (Button[Interactions[Interaction].Num].Parent <> Button[Interactions[Int].Num].Parent));
end;
end;
// implemented for the sake of usablility
// [curser down] picks the button left to the actual atm
// this behaviour doesn't make sense for two rows of buttons
procedure TMenu.InteractPrevRow;
var
Int: integer;
begin
// these two procedures just make sense for at least 5 buttons, because we
// usually start a second row when there are more than 4 buttons
Int := Interaction;
Int := Int - 4;//ceil(Length(Interactions) / 2);
//Set Interaction
if ((Int < 0) or (Int > Length(Interactions) - 1)) then
Int := Interaction // invalid button, keep current one
else
Interaction := Int; // select row above
end;
procedure TMenu.InteractNextRow;
var
Int: integer;
begin
Int := Interaction;
Int := Int + 4; //ceil(Length(Interactions) / 2);
//Set Interaction
if ((Int < 0) or (Int > Length(Interactions) - 1)) then
Int := Interaction // invalid button, keep current one
else
Interaction := Int; // select row above
end;
procedure TMenu.InteractNext;
var
Int: integer;
begin
Int := Interaction;
// change interaction as long as it's needed
repeat
Int := (Int + 1) mod Length(Interactions);
//If no Interaction is Selectable Simply Select Next
if (Int = Interaction) then
Break;
until IsSelectable(Int);
//Set Interaction
Interaction := Int;
end;
procedure TMenu.InteractPrev;
var
Int: integer;
begin
Int := Interaction;
// change interaction as long as it's needed
repeat
Int := Int - 1;
if Int = -1 then
Int := High(Interactions);
//If no Interaction is Selectable Simply Select Next
if (Int = Interaction) then
Break;
until IsSelectable(Int);
//Set Interaction
Interaction := Int
end;
procedure TMenu.InteractCustom(CustomSwitch: integer);
{ needed only for below
var
Num: integer;
Typ: integer;
Again: boolean;
}
begin
//Code Commented atm, because it needs to be Rewritten
//it doesn't work with Button Collections
{then
begin
CustomSwitch:= CustomSwitch*(-1);
Again := true;
// change interaction as long as it's needed
while (Again = true) do
begin
Num := SelInteraction - CustomSwitch;
if Num = -1 then
Num := High(Interactions);
Interaction := Num;
Again := false; // reset, default to accept changing interaction
// checking newly interacted element
Num := Interactions[Interaction].Num;
Typ := Interactions[Interaction].Typ;
case Typ of
iButton:
begin
if Button[Num].Selectable = false then
Again := true;
end;
end; // case
end; // while
end
else if num>0 then
begin
Again := true;
// change interaction as long as it's needed
while (Again = true) do
begin
Num := (Interaction + CustomSwitch) Mod Length(Interactions);
Interaction := Num;
Again := false; // reset, default to accept changing interaction
// checking newly interacted element
Num := Interactions[Interaction].Num;
Typ := Interactions[Interaction].Typ;
case Typ of
iButton:
begin
if Button[Num].Selectable = false then
Again := true;
end;
end; // case
end; // while
end }
end;
procedure TMenu.FadeTo(Screen: PMenu);
begin
Display.Fade := 0;
Display.NextScreen := Screen;
end;
procedure TMenu.FadeTo(Screen: PMenu; aSound: TAudioPlaybackStream);
begin
FadeTo( Screen );
AudioPlayback.PlaySound( aSound );
end;
procedure OnSaveEncodingError(Value: boolean; Data: Pointer);
begin
Display.CheckOK := Value;
if (Value) then
begin
//Hack to Finish Singscreen correct on Exit with Q Shortcut
if (Display.NextScreenWithCheck = nil) then
begin
if (Display.CurrentScreen = @ScreenSing) then
ScreenSing.Finish
{else if (Display.CurrentScreen = @ScreenSingModi) then
ScreenSingModi.Finish;}
end;
end
else
begin
Display.NextScreenWithCheck := nil;
end;
end;
//popup hack
procedure TMenu.CheckFadeTo(Screen: PMenu; Msg: UTF8String);
begin
Display.Fade := 0;
Display.NextScreenWithCheck := Screen;
Display.CheckOK := false;
ScreenPopupCheck.ShowPopup(msg, OnSaveEncodingError, nil, false);
end;
procedure TMenu.AddButtonText(AddX, AddY: real; const AddText: UTF8String);
begin
AddButtonText(AddX, AddY, 1, 1, 1, AddText);
end;
procedure TMenu.AddButtonText(AddX, AddY: real; ColR, ColG, ColB: real; const AddText: UTF8String);
var
Il: integer;
begin
with Button[High(Button)] do
begin
Il := Length(Text);
SetLength(Text, Il+1);
Text[Il] := TText.Create(X + AddX, Y + AddY, AddText);
Text[Il].ColR := ColR;
Text[Il].ColG := ColG;
Text[Il].ColB := ColB;
Text[Il].Int := 1;//0.5;
end;
end;
procedure TMenu.AddButtonText(AddX, AddY: real; ColR, ColG, ColB: real; Font: integer; Size: integer; Align: integer; const AddText: UTF8String);
var
Il: integer;
begin
with Button[High(Button)] do
begin
Il := Length(Text);
SetLength(Text, Il+1);
Text[Il] := TText.Create(X + AddX, Y + AddY, AddText);
Text[Il].ColR := ColR;
Text[Il].ColG := ColG;
Text[Il].ColB := ColB;
Text[Il].Int := 1;//0.5;
Text[Il].Style := Font;
Text[Il].Size := Size;
Text[Il].Align := Align;
end;
end;
procedure TMenu.AddButtonText(CustomButton: TButton; AddX, AddY: real; ColR, ColG, ColB: real; Font: integer; Size: integer; Align: integer; const AddText: UTF8String);
var
Il: integer;
begin
with CustomButton do
begin
Il := Length(Text);
SetLength(Text, Il+1);
Text[Il] := TText.Create(X + AddX, Y + AddY, AddText);
Text[Il].ColR := ColR;
Text[Il].ColG := ColG;
Text[Il].ColB := ColB;
Text[Il].Int := 1;//0.5;
Text[Il].Style := Font;
Text[Il].Size := Size;
Text[Il].Align := Align;
end;
end;
function TMenu.AddSelectSlide(ThemeSelectS: TThemeSelectSlide; var Data: integer; const Values: array of UTF8String): integer;
var
SO: integer;
begin
Result := AddSelectSlide(ThemeSelectS.X, ThemeSelectS.Y, ThemeSelectS.W, ThemeSelectS.H, ThemeSelectS.SkipX, ThemeSelectS.SBGW,
ThemeSelectS.ColR, ThemeSelectS.ColG, ThemeSelectS.ColB, ThemeSelectS.Int,
ThemeSelectS.DColR, ThemeSelectS.DColG, ThemeSelectS.DColB, ThemeSelectS.DInt,
ThemeSelectS.TColR, ThemeSelectS.TColG, ThemeSelectS.TColB, ThemeSelectS.TInt,
ThemeSelectS.TDColR, ThemeSelectS.TDColG, ThemeSelectS.TDColB, ThemeSelectS.TDInt,
ThemeSelectS.SBGColR, ThemeSelectS.SBGColG, ThemeSelectS.SBGColB, ThemeSelectS.SBGInt,
ThemeSelectS.SBGDColR, ThemeSelectS.SBGDColG, ThemeSelectS.SBGDColB, ThemeSelectS.SBGDInt,
ThemeSelectS.STColR, ThemeSelectS.STColG, ThemeSelectS.STColB, ThemeSelectS.STInt,
ThemeSelectS.STDColR, ThemeSelectS.STDColG, ThemeSelectS.STDColB, ThemeSelectS.STDInt,
Skin.GetTextureFileName(ThemeSelectS.Tex), ThemeSelectS.Typ,
Skin.GetTextureFileName(ThemeSelectS.TexSBG), ThemeSelectS.TypSBG,
ThemeSelectS.Text, Data);
for SO := 0 to High(Values) do
AddSelectSlideOption(Values[SO]);
SelectsS[High(SelectsS)].Text.Size := ThemeSelectS.TextSize;
SelectsS[High(SelectsS)].Text.Y := ThemeSelectS.Y + (ThemeSelectS.H /2 ) - (ThemeSelectS.TextSize / 2);
SelectsS[High(SelectsS)].Texture.Z := ThemeSelectS.Z;
SelectsS[High(SelectsS)].TextureSBG.Z := ThemeSelectS.Z;
SelectsS[High(SelectsS)].Tex_SelectS_ArrowL.Z := ThemeSelectS.Z;
SelectsS[High(SelectsS)].Tex_SelectS_ArrowR.Z := ThemeSelectS.Z;
SelectsS[High(SelectsS)].showArrows := ThemeSelectS.showArrows;
SelectsS[High(SelectsS)].oneItemOnly := ThemeSelectS.oneItemOnly;
//Generate Lines
SelectsS[High(SelectsS)].GenLines;
SelectsS[High(SelectsS)].SelectedOption := SelectsS[High(SelectsS)].SelectOptInt; // refresh
end;
function TMenu.AddSelectSlide(X, Y, W, H, SkipX, SBGW, ColR, ColG, ColB, Int, DColR, DColG, DColB, DInt,
TColR, TColG, TColB, TInt, TDColR, TDColG, TDColB, TDInt,
SBGColR, SBGColG, SBGColB, SBGInt, SBGDColR, SBGDColG, SBGDColB, SBGDInt,
STColR, STColG, STColB, STInt, STDColR, STDColG, STDColB, STDInt: real;
const TexName: IPath; Typ: TTextureType; const SBGName: IPath; SBGTyp: TTextureType;
const Caption: UTF8String; var Data: integer): integer;
var
S: integer;
begin
S := Length(SelectsS);
SetLength(SelectsS, S + 1);
SelectsS[S] := TSelectSlide.Create;
if (Typ = TEXTURE_TYPE_COLORIZED) then
begin
SelectsS[S].Colorized := true;
SelectsS[S].Texture := Texture.GetTexture(TexName, Typ, RGBFloatToInt(ColR, ColG, ColB));
SelectsS[S].DeselectTexture := Texture.GetTexture(TexName, Typ, RGBFloatToInt(DColR, DColG, DColB));
end
else
begin
SelectsS[S].Colorized := false;
SelectsS[S].Texture := Texture.GetTexture(TexName, Typ);
SelectsS[S].ColR := ColR;
SelectsS[S].ColG := ColG;
SelectsS[S].ColB := ColB;
SelectsS[S].DColR := DColR;
SelectsS[S].DColG := DColG;
SelectsS[S].DColB := DColB;
end;
SelectsS[S].Int := Int;
SelectsS[S].DInt := DInt;
SelectsS[S].X := X;
SelectsS[S].Y := Y;
SelectsS[S].W := W;
SelectsS[S].H := H;
if (SBGTyp = TEXTURE_TYPE_COLORIZED) then
begin
SelectsS[S].ColorizedSBG := true;
SelectsS[S].TextureSBG := Texture.GetTexture(SBGName, SBGTyp, RGBFloatToInt(SBGColR, SBGColG, SBGColB));
SelectsS[S].DeselectTextureSBG := Texture.GetTexture(SBGName, SBGTyp, RGBFloatToInt(SBGDColR, SBGDColG, SBGDColB));
end
else
begin
SelectsS[S].ColorizedSBG := false;
SelectsS[S].TextureSBG := Texture.GetTexture(SBGName, SBGTyp);
SelectsS[S].SBGColR := SBGColR;
SelectsS[S].SBGColG := SBGColG;
SelectsS[S].SBGColB := SBGColB;
SelectsS[S].SBGDColR := SBGDColR;
SelectsS[S].SBGDColG := SBGDColG;
SelectsS[S].SBGDColB := SBGDColB;
end;
SelectsS[S].SBGInt := SBGInt;
SelectsS[S].SBGDInt := SBGDInt;
SelectsS[High(SelectsS)].Tex_SelectS_ArrowL := Tex_SelectS_ArrowL;
SelectsS[High(SelectsS)].Tex_SelectS_ArrowL.X := X + W + SkipX;
SelectsS[High(SelectsS)].Tex_SelectS_ArrowL.Y := Y + (H - Tex_SelectS_ArrowL.H) / 2;
SelectsS[High(SelectsS)].Tex_SelectS_ArrowL.W := Tex_SelectS_ArrowL.W;
SelectsS[High(SelectsS)].Tex_SelectS_ArrowL.H := Tex_SelectS_ArrowL.H;
SelectsS[High(SelectsS)].Tex_SelectS_ArrowR := Tex_SelectS_ArrowR;
SelectsS[High(SelectsS)].Tex_SelectS_ArrowR.X := X + W + SkipX + SBGW - Tex_SelectS_ArrowR.W;
SelectsS[High(SelectsS)].Tex_SelectS_ArrowR.Y := Y + (H - Tex_SelectS_ArrowR.H) / 2;
SelectsS[High(SelectsS)].Tex_SelectS_ArrowR.W := Tex_SelectS_ArrowR.W;
SelectsS[High(SelectsS)].Tex_SelectS_ArrowR.H := Tex_SelectS_ArrowR.H;
SelectsS[S].TextureSBG.X := X + W + SkipX;
SelectsS[S].TextureSBG.Y := Y;
SelectsS[S].SBGW := SBGW;
SelectsS[S].TextureSBG.H := H;
SelectsS[S].Text.X := X + 20;
SelectsS[S].Text.Y := Y + (SelectsS[S].TextureSBG.H / 2) - 15;
SelectsS[S].Text.Text := Caption;
SelectsS[S].Text.Size := 30;
SelectsS[S].Text.Visible := true;
SelectsS[S].TColR := TColR;
SelectsS[S].TColG := TColG;
SelectsS[S].TColB := TColB;
SelectsS[S].TInt := TInt;
SelectsS[S].TDColR := TDColR;
SelectsS[S].TDColG := TDColG;
SelectsS[S].TDColB := TDColB;
SelectsS[S].TDInt := TDInt;
SelectsS[S].STColR := STColR;
SelectsS[S].STColG := STColG;
SelectsS[S].STColB := STColB;
SelectsS[S].STInt := STInt;
SelectsS[S].STDColR := STDColR;
SelectsS[S].STDColG := STDColG;
SelectsS[S].STDColB := STDColB;
SelectsS[S].STDInt := STDInt;
// new
SelectsS[S].Texture.TexX1 := 0;
SelectsS[S].Texture.TexY1 := 0;
SelectsS[S].Texture.TexX2 := 1;
SelectsS[S].Texture.TexY2 := 1;
SelectsS[S].TextureSBG.TexX1 := 0;
SelectsS[S].TextureSBG.TexY1 := 0;
SelectsS[S].TextureSBG.TexX2 := 1;
SelectsS[S].TextureSBG.TexY2 := 1;
// Sets Data to copy the value of selectops to global value;
SelectsS[S].PData := @Data;
// Configures Select options
{//SelectsS[S].TextOpt[0].Text := IntToStr(I+1);
SelectsS[S].TextOpt[0].Size := 30;
SelectsS[S].TextOpt[0].Align := 1;
SelectsS[S].TextOpt[0].ColR := SelectsS[S].STDColR;
SelectsS[S].TextOpt[0].ColG := SelectsS[S].STDColG;
SelectsS[S].TextOpt[0].ColB := SelectsS[S].STDColB;
SelectsS[S].TextOpt[0].Int := SelectsS[S].STDInt;
SelectsS[S].TextOpt[0].Visible := true; }
// Sets default value of selectopt from Data;
SelectsS[S].SelectedOption := Data;
// Disables default selection
SelectsS[S].SetSelect(false);
{// Configures 3 select options
for I := 0 to 2 do
begin
SelectsS[S].TextOpt[I].X := SelectsS[S].TextureSBG.X + 20 + (50 + 20) + (150 - 20) * I;
SelectsS[S].TextOpt[I].Y := SelectsS[S].TextureSBG.Y + 20;
SelectsS[S].TextOpt[I].Text := IntToStr(I+1);
SelectsS[S].TextOpt[I].Size := 30;
SelectsS[S].TextOpt[I].Align := 1;
SelectsS[S].TextOpt[I].ColR := SelectsS[S].STDColR;
SelectsS[S].TextOpt[I].ColG := SelectsS[S].STDColG;
SelectsS[S].TextOpt[I].ColB := SelectsS[S].STDColB;
SelectsS[S].TextOpt[I].Int := SelectsS[S].STDInt;
SelectsS[S].TextOpt[I].Visible := true;
end;}
// adds interaction
AddInteraction(iSelectS, S);
Result := S;
end;
procedure TMenu.AddSelectSlideOption(const AddText: UTF8String);
begin
AddSelectSlideOption(High(SelectsS), AddText);
end;
procedure TMenu.AddSelectSlideOption(SelectNo: cardinal; const AddText: UTF8String);
var
SO: integer;
begin
SO := Length(SelectsS[SelectNo].TextOptT);
SetLength(SelectsS[SelectNo].TextOptT, SO + 1);
SelectsS[SelectNo].TextOptT[SO] := AddText;
{
SelectsS[S].SelectedOption := SelectsS[S].SelectOptInt; // refresh
if SO = Selects[S].PData^ then
Selects[S].SelectedOption := SO;
}
end;
procedure TMenu.UpdateSelectSlideOptions(ThemeSelectSlide: TThemeSelectSlide;
SelectNum: integer; const Values: array of UTF8String; var Data: integer);
var
SO: integer;
begin
SetLength(SelectsS[SelectNum].TextOptT, 0);
for SO := 0 to High(Values) do
AddSelectSlideOption(SelectNum, Values[SO]);
SelectsS[SelectNum].GenLines;
// SelectsS[SelectNum].SelectedOption := SelectsS[SelectNum].SelectOptInt; // refresh
// SelectS[SelectNum].SetSelectOpt(Data);
// SelectS[SelectNum].SelectedOption := 0;//Data;
// Log.LogError(IntToStr(High(SelectsS[SelectNum].TextOptT)));
// if 0 <= High(SelectsS[SelectNum].TextOptT) then
SelectsS[SelectNum].PData := @Data;
SelectsS[SelectNum].SelectedOption := Data;
end;
procedure TMenu.InteractInc;
var
Num: integer;
Value: integer;
begin
case Interactions[Interaction].Typ of
iSelectS: begin
Num := Interactions[Interaction].Num;
Value := SelectsS[Num].SelectedOption;
// Value := (Value + 1) Mod (Length(SelectsS[Num].TextOptT));
// limit
Value := Value + 1;
if Value <= High(SelectsS[Num].TextOptT) then
SelectsS[Num].SelectedOption := Value;
end;
//Button Collection Mod
iBCollectionChild:
begin
//Select Next Button in Collection
for Num := 1 to High(Button) do
begin
Value := (Interaction + Num) Mod Length(Button);
if Value = 0 then
begin
InteractNext;
Break;
end;
if (Button[Value].Parent = Button[Interaction].Parent) then
begin
Interaction := Value;
Break;
end;
end;
end;
//interact Next if there is Nothing to Change
else InteractNext;
end;
end;
procedure TMenu.InteractDec;
var
Num: integer;
Value: integer;
begin
case Interactions[Interaction].Typ of
iSelectS: begin
Num := Interactions[Interaction].Num;
Value := SelectsS[Num].SelectedOption;
Value := Value - 1;
// if Value = -1 then
// Value := High(SelectsS[Num].TextOptT);
if Value >= 0 then
SelectsS[Num].SelectedOption := Value;
end;
//Button Collection Mod
iBCollectionChild:
begin
//Select Prev Button in Collection
for Num := High(Button) downto 1 do
begin
Value := (Interaction + Num) Mod Length(Button);
if Value = High(Button) then
begin
InteractPrev;
Break;
end;
if (Button[Value].Parent = Button[Interaction].Parent) then
begin
Interaction := Value;
Break;
end;
end;
end;
// interact prev if there is nothing to change
else
begin
InteractPrev;
// if buttoncollection with more than 1 entry then select last entry
if (Button[Interactions[Interaction].Num].Parent <> 0) and (ButtonCollection[Button[Interactions[Interaction].Num].Parent-1].CountChilds > 1) then
begin
//Select Last Child
for Num := High(Button) downto 1 do
begin
Value := (Interaction + Num) Mod Length(Button);
if (Button[Value].Parent = Button[Interaction].Parent) then
begin
Interaction := Value;
Break;
end;
end;
end;
end;
end;
end;
procedure TMenu.AddBox(X, Y, W, H: real);
begin
AddStatic(X, Y, W, H, 0, 0, 0, Skin.GetTextureFileName('MainBar'), TEXTURE_TYPE_COLORIZED);
AddStatic(X+2, Y+2, W-4, H-4, 1, 1, 1, Skin.GetTextureFileName('MainBar'), TEXTURE_TYPE_COLORIZED);
end;
procedure TMenu.OnShow;
begin
// FIXME: this needs some work. First, there should be a variable like
// VideoBackground so we can check whether a video-background is enabled or not.
// Second, a video should be stopped if the screen is hidden, but the Video.Stop()
// method is not implemented by now. This is necessary for theme-switching too.
// At the moment videos cannot be turned off without restarting USDX.
{// check if a background texture was found
if (BackImg.TexNum = 0) then
begin
// try to open an animated background
// Note: newer versions of ffmpeg are able to open images like jpeg
// so do not pass an image's filename to VideoPlayback.Open()
if fileexists( fFileName ) then
begin
if VideoPlayback.Open( fFileName ) then
begin
VideoBGTimer.SetTime(0);
VideoPlayback.Play;
end;
end;
end; }
if (Background = nil) then
AddBackground(DEFAULT_BACKGROUND);
Background.OnShow;
end;
procedure TMenu.OnShowFinish;
begin
// nothing
end;
procedure TMenu.OnHide;
begin
// nothing
Background.OnFinish;
end;
function TMenu.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean;
begin
// nothing
Result := true;
end;
function TMenu.ParseMouse(MouseButton: integer; BtnDown: boolean; X, Y: integer): boolean;
var
nBut: integer;
Action: TMouseClickAction;
begin
//default mouse parsing: clicking generates return keypress,
// mousewheel selects in select slide
//override ParseMouse to customize
Result := true;
if RightMbESC and (MouseButton = SDL_BUTTON_RIGHT) and BtnDown then
begin
//if RightMbESC is set, send ESC keypress
Result:=ParseInput(SDLK_ESCAPE, 0, true);
end;
// transfer mousecords to the 800x600 raster we use to draw
X := Round((X / (ScreenW / Screens)) * RenderW);
if (X > RenderW) then
X := X - RenderW;
Y := Round((Y / ScreenH) * RenderH);
// allways go to next screen if we don't have any interactions
if Length(Interactions) = 0 then
begin
if (BtnDown) and (MouseButton = SDL_BUTTON_LEFT) then
Result := ParseInput(SDLK_RETURN, 0, true);
end
else
begin
nBut := InteractAt(X, Y);
if nBut >= 0 then
begin
//select on mouse-over
if nBut <> Interaction then
SetInteraction(nBut);
Action := maNone;
if (BtnDown) then
begin
if (MouseButton = SDL_BUTTON_LEFT) then
begin
//click button or SelectS
if (Interactions[nBut].Typ = iSelectS) then
Action := SelectsS[Interactions[nBut].Num].OnClick(X, Y)
else
Action := maReturn;
end
else if (MouseButton = SDL_BUTTON_WHEELDOWN) then
begin //forward on select slide with mousewheel
if (Interactions[nBut].Typ = iSelectS) then
Action := maRight;
end
else if (MouseButton = SDL_BUTTON_WHEELUP) then
begin //backward on select slide with mousewheel
if (Interactions[nBut].Typ = iSelectS) then
Action := maLeft;
end;
end;
// do the action we have to do ;)
case Action of
maReturn: Result := ParseInput(SDLK_RETURN, 0, true);
maLeft: Result := ParseInput(SDLK_LEFT, 0, true);
maRight: Result := ParseInput(SDLK_RIGHT, 0, true);
end;
end
else
begin
nBut := CollectionAt(X, Y);
if (nBut >= 0) and (not ButtonCollection[nBut].Selected) then
begin
// if over button collection, that is not already selected
// -> select first child but don't allow click
nBut := ButtonCollection[nBut].FirstChild - 1;
if nBut <> Interaction then
SetInteraction(nBut);
end;
end;
end;
end;
function TMenu.InRegion(X, Y: real; A: TMouseOverRect): boolean;
begin
// check whether A contains X and Y
Result := (X >= A.X) and (X <= A.X + A.W) and (Y >= A.Y) and (Y <= A.Y + A.H);
end;
function TMenu.InRegionX(X: real; A: TMouseOverRect): boolean;
begin
// check whether A contains X
Result := (X >= A.X) and (X <= A.X + A.W);
end;
function TMenu.InRegionY(Y: real; A: TMouseOverRect): boolean;
begin
// check whether A contains Y
Result := (Y >= A.Y) and (Y <= A.Y + A.H);
end;
//takes x,y coordinates and returns the interaction number
//of the control at this position
function TMenu.InteractAt(X, Y: real): integer;
var
i: integer;
begin
Result := -1;
for i := Low(Interactions) to High(Interactions) do
begin
case Interactions[i].Typ of
iButton:
if InRegion(X, Y, Button[Interactions[i].Num].GetMouseOverArea) and
Button[Interactions[i].Num].Visible and Button[Interactions[i].Num].Selectable then
begin
Result:=i;
exit;
end;
iBCollectionChild:
if InRegion(X, Y, Button[Interactions[i].Num].GetMouseOverArea) then
begin
Result:=i;
exit;
end;
iSelectS:
if InRegion(X, Y, SelectSs[Interactions[i].Num].GetMouseOverArea) then
begin
Result:=i;
exit;
end;
end;
end;
end;
//takes x,y coordinates and returns the button collection id
function TMenu.CollectionAt(X, Y: real): integer;
var
i: integer;
begin
Result := -1;
for i:= Low(ButtonCollection) to High(ButtonCollection) do
begin
if InRegion(X, Y, ButtonCollection[i].GetMouseOverArea) and
ButtonCollection[i].Visible then
begin
Result:=i;
exit;
end;
end;
end;
procedure TMenu.SetAnimationProgress(Progress: real);
begin
// nothing
end;
end.