Deprecated: Array and string offset access syntax with curly braces is deprecated in /homepages/21/d38531796/htdocs/jose/smfforum/Sources/Subs.php on line 3825
gdiplus spheres + rectangles effects

Author Topic: gdiplus spheres + rectangles effects  (Read 14615 times)

0 Members and 1 Guest are viewing this topic.

Offline Frank Brübach

  • Full Member
  • ***
  • Posts: 109
  • User-Rate: +13/-5
gdiplus spheres + rectangles effects
« on: January 23, 2010, 08:08:08 PM »
good evening, I explored gdiplus with powerbasic and made this first example with spheres. I used a basically example from jose's gdiplus examples and add new spheres (with different colours) and one close button.
a) - my question: it's also possible to create these rectangles I've made with "gradient, translucent effect" ? I can use the same way for rectangles I have done for my spheres ? only "translucent" and "gradient effect" for rectangles are still missing in my example. perhaps anybody can give some hints.

my spheres/rectangles example:

Code: [Select]
' ========================================================================================
' Draw spheres and rectangles test by frank :)
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE "GDIPLUS.INC"
%IDC_Button = 100
%IDC_GRAPHIC = 101

' ========================================================================================
' The following example draws a spheres.
' ========================================================================================
SUB GDIP_DrawSpheres (BYVAL hdc AS DWORD)

   LOCAL hStatus AS LONG
   LOCAL x AS LONG
   LOCAL y AS LONG
   LOCAL nSize AS LONG
   LOCAL pGraphics AS DWORD
   LOCAL pPath1 AS DWORD
   LOCAL pBrush1 AS DWORD
   LOCAL pPath2 AS DWORD
   LOCAL pBrush2 AS DWORD
   LOCAL pPath3 AS DWORD
   LOCAL pBrush3 AS DWORD
   LOCAL pPath4 AS DWORD
   LOCAL pBrush4 AS DWORD
   LOCAL MiddleColorToOpaque AS DWORD
   LOCAL BlueFullTranslucent AS DWORD
   LOCAL RedFullTranslucent AS DWORD
   LOCAL YellowFullTranslucent AS DWORD
   LOCAL GreenFullTranslucent AS DWORD

   hStatus = GdipCreateFromHDC(hDC, pGraphics)

   ' // Create a GraphicsPath object.
   hStatus = GdipCreatePath(%FillModeAlternate, pPath1)

   ' // Add an ellipse to the path.
   x = 320 : y = 290 : nSize = 320
   hStatus = GdipAddPathEllipseI(pPath1, x, y, nSize, nSize)

   ' // Create a path gradient based on the ellipse.
   hStatus = GdipCreatePathGradientFromPath(pPath1, pBrush1)

   ' // Set the middle color of the path.
   MiddleColorToOpaque = GDIP_ARGB_SetAlphaValue(%ARGB_MediumAquamarine, 0)
   hStatus = GdipSetPathGradientCenterColor(pBrush1, MiddleColorToOpaque)

   ' // Set the entire path boundary to Alpha Black using 50% translucency.
   'BlackFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_Black, 228) '128
   RedFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_RED, 128) '128
   hStatus = GdipSetPathGradientSurroundColorsWithCount(pBrush1, RedFullTranslucent, 1)

   ' // Draw the ellipse, keeping the exact coordinates defined for the path,
   ' // and using antialising mode (+ 2 and - 4 are used to better achieve antialiasing)
   hStatus = GdipSetSmoothingMode(pGraphics, %SmoothingModeAntiAlias)
   hStatus = GdipFillEllipseI(pGraphics, pBrush1, x + 2, y + 2, nSize - 4, nSize - 4)

  '-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o

   ' // Create a second GraphicsPath object.
   hStatus = GdipCreatePath(%FillModeAlternate, pPath2)

   ' // Add an ellipse to the path
   x = 250 : y = 310 : nSize = 180
   hStatus = GdipAddPathEllipseI(pPath2, x, y, nSize, nSize)

   ' // Create a path gradient based on the ellipse.
   hStatus = GdipCreatePathGradientFromPath(pPath2, pBrush2)

   ' // Set the middle color of the path.
   MiddleColorToOpaque = GDIP_ARGB_SetAlphaValue(%ARGB_GREEN, 64)
   hStatus = GdipSetPathGradientCenterColor(pBrush2, MiddleColorToOpaque)

   ' // Set the entire path boundary to Alpha Black using 50% translucency
   BlueFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_Blue, 128)
   CALL GdipSetPathGradientSurroundColorsWithCount(pBrush2, BlueFullTranslucent, 1)

   ' // Draw the ellipse, keeping the exact coords we defined for the path
   hStatus = GdipFillEllipseI(pGraphics, pBrush2, x + 2, y + 2, nSize - 4, nSize - 4)

  '-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o

   ' // Create a second GraphicsPath object.
   hStatus = GdipCreatePath(%FillModeAlternate, pPath3)

   ' // Add an ellipse to the path
   x = 300 : y = 180 : nSize = 100
   hStatus = GdipAddPathEllipseI(pPath3, x, y, nSize, nSize)

   ' // Create a path gradient based on the ellipse.
   hStatus = GdipCreatePathGradientFromPath(pPath3, pBrush3)

   ' // Set the middle color of the path.
   MiddleColorToOpaque = GDIP_ARGB_SetAlphaValue(%ARGB_YELLOW, 64)
   hStatus = GdipSetPathGradientCenterColor(pBrush3, MiddleColorToOpaque)

   ' // Set the entire path boundary to Alpha Black using 50% translucency
   YellowFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_YELLOW, 228)
   CALL GdipSetPathGradientSurroundColorsWithCount(pBrush3, YellowFullTranslucent, 1)

   ' // Draw the ellipse, keeping the exact coords we defined for the path
   hStatus = GdipFillEllipseI(pGraphics, pBrush3, x + 2, y + 2, nSize - 4, nSize - 4)

  '-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o

   ' // Create a second GraphicsPath object.
   hStatus = GdipCreatePath(%FillModeAlternate, pPath4)

   ' // Add an ellipse to the path
   x = 360 : y = 150 : nSize = 180
   hStatus = GdipAddPathEllipseI(pPath4, x, y, nSize, nSize)

   ' // Create a path gradient based on the ellipse.
   hStatus = GdipCreatePathGradientFromPath(pPath4, pBrush4)

   ' // Set the middle color of the path.
   MiddleColorToOpaque = GDIP_ARGB_SetAlphaValue(%ARGB_GREEN, 64)
   hStatus = GdipSetPathGradientCenterColor(pBrush3, MiddleColorToOpaque)

   ' // Set the entire path boundary to Alpha Black using 50% translucency
   GreenFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_GREEN, 128)
   CALL GdipSetPathGradientSurroundColorsWithCount(pBrush4, GreenFullTranslucent, 1)

   ' // Draw the ellipse, keeping the exact coords we defined for the path
   hStatus = GdipFillEllipseI(pGraphics, pBrush4, x + 2, y + 2, nSize - 4, nSize - 4)

'-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o

  ' // Cleanup
   IF pPath1 THEN GdipDeletePath(pPath1)
   IF pPath2 THEN GdipDeletePath(pPath2)
   IF pPath3 THEN GdipDeletePath(pPath3)
   IF pPath4 THEN GdipDeletePath(pPath4)
   IF pBrush1 THEN GdipDeleteBrush(pBrush1)
   IF pBrush2 THEN GdipDeleteBrush(pBrush2)
   IF pBrush3 THEN GdipDeleteBrush(pBrush3)
   IF pBrush4 THEN GdipDeleteBrush(pBrush4)
   IF pGraphics THEN GdipDeleteGraphics(pGraphics)

END SUB


'------------------------------------------rectangles :) ----------------------
SUB GDIP_SetClipRect2 (BYVAL hdc AS DWORD)
'------------------------------------------
   LOCAL hStatus AS LONG
   LOCAL pGraphics AS DWORD
   LOCAL pBrush AS DWORD
   LOCAL pBrush1 AS DWORD
   LOCAL pBlackPen AS DWORD
   LOCAL pBluePen AS DWORD
   LOCAL pRedPen AS DWORD
   LOCAL BlueFullTranslucent AS DWORD
   LOCAL MiddleColorToOpaque AS DWORD

   hStatus = GdipCreateFromHDC(hdc, pGraphics)

   ' // Set the clipping region.
   hStatus = GdipSetClipRect(pGraphics, 10.95!, 10.95!, 240.5!, 240.5!, %CombineModeReplace)
   ' // Update the clipping region to the portion of the rectangle that
   ' // intersects with the current clipping region.
   hStatus = GdipSetClipRect(pGraphics, 50.95!, 50.95!, 200.5!, 200.5!, %CombineModeReplace)
   'hStatus = GdipSetClipRect(pGraphics, 100.95!, 100.95!, 110.5!, 110.5!, %CombineModeIntersect)

   ' // Fill a rectangle to demonstrate the effective clipping region.
   hStatus = GdipCreateSolidFill(GDIP_ARGB(255, 0, 128, 255), pBrush)
   hStatus = GdipFillRectangle(pGraphics, pBrush, 0, 0, 500, 500)

   hStatus = GdipCreateSolidFill(GDIP_ARGB(255, 250, 0, 255), pBrush1)
   hStatus = GdipFillRectangle(pGraphics, pBrush1, 0, 0, 211, 211)

   BlueFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_BLUE, 228)
   'CALL GdipSetPathGradientSurroundColorsWithCount(pBrush1, BlueFullTranslucent, 1)

   MiddleColorToOpaque = GDIP_ARGB_SetAlphaValue(%ARGB_BLUE, 64)
   hStatus = GdipSetPathGradientCenterColor(pBrush1, MiddleColorToOpaque)

   ' // Reset the clipping region to infinite.
   hStatus = GdipResetClip(pGraphics)

   ' // Draw clipRect and intersectRect.
   hStatus = GdipCreatePen1(GDIP_ARGB(255, 0, 0, 255), 1, %UnitWorld, pBluePen)
   hStatus = GdipCreatePen1(GDIP_ARGB(255, 255, 0, 0), 1, %UnitWorld, pRedPen)
   hStatus = GdipDrawRectangle(pGraphics, pBluePen, 10.95!, 10.95!, 200.5!, 200.5!)
   hStatus = GdipDrawRectangle(pGraphics, pRedPen, 100.5!, 100.5!, 200.5!, 200.5!)

   ' // Cleanup
   IF pBluePen THEN GdipDeletePen(pBluePen)
   IF pRedPen THEN GdipDeletePen(pRedPen)
   IF pBrush THEN GdipDeleteBrush(pBrush)
   IF pBrush1 THEN GdipDeleteBrush(pBrush1)
   IF pGraphics THEN GdipDeleteGraphics(pGraphics)

END SUB

' ========================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   LOCAL hr AS LONG
   LOCAL hDlg AS DWORD
   LOCAL hdc AS DWORD
   LOCAL token AS DWORD
   LOCAL StartupInput AS GdiplusStartupInput

   ' Initialize GDI+
   StartupInput.GdiplusVersion = 1
   hr = GdiplusStartup(token, StartupInput, BYVAL %NULL)
   IF hr THEN
      MSGBOX "Error initializing GDI+"
      EXIT FUNCTION
   END IF

   ' Create a new dialog
   DIALOG NEW PIXELS, 0, "Frankos Draw spheres test", ,, 650, 580, %WS_SYSMENU TO hDlg

   ' Add a graphic control
   CONTROL ADD GRAPHIC, hDlg, %IDC_GRAPHIC,"", 0, 0, 650, 580
   CONTROL ADD BUTTON, hDlg, %IDC_Button,"closeMe", 10, 310, 70, 30,%WS_BORDER OR %BS_FLAT OR %BS_PUSHLIKE
   ' Select the drawing target
   GRAPHIC ATTACH hDlg, %IDC_GRAPHIC
   ' Set the foreground and background color
   GRAPHIC COLOR %BLACK, %WHITE
   ' Clear the entire selected graphic window
   GRAPHIC CLEAR
   ' Retrieve the handle of the device context
   GRAPHIC GET DC TO hdc
   ' Draw the graphics
   GDIP_DrawSpheres hdc
   GDIP_SetClipRect2 hdc

   DIALOG SHOW MODAL hDlg, CALL DlgProc

   ' Shutdown GDI+
   GdiplusShutdown token

END FUNCTION

' --------------------------------------
CALLBACK FUNCTION DlgProc() AS LONG

   SELECT CASE CBMSG

      CASE %WM_COMMAND
         SELECT CASE CBCTL
            CASE  %IDC_Button
               IF CBCTLMSG = %BN_CLICKED THEN DIALOG END CBHNDL, 0
         END SELECT

   END SELECT

END FUNCTION
'

I am asking here because there were no answer at powerbasic forum or nobody has tried this job with gdiplus before ;)

thanks, frank
« Last Edit: January 23, 2010, 08:09:50 PM by Frank Brübach »

Offline Patrice Terrier

  • ROMs
  • Hero Member
  • *****
  • Posts: 934
  • User-Rate: +62/-1
    • www.zapsolution.com
Re: gdiplus spheres + rectangles effects
« Reply #1 on: January 23, 2010, 08:58:07 PM »
Written more than 6 years ago with the GDI+ Helper toolkit ...
Code: [Select]
'This is a PowerBASIC example, but it could be easily translated to either C or VB.
'No runtime required, except that the GDIPLUS.DLL must be already installed.
'Note: The GDIPLUS.DLL works with any Windows version except 95 and NT3.
'
' ---------------------------------------------------------------------------------
'
' gpSPHERE GDIPLUS Flat API example
'
' Most GDIPLUS examples and features have been translated to PB/WIN
' in the Patrice Terrier's "GDI+ helper" graphic toolkit.
'
' This demo draws two spheres using the GDI+ AntiAlias mode.
' it is written in pure SDK code to reach the majority of the programming community.
'
#COMPILE EXE "gpSPHERE.exe"

#INCLUDE "win32api.inc"
#INCLUDE "gdiplus.inc"

SUB DrawSphere(BYVAL hDC&)

  ' First Sphere coordinates
    x& = 100: y& = 100: Size& = 200

    CALL GdipCreateFromHDC(hDC&, graphics&)

  ' BRUSH EFFECT
  ' Create a GraphicsPath object
    CALL GdipCreatePath(%FillModeAlternate, path1&)

  ' Add an ellipse to the path
    CALL GdipAddPathEllipseI(path1&, x&, y&, Size&, Size&)

  ' Create a path gradient based on the ellipse
    CALL GdipCreatePathGradientFromPath(path1&, brush1&)

  ' Set the middle color of the path
    MiddleColorToOpaque& = ColorSetAlpha(%ColorsMediumAquamarine, 0)
    CALL GdipSetPathGradientCenterColor(brush1&, MiddleColorToOpaque&)

  ' Set the entire path boundary to Alpha Black using 50% translucency
    BlackFullTranslucent& = ColorSetAlpha(%ColorsBlack, 128)
    CALL GdipSetPathGradientSurroundColorsWithCount(brush1&, BlackFullTranslucent&, 1)

  ' Draw the ellipse, keeping the exact coords we defined for the path
  ' I want to use AntiAlias drawing mode
    CALL GdipSetSmoothingMode(graphics&, %SmoothingModeAntiAlias)
    CALL GdipFillEllipseI(graphics&, brush1&, x& + 2, y& + 2, Size& - 4, Size& - 4)
  ' + 2 and - 4 are used to better achieve the AntiAlias

  ' Second Sphere coordinates
    x& = 200: y& = 200: Size& = 150

  ' Create a GraphicsPath object
    CALL GdipCreatePath(%FillModeAlternate, path2&)

  ' Add an ellipse to the path
    CALL GdipAddPathEllipseI(path2&, x&, y&, Size&, Size&)

  ' Create a path gradient based on the ellipse
    CALL GdipCreatePathGradientFromPath(path2&, brush2&)

  ' Set the middle color of the path
    MiddleColorToOpaque& = ColorSetAlpha(%ColorsYellow, 64)
    CALL GdipSetPathGradientCenterColor(brush2&, MiddleColorToOpaque&)

  ' Set the entire path boundary to Alpha Black using 50% translucency
    BlackFullTranslucent& = ColorSetAlpha(%ColorsRed, 128)
    CALL GdipSetPathGradientSurroundColorsWithCount(brush2&, BlackFullTranslucent&, 1)

  ' Draw the ellipse, keeping the exact coords we defined for the path
    CALL GdipFillEllipseI(graphics&, brush2&, x& + 2, y& + 2, Size& - 4, Size& - 4)
  ' + 2 and - 4 are used to better achieve the AntiAlias

  ' Cleanup
    CALL GdipDeletePath(path1&)
    CALL GdipDeletePath(path2&)
    CALL GdipDeleteBrush(brush1&)
    CALL GdipDeleteBrush(brush2&)
    CALL GdipDeleteGraphics(graphics&)

END SUB

FUNCTION WndProc(BYVAL hWnd& , BYVAL Msg&, BYVAL wParam&, BYVAL lParam&) AS LONG

    LOCAL ps AS PAINTSTRUCT

    SELECT CASE Msg&
    CASE %WM_PAINT
        hDC& = BeginPaint(hWnd&, ps)
        CALL DrawSphere(hDC&)
        CALL EndPaint(hWnd&, ps)

    CASE %WM_DESTROY
        CALL PostQuitMessage(0)
    END SELECT

    FUNCTION = DefWindowProc(hWnd&, Msg&, wParam&, lParam&)

END FUNCTION

FUNCTION WinMain (BYVAL hInstance     AS LONG, _
                  BYVAL hPrevInstance AS LONG, _
                  BYVAL lpCmdLine     AS ASCIIZ PTR, _
                  BYVAL iCmdShow      AS LONG) AS LONG

    LOCAL msg AS tagMSG
    LOCAL wc AS WNDCLASSEX
    LOCAL szClassName AS ASCIIZ * 128
    szClassName = "GDI+ demo"

  ' LOAD the GDI+ Engine
    hGDIplus& = gpStart
    IF hGDIplus& THEN
       IF ISFALSE(hPrevInstance&) THEN
          wc.cbSize        = SIZEOF(wc)
          wc.style         = %CS_HREDRAW OR %CS_VREDRAW
          wc.lpfnWndProc   = CODEPTR(WndProc)
          wc.cbClsExtra    = 0
          wc.cbWndExtra    = 0
          wc.hInstance     = hInstance&
          wc.hIcon         = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
          wc.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
          wc.hbrBackground = GetStockObject(%WHITE_BRUSH)
          wc.lpszMenuName  = %NULL
          wc.lpszClassName = VARPTR(szClassName)
          wc.hIconSm       = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
          CALL RegisterClassEx(wc)
       END IF
       hWnd& = CreateWindowEx(0, _
                              szClassName, _          ' window class name
                              szClassName, _          ' window caption
                              %WS_OVERLAPPEDWINDOW, _ ' window style
                              %CW_USEDEFAULT, _       ' initial x position
                              %CW_USEDEFAULT, _       ' initial y position
                              %CW_USEDEFAULT, _       ' initial x size
                              %CW_USEDEFAULT, _       ' initial y size
                              %NULL, _                ' parent window handle
                              %NULL, _                ' window menu handle
                              hInstance&, _           ' program instance handle
                              BYVAL %NULL)            ' creation parameters
       IF hWnd& THEN                              
          CALL ShowWindow(hWnd&, %SW_SHOW)
          CALL UpdateWindow(hWnd&)

          DO WHILE GetMessage(msg, %NULL, 0, 0)
              TranslateMessage msg
              DispatchMessage msg
          LOOP

          FUNCTION = msg.wParam
       END IF

     ' UNLOAD the GDI+ Engine
       CALL gpEnd(hGDIplus&)

    END IF

END FUNCTION

For rectangle, see the examples in the GDImage trial version.

...
« Last Edit: January 23, 2010, 09:09:17 PM by Patrice Terrier »
Patrice Terrier
GDImage (advanced graphic addon)
http://www.zapsolution.com

Offline Edwin Knoppert

  • Sr. Member
  • ****
  • Posts: 254
  • User-Rate: +11/-4
    • Hellobasic.com
Re: gdiplus spheres + rectangles effects
« Reply #2 on: January 23, 2010, 09:09:43 PM »
Thanks for the gdi+ examples, i hope to see more on this.
I may ever need the gradient stuff :)

Offline Frank Brübach

  • Full Member
  • ***
  • Posts: 109
  • User-Rate: +13/-5
Re: gdiplus spheres + rectangles effects
« Reply #3 on: January 23, 2010, 11:01:49 PM »
thanks patrice, I see, that's really an old sdk example you have shown, but good for learning to adept to new one. here a modern fixed version for current powerbasic 9.03 issue and works. Have included just for a test new yellow sphere. - I will check some example and find a way to cover rectangles with gradient effects, I am close at my aim and sdk window frame is a better choice! :)

yes, edwin, I like gradient effects for polygons, spheres, ellipses and other graphic elements too ! without this effects it's looking always very boring!

adapted code for new pb issue from patrice

Code: [Select]
'---------------frankos fixed version for powerbasic 9.03 with modern gdiplus include files
'------------------------------------------------------------------------------------------
#COMPILE EXE

#INCLUDE "win32api.inc"
#INCLUDE "gdiplus.inc"

SUB DrawSphere(BYVAL hDC&)
   LOCAL hStatus AS LONG

  ' First Sphere coordinates
    x& = 100: y& = 100: Size& = 200

    CALL GdipCreateFromHDC(hDC&, graphics&)

  ' BRUSH EFFECT
  ' Create a GraphicsPath object
    CALL GdipCreatePath(%FillModeAlternate, path1&)

  ' Add an ellipse to the path
    CALL GdipAddPathEllipseI(path1&, x&, y&, Size&, Size&)

  ' Create a path gradient based on the ellipse
    CALL GdipCreatePathGradientFromPath(path1&, brush1&)

  ' Set the middle color of the path
    MiddleColorToOpaque& = GDIP_ARGB_SetAlphaValue(%ARGB_MediumAquamarine, 0)
    CALL GdipSetPathGradientCenterColor(brush1&, MiddleColorToOpaque&)

  ' Set the entire path boundary to Alpha Black using 50% translucency
    BlackFullTranslucent& = GDIP_ARGB_SetAlphaValue(%ARGB_Blue, 128)
    CALL GdipSetPathGradientSurroundColorsWithCount(brush1&, BlackFullTranslucent&, 1)

  ' Draw the ellipse, keeping the exact coords we defined for the path
  ' I want to use AntiAlias drawing mode
    CALL GdipSetSmoothingMode(graphics&, %SmoothingModeAntiAlias)
    CALL GdipFillEllipseI(graphics&, brush1&, x& + 2, y& + 2, Size& - 4, Size& - 4)
  ' + 2 and - 4 are used to better achieve the AntiAlias

  ' Second Sphere coordinates
    x& = 200: y& = 200: Size& = 150

  ' Create a GraphicsPath object
    CALL GdipCreatePath(%FillModeAlternate, path2&)

  ' Add an ellipse to the path
    CALL GdipAddPathEllipseI(path2&, x&, y&, Size&, Size&)

  ' Create a path gradient based on the ellipse
    CALL GdipCreatePathGradientFromPath(path2&, brush2&)

  ' Set the middle color of the path
    MiddleColorToOpaque& = GDIP_ARGB_SetAlphaValue(%ARGB_Yellow, 64)
    CALL GdipSetPathGradientCenterColor(brush2&, MiddleColorToOpaque&)

  ' Set the entire path boundary to Alpha Black using 50% translucency
    BlackFullTranslucent& = GDIP_ARGB_SetAlphaValue(%ARGB_Red, 128)
    CALL GdipSetPathGradientSurroundColorsWithCount(brush2&, BlackFullTranslucent&, 1)

  ' Draw the ellipse, keeping the exact coords we defined for the path
    CALL GdipFillEllipseI(graphics&, brush2&, x& + 2, y& + 2, Size& - 4, Size& - 4)
  ' + 2 and - 4 are used to better achieve the AntiAlias

   '-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-

   ' // Create a third GraphicsPath object.
   hStatus = GdipCreatePath(%FillModeAlternate, path3&)

   ' // Add an ellipse to the path
   x& = 300 : y& = 180 : Size& = 100
   hStatus = GdipAddPathEllipseI(path3&, x&, y&, Size&, Size&)

   ' // Create a path gradient based on the ellipse.
   hStatus = GdipCreatePathGradientFromPath(path3&, brush3&)

   ' // Set the middle color of the path.
   MiddleColorToOpaque& = GDIP_ARGB_SetAlphaValue(%ARGB_YELLOW, 64)
   hStatus = GdipSetPathGradientCenterColor(brush3&, MiddleColorToOpaque&)

   ' // Set the entire path boundary to Alpha Black using 50% translucency
   YellowFullTranslucent& = GDIP_ARGB_SetAlphaValue(%ARGB_YELLOW, 228)
   CALL GdipSetPathGradientSurroundColorsWithCount(brush3&, YellowFullTranslucent&, 1)

   ' // Draw the ellipse, keeping the exact coords we defined for the path
   hStatus = GdipFillEllipseI(graphics&, brush3&, x& + 2, y& + 2, Size& - 4, Size& - 4)

   '-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-

  ' Cleanup
    CALL GdipDeletePath(path1&)
    CALL GdipDeletePath(path2&)
    CALL GdipDeletePath(path3&)
    CALL GdipDeleteBrush(brush1&)
    CALL GdipDeleteBrush(brush2&)
    CALL GdipDeleteBrush(brush3&)
    CALL GdipDeleteGraphics(graphics&)

END SUB

FUNCTION WndProc(BYVAL hWnd& , BYVAL Msg&, BYVAL wParam&, BYVAL lParam&) AS LONG

    LOCAL ps AS PAINTSTRUCT

    SELECT CASE Msg&
    CASE %WM_PAINT
        hDC& = BeginPaint(hWnd&, ps)
        CALL DrawSphere(hDC&)
        CALL EndPaint(hWnd&, ps)

    CASE %WM_DESTROY
        CALL PostQuitMessage(0)
    END SELECT

    FUNCTION = DefWindowProc(hWnd&, Msg&, wParam&, lParam&)

END FUNCTION

FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   LOCAL hr AS LONG
   LOCAL hWndMain AS DWORD
   LOCAL hCtl AS DWORD
   LOCAL hFont AS DWORD
   LOCAL wcex AS WndClassEx
   LOCAL szClassName AS ASCIIZ * 80
   LOCAL rc AS RECT
   LOCAL szCaption AS ASCIIZ * 255
   LOCAL nLeft AS LONG
   LOCAL nTop AS LONG
   LOCAL nWidth AS LONG
   LOCAL nHeight AS LONG
   LOCAL token AS DWORD
   LOCAL hDlg AS DWORD
   LOCAL StartupInput AS GdiplusStartupInput

   ' Initialize GDI+
   StartupInput.GdiplusVersion = 1
   hr = GdiplusStartup(token, StartupInput, BYVAL %NULL)
   IF hr THEN
      MSGBOX "Error initializing GDI+"
      EXIT FUNCTION
   END IF

   hFont = GetStockObject(%ANSI_VAR_FONT)

   ' Register the window class
   szClassName        = "MyClassName"
   wcex.cbSize        = SIZEOF(wcex)
   wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
   wcex.lpfnWndProc   = CODEPTR(WndProc)
   wcex.cbClsExtra    = 0
   wcex.cbWndExtra    = 0
   wcex.hInstance     = hInstance
   wcex.hCursor       = LoadCursor (%NULL, BYVAL %IDC_ARROW)
   wcex.hbrBackground = GetStockObject(%WHITE_BRUSH)
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szClassName)
   wcex.hIcon         = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Sample, if resource icon: LoadIcon(hInst, "APPICON")
   wcex.hIconSm       = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Remember to set small icon too..
   RegisterClassEx wcex

   ' Window caption
   szCaption = "Frankos_GdipSphere example from patrice :)"

   ' Retrieve the nSize of the working area
   SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(rc), 0

   ' Calculate the position and nSize of the window
   nWidth  = (((rc.nRight - rc.nLeft)) + 2) * 0.65   ' 55% of the client screen width
   nHeight = (((rc.nBottom - rc.nTop)) + 2) * 0.60   ' 50% of the client screen height
   nLeft   = ((rc.nRight - rc.nLeft) \ 2) - nWidth \ 2
   nTop    = ((rc.nBottom - rc.nTop) \ 2) - (nHeight \ 2)

   ' Create a window using the registered class
   hWndMain = CreateWindowEx(%WS_EX_CONTROLPARENT, _           ' extended style
                             szClassName, _                    ' window class name
                             szCaption, _                      ' window caption
                             %WS_OVERLAPPEDWINDOW OR _
                             %WS_CLIPCHILDREN, _               ' window style
                             nLeft, _                          ' initial x position
                             nTop, _                           ' initial y position
                             nWidth, _                         ' initial x nSize
                             nHeight, _                        ' initial y nSize
                             %NULL, _                          ' parent window handle
                             0, _                              ' window menu handle
                             hInstance, _                      ' program instance handle
                             BYVAL %NULL)                      ' creation parameters

   ' Show the window
   ShowWindow hWndMain, nCmdShow
   UpdateWindow hWndMain

   ' Message handler loop
   LOCAL Msg AS tagMsg
   WHILE GetMessage(Msg, %NULL, 0, 0)
      IF ISFALSE IsDialogMessage(hWndMain, Msg) THEN
         TranslateMessage Msg
         DispatchMessage Msg
      END IF
   WEND

   ' Shutdown GDI+
   GdiplusShutdown token

   FUNCTION = msg.wParam

END FUNCTION

thanks, frank


Offline Frank Brübach

  • Full Member
  • ***
  • Posts: 109
  • User-Rate: +13/-5
Re: gdiplus spheres + rectangles effects
« Reply #4 on: January 23, 2010, 11:41:09 PM »
here again my example with sphere and rectangle (sdk modus) from first post :)

Code: [Select]
' ========================================================================================
' Draw spheres and rectangles test by frank :)
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE "GDIPLUS.INC"
%IDC_Button = 100
%IDC_GRAPHIC = 101

' ========================================================================================
' The following example draws a spheres.
' ========================================================================================
SUB GDIP_DrawSpheres (BYVAL hdc AS DWORD)

   LOCAL hStatus AS LONG
   LOCAL x AS LONG
   LOCAL y AS LONG
   LOCAL nSize AS LONG
   LOCAL pGraphics AS DWORD
   LOCAL pPath1 AS DWORD
   LOCAL pBrush1 AS DWORD
   LOCAL pPath2 AS DWORD
   LOCAL pBrush2 AS DWORD
   LOCAL pPath3 AS DWORD
   LOCAL pBrush3 AS DWORD
   LOCAL pPath4 AS DWORD
   LOCAL pBrush4 AS DWORD
   LOCAL MiddleColorToOpaque AS DWORD
   LOCAL BlueFullTranslucent AS DWORD
   LOCAL RedFullTranslucent AS DWORD
   LOCAL YellowFullTranslucent AS DWORD
   LOCAL GreenFullTranslucent AS DWORD

   hStatus = GdipCreateFromHDC(hDC, pGraphics)

   ' // Create a GraphicsPath object.
   hStatus = GdipCreatePath(%FillModeAlternate, pPath1)

   ' // Add an ellipse to the path.
   x = 320 : y = 290 : nSize = 320
   hStatus = GdipAddPathEllipseI(pPath1, x, y, nSize, nSize)

   ' // Create a path gradient based on the ellipse.
   hStatus = GdipCreatePathGradientFromPath(pPath1, pBrush1)

   ' // Set the middle color of the path.
   MiddleColorToOpaque = GDIP_ARGB_SetAlphaValue(%ARGB_MediumAquamarine, 0)
   hStatus = GdipSetPathGradientCenterColor(pBrush1, MiddleColorToOpaque)

   ' // Set the entire path boundary to Alpha Black using 50% translucency.
   'BlackFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_Black, 228) '128
   RedFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_RED, 128) '128
   hStatus = GdipSetPathGradientSurroundColorsWithCount(pBrush1, RedFullTranslucent, 1)

   ' // Draw the ellipse, keeping the exact coordinates defined for the path,
   ' // and using antialising mode (+ 2 and - 4 are used to better achieve antialiasing)
   hStatus = GdipSetSmoothingMode(pGraphics, %SmoothingModeAntiAlias)
   hStatus = GdipFillEllipseI(pGraphics, pBrush1, x + 2, y + 2, nSize - 4, nSize - 4)

  '-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o

   ' // Create a second GraphicsPath object.
   hStatus = GdipCreatePath(%FillModeAlternate, pPath2)

   ' // Add an ellipse to the path
   x = 250 : y = 310 : nSize = 180
   hStatus = GdipAddPathEllipseI(pPath2, x, y, nSize, nSize)

   ' // Create a path gradient based on the ellipse.
   hStatus = GdipCreatePathGradientFromPath(pPath2, pBrush2)

   ' // Set the middle color of the path.
   MiddleColorToOpaque = GDIP_ARGB_SetAlphaValue(%ARGB_GREEN, 64)
   hStatus = GdipSetPathGradientCenterColor(pBrush2, MiddleColorToOpaque)

   ' // Set the entire path boundary to Alpha Black using 50% translucency
   BlueFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_Blue, 128)
   CALL GdipSetPathGradientSurroundColorsWithCount(pBrush2, BlueFullTranslucent, 1)

   ' // Draw the ellipse, keeping the exact coords we defined for the path
   hStatus = GdipFillEllipseI(pGraphics, pBrush2, x + 2, y + 2, nSize - 4, nSize - 4)

  '-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o

   ' // Create a second GraphicsPath object.
   hStatus = GdipCreatePath(%FillModeAlternate, pPath3)

   ' // Add an ellipse to the path
   x = 300 : y = 180 : nSize = 100
   hStatus = GdipAddPathEllipseI(pPath3, x, y, nSize, nSize)

   ' // Create a path gradient based on the ellipse.
   hStatus = GdipCreatePathGradientFromPath(pPath3, pBrush3)

   ' // Set the middle color of the path.
   MiddleColorToOpaque = GDIP_ARGB_SetAlphaValue(%ARGB_YELLOW, 64)
   hStatus = GdipSetPathGradientCenterColor(pBrush3, MiddleColorToOpaque)

   ' // Set the entire path boundary to Alpha Black using 50% translucency
   YellowFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_YELLOW, 228)
   CALL GdipSetPathGradientSurroundColorsWithCount(pBrush3, YellowFullTranslucent, 1)

   ' // Draw the ellipse, keeping the exact coords we defined for the path
   hStatus = GdipFillEllipseI(pGraphics, pBrush3, x + 2, y + 2, nSize - 4, nSize - 4)

  '-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o

   ' // Create a second GraphicsPath object.
   hStatus = GdipCreatePath(%FillModeAlternate, pPath4)

   ' // Add an ellipse to the path
   x = 360 : y = 150 : nSize = 180
   hStatus = GdipAddPathEllipseI(pPath4, x, y, nSize, nSize)

   ' // Create a path gradient based on the ellipse.
   hStatus = GdipCreatePathGradientFromPath(pPath4, pBrush4)

   ' // Set the middle color of the path.
   MiddleColorToOpaque = GDIP_ARGB_SetAlphaValue(%ARGB_GREEN, 64)
   hStatus = GdipSetPathGradientCenterColor(pBrush3, MiddleColorToOpaque)

   ' // Set the entire path boundary to Alpha Black using 50% translucency
   GreenFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_GREEN, 128)
   CALL GdipSetPathGradientSurroundColorsWithCount(pBrush4, GreenFullTranslucent, 1)

   ' // Draw the ellipse, keeping the exact coords we defined for the path
   hStatus = GdipFillEllipseI(pGraphics, pBrush4, x + 2, y + 2, nSize - 4, nSize - 4)

'-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o

  ' // Cleanup
   IF pPath1 THEN GdipDeletePath(pPath1)
   IF pPath2 THEN GdipDeletePath(pPath2)
   IF pPath3 THEN GdipDeletePath(pPath3)
   IF pPath4 THEN GdipDeletePath(pPath4)
   IF pBrush1 THEN GdipDeleteBrush(pBrush1)
   IF pBrush2 THEN GdipDeleteBrush(pBrush2)
   IF pBrush3 THEN GdipDeleteBrush(pBrush3)
   IF pBrush4 THEN GdipDeleteBrush(pBrush4)
   IF pGraphics THEN GdipDeleteGraphics(pGraphics)

END SUB


'------------------------------------------rectangles :) ----------------------
SUB GDIP_SetClipRect2 (BYVAL hdc AS DWORD)
'------------------------------------------
   LOCAL hStatus AS LONG
   LOCAL pGraphics AS DWORD
   LOCAL pBrush AS DWORD
   LOCAL pBrush1 AS DWORD
   LOCAL pBlackPen AS DWORD
   LOCAL pBluePen AS DWORD
   LOCAL pRedPen AS DWORD
   LOCAL BlueFullTranslucent AS DWORD
   LOCAL MiddleColorToOpaque AS DWORD

   hStatus = GdipCreateFromHDC(hdc, pGraphics)

   ' // Set the clipping region.
   hStatus = GdipSetClipRect(pGraphics, 10.95!, 10.95!, 240.5!, 240.5!, %CombineModeReplace)
   ' // Update the clipping region to the portion of the rectangle that
   ' // intersects with the current clipping region.
   hStatus = GdipSetClipRect(pGraphics, 50.95!, 50.95!, 200.5!, 200.5!, %CombineModeReplace)
   'hStatus = GdipSetClipRect(pGraphics, 100.95!, 100.95!, 110.5!, 110.5!, %CombineModeIntersect)

   ' // Fill a rectangle to demonstrate the effective clipping region.
   hStatus = GdipCreateSolidFill(GDIP_ARGB(255, 0, 128, 255), pBrush)
   hStatus = GdipFillRectangle(pGraphics, pBrush, 0, 0, 500, 500)

   hStatus = GdipCreateSolidFill(GDIP_ARGB(255, 250, 0, 255), pBrush1)
   hStatus = GdipFillRectangle(pGraphics, pBrush1, 0, 0, 211, 211)

   BlueFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_BLUE, 228)
   'CALL GdipSetPathGradientSurroundColorsWithCount(pBrush1, BlueFullTranslucent, 1)

   MiddleColorToOpaque = GDIP_ARGB_SetAlphaValue(%ARGB_BLUE, 64)
   hStatus = GdipSetPathGradientCenterColor(pBrush1, MiddleColorToOpaque)

   ' // Reset the clipping region to infinite.
   hStatus = GdipResetClip(pGraphics)

   ' // Draw clipRect and intersectRect.
   hStatus = GdipCreatePen1(GDIP_ARGB(255, 0, 0, 255), 1, %UnitWorld, pBluePen)
   hStatus = GdipCreatePen1(GDIP_ARGB(255, 255, 0, 0), 1, %UnitWorld, pRedPen)
   hStatus = GdipDrawRectangle(pGraphics, pBluePen, 10.95!, 10.95!, 200.5!, 200.5!)
   hStatus = GdipDrawRectangle(pGraphics, pRedPen, 100.5!, 100.5!, 200.5!, 200.5!)

   ' // Cleanup
   IF pBluePen THEN GdipDeletePen(pBluePen)
   IF pRedPen THEN GdipDeletePen(pRedPen)
   IF pBrush THEN GdipDeleteBrush(pBrush)
   IF pBrush1 THEN GdipDeleteBrush(pBrush1)
   IF pGraphics THEN GdipDeleteGraphics(pGraphics)

END SUB

' ========================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   LOCAL hr AS LONG
   LOCAL hWndMain AS DWORD
   LOCAL hCtl AS DWORD
   LOCAL hFont AS DWORD
   LOCAL wcex AS WndClassEx
   LOCAL szClassName AS ASCIIZ * 80
   LOCAL rc AS RECT
   LOCAL szCaption AS ASCIIZ * 255
   LOCAL nLeft AS LONG
   LOCAL nTop AS LONG
   LOCAL nWidth AS LONG
   LOCAL nHeight AS LONG
   LOCAL token AS DWORD
   LOCAL hDlg AS DWORD
   LOCAL StartupInput AS GdiplusStartupInput

   ' Initialize GDI+
   StartupInput.GdiplusVersion = 1
   hr = GdiplusStartup(token, StartupInput, BYVAL %NULL)
   IF hr THEN
      MSGBOX "Error initializing GDI+"
      EXIT FUNCTION
   END IF

   hFont = GetStockObject(%ANSI_VAR_FONT)

   ' Register the window class
   szClassName        = "MyClassName"
   wcex.cbSize        = SIZEOF(wcex)
   wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
   wcex.lpfnWndProc   = CODEPTR(WndProc)
   wcex.cbClsExtra    = 0
   wcex.cbWndExtra    = 0
   wcex.hInstance     = hInstance
   wcex.hCursor       = LoadCursor (%NULL, BYVAL %IDC_ARROW)
   wcex.hbrBackground = GetStockObject(%WHITE_BRUSH)
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szClassName)
   wcex.hIcon         = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Sample, if resource icon: LoadIcon(hInst, "APPICON")
   wcex.hIconSm       = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Remember to set small icon too..
   RegisterClassEx wcex

   ' Window caption
   szCaption = "Frankos sdk sphere example "

   ' Retrieve the nSize of the working area
   SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(rc), 0

   ' Calculate the position and nSize of the window
   nWidth  = (((rc.nRight - rc.nLeft)) + 2) * 0.75   ' 55% of the client screen width
   nHeight = (((rc.nBottom - rc.nTop)) + 2) * 0.70   ' 50% of the client screen height
   nLeft   = ((rc.nRight - rc.nLeft) \ 2) - nWidth \ 2
   nTop    = ((rc.nBottom - rc.nTop) \ 2) - (nHeight \ 2)

   ' Create a window using the registered class
   hWndMain = CreateWindowEx(%WS_EX_CONTROLPARENT, _           ' extended style
                             szClassName, _                    ' window class name
                             szCaption, _                      ' window caption
                             %WS_OVERLAPPEDWINDOW OR _
                             %WS_CLIPCHILDREN, _               ' window style
                             nLeft, _                          ' initial x position
                             nTop, _                           ' initial y position
                             nWidth, _                         ' initial x nSize
                             nHeight, _                        ' initial y nSize
                             %NULL, _                          ' parent window handle
                             0, _                              ' window menu handle
                             hInstance, _                      ' program instance handle
                             BYVAL %NULL)                      ' creation parameters

   ' Show the window
   ShowWindow hWndMain, nCmdShow
   UpdateWindow hWndMain

   ' Message handler loop
   LOCAL Msg AS tagMsg
   WHILE GetMessage(Msg, %NULL, 0, 0)
      IF ISFALSE IsDialogMessage(hWndMain, Msg) THEN
         TranslateMessage Msg
         DispatchMessage Msg
      END IF
   WEND

   ' Shutdown GDI+
   GdiplusShutdown token

   FUNCTION = msg.wParam

END FUNCTION

'
'----------------------------------------------------------------------------------------------------------------
FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL hDC AS DWORD
   LOCAL ps AS PAINTSTRUCT

   SELECT CASE wMsg

      CASE %WM_COMMAND
         SELECT CASE LOWRD(wParam)
            CASE %IDCANCEL
               IF HIWRD(wParam) = %BN_CLICKED THEN
                  SendMessage hWnd, %WM_CLOSE, 0, 0
                  FUNCTION = 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_SYSCOMMAND
         ' Capture this message and send a WM_CLOSE message
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hWnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_PAINT
         hDC = BeginPaint(hWnd, ps)
         GDIP_DrawSpheres hDC
         GDIP_SetClipRect2 hDC
         EndPaint(hWnd, ps)

      CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION
' ============================================================================

servus, frank

Offline Frank Brübach

  • Full Member
  • ***
  • Posts: 109
  • User-Rate: +13/-5
Re: gdiplus spheres + rectangles effects
« Reply #5 on: February 01, 2010, 07:57:52 PM »
...task solved :)

gradient rectangles I've made with "GDIP_SetLineBlend", best and fastest solution for me to create gradient effect for rectangles.

powerbasic complete code:
Code: [Select]
' ========================================================================================
' Draw spheres and rectangles test by frank, 01.feb.2010 :)
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE "GDIPLUS.INC"
%IDC_Button = 100
%IDC_GRAPHIC = 101


' ========================================================================================
' The following example draws a spheres.
' ========================================================================================
SUB GDIP_DrawSpheres (BYVAL hdc AS DWORD)

   LOCAL hStatus AS LONG
   LOCAL hStatus1 AS LONG
   LOCAL x AS LONG
   LOCAL y AS LONG
   LOCAL nSize AS LONG
   LOCAL pGraphics AS DWORD
   LOCAL pGraphics1 AS DWORD
   LOCAL pPath AS DWORD
   LOCAL pPath1 AS DWORD
   LOCAL pBrush AS DWORD
   LOCAL pBrush1 AS DWORD
   LOCAL pPath2 AS DWORD
   LOCAL pBrush2 AS DWORD
   LOCAL pPath3 AS DWORD
   LOCAL pBrush3 AS DWORD
   LOCAL pPath4 AS DWORD
   LOCAL pBrush4 AS DWORD
   LOCAL MiddleColorToOpaque AS DWORD
   LOCAL BlueFullTranslucent AS DWORD
   LOCAL RedFullTranslucent AS DWORD
   LOCAL YellowFullTranslucent AS DWORD
   LOCAL GreenFullTranslucent AS DWORD

   hStatus = GdipCreateFromHDC(hDC, pGraphics)
   hStatus1 = GdipCreateFromHDC(hDC, pGraphics1)

   ' // Create a GraphicsPath object.
   hStatus = GdipCreatePath(%FillModeAlternate, pPath1)

   ' // Add an ellipse to the path.
   x = 320 : y = 290 : nSize = 320
   hStatus = GdipAddPathEllipseI(pPath1, x, y, nSize, nSize)

   ' // Create a path gradient based on the ellipse.
   hStatus = GdipCreatePathGradientFromPath(pPath1, pBrush1)

   ' // Set the middle color of the path.
   MiddleColorToOpaque = GDIP_ARGB_SetAlphaValue(%ARGB_MediumAquamarine, 0)
   hStatus = GdipSetPathGradientCenterColor(pBrush1, MiddleColorToOpaque)

   ' // Set the entire path boundary to Alpha Black using 50% translucency.
   RedFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_RED, 128) '128
   hStatus = GdipSetPathGradientSurroundColorsWithCount(pBrush1, RedFullTranslucent, 1)

   ' // Draw the ellipse, keeping the exact coordinates defined for the path,
   ' // and using antialising mode (+ 2 and - 4 are used to better achieve antialiasing)
   hStatus = GdipSetSmoothingMode(pGraphics, %SmoothingModeAntiAlias)
   hStatus = GdipFillEllipseI(pGraphics, pBrush1, x + 2, y + 2, nSize - 4, nSize - 4)

  '-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o

   ' // Create a second GraphicsPath object.
   hStatus = GdipCreatePath(%FillModeAlternate, pPath2)

   ' // Add an ellipse to the path
   x = 250 : y = 310 : nSize = 180
   hStatus = GdipAddPathEllipseI(pPath2, x, y, nSize, nSize)

   ' // Create a path gradient based on the ellipse.
   hStatus = GdipCreatePathGradientFromPath(pPath2, pBrush2)

   ' // Set the middle color of the path.
   MiddleColorToOpaque = GDIP_ARGB_SetAlphaValue(%ARGB_GREEN, 64)
   hStatus = GdipSetPathGradientCenterColor(pBrush2, MiddleColorToOpaque)

   ' // Set the entire path boundary to Alpha Black using 50% translucency
   BlueFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_Blue, 128)
   CALL GdipSetPathGradientSurroundColorsWithCount(pBrush2, BlueFullTranslucent, 1)

   ' // Draw the ellipse, keeping the exact coords we defined for the path
   hStatus = GdipFillEllipseI(pGraphics, pBrush2, x + 2, y + 2, nSize - 4, nSize - 4)

  '-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o

   ' // Create a second GraphicsPath object.
   hStatus = GdipCreatePath(%FillModeAlternate, pPath3)

   ' // Add an ellipse to the path
   x = 300 : y = 180 : nSize = 100
   hStatus = GdipAddPathEllipseI(pPath3, x, y, nSize, nSize)

   ' // Create a path gradient based on the ellipse.
   hStatus = GdipCreatePathGradientFromPath(pPath3, pBrush3)

   ' // Set the middle color of the path.
   MiddleColorToOpaque = GDIP_ARGB_SetAlphaValue(%ARGB_YELLOW, 64)
   hStatus = GdipSetPathGradientCenterColor(pBrush3, MiddleColorToOpaque)

   ' // Set the entire path boundary to Alpha Black using 50% translucency
   YellowFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_YELLOW, 228)
   CALL GdipSetPathGradientSurroundColorsWithCount(pBrush3, YellowFullTranslucent, 1)

   ' // Draw the ellipse, keeping the exact coords we defined for the path
   hStatus = GdipFillEllipseI(pGraphics, pBrush3, x + 2, y + 2, nSize - 4, nSize - 4)

  '-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o

   ' // Create a second GraphicsPath object.
   hStatus = GdipCreatePath(%FillModeAlternate, pPath4)

   ' // Add an ellipse to the path
   x = 360 : y = 150 : nSize = 180
   hStatus = GdipAddPathEllipseI(pPath4, x, y, nSize, nSize)

   ' // Create a path gradient based on the ellipse.
   hStatus = GdipCreatePathGradientFromPath(pPath4, pBrush4)

   ' // Set the middle color of the path.
   MiddleColorToOpaque = GDIP_ARGB_SetAlphaValue(%ARGB_GREEN, 64)
   hStatus = GdipSetPathGradientCenterColor(pBrush3, MiddleColorToOpaque)

   ' // Set the entire path boundary to Alpha Black using 50% translucency
   GreenFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_GREEN, 128)
   CALL GdipSetPathGradientSurroundColorsWithCount(pBrush4, GreenFullTranslucent, 1)

   ' // Draw the ellipse, keeping the exact coords we defined for the path
   hStatus = GdipFillEllipseI(pGraphics, pBrush4, x + 2, y + 2, nSize - 4, nSize - 4)

'-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o

  ' // Cleanup
   IF pPath1 THEN GdipDeletePath(pPath1)
   IF pPath2 THEN GdipDeletePath(pPath2)
   IF pPath3 THEN GdipDeletePath(pPath3)
   IF pPath4 THEN GdipDeletePath(pPath4)
   IF pBrush THEN GdipDeleteBrush(pBrush)
   IF pBrush1 THEN GdipDeleteBrush(pBrush1)
   IF pBrush2 THEN GdipDeleteBrush(pBrush2)
   IF pBrush3 THEN GdipDeleteBrush(pBrush3)
   IF pBrush4 THEN GdipDeleteBrush(pBrush4)
   IF pGraphics THEN GdipDeleteGraphics(pGraphics)
   IF pGraphics1 THEN GdipDeleteGraphics(pGraphics1)
END SUB


'------------------------------------------rectangles :) ----------------------
SUB GDIP_SetClipRect2 (BYVAL hdc AS DWORD)
'------------------------------------------
   LOCAL hStatus AS LONG
   LOCAL pGraphics AS DWORD
   LOCAL pBrush AS DWORD
   LOCAL pBrush1 AS DWORD
   LOCAL pBlackPen AS DWORD
   LOCAL pBluePen AS DWORD
   LOCAL pRedPen AS DWORD
   LOCAL BlueFullTranslucent AS DWORD
   LOCAL MiddleColorToOpaque AS DWORD
   LOCAL pPath1 AS DWORD

   hStatus = GdipCreateFromHDC(hdc, pGraphics)

   ' // Create a GraphicsPath object.
   hStatus = GdipCreatePath(%FillModeAlternate, pPath1)

   ' // Create a path gradient based on the ellipse.
   hStatus = GdipCreatePathGradientFromPath(pPath1, pBrush1)

   ' // Set the clipping region.
   hStatus = GdipSetClipRect(pGraphics, 10.95!, 10.95!, 240.5!, 240.5!, %CombineModeReplace)

   ' // Update the clipping region to the portion of the rectangle that
   ' // intersects with the current clipping region.
   hStatus = GdipSetClipRect(pGraphics, 50.95!, 50.95!, 200.5!, 200.5!, %CombineModeReplace)

   ' // Fill a rectangle to demonstrate the effective clipping region.
   hStatus = GdipCreateSolidFill(GDIP_ARGB(255, 0, 128, 255), pBrush)
   hStatus = GdipFillRectangle(pGraphics, pBrush, 0, 0, 500, 500)

   hStatus = GdipCreateSolidFill(GDIP_ARGB(255, 250, 0, 255), pBrush1)
   hStatus = GdipFillRectangle(pGraphics, pBrush1, 0, 0, 211, 211)

   ' // Reset the clipping region to infinite.
   hStatus = GdipResetClip(pGraphics)

   ' // Draw clipRect and intersectRect.
   hStatus = GdipCreatePen1(GDIP_ARGB(255, 0, 0, 255), 1, %UnitWorld, pBluePen)
   hStatus = GdipCreatePen1(GDIP_ARGB(255, 255, 0, 0), 1, %UnitWorld, pRedPen)
   hStatus = GdipDrawRectangle(pGraphics, pBluePen, 10.95!, 10.95!, 200.5!, 200.5!)
   hStatus = GdipDrawRectangle(pGraphics, pRedPen, 100.5!, 100.5!, 200.5!, 200.5!)

   ' // Cleanup
   IF pBluePen THEN GdipDeletePen(pBluePen)
   IF pRedPen THEN GdipDeletePen(pRedPen)
   IF pBrush THEN GdipDeleteBrush(pBrush)
   IF pBrush1 THEN GdipDeleteBrush(pBrush1)
   IF pGraphics THEN GdipDeleteGraphics(pGraphics)

END SUB

' =========================================================================================================================================
  FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
' =========================================================================================================================================
   LOCAL hr AS LONG
   LOCAL hWndMain AS DWORD
   LOCAL hCtl AS DWORD
   LOCAL hFont AS DWORD
   LOCAL wcex AS WndClassEx
   LOCAL szClassName AS ASCIIZ * 80
   LOCAL rc AS RECT
   LOCAL szCaption AS ASCIIZ * 255
   LOCAL nLeft AS LONG
   LOCAL nTop AS LONG
   LOCAL nWidth AS LONG
   LOCAL nHeight AS LONG
   LOCAL token AS DWORD
   LOCAL hDlg AS DWORD
   LOCAL StartupInput AS GdiplusStartupInput

   ' Initialize GDI+
   StartupInput.GdiplusVersion = 1
   hr = GdiplusStartup(token, StartupInput, BYVAL %NULL)
   IF hr THEN
      MSGBOX "Error initializing GDI+"
      EXIT FUNCTION
   END IF

   hFont = GetStockObject(%ANSI_VAR_FONT)

   ' Register the window class
   szClassName        = "MyClassName"
   wcex.cbSize        = SIZEOF(wcex)
   wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
   wcex.lpfnWndProc   = CODEPTR(WndProc)
   wcex.cbClsExtra    = 0
   wcex.cbWndExtra    = 0
   wcex.hInstance     = hInstance
   wcex.hCursor       = LoadCursor (%NULL, BYVAL %IDC_ARROW)
   wcex.hbrBackground = GetStockObject(%WHITE_BRUSH)
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szClassName)
   wcex.hIcon         = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Sample, if resource icon: LoadIcon(hInst, "APPICON")
   wcex.hIconSm       = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Remember to set small icon too..
   RegisterClassEx wcex

   ' Window caption
   szCaption = "Frankos sdk sphere, rectangle + gradient example, begin 2010"

   ' Retrieve the nSize of the working area
   SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(rc), 0

   ' Calculate the position and nSize of the window
   nWidth  = (((rc.nRight - rc.nLeft)) + 2) * 0.85   ' 55% of the client screen width
   nHeight = (((rc.nBottom - rc.nTop)) + 2) * 0.80   ' 50% of the client screen height
   nLeft   = ((rc.nRight - rc.nLeft) \ 2) - nWidth \ 2
   nTop    = ((rc.nBottom - rc.nTop) \ 2) - (nHeight \ 2)

   ' Create a window using the registered class
   hWndMain = CreateWindowEx(%WS_EX_CONTROLPARENT, _           ' extended style
                             szClassName, _                    ' window class name
                             szCaption, _                      ' window caption
                             %WS_OVERLAPPEDWINDOW OR _
                             %WS_CLIPCHILDREN, _               ' window style
                             nLeft, _                          ' initial x position
                             nTop, _                           ' initial y position
                             nWidth, _                         ' initial x nSize
                             nHeight, _                        ' initial y nSize
                             %NULL, _                          ' parent window handle
                             0, _                              ' window menu handle
                             hInstance, _                      ' program instance handle
                             BYVAL %NULL)                      ' creation parameters

   ' Show the window
   ShowWindow hWndMain, nCmdShow
   UpdateWindow hWndMain

   ' Message handler loop
   LOCAL Msg AS tagMsg
   WHILE GetMessage(Msg, %NULL, 0, 0)
      IF ISFALSE IsDialogMessage(hWndMain, Msg) THEN
         TranslateMessage Msg
         DispatchMessage Msg
      END IF
   WEND

   ' Shutdown GDI+
   GdiplusShutdown token

   FUNCTION = msg.wParam

END FUNCTION

'
'----------------------------------------------------------------------------------------------------------------
FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
'----------------------------------------------------------------------------------------------------------------
   LOCAL hDC AS DWORD
   LOCAL ps AS PAINTSTRUCT

   SELECT CASE wMsg

      CASE %WM_COMMAND
         SELECT CASE LOWRD(wParam)
            CASE %IDCANCEL
               IF HIWRD(wParam) = %BN_CLICKED THEN
                  SendMessage hWnd, %WM_CLOSE, 0, 0
                  FUNCTION = 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_SYSCOMMAND
         ' Capture this message and send a WM_CLOSE message
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hWnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_PAINT
         hDC = BeginPaint(hWnd, ps)
         GDIP_DrawSpheres hDC
         GDIP_SetClipRect2 hDC
         GDIP_AddPathRectangle hDC
         GDIP_SetLineBlend hDC
         EndPaint(hWnd, ps)

      CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION

' ========================================================================================
  SUB GDIP_AddPathRectangle (BYVAL hdc AS DWORD)
' ========================================================================================
   LOCAL hStatus AS LONG
   LOCAL pGraphics AS DWORD
   LOCAL pPath AS DWORD
   LOCAL pPen AS DWORD

   hStatus = GdipCreateFromHDC(hdc, pGraphics)

   hStatus = GdipCreatePath(%FillModeAlternate, pPath)
   hStatus = GdipAddPathRectangle(pPath, 40, 40, 140, 140)

   ' // Draw the path.
   hStatus = GdipCreatePen1(GDIP_ARGB(255, 255, 250, 0), 1, %UnitWorld, pPen)
   hStatus = GdipDrawPath(pGraphics, pPen, pPath)

   ' // Cleanup
   IF pPen THEN GdipDeletePen(pPen)
   IF pPath THEN GdipDeletePath(pPath)
   IF pGraphics THEN GdipDeleteGraphics(pGraphics)

END SUB

' ========================================================================================
 SUB GDIP_SetLineBlend (BYVAL hdc AS DWORD)
' ========================================================================================
   LOCAL hStatus AS LONG
   LOCAL hStatus1 AS LONG
   LOCAL pGraphics AS DWORD
   LOCAL pGraphics1 AS DWORD
   LOCAL rc AS RECTF
   LOCAL colorRed AS DWORD
   LOCAL colorBlue AS DWORD
   LOCAL pLinBrush AS DWORD
   DIM   factors(3) AS SINGLE
   DIM   positions(3) AS SINGLE

   hStatus = GdipCreateFromHDC(hdc, pGraphics)

   rc.x = 660 : rc.y = 320 : rc.Width = 180 : rc.Height = 180
   colorRed = GDIP_ARGB(255, 255, 0, 100)
   colorBlue = GDIP_ARGB(255, 0, 100, 255)
   factors(0) = 0.0! : factors(1) = 0.2! : factors(2) = 0.6! : factors(3) = 0.9!
   positions(0) = 0.0! : positions(1) = 0.3! : positions(2) = 0.8! : positions(3) = 1.0!

   hStatus = GdipCreateLineBrushFromRect(rc, colorRed, colorBlue, %LinearGradientModeHorizontal, %WrapModeTile, pLinBrush)
   hStatus = GdipSetLineBlend(pLinBrush, factors(0), positions(0), 4)
   hStatus = GdipFillRectangle(pGraphics, pLinBrush, rc.x, rc.y, rc.Width, rc.Height)

  '----------------------------------------------- one more rectangles gradient line
   hStatus1 = GdipCreateFromHDC(hdc, pGraphics1)

   rc.x = 660 : rc.y = 60 : rc.Width = 180 : rc.Height = 180
   colorRed = GDIP_ARGB(255, 0, 100, 250)
   colorBlue = GDIP_ARGB(255, 250, 100, 0)
   factors(0) = 0.0! : factors(1) = 0.3! : factors(2) = 0.5! : factors(3) = 0.9!
   positions(0) = 0.0! : positions(1) = 0.4! : positions(2) = 0.7! : positions(3) = 1.0!

   hStatus1 = GdipCreateLineBrushFromRect(rc, colorRed, colorBlue, %LinearGradientModeHorizontal, %WrapModeTile, pLinBrush)
   hStatus1 = GdipSetLineBlend(pLinBrush, factors(0), positions(0), 4)
   hStatus1 = GdipFillRectangle(pGraphics1, pLinBrush, rc.x, rc.y, rc.Width, rc.Height)

   '----------------------------------------------- one more rectangles gradient line

   ' // Cleanup
   IF pLinBrush THEN GdipDeleteBrush(pLinBrush)
   IF pGraphics THEN GdipDeleteGraphics(pGraphics)
   IF pGraphics1 THEN GdipDeleteGraphics(pGraphics1)

END SUB

best regards from freezing germany, franko

Offline Edwin Knoppert

  • Sr. Member
  • ****
  • Posts: 254
  • User-Rate: +11/-4
    • Hellobasic.com
Re: gdiplus spheres + rectangles effects
« Reply #6 on: February 01, 2010, 08:28:23 PM »
Thanks!

Could you write us a more simple example (very much stripped) to get a bar like shown here?

http://www.hellobasic.com/news/images/newsindex.png

The bar on top is gradient but done with css.
I would like to use from/to RGB values if possible.

:)

Offline Frank Brübach

  • Full Member
  • ***
  • Posts: 109
  • User-Rate: +13/-5
Re: gdiplus spheres + rectangles effects
« Reply #7 on: February 02, 2010, 03:14:00 PM »
edwin, this could help.

there are more than one way to get gradient effect, be sure! :)

for me this is a serious way for gradient bars with whatever colour you like. next example shows how you can even with sdk window and gradient effect to size this gradient rectangle to get some gradient boxes or lines or everything you need. this trick I have found last week by making some experiments with sdk frame windows.

1) first example with gradient bar:
Code: [Select]
' ========================================================================================
' Draw rectangle bar gradient test by franko, 02.feb.2010 :)
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE "GDIPLUS.INC"
%IDC_Button = 100
%IDC_GRAPHIC = 101

' =========================================================================================================================================
  FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
' =========================================================================================================================================
   LOCAL hr AS LONG
   LOCAL hWndMain AS DWORD
   LOCAL hCtl AS DWORD
   LOCAL hFont AS DWORD
   LOCAL wcex AS WndClassEx
   LOCAL szClassName AS ASCIIZ * 80
   LOCAL rc AS RECT
   LOCAL szCaption AS ASCIIZ * 255
   LOCAL nLeft AS LONG
   LOCAL nTop AS LONG
   LOCAL nWidth AS LONG
   LOCAL nHeight AS LONG
   LOCAL token AS DWORD
   LOCAL hDlg AS DWORD
   LOCAL StartupInput AS GdiplusStartupInput

   ' Initialize GDI+
   StartupInput.GdiplusVersion = 1
   hr = GdiplusStartup(token, StartupInput, BYVAL %NULL)
   IF hr THEN
      MSGBOX "Error initializing GDI+"
      EXIT FUNCTION
   END IF

   hFont = GetStockObject(%ANSI_VAR_FONT)

   ' Register the window class
   szClassName        = "MyClassName"
   wcex.cbSize        = SIZEOF(wcex)
   wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
   wcex.lpfnWndProc   = CODEPTR(WndProc)
   wcex.cbClsExtra    = 0
   wcex.cbWndExtra    = 0
   wcex.hInstance     = hInstance
   wcex.hCursor       = LoadCursor (%NULL, BYVAL %IDC_ARROW)
   wcex.hbrBackground = GetStockObject(%WHITE_BRUSH)
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szClassName)
   wcex.hIcon         = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Sample, if resource icon: LoadIcon(hInst, "APPICON")
   wcex.hIconSm       = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Remember to set small icon too..
   RegisterClassEx wcex

   ' Window caption
   szCaption = "bar gradient example"

   ' Retrieve the nSize of the working area
   SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(rc), 0

   ' Calculate the position and nSize of the window
   nWidth  = (((rc.nRight - rc.nLeft)) + 2) * 0.85   ' 55% of the client screen width
   nHeight = (((rc.nBottom - rc.nTop)) + 2) * 0.80   ' 50% of the client screen height
   nLeft   = ((rc.nRight - rc.nLeft) \ 2) - nWidth \ 2
   nTop    = ((rc.nBottom - rc.nTop) \ 2) - (nHeight \ 2)

   ' Create a window using the registered class
   hWndMain = CreateWindowEx(%WS_EX_CONTROLPARENT, _           ' extended style
                             szClassName, _                    ' window class name
                             szCaption, _                      ' window caption
                             %WS_OVERLAPPEDWINDOW OR _
                             %WS_CLIPCHILDREN, _               ' window style
                             nLeft, _                          ' initial x position
                             nTop, _                           ' initial y position
                             nWidth, _                         ' initial x nSize
                             nHeight, _                        ' initial y nSize
                             %NULL, _                          ' parent window handle
                             0, _                              ' window menu handle
                             hInstance, _                      ' program instance handle
                             BYVAL %NULL)                      ' creation parameters

   ' Show the window
   ShowWindow hWndMain, nCmdShow
   UpdateWindow hWndMain

   ' Message handler loop
   LOCAL Msg AS tagMsg
   WHILE GetMessage(Msg, %NULL, 0, 0)
      IF ISFALSE IsDialogMessage(hWndMain, Msg) THEN
         TranslateMessage Msg
         DispatchMessage Msg
      END IF
   WEND
   ' Shutdown GDI+
   GdiplusShutdown token
   FUNCTION = msg.wParam
END FUNCTION

'
'----------------------------------------------------------------------------------------------------------------
FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
'----------------------------------------------------------------------------------------------------------------
   LOCAL hDC AS DWORD
   LOCAL ps AS PAINTSTRUCT
   LOCAL tRect  AS RECT

   SELECT CASE wMsg

      CASE %WM_COMMAND
         SELECT CASE LOWRD(wParam)
            CASE %IDCANCEL
               IF HIWRD(wParam) = %BN_CLICKED THEN
                  SendMessage hWnd, %WM_CLOSE, 0, 0
                  FUNCTION = 0
                  EXIT FUNCTION
               END IF
         END SELECT
        
      CASE %WM_SYSCOMMAND
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hWnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_PAINT
         hDC = BeginPaint(hWnd, ps)
         GDIP_SetLineBlend hDC '->
         GetClientRect hWnd, tRect
         SetBkMode hDC, %WHITE_BRUSH '---> or TRANSPARENT
         SetTextColor hDC, %RED
         DrawText hDC, "Hello, simple gradient Windows!", -1, tRect, %DT_SINGLELINE OR %DT_CENTER OR %DT_VCENTER
         EndPaint(hWnd, ps)
        FUNCTION = 1
        EXIT FUNCTION

      CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION
   END SELECT
   FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
END FUNCTION

' ========================================================================================
 SUB GDIP_SetLineBlend (BYVAL hdc AS DWORD)
' ========================================================================================
   LOCAL hStatus AS LONG
   LOCAL hStatus1 AS LONG
   LOCAL hStatus2 AS LONG
   LOCAL pGraphics AS DWORD
   LOCAL pGraphics1 AS DWORD
   LOCAL pGraphics2 AS DWORD
   LOCAL rc AS RECTF
   LOCAL colorRed AS DWORD
   LOCAL colorBlue AS DWORD
   LOCAL pLinBrush AS DWORD
   DIM   factors(4) AS SINGLE
   DIM   positions(4) AS SINGLE

  '----------------------------------------------- one more rectangle with gradient line at top
   hStatus = GdipCreateFromHDC(hdc, pGraphics)
   rc.x = 5 : rc.y = 5 : rc.Width = 800 : rc.Height = 60  '-----------> here you must change values ! :)
   colorRed = GDIP_ARGB(255, 255, 0, 0)                    '-----------> here you must change values ! :)
   colorBlue = GDIP_ARGB(255, 120, 100, 255)               '-----------> here you must change values ! :)
   factors(0) = 0.0! : factors(1) = 0.2! : factors(2) = 0.4! : factors(3) = 0.8! : factors(4) = 1.0!
   positions(0) = 0.0! : positions(1) = 0.2! : positions(2) = 0.6! : positions(3) = 0.7! : positions(4) = 0.9!

   hStatus = GdipCreateLineBrushFromRect(rc, colorRed, colorBlue, %LinearGradientModeHorizontal, %WrapModeTile, pLinBrush)
   hStatus = GdipSetLineBlend(pLinBrush, factors(0), positions(0), 4)
   hStatus = GdipFillRectangle(pGraphics, pLinBrush, rc.x, rc.y, rc.Width, rc.Height)

  '----------------------------------------------- one more rectangle with gradient line at bottom
   hStatus1 = GdipCreateFromHDC(hdc, pGraphics1)

   rc.x = 5 : rc.y = 460 : rc.Width = 800 : rc.Height = 60 '-----------> here you must change values ! :)
   colorRed = GDIP_ARGB(255, 200, 120, 120)                '-----------> here you must change values ! :)
   colorBlue = GDIP_ARGB(255, 0, 255, 250)                 '-----------> here you must change values ! :)
   factors(0) = 0.0! : factors(1) = 0.3! : factors(2) = 0.5! : factors(3) = 0.9!
   positions(0) = 0.0! : positions(1) = 0.2! : positions(2) = 0.6! : positions(3) = 1.0!

   hStatus1 = GdipCreateLineBrushFromRect(rc, colorRed, colorBlue, %LinearGradientModeHorizontal, %WrapModeTile, pLinBrush)
   hStatus1 = GdipSetLineBlend(pLinBrush, factors(0), positions(0), 4)
   hStatus1 = GdipFillRectangle(pGraphics1, pLinBrush, rc.x, rc.y, rc.Width, rc.Height)

   '----------------------------------------------- one more rectangles gradient line

  '----------------------------------------------- one more rectangle with gradient line at middle area
   hStatus2 = GdipCreateFromHDC(hdc, pGraphics2)

   rc.x = 5 : rc.y = 260 : rc.Width = 800 : rc.Height = 60 '-----------> here you must change values ! :)
   colorRed = GDIP_ARGB(255, 200, 200, 0)                '-----------> here you must change values ! :)
   colorBlue = GDIP_ARGB(255, 100, 125, 255)                 '-----------> here you must change values ! :)
   factors(0) = 0.0! : factors(1) = 0.3! : factors(2) = 0.5! : factors(3) = 0.9!
   positions(0) = 0.0! : positions(1) = 0.2! : positions(2) = 0.6! : positions(3) = 1.0!

   hStatus2 = GdipCreateLineBrushFromRect(rc, colorRed, colorBlue, %LinearGradientModeHorizontal, %WrapModeTile, pLinBrush)
   hStatus2 = GdipSetLineBlend(pLinBrush, factors(0), positions(0), 4)
   hStatus2 = GdipFillRectangle(pGraphics2, pLinBrush, rc.x, rc.y, rc.Width, rc.Height)


   ' // Cleanup
   IF pLinBrush THEN GdipDeleteBrush(pLinBrush)
   IF pGraphics THEN GdipDeleteGraphics(pGraphics)
   IF pGraphics1 THEN GdipDeleteGraphics(pGraphics1)
   IF pGraphics2 THEN GdipDeleteGraphics(pGraphics2)
END SUB


I have made some comments for you where to change values for manipulating the gradient areas.

bye, servus, frank
« Last Edit: February 02, 2010, 03:15:33 PM by Frank Brübach »

Offline Frank Brübach

  • Full Member
  • ***
  • Posts: 109
  • User-Rate: +13/-5
Re: gdiplus spheres + rectangles effects
« Reply #8 on: February 02, 2010, 03:18:02 PM »
next one...

you can change gradient rectangle even in old "hello window" sdk example from petzold, if you like!

2) example with gradient rectangle sized:

Code: [Select]
'==============================================================================
'
'   HELLOWIN.BAS for PowerBASIC for Windows
'   Copyright (c) 1997-2008 PowerBASIC, Inc.
'   All Rights Reserved.
'
'   Translation of HELLOWIN.C from Charles Petzold's book:
'
'     "Programming Windows 95" published by Microsoft Press.
'     ISBN 1-55615-676-6
'
'   Note: The original code does not contain the "gradient" effect.
'
'==============================================================================

#COMPILER PBWIN 9
#COMPILE EXE
#DIM ALL

%USEMACROS = 1
#INCLUDE "Win32API.inc"
'#RESOURCE "HelloWin2.pbr"     ' this gives the program the "hellowin" icon


'==============================================================================
FUNCTION WINMAIN (BYVAL hInstance     AS DWORD, _
                  BYVAL hPrevInstance AS DWORD, _
                  BYVAL lpCmdLine     AS ASCIIZ PTR, _
                  BYVAL iCmdShow      AS LONG) AS LONG
'------------------------------------------------------------------------------
    ' Program entry point
    '--------------------------------------------------------------------------

    LOCAL Msg       AS tagMsg
    LOCAL wce       AS WndClassEx
    LOCAL szAppName AS ASCIIZ * 80
    LOCAL hWnd      AS DWORD

    ' Setup and register a window class for the main window
    ' CODEPTR is used to pass the address of the function that will
    ' receive all messages sent to any window created with this class
    szAppName         = "HelloWin2"
    wce.cbSize        = SIZEOF(wce)
    wce.STYLE         = %CS_HREDRAW OR %CS_VREDRAW
    wce.lpfnWndProc   = CODEPTR(WndProc)
    wce.cbClsExtra    = 0
    wce.cbWndExtra    = 0
    wce.hInstance     = hInstance
    wce.hIcon         = LoadIcon(hInstance, "HELLOWIN2")
    wce.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
    wce.hbrBackground = %NULL ' No class background, we do it ourselves
    wce.lpszMenuName  = %NULL
    wce.lpszClassName = VARPTR(szAppName)
    wce.hIconSm       = LoadIcon(hInstance, BYVAL %IDI_APPLICATION)

    RegisterClassEx wce

    ' Create a window using the registered class
    hWnd = CreateWindow(szAppName, _               ' window class name
                        "The Hello AdamEva Program", _     ' window caption
                        %WS_OVERLAPPEDWINDOW, _    ' window style
                        %CW_USEDEFAULT, _          ' initial x position
                        %CW_USEDEFAULT, _          ' initial y position
                        %CW_USEDEFAULT, _          ' initial x size
                        %CW_USEDEFAULT, _          ' initial y size
                        %NULL, _                   ' parent window handle
                        %NULL, _                   ' window menu handle
                        hInstance, _               ' program instance handle
                        BYVAL %NULL)               ' creation parameters

    IF hWnd = 0 THEN  ' exit on failure
        MSGBOX "Unable to create window"
        EXIT FUNCTION
    END IF

    ' Display the window on the screen
    ShowWindow hWnd, iCmdShow
    UpdateWindow hWnd

    ' Main message loop:
    ' Messages sent to HELLOWIN while it has the focus are received by
    ' GetMessage().  This loop translates each message and dispatches it
    ' to the appropriate handler.  When PostQuitMessage() is called, the
    ' loop terminates which ends the application.
    DO WHILE GetMessage(Msg, %NULL, 0, 0)
        TranslateMessage Msg
        DispatchMessage Msg
    LOOP

    FUNCTION = msg.wParam

END FUNCTION


' ========================================================================================
' Draws the gradient
' ========================================================================================
SUB DrawGradient (BYVAL hwnd AS DWORD, BYVAL hdc AS DWORD)

   LOCAL rc AS RECT
   DIM   vertex(1) AS TRIVERTEX

   GetClientRect hwnd, rc

   vertex(0).x      = 0
   vertex(0).y      = 0
   vertex(0).Red    = &HFF00
   vertex(0).Green  = &HFF00
   vertex(0).Blue   = &H0000
   vertex(0).Alpha  = &H0000

   vertex(1).x      = rc.nRight - rc.nLeft
   vertex(1).y      = rc.nBottom - rc.nTop
   vertex(1).Red    = &H8000
   vertex(1).Green  = &H0000
   vertex(1).Blue   = &H0000
   vertex(1).Alpha  = &H0000

   LOCAL gRect AS GRADIENT_RECT

   gRect.UpperLeft  = 0
   gRect.LowerRight = 1

   GradientFill hDc, vertex(0), 2, gRect, 1, %GRADIENT_FILL_RECT_H

END SUB
' ========================================================================================

'==============================================================================
SUB DrawGradient2 (BYVAL hDC AS DWORD)
'------------------------------------------------------------------------------
    ' Custom draw procedure for gradiend fill
    '--------------------------------------------------------------------------

    LOCAL rectFill AS RECT
    LOCAL rectClient AS RECT
    LOCAL fStep AS SINGLE
    LOCAL hBrush AS DWORD
    LOCAL lOnBand AS LONG

    GetClientRect WindowFromDC(hDC), rectClient
    fStep = rectClient.nbottom / 300

    FOR lOnBand = 60 TO 199
        SetRect rectFill, 100, lOnBand * fStep, rectClient.nright - 100, (lOnBand + 55) * fStep*0.75
        hBrush = CreateSolidBrush(RGB(255, 0, 255 - lOnBand))
        Fillrect hDC, rectFill, hBrush
        DeleteObject hBrush
    NEXT

END SUB


'==============================================================================
FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
                  BYVAL wParam AS DWORD, BYVAL lParam AS LONG) EXPORT AS LONG
'------------------------------------------------------------------------------
    ' WndProc is the message handler for all windows creating using the HelloWin
    ' class name.  A single WndProc procedure can handle multiple windows by
    ' testing the hWnd variable passed to it.
    '--------------------------------------------------------------------------

    LOCAL hDC    AS DWORD
    LOCAL pPaint AS PAINTSTRUCT
    LOCAL tRect  AS RECT

    ' The SELECT CASE is used to catch only those messages which the message
    ' handler needs to process.  All other messages are passed through the
    ' tests to the default handler.
    SELECT CASE wMsg

    CASE %WM_CREATE

    CASE %WM_PAINT
        hDC = BeginPaint(hWnd, pPaint)
        GetClientRect hWnd, tRect
        SetBkMode hDC, %TRANSPARENT
        SetTextColor hDC, %GREEN
        DrawText hDC, "Hello, dear AdamEvaBasic Window!", -1, tRect, %DT_SINGLELINE OR %DT_CENTER OR %DT_VCENTER
        EndPaint hWnd, pPaint
        FUNCTION = 1
        EXIT FUNCTION

    CASE %WM_ERASEBKGND
        hDC = wParam
        DrawGradient hwnd,hDC             ' Pass the DC of the region to repaint
        DrawGradient2 hDC              ' Pass the DC of the region to repaint
        FUNCTION = 1
        EXIT FUNCTION

    CASE %WM_DESTROY
        PostQuitMessage 0
        EXIT FUNCTION

    END SELECT

    ' Any message which is not handled in the above SELECT CASE reaches this
    ' point and is processed by the Windows default message handler.
    FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION

I can imagine, nobody has tried it before to change the "Custom draw procedure for gradiend fill".
see more details for this one at 'SUB DrawGradient2 (BYVAL hDC AS DWORD)'...

best regards, franko :)
« Last Edit: February 02, 2010, 03:29:03 PM by Frank Brübach »

Offline José Roca

  • Administrator
  • Hero Member
  • *****
  • Posts: 2487
  • User-Rate: +204/-0
Re: gdiplus spheres + rectangles effects
« Reply #9 on: February 02, 2010, 03:47:58 PM »
 
We have tried. See documentation and three examples here: http://www.jose.it-berater.org/smfforum/index.php?topic=724.0

Offline Patrice Terrier

  • ROMs
  • Hero Member
  • *****
  • Posts: 934
  • User-Rate: +62/-1
    • www.zapsolution.com
Re: gdiplus spheres + rectangles effects
« Reply #10 on: February 02, 2010, 04:25:10 PM »
I have attached a screen shot of a gradient rectangle drawn with GDImage.

See also here and there

And another use of gradient (from my old GDIPLUS Helper toolkit):
Code: [Select]
' gpGRAD GDIPLUS Flat API example
'
' This demo draws a path gradient brush from a star-shaped path
'
#COMPILE EXE "gpGRAD.exe"
#INCLUDE "win32api.inc"
#INCLUDE "gdiplus.inc"

SUB DrawGradient(BYVAL hDC&)

    REDIM pt(1 TO 10) AS POINTL
  ' Random values (From the SDK C++ sample)
    pt(1).x = 75
    pt(1).y = 0
    pt(2).x = 100
    pt(2).y = 50
    pt(3).x = 150
    pt(3).y = 50
    pt(4).x = 112
    pt(4).y = 75
    pt(5).x = 150
    pt(5).y = 150
    pt(6).x = 75
    pt(6).y = 100
    pt(7).x = 0
    pt(7).y = 150
    pt(8).x = 37
    pt(8).y = 75
    pt(9).x = 0
    pt(9).y = 50
    pt(10).x = 50
    pt(10).y = 50

    CALL GdipCreateFromHDC(hDC&, graphics&)

  ' Create a GraphicsPath object
    CALL GdipCreatePath(%FillModeAlternate, path&)

  ' Use the array of points to construct a path.
    CALL GdipAddPathLine2I(path&, pt(1), 10)

  ' Use the path to construct a path gradient brush.
    CALL GdipCreatePathGradientFromPath(path&, brush&)
  
  ' Set the color at the center of the path to red.
    CALL GdipSetPathGradientCenterColor(brush&, ColorARGB(255, 255, 0, 0))
  
  ' Set the colors of the points in the array.
    Count& = 10
    REDIM Colors(1 TO Count&) AS LONG
    Colors(1)  = ColorARGB(255, 0, 0, 0)
    Colors(2)  = ColorARGB(255, 0, 255, 0)
    Colors(3)  = ColorARGB(255, 0, 0, 255)
    Colors(4)  = ColorARGB(255, 255, 255, 255)
    Colors(5)  = ColorARGB(255, 0, 0, 0)
    Colors(6)  = ColorARGB(255, 0, 255, 0)
    Colors(7)  = ColorARGB(255, 0, 0, 255)
    Colors(8)  = ColorARGB(255, 255, 255, 255)
    Colors(9)  = ColorARGB(255, 0, 0, 0)  
    Colors(10) = ColorARGB(255, 0, 255, 0)
    CALL GdipSetPathGradientSurroundColorsWithCount(brush&, Colors(1), Count&)
  
  ' Fill the path with the path gradient brush.
    CALL GdipFillPath(graphics&, brush&, path&)

  ' Cleanup
    CALL GdipDeletePath(path&)
    CALL GdipDeleteBrush(brush&)
    CALL GdipDeleteGraphics(graphics&)

END SUB

FUNCTION WndProc(BYVAL hWnd& , BYVAL Msg&, BYVAL wParam&, BYVAL lParam&) AS LONG

    LOCAL ps AS PAINTSTRUCT

    SELECT CASE Msg&
    CASE %WM_PAINT
        hDC& = BeginPaint(hWnd&, ps)
        CALL DrawGradient(hDC&)
        CALL EndPaint(hWnd&, ps)

    CASE %WM_DESTROY
        CALL PostQuitMessage(0)
    END SELECT

    FUNCTION = DefWindowProc(hWnd&, Msg&, wParam&, lParam&)

END FUNCTION

FUNCTION WinMain (BYVAL hInstance     AS LONG, _
                  BYVAL hPrevInstance AS LONG, _
                  BYVAL lpCmdLine     AS ASCIIZ PTR, _
                  BYVAL iCmdShow      AS LONG) AS LONG

    LOCAL msg AS tagMSG
    LOCAL wc AS WNDCLASSEX
    LOCAL szClassName AS ASCIIZ * 128
    szClassName = "GDI+ demo"

  ' LOAD the GDI+ Engine
    hGDIplus& = gpStart
    IF hGDIplus& THEN
       IF ISFALSE(hPrevInstance&) THEN
          wc.cbSize        = SIZEOF(wc)
          wc.style         = %CS_HREDRAW OR %CS_VREDRAW
          wc.lpfnWndProc   = CODEPTR(WndProc)
          wc.cbClsExtra    = 0
          wc.cbWndExtra    = 0
          wc.hInstance     = hInstance&
          wc.hIcon         = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
          wc.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
          wc.hbrBackground = GetStockObject(%WHITE_BRUSH)
          wc.lpszMenuName  = %NULL
          wc.lpszClassName = VARPTR(szClassName)
          wc.hIconSm       = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
          CALL RegisterClassEx(wc)
       END IF
       hWnd& = CreateWindowEx(0, _
                              szClassName, _          ' window class name
                              szClassName, _          ' window caption
                              %WS_OVERLAPPEDWINDOW, _ ' window style
                              %CW_USEDEFAULT, _       ' initial x position
                              %CW_USEDEFAULT, _       ' initial y position
                              %CW_USEDEFAULT, _       ' initial x size
                              %CW_USEDEFAULT, _       ' initial y size
                              %NULL, _                ' parent window handle
                              %NULL, _                ' window menu handle
                              hInstance&, _           ' program instance handle
                              BYVAL %NULL)            ' creation parameters
       IF hWnd& THEN                              
          CALL ShowWindow(hWnd&, %SW_SHOW)
          CALL UpdateWindow(hWnd&)

          DO WHILE GetMessage(msg, %NULL, 0, 0)
              TranslateMessage msg
              DispatchMessage msg
          LOOP

          FUNCTION = msg.wParam
       END IF

     ' UNLOAD the GDI+ Engine
       CALL gpEnd(hGDIplus&)

    END IF

END FUNCTION

...
« Last Edit: February 02, 2010, 04:44:35 PM by Patrice Terrier »
Patrice Terrier
GDImage (advanced graphic addon)
http://www.zapsolution.com

Offline Edwin Knoppert

  • Sr. Member
  • ****
  • Posts: 254
  • User-Rate: +11/-4
    • Hellobasic.com
Re: gdiplus spheres + rectangles effects
« Reply #11 on: February 02, 2010, 05:55:48 PM »
Thanks Frank!
I think i manage now and.., it even seems to support alpha blending.. cool!
Nice for shadows and such.

I will find me the way to set orientation and colors from/to, thanks :)

Offline Frank Brübach

  • Full Member
  • ***
  • Posts: 109
  • User-Rate: +13/-5
Re: gdiplus spheres + rectangles effects
« Reply #12 on: February 02, 2010, 09:00:38 PM »
edwin, you are welcome!

thanks patrice for you little star-path example and gradient button too. as this example doesn't work (very old one) with current pbwin 9.03 issue I have a) adept it for gdiplus so it can run and b) modified it with a "shadow" star path :) !

coloured star with shadow:
Code: [Select]
'------------------------------------------------------------------------------
' This demo draws a path gradient brush from a star-shaped path with shadow !
' -> demo fixed for pbwin 9.03 and modified by frank brübach, 02.02.2010 :)
'------------------------------------------------------------------------------

#COMPILE EXE
#INCLUDE "win32api.inc"
#INCLUDE "gdiplus.inc"

SUB DrawGradient(BYVAL hDC&)

   LOCAL MiddleColorToOpaque AS DWORD
   LOCAL BlueFullTranslucent AS DWORD
   LOCAL RedFullTranslucent AS DWORD
   LOCAL YellowFullTranslucent AS DWORD
   LOCAL GreenFullTranslucent AS DWORD
   LOCAL CyanFullTranslucent AS DWORD
   LOCAL MagentaFullTranslucent AS DWORD
   LOCAL BlackFullTranslucent AS DWORD
   LOCAL WhiteFullTranslucent AS DWORD
   LOCAL hStatus AS LONG
   LOCAL pBrush AS DWORD
   LOCAL path1 AS DWORD
   LOCAL graphics1 AS DWORD

    REDIM pt(1 TO 10) AS POINTL
    pt(1).x = 175
    pt(1).y = 100
    pt(2).x = 200
    pt(2).y = 150
    pt(3).x = 250
    pt(3).y = 150
    pt(4).x = 212
    pt(4).y = 175
    pt(5).x = 250
    pt(5).y = 250
    pt(6).x = 175
    pt(6).y = 200
    pt(7).x = 100
    pt(7).y = 250
    pt(8).x = 137
    pt(8).y = 175
    pt(9).x = 100
    pt(9).y = 150
    pt(10).x = 150
    pt(10).y = 150

    REDIM pt1(1 TO 10) AS POINTL
    pt1(1).x = 75
    pt1(1).y = 0
    pt1(2).x = 100
    pt1(2).y = 50
    pt1(3).x = 150
    pt1(3).y = 50
    pt1(4).x = 112
    pt1(4).y = 75
    pt1(5).x = 150
    pt1(5).y = 150
    pt1(6).x = 75
    pt1(6).y = 100
    pt1(7).x = 0
    pt1(7).y = 150
    pt1(8).x = 37
    pt1(8).y = 75
    pt1(9).x = 0
    pt1(9).y = 50
    pt1(10).x = 50
    pt1(10).y = 50

    
    CALL GdipCreateFromHDC(hDC&, graphics&)
    CALL GdipCreateFromHDC(hDC&, graphics1)
    
  ' Create a GraphicsPath object
    CALL GdipCreatePath(%FillModeAlternate, path&)
    CALL GdipCreatePath(%FillModeAlternate, path1)
        
  ' Use the array of points to construct a path.
    CALL GdipAddPathLine2I(path&, pt(1), 10)
    CALL GdipAddPathLine2I(path1, pt1(1), 10)
    
  ' Use the path to construct a path gradient brush.
    CALL GdipCreatePathGradientFromPath(path&, brush&)
    CALL GdipCreatePathGradientFromPath(path1, pbrush)
    
    RedFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_RED,64)
    hStatus = GdipSetPathGradientCenterColor(pBrush, RedFullTranslucent)

    WhiteFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_WHITE, 64)
    hStatus = GdipSetPathGradientCenterColor(pBrush, WhiteFullTranslucent)

    GreenFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_GREEN, 64)
    hStatus = GdipSetPathGradientCenterColor(pBrush, GreenFullTranslucent)

    YellowFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_YELLOW, 64)
    hStatus = GdipSetPathGradientCenterColor(pBrush, YellowFullTranslucent)

    BlackFullTranslucent = GDIP_ARGB_SetAlphaValue(%ARGB_Black, 64)
    hStatus = GdipSetPathGradientCenterColor(pBrush, BlackFullTranslucent)

  ' Set the colors of the points in the array.
    Count& = 10
    REDIM Colors(1 TO Count&) AS LONG
    Colors(1)  = %ARGB_Red 'ColorARGB(255, 0, 0, 0)
    Colors(2)  = %ARGB_Yellow 'ColorARGB(255, 0, 255, 0)
    Colors(3)  = %ARGB_Blue 'ColorARGB(255, 0, 0, 255)
    Colors(4)  = %ARGB_White 'ColorARGB(255, 255, 255, 255)
    Colors(5)  = %ARGB_Black 'ColorARGB(255, 0, 0, 0)
    Colors(6)  = %ARGB_Red 'ColorARGB(255, 0, 255, 0)
    Colors(7)  = %ARGB_Blue 'ColorARGB(255, 0, 0, 255)
    Colors(8)  = %ARGB_White 'ColorARGB(255, 255, 255, 255)
    Colors(9)  = %ARGB_Black 'ColorARGB(255, 0, 0, 0)
    Colors(10) = %ARGB_Yellow 'ColorARGB(255, 0, 255, 0)
    CALL GdipSetPathGradientSurroundColorsWithCount(brush&, Colors(1), Count&)

  ' Fill the path with the path gradient brush.
    CALL GdipFillPath(graphics&, brush&, path&)
    CALL GdipFillPath(graphics&, pbrush, path1)

  ' Cleanup
    CALL GdipDeletePath(path&)
    CALL GdipDeletePath(path1)
    CALL GdipDeleteBrush(brush&)
    CALL GdipDeleteBrush(pbrush)
    CALL GdipDeleteGraphics(graphics&)
    CALL GdipDeleteGraphics(graphics1)
    
END SUB

'----------------------------------------------------------------------------------------------------------------
FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
'----------------------------------------------------------------------------------------------------------------
   LOCAL hDC AS DWORD
   LOCAL ps AS PAINTSTRUCT

   SELECT CASE wMsg

      CASE %WM_COMMAND
         SELECT CASE LOWRD(wParam)
            CASE %IDCANCEL
               IF HIWRD(wParam) = %BN_CLICKED THEN
                  SendMessage hWnd, %WM_CLOSE, 0, 0
                  FUNCTION = 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_SYSCOMMAND
         ' Capture this message and send a WM_CLOSE message
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hWnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_PAINT
         hDC = BeginPaint(hWnd, ps)
         DrawGradient hDC
         EndPaint(hWnd, ps)

      CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION


' =========================================================================================================================================
  FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
' =========================================================================================================================================
   LOCAL hr AS LONG
   LOCAL hWndMain AS DWORD
   LOCAL hCtl AS DWORD
   LOCAL hFont AS DWORD
   LOCAL wcex AS WndClassEx
   LOCAL szClassName AS ASCIIZ * 80
   LOCAL rc AS RECT
   LOCAL szCaption AS ASCIIZ * 255
   LOCAL nLeft AS LONG
   LOCAL nTop AS LONG
   LOCAL nWidth AS LONG
   LOCAL nHeight AS LONG
   LOCAL token AS DWORD
   LOCAL hDlg AS DWORD
   LOCAL StartupInput AS GdiplusStartupInput

   ' Initialize GDI+
   StartupInput.GdiplusVersion = 1
   hr = GdiplusStartup(token, StartupInput, BYVAL %NULL)
   IF hr THEN
      MSGBOX "Error initializing GDI+"
      EXIT FUNCTION
   END IF

   hFont = GetStockObject(%ANSI_VAR_FONT)

   ' Register the window class
   szClassName        = "MyClassName"
   wcex.cbSize        = SIZEOF(wcex)
   wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
   wcex.lpfnWndProc   = CODEPTR(WndProc)
   wcex.cbClsExtra    = 0
   wcex.cbWndExtra    = 0
   wcex.hInstance     = hInstance
   wcex.hCursor       = LoadCursor (%NULL, BYVAL %IDC_ARROW)
   wcex.hbrBackground = GetStockObject(%WHITE_BRUSH)
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szClassName)
   wcex.hIcon         = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Sample, if resource icon: LoadIcon(hInst, "APPICON")
   wcex.hIconSm       = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Remember to set small icon too..
   RegisterClassEx wcex

   ' Window caption
   szCaption = "gdiplus example with path for a star with shadow1 :) "

   ' Retrieve the nSize of the working area
   SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(rc), 0

   ' Calculate the position and nSize of the window
   nWidth  = (((rc.nRight - rc.nLeft)) + 2) * 0.85   ' 55% of the client screen width
   nHeight = (((rc.nBottom - rc.nTop)) + 2) * 0.80   ' 50% of the client screen height
   nLeft   = ((rc.nRight - rc.nLeft) \ 2) - nWidth \ 2
   nTop    = ((rc.nBottom - rc.nTop) \ 2) - (nHeight \ 2)

   ' Create a window using the registered class
   hWndMain = CreateWindowEx(%WS_EX_CONTROLPARENT, _           ' extended style
                             szClassName, _                    ' window class name
                             szCaption, _                      ' window caption
                             %WS_OVERLAPPEDWINDOW OR _
                             %WS_CLIPCHILDREN, _               ' window style
                             nLeft, _                          ' initial x position
                             nTop, _                           ' initial y position
                             nWidth, _                         ' initial x nSize
                             nHeight, _                        ' initial y nSize
                             %NULL, _                          ' parent window handle
                             0, _                              ' window menu handle
                             hInstance, _                      ' program instance handle
                             BYVAL %NULL)                      ' creation parameters

   ' Show the window
   ShowWindow hWndMain, nCmdShow
   UpdateWindow hWndMain

   ' Message handler loop
   LOCAL Msg AS tagMsg
   WHILE GetMessage(Msg, %NULL, 0, 0)
      IF ISFALSE IsDialogMessage(hWndMain, Msg) THEN
         TranslateMessage Msg
         DispatchMessage Msg
      END IF
   WEND

   ' Shutdown GDI+
   GdiplusShutdown token

   FUNCTION = msg.wParam

END FUNCTION

I do all these things to learn and use exciting gdiplus features with powerbasic ;)

one little question about gdiplus more:

=> how big is difference between "TB_GDIPLUS.INC" (old one ?) and "GDIPLUS.INC" ? I ask because there are a lot of gdiplus examples at this website they are working only with "TB_GDIPLUS.INC" and not with current "GDIPLUS.INC". it's my job to fit this one ? ;)

best regards, frank
« Last Edit: February 02, 2010, 09:08:28 PM by Frank Brübach »

Offline Patrice Terrier

  • ROMs
  • Hero Member
  • *****
  • Posts: 934
  • User-Rate: +62/-1
    • www.zapsolution.com
Re: gdiplus spheres + rectangles effects
« Reply #13 on: February 02, 2010, 09:26:11 PM »
It seems that there are several GDIPLUS.inc for PowerBASIC floating around.

The first one was posted on the PowerBASIC forum on november 06, 2002 here
Patrice Terrier
GDImage (advanced graphic addon)
http://www.zapsolution.com

Offline José Roca

  • Administrator
  • Hero Member
  • *****
  • Posts: 2487
  • User-Rate: +204/-0
Re: gdiplus spheres + rectangles effects
« Reply #14 on: February 02, 2010, 11:28:12 PM »
Quote
=> how big is difference between "TB_GDIPLUS.INC" (old one ?) and "GDIPLUS.INC" ? I ask because there are a lot of gdiplus examples at this website they are working only with "TB_GDIPLUS.INC" and not with current "GDIPLUS.INC". it's my job to fit this one ?

You won't see them anymore. All the old examples were translated to work with the new compilers and includes, and I kept them in the Legacy Software board because there is always a transition time, but now is time to hide them because it has become confusing to newcomers.
« Last Edit: February 02, 2010, 11:29:57 PM by José Roca »