' DDT style, simple line graph program with scalable window and scalable GDI
' object printing.

' Uses a graphics function to send graphic objects to the device context of
' 1. A window using the WM_PAINT message or
' 2. A printer using a printer function that calls the printer common dialog
' and does the things needed to scale the graphics to the printer.

' Includes a standalone color selection function that calls the ChooseColor
' common dialog.

' Line values are hard coded for demo purposes.

$DIM ALL
$REGISTER NONE
$COMPILE EXE

$INCLUDE "WIN32API.INC"
$INCLUDE "COMDLG32.INC"

GLOBAL result AS LONG
GLOBAL hDlg AS LONG
GLOBAL hDC AS LONG
GLOBAL ps AS PAINTSTRUCT
GLOBAL hPen AS LONG
GLOBAL hBrush AS LONG
GLOBAL LineColor AS DWORD
GLOBAL BackgroundColor AS DWORD
GLOBAL GridColor AS DWORD
GLOBAL TextColor AS DWORD
GLOBAL graph() AS POINTAPI
GLOBAL numpoints AS LONG
GLOBAL valueMax AS LONG
GLOBAL value() AS LONG
GLOBAL xClient AS LONG
GLOBAL yClient AS LONG
GLOBAL title AS STRING

%IDTEXT = %WM_USER
%IDEXIT = %WM_USER + 1
%IDPRINT = %WM_USER + 2
%IDPCOLOR = %WM_USER + 3
%IDBCOLOR = %WM_USER + 4
%IDGCOLOR = %WM_USER + 5
%IDTCOLOR = %WM_USER + 6

' Callback Declarations
DECLARE CALLBACK FUNCTION DlgProc()
DECLARE FUNCTION SelectColor(LocalColor AS DWORD) AS LONG
DECLARE FUNCTION GDICalls(hDC AS LONG, xSize AS LONG, ySize AS LONG) AS LONG
DECLARE FUNCTION Printer(hWnd AS LONG) AS LONG

FUNCTION PBMAIN AS LONG

  xClient = 200  ' set initial size of client (graphing) area
  yClient = 200

  numpoints = 10 ' number of points (values)
  valueMax = 15  ' maximum value
  DIM graph(0:numpoints)
  DIM value(0:numpoints)
  value(0) = 10  ' hard coded for demo purposes
  value(1) = 8
  value(2) = 7
  value(3) = 4
  value(4) = 6
  value(5) = 5
  value(6) = 4
  value(7) = 2
  value(8) = 1
  value(9) = 0
  title = "Example graph"


  LOCAL hMenu AS LONG
  LOCAL hPopup1 AS LONG

  MENU NEW BAR TO hMenu  ' begin defining a menu

  MENU ADD STRING, hMenu, "&Exit", %IDEXIT, %MF_ENABLED
  MENU ADD STRING, hMenu, "&Print", %IDPRINT, %MF_ENABLED

  MENU NEW POPUP TO hPopup1
  MENU ADD STRING, hPopup1, "&Line Color", %IDPCOLOR, %MF_ENABLED
  MENU ADD STRING, hPopup1, "&Background Color", %IDBCOLOR, %MF_ENABLED
  MENU ADD STRING, hPopup1, "&Grid Color", %IDGCOLOR, %MF_ENABLED
  MENU ADD STRING, hPopup1, "&Text Color", %IDTCOLOR, %MF_ENABLED
  MENU ADD POPUP, hMenu, "&Colors",hPopup1, %MF_ENABLED

  ' Create primary dialog box
  DIALOG NEW 0, "Simple line graph with printing", 0, 0, xClient, yClient, _
    %DS_CENTER OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX _
    OR %WS_THICKFRAME OR %WS_EX_TOOLWINDOW, 0 TO hDlg
  MENU ATTACH hMenu, hDlg  ' attach the menu just created

  ' Start up dialog box and run until the user quits
  DIALOG SHOW MODAL hDlg, CALL DlgProc TO result

END FUNCTION



CALLBACK FUNCTION DlgProc()


  SELECT CASE CBMSG

    CASE %WM_INITDIALOG
      LineColor = RGB(255, 0, 0) ' initial color = red
      BackgroundColor = RGB(255, 255, 224) ' initial color = light yellow
      GridColor = RGB(0, 0, 255) ' initial color = blue
      TextColor = RGB(0, 0, 0) ' initial color = black

    CASE %WM_SIZE
      xClient = LOWRD (CBLPARAM) ' get screen size when resized
      yClient = HIWRD (CBLPARAM)
      InvalidateRect hDlg, BYVAL %NULL, %TRUE  'invalidate window to cause a redraw

    CASE %WM_PAINT
      hDC = BeginPaint(hDlg, ps)  ' special for WM_PAINT messages
      GDICalls hDC, xClient, yClient ' do all of the graphics to the screen based on screen size
      EndPaint hDlg, ps  ' special for WM_PAINT messages
      ReleaseDC hDlg, hDC  ' release device context handle


    CASE %WM_COMMAND

      IF CBCTLMSG = %BN_CLICKED THEN
        IF CBCTL = %IDEXIT THEN DIALOG END CBHNDL, 0

        IF CBCTL = %IDPCOLOR THEN
          LineColor = SelectColor(LineColor) ' select pen color
          InvalidateRect hDlg, BYVAL %NULL, %TRUE  'invalidate window to cause a redraw
        END IF

        IF CBCTL = %IDBCOLOR THEN
          BackgroundColor = SelectColor(BackgroundColor)  ' select brush color
          InvalidateRect hDlg, BYVAL %NULL, %TRUE  'invalidate window to cause a redraw
        END IF

        IF CBCTL = %IDGCOLOR THEN
          GridColor = SelectColor(GridColor)  ' select grid color
          InvalidateRect hDlg, BYVAL %NULL, %TRUE  'invalidate window to cause a redraw
        END IF

        IF CBCTL = %IDTCOLOR THEN
          TextColor = SelectColor(TextColor)  ' select text color
          InvalidateRect hDlg, BYVAL %NULL, %TRUE  'invalidate window to cause a redraw
        END IF

        IF CBCTL = %IDPRINT THEN
          Printer hDlg ' printer function
        END IF

      END IF  ' CBCTLMSG

  END SELECT  ' CASE CBMSG

END FUNCTION

'------------------------------------------------------------------

FUNCTION SelectColor(LocalColor AS DWORD) AS LONG

  LOCAL cc AS CHOOSECOLORAPI ' from comdlg32.inc
  DIM CustomColor(15) AS LOCAL DWORD 'array needed even if not used

  cc.lStructSize = LEN(cc)
  cc.hwndOwner = hDlg ' if 0, the dialog box appears at top/left.
  cc.lpCustColors = VARPTR(CustomColor(0)) ' point to array of custom colors
  cc.rgbResult = LocalColor   'set the initial color
  cc.Flags = %CC_RGBINIT OR %CC_FULLOPEN
  ChooseColor cc  ' returns 0 if cancel selected
  FUNCTION = cc.rgbResult

END FUNCTION


'------------------------------------------------------------------

FUNCTION Printer(hWnd AS LONG) AS LONG

  LOCAL result AS LONG
  LOCAL hDC AS LONG
  LOCAL pd AS PRINTDLGAPI
  LOCAL di AS DOCINFO

  LOCAL x1 AS LONG  ' the following needed for scaling calculations
  LOCAL y1 AS LONG
  LOCAL x2 AS LONG
  LOCAL y2 AS LONG
  LOCAL xPrnRes AS SINGLE
  LOCAL yPrnRes AS SINGLE
  LOCAL xScale AS SINGLE
  LOCAL yScale AS SINGLE
  LOCAL xPrinter AS LONG
  LOCAL yPrinter AS LONG
  LOCAL SCALE AS SINGLE

  pd.lStructSize = SIZEOF(pd)
  pd.Flags = %PD_RETURNDC  ' return device context in structure
  pd.hWndOwner = hWnd ' identify window
  result = PrintDlg(pd)  ' call printer common dialog
  IF result = 0 THEN EXIT FUNCTION

  hDC = GetDC(hWnd) ' get device context handle to the main window
  x1 = GetDeviceCaps(hDC, %LOGPIXELSX) ' get pixels per logical inch for display
  y1 = GetDeviceCaps(hDC, %LOGPIXELSY)
  ReleaseDC hWnd, hDC  ' release device context handle

  x2 = GetDeviceCaps(pd.hDC, %LOGPIXELSX) ' get pixels per logical inch for printer
  y2 = GetDeviceCaps(pd.hDC, %LOGPIXELSY)

  xScale = x2 / x1  ' get scaling factor going from screen inches to printer inches
  yScale = y2 / y1

  xPrinter = xClient * xScale  ' scale screen to printer in inches
  yPrinter = yClient * yScale

  xPrnRes = GetDeviceCaps (pd.hDC, %HORZRES)  ' get resolution of the printer
  yPrnRes = GetDeviceCaps (pd.hDC, %VERTRES)

  xScale = xPrnRes / xPrinter  ' get scaling facter going from screen to printer resolution
  yScale = yPrnRes / yPrinter

  IF xScale < yScale THEN  ' find the smaller of the two
    SCALE = xScale
  ELSE
    SCALE = yScale
  END IF

  xPrinter = xPrinter * SCALE  ' scale both by the same factor to retain aspect ratio
  yPrinter = yPrinter * SCALE  ' this will make image as large as possible in the smallest dimension

  StartDoc pd.hDC, di
    StartPage pd.hDC
      GDICalls pd.hDC, xPrinter, yPrinter ' do all of the graphics to the printer based on calculations
    EndPage pd.hDC
  EndDoc pd.hDC

  DeleteDC pd.hDC  ' Delete printer device context

END FUNCTION

'------------------------------------------------------------------

FUNCTION GDICalls (hDC AS LONG, xSize AS LONG, ySize AS LONG) AS LONG

  LOCAL hPen AS LONG
  LOCAL hBrush AS LONG
  LOCAL hPenOld AS LONG
  LOCAL hBrushOld AS LONG

  LOCAL i AS LONG
  LOCAL xRes AS LONG
  LOCAL yRes AS LONG
  LOCAL xOffset AS LONG
  LOCAL yOffset AS LONG
  LOCAL xAdjSize AS LONG
  LOCAL yAdjSize AS LONG
  LOCAL radius AS LONG

  xAdjSize = xSize * .8
  yAdjSize = ySize * .8
  xOffset = (xSize - xAdjSize) / 2
  yOffset = (ySize - yAdjSize) / 2

  hBrush = CreateSolidBrush(BackgroundColor) ' create this brush
  hBrushOld = SelectObject(hDC, hBrush) ' select brush (use this color for now) and save old one
  Rectangle hDC, 0, 0, xSize, ySize ' clear and outline the client area

  SetTextColor hDC, TextColor  ' set text color

  hPen = CreatePen (%PS_SOLID, 0, GridColor) ' create a pen
  hPenOld = SelectObject(hDC, hPen) ' select pen (use this color for now) and save old one

  FOR i = 0 TO valueMax  ' draw value lines
    MoveTo hDC, xOffset, yOffset + yAdjSize - ((yAdjSize / (valueMax + 1)) * i)
    LineTO hDC, xAdjSize + xOffset, yOffset + yAdjSize - ((yAdjSize / (valueMax + 1)) * i)
    SetTextAlign hDC, %TA_BASELINE OR %TA_RIGHT  ' set text parameters
    SetBkMode hDC, %TRANSPARENT
    TextOut hDC, xOffset - (xAdjSize / 50), yOffset + yAdjSize - ((yAdjSize / (valueMax + 1)) * i), STR$(i), LEN(STR$(i))  ' value
  NEXT i

  hPen = CreatePen (%PS_SOLID, 0, LineColor) ' create a pen
  hPenOld = SelectObject(hDC, hPen) ' select pen (use this color for now) and save old one

  FOR i = 0 TO numpoints - 1  ' draw points
    graph(i).x = (i * xAdjSize / (numpoints - 1)) + xOffset
    graph(i).y = yOffset + yAdjSize - ((yAdjSize / (valueMax + 1)) * value(i))
    SetPixel(hDC, graph(i).x, graph(i).y, RGB(0,255,0))
  NEXT i

  POLYLINE hDC, graph(0), numpoints ' draw graph between points

  hPen = CreatePen (%PS_SOLID, 0, GridColor) ' create a pen
  hPenOld = SelectObject(hDC, hPen) ' select pen (use this color for now) and save old one
  hBrush = CreateSolidBrush(LineColor) ' create this brush
  hBrushOld = SelectObject(hDC, hBrush) ' select brush (use this color for now) and save old one

  radius = (xAdjSize / 250) + (yAdjSize / 200) ' base radius of circles on some dimensions
    FOR i = 0 TO numpoints - 1  ' draw circles at data points
    graph(i).x = (i * xAdjSize \ (numpoints - 1)) + xOffset
    ELLIPSE hDC,graph(i).x - radius, graph(i).y - radius,graph(i).x + radius, graph(i).y + radius
  NEXT i

  SetTextAlign hDC, %TA_BASELINE OR %TA_CENTER  ' set text parameters
  SetBkMode hDC, %TRANSPARENT
  TextOut hDC, xSize / 2, ySize - (ySize / 50), title + CHR$(0), LEN(title)

  SelectObject hDC, hPenOld  ' select oldest pen
  DeleteObject hPen  ' delete the pen
  SelectObject hDC, hBrushOld  ' select oldest brush
  DeleteObject hBrush  ' delete the brush

END FUNCTION