unit _Forms;

{
  ver 1.0

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

  window props and control
  main process creation and control
  keys and mouse creation and control
}

interface

uses
  Windows,
  Messages,
  _OpenGL;

//const

type
  TProc = procedure;

var

{$REGION 'Window params'}
  hWnd: THandle;      {window descriptor}
  Msg: TMsg;          {main messages descriptor}
  WCE: TWndClassEx;   {window class}
  PT,PL:integer;      {wiondow params}
  PW,PH:integer;
  glhRC:HGLRC;        {GL render contest and render descriptor}
  glhDC:HDC;
{$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 wheel}
{$ENDREGION}
{$REGION 'main_procedures_creation'}
  {timer}
  tactH: Integer;
  create_procedure,
  kill_procedure,
  timer:TProc;
{$ENDREGION}

procedure Main_Proc(
  name:PAnsiChar; //window name
  cp:TProc; //creation procedure
  kp:TProc; //kill procedure
  tp:TProc; //timer procedure
  T,L,W,H:integer //window size
  );

implementation

{$REGION 'Windows_Messages'}
function PlainWinProc (hWnd: THandle; nMsg: UINT;
  wParam, lParam: Cardinal): Cardinal; export; stdcall;
Var P:TPoint;
begin                  {Messages}
  Result := 0;
  case nMsg of
    wm_lButtonDown:mbl:=true;
    wm_lButtonUp:  mbl:=false;
    wm_rButtonDown:mbr:=true;
    wm_rButtonUp:  mbr:=false;
    WM_MBUTTONDOWN:mbm:=true;
    WM_MBUTTONUP:  mbm:=false;
    wm_KeyDown:key[wParam]:=true;
    wm_KeyUp:key[wParam]:=false;  {keys on/off}
    WM_MOUSEWHEEL:MW:=wParam;     {mouse wheel}
    WM_MOUSEMOVE:                 {mouse position}
     begin
      GetCursorPos(P);
      MX:=P.X;
      MY:=P.Y;
     end;
    WM_size:
     begin
      PW:=LOWORD(lParam) ;
      PH:=HIWORD(lParam);
      On_Resize(PW,PH);
     end;
    wm_Create:                     {creation}
     begin                             
      InitGL(glhRC,glhDC,hWnd,PW,PH);  {OpenGL initiation}
      SetTimer(0,TactH,10,@timer);   {timer creation}
      create_procedure;
     end;
    wm_Destroy:
     begin
      kill_procedure;             {destroy program}
     end
    else
      Result := DefWindowProc (hWnd, nMsg, wParam, lParam);
  end;
end;
{$ENDREGION}

{$REGION 'Create_Main_Window'}
procedure Win_Create(
      Name:PAnsiChar;
      var hWnd: THandle;
      var Msg: TMsg;
      var WCE: TWndClassEx;
      T,L,H,W:integer
      );
begin {создание формы}
 WCE.cbSize := sizeOf (WCE);
 WCE.lpszClassName := Name;
 WCE.style := cs_VRedraw or cs_HRedraw;
 WCE.hInstance := HInstance;
 WCE.lpfnWndProc := @PlainWinProc;    {ну тут параметры всякие..}
 WCE.cbClsExtra := 0;
 WCE.cbWndExtra := 0;
 WCE.hInstance:=HInstance;
 WCE.hIcon := LoadIcon (hInstance,
   MakeIntResource ('MAINICON'));   {иконки}
 WCE.hIconSm  := LoadIcon (hInstance,
   MakeIntResource ('MAINICON'));
 WCE.hCursor := LoadCursor (0, IDC_ARROW{IDC_CROSS});
 WCE.hbrBackground := COLOR_BTNFACE;
 WCE.lpszMenuName := nil;
 // register the class
 RegisterClassEx (WCE);            {регистрация}
 hWnd := CreateWindowEx (WS_EX_TOPMOST, {поверх всего}
  WCE.lpszClassName, // class name
  Name, // caption
  {ws_OverlappedWindow}      {стиль окна}
//  WS_CAPTION or WS_SYSMENU or WS_THICKFRAME or WS_MINIMIZEBOX or WS_MAXIMIZEBOX,
  (WS_MAXIMIZE OR WS_POPUP or WS_SYSMENU or WS_MINIMIZEBOX) AND not WS_DLGFRAME ,
  T,L,  // position
  H,W,  // size
  0, // parent window
  0, // menu
  HInstance, // instance handle
  nil); // initial parameters
 ShowWindow (hWnd, SW_SHOWNORMAL); {показать в нормальном стиле - оно и так во весь экран}
end;
{$ENDREGION}

{$REGION 'Main program way'}
procedure Main_Proc(
  name:PAnsiChar; //window name
  cp:TProc; //main creation/kill/timer procedures
  kp:TProc;
  tp:TProc;
  T,L,W,H:integer);
begin
 create_procedure:=@cp;
 kill_procedure:=@kp;
 timer:=@tp;
 Win_Create(name,hWnd,Msg,WCE,T,L,W,H);  {window create}
 while GetMessage (Msg, 0, 0, 0) do  {основной цикл}
  begin
   TranslateMessage (Msg);   
   DispatchMessage (Msg);
  end;
end;
{$ENDREGION}

end.
