|
為您的應(yīng)用程序建立投影式立體窗口(陰影)
--------------------------------------------------------------------------------
一打開WINDOWS，看著四四方方立在桌面上的應(yīng)用程序窗口，您是否有些厭倦？別心煩，在WINDOW世界里，只要您能為之"心動(dòng)",生活總是美麗而又精彩的。因而許許多多愛好"多樣"的CFAN，便為自己的窗口做成了"透明的"、"不規(guī)則的"等樣式。筆者也心血來潮，將自己的窗口做成了"投影式立體窗口"，見下圖1：
怎么樣？Cool吧！
其實(shí)，制作這樣的立體窗口不是非常難，其原理是這樣的（設(shè)要為hWnd窗口做個(gè)立體）：1、獲取hWnd在屏幕上的位置（GetWindowRect），根據(jù)其位置為其建立三個(gè)投影窗口，分別命名LeftForm-左邊投影，DownForm-下面投影，RdForm-右下角投影；2、獲取三個(gè)投影窗口在屏幕上的位置信息，根據(jù)黑色漸變?cè)恚瑢⑵鋵懭肴齻�(gè)投影窗口中。注意：不能直接將其投影信息寫入屏幕DC中，否則的話，桌面將會(huì)被您繪的一踏糊涂。另外：窗口在移動(dòng)、改變大小時(shí)，均應(yīng)該重新繪制投影信息。這個(gè)在VB中不是非常容易做得到，因此我們需要為其增加一個(gè)Timer控件，在Timer事件監(jiān)視這一系列的動(dòng)作。
好了，下面我們開始動(dòng)手做做這種效果：
1、啟動(dòng)VB6.0，建立一個(gè)新的標(biāo)準(zhǔn)exe工程文件，將啟動(dòng)主窗口FormName命名為"MainForm",并將ScaleMode設(shè)置為3,另外再新添建三個(gè)窗口，分別命名為"LeftForm","DownForm","RdForm"，并且將其"BorderStyle"設(shè)置為"0-None"，將各自的GotFocus事件中寫入如下代碼：
MainForm.setfocus
2、新建一個(gè)模塊API.bas(可以用"外接程序"中的"API瀏覽器"),插入如下代碼：
Public Const SRCCOPY = &HCC0020
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Function SelectObject Lib "gdi32" (
ByVal hdc As Long,
ByVal hObject As Long) As Long
Public Declare Function BitBlt Lib "gdi32" (
ByVal hDestDC As Long,
ByVal x As Long,
ByVal y As Long,
ByVal nWidth As Long,
ByVal nHeight As Long,
ByVal hSrcDC As Long,
ByVal xSrc As Long,
ByVal ySrc As Long,
ByVal dwRop As Long) As Long
Public Declare Function SetPixel Lib "gdi32" (
ByVal hdc As Long,
ByVal x As Long,
ByVal y As Long,
ByVal crColor As Long) As Long
Public Declare Function GetPixel Lib "gdi32" (
ByVal hdc As Long,
ByVal x As Long,
ByVal y As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (
ByVal hdc As Long,
ByVal nWidth As Long,
ByVal nHeight As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetWindowRect Lib "user32" (
ByVal hwnd As Long,
lpRect As RECT) As Long
'取色彩中的Red的值
Public Function GetRed(ByVal n As Long) As Integer
GetRed = n Mod 256&
End Function
'取色彩中的Green的值
Public Function GetGreen(ByVal n As Long) As Integer
GetGreen = (n \ 256&) Mod 256&
End Function
'取色彩中的Blue的值
Public Function GetBlue(ByVal n As Long) As Integer
GetBlue = n \ 65536
End Function
'獲取漸變色彩值
'入口參數(shù)：SrcColor 原色彩
' Steps 步驟數(shù)
' CurStep 當(dāng)前的步子
' DstColor 目標(biāo)色彩
'返回值：當(dāng)月前的色彩值
Public Function GetTrienColor(ByVal scrColor As Long,
ByVal dstColor As Long, ByVal Steps As Integer,
ByVal curStep As Integer) As Long
Dim sR, sG, sB, dR, dG, dB As Integer
sR = GetRed(scrColor)
sG = GetGreen(scrColor)
sB = GetBlue(scrColor)
dR = GetRed(dstColor)
dG = GetGreen(dstColor)
dB = GetBlue(dstColor)
sR = sR + curStep * (dR - sR) / Steps
sG = sG + curStep * (dG - sG) / Steps
sB = sB + curStep * (dB - sB) / Steps
GetTrienColor = RGB(sR, sG, sB)
End Function
其工程文件結(jié)構(gòu)如圖2：
圖2
3、將MainForm窗體設(shè)計(jì)成如圖3，且將窗體Code中加入如下代碼：
Option Explicit
Dim ShowdawDepth As Integer
Dim WinX, WinY, WinW, WinH, wx, wy, xw, xh As Long
Dim ShowdawColor As Long
Private Sub GetWandH()
Dim r As RECT
wy = MainForm.Top
wx = MainForm.Left
Call GetWindowRect(MainForm.hwnd, r) '獲取當(dāng)前窗口在屏幕上的位置
WinX = r.Left
WinY = r.Top
WinH = r.Bottom - r.Top + 1
WinW = r.Right - r.Left + 1
'重新調(diào)整左邊投影的位置
LeftForm.Left = CLng(ScaleX(r.Right, 3, 1) + 0.5)
LeftForm.Top = CLng(ScaleY(r.Top, 3, 1) + 0.5)
LeftForm.Width = xw
LeftForm.Height = CLng(ScaleY(WinH, 3, 1) + 0.5)
'重新調(diào)整下邊投影的位置
DownForm.Width = CLng(ScaleX(WinW, 3, 1) + 0.5)
DownForm.Height = xh
DownForm.Top = CLng(ScaleY(r.Bottom, 3, 1) + 0.5)
DownForm.Left = CLng(ScaleX(r.Left, 3, 1) + 0.5)
'重新調(diào)整右下角邊投影的位置
RdForm.Top = CLng(ScaleY(r.Bottom, 3, 1) + 0.5)
RdForm.Left = CLng(ScaleX(r.Right, 3, 1) + 0.5)
RdForm.Width = xw
RdForm.Height = xh
End Sub
Private Sub Command1_Click()
Unload MainForm
End Sub
Private Sub Form_Load()
ShowdawDepth = 10
xh = CLng(ScaleY(ShowdawDepth, 3, 1) + 0.5)
xw = CLng(ScaleX(ShowdawDepth, 3, 1) + 0.5)
ShowdawColor = 0
Timer1.Interval = 100
dlg.CancelError = True
labColor.BorderStyle = 1
labColor.BackStyle = 1
labColor.BackColor = ShowdawColor
End Sub
Private Sub Paint() '窗口繪制
Dim hScreenDc, hMemLeftDc, hMemDownDc, hMemRdDc, x, y As Long
Dim hMemLeftBit, hMemDownBit, hMemRdBit, curColor, srcColor As Long
LeftForm.Visible = False
DoEvents
DownForm.Visible = False
DoEvents
RdForm.Visible = False
DoEvents
hScreenDc = GetDC(0) '獲取桌面DC
hMemLeftDc = CreateCompatibleDC(hScreenDc)
hMemLeftBit = CreateCompatibleBitmap(hScreenDc, ShowdawDepth, WinH)
SelectObject hMemLeftDc, hMemLeftBit
hMemDownDc = CreateCompatibleDC(hScreenDc)
hMemDownBit = CreateCompatibleBitmap(hScreenDc, WinW, ShowdawDepth)
SelectObject hMemDownDc, hMemDownBit
hMemRdDc = CreateCompatibleDC(hScreenDc)
hMemRdBit = CreateCompatibleBitmap(hScreenDc, ShowdawDepth, ShowdawDepth)
SelectObject hMemRdDc, hMemRdBit
For y = 0 To WinH - 1
For x = 0 To ShowdawDepth - 1 '左邊的投影
srcColor = GetPixel(hScreenDc, WinW + WinX + x, WinY + y)
If srcColor <> -1 Then
If y < ShowdawDepth And x < y Or y >= ShowdawDepth Then
curColor = GetTrienColor(ShowdawColor, srcColor, ShowdawDepth, x)
Else
curColor = srcColor
End If
SetPixel hMemLeftDc, x, y, curColor
End If
Next x
Next y
For y = 0 To ShowdawDepth - 1 '右下角的投影
For x = 0 To ShowdawDepth - 1
srcColor = GetPixel(hScreenDc, WinW + WinX + x, WinY + WinH + y)
If srcColor <> -1 Then
If x <= y Then
curColor = GetTrienColor(ShowdawColor, srcColor, ShowdawDepth, y)
Else
curColor = GetTrienColor(ShowdawColor, srcColor, ShowdawDepth, x)
End If
SetPixel hMemRdDc, x, y, curColor
End If
Next x
Next y
For y = 0 To ShowdawDepth - 1
For x = 0 To WinW - 1
srcColor = GetPixel(hScreenDc, WinX + x, WinY + WinH + y)
If srcColor <> -1 Then
If y < ShowdawDepth And x >= y Or x >= ShowdawDepth Then
curColor = GetTrienColor(ShowdawColor, srcColor, ShowdawDepth, y)
Else
curColor = srcColor
End If
SetPixel hMemDownDc, x, y, curColor
End If
Next x
Next y
LeftForm.Visible = True
DoEvents
Call BitBlt(LeftForm.hdc, 0, 0, ShowdawDepth, WinH, hMemLeftDc, 0, 0, SRCCOPY)
DownForm.Visible = True
DoEvents
Call BitBlt(DownForm.hdc, 0, 0, WinW, ShowdawDepth, hMemDownDc, 0, 0, SRCCOPY)
RdForm.Visible = True
DoEvents
Call BitBlt(RdForm.hdc, 0, 0, ShowdawDepth, ShowdawDepth, hMemRdDc, 0, 0, SRCCOPY)
DeleteDC hMemLeftDc
DeleteDC hMemDownDc
DeleteDC hScreenDc
DeleteDC hMemRdDc
DeleteObject hMemLeftBit
DeleteObject hMemRdBit
DeleteObject hMemDownBit
End Sub
Private Sub Form_Resize()
If MainForm.WindowState = vbNormal Then '窗口在正常狀態(tài)下才顯示立體投影
If MainForm.Height < 2 * xh Then MainForm.Height = 2 * xh
If MainForm.Width < 2 * xw Then MainForm.Width = 2 * xw
Call GetWandH
Call Paint
Else
wx = -1
LeftForm.Visible = False
DownForm.Visible = False
RdForm.Visible = False
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unload LeftForm
Unload DownForm
Unload RdForm
End Sub
Private Sub labColor_Click()
On Error GoTo exitLabColor
dlg.ShowColor
ShowdawColor = dlg.Color
labColor.BackColor = ShowdawColor
Call Paint
exitLabColor:
End Sub
Private Sub Timer1_Timer()
If MainForm.WindowState = vbNormal And (MainForm.Left <> wx Or MainForm.Top <> wy) Then
Call GetWandH
Call Paint
End If
End Sub
Private Sub Form_Paint()
Call GetWandH
Call Paint
End Sub
Private Sub UpDown_Change()
ShowdawDepth = UpDown.Max + UpDown.Min - UpDown.Value
ShowSize.Text = ShowdawDepth
xh = CLng(ScaleY(ShowdawDepth, 3, 1) + 0.5)
xw = CLng(ScaleX(ShowdawDepth, 3, 1) + 0.5)
Call GetWandH
Call Paint
End Sub
此至，您可以按下Play，看看您親手做的這種投影效果。注意：以上的投影大小不能太大，否則速度會(huì)變慢。(2000年2月14日完稿，本文發(fā)表于《電腦編程技術(shù)與維護(hù)》2000年第7期,Word版文檔下載地址為：http://www.i0713.net/Download/Prog/Dragon/Doc/Showdaw.doc,
源程序下載地址：htttp://www.i0713.net/Download/Prog/Dragon/Prog/Showdaw.zip
|
