leo@lhsistemas.com
-
Posts
99 -
Joined
-
Last visited
-
Days Won
3
Posts posted by leo@lhsistemas.com
-
-
kaiaba, boa tarde.
A versão da minha FiveWin é:
FWH/FWHX 10.12 23/Jan/2011
Tem mais nova ?
-
gunafe, bom dia.
Valeu pelo código, porém, o erro ainda persiste, veja abaixo:
Application
===========
Path and name: D:\CLIPPER\PAFECF\LHACESSO.EXE (32 bits)
Size: 1,659,392 bytes
Time from start: 0 hours 0 mins 0 secs
Error occurred at: 20/03/2013, 10:47:23
Error description: Error BASE/1066 Argument error: conditional
Args:
[ 1] = A { ... }
Stack Calls
===========
Called from: D:\CLIPPER\PAFECF\xdev\TREEVIEW.PRG => TTREEVIEW:NEW(188)
Called from: D:\CLIPPER\PAFECF\LHACESSO.PRG => CREATREE(471)
Called from: D:\CLIPPER\PAFECF\LHACESSO.PRG => (b)CHILDTREE(453)
Called from: .\source\classes\WINDOW.PRG => TWINDOW:ACTIVATE(985)
Called from: .\source\classes\MDICHILD.PRG => TMDICHILD:ACTIVATE(245)
Called from: D:\CLIPPER\PAFECF\LHACESSO.PRG => CHILDTREE(453)
Called from: D:\CLIPPER\PAFECF\LHACESSO.PRG => (
_CACESSOS(361)
Called from: .\source\classes\WINDOW.PRG => TMDIFRAME:ACTIVATE(985)
Called from: D:\CLIPPER\PAFECF\LHACESSO.PRG => _CACESSOS(361)
-
Ico, boa tarde;
O problema está na TREE e não na WINDOW.
Abraços,
-
Kapiaba, boa tarde.
Mas, o site acima informa o erro na TWINDOW.
O que está acontecendo comigo é na TTREE
É isto mesmo ???
-
Bom dia.
Estou com o seguinte erro abaixo ao migrar o módulo de acessos do meu software de 16bits para 32bits utilizando FW + xHb + xDev.
Alguém pode me informar que erro é este.
Application
===========
Path and name: D:\CLIPPER\PAFECF\LHACESSO.EXE (32 bits)
Size: 1,660,416 bytes
Time from start: 0 hours 0 mins 4 secs
Error occurred at: 15/03/2013, 09:45:32
Error description: Error BASE/1066 Argument error: conditional
Args:
[ 1] = A { ... }
Stack Calls
===========
Called from: .\source\classes\TTREEVIE.PRG => TTREEVIEW:NEW(149)
Called from: D:\CLIPPER\PAFECF\LHACESSO.PRG => CREATREE(469)
Called from: D:\CLIPPER\PAFECF\LHACESSO.PRG => (b)CHILDTREE(451)
Called from: .\source\classes\WINDOW.PRG => TWINDOW:ACTIVATE(985)
Called from: .\source\classes\MDICHILD.PRG => TMDICHILD:ACTIVATE(245)
Called from: D:\CLIPPER\PAFECF\LHACESSO.PRG => CHILDTREE(451)
Called from: D:\CLIPPER\PAFECF\LHACESSO.PRG => (_CACESSOS(359)
Called from: .\source\classes\WINDOW.PRG => TMDIFRAME:ACTIVATE(985)
Called from: D:\CLIPPER\PAFECF\LHACESSO.PRG => _CACESSOS(359)
Variables in use
================
Procedure Type Value
==========================
TTREEVIEW:NEW
Param 1: N 0
Param 2: N 0
Param 3: N 0
Param 4: N 0
Param 5: O Class: TMDICHILD
Param 6: A Len: 13
Param 7: L .F.
Param 8: N 150
Param 9: B {|| ... }
Param 10: U
Param 11: L .F.
Param 12: O Class: TTREEVIEW
Param 13: C "[_NTOP]"
Param 14: O Class: TTREEVIEW
Param 15: A Len: 13
Param 16: U
Param 17: U
Param 18: C "[ERRORSYS]"
CREATREE
Param 1: O Class: TMDICHILD
Local 1: U
Local 2: U
Local 3: U
Local 4: U
(b)CHILDTREE
Param 1: O Class: TMDICHILD
TWINDOW:ACTIVATE
Param 1: C "NORMAL"
Param 2: U
Param 3: U
Param 4: U
Param 5: U
Param 6: U
Param 7: U
Param 8: B {|| ... }
Param 9: U
Param 10: U
Param 11: U
Param 12: U
Param 13: U
Param 14: U
Param 15: U
Param 16: U
Param 17: U
Local 1: U
Local 2: U
Local 3: O Class: TMDICHILD
Local 4: U
Local 5: U
TMDICHILD:ACTIVATE
Param 1: U
Param 2: U
Param 3: U
Param 4: U
Param 5: U
Param 6: U
Param 7: U
Param 8: B {|| ... }
Param 9: U
Param 10: U
Param 11: U
Param 12: U
Param 13: U
Param 14: U
Param 15: U
Param 16: U
Param 17: U
Param 18: O Class: TMDICHILD
Param 19: C "[ACTIVATE]"
CHILDTREE
Local 1: O Class: TBAR
Local 2: O Class: TMDICHILD
Local 3: U
(_CACESSOS
Param 1: O Class: TMDIFRAME
TMDIFRAME:ACTIVATE
Param 1: C "NORMAL"
Param 2: U
Param 3: U
Param 4: U
Param 5: U
Param 6: U
Param 7: U
Param 8: B {|| ... }
Param 9: U
Param 10: U
Param 11: U
Param 12: U
Param 13: U
Param 14: U
Param 15: U
Param 16: U
Param 17: B {|| ... }
Param 18: U
Param 19: U
Local 1: O Class: TMDIFRAME
Local 2: U
Local 3: U
_CACESSOS
Param 1: C "¦"
Local 1: N 1
Local 2: U
Classes in use:
===============
1 ERROR
2 HASHENTRY
3 HBCLASS
4 HBOBJECT
5 TWINDOW
6 TMDIFRAME
7 TMENU
8 TMENUITEM
9 TBRUSH
10 TMDICLIENT
11 TFONT
12 TMSGBAR
13 TRECT
14 TMSGITEM
15 TTIMER
16 TMDICHILD
17 TCONTROL
18 TICON
19 TBAR
20 TBTNBMP
21 TTREEVIEW
22 TREG32 -
João Bosco, boa tarde.
Valeu mesmo pela sua ajuda.
Deu certo, agora está compilando e linkando a PRINTER e RPREVIEW modificada.
Estou fazendo alguns ajustes nelas.
Daà o usuário poderá salvar em XLS o relatório no vÃdeo.
Abraços.
Leonardo Guimarães
Vitória-ES
FWH + xDevStudio + xHarbour
-
Fiz modificações na classe TPRINTER, aà compila mas não linka a "danada" com as minhas alterações.
O que estar acontecendo gente !!!
Utilizo o FW/xDevStudio/xHarbour
Leonardo Guimarães
Vitória-ES
FWH + xDevStudio + xHarbour
-
Fiz modificações na classe TPRINTER, aà compila mas não linka a "danada" com as minhas alterações.
O que estar acontecendo gente !!!
Utilizo o FW/xDevStudio/xHarbour
Leonardo Guimarães
Vitória-ES
FWH + xDevStudio + xHarbour
-
Bom dia.
Temos software homologado PAFECF desde 2009 para trabalhar com:
-Pre Venda
-DAV
-DAVOS
-Bar e restaurantes.
ECFs: Bematech, Daruma e Elgin.
Se desejar algo, contacte-nos: leo@lhsistemas.com
Leonardo Guimarães
Vitória-ES
FWH + xDevStudio + xHarbour
-
Ico, boa tarde.
Sim as modifcações são compiladas, pois, no xDev vejo compilando a RPREVIEW.PRG e PRINTER.PRG, só que uma variavel chamada cFileCMD criada como publica no PRINTER.PRG, não existe no RPREVIEW.PRG, ocasionando o erro.
Parace que o FiveWin + xHarbour, ignora a minha PRINTER.PRG na execução, e utiliza a interna da bibliteca nativa.
Leonardo Guimarães
Vitória-ES
FWH + xDevStudio + xHarbour
-
Gilmer, boa tarde.
Ajuda !!!
Leonardo Guimarães
Vitória-ES
FWH + xDevStudio + xHarbour
-
Ico, boa tarde.
No PRINTER para cada comando enviado a impressora crio um arquivo .LHS que contém os @SAY.
No RPREVIEW eu criei um arquivo formato excel vazio.xls ai faço a copia dele para o nome que o usuário quer dar ao preview e monto ele de acordo com o script.
Segue abaixo a PRINTER.PRG
*** INICIO
#include "FiveWin.ch"
#include "set.ch"
#include "struct.ch"
#define TA_LEFT 0
#define TA_RIGHT 2
#define TA_CENTER 6
#define ETO_OPAQUE 2
#define ETO_CLIPPED 4
#define HORZSIZE 4
#define VERTSIZE 6
#define HORZRES 8
#define VERTRES 10
#define LOGPIXELSX 88
#define LOGPIXELSY 90
#define MM_TEXT 1
#define MM_LOMETRIC 2
#define MM_HIMETRIC 3
#define MM_LOENGLISH 4
#define MM_HIENGLISH 5
#define MM_TWIPS 6
#define MM_ISOTROPIC 7
#define MM_ANISOTROPIC 8
#define PAD_LEFT 0
#define PAD_RIGHT 1
#define PAD_CENTER 2
// Defines for the oPrn:SetPage(nPage) method (The printer MUST support it)
#define DMPAPER_LETTER 1 // Letter 8 1/2 x 11 in
#define DMPAPER_LETTERSMALL 2 // Letter Small 8 1/2 x 11 in
#define DMPAPER_TABLOID 3 // Tabloid 11 x 17 in
#define DMPAPER_LEDGER 4 // Ledger 17 x 11 in
#define DMPAPER_LEGAL 5 // Legal 8 1/2 x 14 in
#define DMPAPER_STATEMENT 6 // Statement 5 1/2 x 8 1/2 in
#define DMPAPER_EXECUTIVE 7 // Executive 7 1/4 x 10 1/2 in
#define DMPAPER_A3 8 // A3 297 x 420 mm
#define DMPAPER_A4 9 // A4 210 x 297 mm
#define DMPAPER_A4SMALL 10 // A4 Small 210 x 297 mm
#define DMPAPER_A5 11 // A5 148 x 210 mm
#define DMPAPER_B4 12 // B4 250 x 354
#define DMPAPER_B5 13 // B5 182 x 257 mm
#define DMPAPER_FOLIO 14 // Folio 8 1/2 x 13 in
#define DMPAPER_QUARTO 15 // Quarto 215 x 275 mm
#define DMPAPER_10X14 16 // 10x14 in
#define DMPAPER_11X17 17 // 11x17 in
#define DMPAPER_NOTE 18 // Note 8 1/2 x 11 in
#define DMPAPER_ENV_9 19 // Envelope #9 3 7/8 x 8 7/8
#define DMPAPER_ENV_10 20 // Envelope #10 4 1/8 x 9 1/2
#define DMPAPER_ENV_11 21 // Envelope #11 4 1/2 x 10 3/8
#define DMPAPER_ENV_12 22 // Envelope #12 4 \276 x 11
#define DMPAPER_ENV_14 23 // Envelope #14 5 x 11 1/2
#define DMPAPER_CSHEET 24 // C size sheet
#define DMPAPER_DSHEET 25 // D size sheet
#define DMPAPER_ESHEET 26 // E size sheet
#define DMPAPER_ENV_DL 27 // Envelope DL 110 x 220mm
#define DMPAPER_ENV_C5 28 // Envelope C5 162 x 229 mm
#define DMPAPER_ENV_C3 29 // Envelope C3 324 x 458 mm
#define DMPAPER_ENV_C4 30 // Envelope C4 229 x 324 mm
#define DMPAPER_ENV_C6 31 // Envelope C6 114 x 162 mm
#define DMPAPER_ENV_C65 32 // Envelope C65 114 x 229 mm
#define DMPAPER_ENV_B4 33 // Envelope B4 250 x 353 mm
#define DMPAPER_ENV_B5 34 // Envelope B5 176 x 250 mm
#define DMPAPER_ENV_B6 35 // Envelope B6 176 x 125 mm
#define DMPAPER_ENV_ITALY 36 // Envelope 110 x 230 mm
#define DMPAPER_ENV_MONARCH 37 // Envelope Monarch 3.875 x 7.5 in
#define DMPAPER_ENV_PERSONAL 38 // 6 3/4 Envelope 3 5/8 x 6 1/2 in
#define DMPAPER_FANFOLD_US 39 // US Std Fanfold 14 7/8 x 11 in
#define DMPAPER_FANFOLD_STD_GERMAN 40 // German Std Fanfold 8 1/2 x 12 in
#define DMPAPER_FANFOLD_LGL_GERMAN 41 // German Legal Fanfold 8 1/2 x 13 in
// Defines for the oPrn:SetBin(nBin) method (The printer MUST support it)
#define DMBIN_FIRST DMBIN_UPPER
#define DMBIN_UPPER 1
#define DMBIN_ONLYONE 1
#define DMBIN_LOWER 2
#define DMBIN_MIDDLE 3
#define DMBIN_MANUAL 4
#define DMBIN_ENVELOPE 5
#define DMBIN_ENVMANUAL 6
#define DMBIN_AUTO 7
#define DMBIN_TRACTOR 8
#define DMBIN_SMALLFMT 9
#define DMBIN_LARGEFMT 10
#define DMBIN_LARGECAPACITY 11
#define DMBIN_CASSETTE 14
#define DMBIN_LAST DMBIN_CASSETTE
#define DMORIENT_PORTRAIT 1
#define DMORIENT_LANDSCAPE 2
static oPrinter, lTemExcel, nHCMD, nPosLin, nPosCol, nCellRow, nCellCol, nByte, aPosCell
//----------------------------------------------------------------------------//
CLASS TPrinter
Public cFileCMD:=""
DATA oFont
DATA hDC, hDCOut
DATA aMeta
DATA cDir, cDocument, cModel
DATA nPage, nXOffset, nYOffset, nPad, nOrient
DATA lMeta, lStarted, lModified, lPrvModal
METHOD New( cDocument, lUser, lMeta, cModel, lModal, lSelection ) CONSTRUCTOR
MESSAGE StartPage() METHOD _StartPage()
MESSAGE EndPage() METHOD _EndPage()
METHOD End()
METHOD Say( nRow, nCol, cText, oFont, nWidth, nClrText, nBkMode, nPad )
METHOD CmSay( nRow, nCol, cText, oFont, nWidth, nClrText, nBkMode, nPad, lO2A );
INLINE ;
( ::Cmtr2Pix( @nRow, @nCol ),;
If( nWidth # Nil, ( ::Cmtr2Pix( 0, @nWidth ), nWidth += ::nYOffset ), nil ),;
::Say( nRow, nCol, cText, oFont, nWidth, nClrText, nBkMode, nPad, lO2A ) )
METHOD MmSay( nRow, nCol, cText, oFont, nWidth, nClrText, nBkMode, nPad, lO2A );
INLINE ;
( ::Mmtr2Pix( @nRow, @nCol ),;
If( nWidth # Nil, ( ::Mmtr2Pix( 0, @nWidth ), nWidth += ::nYOffset ), nil ),;
::Say( nRow, nCol, cText, oFont, nWidth, nClrText, nBkMode, nPad, lO2A ) )
METHOD InchSay( nRow, nCol, cText, oFont, nWidth, nClrText, nBkMode, nPad, lO2A );
INLINE ;
( ::Inch2Pix( @nRow, @nCol ),;
If( nWidth # Nil, ( ::Inch2Pix( 0, @nWidth ), nWidth += ::nYOffset ), nil ),;
::Say( nRow, nCol, cText, oFont, nWidth, nClrText, nBkMode, nPad, lO2A ) )
METHOD SayBitmap( nRow, nCol, cBitmap, nWidth, nHeight, nRaster )
METHOD SayImage( nRow, nCol, oImage, nWidth, nHeight, nRaster, lStretch, nAlphaLevel, nAlign )
METHOD SetPos( nRow, nCol ) INLINE MoveTo( ::hDCOut, nCol, nRow )
METHOD Line( nTop, nLeft, nBottom, nRight, oPen ) INLINE ;
MoveTo( ::hDCOut, nLeft, nTop ),;
LineTo( ::hDCOut, nRight, nBottom,;
If( oPen != nil, oPen:hPen, 0 ) )
METHOD Box( nRow, nCol, nBottom, nRight, oPen ) INLINE ;
Rectangle( ::hDCOut, nRow, nCol, nBottom, nRight,;
If( oPen != nil, oPen:hPen, 0 ) )
METHOD RoundBox( nRow, nCol, nBottom, nRight, nWidth, nHeight, oPen, nBGColor )
METHOD Arc( nTop, nLeft, nBottom, nRight, nXB, nYB, nXE, nYE, oPen ) INLINE ;
Arc( ::hDCOut, nLeft, nTop, nRight, nBottom, nXB, nYB, nXE, nYE, ;
If( oPen != nil, oPen:hPen, 0 ) )
METHOD Chord( nTop, nLeft, nBottom, nRight, nXB, nYB, nXE, nYE, oPen ) INLINE ;
Chord( ::hDCOut, nLeft, nTop, nRight, nBottom, nXB, nYB, nXE, nYE, ;
If( oPen != nil, oPen:hPen, 0 ) )
METHOD Ellipse( nRow, nCol, nBottom, nRight, oPen ) INLINE ;
Ellipse( ::hDCOut, nCol, nRow, nRight, nBottom, ;
If( oPen != nil, oPen:hPen, 0 ) )
METHOD Pie( nTop, nLeft, nBottom, nRight, nxStartArc, nyStartArc, nxEndArc, nyEndArc, oPen ) INLINE ;
Pie( ::hDCOut, nTop, nLeft, nBottom, nRight, nxStartArc, nyStartArc, nxEndArc, nyEndArc, ;
If( oPen != nil, oPen:hPen, 0 ) )
METHOD GetPixel( nRow, nCol, nRGBColor ) INLINE ;
SetPixel( ::hDCOut, nCol, nRow, nRGBColor )
METHOD SetPixel( nRow, nCol ) INLINE ;
SetPixel( ::hDCOut, nCol, nRow )
METHOD Cmtr2Pix( nRow, nCol )
METHOD Mmtr2Pix( nRow, nCol )
METHOD DraftMode( lOnOff ) INLINE (DraftMode( lOnOff ),;
::Rebuild() )
METHOD Inch2Pix( nRow, nCol )
METHOD Pix2Mmtr(nRow, nCol) INLINE ;
( nRow := nRow * 25.4 / ::nLogPixelX() ,;
nCol := nCol * 25.4 / ::nLogPixelY() ,;
{nRow, nCol} )
METHOD Pix2Inch(nRow, nCol) INLINE ;
( nRow := nRow / ::nLogPixelX() ,;
nCol := nCol / ::nLogPixelY() ,;
{nRow, nCol} )
METHOD CmRect2Pix(aRect)
METHOD nVertRes() INLINE GetDeviceCaps( ::hDC, VERTRES )
METHOD nHorzRes() INLINE GetDeviceCaps( ::hDC, HORZRES )
METHOD nVertSize() INLINE GetDeviceCaps( ::hDC, VERTSIZE )
METHOD nHorzSize() INLINE GetDeviceCaps( ::hDC, HORZSIZE )
METHOD nLogPixelX() INLINE GetDeviceCaps( ::hDC, LOGPIXELSX )
METHOD nLogPixelY() INLINE GetDeviceCaps( ::hDC, LOGPIXELSY )
METHOD SetPixelMode() INLINE SetMapMode( ::hDC, MM_TEXT )
METHOD SetTwipsMode() INLINE SetMapMode( ::hDC, MM_TWIPS )
METHOD SetLoInchMode() INLINE SetMapMode( ::hDC, MM_LOENGLISH )
METHOD SetHiInchMode() INLINE SetMapMode( ::hDC, MM_HIENGLISH )
METHOD SetLoMetricMode() INLINE SetMapMode( ::hDC, MM_LOMETRIC )
METHOD SetHiMetricMode() INLINE SetMapMode( ::hDC, MM_HIMETRIC )
METHOD SetIsotropicMode() INLINE SetMapMode( ::hDC, MM_ISOTROPIC )
METHOD SetAnisotropicMode() INLINE SetMapMode( ::hDC, MM_ANISOTROPIC )
METHOD SetWindowExt( nUnitsWidth, nUnitsHeight ) INLINE ;
SetWindowExt( ::hDC, nUnitsWidth, nUnitsHeight )
METHOD SetViewPortExt( nWidth, nHeight ) INLINE ;
SetViewPortExt( ::hDC, nWidth, nHeight )
METHOD GetTextWidth( cText, oFont ) INLINE ;
GetTextWidth( ::hDC, cText, ::SetFont(oFont):hFont)
METHOD GetTextHeight( cText, oFont ) INLINE Abs( ::SetFont(oFont):nHeight )
METHOD Preview() INLINE If( ::lMeta .and. Len( ::aMeta ) > 0 .and. ::hDC != 0,;
RPreview( Self ), ::End() )
MESSAGE FillRect( aRect, oBrush ) METHOD _FillRect( aRect, oBrush )
METHOD ResetDC() INLINE ResetDC( ::hDC )
METHOD GetOrientation() INLINE PrnGetOrientation()
METHOD SetLandscape() INLINE ( PrnLandscape( ::hDC ),;
::Rebuild() )
METHOD SetPortrait() INLINE ( PrnPortrait( ::hDC ),;
::Rebuild() )
METHOD SetCopies( nCopies ) INLINE ;
( PrnSetCopies( nCopies ),;
::Rebuild() )
METHOD SetSize( nWidth, nHeight ) INLINE ;
( PrnSetSize( nWidth, nHeight ),;
::Rebuild() )
METHOD SetPage( nPage ) INLINE ;
( PrnSetPage( nPage ),;
::Rebuild() )
METHOD SetBin( nBin ) INLINE ;
( PrnBinSource( nBin ),;
::Rebuild() )
METHOD GetModel() INLINE PrnGetName()
METHOD GetDriver() INLINE PrnGetDrive()
METHOD GetPort() INLINE PrnGetPort()
METHOD GetPhySize()
METHOD Setup() INLINE ( PrinterSetup(),;
::Rebuild() )
METHOD Rebuild()
METHOD SetFont( oFont )
METHOD CharSay( nRow, nCol, cText )
METHOD CharWidth()
METHOD CharHeight()
METHOD ImportWMF( cFile )
METHOD ImportRAW( cFile )
METHOD SizeInch2Pix( nHeight, nWidth )
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( cDocument, lUser, lMeta, cModel, lModal, lSelection ) CLASS TPrinter
local aOffset
local cPrinter
local oTestExcel
DEFAULT cDocument := "FiveWin Report" ,;
lUser := .f., lMeta := .f., lModal := .f., lSelection := .f.
if lUser
::hDC := GetPrintDC( GetActiveWindow(), lSelection, PrnGetPagNums() )
if ::hDC != 0
cModel = ::GetModel() + "," + ::GetDriver() + "," + ::GetPort()
endif
elseif cModel == nil
::hDC := GetPrintDefault( GetActiveWindow() )
if ::hDC != 0
cModel = ::GetModel() + "," + ::GetDriver() + "," + ::GetPort()
endif
else
cPrinter := GetProfString( "windows", "device" , "" )
WriteProfString( "windows", "device", cModel )
SysRefresh()
PrinterInit()
::hDC := GetPrintDefault( GetActiveWindow() )
SysRefresh()
WriteProfString( "windows", "device", cPrinter )
// PrinterInit()
// DeleteDC( ::hDC )
// ::hDC = PrinterDCfromName( cModel )
endif
if ::hDC != 0
aOffset = PrnOffset( ::hDC )
::nXOffset = aOffset[ 1 ]
::nYOffset = aOffset[ 2 ]
::nOrient = ::GetOrientation()
elseif ComDlgXErr() != 0
MsgStop( "There are no printers installed!" + CRLF + ;
"Please exit this application and install a printer." )
::nXOffset = 0
::nYOffset = 0
else
::nXOffset = 0
::nYOffset = 0
::nOrient = DMORIENT_PORTRAIT
endif
::cDocument = cDocument
::cModel = cModel
::nPage = 0
::nPad = 0
::lMeta = lMeta
::lStarted = .F.
::lModified = .F.
::lPrvModal = lModal
if !lMeta
::hDcOut = ::hDC
else
::aMeta = {}
::cDir = GetEnv( "TEMP" )
if Empty( ::cDir )
::cDir = GetEnv( "TMP" )
endif
if Right( ::cDir, 1 ) == "\"
::cDir = SubStr( ::cDir, 1, Len( ::cDir ) - 1 )
endif
if ! Empty( ::cDir )
if ! lIsDir( ::cDir )
::cDir = GetWinDir()
endif
else
::cDir := GetWinDir()
endif
endif
// INICIO Leonardo 24-04-2012 //
oTestExcel := TOleAuto():New("Excel.Application")
If Ole2TxtError() # "S_OK"
lTemExcel:= .F.
Else
lTemExcel:= .T.
cFileCMD := cPath_Mod+"\"+StrZero(mNetUse,8)+".LHS"
If File(cFileCMD)
FErase(cFileCMD)
EndIf
nHCMD := FCreate(cFileCMD)
nByte := 0
aPosCell:={}
EndIf
// FIM Leonardo 24-04-2012 //
return Self
//----------------------------------------------------------------------------//
METHOD End() CLASS TPrinter
if ::hDC != 0
if ! ::lMeta
if ::lStarted
EndDoc(::hDC)
endif
else
Aeval(::aMeta,{|val| ferase(val) })
::aMeta := {}
::hDCOut := 0
endif
if ::nOrient != nil
if ::nOrient == DMORIENT_PORTRAIT
::SetPortrait()
else
::SetLandscape()
endif
endif
// PrinterEnd()
DeleteDC( ::hDC )
::hDC := 0
endif
if ::oFont != nil
::oFont:End()
endif
oPrinter := nil
return nil
//----------------------------------------------------------------------------//
METHOD Rebuild() CLASS TPrinter
local cPrinter
if ::lStarted
if ! ::lMeta
EndDoc( ::hDC )
else
::hDCOut := 0
endif
endif
if ::hDC != 0
DeleteDC( ::hDC )
::hDC := GetPrintDefault( GetActiveWindow() )
::lStarted := .F.
::lModified := .T.
endif
if ::hDC != 0
if ! ::lMeta
::hDcOut = ::hDC
endif
endif
return nil
//----------------------------------------------------------------------------//
METHOD _StartPage() CLASS TPrinter
local lSetFixed
if ::hDC == 0
return nil
endif
lSetFixed := Set( _SET_FIXED, .F. )
if ! ::lMeta .and. ! ::lStarted
::lStarted := .T.
StartDoc( ::hDC, ::cDocument )
endif
::nPage++
if ::lMeta
#ifndef __CLIPPER__
AAdd( ::aMeta, ::cDir + cTempFile( "\", "emf" ) )
::hDCOut := CreateEnhMetaFile( ::hDC, ATail( ::aMeta ), ::cDocument ) //jlcr
#else
AAdd( ::aMeta, ::cDir + cTempFile( "\", "wmf" ) )
::hDCOut := CreateMetaFile( ATail( ::aMeta ) )
#endif
else
StartPage( ::hDC )
endif
Set( _SET_FIXED, lSetFixed )
return nil
//----------------------------------------------------------------------------//
METHOD _EndPage() CLASS TPrinter
if ::hDC = 0
return nil
endif
if ::lMeta
if Len( ::aMeta ) == 0
MsgAlert( "The temporal metafile could not be created",;
"Printer object Error" )
else
#ifndef __CLIPPER__
DeleteEnhMetaFile( CloseEnhMetaFile( ::hDCOut ) )
#else
DeleteMetaFile( CloseMetaFile( ::hDCOut ) )
#endif
if ! File( Atail( ::aMeta ) )
MsgAlert("Could not create temporary file: "+Atail(::aMeta)+CRLF+CRLF+;
"Please check your free space on your hard drive "+CRLF+;
"and the amount of files handles available." ,;
"Print preview error" )
endif
endif
else
EndPage( ::hDC )
endif
return nil
//----------------------------------------------------------------------------//
METHOD RoundBox( nRow, nCol, nBottom, nRight, nWidth, nHeight, oPen, nBGColor ) ;
CLASS TPrinter
local hBrush, hOldBrush
local hPen, hOldPen
hPen = If( oPen == nil, CreatePen( PS_SOLID, 1, CLR_BLACK ), oPen:hPen )
hOldPen = SelectObject( ::hDCOut, hPen )
if nBGColor != nil
hBrush := CreateSolidBrush( nBGColor )
hOldBrush := SelectObject( ::hDCOut, hBrush )
endif
RoundRect( ::hDCOut, nRow, nCol, nBottom, nRight, nWidth, nHeight )
if nBGColor # nil
SelectObject( ::hDCOut, hOldBrush )
DeleteObject( hBrush )
endif
SelectObject( ::hDCOut, hOldPen )
If( oPen == nil, DeleteObject( hPen ), nil )
return nil
//----------------------------------------------------------------------------//
METHOD Say( nRow, nCol, cText, oFont, nWidth, nClrText, nBkMode, nPad ) ;
CLASS TPrinter
local nTemp
if ::hDC = 0
return nil
endif
DEFAULT oFont := ::oFont ,;
nBkMode := 1 ,;
nPad := ::nPad
if oFont != nil
oFont:Activate( ::hDCOut )
endif
SetbkMode( ::hDCOut, nBkMode ) // 1,2 transparent or Opaque
if nClrText != nil
SetTextColor( ::hDCOut, nClrText )
endif
if Empty( nWidth )
do case
case nPad == PAD_RIGHT
nCol := Max( 0, nCol - ::GetTextWidth( cText, oFont ) )
case nPad == PAD_CENTER
nCol := Max( 0, nCol - ( ::GetTextWidth( cText, oFont ) / 2 ) )
endcase
SetTextAlign( ::hDCOut, TA_LEFT )
TextOut( ::hDCOut, nRow, nCol, cText )
else
do case
case nPad == PAD_RIGHT
nTemp := nCol + nWidth
SetTextAlign( ::hDCOut, TA_RIGHT )
case nPad == PAD_CENTER
nTemp := nCol + ( nWidth / 2 )
SetTextAlign( ::hDCOut, TA_CENTER )
otherwise
nTemp := nCol
SetTextAlign( ::hDCOut, TA_LEFT )
endcase
ExtTextOut( ::hDCOut, nRow, nTemp,;
{ nRow, nCol, nRow + oFont:nHeight * 1.5, nCol + nWidth },;
cText, ETO_CLIPPED )
endif
if oFont != nil
oFont:DeActivate( ::hDCOut )
endif
// INICIO Leonardo //
If lTemExcel
nCol := If(nCol==0,1,nCol)
If nCellRow = NIL
nCellRow := nRow
nCellCol := 1
nPosLin := nRow
nPosCol := 1
EndIf
If nCellRow != nRow
nCellRow := nRow
nCellCol := 1
nPosLin += 1
nPosCol := 1
EndIf
If nCellCol != nCol
nCellCol := nCol
nPosCol += 1
EndIf
If nRow > 0 .and. nCol > 0
cString := "Say("+Alltrim(Str(nPosLin))+","+;
Alltrim(Str(nPosCol))+","+;
"'"+StrTran(cText,"'","`")+"'"+",'Arial',10)" + Chr(13) + Chr(10)
nByte := FWrite(nHCMD,cString,Len(cString))
nCellCol++
EndIf
EndIf
// Fim Leonardo //
return nil
//----------------------------------------------------------------------------//
METHOD SayBitmap( nRow, nCol, xBitmap, nWidth, nHeight, nRaster ) CLASS TPrinter
local hDib, aBmpPal, hBitmap, hPalette
if ::hDC = 0
return nil
endif
if ( ValType( xBitmap ) == "N" ) .or. ! File( xBitmap )
aBmpPal = PalBmpLoad( xBitmap )
hBitmap = aBmpPal[ 1 ]
hPalette = aBmpPal[ 2 ]
hDib = DibFromBitmap( hBitmap, hPalette )
PalBmpFree( hBitmap, hPalette )
else
hDib = DibRead( xBitmap )
endif
if hDib == 0
return nil
endif
if ! ::lMeta
hPalette = DibPalette( hDib )
endif
DibDraw( ::hDCOut, hDib, hPalette, nRow, nCol,;
nWidth, nHeight, nRaster )
GlobalFree( hDib )
if ! ::lMeta
DeleteObject( hPalette )
endif
return nil
//----------------------------------------------------------------------------//
METHOD SayImage( nRow, nCol, oImage, nWidth, nHeight, nRaster, lStretch, nAlphaLevel, nAlign ) CLASS TPrinter
local hDib, hPalBmp, hPal, nRatio, n, cImageBuf, lCreated := .f.
local hBmp, x, y
DEFAULT nWidth := 0, nHeight := 0, lStretch := .t., nAlphaLevel := 255, nAlign := 1 // center
if ::hDC = 0
return nil
endif
if ValType( oImage ) == 'C'
if File( oImage )
oImage := TImage():Define( , oImage )
lCreated := .t.
else
cImageBuf := oImage
oImage := TImage():Define()
oImage:LoadFromMemory( cImageBuf )
lCreated := .t.
endif
endif
do case
case ValType( oImage ) == "O"
hDib = DibFromBitmap( oImage:hBitmap, oImage:hPalette )
otherwise
hDib = 0
endcase
if hDib = 0
return nil
endif
if ! ::lMeta
hPal := DibPalette( hDib )
endif
x := nWidth; y := nHeight
// try to keep aspect ratio if only one size is passed in.
if nWidth == 0 .and. nHeight > 0 .and. ( n := oImage:nHeight() ) > 0
nRatio := oImage:nWidth() / n
x := int( nHeight * nRatio )
elseif nWidth > 0 .and. nHeight == 0 .and. ( n := oImage:nWidth() ) > 0
nRatio := oImage:nHeight() / n
y := int( nWidth * nRatio )
elseif nWidth > 0 .and. nHeight > 0 .and. ! lStretch
if ( nWidth / oImage:nWidth() ) < ( nHeight / oImage:nHeight() )
x := nWidth; y := oImage:nHeight() * ( nWidth / oImage:nWidth() )
else
y := nHeight; x := oImage:nWidth() * ( nHeight / oImage:nHeight() )
endif
if x < nWidth
if lAnd( nAlign, 1 ) // DT_CENTER = 1
nCol += Int( ( nWidth - x ) / 2 )
elseif lAnd( nAlign, 2 ) // DT_RIGHT = 2
nCol += ( nWidth - x )
endif
endif
if y < nWidth
if lAnd( nAlign, 4 ) // DT_VCENTER = 4
nRow += Int( ( nHeight - y ) / 2 )
elseif lAnd( nAlign, 8 ) // DT_BOTTOM = 8
nRow += ( nHeight - y )
endif
endif
endif
if oImage:HasAlpha()
hBmp := ResizeBmp( oImage:hBitmap, x, y )
// ABPaint( ::hDCOut, nRow, nCol, hBmp, nAlphaLevel )
ABPaint( ::hDCOut, nCol, nRow, hBmp, nAlphaLevel )
DeleteObject( hBmp )
else
DibDraw( ::hDCOut, hDib, hPal, nRow, nCol, x, y, nRaster )
endif
GlobalFree( hDib )
if ! ::lMeta
DeleteObject( hPal )
endif
if lCreated
oImage:End()
endif
return nil
//----------------------------------------------------------------------------//
METHOD _FillRect( aCols, oBrush ) CLASS TPrinter
if ::hDC = 0
return nil
endif
FillRect( ::hDCOut, aCols, oBrush:hBrush )
return nil
//----------------------------------------------------------------------------//
METHOD Cmtr2Pix( nRow, nCol ) CLASS TPrinter
if ValType( ::nYoffset ) == "U"
::nYoffset := 0
endif
if ValType( ::nXOffset ) == "U"
::nXoffset := 0
endif
nRow := Max( 0, ( nRow * 10 * ::nVertRes() / ::nVertSize() ) - ::nYoffset )
nCol := Max( 0, ( nCol * 10 * ::nHorzRes() / ::nHorzSize() ) - ::nXoffset )
return { nRow, nCol }
//----------------------------------------------------------------------------//
METHOD Mmtr2Pix( nRow, nCol ) CLASS TPrinter
if ValType( ::nYoffset ) == "U"
::nYoffset := 0
endif
if ValType( ::nXOffset ) == "U"
::nXoffset := 0
endif
nRow := Max( 0, ( nRow * ::nVertRes() / ::nVertSize() ) - ::nYoffset )
nCol := Max( 0, ( nCol * ::nHorzRes() / ::nHorzSize() ) - ::nXoffset )
return { nRow, nCol }
//----------------------------------------------------------------------------//
METHOD CmRect2Pix(aRect) CLASS TPrinter
local aTmp[ 4 ]
aTmp[ 1 ] = Max( 0, ( aRect[1] * 10 * ::nVertRes() / ::nVertSize() ) - ::nYoffset )
aTmp[ 2 ] = Max( 0, ( aRect[2] * 10 * ::nHorzRes() / ::nHorzSize() ) - ::nXoffset )
aTmp[ 3 ] = Max( 0, ( aRect[3] * 10 * ::nVertRes() / ::nVertSize() ) - ::nYoffset )
aTmp[ 4 ] = Max( 0, ( aRect[4] * 10 * ::nHorzRes() / ::nHorzSize() ) - ::nXoffset )
return aTmp
//----------------------------------------------------------------------------//
METHOD Inch2Pix( nRow, nCol ) CLASS TPrinter
nRow = Max( 0, ( nRow * ::nVertRes() / (::nVertSize() / 25.4 ))-::nYoffset )
nCol = Max( 0, ( nCol * ::nHorzRes() / (::nHorzSize() / 25.4 ))-::nXoffset )
return { nRow, nCol }
//----------------------------------------------------------------------------//
METHOD GetPhySize() CLASS TPrinter
local aData := PrnGetSize( ::hDC )
local nWidth, nHeight
nWidth := aData[ 1 ] / ::nLogPixelX() * 25.4
nHeight := aData[ 2 ] / ::nLogPixelY() * 25.4
return { nWidth, nHeight }
//----------------------------------------------------------------------------//
METHOD SetFont( oFont ) CLASS TPrinter
if oFont != nil
::oFont := oFont
elseif ::oFont == nil
DEFINE FONT ::oFont NAME "COURIER" SIZE 0,-12 OF Self
endif
return ::oFont
//----------------------------------------------------------------------------//
METHOD CharSay( nRow, nCol, cText ) CLASS TPrinter
local nPxRow, nPxCol
::SetFont()
nRow := Max(--nRow, 0)
nCol := Max(--nCol, 0)
nPxRow := nRow * ::GetTextHeight( "", ::oFont )
nPxCol := nCol * ::GetTextWidth( "B", ::oFont )
::Say( nPxRow, nPxCol, cText, ::oFont )
return nil
//----------------------------------------------------------------------------//
METHOD CharWidth() CLASS TPrinter
::SetFont()
return Int( ::nHorzRes() / ::GetTextWidth( "B", ::oFont ) )
//----------------------------------------------------------------------------//
METHOD CharHeight() CLASS TPrinter
::SetFont()
return Int( ::nVertRes() / ::GetTextHeight( "",::oFont ) )
//----------------------------------------------------------------------------//
METHOD ImportWMF( cFile, lPlaceable ) CLASS TPrinter
local hMeta, hOld, hWMF
local aData := PrnGetSize( ::hDC )
local aInfo := Array( 5 )
DEFAULT lPlaceable := .T.
if ! File( cFile )
return nil
endif
SaveDC( ::hDCOut )
#ifdef __CLIPPER__
if lPlaceable
hMeta := GetPMetaFile( cFile, aInfo )
else
hMeta := GetMetaFile( cFile )
endif
#else
if cFileExt( cFile ) == "EMF"
hMeta := GetEnhMetaFile( cFile )
else
hOld = GetPMetaFile( cFile, aInfo )
hMeta = WMF2EMF( hOld, ::hDCOut )
endif
#endif
::SetIsoTropicMode()
::SetWindowExt( GetDeviceCaps( ::hDC, HORZRES ),;
GetDeviceCaps( ::hDC, VERTRES ) ) // aData[ 1 ], aData[ 2 ] )
::SetViewPortExt( GetDeviceCaps( ::hDC, HORZRES ),;
GetDeviceCaps( ::hDC, VERTRES ) ) // aData[ 1 ], aData[ 2 ] )
if ! ::lMeta
SetViewOrg( ::hDCOut, -::nXoffset, -::nYoffset )
endif
SetBkMode( ::hDCOut, 1 )
#ifdef __CLIPPER__
PlayMetaFile( ::hDCOut, hMeta )
DeleteMetafile( hMeta )
#else
if cFileExt( cFile ) == "EMF"
PlayEnhMetafile( ::hDCOut, hMeta,, .t. )
else
PlayMetaFile( ::hDCOut, hWMF := EMF2WMF( hMeta, ::hDCOut ) )
DeleteMetafile( hWMF )
endif
DeleteEnhMetafile( hMeta )
#endif
if ! Empty( hOld )
DeleteMetafile( hOld )
endif
RestoreDC( ::hDCOut )
return nil
//----------------------------------------------------------------------------//
METHOD ImportRAW( cFile ) CLASS TPrinter
if ! File( cFile )
return nil
endif
ImportRawFile( ::HDCOut, cFile )
return nil
//----------------------------------------------------------------------------//
METHOD SizeInch2Pix( nHeight, nWidth ) CLASS TPrinter
// Inch2Pix() is for coordinates and is affected by page offsets
// SizeInch2Pix is for converting width and height
DEFAULT nWidth := 0, nHeight := 0
if nHeight <> 0
nHeight := Max( 0, ( nHeight * ::nVertRes() / ( ::nVertSize() / 25.4 ) ) )
endif
if nWidth <> 0
nWidth := Max( 0, ( nWidth * ::nHorzRes() / ( ::nHorzSize() / 25.4 ) ) )
endif
return { nWidth, nHeight }
//----------------------------------------------------------------------------//
function PrintBegin( cDoc, lUser, lPreview, xModel, lModal, lSelection )
local aPrn
local cText, cDevice
local nScan
local oTestExcel
// INICIO Leonardo 24-04-2012 //
oTestExcel := TOleAuto():New("Excel.Application")
If Ole2TxtError() # "S_OK"
lTemExcel:= .F.
Else
lTemExcel:= .T.
cFileCMD := cPath_Mod+"\"+StrZero(mNetUse,8)+".LHS"
msginfo(cfilecmd)
If File(cFileCMD)
FErase(cFileCMD)
EndIf
nHCMD := FCreate(cFileCMD)
nByte := 0
aPosCell:={}
EndIf
// FIM Leonardo 24-04-2012 //
if xModel == nil
return oPrinter := TPrinter():New( cDoc, lUser, lPreview,, lModal, lSelection )
endif
cText := StrTran( GetProfString( "Devices" ),Chr(0), chr(13)+chr(10))
aPrn := Array( Mlcount( cText, 250 ) )
Aeval(aPrn, {|v,e| aPrn[e] := Trim(Memoline(cText, 250, e)) } )
if Valtype(xModel) == "N"
if xModel < 0 .or. xModel > len(aPrn)
nScan := 0
else
nScan := xModel
endif
else
if ( nScan := Ascan( aPrn, {|v| Upper( xModel ) == Upper( v ) } ) ) == 0
nScan = Ascan( aPrn, {|v| Upper( xModel ) $ Upper( v ) } )
endif
endif
if nScan == 0
MsgBeep()
return oPrinter := TPrinter():New( cDoc, .T., lPreview,, lModal, lSelection )
endif
cText := GetProfString( "Devices", aPrn[ nScan ] )
cDevice := aPrn[ nScan ] + "," + cText
return oPrinter := TPrinter():New( cDoc, .f., lPreview, cDevice, lModal, lSelection )
//----------------------------------------------------------------------------//
function PageBegin() ; oPrinter:StartPage() ; return nil
//----------------------------------------------------------------------------//
function PageEnd() ; oPrinter:EndPage(); return nil
//----------------------------------------------------------------------------//
function PrintEnd()
if oPrinter:lMeta
oPrinter:Preview()
else
oPrinter:End()
endif
oPrinter := nil
// INICIO Leonardo 24-04-2012 //
If lTemExcel
FClose(nHCMD)
EndIf
// FIM Leonardo 24-04-2012 //
return nil
//----------------------------------------------------------------------------//
function AGetPrinters() // returns an array with all the available printers
local aPrinters, cText, cToken := Chr( 15 )
cText = StrTran( StrTran( StrTran( ;
GetProfString( "Devices", 0 ), Chr( 0 ), cToken ), Chr( 13 ) ), Chr( 10 ) )
aPrinters = Array( Len( cText ) - Len( StrTran( cText, cToken ) ) )
AEval( aPrinters, { |cPrn, nEle | ;
aPrinters[ nEle ] := StrToken( cText, nEle, cToken ) } )
return aPrinters
//----------------------------------------------------------------------------//
function SetPrintDefault( cModel )
local cDriver := StrToken( GetProfString( "Devices", cModel, "" ), 1, "," )
local cPort := StrToken( GetProfString( "Devices", cModel, "" ), 2, "," )
WriteProfString( "Windows", "Device", cModel + "," + cDriver + "," + cPort )
return nil
*** FIM
Segue abaixo a RPREVIEW:
*** INICIO
#include "FiveWin.ch"
#Include "tsbutton.ch"
#define DEVICE oWnd:cargo
#define GO_POS 0
#define GO_UP 1
#define GO_DOWN 2
#define GO_LEFT 1
#define GO_RIGHT 2
#define GO_PAGE .T.
#define VSCROLL_RANGE 20 * ::nZFactor
#define HSCROLL_RANGE 20 * ::nZFactor
#define TXT_FIRST LoadString( GetResources(), 07 )
#define TXT_PREVIOUS LoadString( GetResources(), 08 )
#define TXT_NEXT LoadString( GetResources(), 09 )
#define TXT_LAST LoadString( GetResources(), 10 )
#define TXT_ZOOM LoadString( GetResources(), 11 )
#define TXT_UNZOOM LoadString( GetResources(), 12 )
#define TXT_TWOPAGES LoadString( GetResources(), 13 )
#define TXT_ONEPAGE LoadString( GetResources(), 14 )
#define TXT_PRINT LoadString( GetResources(), 15 )
#define TXT_EXIT LoadString( GetResources(), 16 )
#define TXT_FILE LoadString( GetResources(), 17 )
#define TXT_PAGE LoadString( GetResources(), 18 )
#define TXT_PREVIEW LoadString( GetResources(), 03 )
#define TXT_PAGENUM LoadString( GetResources(), 19 )
#define TXT_A_WINDOW_PREVIEW_IS_ALLREADY_RUNNING ;
LoadString( GetResources(), 20 )
#define TXT_GOTO_FIRST_PAGE ;
LoadString( GetResources(), 21 )
#define TXT_GOTO_PREVIOUS_PAGE ;
LoadString( GetResources(), 22 )
#define TXT_GOTO_NEXT_PAGE ;
LoadString( GetResources(), 23 )
#define TXT_GOTO_LAST_PAGE ;
LoadString( GetResources(), 24 )
#define TXT_ZOOM_THE_PREVIEW ;
LoadString( GetResources(), 25 )
#define TXT_UNZOOM_THE_PREVIEW ;
LoadString( GetResources(), 26 )
#define TXT_PREVIEW_ON_TWO_PAGES ;
LoadString( GetResources(), 27 )
#define TXT_PREVIEW_ON_ONE_PAGE ;
LoadString( GetResources(), 28 )
#define TXT_PRINT_CURRENT_PAGE ;
LoadString( GetResources(), 29 )
#define TXT_EXIT_PREVIEW ;
LoadString( GetResources(), 30 )
#define TXT_FACTOR ;
LoadString( GetResources(), 31 )
#define TXT_ZOOM_FACTOR ;
LoadString( GetResources(), 32 )
#define TXT_EXPORT_MSWORD ;
LoadString( GetResources(), 33 )
#define MK_MBUTTON 16
static l2007 := .f.
static bUserBtns := nil
//----------------------------------------------------------------------------//
CLASS TPreview
DATA oWnd, oBar, oFont, oImageList
DATA oDevice
DATA oHand, oCursor
DATA oMeta1, oMeta2, oSay, oFactor
DATA oPage, oTwoPages, oZoom
DATA oMenuZoom, oMenuTwoPages, oMenuUnZoom, oMenuOnePage
DATA cResFile
DATA aFactor, nPage, nZFactor
DATA lTwoPages, lZoom, lExit
DATA cPageNum
DATA hOldRes, hNewRes
CLASSDATA oWndMain
METHOD New( oDevice, cFile )
METHOD Activate()
METHOD BuildButtonBar()
METHOD BuildWindow()
METHOD BuildMenu()
METHOD PaintMeta()
METHOD NextPage()
METHOD PrevPage()
METHOD TopPage()
METHOD BottomPage()
METHOD TwoPages( lMenu )
METHOD Zoom( lMenu )
METHOD VScroll( nType, lPage, nSteps )
METHOD HScroll( nType, lPage, nSteps )
METHOD SetOrg1( nX, nY )
METHOD SetOrg2( nX, nY )
METHOD CheckKey( nKey, nFlags )
METHOD CheckMouseWheel( nKeys, nDelta, nXPos, nYPos )
METHOD SetFactor( nValue )
METHOD PrintPage()
METHOD PrintPrv( oDlg, nOption, nPageIni, nPageEnd, lArq )
METHOD ExportToMSWord()
METHOD SaveAsMenu()
METHOD SaveAs( lPDF )
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( oDevice ) CLASS TPreview
if oDevice == nil
PRINTER oDevice PREVIEW
PAGE
ENDPAGE
MsgInfo( oDevice:aMeta[ 1 ] )
// ENDPRINTER
endif
::oDevice := oDevice
::nPage := 1
::nZFactor := 1
::lTwoPages := .F.
::lZoom := .F.
::lExit := .F.
::BuildWindow()
return Self
//----------------------------------------------------------------------------//
METHOD Activate() CLASS TPreview
ACTIVATE WINDOW ::oWnd MAXIMIZED ;
ON RESIZE ::PaintMeta() ;
ON UP ::VScroll( GO_UP ) ;
ON DOWN ::VScroll( GO_DOWN ) ;
ON PAGEUP ::VScroll( GO_UP, GO_PAGE) ;
ON PAGEDOWN ::VScroll( GO_DOWN, GO_PAGE) ;
ON LEFT ::HScroll( GO_LEFT ) ;
ON RIGHT ::HScroll( GO_RIGHT ) ;
ON PAGELEFT ::HScroll( GO_LEFT, GO_PAGE ) ;
ON PAGERIGHT ::HScroll( GO_RIGHT, GO_PAGE ) ;
VALID ( ::oWnd:oIcon := nil ,;
::oFont:End() ,;
::oMeta1:End() ,;
::oMeta2:End() ,;
::oDevice:End() ,;
::oHand:End() ,;
::oWnd := nil ,;
If( IsAppThemed() .and. ! l2007, ::oImageList:End(),),;
::lExit := .T. ,;
.T. )
if ::oDevice:lPrvModal
StopUntil( { || ::lExit } )
endif
return nil
//----------------------------------------------------------------------------//
METHOD BuildButtonBar() CLASS TPreview
local oImageList, oReBar, oBar, oHand, oWndMain
local l97Look := ::oWndMain != nil .and. ::oWndMain:oBar != nil .and. ;
Len( ::oWndMain:oBar:aControls ) > 0 .and. ;
::oWndMain:oBar:aControls[ 1 ]:l97Look
DEFINE CURSOR ::oHand HAND
if WndMain() != nil
if WndMain():oBar != nil
oBar = WndMain():oBar
if oBar != nil .and. Upper( oBar:ClassName() ) == "TBAR" //.and. oBar:l2007
l2007 = .T.
endif
endif
endif
if IsAppThemed() .and. ! l2007
DEFINE IMAGELIST oImageList SIZE 16, 16
oImageList:AddMasked( TBitmap():Define( "top2",, ::oWnd ), nRGB( 192, 192, 192 ) )
oImageList:AddMasked( TBitmap():Define( "previous2",, ::oWnd ), nRGB( 192, 192, 192 ) )
oImageList:AddMasked( TBitmap():Define( "next2",, ::oWnd ), nRGB( 192, 192, 192 ) )
oImageList:AddMasked( TBitmap():Define( "bottom2",, ::oWnd ), nRGB( 192, 192, 192 ) )
oImageList:AddMasked( TBitmap():Define( "zoom2",, ::oWnd ), nRGB( 192, 192, 192 ) )
oImageList:AddMasked( TBitmap():Define( "two_pages2",, ::oWnd ), nRGB( 192, 192, 192 ) )
oImageList:AddMasked( TBitmap():Define( "printer2",, ::oWnd ), nRGB( 255, 0, 255 ) )
oImageList:AddMasked( TBitmap():Define( "save",, ::oWnd ), nRGB( 255, 0, 255 ) )
oImageList:AddMasked( TBitmap():Define( "word",, ::oWnd ), nRGB( 192, 192, 192 ) )
oImageList:AddMasked( TBitmap():Define( "exit2",, ::oWnd ), nRGB( 192, 192, 192 ) )
oImageList:AddMasked( TBitmap():Define( "unzoom2",, ::oWnd ), nRGB( 192, 192, 192 ) )
oImageList:AddMasked( TBitmap():Define( "one_page2",, ::oWnd ), nRGB( 192, 192, 192 ) )
oImageList:AddMasked( TBitmap():Define( "excel",, ::oWnd ), nRGB( 192, 192, 192 ) )
::oImageList = oImageList
oReBar = TReBar():New( ::oWnd )
DEFINE TOOLBAR oBar OF oReBar SIZE 25, 25 IMAGELIST oImageList
::oBar = oBar
oReBar:InsertBand( oBar )
oBar:nHeight -= 2
DEFINE TBBUTTON OF oBar ;
ACTION ::TopPage() ;
TOOLTIP Strtran( TXT_FIRST, "&", "" ) ;
MESSAGE TXT_GOTO_FIRST_PAGE
DEFINE TBBUTTON OF oBar ;
ACTION ::PrevPage() ;
TOOLTIP Strtran( TXT_PREVIOUS, "&", "" ) ;
MESSAGE TXT_GOTO_PREVIOUS_PAGE
DEFINE TBBUTTON OF oBar ;
ACTION ::NextPage() ;
TOOLTIP Strtran( TXT_NEXT, "&", "" ) ;
MESSAGE TXT_GOTO_NEXT_PAGE
DEFINE TBBUTTON OF oBar ;
ACTION ::BottomPage() ;
TOOLTIP Strtran( TXT_LAST, "&", "" ) ;
MESSAGE TXT_GOTO_LAST_PAGE
DEFINE TBSEPARATOR OF oBar
DEFINE TBBUTTON OF oBar ;
ACTION ::Zoom() ;
TOOLTIP Strtran( TXT_ZOOM, "&", "" ) ;
MESSAGE TXT_ZOOM_THE_PREVIEW
DEFINE TBBUTTON OF oBar ;
ACTION ::TwoPages() ;
TOOLTIP StrTran( Strtran( TXT_TWOPAGES, "&", "" ), "á", "a" ) ;
MESSAGE TXT_PREVIEW_ON_TWO_PAGES
DEFINE TBSEPARATOR OF oBar
DEFINE TBBUTTON OF oBar ;
ACTION ::PrintPage() ;
TOOLTIP Strtran(TXT_PRINT,"&","") ;
MESSAGE TXT_PRINT_CURRENT_PAGE
DEFINE TBMENU OF oBar ;
ACTION ::SaveAs( .f. ) ;
TOOLTIP "SaveAs" ;
MESSAGE "Save As Word Document" ;
MENU ::SaveAsMenu()
DEFINE TBBUTTON OF oBar ;
ACTION ::ExportToMSWord() ;
TOOLTIP TXT_EXPORT_MSWORD ;
MESSAGE TXT_EXPORT_MSWORD
DEFINE TBSEPARATOR OF oBar
DEFINE TBBUTTON OF oBar ;
MESSAGE "Salva Formato .XLS" ;
ACTION GeraXLS(::oWnd) ;
TOOLTIP "Salva Formato .XLS"
DEFINE TBBUTTON OF oBar ;
ACTION ::oWnd:End() ;
TOOLTIP Strtran( TXT_EXIT, "&", "" ) ;
MESSAGE TXT_EXIT_PREVIEW
else
if oBar != nil ///.and. oBar:l2007
DEFINE BUTTONBAR oBar SIZE 26, If( LargeFonts(), 30, 26 ) OF ::oWnd 2007
oBar:bPainted = { || oBar:Say( 7, 285+50, "Factor:",,, ::oFont, .T., .T. ),;
If( Len( ::oDevice:aMeta ) > 1,;
oBar:Say( 7, 380+50, ::cPageNum + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ;
LTrim( Str( Len( ::oDevice:aMeta ) ) ),,, ::oFont, .T., .T. ),;
oBar:Say( 7, 380+50, ::cPageNum + LTrim( Str( ::nPage, 4, 0 ) ),;
,,, ::oFont, .T., .T. ) ) }
else
DEFINE BUTTONBAR oBar _3D SIZE 26, If( LargeFonts(), 30, 26 ) OF ::oWnd
endif
::oBar = oBar
if l97Look
DEFINE BUTTON RESOURCE "Top" OF oBar ;
MESSAGE TXT_GOTO_FIRST_PAGE ;
ACTION ::TopPage() ;
TOOLTIP Strtran( TXT_FIRST, "&", "" ) NOBORDER
DEFINE BUTTON RESOURCE "Previous" OF oBar ;
MESSAGE TXT_GOTO_PREVIOUS_PAGE ;
ACTION ::PrevPage() ;
TOOLTIP Strtran( TXT_PREVIOUS, "&", "" ) NOBORDER
DEFINE BUTTON RESOURCE "Next" OF oBar ;
MESSAGE TXT_GOTO_NEXT_PAGE ;
ACTION ::NextPage() ;
TOOLTIP Strtran( TXT_NEXT, "&", "" ) NOBORDER
DEFINE BUTTON RESOURCE "Bottom" OF oBar ;
MESSAGE TXT_GOTO_LAST_PAGE ;
ACTION ::BottomPage() ;
TOOLTIP Strtran( TXT_LAST, "&", "" ) NOBORDER
DEFINE BUTTON ::oZoom RESOURCE "Zoom" OF oBar GROUP ;
MESSAGE TXT_ZOOM_THE_PREVIEW ;
ACTION ::Zoom() ;
TOOLTIP Strtran( TXT_ZOOM, "&", "" ) NOBORDER
DEFINE BUTTON ::oTwoPages RESOURCE "Two_Pages" OF oBar ;
MESSAGE TXT_PREVIEW_ON_TWO_PAGES ;
ACTION ::TwoPages() ;
TOOLTIP Strtran( TXT_TWOPAGES, "&", "" ) NOBORDER
DEFINE BUTTON RESOURCE "Printer" OF oBar GROUP ;
MESSAGE TXT_PRINT_CURRENT_PAGE ;
ACTION ::PrintPage() ;
TOOLTIP Strtran( TXT_PRINT, "&", "" ) NOBORDER
DEFINE BUTTON RESOURCE "Save" OF oBar ;
MENU ::SaveAsMenu() ;
MESSAGE "Save as DOC/PDF" ;
ACTION This:ShowPopUp() ;
TOOLTIP "Save as Doc/Pdf"
DEFINE BUTTON RESOURCE "Word" OF oBar NOBORDER ;
MESSAGE TXT_EXPORT_MSWORD ;
ACTION ::ExportToMSWord() ;
TOOLTIP TXT_EXPORT_MSWORD
if ! Empty( bUserBtns )
SetResources( ::hOldRes )
Eval( bUserBtns, Self, oBar )
SetResources( ::hNewRes )
endif
DEFINE BUTTON RESOURCE "Excel" OF oBar GROUP ;
MESSAGE "Salva Formato .XLS" ;
ACTION GeraXLS(::oWnd) ;
TOOLTIP "Salva Formato .XLS" NOBORDER
DEFINE BUTTON RESOURCE "Exit" OF oBar GROUP ;
MESSAGE TXT_EXIT_PREVIEW ;
ACTION ::oWnd:End() ;
TOOLTIP Strtran( TXT_EXIT, "&", "" ) NOBORDER
else
DEFINE BUTTON RESOURCE "Top2" OF oBar ;
MESSAGE TXT_GOTO_FIRST_PAGE ;
ACTION ::TopPage() ;
TOOLTIP Strtran( TXT_FIRST, "&", "" )
DEFINE BUTTON RESOURCE "Previous2" OF oBar ;
MESSAGE TXT_GOTO_PREVIOUS_PAGE ;
ACTION ::PrevPage() ;
TOOLTIP Strtran( TXT_PREVIOUS, "&", "" )
DEFINE BUTTON RESOURCE "Next2" OF oBar ;
MESSAGE TXT_GOTO_NEXT_PAGE ;
ACTION ::NextPage() ;
TOOLTIP Strtran( TXT_NEXT, "&", "" )
DEFINE BUTTON RESOURCE "Bottom2" OF oBar ;
MESSAGE TXT_GOTO_LAST_PAGE ;
ACTION ::BottomPage() ;
TOOLTIP Strtran( TXT_LAST, "&", "" )
DEFINE BUTTON ::oZoom RESOURCE "Zoom2" OF oBar GROUP ;
MESSAGE TXT_ZOOM_THE_PREVIEW ;
ACTION ::Zoom() ;
TOOLTIP Strtran( TXT_ZOOM, "&", "" )
DEFINE BUTTON ::oTwoPages RESOURCE "Two_Pages2" OF oBar ;
MESSAGE TXT_PREVIEW_ON_TWO_PAGES ;
ACTION ::TwoPages() ;
TOOLTIP Strtran( TXT_TWOPAGES, "&", "" )
DEFINE BUTTON RESOURCE "Printer2" OF oBar GROUP ;
MESSAGE TXT_PRINT_CURRENT_PAGE ;
ACTION ::PrintPage() ;
TOOLTIP Strtran( TXT_PRINT, "&", "" )
DEFINE BUTTON RESOURCE "Save" OF oBar ;
MENU ::SaveAsMenu() ;
MESSAGE "Save as DOC/PDF" ;
ACTION This:ShowPopUp() ;
TOOLTIP "Save as Doc/Pdf"
DEFINE BUTTON RESOURCE "Word" OF oBar ;
MESSAGE TXT_EXPORT_MSWORD ;
ACTION ::ExportToMSWord() ;
TOOLTIP TXT_EXPORT_MSWORD
if ! Empty( bUserBtns )
SetResources( ::hOldRes )
Eval( bUserBtns, Self, oBar )
SetResources( ::hNewRes )
endif
DEFINE BUTTON RESOURCE "Excel" OF oBar GROUP ;
MESSAGE "Salva Formato .XLS" ;
ACTION GeraXLS(::oWnd) ;
TOOLTIP "Salva Formato .XLS"
DEFINE BUTTON RESOURCE "Exit2" OF oBar GROUP ;
MESSAGE TXT_EXIT_PREVIEW ;
ACTION ::oWnd:End() ;
TOOLTIP Strtran( TXT_EXIT, "&", "" )
endif
AEval( oBar:aControls, { | o | o:oCursor := ::oHand } )
endif
return nil
//----------------------------------------------------------------------------//
METHOD BuildWindow() CLASS TPreview
local oIcon, cTitle := "FiveWin Printing Preview", oCursor
local oThis := Self
DEFAULT ::oWndMain := WndMain()
::hOldRes := GetResources()
#ifdef __CLIPPER__
::cResFile := "Preview.dll"
#else
if ! IsWin64()
::cResFile := "Prev32.dll"
else
::cResFile = "Prev64.dll"
endif
#endif
if SetResources( ::cResFile ) < 32
MsgStop( ::cResFile + " not found, imposible to continue",;
"FiveWin Printing Error" )
return nil
endif
::hNewRes := GetResources()
if ::oDevice != nil
cTitle = ::oDevice:cDocument
endif
if ::oWndMain != nil
oIcon = ::oWndMain:oIcon
else
DEFINE ICON oIcon RESOURCE "Print"
endif
DEFINE FONT ::oFont NAME GetSysFont() SIZE 0, -12
if !::oDevice:lPrvModal .and. ::oWndMain != nil .and. ;
Upper( ::oWndMain:ClassName() ) == "TMDIFRAME"
DEFINE WINDOW ::oWnd ;
TITLE cTitle ;
COLOR CLR_BLACK,CLR_LIGHTGRAY ;
ICON oIcon ;
VSCROLL HSCROLL
else
DEFINE WINDOW ::oWnd FROM 0, 0 TO 24, 80 ;
TITLE cTitle ;
COLOR CLR_BLACK,CLR_LIGHTGRAY ;
ICON oIcon ;
VSCROLL HSCROLL MENU ::BuildMenu()
endif
::oWnd:SetFont( ::oFont )
::oWnd:oVScroll:SetRange( 0, 0 )
::oWnd:oHScroll:SetRange( 0, 0 )
::cPageNum = TXT_PAGENUM
::BuildButtonBar()
#ifdef __CLIPPER__
SET MESSAGE OF ::oWnd TO TXT_PREVIEW CENTERED ;
NOINSET CLOCK DATE KEYBOARD
#else
if l2007
SET MESSAGE OF ::oWnd TO TXT_PREVIEW CENTERED ;
NOINSET CLOCK DATE KEYBOARD 2007
else
DEFINE STATUSBAR OF ::oWnd PROMPT " " + TXT_PREVIEW
endif
#endif
::oMeta1 := TMetaFile():New( 0, 0, 0, 0,;
::oDevice:aMeta[ 1 ],;
::oWnd,;
CLR_BLACK,;
CLR_WHITE,;
::oDevice:nHorzRes(),;
::oDevice:nVertRes() )
DEFINE CURSOR ::oCursor RESOURCE "LUPA"
::oMeta1:oCursor := ::oCursor
::oMeta1:blDblClick := { | nRow, nCol, nKeyFlags | ;
::SetOrg1( nCol, nRow, nKeyFlags ) }
::oMeta1:bKeyDown := { | nKey, nFlags | ::CheckKey( nKey, nFlags ) }
::oMeta1:bMouseWheel := { | nKeys, nDelta, nXPos, nYPos | ;
::CheckMouseWheel( nKeys, nDelta, nXPos, nYPos ) }
#ifndef __XPP__ // XBPP bug. Warning: don't change this into #ifdef __CLIPPER__
::oMeta2 := TMetaFile():New( 0, 0, 0, 0, "",;
::oWnd, CLR_BLACK, CLR_WHITE, ::oDevice:nHorzRes(),;
::oDevice:nVertRes() )
#else
::oMeta2 := TMetaFile():New():_New( 0, 0, 0, 0, "",;
::oWnd, CLR_BLACK, CLR_WHITE, ::oDevice:nHorzRes(),;
::oDevice:nVertRes() )
#endif
::oMeta2:oCursor = ::oCursor
::oMeta2:blDblClick := { | nRow, nCol, nKeyFlags | ;
::SetOrg2( nCol, nRow, nKeyFlags ) }
::oMeta2:hide()
::SetFactor()
if ! l2007
@ 7, 285+50 SAY ::oSay PROMPT "Factor:" ;
SIZE 45, 15 PIXEL OF ::oBar FONT ::oFont
::oSay:lTransparent = .T.
endif
@ 3, 325+50 COMBOBOX ::oFactor VAR ::nZFactor ;
ITEMS { "1", "2", "3", "4", "5", "6", "7", "8", "9" } ;
OF ::oBar FONT ::oFont PIXEL SIZE 35,200 ;
ON CHANGE oThis:SetFactor( oThis:nZFactor )
if ! l2007
if Len( ::oDevice:aMeta ) > 1
@ 7, 370 + 50 SAY ::oPage PROMPT TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ;
LTrim( Str( Len( ::oDevice:aMeta ) ) ) ;
SIZE 180, 15 PIXEL OF ::oBar FONT ::oFont
else
@ 7, 370 + 50 SAY ::oPage PROMPT TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) ;
SIZE 180, 15 PIXEL OF ::oBar FONT ::oFont
endif
::oPage:lTransparent = .T.
endif
if IsAppThemed() .or. l2007
FixSays( ::oBar:hWnd )
endif
#ifndef __XPP__
::oFactor:Set3dLook( .T. )
#endif
SetResources( ::hOldRes )
::oWnd:oHScroll:bPos := { | nPos | ::HScroll( GO_POS, .f., nPos ) }
::oWnd:oVScroll:bPos := { | nPos | ::VScroll( GO_POS, .f., nPos ) }
return nil
//----------------------------------------------------------------------------//
METHOD BuildMenu() CLASS TPreview
local nFor, oMenu
local lThemed := IsAppThemed()
local cPrinter := If( lThemed, "Printer2", "Printer" )
local cTop := If( lThemed, "Top2", "Top" )
local cPrevious := If( lThemed, "Previous2", "Previous" )
local cNext := If( lThemed, "Next2", "Next" )
local cBottom := If( lThemed, "Bottom2", "Bottom" )
local cZoom := If( lThemed, "Zoom2", "Zoom" )
local cUnZoom := If( lThemed, "UnZoom2", "UnZoom" )
local cOne_Page := If( lThemed, "One_page2", "One_page" )
local cTwo_Pages := If( lThemed, "Two_pages2", "Two_pages" )
local cExit := If( lThemed, "Exit2", "Exit" )
::aFactor := Array( 9 )
MENU oMenu
MENUITEM TXT_FILE
MENU
MENUITEM TXT_PRINT ACTION ::PrintPage() ;
MESSAGE TXT_PRINT_CURRENT_PAGE RESOURCE cPrinter
MENUITEM "&Salva Formato .XLS" ACTION GeraXLS() ;
MESSAGE "Salva Formato .XLS" RESOURCE "Excel"
SEPARATOR
MENUITEM TXT_EXIT ACTION ::oWnd:End() ;
MESSAGE TXT_EXIT_PREVIEW RESOURCE cExit
ENDMENU
MENUITEM TXT_PAGE
MENU
MENUITEM TXT_FIRST ACTION ::TopPage() ;
MESSAGE TXT_GOTO_FIRST_PAGE RESOURCE cTop
MENUITEM TXT_PREVIOUS ACTION ::PrevPage() ;
MESSAGE TXT_GOTO_PREVIOUS_PAGE RESOURCE cPrevious
MENUITEM TXT_NEXT ACTION ::NextPage() ;
MESSAGE TXT_GOTO_NEXT_PAGE RESOURCE cNext
MENUITEM TXT_LAST ACTION ::BottomPage() ;
MESSAGE TXT_GOTO_LAST_PAGE RESOURCE cBottom
SEPARATOR
MENUITEM ::oMenuZoom PROMPT TXT_ZOOM ACTION ::Zoom( .T. ) ;
MESSAGE TXT_ZOOM_THE_PREVIEW RESOURCE cZoom
MENUITEM ::oMenuUnZoom PROMPT TXT_UNZOOM ACTION ::Zoom( .T. ) ;
MESSAGE TXT_UNZOOM_THE_PREVIEW RESOURCE cUnZoom
MENUITEM "&Factor" MESSAGE TXT_ZOOM_FACTOR
MENU
for nFor := 1 to Len( ::aFactor )
MENUITEM ::aFactor[ nFor ] ;
PROMPT "&" + LTrim( Str( nFor ) ) ;
MESSAGE "Factor " + LTrim( Str( nFor ) ) ;
ACTION ( ::oFactor:Set( oMenuItem:nHelpId ),;
Eval( ::oFactor:bChange ) )
next
ENDMENU
SEPARATOR
MENUITEM ::oMenuTwoPages PROMPT TXT_TWOPAGES ACTION ::TwoPages( .T. ) ;
ENABLED ;
MESSAGE TXT_PREVIEW_ON_TWO_PAGES RESOURCE cTwo_Pages
MENUITEM ::oMenuOnePage PROMPT TXT_ONEPAGE ACTION ::TwoPages(.T.) ;
MESSAGE TXT_PREVIEW_ON_ONE_PAGE RESOURCE cOne_Page
ENDMENU
ENDMENU
::oMenuUnZoom:Disable()
::oMenuOnePage:Disable()
return oMenu
//----------------------------------------------------------------------------//
METHOD PaintMeta() CLASS TPreview
local oCoors1, oCoors2
local aFiles := ::oDevice:aMeta // DEVICE
local nWidth, nHeight, nFactor, nMetaWidth
if ::oWnd != nil .and. IsIconic( ::oWnd:hWnd )
return nil
endif
do case
case ! ::lTwoPages
if ! ::lZoom
if ::oDevice:nHorzSize() >= ; // landscape (apaisado) // DEVICE
::oDevice:nVertSize()
nFactor := .8 // .4
else
nFactor := .40 // .25
endif
else
nFactor := .47
endif
if ::oWnd != nil
nWidth = ::oWnd:nWidth() - If( ::lZoom, 20, 0 )
nHeight = ::oWnd:nHeight() - If( ::lZoom .and. ::nZFactor > 1, 20, 0 ) - 10 - ;
If( LargeFonts(), 100, 80 )
if ! ::lZoom
nMetaWidth = ( nHeight - 40 ) * nFactor
else
nMetaWidth = nWidth * nFactor
endif
oCoors1 := TRect():New( 40,;
Max( ( nWidth / 2 ) - nMetaWidth, 10 ),;
nHeight,;
Min( ( nWidth / 2 ) + nMetaWidth, nWidth - 20 ) )
::oMeta2:Hide()
::oMeta1:SetCoors( oCoors1 )
::oMeta1:Refresh()
endif
case ::lTwoPages
nFactor := .4
aFiles := ::oDevice:aMeta // DEVICE
nWidth := ::oWnd:nWidth()
nHeight := ::oWnd:nHeight() - 10 - If( LargeFonts(), 100, 80 )
nMetaWidth = Min( ( nHeight - 40 ) * nFactor, ( nWidth - 60 ) / 4 )
oCoors1 := TRect():New( 40,;
( nWidth / 4 ) - nMetaWidth,;
nHeight,;
( nWidth / 4 ) + nMetaWidth )
oCoors2 := TRect():New( 40,;
( nWidth / 4 ) - nMetaWidth + ( nWidth / 2 ),;
nHeight,;
( nWidth / 4 ) + nMetaWidth + ( nWidth / 2 ) )
if ::nPage == Len( aFiles )
::oMeta2:SetFile( "" )
else
::oMeta2:SetFile( aFiles[ ::nPage + 1 ] )
endif
::oMeta1:SetCoors( oCoors1 )
::oMeta2:SetCoors( oCoors2 )
::oMeta1:Refresh()
::oMeta2:Show()
endcase
::oMeta1:SetFocus()
return nil
//----------------------------------------------------------------------------//
METHOD NextPage() CLASS TPreview
local hOldRes := GetResources()
local aFiles := ::oDevice:aMeta // DEVICE
if ::nPage >= Len( aFiles )
MsgBeep()
return nil
endif
::nPage++
SET RESOURCES TO ::cResFile
::oMeta1:SetFile( aFiles[ ::nPage ] )
if ! l2007
::oPage:SetText( TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ;
LTrim( Str( Len( aFiles ) ) ) )
endif
::oBar:Refresh()
::oMeta1:Refresh()
if ::lTwoPages
if Len( aFiles ) >= ::nPage + 1
::oMeta2:SetFile( aFiles[ ::nPage + 1 ] )
else
::oMeta2:SetFile( "" )
endif
::oMeta2:Refresh()
endif
::oMeta1:SetFocus()
SetResources( hOldRes )
return nil
//----------------------------------------------------------------------------//
METHOD PrevPage() CLASS TPreview
local hOldRes := GetResources()
local aFiles := ::oDevice:aMeta // DEVICE
if ::nPage == 1
MsgBeep()
return nil
endif
::nPage--
SET RESOURCES TO ::cResFile
::oMeta1:SetFile( aFiles[ ::nPage ] )
if ! l2007
::oPage:SetText( TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ;
LTrim( Str( Len( aFiles ) ) ) )
endif
::oBar:Refresh()
::oMeta1:Refresh()
if ::lTwoPages
if Len( aFiles ) >= ::nPage + 1
::oMeta2:SetFile( aFiles[ ::nPage + 1 ] )
else
::oMeta2:SetFile( "" )
endif
::oMeta2:Refresh()
endif
::oMeta1:SetFocus()
SetResources( hOldRes )
return nil
//----------------------------------------------------------------------------//
METHOD TopPage() CLASS TPreview
local hOldRes := GetResources()
local aFiles := ::oDevice:aMeta // DEVICE
if ::nPage == 1
MsgBeep()
return nil
endif
::nPage = 1
SET RESOURCES TO ::cResFile
::oMeta1:SetFile( aFiles[ ::nPage ] )
if ! l2007
::oPage:SetText( TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ;
LTrim( Str( Len( aFiles ) ) ) )
endif
::oBar:Refresh()
::oMeta1:Refresh()
if ::lTwoPages
if Len( aFiles ) >= ::nPage + 1
::oMeta2:SetFile( aFiles[ ::nPage + 1 ] )
else
::oMeta2:SetFile( "" )
endif
::oMeta2:Refresh()
endif
::oMeta1:SetFocus()
SetResources( hOldRes )
return nil
//----------------------------------------------------------------------------//
METHOD BottomPage() CLASS TPreview
local hOldRes := GetResources()
local aFiles := ::oDevice:aMeta // DEVICE
if ::nPage == Len( aFiles )
MsgBeep()
return nil
endif
::nPage = Len( aFiles )
SET RESOURCES TO ::cResFile
::oMeta1:SetFile( aFiles[ ::nPage ] )
if ! l2007
::oPage:SetText( TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ;
LTrim( Str( Len( aFiles ) ) ) )
endif
::oBar:Refresh()
::oMeta1:Refresh()
if ::lTwoPages
::oMeta2:SetFile( "" )
::oMeta2:Refresh()
endif
::oMeta1:SetFocus()
SetResources( hOldRes )
return nil
//----------------------------------------------------------------------------//
METHOD TwoPages( lMenu ) CLASS TPreview
local hOldRes := GetResources()
SET RESOURCES TO ::cResFile
DEFAULT lMenu := .F.
::lTwoPages := ! ::lTwoPages
if ::lTwoPages
if Len( ::oDevice:aMeta) == 1 // solo hay una pagina // DEVICE
::lTwoPages := ! ::lTwoPages
MsgBeep()
SetResources( hOldRes )
return nil
endif
if ::oDevice:nHorzSize() >= ; // Apaisado // DEVICE
::oDevice:nVertSize() // DEVICE
::lTwoPages := ! ::lTwoPages
MsgBeep()
SetResources( hOldRes )
return nil
endif
if ::lZoom
::Zoom( .T. )
endif
if ! IsAppThemed() .or. Upper( ::oBar:ClassName() ) == "TBAR"
::oTwoPages:FreeBitmaps()
::oTwoPages:LoadBitmaps( "One_Page2" )
::oTwoPages:cMsg := TXT_PREVIEW_ON_ONE_PAGE
::oTwoPages:cTooltip := StrTran( TXT_ONEPAGE, "&", "" )
else
::oBar:ChangeBitmap( 6, 10+2 )
::oBar:SetTooltip( 6, StrTran( TXT_ONEPAGE, "&", "" ) )
::oBar:SetMessage( 6, TXT_PREVIEW_ON_ONE_PAGE )
endif
if ::oWnd:oMenu != nil
::oMenuTwoPages:Disable()
::oMenuOnePage:Enable()
endif
else
if ! IsAppThemed() .or. Upper( ::oBar:ClassName() ) == "TBAR"
::oTwoPages:FreeBitmaps()
::oTwoPages:LoadBitmaps( "Two_Pages2" )
::oTwoPages:cMsg := TXT_PREVIEW_ON_TWO_PAGES
::oTwoPages:cTooltip := StrTran( TXT_TWOPAGES, "&", "" )
else
::oBar:ChangeBitmap( 6, 6 )
::oBar:SetTooltip( 6, StrTran( TXT_TWOPAGES, "&", "" ) )
::oBar:SetMessage( 6, TXT_PREVIEW_ON_TWO_PAGES )
endif
if ::oWnd:oMenu != nil
::oMenuTwoPages:Enable()
::oMenuOnePage:Disable()
endif
endif
if lMenu .and. ! IsAppThemed()
::oTwoPages:Refresh()
endif
::oWnd:Refresh()
::PaintMeta()
SetResources( hOldRes )
return nil
//----------------------------------------------------------------------------//
METHOD Zoom( lMenu ) CLASS TPreview
local hOldRes := GetResources()
SET RESOURCES TO ::cResFile
DEFAULT lMenu := .F.
::lZoom := ! ::lZoom
if ::lZoom
if ::lTwoPages
::TwoPages( .T. )
endif
if ! IsAppThemed() .or. l2007
::oZoom:FreeBitmaps()
::oZoom:LoadBitmaps( "Unzoom2" )
::oZoom:cMsg := TXT_UNZOOM_THE_PREVIEW
::oZoom:cTooltip := StrTran( TXT_UNZOOM, "&", "" )
else
::oBar:ChangeBitmap( 5, 9+2 )
::oBar:SetTooltip( 5, StrTran( TXT_UNZOOM, "&", "" ) )
::oBar:SetMessage( 5, TXT_UNZOOM_THE_PREVIEW )
endif
if ::oWnd:oMenu != nil
::oMenuZoom:Disable()
::oMenuUnZoom:Enable()
endif
::oWnd:oVScroll:SetRange( 1, VSCROLL_RANGE )
if ::nZFactor > 1
::oWnd:oHScroll:SetRange( 1, HSCROLL_RANGE )
endif
::oMeta1:ZoomIn()
else
if ! IsAppThemed() .or. l2007
::oZoom:FreeBitmaps()
::oZoom:LoadBitmaps( "Zoom2" )
::oZoom:cMsg := TXT_ZOOM_THE_PREVIEW
::oZoom:cTooltip := StrTran( TXT_ZOOM, "&", "" )
else
::oBar:ChangeBitmap( 5, 5 )
::oBar:SetTooltip( 5, StrTran( TXT_ZOOM, "&", "" ) )
::oBar:SetMessage( 5, TXT_ZOOM_THE_PREVIEW )
endif
if ::oWnd:oMenu != nil
::oMenuZoom:Enable()
::oMenuUnZoom:Disable()
endif
::oWnd:oVScroll:SetRange( 0, 0 )
::oWnd:oHScroll:SetRange( 0, 0 )
::oMeta1:ZoomOut()
::nZFactor = 1
if ::oWnd:oMenu != nil
AEval( ::aFactor, { | val, elem | val:SetCheck( ( elem == 1 ) ) } )
endif
::oFactor:Set( 1 )
endif
if lMenu .and. ! IsAppThemed()
::oZoom:Refresh()
endif
::PaintMeta()
SetResources( hOldRes )
return nil
//----------------------------------------------------------------------------//
METHOD VScroll( nType, lPage, nSteps ) CLASS TPreview
local nYfactor, nYorig, nStep
DEFAUL
-
Ico, boa tarde.
Valeu pela dica.
Sou novo com FiveWin, mas, com o clipper há muito tempo.
Onde posto os fontes mesmo ?
Leonardo Guimarães
Vitória-ES
FWH + xDevStudio + xHarbour
-
Ico, boa tarde.
No PREV32.DLL inseri a imagem da EXCEL no botão.
No PRINTER.PRG fiz as mesmas mudanças do FW 16.
No RPREVIEW.PRG fiz também as mesmas mudanças do FW 16.
Quando dou o Preview do relatório, dá tudo certo.
Quando clico no botão EXCEL, dá erro, onde a variável que informa é a declarada e utilizada no PRINTER.PRG, muito estranho.
Ajude-me por favor.
Leonardo Guimarães
Vitória-ES
FWH + xDevStudio + xHarbour
-
Ico, boa tarde.
Sim, coloquei para compilar a RPREVIEW e a PRINTER no xDevStudio para compilar.
Fiz sim no PREV32.DLL as mudanças e nada ainda.
Leonardo Guimarães
Vitória-ES
FWH + xDevStudio + xHarbour
-
Rogério, boa tarde.
Já tenho pronto e rodando no FW 16, agora, estou migrando para o FW 32 + xHarbour.
Copiei a classe original de \FIVEWIN\SOURCE\CLASSE e fiz as devidas modificações para gerar para o Excel conforme já feito no FW 16. Só que as TPRINTER parece não estar compilando as minhas modificações.
No RPREVIEW coloquei um botão EXCEL daà gero o arquivo para o MS-EXCEL.
Leonardo Guimarães
Vitória-ES
FWH + xDevStudio + xHarbour
-
Pessoal, me ajudem por favor.
-
Fiz umas modificações na classe RPREVIEW e na TPRINTER para gerar arquivos para o EXCEL num clique.
Porém, uso o FiveWin com xHarbour e adicionei os programas acima para compilarem no xDevStudio.
Mas o xDevStudio não está compilando a TPRINTER.
Alguem pode me ajudar.
Léo.
-
Fiz umas modificações na classe RPREVIEW e na TPRINTER para gerar arquivos para o EXCEL num clique.
Porém, uso o FiveWin com xHarbour e adicionei os programas acima para compilarem no xDevStudio.
Mas o xDevStudio não está compilando a TPRINTER.
Alguem pode me ajudar.
Léo.
Classe TTree 32 bist
in Programação
Posted
Ercilei, bom dia.
Segue abaixo o código completo:
#include "fivewin.ch"
#include "treeview.ch"
#include "FileIO.ch"
STATIC oWnd
FUNCTION _CAcessos(cUsu,cModo)
LOCAL oBarra
Private aMatVar := {}
SET 3D LOOK ON
set epoch to 1960
set date to british
set bell on
set console off
set deleted on
set exclusive off
set scoreboard off
set cursor off
set century on
setblink(.F.)
sethandlecount(255)
cUsu := "S"
IF cUsu = Nil
MsgInfo("Informe o Usuario !!!","Erro !")
Return(Nil)
ENDIF
cModo := If(cModo=Nil,1,Val(cModo))
cArqConf := cUsu
cUsu := Cript(Left(Alltrim(cUsu+Space(20)),20),1)
Aadd(aMatVar,{3,"CORES->Cada1","",;
'If(cTpLj$"2_7",scl1111_(),'+;
'If(cTpLj="3",scl1113_(),'+;
'If(cTpLj="5",scl1112_(),scl1110_())))'})
Aadd(aMatVar,{4,"CORES->Cada2","",;
'If(cTpLj$"2_7",scl1111_(,"A"),'+;
'If(cTpLj="3",scl1113_(,"A"),'+;
'If(cTpLj="5",scl1112_(,"A"),scl1110_(,"A"))))'})
Aadd(aMatVar,{6,"CORES->Cada3a","","scl113d_()"})
Aadd(aMatVar,{7,"CORES->Cada3b","","scl1134_()"})
Aadd(aMatVar,{8,"CORES->Cada3c","","scl113e_()"})
Aadd(aMatVar,{10,"CORES->Cadb1","","scl1210_()"})
Aadd(aMatVar,{11,"CORES->Cadb2","","scl1210_(,'A')"})
Aadd(aMatVar,{12,"CORES->Cadb3","","scl1220_()"})
Aadd(aMatVar,{13,"CORES->Cadc1","","scl1310_()"})
Aadd(aMatVar,{14,"CORES->Cadc2","","scl1320_()"})
Aadd(aMatVar,{15,"CORES->Cadc3a","","scl1330_()"})
Aadd(aMatVar,{16,"CORES->Cadd","","scl1400_()"})
Aadd(aMatVar,{17,"CORES->Cade","","scl1500_()"})
Aadd(aMatVar,{18,"CORES->Cadn","","scl1f00_()"})
Aadd(aMatVar,{19,"CORES->Cadp","","scl1i00_()"})
Aadd(aMatVar,{20,"CORES->Esta1","","scl1610_()"})
Aadd(aMatVar,{21,"CORES->Esta2","","scl1610_(,'A')"})
Aadd(aMatVar,{22,"CORES->Esta5e","","scl164E_()"})
Aadd(aMatVar,{23,"CORES->Esta7","","scl16a0_()"})
Aadd(aMatVar,{24,"CORES->Esta5a","","scl164a_()"})
Aadd(aMatVar,{25,"CORES->Esta8","","scl164f_()"})
Aadd(aMatVar,{26,"CORES->Esta9","","scl164g_()"})
Aadd(aMatVar,{27,"CORES->Esta10","","_GeraBToledo()"})
Aadd(aMatVar,{28,"CORES->Cadg","","scl1700_()"})
Aadd(aMatVar,{29,"CORES->Cadk","","scl1d00_()"})
Aadd(aMatVar,{30,"CORES->Cadl","","scl1E00_()"})
Aadd(aMatVar,{31,"CORES->Cadm","","scl1h00_()"})
Aadd(aMatVar,{32,"CORES->Cado","","scl1g00_()"})
Aadd(aMatVar,{33,"CORES->Cadi","","scl1b00_()"})
Aadd(aMatVar,{34,"CORES->Cadj","","scl1c00_()"})
Aadd(aMatVar,{35,"CORES->UltH","","scl6b00_()"})
Aadd(aMatVar,{36,"CORES->Ultn","","scl1510_()"})
Aadd(aMatVar,{37,"CORES->estb1","","scl2110_()"})
Aadd(aMatVar,{38,"CORES->estb5a","","scl2171_(,oWndPrinc)"})
Aadd(aMatVar,{39,"CORES->Fina1","","SCL3110_()"})
Aadd(aMatVar,{40,"CORES->Fina2","","SCL3110_('A')"})
Aadd(aMatVar,{41,"CORES->Fina3","","SCL3110_('E')"})
Aadd(aMatVar,{42,"CORES->Fina4","","SCL3140_()"})
Aadd(aMatVar,{43,"CORES->Finb1","","SCL3210_()"})
Aadd(aMatVar,{44,"CORES->Finb2","","SCL3210_('A')"})
Aadd(aMatVar,{45,"CORES->Finb3","","SCL3210_('E')"})
Aadd(aMatVar,{46,"CORES->Finb4","","SCL3240_()"})
Aadd(aMatVar,{47,"CORES->Finb6","","SCL3250_()"})
Aadd(aMatVar,{48,"CORES->Bana","","SCL4100_(1)"})
Aadd(aMatVar,{49,"CORES->Banb","","SCL4100_(2)"})
Aadd(aMatVar,{50,"CORES->Banc","","SCL4100_(3)"})
Aadd(aMatVar,{51,"CORES->esta3","","SCL1630_()"})
Aadd(aMatVar,{52,"CORES->esta3e","","scl1637_()"})
Aadd(aMatVar,{53,"CORES->esta3i","","SCL163b_()"})
Aadd(aMatVar,{54,"CORES->cadc3c","","SCL163d_()"})
Aadd(aMatVar,{55,"CORES->esta3g","","SCL163b1_()"})
Aadd(aMatVar,{56,"CORES->esta3h","","_EmitSVDav()"})
Aadd(aMatVar,{57,"CORES->esta8n","","SCL1684_()"})
Aadd(aMatVar,{58,"CORES->esta8d","","SCL1683_()"})
Aadd(aMatVar,{59,"CORES->esta8j","","SCL168B_()"})
Aadd(aMatVar,{60,"CORES->esta8b","","SCL1682_()"})
Aadd(aMatVar,{61,"CORES->Fina5","","SCL3151_()"})
Aadd(aMatVar,{62,"CORES->Finb5","","scl3251_()"})
Aadd(aMatVar,{63,"CORES->Estc1","","scl212s_()"})
Aadd(aMatVar,{64,"CORES->Estc2","","scl212x_()"})
Aadd(aMatVar,{65,"CORES->Ultb1","",;
'If(MsgYesNo("Confirma Manutencao ?",'+;
'"Reorganizar Arquivos !!!"),_CriaArq(0,2),.F.)'})
Aadd(aMatVar,{66,"CORES->UltJ","","scl6900_() "})
Aadd(aMatVar,{67,"CORES->Ultc","","_Acessos() "})
Aadd(aMatVar,{68,"CORES->Estb4a","",;
"MsgInfo('Apenas no Modulo de Vendas !!!','Alerta !!!')"})
Aadd(aMatVar,{69,"CORES->Estb4d","",;
"MsgInfo('Apenas no Modulo de Vendas !!!','Alerta !!!')"})
Aadd(aMatVar,{70,"CORES->Estb4f","",;
"MsgInfo('Apenas no Modulo de Vendas !!!','Alerta !!!')"})
Aadd(aMatVar,{71,"CORES->Estb4g","",;
"MsgInfo('Apenas no Modulo de Vendas !!!','Alerta !!!')"})
Aadd(aMatVar,{72,"CORES->Estb4h","",;
"MsgInfo('Apenas no Modulo de Vendas !!!','Alerta !!!')"})
Aadd(aMatVar,{73,"CORES->Estb4i","","scl2120_()"})
Aadd(aMatVar,{90,"CORES->Estc1","",""})
Aadd(aMatVar,{91,"CORES->Estc2","",""})
Aadd(aMatVar,{92,"CORES->esta3s","","SCL163b2_()"})
Aadd(aMatVar,{93,"CORES->esta8a","","SCL1681_()"})
Aadd(aMatVar,{94,"CORES->ultb2","","scl6200_(1)"})
Aadd(aMatVar,{95,"CORES->ultb3","","scl6200_(2)"})
Aadd(aMatVar,{96,"CORES->ultd1","",""})
Aadd(aMatVar,{97,"CORES->ultd2","",""})
Aadd(aMatVar,{98,"CORES->ultd3","",""})
Aadd(aMatVar,{99,"CORES->ultd4","",""})
Aadd(aMatVar,{100,"CORES->ultd6","",""})
Aadd(aMatVar,{101,"CORES->exc_it","",""})
Aadd(aMatVar,{102,"CORES->lib_ds","",""})
Aadd(aMatVar,{103,"CORES->esta3j","","SCL163e_()"})
Aadd(aMatVar,{104,"CORES->imp_dv","",""})
Aadd(aMatVar,{105,"CORES->en_ex","",""})
Aadd(aMatVar,{106,"CORES->esta3k","","SCL163b3_()"})
Aadd(aMatVar,{107,"CORES->esta3ij","","SCL163c_()"})
Aadd(aMatVar,{1107,"CORES->esta3ij","","SCL163i_()"})
Aadd(aMatVar,{108,"CORES->estb5g","","scl2179_()"})
Aadd(aMatVar,{109,"CORES->pr_al","",""})
Aadd(aMatVar,{110,"CORES->pr_ex","",""})
Aadd(aMatVar,{111,"CORES->can_cp","",""})
Aadd(aMatVar,{112,"CORES->estd16","","scl164h_()"})
Aadd(aMatVar,{113,"CORES->cadb4a","","scl1241_()"})
Aadd(aMatVar,{114,"CORES->cadb4b","","scl1242_()"})
Aadd(aMatVar,{115,"CORES->cadb4c","","scl1243_()"})
Aadd(aMatVar,{116,"CORES->Finb5f","","scl3257_()"})
Aadd(aMatVar,{117,"CORES->Cadc3n","","scl1k00_()"})
Aadd(aMatVar,{118,"CORES->Cadc3m","",""})
Aadd(aMatVar,{119,"CORES->cl_bl","",""})
Aadd(aMatVar,{120,"CORES->finb7","","SCL3270_()"})
Aadd(aMatVar,{121,"CORES->finb5d","","SCL3280_()"})
Aadd(aMatVar,{122,"CORES->esta3l","","SCL163b4_()"})
Aadd(aMatVar,{123,"CORES->nt_in","",""})
Aadd(aMatVar,{124,"CORES->nt_al","",""})
Aadd(aMatVar,{125,"CORES->nt_ex","",""})
Aadd(aMatVar,{126,"CORES->Estb4i","","scl2121_()"})
Aadd(aMatVar,{127,"CORES->finb5e","","SCL3290_()"})
Aadd(aMatVar,{128,"CORES->cl_al","",""})
Aadd(aMatVar,{129,"CORES->cl_ex","",""})
Aadd(aMatVar,{130,"CORES->fo_al","",""})
Aadd(aMatVar,{131,"CORES->fo_ex","",""})
Aadd(aMatVar,{132,"CORES->fo_hi","",""})
Aadd(aMatVar,{133,"CORES->fo_lu","",""})
Aadd(aMatVar,{134,"CORES->Cadb4","","scl1230_()"})
Aadd(aMatVar,{135,"CORES->pa_al","",""})
Aadd(aMatVar,{136,"CORES->rc_al","",""})
Aadd(aMatVar,{137,"CORES->esta3m","","SCL163f_()"})
Aadd(aMatVar,{138,"CORES->En_Al","",""})
Aadd(aMatVar,{139,"CORES->En_Ex","",""})
Aadd(aMatVar,{140,"CORES->Pr_Pr","",""})
Aadd(aMatVar,{141,"CORES->Esta8k","",""})
Aadd(aMatVar,{142,"CORES->Finc","","SCL329A_()"})
Aadd(aMatVar,{143,"CORES->cadb4d","",""})
Aadd(aMatVar,{144,"CORES->cadb4d1","","scl1244_()"})
Aadd(aMatVar,{145,"CORES->cadb4d2","",""})
Aadd(aMatVar,{146,"CORES->cadb4d3","",""})
Aadd(aMatVar,{147,"CORES->esta3r","","scl1j00_()"})
Aadd(aMatVar,{148,"CORES->esta3s","","SCL163b2_()"})
Aadd(aMatVar,{149,"CORES->esta4","","scl16b0_()"})
Aadd(aMatVar,{1149,"CORES->esta4","","scl16b1_()"})
Aadd(aMatVar,{150,"CORES->esta5","","SCL217E_()"})
Aadd(aMatVar,{151,"CORES->Find","","SCL329B_()"})
Aadd(aMatVar,{152,"CORES->esta3n","","SCL163g_()"})
Aadd(aMatVar,{153,"CORES->esta3o","","SCL163h_()"})
Aadd(aMatVar,{154,"CORES->his_in","",""})
Aadd(aMatVar,{155,"CORES->his_al","",""})
Aadd(aMatVar,{156,"CORES->his_ex","",""})
Aadd(aMatVar,{157,"CORES->Fina4a","","SCL3140_()"})
Aadd(aMatVar,{158,"CORES->Finb4a","","SCL3240_()"})
Aadd(aMatVar,{159,"CORES->esta3p","","SCL163j_()"})
Aadd(aMatVar,{160,"CORES->cadc3d","","SCL163k_()"})
cur_dir := "\"+curdir()
mat_seg := directory("\HL_FLJ.INI","H")
nsalto_print := 60
cporta_fis :="COM2"
if len(mat_seg) = 0
setcolor("")
clear
MsgAlert("O arquivo de configuracao nao foi encontrado","Erro !!!")
clear all
quit
else
texto = memoread("\HL_FLJ.INI")
Texto_2= alltrim(memoline(texto,80,2))
texto_2= alltrim(cript(texto_2,2))
endif
cpath_dll :=texto_2+"\DLL"
set default to &texto_2
set path to &texto_2
path_2 = texto_2
if ! file("EMP01.DBF") .or. ! file("EMP01A.NTX")
MsgAlert("Execute LHCONFIG.EXE !!!","Erro !!!")
clear all
quit
endif
lEGrade:=.T.
cTpAT :="1"
Use EMP01 Alias EMP01 Shared New
Set Index To EMP01A
texto_2 :=alltrim(emp01->path_emp)
path :=texto_2+"\TMP\"
set default to &texto_2
set path to &texto_2
firma :=emp01->nome_fan
If ! Empty(EMP01->Layout)
Firma := EMP01->Layout
EndIf
DbCloseAll()
If cModo = 2
aMatAcesso := {}
oFile = TTxtFile():New( texto_2+"\"+Alltrim(Left(cArqConf,8))+".LHC" )
while ! oFile:lEof()
cLine = oFile:cLine
cMenu := Left(cLine,At("|",cLine)-1)
cLine := SubStr(cLine,At("|",cLine)+1)
cAcesso := Left(cLine,At("|",cLine)-1)
cChama := SubStr(cLine,At("|",cLine)+1)
Aadd(aMatAcessos,cAcesso)
oFile:Skip()
enddo
oFile:Close()
Use CORES Shared New Alias ATUAL
Set Index To CORESA
cStruct := ATUAL->( DbStruct())
DbCreate(Alltrim(Left(cArqConf,8))+".DBF",cStruct)
Use (Alltrim(Left(cArqConf,8))+".DBF") Exclusive New Alias CORES
Index On CORES->usuario To (Alltrim(Left(cArqConf,8)))
If ATUAL->( Dbseek(cUsu))
CORES->( DbAppend())
CORES->Usuario := ATUAL->USuario
For nI := 1 to Len(aMAtAcessos)
cVar := aMatAcessos[nI]
&CVar := .T.
Next
EndIf
ATUAL->( DbCloseArea())
Else
Use CORES Shared New
Set Index To CORESA
EndIf
//seek cript(substr("S"+space(20),1,20),1)
seek cUsu
Use ULT01 Shared New
cTpLj:=ULT01->TComer
cCRes:="N"
If ULT01->Grade = "N" .or. ULT01->Grade = "1"
lEGrade:=.F.
EndIf
If ULT01->Reserva = "S"
cCRes:="S"
Endif
cTpAt:= ULT01->TpAtend
//Set Resources To cpath_dll+"\PAFECF2.DLL"
If cModo = 1
DEFINE WINDOW oWnd FROM 0,0 TO 400,600 PIXEL ;
TITLE "Control de Acessos dos Usuarios do Sistema" ;
MDI Menu MenuPrincipal()
Else
DEFINE WINDOW oWnd FROM 0,0 TO 400,600 PIXEL ;
TITLE "CADASTRAMENTO DE ACESSO PERSONALIZADOS" ;
MDI Menu MenuPrincipal()
EndIf
DEFINE FONT oFont NAME "MS Sans Serif" SIZE 0,16
SET MESSAGE OF oWnd KEYBOARD NOINSET FONT oFont
SET FONT OF oWnd TO oFont
ACTIVATE WINDOW oWnd ;
On Init ChildTree() VALID ;
MsgYesNo( "Deseja Encerrar Controle de Usuarios ?", "Selecione uma Opcao !" )
If File(cArqConf)
FErase(cArqConf)
EndIf
If cModo = 2
cArqConf := Texto_2+"\"+Alltrim(cArqConf)+".LHC"
nIHdl := fcreate( cArqConf,0 )
nPos := AScan(aMAtVar,{|x| x[1] = 107 })
If nPos > 0 .and. ! Empty(aMAtVar[nPos,3])
cTexto := aMatVar[nPos,3]
nPos := AScan(aMAtVar,{|x| x[1] = 1107 })
If nPos > 0
aMAtVar[nPos,3] := cTexto
Endif
Endif
If ! lEGrade
nPos := AScan(aMAtVar,{|x| x[1] = 37 })
If nPos > 0 .and. ! Empty(aMAtVar[nPos,3])
aMAtVar[nPos,4] := "scl2111_()"
EndIf
EndIf
nPos := AScan(aMAtVar,{|x| x[1] = 149 })
If nPos > 0 .and. ! Empty(aMAtVar[nPos,3])
cTexto := aMatVar[nPos,3]
nPos := AScan(aMAtVar,{|x| x[1] = 1149 })
If nPos > 0
aMAtVar[nPos,3] := "Ajuste de Preco por Fator"
Endif
EndIf
For nX := 1 to Len(aMatVar)
If ! Empty(aMatVar[nX,3]) .and. &(aMatVar[nX,2]) .and. ;
! Empty(aMatVar[nX,4])
FWrite( nIHdl, aMatVar[nX,3]+"|"+aMatVar[nX,2]+"|"+aMatVar[nX,4] + CRLF )
EndIf
Next
FClose( nIHdl )
EndIf
DbCloseAll()
If cModo =2
cArqConf := StrTran(cArqConf,".LHC","")
If File(cArqConf+".DBF")
FErase(cArqConf+".DBF")
FErase(cArqConf+".NTX")
EndIf
Endif
RETURN nil
FUNCTION ChildTree()
LOCAL oBarra
LOCAL oChild
LOCAL oTree
DEFINE WINDOW oChild FROM 0,0 TO 400,600 PIXEL ;
TITLE "Banco de Dados do Usuario "+;
Alltrim(Cript(CORES->Usuario,2)) MDICHILD ICON "Database"
DEFINE BUTTONBAR oBarra OF oChild SIZE 28,29 _3D
DEFINE BUTTON RESOURCE "Atualizar" OF oBarra ;
MESSAGE "Atualizar Base de Dados ..." ACTION ( oTree:End(),;
oChild:Refresh(.T.) ,;
oTree := CreaTree(oChild) ) ;
NOBORDER TOOLTIP "Atualizar Base de Datos ..."
SET MESSAGE OF oChild NOINSET
DEFINE MSGITEM OF oChild:oMsgBar PROMPT "Controlando Acessos do Usuario" SIZE 250
ACTIVATE WINDOW oChild ON INIT (oChild:Maximize(),oTree := CreaTree(oChild))
RETURN NIL
FUNCTION CreaTree(oChild)
LOCAL oTree
LOCAL oRoot
LOCAL oLink
LOCAL nStep
@ 0, 0 TREE oTree OF oChild ;
SIZE 0, 0 PIXEL ;
BITMAPS { "Paper","FoldClose","FoldOpen", "BookClose", "BookOpen",;
"Tabla", "Procedimiento", "Usuario", "Server", "Ejecutivo",;
"Respaldo","selected","unselected" } ;
TREE STYLE nOr( TVS_HASLINES, TVS_HASBUTTONS ) ;
ON DBLCLICK ClickTree(oTree)
oChild:SetControl(oTree)
oRoot := oTree:GetRoot()
oRoot2:= oTree:GetRoot()
oRoot3:= oTree:GetRoot()
// Acessos Sistema de Retaguarda //
oRoot:=oRoot:AddLastChild( "Controle de Acessos LH Retaguarda", 9, 8 )
oLink:=oRoot:AddLastChild( "Cadastros", 3, 2 )
oBloq1:=oLink:AddLastChild( "Clientes" , 3, 2 )
oBloq1:AddLastChild( "Inclusao" ,,_VAMenu2(3,1,"ClientesInclusao") )
oBloq1:AddLastChild( "Consulta/Alteracao/Exclusao" ,,_VAMenu2(4,1,"ClientesConsulta/Alteracao/Exclusao"))
oBloq1:AddLastChild( "Altera Clientes" ,,_VAMenu2(128,1,"ClientesAltera Clientes"))
oBloq1:AddLastChild( "Exclui Clientes" ,,_VAMenu2(129,1,"ClientesExclui Clientes"))
oBloq1:AddLastChild( "Libera Clientes Bloqueados" ,,_VAMenu2(119,1,"ClientesLibera Clientes Bloqueados"))
oBloq11:=oBloq1:AddLastChild( "Relatorios de Clientes" , 3, 2 )
oBloq11:AddLastChild( "Completo" ,,_VAMenu2(6,1,"Relatorios de ClientesCompleto"))
oBloq11:AddLastChild( "Aniversario" ,,_VAMenu2(7,1,"Relatorios de ClientesAniversario"))
oBloq11:AddLastChild( "Planos" ,,_VAMenu2(8,1,"Relatorios de ClientesPlanos"))
oBloq2:=oLink:AddLastChild( "Fornecedores" , 3, 2 )
oBloq2:AddLastChild( "Inclusao" ,,_VAMenu2(10,1,"FornecedoresInclusao"))
oBloq2:AddLastChild( "Consulta/Alteracao/Exclusao" ,,_VAMenu2(11,1,"FornecedoresConsulta/Alteracao/Exclusao"))
oBloq2:AddLastChild( "Altera Fornecedor" ,,_VAMenu2(130,1,"FornecedoresAltera Fornecedor"))
oBloq2:AddLastChild( "Exclui Fornecedor" ,,_VAMenu2(131,1,"FornecedoresExclui Fornecedor"))
oBloq2:AddLastChild( "Alterar Historico" ,,_VAMenu2(132,1,"FornecedoresAlterar Historico"))
oBloq2:AddLastChild( "Dados Comerciais" ,,_VAMenu2(133,1,"FornecedoresDados Comerciais"))
oBloq2:AddLastChild( "Relatorios" ,,_VAMenu2(12,1,"FornecedoresRelatorios"))
oBloq2:AddLastChild( "Conexao com Fornecedores" ,,_VAMenu2(134,1,"FornecedoresConexao com Fornecedores"))
oBloq40:=oBloq2:AddLastChild( "Compras", 3, 2 )
oBloq40:AddLastChild("Comprador" ,,_VAMenu2(117,1,"ComprasComprador"))
oBloq40:AddLastChild("Lancamento" ,,_VAMenu2(113,1,"ComprasLancamento"))
oBloq40:AddLastChild("Alteracao" ,,_VAMenu2(114,1,"ComprasAlteracao"))
oBloq40:AddLastChild("Tabela de Autorizacao",,_VAMenu2(115,1,"ComprasTabela de Autorizacao"))
oBloq41:=oBloq40:AddLastChild("Relatorios" ,3,2)
oBloq41:AddLastChild("Emite Pedido de Compras" ,,_VAMenu2(144,1,"RelatoriosEmite Pedido de Compras"))
oBloq41:AddLastChild("Emite Saldo dos Pedidos de Compras" ,,_VAMenu2(145,1,"RelatoriosEmite Saldo dos Pedidos de Compras"))
oBloq41:AddLastChild("Comparacao com Tabela de Autorizacao Mensal" ,,_VAMenu2(146,1,"RelatoriosComparacao com Tabela de Autorizacao Mensal"))
If cTpLj = "7"
oBloq3:=oLink:AddLastChild( "Funcionario" , 3, 2 )
oBloq3:AddLastChild( "Inclusao" ,,_VAMenu2(13,1,"FuncionarioInclusao"))
oBloq3:AddLastChild( "Consulta/Alteracao/Exclusao" ,,_VAMenu2(14,1,"FuncionarioConsulta/Alteracao/Exclusao"))
oBloq3:AddLastChild( "Relatorios" ,,_VAMenu2(15,1,"FuncionarioRelatorios"))
Else
oBloq3:=oLink:AddLastChild( "Vendedor" , 3, 2 )
oBloq3:AddLastChild( "Inclusao" ,,_VAMenu2(13,1,"VendedorInclusao"))
oBloq3:AddLastChild( "Consulta/Alteracao/Exclusao" ,,_VAMenu2(14,1,"VendedorConsulta/Alteracao/Exclusao"))
oBloq3:AddLastChild( "Relatorios" ,,_VAMenu2(15,1,"VendedorRelatorios"))
EndIf
oBloq4:=oLink:AddLastChild( "Grupos" ,,_VAMenu2(16,1,"CadastrosGrupos"))
oBloq5:=oLink:AddLastChild( "Sub-Grupos" ,,_VAMenu2(17,1,"CadastrosSub-Grupos"))
oBloq6:=oLink:AddLastChild( "Multi-Grupos",,_VAMenu2(18,1,"CadastrosMulti-Grupos"))
oBloq7:=oLink:AddLastChild( "Marca" ,,_VAMenu2(19,1,"CadastrosMarca"))
oBloq8:=oLink:AddLastChild( "Produto" , 3, 2 )
oBloq8:AddLastChild( "Inclusao" ,,_VAMenu2(20,1,"ProdutoInclusao"))
oBloq8:AddLastChild( "Consulta/Alteracao/Exclusao" ,,_VAMenu2(21,1,"ProdutoConsulta/Alteracao/Exclusao"))
oBloq8:AddLastChild( "Alterar Produtos" ,,_VAMenu2(109,1,"ProdutoAlterar Produtos"))
oBloq8:AddLastChild( "Excluir Produtos" ,,_VAMenu2(110,1,"ProdutoExcluir Produtos"))
oBloq8:AddLastChild( "Alterar Preco de Promocao" ,,_VAMenu2(140,1,"ProdutoAlterar Preco de Promocao"))
oBloq8:AddLastChild( "Gera Codigo de Barras" ,,_VAMenu2(22,1,"ProdutoGera Codigo de Barras"))
If lEGrade
oBloq8:AddLastChild( "Grades" ,,_VAMenu2(23,1,"ProdutoGrades"))
EndIf
oBloq8:AddLastChild( "Altera Codigo de Produtos" ,,_VAMenu2(24,1,"ProdutoAltera Codigo de Produtos"))
If ! lEGrade
oBloq8:AddLastChild( "Familia de Produtos" ,,_VAMenu2(25,1,"ProdutoFamilia de Produtos"))
EndIf
If cTpLj = "3" .or. ULT01->Producao = "S"
oBloq8:AddLastChild( "Composicao" ,,_VAMenu2(26,1,"ProdutoComposicao"))
EndIf
If cTpLj = "1"
oBloq8:AddLastChild( "Produtos em Falta",,_VAMenu2(112,1,"ProdutoProdutos em Falta"))
Endif
oBloq8:AddLastChild( "Gera Codigo para Balanca" ,,_VAMenu2(27,1,"ProdutoGera Codigo para Balanca"))
oBloq8:AddLastChild( "Ajuste de Precos" ,,_VAMenu2(149,1,"ProdutoAjuste de Precos"))
oBloq9 :=oLink:AddLastChild( "Natureza de Operacao" , 3, 2 )
oBloq9:AddLastChild( "Consulta" ,,_VAMenu2(28,1,"Natureza de OperacaoConsulta"))
oBloq9:AddLastChild( "Inclusao" ,,_VAMenu2(123,1,"Natureza de OperacaoInclusao"))
oBloq9:AddLastChild( "Alteracao" ,,_VAMenu2(124,1,"Natureza de OperacaoAlteracao"))
oBloq9:AddLastChild( "Exclusao" ,,_VAMenu2(125,1,"Natureza de OperacaoExclusao"))
oBloq10:=oLink:AddLastChild( "Condicao de Pagamento" ,,_VAMenu2(29,1,"CadastrosCondicao de Pagamento"))
oBloq11:=oLink:AddLastChild( "Transportadoras" ,,_VAMenu2(30,1,"CadastrosTransportadoras"))
oBloq12:=oLink:AddLastChild( "Portador" ,,_VAMenu2(31,1,"CadastrosPortador"))
oBloq12:=oLink:AddLastChild( "Planos Comerciais" ,,_VAMenu2(32,1,"CadastrosPlanos Comerciais"))
oBloq12:=oLink:AddLastChild( "Ramo de Atividade" ,,_VAMenu2(147,1,"CadastrosRamo de Atividade"))
oBloq12:=oLink:AddLastChild( "Rede de Clientes" ,,_VAMenu2(148,1,"CadastrosRede de Clientes"))
oBloq13:=oLink:AddLastChild( "Conta" ,,_VAMenu2(33,1,"CadastrosConta"))
oBloq14:=oLink:AddLastChild( "Sub-Conta" ,,_VAMenu2(34,1,"CadastrosSub-Conta"))
oBloq15:=oLink:AddLastChild( "Lojas" ,,_VAMenu2(35,1,"CadastrosLojas"))
oBloq16:=oLink:AddLastChild( "Cadastro do Contabilista" ,,_VAMenu2(36,1,"CadastrosCadastro do Contabilista"))
oBloq17:=oLink:AddLastChild( "Cadastro Situacao da Conta Cliente" ,,_VAMenu2(118,1,"CadastrosCadastro Situacao da Conta Cliente"))
oBloq42 :=oLink:AddLastChild( "Historico Contabil" , 3, 2 )
oBloq42:AddLastChild( "Inclusao" ,,_VAMenu2(154,1,"Historico ContabilInclusao"))
oBloq42:AddLastChild( "Alteracao" ,,_VAMenu2(155,1,"Historico ContabilAlteracao"))
oBloq42:AddLastChild( "Exclusao" ,,_VAMenu2(156,1,"Historico ContabilExclusao"))
oLink:=oRoot:AddLastChild( "Movimentacao", 3, 2 )
oBloq17:=oLink:AddLastChild("Entradas",,_VAMenu2(37,1,"MovimentacaoEntradas"))
oBloq17:=oLink:AddLastChild("Alterar Notas",,_VAMenu2(138,1,"MovimentacaoAlterar Notas"))
oBloq17:=oLink:AddLastChild("Excluir Notas",,_VAMenu2(139,1,"MovimentacaoExcluir Notas"))
oBloq18:=oLink:AddLastChild("Balanco" ,,_VAMenu2(38,1,"MovimentacaoBalanco"))
oBloq18:=oLink:AddLastChild("Nota Fiscal de Devolucao/Reentrada" ,,_VAMenu2(126,1,"MovimentacaoNota Fiscal de Devolucao/Reentrada"))
If ULT01->Producao = "S"
oBloq19:=oLink:AddLastChild("Ordem de Fabricacao" ,,_VAMenu2(108,1,"MovimentacaoOrdem de Fabricacao"))
EndIf
If ULT01->CFrete = "S"
oBloq19:=oLink:AddLastChild("Conhecimento de Frete" ,,;
_VAMenu2(150,1,"MovimentacaoConhecimento de Frete"))
EndIf
oLink:=oRoot:AddLastChild( "Financas", 3, 2 )
oBloq19:=oLink:AddLastChild("Contas a Pagar",3,2)
oBloq19:AddLastChild("Inclusao" ,,_VAMenu2(39,1,"Contas a PagarInclusao"))
oBloq19:AddLastChild("Consulta/Alteracao" ,,_VAMenu2(40,1,"Contas a PagarConsulta/Alteracao"))
oBloq19:AddLastChild("Alteracao de Contas" ,,_VAMenu2(135,1,"Contas a PagarAlteracao de Contas"))
oBloq19:AddLastChild("Exclusao" ,,_VAMenu2(41,1,"Contas a PagarExclusao"))
oBloq19:AddLastChild("Quita" ,,_VAMenu2(42,1,"Contas a PagarQuita"))
oBloq19:AddLastChild("Estorna" ,,_VAMenu2(157,1,"Contas a PagarEstorna"))
oBloq19:AddLastChild("Fatura a Pagar",,_VAMenu2(151,1,"Contas a PagarFatura a Pagar"))
oBloq20:=oLink:AddLastChild("Contas a Receber",3,2)
oBloq20:AddLastChild("Inclusao" ,,_VAMenu2(43,1,"Contas a ReceberInclusao"))
oBloq20:AddLastChild("Consulta/Alteracao" ,,_VAMenu2(44,1,"Contas a ReceberConsulta/Alteracao"))
oBloq20:AddLastChild("Alteracao de Contas" ,,_VAMenu2(136,1,"Contas a ReceberAlteracao de Contas"))
oBloq20:AddLastChild("Exclusao" ,,_VAMenu2(45,1,"Contas a ReceberExclusao"))
oBloq20:AddLastChild("Quita" ,,_VAMenu2(46,1,"Contas a ReceberQuita"))
oBloq20:AddLastChild("Estorna" ,,_VAMenu2(158,1,"Contas a ReceberEstorna"))
oBloq20:AddLastChild("Ficha de Cliente" ,,_VAMenu2(47,1,"Contas a ReceberFicha de Cliente"))
oBloq20:AddLastChild("Boleto Bancario" ,,_VAMenu2(120,1,"Contas a ReceberBoleto Bancario"))
oBloq20:AddLastChild("Duplicata" ,,_VAMenu2(121,1,"Contas a ReceberDuplicata"))
oBloq20:AddLastChild("Previa de Recebimento",,_VAMenu2(127,1,"Contas a ReceberPrevia de Recebimento"))
oBloq20:AddLastChild("Fatura a Receber",,_VAMenu2(142,1,"Contas a ReceberFatura a Receber"))
oBloq21:=oLink:AddLastChild("Bancario",3,2)
oBloq21:AddLastChild("Contas" ,,_VAMenu2(48,1,"BancarioContas"))
oBloq21:AddLastChild("Movimentacao" ,,_VAMenu2(49,1,"BancarioMovimentacao"))
oBloq21:AddLastChild("Extratos" ,,_VAMenu2(50,1,"BancarioExtratos"))
oLink:=oRoot:AddLastChild( "Relatorios", 3, 2 )
oBloq22:=oLink:AddLastChild("Produtos x Estoque" ,,_VAMenu2(51,1,"RelatoriosProdutos x Estoque"))
oBloq23:=oLink:AddLastChild("Etiquetas Cod.Barras" ,,_VAMenu2(52,1,"RelatoriosEtiquetas Cod.Barras"))
oBloq24:=oLink:AddLastChild("Vendas" ,,_VAMenu2(53,1,"RelatoriosVendas"))
oBloq24:=oLink:AddLastChild("Vendas Canceladas" ,,_VAMenu2(152,1,"RelatoriosVendas Canceladas"))
oBloq24:=oLink:AddLastChild("Devolucoes" ,,_VAMenu2(153,1,"RelatoriosDevolucoes"))
oBloq24:=oLink:AddLastChild("Sugestao de Compras" ,,_VAMenu2(122,1,"RelatoriosSugestao de Compras"))
oBloq24:=oLink:AddLastChild("Produtos Comprados",,_VAMenu2(137,1,"RelatoriosProdutos Comprados"))
oBloq24:=oLink:AddLastChild("Produtos nao Movimentados",,_VAMenu2(159,1,"RelatoriosProdutos nao Movimentados"))
oBloq25:=oLink:AddLastChild("Comissao" ,,_VAMenu2(54,1,"RelatoriosComissao"))
If cTpLj = "7"
oBloq25:=oLink:AddLastChild("Comissao por Pagamento" ,,_VAMenu2(160,1,"RelatoriosComissao por Pagamento"))
Endif
If cTpAt >= "3"
oBloq26:=oLink:AddLastChild("Movimento de DAV" ,,_VAMenu2(55,1,"RelatoriosMovimento de DAV"))
oBloq27:=oLink:AddLastChild("Segunda Via do DAV" ,,_VAMenu2(56,1,"RelatoriosSegunda Via do DAV"))
If cTpLj = "6"
oBloq33:=oLink:AddLastChild("Emitir Varias Copias DAV",,_VAMenu2(104,1,"RelatoriosEmitir Varias Copias DAV"))
EndIf
oBloq34:=oLink:AddLastChild("Relatorio de Reservas",,_VAMenu2(92,1,"RelatoriosRelatorio de Reservas"))
EndIf
oBloq28:=oLink:AddLastChild("Notas Emitidas" ,,_VAMenu2(57,1,"RelatoriosNotas Emitidas"))
oBloq29:=oLink:AddLastChild("Total Por ICMS" ,,_VAMenu2(58,1,"RelatoriosTotal Por ICMS"))
oBloq30:=oLink:AddLastChild("Fiscal/Sintegra",,_VAMenu2(59,1,"RelatoriosFiscal/Sintegra"))
oBloq31:=oLink:AddLastChild("Inventario Estoque" ,,_VAMenu2(60,1,"RelatoriosInventario Estoque"))
oBloq33:=oLink:AddLastChild("Ficha Cardex",,_VAMenu2(93,1,"RelatoriosFicha Cardex"))
If ! cTpLj $ "34"
oBloq34:=oLink:AddLastChild("Vendas Apuracao PIS/COFINS" ,,_VAMenu2(103,1,"RelatoriosVendas Apuracao PIS/COFINS"))
EndIf
If cTpAt >= "3"
oBloq35:=oLink:AddLastChild("Controle DAV/RPV" ,,_VAMenu2(106,1,"RelatoriosControle DAV/RPV"))
EndIf
oBloq36:=oLink:AddLastChild("Ranking de Vendas" ,,_VAMenu2(107,1,"RelatoriosRanking de Vendas"))
oBloq37:=oLink:AddLastChild("SPED PIS/COFINS",,_VAMenu2(141,1,"RelatoriosSPED PIS/COFINS"))
oBloq32:=oLink:AddLastChild("Relatorio Financeiro" ,3,2)
oBloq32:AddLastChild( "Contas a Pagar" ,,_VAMenu2(61,1,"Relatorio FinanceiroContas a Pagar"))
oBloq32:AddLastChild( "Contas a Receber" ,,_VAMenu2(62,1,"Relatorio FinanceiroContas a Receber"))
oBloq32:AddLastChild( "Posicao Financeira" ,,_VAMenu2(116,1,"Relatorio FinanceiroPosicao Financeira"))
oLink:=oRoot:AddLastChild( "Comunicacao", 3, 2 )
oBloq22:=oLink:AddLastChild("Exporta Cadastros" ,,_VAMenu2(63,1,"ComunicacaoExporta Cadastros"))
oBloq23:=oLink:AddLastChild("Importa Movimento" ,,_VAMenu2(64,1,"ComunicacaoImporta Movimento"))
oLink:=oRoot:AddLastChild( "Utilitarios", 3, 2 )
oBloq24:=oLink:AddLastChild("Manutencao" ,,_VAMenu2(65,1,"UtilitariosManutencao"))
oBloq27:=oLink:AddLastChild("Conferencia Produto",,_VAMenu2(94,1,"UtilitariosConferencia Produto"))
oBloq28:=oLink:AddLastChild("Conferencia Estoque Geral",,_VAMenu2(95,1,"UtilitariosConferencia Estoque GeralConferencia Estoque Geral"))
oBloq25:=oLink:AddLastChild("Parametros" ,,_VAMenu2(66,1,"UtilitariosParametros"))
oBloq26:=oLink:AddLastChild("Controle de Usuarios" ,3,2)
oBloq26:AddLastChild( "Consulta Usuarios",,_VAMenu2(67,1,"Controle de UsuariosConsulta Usuarios"))
oBloq26:AddLastChild( "Cadastrar Novo Usuario",,_VAMenu2(96,1,"Controle de UsuariosCadastrar Novo Usuario"))
oBloq26:AddLastChild( "Alterar Senha",,_VAMenu2(97,1,"Controle de UsuariosAlterar Senha"))
oBloq26:AddLastChild( "Alterar Acessos",,_VAMenu2(98,1,"Controle de UsuariosAlterar Acessos"))
oBloq26:AddLastChild( "Excluir Usuario",,_VAMenu2(99,1,"Controle de UsuariosExcluir Usuario"))
oBloq26:AddLastChild( "Copiar Acessos de Usuario",,_VAMenu2(100,1,"Controle de UsuariosCopiar Acessos de Usuario"))
// Acessos Sistema de Vendas //
oRoot2:=oRoot2:AddLastChild( "Controle de Acessos LH VENDAS", 9, 8 )
oLink:=oRoot2:AddLastChild( "Vendas", 3, 2 )
oBloq24:=oLink:AddLastChild("Venda Direta" ,,_VAMenu2(68,1,"VendasVenda Direta"))
oBloq24:=oLink:AddLastChild("Relatorios Fiscais" ,,_VAMenu2(69,1,"VendasRelatorios Fiscais"))
oBloq24:=oLink:AddLastChild("Cancelamento de Vendas" ,,_VAMenu2(70,1,"VendasCancelamento de Vendas"))
If ULT01->SCan = "S"
oBloq24:=oLink:AddLastChild("Permissao para Cancelamento" ,,_VAMenu2(111,1,"VendasPermissao para Cancelamento"))
EndIf
oBloq24:=oLink:AddLastChild("Caixa" ,,_VAMenu2(71,1,"VendasCaixa"))
If At("LAND",Firma) != 0 .or. cTpLj = "1"
oBloq24:=oLink:AddLastChild("Troca de Mercadoria" ,,_VAMenu2(72,1,"VendasTroca de Mercadoria"))
EndIf
oBloq24:=oLink:AddLastChild("Nota Fiscal Manual" ,,_VAMenu2(73,1,"VendasNota Fiscal Manual"))
oBloq24:=oLink:AddLastChild("Exclui Item na Venda (ECF)" ,,_VAMenu2(101,1,"VendasExclui Item na Venda (ECF)"))
oBloq24:=oLink:AddLastChild("Desconto Acima do limite",,_VAMenu2(102,1,"VendasDesconto Acima do limite"))
oBloq24:=oLink:AddLastChild("Cancelamento Nota Fiscal",,_VAMenu2(105,1,"VendasCancelamento Nota Fiscal"))
oLink:=oRoot2:AddLastChild( "Comunicacao", 3, 2 )
oBloq25:=oLink:AddLastChild("Importa Cadastros" ,,_VAMenu2(90,1,"ComunicacaoImporta Cadastros"))
oBloq25:=oLink:AddLastChild("Exporta Movimento" ,,_VAMenu2(91,1,"ComunicacaoExporta Movimento"))
/* // Acessos Sistema de Compras //
oRoot3:=oRoot3:AddLastChild( "Controle de Acessos LH COMPRAS", 9, 8 )
oLink:=oRoot3:AddLastChild( "Compras", 3, 2 )
oBloq24:=oLink:AddLastChild("Comprador" ,,_VAMenu2(117,1,"ComprasComprador"))
oBloq24:=oLink:AddLastChild("Lancamento" ,,_VAMenu2(113,1,"ComprasLancamento"))
oBloq24:=oLink:AddLastChild("Alteracao" ,,_VAMenu2(114,1,"ComprasAlteracao"))
oBloq24:=oLink:AddLastChild("Tabela de Autorizacao",,_VAMenu2(115,1,"ComprasTabela de Autorizacao"))
oBloq24:=oLink:AddLastChild("Relatorios" ,3,2)
oBloq24:AddLastChild("Emite Pedido de Compras" ,,_VAMenu2(144,1,"RelatoriosEmite Pedido de Compras"))
oBloq24:AddLastChild("Emite Saldo dos Pedidos de Compras" ,,_VAMenu2(145,1,"RelatoriosEmite Saldo dos Pedidos de Compras"))
oBloq24:AddLastChild("Comparacao com Tabela de Autorizacao Mensal" ,,_VAMenu2(146,1,"RelatoriosComparacao com Tabela de Autorizacao Mensal"))
*/
oTree:UpdateTV()
oTree:Expand(0)
oTree:Expand(7)
//oTree:Expand(10)
oTree:SetFocus()
RETURN oTree
**************************************************************************
Function ClickTree( oTree )
LOCAL oLink := oTree:GetLinkAt( oTree:GetCursel() )
LOCAL cPrompt := oLink:TreeItem:cPrompt
LOCAL cParent, nPos,nPos2
If At( Left(cPrompt,19) , "Controle de Acessos" ) > 0
Else
nPos := oTree:GetCursel()
cParent := oLink:ParentLink:TreeItem:cPrompt
nPos2 := AScan(aMatVar,{|x| x[3] = cParent+cPrompt })
If nPos2 > 0
cVar := aMatVar[nPos2,2]
Do While CORES->(! RLock()); EndDo
&cVar. := ! &cVar.
CORES->( DbUnlock())
If &cVar.
oTree:Modify( nPos, cPrompt, , 12 )
Else
oTree:Modify( nPos, cPrompt, , 13 )
EndIf
EndIf
EndIf
Return(Nil)
*********************************************************************************
Static Function MenuPrincipal()
local oMenu
Menu oMenu
MenuItem "&Sair do Sistema" ;
Action oWnd:End()
EndMenu
return oMenu
********************************************************************************
Function _VAMenu2(nVar,Modo,cTexto)
Local Ret,cArea:=Alias()
Local lCores:=Select("CORES")==0,nPos
Modo := If(Modo=Nil,1,Modo)
nPos := AScan(aMatVar,{|x| x[1] = nVar })
If Modo = 1
Ret := 13
Else
Ret := .F.
Endif
If nPos <= 0
Else
If Empty(aMatVar[nPos,3])
aMatVar[nPos,3]:=cTexto
EndIf
cVar := aMatVar[nPos,2]
If &cVar.
If Modo = 1
Ret := 12
Else
Ret := .T.
Endif
Endif
EndIf
If ! empty(cArea)
Select (cArea)
Endif
Return(Ret)
****************************************************************************
Function cript(mvar,modo)
local tam:=len(mvar)
local i
local var1,var2:=""
if modo = 1 // criptografa
for i = 1 to tam
var1 = substr(mvar,i,1)
var2+= (chr(asc(var1)+81+(i*2)))
next
elseif modo = 2
for i = 1 to tam
var1 = substr(mvar,i,1)
var2+= (chr(asc(var1)-81-(i*2)))
next
endif
return(var2)