Visual Basic 6.0 - Создать эллиптический регион

Hello, Pasha!

Jan 2004 17:44:46 +0300:


А вот Дмитрий Козырев догадался по моему мылу. Слабо?


Возвращаясь к сабжу. Методом "автогеном через .опу" я всё-таки добился эллиптических регионов в МЕ. Зацените красотищу.
=========Beginning of the citation==============
VERSION 5.00
Begin VB.Form frmClock
AutoRedraw = -1 'True
BorderStyle = 5 'Sizable ToolWindow
Caption = "Clock"
ClientHeight = 5460
ClientLeft = 390
ClientTop = 960
ClientWidth = 5910
FillColor = &H00808080&
FillStyle = 0 'Solid
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5460
ScaleWidth = 5910
ShowInTaskbar = 0 'False
Begin VB.Timer tmrBorder
Enabled = 0 'False
Interval = 1000
Left = 0
Top = 480
End
Begin VB.Timer tmrTime
Interval = 1000
Left = 0
Top = 0
End
End
Attribute VB_Name = "frmClock"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

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 RGNDATAHEADER
dwSize As Long
iType As Long
nCount As Long
nRgnSize As Long
rcBound As RECT
End Type
Private Type RgnData
rdh As RGNDATAHEADER
Buffer(1024) As RECT
End Type
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn 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 Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As
Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function AdjustWindowRectEx Lib "user32" (lpRect As RECT, ByVal dsStyle As Long, ByVal bMenu As Long, ByVal
dwEsStyle As Long) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As
Long
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode 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 OffsetRgn Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetRegionData Lib "gdi32" (ByVal hRgn As Long, ByVal dwCount As Long, RgnData As RgnData) As Long
Private Declare Function ExtCreateRegion Lib "gdi32" (ByVal lpXform As Long, ByVal nCount As Long, RgnData As RgnData) As Long
Private Declare Function GetRgnBox Lib "gdi32" (ByVal hRgn As Long, lpRect As RECT) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hDC As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function Polyline Lib "gdi32" (ByVal hDC As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function Ellipse 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 GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Const COLOR_BTNFACE As Long = 15&
Const HWND_TOPMOST As Long = -1&
Const HWND_NOTOPMOST As Long = -2&
Const SWP_NOACTIVATE As Long = &H10&
Const SWP_NOMOVE As Long = 2&
Const SWP_NOSIZE As Long = 1&
Const GWL_STYLE As Long = -16&
Const GWL_EXSTYLE As Long = -20&
Const RGN_AND As Long = 1&
Const RGN_OR As Long = 2&
Const RGN_DIFF As Long = 4&
Const RGN_COPY As Long = 5&
Const WS_EX_WINDOWEDGE As Long = &H20000
Const Precision = 1000
Const TwoPiOver360 = 0.017453292
Private Offset As RECT, Updating As Boolean

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim hRgn1 As Long, hRgn2 As Long, hRgn As Long
Dim Height As Long, Width As Long
If tmrBorder.Enabled Then
tmrBorder.Enabled = False
Else
hRgn = CreateRectRgn(0, 0, 0, 0)
GetWindowRgn hWnd, hRgn
Width = ScaleX(ScaleWidth, vbUser, vbPixels)
Height = ScaleY(ScaleHeight, vbUser, vbPixels)
hRgn1 = CreateRectRgn(0, 0, Width + Offset.Left + Offset.Right, Height + Offset.Top + Offset.Bottom)
hRgn2 = CreateRectRgn(Offset.Left, Offset.Top, Width + Offset.Left, Height + Offset.Top)
CombineRgn hRgn1, hRgn1, hRgn2, RGN_DIFF
CombineRgn hRgn, hRgn, hRgn1, RGN_OR
SetWindowRgn hWnd, hRgn, 1
DeleteObject hRgn1
DeleteObject hRgn2
End If
tmrBorder.Enabled = True
End Sub

Private Sub Form_Paint()
Refresh
SetWindowPos hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_NOSIZE Or SWP_NOMOVE
End Sub

Private Sub Form_Resize()
Scale (-Precision, Precision)-(Precision, -Precision)
If Not Updating Then tmrTime_Timer
End Sub

Private Sub Form_Load()
Dim Origin As POINTAPI, Client As RECT, Nonclient As RECT
SetWindowLong hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_WINDOWEDGE
BackColor = GetSysColor(COLOR_BTNFACE)

With Origin
.x = 0
.y = 0
End With
ClientToScreen hWnd, Origin
ScaleMode = vbPixels
With Client
.Left = Origin.x
.Right = Origin.x + ScaleWidth
.Top = Origin.y
.Bottom = Origin.y + ScaleHeight
End With
Nonclient = Client
AdjustWindowRectEx Nonclient, GetWindowLong(hWnd, GWL_STYLE), 0, GetWindowLong(hWnd, GWL_EXSTYLE)
With Offset
.Left = Client.Left - Nonclient.Left
.Right = Nonclient.Right - Client.Right
.Top = Client.Top - Nonclient.Top
.Bottom = Nonclient.Bottom - Client.Bottom
End With

Form_Resize
End Sub

Private Sub tmrTime_Timer()
Dim Hour As Single, Minute As Single, Second As Single, Hand(1 To 4) As POINTAPI
Dim Tick As Integer, Bounds As RECT, hBrush As Long, Extent As Long
Dim hRgn As Long, hRgn1 As Long, Height As Long, Width As Long
Hour = 90 - (30 * VBA.Hour(Now) + VBA.Minute(Now) / 2)
Minute = 90 - (6 * VBA.Minute(Now) + VBA.Second(Now) / 10)
Second = 90 - (6 * VBA.Second(Now))

Width = ScaleX(ScaleWidth, vbUser, vbPixels)
Height = ScaleY(ScaleHeight, vbUser, vbPixels)
If tmrBorder.Enabled Then
hRgn = CreateRectRgn(0, 0, Width + Offset.Left + Offset.Right, Height + Offset.Top + Offset.Bottom)
hRgn1 = CreateRectRgn(Offset.Left, Offset.Top, Width + Offset.Left, Height + Offset.Top)
CombineRgn hRgn, hRgn, hRgn1, RGN_DIFF
DeleteObject hRgn1
Else
hRgn = CreateRectRgn(0, 0, 0, 0)
End If
With Bounds
.Left = 0: .Top = 0
.Right = Width
.Bottom = Height
End With
hBrush = CreateSolidBrush(BackColor)
FillRect hDC, Bounds, hBrush
DeleteObject hBrush
For Tick = 1 To 60
If (Tick Mod 5) = 0 Then Extent = 20 Else Extent = 10
Hand(1) = PolarToRect(Precision * 0.95, Tick * 6)
With Bounds
.Left = Hand(1).x - ScaleX(Extent, vbUser, vbPixels)
.Right = Hand(1).x + ScaleX(Extent, vbUser, vbPixels)
.Top = Hand(1).y - ScaleY(Extent, vbUser, vbPixels)
.Bottom = Hand(1).y + ScaleY(Extent, vbUser, vbPixels)
Ellipse hDC, .Left, .Top, .Right, .Bottom
hRgn1 = CreateEllipticRgn(.Left, .Top, .Right, .Bottom)
GoSub PrepareRgn
CombineRgn hRgn, hRgn, hRgn1, RGN_OR
DeleteObject hRgn1
End With
Next Tick
Hand(1) = PolarToRect(60, Hour + 90)
Hand(2) = PolarToRect(110, Hour + 180)
Hand(3) = PolarToRect(60, Hour - 90)
Hand(4) = PolarToRect(Precision * 0.6, Hour)
Polygon hDC, Hand(1), 4
hRgn1 = CreatePolygonRgn(Hand(1), 4, 0)
GoSub PrepareRgn
CombineRgn hRgn, hRgn, hRgn1, RGN_OR
DeleteObject hRgn1
Hand(1) = PolarToRect(40, Minute + 90)
Hand(2) = PolarToRect(160, Minute + 180)
Hand(3) = PolarToRect(40, Minute - 90)
Hand(4) = PolarToRect(Precision * 0.9, Minute)
Polygon hDC, Hand(1), 4
hRgn1 = CreatePolygonRgn(Hand(1), 4, 0)
GoSub PrepareRgn
CombineRgn hRgn, hRgn, hRgn1, RGN_OR
DeleteObject hRgn1
Hand(1) = PolarToRect(Precision * 0.9, Second)
Hand(2) = PolarToRect(0, 0)
' Hand(3) = PolarToRect(ScaleX(1, vbPixels, vbUser), Second + 90)
' Hand(4).x = Hand(1).x + Hand(3).x - Hand(2).x: Hand(4).y = Hand(1).y + Hand(3).y - Hand(2).y
Polyline hDC, Hand(1), 2
' Polygon hDC, Hand(1), 4
' hRgn1 = CreatePolygonRgn(Hand(1), 4, 0)
' GoSub PrepareRgn
' CombineRgn hRgn, hRgn, hRgn1, RGN_OR
' DeleteObject hRgn1

Updating = True
SetWindowRgn hWnd, hRgn, 1
Updating = False
Form_Paint
Exit Sub
PrepareRgn: '[in, out] hRgn1 As Long
Dim hRgn2 As Long, box As RECT, RgnData As RgnData, i As Long, Tmp As Long
OffsetRgn hRgn1, Offset.Left, Offset.Top
hRgn2 = CreateRectRgn(0, 0, 0, 0)
CombineRgn hRgn2, hRgn1, hRgn1, RGN_COPY
OffsetRgn hRgn2, 1, 0
CombineRgn hRgn1, hRgn2, hRgn1, RGN_OR
DeleteObject hRgn2
If Tick = 61 Then Return
GetRgnBox hRgn1, box
If GetRegionData(hRgn1, 1024, RgnData) = 0 Then Return 'Region too small
For i = 0 To RgnData.rdh.nCount - 1
Tmp = box.Bottom - RgnData.Buffer(i).Bottom + box.Top + 1
RgnData.Buffer(i).Bottom = box.Bottom - RgnData.Buffer(i).Top + box.Top + 1
RgnData.Buffer(i).Top = Tmp
Next
hRgn2 = ExtCreateRegion(0, RgnData.rdh.nRgnSize + RgnData.rdh.dwSize, RgnData)
CombineRgn hRgn1, hRgn2, hRgn1, RGN_OR
DeleteObject hRgn2
Return
End Sub

Private Sub tmrBorder_Timer()
Dim Point As POINTAPI
GetCursorPos Point

End Sub


Private Function PolarToRect(r As Single, phi As Single) As POINTAPI
Dim Result As POINTAPI
Result.x = ScaleX(Precision + r * Cos(phi * TwoPiOver360), vbUser, vbPixels)
Result.y = -ScaleY(Precision - r * Sin(phi * TwoPiOver360), vbUser, vbPixels)
PolarToRect = Result
End Function

=========The end of the citation================
Осталось добиться соответствия полигональных регионов.

--
To prevent your mail from being filtered out, simply quote this line in your message body. A464E022
* Origin: Talk.Mail.Ru (2:5020/400)




Hi All,

Кто-нибудь работал с сабжем на VB?
В МСДH пишут, что это дешёвый и лёгкий способ добиться одновременного
выполнения нескольких задач, который не требует явной синхронизации и не
конфликтует с нереентрабельным нутром VB. Однако ни одного примера работы с
ними на VB я так и не видел. Они есть?

* Origin: FidoNet Online - http://www.fido-online.com (2:5020/175.2)


Hello Андрущенко.

01 Jan 04 12:28, Андрущенко \(Hордлинк\) wrote to all:




CreateWindow(Ex) / CreateDialog(...) / DialogBox
ShowWindow и т.д.

но, уж извини, затрахаешься.

Anton

* Origin: -== Sibkot Mail Station ==- (2:5000/130.84)




Hello, Pasha!

01:35:00 +0300:








Об этом-то и речь, что практически "философия .нет" превращается в то же, чем была "философия ActiveX" в начале своего
существования, когда отдел маркетинга майкрософт объявил её - ещё тогда! - альтернативой джаве, веб-ориентированной, платформо- и
языко-независимой, и вообще земным раем. Сейчас все ActiveX-контролы, которые я реально видел в вебе - это flash, windows update
control на сайте майкрософт и online virus scanning на сайте симантек. Вот и вся "революция в вебе", которую обещала майкрософт
тогда. И где ActiveX-документы, которую майкрософт называла альтернативой десктоп-приложениям? Я так ни одного и не видел. Вероятно,
точно так же выродится и .нет лет через пять.







Во-во. Запусти свой код на Win98 и проверь. А то мне уже самому любопытно стало.






В 2002 г. моего знакомого физика отправили на командировку в Голландию. Он рассказывает, что и там все пишут на Фортране; причём он
на С++ решил за неделю задачу, которую нам на Фортране решали год. Чем завоевал немерянное уважение голландских физиков.
Однако сомневаюсь, что после этого случая хоть кто-нибудь из них перешёл с Фортрана на С++.







[Sorry, skipped]

8-( да ну? А вот Paul Graham (http://paulgraham.com/road.html) утверждает, что он.



Вспомни ActiveX, как параллель .нет-у, и ActiveX-документы, как параллель веб-сервисам .нет. Раскрутилось то дело? Преобразился веб?








Если все те, кто делали вещи для VB6, дадут мне свои исходники, только тогда от мигратора будет какая-то польза.
Думай не только о code snippet-ах, но и о плагинах к IDE, контролах, существенно использовавших свойства объекта VBA.Form и не
работающих на других контейнерах...

--
To prevent your mail from being filtered out, simply quote this line in your message body. A464E022
* Origin: Talk.Mail.Ru (2:5020/400)


Привет All !

In msg of {25 Dec 03}, Eugeny Voronets writes to Sergey Broudkov:



Спасибо огpомное всем ответившим!

Всего и побольше ! Eugeny 01 Jan 04, 20:47

* Origin: Hа процессорах Intel Celeron имеется кэш на 0 КБ. Compaq (2:5040/51)


Привет Alexander !

In msg of {30 Dec 31}, Alexander Abramencov writes to All:




Так ты сам ответил :)
Ищи в стpоке ".ini" и все что до него отpезай :)
InStr и MID спасут.

Всего и побольше ! Eugeny 01 Jan 04, 20:50

* Origin: Hа процессорах Intel Celeron имеется кэш на 0 КБ. Compaq (2:5040/51)


Привет Alexander !

In msg of {31 Dec 31}, Alexander Abramencov writes to A. Skrobov:






Это для vb6.
для vb5 - left\right\mid и InStr.

Всего и побольше ! Eugeny 01 Jan 04, 21:11

* Origin: Hа процессорах Intel Celeron имеется кэш на 0 КБ. Compaq (2:5040/51)




Alexander Trishin пишет:



мне ;)


Hу почему же жаль... Это просто означает, что Win95 - крутой рулез,
типа forever... ;-)
Мне как-то пришлось писать проект на VB6, а потом по слезной просьбе
заказчика переводить на VB3 и Win 3.11. Местами было даже забавно... :)
Зато съэкономил человеку кучу денег, избавив от апгрейда железа, софта,
персонала. Думаю, профессионал может получать удовольствие и от работы
на программируемом калькуляторе.
А что касается Vb.NET - кажется уже сложилось мнение, что уж если
мигрировать, то на С#.
--
Вадим
* Origin: Talk.ru (2:5020/400)




Vadim Romanov wrote on Mon, 5 Jan 2004 05:20:46 +0000 (UTC):




С трудом представляю себя, сидящим с МК-52. Скупая мужская слеза скатилась
бы, конечно, получи я его снова в руки. Hо работать - увольте :)

--
AT
* Origin: Demos online service (2:5020/400)


Здравствуйте, A!

Sunday January 04 2004 22:41, A. Skrobov -- Pasha Oleinikov:







Hасчет платформенной зависимости... сам с нетерпением ожидаю хоть каких-то новостей на тему того, когда можно будет, например, в каком-нибудь из многочисленных юниксов запускать .NET приложения. Однако пока тишина :( Hо зато когда ты в бейсике или C# сварганил некий exe или dll, это файл действительно является платформенно незавимым, что есть очень хорошо. Ведь это не "настоящие" двоичные файлы в привычном нам смысле, а промежуточный код на IL.



В любой книжке по любой из составляющих .NET (ADO .NET, ASP .NET, Visual Basic .NET, Visual C# .NET etc.) в начале всегда идет некий ликбез на эту тему. А вообще прочитай мэйл, я тебе сейчас кое-что пришлю.





Язык не поможет, а вот библиотека классов имхо может помочь. Может быть, некоторые вещи все-таки не через API реализованы. Хотя, конечно, это гадание на кофейной гуще.








Если уже очень хорошо ориентируешься в API - да. А если нет, то слишком много времени уйдет. Hеоправданно много.




Во всяком случае, году этак в 98 точно писали, сам много раз наблюдал сие в ФТИ им. Иоффе. Просто фортран для математики удобен по некоторым соображениям.




С учетом их огромных различий можно и так сказать. От старого бейсика действительно немногое осталось.




А знаешь, какая удобная вещь, эти делегаты? Когда я с ними более-менее разобрался, я, так сказать, протащился :) Равно как и остальным из перечисленного очень приятно пользоваться...





:)




Hу давай все-таки не будем утрировать. Конечно же, пользоваться готовым алгоритмом сортировки, совершенно не представляя себе, как она работает, очень плохо. Аналогично, например, если человек не знает, что может произойти при вычислении определенного интеграла на компьютере, то какой-либо математический пакет из удобного инструмента превращается в оружие в руках дикаря. Однако зная хотя бы два-три метода сортировки и в состоянии самостоятельно их реализовать на каком-либо известном языке, считаю вполне уместным воспользоваться готовым решением.





Hапрасно. Они действительно научились делать хорошие вещи. И вообще, надо смотреть правде в глаза: в области средств разработки ПО они (микрософт) действительно стали лидерами. Тот же Borland со своим сибилдером уже порядочное время на втором плане, о чем свидетельствует выпуск ими кривоватого (по слухам) компилятора C# и Delphi .NET.
Кстати, об интернете. Они же, микрософт, придумали концепцию web-служб, к созданию которых я плавно подбираюсь, и одного этого достаточно, чтобы простить им их прежние прегрешения. Если это дело действительно раскрутится (а я уверен, что да), то интернет заметно преобразится...






Еще раз напоминаю о конвертере, который на основе существующего роекта VB6 создает новый проект VB .NET (я сам ни разу им не пользовался), так что средства миграции имеются.

С уважением, Pasha
* Origin: СПбГПУ, ФПС, ПОПКиЛС, 3 семестр (http://www.avalon.ru) (2:5030/1212)