program APIMultiThread;

uses Windows, Messages;

{$R sun.res}

type
  PData = ^TData;
  TData = record
    XPos: Integer;
    YPos: Integer;
  end;

const AppName='Потоки';
      Margin = 20;

var AMessage  : TMsg;
    hWindow   : HWnd;
    hBtnExit  : HWnd;
    hBtnThreads : HWnd;

    AWidth    : word;
    AHeight   : word;
    SunHBMP   : HBitmap;
    ABMP      : Windows.TBitmap;

    hThread1, hThread2, hThread3: THandle;
    ThreadID  : DWORD;
    Data      : PData;

procedure DrawBitmap(PaintDC: HDC; Bitmap: HBitMap; XVal, YVal: Integer);
var
  MemDC: HDC;
  OldBitmap: HBitmap;
begin
  MemDC := CreateCompatibleDC(PaintDC);
  OldBitmap := SelectObject(MemDC, Bitmap);
  BitBlt(PaintDC, XVal, YVal, AWidth, AHeight, MemDC, 0, 0, SRCCOPY);
  SelectObject(MemDC, OldBitmap);
  DeleteObject(MemDC);
end;

function ThreadFunc(Ptr: Pointer): LongInt;
var
  i, j : Integer;
  P    : TColorRef;
  DC   : HDC;
  Data : PData;
begin
  Data := PData(Ptr);
  DC := GetDC(hWindow);
  for j := 0 to AHeight do
  for i := Margin to AWidth + Margin do begin
    P := GetPixel(DC, i, j);
    SetPixel(DC, i + Data^.Xpos, Data^.YPos + j, P);
  end;
  ReleaseDC(hWindow, DC);
  Dispose(Data);
end;

function WindowProc(Window: HWnd; AMessage, WParam, LParam: longint): longint; stdcall; export;
begin
  WindowProc := 0;
  case AMessage of
    WM_DESTROY: begin PostQuitMessage(0); Exit; end;
    WM_COMMAND: if LParam = hBtnExit then begin PostQuitMessage(0); Exit; end
                  else if LParam = hBtnThreads then begin
                     CloseHandle(hThread1);
                     CloseHandle(hThread2);
                     CloseHandle(hThread3);

                     New(Data);
                     Data^.XPos := AWidth;
                     Data^.YPos := 0;
                     hThread1 := BeginThread(nil, 0, @ThreadFunc, Data, 0, ThreadID);
                     SetThreadPriority(hThread1, THREAD_PRIORITY_IDLE);

                     New(Data);
                     Data^.XPos := 0;
                     Data^.YPos := AHeight;
                     hThread2 := BeginThread(nil, 0, @ThreadFunc, Data, 0, ThreadID);

                     New(Data);
                     Data^.XPos := AWidth;
                     Data^.YPos := AHeight;
                     hThread3 := BeginThread(nil, 0, @ThreadFunc, Data, 0, ThreadID);
                     SetThreadPriority(hThread3, THREAD_PRIORITY_HIGHEST);
                  end;
    WM_KEYDOWN: if (wParam = VK_RETURN) or (wParam = VK_ESCAPE) then SendMessage(hBtnExit, BM_CLICK, 0, 0);
  end;
  WindowProc  := DefWindowProc(Window, AMessage, WParam, LParam);
end;

function WinRegister: boolean;
var WindowClass: TWndClass;
begin
  with WindowClass do begin
    Style := CS_HREDRAW or CS_VREDRAW;
    lpfnWndProc := @WindowProc;
    cbClsExtra := 0;
    cbWndExtra := 0;
    hInstance := SysInit.HInstance;
    hIcon := LoadIcon(0, IDI_APPLICATION);
    hCursor :=  LoadCursor(0, IDC_ARROW);
    hbrBackGround := COLOR_WINDOW;
    lpszMenuName := nil;
    lpszClassName := AppName;
  end;
  Result := RegisterClass(WindowClass) <> 0;
end;

function WinCreate: HWnd;
var hWindow : HWnd;
begin
  hWindow := CreateWindow(AppName, 'Робота потоків', WS_OVERLAPPEDWINDOW,
    200, 100, 700, 550, 0, 0, HInstance, nil);

  if hWindow<>0 then begin
    ShowWindow(hWindow, SW_SHOWNORMAL);
    UpdateWindow(hWindow);
    hBtnExit := CreateWindow('BUTTON', 'Вихід', WS_CHILD or BS_DEFPUSHBUTTON or WS_TABSTOP,
      600, 10, 90, 30, hWindow, 0, HInstance, nil);
    if hBtnExit <> 0 then ShowWindow(hBtnExit, SW_SHOWNORMAL);
    hBtnThreads := CreateWindow('BUTTON', 'Потоки', WS_CHILD or WS_TABSTOP,
      600, 70, 90, 30, hWindow, 0, HInstance, nil);
    if hBtnThreads <> 0 then ShowWindow(hBtnThreads, SW_SHOWNORMAL);
  end;
  Result := hWindow;
end;

begin
  if not WinRegister then begin
    MessageBox(0, 'Клас вікна не зареєстровано', AppName, MB_OK);
    Exit;
  end;
  hWindow := WinCreate;
  if hWindow = 0 then begin
    MessageBox(0, 'Не вийшло створити вікно.', AppName, MB_OK);
    Exit;
  end;

  SunHBMP := LoadBitmap(hInstance, 'Sun');
  GetObject(SunHBMP, SizeOf(Windows.TBitMap), @ABMP);
  AWidth := ABMP.bmWidth;
  AHeight := ABMP.bmHeight;
  if SunHBMP <> 0 then DrawBitmap(GetDC(hWindow), SunHBMP, Margin, 0);

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

  CloseHandle(hThread1);
  CloseHandle(hThread2);
  CloseHandle(hThread3);

  Halt(AMessage.wParam);
end.
