source: trunk/ab5.0/ablib/TestCase/UI_Sample/step32_AnalogWatch_Gdiplus.ab@ 701

Last change on this file since 701 was 701, checked in by イグトランス (egtra), 15 years ago

BrushとStringFormatを追加
(#241)

File size: 4.9 KB
RevLine 
[698]1#require <gdiplus.ab>
2#require <Classes/System/Drawing/Graphics.ab>
3#require <Classes/System/Drawing/misc.ab>
4#require <Classes/System/Drawing/Point.ab>
5#require <Classes/System/Drawing/PointF.ab>
6#require <Classes/System/Drawing/Rectangle.ab>
7#require <Classes/System/Drawing/RectangleF.ab>
8#require <Classes/System/Drawing/Size.ab>
9#require <Classes/System/Drawing/SizeF.ab>
10#require <Classes/System/Drawing/Color.ab>
11#require <Classes/System/Drawing/CharacterRange.ab>
12#require <Classes/System/Drawing/Font.ab>
13#require <Classes/System/Drawing/FontFamily.ab>
14#require <Classes/System/Drawing/Pen.ab>
[701]15#require <Classes/System/Drawing/Brush.ab>
16#require <Classes/System/Drawing/StringFormat.ab>
17#require <Classes/System/Drawing/Image.ab>
[698]18#require <Classes/System/Drawing/Drawing2D/misc.ab>
19#require <Classes/System/Drawing/Drawing2D/Matrix.ab>
20#require <Classes/System/Drawing/Imaging/misc.ab>
21#require <Classes/System/Drawing/Imaging/MetafileHeader.ab>
22#require <Classes/System/Drawing/Text/misc.ab>
23
24/*!
25@file
26@brief 「Win32プログラミング講座 ~ Step32. アナログ時計を作る ~」のAB5 GDI+移植版
27http://www.activebasic.com/help_center/articles/win32/step05/
28メニューは未実装。
29
30@date 2008/07/20
31@auther Egtra
32*/
33
34#require <Classes/ActiveBasic/Windows/UI/Form.ab>
35#require <Classes/ActiveBasic/Windows/UI/Application.ab>
36#require <Classes/ActiveBasic/Windows/UI/Timer.ab>
37
38Imports ActiveBasic.Windows.UI
39Imports ActiveBasic.Math
40Imports System
[701]41Imports System.Drawing
42Imports System.Drawing.Drawing2D
[698]43
44#resource "UI_Sample.rc"
45
46Const PAI = 3.14159265358979323846264
47
48Class WatchForm
49 Inherits Form
50Public
51 Sub WatchForm()
52 AddCreate(AddressOf(OnCreate))
53 AddDestroy(AddressOf(OnDestroy))
54 AddPaintDC(AddressOf(OnPaint_))
55 AddPaintBackground(AddressOf(OnPaintBackground_))
56 End Sub
57
58Protected
59 Override Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
60 Super.GetCreateStruct(cs)
61 With cs
62 .cx = 240
63 .cy = 240
64 .lpszName = "clock"
65 End With
66 End Sub
67
68Private
69 Sub OnCreate(sender As Object, e As CreateArgs)
70 timer = New Timer(This)
71 With timer
72 .Interval = 100 '元に忠実にするなら10
73 .AddTick(AddressOf(Timer_OnTick))
74 .Start()
75 End With
76 GetLocalTime(st)
77
78 Dim gsi = [1] As GdiplusStartupInput
79 GdiplusStartup(gdipToken, gsi, 0)
80 End Sub
81
82 Sub OnDestroy(sender As Object, e As EventArgs)
[701]83 GdiplusShutdown(gdipToken)
[698]84 End Sub
85
86 Sub Timer_OnTick(sender As Object, e As Args)
87 Dim wsec As Word
88 wsec = st.wSecond
89 GetLocalTime(st)
90 '秒針を動かす必要があるときは再描画する
91 If wsec <> st.wSecond Then Invalidate()
92 End Sub
93
94 Sub OnPaintBackground_(sender As Object, e As PaintBackgroundArgs)
95 Dim hdc = e.Handle
96 Dim rc = This.ClientRect
97 Dim hbrOld = SelectObject(hdc, GetStockObject(WHITE_BRUSH))
98 ExtTextOut(hdc, 0, 0, ETO_OPAQUE, rc, "", 0, 0)
99 SelectObject(hdc, hbrOld)
100 End Sub
101
102 Sub OnPaint_(sender As Object, e As PaintDCArgs)
103 Dim pos As PointF
104
105 Dim hdc = e.Handle
106 Dim g = Graphics.FromHDC(hdc)
107 g.Clear(&hffffffff)
108
109 Dim rc = This.ClientRect
110 Dim CenterPos As PointF '針の中心位置
111 '針の中心位置
112 CenterPos.X = rc.right / 2
113 CenterPos.Y = rc.bottom / 2
114
115 '3つとも元と違ってDouble型にしている。
116 Dim Length_Second = Math.Min(rc.bottom, rc.right) / 2.0 - 2.0 '秒針の長さ
117 Dim Length_Minute = Length_Second As Double '短針の長さ
118 Dim Length_Hour = Length_Minute * 0.70 '長針の長さ
119
120 '短針
121 If st.wHour = 12 Then st.wHour = 0
122 pos.X = (CenterPos.X + Length_Hour * Sin(st.wHour * PAI / 6 + st.wMinute * PAI / 360)) As Single
123 pos.Y = (CenterPos.Y - Length_Hour * Cos(st.wHour * PAI / 6 + st.wMinute * PAI / 360)) As Single
124 Dim pen = New Pen(&hffff6400, 5.0)
125 g.DrawLine(pen, CenterPos, pos)
126
127 '長針
128 pos.X = (CenterPos.X + Length_Minute * Sin(st.wMinute * PAI / 30 + st.wSecond * PAI / 1800)) As Single
129 pos.Y = (CenterPos.Y - Length_Minute * Cos(st.wMinute * PAI / 30 + st.wSecond * PAI / 1800)) As Single
130 pen.Color = &hffff0000
131 pen.Width = 2.0
132 g.DrawLine(pen, CenterPos, pos)
133
134 '秒針
135 pos.X = (CenterPos.X + Length_Second * Sin(st.wSecond * PAI / 30)) As Long
136 pos.Y = (CenterPos.Y - Length_Second * Cos(st.wSecond * PAI / 30)) As Long
137 pen.Color = &hff000000
138 pen.Width = 1.0
139 g.DrawLine(pen, CenterPos, pos)
140 pen.Dispose()
[701]141
142 Dim pt1 = [0, 0] As Point
143 Dim pt2 As Point
144 pt2.X = rc.right
145 pt2.Y = rc.bottom
146 Dim br = New LinearGradientBrush(pt1, pt2, &haa00ff40 As Color, &h66ffcc00 As Color) 'New SolidBrush(&h8080ff00)
147 br.GammaCorrection = True
148 Dim f = New Font("Verdana", 20.0)
149 Dim s = "Step32. Analog whach" As String
150 g.RotateTransform(25)
151 g.DrawString(s, f, br, 10.0, 10.0)
152 f.Dispose()
153 br.Dispose()
154
[698]155 g.Dispose()
156 End Sub
157
158 timer As Timer
159 st As SYSTEMTIME
160 bTopMost As Long
161 gdipToken As ULONG_PTR
162End Class
163
164Control.Initialize(GetModuleHandle(0))
165Dim f = New WatchForm
166f.CreateForm()
167Application.Run(f)
168End
Note: See TracBrowser for help on using the repository browser.