vector.bas

Powerbasic 对GDI 的操作 很漂亮的代码!

         wP& = LOWRD(wParam&)

         SELECT CASE LONG wP&
         CASE %ID_NEW_IMAGE
              FilName$ = ZI_LoadDialog(hWin&)
              CALL ZI_SetFromFile(GetDlgItem(hWin&, %ID_CTRL), (FilName$))

         CASE %ID_DRAW_MAP ' Draw vector MAP
              IF InProgress& THEN
                 CALL zFocusBeep()
                 FUNCTION = 0: EXIT FUNCTION
              ELSE
                 InProgress& = -1
                 CALL ZD_ShowObjectList(BYVAL VARPTR(IDpolygon&(1)), 4, %ZD_HIDE)
              END IF
              hCtrl& = GetDlgItem(hWin&, %ID_CTRL)

              Usa$ = "146,218,166,224,168,230,162,235,168,240,175,236,175,224,175,206,244,216,350,222," + _
                     "468,210,500,203,518,210,529,205,546,210,573,207,554,235,566,232,570,236,577,233," + _
                     "585,243,591,243,606,240,616,253,618,259,613,265,618,262,622,291,629,299,628,310," + _
                     "637,317,644,308,644,287,637,272,633,253,641,250,639,242,647,229,663,233,670,242," + _
                     "673,250,666,259,666,266,673,271,678,261,683,258,691,272,687,283,686,295,691,298," + _
                     "703,297,730,269,733,259,731,248,747,240,755,237,759,220,766,198,792,188,810,176," + _
                     "814,161,812,138,813,131,829,128,842,147,855,152,852,168,840,176,841,185,833,189," + _
                     "833,203,830,214,838,218,833,227,844,228,851,224,852,231,846,236,840,236,840,244," + _
                     "831,251,837,254,830,265,814,277,816,291,813,304,802,306,809,314,814,325,810,329," + _
                     "811,337,807,343,804,336,806,328,796,319,791,306,788,305,786,319,794,324,792,329," + _
                     "800,336,801,345,795,347,802,352,806,349,813,352,815,359,811,368,823,370,818,383," + _
                     "811,381,812,389,818,388,821,390,809,399,803,412,795,416,794,423,791,435,775,459," + _
                     "775,464,776,478,772,489,781,497,783,513,797,531,809,545,819,567,820,575,814,592," + _
                     "809,592,803,588,801,581,791,576,772,557,770,547,767,546,763,531,747,517,735,517," + _
                     "727,526,719,525,703,517,682,523,677,525,673,520,669,523,661,527,652,535,649,540," + _
                     "656,541,652,549,663,557,662,559,648,552,645,553,649,557,640,560,634,560,622,551," + _
                     "614,551,611,556,603,559,599,552,589,554,581,559,574,555,567,555,563,558,572,560," + _
                     "574,564,555,585,547,584,548,593,536,600,534,613,531,616,537,630,538,639,516,636," + _
                     "506,626,502,613,502,608,494,608,475,583,457,573,450,576,440,590,429,592,418,581," + _
                     "411,565,385,543,383,541,358,542,354,547,340,546,309,548,253,526,254,522,212,522," + _
                     "206,505,189,489,168,480,148,442,150,431,144,426,147,421,149,421,150,415,141,414," + _
                     "130,392,128,380,129,364,134,347,132,328,133,314,145,291,151,259,153,237,147,226"
              UsaCount& = PARSECOUNT(Usa$) \ 2

              DIM zp(0) AS ZPOLYGON
              DIM xy(0 TO UsaCount& - 1) AS POINTS
              PolygonCount& = UBOUND(zp()) - LBOUND(zp()) + 1

              CALL ZD_ShowObject(%ID_OBJECT_MAP_FILLED, %ZD_HIDE)

              FOR I& = 10 TO 55
                  N& = 0: C& = 0: Coef! = I& / 100
                  FOR K& = 0 TO UsaCount& - 1
                      INCR N&: xy(C&).x = VAL(PARSE$(USA$, N&)) * Coef!
                      INCR N&: xy(C&).y = VAL(PARSE$(USA$, N&)) * Coef!
                      INCR C&
                  NEXT

                  zp(0).pXY = VARPTR(xy(0))
                  zp(0).ArraySize = UsaCount&
                  zp(0).ObjID     = %ID_OBJECT_MAP_OUTLINE
                  zp(0).ColorARGB = ZD_ColorARGB(255, RGB(100,250,150))
                  zp(0).PenSize   = 1
                  zp(0).ZS_Style  = %ZS_VISIBLE OR %ZS_DRAFT
                  zp(0).ZD_Style  = %ZD_DRAW_OUTLINE

                  CALL ZD_PolyPolygon(hCtrl&, zp(), PolygonCount&)
              NEXT

              zp(0).ZD_Style  = %ZD_DRAW_FILLED
              zp(0).ColorARGB = ZD_ColorARGB(64, RGB(100,250,150))
              CALL ZD_PolyPolygon(hCtrl&, zp(), PolygonCount&)

              zp(0).pXY = VARPTR(xy(0))
              zp(0).ArraySize = UsaCount&
              zp(0).ObjID     = %ID_OBJECT_MAP_FILLED
              zp(0).ColorARGB = ZD_ColorARGB(255, RGB(100,250,150))
              zp(0).PenSize   = 2
              zp(0).ZS_Style  = %ZS_VISIBLE
              zp(0).ZD_Style  = %ZD_DRAW_OUTLINE

              CALL ZD_PolyPolygon(hCtrl&, zp(), PolygonCount&)

              InProgress& = 0

         CASE %ID_POLYPOLYGON ' Draw PolyPolygon
              IDpolygon&(1) = 21 ' Each polygon must use a unique object ID
              IDpolygon&(2) = 22 ' Each polygon must use a unique object ID
              IDpolygon&(3) = 23 ' Each polygon must use a unique object ID
              IDpolygon&(4) = 24 ' Each polygon must use a unique object ID
              IF ZD_IsObjectVisible(IDpolygon&(1)) THEN
                 CALL ZD_ShowObjectList(BYVAL VARPTR(IDpolygon&(1)), 4, %ZD_HIDE)
                 FUNCTION = 0: EXIT FUNCTION
              ELSE
                 IF ZD_GetObjectParent(IDpolygon&(1)) THEN
                    CALL ZD_ShowObjectList(BYVAL VARPTR(IDpolygon&(1)), 4, %ZD_SHOW)
                    FUNCTION = 0: EXIT FUNCTION
                 END IF
              END IF

              hCtrl& = GetDlgItem(hWin&, %ID_CTRL)

              DIM pp(0 TO 3) AS ZPOLYGON
              DIM pxy(0 TO 11) AS POINTS

            ' Top Triangle
              pxy(0).x = 125:  pxy(0).y = 290 + 10
              pxy(1).x =  95:  pxy(1).y = 290 + 70
              pxy(2).x = 155:  pxy(2).y = 290 + 70
              pp(0).pXY = VARPTR(pxy(0))
              pp(0).ArraySize = 3
              pp(0).ObjID     = IDpolygon&(1)
              pp(0).ColorARGB = ZD_ColorARGB(255, RGB(100,250,150))
              pp(0).PenSize   = 4
              pp(0).ZS_Style  = %ZS_VISIBLE
              pp(0).ZD_Style  = %ZD_DRAW_OUTLINE

            ' Left Triangle
              pxy(3).x =  80:  pxy(3).y = 290 + 80
              pxy(4).x =  20:  pxy(4).y = 290 + 110
              pxy(5).x =  80:  pxy(5).y = 290 + 140
              pp(1).pXY = VARPTR(pxy(3))
              pp(1).ArraySize = 3
              pp(1).ObjID     = IDpolygon&(2)
              pp(1).ColorARGB = ZD_ColorARGB(255, RGB(100,150,250))
              pp(1).PenSize   = 4
              pp(1).ZS_Style  = %ZS_VISIBLE
              pp(1).ZD_Style  = %ZD_DRAW_OUTLINE

            ' Bottom Triangle
              pxy(6).x =  95: pxy(6).y = 290 + 155
              pxy(7).x = 125: pxy(7).y = 290 + 215
              pxy(8).x = 155: pxy(8).y = 290 + 155
              pp(2).pXY = VARPTR(pxy(6))
              pp(2).ArraySize = 3
              pp(2).ObjID     = IDpolygon&(3)
              pp(2).ColorARGB = ZD_ColorARGB(255, RGB(255,0,0))
              pp(2).PenSize   = 4
              pp(2).ZS_Style  = %ZS_VISIBLE
              pp(2).ZD_Style  = %ZD_DRAW_OUTLINE

            ' Right Triangle
              pxy(9).x  = 170: pxy(9).y  = 290 +  80
              pxy(10).x = 170: pxy(10).y = 290 + 140
              pxy(11).x = 230: pxy(11).y = 290 + 110
              pp(3).pXY = VARPTR(pxy(9))
              pp(3).ArraySize = 3
              pp(3).ObjID     = IDpolygon&(4)
              pp(3).ColorARGB = ZD_ColorARGB(255, RGB(250,250,150))
              pp(3).PenSize   = 8
              pp(3).ZS_Style  = %ZS_VISIBLE
              pp(3).ZD_Style  = %ZD_DRAW_OUTLINE

              PolygonCount& = UBOUND(pp()) - LBOUND(pp()) + 1
              CALL ZD_PolyPolygon(hCtrl&, pp(), PolygonCount&)

         CASE %ID_BACKGROUND
              hCtrl& = GetDlgItem(hWin&, %ID_CTRL)
              IF ZI_GetTiledBackground(hCtrl&) THEN
                 CALL ZI_SetTiledBackground(hCtrl&, 0)
              ELSE
                 CALL ZI_SetTiledBackground(hCtrl&, ZI_CreateBitmapFromFile("038.jpg", 0,0))
              END IF
              CALL ZI_UpdateWindow(hCtrl&, %FALSE)

         END SELECT

    CASE %WM_CREATE
    CASE %WM_TIMER
    CASE %WM_MOVING
         DIM pRC AS RECT PTR
       ' Move also our "Child window Region" while user drags the main window
         prc = lParam&
         CALL ZI_GetImageSizeFromControl(ghRegion, imgWidth&, imgHeight&)
         x& = @prc.nLeft - (imgWidth& \ 2)
         y& = @prc.nTop + @prc.nBottom - @prc.nTop - imgHeight&
         CALL MoveWindow(ghRegion, x&, y&, imgWidth&, imgHeight&, %TRUE)
    CASE %WM_SIZE
         'sbh& = rc.nBottom - rc.nTop
         'caW& = LOWRD(lParam&)
         'caH& = HIWRD(lParam&)
         'CALL MoveWindow(ghRegion, 0, caH& - sbh&, caW&, caH&, %TRUE)
         'FUNCTION = 0: EXIT FUNCTION
    CASE %WM_PAINT
         CALL GradientPaint(hWin&, RGB(228,227,227), RGB(168,167,191))
         FUNCTION = 0: EXIT FUNCTION
    CASE %WM_CLOSE
    CASE %WM_DESTROY
         IF hBitmapFromFile& THEN CALL DeleteObject(hBitmapFromFile&)
         CALL PostQuitMessage(0)
         FUNCTION = 0: EXIT FUNCTION
    END SELECT
    FUNCTION = DefWindowProc(hWin&, Msg&, wParam&, lParam&)
END FUNCTION

SUB GradientPaint(BYVAL hWin&, BYVAL TopRGB&, BYVAL BottomRGB&)
    LOCAL ps AS PAINTSTRUCT
    LOCAL rc AS RECT
  ' Tile the background
    CALL GetClientRect (hWin&, rc)
    hDC& = BeginPaint(hWin&, ps)
    CALL ZI_GradientPaintDC(hDC&, 0, 0, rc.nRight, rc.nBottom, TopRGB&, BottomRGB&)
    CALL EndPaint(hWin&, ps)
END SUB