From aad5222e01e05f53e013a9b793fdea182f304a4f Mon Sep 17 00:00:00 2001 From: RD42 <42702181+dashr9230@users.noreply.github.com> Date: Tue, 12 Dec 2023 22:45:17 +0800 Subject: [PATCH] [exgui] Implement TfmAbout functions --- exgui/About.dfm | Bin 528 -> 447 bytes exgui/About.pas | 230 ++++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 223 insertions(+), 7 deletions(-) diff --git a/exgui/About.dfm b/exgui/About.dfm index fd55b0788d3c81867f4fa9181daa38e5f82e3bf6..d8238b3a25f77cccf796759a423f845feb1bf5ea 100644 GIT binary patch literal 447 zcmXv}%~FFf5T;-WEvUVC_XTwN3KYdUV+$i_FOHhRRx*Yx6Vhq>P`;hxRYRz!d_UQ5 z_xl}NdAtZ`$y07kCtm~0%F}r2<(oQO<5rR5d-4Dq<-FKVj*VUWGn6IBOdU87cik>g z0EuX$7z)=ngO^!&wMc`AGZ1PH?4wf7kLCA##Y$BCpl7=^lyDk@u0BnX$;{aZ8-AG6zh+*>9sDENwr5_dW5m2ZrGzx_Qj zY)NZyhoNMY_j9I)?{3-|^3pm>co|8c3X-m*=cU-Pt{Is$xS&kLDCO=)87mpCE^BJCGkM?jj}!xHxXHdJK}X(hfY(r2i~S2??qAB N@8ho3vCp|>{Q>XHlX3t6 literal 528 zcmX|;L2tq^42AFfirhFc0Rto^?NGWgkOow1H4f7>h1RUuLR>jPjDJ77w7orlFShGf zJp4c&)bSJ@@Ejgg)~KFRuW$_NQO$-EE;6iGkA`#B3#0-l4Oa`y4t|Rc7{|H_1|6e* zJxrz1V3YL4u?AdNf%z_F;&?La;NBFWWOhFt3PX#;Rc>EMUm0Yiov$=;d+ohzdzPiS z-DpB|{A7tP+{L9P4>CO3rt7bG6}_d;S?6|R_r?`?$>1-vUiVdl(YR$>eUc^ph>W&! zK)s_q_~YmoXp2wgJ6psAI>1g6;g+SgUb0Bgn*6FAWySEHQszeFC(0xx_t}KOix5=Z~g6a7FJQ Dpm?PL diff --git a/exgui/About.pas b/exgui/About.pas index 0bdf1ab..5ceed0e 100644 --- a/exgui/About.pas +++ b/exgui/About.pas @@ -4,7 +4,7 @@ interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs; + Dialogs, MMSystem, StdCtrls, Jpeg; type TfmAbout = class(TForm) @@ -19,36 +19,252 @@ type { Public declarations } end; + TBGRArray = Array[0..MaxInt div SizeOf(TRGBQuad)-1] of TRGBQuad; + PBGRArray = ^TBGRArray; + + TCreditLine = record + Line: String; + Color: COLORREF; + Bold: Boolean; + end; + +const + COLOR_TITLE = $000080FF; + COLOR_NAME = $00FFFFFF;//$00FFAA00; + COLOR_URL = $00FFAA00;//$008000FF; + var + CreditLines: Array[0..45] of TCreditLine = + ( + //---------- Header Start + //(Line: 'Grand Theft Auto'; Color: $00FF8000; Bold: true), + (Line: 'San Andreas'; Color: COLOR_NAME; Bold: true), + (Line: 'Multiplayer'; Color: COLOR_TITLE; Bold: true), + //---------- Header End + + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + + //---------- Coder Start + (Line: 'Coding:'; Color: COLOR_TITLE; Bold: true), + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: 'Kalcor'; Color: COLOR_NAME; Bold: false), + (Line: 'spookie'; Color: COLOR_NAME; Bold: false), + //---------- Coder End + + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + + //---------- Past Coders Start + (Line: 'Past coders:'; Color: COLOR_TITLE; Bold: true), + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: 'Y_Less'; Color: COLOR_NAME; Bold: false), + //---------- Past Coders End + + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + + //---------- Tester Start + (Line: 'Beta Testing:'; Color: COLOR_TITLE; Bold: true), + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: 'BlueG, cessil, CrazyBob'; Color: COLOR_NAME; Bold: false), + (Line: 'DamianC, dugi, d0'; Color: COLOR_NAME; Bold: false), + (Line: 'Jay, JernejL, kaisersouse'; Color: COLOR_NAME; Bold: false), + (Line: 'KingJ, Matite, Mmartin'; Color: COLOR_NAME; Bold: false), + (Line: 'RayW, Si|ent, Wicko'; Color: COLOR_NAME; Bold: false), + //---------- Tester End + + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + + //---------- URL Start + (Line: 'www.sa-mp.com'; Color: COLOR_URL; Bold: true), + //---------- URL End + + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false), // Spacer + (Line: ''; Color: 666; Bold: false) // Spacer + ); + fmAbout: TfmAbout; + CritSect: _RTL_CRITICAL_SECTION; + GameOver: Boolean; + + DIBWidth: Integer; + DIBHeight: Integer; + + // Timing + Ticks: Cardinal; + TimeScale: Integer = 1; + + // Drawing + RenderThread: THandle; + bmi: BITMAPINFO; + hDC1, hDC2: HDC; + Buf: PBGRArray; + hBmp: HBITMAP; + hNormFont, hBoldFont: HFONT; + xRect: TRect; implementation {$R *.dfm} -procedure TfmAbout.FormShow(Sender: TObject); +var + CreditsRollY: Integer = 300; + TempCRY: Integer = 0; +procedure Flip; +var + i: Integer; begin - // TODO: TfmAbout.FormShow + SetDIBits(hDC2, hBmp, 0, DIBHeight, @Buf[0], bmi, DIB_RGB_COLORS); + + Inc(TempCRY, TimeScale); + if TempCRY >= 5 then begin + TempCRY:= 0; + Dec(CreditsRollY, TimeScale); + if CreditsRollY < -((High(CreditLines) * 12) + 50) then + CreditsRollY:= 300; + end; + + xRect.Top:= CreditsRollY; + for i:= 0 to High(CreditLines) do begin + if (CreditLines[i].Color <> 666) and (xRect.Top > -12) and (xRect.Top < 300) then begin + SetTextColor(hDC2, CreditLines[i].Color); + if CreditLines[i].Bold then + SelectObject(hDC2, hBoldFont) + else + SelectObject(hDC2, hNormFont); + DrawText(hDC2, PChar(CreditLines[i].Line), -1, xRect, DT_NOCLIP or DT_CENTER); + end; + Inc(xRect.Top, 20); + end; + + BitBlt(hDC1, 2, 2, DIBWidth, DIBHeight, hDC2, 0, 0, SRCCOPY); +end; + +procedure Render; +var + t: Cardinal; +begin + timeBeginPeriod(1); + t:= timeGetTime; + timeEndPeriod(1); + TimeScale:= Round(100 / (1000 / (t - Ticks))); + Ticks:= t; + + ZeroMemory(Buf, (DIBWidth*DIBHeight)*4); + + Flip; +end; + +procedure RenderTimer; +begin + while true do begin + Sleep(10); + EnterCriticalSection(CritSect); + if GameOver then begin + LeaveCriticalSection(CritSect); + Exit; + end; + Render; + LeaveCriticalSection(CritSect); + end; +end; + +procedure TfmAbout.FormShow(Sender: TObject); +var + FontStruct: LogFont; +begin + CreditsRollY:= 300; + + GetMem(Buf, (DIBWidth*DIBHeight)*4); + hDC1:= GetDC(fmAbout.Handle); + hDC2:= CreateCompatibleDC(hDC1); + hBmp:= CreateCompatibleBitmap(hDC1, DIBWidth, DIBHeight); + ZeroMemory(@FontStruct, SizeOf(FontStruct)); + FontStruct.lfWidth:= 0; + FontStruct.lfHeight:= -18; + FontStruct.lfQuality:= ANTIALIASED_QUALITY; + FontStruct.lfFaceName:= 'Arial'; + hNormFont:= CreateFontIndirect(FontStruct); + FontStruct.lfWeight:= FW_BOLD; + hBoldFont:= CreateFontIndirect(FontStruct); + + SelectObject(hDC2, hBmp); + SetBkMode(hDC2, TRANSPARENT); + + Ticks:= timeGetTime; + GameOver:= false; + BeginThread(nil, 0, @RenderTimer, nil, 0, RenderThread); end; procedure TfmAbout.FormClose(Sender: TObject; var Action: TCloseAction); begin - // TODO: TfmAbout.FormClose + EnterCriticalSection(CritSect); + + GameOver:= true; + + DeleteObject(hNormFont); + DeleteObject(hBoldFont); + DeleteObject(hBmp); + DeleteDC(hDC1); + DeleteDC(hDC2); + FreeMem(Buf); + + LeaveCriticalSection(CritSect); end; procedure TfmAbout.FormCreate(Sender: TObject); begin - // TODO: TfmAbout.FormCreate + InitializeCriticalSection(CritSect); + + DIBWidth:= ClientWidth - 4; + DIBHeight:= ClientHeight - 4; + + xRect:= Rect(0, 0, ClientWidth, ClientHeight); + + with bmi.bmiHeader do begin + biSize:= SizeOf(bmi.bmiHeader); + biWidth:= DIBWidth; + biHeight:= -DIBHeight; + biPlanes:= 1; + biBitCount:= 32; + biCompression:= BI_RGB; + biSizeImage:= 0; + biXPelsPerMeter:= 0; + biYPelsPerMeter:= 0; + biClrUsed:= 0; + biClrImportant:= 0; + end; end; procedure TfmAbout.FormDestroy(Sender: TObject); begin - // TODO: TfmAbout.FormDestroy + DeleteCriticalSection(CritSect); end; procedure TfmAbout.FormClick(Sender: TObject); begin - // TODO: TfmAbout.FormClick + Close; end; end.