unit _Forms;

{
  ver 1.1

  Mefistofel
    (Костромин Кирилл)
  08.08.2011

  all need system properties,
  window creation and control
  timer and main process creation and control
  keys and mouse creation and control
}

interface

uses
  Windows,
  Messages;

const
{$REGION 'Keys'}
  __space = 32;   
  __alt = 18;
  __ctrl = 17;
  __esc = 27;
  __d = 87;
  __a = 83;
  __s = 65;
  __w = 68;
  __right = 38;
  __left  = 40;
  __down  = 37;
  __up    = 39;
{$ENDREGION}  

type
  TProc = procedure;

 TWindow = record
{$REGION 'Window params'}
  Handle: THandle;        //window descriptor
  WCE: TWndClassEx;     //window class
  Top,Left:integer;          //window scale+borderscale
  Width,Height:integer;      //window size
  ScreenWidth,ScreenHeight:integer;//Canvas size (Window-Borders)
  glhRC:HGLRC;          //GL render contest and render descriptor
  glhDC:HDC;            //gl dev context
  Focus:boolean; //window Focus
{$ENDREGION}
{$REGION 'Keys & mouse'}
  {keys}
  key: array [0..255] of boolean; //keyboard keys
  {mouse coords}
  mx,my:integer;      //mouse coords
  mw:integer;         //mouse wheel
  mbl,mbr,mbm:boolean;//mouse left/rigth/middle button
{$ENDREGION}
{$REGION 'main_procedures_creation'}
  create_procedure,   //creation procedure
  kill_procedure,     //kil proc
  change_state_procedure:TProc;       //window shange state (resize/remove window/minimize/maximize/set and drop Focus) procedure
{$ENDREGION}
 end;
          
var
 Win:TWindow;

procedure Main_Proc(
  name:PAnsiChar; //window name
  CreateProc:TProc; //creation procedure
  KillProc:TProc; //kill procedure
  ChangeStateProc:TProc; //change_state (resize/remove window/minimize/maximize/set and drop Win.Focus) procedure
  WinT,WinL,WinW,WinH:integer //window size
  );
procedure Set_Window_title(new_title:String);    
procedure Set_Mouse(coord:array of integer);overload;
procedure Set_Mouse(x,y:integer);overload;
procedure Kill_Window;

implementation

{$REGION 'Change title'}
procedure Set_Window_title(new_title:String);
begin
 SendMessage(Win.Handle,WM_SETTEXT,0,Integer(PChar(new_title)))
end;
{$ENDREGION}

{$REGION 'Kill_Window'}
procedure Kill_Window;
begin
 SendMessage(Win.Handle,wm_destroy,0,0);
end;
{$ENDREGION}

{$REGION 'Set Mouse Coord'}
procedure Set_Mouse(coord:array of integer);
begin
 SetCursorPos(coord[0],coord[1]);
end;

procedure Set_Mouse(x,y:integer);
begin   
 SetCursorPos(x,y);
end;
{$ENDREGION}

{$REGION 'Get_Win_Scale'}
procedure Get_Win_Scale;
Var
 f:TPoint;
 Rect:TRect;
begin
 GetDCOrgEx(GetDC(Win.Handle),f);
 GetClientRect(Win.Handle,Rect);
 Win.Left:=f.x;
 Win.Top:=f.y;
 Win.ScreenWidth:=Rect.Right;
 Win.ScreenHeight:=Rect.Bottom;
end;
{$ENDREGION}

{$REGION 'Windows_Messages'}
function MainWinProc (WH: THandle; nMsg: UINT;
  wParam, lParam: Cardinal): Cardinal; export; stdcall;
Var
 P:TPoint;
begin                 {Messages}
  Result := 0;
  case nMsg of
   {$REGION 'Mouse'}
    wm_lButtonDown:Win.mbl:=true;
    wm_lButtonUp:  Win.mbl:=false;
    wm_rButtonDown:Win.mbr:=true;
    wm_rButtonUp:  Win.mbr:=false;
    WM_MButtonDown:Win.mbm:=true;
    WM_MButtonUp:  Win.mbm:=false;
    WM_MouseMove:                 {mouse position}
     begin
      GetCursorPos(P);
      Win.mx:=P.X-Win.Left;
      Win.my:=P.Y-Win.Top;
     end;
   {$ENDREGION}
   {$REGION 'Keys'}
    wm_KeyDown:Win.key[wParam]:=true;
    wm_KeyUp:Win.key[wParam]:=false;  {keys on/off}
    WM_MouseWheel:Win.mw:=wParam;     {mouse wheel}
   {$ENDREGION}
   {$REGION 'Window_messages'}
    WM_Activate:
     begin
      Win.Focus:=not (wparam=0);         //active
      Win.change_state_procedure;        //recalculate window scale
     end;
    WM_Moving:
     begin
      Get_Win_Scale;
      Win.change_state_procedure;        //recalculate window scale
     end;
    WM_Size:
     begin
      Win.Width:=LOWORD(lParam) ;
      Win.Height:=HIWORD(lParam);            //New window size
      Get_Win_Scale;                 //recalculate window scale
      Win.change_state_procedure;
     end;
   {$ENDREGION}
   {$REGION 'WM_Create'}
    wm_Create:                       //creation
     begin
      Win.Handle:=WH;                      //return handle
      Get_Win_Scale;                 //recalculate window scale
      Win.create_procedure;              //set creation procedure
     end;
   {$ENDREGION}
   {$REGION 'WM_Destroy'}
    wm_Destroy:
     begin
      Win.kill_procedure;             {destroy program}      
      Result := 0;   
      PostQuitMessage(0);
      Exit;
     end
   {$ENDREGION}
    else
      Result := DefWindowProc (WH, nMsg, wParam, lParam);
  end;
end;
{$ENDREGION}

{$REGION 'Create_Main_Window'}
procedure Win_Create(
      Name:PAnsiChar;
      var Handle: THandle;
      var Msg: TMsg;
      var WCE: TWndClassEx;
      WinT,WinL,WinH,WinW:integer
      );
begin {создание формы}
 WCE.cbSize := sizeOf (Win.WCE);
 WCE.lpszClassName := Name;
 WCE.style := cs_VRedraw or cs_HRedraw;
 WCE.hInstance := HInstance;
 WCE.lpfnWndProc := @MainWinProc;    {ну тут параметры всякие..}
 WCE.cbClsExtra := 0;
 WCE.cbWndExtra := 0;
 WCE.hInstance:=HInstance;
 WCE.hIcon := LoadIcon (hInstance,  IDI_APPLICATION );   //default icons
 WCE.hIconSm  := LoadIcon (hInstance,  IDI_APPLICATION );
 WCE.hCursor := LoadCursor (0, IDC_Arrow);    
 WCE.hbrBackground := COLOR_BTNFACE;
 WCE.lpszMenuName := nil;
 // register the class
 RegisterClassEx (WCE);            {регистрация}
 Win.Handle := CreateWindowEx (WS_EX_TOPMOST, {поверх всего}
  WCE.lpszClassName, // class name
  Name, // caption
//  ws_OverlappedWindow, //win style
  (WS_MAXIMIZE OR WS_POPUP or WS_SYSMENU or WS_MINIMIZEBOX) AND not WS_DLGFRAME ,
  WinT,WinL,  // position
  WinH,WinW,  // size
  0, // parent window
  0, // menu
  HInstance, // instance handle
  nil); // initial parameters
 ShowWindow (Win.Handle, SW_SHOWNORMAL); //показать   
end;
{$ENDREGION}

{$REGION 'Main program way'}
procedure Main_Proc(
  name:PAnsiChar; //window name
  CreateProc:TProc; //main creation/kill/timer procedures
  KillProc:TProc;
  ChangeStateProc:TProc;
  WinT,WinL,WinW,WinH:integer);
var Msg: TMsg;          //main messages descriptor
begin
 Win.Focus:=true;
 Win.create_procedure:=@CreateProc;
 Win.kill_procedure:=@KillProc;
 Win.change_state_procedure:=@ChangeStateProc;
 Win_Create(name,Win.Handle,Msg,Win.WCE,WinT,WinL,WinW,WinH);  {window create}
 while GetMessage (Msg, 0, 0, 0) do  {основной цикл}
  begin
   TranslateMessage (Msg);   
   DispatchMessage (Msg);
  end;
end;
{$ENDREGION}

end.
