resource.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_MOVE_ZMAGIC ' Draw BITMAP Overlay
              IF InProgress& THEN
                 CALL zFocusBeep()
                 FUNCTION = 0: EXIT FUNCTION
              ELSE
                 InProgress& = -1
              END IF
              hCtrl& = GetDlgItem(hWin&, %ID_CTRL)
              CALL GetClientRect(hCtrl&, rc): xRight& = rc.nRight
            ' Load Bitmap from resource, and create a BITMAP overlay
              IF hBitmapFromResource& = 0 THEN ' Load it ONLY ONCE !
                 hBitmapFromResource& = ZI_LoadBitmap("ZMAGIC")
               ' Don't forget to use DeleteObject(hBitmapFromResource&) when you don't need it anymore.
              END IF
              CALL ZI_GetBitmapSize(hBitmapFromResource&, BitmapWidth&, BitmapHeight&)
              Alpha& = 0
              FOR x& = xRight& TO 174 STEP - 2
                  IF Alpha& < 255 THEN INCR Alpha&
                  CALL ZD_DrawBitmapToCtrl(hCtrl&, x&, 0, hBitmapFromResource&, ZD_ColorARGB(Alpha&,0), %ID_BITMAP_ZMAGIC, %ZS_VISIBLE)
                  CALL ZI_UpdateWindow(hCtrl&, %FALSE)
                  IF ZD_DoEvents() THEN EXIT FOR
              NEXT
              CALL ZD_DrawBitmapToCtrl(hCtrl&, 174, 0, hBitmapFromResource&, ZD_ColorARGB(255,0), %ID_BITMAP_ZMAGIC, %ZS_VISIBLE)

            ' This shows you what could be done with some of the low level GDImage API
            ' ZI_GetDIBits / ZI_SetDIBits
            ' or
            ' ZD_GetBitmapObjectBits / ZD_SetBitmapObjectBits 
              REDIM ColrSrce(0,0) AS LONG
              IF ZD_GetBitmapObjectBits(%ID_BITMAP_ZMAGIC, ColrSrce()) THEN
                 bmWSrce& = UBOUND(ColrSrce(1))
                 bmHSrce& = UBOUND(ColrSrce(2))
                 FOR X& = 0 TO bmWSrce&
                     NewColor& = ZD_ColorARGB(128, RGB(255,255,0))
                     FOR Y& = bmHSrce& TO 0 STEP - 1
                         IF ColrSrce(x&, y&) = &HFF000000& THEN 
                            ColrSrce(x&, y&) = NewColor&
                         END IF
                     NEXT
                     CALL ZD_SetBitmapObjectBits(%ID_BITMAP_ZMAGIC, ColrSrce(), %TRUE)
                     CALL ZI_UpdateWindow(hCtrl&, %FALSE)
                     FOR Y& = bmHSrce& TO 0 STEP - 1
                         IF ColrSrce(x&, y&) = NewColor& THEN 
                            ColrSrce(x&, y&) = &hFFFF00FF& '%ZD_TRANSCOLOR'&H00000000&
                         END IF
                     NEXT
                 NEXT
                 FOR X& = 0 TO bmWSrce&
                     FOR Y& = bmHSrce& TO 0 STEP - 1
                         IF ColrSrce(x&, y&) = &HFFFF00FF& THEN 
                            ColrSrce(x&, y&) = &HFF000000&
                         END IF
                     NEXT
                 NEXT
                 CALL ZD_SetBitmapObjectBits(%ID_BITMAP_ZMAGIC, ColrSrce())
                 REDIM ColrSrce(0,0)
              END IF
              InProgress& = 0
              
         CASE %ID_ANIMATE_TEXT
            ' 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&)
            ' Put it on top of z-order
              CALL ZD_SetObjectZorder(%ID_TEXT_FLOATING, %ZD_ORDER_TOP)

              DoneWithX& = 0: DoneWithY& = 0
              X1& = xX&: Y1& = yY&
              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_IMAGE_ROTATE
              hCtrl& = GetDlgItem(hWin&, %ID_CTRL)

            ' Load Bitmap from resource, and create a BITMAP overlay
              IF hBitmapFromFile& = 0 THEN ' Load it ONLY ONCE !
               ' Create a valid GDI BITMAP handle from FILE using any of the supported GDImage format.
                 hBitmapFromFile& = ZI_CreateBitmapFromFile("mask.png", imgW&, imgH&)
              END IF
            ' Drop it out of viewport
              CALL ZD_DrawBitmapToCtrl(hCtrl&, -2000, -2000, hBitmapFromFile&, ZD_ColorARGB(255,0), %ID_BITMAP_FROMFILE, %ZS_VISIBLE)
            ' Refresh display Make sure to show it hidden first
              CALL ZI_UpdateWindow(hCtrl&, %FALSE)

            ' Get a GDIPLUS image handle from FILE using any of the supported GDImage format.
            ' We need a GDIPLUS image handle to perform image rotation and alphablending together.
            ' We want to use a transparent color: ZD_ColorARGB(255, %ZD_TRANSCOLOR),
            ' thus we set the parameter RemoveARGBColor = %TRUE
              Img& = ZI_CreateImageFromFile("mask.png", imgW&, imgH&, %TRUE, ZD_ColorARGB(255, %ZD_TRANSCOLOR))
              UseApha& = 0
              FOR AngleDegree& = 0 TO 360 STEP 4
                  UseAlpha& = UseAlpha& + 3: IF UseAlpha& > 255 THEN UseAlpha& = 255
                ' IF you think you have a fast computer then you can try this:
                '    CALL ZI_RenderImageRotationToWindow(hCtrl&, img&, 140, 150, AngleDegree&, UseAlpha&)
                ' ELSE
                  CALL ZI_RenderImageRotationToWindow(hCtrl&, img&, 140, 150, AngleDegree&, 255)
                ' END IF
                  IF ZD_DoEvents() THEN EXIT FOR
              NEXT 
            ' Delete the GDIPLUS image handle  
              CALL ZI_DeleteImageObject(Img&)

            ' Move the overlayed BITMAP back to viewport
              CALL ZD_DrawBitmapToCtrl(hCtrl&, 140, 150, hBitmapFromFile&, ZD_ColorARGB(255,0), %ID_BITMAP_FROMFILE, %ZS_VISIBLE)

         CASE %ID_BACKGROUND
              hCtrl& = GetDlgItem(hWin&, %ID_CTRL)
            ' We restore the default "REDMASK" bitmap, in case the backround has changed.
              CALL ZI_LoadFromResource(hCtrl&, "REDMASK")
              IF ZI_GetTiledBackground(hCtrl&) THEN
                 CALL ZI_SetTiledBackground(hCtrl&, 0)
              ELSE
                 hTiledBitmap& = ZI_CreateBitmapFromFile("038.jpg", 0,0)
                 CALL ZI_SetTiledBackground(hCtrl&, hTiledBitmap&)'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 hBitmapFromResource& THEN CALL DeleteObject(hBitmapFromResource&)
         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