Bildschirm wird neugezeichnet

[turboPASCAL]

Wenn du nicht die TimerProc verwendest is alles ok.

Delphi-Quellcode:

program Timer;

uses
  Windows, Messages;

const
  ClassName         = 'WndClass';
  AppName           = 'Timer';
  WindowWidth       = 350;
  WindowHeight      = 250;

var
  TimeRect          : TRect = (Left: 10; Top: 10; Right: 200; Bottom: 100);

procedure TimerCallback(hWnd: HWND; uMsg: UINT; IDTimer: UINT; dwTime: DWORD);
begin
  KillTimer(hWnd, IDTimer);
  InvalidateRect(hWnd, @TimeRect, FALSE);
end;

procedure PaintContent(hwnd: HWND;  ps: PAINTSTRUCT);
var
  szTime            : PChar;
  lenTime           : Cardinal;
  clrBk             : COLORREF;
begin
  lenTime := GetTimeFormat(LOCALE_USER_DEFAULT, 0, nil, nil, nil, 0);
  if lenTime > 0 then
  begin
    GetMem(szTime, lenTime);
    try
      GetTimeFormat(LOCALE_USER_DEFAULT, 0, nil, nil, szTime, lenTime);
      SetWindowText(hWnd, szTime);
      clrBk := SetBkColor(ps.hdc, GetSysColor(COLOR_BTNFACE) + 1);
      ExtTextOut(ps.hdc, TimeRect.Left, TimeRect.Top, ETO_CLIPPED or
        ETO_OPAQUE, @TimeRect, szTime, lenTime - 1, nil);
      SetBkColor(ps.hdc, clrBk);
    finally
      FreeMem(szTime);
    end;
  end;
end;

function WndProc(hWnd: HWND; uMsg: UINT; wParam: wParam; lParam: LParam): lresult; stdcall;
var
  ps                : TPaintStruct;
  st                : SYSTEMTIME;
  dwTimeToNextTick  : DWORD;
begin
  Result := 0;

  case uMsg of
    WM_CREATE: ;  // erst einmal nix ;)
    WM_PAINT:
      begin
        beep(220,20);

        BeginPaint(hWnd, ps);
        // if PtVisible(ps.hdc, TimeRect.Right,TimeRect.Bottom) then
        if RectVisible(ps.hdc, TimeRect) then
        begin
          GetSystemTime(st);
          dwTimeToNextTick := 1000 - st.wMilliseconds;
          SetTimer(hWnd, 1, dwTimeToNextTick, {@TimerCallback} nil);
        end;

        PaintContent(hWnd, ps);

        EndPaint(hWnd, ps);
      end;

    wm_timer:
    begin
      KillTimer(hWnd, 1);
      InvalidateRect(hWnd, @TimeRect, FALSE);
    end;

    WM_CLOSE: DestroyWindow(hWnd);

    WM_DESTROY: PostQuitMessage(0);

  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;
    hbrBackground: COLOR_BTNFACE + 1;
    lpszMenuName: nil;
    lpszClassName: ClassName;
    hIconSm: 0;
    );
  msg               : TMsg;

begin
  wc.hInstance := HInstance;
  wc.hCursor := LoadCursor(0, IDC_ARROW);

  RegisterClassEx(wc);

  CreateWindowEx(0,
    ClassName,
    AppName,
    WS_CAPTION or WS_VISIBLE or WS_SYSMENU or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_SIZEBOX,
    (GetSystemMetrics(SM_CXSCREEN) div 2) - (WindowWidth div 2),
    (GetSystemMetrics(SM_CYSCREEN) div 2) - (WindowHeight div 2),
    WindowWidth, WindowHeight,
    0,
    0,
    hInstance,
    nil);

  while GetMessage(msg, 0, 0, 0) do
  begin
    TranslateMessage(msg);
    DispatchMessage(msg);
  end;

  ExitCode := msg.wParam;
end.

Ich denke mal das es an dem InvalidateRect liegt. Irgend wie wird das Rechteck @TimeRect in dieser Funtionn icht richtig asoz... äh, gesetzt.
Deswegen wird auch der gesamte Bildschirm neu gezeichnet an stelle des angeg. Bereiches.
So zusagen InvalidateRect(hWnd, nil, FALSE);.