CREATE CURSOR CrTestSonuc (Deger n (4,2),h1 n(2),h2 n(2),h3 n(2),h4 n(2),h5 n(2),h6 n(2),h7 n(2),h8 n(2),h9 n(2))

INSERT INTO CrTestSonuc (deger,h1) values(44.4,1)

INSERT INTO CrTestSonuc (deger,h2) values(44.4,1)

INSERT INTO CrTestSonuc (deger,h3) values(24.0,1)

INSERT INTO CrTestSonuc (deger,h4) values(22.2,1)

INSERT INTO CrTestSonuc (deger,h4) values(22.2,2)

INSERT INTO CrTestSonuc (deger,h3) values(20.0,2)

INSERT INTO CrTestSonuc (deger,h5) values(19.2,1)

INSERT INTO CrTestSonuc (deger,h5) values(17.8,2)

INSERT INTO CrTestSonuc (deger,h6) values(16.7,1)

INSERT INTO CrTestSonuc (deger,h6) values(15.6,2)

INSERT INTO CrTestSonuc (deger,h5) values(6.0,3)

INSERT INTO CrTestSonuc (deger,h6) values(5.6,3)

INSERT INTO CrTestSonuc (deger,h6) values(4.4,4)

INSERT INTO CrTestSonuc (deger,h7) values(3.3,1)

INSERT INTO CrTestSonuc (deger,h7) values(3.3,2)

* All sizes in inches

ooo = NEWOBJECT("AddPrinterForm", "AddPrinterForm.fxp")

IF NOT ooo.AddForm("MyCustomForm1", 5,7, lcPrinterName)

    ? ooo.cErrorMessage

    ? ooo.cApiErrorMessage 

  * Error

ENDIF

 

*!*    * Delete just created form

*!*    ooo = NEWOBJECT("AddPrinterForm", "AddPrinterForm.fxp")

*!*    IF NOT ooo.DeleteForm("MyCustomForm1", lcPrinterName)

*!*        ? ooo.cErrorMessage

*!*        ? ooo.cApiErrorMessage 

*!*      * Error

*!*    ENDIF

 

 

* All sizes in cm

ooo = NEWOBJECT("AddPrinterForm", "AddPrinterForm.fxp", "", "Metric")

IF NOT ooo.AddForm("MyCustomForm2", 15,17, lcPrinterName)

  * Error

ENDIF

 

*!*    * Delete just created form

*!*    ooo = NEWOBJECT("AddPrinterForm", "AddPrinterForm.fxp")

*!*    IF NOT ooo.DeleteForm("MyCustomForm2", lcPrinterName)

*!*        ? ooo.cErrorMessage

*!*        ? ooo.cApiErrorMessage 

*!*      * Error

*!*    ENDIF

 

* AddPrinterForm.prg

DEFINE CLASS AddPrinterForm AS Custom

 

    HIDDEN cUnit, cPrinterName, nFormHeight, nFormWidth, nLeftMargin, ;

              nTopMargin, nRightMargin, nBottomMargin, nInch2mm, nCm2mm, nCoefficient, hHeap

 

    cUnit = "English"        && inches or Metric - cm's

    cPrinterName = ""

    nFormHeight = 0

    nFormWidth = 0

    nLeftMargin = 0

    nTopMargin = 0

    nRightMargin = 0

    nBottomMargin = 0

 

    cApiErrorMessage = ""

    cErrorMessage = ""

 

    nInch2mm = 25.4

    nCm2mm = 10

    nCoefficient = This.nInch2mm * 1000

 

    hHeap = 0

 

    * Win API support class

    oWas = NULL

 

    PROCEDURE Init(tcUnit)

    This.oWas = NEWOBJECT("WinApiSupport", "WinApiSupport.fxp")

    IF PCOUNT() = 1 

        This.cUnit = PROPER(tcUnit)

    ENDIF

    This.LoadApiDlls()

    This.hHeap = HeapCreate(0, 4096, 0)

    * Use Windows default printer

    This.cPrinterName = SET("Printer",2)

    ENDPROC

 

    PROCEDURE cUnit_Assign(tcUnit)

    IF INLIST(tcUnit, "English", "Metric")

        This.cUnit = PROPER(tcUnit)

    ELSE

        RETURN    

    ENDIF

    * Calculate conversion coefficient

    This.nCoefficient = IIF(PROPER(This.cUnit) = "English", ;

                        This.nInch2mm, This.nCm2mm) * 1000

    ENDPROC

 

    PROCEDURE Destroy

    IF This.hHeap <> 0

        HeapDestroy(This.hHeap)

    ENDIF

 

    ENDPROC

 

    PROCEDURE SetFormMargins(tnLeft, tnTop, tnRight, tnBottom)

    WITH This

        .nLeftMargin     = tnLeft   * .nCoefficient

        .nTopMargin     = tnTop    * .nCoefficient

        .nRightMargin     = tnRight  * .nCoefficient

        .nBottomMargin     = tnBottom * .nCoefficient

    ENDWITH

    ENDPROC

 

    PROCEDURE AddForm(tcFormName, tnWidth, tnHeight, tcPrinterName)

    LOCAL lhPrinter, llOK, lcForm

 

    This.nFormWidth  = tnWidth  * This.nCoefficient

    This.nFormHeight = tnHeight * This.nCoefficient

    IF PCOUNT() > 3

        This.cPrinterName = tcPrinterName

    ENDIF

 

    This.ClearErrors()

    lhPrinter = 0

    IF OpenPrinter(This.cPrinterName, @lhPrinter, 0) = 0

        This.cErrorMessage = "Unable to get printer handle for " + This.cPrinterName 

        This.cApiErrorMessage = WinApiErrMsg(GetLastError())

        RETURN .F.

    ENDIF

 

    lnFormName = HeapAlloc(This.hHeap, 0, LEN(tcFormName) + 1)

    = SYS(2600, lnFormName, LEN(tcFormName) + 1, tcFormName + CHR(0))

 

    * Build FORM_INFO_1 structure

    WITH This.oWas

        lcForm = .Num2Long(0) + .Num2Long(lnFormName) + ;

            .Num2Long(This.nFormWidth) + .Num2Long(This.nFormHeight) + ;

            .Num2Long(This.nLeftMargin) + .Num2Long(This.nTopMargin) + ;

            .Num2Long(This.nFormWidth - This.nRightMargin) + ;

            .Num2Long(This.nFormHeight - This.nBottomMargin)

    ENDWITH

 

    * Finally, call the API

    IF AddForm(lhPrinter, 1, @lcForm) = 0

        This.cErrorMessage = "Unable to Add Form " + tcFormName 

        This.cApiErrorMessage = STRTRAN(WinApiErrMsg(GetLastError()), "file", "form", -1, -1, 3)

        llOK = .F.

    ELSE

        llOK = .T.

    ENDIF

    = HeapFree(This.hHeap, 0, lnFormName)

    = ClosePrinter(lhPrinter)

 

    RETURN llOK

 

    PROCEDURE ClearErrors

    This.cErrorMessage = ""

    This.cApiErrorMessage = ""

    ENDPROC

 

    PROCEDURE DeleteForm(tcFormName, tcPrinterName)

    LOCAL lhPrinter, llOK

 

    IF PCOUNT() > 1

        This.cPrinterName = tcPrinterName

    ENDIF

 

    This.ClearErrors()

    lhPrinter = 0

    IF OpenPrinter(This.cPrinterName, @lhPrinter, 0) = 0

        This.cErrorMessage = "Unable to get printer handle for " + This.cPrinterName + "."

        This.cApiErrorMessage = WinApiErrMsg(GetLastError())

        RETURN .F.

    ENDIF

 

    * Finally, call the API

    llOK = ( DeleteForm(lhPrinter, tcFormName) <> 0 )

    IF NOT llOK 

        This.cErrorMessage = "Unable to delete Form " + tcFormName 

        This.cApiErrorMessage = STRTRAN(WinApiErrMsg(GetLastError()), "file", "form", -1, -1, 3)

    ENDIF

    = ClosePrinter(lhPrinter)

    RETURN llOK

 

    HIDDEN PROCEDURE LoadApiDlls

        DECLARE Long HeapCreate IN WIN32API Long dwOptions, Long dwInitialSize, Long dwMaxSize

        DECLARE Long HeapAlloc IN WIN32API Long hHeap, Long dwFlags, Long dwBytes

        DECLARE Long HeapFree IN WIN32API Long hHeap, Long dwFlags, Long lpMem

        DECLARE HeapDestroy IN WIN32API Long hHeap

        DECLARE Long GetLastError IN kernel32

    ENDPROC

 

ENDDEFINE

*----------------------------------------------------------------------------------------------

 

FUNCTION OpenPrinter(tcPrinterName, thPrinter, tcDefault)

DECLARE Long OpenPrinter IN WinSpool.Drv ;

    String pPrinterName, Long @ phPrinter, String pDefault

RETURN     OpenPrinter(tcPrinterName, @thPrinter, tcDefault)

 

FUNCTION ClosePrinter (thPrinter)

DECLARE Long ClosePrinter IN WinSpool.Drv Long hPrinter

RETURN ClosePrinter(thPrinter)

 

 

FUNCTION AddForm(thPrinter, tnLevel, tcForm)

DECLARE Long AddForm IN winspool.drv Long hPrinter, Long Level, String @pForm

RETURN AddForm(thPrinter, tnLevel, tcForm)

 

FUNCTION DeleteForm(thPrinter, tcForm)

DECLARE Long DeleteForm IN winspool.drv Long hPrinter, String  pFormName 

RETURN DeleteForm(thPrinter, tcForm)

WITH thisform.moverlistx1

.sourceSQL = "crsckod.ckod,firma.firma FROM crsckod,firma WHERE crsckod.ckod==firma.ckod  INTO CURSOR crsSF"

ENDWITH

SET DECIMAL TO 2

SET FIXED ON   && veya OFF, farketmiyor

...

...

nKurus = .nToplamYTL.VALUE - INT(.nToplamYTL.VALUE)    && burda INT dogru sonucu veriyor

IF nKurus > 0    && burda nKurus 0,47

  nKurus = INT(nKurus  * 100)    && 47 yerine 46 veriyor

  ... 

  ...

ENDIF

*!* Author Cetin BASOZ

Public oForm

oForm = Createobject('myForm')

oForm.Show()

 

Define Class myForm As Form

  Height = 450

  Width = 850

  DataSession=2

  Caption='Show Access Data'

 

  Add Object lblAccess As Label With ;

    Caption = "Access Database", ;

    Left = 10, Top = 15, Width = 100

 

  Add Object txtMDBlocation As TextBox With ;

    Left = 112, Top = 12, Width = 520

 

  Add Object cmdBrowse As CommandButton With ;

    Top = 10, Left = 640, Caption = "Browse", Autosize=.t.

 

  Add Object lblTables As Label With ;

    Caption = "Tables", Left = 20, Top = 40, Width = 40

 

  Add Object lstTables As ListBox With ;

    Height = 400, Left = 65, Top = 40, Width = 265

 

  Add Object grdShow As Grid With ;

    Height = 400, Left = 340, Top = 40, Width = 500

 

  Procedure listtables

    Local lnConnHandle,lcMDB

    With This.txtMDBlocation

      If Empty(.Value) Or !File(.Value)

        Return

      Endif

      lcMDB = Trim(.Value)

    Endwith

 

    lnConnHandle = ;

     Sqlstringconnect("Driver={Microsoft Access Driver (*.mdb)};"+;

                     "Uid=Admin;DBQ="+m.lcMDB)

    SQLTABLES(m.lnConnHandle, ['TABLE'], 'crsTables')

    SQLDISCONNECT(m.lnConnHandle)

    Select crsTables

    This.lstTables.Clear()

    Scan

      This.lstTables.AddItem(crsTables.table_name)

    Endscan

  Endproc

 

 

  Procedure txtMDBlocation.LostFocus

    Thisform.listtables()

  Endproc

 

 

  Procedure cmdBrowse.Click

    This.Parent.txtMDBlocation.Value = Getfile('MDB','','',0,'Select Access Database')

    Thisform.listtables()

  Endproc

 

 

  Procedure lstTables.InteractiveChange

    Local lnConnHandle,lcMDB,lcSQL

    With This.Parent.txtMDBlocation

      If Empty(.Value) Or !File(.Value)

        Return

      Endif

      lcMDB = Trim(.Value)

    Endwith

 

    lcSQL = 'select * from "'+Trim(This.Value)+'"'

    lnConnHandle = ;

     Sqlstringconnect("Driver={Microsoft Access Driver (*.mdb)};"+;

                     "Uid=Admin;DBQ="+m.lcMDB)

    SQLEXEC(m.lnConnHandle,m.lcSQL,'crsLocal')

    SQLDISCONNECT(m.lnConnHandle)

    With This.Parent.grdShow

      .ColumnCount = -1

      .RecordSource = 'crsLocal'

    Endwith

  Endproc

Enddefine