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

Cryptic graphics message

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

  • Cryptic graphics message

    See new code below.

    [This message has been edited by Erik Christensen (edited December 24, 2005).]

  • #2
    -


    [This message has been edited by Erik Christensen (edited December 24, 2005).]

    Comment


    • #3
      ' Cryptic graphics message. New version.
      '
      ' Best Regards,
      '
      ' Erik ----------- 24th December, 2005
      Code:
      #COMPILE EXE
      #REGISTER NONE
      #DIM ALL
      #INCLUDE "win32api.inc"
      '
      FUNCTION RainbowColor(BYVAL i AS LONG) AS LONG
          LOCAL Red&,Green&,Blue&
          SELECT CASE i& 'i& can vary between 0 and 359 (full circle)
              CASE 0 TO 59
                  Red&=(i& MOD 60)*4.25       ' increasing red
                  Green&=255                  ' maximum green
                  Blue&=0                     ' no blue
              CASE 60 TO 119
                  Red&=255                    ' maximum red
                  Green&=255-(i& MOD 60)*4.25 ' decreasing green
                  Blue&=0                     ' no blue
              CASE 120 TO 179
                  Red&=255                    ' maximum red
                  Green&=0                    ' no green
                  Blue&=(i& MOD 60)*4.25      ' increasing blue
              CASE 180 TO 239
                  Red&=255-(i& MOD 60)*4.25   ' decreasing red
                  Green&=0                    ' no green
                  Blue&= 255                  ' maximum blue
              CASE 240 TO 299
                  Red&=0                      ' no red
                  Green&=(i& MOD 60)*4.25     ' increasing green
                  Blue& = 255                 ' maximum blue
              CASE 300 TO 359
                  Red&=0                      ' no red
                  Green&=255                  ' maximum green
                  Blue&=255-(i& MOD 60)*4.25  ' decreasing blue
              CASE ELSE
          END SELECT
          FUNCTION = RGB(Red,Green,Blue)
      END FUNCTION
      '
      CALLBACK FUNCTION DialCallBack
          STATIC hDC&,Rc AS RECT,i&,hPen&,k&,j&,m1&,a$,x&,LogPixelsY&,FH&,FontTypeSize&,m&,h$
          STATIC Ps AS PAINTSTRUCT,N&,N4&,N05&,sy&,hBrush&,MaxX&,MaxY&
          STATIC Xmax&,Xmin&,Ymax&,Ymin&,Xstep&,Ystep&,Xmid&,Ymid&,XCur&
          STATIC X() AS LONG, Y() AS LONG
          STATIC Colour() AS LONG
          STATIC Pnt AS POINTAPI
          GLOBAL memDC1&, memDC2&, hBit&, hBit2&
          LOCAL st&,Fak!,Fak2&, dimi&
          GLOBAL fo&
          STATIC lpSize AS SIZEL : DIM lpsz AS STATIC ASCIIZ * 2400
          STATIC tm AS TEXTMETRIC
      
          SELECT CASE CBMSG
              CASE %WM_INITDIALOG
                  MaxX& = GetSystemMetrics(%SM_CXSCREEN)
                  MaxY& = GetSystemMetrics(%SM_CYSCREEN)
                  a$=""
                  h$="d…2Q‚Œ…ƒ‚„t‚>|q<Ws‡Š<epƒ9cz„5‹~+‘„y-d’„^q‡}p0_…ˆ†{ƒ‘Š"
                  RANDOMIZE 1.1
                  FOR i = 1 TO LEN(h$)
                      a$=a$+CHR$(ASC(MID$(h$,i,1))-RND(10, 30))
                  NEXT
                  DIM sx(1 TO LEN(a$)+1) AS STATIC LONG
                  REDIM Colour(1 TO 12) : j = 0
                  FOR i=0 TO 359 STEP 30 : INCR j: Colour(j) = RainbowColor(i) : NEXT
                  hDC = GetDC(%HWND_DESKTOP)
                  SetMapMode hDC, %MM_TEXT
                  LogPixelsY  = GetDeviceCaps(hDC, %LOGPIXELSY)
                  ReleaseDC %HWND_DESKTOP, hDC
                  GetClientRect CBHNDL,Rc : FontTypeSize = 24
                  NewFontSize:
                  FH = -MulDiv(FontTypeSize,LogPixelsY, 72)
                  fo = CreateFont(FH,0,0,0,700,0,0,0,0,3,2,1,82,"Edwardian Script ITC") '"Arial")
                  hDC = GetDC(CBHNDL)
                  SelectObject hDC, fo
                  lpsz = a$ : GetTextExtentPoint32 hDC,lpsz,LEN(lpsz),lpSize
                  ReleaseDC CBHNDL, hDC : k = (Rc.nRight - lpSize.cx) \ 2
                  IF k < 0 THEN DECR FontTypeSize : GOTO NewFontSize
                  '
                  hDC = GetDC(CBHNDL)
                  SelectObject hDC, fo : sx(1) = k
                  GetTextMetrics hDC,tm : sy& = (Rc.nBottom - tm.tmHeight - tm.tmExternalLeading) \ 2
                  FOR i = 1 TO LEN(a$)
                      lpsz = MID$(a$,i,1)
                      GetTextExtentPoint32 hDC,lpsz,LEN(lpsz),lpSize
                      sx(i+1) = sx(i) + lpSize.cx
                  NEXT
                  ReleaseDC CBHNDL, hDC
                  Xmid = rc.nRight \ 2 - 1 : Ymid& = rc.nBottom \ 2
                  XCur = 1
                  hDC = GetDC(CBHNDL)
                  memDC1 = CreateCompatibleDC (hDC) : memDC2 = CreateCompatibleDC (hDC)
                  hBit = CreateCompatibleBitmap (hDC, MaxX, MaxY)
                  hBit2 = CreateCompatibleBitmap (hDC, MaxX, MaxY)
                  SelectObject memDC1, hBit : SelectObject memDC2, hBit2
                  hBrush = GetStockObject(%DKGRAY_BRUSH)
                  SelectObject memDC1, hBrush
                  SelectObject memDC2, hBrush
                  PatBlt memDC1, 0, 0, MaxX, MaxY, %PATCOPY
                  PatBlt memDC2, 0, 0, MaxX, MaxY, %PATCOPY
                  SetBkMode memDC2, %TRANSPARENT
                  ReleaseDC CBHNDL, hDC
                  RANDOMIZE TIMER
                  InvalidateRect CBHNDL,BYVAL %NULL,BYVAL %TRUE
                  FUNCTION = 1
              CASE %WM_PAINT
                  FOR m = 1 TO 6 : GOSUB Pattern : NEXT
                  Fak! = 1! : Fak2 = 1060 : dimi = 45
                  hDC = BeginPaint(CBHNDL, Ps)
                  DO
                      BitBlt memDC2,0,0,MaxX, MaxY,memDC1,0,0,%SRCCOPY
                      FOR i = 1 TO LEN(A$)
                          SelectObject memDC2, fo
                          SetTextColor memDC2, Colour(RND(1, 12))
                          lpsz=MID$(A$,i,1)
                          TextOut memDC2, sx(i)+RND(-Fak2, Fak2), sy+RND(-Fak2, Fak2), lpsz, BYVAL LEN(lpsz)
                          DeleteObject fo
                      NEXT
                      BitBlt hDC,0,0,MaxX, MaxY,memDC2,0,0,%SRCCOPY
                      fak2 = fak2 - dimi
                      IF dimi >=2 THEN DECR dimi
                      SLEEP 50
                  LOOP UNTIL fak2 <1
                  DeleteObject hPen
                  BitBlt memDC2,0,0,MaxX, MaxY,memDC1,0,0,%SRCCOPY
                  SetTextColor memDC2, RGB(255,255,128)
                  lpsz = A$
                  TextOut memDC2, sx(1), sy, lpsz, BYVAL LEN(lpsz)
                  BitBlt hDC,0,0,MaxX, MaxY,memDC2,0,0,%SRCCOPY
                  SLEEP 1500
                  EndPaint CBHNDL, Ps
                  ReleaseDC CBHNDL, hDC
                  GetCursorPos Pnt
                  XCur = -1*XCur : Pnt.x = Pnt.x + XCur
                  SetCursorPos Pnt.x, Pnt.y ' "Rock" cursor slightly from side to side
                                            ' to elicit a %WM_MOUSEMOVE message and thereby
                                            ' a new pattern.
              CASE %WM_MOUSEMOVE
                  InvalidateRect CBHNDL,BYVAL %NULL,BYVAL %FALSE
                  FUNCTION = 1
              CASE %WM_KEYDOWN
                  IF CBWPARAM = %VK_SPACE THEN DIALOG END CBHNDL ' Close using the space-bar.
                  FUNCTION = 1
          END SELECT
          EXIT FUNCTION
          '
          Pattern:
              N05 = RND(8,16) : N = N05 * 2 : N4 = 4 * N
              REDIM X(N4),Y(N4)
              Xstep = Xmid \ N05 + 1 : Ystep = Ymid \ N05 + 1 ' + 1 ensures that pattern always fills the whole client area.
              Xmin = Xmid - N05 * Xstep : Ymin = Ymid - N05 * Ystep
              Xmax = Xmid + N05 * Xstep : Ymax = Ymid + N05 * Ystep
              hPen = CreatePen(%PS_SOLID, 1, Colour(RND(1, 12)))
              SelectObject memDC1, hPen
              FOR i=1 TO N
                  X(i) = Xmin : Y(i) = Ymin + (i-1)*Ystep
                  X(N*3+1-i) = Xmax : Y(N*3+1-i) = Ymin + i*Ystep
                  X(i+N) = Xmin + (i-1)*Xstep : Y(i+N) = Ymax
                  X(N4+1-i) = Xmin + i*Xstep : Y(N4+1-i) = Ymin
              NEXT
              FOR i=1 TO N4
                  j=1 : k& = i + 1
                  DO WHILE k& - i& < N4
                      MoveToEx memDC1, X(i), Y(i), BYVAL %NULL
                      m1= 1 + (k MOD N4)
                      LineTo memDC1, X(m1), Y(m1)
                      INCR j : k = k + j
                  LOOP
              NEXT
              DeleteObject hPen
          RETURN
      END FUNCTION
      '
      FUNCTION PBMAIN
          LOCAL hForm&,rc AS RECT,i&,Count&
          SystemParametersInfo %SPI_GETWORKAREA,BYVAL 0, BYVAL VARPTR(rc),BYVAL 0
          DIALOG NEW 0, "At Steady Message: Pause By Moving Mouse To This Caption Area - Stop By Using Space-Bar",,,0,0,%DS_MODALFRAME OR %WS_CAPTION OR %WS_SYSMENU OR %DS_CENTER OR %WS_CLIPCHILDREN,0 TO hForm&
          MoveWindow hForm&,rc.nLeft,rc.nTop,rc.nRight-rc.nLeft,rc.nBottom-rc.nTop,%TRUE
          DIALOG SHOW MODELESS hForm&,CALL DialCallBack
          DO
              DIALOG DOEVENTS TO Count&
          LOOP UNTIL Count&=0
          DeleteObject Fo
          DeleteDC memDC1 : DeleteObject hbit
          DeleteDC memDC2 : DeleteObject hbit2
      END FUNCTION

      ------------------

      Comment


      • #4
        ' This is a new version
        Code:
        #COMPILE EXE
        #REGISTER NONE
        #DIM ALL
        #INCLUDE "win32api.inc"
        '
        SUB GetRainbowRGB(BYVAL i&,BYREF Red&,BYREF Green&,BYREF Blue&)
            SELECT CASE i& 'i& can vary between 0 and 359 (full circle)
                CASE 0 TO 59, 360 TO 59 + 360
                    Red&=(i& MOD 60)*4.25       ' increasing red
                    Green&=255                  ' maximum green
                    Blue&=0                     ' no blue
                CASE 60 TO 119, 60 + 360 TO 119 + 360
                    Red&=255                    ' maximum red
                    Green&=255-(i& MOD 60)*4.25 ' decreasing green
                    Blue&=0                     ' no blue
                CASE 120 TO 179, 120 + 360 TO 179 + 360
                    Red&=255                    ' maximum red
                    Green&=0                    ' no green
                    Blue&=(i& MOD 60)*4.25      ' increasing blue
                CASE 180 TO 239, 180 + 360 TO 239 + 360
                    Red&=255-(i& MOD 60)*4.25   ' decreasing red
                    Green&=0                    ' no green
                    Blue&= 255                  ' maximum blue
                CASE 240 TO 299, 240 + 360 TO 299 + 360
                    Red&=0                      ' no red
                    Green&=(i& MOD 60)*4.25     ' increasing green
                    Blue& = 255                 ' maximum blue
                CASE 300 TO 359, 300 + 360 TO 359 + 360
                    Red&=0                      ' no red
                    Green&=255                  ' maximum green
                    Blue&=255-(i& MOD 60)*4.25  ' decreasing blue
                CASE ELSE
            END SELECT
        END SUB
        '
        SUB ColorExample1(BYVAL hDC AS LONG, BYVAL MaxX AS LONG, BYVAL MaxY AS LONG)
            LOCAL XX&,YY&,XR&,YR&,hEdit AS LONG
            LOCAL i&,j&,k&,Red&,Green&,Blue&,Col&,Radian!,Radius&,res&,a$
            DIM lpsz AS ASCIIZ * 255
            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 hPen AS LONG
            LOCAL hBrush AS LONG
            XX = RND(30, MaxX-30) : YY = RND(30, MaxY-30)
            Radius&=RND(50, 150)
            xLeft  = XX& - Radius& : xRight =  XX& + Radius&
            yTop   = YY& - Radius& : yBottom = YY& + Radius&
            j = RND(0, 359)
            FOR i&=j TO j + 359 STEP 2           ' one 360 degrees turn (color loop)
                Radian!=i&*0.0174533
                xStart=XX&+Radius&*COS(Radian!)  ' coordinates
                yStart=YY&+Radius&*SIN(Radian!)
                xEnd=XX&+Radius&*COS((i&-3)*0.0174533) ' angle converted to radians
                yEnd=YY&+Radius&*SIN((i&-3)*0.0174533)
                CALL GetRainbowRGB(i-j, Red&, Green&, Blue&)
                Col&=RGB(Red&,Green&,Blue&) ' make color from red, green and blue
                hPen = SelectObject(hDC, CreatePen(0, 0, Col&))
                hBrush = SelectObject(hDC, CreateSolidBrush (Col&))
                ' draw pie piece in specified color
                PIE hDC, xLeft,yTop,xRight,yBottom, xStart, yStart, xEnd, yEnd
                ' delete pen and brush (very important cleaning up)
                DeleteObject SelectObject(hDC, hPen)
                DeleteObject SelectObject(hDC, hBrush)
            NEXT
        END SUB
        '
        CALLBACK FUNCTION DialCallBack
            STATIC hDC&,Rc AS RECT,i&,hPen&,k&,j&,m1&,a$,x&,LogPixelsY&,FH&,FontTypeSize&,m&,h$
            STATIC Ps AS PAINTSTRUCT,N&,N4&,N05&,sy&,hBrush&,MaxX&,MaxY&
            STATIC Xmax&,Xmin&,Ymax&,Ymin&,Xstep&,Ystep&,Xmid&,Ymid&,XCur&
            STATIC X() AS LONG, Y() AS LONG
            STATIC Colour() AS LONG
            STATIC Pnt AS POINTAPI
            GLOBAL memDC1&, memDC2&, hBit&, hBit2&
            LOCAL st&,Fak!,Fak2&, dimi&
            LOCAL Red&,Green&,Blue&
            GLOBAL fo&
            STATIC lpSize AS SIZEL : DIM lpsz AS STATIC ASCIIZ * 2400
            STATIC tm AS TEXTMETRIC
        
            SELECT CASE CBMSG
                CASE %WM_INITDIALOG
                    MaxX& = GetSystemMetrics(%SM_CXSCREEN)
                    MaxY& = GetSystemMetrics(%SM_CYSCREEN)
                    h$="jn‘{€:aŽus‹|}…Ž3a‹/Sƒ†6l†‚q‹L{Œ{x7_pŒŒ€r"
                    a$=""
                    RANDOMIZE 1.1
                    FOR i = 1 TO LEN(h$)
                        a$=a$+CHR$(ASC(MID$(h$,i,1))-RND(10, 30))
                    NEXT
                    DIM sx(1 TO LEN(a$)+1) AS STATIC LONG
                    REDIM Colour(1 TO 12) : j = 0
                    FOR i=0 TO 359 STEP 30 : INCR j: GetRainbowRGB(i&, Red&, Green&,Blue&) : Colour(j) = RGB(Red&,Green&,Blue&) : NEXT
                    hDC = GetDC(%HWND_DESKTOP)
                    SetMapMode hDC, %MM_TEXT
                    LogPixelsY  = GetDeviceCaps(hDC, %LOGPIXELSY)
                    ReleaseDC %HWND_DESKTOP, hDC
                    GetClientRect CBHNDL,Rc : FontTypeSize = 24
                    NewFontSize:
                    FH = -MulDiv(FontTypeSize,LogPixelsY, 72)
                    fo = CreateFont(FH,0,0,0,700,0,0,0,0,3,2,1,82,"Edwardian Script ITC") '"Arial")
                    hDC = GetDC(CBHNDL)
                    SelectObject hDC, fo
                    lpsz = a$ : GetTextExtentPoint32 hDC,lpsz,LEN(lpsz),lpSize
                    ReleaseDC CBHNDL, hDC : k = (Rc.nRight - lpSize.cx) \ 2
                    IF k < 0 THEN DECR FontTypeSize : GOTO NewFontSize
                    '
                    hDC = GetDC(CBHNDL)
                    SelectObject hDC, fo : sx(1) = k
                    GetTextMetrics hDC,tm : sy& = (Rc.nBottom - tm.tmHeight - tm.tmExternalLeading) \ 2
                    FOR i = 1 TO LEN(a$)
                        lpsz = MID$(a$,i,1)
                        GetTextExtentPoint32 hDC,lpsz,LEN(lpsz),lpSize
                        sx(i+1) = sx(i) + lpSize.cx
                    NEXT
                    ReleaseDC CBHNDL, hDC
                    Xmid = rc.nRight \ 2 - 1 : Ymid& = rc.nBottom \ 2
                    XCur = 1
                    hDC = GetDC(CBHNDL)
                    memDC1 = CreateCompatibleDC (hDC) : memDC2 = CreateCompatibleDC (hDC)
                    hBit = CreateCompatibleBitmap (hDC, MaxX, MaxY)
                    hBit2 = CreateCompatibleBitmap (hDC, MaxX, MaxY)
                    SelectObject memDC1, hBit : SelectObject memDC2, hBit2
                    hBrush = GetStockObject(%DKGRAY_BRUSH)
                    SelectObject memDC1, hBrush
                    SelectObject memDC2, hBrush
                    PatBlt memDC1, 0, 0, MaxX, MaxY, %PATCOPY
                    PatBlt memDC2, 0, 0, MaxX, MaxY, %PATCOPY
                    SetBkMode memDC2, %TRANSPARENT
                    ReleaseDC CBHNDL, hDC
                    RANDOMIZE TIMER
                    InvalidateRect CBHNDL,BYVAL %NULL,BYVAL %TRUE
                    FUNCTION = 1
                CASE %WM_PAINT
                    FOR m = 1 TO 150 : ColorExample1(memDC1, MaxX, MaxY) : NEXT
                    FOR m = 1 TO 3 : GOSUB Pattern : NEXT
                    Fak! = 1! : Fak2 = 1060 : dimi = 45
                    hDC = BeginPaint(CBHNDL, Ps)
                    DO
                        BitBlt memDC2,0,0,MaxX, MaxY,memDC1,0,0,%SRCCOPY
                        FOR i = 1 TO LEN(A$)
                            SelectObject memDC2, fo
                            SetTextColor memDC2, Colour(RND(1, 12))
                            lpsz=MID$(A$,i,1)
                            TextOut memDC2, sx(i)+RND(-Fak2, Fak2), sy+RND(-Fak2, Fak2), lpsz, BYVAL LEN(lpsz)
                            DeleteObject fo
                        NEXT
                        BitBlt hDC,0,0,MaxX, MaxY,memDC2,0,0,%SRCCOPY
                        fak2 = fak2 - dimi
                        IF dimi >=2 THEN DECR dimi
                        SLEEP 50
                    LOOP UNTIL fak2 <1
                    DeleteObject hPen
                    BitBlt memDC2,0,0,MaxX, MaxY,memDC1,0,0,%SRCCOPY
                    SetTextColor memDC2, RGB(255,255,128)
                    lpsz = A$
                    TextOut memDC2, sx(1), sy, lpsz, BYVAL LEN(lpsz)
                    BitBlt hDC,0,0,MaxX, MaxY,memDC2,0,0,%SRCCOPY
                    SLEEP 1500
                    EndPaint CBHNDL, Ps
                    ReleaseDC CBHNDL, hDC
                    GetCursorPos Pnt
                    XCur = -1*XCur : Pnt.x = Pnt.x + XCur
                    SetCursorPos Pnt.x, Pnt.y ' "Rock" cursor slightly from side to side
                                              ' to elicit a %WM_MOUSEMOVE message and thereby
                                              ' a new pattern.
                CASE %WM_MOUSEMOVE
                    InvalidateRect CBHNDL,BYVAL %NULL,BYVAL %FALSE
                    FUNCTION = 1
                CASE %WM_KEYDOWN
                    IF CBWPARAM = %VK_SPACE THEN DIALOG END CBHNDL ' Close using the space-bar.
                    FUNCTION = 1
            END SELECT
            EXIT FUNCTION
            '
            Pattern:
                N05 = RND(4,9) : N = N05 * 2 : N4 = 4 * N
                REDIM X(N4),Y(N4)
                Xstep = Xmid \ N05 + 1 : Ystep = Ymid \ N05 + 1 ' + 1 ensures that pattern always fills the whole client area.
                Xmin = Xmid - N05 * Xstep : Ymin = Ymid - N05 * Ystep
                Xmax = Xmid + N05 * Xstep : Ymax = Ymid + N05 * Ystep
                hPen = CreatePen(%PS_SOLID, 1, Colour(RND(1, 12)))
                SelectObject memDC1, hPen
                FOR i=1 TO N
                    X(i) = Xmin : Y(i) = Ymin + (i-1)*Ystep
                    X(N*3+1-i) = Xmax : Y(N*3+1-i) = Ymin + i*Ystep
                    X(i+N) = Xmin + (i-1)*Xstep : Y(i+N) = Ymax
                    X(N4+1-i) = Xmin + i*Xstep : Y(N4+1-i) = Ymin
                NEXT
                FOR i=1 TO N4
                    j=1 : k& = i + 1
                    DO WHILE k& - i& < N4
                        MoveToEx memDC1, X(i), Y(i), BYVAL %NULL
                        m1= 1 + (k MOD N4)
                        LineTo memDC1, X(m1), Y(m1)
                        INCR j : k = k + j
                    LOOP
                NEXT
                DeleteObject hPen
            RETURN
        END FUNCTION
        '
        FUNCTION PBMAIN
            LOCAL hForm&,rc AS RECT,i&,Count&
            SystemParametersInfo %SPI_GETWORKAREA,BYVAL 0, BYVAL VARPTR(rc),BYVAL 0
            DIALOG NEW 0, "At Steady Message: Pause By Moving Mouse To This Caption Area - Stop By Using Space-Bar",,,0,0,%DS_MODALFRAME OR %WS_CAPTION OR %WS_SYSMENU OR %DS_CENTER OR %WS_CLIPCHILDREN,0 TO hForm&
            MoveWindow hForm&,rc.nLeft,rc.nTop,rc.nRight-rc.nLeft,rc.nBottom-rc.nTop,%TRUE
            DIALOG SHOW MODELESS hForm&,CALL DialCallBack
            DO
                DIALOG DOEVENTS TO Count&
            LOOP UNTIL Count&=0
            DeleteObject Fo
            DeleteDC memDC1 : DeleteObject hbit
            DeleteDC memDC2 : DeleteObject hbit2
        END FUNCTION

        Comment

        Working...
        X