真彩色展示

2008年2月15日小程序
0

Comments

比较无聊的我用VB写了一个能生成所有24位真彩色的程序，可以循环播放真彩色。在这个程序中，你开始会觉得看不出来有变化，不知不觉间就完全变掉了。每轮一共512桢，每桢256*256，向右绿色增加，向下蓝色增加，播放为红色的变化。

如果感兴趣可以在这里下载：allTrueColor.exe (28KB)

Windows 9x需要有VB6运行库支持。另外运行本程序可能导致CPU占用率极高（我用双核，其中一个核可以达到100%）。这个程序的变化速度取决于电脑的运行速度，但通常是比较快速的，这完全得益于使用Windows API代替VB自带的函数带来的效率。

下面是源代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

Option Explicit
Dim isBegin As Boolean, isAdd As Boolean
Dim i As Integer, j As Integer, k As Integer
Private Declare Function SetPixel Lib "gdi32" _
    (ByVal hdc As Long, _
    ByVal x As Long, ByVal y As Long, _
    ByVal crColor As Long) As Long
 
Private Sub cmdStart_Click()
    Dim hdc As Long
    hdc = pic.hdc
    isBegin = True
    Do
        For j = 0 To 255
            For k = 0 To 255
                SetPixel hdc, j, k, RGB(i, j, k)
            Next k
            DoEvents
        Next j
        If Not isBegin Then Exit Sub
        'SavePicture pic.Image, _
            'App.Path & "\" & CStr(i) & ".bmp"
        pic.Refresh
        DoEvents
        If isAdd Then
            i = i + 1
            If i = 255 Then isAdd = False
        Else
            i = i - 1
            If i = 0 Then isAdd = True
        End If
    Loop
End Sub
 
Private Sub cmdStop_Click()
    isBegin = False
End Sub
 
Private Sub Form_Load()
    isAdd = True
End Sub

整个窗体只有3个控件：一个PictureBox控件pic，长宽256px，记得要把ScaleMode设为Pixel；剩下的就是两个按钮cmdStart和cmdStop了

You can follow any responses to this entry through the RSS 2.0 | You can leave a response or trackback from your own site.

Related Posts Random Posts

Leave a Reply