HarbourMiniGUI - Ejemplo de Tarifas (Jose Miguel

   ***crear fichero de datos para este ejemplo***
   IF .NOT. FILE("TARIFAS.DBF")
      aArq:={}
      Aadd( aArq , { 'CODTAR'    , 'C' , 10 , 0 } )
      Aadd( aArq , { 'NOMTAR'    , 'C' , 50 , 0 } )
      Aadd( aArq , { 'IMPORTE'   , 'N' , 13 , 2 } )
      DBCreate( "TARIFAS" , aArq )
      Use TARIFAS Alias TARIFAS new
      FOR N=1 TO 50
         APPEND BLANK
         REPLACE CODTAR WITH "E"+STRZERO(N,3)
         REPLACE NOMTAR WITH "Nombre articulo "+LTRIM(STR(N))
         REPLACE IMPORTE WITH N+1000
      NEXT
      TARIFAS->( DBCLOSEAREA() )
   ENDIF
   ***fin crear fichero de datos para este ejemplo***

   ***crear fichero indice para este ejemplo***
   IF .NOT. FILE("TARIFAS.CDX")
      FERASE('TARIFAS.CDX')
      Use TARIFAS Alias TARIFAS new shared
      Index on CODTAR TAG ORDEN1 to TARIFAS.CDX
      TARIFAS->( DBCLOSEAREA() )
   ENDIF
   ***fin crear fichero indice para este ejemplo***

Lis_TarCodigo()

procedure Lis_TarCodigo()
TituloImp:="Listado de tarifas"

   DEFINE WINDOW W_Imp1 ;
      AT 10,10 ;
      WIDTH 400 HEIGHT 275 ;
      TITLE 'Imprimir: '+TituloImp ;
      MAIN      ;
      ON RELEASE CloseTables()

      @ 15,10 LABEL L_CodTar1 ;
              VALUE 'Desde codigo' ;
              WIDTH 90 HEIGHT 25
      @ 10,100 TEXTBOX T_CodTar1 ;
              WIDTH 100 ;
              VALUE '' ;
              TOOLTIP 'Codigo tarifa' ;
              MAXLENGTH 10

      @ 45,10 LABEL L_CodTar2 ;
              VALUE 'Hasta codigo' ;
              WIDTH 90 HEIGHT 25
      @ 40,100 TEXTBOX T_CodTar2 ;
              WIDTH 100 ;
              VALUE 'ZZZZZZZZZZ' ;
              TOOLTIP 'Codigo tarifa' ;
              MAXLENGTH 10

      @ 70,10 CHECKBOX C_Cuadro ;
            CAPTION 'Imprimir cuadros en lineas' ;
            WIDTH 200 VALUE .F.

draw rectangle in window W_Imp1 at 110,010 to 112,390 fillcolor{255,0,0} //Rojo
      aIMP:=Impresoras("LISTADO")
      @125,10 LABEL L_Impresora ;
              VALUE 'Impresora' ;
              WIDTH 90 HEIGHT 25
      @120,100 COMBOBOX C_Impresora ;
            WIDTH 280 ;
            ITEMS aIMP[1] ;
            VALUE aIMP[3] ;
            TOOLTIP 'Impresora' NOTABSTOP

      @150, 10 CHECKBOX nImp CAPTION 'Seleccionar impresora' ;
               width 150 value .f. ;
               ON CHANGE W_Imp1.C_Impresora.Enabled:=IF(W_Imp1.nImp.Value=.T.,.F.,.T.)

@180, 10 CHECKBOX nVer CAPTION 'Previsualizar documento' ;
width 150 value .f.

@210, 10 BUTTON B_Imp CAPTION 'Imprimir' WIDTH 90 HEIGHT 25 ;
ACTION Lis_TarCodigoi("IMPRESORA")

@210,110 BUTTON B_Excel CAPTION 'Hoja excel' WIDTH 90 HEIGHT 25 ;
ACTION Lis_TarCodigoi("EXCEL")

@210,210 BUTTON B_Can CAPTION 'Cancelar' WIDTH 90 HEIGHT 25 ;
ACTION W_Imp1.release

      END WINDOW
      CENTER WINDOW W_Imp1
      ACTIVATE WINDOW W_Imp1

Return Nil

Function CloseTables()
   DBCOMMITALL()
   DBUNLOCKALL()
   CLOSE DATABASES
Return NIL

procedure Lis_TarCodigoi(LLAMADA)
   IF FILE("FIN.DBF")
      IF SELEC("FIN")<>0
         FIN->( DBCLOSEAREA() )
      ENDIF
      ERASE FIN.DBF
      ERASE FIN.CDX
   ENDIF

Use TARIFAS index TARIFAS Alias TARIFAS new shared

   SET FILTER TO
   COPY TO FIN FOR ;
   CODTAR>=W_Imp1.T_CodTar1.value .AND. CODTAR<=W_Imp1.T_CodTar1.value
   Use FIN Alias FIN new shared
   INDEX ON CODTAR TO FIN

   GO TOP
   IF LASTREC()=0
      MsgExclamation("No hay datos en las fecha introducidas","Informacion")
      FIN->( DBCLOSEAREA() )
      RETURN
   ENDIF

   IF LLAMADA="EXCEL"
      Lis_TarCodigoiE()
   ELSE
      Lis_TarCodigoiF()
   ENDIF

procedure Lis_TarCodigoiF(LLAMADA)
dirimp:=GetCurrentFolder()

   IF W_Imp1.nImp.value=.t.
      IF W_Imp1.nVer.value=.t.
         SELECT PRINTER GetPrinter() ORIENTATION PRINTER_ORIENT_PORTRAIT PREVIEW
      ELSE
         SELECT PRINTER GetPrinter() ORIENTATION PRINTER_ORIENT_PORTRAIT
      ENDIF
   ELSE
      IF W_Imp1.C_Impresora.ItemCount=0 .OR. ;
         W_Imp1.C_Impresora.Value<=0 .OR. ;
         W_Imp1.C_Impresora.Value>W_Imp1.C_Impresora.ItemCount
         MSGSTOP("No hay impresoras instaladas","Error")
         SetCurrentFolder(dirimp)
         RETURN
      ENDIF
      IF W_Imp1.nVer.value=.t.
         SELECT PRINTER W_Imp1.C_Impresora.Item(W_Imp1.C_Impresora.Value) ORIENTATION PRINTER_ORIENT_PORTRAIT PREVIEW
      ELSE
         SELECT PRINTER W_Imp1.C_Impresora.Item(W_Imp1.C_Impresora.Value) ORIENTATION PRINTER_ORIENT_PORTRAIT
      ENDIF
   ENDIF

START PRINTDOC NAME TituloImp
START PRINTPAGE

GO TOP
PAG:=0
LIN:=0
DO WHILE .NOT. EOF()
   IF LIN>=260 .OR. PAG=0
      IF PAG<>0
         @ LIN+5,105 PRINT "SIGUE EN LA HOJA: "+LTRIM(STR(PAG+1)) CENTER
         END PRINTPAGE
         START PRINTPAGE
      ENDIF
      PAG=PAG+1

      @ 20,20 PRINT "SUIZO ejemplos"
      @ 20,190 PRINT "Hoja: "+LTRIM(STR(PAG)) RIGHT
      @ 25,20 PRINT DATE()

@ 25,105 PRINT "Nombre de la empresa" CENTER
@ 35,105 PRINT TituloImp FONT "ft18" CENTER

@ 40,20 PRINT 'desde: '+W_Imp1.T_CodTar1.value
@ 45,20 PRINT 'hasta: '+W_Imp1.T_CodTar2.value

      LIN:=55
      IF W_Imp1.C_Cuadro.Value=.T.
         @ LIN, 19 PRINT RECTANGLE TO LIN+5, 39
         @ LIN, 39 PRINT RECTANGLE TO LIN+5,109
         @ LIN,109 PRINT RECTANGLE TO LIN+5,141
      ELSE
         @ LIN+4,20 PRINT LINE TO LIN+4,140
      ENDIF
      @ LIN,20 PRINT "Codigo"
      @ LIN,40 PRINT "Descripcion"
      @ LIN,140 PRINT "Importe" RIGHT

LIN:=LIN+5
ENDIF

   IF W_Imp1.C_Cuadro.Value=.T.
      @ LIN, 19 PRINT RECTANGLE TO LIN+5, 39
      @ LIN, 39 PRINT RECTANGLE TO LIN+5,109
      @ LIN,109 PRINT RECTANGLE TO LIN+5,141
   ENDIF
   @ LIN,20 PRINT CODTAR
   @ LIN,40 PRINT NOMTAR
   @ LIN,140 PRINT TRANSFORM( IMPORTE , "@E 9,999,999.99" ) RIGHT

LIN:=LIN+5
SKIP

ENDDO

SELEC FIN
FIN->( DBCLOSEAREA() )

   END PRINTPAGE
   END PRINTDOC
   SetCurrentFolder(dirimp)

W_Imp1.release

Return Nil

procedure Lis_TarCodigoiE(LLAMADA)
   LOCAL oExcel, oHoja
   oExcel := TOleAuto():New( "Excel.Application" )
   oExcel:WorkBooks:Add()
   oExcel:Sheets("Hoja1"):Name := "Listado"
*   oExcel:Sheets("Hoja2"):Name := "Resumen"
   oHoja := oExcel:Get( "ActiveSheet" )
   oHoja:Cells:Font:Name := "Arial"
   oHoja:Cells:Font:Size := 10

LIN:=8

oHoja:Cells( LIN, 1 ):Value := "Codigo"
oHoja:Cells( LIN, 1 ):HorizontalAlignment:= -4152 //Derecha
oHoja:Cells( LIN, 2 ):Value := "Descripcion"
oHoja:Cells( LIN, 3 ):Value := "Importe"
oHoja:Cells( LIN, 3 ):Set( "NumberFormat", "#.##0,00 €" )

oHoja:Range(CHR(64+1)+LTRIM(STR(LIN))+":"+CHR(64+3)+LTRIM(STR(LIN))):Font:Bold := .T.
oHoja:Range(CHR(64+1)+LTRIM(STR(LIN))+":"+CHR(64+3)+LTRIM(STR(LIN))):Interior:ColorIndex := 36 //sombrear celdas
oHoja:Range(CHR(64+1)+LTRIM(STR(LIN))+":"+CHR(64+3)+LTRIM(STR(LIN))):Borders(4):LineStyle:= 1 //linea inferior
oHoja:Range(CHR(64+1)+LTRIM(STR(LIN))+":"+CHR(64+3)+LTRIM(STR(LIN))):HorizontalAlignment := -4108 //Centrar

LIN++

PAG:=0
*LIN:=0
DO WHILE .NOT. EOF()

   oHoja:Cells( LIN, 1 ):Value := CODTAR
   oHoja:Cells( LIN, 2 ):Value := NOMTAR
   oHoja:Cells( LIN, 3 ):Value := IMPORTE
   oHoja:Cells( LIN, 3 ):Set( "NumberFormat", "#.##0,00" )

LIN++
SKIP

ENDDO

   oHoja:Cells( 1, 1 ):Value := "SUIZO ejemplos"
   oHoja:Cells( 2, 1 ):Value := DATE()
   oHoja:Cells( 4, 1 ):Value := 'desde:'
   oHoja:Cells( 4, 2 ):Value := W_Imp1.T_CodTar1.value
   oHoja:Cells( 5, 1 ):Value := 'hasta:'
   oHoja:Cells( 5, 2 ):Value := W_Imp1.T_CodTar2.value
   oHoja:Range("A1:B6"):HorizontalAlignment:= -4131 //Izquierda

   FOR nCol:=1 TO FCOUNT()
      oHoja:Columns( nCol ):AutoFit()
   NEXT

*Guardar como
*oHoja:SaveAs( TituloImp )

oHoja:Cells( 1, 1 ):Select()
oExcel:Visible := .T.

oHoja:End()
oExcel:End()

SELEC FIN
FIN->( DBCLOSEAREA() )

W_Imp1.release

Return Nil

procedure Impresoras(LLAMADA)
   aIMP1:=aPrinters()
   ASORT(aIMP1,,, { |x, y| UPPER(x) < UPPER(y) })
   aIMP2:=GetDefaultPrinter()
   aIMP3:=ASCAN(aIMP1, {|aVal| aVal == aIMP2})
   aIMP:={aIMP1,aIMP2,aIMP3}
RETURN(aIMP)

< Anterior		Siguiente >

[Volver]

Anuncios Google

Archivo: miniprint_list.prg