WinAPI для простой графики Опции

[KljaGGsa]

Как практически с помощью функций WinAPI нарисовать мячик, который бы двигался горизонтально в прямоугольнике вправо-влево, "отскакивая" от боковых стенок, "пинг-понг" - ?

Сообщение отредактировано: KljaGGsa - 6.07.2009 17:26

[volvo]

Так тебе совсем WinAPI-шное приложение надо, без VCL? Ну, тогда так, к примеру:

program Project1;

uses
  Windows, Messages;

const
  WM_SETUP = 500;

  WinName = 'MainWClass';
  R = 5;

var
  myTimer: THandle;
  delta: integer;
  Rec: TRect;
  posX, posY: integer;

function MainWndProc(Window: HWnd; AMessage: UINT; WParam: WPARAM; LParam: LPARAM): INT_PTR; stdcall;
var
  myDC: HDC;
  ps: PAINTSTRUCT;
begin
  case AMessage of
    WM_CREATE: // Создание окна
    begin
      myTimer := SetTimer(Window, 0, 1, nil);
      Result := 0; Exit;
    end;
    WM_SETUP: // "Установка" начальных значений
    begin
      myDC := GetDC(Window);
        GetClientRect(Window, Rec);
        posX := 0; posY := (Rec.Bottom - Rec.Top) div 2; delta := 5;
      ReleaseDC(Window, myDC);
      Result := 0; Exit;
    end;
    WM_SIZE: // Изменение размеров окна
    begin
      PostMessage(Window, WM_SETUP, 0, 0); // Просто вызываем "установку"
      Result := 0; Exit;
    end;
    WM_PAINT:
    begin
      myDC := BeginPaint(Window, ps);
        PostMessage(Window, WM_SETUP, 0, 0); // Тоже "установка"
      EndPaint(Window, ps);
      Result := 0; Exit;
    end;
    WM_TIMER: // Событие таймера
    begin
      myDC := GetDC(Window);
      // стираем старое изображение шарика
      SelectObject(myDC, GetStockObject(WHITE_PEN));
      Ellipse(myDC, posX - R, posY - R, posX + R, posY + R);

      if ((delta > 0) and (posX + delta + R > (Rec.Right - Rec.Left)))
          or
         ((delta < 0) and (posX - delta - R < 0))
      then delta := -delta;
      posX := posX + delta;

      // и рисуем в новых координатах новое
      SelectObject(myDC, GetStockObject(BLACK_PEN));
      Ellipse(myDC, posX - R, posY - R, posX + R, posY + R);
      ReleaseDC(Window, myDC);
      Result := 0; Exit;
    end;
    WM_DESTROY: // Уничтожение окна
    begin
      KillTimer(Window, myTimer);
      PostQuitMessage(0);
      Result := 0; Exit;
    end;
    else
      Result := DefWindowProc(Window, AMessage, WParam, LParam);
  end;
end;

function InitApplication: Boolean;
var
  wcx: TWndClass;
begin
  wcx.style := CS_HREDRAW or CS_VREDRAW;
  wcx.lpfnWndProc := @MainWndProc;
  wcx.cbClsExtra := 0;
  wcx.cbWndExtra := 0;
  wcx.hInstance := hInstance;
  wcx.hIcon := LoadIcon(0, IDI_APPLICATION);
  wcx.hCursor := LoadCursor(0, IDC_ARROW);
  wcx.hbrBackground := COLOR_WINDOW;
  wcx.lpszMenuName := nil;
  wcx.lpszClassName := PChar(WinName);

  Result := RegisterClass(wcx) <> 0;
end;

function InitInstance: HWND;
begin
  Result := CreateWindow(
    PChar(WinName),
    'Ping-pong',
    WS_OVERLAPPEDWINDOW,
    Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT),
    0, 0, hInstance, nil);
end;

var
  hwndMain: HWND;
  AMessage: msg;
begin
  if (not InitApplication) then begin
    MessageBox(0, 'Ошибка регистрации окна', nil, mb_Ok)
  end
  else begin
    hwndMain := InitInstance;
    if (hwndMain = 0) then begin
      MessageBox(0, 'Ошибка создания окна', nil, mb_Ok)
    end
    else begin
      ShowWindow(hwndMain, CmdShow);
      UpdateWindow(hwndMain);
      while (GetMessage(AMessage, 0, 0, 0)) do begin
        TranslateMessage(AMessage);
        DispatchMessage(AMessage);
      end;
    end;
  end;

end.