2013-06-19 07:43

     TYPE RECTA
      Left AS LONG
      Top AS LONG
      Right AS LONG
      Bottom AS LONG
     END TYPE
     CONST LVM_FIRST = &H1000
     CONST LVM_GETHEADER = (LVM_FIRST + 31)
     CONST HDM_FIRST = &H1200
     DIM r AS rectA
     DIM IDcolumn AS INTEGER
     DIM ccount AS INTEGER
     CONST bOK = 0
     CONST bOKCan = 1
     CONST bAbRetIg = 2
     CONST bYesNoCan = 3
     CONST bYesNo = 4
     CONST bRetCan = 5
     CONST iCritMsg = 16
     CONST iWarnQuery = 32
     CONST iWarnMsg = 48
     CONST iInfMsg = 64
     CONST dFst = 0
     CONST dSec = 256
     CONST dTrd = 512
     CONST dFth = 768


'$TYPECHECK ON
     $INCLUDE "rapidq.inc"
     $INCLUDE "APIs.inc"
     $INCLUDE "mysql.inc

'------- SUB & FORM DECLARATIONS -----------

Declare Function SendMessagea Lib ""user32 Alias ""SendMessageA (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As LONG) As Long
Declare Function GetWindowRect Lib ""user32 Alias ""GetWindowRect (ByVal hwnd As Long, lpRect As RECTA)AS Long
Declare Function GetParent Lib ""user32 Alias ""GetParent (ByVal hwnd As Long) As Long
Declare Function MsgDlg (MsgDlgText As String, MsgDlgTitle As String, MsgDlgButtons As Long) As Long
Declare Function MDlg Lib ""user32 Alias ""MessageBoxA (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long

DECLARE SUB OK(COLUMN%,s as qlistview)
DECLARE SUB BTNK
declare sub principio
declare sub registrosiguiente
declare sub registroanterior
declare sub ultimoregistro
declare sub busqueda
DECLARE SUB Finalizar
DECLARE SUB FillList
DECLARE SUB LoadEditFields
declare sub validardatos
DECLARE SUB AgregaRegistro
DECLARE SUB ModificaRegistro
DECLARE SUB BorraRegistro
Declare Function SetFocusAPI Lib ""user32 Alias ""SetFocus (hWnd As Long) As Long
Declare sub Limpiadatos

declare sub cargarlistview
Dim Columna as long
dim k as  integer
dim fuente as qfont
fuente.color=qbcolor(15)
DIM MySQL AS QMYSQL
DIM Host$ as STRING
DIM User$ as STRING
DIM Password$ as STRING
dim Fecha$ as string
dim rec as integer
dim bandera as integer
Function MsgDlg (MsgDlgText As String, MsgDlgTitle As String, MsgDlgButtons As Long) As Long
   Result = MDlg (Form.Handle,MsgDlgText,MsgDlgTitle,MsgDlgButtons)
End Function


CREATE Form AS QFORM
    Caption = "List of "Taxes
    Width = 788
    Height = 478
    Center
    CREATE Image1 AS QIMAGE
        BMP = "C:\RAPIDQ\bmp\Degradee."bmp
        Width = 750
        Height = 450
        Autosize=1
    END CREATE

   CREATE Label1 AS QLABEL
        Caption = ""Tax
        Font=fuente
        Transparent=1
        Left = 12
        Top = 245
        Width = 88
    END CREATE
    CREATE Label2 AS QLABEL
        Caption = ""Quota
        Font=fuente
        Left = 12
        Transparent=1
        Top = 275
        Width = 72
    END CREATE
    CREATE Label3 AS QLABEL
        Caption = "Expiration "Date
        Font=fuente
        Transparent=1
        Left = 12
        Top = 305
        Width = 88
    END CREATE
    CREATE Label4 AS QLABEL
        Caption = ""Amount
        Font=fuente
        Left = 12
        Transparent=1
        Top = 335
        Width = 88
    END CREATE
    CREATE Label5 AS QLABEL
        Caption = "Payment "Date
        Font=fuente
        Left = 12
        Transparent=1
        Top = 365
        Width = 78
    END CREATE
    CREATE Label6 AS QLABEL
        Caption = "Payment "Place
        Font=fuente
        Left = 12
        Transparent=1
        Top = 395
        Width = 78
    END CREATE
    CREATE Edit1 AS QEdit
        Color=14344934
        Text = ""
        Left = 116
        Top = 245
        Width = 257
        Charcase=1
        MaxLength = 40
        Taborder=1
    END CREATE
    CREATE Edit2 AS QEDIT
        Color=14344934
        Text = ""
        Left = 116
        Top = 275
        Charcase=1
        Width = 257
        TabOrder = 2
    END CREATE
    CREATE Edit3 AS QEDIT
        Color=14344934
        Text = ""
        Left = 116
        Top = 305
        Width = 257
        Charcase=1
        InputMask="##/##/"####
        TabOrder = 3
        'Onkeyup = tecla
    END CREATE
    CREATE Edit4 AS QEDIT
        Color=14344934
        Left = 116
        Top = 335
        Width = 257
        Charcase=1
        TabOrder = 4
    END CREATE
    CREATE Edit5 AS QEDIT
        Color=14344934
        Left = 116
        Top = 365
        Width = 257
        InputMask="##/##/"####
        Charcase=1
        TabOrder = 5
    END CREATE
    CREATE Edit6 AS QEDIT
        Color=14344934
        Text = ""
        Left = 116
        Top = 395
        width = 257
        MaxLength = 40
        Charcase=1
        Taborder=6
    END CREATE
    CREATE BtnOK AS QBUTTON
        Caption = "&"Exit
        BMP="\rapidq\bmp\salida."bmp
        Left = 650
        Top = 374
        Height = 50
        Width = 110
        OnClick = Finalizar
    END CREATE
    CREATE BtnAdd AS QButton
            Caption = ""ADD
            Bmp="\rapidq\bmp\ingresar."bmp
            Left = 470
            Top = 310
            Width = 110
            Height = 50
            OnClick = AgregaRegistro
        END CREATE
        CREATE BtnChange AS QButton
            Caption = ""MODIFY
            'Bmp="\rapidq\bmp\reintentar1."bmp
            Left = 650
            Top = 310
            Width = 110
            Height = 50
            OnClick = ModificaRegistro
        END CREATE
        CREATE BtnDelete AS QBUTTON
            Caption = ""ERASE
            'Bmp="\rapidq\bmp\BORRAR1."bmp
            Left = 650
            Top = 245
            Width = 110
            Height = 50
            OnClick = BorraRegistro
        END CREATE
        CREATE primero AS QBUTTON
            Caption = ""
            Bmp="\rapidq\bmp\primero."bmp
            Left = 470
            Top = 245
            Showhint=1
            Hint="First "Registry
            Width = 30
            Height = 50
            OnClick = Principio
        END CREATE
        CREATE anterior AS QBUTTON
            Caption = ""
            Bmp="\rapidq\bmp\anterior."bmp
            Left = 510
            Top = 245
            Showhint=1
            Hint="Previous "Registry
            Width = 30
            Height = 50
            OnClick = RegistroAnterior
        END CREATE
        CREATE posterior AS QBUTTON
            Caption = ""
            Bmp="\rapidq\bmp\posterior."bmp
            Left = 550
            Top = 245
            Showhint=1
            Hint="NEXT "Registry
            Width = 30
            Height = 50
            OnClick = RegistroSiguiente
        END CREATE
        CREATE ultimo AS QBUTTON
            Caption = ""
            Bmp="\rapidq\bmp\ultimo."bmp
            Left = 590
            Showhint=1
            Hint="Last "Registry
            Top = 245
            Width = 30
            Height = 50
            OnClick = UltimoRegistro
        END CREATE
        CREATE Imprimir AS QButton
            Caption = ""Print
            Bmp="\rapidq\bmp\impresora."bmp
            Left = 470
            Top = 374
            Width = 110
            Height = 50
        END CREATE

CREATE ListView AS QListView
        Top=16
        Left=10
        HideSelection=0
        Width=750
        Height=200
        ViewStyle=vsReport
        showcolumnheaders=1
        Color=14344934
        AddColumns ""Id_Tax,""Tax,""Quota,""Expiration_Date,""Amount,""Payment_Date,""Payment_Place
        Column(0).Width=50
        Column(1).Width=200
        Column(2).Width=65
        Column(3).Width=100
        Column(4).Width=70
        Column(5).Width=100
        Column(6).Width=180
        Multiselect=True
        Gridlines=True
        Rowselect=True
        OnClick=LoadEditFields
        ONCOLUMNCLICK=OK
    END CREATE
END CREATE

'--------- INITIALISATION ---------------

Host$=""
User$=""
Password$=""
MySQL.Connect(Host$,User$,Password$)
IF MySQL.Connected THEN
    cargarListview
ELSE
    Form.Caption="No Conection TO a "Server
    END
End IF
Form.ShowModal


SUB LoadEditFields(A$)
    dim Puntero$ as string
    MySQL.SelectDB(""Taxes)
    DIM x AS INTEGER
    DIM a$ AS STRING
    Puntero$ = ListView.Item(Listview.ItemIndex).Caption
    if MySQL.Query("SELECT * from datos WHERE Id_Tax = '" + Puntero$ + "'") = 0 THEN
     SHOWMESSAGE("Don't call the Registry")
     EXIT SUB
     ELSE
      WHILE MySQL.FetchRow
       MySQL.FieldSeek(0)
       validardatos
       SetFocus(edit1.handle)
      WEND
     END IF
     END SUB

     SUB AgregaRegistro
'   MySQL.SelectDB("Taxes")
      bandera=0
      IF bandera =1 THEN
       limpiadatos
       setfocus(Edit1.handle)
       EXIT SUB
      END IF
      IF Edit1.text="" THEN
       SHOWMESSAGE "Don't Add with blanck"
       setfocus(edit1.handle)
       EXIT SUB
      END IF
      IF MySQL.Query ("Insert into datos(Tax,Quota,Expiration_Date,Amount,Payment_Date,Payment_Place) values ('" + Edit1.Text + "','" + Edit2.Text + "','" + Edit3.Text + "','" + Edit4.Text + "','" + Edit5.Text + "','" + Edit6.Text + "')") =0 THEN
       SHOWMESSAGE("Failed to write register")
      ELSE
       LimpiaDatos
       cargarListview
      END IF

     END SUB

     SUB ModificaRegistro
      IF MySQL.Query ("Update datos SET Tax= '" + Edit1.Text + "',_
                   Quota='" + Edit2.Text + "',_
                   Expiration_Date='" + Edit3.Text + "',_
                   Amount='" + Edit4.Text + "',_
                   Payment_Date='" + Edit5.Text + "',_
                   Payment_Place='" + Edit6.Text + "' where Id_Tax='" + Listview.Item(Listview.ItemIndex).CAPTION+ "'") =0 THEN
      SHOWMESSAGE("Error al realizar la modificación")
     ELSE
      CargarListview
     END IF
     END SUB

     SUB BorraRegistro
      opcion=0
      opcion=MsgDlg ("Sure to erase this "+ Edit1.text,"Eliminated a Register",1+16+0)
      SELECT CASE opcion
      CASE 1
       segundaopcion=MsgDlg ("Sure ? "+ Edit1.text,"Segunda Opcion Para Eliminar un Proveedor",1+16+0)
       SELECT CASE segundaopcion
       CASE 1
        IF MySQL.Query("DELETE from datos WHERE Tax = '" + Edit1.text + "'") = 0 THEN
         SHOWMESSAGE("I don't erase")
        END IF
       CASE 2
        Limpiadatos
        cargarlistview
        SetFocus(Edit1.handle)
       END SELECT
      CASE 2
       CargarListview
       Limpiadatos
       SetFocus(Edit1.handle)
      END SELECT
     END SUB

     SUB Limpiadatos
      Edit1.Text=""
      Edit2.Text=""
      Edit3.Text=""
      Edit4.Text=""
      Edit5.Text=""
      Edit6.Text=""
     END SUB

     SUB validardatos
      Edit1.Text=MySQL.Row(1)
      Edit2.Text=MySQL.Row(2)
      Edit3.Text=MySQL.Row(3)
      Edit4.Text=MySQL.Row(4)
      Edit5.Text=MySQL.Row(5)
      Edit6.Text=MySQL.Row(6)

     END SUB

     SUB Finalizar(sender AS QBUTTON)

      Resultado=MsgDlg ("Cancel this Job ?","Your Option",1+16+0)
      SELECT CASE resultado
       CASE=1
       MySQL.CLOSE
       END
       CASE=2
       setfocus(Edit1.handle)
      END SELECT
     END SUB

     SUB principio
      rec=1
      IF MySQL.Query("SELECT * from datos WHERE id_Tax="+STR$(rec))=0 THEN
       SHOWMESSAGE("I don't call the registry")
       EXIT SUB
      ELSE
       WHILE MySQL.FetchRow
        MySQL.FieldSeek(0)
        validardatos
        SetFocus(edi2.handle)
       WEND
      END IF
     END SUB

     SUB ultimoregistro
      MySQL.Query("Select Count(*) from datos")
      MySQL.FetchRow
      MySQL.FieldSeek(0)
      rec = VAL(MySQL.Row(0))
      IF MySQL.Query("SELECT * from datos WHERE id_Tax="+STR$(rec))=0 THEN
       SHOWMESSAGE("I don't call the registry")
       EXIT SUB
      ELSE
       WHILE MySQL.FetchRow
        MySQL.FieldSeek(0)
        validardatos
        SetFocus(edi2.handle)
       WEND
      END IF
     END SUB

     SUB registrosiguiente
      DIM ultimo AS INTEGER
      MySQL.Query("Select Count(*) from datos")
      MySQL.FetchRow
      MySQL.FieldSeek(0)
      ultimo = VAL(MySQL.Row(0))
      rec=rec+1
      IF rec>ultimo THEN rec=ultimo
      IF MySQL.Query("SELECT * from datos WHERE id_Tax="+STR$(rec))=0 THEN
       SHOWMESSAGE("I don't call the registry")
       EXIT SUB
      ELSE
       WHILE MySQL.FetchRow
        MySQL.FieldSeek(0)
        validardatos
        SetFocus(edi2.handle)
       WEND
      END IF

     END SUB

     SUB registroanterior
      rec=rec-1
      IF rec<1 THEN rec=1
      IF MySQL.Query("SELECT * from datos WHERE id_Tax="+STR$(rec))=0 THEN
       SHOWMESSAGE("I don't call the registry")
       EXIT SUB
      ELSE
       WHILE MySQL.FetchRow
        MySQL.FieldSeek(0)
        validardatos
        SetFocus(edi2.handle)
       WEND
      END IF
     END SUB

     SUB OK(COLUMN%,s AS QLISTVIEW)
      DEFINT mx,my,i,cw,lvh,cc,hh,parw
      mx=screen.MOUSEX
      my=screen.MOUSEY
      lvh=ListView.Handle
      hh=sendMESSAGEa(lvh, (LVM_GETHEADER),0,0)'get handler of header
      ccount=sendMESSAGEa(hh, (HDM_FIRST + 0),0,0 )'get number of columns
      parw=getparent(lvh)
      getWINDOWrect(parw,R)
      cc=0:cw=0
      FOR i=0 TO ccount-1
       cw=s.column(i).width
       cc=cw+cc
       IF s.left+cc+R.left>mx THEN EXIT FOR
      NEXT
      idcolumn=i+
      parametro$=s.column(idcolumn).CAPTION
      MySQL.SelectDB("Taxes")
      MySQL.Query("SELECT * FROM datos ORDER BY "+ Parametro$ +";")
      j=0
      i=0
      Listview.clear
      WHILE MySQL.FetchRow
       MySQL.FieldSeek(0)
       ListView.Additems MySQL.Row(0)
       j=1
       DO
        ListView.Addsubitem i, MySQL.Row(j)
        j++
       LOOP UNTIL j>MySQL.ColCount-1
       i++
      WEND
     END SUB

     SUB cargarlistview
      MySQL.SelectDB("Taxes")
      MySQL.Query("SELECT * from Datos order by Expiration_Date")
      DIM j AS INTEGER
      DIM i AS INTEGER
      j=0
      i=0
      Listview.clear
      WHILE MySQL.FetchRow
       MySQL.FieldSeek(0)
       Listview.Additems MySQL.Row(0)
       j=1
       DO
        ListView.Addsubitem i,MySQL.Row(j)
        j++
       LOOP UNTIL j>MySQL.ColCount-1
       i++
      WEND
     END SUB

2013-06-19 07:43