program Lab4;

uses windows,
  messages; {èíòåðôåéñû ê ñèñòåìíûì DLL}
Var
  FontH  :  THandle;

function WndProc(hWnd: THandle; Msg: integer;
                 wParam: longint; lParam: longint): longint;
                 stdcall; forward;

procedure WinMain; {Îñíîâíîé öèêë îáðàáîòêè ñîîáùåíèé}
  const szClassName='Shablon';
  var   wndClass:TWndClassEx;
        hWnd: THandle;
        msg:TMsg;
  MyFont  :  TLogFont;


begin
  wndClass.cbSize:=sizeof(wndClass);
  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:=GetStockObject(black_Brush);
  wndClass.lpszMenuName:=nil;
  wndClass.lpszClassName:=szClassName;
  wndClass.hIconSm:=loadIcon(0, idi_Application);

  RegisterClassEx(wndClass);

  hwnd:=CreateWindowEx(
         0,
         szClassName, {èìÿ êëàññà îêíà}
         'Çàãîëîâîê îêíà',    {çàãîëîâîê îêíà}
         ws_overlappedWindow,     {ñòèëü îêíà}
         cw_useDefault,           {Left}
         cw_useDefault,           {Top}
         cw_useDefault,           {Width}
         cw_useDefault,           {Height}
         0,                       {õýíäë ðîäèòåëüñêîãî îêíà}
         0,                       {õýíäë îêîííîãî ìåíþ}
         hInstance,               {õýíäë ýêçåìïëÿðà ïðèëîæåíèÿ}
         nil);                    {ïàðàìåòðû ñîçäàíèÿ îêíà}

        // Óñòàíàâëèâàåì ïàðàìåòðû íîâîãî øðèôòà
  with MyFont do
    begin
    lfHeight := 18; // Âûñîòà  14pt * ppi( ïèêñåëåé íà äþéì) div 72
    lfWidth  := 0;   //  Äëèíà
    lfEscapement := -450;  // Óãîë íàêëîíà
    lfOrientation:= lfEscapement;
    lfWeight := 1000;   // Æèðíîñòü
    lfItalic :=0;
    lfUnderline:= 0;
    lfStrikeOut:= 0;
    lfCharSet :=0;
    lfOutPrecision := 0;
    lfClipPrecision := 0;
    lfQuality := 0;
    lfPitchAndFamily := 0;
    lfFaceName := 'Courier New'#0;   // Íàçâàíèå øðèôòà
    end;

  FontH := CreateFontIndirect( MyFont );

  ShowWindow(hwnd,sw_Show);  {îòîáðàçèòü îêíî}
  updateWindow(hwnd);   {ïîñëàòü wm_paint îêîííîé ïðîöåäóðå, ïðîðèñîâàâ
                         îêíî ìèíóÿ î÷åðåäü ñîîáùåíèé (íåîáÿçàòåëüíî)}

  while GetMessage(msg,0,0,0) do begin {ïîëó÷èòü î÷åðåäíîå ñîîáùåíèå}
    TranslateMessage(msg);   {Windows òðàíñëèðóåò ñîîáùåíèÿ îò êëàâèàòóðû}
    DispatchMessage(msg);    {Windows âûçîâåò îêîííóþ ïðîöåäóðó}
  end; {âûõîä ïî wm_quit, íà êîòîðîå GetMessage âåðíåò FALSE}

  DeleteObject ( FontH );







end;

function WndProc(hWnd: THandle; Msg: integer; wParam: longint; lParam: longint): longint; stdcall;
  var ps:TPaintStruct;
      hdc:THandle;
      hpen:THandle;
      rect:TRect;
      color:integer;
      p:pointer;
      bmi:^TBitmapInfo;
      data:pointer;
      f:file;
      sze:integer;
  type
    Re  = record
    left  :  longint;
    top : longint;
    right : longInt;
    bottom  :  longint;
  end;

  VAR
      OldFont  :  THandle;
      BmpXY : RECORD
                Left,
                Top,
                Right,
                Bottom  :  integer;
              END;
      OldMapMode  :  integer;
      RRR  :  TRECT;
      OldPen  :  THandle;
      NewPen  :  THandle;
  CONST
    WWW  :  integer = 10;

begin
  result:=0;
  case Msg of
    wm_paint:
      begin
        hdc:=BeginPaint(hwnd,ps); //Óäàëèòü WM_PAINT èç î÷åðåäè è íà÷àòü ðèñîâàíèå
        GetClientRect(hwnd,rect);

        hPen:=SelectObject(hdc,createPen(PS_SOLID,WWW,rgb(0,0,200)));
        SetRop2(hdc,r2_copypen);

        assignFile(f,'wallppr.bmp'); reset(f,1);
        sze:=filesize(f);
        getmem(p,sze);
        blockread(f,p^,sze);
        closeFile(f);

        integer(bmi):=integer(p)+sizeof(TBitmapFileheader);
        integer(data):=integer(p)+TBitmapFileheader(p^).bfOffBits;

        //Áåðåì êîîðäèíàòû 70 ïðîöåíòîâ îò òåêóùåãî ðàçìåðà îêíà
        With BmpXY do
          begin
            Left := rect.left;
            Top := rect.top;
            Right := Round ( 70 * rect.right / 100 );
            Bottom := Round ( 70 * rect.bottom / 100 );
          end;