aboutsummaryrefslogtreecommitdiffstats
path: root/Game/Code/Menu
diff options
context:
space:
mode:
Diffstat (limited to 'Game/Code/Menu')
-rw-r--r--Game/Code/Menu/UDisplay.pas929
-rw-r--r--Game/Code/Menu/UMenuButton.pas1137
-rw-r--r--Game/Code/Menu/UMenuText.pas668
3 files changed, 1380 insertions, 1354 deletions
diff --git a/Game/Code/Menu/UDisplay.pas b/Game/Code/Menu/UDisplay.pas
index ed65d62d..6181fab1 100644
--- a/Game/Code/Menu/UDisplay.pas
+++ b/Game/Code/Menu/UDisplay.pas
@@ -1,460 +1,469 @@
-unit UDisplay;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-uses Windows,
- SDL,
- UMenu,
- OpenGL12,
- SysUtils;
-
-type
- TDisplay = class
- ActualScreen: PMenu;
- NextScreen: PMenu;
-
- //fade-to-black-hack
- BlackScreen: Boolean;
- //popup hack
- NextScreenWithCheck: Pmenu;
- CheckOK: Boolean;
-
- h_DC: HDC;
- h_RC: HGLRC;
-
- Fade: Real;
- // fade-mod
- doFade: Boolean;
- canFade: Boolean;
- myFade: integer;
- lastTime: Cardinal;
- pTexData : Pointer;
- pTex : array[1..2] of glUInt;
- // end
-
- //FPS Counter
- FPSCounter: Cardinal;
- LastFPS: Cardinal;
- NextFPSSwap:Cardinal;
-
- //For Debug OSD
- OSD_LastError: String;
-
- function Draw: Boolean;
- procedure PrintScreen;
- constructor Create;
- // fade mod
- destructor Destroy; override;
- // end
- procedure ScreenShot;
-
- procedure DrawDebugInformation;
- end;
-
-var
- Display: TDisplay;
-
-implementation
-
-uses
- {$IFDEF FPC}
- ulazjpeg,
- {$ELSE}
- JPEG,
- {$ENDIF}
- graphics,
- TextGL,
- // UFiles,
- UMain,
- UTexture,
- UIni,
- UGraphic,
- UTime,
- UCommandLine;
-
-constructor TDisplay.Create;
-var i: integer;
-begin
- inherited Create;
-
- //popup hack
- CheckOK:=False;
- NextScreen:=NIL;
- NextScreenWithCheck:=NIL;
- BlackScreen:=False;
-
- // fade mod
- myfade:=0;
-
- if Ini.ScreenFade=1 then
- doFade:=True
- else
- doFade:=False;
-
- canFade:=True;
- // generate texture for fading between screens
- GetMem(pTexData, 512*512*4);
- if pTexData <> NIL then
- for i:= 1 to 2 do
- begin
- glGenTextures(1, pTex[i]);
- if glGetError <> GL_NO_ERROR then canFade := False;
- glBindTexture(GL_TEXTURE_2D, pTex[i]);
- if glGetError <> GL_NO_ERROR then canFade := False;
- glTexImage2D(GL_TEXTURE_2D, 0, 4, 512, 512, 0, GL_RGBA, GL_UNSIGNED_BYTE, pTexData);
- if glGetError <> GL_NO_ERROR then canFade := False;
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
- if glGetError <> GL_NO_ERROR then canFade := False;
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
- if glGetError <> GL_NO_ERROR then canFade := False;
- end
- else
- begin
- canFade:=False;
- end;
- FreeMem(pTexData);
- // end
-
- //Set LastError for OSD to No Error
- OSD_LastError := 'No Errors';
-end;
-
-// fade mod
-destructor TDisplay.Destroy;
-begin
- if canFade then
- glDeleteTextures(1,@pTex);
- inherited Destroy;
-end;
-// end
-
-function TDisplay.Draw: Boolean;
-var
- S: integer;
- Col: Real;
- // fade mod
- myFade2: Real;
- currentTime: Cardinal;
- glError: glEnum;
- glErrorStr: String;
- // end
-begin
- Result := True;
-
- Col := 1;
- {if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then
- Col := 0; }
-
- glClearColor(Col, Col, Col , 0);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
-
- for S := 1 to Screens do begin
- ScreenAct := S;
-
-// if Screens = 1 then ScreenX := 0;
-// if (Screens = 2) and (S = 1) then ScreenX := -1;
-// if (Screens = 2) and (S = 2) then ScreenX := 1;
- ScreenX := 0;
-
- if S = 2 then TimeSkip := 0 else;
- glViewPort((S-1) * ScreenW div Screens, 0, ScreenW div Screens, ScreenH);
-
- //popup hack
- // check was successful... move on
- if CheckOK then
- if assigned (NextScreenWithCheck)then
- begin
- NextScreen:=NextScreenWithCheck;
- NextScreenWithCheck := NIL;
- CheckOk:=False;
- end
- else
- BlackScreen:=True; // end of game - fade to black before exit
- //end popup hack
-
-// ActualScreen.SetAnimationProgress(1);
- if (not assigned (NextScreen)) and (not BlackScreen) then begin
- ActualScreen.Draw;
- //popup mod
- if ScreenPopupError <> NIL then if ScreenPopupError.Visible then ScreenPopupError.Draw else
- if ScreenPopupCheck <> NIL then if ScreenPopupCheck.Visible then ScreenPopupCheck.Draw;
- //popup end
- // fade mod
- myfade:=0;
- if (Ini.ScreenFade=1) and canFade then
- doFade:=True
- else if Ini.ScreenFade=0 then
- doFade:=False;
- // end
- end
- else
- begin
- // check if we had an initialization error (canfade=false, dofade=true)
- if doFade and not canFade then begin
- doFade:=False; //disable fading
-// ScreenPopupError.ShowPopup('Error initializing\nfade texture\n\nfading\ndisabled'); //show error message
- end;
- if doFade and canFade then
- begin
- // fade mod
- //Create Fading texture if we're just starting
- if myfade = 0 then
- begin
- glViewPort(0, 0, 512, 512);
- ActualScreen.Draw;
- glBindTexture(GL_TEXTURE_2D, pTex[S]);
- glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 0, 512, 512, 0);
- glError:=glGetError;
- if glError <> GL_NO_ERROR then
- begin
- canFade := False;
- case glError of
- GL_INVALID_ENUM: glErrorStr:='INVALID_ENUM';
- GL_INVALID_VALUE: glErrorStr:='INVALID_VALUE';
- GL_INVALID_OPERATION: glErrorStr:='INVALID_OPERATION';
- GL_STACK_OVERFLOW: glErrorStr:='STACK_OVERFLOW';
- GL_STACK_UNDERFLOW: glErrorStr:='STACK_UNDERFLOW';
- GL_OUT_OF_MEMORY: glErrorStr:='OUT_OF_MEMORY';
- else glErrorStr:='unknown error';
- end;
-// ScreenPopupError.ShowPopup('Error copying\nfade texture\n('+glErrorStr+')\nfading\ndisabled'); //show error message
- end;
- glViewPort((S-1) * ScreenW div Screens, 0, ScreenW div Screens, ScreenH);
- // blackscreen-hack
- if not BlackScreen then
- NextScreen.onShow;
- lastTime:=GetTickCount;
- if (S=2) or (Screens = 1) then
- myfade:=myfade+1;
- end; // end texture creation in first fading step
-
- //do some time-based fading
- currentTime:=GetTickCount;
- if (currentTime > lastTime+30) and (S=1) then
- begin
- myfade:=myfade+4;
- lastTime:=currentTime;
- end;
-
-// LastFade := Fade; // whatever
-// Fade := Fade -0.999; // start fading out
-
-
-// ActualScreen.ShowFinish := false; // no purpose?
-
-// ActualScreen.SetAnimationProgress(Fade-1); // nop?
-
- // blackscreen-hack
- if not BlackScreen then
- NextScreen.Draw // draw next screen
- else if ScreenAct=1 then begin
- glClearColor(0, 0, 0 , 0);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
- end;
-
- // and draw old screen over it... slowly fading out
- myfade2:=(myfade*myfade)/10000;
- glBindTexture(GL_TEXTURE_2D, pTex[S]);
- glColor4f(1, 1, 1, (1000-myfade*myfade)/1000); // strange calculation - alpha gets negative... but looks good this way
- glEnable(GL_TEXTURE_2D);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
- glBegin(GL_QUADS);
- glTexCoord2f(0+myfade2,0+myfade2);glVertex2f(0, 600);
- glTexCoord2f(0+myfade2,1-myfade2);glVertex2f(0, 0);
- glTexCoord2f(1-myfade2,1-myfade2);glVertex2f(800, 0);
- glTexCoord2f(1-myfade2,0+myfade2);glVertex2f(800, 600);
- glEnd;
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
- end
- else
- // blackscreen hack
- if not BlackScreen then
- NextScreen.OnShow;
-
-
- if ((myfade > 40) or (not doFade) or (not canFade)) And (S = 1) then begin // fade out complete...
- myFade:=0;
- ActualScreen.onHide;
- ActualScreen.ShowFinish:=False;
- ActualScreen:=NextScreen;
- NextScreen := nil;
- if not blackscreen then
- begin
- ActualScreen.onShowFinish;
- ActualScreen.ShowFinish := true;
- end
- else
- begin
- Result:=False;
- Break;
- end;
- // end of fade mod
- end;
- end; // if
-
- //Draw OSD only on first Screen if Debug Mode is enabled
- if ((Ini.Debug = 1) OR (Params.Debug)) AND (S=1) then
- DrawDebugInformation;
-
- end; // for
-// SwapBuffers(h_DC);
-end;
-
-{function TDisplay.Fade(FadeIn : Boolean; Steps : UInt8): UInt8;
-begin
- Self.FadeIn := FadeIn;
- FadeStep := (SizeOf(FadeStep) * $FF) div Steps;
- ActualStep := $FF;
- Result := $FF div FadeStep;
-end;}
-
-procedure TDisplay.PrintScreen;
-var
- Bitmap: TBitmap;
- Jpeg: TJpegImage;
- X, Y: integer;
- Num: integer;
- FileName: string;
-begin
- for Num := 1 to 9999 do begin
- FileName := IntToStr(Num);
- while Length(FileName) < 4 do FileName := '0' + FileName;
- FileName := ScreenshotsPath + 'screenshot' + FileName + '.jpg';
- if not FileExists(FileName) then break
- end;
-
- glReadPixels(0, 0, ScreenW, ScreenH, GL_RGBA, GL_UNSIGNED_BYTE, @PrintScreenData[0]);
- Bitmap := TBitmap.Create;
- Bitmap.Width := ScreenW;
- Bitmap.Height := ScreenH;
-
- for Y := 0 to ScreenH-1 do
- for X := 0 to ScreenW-1 do
- Bitmap.Canvas.Pixels[X, Y] := PrintScreenData[(ScreenH-1-Y) * ScreenW + X] and $00FFFFFF;
-
- Jpeg := TJpegImage.Create;
- Jpeg.Assign(Bitmap);
- Bitmap.Free;
- Jpeg.CompressionQuality := 95;//90;
- Jpeg.SaveToFile(FileName);
- Jpeg.Free;
-end;
-
-procedure TDisplay.ScreenShot;
- var F : file;
- FileInfo: BITMAPINFOHEADER;
- FileHeader : BITMAPFILEHEADER;
- pPicData:Pointer;
- FileName: String;
- Num: Integer;
-begin
- //bilddatei Suchen
- for Num := 1 to 9999 do begin
- FileName := IntToStr(Num);
- while Length(FileName) < 4 do FileName := '0' + FileName;
- FileName := ScreenshotsPath + FileName + '.BMP';
- if not FileExists(FileName) then break
- end;
-
- //Speicher für die Speicherung der Header-Informationen vorbereiten
- ZeroMemory(@FileHeader, SizeOf(BITMAPFILEHEADER));
- ZeroMemory(@FileInfo, SizeOf(BITMAPINFOHEADER));
-
- //Initialisieren der Daten des Headers
- FileHeader.bfType := 19778; //$4D42 = 'BM'
- FileHeader.bfOffBits := SizeOf(BITMAPINFOHEADER)+SizeOf(BITMAPFILEHEADER);
-
- //Schreiben der Bitmap-Informationen
- FileInfo.biSize := SizeOf(BITMAPINFOHEADER);
- FileInfo.biWidth := ScreenW;
- FileInfo.biHeight := ScreenH;
- FileInfo.biPlanes := 1;
- FileInfo.biBitCount := 32;
- FileInfo.biSizeImage := FileInfo.biWidth*FileInfo.biHeight*(FileInfo.biBitCount div 8);
-
- //Größenangabe auch in den Header übernehmen
- FileHeader.bfSize := FileHeader.bfOffBits + FileInfo.biSizeImage;
-
- //Speicher für die Bilddaten reservieren
- GetMem(pPicData, FileInfo.biSizeImage);
- try
- //Bilddaten von OpenGL anfordern (siehe oben)
- glReadPixels(0, 0, ScreenW, ScreenH, GL_BGRA, GL_UNSIGNED_BYTE, pPicData);
-
- //Und den ganzen Müll in die Datei schieben ;-)
- //Moderne Leute nehmen dafür auch Streams ...
- AssignFile(f, Filename);
- Rewrite( f,1 );
- try
- BlockWrite(F, FileHeader, SizeOf(BITMAPFILEHEADER));
- BlockWrite(F, FileInfo, SizeOf(BITMAPINFOHEADER));
- BlockWrite(F, pPicData^, FileInfo.biSizeImage );
- finally
- CloseFile(f);
- end;
- finally
- //Und den angeforderten Speicher wieder freigeben ...
- FreeMem(pPicData, FileInfo.biSizeImage);
- end;
-end;
-
-//------------
-// DrawDebugInformation - Procedure draw FPS and some other Informations on Screen
-//------------
-procedure TDisplay.DrawDebugInformation;
-var Ticks: Cardinal;
-begin
- //Some White Background for information
- glEnable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
- glColor4f(1, 1, 1, 0.5);
- glBegin(GL_QUADS);
- glVertex2f(690, 44);
- glVertex2f(690, 0);
- glVertex2f(800, 0);
- glVertex2f(800, 44);
- glEnd;
- glDisable(GL_BLEND);
-
- //Set Font Specs
- SetFontStyle(0);
- SetFontSize(7);
- SetFontItalic(False);
- glColor4f(0, 0, 0, 1);
-
- //Calculate FPS
- Ticks := GetTickCount;
- if (Ticks >= NextFPSSwap) then
- begin
- LastFPS := FPSCounter * 4;
- FPSCounter := 0;
- NextFPSSwap := Ticks + 250;
- end;
-
- Inc(FPSCounter);
-
- //Draw Text
-
- //FPS
- SetFontPos(695, 0);
- glPrint (PChar('FPS: ' + InttoStr(LastFPS)));
-
- //RSpeed
- SetFontPos(695, 13);
- glPrint (PChar('RSpeed: ' + InttoStr(Round(1000 * TimeMid))));
-
- //LastError
- SetFontPos(695, 26);
- glColor4f(1, 0, 0, 1);
- glPrint (PChar(OSD_LastError));
-
- glColor4f(1, 1, 1, 1);
-end;
-
-end.
+unit UDisplay;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+uses {$IFDEF win32}
+ windows,
+ {$ELSE}
+ LCLType,
+ {$ENDIF}
+ ucommon,
+ SDL,
+ UMenu,
+ OpenGL12,
+ SysUtils;
+
+type
+ TDisplay = class
+ ActualScreen: PMenu;
+ NextScreen: PMenu;
+
+ //fade-to-black-hack
+ BlackScreen: Boolean;
+ //popup hack
+ NextScreenWithCheck: Pmenu;
+ CheckOK: Boolean;
+
+ h_DC: HDC;
+ h_RC: HGLRC;
+
+ Fade: Real;
+ // fade-mod
+ doFade: Boolean;
+ canFade: Boolean;
+ myFade: integer;
+ lastTime: Cardinal;
+ pTexData : Pointer;
+ pTex : array[1..2] of glUInt;
+ // end
+
+ //FPS Counter
+ FPSCounter: Cardinal;
+ LastFPS: Cardinal;
+ NextFPSSwap:Cardinal;
+
+ //For Debug OSD
+ OSD_LastError: String;
+
+ function Draw: Boolean;
+ procedure PrintScreen;
+ constructor Create;
+ // fade mod
+ destructor Destroy; override;
+ // end
+ procedure ScreenShot;
+
+ procedure DrawDebugInformation;
+ end;
+
+var
+ Display: TDisplay;
+
+implementation
+
+uses
+ {$IFDEF FPC}
+ ulazjpeg,
+ {$ELSE}
+ JPEG,
+ {$ENDIF}
+ {$IFNDEF win32}
+ lclintf,
+ {$ENDIF}
+ graphics,
+ TextGL,
+ // UFiles,
+ UMain,
+ UTexture,
+ UIni,
+ UGraphic,
+ UTime,
+ UCommandLine;
+
+constructor TDisplay.Create;
+var i: integer;
+begin
+ inherited Create;
+
+ //popup hack
+ CheckOK:=False;
+ NextScreen:=NIL;
+ NextScreenWithCheck:=NIL;
+ BlackScreen:=False;
+
+ // fade mod
+ myfade:=0;
+
+ if Ini.ScreenFade=1 then
+ doFade:=True
+ else
+ doFade:=False;
+
+ canFade:=True;
+ // generate texture for fading between screens
+ GetMem(pTexData, 512*512*4);
+ if pTexData <> NIL then
+ for i:= 1 to 2 do
+ begin
+ glGenTextures(1, pTex[i]);
+ if glGetError <> GL_NO_ERROR then canFade := False;
+ glBindTexture(GL_TEXTURE_2D, pTex[i]);
+ if glGetError <> GL_NO_ERROR then canFade := False;
+ glTexImage2D(GL_TEXTURE_2D, 0, 4, 512, 512, 0, GL_RGBA, GL_UNSIGNED_BYTE, pTexData);
+ if glGetError <> GL_NO_ERROR then canFade := False;
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
+ if glGetError <> GL_NO_ERROR then canFade := False;
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
+ if glGetError <> GL_NO_ERROR then canFade := False;
+ end
+ else
+ begin
+ canFade:=False;
+ end;
+ FreeMem(pTexData);
+ // end
+
+ //Set LastError for OSD to No Error
+ OSD_LastError := 'No Errors';
+end;
+
+// fade mod
+destructor TDisplay.Destroy;
+begin
+ if canFade then
+ glDeleteTextures(1,@pTex);
+ inherited Destroy;
+end;
+// end
+
+function TDisplay.Draw: Boolean;
+var
+ S: integer;
+ Col: Real;
+ // fade mod
+ myFade2: Real;
+ currentTime: Cardinal;
+ glError: glEnum;
+ glErrorStr: String;
+ // end
+begin
+ Result := True;
+
+ Col := 1;
+ {if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then
+ Col := 0; }
+
+ glClearColor(Col, Col, Col , 0);
+ glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
+
+ for S := 1 to Screens do begin
+ ScreenAct := S;
+
+// if Screens = 1 then ScreenX := 0;
+// if (Screens = 2) and (S = 1) then ScreenX := -1;
+// if (Screens = 2) and (S = 2) then ScreenX := 1;
+ ScreenX := 0;
+
+ if S = 2 then TimeSkip := 0 else;
+ glViewPort((S-1) * ScreenW div Screens, 0, ScreenW div Screens, ScreenH);
+
+ //popup hack
+ // check was successful... move on
+ if CheckOK then
+ if assigned (NextScreenWithCheck)then
+ begin
+ NextScreen:=NextScreenWithCheck;
+ NextScreenWithCheck := NIL;
+ CheckOk:=False;
+ end
+ else
+ BlackScreen:=True; // end of game - fade to black before exit
+ //end popup hack
+
+// ActualScreen.SetAnimationProgress(1);
+ if (not assigned (NextScreen)) and (not BlackScreen) then begin
+ ActualScreen.Draw;
+ //popup mod
+ if ScreenPopupError <> NIL then if ScreenPopupError.Visible then ScreenPopupError.Draw else
+ if ScreenPopupCheck <> NIL then if ScreenPopupCheck.Visible then ScreenPopupCheck.Draw;
+ //popup end
+ // fade mod
+ myfade:=0;
+ if (Ini.ScreenFade=1) and canFade then
+ doFade:=True
+ else if Ini.ScreenFade=0 then
+ doFade:=False;
+ // end
+ end
+ else
+ begin
+ // check if we had an initialization error (canfade=false, dofade=true)
+ if doFade and not canFade then begin
+ doFade:=False; //disable fading
+// ScreenPopupError.ShowPopup('Error initializing\nfade texture\n\nfading\ndisabled'); //show error message
+ end;
+ if doFade and canFade then
+ begin
+ // fade mod
+ //Create Fading texture if we're just starting
+ if myfade = 0 then
+ begin
+ glViewPort(0, 0, 512, 512);
+ ActualScreen.Draw;
+ glBindTexture(GL_TEXTURE_2D, pTex[S]);
+ glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 0, 512, 512, 0);
+ glError:=glGetError;
+ if glError <> GL_NO_ERROR then
+ begin
+ canFade := False;
+ case glError of
+ GL_INVALID_ENUM: glErrorStr:='INVALID_ENUM';
+ GL_INVALID_VALUE: glErrorStr:='INVALID_VALUE';
+ GL_INVALID_OPERATION: glErrorStr:='INVALID_OPERATION';
+ GL_STACK_OVERFLOW: glErrorStr:='STACK_OVERFLOW';
+ GL_STACK_UNDERFLOW: glErrorStr:='STACK_UNDERFLOW';
+ GL_OUT_OF_MEMORY: glErrorStr:='OUT_OF_MEMORY';
+ else glErrorStr:='unknown error';
+ end;
+// ScreenPopupError.ShowPopup('Error copying\nfade texture\n('+glErrorStr+')\nfading\ndisabled'); //show error message
+ end;
+ glViewPort((S-1) * ScreenW div Screens, 0, ScreenW div Screens, ScreenH);
+ // blackscreen-hack
+ if not BlackScreen then
+ NextScreen.onShow;
+
+ lastTime:=GetTickCount;
+ if (S=2) or (Screens = 1) then
+ myfade:=myfade+1;
+ end; // end texture creation in first fading step
+
+ //do some time-based fading
+ currentTime:=GetTickCount;
+ if (currentTime > lastTime+30) and (S=1) then
+ begin
+ myfade:=myfade+4;
+ lastTime:=currentTime;
+ end;
+
+// LastFade := Fade; // whatever
+// Fade := Fade -0.999; // start fading out
+
+
+// ActualScreen.ShowFinish := false; // no purpose?
+
+// ActualScreen.SetAnimationProgress(Fade-1); // nop?
+
+ // blackscreen-hack
+ if not BlackScreen then
+ NextScreen.Draw // draw next screen
+ else if ScreenAct=1 then begin
+ glClearColor(0, 0, 0 , 0);
+ glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
+ end;
+
+ // and draw old screen over it... slowly fading out
+ myfade2:=(myfade*myfade)/10000;
+ glBindTexture(GL_TEXTURE_2D, pTex[S]);
+ glColor4f(1, 1, 1, (1000-myfade*myfade)/1000); // strange calculation - alpha gets negative... but looks good this way
+ glEnable(GL_TEXTURE_2D);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glEnable(GL_BLEND);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0+myfade2,0+myfade2);glVertex2f(0, 600);
+ glTexCoord2f(0+myfade2,1-myfade2);glVertex2f(0, 0);
+ glTexCoord2f(1-myfade2,1-myfade2);glVertex2f(800, 0);
+ glTexCoord2f(1-myfade2,0+myfade2);glVertex2f(800, 600);
+ glEnd;
+ glDisable(GL_BLEND);
+ glDisable(GL_TEXTURE_2D);
+ end
+ else
+ // blackscreen hack
+ if not BlackScreen then
+ NextScreen.OnShow;
+
+
+ if ((myfade > 40) or (not doFade) or (not canFade)) And (S = 1) then begin // fade out complete...
+ myFade:=0;
+ ActualScreen.onHide;
+ ActualScreen.ShowFinish:=False;
+ ActualScreen:=NextScreen;
+ NextScreen := nil;
+ if not blackscreen then
+ begin
+ ActualScreen.onShowFinish;
+ ActualScreen.ShowFinish := true;
+ end
+ else
+ begin
+ Result:=False;
+ Break;
+ end;
+ // end of fade mod
+ end;
+ end; // if
+
+ //Draw OSD only on first Screen if Debug Mode is enabled
+ if ((Ini.Debug = 1) OR (Params.Debug)) AND (S=1) then
+ DrawDebugInformation;
+
+ end; // for
+// SwapBuffers(h_DC);
+end;
+
+{function TDisplay.Fade(FadeIn : Boolean; Steps : UInt8): UInt8;
+begin
+ Self.FadeIn := FadeIn;
+ FadeStep := (SizeOf(FadeStep) * $FF) div Steps;
+ ActualStep := $FF;
+ Result := $FF div FadeStep;
+end;}
+
+procedure TDisplay.PrintScreen;
+var
+ Bitmap: TBitmap;
+ Jpeg: TJpegImage;
+ X, Y: integer;
+ Num: integer;
+ FileName: string;
+begin
+ for Num := 1 to 9999 do begin
+ FileName := IntToStr(Num);
+ while Length(FileName) < 4 do FileName := '0' + FileName;
+ FileName := ScreenshotsPath + 'screenshot' + FileName + '.jpg';
+ if not FileExists(FileName) then break
+ end;
+
+ glReadPixels(0, 0, ScreenW, ScreenH, GL_RGBA, GL_UNSIGNED_BYTE, @PrintScreenData[0]);
+ Bitmap := TBitmap.Create;
+ Bitmap.Width := ScreenW;
+ Bitmap.Height := ScreenH;
+
+ for Y := 0 to ScreenH-1 do
+ for X := 0 to ScreenW-1 do
+ Bitmap.Canvas.Pixels[X, Y] := PrintScreenData[(ScreenH-1-Y) * ScreenW + X] and $00FFFFFF;
+
+ Jpeg := TJpegImage.Create;
+ Jpeg.Assign(Bitmap);
+ Bitmap.Free;
+ Jpeg.CompressionQuality := 95;//90;
+ Jpeg.SaveToFile(FileName);
+ Jpeg.Free;
+end;
+
+procedure TDisplay.ScreenShot;
+ var F : file;
+ FileInfo: BITMAPINFOHEADER;
+ FileHeader : BITMAPFILEHEADER;
+ pPicData:Pointer;
+ FileName: String;
+ Num: Integer;
+begin
+ //bilddatei Suchen
+ for Num := 1 to 9999 do begin
+ FileName := IntToStr(Num);
+ while Length(FileName) < 4 do FileName := '0' + FileName;
+ FileName := ScreenshotsPath + FileName + '.BMP';
+ if not FileExists(FileName) then break
+ end;
+
+ //Speicher für die Speicherung der Header-Informationen vorbereiten
+ ZeroMemory(@FileHeader, SizeOf(BITMAPFILEHEADER));
+ ZeroMemory(@FileInfo , SizeOf(BITMAPINFOHEADER));
+
+ //Initialisieren der Daten des Headers
+ FileHeader.bfType := 19778; //$4D42 = 'BM'
+ FileHeader.bfOffBits := SizeOf(BITMAPINFOHEADER)+SizeOf(BITMAPFILEHEADER);
+
+ //Schreiben der Bitmap-Informationen
+ FileInfo.biSize := SizeOf(BITMAPINFOHEADER);
+ FileInfo.biWidth := ScreenW;
+ FileInfo.biHeight := ScreenH;
+ FileInfo.biPlanes := 1;
+ FileInfo.biBitCount := 32;
+ FileInfo.biSizeImage := FileInfo.biWidth*FileInfo.biHeight*(FileInfo.biBitCount div 8);
+
+ //Größenangabe auch in den Header übernehmen
+ FileHeader.bfSize := FileHeader.bfOffBits + FileInfo.biSizeImage;
+
+ //Speicher für die Bilddaten reservieren
+ GetMem(pPicData, FileInfo.biSizeImage);
+ try
+ //Bilddaten von OpenGL anfordern (siehe oben)
+ glReadPixels(0, 0, ScreenW, ScreenH, GL_BGRA, GL_UNSIGNED_BYTE, pPicData);
+
+ //Und den ganzen Müll in die Datei schieben ;-)
+ //Moderne Leute nehmen dafür auch Streams ...
+ AssignFile(f, Filename);
+ Rewrite( f,1 );
+ try
+ BlockWrite(F, FileHeader, SizeOf(BITMAPFILEHEADER));
+ BlockWrite(F, FileInfo, SizeOf(BITMAPINFOHEADER));
+ BlockWrite(F, pPicData^, FileInfo.biSizeImage );
+ finally
+ CloseFile(f);
+ end;
+ finally
+ //Und den angeforderten Speicher wieder freigeben ...
+ FreeMem(pPicData, FileInfo.biSizeImage);
+ end;
+end;
+
+//------------
+// DrawDebugInformation - Procedure draw FPS and some other Informations on Screen
+//------------
+procedure TDisplay.DrawDebugInformation;
+var Ticks: Cardinal;
+begin
+ //Some White Background for information
+ glEnable(GL_BLEND);
+ glDisable(GL_TEXTURE_2D);
+ glColor4f(1, 1, 1, 0.5);
+ glBegin(GL_QUADS);
+ glVertex2f(690, 44);
+ glVertex2f(690, 0);
+ glVertex2f(800, 0);
+ glVertex2f(800, 44);
+ glEnd;
+ glDisable(GL_BLEND);
+
+ //Set Font Specs
+ SetFontStyle(0);
+ SetFontSize(7);
+ SetFontItalic(False);
+ glColor4f(0, 0, 0, 1);
+
+ //Calculate FPS
+ Ticks := GetTickCount;
+ if (Ticks >= NextFPSSwap) then
+ begin
+ LastFPS := FPSCounter * 4;
+ FPSCounter := 0;
+ NextFPSSwap := Ticks + 250;
+ end;
+
+ Inc(FPSCounter);
+
+ //Draw Text
+
+ //FPS
+ SetFontPos(695, 0);
+ glPrint (PChar('FPS: ' + InttoStr(LastFPS)));
+
+ //RSpeed
+ SetFontPos(695, 13);
+ glPrint (PChar('RSpeed: ' + InttoStr(Round(1000 * TimeMid))));
+
+ //LastError
+ SetFontPos(695, 26);
+ glColor4f(1, 0, 0, 1);
+ glPrint (PChar(OSD_LastError));
+
+ glColor4f(1, 1, 1, 1);
+end;
+
+end.
diff --git a/Game/Code/Menu/UMenuButton.pas b/Game/Code/Menu/UMenuButton.pas
index f3b00830..af4f69ee 100644
--- a/Game/Code/Menu/UMenuButton.pas
+++ b/Game/Code/Menu/UMenuButton.pas
@@ -1,565 +1,572 @@
-unit UMenuButton;
-
-interface
-uses TextGL, UTexture, OpenGL12, UMenuText;
-
-type
- CButton = class of TButton;
- TButton = class
- protected
- SelectBool: Boolean;
-
- FadeProgress: Real;
- FadeLastTick: Cardinal;
-
- DeSelectW: Real;
- DeSelectH: Real;
- PosX: Real;
- PosY: Real;
-
- constructor Create(); overload;
-
- public
- Text: Array of TText;
- Texture: TTexture; // Button Screen position and size
- Texture2: TTexture; // second texture only used for fading full resolution covers
- //colorized hack
- Colorized: Boolean;
- DeSelectTexture: TTexture; // texture for colorized hack
-
- FadeTex: TTexture; //Texture for beautiful fading
- FadeTexPos: byte; //Pos of the FadeTexture (0: Top, 1: Left, 2: Bottom, 3: Right)
-// Texture2Blend: real; // blending factor for second texture (0=invisible, 1=visible)
- // now uses alpha
-
- DeselectType: integer; // not used yet
- Visible: boolean;
- //Reflection Mod
- Reflection: boolean;
- Reflectionspacing: Real;
- DeSelectReflectionspacing: Real;
-
- //Fade Mod
- Fade: Boolean;
- FadeText: Boolean;
-
- Selectable: boolean;
-
- //No of the Parent Collection, 0 if in no Collection
- Parent: Byte;
-
- SelectColR: real;
- SelectColG: real;
- SelectColB: real;
- SelectInt: real;
- SelectTInt: real;
- //Fade Mod
- SelectW: real;
- SelectH: real;
-
- DeselectColR: real;
- DeselectColG: real;
- DeselectColB: real;
- DeselectInt: real;
- DeselectTInt: real;
-
- procedure SetY(Value: real);
- procedure SetX(Value: real);
- procedure SetW(Value: real);
- procedure SetH(Value: real);
-
- procedure SetSelect(Value: Boolean); virtual;
- property X: real read PosX write SetX;
- property Y: real read PosY write SetY;
- property Z: real read Texture.z write Texture.z;
- property W: real read DeSelectW write SetW;
- property H: real read DeSelectH write SetH;
- property Selected: Boolean read SelectBool write SetSelect;
-
- procedure Draw; virtual;
-
- constructor Create(Textura: TTexture); overload;
- constructor Create(Textura, DSTexture: TTexture); overload;
- destructor Destroy; override;
- end;
-
-implementation
-uses UDrawTexture, SysUtils, windows;
-
-procedure TButton.SetX(Value: real);
-{var
- dx: real;
- T: integer; // text}
-begin
- {dY := Value - Texture.y;
-
- Texture.X := Value;
-
- for T := 0 to High(Text) do
- Text[T].X := Text[T].X + dY;}
-
- PosX := Value;
- if (FadeTex.TexNum = -1) then
- Texture.X := Value;
-
-end;
-
-procedure TButton.SetY(Value: real);
-{var
- dY: real;
- T: integer; // text}
-begin
- {dY := Value - PosY;
-
-
- for T := 0 to High(Text) do
- Text[T].Y := Text[T].Y + dY;}
-
- PosY := Value;
- if (FadeTex.TexNum = -1) then
- Texture.y := Value;
-end;
-
-procedure TButton.SetW(Value: real);
-begin
- if SelectW = DeSelectW then
- SelectW := Value;
-
- DeSelectW := Value;
-
- if Not Fade then
- begin
- if SelectBool then
- Texture.W := SelectW
- else
- Texture.W := DeSelectW;
- end;
-end;
-
-procedure TButton.SetH(Value: real);
-begin
- if SelectH = DeSelectH then
- SelectH := Value;
-
- DeSelectH := Value;
-
- if Not Fade then
- begin
- if SelectBool then
- Texture.H := SelectH
- else
- Texture.H := DeSelectH;
- end;
-end;
-
-procedure TButton.SetSelect(Value : Boolean);
-var
- T: integer;
-begin
- SelectBool := Value;
- if (Value) then begin
- Texture.ColR := SelectColR;
- Texture.ColG := SelectColG;
- Texture.ColB := SelectColB;
- Texture.Int := SelectInt;
-
- Texture2.ColR := SelectColR;
- Texture2.ColG := SelectColG;
- Texture2.ColB := SelectColB;
- Texture2.Int := SelectInt;
-
- for T := 0 to High(Text) do
- Text[T].Int := SelectTInt;
-
- //Fade Mod
- if Fade then
- begin
- if (FadeProgress <= 0) then
- FadeProgress := 0.125;
- end
- else
- begin
- Texture.W := SelectW;
- Texture.H := SelectH;
- end;
- end else begin
- Texture.ColR := DeselectColR;
- Texture.ColG := DeselectColG;
- Texture.ColB := DeselectColB;
- Texture.Int := DeselectInt;
-
- Texture2.ColR := DeselectColR;
- Texture2.ColG := DeselectColG;
- Texture2.ColB := DeselectColB;
- Texture2.Int := DeselectInt;
-
- for T := 0 to High(Text) do
- Text[T].Int := DeselectTInt;
-
- //Fade Mod
- if Fade then
- begin
- if (FadeProgress >= 1) then
- FadeProgress := 0.875;
- end
- else
- begin
- Texture.W := DeSelectW;
- Texture.H := DeSelectH;
- end;
- end;
-end;
-
-constructor TButton.Create();
-begin
- inherited Create;
- // We initialize all to 0, nil or false
- Visible := true;
- SelectBool := false;
- DeselectType := 0;
- Selectable := true;
- //Reflection Mod
- Reflection := true;
-
- //colorized hack
- Colorized:=False;
-
- // Default
-// SelectInt := 1;
-// DeselectInt := 0.5;
-
-{ SelectColR := 0.5;
- SelectColG := 0.75;
- SelectColB := 0;
- SelectInt := 1;
- SelectTInt := 1;
-
- DeselectColR := 1;
- DeselectColG := 1;
- DeselectColB := 1;
- DeselectInt := 0.5;
- DeselectTInt := 1;}
-
- SelectColR := 1;
- SelectColG := 1;
- SelectColB := 1;
- SelectInt := 1;
- SelectTInt := 1;
-
- DeselectColR := 1;
- DeselectColG := 1;
- DeselectColB := 1;
- DeselectInt := 0.5;
- DeselectTInt := 1;
-
- FadeTex.TexNum := -1;
-
- FadeProgress := 0;
- Fade := False;
- FadeText := False;
- SelectW := DeSelectW;
- SelectH := DeSelectH;
-
- PosX := 0;
- PosY := 0;
-
- Parent := 0;
-end;
-
-// ***** Public methods ****** //
-
-procedure TButton.Draw;
-var
- T: integer;
- Tick: Cardinal;
- Spacing: Real;
-begin
- if Visible then begin
- //Fade Mod
- T:=0;
- if Fade then
- begin
- if (FadeProgress < 1) and (FadeProgress > 0) then
- begin
- Tick := GetTickCount div 16;
- if (Tick <> FadeLastTick) then
- begin
- FadeLastTick := Tick;
- if SelectBool then
- FadeProgress := FadeProgress + 0.125
- else
- FadeProgress := FadeProgress - 0.125;
-
- if (FadeText) then
- begin
- For T := 0 to high(Text) do
- begin
- Text[T].MoveX := (SelectW - DeSelectW) * FadeProgress;
- Text[T].MoveY := (SelectH - DeSelectH) * FadeProgress;
- end;
- end;
- end;
- end;
- //Method without Fade Texture
- if (FadeTex.TexNum = -1) then
- begin
- Texture.W := DeSelectW + (SelectW - DeSelectW) * FadeProgress;
- Texture.H := DeSelectH + (SelectH - DeSelectH) * FadeProgress;
- DeselectTexture.W := Texture.W;
- DeselectTexture.H := Texture.H;
- end
- else //method with Fade Texture
- begin
- Texture.W := DeSelectW;
- Texture.H := DeSelectH;
- DeselectTexture.W := Texture.W;
- DeselectTexture.H := Texture.H;
-
- FadeTex.ColR := Texture.ColR;
- FadeTex.ColG := Texture.ColG;
- FadeTex.ColB := Texture.ColB;
- FadeTex.Int := Texture.Int;
-
- FadeTex.Z := Texture.Z;
-
- FadeTex.Alpha := Texture.Alpha;
- FadeTex.TexX1 := 0;
- FadeTex.TexX2 := 1;
- FadeTex.TexY1 := 0;
- FadeTex.TexY2 := 1;
-
- Case FadeTexPos of
- 0: //FadeTex on Top
- begin
- //Standard Texture
- Texture.X := PosX;
- Texture.Y := PosY + (SelectH - DeSelectH) * FadeProgress;
- DeselectTexture.X := Texture.X;
- DeselectTexture.Y := Texture.Y;
- //Fade Tex
- FadeTex.X := PosX;
- FadeTex.Y := PosY;
- FadeTex.W := Texture.W;
- FadeTex.H := (SelectH - DeSelectH) * FadeProgress;
- FadeTex.ScaleW := Texture.ScaleW;
- //Some Hack that Fixes a little Space between both Textures
- FadeTex.TexY2 := 0.9;
- end;
- 1: //FadeTex on Left
- begin
- //Standard Texture
- Texture.X := PosX + (SelectW - DeSelectW) * FadeProgress;
- Texture.Y := PosY;
- DeselectTexture.X := Texture.X;
- DeselectTexture.Y := Texture.Y;
- //Fade Tex
- FadeTex.X := PosX;
- FadeTex.Y := PosY;
- FadeTex.H := Texture.H;
- FadeTex.W := (SelectW - DeSelectW) * FadeProgress;
- FadeTex.ScaleH := Texture.ScaleH;
- //Some Hack that Fixes a little Space between both Textures
- FadeTex.TexX2 := 0.9;
- end;
- 2: //FadeTex on Bottom
- begin
- //Standard Texture
- Texture.X := PosX;
- Texture.Y := PosY;
- DeselectTexture.X := Texture.X;
- DeselectTexture.Y := Texture.Y;
- //Fade Tex
- FadeTex.X := PosX;
- FadeTex.Y := PosY + (SelectH - DeSelectH) * FadeProgress;;
- FadeTex.W := Texture.W;
- FadeTex.H := (SelectH - DeSelectH) * FadeProgress;
- FadeTex.ScaleW := Texture.ScaleW;
- //Some Hack that Fixes a little Space between both Textures
- FadeTex.TexY1 := 0.1;
- end;
- 3: //FadeTex on Right
- begin
- //Standard Texture
- Texture.X := PosX;
- Texture.Y := PosY;
- DeselectTexture.X := Texture.X;
- DeselectTexture.Y := Texture.Y;
- //Fade Tex
- FadeTex.X := PosX + (SelectW - DeSelectW) * FadeProgress;
- FadeTex.Y := PosY;
- FadeTex.H := Texture.H;
- FadeTex.W := (SelectW - DeSelectW) * FadeProgress;
- FadeTex.ScaleH := Texture.ScaleH;
- //Some Hack that Fixes a little Space between both Textures
- FadeTex.TexX1 := 0.1;
- end;
- end;
- end;
- end
- else if (FadeText) then
- begin
- Text[T].MoveX := (SelectW - DeSelectW);
- Text[T].MoveY := (SelectH - DeSelectH);
- end;
-
- if SelectBool or (FadeProgress > 0) or not Colorized then
- DrawTexture(Texture)
- else
- DrawTexture(DeselectTexture);
-
- //Draw FadeTex
- if (FadeTex.TexNum <> -1) then
- DrawTexture(FadeTex);
-
- if Texture2.Alpha > 0 then begin
- Texture2.ScaleW := Texture.ScaleW;
- Texture2.ScaleH := Texture.ScaleH;
-
- Texture2.X := Texture.X;
- Texture2.Y := Texture.Y;
- Texture2.W := Texture.W;
- Texture2.H := Texture.H;
-
- Texture2.ColR := Texture.ColR;
- Texture2.ColG := Texture.ColG;
- Texture2.ColB := Texture.ColB;
- Texture2.Int := Texture.Int;
-
- Texture2.Z := Texture.Z;
-
- DrawTexture(Texture2);
- end;
-
- //Reflection Mod
- if (Reflection) then // Draw Reflections
- begin
- if (FadeProgress <> 0) AND (FadeProgress <> 1) then
- begin
- Spacing := DeSelectReflectionspacing - (DeSelectReflectionspacing - Reflectionspacing) * FadeProgress;
- end
- else if SelectBool then
- Spacing := Reflectionspacing
- else
- Spacing := DeSelectReflectionspacing;
-
- if SelectBool or not Colorized then
- with Texture do
- begin
- //Bind Tex and GL Attributes
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
-
- glDepthRange(0, 10);
- glDepthFunc(GL_LEQUAL);
- glEnable(GL_DEPTH_TEST);
-
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, TexNum);
-
- //Draw
- glBegin(GL_QUADS);//Top Left
- glColor4f(ColR * Int, ColG * Int, ColB * Int, Alpha-0.3);
- glTexCoord2f(TexX1*TexW, TexY2*TexH);
- glVertex3f(x, y+h*scaleH+ Spacing, z);
-
- //Bottom Left
- glColor4f(ColR * Int, ColG * Int, ColB * Int, 0);
- glTexCoord2f(TexX1*TexW, TexY1+TexH*0.5);
- glVertex3f(x, y+h*scaleH + h*scaleH/2 + Spacing, z);
-
-
- //Bottom Right
- glColor4f(ColR * Int, ColG * Int, ColB * Int, 0);
- glTexCoord2f(TexX2*TexW, TexY1+TexH*0.5);
- glVertex3f(x+w*scaleW, y+h*scaleH + h*scaleH/2 + Spacing, z);
-
- //Top Right
- glColor4f(ColR * Int, ColG * Int, ColB * Int, Alpha-0.3);
- glTexCoord2f(TexX2*TexW, TexY2*TexH);
- glVertex3f(x+w*scaleW, y+h*scaleH + Spacing, z);
- glEnd;
-
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_DEPTH_TEST);
- glDisable(GL_BLEND);
- end else
- with DeselectTexture do
- begin
- //Bind Tex and GL Attributes
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
-
- glDepthRange(0, 10);
- glDepthFunc(GL_LEQUAL);
- glEnable(GL_DEPTH_TEST);
-
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, TexNum);
-
- //Draw
- glBegin(GL_QUADS);//Top Left
- glColor4f(ColR * Int, ColG * Int, ColB * Int, Alpha-0.3);
- glTexCoord2f(TexX1*TexW, TexY2*TexH);
- glVertex3f(x, y+h*scaleH+ Spacing, z);
-
- //Bottom Left
- glColor4f(ColR * Int, ColG * Int, ColB * Int, 0);
- glTexCoord2f(TexX1*TexW, TexY1+TexH*0.5);
- glVertex3f(x, y+h*scaleH + h*scaleH/2 + Spacing, z);
-
-
- //Bottom Right
- glColor4f(ColR * Int, ColG * Int, ColB * Int, 0);
- glTexCoord2f(TexX2*TexW, TexY1+TexH*0.5);
- glVertex3f(x+w*scaleW, y+h*scaleH + h*scaleH/2 + Spacing, z);
-
- //Top Right
- glColor4f(ColR * Int, ColG * Int, ColB * Int, Alpha-0.3);
- glTexCoord2f(TexX2*TexW, TexY2*TexH);
- glVertex3f(x+w*scaleW, y+h*scaleH + Spacing, z);
- glEnd;
-
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_DEPTH_TEST);
- glDisable(GL_BLEND);
- end;
- end;
-
- for T := 0 to High(Text) do begin
- Text[T].Draw;
- end;
- end;
-end;
-
-// ***** ****** //
-
-destructor TButton.Destroy;
-begin
- inherited;
-end;
-
-constructor TButton.Create(Textura: TTexture);
-begin
- Create();
- Texture := Textura;
- DeselectTexture:=Textura;
- Texture.ColR := 0;
- Texture.ColG := 0.5;
- Texture.ColB := 0;
- Texture.Int := 1;
- Colorized:=False;
-end;
-
-constructor TButton.Create(Textura, DSTexture: TTexture);
-begin
- Create();
- Texture := Textura;
- DeselectTexture := DSTexture;
- Texture.ColR := 1;
- Texture.ColG := 1;
- Texture.ColB := 1;
- Texture.Int := 1;
- Colorized:=True;
-end;
-
-end.
+unit UMenuButton;
+
+interface
+uses TextGL, UTexture, OpenGL12, UMenuText;
+
+type
+ CButton = class of TButton;
+ TButton = class
+ protected
+ SelectBool: Boolean;
+
+ FadeProgress: Real;
+ FadeLastTick: Cardinal;
+
+ DeSelectW: Real;
+ DeSelectH: Real;
+ PosX: Real;
+ PosY: Real;
+
+ constructor Create(); overload;
+
+ public
+ Text: Array of TText;
+ Texture: TTexture; // Button Screen position and size
+ Texture2: TTexture; // second texture only used for fading full resolution covers
+ //colorized hack
+ Colorized: Boolean;
+ DeSelectTexture: TTexture; // texture for colorized hack
+
+ FadeTex: TTexture; //Texture for beautiful fading
+ FadeTexPos: byte; //Pos of the FadeTexture (0: Top, 1: Left, 2: Bottom, 3: Right)
+// Texture2Blend: real; // blending factor for second texture (0=invisible, 1=visible)
+ // now uses alpha
+
+ DeselectType: integer; // not used yet
+ Visible: boolean;
+ //Reflection Mod
+ Reflection: boolean;
+ Reflectionspacing: Real;
+ DeSelectReflectionspacing: Real;
+
+ //Fade Mod
+ Fade: Boolean;
+ FadeText: Boolean;
+
+ Selectable: boolean;
+
+ //No of the Parent Collection, 0 if in no Collection
+ Parent: Byte;
+
+ SelectColR: real;
+ SelectColG: real;
+ SelectColB: real;
+ SelectInt: real;
+ SelectTInt: real;
+ //Fade Mod
+ SelectW: real;
+ SelectH: real;
+
+ DeselectColR: real;
+ DeselectColG: real;
+ DeselectColB: real;
+ DeselectInt: real;
+ DeselectTInt: real;
+
+ procedure SetY(Value: real);
+ procedure SetX(Value: real);
+ procedure SetW(Value: real);
+ procedure SetH(Value: real);
+
+ procedure SetSelect(Value: Boolean); virtual;
+ property X: real read PosX write SetX;
+ property Y: real read PosY write SetY;
+ property Z: real read Texture.z write Texture.z;
+ property W: real read DeSelectW write SetW;
+ property H: real read DeSelectH write SetH;
+ property Selected: Boolean read SelectBool write SetSelect;
+
+ procedure Draw; virtual;
+
+ constructor Create(Textura: TTexture); overload;
+ constructor Create(Textura, DSTexture: TTexture); overload;
+ destructor Destroy; override;
+ end;
+
+implementation
+
+uses SysUtils,
+ {$IFDEF win32}
+ windows,
+ {$ELSE}
+ lclintf,
+ {$ENDIF}
+ UDrawTexture;
+
+procedure TButton.SetX(Value: real);
+{var
+ dx: real;
+ T: integer; // text}
+begin
+ {dY := Value - Texture.y;
+
+ Texture.X := Value;
+
+ for T := 0 to High(Text) do
+ Text[T].X := Text[T].X + dY;}
+
+ PosX := Value;
+ if (FadeTex.TexNum = -1) then
+ Texture.X := Value;
+
+end;
+
+procedure TButton.SetY(Value: real);
+{var
+ dY: real;
+ T: integer; // text}
+begin
+ {dY := Value - PosY;
+
+
+ for T := 0 to High(Text) do
+ Text[T].Y := Text[T].Y + dY;}
+
+ PosY := Value;
+ if (FadeTex.TexNum = -1) then
+ Texture.y := Value;
+end;
+
+procedure TButton.SetW(Value: real);
+begin
+ if SelectW = DeSelectW then
+ SelectW := Value;
+
+ DeSelectW := Value;
+
+ if Not Fade then
+ begin
+ if SelectBool then
+ Texture.W := SelectW
+ else
+ Texture.W := DeSelectW;
+ end;
+end;
+
+procedure TButton.SetH(Value: real);
+begin
+ if SelectH = DeSelectH then
+ SelectH := Value;
+
+ DeSelectH := Value;
+
+ if Not Fade then
+ begin
+ if SelectBool then
+ Texture.H := SelectH
+ else
+ Texture.H := DeSelectH;
+ end;
+end;
+
+procedure TButton.SetSelect(Value : Boolean);
+var
+ T: integer;
+begin
+ SelectBool := Value;
+ if (Value) then begin
+ Texture.ColR := SelectColR;
+ Texture.ColG := SelectColG;
+ Texture.ColB := SelectColB;
+ Texture.Int := SelectInt;
+
+ Texture2.ColR := SelectColR;
+ Texture2.ColG := SelectColG;
+ Texture2.ColB := SelectColB;
+ Texture2.Int := SelectInt;
+
+ for T := 0 to High(Text) do
+ Text[T].Int := SelectTInt;
+
+ //Fade Mod
+ if Fade then
+ begin
+ if (FadeProgress <= 0) then
+ FadeProgress := 0.125;
+ end
+ else
+ begin
+ Texture.W := SelectW;
+ Texture.H := SelectH;
+ end;
+ end else begin
+ Texture.ColR := DeselectColR;
+ Texture.ColG := DeselectColG;
+ Texture.ColB := DeselectColB;
+ Texture.Int := DeselectInt;
+
+ Texture2.ColR := DeselectColR;
+ Texture2.ColG := DeselectColG;
+ Texture2.ColB := DeselectColB;
+ Texture2.Int := DeselectInt;
+
+ for T := 0 to High(Text) do
+ Text[T].Int := DeselectTInt;
+
+ //Fade Mod
+ if Fade then
+ begin
+ if (FadeProgress >= 1) then
+ FadeProgress := 0.875;
+ end
+ else
+ begin
+ Texture.W := DeSelectW;
+ Texture.H := DeSelectH;
+ end;
+ end;
+end;
+
+constructor TButton.Create();
+begin
+ inherited Create;
+ // We initialize all to 0, nil or false
+ Visible := true;
+ SelectBool := false;
+ DeselectType := 0;
+ Selectable := true;
+ //Reflection Mod
+ Reflection := true;
+
+ //colorized hack
+ Colorized:=False;
+
+ // Default
+// SelectInt := 1;
+// DeselectInt := 0.5;
+
+{ SelectColR := 0.5;
+ SelectColG := 0.75;
+ SelectColB := 0;
+ SelectInt := 1;
+ SelectTInt := 1;
+
+ DeselectColR := 1;
+ DeselectColG := 1;
+ DeselectColB := 1;
+ DeselectInt := 0.5;
+ DeselectTInt := 1;}
+
+ SelectColR := 1;
+ SelectColG := 1;
+ SelectColB := 1;
+ SelectInt := 1;
+ SelectTInt := 1;
+
+ DeselectColR := 1;
+ DeselectColG := 1;
+ DeselectColB := 1;
+ DeselectInt := 0.5;
+ DeselectTInt := 1;
+
+ FadeTex.TexNum := -1;
+
+ FadeProgress := 0;
+ Fade := False;
+ FadeText := False;
+ SelectW := DeSelectW;
+ SelectH := DeSelectH;
+
+ PosX := 0;
+ PosY := 0;
+
+ Parent := 0;
+end;
+
+// ***** Public methods ****** //
+
+procedure TButton.Draw;
+var
+ T: integer;
+ Tick: Cardinal;
+ Spacing: Real;
+begin
+ if Visible then begin
+ //Fade Mod
+ T:=0;
+ if Fade then
+ begin
+ if (FadeProgress < 1) and (FadeProgress > 0) then
+ begin
+ Tick := GetTickCount div 16;
+ if (Tick <> FadeLastTick) then
+ begin
+ FadeLastTick := Tick;
+ if SelectBool then
+ FadeProgress := FadeProgress + 0.125
+ else
+ FadeProgress := FadeProgress - 0.125;
+
+ if (FadeText) then
+ begin
+ For T := 0 to high(Text) do
+ begin
+ Text[T].MoveX := (SelectW - DeSelectW) * FadeProgress;
+ Text[T].MoveY := (SelectH - DeSelectH) * FadeProgress;
+ end;
+ end;
+ end;
+ end;
+ //Method without Fade Texture
+ if (FadeTex.TexNum = -1) then
+ begin
+ Texture.W := DeSelectW + (SelectW - DeSelectW) * FadeProgress;
+ Texture.H := DeSelectH + (SelectH - DeSelectH) * FadeProgress;
+ DeselectTexture.W := Texture.W;
+ DeselectTexture.H := Texture.H;
+ end
+ else //method with Fade Texture
+ begin
+ Texture.W := DeSelectW;
+ Texture.H := DeSelectH;
+ DeselectTexture.W := Texture.W;
+ DeselectTexture.H := Texture.H;
+
+ FadeTex.ColR := Texture.ColR;
+ FadeTex.ColG := Texture.ColG;
+ FadeTex.ColB := Texture.ColB;
+ FadeTex.Int := Texture.Int;
+
+ FadeTex.Z := Texture.Z;
+
+ FadeTex.Alpha := Texture.Alpha;
+ FadeTex.TexX1 := 0;
+ FadeTex.TexX2 := 1;
+ FadeTex.TexY1 := 0;
+ FadeTex.TexY2 := 1;
+
+ Case FadeTexPos of
+ 0: //FadeTex on Top
+ begin
+ //Standard Texture
+ Texture.X := PosX;
+ Texture.Y := PosY + (SelectH - DeSelectH) * FadeProgress;
+ DeselectTexture.X := Texture.X;
+ DeselectTexture.Y := Texture.Y;
+ //Fade Tex
+ FadeTex.X := PosX;
+ FadeTex.Y := PosY;
+ FadeTex.W := Texture.W;
+ FadeTex.H := (SelectH - DeSelectH) * FadeProgress;
+ FadeTex.ScaleW := Texture.ScaleW;
+ //Some Hack that Fixes a little Space between both Textures
+ FadeTex.TexY2 := 0.9;
+ end;
+ 1: //FadeTex on Left
+ begin
+ //Standard Texture
+ Texture.X := PosX + (SelectW - DeSelectW) * FadeProgress;
+ Texture.Y := PosY;
+ DeselectTexture.X := Texture.X;
+ DeselectTexture.Y := Texture.Y;
+ //Fade Tex
+ FadeTex.X := PosX;
+ FadeTex.Y := PosY;
+ FadeTex.H := Texture.H;
+ FadeTex.W := (SelectW - DeSelectW) * FadeProgress;
+ FadeTex.ScaleH := Texture.ScaleH;
+ //Some Hack that Fixes a little Space between both Textures
+ FadeTex.TexX2 := 0.9;
+ end;
+ 2: //FadeTex on Bottom
+ begin
+ //Standard Texture
+ Texture.X := PosX;
+ Texture.Y := PosY;
+ DeselectTexture.X := Texture.X;
+ DeselectTexture.Y := Texture.Y;
+ //Fade Tex
+ FadeTex.X := PosX;
+ FadeTex.Y := PosY + (SelectH - DeSelectH) * FadeProgress;;
+ FadeTex.W := Texture.W;
+ FadeTex.H := (SelectH - DeSelectH) * FadeProgress;
+ FadeTex.ScaleW := Texture.ScaleW;
+ //Some Hack that Fixes a little Space between both Textures
+ FadeTex.TexY1 := 0.1;
+ end;
+ 3: //FadeTex on Right
+ begin
+ //Standard Texture
+ Texture.X := PosX;
+ Texture.Y := PosY;
+ DeselectTexture.X := Texture.X;
+ DeselectTexture.Y := Texture.Y;
+ //Fade Tex
+ FadeTex.X := PosX + (SelectW - DeSelectW) * FadeProgress;
+ FadeTex.Y := PosY;
+ FadeTex.H := Texture.H;
+ FadeTex.W := (SelectW - DeSelectW) * FadeProgress;
+ FadeTex.ScaleH := Texture.ScaleH;
+ //Some Hack that Fixes a little Space between both Textures
+ FadeTex.TexX1 := 0.1;
+ end;
+ end;
+ end;
+ end
+ else if (FadeText) then
+ begin
+ Text[T].MoveX := (SelectW - DeSelectW);
+ Text[T].MoveY := (SelectH - DeSelectH);
+ end;
+
+ if SelectBool or (FadeProgress > 0) or not Colorized then
+ DrawTexture(Texture)
+ else
+ DrawTexture(DeselectTexture);
+
+ //Draw FadeTex
+ if (FadeTex.TexNum <> -1) then
+ DrawTexture(FadeTex);
+
+ if Texture2.Alpha > 0 then begin
+ Texture2.ScaleW := Texture.ScaleW;
+ Texture2.ScaleH := Texture.ScaleH;
+
+ Texture2.X := Texture.X;
+ Texture2.Y := Texture.Y;
+ Texture2.W := Texture.W;
+ Texture2.H := Texture.H;
+
+ Texture2.ColR := Texture.ColR;
+ Texture2.ColG := Texture.ColG;
+ Texture2.ColB := Texture.ColB;
+ Texture2.Int := Texture.Int;
+
+ Texture2.Z := Texture.Z;
+
+ DrawTexture(Texture2);
+ end;
+
+ //Reflection Mod
+ if (Reflection) then // Draw Reflections
+ begin
+ if (FadeProgress <> 0) AND (FadeProgress <> 1) then
+ begin
+ Spacing := DeSelectReflectionspacing - (DeSelectReflectionspacing - Reflectionspacing) * FadeProgress;
+ end
+ else if SelectBool then
+ Spacing := Reflectionspacing
+ else
+ Spacing := DeSelectReflectionspacing;
+
+ if SelectBool or not Colorized then
+ with Texture do
+ begin
+ //Bind Tex and GL Attributes
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+
+ glDepthRange(0, 10);
+ glDepthFunc(GL_LEQUAL);
+ glEnable(GL_DEPTH_TEST);
+
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glBindTexture(GL_TEXTURE_2D, TexNum);
+
+ //Draw
+ glBegin(GL_QUADS);//Top Left
+ glColor4f(ColR * Int, ColG * Int, ColB * Int, Alpha-0.3);
+ glTexCoord2f(TexX1*TexW, TexY2*TexH);
+ glVertex3f(x, y+h*scaleH+ Spacing, z);
+
+ //Bottom Left
+ glColor4f(ColR * Int, ColG * Int, ColB * Int, 0);
+ glTexCoord2f(TexX1*TexW, TexY1+TexH*0.5);
+ glVertex3f(x, y+h*scaleH + h*scaleH/2 + Spacing, z);
+
+
+ //Bottom Right
+ glColor4f(ColR * Int, ColG * Int, ColB * Int, 0);
+ glTexCoord2f(TexX2*TexW, TexY1+TexH*0.5);
+ glVertex3f(x+w*scaleW, y+h*scaleH + h*scaleH/2 + Spacing, z);
+
+ //Top Right
+ glColor4f(ColR * Int, ColG * Int, ColB * Int, Alpha-0.3);
+ glTexCoord2f(TexX2*TexW, TexY2*TexH);
+ glVertex3f(x+w*scaleW, y+h*scaleH + Spacing, z);
+ glEnd;
+
+ glDisable(GL_TEXTURE_2D);
+ glDisable(GL_DEPTH_TEST);
+ glDisable(GL_BLEND);
+ end else
+ with DeselectTexture do
+ begin
+ //Bind Tex and GL Attributes
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+
+ glDepthRange(0, 10);
+ glDepthFunc(GL_LEQUAL);
+ glEnable(GL_DEPTH_TEST);
+
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glBindTexture(GL_TEXTURE_2D, TexNum);
+
+ //Draw
+ glBegin(GL_QUADS);//Top Left
+ glColor4f(ColR * Int, ColG * Int, ColB * Int, Alpha-0.3);
+ glTexCoord2f(TexX1*TexW, TexY2*TexH);
+ glVertex3f(x, y+h*scaleH+ Spacing, z);
+
+ //Bottom Left
+ glColor4f(ColR * Int, ColG * Int, ColB * Int, 0);
+ glTexCoord2f(TexX1*TexW, TexY1+TexH*0.5);
+ glVertex3f(x, y+h*scaleH + h*scaleH/2 + Spacing, z);
+
+
+ //Bottom Right
+ glColor4f(ColR * Int, ColG * Int, ColB * Int, 0);
+ glTexCoord2f(TexX2*TexW, TexY1+TexH*0.5);
+ glVertex3f(x+w*scaleW, y+h*scaleH + h*scaleH/2 + Spacing, z);
+
+ //Top Right
+ glColor4f(ColR * Int, ColG * Int, ColB * Int, Alpha-0.3);
+ glTexCoord2f(TexX2*TexW, TexY2*TexH);
+ glVertex3f(x+w*scaleW, y+h*scaleH + Spacing, z);
+ glEnd;
+
+ glDisable(GL_TEXTURE_2D);
+ glDisable(GL_DEPTH_TEST);
+ glDisable(GL_BLEND);
+ end;
+ end;
+
+ for T := 0 to High(Text) do begin
+ Text[T].Draw;
+ end;
+ end;
+end;
+
+// ***** ****** //
+
+destructor TButton.Destroy;
+begin
+ inherited;
+end;
+
+constructor TButton.Create(Textura: TTexture);
+begin
+ Create();
+ Texture := Textura;
+ DeselectTexture:=Textura;
+ Texture.ColR := 0;
+ Texture.ColG := 0.5;
+ Texture.ColB := 0;
+ Texture.Int := 1;
+ Colorized:=False;
+end;
+
+constructor TButton.Create(Textura, DSTexture: TTexture);
+begin
+ Create();
+ Texture := Textura;
+ DeselectTexture := DSTexture;
+ Texture.ColR := 1;
+ Texture.ColG := 1;
+ Texture.ColB := 1;
+ Texture.Int := 1;
+ Colorized:=True;
+end;
+
+end.
diff --git a/Game/Code/Menu/UMenuText.pas b/Game/Code/Menu/UMenuText.pas
index cba237b8..d1c8b7b1 100644
--- a/Game/Code/Menu/UMenuText.pas
+++ b/Game/Code/Menu/UMenuText.pas
@@ -1,329 +1,339 @@
-unit UMenuText;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-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;
- Alpha: 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;
-
- //Set Cursor Visible
- SelectBlink := True;
- STicks := GettickCount div 550;
-
- //Exit if there is no Need to Create Tiles
- If (W <= 0) and (Pos('\n', Value) = 0) then
- begin
- SetLength (TextTiles, 1);
- TextTiles[0] := Value;
- Exit;
- end;
-
- //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
- isBreak := False;
- //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;
-
- isBreak := True;
- //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);
-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);
- glColor4f(ColR*Int, ColG*Int, ColB*Int, Alpha);
-
- //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}
- //Now Use allways:
- //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));
-
- {if Size >= 10 then
- Y2 := Y2 + Size * 2.8
- else}
- if (Style = 1) then
- Y2 := Y2 + Size * 2.8
- else
- Y2 := Y2 + Size * 2.15;
- 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;
- Alpha := 1;
- 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.
+unit UMenuText;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+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;
+ Alpha: 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,
+ {$IFDEF win32}
+ windows,
+ {$ELSE}
+ lclintf,
+ {$ENDIF}
+ StrUtils;
+
+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;
+
+ //Set Cursor Visible
+ SelectBlink := True;
+ STicks := GettickCount div 550;
+
+ //Exit if there is no Need to Create Tiles
+ If (W <= 0) and (Pos('\n', Value) = 0) then
+ begin
+ SetLength (TextTiles, 1);
+ TextTiles[0] := Value;
+ Exit;
+ end;
+
+ //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
+ isBreak := False;
+ //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;
+
+ isBreak := True;
+ //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);
+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);
+ glColor4f(ColR*Int, ColG*Int, ColB*Int, Alpha);
+
+ //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}
+ //Now Use allways:
+ //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));
+
+ {if Size >= 10 then
+ Y2 := Y2 + Size * 2.8
+ else}
+ if (Style = 1) then
+ Y2 := Y2 + Size * 2.8
+ else
+ Y2 := Y2 + Size * 2.15;
+ 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;
+ Alpha := 1;
+ 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.
generated by cgit v1.2.3 (git 2.25.1) at 2024-10-31 07:58:26 +0000