OpenScreen with some interesting stuff

Share your advanced PureBasic knowledge/code with the community.
fweil
Enthusiast
Enthusiast
Posts: 725
Joined: Thu Apr 22, 2004 5:56 pm
Location: France
Contact:

OpenScreen with some interesting stuff

Post by fweil »

Hi,

This code answers several questions I have red on the forum.

The program opens a full screen to do anything you want.

It contains a user area in which the cursor is a cross and a program area in which the cursor is an arrow.

Also there is a tip to create active buttons, that is to say buttons which state changes when the mouse is over.

Also when you click these buttons it executes something (like exit the program or call an external app).

The IsScreenActive() allows to check if an external program was launched. But it was not enough to not have errors because the sprite program was trying to continue to draw. Then I added something to test if ScreenOutput() is possible in the meanwhile and this works fine. Try to launch IE by clicking the "Web" button, it will iconize the sprite program that you can maximize later.

I will try to embed this listing with more comments before to post it everywhere.

Code: Select all

Enumeration
  #Button_Exit_State1
  #Button_Exit_State2
  #Button_Web_State1
  #Button_Web_State2
  #Pointer1
  #Pointer2
EndEnumeration

#BackgroundColor = $400000

Procedure CreateSpriteObject(SpriteNumber.l, Width.l, Height.l, ObjectName.s, Color1.l, Color2.l)
  If CreateSprite(SpriteNumber, Width, Height, #PB_Sprite_Texture)
      StartDrawing(SpriteOutput(SpriteNumber))
        Select ObjectName
          Case "Cross" ; A cross cursor is drawn using two LineXY in a box which background color should be set as transparent
            DrawingMode(0)
            Box(0, 0, Width, Height, Color2)
            LineXY(0, Height / 2, Width, Height / 2, Color1)
            LineXY(Width / 2, 0, Width / 2, Height, Color1)
          Case "Arrow" ; An arrow cursor is drawn using some lines and filling the internal part of the arrow. The background should be set as transparent
            DrawingMode(0)
            Box(0, 0, Width, Height, Color2)
            LineXY(0, 0, 4, 13, Color1)
            LineXY(4, 13, 5, 8, Color1)
            LineXY(5, 8, 29, 32, Color1)
            LineXY(29, 32, 32, 29, Color1)
            LineXY(32, 29, 9, 6, Color1)
            LineXY(9, 6, 13, 5, Color1)
            LineXY(13, 5, 0, 0, Color1)
            FillArea(2, 2, Color1, Color1)
          Default ; By default I mean 'unknown', so I draw a quote mark as default 'Icon'
            DrawingMode(0)
            Box(0, 0, Width, Height, Color1)
            DrawingMode(1)
            Box(0, 0, Width, Height, Color2)
            DrawingMode(1)
            Label.s = "?"
            DrawingFont(LoadFont(0, "Verdana", 12, #PB_Font_Bold | #PB_Font_HighQuality))
            Locate((Width - TextLength(Label)) / 2, (Height - 3 * FontSize / 2) / 2)
            FrontColor(Red(255), Green(0), Blue(0))
            DrawText(Label)
        EndSelect
      StopDrawing()
  EndIf
EndProcedure

Procedure CreateSpriteButton(SpriteNumber.l, Width.l, Height.l, FontName.s, FontSize.l, Label.s, BackgroundColor.l, ForegroundColor.l, TextColor.l)
  ;
  ; Here the button style is a smooth border with a text centered horizontally and vertically
  ;
  If CreateSprite(SpriteNumber, Width, Height, #PB_Sprite_Texture)
      StartDrawing(SpriteOutput(SpriteNumber))
        Box(0, 0, Width, Height, BackgroundColor)
        DrawingMode(4)
        For i = 0 To 3
          Box(i, i, Width - 2 * i, 20 - 2 * i, RGB(255 - 50 * i, 255 - 50 * i, 266 - 50 * i))
        Next
        DrawingMode(0)
        Box(i, i, Width - 2 * i, Height - 2 * i, ForegroundColor)
        DrawingMode(1)
        DrawingFont(LoadFont(0, FontName, FontSize, #PB_Font_Bold | #PB_Font_HighQuality))
        Locate((Width - TextLength(Label)) / 2, (Height - 3 * FontSize / 2) / 2)
        FrontColor(Red(TextColor), Green(TextColor), Blue(TextColor))
        DrawText(Label)
      StopDrawing()
  EndIf
EndProcedure

Procedure DrawLabel(String.s, X.l, Y.l, BackgroundColor.l, ForegroundColor.l, FontName.s, FontSize.l, FontHeight.l)
  ;
  ; DrawLabel assumes that StartDrawing() is made.
  ;
  DrawingFont(LoadFont(0, FontName, FontSize, #PB_Font_HighQuality))
  DrawingMode(1)
  BackColor(Red(BackgroundColor), Green(BackgroundColor), Blue(BackgroundColor))
  FrontColor(Red(ForegroundColor), Green(ForegroundColor), Blue(ForegroundColor))
  Locate(X, Y)
  DrawText(String)
EndProcedure

Procedure CreateActiveButton(SpriteNumber1.l, SpriteNumber2.l, Width.l, Height.l, BackgroundColor.l, ForegroundColor.l, Label.s, FontName.s, FontSize.l)
  CreateSpriteButton(SpriteNumber1, Width, Height, FontName, FontSize, Label, BackgroundColor, ForegroundColor, BackgroundColor)
  CreateSpriteButton(SpriteNumber2, Width, Height, FontName, FontSize, Label, ForegroundColor, BackgroundColor, ForegroundColor)
EndProcedure

Procedure ActiveButton(SpriteNumber1.l, SpriteNumber2.l, X.l, Y.l, Width, Height, MouseX.l, MouseY.l)
  If MouseX >= X And MouseX <= X + Width And MouseY >= Y And MouseY <= Y + Height
      DisplaySprite(SpriteNumber2, X, Y)
      ProcedureReturn #TRUE
    Else
      DisplaySprite(SpriteNumber1, X, Y)
      ProcedureReturn #FALSE
  EndIf
EndProcedure

;
;
;
  ScreenXSize = 1024
  ScreenYSize = 768
  ScreenDepth = 32
  PlayAreaXSize = 800
  PlayAreaYSize = 600
  ScreenName.s = "My screen"
  Quit = #FALSE
  FontID = LoadFont(0, "Verdana", 7, #PB_Font_HighQuality)
  If InitKeyboard() And InitMouse() And InitSprite() And InitSprite3D()
      If OpenScreen(ScreenXSize, ScreenYSize, ScreenDepth, ScreenName)
          TransparentSpriteColor(-1, Red(#BackgroundColor), Green(#BackgroundColor), Blue(#BackgroundColor))
          ;
          ; Here we create / load sprites that willbe used later
          ;
          CreateActiveButton(#Button_Exit_State1, #Button_Exit_State2, 60, 20, #BackgroundColor, $C0FFFF, "Exit", "Verdana", 7)
          CreateActiveButton(#Button_Web_State1, #Button_Web_State2, 60, 20, #BackgroundColor, $C0FFFF, "Web", "Verdana", 7)
          CreateSpriteObject(#Pointer1, 32, 32, "Cross", $FFFFFF, #BackgroundColor)
          CreateSpriteObject(#Pointer2, 32, 32, "Arrow", $FFFFFF, #BackgroundColor)
          ;
          ; Main event loop
          ;
          Repeat
            FlipBuffers()
            If IsScreenActive()
                ClearScreen(Red(#BackgroundColor), Green(#BackgroundColor), Blue(#BackgroundColor))
                ;
                ; At the en of the main event loop
                ;
                ExamineKeyboard()
                ExamineMouse()
                MouseDeltaX = MouseDeltaX()
                MouseDeltaY = MouseDeltaY()
                MouseX = MouseX()
                MouseY = MouseY()
                ScreenOutput = ScreenOutput()
                If ScreenOutput
                    If StartDrawing(ScreenOutput)
                        DrawingMode(4)
                        Box((ScreenXSize - PlayAreaXSize) / 2, (ScreenYSize - PlayAreaYSize) / 2, PlayAreaXSize, PlayAreaYSize, #White)
                        DrawLabel("Mouse delta = (" + Str(MouseDeltaX) + "," + Str(MouseDeltaY) + ")", 10, 10, #BackgroundColor, $C0FFFF, "Verdana", 7, 11)
                        DrawLabel("Mouse position = (" + Str(MouseX) + "," + Str(MouseY) + ")", 10, 20, #BackgroundColor, $C0FFFF, "Verdana", 7, 11)
                        StopDrawing()
                    EndIf
                    Quit = ActiveButton(#Button_Exit_State1, #Button_Exit_State2, ScreenXSize - 70, 10, 60, 20, MouseX, MouseY) And MouseButton(1)
                    If ActiveButton(#Button_Web_State1, #Button_Web_State2, ScreenXSize - 150, 10, 60, 20, MouseX, MouseY) And MouseButton(1)
                        ShellExecute_(WindowID(), "open", "http://www.purebasic.com", 0, 0, #SW_SHOWNORMAL)
                    EndIf
                    If MouseX >= (ScreenXSize - PlayAreaXSize) / 2 And MouseX <= (ScreenXSize - PlayAreaXSize) / 2 + PlayAreaXSize And MouseY >= (ScreenYSize - PlayAreaYSize) / 2 And MouseY <= (ScreenYSize - PlayAreaYSize) / 2 + PlayAreaYSize
                        DisplayTransparentSprite(#Pointer1, MouseX - 16, MouseY - 16)
                      Else
                        DisplayTransparentSprite(#Pointer2, MouseX, MouseY)
                    EndIf
                EndIf
            EndIf
          Until Quit Or KeyboardPushed(#PB_Key_Escape)
      EndIf
      CloseScreen()
    Else
      MessageRequester("Alert", "Can't open DirectX", #PB_MessageRequester_Ok)
  EndIf
  TerminateProcess_(GetCurrentProcess_(), 0)
End
My avatar is a small copy of the 4x1.8m image I created and exposed at 'Le salon international du meuble à Paris' january 2004 in Matt Sindall's 'Shades' designers exhibition. The original laminated print was designed using a 150 dpi printout.