VISUAL DBTOOLS VD2.2 SAMPLE 交流園地 發表人 - daniellee 於 2002/11/19 14:41:40

請各位同好多多豐富這塊園地!

------
Jaime Tsao

引言: VD2.2 SAMPLE 交流討論區

這是什麼??? -- 聰明的人，喜歡猜心；雖然每次都猜對了，卻失去了自己的心 傻氣的人，喜歡給心；雖然每次都被笑了，卻得到了別人的心

恭喜大家，有新家了。

VD2.2使用shellexecute的方法 H=LOAD("SHELL32.DLL") &&傳回一個DLL HANDLE於H變數中 X=CALL(H,"ShellExecuteA","5LL****L",VDHANDLE(),'OPEN','http://www.jet.com.tw','','',0) RELEASE(H) && 將DLL釋放

------
Jaime Tsao

嗯....    有一個好的開始....就算是成功了一半.... 期待在這裡能看到更多朋友的加入....

看不懂... 可否請教一下這個是什麼ㄋ?? thanks... chih..

引言: VISUAL DBTOOLS VD2.2 SAMPLE 交流園地 發表人 - daniellee 於 2002/11/19 14:41:40

VD2.X是訊光科技以DELPHI開發的CASE TOOL,因為在VD使用WINDOWS 32API函數有其自訂的格式,所以將一個範例POST上來提供大家作為參考!或許透過WIN 32API函數的使用,可用來彌補VD2.X某些不足呢? Jaime Tsao

------
Jaime Tsao

VD2.X使用ACTIVE X元件"MSComDlg.CommonDialog"顯示印表機設定視窗的範例,請參考! MYOBJ=NEWOBJ("TVDOLEOBJECT","","MAIN","",.F.) MYOBJ.OLENAME="MSComDlg.CommonDialog" MYOBJ.ACTIVE=1 MYOBJ.EXECPROC("ShowPrinter") DELOBJ(MYOBJ) Jaime Tsao

------
Jaime Tsao

那應該去訊光的網站,來ktop,這......    

引言: VD2.X使用ACTIVE X元件"MSComDlg.CommonDialog"顯示印表機設定視窗的範例,請參考! MYOBJ=NEWOBJ("TVDOLEOBJECT","","MAIN","",.F.) MYOBJ.OLENAME="MSComDlg.CommonDialog" MYOBJ.ACTIVE=1 MYOBJ.EXECPROC("ShowPrinter") DELOBJ(MYOBJ) Jaime Tsao

版主大大： 因為訊光的討論區不提供檔案上傳，vd2 的user 想要分享一些sample 互相交流 因苦無平台，所以借貴寶地一用，希望能有容身之地。 sample 大小一般都不會很大的。 因 vd2 也是用 delphi 開發出來的，所以才想攀點親帶點故，來此借版交流。不知版主您意下如何？

引言: 版主大大： 因為訊光的討論區不提供檔案上傳，vd2 的user 想要分享一些sample 互相交流 因苦無平台，所以借貴寶地一用，希望能有容身之地。 sample 大小一般都不會很大的。 因 vd2 也是用 delphi 開發出來的，所以才想攀點親帶點故，來此借版交流。不知版主您意下如何？

是不是該徵求一下站長的同意嘛? ～～～Delphi K.Top討論區站長～～～

Sorry! 偶是新生，還沒進入狀況， 我以為版主就是站長啦!沒注意是哪個版的版主， 因為我不是申請本版者，只是代為發言， 以為申請者已經取得站長的同意才獲得此版。 站長，您就高抬貴手，可憐一下我們啦！ 會用 VD2 的USER 一般也多少會接觸 DELPHI，只是 VD2 經過再包裝。 DELPHI 的部分還要跟站上前輩多學習。

引言: Sorry! 偶是新生，還沒進入狀況， 我以為版主就是站長啦!沒注意是哪個版的版主， 因為我不是申請本版者，只是代為發言， 以為申請者已經取得站長的同意才獲得此版。 站長，您就高抬貴手，可憐一下我們啦！ 會用 VD2 的USER 一般也多少會接觸 DELPHI，只是 VD2 經過再包裝。 DELPHI 的部分還要跟站上前輩多學習。

好的,下不為例喔! 但是,只是一個討論主題,將來POST的文章若愈來愈多, 文章會分很多頁咧! 訊光科技應該盡早架好自己的討論區才是長久之計吧? ～～～Delphi K.Top討論區站長～～～

請問如何附加檔案?

請參考 如何發表一篇圖文並茂的文章? http://delphi.ktop.com.tw/topic.php?TOPIC_ID=7332

------
**********************************************************
哈哈&兵燹
最會的2大絕招 這個不會與那個也不會 哈哈哈 粉好

Delphi K.Top的K.Top分兩個字解釋Top代表尖端的意思,希望本討論區能提供Delphi的尖端新知
K.表Knowlege 知識,就是本站的標語:Open our mind

有提供按鍵模擬函式,網址如下,不可用在商業行為上: http://www.froggy.com.au/andromeda/software/pushkeys/ (keypush.dll/pushkeys.hlp) 我下載測試還可以用,使用方法可查HELP 假設FORM 上有3個EDIT h=load("KEYPUSH.DLL") edit0.Focused() call(h,"PushKeys","5L**","ANDYABCD") &&在EDIT0 輸入ANDYABC call(h,"PushKeys","5L**","{DOWN}") &&游標移至EDIT1 call(h,"PushKeys","5L**",{CAPSLOCK}) &大/小寫切換 call(h,"PushKeys","5L**","ANDYTTY") &&在EDIT1 輸入ANDYTTY call(h,"PushKeys","5L**","{DOWN}") && &&游標移至EDIT2 call(h,"PushKeys","5L**","My report")&&在EDIT2 輸入My report release(H) ========================== 呼叫notepad.exe 輸入資料 h=load("KEYPUSH.DLL") WRUN("notepad.exe",.t.) call(h,"PushKeys","5L**","ABC~PPO~KJHSKDFSJKDHW") call(h,"PushKeys","5L**","^(' ')") && CTRL SPACE 中文切換 call(h,"PushKeys","5L**","FU,41") release(H) 中文輸入有一點問題 =============== 呼叫calc.exe 輸入計算資料傳回值 h=load("KEYPUSH.DLL") WRUN("calc.exe",.t.) call(h,"PushKeys","5L**","15*8{ENTER}") &&輸入15*8 return 15*8:可寫成變數 call(h,"PushKeys","5L**","^(C)") &&ctrl c 拷貝 call(h,"PushKeys","5L**","{SLEEP 2}%{F4}") && 暫停 2 sec /alt f4 結束計算機 edit3.Focused() call(h,"PushKeys","5L**","{SLEEP 2}^(V)") && ctrl V 貼上 這裹有計算,有copy,但貼上有點問題 其他功能看 help 希望對你有一點幫助

library reg; uses SysUtils, Classes,Registry,Windows; {$R *.RES} function GetReg(RootNo: Integer; Key, Value: PChar):PChar;stdcall; var Reg: TRegistry; RegDataType: TRegDataType; DataSize, Len: integer; s: string; label cantread; begin Reg := nil; try Reg := TRegistry.Create(KEY_QUERY_VALUE); //Reg.RootKey := RootKey; //1:HKEY_CLASSES_ROOT //2:HKEY_CURRENT_USER //3:HKEY_LOCAL_MACHINE //4:HKEY_USERS //5:HKEY_CURRENT_CONFIG case RootNo of 1:Reg.RootKey:=HKEY_CLASSES_ROOT; 2:Reg.RootKey:=HKEY_CURRENT_USER; 3:Reg.RootKey:=HKEY_LOCAL_MACHINE; 4:Reg.RootKey:=HKEY_USERS; 5:Reg.RootKey:=HKEY_CURRENT_CONFIG; else Result:=Pchar('*'); Reg.Free; exit; end; if Reg.OpenKeyReadOnly(Key) then begin try RegDataType := Reg.GetDataType(PChar(Value)); if (RegDataType = rdString) or (RegDataType = rdExpandString) then Result := PChar(Reg.ReadString(PChar(Value))) else if RegDataType = rdInteger then Result := PChar(Reg.ReadInteger(Value)) else if RegDataType = rdBinary then begin DataSize := Reg.GetDataSize(Value); if DataSize = -1 then goto cantread; SetLength(s, DataSize); Len := Reg.ReadBinaryData(Value, PChar(s)^, DataSize); if Len <> DataSize then goto cantread; Result := Pchar(s); end else cantread: raise Exception.Create(SysErrorMessage(ERROR_CANTREAD)); except s := ''; // Deallocates memory if allocated Reg.CloseKey; raise; end; Reg.CloseKey; end else raise Exception.Create(SysErrorMessage(GetLastError)); except Reg.Free; raise; end; Reg.Free; end; //----------------- function SetRegStr(RootNo: Integer; Key, Value: PChar; RegDataType: Integer ; Data: PChar):PChar;stdcall; var Reg: TRegistry; s: string; begin Reg := TRegistry.Create(KEY_WRITE); try //Reg.RootKey := RootKey; case RootNo of 1:Reg.RootKey:=HKEY_CLASSES_ROOT; 2:Reg.RootKey:=HKEY_CURRENT_USER; 3:Reg.RootKey:=HKEY_LOCAL_MACHINE; 4:Reg.RootKey:=HKEY_USERS; 5:Reg.RootKey:=HKEY_CURRENT_CONFIG; else Reg.Free; Result:=Pchar('*'); exit; end; if Reg.OpenKey(Key, True) then begin try //if RegDataType = ord(rdUnknown) then // RegDataType := Reg.GetDataType(Value); if RegDataType = ord(rdString) then Reg.WriteString(Value, Data) else if RegDataType = ord(rdExpandString) then Reg.WriteExpandString(Value, Data) else if RegDataType = ord(rdBinary) then begin s := Data; Reg.WriteBinaryData(Value, PChar(s)^, Length(s)); end else raise Exception.Create(SysErrorMessage(ERROR_CANTWRITE)); except Reg.CloseKey; raise; end; Result :=Pchar('OK'); Reg.CloseKey; end else raise Exception.Create(SysErrorMessage(GetLastError)); finally Reg.Free; end; end; function SetRegInt(RootNo: Integer; Key, Value: PChar; RegDataType: Longint ; Data:Integer):PChar;stdcall; var Reg: TRegistry; begin Reg := TRegistry.Create(KEY_WRITE); try //Reg.RootKey := RootKey; case RootNo of 1:Reg.RootKey:=HKEY_CLASSES_ROOT; 2:Reg.RootKey:=HKEY_CURRENT_USER; 3:Reg.RootKey:=HKEY_LOCAL_MACHINE; 4:Reg.RootKey:=HKEY_USERS; 5:Reg.RootKey:=HKEY_CURRENT_CONFIG; else Reg.Free; Result:=Pchar('*'); exit; end; if Reg.OpenKey(Key, True) then begin try if RegDataType = ord(rdInteger) then Reg.WriteInteger(Value, Data) else raise Exception.Create(SysErrorMessage(ERROR_CANTWRITE)); except Reg.CloseKey; raise; end; Result :=Pchar('OK'); Reg.CloseKey; end else raise Exception.Create(SysErrorMessage(GetLastError)); finally Reg.Free; end; end; exports GetReg,SetRegStr,SetRegInt; end. ====================================================== Reg 登錄檔,reg.dll使用方法 讀取reg:GetReg, 寫入reg:SetRegStr,SetRegInt GetReg(RootKey,key,資料項): RootKey: ** 1:HKEY_CLASSES_ROOT ** 2:HKEY_CURRENT_USER ** 3:HKEY_LOCAL_MACHINE ** 4:HKEY_USERS ** 5:HKEY_CURRENT_CONFIG DataType: ----------------- 1: String 2:ExpandString 3:Integer 4:Binary **讀取reg** h=load("reg.dll") x=call(h,"GetReg","5*L**",3,"\Hardware\Description\System\CentralProcessor\0","Identifier") WARNING(X) SetRegStr(RootKey,key,資料項目,DataType,資料) **寫入reg 字串 :String** x=call(h,"SetRegStr","5*L**L*",3,"\Software\Microsoft\Windows\CurrentVersion\JYC","COMPANY",1,"ABC股份有限公司") WARNING(X) **寫入reg 字串:Integer** x=call(h,"SetRegInt","5*L**LL",3,"\Software\Microsoft\Windows\CurrentVersion\JYC","Number",3,21167) WARNING(X)

抓取螢幕上某一座標之顏色 library scrgb; uses SysUtils, Classes,Graphics,Messages,Windows; {$R *.RES} Function GetRGB(xx,yy:Integer):PChar;stdcall; var Pixelcol:TColor; ScreenDc:HDC; cr,cg,cb,s:String; begin ScreenDc:=GetDc(0); Pixelcol:=GetPixel(ScreenDc,xx,yy); CR:=IntToStr(GetRValue(Pixelcol)); CG:=IntToStr(GetGValue(Pixelcol)); CB:=IntToStr(GetBValue(Pixelcol)); S:='R=' CR ';' 'G=' CG ';' 'B=' CB ';'; ReleaseDC(0,ScreenDc); Result:=Pchar(S); end ; Function GetR(xx,yy:Integer):PChar;stdcall; var Pixelcol:TColor; ScreenDc:HDC; cr:String; begin ScreenDc:=GetDc(0); Pixelcol:=GetPixel(ScreenDc,xx,yy); CR:=IntToStr(GetRValue(Pixelcol)); ReleaseDC(0,ScreenDc); Result:=Pchar(CR); end ; Function GetG(xx,yy:Integer):PChar;stdcall; var Pixelcol:TColor; ScreenDc:HDC; cg:String; begin ScreenDc:=GetDc(0); Pixelcol:=GetPixel(ScreenDc,xx,yy); CG:=IntToStr(GetGValue(Pixelcol)); ReleaseDC(0,ScreenDc); Result:=Pchar(CG); end ; Function GetB(xx,yy:Integer):PChar;stdcall; var Pixelcol:TColor; ScreenDc:HDC; cb:String; begin ScreenDc:=GetDc(0); Pixelcol:=GetPixel(ScreenDc,xx,yy); CB:=IntToStr(GetBValue(Pixelcol)); ReleaseDC(0,ScreenDc); Result:=Pchar(CB); end ; exports GetRGB,GetR,GetG,GetB; end. ========================== **取出某螢幕 x,y點 RGB 顏色 h=load("scrgb.dll") **取出X,Y 點RGB** x=call(h,"GetRGB","5*LL",175,94) Warning(x) **字串分解** Warning('r=' utl.parstring2(x,'R=',';')) Warning('g=' utl.parstring2(x,'G=',';')) Warning('b=' utl.parstring2(x,'B=',';')) *** 各別取出 R,G,B *** x=call(h,"GetR","5*LL",175,94) Warning(x) x=call(h,"GetG","5*LL",175,94) Warning(x) x=call(h,"GetB","5*LL",175,94) Warning(x) RELEASE(H) *************************** utl.parstring2 Parameter str_pardat,str_beg,str_end f_tempback ='' li_lens1 = Len( str_beg ) li_lens2 = Len( str_end ) li_pos1 = at(Upper(str_beg), Upper(str_pardat) ) lp=li_pos1 li_pos2=0 Do While lp<=len(str_pardat) if Upper(Substr(str_pardat,lp,1))=Upper(str_end) li_pos2=lp exit endif lp=lp 1 EndDo If li_pos1 <>0 .and. li_pos2 <> 0 f_tempBack = Substr( str_pardat , li_pos1 li_lens1 ,li_pos2 - li_pos1 -li_lens1 ) Else f_tempback = str_pardat Endif return(f_tempback)