xHarbour.org updated!

Re: xHarbour.org updated!

Postby karinha » Fri Sep 15, 2023 5:58 pm

Enrico, ¿cómo modificar BCC32.CFG para FWH1905 y xHarbour para BCC76?

Enrico, how to modify BCC32.CFG for FWH1905 and xHarbour for BCC76?

// BCC32.CFG

Code: Select all  Expand view

-I@\..\include\windows\crtl;@\..\include\windows\sdk;@\..\include\dinkumware
-O
-O1
-OS
-Ob
-Oc
-Ov
-c
-d
-g0
-k-
-v-
-w
-w!
 


Gracias, thanks.

Regards, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7822
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: xHarbour.org updated!

Postby karinha » Fri Sep 15, 2023 6:00 pm

Enrico, ¿cómo modificar ILÇINK32.CFG para FWH1905 y xHarbour para BCC76?

Enrico, how to modify ILINK32.CFG for FWH1905 and xHarbour for BCC76?


// ILINK32.CFG

Code: Select all  Expand view

-Gn
-aa
-x
 


Gracias, thanks.

Regards, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7822
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: xHarbour.org updated!

Postby wartiaga » Fri Sep 15, 2023 7:46 pm



Enrico,

Turbo Incremental Link 6.80 Copyright (c) 1997-2017 Embarcadero Technologies, Inc.
Error: Unresolved external '___get_std_stream' referenced from D:\LANG\FWH1811\XH1.3.0\LIB\COMMON.LIB|hbtrace
Error: Unresolved external '__chdir' referenced from D:\LANG\FWH1811\XH1.3.0\LIB\HBZIP.LIB|zipplatform
Error: Unable to perform link
wartiaga
 
Posts: 212
Joined: Wed May 25, 2016 1:04 am

Re: xHarbour.org updated!

Postby karinha » Fri Sep 15, 2023 8:14 pm

Enrico:

Code: Select all  Expand view

Embarcadero C++ 7.60 for Win32 Copyright (c) 1993-2023 Embarcadero Technologies, Inc.
WINORCAM.c:
Warning W8027 C:\bcc76\include\windows\sdk\shobjidl_core.h 16821: Functions containing for are not expanded inline
Warning W8027 C:\bcc76\include\windows\sdk\shlobj_core.h 3504: Functions containing while are not expanded inline
*** 1 errors in Compile ***
 


Regards, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7822
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: xHarbour.org updated!

Postby Enrico Maria Giordano » Fri Sep 15, 2023 8:35 pm

karinha wrote:Enrico, está correcto?

Code: Select all  Expand view

xHarbour 1.3.0 Intl. (SimpLex) (Build 20230914)
 


Regards, saludos.


Yes.
User avatar
Enrico Maria Giordano
 
Posts: 8715
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia

Re: xHarbour.org updated!

Postby Enrico Maria Giordano » Fri Sep 15, 2023 8:37 pm

karinha wrote:Enrico, ¿cómo modificar BCC32.CFG para FWH1905 y xHarbour para BCC76?

Enrico, how to modify BCC32.CFG for FWH1905 and xHarbour for BCC76?


No changes.
User avatar
Enrico Maria Giordano
 
Posts: 8715
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia

Re: xHarbour.org updated!

Postby Enrico Maria Giordano » Fri Sep 15, 2023 8:37 pm

karinha wrote:Enrico, ¿cómo modificar ILÇINK32.CFG para FWH1905 y xHarbour para BCC76?

Enrico, how to modify ILINK32.CFG for FWH1905 and xHarbour for BCC76?


// ILINK32.CFG

Code: Select all  Expand view

-Gn
-aa
-x
 


Gracias, thanks.

Regards, saludos.


No changes too.
User avatar
Enrico Maria Giordano
 
Posts: 8715
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia

Re: xHarbour.org updated!

Postby Enrico Maria Giordano » Fri Sep 15, 2023 8:41 pm

karinha wrote:Enrico:

Code: Select all  Expand view

Embarcadero C++ 7.60 for Win32 Copyright (c) 1993-2023 Embarcadero Technologies, Inc.
WINORCAM.c:
Warning W8027 C:\bcc76\include\windows\sdk\shobjidl_core.h 16821: Functions containing for are not expanded inline
Warning W8027 C:\bcc76\include\windows\sdk\shlobj_core.h 3504: Functions containing while are not expanded inline
*** 1 errors in Compile ***
 


Regards, saludos.


Can I see a little PRG example showing the problem, please? None of my applications show this warning.
User avatar
Enrico Maria Giordano
 
Posts: 8715
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia

Re: xHarbour.org updated!

Postby karinha » Sat Sep 16, 2023 5:51 pm

Enrico, I have no way to simulate this example, as it is my MAIN MENU that compiles perfectly with BCC74.

Enrico, no tengo forma de simular este ejemplo, ya que es mi MENÚ PRINCIPAL el que se compila perfectamente con BCC74.

Code: Select all  Expand view

Lines 281, Functions/Procedures 2, pCodes 1483
Embarcadero C++ 7.60 for Win32 Copyright (c) 1993-2023 Embarcadero Technologies, Inc.
WINORCAM.c:
Warning W8027 c:\bcc76\include\windows\sdk\shobjidl_core.h 16821: Functions containing for are not expanded inline
Warning W8027 c:\bcc76\include\windows\sdk\shlobj_core.h 3504: Functions containing while are not expanded inline
*** 1 errors in Compile ***
 



Con BCC76, sólo el MENÚ PRINCIPAL no se compila, los demás módulos se compilan perfectamente. No entiendo. Lo cambio a BCC74 y se compila normalmente.

With BCC76, only the MAIN MENU does not compile, the other modules compile perfectly. I don't understand. I change it to BCC74 and it compiles normally.

Regards, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7822
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: xHarbour.org updated!

Postby Enrico Maria Giordano » Sat Sep 16, 2023 5:54 pm

Can you send me WINORCAM.PRG to try to compile it here?
User avatar
Enrico Maria Giordano
 
Posts: 8715
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia

Re: xHarbour.org updated!

Postby karinha » Sat Sep 16, 2023 7:15 pm

Enrico Maria Giordano wrote:Can you send me WINORCAM.PRG to try to compile it here?


Enrico, problem solved. I removed these functions that are not used in the main program and it compiled perfectly.

Enrique, problema solucionado. Eliminé estas funciones que no se utilizan en el programa principal y se compiló perfectamente.

No tengo idea de qué función causó el ERROR.

I have no idea which function caused the ERROR.

Code: Select all  Expand view

// http://forums.fivetechsupport.com/viewt ... =3&t=39669  // BARCOLOR.PRG
FUNCTION ButtonBarColor() // essa pohha nao funcionou, passei raiva.

RETURN( nRGB( 255, 128, 128) )

Function DiagonalGradientFill( hDC, nTop, nLeft, nBottom, nRight, aGradInfo, lDirection )

   local nClr := 1, nClrs := Len( aGradInfo )
   local nSize, nStart, nEnd

   default lDirection := .T.

   if Empty( aGradInfo )
      return nil
   endif

   nSize    = ( nBottom - nTop ) + ( nRight - nLeft )
   nStart   = 0
   nEnd     = 0

   for nClr := 1 to nClrs

      nStart = nEnd
      nEnd   += ( nSize * ( aGradInfo[ nClr ][ 1 ] ) )

      DiagonalGradient( hDC, ;
                       { nTop, nLeft, nBottom, nRight },;
                         aGradInfo[ nClr ][ 2 ], ;
                         aGradInfo[ nClr ][ 3 ], ;
                         lDirection, ;
                         nStart, ;
                         nEnd )

   next

return nil

Static Function _ResMessage( nScr1,nScr2 )

   MsgInfo( "Sua resolução de tela atual é: " + STR( nSCR1,4 ) + " x " + STR( nSCR2, 4 )+CRLF+ ;
            "Para este aplicativo, a resolução ideal é: 1024 x 768. Isto não é um erro" +CRLF+ ;
            "crítico, no entanto, você pode encontrar algumas telas e formulários"      +CRLF+ ;
            "neste aplicativo que será melhor visualizado em: 1024 x 768       (Video)",       ;
            "PLENOIND: Sugestão de melhor resolução de tela..." )

RETURN(.T.)
// --------  WINDOW - Background --------------- nao usei isto(pesado)
FUNCTION W_BACKGRD( oWnd, cImage )

   local oImage

   // original
   // DEFINE IMAGE oImage FILE c_path1 + cImage
   DEFINE IMAGE oImage FILE cDirPleno + cImage

   oBrush := TBrush():new( ,,,, ResizeBmp( oImage:hBitmap, oWnd:nWidth, oWnd:nHeight , .T. ) )

   oImage:End()

   oWnd:SetBrush( oBrush )

   oBrush:End()

RETURN NIL

// ESTA EM: AUTORES.PRG - PREFERI NAO USAR. EFEITOS COLATERAIS QUE NAO GOSTEI.
FUNCTION AutoResize( lAutoresize, nWhatSize, oWnd, nResolution, lRepaint )

   // Resolución de la pantalla en el momento de definir los controles.
   Local nOriWidth, nOriHeight
   // Lo normal sería que fuera la resolución actual de la pantalla (nWhatSize=0).
   // Se permite forzar esta resolución mediante el valor de nWhatSize=1,2,3,4,5,6,7,....
   Local nWidth, nHeight
   // Son la relación entre la resolución de pantalla y la resolución de diseño.
   Local nFactorWitdh, nFactorHeight
   Local nContador

   DEFAULT lRepaint := .T.

   nOriWidth  := 0
   nOriHeight := 0
   nWidth     := 0
   nHeight    := 0
   nContador  := 0

   If ABS(nResolution) = 1
      nOriWidth := 640
      nOriHeight := 480
   ElseIf ABS(nResolution) = 2
      nOriWidth := 800
      nOriHeight := 600
   ElseIf ABS(nResolution) = 3
      nOriWidth := 1024
      nOriHeight := 768
   ElseIf ABS(nResolution) = 4
      nOriWidth := 1152
      nOriHeight := 864
   ElseIf ABS(nResolution) = 5
      nOriWidth := 1280
      nOriHeight := 800
   ElseIf ABS(nResolution) = 6
      nOriWidth := 1280
      nOriHeight := 1024
   ElseIf ABS(nResolution) = 7
      nOriWidth := 1600
      nOriHeight := 1200
   ElseIf ABS(nResolution) = 8
      nOriWidth := 768
      nOriHeight := 1024
   Else
      ScrResolution( @nOriWidth, @nOriHeight )
   Endif

   If nWhatSize = 1
      nWidth := 640
      nHeight := 480
   ElseIf nWhatSize = 2
      nWidth := 800
      nHeight := 600
   ElseIf nWhatSize = 3
      nWidth := 1024
      nHeight := 768
   ElseIf nWhatSize = 4
      nWidth := 1152
      nHeight := 864
   ElseIf nWhatSize = 5
      nWidth := 1280
      nHeight := 800
   ElseIf nWhatSize = 6
      nWidth := 1280
      nHeight := 1024
   ElseIf nWhatSize = 7
      nWidth := 1600
      nHeight := 1200
   ElseIf nWhatSize = 8
      nWidth := 768
      nHeight := 1024
   Else

      ScrResolution( @nWidth, @nHeight )

   Endif

   If lAutoresize .and. nOriHeight != nHeight

      /* Este será el caso habitual, en el cual se pretende redimensionar
      los controles a la resolución de la pantalla en la cual se estan
      viendo. 01/03/2006 */


   If nResolution > 0

      nFactorWitdh  := nWidth / nOriWidth
      nFactorHeight := nHeight / nOriHeight

      /* Este será el caso en el cual se pretende deshacer el redimensionamiento
      de los controles realizado previamente. */


   ElseIf nResolution < 0

      nFactorWitdh := nOriWidth / nWidth
      nFactorHeight := nOriHeight / nHeight

   EndIf

   If lRepaint
      oWnd:Hide()
   EndIf

   //If nFactorWitdh > 1 // .or.
   If nFactorHeight > 1

      If oWnd:ClassName() == "kalimeroquetequiero"

      ElseIf oWnd:ClassName() $ "/TJ02LISMN/TLISTBOX/"
         oWnd:Move( oWnd:nTop * nFactorHeight , ;
         oWnd:nLeft * nFactorWitdh, ;
         oWnd:nWidth * nFactorWitdh, ;
         oWnd:nHeight , ;
         .F. )

      Else

         oWnd:Move( oWnd:nTop * nFactorHeight , ;
         oWnd:nLeft * nFactorWitdh, ;
         oWnd:nWidth * nFactorWitdh, ;
         oWnd:nHeight * nFactorHeight , ;
         .F. )

      EndIf

   EndIf

   If oWnd:ClassName() == "TFOLDER"

      If ValType( oWnd:aDialogs ) = "A"
         For nContador := 1 To Len( oWnd:aDialogs )
            AutoResize( lAutoresize, nWhatSize, oWnd:aDialogs[nContador], nResolution, .F. )
         EndFor
      EndIf

   Else

      If ValType( oWnd:aControls ) = "A"

         For nContador := 1 To Len( oWnd:aControls )
            AutoResize( lAutoresize, nWhatSize, oWnd:aControls[nContador], nResolution, .F. )
         EndFor

      EndIf

   EndIf

   //If nFactorWitdh < 1 // .or.
   If nFactorHeight < 1

      If oWnd:ClassName() == "kalimeroquetequiero"

         ElseIf oWnd:ClassName() $ "/TJ02LISMN/TLISTBOX/"
            oWnd:Move( oWnd:nTop * nFactorHeight , ;
            oWnd:nLeft * nFactorWitdh, ;
            oWnd:nWidth * nFactorWitdh, ;
            oWnd:nHeight , ;
            .F. )

         Else

            oWnd:Move( oWnd:nTop * nFactorHeight , ;
            oWnd:nLeft * nFactorWitdh, ;
            oWnd:nWidth * nFactorWitdh, ;
            oWnd:nHeight * nFactorHeight , ;
            .F. )

         EndIf

      EndIf

      If lRepaint
         oWnd:Show()
      EndIf

   EndIf

Return Nil
/*
SHOWTASKBAR() // Habilita
HIDETASKBAR() // Desabilita
TIRA_X()      // Desabilita o X da Janela
PISCA_EXE()   // Vai Piscar o Seu EXE na Barra do Windows
*/


#pragma BEGINDUMP

#include "windows.h"
#include "shlobj.h"
#include "hbapi.h"
#include "math.h"
#include "hbvm.h"
#include "hbstack.h"
#include "hbapiitm.h"
#include "hbapigt.h"

/*// ESTA EM: ALTTAB.PRG
HB_FUNC ( SHOWTASKBAR ) //Habilita o botao INICIAR
{
HWND hWnd = FindWindow("Shell_TrayWnd", "");

ShowWindow( hWnd, 1 );
}
*/


HB_FUNC ( HIDETASKBAR ) //Desabilita o botao Iniciar
{
HWND hWnd = FindWindow("Shell_TrayWnd", "");

ShowWindow( hWnd, 0 );
}

HB_FUNC ( PISCA_EXE ) // VAI PISCAR O SEU EXE NA BARRA
{
HWND Handle = GetForegroundWindow();

FlashWindow(Handle,TRUE); // VAI PISCAR O SEU EXE NA BARRA

Sleep(300); // TEMPO DE ESPERA
}

HB_FUNC ( TIRA_X ) // DESABILITA O X da janela

{
HMENU MenuH = GetSystemMenu(GetForegroundWindow(),FALSE);

EnableMenuItem(MenuH,SC_CLOSE,MF_GRAYED);
}

HB_FUNC ( VOLTA_X ) // HABILUTA O X da janela

{
HMENU MenuH = GetSystemMenu(GetForegroundWindow(),TRUE);

EnableMenuItem(MenuH,SC_CLOSE,MF_GRAYED);
}

HB_FUNC ( DESABILITA_X ) // Desabilita O X da janela
{
HMENU MenuH = GetSystemMenu(GetActiveWindow(),FALSE);
EnableMenuItem(MenuH,SC_CLOSE,MF_GRAYED);
//DeleteMenu(MenuH,SC_CLOSE,MF_BYCOMMAND);
}

#pragma ENDDUMP

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

/*
 *  FlashWndTimer()
 *  Flash Windows from API
 *
 *  Andrade A. Daniel - 2001
 *      Rosario, Argentina  -  www.dbwide.com.br
 */


/*
 *  FlashWndTimer( <ohWnd>, [<nDelay>], [<bWhen>] )
 *
 *  ohWnd   - Objeto Window/Dialog o Puntero del Objeto
 *  nDelay  - n Milisegundos del Timer
 *  bWhen   - Condición para ejecutar el Flashing
 *
 */

FUNCTION FlashWndTimer( ohWnd, nDelay, bWhen, oWnd )

    Local oTmr

    //Em Ingles/FiveWin
    DEFAULT nDelay  := 500
    DEFAULT bWhen   := { || .T. }

    DEFINE TIMER oTmr INTERVAL nDelay ACTION Flashing( ohWnd, bWhen )
    ACTIVATE TIMER oTmr

RETURN oTmr
/*
 *      Flashing()
 */

STATIC FUNCTION Flashing( ohWnd, bWhen )

   Static nStatus := 0

   Local  hWnd

   hWnd := IIF( ValType(ohWnd) != "O", ohWnd, ohWnd:hWnd )

   If Eval( bWhen, hWnd )
      FlashWnd( hWnd, ( nStatus := IIF( nStatus == 1, 0, 1 ) ) )
   Endif

RETURN .T.

DLL32 STATIC FUNCTION FlashWnd( hWnd AS LONG, nInvert AS LONG ) ;
      AS LONG PASCAL FROM "FlashWindow" LIB "User32.dll"

// Declare Function FlashWindow Lib "user32" Alias "FlashWindow"
// (ByVal hwnd As Long, ByVal bInvert As Long) As Long

// [AD-2001] - Daniel Andrade, www.dbwide.com.ar - 2001

// QUEBRANDO NO PREVIEW, VERIFICAR NAS NOVAS VERSOES: FWH1905 EM DIANTE.
// NAO E IMPORTANTE, APENAS PARA FAZER UM BEEP NO BOTAO, PARA VE SE ESTA OK.
Function FWSkinBtnLButtonDown( hWnd, nRow, nCol )  // 19/02/2020 - Joao

   LOCAL hDC   := GetDC( hWnd )
   LOCAL oBtn  := oWndFromhWnd( hWnd )

   hWndDown    := hWnd
   SetFocus( hWnd )
   SysRefresh()
   lBtnPressed := .T.
   lMOver      := .F.

   FWSkinBtnPaint( hWnd, hDC, lBtnPressed )

   ReleaseDC( hWnd, hDC )

   // MsgBeep()  // FAZ UM BEEP NO CLICK DO BOTAO

Return nil

*******************************************************************************
*
* Function SetMenuBG(oWnd, nClrBack, oBrush)
*
*   ENGLISH : Changes menus backgrounds or paint them with a brush
*   ESPANHOL: Cambia el color de fondo de los menús o les agrega un brush
*  
*  TESTED / PROBADO: FWH23c, xHarbour0.81
*
*  César E. Lozada (cesarlozada@hotmail.com)
*  Los Teques, Venezuela    2003-08-08
*
*******************************************************************************

#Define MIM_APPLYTOSUBMENUS 2147483648 //&H80000000
#Define MIM_BACKGROUND      2          //&H2

*==============================================================================
Function SetMenuBG( oWnd, nClrBack, oBrush )

    Local nRet := 0
    Local hMenu
    Local oMenuInfo, cBuffer

    STRUCT oMenuInfo
        MEMBER nSize AS LONG
        MEMBER nMask AS LONG
        MEMBER nStyle AS LONG
        MEMBER nMax AS LONG
        MEMBER nClrBack AS LONG
        MEMBER nHelpID AS LONG
        MEMBER nMenuData AS LONG
    ENDSTRUCT

    IF ( hMenu := GetMenu( oWnd:hWnd ) ) <> 0

        cBuffer           := oMenuInfo:cBuffer

        GetMenuInfo( hMenu, @cBuffer )
        oMenuInfo:cBuffer := cBuffer

        oMenuInfo:nSize   := Len( oMenuInfo:cBuffer )
        oMenuInfo:nMask   := nOr( MIM_APPLYTOSUBMENUS, MIM_BACKGROUND )

        IF oBrush <> Nil
            oMenuInfo:nClrBack := oBrush:hBrush
         ELSE
            oMenuInfo:nClrBack := CreateSolidBrush( nClrBack )
        ENDIF

        nRet := SetMenuInfo( hMenu, oMenuInfo:cBuffer )

        DrawMenuBar( oWnd:hWnd )

    ENDIF

Return nRet

*==============================================================================

DLL32 STATIC FUNCTION GetMenu ;
      ( hwnd AS LONG )        ;
        AS LONG PASCAL        ;
        LIB "USER32"

DLL32 Static Function GetMenuInfo ;
      ( hMenu AS LONG,            ;
        cMenuInfo AS LPSTR)       ;
        AS LONG PASCAL            ;
        FROM "GetMenuInfo" LIB "USER32"

DLL32 Static Function SetMenuInfo ;
      ( hMenu AS LONG,            ;
        cMenuInfo AS LPSTR)       ;
        AS LONG PASCAL            ;
        FROM "SetMenuInfo" LIB "USER32"

//------Fim da Function SetMenuBG(oWnd, nClrBack, oBrush)------------------
// -----------------------------------------------------------------------------
// Reabre o menu que chamou uma rotina.
// 1§ Descobre o caminho para se chegar ate oM:LastItem()
// 2§ Abre o menu simulando a tecla Alt e, em seguida, a
// sequencia de setas para chegar ate oM:LastItem()
FUNCTION ShowMenu( oM, nNiv )

   LOCAL nItem, oLItM, cMov := "", cMv, nChr

   DEFAULT oM := WndMain():oMenu
   DEFAULT nNiv := 0

   oLItM := oM:LastItem()

   FOR nItem := 1 TO Len( oM:aItems )
      IF ValType( oM:aItems[ nItem ]:bAction ) = 'O'
         cMv := ShowMenu( oM:aItems[ nItem ]:bAction, nNiv + 1 )
         IF Right( cMv, 1 ) == "x"
            cMov += Chr( if( nNiv = 0, VK_DOWN, VK_RIGHT ) ) + cMv
            IF nNiv == 0
               cMov := Left( cMov, Len( cMov ) - 1 )
               // MsgInfo( StrTran( StrTran( cMov,Chr(VK_DOWN),"V" ), Chr(VK_RIGHT), ">" ) )
               keybd_event( VK_MENU, 0, 0, 0 )
               keybd_event( VK_MENU, 0, KEYEVENTF_KEYUP, 0 )
               FOR nChr := 1 TO Len( cMov )
                  keybd_event( Asc( SubStr( cMov, nChr, 1 ) ), 0, 0, 0 )
                  keybd_event( Asc( SubStr( cMov, nChr, 1 ) ), 0, KEYEVENTF_KEYUP, 0 )
               NEXT
               RETURN .T.
            ENDIF
            RETURN cMov
         ENDIF
      ELSE
         IF oM:aItems[ nItem ]:nId == oLItM:nId
            RETURN cMov + "x"
         ENDIF
      ENDIF

      IF !Empt( oM:aItems[ nItem ]:cPrompt ) // se não for um separador
         cMov += Chr( if( nNiv = 0, VK_RIGHT, VK_DOWN ) )
      ENDIF

   NEXT

RETURN if( nNiv == 0, .F., "" )

// CORES NO TITULO DA WINDOW -FUNCIONOU-- Melhor nao usar isto, efeito colateral.
#pragma BEGINDUMP

#include <hbapi.h>
#include <windows.h>

HB_FUNC( CLRTEST )
{
   int aElements[2] = { COLOR_CAPTIONTEXT, COLOR_ACTIVECAPTION };
   DWORD aColors[2];

   aColors[ 0 ] = hb_parnl( 1 );
   aColors[ 1 ] = hb_parnl( 2 );
   SetSysColors( 2, aElements, aColors );

}

#pragma ENDDUMP

/* // JA TEM EM CALCULAD.PRG
// ***********************************************************
DLL32 FUNCTION keybd_event( bVk as _INT, bScan as _INT, dwFlags ;
      as LONG, dwExtraInfo as LONG ) AS LONG PASCAL LIB "user32.dll"
// ***********************************************************
*/


// 03/09/2022 - INFELIZMENTE ESTA FUNCAO NAO FUNCIONA EM WINDOWS 10. Seria perfeita.
Function CamReso( nAncho, nAlto )

   Local DM_PELSWIDTH  := nHex("80000")
   Local DM_PELSHEIGHT := nHex("100000")
   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 no soportado", "Error" )
      END
   else
      MsgAlert("Modo no soportado", "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"
 


Gracias, thanks.

Regards, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7822
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: xHarbour.org updated!

Postby karinha » Sat Sep 16, 2023 7:22 pm

I also noticed that the size of the DAUGHTER WINDOW was a little smaller than the one compiled with the BCC74 version. As shown in the image, look at the bottom of the window to understand.

También noté que el tamaño de DAUGHTER WINDOW era un poco más pequeño que el compilado con la versión BCC74. Como se muestra en la imagen, mire la parte inferior de la ventana para comprenderlo.

https://imgur.com/HyksFAx

Image

Regards, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7822
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: xHarbour.org updated!

Postby karinha » Sat Sep 16, 2023 7:36 pm

Enerico, esta correcto esto?

Code: Select all  Expand view

// BCC32.CFG

-6
-DHB_GUI
-DHB_INCLUDE_WINEXCHANDLER
-DHB_NO_PROFILER
-DHB_NO_TRACE
-DHB_WIN32_IO
-Ic:\bcc76\include\windows\crtl;c:\bcc76\include\windows\sdk;c:\bcc76\include\dinkumware
-O
-O1
-O2
-OS
-Ob
-Oc
-Ov
-c
-d
-g0
-k-
-v-
-w
-w!
 


// ILINK32.CFG

Code: Select all  Expand view

-Gn
-Lc:\bcc76\lib;c:\bcc76\lib\psdk
-aa
-x
 


Regards, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7822
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: xHarbour.org updated!

Postby Enrico Maria Giordano » Sat Sep 16, 2023 9:39 pm

karinha wrote:I also noticed that the size of the DAUGHTER WINDOW was a little smaller than the one compiled with the BCC74 version. As shown in the image, look at the bottom of the window to understand.


Sorry, I don't understand. Can you mark the place of the problem, please?
User avatar
Enrico Maria Giordano
 
Posts: 8715
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia

Re: xHarbour.org updated!

Postby Enrico Maria Giordano » Sat Sep 16, 2023 9:42 pm

karinha wrote:Enerico, esta correcto esto?

Code: Select all  Expand view

// BCC32.CFG

-6
-DHB_GUI
-DHB_INCLUDE_WINEXCHANDLER
-DHB_NO_PROFILER
-DHB_NO_TRACE
-DHB_WIN32_IO
-Ic:\bcc76\include\windows\crtl;c:\bcc76\include\windows\sdk;c:\bcc76\include\dinkumware
-O
-O1
-O2
-OS
-Ob
-Oc
-Ov
-c
-d
-g0
-k-
-v-
-w
-w!
 


No, use this:

Code: Select all  Expand view
-I@\..\include\windows\crtl;@\..\include\windows\sdk;@\..\include\dinkumware
-O
-O1
-OS
-Ob
-Oc
-Ov
-c
-d
-g0
-k-
-v-
-w
-w!


karinha wrote:// ILINK32.CFG

Code: Select all  Expand view

-Gn
-Lc:\bcc76\lib;c:\bcc76\lib\psdk
-aa
-x
 


Yes, this look correct.
User avatar
Enrico Maria Giordano
 
Posts: 8715
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia

PreviousNext

Return to WhatsNew / Novedades

Who is online

Users browsing this forum: No registered users and 16 guests