drawing.bas

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

          DIM xy(0 TO 9) AS POINTS
          xy(0).x = 80  + 150:  xy(0).y = 135 + 150
          xy(1).x = 140 + 150:  xy(1).y = 130 + 150
          xy(2).x = 160 + 150:  xy(2).y = 80  + 150
          xy(3).x = 180 + 150:  xy(3).y = 130 + 150
          xy(4).X = 240 + 150:  xy(4).y = 135 + 150
          xy(5).X = 192 + 150:  xy(5).y = 165 + 150
          xy(6).X = 210 + 150:  xy(6).y = 220 + 150
          xy(7).X = 160 + 150:  xy(7).y = 190 + 150
          xy(8).X = 110 + 150:  xy(8).y = 220 + 150
          xy(9).X = 128 + 150:  xy(9).y = 165 + 150
          CALL ZD_DrawPolyLineToCtrl(GetDlgItem(hMain, %ID_CTRL), _     ' The GDImage control handle
                                  BYVAL VARPTR(xy(0)), _
                                  UBOUND(xy) - LBOUND(xy) + 1, _
                                  ZD_ColorARGB(255,RGB(100,250,150)), _
                                  5, _
                                  %ID_POLYLINE_1, _
                                  %ZS_VISIBLE OR %ZS_DRAFT, _
                                  %ZD_DRAW_OUTLINE OR %ZD_DRAW_OPEN, _
                                  0)

        ' Show the main window
          CALL ShowWindow(hMain, iCmdShow)
          CALL SetForegroundWindow(hMain)                  ' Slightly Higher Priority
          CALL SetFocus(GetDlgItem(hMain, %ID_CTRL))       ' Sets Keyboard Focus To The Window

          WHILE GetMessage(Msg, %NULL, 0, 0)
              IF IsDialogMessage(hMain, Msg) = %FALSE THEN
                 CALL TranslateMessage(msg)                ' Translate The Message
                 CALL DispatchMessage(msg)                 ' Dispatch The Message
              END IF
          WEND

          FUNCTION = msg.wParam
       END IF

     ' UNLOAD the WinXP Theme DLL (if necessary)
       IF hWinXP_Lib THEN CALL FreeLibrary(hWinXP_Lib)

    END IF
'
    IF hMutex THEN CALL CloseHandle(hMutex)
'
END FUNCTION

FUNCTION WndProc(BYVAL hWin&, BYVAL Msg&, BYVAL wParam&, BYVAL lParam&) EXPORT AS LONG
    LOCAL ps AS PAINTSTRUCT
    LOCAL rc AS RECT

    STATIC InProgress&

    SELECT CASE Msg&

    CASE %WM_COMMAND
         wP& = LOWRD(wParam&)

         SELECT CASE LONG wP&
         CASE %ID_NEWIMAGE
              FilName$ = ZI_LoadDialog(hWin&)
              CALL ZI_SetFromFile(GetDlgItem(hWin&, %ID_CTRL), (FilName$))
         CASE %ID_ANTIALIAS
              StyleIs& = ZD_GetObjectStyle(%ID_ARROW_1)
              IF (StyleIs& AND %ZS_DRAFT) = %ZS_DRAFT THEN
                  StyleIs& = StyleIs& XOR %ZS_DRAFT
                  CALL ZD_SetObjectStyle(%ID_ARROW_1, StyleIs&)
              ELSE
                  StyleIs& = StyleIs& OR %ZS_DRAFT
                  CALL ZD_SetObjectStyle(%ID_ARROW_1, StyleIs&)
              END IF

              StyleIs& = ZD_GetObjectStyle(%ID_ELLIPSE_1)
              IF (StyleIs& AND %ZS_DRAFT) = %ZS_DRAFT THEN
                  StyleIs& = StyleIs& XOR %ZS_DRAFT
                  CALL ZD_SetObjectStyle(%ID_ELLIPSE_1, StyleIs&)
              ELSE
                  StyleIs& = StyleIs& OR %ZS_DRAFT
                  CALL ZD_SetObjectStyle(%ID_ELLIPSE_1, StyleIs&)
              END IF

              StyleIs& = ZD_GetObjectStyle(%ID_CURVE_1)
              IF (StyleIs& AND %ZS_DRAFT) = %ZS_DRAFT THEN
                  StyleIs& = StyleIs& XOR %ZS_DRAFT
                  CALL ZD_SetObjectStyle(%ID_CURVE_1, StyleIs&)
              ELSE
                  StyleIs& = StyleIs& OR %ZS_DRAFT
                  CALL ZD_SetObjectStyle(%ID_CURVE_1, StyleIs&)
              END IF

              StyleIs& = ZD_GetObjectStyle(%ID_POLYLINE_1)
              IF (StyleIs& AND %ZS_DRAFT) = %ZS_DRAFT THEN
                  StyleIs& = StyleIs& XOR %ZS_DRAFT
                  CALL ZD_SetObjectStyle(%ID_POLYLINE_1, StyleIs&)
              ELSE
                  StyleIs& = StyleIs& OR %ZS_DRAFT
                  CALL ZD_SetObjectStyle(%ID_POLYLINE_1, StyleIs&)
              END IF

              CALL ZI_UpdateWindow(ZD_GetObjectParent(%ID_ARROW_1), %FALSE)

         CASE %ID_RECTANGLE
            ' Check visibility status
              zOrder& = ZD_GetObjectZorder(%ID_RECT_1)
              IF zOrder& = 1 THEN
                 zOrder& = %ZD_ORDER_TOP
              ELSE
                 zOrder& = %ZD_ORDER_BOTTOM
              END IF
              CALL ZD_SetObjectZorder(%ID_RECT_1, zOrder&)
              CALL ZI_UpdateWindow(ZD_GetObjectParent(%ID_ARROW_1), %FALSE)

         CASE %ID_ANIMATETEXT
            ' Check first for text overlay visibility
              IF ZD_IsObjectVisible(%ID_TEXT_SCROLLING) = 0 AND ZD_IsObjectVisible(%ID_TEXT_FLOATING) THEN
                 FUNCTION = 0: EXIT FUNCTION
              END IF
            ' If effect already in progress then bailout
              IF InProgress& THEN
                 CALL zFocusBeep()
                 FUNCTION = 0: EXIT FUNCTION
              ELSE
                 InProgress& = -1
              END IF
            ' Get the %ID_TEXT_WATERMAK properties
              CALL GetClientRect (ZD_GetObjectParent(%ID_TEXT_SCROLLING), rc): xRight& = rc.nRight
              CALL ZD_GetObjectBound(%ID_TEXT_SCROLLING, xBoundWidth&, xBoundHeight&)
              CALL ZD_GetOBjectXY(%ID_TEXT_SCROLLING, xX&, Xy&)

            ' Get the %ID_TEXT_FLOATING properties
              CALL GetClientRect (ZD_GetObjectParent(%ID_TEXT_FLOATING), rc): yHeight& = rc.nBottom
              CALL ZD_GetObjectBound(%ID_TEXT_FLOATING, yBoundWidth&, yBoundHeight&)
              CALL ZD_GetOBjectXY(%ID_TEXT_FLOATING, yX&, yY&)

              DoneWithX& = 0: DoneWithY& = 0
              X1& = xX&: Y1& = yY&
              IF ZD_IsObjectVisible(%ID_RECT_1) THEN UseStep& = 4 ELSE UseStep& = 2
              DO UNTIL DoneWithX& and DoneWithY&
                 IF ZD_IsObjectVisible(%ID_TEXT_SCROLLING) THEN ' Check for visibility
                    IF DoneWithX& = 0 THEN
                       IF X1& > -xBoundWidth& THEN
                          X1& = X1& - UseStep&
                          CALL ZD_SetObjectXY(%ID_TEXT_SCROLLING, X1&, Xy&, %ZD_DRAW_DEFERRED)
                       ELSEIF X2& = 0 THEN
                          X2& = xRight& + xBoundWith&
                       END IF
                    END IF
                 END IF
                 IF ZD_IsObjectVisible(%ID_TEXT_FLOATING) THEN ' Check for visibility
                    IF DoneWithY& = 0 THEN
                       IF Y1& > -yBoundHeight& THEN
                          Y1& = Y1& - UseStep&
                          CALL ZD_SetObjectXY(%ID_TEXT_FLOATING, yX&, Y1&, %ZD_DRAW_DEFERRED)
                       ELSEIF Y2& = 0 THEN
                          Y2& = yHeight& + yBoundHeight&
                       END IF
                    END IF
                 END IF
                 IF ZD_IsObjectVisible(%ID_TEXT_SCROLLING) THEN ' Check for visibility
                    IF DoneWithX& = 0 THEN
                       IF X2& > 0 THEN
                          X2& = X2& - UseStep&
                          IF X2& < xX& + 1 THEN X2& = xX&: DoneWithX& = -1
                          CALL ZD_SetObjectXY(%ID_TEXT_SCROLLING, X2&, Xy&, %ZD_DRAW_DEFERRED)
                        END IF
                    END IF
                 END IF
                 IF ZD_IsObjectVisible(%ID_TEXT_FLOATING) THEN ' Check for visibility
                    IF DoneWithY& = 0 THEN
                       IF Y2& > 0 THEN
                          Y2& = Y2& - UseStep&
                          IF Y2& < yY& + 1 THEN Y2& = yY&: DoneWithY& = -1
                          CALL ZD_SetObjectXY(%ID_TEXT_FLOATING, yX&, Y2&, %ZD_DRAW_DEFERRED)
                       END IF
                    END IF
                 END IF

               ' Changing text on the fly
                 CALL ZD_SetObjectText(%ID_TEXT_FLOATING, "Floating [" + LTRIM$(STR$(GetTickCount)) + "]")

                 CALL ZI_UpdateWindow(ZD_GetObjectParent(%ID_TEXT_FLOATING), %FALSE)
                 IF ZD_DoEvents() THEN EXIT DO

              LOOP
              InProgress& = 0
         CASE %ID_COLORCOUNT
              Message$ = "This image has" + STR$(ZI_ColorCount(GetDlgItem(hWin&, %ID_CTRL))) + " unique color(s)"
              CALL MessageBox(0, (Message$), "GDImage version " + ZI_Version, 0)

         CASE %ID_GRAYSHADE
              CALL ZI_ConvertToGray(ZI_GetDC(GetDlgItem(hWin&, %ID_CTRL)))
              CALL ZI_UpdateWindow(GetDlgItem(hWin&, %ID_CTRL), %FALSE)

         CASE %ID_PRINTIMAGE
              CALL ZI_PrintImage(GetDlgItem(hWin&, %ID_CTRL))

         CASE %ID_PRINTFULL
              CALL ZI_PrintFull(GetDlgItem(hWin&, %ID_CTRL))
              
         CASE %ID_FROMSTREAM
              FilName$ = "genus.jpg" ' "JPGSTRNG.txt"
              IF zExist(FilName$) THEN
               ' Read from text file
                 Errcode& = zFOpen(FilName$, 0, 0, hFile&)
                 IF ErrCode& = 0 THEN
                    BufferSize& = zFlof(hFile&)
                    BufferData$ = SPACE$(BufferSize&)
                    ErrCode& = zFGet(hFile&, BufferData$)
                    CALL zFClose(hFile&)
                    IF ErrCode& = 0 THEN
                       IF ZI_LoadImageFromStream(GetDlgItem(hWin&, %ID_CTRL), BYVAL STRPTR(BufferData$), BufferSize&) = 0 THEN
                          zReportError "The provided string is not a valid Image Stream"
                       END IF
                    END IF
                 END IF              
              END IF
         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
         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