Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Enhanced metafile graphics and trackbar demonstration program

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Enhanced metafile graphics and trackbar demonstration program

    the program has been re-updated june 24th, 2002. see the last post
    in this thread.
    the program now runs with both bp win 6 and 7.

    comments are in this thread:
    http://www.powerbasic.com/support/pb...ead.php?t=5995

    regards,

    erik


    [this message has been edited by erik christensen (edited june 24, 2002).]

  • #2
    Erik,

    Your code works quite nicely. Quite impressed.

    One thing that I was wondering about is about the best way
    to place the metafile (image) onto the clipboard.
    That way I could generate drawings from my PB program,
    save them on the clipboard and then paste into MSWord, etc.

    Any pointers or ideas?

    Thanks, Mik.

    ------------------
    Ozzie in Ottawa

    Comment


    • #3
      Mik, the Source Code Forum should not be used to ask questions or discussions - please repost your question in a more appropriate forum (ie, PB for Windows) and include a URL link to this topic.

      Thank you.


      ------------------
      Lance
      PowerBASIC Support
      mailto:support@powerbasic.comsupport@powerbasic.com</A>
      Lance
      mailto:lanceedmonds@xtra.co.nz

      Comment


      • #4
        ' Enhanced metafile graphics and trackbar demonstration program.
        '
        ' Re-adjusted version June 24, 2002.
        '
        ' Runs now both with PB Win 6 and 7 ("Font" was changed to "Fontt"
        ' to avoid conflict with the new DIALOG FONT statement.)
        '
        ' Enhanced metafiles are graphics files made up of drawing instructions
        ' - not bits. They may be much smaller than bit-based graphics files.
        ' Once designed, the enhanced metafiles can be drawn in any size and
        ' aspect with maximum resolution on any screen. Furthermore, the
        ' drawing instructions in enhanced metafiles may be edited to modify
        ' the result. An enhanced metafile inserted into a word-processing
        ' document in WORD may be edited simply by using the mouse and the
        ' keyboard. These features make enhanced metafiles very interesting.
        '
        ' This program makes an enhanced metafile and illustrates some of the fea-
        ' tures. The program can open and save enhanced metafiles and display them in
        ' any size and aspect using trackbars as scalers. Saved enhanced metafiles
        ' can be inserted in your word-processing documents. Once inserted you
        ' should try to edit them to see the possibilities (double click on the
        ' diagram and see what happens).
        '
        ' April 9th: Any creation of pens, brushes and fonts is avoided in the
        ' creation of the metafile. Pens, brushes and fonts are created before the
        ' metafile creation. During the metafile creation the pens, brushes and
        ' fonts are just selected. I think this detail may be important to have the
        ' metafile working properly in other programs including Word (avoidance of
        ' overflow problems).
        '
        ' Best wishes
        '
        ' Erik Christensen ---- e.chr@email.dk
        Code:
        #COMPILE EXE
        #REGISTER NONE
        #DIM ALL
        '
        %NOANIMATE       = 1  ' Animate control.
        %NOBUTTON        = 1
        %NOCOMBO         = 1
        %NODATETIMEPICK  = 1
        %NODRAGLIST      = 1  ' APIs to make a listbox source and sink drag&drop actions.
        %NOEDIT          = 1
        %NOFLATSBAPIS    = 1
        %NOHEADER        = 1  ' Header bar control.
        %NOHOTKEY        = 1  ' HotKey control.
        %NOIMAGELIST     = 1  ' ImageList apis.
        %NOIPADDRESS     = 1
        %NOLIST          = 1
        %NOLISTVIEW      = 1  ' ListView control.
        %NOMENUHELP      = 1  ' APIs to help manage menus, especially with a status bar.
        %NOMONTHCAL      = 1
        %NOMUI           = 1
        %NONATIVEFONTCTL = 1
        %NOPAGESCROLLER  = 1
        %NOPROGRESS      = 1  ' Progress gas gauge.
        %NOREBAR         = 1
        %NOSTATUSBAR     = 1  ' Status bar control.
        %NOTABCONTROL    = 1
        %NOTOOLBAR       = 1  ' Customizable bitmap-button toolbar control.
        %NOTOOLTIPS      = 1
        '   %NOTRACKBAR      = 1  ' Customizable column-width tracking control.
        %NOTREEVIEW      = 1  ' TreeView control.
        %NOUPDOWN        = 1  ' Up and Down arrow increment/decrement control.
        '
        #INCLUDE "win32api.inc"   ' Must come first before other include files !
        #INCLUDE "commctrl.inc"   ' The Common Controls include file !
        #INCLUDE "COMDLG32.INC"
        '
        ' ----------------------------------------------------------
        %Form1_FILE                                     = 500
        ' ----------------------------------------------------------
        %Form1_DEFAULT                                  = 505
        %Form1_OPENFILE                                 = 510
        %Form1_SAVEAS                                   = 515
        %Form1_SEPARATOR_520                            = 520
        %Form1_SAVE_CUR_GRAPH                           = 522
        %Form1_SEPARATOR_524                            = 524
        %Form1_EXIT                                     = 525
        
        ' ----------------------------------------------------------
        %Form1_EDIT                                     = 600
        ' ----------------------------------------------------------
        %Form1_HELP                                     = 700
        ' ----------------------------------------------------------
        %Form1_HELP1                                    = 705
        %Form1_ABOUT                                    = 710
        %FORM1_LABELRESULTS       = 100
        %FORM1_LABELFORGRAPH      = 102
        %FORM1_GRAPHLABEL         = 105
        %FORM1_HOR_TRACKBAR       = 106
        %FORM1_VER_TRACKBAR       = 107
        
        ' --------------------------------------------------
        DECLARE SUB ShowDialog_Form1(BYVAL hParent&)
        DECLARE CALLBACK FUNCTION Form1_DLGPROC
        DECLARE SUB Form1_HELP1_Select()
        DECLARE SUB Form1_ABOUT_Select()
        DECLARE FUNCTION MakeFont(BYVAL FontTypeSize AS LONG,BYVAL FontWeight AS LONG, _
            BYVAL Italic AS LONG, BYVAL Underline AS LONG,BYVAL StrikeOut AS LONG, _
            BYVAL FaceName AS STRING) AS LONG
        DECLARE FUNCTION FilNameOpen() AS LONG
        DECLARE FUNCTION FilNameSaveEMF() AS LONG
        DECLARE FUNCTION FilePath(BYVAL Src AS STRING) AS STRING
        DECLARE FUNCTION FileNam(BYVAL Src AS STRING) AS STRING
        DECLARE FUNCTION gColor(BYVAL I AS LONG) AS LONG
        DECLARE FUNCTION PenStyle(BYVAL I AS LONG) AS LONG
        
        ' *************************************************************
        GLOBAL hForm1&    ' Dialog handle
        ' Global Handles for menus
        GLOBAL hForm1_Menu0&
        GLOBAL hForm1_Menu1&
        GLOBAL hForm1_Menu3&
        GLOBAL hGraph AS LONG
        GLOBAL hTrackBarH AS LONG, hTrackBarV AS LONG
        '
        GLOBAL PAFUemf AS ASCIIZ * %MAX_PATH  ' path and file for enhanced metafile format graph
        GLOBAL lfFont AS lOGFONT  ' Logfont structure
        GLOBAL LogPixelsY AS LONG ' pixels per inch of screen height
        GLOBAL LogPixelsX AS LONG ' pixels per inch of screen width
        GLOBAL XDialUn&,YDialUn&
        GLOBAL Rct AS RECT
        GLOBAL Ps AS PAINTSTRUCT  ' Paint structure
        GLOBAL Xfact AS SINGLE, Yfact AS SINGLE
        GLOBAL H_Pos AS LONG, V_Pos AS LONG
        GLOBAL X1&,Y1&
        GLOBAL hPen() AS LONG
        GLOBAL hBrush() AS LONG
        GLOBAL Fontt AS LONG
        '
        ' *************************************************************
        '
        FUNCTION PBMAIN
            LOCAL Count&,Res&,I&
            LOCAL hDC AS LONG
            LOCAL hemf AS LONG
            LOCAL hdcEMF AS LONG
            LOCAL CC1 AS INIT_COMMON_CONTROLSEX
            CC1.dwSize=SIZEOF(CC1)
            CC1.dwICC=%ICC_WIN95_CLASSES
            InitCommonControlsEX CC1
            'Retrieves a handle of a display device context (DC) for the
            'client area of the specified window (here the desktop).
            hDC = GetDC(%HWND_DESKTOP)
            '
            'Retrieves device-specific information about the number
            'of pixels per logical inch along the screen height
            '(depends on screen resolution setting).
            'This is important to define appropriate font sizes.
            LogPixelsY  = GetDeviceCaps(hDC, %LOGPIXELSY)
            LogPixelsX  = GetDeviceCaps(hDC, %LOGPIXELSX)
            '
            ReleaseDC %HWND_DESKTOP, hDC
            ShowDialog_Form1 0
            REDIM hPen(10): REDIM hBrush(5)
            hDC = GetDC(hGraph)
            FOR I& = 0 TO 5
                ' CreatePen(PenStyle,PenWidth,PenColor)
                ' PenWidth is in logical units, but zero always corresponds to 1 pixel.
                hPen(I&) = CreatePen (PenStyle(I&), 0, gColor(I&))
                hBrush(I&) = CreateSolidBrush (gColor(I))
            NEXT
            FOR I& = 6 TO 10
                hPen(I&) = CreatePen (0, 0, gColor(I&-5))
            NEXT
        
            ' sizes between 8 and 10 are most suitable here
            Fontt = MakeFont(9,400,0,0,0,"Arial")
            '
            ShowWindow hGraph,%SW_HIDE ' hide graph area temporarily
            ' set co-ordinates for graphics label window rectangle
            GetClientRect hGraph,Rct
            ' SPECIFY RECTANCLE IN 0.01 MM UNITS FOR CREATION OF METAFILE:
            'Rct.nLeft = 0
            'Rct.nTop  = 0
            Rct.nRight = ROUND(Rct.nRight*2.54*1000/LogPixelsX,0)
            Rct.nBottom = ROUND(Rct.nBottom*2.54*1000/LogPixelsY,0)
            hdcEMF = CreateEnhMetafile (BYVAL %NULL, BYVAL %NULL, Rct, BYVAL %NULL)
            ' For making of graph, use the graph label window dimensions in pixels.
            GetClientRect hGraph,Rct
            CALL MakeGraph(hdcEMF) ' Design graph to be displayed
            hemf = CloseEnhMetafile (BYVAL hdcEMF) ' Done: get handle to enhanced metafile
            IF FilNameSaveEMF() THEN
                Res& = CopyEnhMetaFile(BYVAL hemf,PAFUemf) ' save to disk
            END IF
            Res& = DeleteEnhMetaFile (BYVAL hemf)
            ShowWindow hGraph,%SW_SHOW ' show graph area
            DO
                DIALOG DOEVENTS TO Count&
            LOOP UNTIL Count&=0
            '
            ' Delete pens, brushes and font
            FOR I& = 0 TO 10
                IF I& < 6 THEN DeleteObject hBrush(I&)
                DeleteObject hPen(I&)
            NEXT
            DeleteObject Fontt
        END FUNCTION
        '
        ' *************************************************************
        SUB ShowDialog_Form1(BYVAL hParent&)
            LOCAL Style&, ExStyle& ,hCtl&
            LOCAL LabelStyle2&
            ' hParent& = 0 if no parent Dialog
            Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER OR %WS_CLIPCHILDREN
            ' NB: the clipchildren style must be included
            ExStyle& = 0
            XDialUn&=392 :YDialUn&=260
            DIALOG NEW hParent&, "Enhanced Metafiles Graphics demonstration", 0, 0,XDialUn&,YDialUn&, Style&, ExStyle& TO hForm1&
            LabelStyle2& = %WS_CHILD OR %WS_VISIBLE OR %SS_GRAYFRAME OR %SS_LEFT
            ' NB: The grayframe style must be included
            CONTROL ADD LABEL, hForm1&, %FORM1_GRAPHLABEL, "",19,19, 47+5*31.4, 32+5*18.55, LabelStyle2&
            CONTROL HANDLE hForm1&, %FORM1_GRAPHLABEL TO hGraph ' handle for graphics window
            CONTROL ADD "msctls_trackbar32",hForm1&, %FORM1_HOR_TRACKBAR, "", _
                60,5,325,12 ,%TBS_AUTOTICKS OR _ '%TBS_TOOLTIPS OR _
                %TBS_HORZ OR %TBS_BOTTOM OR %WS_VISIBLE OR %WS_CHILD OR %WS_TABSTOP,%WS_EX_CLIENTEDGE
            CONTROL SEND hForm1&, %FORM1_HOR_TRACKBAR,%TBM_SETRANGE,1, MAKLNG(0,10)
            CONTROL SEND hForm1&, %FORM1_HOR_TRACKBAR,%TBM_SETPOS,1,5 :H_Pos = 5
            CONTROL HANDLE hForm1&, %FORM1_HOR_TRACKBAR TO hTrackBarH
        
            CONTROL ADD "msctls_trackbar32",hForm1&, %FORM1_VER_TRACKBAR, "", _
                5,45,12,197,%TBS_AUTOTICKS OR _ '%TBS_TOOLTIPS OR _
                %TBS_VERT OR %TBS_RIGHT OR %WS_VISIBLE OR %WS_CHILD OR %WS_TABSTOP,%WS_EX_CLIENTEDGE
            CONTROL SEND hForm1&, %FORM1_VER_TRACKBAR,%TBM_SETRANGE,1, MAKLNG(0,10)
            CONTROL SEND hForm1&, %FORM1_VER_TRACKBAR,%TBM_SETPOS,1,5 : V_Pos = 5
            CONTROL HANDLE hForm1&, %FORM1_VER_TRACKBAR TO hTrackBarV
            ' ---------------------------
            MENU NEW BAR TO hForm1_Menu0&
            ' ---------------------------
            MENU NEW POPUP TO hForm1_Menu1&
            MENU ADD POPUP, hForm1_Menu0& ,"&File", hForm1_Menu1&, %MF_ENABLED
            ' - - - - - - - - - - - - - -
            MENU ADD STRING, hForm1_Menu1&, "&Open Enhanced Metafile", %Form1_OPENFILE, %MF_ENABLED
            MENU ADD STRING, hForm1_Menu1&, "Save Enhanced Metafile &As", %Form1_SAVE_CUR_GRAPH, %MF_ENABLED
            MENU ADD STRING, hForm1_Menu1&, "E&xit",  %Form1_EXIT, %MF_ENABLED
            '
            MENU NEW POPUP TO hForm1_Menu3&
            MENU ADD POPUP, hForm1_Menu0& ,"&Help", hForm1_Menu3&, %MF_ENABLED
            ' - - - - - - - - - - - - - -
            MENU ADD STRING, hForm1_Menu3&, "&Description of program",  %Form1_HELP1, %MF_ENABLED
            MENU ADD STRING, hForm1_Menu3&, "&About",  %Form1_ABOUT, %MF_ENABLED
            MENU ATTACH hForm1_Menu0&, hForm1&
            DIALOG SHOW MODELESS hForm1& , CALL Form1_DLGPROC
        END SUB
        ' ---------------------------------------------------------
        CALLBACK FUNCTION Form1_DLGPROC
            LOCAL hemf AS LONG
            LOCAL hdcEMF AS LONG
            LOCAL hDC AS LONG
            LOCAL Res AS LONG
            STATIC V_Prev AS LONG, H_Prev AS LONG
            SELECT CASE CBMSG
                CASE %WM_PAINT
                    BeginPaint CBHNDL, Ps
                    hemf = GetEnhMetafile(PAFUemf)
                    GetClientRect hGraph,Rct
                    hDC = GetDC(hGraph)
                    CALL PlayEnhMetafile (BYVAL hDC, BYVAL hemf, Rct)
                    EndPaint CBHNDL, Ps
                    Res& = DeleteEnhMetaFile(BYVAL hemf)
                    ReleaseDC hGraph, hDC
                    FUNCTION = 1
                    '
                CASE %WM_HSCROLL
                    IF CBLPARAM = hTrackBarH THEN
                        ' Horizontal track bar has been moved.
                        ' No elaborate functioning is necessary.
                        SELECT CASE LOWRD(CBWPARAM)
                            CASE %TB_TOP,%TB_BOTTOM,%TB_PAGEUP,%TB_LINEUP,%TB_PAGEDOWN,%TB_LINEDOWN,%TB_THUMBPOSITION,%TB_THUMBTRACK
                                CONTROL SEND hForm1&,%FORM1_HOR_TRACKBAR,%TBM_GETPOS,0,0 TO H_Pos
                        END SELECT
                        IF H_Pos<>H_Prev THEN
                            CONTROL SET SIZE hForm1&, %FORM1_GRAPHLABEL,47+H_Pos*31.4, 32+V_Pos*18.55
                            res&=InvalidateRect(hForm1&,BYVAL %NULL,%TRUE)
                            H_Prev=H_Pos
                        END IF
                    END IF
                    FUNCTION = 1
                    '
                CASE %WM_VSCROLL
                    IF CBLPARAM = hTrackBarV THEN
                        ' Vertical track bar has been moved.
                        ' No elaborate functioning is necessary.
                        SELECT CASE LOWRD(CBWPARAM)
                            CASE %TB_TOP,%TB_BOTTOM,%TB_PAGEUP,%TB_LINEUP,%TB_PAGEDOWN,%TB_LINEDOWN,%TB_THUMBPOSITION,%TB_THUMBTRACK
                                CONTROL SEND hForm1&, %FORM1_VER_TRACKBAR,%TBM_GETPOS,0,0 TO V_Pos
                        END SELECT
                        IF V_Pos<>V_Prev THEN
                            CONTROL SET SIZE hForm1&, %FORM1_GRAPHLABEL,47+H_Pos*31.4, 32+V_Pos*18.55
                            res&=InvalidateRect(hForm1&,BYVAL %NULL,%TRUE)
                            V_Prev=V_Pos
                        END IF
                    END IF
                    FUNCTION = 1
                    '
                CASE %WM_COMMAND
                    ' Process Messages to Controls that have no Callback Function
                    ' and Process Messages to Menu Items
                    SELECT CASE CBCTL
                        CASE  %Form1_OPENFILE
                            IF FilNameOpen() THEN Res&=InvalidateRect(hForm1&,BYVAL %NULL,%TRUE)
                        CASE  %Form1_SAVE_CUR_GRAPH
                            hemf = GetEnhMetafile(PAFUemf)
                            IF FilNameSaveEMF() THEN
                                Res& = CopyEnhMetaFile(BYVAL hemf,PAFUemf)
                                Res& = InvalidateRect(hForm1&,BYVAL %NULL,%TRUE)
                            END IF
                        CASE  %Form1_EXIT
                            res&=MSGBOX ("Are you sure?",%MB_YESNO OR %MB_ICONQUESTION ,"End?")
                            IF res&=%IDYES THEN DIALOG END hForm1&
                        CASE  %Form1_HELP1
                            Form1_HELP1_Select
                        CASE %Form1_ABOUT
                            Form1_ABOUT_Select
                        CASE ELSE
                    END SELECT
                CASE ELSE
            END SELECT
        END FUNCTION
        ' ------------------------------------------------
        SUB MakeGraph(BYVAL hDC AS LONG)
            DIM DA(10) AS SINGLE
            DIM gText(10) AS ASCIIZ * 200
            LOCAL gTex AS ASCIIZ * 200
            LOCAL I AS LONG
            LOCAL TOTAL AS SINGLE
            LOCAL CUMUL AS SINGLE
            LOCAL pi2 AS SINGLE
            LOCAL pct AS LONG, Radius AS LONG
            LOCAL recstart AS LONG
            LOCAL xLeft AS LONG, yTop AS LONG, xRight AS LONG, yBottom AS LONG
            LOCAL xStart AS LONG, yStart AS LONG, xEnd AS LONG, yEnd AS LONG
            LOCAL xText AS LONG, yText AS LONG, korr AS LONG
            X1&=Rct.nRight
            Y1&=Rct.nBottom
        
            FillRect hDC, Rct, GetStockObject(%WHITE_BRUSH)
        
            ' Make frame to illustrate line-drawing
            FOR I=3 TO 15 STEP 3
              SelectObject hDC, hPen(I/3-1)
              MoveToEx hDC, I,I, BYVAL %NULL
              LineTo hDC, X1&-I,I
              LineTo hDC, X1&-I,Y1&-I
              LineTo hDC, I,Y1&-I
              LineTo hDC, I,I
            NEXT
        
            Radius = Y1&/3.6
        
            xLeft  = X1&/2 - Radius : xRight =  X1&/2 + Radius
            yTop   = Y1&/2 - Radius : yBottom = Y1&/2 + Radius
        
            DATA Andersen, Kierkegaard, Bohr, Borge, Hein
            ' these names are quite arbitrary
            FOR I=1 TO 5
               gText(I)=READ$(I)
            NEXT
        
            DATA 5.6,  7.2,  5.2,  3.3,  8.9
            ' these numbers are arbitrary without any relation to the names above
            TOTAL=0
        
            FOR I=1 TO 5
              DA(I) = VAL(READ$(I+5))
              TOTAL = TOTAL + DA(I)
            NEXT
        
            SelectObject hDC, Fontt
        
            pi2=8*ATN(1)
            CUMUL=0
            korr=-11 ' empiric correction for height of characters. This may be improved.
            FOR I=1 TO 5
              CUMUL = CUMUL + DA(I)
              pct=INT(100*DA(I)/TOTAL+0.5)
              xText = INT(X1&/2+(Radius-korr)*COS(pi2 * (CUMUL - DA(I)/2) / TOTAL)+0.5)
              yText = INT(Y1&/2-(Radius-korr)*SIN(pi2 * (CUMUL - DA(I)/2) / TOTAL)+0.5)
              IF COS(pi2 * (CUMUL - DA(I)/2) / TOTAL) >= 0 THEN
                SetTextAlign hDC,%TA_LEFT ' text on right side of diagram
              ELSE
                SetTextAlign hDC,%TA_RIGHT ' text on left side of diagram
              END IF
              gTex=gText(I)+" ("+LTRIM$(STR$(pct))+"%)"
              TextOut hDC, xText, yText+korr, gTex, BYVAL LEN(gTex)
            NEXT
        
            xStart=X1&/2+Radius: yStart=Y1&/2 ' select starting point for pie pieces
            CUMUL=0
        
            FOR I=1 TO 5
              CUMUL = CUMUL + DA(I)
              xEnd  = INT(X1&/2+Radius*COS(pi2 * CUMUL / TOTAL)+0.5)
              yEnd  = INT(Y1&/2-Radius*SIN(pi2 * CUMUL / TOTAL)+0.5)
              SelectObject hDC, hBrush(I)
              SelectObject hDC, hPen(I+5)
              Pie hDC, xLeft,yTop,xRight,yBottom, xStart, yStart, xEnd, yEnd
              xStart=xEnd: yStart=yEnd
            NEXT
        
        'These are other graphic features you may want to use in your application:
        'RoundRect hDC, xLeft,yTop,xRight,yBottom, xCornerEllipse, yCornerEllipse
        'Arc hDC, xLeft,yTop,xRight,yBottom, xStart, yStart, xEnd, yEnd
        'Chord hDC, xLeft,yTop,xRight,yBottom, xStart, yStart, xEnd, yEnd
        
        END SUB
        ' ------------------------------------------------
        SUB Form1_HELP1_Select()
            LOCAL St AS STRING
            St ="Enhanced metafile graphics and trackbar demonstration program."+$CRLF+$CRLF+ _
            "Enhanced metafiles are graphics files made up of drawing instructions "+ _
            "- not bits. They may be much smaller than bit-based graphics files. "+ _
            "Once designed, the enhanced metafiles can be drawn in any size and "+ _
            "aspect with maximum resolution on any screen. Furthermore, the "+ _
            "drawing instructions in enhanced metafiles may be edited to modify "+ _
            "the result. An enhanced metafile inserted into a word-processing "+ _
            "document in WORD may be edited simply by using the mouse and the "+ _
            "keyboard. These features make enhanced metafiles very interesting. "+$CRLF+$CRLF+ _
            "This program makes an enhanced metafile and illustrates some of the features. The "+ _
            "program can open and save enhanced metafiles and display them in any "+ _
            "size and aspect using trackbars as scalers. Saved enhanced metafiles "+ _
            "can be inserted in your word-processing documents. Once inserted you "+ _
            "should try to edit them to see the possibilities (double click on the "+ _
            "diagram and see what happens)."+$CRLF+$CRLF+ _
            "Best wishes"+$CRLF+$CRLF+ _
            "Erik Christensen ---- e.chr@email.dk"
            MSGBOX St,%MB_ICONINFORMATION,"Information"
        END SUB
        ' ------------------------------------------------
        SUB Form1_ABOUT_Select
            LOCAL St AS STRING
            St="Enhanced metafiles and trackbar demonstration program (version 1.2, June 24, 2002)"+$CRLF+$CRLF+ _
            "By Erik Christensen, Copenhagen, Denmark       e.chr@email.dk"+$CRLF+$CRLF+ _
            "The use of this Public Domain program and its consequences are your own responsibility. However, any comment you may have is welcome."+$CRLF+$CRLF+ _
            "Good Luck!"
            MSGBOX St,%MB_ICONINFORMATION,"About this program"
        END SUB
        ' ------------------------------------------------
        FUNCTION MakeFont(BYVAL FontTypeSize AS LONG,BYVAL FontWeight AS LONG, _
            BYVAL Italic AS LONG, BYVAL Underline AS LONG,BYVAL StrikeOut AS LONG, _
            BYVAL FaceName AS STRING) AS LONG
        ' -----------------------
            'TYPE LOGFONT defines the attributes of a font.
            'See LOGFONT in the Win32 help file
            lfFont.lfHeight = -MulDiv(FontTypeSize,LogPixelsY,72) ' better than: -(FontTypeSize * LogPixelsY) \ 72
                                                    ' logical height of font
            lfFont.lfWidth = 0                      ' logical average character width
            lfFont.lfEscapement = 0                 ' angle of escapement
            lfFont.lfOrientation = 0                ' base-line orientation angle
            lfFont.lfWeight = FontWeight            ' font weight
            lfFont.lfItalic = Italic                ' italic attribute flag    (0,1)
            lfFont.lfUnderline = Underline          ' underline attribute flag (0,1)
            lfFont.lfStrikeOut = StrikeOut          ' strikeout attribute flag (0,1)
            lfFont.lfCharSet = %ANSI_CHARSET        ' character set identifier
            lfFont.lfOutPrecision = %OUT_TT_PRECIS  ' output precision
            lfFont.lfClipPrecision = %CLIP_DEFAULT_PRECIS  ' clipping precision
            lfFont.lfQuality = %DEFAULT_QUALITY     ' output quality
            lfFont.lfPitchAndFamily = %FF_DONTCARE  ' pitch and family
            lfFont.lfFaceName = FaceName            ' typeface name string
        ' -----------------------
            ' Make font according to specifications
            FUNCTION = CreateFontIndirect (lfFont)
        END FUNCTION
        ' ------------------------------------------------
        FUNCTION FilNameSaveEMF() AS LONG
           LOCAL Path   AS STRING
           LOCAL f      AS STRING
           LOCAL Style  AS DWORD
           LOCAL curPath   AS ASCIIZ * %MAX_PATH
           ' Get path to where this program is located (proposed by Borje Hagsten):
           GetModuleFileName GetModuleHandle(""), curPath, SIZEOF(curPath)
           '
           Path = FilePath(curPath)
           f=FileNam(PAFUemf)
           Style = %OFN_HIDEREADONLY OR %OFN_LONGNAMES
           IF SaveFileDialog(0, "Provide File Name For Saving Of Enhanced Metafile", f, Path, _
               "Enhanced Metafiles|*.emf|All Files|*.*", "emf", Style) THEN
               PAFUemf=f
               FUNCTION = 1
           END IF
        END FUNCTION
        ' ------------------------------------------------
        FUNCTION FilNameOpen() AS LONG
           LOCAL Path   AS STRING
           LOCAL f      AS STRING
           LOCAL Style  AS DWORD
           Path = FilePath(PAFUemf)
           f = FileNam(PAFUemf)
           Style    = %OFN_FILEMUSTEXIST OR %OFN_HIDEREADONLY OR %OFN_LONGNAMES
           IF OpenFileDialog(0, "Open Enhanced Metafile", f, Path, _
             "Enhanced Metafiles|*.emf|All Files|*.*", "emf", Style) THEN
              PAFUemf=f
              FUNCTION = 1
           END IF
        END FUNCTION
        ' ------------------------------------------------
        FUNCTION FileNam(BYVAL Src AS STRING) AS STRING
          LOCAL x AS LONG
          FOR x = LEN(Src) TO 1 STEP -1
            IF (ASC(Src, x) = 92) OR (ASC(Src, x) = 58) THEN EXIT FOR
          NEXT x
          FUNCTION = MID$(Src, x + 1)
        END FUNCTION
        ' ------------------------------------------------
        FUNCTION FilePath(BYVAL Src AS STRING) AS STRING
          LOCAL x AS LONG
          FOR x = LEN(Src) TO 1 STEP -1
            IF (ASC(Src, x) = 92) OR (ASC(Src, x) = 58) THEN EXIT FOR
          NEXT x
          FUNCTION = LEFT$(Src, x)
        END FUNCTION
        ' ------------------------------------------------
        FUNCTION gColor(BYVAL I AS LONG) AS LONG
          SELECT CASE I
            ' Common RGB Colors:
            CASE 0 : FUNCTION = &H000000???  '%Black - same as RGB(0,0,0)
            CASE 1 : FUNCTION = &HFF0000???  '%Blue
            CASE 2 : FUNCTION = &H00FF00???  '%Green
            CASE 3 : FUNCTION = &HFFFF00???  '%Cyan
            CASE 4 : FUNCTION = &H0000FF???  '%Red
            CASE 5 : FUNCTION = &HFF00FF???  '%Magenta
            CASE 6 : FUNCTION = &H00FFFF???  '%Yellow
            CASE 7 : FUNCTION = &HFFFFFF???  '%White - same as RGB(255,255,255)
            CASE 8 : FUNCTION = &H808080???  '%Gray
            CASE 9 : FUNCTION = &HC0C0C0???  '%LtGray
            ' Additional colors can be added e.g. using the RGB function,
            ' e.g. CASE 10: FUNCTION = RGB(164,164,164)
            ' and so on.
            CASE ELSE : FUNCTION = &H000000???  '%Black
          END SELECT
        END FUNCTION
        ' ------------------------------------------------
        FUNCTION PenStyle(BYVAL I AS LONG) AS LONG
          SELECT CASE I
            CASE 0 :   FUNCTION = %PS_SOLID       '  _______
            CASE 1 :   FUNCTION = %PS_DASH        '  -------
            CASE 2 :   FUNCTION = %PS_DOT         '  .......
            CASE 3 :   FUNCTION = %PS_DASHDOT     '  _._._._
            CASE 4 :   FUNCTION = %PS_DASHDOTDOT  '  _.._.._
            CASE ELSE: FUNCTION = %PS_SOLID
          END SELECT
        END FUNCTION


        [This message has been edited by Erik Christensen (edited June 24, 2002).]

        Comment

        Working...
        X