diff options
Diffstat (limited to 'unicode/src/menu/UMenu.pas')
| -rw-r--r-- | unicode/src/menu/UMenu.pas | 373 |
1 files changed, 93 insertions, 280 deletions
diff --git a/unicode/src/menu/UMenu.pas b/unicode/src/menu/UMenu.pas index 444bac62..6d9fba96 100644 --- a/unicode/src/menu/UMenu.pas +++ b/unicode/src/menu/UMenu.pas @@ -34,20 +34,19 @@ interface {$I switches.inc} uses - SysUtils, - Math, gl, - SDL, - UMenuBackground, - UMenuButton, - UMenuButtonCollection, - UMenuInteract, - UMenuSelectSlide, + SysUtils, + UTexture, UMenuStatic, UMenuText, - UMusic, - UTexture, - UThemes; + UMenuButton, + UMenuSelectSlide, + UMenuInteract, + UMenuBackground, + UThemes, + UMenuButtonCollection, + Math, + UMusic; type { Int16 = SmallInt;} @@ -55,15 +54,15 @@ type PMenu = ^TMenu; TMenu = class protected - Background: TMenuBackground; - - Interactions: array of TInteract; - SelInteraction: integer; + Background: TMenuBackground; - ButtonPos: integer; - Button: array of TButton; + Interactions: array of TInteract; + SelInteraction: integer; - SelectsS: array of TSelectSlide; + ButtonPos: integer; + Button: array of TButton; + + SelectsS: array of TSelectSlide; ButtonCollection: array of TButtonCollection; public Text: array of TText; @@ -73,7 +72,6 @@ type 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; @@ -82,10 +80,10 @@ type // interaction procedure AddInteraction(Typ, Num: integer); - procedure SetInteraction(Num: integer); virtual; + procedure SetInteraction(Num: integer); property Interaction: integer read SelInteraction write SetInteraction; - // procedure load bg, texts, statics and button collections from themebasic + //Procedure Load BG, Texts, Statics and Button Collections from ThemeBasic procedure LoadFromTheme(const ThemeBasic: TThemeBasic); procedure PrepareButtonCollections(const Collections: AThemeButtonCollection); @@ -111,7 +109,7 @@ type function AddText(X, Y, W: real; Style: integer; Size, ColR, ColG, ColB: real; Align: integer; const Text_: UTF8String; Reflection_: boolean; ReflectionSpacing_: real; Z : real): 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 + 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 Name: string): integer; overload; function AddButton(X, Y, W, H: real; const Name: string; Typ: TTextureType; Reflection: boolean): integer; overload; @@ -145,10 +143,9 @@ type 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(X1, Y1, W, H, X, Y: real): boolean; - function InteractAt(X, Y: real): integer; - function CollectionAt(X, Y: real): integer; + // FIXME: ParseMouse is not implemented in any subclass and not even used anywhere in the code + // -> do this before activation of this method + //function ParseMouse(Typ: integer; X: integer; Y: integer): boolean; virtual; abstract; procedure onShow; virtual; procedure onShowFinish; virtual; procedure onHide; virtual; @@ -168,16 +165,13 @@ type end; const - MENU_MDOWN = 8; - MENU_MUP = 0; - - pmMove = 1; - pmClick = 2; + pmMove = 1; + pmClick = 2; pmUnClick = 3; - iButton = 0; // interaction type - iText = 2; - iSelectS = 3; + iButton = 0; // interaction type + iText = 2; + iSelectS = 3; iBCollectionChild = 5; // fBlack = 0; // fade type @@ -185,22 +179,21 @@ const implementation -uses - UCommon, - UCovers, - UDisplay, - UDrawTexture, - UGraphic, - ULog, - UMain, - USkins, - UTime, - //Background types - UMenuBackgroundNone, - UMenuBackgroundColor, - UMenuBackgroundTexture, - UMenuBackgroundVideo, - UMenuBackgroundFade; +uses UCommon, + ULog, + UMain, + UDrawTexture, + UGraphic, + UDisplay, + UCovers, + UTime, + USkins, + //Background types + UMenuBackgroundNone, + UMenuBackgroundColor, + UMenuBackgroundTexture, + UMenuBackgroundVideo, + UMenuBackgroundFade; destructor TMenu.Destroy; begin @@ -225,8 +218,6 @@ begin ButtonPos := -1; Background := nil; - - RightMbESC := true; end; { constructor TMenu.Create(Back: string); @@ -258,7 +249,7 @@ begin BackH := H; end; } -function RGBFloatToInt(R, G, B: double): cardinal; +function RGBFloatToInt(R, G, B: Double): cardinal; begin Result := (Trunc(255 * R) shl 16) or (Trunc(255 * G) shl 8) or @@ -297,8 +288,8 @@ begin 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 + //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; @@ -346,9 +337,8 @@ procedure TMenu.AddBackground(ThemedSettings: TThemeBackground); var FileExt: string; - function IsInArray(const Piece: string; const A: array of string): boolean; - var - I: integer; + Function IsInArray(const Piece: string; const A: array of string): boolean; + var I: integer; begin Result := false; @@ -360,7 +350,7 @@ procedure TMenu.AddBackground(ThemedSettings: TThemeBackground); end; end; - function TryBGCreate(Typ: cMenuBackground): boolean; + Function TryBGCreate(Typ: cMenuBackground): boolean; begin Result := true; @@ -382,7 +372,7 @@ begin Background := nil; end; - case ThemedSettings.BGType of + Case ThemedSettings.BGType of bgtAuto: begin //Automaticly choose one out of BGT_Texture, BGT_Video or BGT_Color if (Length(ThemedSettings.Tex) > 0) then @@ -499,7 +489,7 @@ end; //---------------------- procedure TMenu.AddButtonCollection(const ThemeCollection: TThemeButtonCollection; const Num: byte); var - BT, BTLen: integer; + BT, BTLen: integer; TempCol, TempDCol: cardinal; begin @@ -602,25 +592,17 @@ begin Result := AddStatic(X, Y, W, H, Name, TEXTURE_TYPE_PLAIN); end; -function TMenu.AddStatic(X, Y, W, H: real; - ColR, ColG, ColB: real; - const Name: string; - Typ: TTextureType): integer; +function TMenu.AddStatic(X, Y, W, H: real; ColR, ColG, ColB: real; const Name: string; Typ: TTextureType): integer; begin Result := AddStatic(X, Y, W, H, ColR, ColG, ColB, Name, Typ, $FFFFFF); end; -function TMenu.AddStatic(X, Y, W, H, Z: real; - ColR, ColG, ColB: real; - const Name: string; - Typ: TTextureType): integer; +function TMenu.AddStatic(X, Y, W, H, Z: real; ColR, ColG, ColB: real; const Name: string; Typ: TTextureType): integer; begin Result := AddStatic(X, Y, W, H, Z, ColR, ColG, ColB, Name, Typ, $FFFFFF); end; -function TMenu.AddStatic(X, Y, W, H: real; - const Name: string; - Typ: TTextureType): integer; +function TMenu.AddStatic(X, Y, W, H: real; const Name: string; Typ: TTextureType): integer; var StatNum: integer; begin @@ -638,32 +620,17 @@ begin Result := StatNum; end; -function TMenu.AddStatic(X, Y, W, H: real; - ColR, ColG, ColB: real; - const Name: string; - Typ: TTextureType; - Color: integer): integer; +function TMenu.AddStatic(X, Y, W, H: real; ColR, ColG, ColB: real; const Name: string; Typ: TTextureType; Color: integer): integer; begin Result := AddStatic(X, Y, W, H, 0, ColR, ColG, ColB, Name, Typ, Color); end; -function TMenu.AddStatic(X, Y, W, H, Z: real; - ColR, ColG, ColB: real; - const Name: string; - Typ: TTextureType; - Color: integer): integer; +function TMenu.AddStatic(X, Y, W, H, Z: real; ColR, ColG, ColB: real; const Name: string; Typ: TTextureType; Color: integer): integer; begin Result := AddStatic(X, Y, W, H, Z, ColR, ColG, ColB, 0, 0, 1, 1, Name, Typ, Color, false, 0); end; -function TMenu.AddStatic(X, Y, W, H, Z: real; - ColR, ColG, ColB: real; - TexX1, TexY1, TexX2, TexY2: real; - const Name: string; - Typ: TTextureType; - Color: integer; - Reflection: boolean; - ReflectionSpacing: real): integer; +function TMenu.AddStatic(X, Y, W, H, Z: real; ColR, ColG, ColB: real; TexX1, TexY1, TexX2, TexY2: real; const Name: string; Typ: TTextureType; Color: integer; Reflection: boolean; ReflectionSpacing: real): integer; var StatNum: integer; begin @@ -681,22 +648,12 @@ begin begin Static[StatNum] := TStatic.Create(Texture.GetTexture(Name, Typ, Color)); // new skin end; - + // configures static Static[StatNum].Texture.X := X; Static[StatNum].Texture.Y := Y; - - //Set height and width via sprite size if omitted - if(H = 0) then - Static[StatNum].Texture.H := Static[StatNum].Texture.H - else - Static[StatNum].Texture.H := H; - - if(W = 0) then - Static[StatNum].Texture.W := Static[StatNum].Texture.W - else - Static[StatNum].Texture.W := W; - + Static[StatNum].Texture.W := W; + Static[StatNum].Texture.H := H; Static[StatNum].Texture.Z := Z; if (Typ <> TEXTURE_TYPE_COLORIZED) then begin @@ -735,22 +692,12 @@ begin Result := TextNum; end; -function TMenu.AddText(X, Y: real; - Style: integer; - Size, ColR, ColG, ColB: real - ; const Text: UTF8String): integer; +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); 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): integer; +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): integer; var TextNum: integer; begin @@ -762,9 +709,9 @@ begin end; //Function that Set Length of Button boolean in one Step instead of register new Memory for every Button -procedure TMenu.SetButtonLength(Length: cardinal); +Procedure TMenu.SetButtonLength(Length: cardinal); begin - if (ButtonPos = -1) and (Length > 0) then + if (ButtonPos = -1) AND (Length > 0) then begin //Set Length of Button SetLength(Button, Length); @@ -820,10 +767,10 @@ begin ThemeButton.Text[BT].Text); end; - // bautton collection mod + //BAutton Collection Mod if (ThemeButton.Parent <> 0) then begin - // if collection exists then change interaction to child button + //If Collection Exists then Change Interaction to Child Button if (@ButtonCollection[ThemeButton.Parent-1] <> nil) then begin Interactions[High(Interactions)].Typ := iBCollectionChild; @@ -852,10 +799,8 @@ begin end; function TMenu.AddButton(X, Y, W, H, ColR, ColG, ColB, Int, DColR, DColG, DColB, DInt: real; - const Name: string; - Typ: TTextureType; - Reflection: boolean; - ReflectionSpacing, DeSelectReflectionSpacing: real): integer; + const Name: string; Typ: TTextureType; + Reflection: boolean; ReflectionSpacing, DeSelectReflectionSpacing: real): integer; begin // adds button //SetLength is used once to reduce Memory usement @@ -908,7 +853,7 @@ begin Button[Result].Reflectionspacing := ReflectionSpacing; Button[Result].DeSelectReflectionspacing := DeSelectReflectionSpacing; - // button collection mod + //Button Collection Mod Button[Result].Parent := 0; // adds interaction @@ -921,10 +866,11 @@ begin Setlength(Button, 0); end; -// method to draw our tmenu and all his child buttons +// Method to draw our TMenu and all his child buttons function TMenu.DrawBG: boolean; begin Background.Draw; + Result := true; end; @@ -972,9 +918,9 @@ end; } { -function TMenu.AddWidget(X, Y: UInt16; WidgetSrc: PSDL_Surface): Int16; +function TMenu.AddWidget(X, Y : UInt16; WidgetSrc : PSDL_Surface): Int16; var - WidgetNum: Int16; + WidgetNum : Int16; begin if (Assigned(WidgetSrc)) then begin @@ -998,9 +944,9 @@ end; } { -procedure TMenu.ClearWidgets(MinNumber: Int16); +procedure TMenu.ClearWidgets(MinNumber : Int16); var - J: Int16; + J : Int16; begin for J := MinNumber to (Length(WidgetsSrc) - 1) do begin @@ -1043,10 +989,9 @@ begin Int := Int - 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 + if ((Int < 0) or (Int > Length(Interactions) - 1)) + then Int := Interaction //nonvalid button, keep current one + else Interaction := Int; //select row above end; procedure TMenu.InteractNextRow; @@ -1058,10 +1003,9 @@ begin Int := Int + 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 + if ((Int < 0) or (Int > Length(Interactions) - 1)) + then Int := Interaction //nonvalid button, keep current one + else Interaction := Int; //select row above end; procedure TMenu.InteractNext; @@ -1075,8 +1019,7 @@ begin Int := (Int + 1) mod Length(Interactions); //If no Interaction is Selectable Simply Select Next - if (Int = Interaction) then - Break; + if (Int = Interaction) then Break; until IsSelectable(Int); @@ -1093,12 +1036,10 @@ begin // change interaction as long as it's needed repeat Int := Int - 1; - if Int = -1 then - Int := High(Interactions); + if Int = -1 then Int := High(Interactions); //If no Interaction is Selectable Simply Select Next - if (Int = Interaction) then - Break; + if (Int = Interaction) then Break; until IsSelectable(Int); //Set Interaction @@ -1123,8 +1064,7 @@ begin while (Again = true) do begin Num := SelInteraction - CustomSwitch; - if Num = -1 then - Num := High(Interactions); + if Num = -1 then Num := High(Interactions); Interaction := Num; Again := false; // reset, default to accept changing interaction @@ -1268,9 +1208,6 @@ begin SelectsS[High(SelectsS)].Texture.Z := ThemeSelectS.Z; SelectsS[High(SelectsS)].TextureSBG.Z := ThemeSelectS.Z; - SelectsS[High(SelectsS)].showArrows := ThemeSelectS.showArrows; - SelectsS[High(SelectsS)].oneItemOnly := ThemeSelectS.oneItemOnly; - //Generate Lines SelectsS[High(SelectsS)].GenLines; @@ -1313,21 +1250,9 @@ begin SelectsS[S].TextureSBG := Texture.GetTexture(SBGName, SBGTyp, RGBFloatToInt(SBGColR, SBGColG, SBGColB)) else SelectsS[S].TextureSBG := Texture.GetTexture(SBGName, SBGTyp); - - 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; - 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; - 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].TextureSBG.W := 450; SelectsS[S].SBGW := SBGW; SelectsS[S].TextureSBG.H := H; SelectsS[S].SBGColR := SBGColR; @@ -1425,12 +1350,10 @@ begin 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; -} + //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 string; var Data: integer); @@ -1530,12 +1453,12 @@ begin end; end; end; - // interact prev if there is nothing to change + //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 + //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 @@ -1604,120 +1527,10 @@ begin Result := true; end; -function TMenu.ParseMouse(MouseButton: integer; BtnDown: boolean; X, Y: integer): boolean; -var - nBut: integer; -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; - - nBut := InteractAt(X, Y); - if nBut >= 0 then - begin - //select on mouse-over - if nBut <> Interaction then - SetInteraction(nBut); - if (MouseButton = SDL_BUTTON_LEFT) and BtnDown then - begin - //click button - Result:=ParseInput(SDLK_RETURN, 0, true); - end; - if (Interactions[nBut].Typ = iSelectS) then - begin - //forward/backward in select slide with mousewheel - if (MouseButton = SDL_BUTTON_WHEELDOWN) and BtnDown then - begin - ParseInput(SDLK_RIGHT, 0, true); - end; - if (MouseButton = SDL_BUTTON_WHEELUP) and BtnDown then - begin - ParseInput(SDLK_LEFT, 0, true); - end; - end; - end - else - begin - nBut := CollectionAt(X, Y); - if nBut >= 0 then - begin - // if over button collection, select first child but don't allow click - nBut := ButtonCollection[nBut].FirstChild - 1; - if nBut <> Interaction then - SetInteraction(nBut); - end; - end; -end; - -function TMenu.InRegion(X1, Y1, W, H, X, Y: real): boolean; -begin - Result := false; - X1 := X1 * Screen.w / 800; - W := W * Screen.w / 800; - Y1 := Y1 * Screen.h / 600; - H := H * Screen.h / 600; - if (X >= X1) and (X <= X1 + W) and (Y >= Y1) and (Y <= Y1 + H) then - Result := true; -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, nBut: integer; -begin - Result := -1; - for i := Low(Interactions) to High(Interactions) do - begin - case Interactions[i].Typ of - iButton: if InRegion(Button[Interactions[i].Num].X, Button[Interactions[i].Num].Y, Button[Interactions[i].Num].W, Button[Interactions[i].Num].H, X, Y) and - Button[Interactions[i].Num].Visible then - begin - Result:=i; - exit; - end; - iBCollectionChild: if InRegion(Button[Interactions[i].Num].X, Button[Interactions[i].Num].Y, Button[Interactions[i].Num].W, Button[Interactions[i].Num].H, X, Y) then - begin - Result:=i; - exit; - end; - iSelectS: if InRegion(SelectSs[Interactions[i].Num].X, SelectSs[Interactions[i].Num].Y, SelectSs[Interactions[i].Num].W, SelectSs[Interactions[i].Num].H, X, Y) or - InRegion(SelectSs[Interactions[i].Num].TextureSBG.X, SelectSs[Interactions[i].Num].TextureSBG.Y, SelectSs[Interactions[i].Num].TextureSBG.W, SelectSs[Interactions[i].Num].TextureSBG.H, X, Y) 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, nBut: integer; -begin - Result := -1; - for i:= Low(ButtonCollection) to High(ButtonCollection) do - begin - if InRegion(ButtonCollection[i].X, ButtonCollection[i].Y, ButtonCollection[i].W, ButtonCollection[i].H, X, Y) and - ButtonCollection[i].Visible then - begin - Result:=i; - exit; - end; - end; -end; - procedure TMenu.SetAnimationProgress(Progress: real); begin // nothing end; end. + |