گرافيك فرم ها در ويژرال بيسيك
گرافيك فرم ها در ويژال بيسيك
اين مقاله يك مقاله ي منحصر به فرد است شايد كمي زياد باشد ولي ارزش خواندن و استفاده از ان را حتما دارد
1.تبديل فرم به اشكال مختلف
CreateEllipticRgn
اين تابع يك ناحيه به شكل بيضي شكل با اندازه دلخواه مي سازد.كه مي توان به كمك تابع SetWindowRgn فرم را به آن شكل در آورد.
Declare Function CreateEllipticRgn Lib "gdi32" Alias "CreateEllipticRgn" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
مقدار برگشتي : اگر تابع موفق باشد مقدار برگشتي اشاره گر از ناحيه ساخته شده مي باشد و اگر با خطا مواجه شود مقدار برگشتي صفر خواهد بود.
پارامترها:
X1 : مختصات x گوشه سمت چپ- بالاي چهارگوش مي باشد كه بيضي ساخته شده بايد در آن احاطه شود.
Y1 : مختصات y گوشه سمت چپ- بالاي چهارگوش مي باشد كه بيضي ساخته شده بايد در آن احاطه شود.
X2 : مختصات x گوشه سمت راست- پايين چهارگوش مي باشد كه بيضي ساخته شده بايد در آن احاطه شود.
Y2 : مختصات Y گوشه سمت راست- پايين چهارگوش مي باشد كه بيضي ساخته شده بايد در آن احاطه شود.
توجه : واحد همه اين مقادير Pixel است.
CreateEllipticRgnIndirect
اين تابع يك ناحيه به شكل بيضي شكل با اندازه دلخواه مي سازد.كه مي توان به كمك تابع SetWindowRgn فرم را به آن شكل در آورد.
Declare Function CreateEllipticRgnIndirect Lib "gdi32" Alias "CreateEllipticRgnIndirect" (lpRect As Rect) As Long
مقدار برگشتي : اگر تابع موفق باشد مقدار برگشتي اشاره گر از ناحيه ساخته شده مي باشد و اگر با خطا مواجه شود مقدار برگشتي صفر خواهد بود.
پارامتر:
LpRect : اين متغير به ساختاري به نام Rect اشاره دارد كه فيلدهاي آن مشخصات گوشه ي سمت چپ-بالا و گوشه سمت راست-پايين چهارگوش فرضي را مشخص مي كنند.فيلدهاي اين ساختار دقيقا مثل متغيرهاي تابع CreateEllipticRgn است.
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
CreatePolygonRgn
اين تابع ، يك ناحيه چند ضلعي به اندازه دلخواه مي سازد. كه مي توان به كمك تابع SetWindowRgn فرم را به آن شكل در آورد.
Declare Function CreatePolygonRgn Lib "gdi32" Alias "CreatePolygonRgn" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
مقدار برگشتي : اگر تابع موفق باشد مقدار برگشتي اشاره گر از ناحيه ساخته شده مي باشد و اگر با خطا مواجه شود مقدار برگشتي صفر خواهد بود.
پارامترها:
lpPoint : اين متغير يك آرايه مي باشد كه مختصات x,y راس هاي چند ضلعي را در خود نگه مي دارد .
nCount : مقدار اين پارامتر ، تعداد راس هاي چند ضلعي مي باشد.
nPolyFillMode : مقدار اين متغير نوع پرشدن چند ضلعي را مشخص مي كند كه مي تواند يكي از موارد Winding يا Alternate باشد.
به اين مثال توجه كنيد:
Private Type COORD
x As Long
y As Long
End Type
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Const ALTERNATE = 1 ' ALTERNATE and WINDING are
Const WINDING = 2 ' constants for FillMode.
Private Sub Form_Paint()
Dim hRgn As Long, NumCoords As Long
Dim poly(1 To 3) As COORD
NumCoords = 3
Me.ScaleMode = vbPixels
poly(1).x = Form1.ScaleWidth / 2
poly(1).y = Form1.ScaleHeight / 2
poly(2).x = Form1.ScaleWidth / 4
poly(2).y = 3 * Form1.ScaleHeight / 4
poly(3).x = 3 * Form1.ScaleWidth / 4
poly(3).y = 3 * Form1.ScaleHeight / 4
hRgn = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE)
SetWindowRgn Me.hWnd, hRgn, True
End Sub
Private Sub Form_Resize()
Form_Paint
End Sub
Private Sub Form_Unload(Cancel As Integer)
DeleteObject hRgn
End Sub
حال برنامه را اجرا كنيد فرم به شكل مثلث نمايش داده مي شود.
CreateRoundRectRgn
اين تابع ، يك ناحيه چهارگوش مي سازد ولي گوشه هاي آن را مي تواند به اندازه دلخواه بگرداند و بعد يك اشاره گر از ناحيه ساخته شده بر مي گرداند كه مي تواند توسط تابع SetWindowRgn فرم به آن شكل درآيد.
Declare Function CreateRoundRectRgn Lib "gdi32" Alias "CreateRoundRectRgn" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
مقدار برگشتي : اگر تابع موفق باشد مقدار برگشتي اشاره گر از ناحيه ساخته شده مي باشد و اگر با خطا مواجه شود مقدار برگشتي صفر خواهد بود.
پارامترها:
X1 : مختصات x گوشه سمت چپ_بالاي چهارگوش مي باشد.
Y1 : مختصات y گوشه سمت چپ_بالا چهار گوش مي باشد.
X2 : مختصات x گوشه سمت راست_پايين چهار گوش مي باشد.
Y2 : مختصات y گوشه سمت راست_پايين چهار گوش مي باشد.
X3 : به مقدار اين متغير ، هرگوشه چهار گوش در جهت عرض(x) گرد مي گردد.
Y3 : به مقدار اين متغير ، هرگوشه چهار گوش در جهت طولي(y) گرد مي گردد.
به مثال زير توجه كنيد:
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Sub Form_Paint()
Dim hHBr As Long, hFRgn As Long, hRgn As Long
Me.ScaleMode = vbPixels
hRgn = CreateRoundRectRgn(0, 0, 150, 150, 100, 100)
SetWindowRgn Me.hWnd, hRgn, True
DeleteObject hRgn
End Sub
OffsetRgn
اين تابع ، مكان يك ناحيه را بدون تغيير اندازه آن تغيير دهيد.براي مثال شما يك ناحيه را كه ساختيد و احساس مي كنيد كمي بالا يا چپ يا محل مناسبي ندارد است مي توانيد بااين تابع جاي اين ناحيه را عوض كنيد.
Declare Function OffsetRgn Lib "gdi32" Alias "OffsetRgn" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
مقدار برگشتي :اگر تابع موفق نباشد مقدار برگشتي صفر خواهد بود.
پارامترها:
hRgn : مقدار اين متغير ، يك اشاره گر از ناحيه موردنظر مي باشد..
X : به مقدار اين متغير، ناحيه در جهتت افقي حركت مي كند. مقادير مثبت به سمت راست و مقادير منفي به سمت چپ
Y : به مقدار اين متغير ، ناحيه در جهت عمودي حركت مي كند.مقادير مثبت به سمت پايين و مقادير منفي به سمت بالا.
به مثال زير توجه كنيد:
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function OffsetRgn Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
Private Sub Form_Paint()
Dim hHBr As Long, hFRgn As Long, hRgn As Long
Me.ScaleMode = vbPixels
hRgn = CreateRoundRectRgn(0, 0, 150, 150, 100, 100)
OffsetRgn hRgn, 30, 30
SetWindowRgn Me.hWnd, hRgn, True
DeleteObject hRgn
End Sub
در اين برنامه به دليل اينكه آن ناحيه بر روي ناحيه آبي مي افتاد آن را پايين تر و راست تر آورديم.
CombineRgn
اين تابع ، دو ناحيه(منطقه) را به يكديگر ملحق مي كند و ناحيه بدست آمده را در متغير ديگر به عنوان اشاره گر ناحيه جديد قرار مي دهد.در ضمن در الحاق كردن در ناحيه مي توان از Diff,Xor,or,AND و Copy استفاده كرد.
Declare Function CombineRgn Lib "gdi32" Alias "CombineRgn" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
مقدار برگشتي : مقدار برگشتي يكي از مقادير زير خواهد بود.
Error : در الحاق دو ناحيه يك خطايي رخ داده است.
NullRegion : نتيجه دو ناحيه ، ناحيه اي خالي مي باشد.
SimpleRegion : نتيجه دو ناحيه يك چهارگوش مي باشد و يك ناحيه ساده مي باشد.
ComplexRegion : نتيجه دو ناحيه يك ناحيه چهارگوش و تكي نمي باشد ولي ناحيه اي بدست آمده است.
پارامترها:
HDestRgn : مقدار اين متغير ، يك اشاره گر ناحيه مي باشد كه نتيجه 2 ناحيه ديگر در اين ناحيه ريخته مي شود.توجه داشته باشيد كه اين ناحيه قبلا بايد ساخته شده باشد.
hSrcRgn1 : مقدار اين متغير ، يك اشاره گر از ناحيه اول مي باشد كه اين ناحيه مي تواند هر شكلي داشته باشد.
hSrcRgn2 : مقدار اين متغير ، يك اشاره گر از ناحيه دوم مي باشد كه اين ناحيه مي تواند هر شكلي داشته باشد.
nCombinMode : مقدار اين متغير ، نوع الحاق دو ناحيه را مشخص مي كند كه مي تواند يكي ازموارد زير باشد:
RGN_OR : جمع دو ناحيه را بع عنوان ناحيه نتيجه بر مي گرداند.
RGN_AND : ناحيه مشترك بين دو ناحيه را بر مي گرداند.
RGN_XOR : جمع دو ناحيه به غير از ناحيه مشترك را بر مي گرداند.
RGN_COPY : كل ناحيه اول را به عنوان ناحيه نتيجه بر مي گرداند.
RGN_DIFF : كل ناحيه اول به غير از قسمت هاي مشترك با ناحيه دوم را بر مي گرداند.
به مثال زير توجه كنيد:
Const PS_DOT = 2
Const PS_SOLID = 0
Const RGN_AND = 1
Const RGN_COPY = 5
Const RGN_OR = 2
Const RGN_XOR = 3
Const RGN_DIFF = 4
Const HS_DIAGCROSS = 5
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type LOGPEN
lopnStyle As Long
lopnWidth As POINTAPI
lopnColor As Long
End Type
Private Declare Function CreateHatchBrush Lib "gdi32" (ByVal nIndex As Long, ByVal crColor As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreatePenIndirect Lib "gdi32" (lpLogPen As LOGPEN) As Long
Private Declare Function CreateRectRgnIndirect Lib "gdi32" (lpRect As RECT) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function FloodFill Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function FrameRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function InvertRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function OffsetRgn Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function Pie Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Sub Form_Load()
Me.ScaleMode = vbPixels
End Sub
Private Sub Form_Paint()
Dim hHBr As Long, R As RECT, hFRgn As Long, hRRgn As Long, hRPen As Long, LP As LOGPEN
Dim hFFBrush As Long, mIcon As Long, Cnt As Long
Me.Cls
SetRect R, 0, 0, Me.ScaleWidth, Me.ScaleHeight
hHBr = CreateHatchBrush(HS_DIAGCROSS, vbRed)
FrameRect Me.hdc, R, hHBr
hFRgn = CreateRoundRectRgn(0, 0, Me.ScaleWidth, Me.ScaleHeight, (Me.ScaleWidth / 3) * 2, (Me.ScaleHeight / 3) * 5)
FrameRgn Me.hdc, hFRgn, hHBr, Me.ScaleWidth, Me.ScaleHeight
InvertRgn Me.hdc, hFRgn
OffsetRgn hFRgn, 10, 10
hRRgn = CreateRectRgnIndirect(R)
CombineRgn hRRgn, hFRgn, hRRgn, RGN_XOR
FrameRgn Me.hdc, hRRgn, hHBr, Me.ScaleWidth, Me.ScaleHeight
hRPen = CreatePen(PS_SOLID, 5, vbBlue)
DeleteObject SelectObject(Me.hdc, hRPen)
Rectangle Me.hdc, Me.ScaleWidth / 2 - 25, Me.ScaleHeight / 2 - 25, Me.ScaleWidth / 2 + 25, Me.ScaleHeight / 2 + 25
DeleteObject hRPen
LP.lopnStyle = PS_DOT
LP.lopnColor = vbGreen
hRPen = CreatePenIndirect(LP)
SelectObject Me.hdc, hRPen
RoundRect Me.hdc, Me.ScaleWidth / 2 - 25, Me.ScaleHeight / 2 - 25, Me.ScaleWidth / 2 + 25, Me.ScaleHeight / 2 + 25, 50, 50
hFFBrush = CreateSolidBrush(vbYellow)
SelectObject Me.hdc, hFFBrush
FloodFill Me.hdc, Me.ScaleWidth / 2, Me.ScaleHeight / 2, vbBlue
DeleteObject hFFBrush
hFFBrush = CreateSolidBrush(vbMagenta)
SelectObject Me.hdc, hFFBrush
Pie Me.hdc, Me.ScaleWidth / 2 - 15, Me.ScaleHeight / 2 - 15, Me.ScaleWidth / 2 + 15, Me.ScaleHeight / 2 + 15, 20, 20, 20, 20
DeleteObject hFFBrush
DeleteObject hRPen
DeleteObject hRRgn
DeleteObject hFRgn
DeleteObject hHBr
End Sub
Private Sub Form_Resize()
Form_Paint
End Sub
در اين برنامه شكل فرم را تغيير نداديم بلكه آن اشكال را برروي فرم رسم كرديم.
SetWindowRgn
اين تابع فرم را به شكل هاي در مي آورند كه توسط توابع بالا درست شده اند.
Declare Function SetWindowRgn Lib "user32" Alias "SetWindowRgn" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
پارامترها:
hwnd : مقدار اين متغير ، اشاره گر پنجره (فرم) مورد نظر مي باشد.
hRgn : مقدار اين متغير ، اشاره گر ناحيه موردنظر مي باشد كه فرم به اين ناحيه محدود مي شود.
bRedraw : اگر مقدار اين متغير True باشد بعد از محدود شدن پنجره به ناحيه ، پنجره دوباره ترسيم مي شود و اگر False باشد اين كار انجام نمي شود.
.تبديل فرم به نوشته
تا حالا فهميديم چگونه فرم را چندضلعي و بيضي شكل و ... كنيم حالا مي خواهم بگويم كه چگونه فرم را به نوشته تبديل كرد.در اين روش بايد ابتدا به كمك تابع BeginPath يك قالب را شروع كرد و بعد يك متن را روي فرم به وسيله تابع TextOut ترسيم كرد سپس با تابع EndPath قاب را درست كرد بعد با تابع PathtoRegion متن را به يك ناحيه تبديل كرد.و سرانجام با تابع SetWindowRgn فرم را به ان ناحيه محدود كرد تا به آن شكل در آيد. براي اين كار 4 تابع زير را نياز داريم:
BeginPath
اين تابع به كمك تابع EndPath يك قاب تهيه مي كند كه سرانجام به كمك توابع ديگر مي توان فرم را به شكل متن در آورد.
Declare Function BeginPath Lib "gdi32" Alias "BeginPath" (ByVal hdc As Long) As Long
پارامتر:
hdc : مقدار اين متغير ، يك اشاره گر از (Device Context) hdc پنجره اي مي باشد كه متن بر روي آن ترسيم شده است.
EndPath
اين تابع به كمك تابع BeginPath يك قاب تهيه مي كند كه سرانجام به كمك توابع ديگر مي توان فرم را به شكل متن در آورد.
Declare Function EndPath Lib "gdi32" Alias "EndPath" (ByVal hdc As Long) As Long
.
پارامتر:
hdc : مقدار اين متغير ، يك اشاره گر از (Device Context) hdc پنجره اي مي باشد كه متن بر روي آن ترسيم شده است
TextOut
اين تابع ، يك متن را در مكاني داخواه ترسيم مي كند و همچنين مي توان تعداد كاراكترهايي را كه تابع بايد از متن ترسيم كند ، را تعيين كرد.
Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
پارامترها:
hdc : اين متغير ، يك اشاره گر از (Device Context) hdc پنجره اي مي باشد كه متن بر روي آن بايد ترسيم شود.
x : مختصات x محل نمايش متن مي باشد.
y : مختصات y محل نمايش متن مي باشد.
lpString : مقدار اين متغير ، متن مورد نظر است.
nCount : مقدار اين متغير ، تعداد كاراكترهايي از متن براي نمايش است.
PathToRegion
اين تابع يك قاب ساخته شده توسط تابع BeginPath و EndPath را به يك ناحيه تبديل مي كند.
پارامترها:
hdc : مقدار اين متغير ، يك اشاره گر از (Device Context) hdc پنجره و يا فرم مورد نظر مي باشد كه قاب بر روي آن ساخته شده است .
Declare Function PathToRegion Lib "gdi32" Alias "PathToRegion" (ByVal hdc As Long) As Long
در مورد تابع SetWindowRgn قبلا توضيح دادم.
توجه : در آخر كه اين نواحي را ساختيد بايد توسط تابع DeleteObject اشاره گر ناحيه را پاك كنيد.
حالا به مثال زير توجه كنيد.
Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function PathToRegion Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Sub Form_Load()
Dim hRgn As Long
Dim s As String
Me.FontName = "Times New Roman"
Me.FontSize = 90
Me.BackColor = vbRed
s = "Soheil"
BeginPath Me.hdc
TextOut Me.hdc, 10, 10, s, Len(s)
EndPath Me.hdc
hRgn = PathToRegion(Me.hdc)
SetWindowRgn Me.hWnd, hRgn, True
End Sub
3.توليد فرم هاي شفاف
براي توليد فرم هاي شفاف بايد از تابع SetLayeredWindowAttributes استفاده كنيم كه من توضيح آن را در پايين مي نويسم.
SetLayeredWindowAttributes
اين تابع مي نواند:
1.كل پنجره و تمام كنترل هاي داخل آن را به ميزان دلخواه به صورت شفاف (Trandparent) تبديل كند. 2.تمام پيكسل هاي رنگ داده شده را حذف مي كند و در واقع محدوده ي آن رنگ را به صورت كاملا شفاف تبديل مي كند.توجه داشته باشيد كه اين رنگ مي تواند BackColor , ForeColor و يا FillColor هر پنجره فرم يا كنترل ها باشد.در ضمن مي تواند به عنوان مپال رنگ داخل يك PictureBox نيز باشد.
Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
مقداز بازگشتي: مقدار صفر به منزله عدم موفقيت تابع مي باشد و مقادير غيرصفر موفقيت آن را مي رساند.
پارامترها:
hWnd : مقدار اين متغير يك اشاره گر از پنجره ، فرم يا كنترلي باشد كه مي خواهيم تابع بر روي آن تغييراتي را به وجود آورد.
crKey : اگر مقدار متغير dwflag ، LWA_colorkey باشد . اين متغير ، كد رنگي مي باشد كه بايد به صورت شفاف تبديل شود.
lAlpha : اگر مقدار متغير dwflags ، LWA_Alpha باشد . عدد اختصاص داده شده به اين متغير ميزان شفافيت را مشخص مي كند.توجه داشته باشيد كه اين متغير از نوع Byte مي باشد و محدوده ي عددي بين 0 تا 255 مي باشد.هرچه عدد كمتر باشد ميزان شفافيت بيشتر مي شود.مقدار صفر پنجره را كاملا محو مي كند..
dwflag : مقدار اين متغير نوع كار تابع را مشخص مي كند كه مي تواند يكي و يا با كمك دستورor تركيبي از موارد زير باشد:
LWA_Colorkey : اين مقدار باعث مي شود تا فقط رنگ داده شده به صورت شفاف تبديل شود.
LWA_Alpha : اين مقدار باعث مي شود تا كل پنجره و فرم با تمام كنترل هاي داخل آن به ميزان تعيين شده به صورت شفاف تبديل شود.
توجه : براي كار با اين دو تابع بايد از دو تابع GetWindowLong و SetWindowLong استفاده كرد.كه تابع SetWindowLong يك خاصيت را براي يك پنجره ، فرم و يا كنترل تنظيم مي كند و تابع GetWindowLong خاصيت مورد نظر را مي گيرد. كه در اين مثال ها تابع GetWindowLong روش ترسيم (GWL_Exstyle) را مي گيرد و تابع SetWindowLong ، خاصيت لايه لايه شدن را (WS_Ex_Layred) اضافه مي كند و بعد SetLayeredWindowAttributes مي تواند ميزان شفافيت هر لايه را تنظيم كنيد.
ثابت ها:
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
مثال 1 :
حالا ويژال بيسيك را باز كرده و بر روي فرم دو CommandButton با نام هاي Command1 و Command2 را ايجاد كنيد و يك TextBox نيز روي فرم قرار دهيد . حالا كد زير را وارد كنيد.(TextBox را بزرگ كنيد)
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Sub Command1_Click()
Dim Ret As Long
Ret = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED
SetWindowLong Me.hwnd, GWL_EXSTYLE, Ret
SetLayeredWindowAttributes Me.hwnd, 0, 120, LWA_ALPHA
End Sub
Private Sub Command2_Click()
Dim Ret As Long
Ret = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED
SetWindowLong Me.hwnd, GWL_EXSTYLE, Ret
SetLayeredWindowAttributes Me.hwnd, vbRed, 255, LWA_COLORKEY
End Sub
Private Sub Form_Load()
Me.AutoRedraw = True
Text1.ForeColor = vbRed
Text1.BackColor = vbBlue
Text1.Text = "Soheil"
Text1.Font.Size = 50
End Sub
حالا با زدن Command1 كل فرم با تمام كنترل هاي آن شفاف مي شود و با زدن Command2 هر رنگ آبي موجود در روي فرم مثل Soheil نوشته شده درون TextBox شفاف مي شود و پشت آن ديده مي شود.
4.زدن سايه روشن روي فرم
براي اين كار ما از دستور line استفاده مي كنيم . با چند حالت مي توان روي فرم سايه روشن زد. كه كد آن ها را در زير مي نويسم.
1.
Me.AutoRedraw = True
For x = 0 To 128
Line (0, x * Me.Height / 128)-(Me.Width, Me.Height), RGB(0, 0, x * 2), BF
Next x
توجه : در اين كدها سايه روشن به رنگ آبي است براي تغيير اين رنگ مي توانيد در قسمت RGB(0, 0, x * 2) مقادير را تغير دهيد براي مثال بنويسيد : RGB(0, X * 2, 0) كه سايه به رنگ سبز يا تركيب اين دو رنگ يعني RGB(0, X * 2, X * 2) را بنويسيد.
2.
Me.AutoRedraw = True
For x = 0 To 128
Line (x * Me.Width / 128, 0)-(Me.Width, Me.Height), RGB(0, 0, x * 2), BF
Next x
3.
Me.AutoRedraw = True
For x = 1 To 128
Line (x * Me.Width / 256, x * Me.Height / 256)-(Me.Width - (x * Me.Width / 256), Me.Height - (x * Me.Height / 256)), RGB(0, 0, x * 2), BF
Next x
4.
Me.AutoRedraw = True
For x = 1 To 128
Line (x * Me.Width / 128, x * Me.Height / 128)-(Me.Width, Me.Height), RGB(0, 0, x * 2), BF
Next x
اين يك مقاله ي منحصر به فرد است اميدوارم همه ي شما از آن لذت ببريد
اين مقاله يك مقاله ي منحصر به فرد است شايد كمي زياد باشد ولي ارزش خواندن و استفاده از ان را حتما دارد
1.تبديل فرم به اشكال مختلف
CreateEllipticRgn
اين تابع يك ناحيه به شكل بيضي شكل با اندازه دلخواه مي سازد.كه مي توان به كمك تابع SetWindowRgn فرم را به آن شكل در آورد.
Declare Function CreateEllipticRgn Lib "gdi32" Alias "CreateEllipticRgn" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
مقدار برگشتي : اگر تابع موفق باشد مقدار برگشتي اشاره گر از ناحيه ساخته شده مي باشد و اگر با خطا مواجه شود مقدار برگشتي صفر خواهد بود.
پارامترها:
X1 : مختصات x گوشه سمت چپ- بالاي چهارگوش مي باشد كه بيضي ساخته شده بايد در آن احاطه شود.
Y1 : مختصات y گوشه سمت چپ- بالاي چهارگوش مي باشد كه بيضي ساخته شده بايد در آن احاطه شود.
X2 : مختصات x گوشه سمت راست- پايين چهارگوش مي باشد كه بيضي ساخته شده بايد در آن احاطه شود.
Y2 : مختصات Y گوشه سمت راست- پايين چهارگوش مي باشد كه بيضي ساخته شده بايد در آن احاطه شود.
توجه : واحد همه اين مقادير Pixel است.
CreateEllipticRgnIndirect
اين تابع يك ناحيه به شكل بيضي شكل با اندازه دلخواه مي سازد.كه مي توان به كمك تابع SetWindowRgn فرم را به آن شكل در آورد.
Declare Function CreateEllipticRgnIndirect Lib "gdi32" Alias "CreateEllipticRgnIndirect" (lpRect As Rect) As Long
مقدار برگشتي : اگر تابع موفق باشد مقدار برگشتي اشاره گر از ناحيه ساخته شده مي باشد و اگر با خطا مواجه شود مقدار برگشتي صفر خواهد بود.
پارامتر:
LpRect : اين متغير به ساختاري به نام Rect اشاره دارد كه فيلدهاي آن مشخصات گوشه ي سمت چپ-بالا و گوشه سمت راست-پايين چهارگوش فرضي را مشخص مي كنند.فيلدهاي اين ساختار دقيقا مثل متغيرهاي تابع CreateEllipticRgn است.
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
CreatePolygonRgn
اين تابع ، يك ناحيه چند ضلعي به اندازه دلخواه مي سازد. كه مي توان به كمك تابع SetWindowRgn فرم را به آن شكل در آورد.
Declare Function CreatePolygonRgn Lib "gdi32" Alias "CreatePolygonRgn" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
مقدار برگشتي : اگر تابع موفق باشد مقدار برگشتي اشاره گر از ناحيه ساخته شده مي باشد و اگر با خطا مواجه شود مقدار برگشتي صفر خواهد بود.
پارامترها:
lpPoint : اين متغير يك آرايه مي باشد كه مختصات x,y راس هاي چند ضلعي را در خود نگه مي دارد .
nCount : مقدار اين پارامتر ، تعداد راس هاي چند ضلعي مي باشد.
nPolyFillMode : مقدار اين متغير نوع پرشدن چند ضلعي را مشخص مي كند كه مي تواند يكي از موارد Winding يا Alternate باشد.
به اين مثال توجه كنيد:
Private Type COORD
x As Long
y As Long
End Type
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Const ALTERNATE = 1 ' ALTERNATE and WINDING are
Const WINDING = 2 ' constants for FillMode.
Private Sub Form_Paint()
Dim hRgn As Long, NumCoords As Long
Dim poly(1 To 3) As COORD
NumCoords = 3
Me.ScaleMode = vbPixels
poly(1).x = Form1.ScaleWidth / 2
poly(1).y = Form1.ScaleHeight / 2
poly(2).x = Form1.ScaleWidth / 4
poly(2).y = 3 * Form1.ScaleHeight / 4
poly(3).x = 3 * Form1.ScaleWidth / 4
poly(3).y = 3 * Form1.ScaleHeight / 4
hRgn = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE)
SetWindowRgn Me.hWnd, hRgn, True
End Sub
Private Sub Form_Resize()
Form_Paint
End Sub
Private Sub Form_Unload(Cancel As Integer)
DeleteObject hRgn
End Sub
حال برنامه را اجرا كنيد فرم به شكل مثلث نمايش داده مي شود.
CreateRoundRectRgn
اين تابع ، يك ناحيه چهارگوش مي سازد ولي گوشه هاي آن را مي تواند به اندازه دلخواه بگرداند و بعد يك اشاره گر از ناحيه ساخته شده بر مي گرداند كه مي تواند توسط تابع SetWindowRgn فرم به آن شكل درآيد.
Declare Function CreateRoundRectRgn Lib "gdi32" Alias "CreateRoundRectRgn" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
مقدار برگشتي : اگر تابع موفق باشد مقدار برگشتي اشاره گر از ناحيه ساخته شده مي باشد و اگر با خطا مواجه شود مقدار برگشتي صفر خواهد بود.
پارامترها:
X1 : مختصات x گوشه سمت چپ_بالاي چهارگوش مي باشد.
Y1 : مختصات y گوشه سمت چپ_بالا چهار گوش مي باشد.
X2 : مختصات x گوشه سمت راست_پايين چهار گوش مي باشد.
Y2 : مختصات y گوشه سمت راست_پايين چهار گوش مي باشد.
X3 : به مقدار اين متغير ، هرگوشه چهار گوش در جهت عرض(x) گرد مي گردد.
Y3 : به مقدار اين متغير ، هرگوشه چهار گوش در جهت طولي(y) گرد مي گردد.
به مثال زير توجه كنيد:
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Sub Form_Paint()
Dim hHBr As Long, hFRgn As Long, hRgn As Long
Me.ScaleMode = vbPixels
hRgn = CreateRoundRectRgn(0, 0, 150, 150, 100, 100)
SetWindowRgn Me.hWnd, hRgn, True
DeleteObject hRgn
End Sub
OffsetRgn
اين تابع ، مكان يك ناحيه را بدون تغيير اندازه آن تغيير دهيد.براي مثال شما يك ناحيه را كه ساختيد و احساس مي كنيد كمي بالا يا چپ يا محل مناسبي ندارد است مي توانيد بااين تابع جاي اين ناحيه را عوض كنيد.
Declare Function OffsetRgn Lib "gdi32" Alias "OffsetRgn" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
مقدار برگشتي :اگر تابع موفق نباشد مقدار برگشتي صفر خواهد بود.
پارامترها:
hRgn : مقدار اين متغير ، يك اشاره گر از ناحيه موردنظر مي باشد..
X : به مقدار اين متغير، ناحيه در جهتت افقي حركت مي كند. مقادير مثبت به سمت راست و مقادير منفي به سمت چپ
Y : به مقدار اين متغير ، ناحيه در جهت عمودي حركت مي كند.مقادير مثبت به سمت پايين و مقادير منفي به سمت بالا.
به مثال زير توجه كنيد:
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function OffsetRgn Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
Private Sub Form_Paint()
Dim hHBr As Long, hFRgn As Long, hRgn As Long
Me.ScaleMode = vbPixels
hRgn = CreateRoundRectRgn(0, 0, 150, 150, 100, 100)
OffsetRgn hRgn, 30, 30
SetWindowRgn Me.hWnd, hRgn, True
DeleteObject hRgn
End Sub
در اين برنامه به دليل اينكه آن ناحيه بر روي ناحيه آبي مي افتاد آن را پايين تر و راست تر آورديم.
CombineRgn
اين تابع ، دو ناحيه(منطقه) را به يكديگر ملحق مي كند و ناحيه بدست آمده را در متغير ديگر به عنوان اشاره گر ناحيه جديد قرار مي دهد.در ضمن در الحاق كردن در ناحيه مي توان از Diff,Xor,or,AND و Copy استفاده كرد.
Declare Function CombineRgn Lib "gdi32" Alias "CombineRgn" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
مقدار برگشتي : مقدار برگشتي يكي از مقادير زير خواهد بود.
Error : در الحاق دو ناحيه يك خطايي رخ داده است.
NullRegion : نتيجه دو ناحيه ، ناحيه اي خالي مي باشد.
SimpleRegion : نتيجه دو ناحيه يك چهارگوش مي باشد و يك ناحيه ساده مي باشد.
ComplexRegion : نتيجه دو ناحيه يك ناحيه چهارگوش و تكي نمي باشد ولي ناحيه اي بدست آمده است.
پارامترها:
HDestRgn : مقدار اين متغير ، يك اشاره گر ناحيه مي باشد كه نتيجه 2 ناحيه ديگر در اين ناحيه ريخته مي شود.توجه داشته باشيد كه اين ناحيه قبلا بايد ساخته شده باشد.
hSrcRgn1 : مقدار اين متغير ، يك اشاره گر از ناحيه اول مي باشد كه اين ناحيه مي تواند هر شكلي داشته باشد.
hSrcRgn2 : مقدار اين متغير ، يك اشاره گر از ناحيه دوم مي باشد كه اين ناحيه مي تواند هر شكلي داشته باشد.
nCombinMode : مقدار اين متغير ، نوع الحاق دو ناحيه را مشخص مي كند كه مي تواند يكي ازموارد زير باشد:
RGN_OR : جمع دو ناحيه را بع عنوان ناحيه نتيجه بر مي گرداند.
RGN_AND : ناحيه مشترك بين دو ناحيه را بر مي گرداند.
RGN_XOR : جمع دو ناحيه به غير از ناحيه مشترك را بر مي گرداند.
RGN_COPY : كل ناحيه اول را به عنوان ناحيه نتيجه بر مي گرداند.
RGN_DIFF : كل ناحيه اول به غير از قسمت هاي مشترك با ناحيه دوم را بر مي گرداند.
به مثال زير توجه كنيد:
Const PS_DOT = 2
Const PS_SOLID = 0
Const RGN_AND = 1
Const RGN_COPY = 5
Const RGN_OR = 2
Const RGN_XOR = 3
Const RGN_DIFF = 4
Const HS_DIAGCROSS = 5
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type LOGPEN
lopnStyle As Long
lopnWidth As POINTAPI
lopnColor As Long
End Type
Private Declare Function CreateHatchBrush Lib "gdi32" (ByVal nIndex As Long, ByVal crColor As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreatePenIndirect Lib "gdi32" (lpLogPen As LOGPEN) As Long
Private Declare Function CreateRectRgnIndirect Lib "gdi32" (lpRect As RECT) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function FloodFill Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function FrameRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function InvertRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function OffsetRgn Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function Pie Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Sub Form_Load()
Me.ScaleMode = vbPixels
End Sub
Private Sub Form_Paint()
Dim hHBr As Long, R As RECT, hFRgn As Long, hRRgn As Long, hRPen As Long, LP As LOGPEN
Dim hFFBrush As Long, mIcon As Long, Cnt As Long
Me.Cls
SetRect R, 0, 0, Me.ScaleWidth, Me.ScaleHeight
hHBr = CreateHatchBrush(HS_DIAGCROSS, vbRed)
FrameRect Me.hdc, R, hHBr
hFRgn = CreateRoundRectRgn(0, 0, Me.ScaleWidth, Me.ScaleHeight, (Me.ScaleWidth / 3) * 2, (Me.ScaleHeight / 3) * 5)
FrameRgn Me.hdc, hFRgn, hHBr, Me.ScaleWidth, Me.ScaleHeight
InvertRgn Me.hdc, hFRgn
OffsetRgn hFRgn, 10, 10
hRRgn = CreateRectRgnIndirect(R)
CombineRgn hRRgn, hFRgn, hRRgn, RGN_XOR
FrameRgn Me.hdc, hRRgn, hHBr, Me.ScaleWidth, Me.ScaleHeight
hRPen = CreatePen(PS_SOLID, 5, vbBlue)
DeleteObject SelectObject(Me.hdc, hRPen)
Rectangle Me.hdc, Me.ScaleWidth / 2 - 25, Me.ScaleHeight / 2 - 25, Me.ScaleWidth / 2 + 25, Me.ScaleHeight / 2 + 25
DeleteObject hRPen
LP.lopnStyle = PS_DOT
LP.lopnColor = vbGreen
hRPen = CreatePenIndirect(LP)
SelectObject Me.hdc, hRPen
RoundRect Me.hdc, Me.ScaleWidth / 2 - 25, Me.ScaleHeight / 2 - 25, Me.ScaleWidth / 2 + 25, Me.ScaleHeight / 2 + 25, 50, 50
hFFBrush = CreateSolidBrush(vbYellow)
SelectObject Me.hdc, hFFBrush
FloodFill Me.hdc, Me.ScaleWidth / 2, Me.ScaleHeight / 2, vbBlue
DeleteObject hFFBrush
hFFBrush = CreateSolidBrush(vbMagenta)
SelectObject Me.hdc, hFFBrush
Pie Me.hdc, Me.ScaleWidth / 2 - 15, Me.ScaleHeight / 2 - 15, Me.ScaleWidth / 2 + 15, Me.ScaleHeight / 2 + 15, 20, 20, 20, 20
DeleteObject hFFBrush
DeleteObject hRPen
DeleteObject hRRgn
DeleteObject hFRgn
DeleteObject hHBr
End Sub
Private Sub Form_Resize()
Form_Paint
End Sub
در اين برنامه شكل فرم را تغيير نداديم بلكه آن اشكال را برروي فرم رسم كرديم.
SetWindowRgn
اين تابع فرم را به شكل هاي در مي آورند كه توسط توابع بالا درست شده اند.
Declare Function SetWindowRgn Lib "user32" Alias "SetWindowRgn" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
پارامترها:
hwnd : مقدار اين متغير ، اشاره گر پنجره (فرم) مورد نظر مي باشد.
hRgn : مقدار اين متغير ، اشاره گر ناحيه موردنظر مي باشد كه فرم به اين ناحيه محدود مي شود.
bRedraw : اگر مقدار اين متغير True باشد بعد از محدود شدن پنجره به ناحيه ، پنجره دوباره ترسيم مي شود و اگر False باشد اين كار انجام نمي شود.
.تبديل فرم به نوشته
تا حالا فهميديم چگونه فرم را چندضلعي و بيضي شكل و ... كنيم حالا مي خواهم بگويم كه چگونه فرم را به نوشته تبديل كرد.در اين روش بايد ابتدا به كمك تابع BeginPath يك قالب را شروع كرد و بعد يك متن را روي فرم به وسيله تابع TextOut ترسيم كرد سپس با تابع EndPath قاب را درست كرد بعد با تابع PathtoRegion متن را به يك ناحيه تبديل كرد.و سرانجام با تابع SetWindowRgn فرم را به ان ناحيه محدود كرد تا به آن شكل در آيد. براي اين كار 4 تابع زير را نياز داريم:
BeginPath
اين تابع به كمك تابع EndPath يك قاب تهيه مي كند كه سرانجام به كمك توابع ديگر مي توان فرم را به شكل متن در آورد.
Declare Function BeginPath Lib "gdi32" Alias "BeginPath" (ByVal hdc As Long) As Long
پارامتر:
hdc : مقدار اين متغير ، يك اشاره گر از (Device Context) hdc پنجره اي مي باشد كه متن بر روي آن ترسيم شده است.
EndPath
اين تابع به كمك تابع BeginPath يك قاب تهيه مي كند كه سرانجام به كمك توابع ديگر مي توان فرم را به شكل متن در آورد.
Declare Function EndPath Lib "gdi32" Alias "EndPath" (ByVal hdc As Long) As Long
.
پارامتر:
hdc : مقدار اين متغير ، يك اشاره گر از (Device Context) hdc پنجره اي مي باشد كه متن بر روي آن ترسيم شده است
TextOut
اين تابع ، يك متن را در مكاني داخواه ترسيم مي كند و همچنين مي توان تعداد كاراكترهايي را كه تابع بايد از متن ترسيم كند ، را تعيين كرد.
Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
پارامترها:
hdc : اين متغير ، يك اشاره گر از (Device Context) hdc پنجره اي مي باشد كه متن بر روي آن بايد ترسيم شود.
x : مختصات x محل نمايش متن مي باشد.
y : مختصات y محل نمايش متن مي باشد.
lpString : مقدار اين متغير ، متن مورد نظر است.
nCount : مقدار اين متغير ، تعداد كاراكترهايي از متن براي نمايش است.
PathToRegion
اين تابع يك قاب ساخته شده توسط تابع BeginPath و EndPath را به يك ناحيه تبديل مي كند.
پارامترها:
hdc : مقدار اين متغير ، يك اشاره گر از (Device Context) hdc پنجره و يا فرم مورد نظر مي باشد كه قاب بر روي آن ساخته شده است .
Declare Function PathToRegion Lib "gdi32" Alias "PathToRegion" (ByVal hdc As Long) As Long
در مورد تابع SetWindowRgn قبلا توضيح دادم.
توجه : در آخر كه اين نواحي را ساختيد بايد توسط تابع DeleteObject اشاره گر ناحيه را پاك كنيد.
حالا به مثال زير توجه كنيد.
Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function PathToRegion Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Sub Form_Load()
Dim hRgn As Long
Dim s As String
Me.FontName = "Times New Roman"
Me.FontSize = 90
Me.BackColor = vbRed
s = "Soheil"
BeginPath Me.hdc
TextOut Me.hdc, 10, 10, s, Len(s)
EndPath Me.hdc
hRgn = PathToRegion(Me.hdc)
SetWindowRgn Me.hWnd, hRgn, True
End Sub
3.توليد فرم هاي شفاف
براي توليد فرم هاي شفاف بايد از تابع SetLayeredWindowAttributes استفاده كنيم كه من توضيح آن را در پايين مي نويسم.
SetLayeredWindowAttributes
اين تابع مي نواند:
1.كل پنجره و تمام كنترل هاي داخل آن را به ميزان دلخواه به صورت شفاف (Trandparent) تبديل كند. 2.تمام پيكسل هاي رنگ داده شده را حذف مي كند و در واقع محدوده ي آن رنگ را به صورت كاملا شفاف تبديل مي كند.توجه داشته باشيد كه اين رنگ مي تواند BackColor , ForeColor و يا FillColor هر پنجره فرم يا كنترل ها باشد.در ضمن مي تواند به عنوان مپال رنگ داخل يك PictureBox نيز باشد.
Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
مقداز بازگشتي: مقدار صفر به منزله عدم موفقيت تابع مي باشد و مقادير غيرصفر موفقيت آن را مي رساند.
پارامترها:
hWnd : مقدار اين متغير يك اشاره گر از پنجره ، فرم يا كنترلي باشد كه مي خواهيم تابع بر روي آن تغييراتي را به وجود آورد.
crKey : اگر مقدار متغير dwflag ، LWA_colorkey باشد . اين متغير ، كد رنگي مي باشد كه بايد به صورت شفاف تبديل شود.
lAlpha : اگر مقدار متغير dwflags ، LWA_Alpha باشد . عدد اختصاص داده شده به اين متغير ميزان شفافيت را مشخص مي كند.توجه داشته باشيد كه اين متغير از نوع Byte مي باشد و محدوده ي عددي بين 0 تا 255 مي باشد.هرچه عدد كمتر باشد ميزان شفافيت بيشتر مي شود.مقدار صفر پنجره را كاملا محو مي كند..
dwflag : مقدار اين متغير نوع كار تابع را مشخص مي كند كه مي تواند يكي و يا با كمك دستورor تركيبي از موارد زير باشد:
LWA_Colorkey : اين مقدار باعث مي شود تا فقط رنگ داده شده به صورت شفاف تبديل شود.
LWA_Alpha : اين مقدار باعث مي شود تا كل پنجره و فرم با تمام كنترل هاي داخل آن به ميزان تعيين شده به صورت شفاف تبديل شود.
توجه : براي كار با اين دو تابع بايد از دو تابع GetWindowLong و SetWindowLong استفاده كرد.كه تابع SetWindowLong يك خاصيت را براي يك پنجره ، فرم و يا كنترل تنظيم مي كند و تابع GetWindowLong خاصيت مورد نظر را مي گيرد. كه در اين مثال ها تابع GetWindowLong روش ترسيم (GWL_Exstyle) را مي گيرد و تابع SetWindowLong ، خاصيت لايه لايه شدن را (WS_Ex_Layred) اضافه مي كند و بعد SetLayeredWindowAttributes مي تواند ميزان شفافيت هر لايه را تنظيم كنيد.
ثابت ها:
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
مثال 1 :
حالا ويژال بيسيك را باز كرده و بر روي فرم دو CommandButton با نام هاي Command1 و Command2 را ايجاد كنيد و يك TextBox نيز روي فرم قرار دهيد . حالا كد زير را وارد كنيد.(TextBox را بزرگ كنيد)
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Sub Command1_Click()
Dim Ret As Long
Ret = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED
SetWindowLong Me.hwnd, GWL_EXSTYLE, Ret
SetLayeredWindowAttributes Me.hwnd, 0, 120, LWA_ALPHA
End Sub
Private Sub Command2_Click()
Dim Ret As Long
Ret = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED
SetWindowLong Me.hwnd, GWL_EXSTYLE, Ret
SetLayeredWindowAttributes Me.hwnd, vbRed, 255, LWA_COLORKEY
End Sub
Private Sub Form_Load()
Me.AutoRedraw = True
Text1.ForeColor = vbRed
Text1.BackColor = vbBlue
Text1.Text = "Soheil"
Text1.Font.Size = 50
End Sub
حالا با زدن Command1 كل فرم با تمام كنترل هاي آن شفاف مي شود و با زدن Command2 هر رنگ آبي موجود در روي فرم مثل Soheil نوشته شده درون TextBox شفاف مي شود و پشت آن ديده مي شود.
4.زدن سايه روشن روي فرم
براي اين كار ما از دستور line استفاده مي كنيم . با چند حالت مي توان روي فرم سايه روشن زد. كه كد آن ها را در زير مي نويسم.
1.
Me.AutoRedraw = True
For x = 0 To 128
Line (0, x * Me.Height / 128)-(Me.Width, Me.Height), RGB(0, 0, x * 2), BF
Next x
توجه : در اين كدها سايه روشن به رنگ آبي است براي تغيير اين رنگ مي توانيد در قسمت RGB(0, 0, x * 2) مقادير را تغير دهيد براي مثال بنويسيد : RGB(0, X * 2, 0) كه سايه به رنگ سبز يا تركيب اين دو رنگ يعني RGB(0, X * 2, X * 2) را بنويسيد.
2.
Me.AutoRedraw = True
For x = 0 To 128
Line (x * Me.Width / 128, 0)-(Me.Width, Me.Height), RGB(0, 0, x * 2), BF
Next x
3.
Me.AutoRedraw = True
For x = 1 To 128
Line (x * Me.Width / 256, x * Me.Height / 256)-(Me.Width - (x * Me.Width / 256), Me.Height - (x * Me.Height / 256)), RGB(0, 0, x * 2), BF
Next x
4.
Me.AutoRedraw = True
For x = 1 To 128
Line (x * Me.Width / 128, x * Me.Height / 128)-(Me.Width, Me.Height), RGB(0, 0, x * 2), BF
Next x
اين يك مقاله ي منحصر به فرد است اميدوارم همه ي شما از آن لذت ببريد
نظر یادتون نره با تشکرmahdics2
+ نوشته شده در شنبه دوم آبان ۱۳۸۸ ساعت 18:11 توسط مهدی
|