|
設(shè)置該控件dragmode自動模式
***************************
應(yīng)用程序環(huán)境配置文件config.fpw
應(yīng)用程序環(huán)境配置文件config.fpw在程序連編時是可選的,也就是可要可不要,它保存的是一些vfp系統(tǒng)設(shè)置.如果存在,VFP啟動時會去讀取;如果沒有,系統(tǒng)會設(shè)定默認值. 代碼中建-----默認存入格式.prg ------文件夾中修改后綴為：config.fpw
********************************
* 表單設(shè)置背景圖片
pictrue屬性
stretch屬性值=2
********************************
* 一種加密和解密算法 JM.PRG (C)Copyright 2006-2006
* 加密: ?JM("文件名.DBF",88) &&返回.T.為成功 * 解密: ?JM("文件名.DBF",-88) &&返回.T.為成功 * 作者: Tiger5392 * 時間: 2006.06.11 PARAMETERS cFileName,nNumber PRIVATE cFileName,nNumber,A,B,D nHandle=FOPEN(cFileName,2) IF nHandle<>-1 DIMENSION D(1) ADIR(D,cFileName) FOR I=1 TO D(1,2) A=FREAD(nHandle,1) B=CHR(MOD(ASC(a)+nNumber,256)) FSEEK(nHandle,I) FWRITE(nHandle,B) ENDFOR FCLOSE(nHandle) RETURN .T. ELSE RETURN .F. ENDIF **************************************************
* 查找問題 seek for locatefor
*用found() 測試結(jié)果 聯(lián)合使用
if found()=.t.
...........
*****************************************************
* 測試文件值類型
Case Vartype(ThisForm.Text1.Value)='' && c、n。。。
****************************************************
* 分級設(shè)置權(quán)限方法
*主菜單都是執(zhí)行一些具體功能的子表單，不想讓普通用戶組使用的命令，就用skip for屏蔽 就是我上面說的那種
*有些子表單，普通用戶也可以用，但上面有些按鈕，只能管理員才能用的，就在子表單的init中判斷 *將不能讓普通用戶點的，enabled=.f.或直接visible=.f. *就這些。。。。 set exact on
thisform.i=thisform.i+1 &&這句是今天新學(xué)到的，用于標(biāo)識試圖登錄的次數(shù) select user &&當(dāng)然是打開數(shù)據(jù)環(huán)境對應(yīng)的賬號信息表 locate for alltrim(賬號)=alltrim(thisform.txt賬號.value) if found() and alltrim(密碼)=alltrim(thisform.txt密碼.value) &&說明找到了用戶名，并且密碼與名對應(yīng) if 級別="管理員" bsadmin="sysadmin" else bsadmin="" &&仍然等到空，可以根據(jù)此擴充為二級權(quán)限管理員，三級權(quán)限。。 endif do form 主表單 thisform.release else if thisform.i<3 &&試圖登錄三次以內(nèi) 重輸賬號、密碼 else 三次都錯，clear events，quit endif endif set exact off ************************************************ 設(shè)置該控件dragmode自動模式
***************************
應(yīng)用程序環(huán)境配置文件config.fpw
應(yīng)用程序環(huán)境配置文件config.fpw在程序連編時是可選的,也就是可要可不要,它保存的是一些vfp系統(tǒng)設(shè)置.如果存在,VFP啟動時會去讀取;如果沒有,系統(tǒng)會設(shè)定默認值.
代碼中建-----默認存入格式.prg ------文件夾中修改后綴為：config.fpw
******************************** *
表單設(shè)置背景圖片 pictrue屬性 stretch屬性值=2
******************************** *
一種加密和解密算法 JM.PRG (C)Copyright 2006-2006
* 加密: ?JM("文件名.DBF",88) &&返回.T.為成功 * 解密: ?JM("文件名.DBF",-88) &&返回.T.為成功 * 作者: Tiger5392
* 時間: 2006.06.11 PARAMETERS cFileName,nNumber PRIVATE cFileName,nNumber,A,B,D nHandle=FOPEN(cFileName,2) IF nHandle<>-1 DIMENSION D(1) ADIR(D,cFileName) FOR I=1 TO D(1,2) A=FREAD(nHandle,1) B=CHR(MOD(ASC(a)+nNumber,256)) FSEEK(nHandle,I) FWRITE(nHandle,B) ENDFOR FCLOSE(nHandle) RETURN .T. ELSE RETURN .F. ENDIF ************************************************** *
查找問題
seek for locatefor
*用found() 測試結(jié)果 聯(lián)合使用 if found()=.t. ...........
***************************************************** *
測試文件值類型 Case Vartype(ThisForm.Text1.Value)='' && c、n。。。
**************************************************** *
分級設(shè)置權(quán)限方法
*主菜單都是執(zhí)行一些具體功能的子表單，不想讓普通用戶組使用的命令，就用skip for屏蔽 就是我上面說的那種
*有些子表單，普通用戶也可以用，但上面有些按鈕，只能管理員才能用的，就在子表單的init中判斷
*將不能讓普通用戶點的，enabled=.f.或直接visible=.f.
*就這些。。。。 set exact on thisform.i=thisform.i+1
&&這句是今天新學(xué)到的，用于標(biāo)識試圖登錄的次數(shù) select user
&&當(dāng)然是打開數(shù)據(jù)環(huán)境對應(yīng)的賬號信息表 locate for alltrim(賬號)=alltrim(thisform.txt賬號.value) if found() and alltrim(密碼)=alltrim(thisform.txt密碼.value)
&&說明找到了用戶名，并且密碼與名對應(yīng) if 級別="管理員" bsadmin="sysadmin" else bsadmin=""
&&仍然等到空，可以根據(jù)此擴充為二級權(quán)限管理員，三級權(quán)限。。 endif do form 主表單 thisform.release else if thisform.i<3
&&試圖登錄三次以內(nèi) 重輸賬號、密碼 else 三次都錯，clear events，quit endif endif set exact off
************************************************
*檢驗斷斷續(xù)續(xù)出現(xiàn)的錯誤的原因. 用以下代碼創(chuàng)建一個叫做
*Errutil.prg 和程序. ON ERROR DO errhand IN errutil ; WITH SYS(0), ERROR(), MESSAGE(), MESSAGE(1), ; PROGRAM(), LINENO(1), DBF(), DATE(), TIME() * 錯誤捕捉設(shè)置結(jié)束. PROCEDURE errhand PARAMETER m.machine, m.messgnum, m.messg, m.linecode, ; m.callprog, m.inline, m.OPENTABL, m.errdate, ; m.errtime m.errspace=SELECT() && 保存當(dāng)前工作區(qū).
m.errorder=ORDER() && 保存當(dāng)前排序.
IF LEN(ALLTRIM(m.callprog))=0 m.callprog="Command Line" STORE SPACE(0) TO m.linecode ENDIF outmsgline="錯誤 ; "+m.messg+CHR(13)+"行號 "+STR(m.inline)+ ; CHR(13)+ ; "程序名 = "+m.callprog+CHR(13)+"語法 :"+m.linecode
* Visual FoxPro 用戶使用 =MESSAGEBOX(outmsgline,32+0)
* FoxPro For Windows 用戶使用 Foxtools.fll 中的 MsgBox() 函數(shù) WAIT WINDOW outmsgline TIMEOUT 5 && 所有版本均可使用該語法. IF !USED("ERRORLOG") IF FILE("ERRORLOG.DBF") SELECT 0 USE errorlog ELSE SELECT 0 thisversion=VERSION() IF LEFT(ALLTRIM(thisversion),6)="Visual"
* 為 Visual FoxPro 版本創(chuàng)建一個自由表 CREATE TABLE errorlog FREE (machine c(20), messgnum N(4,0), ; messg c(70), linecode c(70), callprog c(40), ; inline N(6,0), OPENTABL c(25), errdate d, errtime c(8)) ELSE CREATE TABLE errorlog (machine c(20), messgnum N(4,0), ; messg c(70), linecode c(70), callprog c(40), ; inline N(6,0), OPENTABL c(25), errdate d, errtime c(8)) ENDIF ENDIF ENDIF INSERT INTO errorlog FROM MEMVAR SELECT errorlog && 選擇
errorlog 表.
USE && 關(guān)閉 errorlog 表.
SELECT (m.errspace) && 返回到保存的工作區(qū).
IF !EMPTY(ALIAS()) SET ORDER TO (m.errorder)
ENDIF RELEASE ALL LIKE m.messgnum, m.messg, m.linecode, m.callprog, ;
m.inline
RETURN
用以下代碼創(chuàng)建一個名為 Ztest.prg 的程序:
DO errutil && 激活 Errutil.prg 中的 ON ERROR 例程.
USE c:\noexist.dbf && 因為該文件尚不存在因此會發(fā)生錯誤 DO C:\noexist.prg ON ERROR && 關(guān)閉活動的 ON ERROR 例程.
在 Visual FoxPro 命令窗口中打入以下命令: Do ZTest.prg. 兩個 Wait 窗口顯示出不愉快的錯誤代碼行. 這些信息被放入
Errorlog.dbf 文件中. 5 秒鐘后窗口消失. 激活命令窗口, 然后打開并瀏覽 Errorlog 表.
************************************************
* set path to 和 set default to 區(qū)別
1. set default to 是設(shè)置系統(tǒng)默認路徑的命令,如:當(dāng)前程序執(zhí)行時所在的路徑是c:\\temp,但是系統(tǒng)運行后向把系統(tǒng)的默認路徑改為d:\\temp時,就執(zhí)行set defautl to d:\\temp.
2. set path to 是設(shè)置系統(tǒng)的文件搜索路徑,如:當(dāng)前程序執(zhí)行時所在的路徑是c:\\temp,但是系統(tǒng)運行后需要某些操作文件(已知這些文件所在的路徑,如:d:\\temp.d:\\temp1...),而又不能改變系統(tǒng)運行的默認路徑時,就執(zhí)行set path to d:\\temp,set path to d:\\temp1 .... *******************************************
** Modal窗口和Modeless窗口有什么區(qū)別？
答： Modeless 窗口可以在窗口運行后，但是并沒有退出窗口時，仍然運行DO Form 后的代碼。 Modal 窗口必須在退出窗口后，才能繼續(xù)運行DO Form 后的代碼。
********************************************** * 如何把表單的標(biāo)題欄移掉
答：其實，這很容易制作。只要您把表單的下面幾個屬性 Closable ,ControlBox , Minbutton , Maxbutton , Movable 設(shè)為 False,再把Caption設(shè)為空(caption=""),就可以達到要求。
************************************************** * 表單啟動后的事件執(zhí)行順序
DataEnvironment.BeforeOpenTables()
Form.Load() DataEnvironment.Init() Form.Container1.Contol1.Init() Form.Container1.Control2.Init() Form.Container1.Init() ****************************************************** * 程序自動設(shè)定路徑？
答：一般運行程序的目錄并非固定不變，因此一般在程序啟動時 都要查詢當(dāng)前運行程序的目錄。下面這段程序給出當(dāng)前路徑的查詢 方法： Function SetPath() CD LEFT(lcProgram, RAT("\", lcProgram))
*-- If we are running MAIN.PRG directly, then *-- CD up to the parent directory IF RIGHT(lcProgram, 3) = "FXP" CD .. ENDIF SET PATH TO PROGS, FORMS, LIBS, ; MENU, DATA, ; REPORTS, INCLUDE, HELP, ; BITMAPS SET CLASSLIB TO MAIN ,vfptool ENDFUNC ***************************************************** *--鎖定數(shù)據(jù)庫
do while !rlock() && 鎖定數(shù)據(jù)庫
wait window '正在鎖定數(shù)據(jù)庫請稍候！' Timeout 0.05 enddo repl kcl with kcl-sp.sl && 更新數(shù)據(jù) unlock in mjsm_temp && 解鎖數(shù)據(jù)庫 *****************************************************
* -- 取得卷（磁盤）信息 DECLARE INTEGER GetVolumeInformation IN WIN32API STRING @cRooDirectory ,STRING @cVolume, INTEGER nVolumeSize, ; INTEGER @nSerialNo, INTEGER @nMaxFileNameLen, INTEGER @nFileSystemFlags, STRING @cFileSystemName, ; INTEGER nFileSystemNameSize ******************************************************
* --- 設(shè)置卷標(biāo) DECLARE INTEGER SetVolumeLabel IN WIN32API STRING cRootPathName, STRING cVolumeName cRooDirectory = "C:\"
cVolume = SPACE(255) nVolumeSize = 255 nSerialNo = 0 nMaxFileNameLen = 0 nFileSystemFlags = 0 cFileSystemName = SPACE(255) nFileSystemNameSize = 255 nOk = GetVolumeInformation(@cRooDirectory , @cVolume, nVolumeSize,@nSerialNo, @nMaxFileNameLen, @nFileSystemFlags, ;
@cFileSystemName,nFileSystemNameSize) *IF nOk > 0 "cVolume =", cVolume "nSerialNo =", LEFT(SUBSTR(TRANSFORM(nSerialNo, "@0X"), 3), 4) + "-" +RIGHT(SUBSTR(TRANSFORM(nSerialNo, "@0X"), 3), 4) "nMaxFileNameLen = ", nMaxFileNameLen "nFileSystemFlags = ", nFileSystemFlags "cFileSystemName =",cFileSystemName *ELSE "Read Error=", nOk *ENDIF *? SetVolumeLabel("C:\", "WINDOWS_98") *? SetVolumeLabel("A:\", "WINDOWS_98") or (1).dir>xxx.txt
(2) handle = fopen("xxx.txt",2) s = fget(handle,10) ******************************************************
**--- 如何在一個表單上戳一個（或幾個平行）的透明窟窿？--
* Program Name : MakeTransparentHole.Prg
* Article No. : [Win API] - 001 * Illustrate : 如何在一個表單上戳一個（或幾個平行）的透明窟窿？ * Date / Time : 2001.09.09 / 16:00 * Writer : * 1st Post : ******************************************************** PUBLIC frm frm = CreateObject ("Tform") frm.Visible = .T. * end of main DEFINE CLASS Tform As Form
Width = 500 Height = 300 AutoCenter = .T. BackColor = Rgb(192,224,192) Caption = "如何在一個表單上戳一個（或幾個平行）的透明窟窿" ADD OBJECT lbl1 As Tlabel WITH Caption="她初看是一個 Form 上的 Shapes，...", Left=10, Top=10
ADD OBJECT lbl2 As Tlabel WITH Caption="...但它們確實是一個洞，在背后可以放置東西。", Left=20, Top=150 PROCEDURE Load
THIS.decl ENDPROC PROCEDURE Resize
*THIS.RemoveRegions && does not make any difference ThisForm.ApplyRegions ENDPROC PROCEDURE Activate
ThisForm.ApplyRegions ENDPROC PROCEDURE RemoveRegions
= SetWindowRgn (GetFocus(), 0, 1) ENDPROC PROCEDURE ApplyRegions
#DEFINE RGN_AND 1 #DEFINE RGN_OR 2 #DEFINE RGN_XOR 3 #DEFINE RGN_DIFF 4 #DEFINE RGN_COPY 5 #DEFINE radius 84 #DEFINE interspace 12 LOCAL hRgnBase, hRgn, hwnd, x0,y0,x1,y1
DIMEN hRgnExclude [5] && an array to store elliptical regions * create a rectangle region
* and set it by the rectangle of the form hRgn = CreateRectRgn (0,0,1,1) hwnd = GetFocus() && get window handle for the form THIS.GetRect (hwnd, @x0,@y0,@x1,@y1) hRgnBase = CreateRectRgn (0,0,x1-x0,y1-y0) x0 = 20
y0 = 70 y1 = y0 + radius * create several elliptical regions FOR ii=1 TO 5 hRgnExclude[ii] = CreateEllipticRgn (x0,y0, x0+radius,y1) x0 = x0 + radius + interspace ENDFOR * combine elliptical regions into one region = CombineRgn (hRgn, hRgnExclude[1], hRgnExclude [2], RGN_OR) = CombineRgn (hRgn, hRgn, hRgnExclude [3], RGN_OR) = CombineRgn (hRgn, hRgn, hRgnExclude [4], RGN_OR) = CombineRgn (hRgn, hRgn, hRgnExclude [5], RGN_OR) * subtract the resulting region * from the region defined by the rectangle of the form = CombineRgn (hRgn, hRgnBase, hRgn, RGN_XOR) * apply final region to the form = SetWindowRgn (hwnd, hRgn, 1) * free system resources = DeleteObject (hRgn) FOR ii=1 TO 5 = DeleteObject (hRgnExclude[ii]) ENDFOR = DeleteObject (hRgnBase) ENDPROC PROCEDURE GetRect (hwnd, x0,y0,x1,y1)
LOCAL lpRect lpRect = SPACE (16) = GetWindowRect (hwnd, @lpRect)
x0 = THIS.buf2dword (SUBSTR(lpRect, 1,4)) y0 = THIS.buf2dword (SUBSTR(lpRect, 5,4)) x1 = THIS.buf2dword (SUBSTR(lpRect, 9,4)) y1 = THIS.buf2dword (SUBSTR(lpRect, 13,4)) ENDPROC FUNCTION buf2dword (lcBuffer)
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + Asc(SUBSTR(lcBuffer, 2,1)) * 256 + Asc(SUBSTR(lcBuffer, 3,1)) * 65536 + Asc(SUBSTR(lcBuffer, 4,1)) * 16777216 ENDFUNC PROCEDURE decl
DECLARE INTEGER CreateEllipticRgn IN gdi32 INTEGER nLeftRect, INTEGER nTopRect, INTEGER nRightRect, INTEGER nBottomRect DECLARE INTEGER CreateRectRgn IN gdi32 INTEGER nLeftRect, INTEGER nTopRect, INTEGER nRightRect, INTEGER nBottomRect DECLARE INTEGER CombineRgn IN gdi32 INTEGER hrgnDest, INTEGER hrgnSrc1, INTEGER hrgnSrc2, INTEGER fnCombineMode DECLARE SetWindowRgn IN user32 INTEGER hWnd, INTEGER hRgn, SHORT bRedraw DECLARE SHORT GetWindowRect IN user32 INTEGER hwnd, STRING @ lpRect DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObject DECLARE INTEGER GetFocus IN user32 ENDPROC ENDDEFINE DEFINE CLASS Tlabel As Label
FontName="System" FontSize=18 AutoSize=.T. BackStyle=0 ENDDEFINE **********************************************************************
**---- 如何生成世界上唯一的 64 位 ID？--
* Program Name : OnlyID.Prg
* Article No. : [Win API] - 003 * Illustrate : 如何生成世界上唯一的 64 位 ID？ * Date / Time : 2001.09.09 / 18:00 * Writer : * 1st Post : *********************************************************************** LOCAL lcRetval, lcStruc_GUID, lcGUID, lnSize DECLARE INTEGER CoCreateGuid IN "ole32.dll" STRING @lcGUIDStruc DECLARE INTEGER StringFromGUID2 IN "ole32.dll" STRING cGUIDStruc, STRING @cGUID, LONG nSize * Create a GUID-structure
lcStruc_GUID = REPLICATE(" ", 16) lcGUID = REPLICATE(" ", 80) lnSize = LEN(lcGUID) / 2 * Pass the structure to the API function so that it creates a new ID IF CoCreateGuid(@lcStruc_GUID) <> 0 RETURN "" ENDIF * Convert the structure to a string that we can use in VFP IF StringFromGUID2(lcStruc_GUID, @lcGuid, lnSize) = 0 RETURN "" ENDIF STRCONV(LEFT(lcGUID, 76), 6) RETURN STRCONV(LEFT(lcGUID, 76), 6) **---- 如何使用和調(diào)用 Win32 的 GetUserName API？-- * Program Name : GetUserID.Prg
* Article No. : [Win API] - 002 * Illustrate : 如何使用和調(diào)用 Win32 的 GetUserName API？ * Date / Time : 2001.09.09 / 17:00 * Writer : * 1st Post : * Public lpUserIDBuffer, nBufferSize, RetVal RetVal = 0 lpUserIDBuffer = SPACE(25) && Return buffer for user ID string nBufferSize = 25 && Size of user ID return buffer Declare INTEGER GetUserName IN Win32API AS GetName STRING @lpUserIDBuffer, INTEGER @nBufferSize
RetVal=GetName(@lpUserIDBuffer, @nBufferSize) Define WINDOW ShowInfo FROM 0,0 TO 5,70 FLOAT CLOSE TITLES "User ID Information" FONT "System",12 Activate WINDOW ShowInfo Move WINDOW ShowInfo CENTER @ 0,1 SAY "User ID : " + LEFT(lpUserIDBuffer,nBufferSize-1) *******************************************************************
** -- Parameters: lcWindCaption - 應(yīng)用程序窗口標(biāo)題-- ******************************************************************* Function TestAppRun
LPARAMETER lcWindCaption IF TYPE('lcWindCaption') # 'C' OR EMPTY(lcWindCaption) RETURN .F. ENDIF LOCAL GetWind, wclass, apphand SET LIBRARY TO foxtools.fll ADDITIVE GetWind = RegFn("FindWindow", "CC", "I") wclass=0 apphand=CallFn(GetWind,wclass ,lcWindCaption) IF apphand # 0
RETURN .F. ENDIF RETURN .T. *******************************************************************
**--數(shù)值轉(zhuǎn)換成人民幣大寫格式-- *Programmer:Craftsman *2001.10.18 cUnit="仟佰拾萬仟佰拾圓角分"
cChar="" If Vartype(This.Input)<>"N" Messagebox("請確認數(shù)據(jù)類型",48,"警告") Else cInput=Chrtran((Ltrim(Str(This.Input,20,2))),".","") If This.Input<=0 or Len(cInput)>10 Messagebox("您輸入的數(shù)值可能存在以下問題："+Chr(13); +"1、輸入的數(shù)值太大(最大處理值：99999999.99)"+Chr(13); +"2、輸入的數(shù)值小于或等于零",48,"警告") Else For N=1 to Len(cInput) If Val(Substr(Right(cInput,N),1,1))>0 cChar=Stuffc(cUnit,11-N,0,Substr("0零1壹2貳3叁4肆5伍6陸7柒8 捌9玖",At(Substr(Right(cInput,N),1,1),"0零1壹2貳3叁4肆5伍6陸7柒8捌9玖 ")+1,2)) Else Do Case Case N=1 cChar=Stuffc(cUnit,11-N,1,"整") Case N=2 cChar=Iif(Val(Substr(Right(cInput,N-1),1,1))>0,Stuffc(cUnit,11-N,1,"零
"),Stuffc(cUnit,11-N,1,"")) Case N=3 or N=7 Loop Otherwise cChar=Iif(Val(Substr(Right(cInput,N+1),1,1))=0,Stuffc(cUnit,11-N,1,""),Stuff
c(cUnit,11-N,1,"零")) Endcase Endif cUnit=cChar Endfor cChar=Substrc(cChar,11-Len(cInput)) cChar=Iif("零萬"$cChar,Stuffc(cChar,At_c("零萬",cChar),2,"萬"),cChar) cChar=Iif(Substr(Right(cInput,6),1,1)="0" And Substr(Right(cInput,7),1,1)="0",Stuffc(cChar,At_c("萬",cChar)+1,0,"零 "),cChar) cChar=Iif("零圓"$cChar,Stuffc(cChar,At_c("零圓",cChar),2,"圓"),cChar) This.Output=cChar Endif Endif or
procedure Camount
parameter Mamount MyAmount=alltrim(str(abs(Mamount)*100,11,0)) temp=len(alltrim(MyAmount)) chr_amount='' For i = 1 TO temp MYmemo=val(subs(MyAmount, temp-i+1, 1)) chr_amount =subs("零壹貳叁肆伍陸柒捌玖", MYmemo*2+1, 2)+subs("分角圓拾佰仟 萬拾佰仟億", i*2-1, 2)+ chr_amount EndFor chr_amount=iif(Mamount<0,'負'＋chr_amount,chr_amount) chr_amount return chr_amount *****************************************************************
**--這個Prncode.zap程序全部使用Visual Foxpro編寫，用于VFP表單文件(SCX)或類庫文件(VCX)過程源碼查看及打印。運行于VFP環(huán)境或安裝了VFP6運行時刻系統(tǒng)中。
說明：
1.在"打開"窗口中，選擇打開表單(SCX)或類庫(VCX)類型，打開文件。 2.選擇"按對象"查看方式時，可把同一對象的過程顯示在文本框中；選擇"按過程"查看方式時，僅顯示一個指定過程。 3.選擇組合框內(nèi)容，隨查看方式不同，列表出打開文件的中包含的對象集或所有過程。 4.通過"保存"或"另存為"功能按鈕，可以將文本框內(nèi)容保存為文本文件。 5.通過"預(yù)覽"或"打印"功能按鈕，可以將文本框內(nèi)容打印到屏幕或打印機中。 6.已打開源文件名稱顯示窗口標(biāo)題中，底部標(biāo)簽中顯示是保存文本文件名稱。 7.運行于VFP環(huán)境時，執(zhí)行"startapp.app"可把本程序加入工具菜單中，如果在選項窗口中，把"startapp.app"設(shè)置為啟動程序，那它真的就是一個系統(tǒng)工具了。 8.這個小程序意在為初學(xué)者，提供一編程示例，也是VFP愛好者的一個實用小工具。您可以根據(jù)需要進行修改完善。 * Program Name : VolumeInformation.Prg
* Article No. : [Win API] - 029 * Illustrate : 常用卷標(biāo)信息 * Date / Time : 2001.09.27 * Writer : * 1st Post : * My Comment : 需要 Win32VFP.Dll 庫支持，見附件。 *****************************************************************
#Define FILE_CASE_SENSITIVE_SEARCH 1
#Define FILE_CASE_PRESERVED_NAMES 2 #Define FILE_UNICODE_ON_DISK 4 #Define FILE_PERSISTENT_ACLS 8 #Define FILE_FILE_COMPRESSION 16 #Define FILE_VOLUME_IS_COMPRESSED 32768 && &H8000 Declare INTEGER GetLastError IN kernel32
Declare INTEGER intAnd IN win32vfp INTEGER nInt0, INTEGER nInt1 Declare SHORT GetVolumeInformation IN kernel32;
STRING lpRootPathName,; STRING @ lpVolumeNameBuffer,; INTEGER nVolumeNameSize,; INTEGER @ lpVolumeSerialNumber,; INTEGER @ lpMaximumComponentLength,; INTEGER @ lpFlags,; STRING @ lpFileSystemNameBuffer,; INTEGER nFileSystemNameSize lpRootPathName = "C:\" && check the slash, or "D:\", "E:\"....
nVolumeNameSize = 250
lpVolumeNameBuffer = SPACE (nVolumeNameSize) lpVolumeSerialNumber = 0 lpMaximumComponentLength = 0 lpFlags = 0 nFileSystemNameSize = 250 lpFileSystemNameBuffer = SPACE(nFileSystemNameSize) lnResult = GetVolumeInformation (lpRootPathName, @lpVolumeNameBuffer,;
nVolumeNameSize, @lpVolumeSerialNumber,; @lpMaximumComponentLength, @lpFlags,; @lpFileSystemNameBuffer,nFileSystemNameSize ) If lnResult = 1
* display parameters returned lpVolumeNameBuffer = LEFT(lpVolumeNameBuffer,; AT(Chr(0),lpVolumeNameBuffer)-1) "Volume Name: [", lpVolumeNameBuffer, "]" "Volume Serial Number: ", lpVolumeSerialNumber
"Max Filename Length: ", lpMaximumComponentLength "File System Flags: ", lpFlags
= displayFlag (lpFlags, FILE_CASE_SENSITIVE_SEARCH,; "Case-sensitive file names support: ") = displayFlag (lpFlags, FILE_CASE_PRESERVED_NAMES,;
"The file system preserves the case of file names: ") = displayFlag (lpFlags, FILE_UNICODE_ON_DISK,;
"Unicode in file names support: ") = displayFlag (lpFlags, FILE_PERSISTENT_ACLS,;
"ACLs support: ") = displayFlag (lpFlags, FILE_FILE_COMPRESSION,;
"File-based compression support: ") = displayFlag (lpFlags, FILE_VOLUME_IS_COMPRESSED,;
"The specified volume is a compressed volume: ") lpFileSystemNameBuffer = LEFT(lpFileSystemNameBuffer,;
AT(Chr(0),lpFileSystemNameBuffer)-1) "File System Name: [", lpFileSystemNameBuffer, "]" Else * 3 - The system cannot find the path specified = ERROR_PATH_NOT_FOUND * 21 - The device is not ready = ERROR_NOT_READY "Error code: ", GetLastError() Endif Procedure displayFlag (lnFlags, lnMask, lcCaption)
lcResult = IIF (intAnd(lnFlags, lnMask) = lnMask, "Yes", "No") " - ", lcCaption, lcResult Return * Program Name : EllipticalForm.Prg
* Article No. : [Win API] - 028 * Illustrate : 橢圓型表單 * Date / Time : 2001.09.27 * Writer : Tuberose zyg8108@21cn.com * 1st Post : News://news.newsfan.net/計算機.軟件.數(shù)據(jù)庫.Vfp Public frm
frm = CreateObject ("Tform") frm.Visible = .T. Return Define CLASS Tform As Form
#Define horizDiameter 400 #Define vertDiameter 260 Caption = "橢圓型表單"
Width = 600 Height = 350 AutoCenter = .T. MaxButton = .F. MinButton = .F. hRgn = 0 hwind = 0 Add OBJECT cmd As CommandButton WITH;
Width=80, Height=25, FontName='System', Caption="執(zhí)行" Procedure Load
This.decl Endproc Procedure Init
With THIS.cmd .Top = THIS.Height - .Height - 15 .Left = (THIS.Width - .Width)/2 Endwith Endproc Procedure cmd.Click
Thisform.TimeConsumingProc Endproc Procedure TimeConsumingProc
* this is an emulation of a time consuming process * while it is running the form is limited to an ellipse Clear * limit the form to an ellipse
* defined by a region This.regionOn Local ii, jj For ii=1 TO 10 Create CURSOR cs (id N(6), dt decl) "Inserting records to cursor... "
For jj=1 TO 100
Insert INTO cs VALUES (jj, DATE()-jj) DATE()-jj, ", " Endfor * DOEVENTS "Indexing cursor... "
Index ON id TAG id
Index ON dt TAG dt * DOEVENTS Use IN cs
"Ok | " Endfor This.regionOff && restore the form to its original state
This.cmd.Visible = .T. Endproc Procedure regionOn
* create an elliptical region and apply it to the form Local x0,y0,x1,y1 x0 = (THIS.Width - horizDiameter)/2 y0 = (THIS.Height - vertDiameter)/2 x1 = x0 + horizDiameter y1 = y0 + vertDiameter This.hwind = GetFocus()
This.hRgn = CreateEllipticRgn (x0,y0,x1,y1) = SetWindowRgn (THIS.hwind, THIS.hRgn, 1) Endproc Procedure regionOff
* release a region for this form = SetWindowRgn (THIS.hwind, 0, 1) Endproc Procedure decl
Declare INTEGER CreateEllipticRgn IN gdi32; INTEGER nLeftRect,; INTEGER nTopRect,; INTEGER nRightRect,; INTEGER nBottomRect Declare SetWindowRgn IN user32;
INTEGER hWnd,; INTEGER hRgn,; SHORT bRedraw Declare INTEGER GetFocus IN user32
Endproc Enddefine ***************************************************************
* Program Name : WinCalc.Prg
* Article No. : [Win API] - 027 * Illustrate : 計算器 * Date / Time : 2001.09.27 * Writer : * 1st Post : ***************************************************************
Private frm
frm = CreateObject ("Tform") frm.Show (1) Define CLASS Tform As Form
Width = 400 Height = 200 AutoCenter = .T. Caption = "Accessing WinCalc Window" Add OBJECT cmdShow As Tbutton
Add OBJECT cmdHide As Tbutton Procedure Init
This.cmdShow.caption = "Show Calc" This.cmdHide.caption = "Hide Calc" This._resize This.decl Endproc Procedure cmdShow.click
Thisform._show Endproc Procedure cmdHide.click
Thisform._hide Endproc Procedure _resize
With THIS.cmdHide .top = THIS.height - .height - 10 .left = THIS.width - .width - 10 Endwith With THIS.cmdShow .top = THIS.cmdHide.top .left = THIS.cmdHide.left - .width - .3 Endwith Endproc Protected PROCEDURE decl
Declare INTEGER SetForegroundWindow IN "user32" INTEGER hwnd Declare INTEGER FindWindow IN user32;
STRING lpClassName,; STRING lpWindowName Declare INTEGER WinExec IN kernel32;
STRING lpCmdLine, INTEGER nCmdShow Declare SHORT PostMessage IN user32;
INTEGER hWnd,; INTEGER Msg,; STRING @ wParam,; INTEGER lParam Endproc Procedure _show
#Define SW_SHOWNORMAL 1 Local hwnd HWnd = FindWindow (.NULL., "Calculator") If hwnd = 0 = WinExec ("calc.exe", SW_SHOWNORMAL) Else = SetForegroundWindow (hwnd) Endif Endproc Procedure _hide
#Define WM_QUIT 18 Local hwnd HWnd = FindWindow (.NULL., "Calculator") If hwnd <> 0 = PostMessage (hwnd, WM_QUIT, 0,0) Endif Endproc Enddefine Define CLASS Tbutton As CommandButton
FontName = 'System' Height = 24 Width = 100 Enddefine ****************************************************************
* Program Name : LocaleRecord.Prg
* Article No. : [Win API] - 026 * Illustrate : 獲得系統(tǒng)中的所有國家/地區(qū)信息 * Date / Time : 2001.09.25 * Writer : * 1st Post : * My Comment : * some LCTYPE constants
#DEFINE LOCALE_ILANGUAGE 1 && language id #DEFINE LOCALE_SLANGUAGE 2 && localized name of language #DEFINE LOCALE_SENGLANGUAGE 4097 && English name of language #DEFINE LOCALE_SABBREVLANGNAME 3 && abbreviated language name #DEFINE LOCALE_SNATIVELANGNAME 4 && native name of language #DEFINE LOCALE_ICOUNTRY 5 && country code #DEFINE LOCALE_SCOUNTRY 6 && localized name of country #DEFINE LOCALE_SENGCOUNTRY 4098 && English name of country #DEFINE LOCALE_SABBREVCTRYNAME 7 && abbreviated country name #DEFINE LOCALE_SNATIVECTRYNAME 8 && native name of country #DEFINE LOCALE_IDEFAULTLANGUAGE 9 && default language id #DEFINE LOCALE_IDEFAULTCOUNTRY 10 && default country code #DEFINE LOCALE_IDEFAULTCODEPAGE 11 && default oem code page #DEFINE LOCALE_IDEFAULTANSICODEPAGE 4100 && default ansi code page #DEFINE LOCALE_IDEFAULTMACCODEPAGE 4113 && default mac code page #DEFINE LOCALE_ILDATE 34 && long date format ordering
#DEFINE LOCALE_ILZERO 18 && leading zeros for decimal #DEFINE LOCALE_IMEASURE 13 && 0 = metric, 1 = US #DEFINE LOCALE_IMONLZERO 39 && leading zeros in month field #DEFINE LOCALE_INEGCURR 28 && negative currency mode #DEFINE LOCALE_INEGSEPBYSPACE 87 && mon sym sep by space from neg amt #DEFINE LOCALE_INEGSIGNPOSN 83 && negative sign position * more constants exist... DECLARE INTEGER GetLocaleInfo IN kernel32;
INTEGER Locale,; INTEGER LCType,; STRING @ lpLCData,; INTEGER cchData CREATE CURSOR cs (;
locale N(6),; langid C( 4),; llnagname C(30),; elangname C(30),; alangname C( 3),; nlangname C(30),; ccode C( 3),; lcname C(30),; ecname C(30),; acname C( 3),; ncname C(30),; dlangid C( 4),; dccode C( 3),; doemcp C( 5),; dansicp C( 5),; dmaccp C( 5),; ldtfmt C( 2),; ldzeros C( 2),; metrics C( 2),; monzero C( 2),; necurr C( 2),; negsep C( 2),; negsign C( 2); ) * scan top &H10000 codes
* under WinNT 4.0 it returns 138 records * WinMe -- 164 records FOR ii=0 TO 65535 = saveLInfo (ii) ENDFOR SELECT cs
GO TOP BROW NORMAL NOWAIT RETURN && main PROCEDURE saveLInfo (lnLocale)
* saves one local record for the locale IF Len (getLInfo (lnLocale, LOCALE_ILANGUAGE)) = 0 * exit if no information exists for this locale id RETURN ENDIF INSERT INTO cs VALUES (;
lnLocale,; getLInfo (lnLocale, LOCALE_ILANGUAGE),; getLInfo (lnLocale, LOCALE_SLANGUAGE),; getLInfo (lnLocale, LOCALE_SENGLANGUAGE),; getLInfo (lnLocale, LOCALE_SABBREVLANGNAME),; getLInfo (lnLocale, LOCALE_SNATIVELANGNAME),; getLInfo (lnLocale, LOCALE_ICOUNTRY),; getLInfo (lnLocale, LOCALE_SCOUNTRY),; getLInfo (lnLocale, LOCALE_SENGCOUNTRY),; getLInfo (lnLocale, LOCALE_SABBREVCTRYNAME),; getLInfo (lnLocale, LOCALE_SNATIVECTRYNAME),; getLInfo (lnLocale, LOCALE_IDEFAULTLANGUAGE),; getLInfo (lnLocale, LOCALE_IDEFAULTCOUNTRY),; getLInfo (lnLocale, LOCALE_IDEFAULTCODEPAGE),; getLInfo (lnLocale, LOCALE_IDEFAULTANSICODEPAGE),; getLInfo (lnLocale, LOCALE_IDEFAULTMACCODEPAGE),; getLInfo (lnLocale, LOCALE_ILDATE),; getLInfo (lnLocale, LOCALE_ILZERO),; getLInfo (lnLocale, LOCALE_IMEASURE),; getLInfo (lnLocale, LOCALE_IMONLZERO),; getLInfo (lnLocale, LOCALE_INEGCURR),; getLInfo (lnLocale, LOCALE_INEGSEPBYSPACE),; getLInfo (lnLocale, LOCALE_INEGSIGNPOSN); ) RETURN PROCEDURE getLInfo (lnLocale, lnType)
**************************************************************** * retrieves a value for the parameter of lnType for the locale lnLocale
lcBuffer = SPACE(250) lnLength = GetLocaleInfo (lnLocale, lnType, @lcBuffer, Len(lcBuffer)) RETURN Iif (lnLength > 0, STRTRAN(LEFT(lcBuffer, lnLength-1), Chr(0)), "") ****************************************************************
* Program Name : RemoveHistory.Prg
* Article No. : [Win API] - 025 * Illustrate : 清理[開始] -> [文檔] 中的 [歷史記錄] * Date / Time : 2001.09.25 * Writer : * 1st Post : * My Comment : 在 Windows 中運行或打開某些文件時，在[開始] -> [文 * : 檔]中會留下[歷史記錄]，比如你打開了 Readme.Txt or * : mumu.bmp，因此用該函數(shù)可以清楚歷史記錄。提高安全性。 ***************************************************************
#Define SHARD_PATHA 2
#Define SHARD_PATHW 3 #Define SHARD_PIDL 1 Declare SHAddToRecentDocs IN shell32;
INTEGER uFlags,; STRING @ lpName Do _clear
= _add ("c:Readme.Txt") = _add ("c:mumu.bmp") Procedure _clear
* clears Documents list in the Windows Start menu = SHAddToRecentDocs (SHARD_PATHA, .null.) Return Procedure _add (lpName)
*****************************************************************
* adds new item to the Documents list * it does not check whether this file really exists = SHAddToRecentDocs (SHARD_PATHA, @lpName) Return ******************************************************************
* Program Name : ElapsedTime.Prg
* Article No. : [Win API] - 024 * Illustrate : 計算開機時間 * Date / Time : 2001.09.25 * Writer : * 1st Post : * My Comment : 用 Win API 的函數(shù)比用 VFP 的計時器控件計算時間 * : 要少開銷資源。 ******************************************************************
Declare LONG GetTickCount IN WIN32API
Local lnAPIRetVal, lnHour, lnMin lnAPIRetVal = GetTickCount() lnHour = ((lnAPIRetVal / 1000) / 60) / 60 lnMin = MOD(((lnAPIRetVal / 1000) / 60), 60) Messagebox("你的電腦已運行了: " + ALLTRIM(STR(lnHour)) + " 小時, " + ; ALLTRIM(STR(lnMin)) + " 分.") ******************************************************************
* Program Name : TaskBar.Prg
* Article No. : [Win API] - 023 * Illustrate : 隱藏或顯示任務(wù)條 [TaskBar] 和 [開始] 按鈕 * Date / Time : 2001.09.25 * Writer : * 1st Post : * My Comment : ******************************************************************
Messagebox("點擊 [確認] 隱藏任務(wù)條 [TaskBar]")
HideTaskBar() Messagebox("點擊 [確認] 顯示任務(wù)條 [TaskBar]") ShowTaskBar() If MESSAGEBOX("是否隱藏 '開始' [Start] 按鈕? 如果要恢復(fù) '開始' ; [Start] 按鈕，必須重新熱啟動 [Reboot] !", 36) = 6 RemoveStartButton() Endif Function HideTaskBar
Declare LONG FindWindow IN "user32" STRING lpClassName, STRING lpWindowName Declare LONG SetWindowPos IN "user32" LONG hWnd, LONG hWndInsertAfter, ; LONG x, LONG Y, LONG cx, LONG cy, LONG wFlags #Define WINDOWHIDE 0x80 #Define WINDOWSHOW 0x40 Local lnHandle lnHandle = FindWindow("Shell_TrayWnd", "") SetWindowPos(lnHandle, 0, 0, 0, 0, 0, WINDOWHIDE) Endfunc Function ShowTaskBar
Declare LONG FindWindow IN "user32" STRING lpClassName, STRING lpWindowName Declare LONG SetWindowPos IN "user32" LONG hWnd, LONG hWndInsertAfter, ; LONG x, LONG Y, LONG cx, LONG cy, LONG wFlags #Define WINDOWHIDE 0x80 #Define WINDOWSHOW 0x40 Local lnHandle lnHandle = FindWindow("Shell_TrayWnd", "") SetWindowPos(lnHandle, 0, 0, 0, 0, 0, WINDOWSHOW) Endfunc Function RemoveStartButton
Declare LONG FindWindow IN "user32" STRING lpClassName, STRING lpWindowName Declare LONG SendMessage IN "user32" LONG hWnd, LONG wMsg, ; LONG wParam, LONG lParam Declare LONG FindWindowEx IN "user32" LONG hWnd1, LONG hWnd2, ; STRING lpsz1, STRING lpsz2 #Define WM_CLOSE 0x10 SendMessage(FindWindowEx(FindWindow("Shell_TrayWnd", ""), 0x0, ; "Button", .NULL.), WM_CLOSE, 0, 0) Endfunc ***************************************************************
[轉(zhuǎn)帖]獲取windows版本
* Program....: GETWINVER.PRG
* Author.....: ** Richard G Bean ** * Date.......: April 3, 2000 * Changed on 01/31/02 - Extended for XP+ **************************************************************** && Don't currently use all these DEFINEs, but could if want to explore Server Versions #DEFINE VER_PLATFORM_WIN32S 0 #DEFINE VER_PLATFORM_WIN32_WINDOWS 1 #DEFINE VER_PLATFORM_WIN32_NT 2 #DEFINE VER_SERVER_NT 0x80000000 #DEFINE VER_WORKSTATION_NT 0x40000000 #DEFINE VER_NT_WORKSTATION 0x00000001 #DEFINE VER_NT_DOMAIN_CONTROLLER 0x00000002 #DEFINE VER_NT_SERVER 0x00000003 #DEFINE VER_SUITE_SMALLBUSINESS 0x00000001 #DEFINE VER_SUITE_ENTERPRISE 0x00000002 #DEFINE VER_SUITE_BACKOFFICE 0x00000004 #DEFINE VER_SUITE_COMMUNICATIONS 0x00000008 #DEFINE VER_SUITE_TERMINAL 0x00000010 #DEFINE VER_SUITE_SMALLBUSINESS_RESTRICTED 0x00000020 #DEFINE VER_SUITE_EMBEDDEDNT 0x00000040 #DEFINE VER_SUITE_DATACENTER 0x00000080 #DEFINE VER_SUITE_SINGLEUSERTS 0x00000100 #DEFINE VER_SUITE_PERSONAL 0x00000200 #DEFINE VER_SUITE_BLADE 0x00000400 #DEFINE FFFF 0x0000FFFF && 65535 Declare LONG GetVersionEx in WIN32API STRING STORE 0 to; dwOSVersionInfoSize,; dwMajorVersion,; dwMinorVersion,; dwBuildNumber,; dwPlatformId,; wServicePackMajor,; wServicePackMinor,; wSuiteMask,; wProductType,; wReserved szCSDVersion = "" PId = "(Unknown)" lczStructure = chr(5*4+127+1+3*2+2*1)+replicate(chr(0), 5*4-1)+space(127)+chr(0); +replicate(chr(0), 3*2+2*1) lcReturn = "" lnResult = GetVersionEx( @lczStructure ) IF lnResult <> 0 && No Error dwOSVersionInfoSize = asc2BEint(lczStructure, 1, 4) dwMajorVersion = asc2BEint(lczStructure, 5, 4) dwMinorVersion = asc2BEint(lczStructure, 9, 4) dwBuildNumber = BITAND(asc2BEint(lczStructure, 13, 4), FFFF) dwPlatformId = asc2BEint(lczStructure, 17, 4) szCSDVersion = ALLTRIM(CHRTRAN(SUBSTR(lczStructure, 21, 128),CHR(0)+CHR(1),"")) IF dwOSVersionInfoSize > 148 wServicePackMajor = asc2BEint(lczStructure, 149, 2) wServicePackMinor = asc2BEint(lczStructure, 151, 2) wSuiteMask = asc2BEint(lczStructure, 153, 2) wProductType = ASC(SUBSTR(lczStructure, 155, 1)) wReserved = ASC(SUBSTR(lczStructure, 156, 1)) ENDIF DO Case Case dwPlatformId = VER_PLATFORM_WIN32S PId = "32s " && "Windows 32s " Case dwPlatformId = VER_PLATFORM_WIN32_WINDOWS PId = "95/98 " && "Windows 95/98 " DO CASE CASE dwMajorVersion = 4 and dwMinorVersion = 0 PId = "95 " && "Windows 95 " lcSubVer = SUBSTR(szCSDVersion, 1, 1) IF INLIST(lcSubVer, "B", "C") PId = PId + "OSR2 " ENDIF CASE dwMajorVersion = 4 and dwMinorVersion = 10 PId = "98 " && "Windows 98 " lcSubVer = SUBSTR(szCSDVersion, 1, 1) IF lcSubVer = "A" PId = PId + "SE " ENDIF CASE dwMajorVersion = 4 and dwMinorVersion = 90 PId = "ME " && "Windows ME " ENDCASE Case dwPlatformId = VER_PLATFORM_WIN32_NT PId = "NT " && "Windows NT " DO CASE CASE dwMajorVersion <= 4 PId = "NT " && "Windows NT " CASE dwMajorVersion = 5 and dwMinorVersion = 0 PId = "2000 " && "Windows 2000 " CASE dwMajorVersion = 5 and dwMinorVersion = 1 PId = "XP " && "Windows XP " IF BITAND(wSuiteMask, VER_SUITE_PERSONAL) <> 0 PId = PId + "Home " ELSE PId = PId + "Pro " ENDIF ENDCASE ENDCASE lcReturn = PId ; + ALLTRIM(transform(dwMajorVersion,"99999")); + "." + ALLTRIM(transform(dwMinorVersion,"99999")); + " (Build "+ ALLTRIM(transform(dwBuildNumber,"99999")); + ":"+ IIF(EMPTY(szCSDVersion),"No SP", szCSDVersion); + ")" ENDIF RETURN lcReturn ****************************************************************** **!* EOP: GETWINVER.PRG * Program....: ASC2BEINT.PRG * Author.....: ** Richard G Bean ** * Date.......: April 3, 2000 * Abstract...: Ascii String to BigEndian Integer (i.e. Most significant byte on right) * (use asc2int() for LittleEndian) * Doesn't return negative numbers * RETURN -1 if any error * Changes....: ******************************************************************* *FUNCTION asc2BEint LPARAMETERS p_cString, p_nStart, p_nLength IF PCOUNT() < 1 OR VARTYPE(p_cString) <> "C" RETURN -1 ENDIF IF PCOUNT() < 2 OR VARTYPE(p_nStart) <> "N" p_nStart = 1 ENDIF IF PCOUNT() < 3 OR VARTYPE(p_nLength) <> "N" p_nLength = LEN(p_cString) ENDIF LOCAL lnRet_val DO CASE CASE p_nLength = 1 lnRet_val = asc(SUBSTR(p_cString, p_nStart, 1)) CASE p_nLength = 2 lnRet_val = asc(SUBSTR(p_cString, p_nStart, 1)); + asc(SUBSTR(p_cString, p_nStart+1, 1))*256 CASE p_nLength = 3 lnRet_val = asc(SUBSTR(p_cString, p_nStart, 1)); + asc(SUBSTR(p_cString, p_nStart+1, 1))*256; + asc(SUBSTR(p_cString, p_nStart+2, 1))*256^2 CASE p_nLength = 4 lnRet_val = asc(SUBSTR(p_cString, p_nStart, 1)); + asc(SUBSTR(p_cString, p_nStart+1, 1))*256; + asc(SUBSTR(p_cString, p_nStart+2, 1))*256^2; + asc(SUBSTR(p_cString, p_nStart+3, 1))*256^3 OTHERWISE lnRet_val = -1 ENDCASE RETURN INT(lnRet_val) *!* EOP: ASC2BEINT.PRG *************************************************************
** 解決grid空格問題
*************************************************************
grid 中一個令人煩惱的問題是,當(dāng)不能找到它的 RecordSource 時發(fā)生混亂. 例如, 你用一個 sql-SELECT 結(jié)果游標(biāo)關(guān)聯(lián)到一個 grid 時, 某一次運行相同的 SELECT 時, 你可能看到的是一個空的 grid. VFP 在準備創(chuàng)建一個新的記錄集時刪除舊的記錄集, 并在那一瞬間 grid 丟失了與它的 RecordSource 的聯(lián)接及所有有關(guān)設(shè)置. 在重運行 SELECT 后, 有一個相同別名的新的游標(biāo), 但是它所基于的臨時表有一個新的名字, 而且 grid 沒有自動的聰明辦法來使用它的新的 RecordSource.
一個方案是在重新運行 sql-SELECT前設(shè)置 Grid.RecordSource 為一個空的串 (""), 并在運行 SQL-SELECT后重新設(shè)置它到游標(biāo)的別名. 這種處理方法在許多情況下,grid 列是按它們在游標(biāo)中的順序顯示的. 在任何 ControlSources 偏離默認的游標(biāo)時會發(fā)生問題. 在那種情況下, 需要重置各列的 ControlSource . 勝于令人討厭地硬編碼各 ControlSource 和危險的潛在的同步問題, 我使用更間接和方法. 在 Grid.Init() 中, 我用各列的細節(jié)填充一個自定義數(shù)組屬性, 然后在稍后用該數(shù)組來重建 grid. 首先設(shè)置一個自定義數(shù)組屬性. 它可以是一個表單屬性或最好是在 grid 類自身中. 在 Grid.Init() 中, DIMENSION 數(shù)組,因此它擁有與 grid 列相同的行, 并且有著你想保存的屬性個數(shù)的列數(shù). 至少, 你可能要保存 ControlSource, CurrentControl, 控件的類, 列頭的標(biāo)題, 列寬及列順序. 然后用 grid 信息填充該數(shù)組, 如下所示: FOR lnColumnCounter = 1 TO This.ColumnCount This.aRestore[lnColumnCounter, ] = <要保存的第一個屬性> This.aRestore[lnColumnCounter,2] = <要保存的第二個屬性> This.aRestore[lnColumnCounter,3] = <要保存的第三個屬性> 等... ENDFOR 任何時候你為 grid重建 RecordSource 時, 你可以遍歷數(shù)組, 從數(shù)組中恢復(fù)各列. 你也可能想用一個自定義方法來處理, 這樣當(dāng)你需要時調(diào)用該方法即可. |
|
|
