From db82b7e30a1b58b56fdb4bfc6089b47200ca1da1 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 06:36:58 +0000 Subject: Ultrastar-DX now compiles in linux (using lazarus) Bass etc is commented out.. but it compiles, and im working through the runtime errors. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@408 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Menu/UDisplay.pas | 929 ++++++++++++++++---------------- Game/Code/Menu/UMenuButton.pas | 1137 ++++++++++++++++++++-------------------- Game/Code/Menu/UMenuText.pas | 668 +++++++++++------------ 3 files changed, 1380 insertions(+), 1354 deletions(-) (limited to 'Game/Code/Menu') 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. -- cgit v1.2.3