FiveTech Software tech support forums

Code: Select all

   TelaMTopo   := Val(VerifyINI( "PROGRAMA"  , "COORDT", "000", cPath+"nfw.ini" ))
   TelaMEsque  := Val(VerifyINI( "PROGRAMA"  , "COORDL", "000", cPath+"nfw.ini" ))

   ResLargura := GetSysMetrics(0)   
   ResAltura   := GetSysMetrics(1)
   Resolucao   := alltrim(str(ResLargura))+'x'+alltrim(str(ResAltura))
   do case
      case Resolucao = "640x480"
           ? "Resolucao Impropria para trabalho"
           quit
      case Resolucao = "800x600"
           ResLargura := 800   
           ResAltura  := 600
      case Resolucao = "1024x768"
           ResLargura := 1024 // 800
           ResAltura  :=  768 // 600
      case Resolucao = "1280x1024"
           ResLargura := 1280 // 1024
           ResAltura  := 1024 // 768
   endcase
   SET _3DLOOK ON
   DEFINE WINDOW oWnd FROM TelaMTopo,TelaMEsque TO ResAltura,ResLargura PIXEL TITLE "5Volution Legacy" ICON oIcon MDI MENU BuildMenu() COLOR nRGB(000,000,000),nRGB(200,223,254)
   ...
   ACTIVATE WINDOW oWnd VALID (SalvaCoordenadas(oWnd),.t.)

Code: Select all

function SalvaCoordenadas(oWnd)
   lForcaGravar := .f.
   VerifyINI( "PROGRAMA", "COORDT", GetWndRect(oWnd:hWnd)[1], cPath+"nfw.ini", lForcaGravar )
   VerifyINI( "PROGRAMA", "COORDL", GetWndRect(oWnd:hWnd)[2], cPath+"nfw.ini", lForcaGravar )
   return nil

function VerifyINI( _section_, _entry_, _var_, _inifile_, _grava_ )
   oIni := TIni():New( _inifile_ )
   if _grava_ = .t.
      oIni:Set( _section_, _entry_, _var_ )
   endif
   return oIni:Get( _section_, _entry_, _var_, _var_ )

Code: Select all

Function BuildMenu()
MENU oMenu
         MENUITEM "640x480"    ACTION ChangeRes(640,480)
         MENUITEM "800x600"    ACTION ChangeRes(800,600)
         MENUITEM "1024x768"   ACTION ChangeRes(1024,768)
         MENUITEM "1280x1024" ACTION ChangeRes(1280,1024)
ENDMENU

Code: Select all

#Include "Fivewin.ch"
#Include "dll.ch"
#Include "Struct.ch"

#xTranslate nTrim(<n>)=>LTrim(Str(<n>))

Function ChangeRes(nX,nY,lDireto)
  Local CCDEVICENAME  := 32
  Local CCFORMNAME    := 32
  Local EWX_LOGOFF    := 0
  Local EWX_SHUTDOWN  := 1
  Local EWX_REBOOT    := 2
  Local EWX_FORCE     := 4
  Local DM_BITSPERPEL := nHex("40000")  // &H40000  // 4*16^4  // 262144 
  Local DM_PELSWIDTH  := nHex("80000")  // &H80000  // 8*16^4  // 524288  
  Local DM_PELSHEIGHT := nHex("100000") // &H100000 // 1*16^5  //1048576 
  Local CDS_UPDATE    := 1  //&H1
  Local CDS_TEST      := 4  //&H4
  Local DISP_SUCCESS  := 0
  Local DISP_RESTART  := 1
  Local nOldX         := WndWidth(GetDesktopWnd()) // GetSysMetrics(0)
  Local nOldY         := WndHeight(GetDesktopWnd()) // GetSysMetrics(1)
  Local oDevMode
  Local uRet 
  Local cBuffer
  Local lDone:=.F.
  DEFAULT nX := WndWidth(GetDesktopWnd()),;
          nY := WndHeight(GetDesktopWnd()),;
          lDireto:=.f.
  STRUCT oDevMode     
    MEMBER cDevName   AS STRING LEN CCDEVICENAME
    MEMBER nSpecVer   AS _INT
    MEMBER nDrvVer    AS _INT
    MEMBER nSize      AS _INT
    MEMBER nDrvExtra  AS _INT
    MEMBER nFields    AS DWORD
    MEMBER nOrientat  AS _INT
    MEMBER nPaperSiz  AS _INT
    MEMBER nPaperLen  AS _INT
    MEMBER nPaperWid  AS _INT
    MEMBER nScale     AS _INT
    MEMBER nCopies    AS _INT
    MEMBER nDefSrc    AS _INT
    MEMBER nPrnQlty   AS _INT
    MEMBER nColor     AS _INT  
    MEMBER nDuplex    AS _INT
    MEMBER nYResolut  AS _INT
    MEMBER nTTOpt     AS _INT
    MEMBER nCollate   AS _INT
    MEMBER cFormName  AS STRING LEN CCFORMNAME
    MEMBER nUnusePad  AS _INT
    MEMBER nBitsPPel  AS DWORD 
    MEMBER nPelWidth  AS DWORD 
    MEMBER nPelHeigh  AS DWORD
    MEMBER nDisFlags  AS DWORD
    MEMBER nDisFreq   AS DWORD
  ENDSTRUCT
  cBuffer:=oDevMode:cBuffer
  uRet := EnumDisplaySettings(0, 0, @cBuffer) 
  oDevMode:cBuffer:=cBuffer   
  IF uRet
     // Descomente o ultimo parametro se quer trocar as cores, so que nao recomendo pois irá
     // reiniciar 
     oDevMode:nFields   := nOr(DM_PELSWIDTH, DM_PELSHEIGHT /* , DM_BITSPERPEL */)
     oDevMode:nPelWidth := nX    //ScreenWidth
     oDevMode:nPelHeight:= nY    //ScreenHeight
     // Descomente esta linha para trocar as cores so que nao recomendo
     * oDevMode:nBitsPPel := 16 //(could be 8, 16, 32 or even 4)
     cBuffer:=oDevMode:cBuffer
     uRet := ChangeDisplaySettings(@cBuffer, CDS_TEST)
     oDevMode:cBuffer:=cBuffer
     DO CASE
        Case uRet = DISP_RESTART
             if MsgYesNo("Deseja reiniciar para aplicar as alteracoes?", "Atencao")
                uRet := ExitWindowsEx(EWX_REBOOT, 0)
             Endif
        Case uRet = DISP_SUCCESS
             uRet := ChangeDisplaySettings( @cBuffer, CDS_UPDATE)
             lDone:=.T.
             if lDireto
                oDevMode:nFields   := nOr(DM_PELSWIDTH, DM_PELSHEIGHT /* , DM_BITSPERPEL */)
                oDevMode:nPelWidth := nOldX    //ScreenWidth
                oDevMode:nPelHeight:= nOldY    //ScreenHeight
                cBuffer:=oDevMode:cBuffer
                uRet := ChangeDisplaySettings(@cBuffer, CDS_TEST)
                oDevMode:cBuffer:=cBuffer
             else
                if MsgYesNo("Tem certeza desta alteracao?", "Atencao")
                else
                   oDevMode:nFields   := nOr(DM_PELSWIDTH, DM_PELSHEIGHT /* , DM_BITSPERPEL */)
                   oDevMode:nPelWidth := nOldX    //ScreenWidth
                   oDevMode:nPelHeight:= nOldY    //ScreenHeight
                   cBuffer:=oDevMode:cBuffer
                   uRet := ChangeDisplaySettings(@cBuffer, CDS_TEST)
                   oDevMode:cBuffer:=cBuffer
                endif
             endif
       otherwise
             MsgAlert("Modo nao suportado", "Erro" )
     ENDCASE
  endif
return lDone

DLL32 FUNCTION EnumDisplaySettings(lpszDeviceName AS DWORD,;
                                   iModeNum AS DWORD, ;
                                   @lpDevMode AS LPSTR) AS BOOL PASCAL;
   FROM "EnumDisplaySettingsA" LIB "User32.dll" 

DLL32 FUNCTION ChangeDisplaySettings(@lpDevMode AS LPSTR,;
                                     dwFlags AS DWORD) AS DWORD;
   FROM "ChangeDisplaySettingsA" LIB "User32.dll" 

DLL32 FUNCTION ExitWindowsEx(uFlags AS DWORD,;
                             dwReserved AS DWORD) AS DWORD PASCAL;
   LIB "user32.dll"