Ajusta Resolução de Tela

por **Kapiaba** » 13 Ago 2015 11:10

#include "FiveWin.ch"
#Include "dll.ch"
#Include "Struct.ch"

static oWnd

//----------------------------------------------------------------------------//

function Main()

   local oIco, oBar, oBmp

   AjustaResolucion() // al inicio de la aplicacion

   DEFINE ICON oIco FILE "..\icons\fax.ico"

   DEFINE WINDOW oWnd FROM 1, 1 TO 22, 75 ;
      TITLE "FiveWin sample" ;
      MENU  BuildMenu() ;
      COLOR "B/W" ;
      ICON oIco

   DEFINE BUTTONBAR oBar _3D SIZE 26, 27 OF oWnd

   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\16x16\new.bmp" FLAT ;
      ACTION MsgInfo( "New" ) ;
      TOOLTIP "Creates a new document"

   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\16x16\open.bmp" FLAT ;
      ACTION MsgInfo( cGetFile( "*.*", "Select a document to open" ) ) ;
      TOOLTIP "Opens a document" WHEN .f.

   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\16x16\floppy.bmp" FLAT ;
      ACTION MsgInfo( Time() ) TOOLTIP "Saves this document"

   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\16x16\printer.bmp" FLAT ;
      ACTION MsgInfo( "Prints this document" ) TOOLTIP "Print this document" GROUP

   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\16x16\prop.bmp" FLAT ;
      ACTION PrinterSetup() TOOLTIP "Setup the printer"

   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\16x16\HelpInd.bmp" FLAT ;
      ACTION MsgInfo( Version() ) TOOLTIP "A multiple lines" + ;
      Chr( 13 ) + Chr( 10 ) + "tooltip!" GROUP

   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\16x16\Help.bmp" FLAT ;
      ACTION MsgInfo( "fivewin power!" ) TOOLTIP "fivewin power!"

   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\16x16\Exit.bmp" FLAT ;
      ACTION oWnd:End() TOOLTIP "Exit this app" GROUP

   DEFINE MESSAGE OF oWnd ;
      PROMPT FWVERSION + " " + FWCOPYRIGHT ;
      NOINSET CENTERED KEYBOARD DATE CLOCK

   DEFINE BITMAP oBmp FILENAME "..\bitmaps\fiveback.bmp"

   oWnd:bPainted = { | hDC | BmpTiled( hDC, oWnd, oBmp ) }

   ACTIVATE WINDOW oWnd ;
      VALID MsgYesNo( "Do you want to quit ?" )

return nil

//----------------------------------------------------------------------------//

function BuildMenu()

   local oMenu

   MENU oMenu
      MENUITEM "Information"
      MENU
         MENUITEM "&About..." ;
            ACTION MsgInfo( FWDESCRIPTION ) ;
            FILENAME "..\bitmaps\16x16\info.bmp"
         SEPARATOR
         MENUITEM "&End..."  ;
            ACTION oWnd:End() FILENAME "..\bitmaps\16x16\exit.bmp"

      ENDMENU

      MENUITEM "&Clients"
      MENU
         MENUITEM "&New..." ;
            ACTION ( MsgStop( "New Clients" ),;
                     oWnd:Say( 5, 5, "New Clients...", "GR+/G" ) ) ;
            FILENAME "..\bitmaps\16x16\faces.bmp"

         MENUITEM "&Modify..."  ACTION MsgInfo( "Modif. Clients" ) ;
            FILENAME "..\bitmaps\edit.bmp"

         MENUITEM "&Delete..."  ACTION MsgAlert( "Del Clients" ) ;
            FILENAME "..\bitmaps\16x16\delete.bmp"

         SEPARATOR

         MENUITEM "&Browse..."  ACTION MsgInfo( "Browse Clients" ) ;
            FILENAME "..\bitmaps\16x16\browse.bmp"

      ENDMENU

      MENUITEM "&Utilities"
      MENU
         MENUITEM "&Calculator..." ACTION WinExec( "Calc" ) ;
            FILENAME "..\bitmaps\16x16\calc.bmp"

         MENUITEM "&Internet..." ;
            ACTION WinExec( "start iexplore www.fivetech.com", 0 ) ;
            FILENAME "..\bitmaps\16x16\explorer.bmp"
      ENDMENU
   ENDMENU

return oMenu

//----------------------------------------------------------------------------//

STATIC FUNCTION BmpTiled( hDC, oWnd, oBmp )

   local nWidth := oWnd:nWidth(), nHeight := oWnd:nHeight()
   local nRow := 0, nCol := 0, n
   local nBmpWidth  := oBmp:nWidth(),  nBmpHeight := oBmp:nHeight()

   if oBmp:hBitmap == 0
      return nil
   endif

   while nRow < nHeight
      nCol = 0
      while nCol < nWidth
         PalBmpDraw( hDC, nRow, nCol, oBmp:hBitmap )
         nCol += nBmpWidth
      end
      nRow += nBmpHeight
   end

return nil

//----------------------------------------------------------------------------//

//AjustaResolucion() // al inicio de la aplicacion

FUNCTION AjustaResolucion()

   LOCAL nResoAncho := GetSysMetrics(0)

   IF nResoAncho > 1024

      CamReso ( 1024, 768)

   ENDIf

RETURN nil

//*****************************************************************

Function CamReso(nAncho, nAlto)

   Local DM_PELSWIDTH  := nHex("80000")
   Local DM_PELSHEIGHT := nHex("100000")

   //Local DM_PELSWIDTH := nHex("100000")
   //Local DM_PELSHEIGHT := nHex("160000")

   Local oDevMode
   Local lPosible
   Local cBuffer
   Local lCamReso := .f.

   DEFAULT nAncho := GetSysMetrics(0), ;
           nAlto  := GetSysMetrics(1)

   STRUCT oDevMode

      MEMBER cDevName AS STRING LEN 32
      MEMBER nSpecVer AS WORD
      MEMBER nDrvVer AS WORD
      MEMBER nSize AS WORD
      MEMBER nDrvExtra AS WORD
      MEMBER nFields AS DWORD
      MEMBER nOrientat AS WORD
      MEMBER nPaperSiz AS WORD
      MEMBER nPaperLen AS WORD
      MEMBER nPaperWid AS WORD
      MEMBER nScale AS WORD
      MEMBER nCopies AS WORD
      MEMBER nDefSrc AS WORD
      MEMBER nPrnQlty AS WORD
      MEMBER nColor AS WORD
      MEMBER nDuplex AS WORD
      MEMBER nYResolut AS WORD
      MEMBER nTTOpt AS WORD
      MEMBER nCollate AS WORD
      MEMBER cFormName AS STRING LEN 32
      MEMBER nUnusePad AS WORD
      MEMBER nBitsPPel AS DWORD
      MEMBER nPelWidth AS DWORD
      MEMBER nPelHeigh AS DWORD
      MEMBER nDisFlags AS DWORD
      MEMBER nDisFreq AS DWORD

   ENDSTRUCT

   cBuffer := oDevMode:cBuffer

   lPosible := EnumDisplaySettings(0, 0, @cBuffer)

   IF lPosible

      oDevMode:nFields := nOr(DM_PELSWIDTH, DM_PELSHEIGHT )
      oDevMode:nPelWidth := nAncho
      oDevMode:nPelHeigh := nAlto
      cBuffer:=oDevMode:cBuffer

      TRY

         ChangeDisplaySettings(@cBuffer, 4)

         lCamReso := .T.

      CATCH

         MsgAlert("Modo nao suportado", "Error" )

      END

   else

      MsgAlert("Modo nao suportado", "Error" )

   endif

return lCamReso

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

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

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

Ajusta Resolução de Tela

Ajusta Resolução de Tela

Quem está online