#include "fivewin.ch"
Function main()
Local oBar
Local oWnd
Local oLabelDesign
Local oLabelHeight := 400
Local oLabelWidth := 200
Local oLabelName := "Test.lbl"
Local aGet[10]
//--------------------------------------------------------------------//
DEFINE WINDOW oWnd TITLE "Label Design" Vscroll
DEFINE BUTTONBAR oBar OF oWnd SIZE 80, 80 2015 BOTTOM
@ 20,10 SAY "Label Height :" of oWnd size 100,20 PIXEL
@ 44,10 SAY "Label Width :" of oWnd size 100,20 PIXEL
@ 20,410 SAY "Label Name :" of oWnd size 100,20 PIXEL
@ 20, 125 GET aGet[1] VAR oLabelHeight of oWnd size 60,20 SPINNER PIXEL on change Refresh_oLabel(oLabelDesign,oLabelHeight, oLabelWidth)
@ 44, 125 GET aGet[2] VAR oLabelWidth of oWnd size 60,20 SPINNER PIXEL on change Refresh_oLabel(oLabelDesign,oLabelHeight, oLabelWidth)
@ 20, 510 GET aGet[3] VAR oLabelName of oWnd size 120,20 PIXEL
oLabelDesign :=TMetaFile():New( 200, 200, oLabelHeight, oLabelWidth,,oWnd,CLR_BLACK,CLR_WHITE,)
ACTIVATE WINDOW oWnd center ;
ON INIT (CreateSay( oLabelDesign ))
return nil
//--------------------------------------------------------------------//
Function Refresh_oLabel(oBjeto,oLabelHeight, oLabelWidth)
oBjeto:nHeight:= oLabelHeight
oBjeto:nWidth:= oLabelWidth
oBjeto:setsize(oLabelHeight, oLabelWidth)
oBjeto:refresh()
return nil
//--------------------------------------------------------------------//
function CreateSay( oDlg )
local oSay
@ 1, 2 SAY oSay PROMPT "Label:" OF oDlg SIZE 70, 20 DESIGN BORDER
oSay:bGet = nil
oSay:lWantClick = .T.
BringWindowToTop( oSay:hWnd )
oSay:SetFocus()
* oSay:bRClicked = { | nRow, nCol | EditControl( nRow, nCol, oSay ) }
return nil
//--------------------------------------------------------------------//
Function Refresh_oLabel(oBjeto,oLabelHeight, oLabelWidth,oWnd)
oBjeto:nHeight:= oLabelHeight
oBjeto:nWidth:= oLabelWidth
oBjeto:setsize(oLabelHeight, oLabelWidth)
oBjeto:refresh()
oWnd:Refresh()
return nil
#include "fivewin.ch"
#include "Constant.ch"
#Define Label_extension ".LBL"
REQUEST DBFCDX
REQUEST DBFFPT
EXTERNAL ORDKEYNO,ORDKEYCOUNT,ORDCREATE,ORDKEYGOTO
Static oLabelDesign,nLabelHeight,nLabelWidth ,cLabelName
Function Test()
local oDlg, oBrw, oFont
Local oBtnLabel[2]
SET DATE ITALIAN
SET CENTURY ON
FwNumFormat( 'E', .t. )
USE CUSTOMER ALIAS CUST
DEFINE FONT oFont NAME 'Tahoma' SIZE 0, -14
DEFINE DIALOG oDlg SIZE 640,440 PIXEL ;
FONT oFont TITLE 'XBrowse Windows 7 Bars' ;
COLOR CLR_BLACK,RGB(250,250,250)
@ 10,20 XBROWSE oBrw OF oDlg SIZE -10,-20 PIXEL ;
COLUMNS "First","Last","Street","City", "State", "Zip","HireDate","Age", "Salary" ;
ALIAS 'CUST' NOBORDER
oBrw:lRecordSelector := .f.
oBrw:nMarqueeStyle := MARQSTYLE_HIGHLWIN7
WITH OBJECT oBrw:InsCol( 1 )
:cHeader := " "
:bEditValue := { || If( AScan( oBrw:aSelected, oBrw:BookMark ) > 0, .t., nil ) }
:SetCheck()
:nHeadBmpNo := { || If( Len( oBrw:aSelected ) == oBrw:nLen, 1, 2 ) }
:bLClickHeader := { |r,c,f,oCol| If( Len( oBrw:aSelected ) == oBrw:nLen, ;
oBrw:SelectNone(), oBrw:SelectAll() ) }
END
oBrw:CreateFromCode()
@ 204,2 BUTTON oBtnLabel Prompt "Label Manager" SIZE 60,10 PIXEL;
ACTION Label_Manager('CUST',oBrw,'CUST')
ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont
Return nil
//---------------------------------------------------------------------//
Function Label_Manager(cDbf,oGrid,cPref)
Local oBar
Local oWnd
Local lPrintFrame := .t.
Local nLblVSep := 0
Local nLblHSep := 0
Local nLblOnLine := 0
Local nLen := Len( oGrid:aCols )
Local aCampos [ nLen ]
Local aTitulos[ nLen ]
Local aTipos [ nLen ]
Local cField
Local aGet[10]
Local oHand
//---------------------------------------------------------------------//
RddSetDefault( "DBFCDX" )
SetHandleCount( 100 )
//--------------------------------------------------------------------//
FOR n = 1 TO nLen
aCampos [ n ]:= oGrid:aCols[ n ]:cExpr
aTitulos [ n ]:= oGrid:aCols[ n ]:cHeader
aTipos [ n ]:= oGrid:aCols[ n ]:cDataType
NEXT
DEFAULT nLabelHeight := 400
DEFAULT nLabelWidth := 650
cLabelName := "Test.lbl"
DEFINE CURSOR oHand HAND
DEFINE WINDOW oWnd TITLE "Label Design" Vscroll
DEFINE BUTTONBAR oBar OF oWnd SIZE 40, 40 2015
oBar:bRClicked := { || .t. }
oBar:oCursor:= oHand
DEFINE BUTTON OF oBar ;
FILENAME "PRINT.BMP" ;
ACTION Preview(lPrintFrame ) ;
TOOLTIP i18n( "Preview Label. " ) ;
MESSAGE i18n( "Preview Label." ) ;
NOBORDER
@ 60,10 SAY "Label Height :" of oWnd size 100,20 PIXEL
@ 80,10 SAY "Label Width :" of oWnd size 100,20 PIXEL
@ 60,410 SAY "Label Name :" of oWnd size 100,20 PIXEL
@ 100, 410 say "Horizontal Separator (mm):" of oWnd size 180,20 PIXEL
@ 125, 410 say "Vertical Separator (mm):" of oWnd size 180,20 PIXEL
@ 60, 125 GET aGet[1] VAR nLabelHeight of oWnd size 60,20 SPINNER PIXEL on change Refresh_oLabel(oWnd)
@ 84, 125 GET aGet[2] VAR nLabelWidth of oWnd size 60,20 SPINNER PIXEL on change Refresh_oLabel(oWnd)
@ 60, 510 GET aGet[3] VAR cLabelName of oWnd size 120,20 PIXEL
@ 100, 600 GET aGet[4] VAR nLblHSep of oWnd size 60,20 SPINNER PIXEL
@ 125, 600 GET aGet[5] VAR nLblVSep of oWnd size 60,20 SPINNER PIXEL
oLabelDesign :=TMetaFile():New( 200, 200,nLabelWidth, nLabelHeight, ,oWnd,CLR_BLACK,CLR_WHITE,)
oLabelDesign:bRClicked := {|nRow,nCol,nFlags|EditDialog( nRow, nCol, oLabelDesign )}
@ 2.17, 130 say "Select Fields:" OF oBar SIZE 120,20 PIXEL
@ 2.17,259 COMBOBOX aGet[10] VAR cField ITEMS aTitulos OF oBar SIZE 200,90 PIXEL STYLE CBS_DROPDOWN ;
on change CreateSay( cField, oLabelDesign )
ACTIVATE WINDOW oWnd center
return nil
//--------------------------------------------------------------------//
Function Refresh_oLabel(oWnd)
oLabelDesign:nHeight:= nLabelHeight
oLabelDesign:nWidth:= nLabelWidth
oLabelDesign:setsize(nLabelWidth,nLabelHeight, )
oLabelDesign:refresh()
oWnd:refresh()
return nil
//--------------------------------------------------------------------//
function CreateSay(cTesto, oDlg )
local oSay
local oFontName := TFont():New( "ARIAL", 0, -24,,,,,,,,,,,,, , )
IF !empty(cTesto)
@ 1, 2 SAY oSay PROMPT "<" +cTesto+">" OF oDlg SIZE 150, 40 DESIGN BORDER FONT oFontName
oSay:bGet = nil
oSay:lWantClick = .T.
BringWindowToTop( oSay:hWnd )
oSay:SetFocus()
oSay:bRClicked = { | nRow, nCol | EditControl( nRow, nCol, oSay ) }
Endif
return nil
//---------------------------------------------------------------------------------------//
function EditControl( nRow, nCol, oControl )
local oMenu
MENU oMenu POPUP
MENUITEM "Bring to front" ACTION BringWindowToTop( oControl:hWnd )
MENUITEM "Position"
MENU
MENUITEM "nTop" + Chr( 9 ) + LTrim( Str( oControl:nTop ) )
MENUITEM "nLeft" + Chr( 9 ) + LTrim( Str( oControl:nLeft ) )
MENUITEM "Move up" ACTION ( oControl:HideDots(), oControl:nTop--, oControl:ShowDots() )
MENUITEM "Move down" ACTION ( oControl:HideDots(), oControl:nTop++, oControl:ShowDots() )
ENDMENU
MENUITEM "Size"
MENU
MENUITEM "nWidth" + Chr( 9 ) + LTrim( Str( oControl:nWidth ) )
MENUITEM "nHeight" + Chr( 9 ) + LTrim( Str( oControl:nHeight ) )
ENDMENU
ENDMENU
ACTIVATE POPUP oMenu WINDOW oControl AT nRow, nCol
return nil
function Preview(lPrintFrame )
local oPrn, oCtrl, oBrush, oFont
local n
oWndChild:=oLabelDesign
PRINTER oPrn PREVIEW NAME cLabelName
PAGE
aDes:= oPrn:Pix2Cmtr( oWndChild:nBottom, oWndChild:nRight )
if lPrintFrame
oPrn:Box( 10, 10, oWndChild:nBottom, oWndChild:nRight, )
Endif
if ! Empty( oWndChild:aControls )
for n = 1 to Len( oWndChild:aControls )
oCtrl = oWndChild:aControls[ n ]
do case
case oCtrl:ClassName() == "TSAY"
SetBkColor( oPrn:hDcOut, oCtrl:nClrPane )
DEFINE BRUSH oBrush COLOR oCtrl:nClrPane
FillRect( oPrn:hDcOut, { oCtrl:nTop, oCtrl:nLeft,;
oCtrl:nTop + oCtrl:nHeight - 1,;
oCtrl:nLeft + oCtrl:nWidth - 1 }, oBrush:hBrush )
oBrush:End()
oCtrl:GetFont()
DEFINE FONT oFont NAME oCtrl:oFont:cFaceName ;
SIZE oCtrl:oFont:nWidth, oCtrl:oFont:nHeight ;
OF oPrn
oFont:Activate( oPrn:hDCOut )
TextOut( oPrn:hDcOut,;
oCtrl:nTop,;
oCtrl:nLeft,;
oCtrl:GetText() )
oFont:DeActivate( oPrn:hDCOut )
oFont:End()
case oCtrl:ClassName() == "TBITMAP"
oPrn:SayBitmap( oCtrl:nTop,;
oCtrl:nLeft,;
oCtrl:cFileName, 80, 80 )
endcase
next
endif
ENDPAGE
ENDPRINTER
return nil
//-----------------------------------------------------------------------------------------//
static function EditDialog( nRow, nCol, oControl )
local oMenu
MENU oMenu POPUP
MENUITEM "Title..." ACTION NIL //EditTitle( oDlg )
SEPARATOR
MENUITEM "Add field" ACTION NIL
SEPARATOR
ENDMENU
endmenu
ACTIVATE POPUP oMenu WINDOW oControl AT nRow, nCol // SAVE
return nil
#include "fivewin.ch"
#include "Constant.ch"
#Define Label_extension ".LBL"
REQUEST DBFCDX
REQUEST DBFFPT
EXTERNAL ORDKEYNO,ORDKEYCOUNT,ORDCREATE,ORDKEYGOTO
Static oLabelDesign,nLabelHeight,nLabelWidth ,cLabelName
Function Test()
local oDlg, oBrw, oFont
Local oBtnLabel[2]
SET DATE ITALIAN
SET CENTURY ON
FwNumFormat( 'E', .t. )
USE CUSTOMER ALIAS CUST
DEFINE FONT oFont NAME 'Tahoma' SIZE 0, -14
DEFINE DIALOG oDlg SIZE 640,440 PIXEL ;
FONT oFont TITLE 'XBrowse Windows 7 Bars' ;
COLOR CLR_BLACK,RGB(250,250,250)
@ 10,20 XBROWSE oBrw OF oDlg SIZE -10,-20 PIXEL ;
COLUMNS "First","Last","Street","City", "State", "Zip","HireDate","Age", "Salary" ;
ALIAS 'CUST' NOBORDER
oBrw:lRecordSelector := .f.
oBrw:nMarqueeStyle := MARQSTYLE_HIGHLWIN7
WITH OBJECT oBrw:InsCol( 1 )
:cHeader := " "
:bEditValue := { || If( AScan( oBrw:aSelected, oBrw:BookMark ) > 0, .t., nil ) }
:SetCheck()
:nHeadBmpNo := { || If( Len( oBrw:aSelected ) == oBrw:nLen, 1, 2 ) }
:bLClickHeader := { |r,c,f,oCol| If( Len( oBrw:aSelected ) == oBrw:nLen, ;
oBrw:SelectNone(), oBrw:SelectAll() ) }
END
oBrw:CreateFromCode()
@ 204,2 BUTTON oBtnLabel Prompt "Label Manager" SIZE 60,10 PIXEL;
ACTION Label_Manager('CUST',oBrw,'CUST')
ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont
Return nil
//---------------------------------------------------------------------//
Function Label_Manager(cDbf,oGrid,cPref)
Local oBar
Local oWnd
Local lPrintFrame := .t.
Local nLblVSep := 0
Local nLblHSep := 0
Local nLblOnLine := 0
Local nLen := Len( oGrid:aCols )
Local aCampos [ nLen ]
Local aTitulos[ nLen ]
Local aTipos [ nLen ]
Local cField
Local aGet[10]
Local oHand
//---------------------------------------------------------------------//
RddSetDefault( "DBFCDX" )
SetHandleCount( 100 )
//--------------------------------------------------------------------//
FOR n = 1 TO nLen
aCampos [ n ]:= oGrid:aCols[ n ]:cExpr
aTitulos [ n ]:= oGrid:aCols[ n ]:cHeader
aTipos [ n ]:= oGrid:aCols[ n ]:cDataType
NEXT
DEFAULT nLabelHeight := 400
DEFAULT nLabelWidth := 650
cLabelName := "Test.lbl"
DEFINE CURSOR oHand HAND
DEFINE WINDOW oWnd TITLE "Label Design" Vscroll
DEFINE BUTTONBAR oBar OF oWnd SIZE 40, 40 2015
oBar:bRClicked := { || .t. }
oBar:oCursor:= oHand
DEFINE BUTTON OF oBar ;
FILENAME "PRINT.BMP" ;
ACTION Preview(lPrintFrame ) ;
TOOLTIP i18n( "Preview Label. " ) ;
MESSAGE i18n( "Preview Label." ) ;
NOBORDER
@ 60,10 SAY "Label Height :" of oWnd size 100,20 PIXEL
@ 80,10 SAY "Label Width :" of oWnd size 100,20 PIXEL
@ 60,410 SAY "Label Name :" of oWnd size 100,20 PIXEL
@ 100, 410 say "Horizontal Separator (mm):" of oWnd size 180,20 PIXEL
@ 125, 410 say "Vertical Separator (mm):" of oWnd size 180,20 PIXEL
@ 60, 125 GET aGet[1] VAR nLabelHeight of oWnd size 60,20 SPINNER PIXEL on change Refresh_oLabel(oWnd)
@ 84, 125 GET aGet[2] VAR nLabelWidth of oWnd size 60,20 SPINNER PIXEL on change Refresh_oLabel(oWnd)
@ 60, 510 GET aGet[3] VAR cLabelName of oWnd size 120,20 PIXEL
@ 100, 600 GET aGet[4] VAR nLblHSep of oWnd size 60,20 SPINNER PIXEL
@ 125, 600 GET aGet[5] VAR nLblVSep of oWnd size 60,20 SPINNER PIXEL
oLabelDesign :=TMetaFile():New( 200, 200,nLabelWidth, nLabelHeight, ,oWnd,CLR_BLACK,CLR_WHITE,)
oLabelDesign:bRClicked := {|nRow,nCol,nFlags|EditDialog( nRow, nCol, oLabelDesign )}
@ 2.17, 130 say "Select Fields:" OF oBar SIZE 120,20 PIXEL
@ 2.17,259 COMBOBOX aGet[10] VAR cField ITEMS aTitulos OF oBar SIZE 200,90 PIXEL STYLE CBS_DROPDOWN ;
on change CreateSay( cField, oLabelDesign )
ACTIVATE WINDOW oWnd center
return nil
//--------------------------------------------------------------------//
Function Refresh_oLabel(oWnd)
oLabelDesign:nHeight:= nLabelHeight
oLabelDesign:nWidth:= nLabelWidth
oLabelDesign:setsize(nLabelWidth,nLabelHeight, )
oLabelDesign:refresh()
oWnd:refresh()
return nil
//--------------------------------------------------------------------//
function CreateSay(cTesto, oDlg )
local oSay
local oFontName := TFont():New( "ARIAL", 0, -24,,,,,,,,,,,,, , )
IF !empty(cTesto)
@ 1, 2 SAY oSay PROMPT "<" +cTesto+">" OF oDlg SIZE 150, 40 DESIGN BORDER FONT oFontName
oSay:bGet = nil
oSay:lWantClick = .T.
BringWindowToTop( oSay:hWnd )
oSay:SetFocus()
oSay:bRClicked = { | nRow, nCol | EditControl( nRow, nCol, oSay ) }
Endif
return nil
//---------------------------------------------------------------------------------------//
function EditControl( nRow, nCol, oControl )
local oMenu
MENU oMenu POPUP
MENUITEM "Bring to front" ACTION BringWindowToTop( oControl:hWnd )
MENUITEM "Position"
MENU
MENUITEM "nTop" + Chr( 9 ) + LTrim( Str( oControl:nTop ) )
MENUITEM "nLeft" + Chr( 9 ) + LTrim( Str( oControl:nLeft ) )
MENUITEM "Move up" ACTION ( oControl:HideDots(), oControl:nTop--, oControl:ShowDots() )
MENUITEM "Move down" ACTION ( oControl:HideDots(), oControl:nTop++, oControl:ShowDots() )
ENDMENU
MENUITEM "Size"
MENU
MENUITEM "nWidth" + Chr( 9 ) + LTrim( Str( oControl:nWidth ) )
MENUITEM "nHeight" + Chr( 9 ) + LTrim( Str( oControl:nHeight ) )
ENDMENU
ENDMENU
ACTIVATE POPUP oMenu WINDOW oControl AT nRow, nCol
return nil
function Preview(lPrintFrame )
local oPrn, oCtrl, oBrush, oFont
local n
oWndChild:=oLabelDesign
PRINTER oPrn PREVIEW NAME cLabelName
PAGE
aDes:= oPrn:Pix2Cmtr( oWndChild:nBottom, oWndChild:nRight )
if lPrintFrame
oPrn:Box( 10, 10, oWndChild:nBottom, oWndChild:nRight, )
Endif
if ! Empty( oWndChild:aControls )
for n = 1 to Len( oWndChild:aControls )
oCtrl = oWndChild:aControls[ n ]
do case
case oCtrl:ClassName() == "TSAY"
SetBkColor( oPrn:hDcOut, oCtrl:nClrPane )
DEFINE BRUSH oBrush COLOR oCtrl:nClrPane
FillRect( oPrn:hDcOut, { oCtrl:nTop, oCtrl:nLeft,;
oCtrl:nTop + oCtrl:nHeight - 1,;
oCtrl:nLeft + oCtrl:nWidth - 1 }, oBrush:hBrush )
oBrush:End()
oCtrl:GetFont()
DEFINE FONT oFont NAME oCtrl:oFont:cFaceName ;
SIZE oCtrl:oFont:nWidth, oCtrl:oFont:nHeight ;
OF oPrn
oFont:Activate( oPrn:hDCOut )
ExtTextOut( oPrn:hDcOut,;
oCtrl:nTop,;
oCtrl:nLeft,;
oCtrl:GetText() )
oFont:DeActivate( oPrn:hDCOut )
oFont:End()
case oCtrl:ClassName() == "TBITMAP"
oPrn:SayBitmap( oCtrl:nTop,;
oCtrl:nLeft,;
oCtrl:cFileName, 80, 80 )
endcase
next
endif
ENDPAGE
ENDPRINTER
return nil
//-----------------------------------------------------------------------------------------//
static function EditDialog( nRow, nCol, oControl )
local oMenu
MENU oMenu POPUP
MENUITEM "Title..." ACTION NIL //EditTitle( oDlg )
SEPARATOR
MENUITEM "Add field" ACTION NIL
SEPARATOR
ENDMENU
endmenu
ACTIVATE POPUP oMenu WINDOW oControl AT nRow, nCol // SAVE
return nil
Antonio Linares wrote:Silvio,
You may multiply the width and height by some amount until they look as expected.
To create a INI file is very easy. You have examples in fivedit.prg, fivedbu.prg, etc
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: Google [Bot] and 42 guests