#include once "windows.bi"

enum IBFLAGS
  IB_LowerCase      =   1
  IB_UpperCase      =   2
  IB_Password       =   4
  IB_Numbers        =   8
  IB_Hex            =  16
  IB_Binary         =  32
  IB_TopMost        =  64
  IB_DisableOwner   = 128
  IB_NoEmpty        = 256
end enum

namespace IBV
dim shared as hwnd HCTL(8)
dim shared as hwnd OWN
dim shared as string RESULT
dim shared as integer FLAGS
dim shared as rect WRCT

enum Controles
  CTL_MAIN
  CTL_STATIC
  CTL_EDIT
end enum

end namespace

declare function InputBox ( OWNERWND as hwnd=0, TITLE as string, QUERY as string,INITIAL as string="",FLAGS as integer=0 ) as string

' *************** Procedure Function ****************
function InputBoxProc (hWnd as HWND,message as UINT,wParam as WPARAM,lParam as LPARAM ) as LRESULT  
  
  function = 0  
  
  select case( MESSAGE )
  
  case WM_CREATE
    IBV.RESULT = ""
    
  case WM_ACTIVATE
    if LOWORD(wParam) <> WA_INACTIVE then 
      'SetForeGroundWindow(hwnd)
      'SetForeGroundWindow(IBV.HCTL(IBV.CTL_EDIT))
      'SetFocus(IBV.HCTL(IBV.CTL_EDIT))
    end if    
  
  case WM_PAINT
    
    dim hDC as HDC
    dim pnt as PAINTSTRUCT
    hDC = BeginPaint( hWnd, @pnt )       
    'GetClientRect( hWnd, @RCT )
    EndPaint( hWnd, @pnt )
  
  case WM_CLOSE
    PostQuitMessage( 0 )
    exit function
  end select
  
  return DefWindowProc( hWnd, message, wParam, lParam )
  
end function

function InputBox ( OWNERWND as hwnd=0, TITLE as string, QUERY as string,INITIAL as string="", FLAGS as integer=0 ) as string  
  
  ' *********************** Variaveis ********************
  dim as hinstance HINSTANCE
  dim as integer TEXTSZ,TEXTYY,WINSX,WINSY,WINPX,WINPY
  dim as integer EDITSTY,EXSTY
  dim wMsg as MSG
  dim wcls as WNDCLASS 
  dim as HWND hWnd  
  
  #define FontSize(PIXELPNT) (-MulDiv(PIXELPNT, GetDeviceCaps(GetDC(hwnd), LOGPIXELSY), 72))
  #macro AddFixedFont(FONTHD,FONTSZ,FONTWID,FONTITA,FONTNAME)
  FONTE(FONTHD) = CreateFont(FontSize((FONTSZ)),0,0,0,(FONTWID),(FONTITA),0,0,0,0,0,0,0,FONTNAME)    
  #endmacro
  
  ''
  '' Setup window class
  ''  
  HINSTANCE = GetModuleHandle(null)
  IBV.FLAGS = FLAGS
  
  with wcls
    .style         = CS_HREDRAW or CS_VREDRAW or CS_SAVEBITS
    .lpfnWndProc   = @InputBoxProc
    .cbClsExtra    = 0
    .cbWndExtra    = 0
    .hInstance     = hInstance
    .hIcon         = LoadIcon( hinstance, "FB_PROGRAM_ICON" )
    .hCursor       = LoadCursor( NULL, IDC_ARROW )
    .hbrBackground = cast(hBrush, COLOR_BTNFACE + 1)
    .lpszMenuName  = NULL
    .lpszClassName = @"MysoftInputBoxClass"
  end with
  
  ''
  '' Register the window class     
  ''
  'CheckError( RegisterClass( @wcls ) = 0 )
  RegisterClass( @wcls )
  enum fontes
    AF_TEXT = 1
    AF_EDIT
    AF_FIM
  end enum
  
  dim as hfont FONTE(AF_FIM)
  
  AddFixedFont(AF_TEXT,12,FW_NORMAL,false,"verdana")
  if (FLAGS and IB_PASSWORD) then    
    AddFixedFont(AF_EDIT,12,FW_NORMAL,false,"Courier")
  else
    AddFixedFont(AF_EDIT,10,FW_NORMAL,false,"Tahoma")
  end if
  
  scope 
    dim as hdc TMPDC
    dim as hwnd TMPWND
    dim as hfont OLDFNT
    dim as size TXTSZ    
    TMPWND = GetDesktopWIndow()
    TMPDC = GetDC(TMPWND)
    OLDFNT = SelectObject(TMPDC,FONTE(AF_TEXT))
    GetTextExtentPoint32(TMPDC,strptr(QUERY),len(QUERY),@TXTSZ)
    ReleaseDC(TMPWND,TMPDC)
    TEXTSZ = TXTSZ.CX
    if TEXTSZ < 64 then TEXTSZ = 64
    TEXTYY = TXTSZ.CY
  end scope
  
  WINSX = TEXTSZ*1.1
  WINSY = TEXTYY*3+32
  
  EDITSTY = WS_CHILD or WS_VISIBLE or ES_AUTOHSCROLL
  if (FLAGS and IB_LOWERCASE) then EDITSTY or= ES_LOWERCASE	
  if (FLAGS and IB_UPPERCASE) then EDITSTY or= ES_UPPERCASE	
  if (FLAGS and IB_PASSWORD) then EDITSTY or= ES_PASSWORD	
  if (FLAGS and IB_NUMBERS) then EDITSTY or= ES_NUMBER
  
  if (FLAGS and IB_TOPMOST) then EXSTY or= WS_EX_TOPMOST
  
  ''
  '' Create the window and show it
  ''
    
  if (FLAGS and IB_DisableOwner) then 
    EnableWindow(OWNERWND,false)
  end if
  
  IBV.OWN = OWNERWND
  if OWNERWND then    
    GetWindowRect(OWNERWND,@IBV.WRCT)
    with IBV.WRCT
      WINPX = .Left+(((.Right-.Left)-WINSX)\2)
      WINPY = .Top+(((.Bottom-.Top)-WINSY)\2)
    end with
  else
    WINPX=CW_USEDEFAULT: WINPY=0
  end if
  
  HWND = CreateWindowEx(EXSTY,"MysoftInputBoxClass",TITLE,WS_VISIBLE or WS_OVERLAPPEDWINDOW or WS_SYSMENU,WINPX,WINPY,WINSX,WINSY,OWNERWND,NULL,hInstance,NULL)
  
  IBV.HCTL(IBV.CTL_MAIN) = HWND
  IBV.HCTL(IBV.CTL_EDIT) = CreateWindowEx(WS_EX_CLIENTEDGE,"edit","",EDITSTY,5,TEXTYY*1.1+5,TEXTSZ,TEXTYY+4,hWnd,0,hInstance,null)
  IBV.HCTL(IBV.CTL_STATIC) = CreateWindow("static",QUERY,WS_CHILD or WS_VISIBLE,5,5,TEXTSZ,TEXTYY,hwnd,0,hInstance,null)
      
  Sendmessage(IBV.HCTL(IBV.CTL_EDIT),WM_SETFONT,cast(wparam,FONTE(AF_EDIT)),True)
  Sendmessage(IBV.HCTL(IBV.CTL_STATIC),WM_SETFONT,cast(wparam,FONTE(AF_TEXT)),True)
  SetWindowText(IBV.HCTL(IBV.CTL_EDIT),strptr(INITIAL))
    
  ShowWindow( hWnd, SW_SHOW )
  UpdateWindow( hWnd )  
    
  SetForeGroundWindow(hwnd)
  SetForeGroundWindow(IBV.HCTL(IBV.CTL_EDIT))
  SetFocus(IBV.HCTL(IBV.CTL_EDIT))
    
  ''
  '' Process windows messages
  ''
  while  GetMessage( @wMsg, 0, 0, 0 )    
    
    with wmsg
      
      ' *** Invalid Caracteres ***
      if .message = WM_CHAR then        
        if .wparam >= 32 then
          if (FLAGS and IB_HEX) then
            select case chr$(.wparam)
            case "a" to "f","A" to "F","0" to "9"
              .wparam = asc(ucase$(chr$(.wparam)))
            case else
              continue while
            end select
          elseif (FLAGS and IB_BINARY) then
            if .wparam < 48 or .wparam > 49 then continue while
          end if
        end if
      end if
      
      if .message = WM_KEYDOWN then
        ' *** Enter / Escape ***
        if .wparam = VK_RETURN then          
          scope      
            dim as zstring*1025 CURTXT
            GetWindowText(IBV.HCTL(IBV.CTL_EDIT),@CURTXT,1024)          
            if CURTXT <> "" or (IBV.FLAGS and IB_NOEMPTY)=0 then          
              IBV.RESULT = CURTXT
              SendMessage(hwnd,WM_CLOSE,null,null)
              continue while
            end if
          end scope
        elseif .wparam = VK_ESCAPE then          
          SendMessage(hwnd,WM_CLOSE,null,null)
          continue while
        end if
      end if
    end with
    
    TranslateMessage( @wMsg )
    DispatchMessage( @wMsg )
    
  wend
  
  for COUNT as integer = 0 to AF_FIM
    DeleteObject(FONTE(COUNT))
  next COUNT
  
  DestroyWindow(hwnd)
  
  
  'CheckError( UnregisterClass("MysoftInputBoxClass",Hinstance) = 0 )
  UnregisterClass("MysoftInputBoxClass",Hinstance)
  if (FLAGS and IB_DisableOwner) then
    EnableWindow(OWNERWND,True)
  end if
  
  ''
  '' Program has ended
  ''
  
  return IBV.RESULT
  
end function