|
发信人: zhenbao(闲云孤鹤) 整理人: hunter__fox(2002-03-16 22:47:22), 站内信件 |
| 【 在 ming_qian 的大作中提到：】
:如何改变VFP表单的外观呀??现在的不好看呀.?? :...... 那就不要外观了，自己做！ 这是一个圆型的表单！ Public frm frm = CreateObject ("Tform") frm.Visible = .T. Define CLASS Tform As Form #Define badgeDiameter 264 #Define topMargin 4 #Define leftMargin 2 Width = 800 Height = 350 AutoCenter = .t. AlwaysOnTop= .t. BorderStyle= 2 ShowWindow = 2 WindowType = 1 Caption = "登录表单" Picture="11.jpg" mouseX = 0 mouseY = 0 hRgn=0 Add OBJECT lbl As Label WITH; Caption="您的口令:", FontName="Arial", FontSize=14,; Bold=.T., Forecolor=Rgb(0,0,255), BackStyle=0,; Alignment=2, Left=20, Width=100, Top=130, Height=25 Add OBJECT txt As TextBox WITH; Width=100, Height=24, Left=120, Top=130,; PasswordChar="*" Add OBJECT cmd As CommandButton WITH; Width=60, Height=25, Left=104, Top=165,; Caption="确 定", Default=.T. Procedure Load Do decl Endproc Procedure Activate This.RegionOn Endproc Procedure RegionOn #Define SM_CYSIZE 31 #Define SM_CXFRAME 32 #Define SM_CYFRAME 33 If THIS.hRgn <> 0 Return && the region is already set Endif Local hwnd, x0, y0, x1, y1 * calculating the position of the region * based on some Windows system metrics x0 = GetSystemMetrics (SM_CXFRAME) +; leftMargin y0 = GetSystemMetrics (SM_CYSIZE) +; GetSystemMetrics (SM_CYFRAME) + topMargin x1 = x0 + badgeDiameter y1 = y0 + badgeDiameter * creating an elliptical region to be applied to the form * its the visible part displays exactly the badge This.hRgn = CreateEllipticRgn (x0, y0, x1, y1) HWnd = GetFocus() *** the next line makes a difference If SetWindowRgn (hwnd, THIS.hRgn, 1) = 0 * applying the region fails -- the handle to be released = DeleteObject (THIS.hRgn) This.hRgn = 0 Endif *** ---------------------------- Endproc Procedure _move * MouseMove returns relative cursor position; using this makes the form twitching; * a sort of a feedback: moving the form fires the MouseMove event again * with already recalculated coordinates -- and then over and over again * This sounds pretty obscure, eh? prove me wrong :) Local lnX, lnY, lnPosX, lnPosY = getMousePos (@lnX, @lnY) && gets cursor absolute position If Not (ThisForm.mouseX = lnX And ThisForm.mouseY = lnY) * moves the form only if cursor absolute position changed lnPosX = ThisForm.Left + (lnX - ThisForm.mouseX) lnPosY = ThisForm.Top + (lnY - ThisForm.mouseY) Thisform.Move (lnPosX, lnPosY) * stores the current Thisform.mouseX = lnX Thisform.mouseY = lnY Endif Endproc Procedure MouseDown Lparameters nButton, nShift, nXCoord, nYCoord * stores cursor absolute position If nButton = 1 Local lnX, lnY = getMousePos (@lnX, @lnY) Thisform.mouseX = lnX Thisform.mouseY = lnY Endif Endproc Procedure MouseMove Lparameters nButton, nShift, nXCoord, nYCoord If nButton = 1 Thisform._move && moves the form Endif Endproc Procedure cmd.Click =messagebox(allt(thisform.txt.value), 64, "您输入的密码为:",1000) Thisform.Release Endproc Enddefine Procedure decl Declare INTEGER GetFocus IN user32 Declare INTEGER DeleteObject IN gdi32 INTEGER hObject Declare SHORT GetCursorPos IN user32 STRING @ lpPoint Declare INTEGER GetSystemMetrics IN user32 INTEGER nIndex Declare INTEGER CreateEllipticRgn IN gdi32; INTEGER nLeftRect, INTEGER nTopRect,; INTEGER nRightRect, INTEGER nBottomRect Declare INTEGER SetWindowRgn IN user32; INTEGER hWnd, INTEGER hRgn, INTEGER bRedraw Endproc Procedure getMousePos (x, y) Local lcBuffer lcBuffer = Repli(Chr(0), 8) = GetCursorPos (@lcBuffer) x = buf2dword(SUBSTR(lcBuffer, 1,4)) Y = buf2dword(SUBSTR(lcBuffer, 5,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 这是一个可调透明度的表单 注：不能运行在98，SE，ME下 PUBLIC oform1 oform1=NEWOBJECT("form1") oform1.Show RETURN DEFINE CLASS form1 AS form Top = 72 Left = 169 Height = 250 Width = 376 ShowWindow = 2 DoCreate = .T. Caption = "透明窗口 zhenbao珍宝 [email protected]" Closable = .F. MaxButton = .F. MinButton = .F. Name = "Form1" ADD OBJECT olecontrol1 AS olecontrol WITH ; Top = 160, ; Left = 50, ; Height = 36, ; Width = 264, ; Name = "Olecontrol1" ,; oletypeallowed=-2 ,; max = 25,; min = 10,; OLEclass="MSCOMCTLLIB.Slider.2" ADD OBJECT shape1 AS shape WITH ; Top = 10, ; Left = 6, ; Height = 139, ; Width = 354, ; Name = "Shape1" ADD OBJECT label1 AS label WITH ; FontSize = 12, ; Caption = "说 明 ", ; Height = 16, ; Left = 25, ; Top = 3, ; Width = 41, ; Name = "Label1" ADD OBJECT label3 AS label WITH ; FontSize = 12, ; Caption = "操作系统要为Windows 2000、WinXP 2600、", ; Height = 39, ; Left = 17, ; Top = 25, ; Width = 335, ; Name = "Label3" ADD OBJECT label4 AS label WITH ; FontSize = 12, ; Caption = "WinNT For SP6.", ; Height = 16, ; Left = 17, ; Top = 54, ; Width = 288, ; Name = "Label4" ADD OBJECT label5 AS label WITH ; FontSize = 12, ; Caption = "不能运行在98、me、等下面。因为调用2000等", ; Height = 16, ; Left = 15, ; Top = 81, ; Width = 324, ; Name = "Label5" ADD OBJECT label2 AS label WITH ; FontSize = 12, ; Caption = "的OLE控件。", ; Height = 16, ; Left = 16, ; Top = 110, ; Width = 324, ; Name = "Label2" ADD OBJECT label6 AS label WITH ; Caption = "透明", ; Height = 16, ; Left = 23, ; Top = 195, ; Width = 26, ; Name = "Label6" ADD OBJECT label7 AS label WITH ; Caption = "不透明", ; Height = 16, ; Left = 315, ; Top = 198, ; Width = 41, ; Name = "Label7" ADD OBJECT command1 AS commandbutton WITH ; Top = 219, ; Left = 154, ; Height = 25, ; Width = 60, ; Caption = "退出", ; Name = "Command1" PROCEDURE Init DODEFAULT() #DEFINE BADOS_LOC "不好意思，只能运行在WINDOWS 2000下." IF VAL(OS(3))<5 MESSAGEBOX(BADOS_LOC) RETURN .F. ENDIF DECLARE SetWindowLong In Win32Api AS _Sol_SetWindowLong Integer, Integer, Integer DECLARE SetLayeredWindowAttributes In Win32Api AS _Sol_SetLayeredWindowAttributes Integer, String, Integer, Integer _Sol_SetWindowLong(THISFORM.hWnd, -20, 0x00080000) _Sol_SetLayeredWindowAttributes(THISFORM.hWnd, 0, 255, 2) THISFORM.Olecontrol1.SetFocus() ENDPROC PROCEDURE Destroy CLEAR DLLS _Sol_SetWindowLong CLEAR DLLS _Sol_SetLayeredWindowAttributes ENDPROC PROCEDURE olecontrol1.Change *** ActiveX Control Event *** LOCAL lnValue DO CASE CASE THIS.Value = 0 lnValue = 0 CASE THIS.Value = 25 lnValue = 255 OTHERWISE lnValue = THIS.Value * 10 ENDCASE _Sol_SetLayeredWindowAttributes(THISFORM.hWnd, 0, lnValue, 2) ENDPROC PROCEDURE command1.Click thisform.Release ENDPROC ENDDEFINE * *-- EndDefine: form1 ************************************************** ----  |
|
[关闭][返回] |