OffScreenBitmap realisieren ohne VCL

[Luckie]

Man steht immer wieder vor dem Problem, wenn man auf den Canvas des Fensters oder der Paintbox zeichnet, dass das Gezeichnete verloren geht, so bald das Fenster von Windows neugezeichnet werden muss. Hier nun eine Lösung für die nonVCL-Programmierung. Die Kommentare im Code sollten, das Vorgehen erklären. Man zeichent nicht auf den Canvas, sondern auf ein Bitmap im Speicher und kopiert das Bitmap im Speicher bei Bedarf (WM_PAINT / OnPaint) auf den Canvas. Ohne VCL ist es etwas aufwendiger aber dennoch mit relativ wenig Code realisierbar.

Startet man das Programm, wird das Fenster rot gefüllt. Zieht man mit gedrücklter rechter Maustaste ein Rechteck auf, wird selbiges weiß mit schwarzem Rand gezeichnet.

Delphi-Quellcode:

{******************************************************************************}
{                                                                              }
{                              Offscreen-Bitmap                                }
{                                                                              }
{                  Copyright (c) 2004 Michael .:Luckie:. Puff                  }
{                          [url]www.luckie-online.de[/url]                                }
{                                                                              }
{******************************************************************************}

program OffScreenBmp;

uses
  Windows, Messages;

const
  CLASSNAME = 'WndClass';
  APPNAME = 'OffScreen-Bitmap';
  WINDOWWIDTH = 500;
  WINDOWHEIGHT = 350;

var
  hdcMem: HDC;
  hBmp: THandle;
  hBmpOld: THandle;

function WndProc(hWnd: HWND; uMsg: UINT; wParam: wParam; lParam: LParam):
  lresult; stdcall;
var
  rect: TRect;
  RedBrush: HBRUSH;
  ps: TPaintStruct;
  dc: HDC;
  ptStart, ptEnd: TPoint;
begin
  Result := 0;
  case uMsg of
    WM_CREATE:
      begin
        // Create a screen compatible DC in memory
        hdcMem := CreateCompatibleDC(0);
        // Create a Bitmap compatible to the window
        hBmp := CreateCompatibleBitmap(GetDC(hWnd), WINDOWWIDTH, WINDOWHEIGHT);
        // Select Bitmap into the memory DC and saving the old one
        hBmpOld := SelectObject(hdcMem, hBmp);
        // Release the Bitmap
        DeleteObject(hBmp);

        rect.Left := 0;
        rect.Top := 0;
        rect.Right := WINDOWWIDTH;
        rect.Bottom := WINDOWHEIGHT;
        RedBrush := CreateSolidBrush(RGB(255, 0, 0));
        // paint red rectangle on the Bitmap in memory
        FillRect(hdcMem, rect, RedBrush);
        DeleteObject(RedBrush);
      end;
    WM_PAINT:
      begin
        dc := BeginPaint(hWnd, ps);
        // everytime window needs to be painted, copy the Bitmap in memory
        // onto the window
        BitBlt(dc, 0, 0, WINDOWWIDTH, WINDOWHEIGHT, hdcMem, 0, 0, SRCCOPY);
        EndPaint(hWnd, ps);
      end;
    WM_LBUTTONDOWN:
      begin
        // starting coordinates
        ptStart.X := LoWord(lParam);
        ptStart.Y := HiWord(lParam);
      end;
    WM_LBUTTONUP:
      begin
        // ending coordinates
        ptEnd.X := LoWord(lParam);
        ptEnd.Y := HiWord(lParam);
        // paint rectangle on Bitmap in memory
        Rectangle(hdcMem, ptStart.X, ptStart.Y, ptEnd.X, ptEnd.Y);
        // declare window invalide, force WM_PAINT 
        InvalidateRect(hWnd, nil, False);
      end;
    WM_DESTROY:
      begin
        SelectObject(hdcMem, hBmpOld);
        DeleteObject(hdcMem);
        PostQuitMessage(0);
      end;
  else
    Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  end;
end;

var
  wc: TWndClassEx = (
    cbSize: SizeOf(TWndClassEx);
    Style: CS_HREDRAW or CS_VREDRAW;
    lpfnWndProc: @WndProc;
    cbClsExtra: 0;
    cbWndExtra: 0;
    lpszMenuName: nil;
    lpszClassName: ClassName;
    hIconSm: 0;
    );
  msg: TMsg;
begin
  wc.hInstance := hInstance;
  wc.hbrBackground := GetStockObject(WHITE_BRUSH);
  wc.hIcon := LoadIcon(0, IDI_APPLICATION);
  wc.hCursor := LoadCursor(0, IDC_ARROW);

  RegisterClassEx(wc);
  CreateWindowEx(0, ClassName, AppName, WS_OVERLAPPEDWINDOW or
    WS_VISIBLE or WS_SYSMENU or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_SIZEBOX,
    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), WINDOWWIDTH, WINDOWHEIGHT,
    0, 0, hInstance, nil);

  while true do
  begin
    if not GetMessage(msg, 0, 0, 0) then
      break;
    begin
      TranslateMessage(msg);
      DispatchMessage(msg);
    end;
  end;
  ExitCode := msg.wParam;
end.