#1
|
|||
|
|||
[Delphi] Flicker Free Text Scrolling with Double Buffering
http://s19.postimg.org/69f4hvu4j/image.gif
Code:
{ Flicker Free Text Scrolling with Double Buffering Original C++ Source: http://www.codeproject.com/Tips/610388/Flicker-Free-Text-Scrolling-with-Double-Buffering Converted to Delphi by Agmcz Rlz Date: 17-12-2015 } program w32; uses Windows, Messages; {$R w32.RES} const IDD_DIALOG1 = 101; IDB_BITMAP1 = 102; var hIns: HINST; hSkin: HBITMAP; rcClient, rcText: TRect; nLines: Integer = 0; TextLen: Integer = 0; lf: LOGFONT; _hFont: HFONT; ScrollConst: Integer = 1; CLR: COLORREF; cx, cy: LongInt; hdcBackground: HDC; ndcBackground: Integer; const Text = 'Simple flicker free text scrolling' + #13#10 + 'Coded by Tejashwi Kalp Taru' + #13#10 + #13#10 + 'Enjoy the double buffer' + #13#10 + #13#10 + 'Thanks to codeproject.com for a nice place' + #13#10 + 'for developer to developer'; function DlgProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL stdcall; var bm: BITMAP; hdcScreen: HDC; i: Integer; sizeAboutText: TSIZE; _hDC: HDC; hDCMem: HDC; ps: PAINTSTRUCT; ndcmem: Integer; hbmMem: HBITMAP; begin case Msg of WM_INITDIALOG: begin // Loads the bitmap, get its CX,CY and get compatibe device context hSkin := LoadBitmap(hIns, MAKEINTRESOURCE(IDB_BITMAP1)); GetObject(hSkin, sizeof(bm), @bm); cx := bm.bmWidth; cy := bm.bmHeight; hdcScreen := GetDC(hWnd); hdcBackground := CreateCompatibleDC(hdcScreen); ndcBackground := SaveDC(hdcBackground); SelectObject(hdcBackground, hSkin); ReleaseDC(hWnd, hdcScreen); //------------------------------------------------------------------ // Counts the number of lines in scroll text TextLen := lstrlen(Text); for i := 1 to TextLen do begin if (Text[i] = #13#10) then Inc(nLines); end; //------------------------------------------ // Create a font as desired ZeroMemory(@lf, sizeof(LOGFONT)); lstrcpy(lf.lfFaceName, 'Lucida Console'); lf.lfHeight := 20; lf.lfWeight := FW_BOLD; lf.lfQuality := ANTIALIASED_QUALITY; _hFont := CreateFontIndirect(lf); GetClientRect(hWnd, rcClient); //----------------------------------- // Gets the size of total scroll texts _hDC := GetDC(hWnd); hDCMem := CreateCompatibleDC(_hDC); SelectObject(hDCMem, _hFont); GetTextExtentPoint32A(hDCMem, Text, TextLen, sizeAboutText); ReleaseDC(hWnd, _hDC); DeleteDC(hDCMem); //----------------------------------------------------------- // Calculates the needed size for given scroller text rcText.bottom := rcText.bottom + (sizeAboutText.cy * (nLines + 3)) + rcClient.bottom; rcText.top := rcClient.bottom; rcText.right := rcClient.right; rcText.left := rcClient.left; //---------------------------------------------------------------- SetTimer(hWnd, 1, 20, 0); // Starts timer of duration of 20MS Result := True; end; WM_TIMER: begin // Check and set the current range of scroll text and sets color of text accordingly rcText.top := rcText.top + ScrollConst; rcText.bottom := rcText.bottom + ScrollConst; if (rcText.top >= rcClient.bottom + 10) then begin ScrollConst := -1; CLR := RGB(0, 0, 255); end; if (rcText.bottom <= rcClient.top) then begin ScrollConst := 1; CLR := RGB(255, 0, 0); end; //----------------------------------------------------------------------------------- InvalidateRect(hWnd, nil, False); // Invalidates the window, WM_PAINT caused !!! Result := True; end; WM_PAINT: begin if BeginPaint(hWnd, ps) > 0 then begin //Creating double buffer hdcMem := CreateCompatibleDC(ps.hdc); ndcmem := SaveDC(hdcMem); hbmMem := CreateCompatibleBitmap(ps.hdc, cx, cy); SelectObject(hdcMem, hbmMem); //------------------------------------------------------- // Copy background bitmap into double buffer BitBlt(hdcMem, 0, 0, cx, cy, hdcBackground, 0, 0, SRCCOPY); //--------------------------------------------------------- // Draw the text SelectObject(hdcMem, _hFont); SetTextColor(hdcMem, CLR); SetBkMode(hdcMem, TRANSPARENT); DrawText(hdcMem, Text, -1, rcText, DT_CENTER or DT_TOP or DT_NOPREFIX or DT_NOCLIP); //----------------------------------------------------------------------------- // Copy double buffer to screen BitBlt(ps.hdc, 0, 0, cx, cy, hdcMem, 0, 0, SRCCOPY); //-------------------------------------------------- // Clean up RestoreDC(hdcMem, ndcmem); DeleteObject(hbmMem); DeleteDC(hdcMem); EndPaint(hWnd, ps); //-------------------- end else begin KillTimer(hWnd, 1); MessageBox(hWnd, 'Unable to render graphics' + #13#10 + 'Error : Can not start painting!', 'Error', MB_ICONERROR); end; Result := True; end; WM_CLOSE: begin KillTimer(hWnd, 1); RestoreDC(hdcBackground, ndcBackground); DeleteDC(hdcBackground); DeleteObject(hSkin); DeleteObject(_hFont); EndDialog(hWnd, 0); Result := True; end; end; Result := False; end; begin hIns := hInstance; DialogBoxParam(hInstance, PChar(IDD_DIALOG1), 0, @DlgProc, 0); end. |
|
|