Bildschirm wird neugezeichnet

[Luckie]

Ich habe gerade verscuht diesen Tipp von Raymond Chen umzusetzen:
http://blogs.msdn.com/oldnewthing/ar.../29/54728.aspx

Delphi-Quellcode:

var
  TimeRect          : TRect;

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

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

  case uMsg of
    WM_CREATE:
      begin
        TimeRect.Left := 10;
        TimeRect.Top := 25;
        TimeRect.Right := TimeRect.Left + 75;
        TimeRect.Bottom := TimeRect.Top + 16;
      end;
    WM_PAINT:
      begin
        BeginPaint(hWnd, ps);
        if RectVisible(ps.hdc, TimeRect) then
        begin
          GetSystemTime(st);
          dwTimeToNextTick := 1000 - st.wMilliseconds;
          SetTimer(hWnd, 1, dwTimeToNextTick, @TimerCallback);
        end;

        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;

        EndPaint(hWnd, ps);
      end;
    WM_DESTROY:
      PostQuitMessage(0);
  else
    Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  end;
end;

Aber bei mir flackert der ganze Bildschirm. Und das sogar, wenn das Fenster minimiert ist. aber wenn es minimiert ist, sollte es doch gar keine Paint Nachrichten bekommen Wo hab eich da den entscheidenden Fehler gemacht?

[turboPASCAL]

Soweit keine Tippfehler, das der ges. Desktop neu gezeichnet wird ist seltsam.

Hast du schon einmal Windows.RectVisible versucht ? Bie mir gibt das einen Programmabbruch.

[Luckie]

Nein, aber das gibt bei mir kein Programmabbruch. raymond benutzt immer so eine Vorlage, aber an die kommt man zur Zeit nicht dran, wenn man auf den entsprechenden Link zum "sratch program" klickt.

[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);.

[Luckie]

Beim Debuggen hat er mir aber die Werte des Rects immer Korrekt angezeigt. Da soll mal einer draufkommen.

[Flocke]

P.S. Vergessen: stdcall bei TimerCallback

[Luckie]

Aaah. Schon wieder vergessen. Ich lerne es wohl nie.

[turboPASCAL]

Zitat:

P.S. Vergessen: stdcall bei TimerCallback

Ist mir überhaupt nicht aufgefallen. Leider steht das auch nicht in meiner Hilfe so dass es bei mir regelmässig vergessen wird.

[Luckie]

Es ist eine Windows Pozedur, ergo muss sie mit stdcall aufgerufen werden. Im PSDK steht es natürlich nicht und in der Delphi Hiölfe hat es nichts verloren.

[turboPASCAL]

Ich mach mir in der Hilfe Notizen, damit ich soetwas nicht vergesse.