2D графика на основе WinApi Delphi

[ArxLex]

Интересная статья об выводе и анимации 2D графики на основе WinApi, код примера перевел из C++ на Delphi. Источник на C++: https://api-2d3d-cad.com/2d_winapi_c/

 

Спойлер

program test;

uses
  Windows, Messages;

type
  TPoints = record
    x: double;
    y: double;
  end;

  TMyArray = array [0 .. 3] of double;

  _Point = TPoints;

const
  MARGIN = 10;

var
  Wnd: THandle;
  Msg: TMsg;
  wndClass: TWndClass;
  Width, Height: Integer;
  Matrix: TMyArray;
  current_rot: TMyArray;

procedure SetRotationMatrix(alpha: double; var mat: TMyArray);
begin
  mat[0] := cos(alpha);
  mat[1] := -sin(alpha);
  mat[2] := sin(alpha);
  mat[3] := cos(alpha);
end;

procedure InitRotation();
begin
  SetRotationMatrix(0.0, current_rot);
end;

procedure SetWindowSize(_Width, _Height: Integer);
begin
  Width := _Width;
  Height := _Height;
end;

procedure MultiplyMatrices(var dest, left, right: TMyArray);
var
  _dest: TMyArray;
begin
  _dest[0] := left[0] * right[0] + left[1] * right[2];
  _dest[1] := left[0] * right[1] + left[1] * right[3];
  _dest[2] := left[2] * right[0] + left[3] * right[2];
  _dest[3] := left[2] * right[1] + left[3] * right[3];
  CopyMemory(@dest, @_dest, sizeof(Matrix));
end;

procedure AddRotation(alpha: double);
var
  additional_rot: TMyArray;
begin
  SetRotationMatrix(alpha, additional_rot);
  MultiplyMatrices(current_rot, current_rot, additional_rot);
end;

function Tx(X_Log: double): Integer;
var
  tempDouble: double;
begin
  tempDouble := MARGIN + (1.0 / 2) * (X_Log + 1) * (Width - 2 * MARGIN);
  result := Trunc(tempDouble);
end;

function Ty(Y_Log: double): Integer;
var
  tempDouble: double;
begin
  tempDouble := MARGIN + (-1.0 / 2) * (Y_Log - 1) * (Height - 2 * MARGIN);
  result := Trunc(tempDouble);
end;

function T(point: _Point): _Point;
var
  p: _Point;
begin
  p.x := MARGIN + (1.0 / 2) * (point.x + 1) * (Width - 2 * MARGIN);
  p.y := MARGIN + (-1.0 / 2) * (point.y - 1) * (Height - 2 * MARGIN);
  result := p;
end;

procedure ApplyMatrixtoPoint(rot: TMyArray; var point: _Point);
var
  _x, _y: double;
begin
  _x := point.x;
  _y := point.y;
  point.x := _x * rot[0] + _y * rot[1];
  point.y := _x * rot[2] + _y * rot[3];
end;

procedure Draw(dc: HDC);
var
  triangle: array [0 .. 2] of _Point;
  i, j: Integer;
begin
  triangle[0].x := 0.0;
  triangle[0].y := 0.5;
  triangle[1].x := 0.5;
  triangle[1].y := 0.0;
  triangle[2].x := -0.5;
  triangle[2].y := -0.5;

  for i := 0 to 3 - 1 do
  begin
    ApplyMatrixtoPoint(current_rot, triangle[i]);
    triangle[i] := T(triangle[i]);
  end;
  for i := 0 to 3 + i do
  begin
    j := i mod 3;
    if (i = 0) then
    begin
      MoveToEx(dc, Trunc(triangle[j].x), Trunc(triangle[j].y), nil);
    end
    else
    begin
      LineTo(dc, Trunc(triangle[j].x), Trunc(triangle[j].y));
    end;
  end;
end;

function WndProc(Wnd: HWND; Message: UINT; wParam: Integer; lParam: Integer): Integer; stdcall;
var
  ps: TPAINTSTRUCT;
  rc: TRECT;
  dc, hCmpDC: HDC;
  hBmp: HBITMAP;
  br: TLOGBRUSH;
  brush: HBRUSH;
  KeyPressed: Integer;
begin
  case Message of
    WM_CREATE:
      begin
        InitRotation();
      end;
    WM_KEYDOWN:
      begin
        KeyPressed := wParam;
        if (KeyPressed = VK_RIGHT) then
        begin
          AddRotation(-PI / 10);
        end;
        if (KeyPressed = VK_LEFT) then
        begin
          AddRotation(PI / 10);
        end;
        InvalidateRect(Wnd, nil, FALSE);
      end;
    WM_SIZE:
      begin
        GetClientRect(Wnd, &rc);
        SetWindowSize(rc.right - rc.left, rc.bottom - rc.top);
      end;
    WM_ERASEBKGND:
      begin
        //
      end;
    WM_PAINT:
      begin
        GetClientRect(Wnd, &rc);
        dc := BeginPaint(Wnd, &ps);
        hCmpDC := CreateCompatibleDC(dc);
        hBmp := CreateCompatibleBitmap(dc, rc.right - rc.left, rc.bottom - rc.top);
        SelectObject(hCmpDC, hBmp);
        br.lbStyle := BS_SOLID;
        br.lbColor := $EECCCC;
        brush := CreateBrushIndirect(&br);
        FillRect(hCmpDC, &rc, brush);
        DeleteObject(brush);

        Draw(hCmpDC);

        SetStretchBltMode(dc, COLORONCOLOR);
        BitBlt(dc, 0, 0, rc.right - rc.left, rc.bottom - rc.top, hCmpDC, 0, 0, SRCCOPY);
        DeleteDC(hCmpDC);
        DeleteObject(hBmp);
        hCmpDC := 0;
        EndPaint(Wnd, &ps);
      end;
    WM_DESTROY:
      begin
        PostQuitMessage(0);
      end;
  else
    result := DefWindowProc(Wnd, Message, wParam, lParam);
  end;
end;

begin
  wndClass.style := CS_HREDRAW or CS_VREDRAW;
  wndClass.lpfnWndProc := @WndProc;
  wndClass.cbClsExtra := 0;
  wndClass.cbWndExtra := 0;
  wndClass.hInstance := hInstance;
  wndClass.hIcon := LoadIcon(0, IDI_APPLICATION);
  wndClass.hCursor := LoadCursor(0, IDC_ARROW);
  wndClass.hbrBackground := HBRUSH(GetStockObject(WHITE_BRUSH));
  wndClass.lpszMenuName := nil;
  wndClass.lpszClassName := 'CG_WAPI_Template by ArxLex';
  RegisterClass(wndClass);
  Wnd := CreateWindow('CG_WAPI_Template by ArxLex', '2D графика на основе WinApi Delphi by ArxLex', WS_OVERLAPPEDWINDOW, 50, 50, 600, 600, 0, 0, hInstance, nil);
  ShowWindow(Wnd, SW_SHOW);
  UpdateWindow(Wnd);
  while GetMessage(Msg, 0, 0, 0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;

end.