VFP 愛用者社區 首頁 VFP 愛用者社區
本討論區為 Visual Foxpro 愛用者經驗交流的地方, 請多多利用"搜尋"的功能, 先查看看有無前例可循, 如果還有不懂的再發問. 部份主題有附加檔案, 須先註冊成為社區居民才可以下載.
 
 常見問題常見問題   搜尋搜尋   會員列表會員列表   會員群組會員群組   會員註冊會員註冊 
 個人資料個人資料   登入檢查您的私人訊息登入檢查您的私人訊息   登入登入

如何新增/刪除自訂報表格式(轉貼)

 
發表新主題   回覆主題    VFP 愛用者社區 首頁 -> VFP 討論區
上一篇主題 :: 下一篇主題  
發表人 內容
Ruey



註冊時間: 2003-03-12
文章: 1698
來自: tunglo

第 1 樓

發表發表於: 星期四 十二月 11, 2003 10:33 pm    文章主題: 如何新增/刪除自訂報表格式(轉貼) 引言回覆

http://www.universalthread.com/wconnect/wc.dll?FournierTransformation~2,84,14,21202
代碼:

* All sizes in inches
ooo = NEWOBJECT("AddPrinterForm", "AddPrinterFormClass.fxp")
IF NOT ooo.AddForm("MyCustomForm1", 5,7, "EPSON Stylus C82 Series")
   ? ooo.cErrorMessage
   ? ooo.cApiErrorMessage
  * Error
ENDIF
ooo = Null
*RETURN
* All sizes in cm
ooo = NEWOBJECT("AddPrinterForm", "AddPrinterFormClass.fxp", "", "Metric")
IF NOT ooo.AddForm("MyCustomForm2", 15,17, "EPSON Stylus C82 Series")
  * Error
ENDIF
ooo = Null

ooo = NEWOBJECT("AddPrinterForm", "AddPrinterFormClass.fxp")
IF NOT ooo.DeleteForm("MyCustomForm1", "EPSON Stylus C82 Series")
   ? ooo.cErrorMessage
   ? ooo.cApiErrorMessage
  * Error
ENDIF



*AddPrinterFormClass.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

   nApiErrorCode = 0
   cApiErrorMessage = ""
   cErrorMessage = ""

   nInch2mm = 25.4
   nCm2mm = 10
   nCoefficient = 0

   hHeap = 0

   PROCEDURE Init(tcUnit)
   IF PCOUNT() = 1 AND INLIST(tcUnit, "English", "Metric")
      This.cUnit = PROPER(tcUnit)
   ENDIF
   This.LoadApiDlls()
   This.hHeap = HeapCreate(0, 4096, 0)
   * Use Windows default printer
   This.cPrinterName = SET("Printer",2)
   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, llSuccess, 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.nApiErrorCode = GetLastError()
      This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode)
      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
      lcForm = This.Num2LOng(0) + ;      && Flags
      This.Num2LOng(lnFormName) + ;
         This.Num2LOng(.nFormWidth) + ;
         This.Num2LOng(.nFormHeight) + ;
         This.Num2LOng(.nLeftMargin) + ;
         This.Num2LOng(.nTopMargin) + ;
         This.Num2LOng(.nFormWidth - .nRightMargin) + ;
         This.Num2LOng(.nFormHeight - .nBottomMargin)
   ENDWITH

   * Finally, call the API
   IF AddForm(lhPrinter, 1, @lcForm) = 0
      This.cErrorMessage = "Unable to Add Form '" + tcFormName + "'."
      This.nApiErrorCode = GetLastError()
      This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode)
      llSuccess = .F.
   ELSE
      llSuccess = .T.
   ENDIF
   = HeapFree(This.hHeap, 0, lnFormName)
   = ClosePrinter(lhPrinter)

   RETURN llSuccess

   PROCEDURE ClearErrors
   This.cErrorMessage = ""
   This.nApiErrorCode = 0
   This.cApiErrorMessage = ""
   ENDPROC

   PROCEDURE DeleteForm(tcFormName, tcPrinterName)
   LOCAL lhPrinter, llSuccess

   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.nApiErrorCode = GetLastError()
      This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode)
      RETURN .F.
   ENDIF

   * Finally, call the API
   IF DeleteForm(lhPrinter, tcFormName) = 0
      This.cErrorMessage = "Unable to delete Form '" + tcFormName + "'."
      This.nApiErrorCode = GetLastError()
      This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode)
      llSuccess = .F.
   ELSE
      llSuccess = .T.
   ENDIF
   = ClosePrinter(lhPrinter)
   RETURN llSuccess

   FUNCTION Num2LOng(tnNum)
   DECLARE RtlMoveMemory IN WIN32API AS RtlCopyLong ;
      STRING @Dest, Long @Source, Long Length
   LOCAL lcString
   lcString = SPACE(4)
   =RtlCopyLong(@lcString, BITOR(tnNum,0), 4)
   RETURN lcString
   ENDFUNC

   FUNCTION Long2Num(tcLong)
   DECLARE RtlMoveMemory IN WIN32API AS RtlCopyNum ;
      Long @Dest, String @Source, Long Length
   LOCAL lnNum
   lnNum = 0
   = RtlCopyNum(@lnNum, tcLong, 4)
   RETURN lnNum
   ENDFUNC

   HIDDEN PROCEDURE ApiErrorText
      LPARAMETERS tnErrorCode
      Local lcErrBuffer
      lcErrBuffer = REPL(CHR(0),1024)
      = FormatMessage(0x1000 ,.NULL., tnErrorCode, 0, @lcErrBuffer, 1024,0)
      RETURN STRTRAN(LEFT(lcErrBuffer, AT(CHR(0),lcErrBuffer)- 1 ), ;
                         "file", "form", -1, -1, 3)

      ENDPROC

   HIDDEN PROCEDURE LoadApiDlls
      DECLARE INTEGER OpenPrinter IN winspool.drv;
         STRING  pPrinterName,;
         INTEGER @phPrinter,;
         INTEGER pDefault
      DECLARE INTEGER ClosePrinter IN winspool.drv;
         INTEGER hPrinter
      DECLARE INTEGER AddForm IN winspool.drv;
         INTEGER hPrinter,;
         INTEGER LEVEL,;
         STRING  @pForm
      DECLARE INTEGER DeleteForm IN winspool.drv;
         INTEGER hPrinter,;
         STRING  pFormName
      DECLARE INTEGER HeapCreate IN Win32API;
         INTEGER dwOptions, INTEGER dwInitialSize,;
         INTEGER dwMaxSize
      DECLARE INTEGER HeapAlloc IN Win32API;
         INTEGER hHeap, INTEGER dwFlags, INTEGER dwBytes
      DECLARE lstrcpy IN Win32API;
         STRING @lpstring1, INTEGER lpstring2
      DECLARE INTEGER HeapFree IN Win32API;
         INTEGER hHeap, INTEGER dwFlags, INTEGER lpMem
      DECLARE HeapDestroy IN Win32API;
         INTEGER hHeap
      DECLARE INTEGER GetLastError IN kernel32
      Declare Integer FormatMessage In kernel32.dll ;
         Integer dwFlags, String @lpSource, ;
         Integer dwMessageId, Integer dwLanguageId, ;
         String @lpBuffer, Integer nSize, Integer Arguments

      ENDPROC

ENDDEFINE

_________________
#############################
快樂媽咪系列幸福宅配,喝十全雞湯~原來幸福那麼簡單!!

學會VFP使用者社區的搜尋,Code才會更有趣~
#############################
回頂端
檢視會員個人資料 發送私人訊息
richshih



註冊時間: 2007-10-11
文章: 153


第 2 樓

發表發表於: 星期一 十二月 01, 2008 4:04 pm    文章主題: 引言回覆

請問本程式中的MyCustomForm1 & MyCustomForm2 須帶入什麼??
回頂端
檢視會員個人資料 發送私人訊息
syntech



註冊時間: 2003-05-16
文章: 4211
來自: Taipei,Taiwan

第 3 樓

發表發表於: 星期四 五月 24, 2018 9:55 am    文章主題: 引言回覆

勘誤一下.
這是"新增/刪除自訂報表格式"的程式,不是 "新增印表機"的程式.
"MyCustomForm1","MyCustomForm2" 就是 自訂格式的名稱.
"EPSON Stylus C82 Series" 是指定印表機,一定要先建立.
但測試之後,在印表機內容中不會自動設定為預設格式,
是否只是單純建立自定格式要再測試一下.

執行步驟:

主程式: 可以存檔為 ADD_PRTFORM.PRG
代碼:

* 建立新報表格式 MyCustomForm1 ,5"X7"
* All sizes in inches
ooo = NEWOBJECT("AddPrinterForm", "AddPrinterFormClass.fxp")
IF NOT ooo.AddForm("MyCustomForm1", 5,7, "EPSON Stylus C82 Series")
? ooo.cErrorMessage
? ooo.cApiErrorMessage
* Error
ENDIF
ooo = Null
*RETURN

* 建立新報表格式 MyCustomForm2 ,15cm X 17cm
* All sizes in cm
ooo = NEWOBJECT("AddPrinterForm", "AddPrinterFormClass.fxp", "", "Metric")
IF NOT ooo.AddForm("MyCustomForm2", 15,17, "EPSON Stylus C82 Series")
* Error
ENDIF
ooo = Null

* 刪除報表格式 MyCustomForm1
ooo = NEWOBJECT("AddPrinterForm", "AddPrinterFormClass.fxp")
IF NOT ooo.DeleteForm("MyCustomForm1", "EPSON Stylus C82 Series")
? ooo.cErrorMessage
? ooo.cApiErrorMessage
* Error
ENDIF



函式: 一定要叫做 AddPrinterFormClass.prg ,編譯後才會是 AddPrinterFormClass.FXP
代碼:

*AddPrinterFormClass.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

nApiErrorCode = 0
cApiErrorMessage = ""
cErrorMessage = ""

nInch2mm = 25.4
nCm2mm = 10
nCoefficient = 0

hHeap = 0

PROCEDURE Init(tcUnit)
IF PCOUNT() = 1 AND INLIST(tcUnit, "English", "Metric")
This.cUnit = PROPER(tcUnit)
ENDIF
This.LoadApiDlls()
This.hHeap = HeapCreate(0, 4096, 0)
* Use Windows default printer
This.cPrinterName = SET("Printer",2)
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, llSuccess, 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.nApiErrorCode = GetLastError()
This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode)
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
lcForm = This.Num2LOng(0) + ;   && Flags
This.Num2LOng(lnFormName) + ;
This.Num2LOng(.nFormWidth) + ;
This.Num2LOng(.nFormHeight) + ;
This.Num2LOng(.nLeftMargin) + ;
This.Num2LOng(.nTopMargin) + ;
This.Num2LOng(.nFormWidth - .nRightMargin) + ;
This.Num2LOng(.nFormHeight - .nBottomMargin)
ENDWITH

* Finally, call the API
IF AddForm(lhPrinter, 1, @lcForm) = 0
This.cErrorMessage = "Unable to Add Form '" + tcFormName + "'."
This.nApiErrorCode = GetLastError()
This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode)
llSuccess = .F.
ELSE
llSuccess = .T.
ENDIF
= HeapFree(This.hHeap, 0, lnFormName)
= ClosePrinter(lhPrinter)

RETURN llSuccess

PROCEDURE ClearErrors
This.cErrorMessage = ""
This.nApiErrorCode = 0
This.cApiErrorMessage = ""
ENDPROC

PROCEDURE DeleteForm(tcFormName, tcPrinterName)
LOCAL lhPrinter, llSuccess

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.nApiErrorCode = GetLastError()
This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode)
RETURN .F.
ENDIF

* Finally, call the API
IF DeleteForm(lhPrinter, tcFormName) = 0
This.cErrorMessage = "Unable to delete Form '" + tcFormName + "'."
This.nApiErrorCode = GetLastError()
This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode)
llSuccess = .F.
ELSE
llSuccess = .T.
ENDIF
= ClosePrinter(lhPrinter)
RETURN llSuccess

FUNCTION Num2LOng(tnNum)
DECLARE RtlMoveMemory IN WIN32API AS RtlCopyLong ;
STRING @Dest, Long @Source, Long Length
LOCAL lcString
lcString = SPACE(4)
=RtlCopyLong(@lcString, BITOR(tnNum,0), 4)
RETURN lcString
ENDFUNC

FUNCTION Long2Num(tcLong)
DECLARE RtlMoveMemory IN WIN32API AS RtlCopyNum ;
Long @Dest, String @Source, Long Length
LOCAL lnNum
lnNum = 0
= RtlCopyNum(@lnNum, tcLong, 4)
RETURN lnNum
ENDFUNC

HIDDEN PROCEDURE ApiErrorText
LPARAMETERS tnErrorCode
Local lcErrBuffer
lcErrBuffer = REPL(CHR(0),1024)
= FormatMessage(0x1000 ,.NULL., tnErrorCode, 0, @lcErrBuffer, 1024,0)
RETURN STRTRAN(LEFT(lcErrBuffer, AT(CHR(0),lcErrBuffer)- 1 ), ;
"file", "form", -1, -1, 3)

ENDPROC

HIDDEN PROCEDURE LoadApiDlls
DECLARE INTEGER OpenPrinter IN winspool.drv;
STRING pPrinterName,;
INTEGER @phPrinter,;
INTEGER pDefault
DECLARE INTEGER ClosePrinter IN winspool.drv;
INTEGER hPrinter
DECLARE INTEGER AddForm IN winspool.drv;
INTEGER hPrinter,;
INTEGER LEVEL,;
STRING @pForm
DECLARE INTEGER DeleteForm IN winspool.drv;
INTEGER hPrinter,;
STRING pFormName
DECLARE INTEGER HeapCreate IN Win32API;
INTEGER dwOptions, INTEGER dwInitialSize,;
INTEGER dwMaxSize
DECLARE INTEGER HeapAlloc IN Win32API;
INTEGER hHeap, INTEGER dwFlags, INTEGER dwBytes
DECLARE lstrcpy IN Win32API;
STRING @lpstring1, INTEGER lpstring2
DECLARE INTEGER HeapFree IN Win32API;
INTEGER hHeap, INTEGER dwFlags, INTEGER lpMem
DECLARE HeapDestroy IN Win32API;
INTEGER hHeap
DECLARE INTEGER GetLastError IN kernel32
Declare Integer FormatMessage In kernel32.dll ;
Integer dwFlags, String @lpSource, ;
Integer dwMessageId, Integer dwLanguageId, ;
String @lpBuffer, Integer nSize, Integer Arguments

ENDPROC

ENDDEFINE

_________________
如果公司有下列困擾:
1. 找不到便宜,快速,簡易的 生產排程軟體
2. 不知道如何快速排定 採購計劃
3. 成本抓不準,自己算比軟體算有用
4. 想學習系統規劃,想找系統架構的顧問

請聯絡我們,也許我們幫得上忙


syntech 在 星期四 五月 24, 2018 10:02 am 作了第 1 次修改
回頂端
檢視會員個人資料 發送私人訊息 發送電子郵件 AIM Address
syntech



註冊時間: 2003-05-16
文章: 4211
來自: Taipei,Taiwan

第 4 樓

發表發表於: 星期四 五月 24, 2018 9:58 am    文章主題: 引言回覆

真正的 新增印表機 在這裡:
https://www.tek-tips.com/viewthread.cfm?qid=334420


代碼:


DO decl
*|typedef struct _PRINTER_INFO_2 { 
*|  LPTSTR    pServerName;         0:4
*|  LPTSTR    pPrinterName;        4:4
*|  LPTSTR    pShareName;          8:4
*|  LPTSTR    pPortName;           12:4
*|  LPTSTR    pDriverName;         16:4
*|  LPTSTR    pComment;            20:4
*|  LPTSTR    pLocation;           24:4
*|  LPDEVMODE pDevMode;            28:4
*|  LPTSTR    pSepFile;            32:4
*|  LPTSTR    pPrintProcessor;     36:4
*|  LPTSTR    pDatatype;           40:4
*|  LPTSTR    pParameters;         44:4
*|  PSECURITY_DESCRIPTOR pSecDesc; 48:4 
*|  DWORD     Attributes;          52:4
*|  DWORD     Priority;            56:4
*|  DWORD     DefaultPriority;     60:4
*|  DWORD     StartTime;           64:4
*|  DWORD     UntilTime;           68:4
*|  DWORD     Status;              72:4
*|  DWORD     cJobs;               76:4
*|  DWORD     AveragePPM;          80:4
*|} PRINTER_INFO_2, *PPRINTER_INFO_2; 84 bytes

LOCAL lcInfoBuffer, hPrinter, lcSrvName, lcPrnName, lcDrvName
lcPrnName = "Fujitsu DL 3600 (小表)" && 新增的印表機名稱
lcDrvName = "Fujitsu DL 3600"   && 印表機必須已安裝

* empty server name means local computer
* or put existing server name like "\\MYSERV"
* Win9/Me: should be empty, can only install local printers
lcSrvName = ""

* MSDN: You must specify non-NULL values for the pPrinterName, 
* pPortName, pDriverName, and pPrintProcessor members of 
* this structure before calling AddPrinter.

LOCAL loSrvName, loPrnName, loPortName, loDrvName, loPrnProc
loSrvName  = CreateObject("PChar", lcSrvName)
loPrnName  = CreateObject("PChar", lcPrnName)
loPortName = CreateObject("PChar", "LPT1:")
loDrvName  = CreateObject("PChar", lcDrvName)
loPrnProc  = CreateObject("PChar", "WinPrint")

* filling PRINTER_INFO_2 structure
lcInfoBuffer = num2dword(loSrvName.GetAddr()) +;
    num2dword(loPrnName.GetAddr()) + num2dword(0) +;
    num2dword(loPortName.GetAddr()) +;
    num2dword(loDrvName.GetAddr()) +;
    num2dword(0) + num2dword(0) +;
    num2dword(0) + num2dword(0) +;
    num2dword(loPrnProc.GetAddr()) +;
    num2dword(0) + num2dword(0) +;
    num2dword(0) + num2dword(0) +;
    num2dword(0) + num2dword(0) +;
    num2dword(0) + num2dword(0) +;
    num2dword(0) + num2dword(0) +;
    num2dword(0)

hPrinter = AddPrinter(lcSrvName, 2, @lcInfoBuffer)
IF hPrinter = 0
* 1795 - ERROR_PRINTER_DRIVER_ALREADY_INSTALLED
* 1796 - ERROR_UNKNOWN_PORT
* 1797 - ERROR_UNKNOWN_PRINTER_DRIVER
* 1798 - ERROR_UNKNOWN_PRINTPROCESSOR
* 1801 - ERROR_INVALID_PRINTER_NAME
* 1802 - ERROR_PRINTER_ALREADY_EXISTS
    ? "Error code:", GetLastError()
ELSE
    ? "Handle to a new printer object:", hPrinter
    = ClosePrinter(hPrinter)
ENDIF

* end of main
PROCEDURE decl
    DECLARE INTEGER GetLastError IN kernel32
    DECLARE INTEGER ClosePrinter IN winspool.drv INTEGER hPrinter
    DECLARE INTEGER AddPrinter IN winspool.drv;
        STRING pName, INTEGER Level, STRING @pPrinter

FUNCTION  num2dword (lnValue)
#DEFINE m0       256
#DEFINE m1     65536
#DEFINE m2  16777216
    LOCAL b0, b1, b2, b3
    b3 = Int(lnValue/m2)
    b2 = Int((lnValue - b3*m2)/m1)
    b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
    b0 = Mod(lnValue, m0)
RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)

* * *
DEFINE CLASS PChar As Custom
    PROTECTED hMem

PROCEDURE  Init (lcString)
    THIS.hMem = 0
    THIS.setValue (lcString)

PROCEDURE  Destroy
    THIS.ReleaseString

FUNCTION getAddr  && returns a pointer to the string
RETURN THIS.hMem

FUNCTION getValue && returns string value
    LOCAL lnSize, lcBuffer
    lnSize = THIS.getAllocSize()
    lcBuffer = SPACE(lnSize)

    IF THIS.hMem <> 0
        DECLARE RtlMoveMemory IN kernel32 As Heap2Str;
            STRING @, INTEGER, INTEGER
        = Heap2Str (@lcBuffer, THIS.hMem, lnSize)
    ENDIF
RETURN lcBuffer

FUNCTION getAllocSize  && returns allocated memory size (string length)
    DECLARE INTEGER GlobalSize IN kernel32 INTEGER hMem
RETURN Iif(THIS.hMem=0, 0, GlobalSize(THIS.hMem))

PROCEDURE setValue (lcString) && assigns new string value
#DEFINE GMEM_FIXED   0 
    THIS.ReleaseString

    DECLARE INTEGER GlobalAlloc IN kernel32 INTEGER, INTEGER
    DECLARE RtlMoveMemory IN kernel32 As Str2Heap;
        INTEGER, STRING @, INTEGER

    LOCAL lnSize
    lcString = lcString + Chr(0)
    lnSize = Len(lcString)
    THIS.hMem = GlobalAlloc (GMEM_FIXED, lnSize)
    IF THIS.hMem <> 0
        = Str2Heap (THIS.hMem, @lcString, lnSize)
    ENDIF
         
PROCEDURE ReleaseString  && releases allocated memory
    IF THIS.hMem <> 0
        DECLARE INTEGER GlobalFree IN kernel32 INTEGER
        = GlobalFree (THIS.hMem)
        THIS.hMem = 0
    ENDIF
ENDDEFINE

_________________
如果公司有下列困擾:
1. 找不到便宜,快速,簡易的 生產排程軟體
2. 不知道如何快速排定 採購計劃
3. 成本抓不準,自己算比軟體算有用
4. 想學習系統規劃,想找系統架構的顧問

請聯絡我們,也許我們幫得上忙
回頂端
檢視會員個人資料 發送私人訊息 發送電子郵件 AIM Address
從之前的文章開始顯示:   
發表新主題   回覆主題    VFP 愛用者社區 首頁 -> VFP 討論區 所有的時間均為 台北時間 (GMT + 8 小時)
1頁(共1頁)

 
前往:  
無法 在這個版面發表文章
無法 在這個版面回覆文章
無法 在這個版面編輯文章
無法 在這個版面刪除文章
無法 在這個版面進行投票
無法 在這個版面附加檔案
無法 在這個版面下載檔案


Powered by phpBB © 2001, 2005 phpBB Group
正體中文語系由 phpbb-tw 維護製作