// http://forums.fivetechsupport.com/viewt ... =3&t=39669 // BARCOLOR.PRGFUNCTION 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
) nextreturn nilStatic 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 EndIfReturn 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 BARRASleep(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 ) ) ) EndifRETURN .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 BOTAOReturn 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 ) ENDIFReturn 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 NEXTRETURN 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" ) endifreturn 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"