窗体绘图如何添加滚动条？

zopey

在窗体上设置了一个 800*600 矩形区域绘制 XY散点图，X是不重复的日期，Y是股票收盘价，
1、当数据过多时 系列点会超出此区域，看不见了，
2、为解决问题1，对源数据缩放后，同一竖线 出现 多个数据点 （相邻日期）。

希望提供 横向可延伸的绘图区域， 类似滚动条效果。



收盘价连线.zip (285.49 KB, 下载次数: 830)

2018-11-7 11:21 上传

点击文件名下载附件

zopey

插入图表 有现成的 股价图，缺点是  数据不能 灵活处理。

zopey

好不容易找到足够大的画布，初具雏形。

      For i = 1 To k0
          junk = SetPixel(hDCmem, i, 600 - arr(i, 6) * 8, RGB(255, 0, 0))
          junk = SetPixel(hDCmem, i, 600 - arr(i, 3) * 8, RGB(0, 0, 255))
          junk = SetPixel(hDCmem, i, 600 - arr(i, 4) * 8, RGB(0, 255, 0))
      Next

zopey

    5日k线图 ，30日k线图，60日k线图  （不同颜色的点）示例，数组数据 可以灵活处理

  For i = 60 To k0
          'junk = SetPixel(hDCmem, i, 600 - arr(i, 6) * 8, RGB(255, 0, 0))

          avg5 = 0
          For j = 0 To 4
             avg5 = avg5 + arr(i - j, 6)
          Next
          junk = SetPixel(hDCmem, i, 600 - avg5 * 8 / 5, RGB(0, 0, 255))

          avg30 = 0
          For j = 0 To 29
             avg30 = avg30 + arr(i - j, 6)
          Next
          junk = SetPixel(hDCmem, i, 600 - avg30 * 8 / 30, RGB(255, 0, 0))

          avg60 = 0
          For j = 0 To 59
             avg60 = avg60 + arr(i - j, 6)
          Next
          junk = SetPixel(hDCmem, i, 600 - avg60 * 8 / 60, RGB(0, 255, 0))
      Next

clyfd

zopey 发表于 2018-11-12 11:31
5日k线图 ，30日k线图，60日k线图  （不同颜色的点）示例，数组数据 可以灵活处理

  For i = 60 To  ...

在给个实例呗

zopey

clyfd 发表于 2018-11-12 15:09
在给个实例呗

在摸石头过河，求助高人

刘伶醉0

zopey 发表于 2018-11-12 11:31
5日k线图 ，30日k线图，60日k线图  （不同颜色的点）示例，数组数据 可以灵活处理

  For i = 60 To  ...

这一段是插在哪里的

zopey

刘伶醉0 发表于 2018-11-12 15:26
这一段是插在哪里的

基本过程：
1、提取 网易历史交易数据 =arr ，不同日期可能有 几千条，
2、根据数据规模  建立像素足够大的位图 =bitmap，同时 生成内存画布= hDCmem
3、插入以上代码 在内存画布上 绘制数据点 （x代表日期，y代表价格）
4、通过剪切板 用window 画图 读取全部图像，
     或者别的方式 读取部分图像（这里可以 采用滚动条 方式）。

zopey

clyfd 发表于 2018-11-12 15:09
在给个实例呗

精简实例

Sub 按钮5_Click()
   Dim arr, k0, k2, i, j As Integer
   With Worksheets("sheet2")
       k0 = .[a1].End(4).Row - 1
       arr = .[a2].Resize(k0, 6)
   End With
   k2 = arr(1, 3)
   For i = 2 To k0
      If arr(i, 3) > k2 Then k2 = arr(i, 3)
   Next

   Dim hdc As Long, hDCmem As Long, hBitmap As Long
   hdc = GetDC(0)

   hDCmem = CreateCompatibleDC(hdc)              '创建一个与窗体相兼容的设备场景
   hBitmap = CreateCompatibleBitmap(hdc, k0, 400)  '创建一个与屏幕兼容的位图，得到它的句柄

   If hBitmap <> 0 Then
      Dim junk As Long, avg5, avg30, avg60
      junk = SelectObject(hDCmem, hBitmap)

       For i = 1 To k0

           avg5 = 0
           For j = 0 To 4
              If i - j = 0 Then Exit For
              avg5 = avg5 + arr(i - j, 6)
           Next
           avg5 = avg5 / (j + 1)
           junk = SetPixel(hDCmem, i, 400 - avg5 * 400 / k2, RGB(0, 0, 255))

           '''''''''''''''''''''
           avg30 = 0
           For j = 0 To 29
              If i - j = 0 Then Exit For
              avg30 = avg30 + arr(i - j, 6)
           Next
           avg30 = avg30 / (j + 1)
           junk = SetPixel(hDCmem, i, 400 - avg30 * 400 / k2, RGB(255, 0, 0))

           '''''''''''''''''''
           avg60 = 0
           For j = 0 To 59
              If i - j = 0 Then Exit For
              avg60 = avg60 + arr(i - j, 6)
           Next
           avg60 = avg60 / (j + 1)
           junk = SetPixel(hDCmem, i, 400 - avg60 * 400 / k2, RGB(0, 255, 0))
       Next

      junk = OpenClipboard(0)
      junk = EmptyClipboard()
      junk = SetClipboardData(CF_BITMAP, hBitmap)
      junk = CloseClipboard()
   End If

   junk = DeleteDC(hDCmem)
   junk = ReleaseDC(0, hdc)

   ActiveSheet.Paste
End Sub



ff6.rar (105.56 KB, 下载次数: 262)

2018-11-12 19:55 上传

点击文件名下载附件

clyfd

zopey 发表于 2018-11-12 19:56
精简实例

Sub 按钮5_Click()

加载DLL错误