CodeArchiv für PB v4 - aktueller Status & Mithelfer gesu

Deeem2031 · Beitrag von **Deeem2031** » 02.12.2006 16:12

> http://www.purearea.net/pb/CodeArchiv/G ... unnel03.pb (traumatic)

MIr fehlt eine "font.bmp" um den Code testen zu können.

hardfalcon · Beitrag von **hardfalcon** » 03.12.2006 00:22

Die is im Codearchiv dabei, wenn dus rutnerlädtst.

Andre · Beitrag von **Andre** » 10.12.2006 20:03

Wenn ich die letzten Anregungen bzgl. Weglassen von Codes (und damit Verzicht auf eine Konvertierung) in diesem Thread berücksichtige, bleiben trotzdem noch folgende Codes offen:

http://www.purearea.net/pb/CodeArchiv/G ... tArrows.pb (Danilo)
http://www.purearea.net/pb/CodeArchiv/G ... eIcons1.pb (freak)
http://www.purearea.net/pb/CodeArchiv/G ... eIcons2.pb (freak)
http://www.purearea.net/pb/CodeArchiv/G ... Example.pb (DarkDragon)
http://www.purearea.net/pb/CodeArchiv/G ... unnel03.pb (traumatic)
http://www.purearea.net/pb/CodeArchiv/I ... +delete.pb (ricardo)
http://www.purearea.net/pb/CodeArchiv/W ... e_Win9x.pb (spangly)

Kann da noch jemand helfen?

Ich denke nämlich, dass diese zumeist sehr sinnvolle Codes darstellen und daher unbedingt im CodeArchiv auch in PB4-kompatiblen Versionen erhalten bleiben sollten.

Andre · Beitrag von **Andre** » 10.12.2006 22:14

Kurze Zwischeninfo:

freak war so nett und hat die beiden CreateIcons Codes angepasst. Die sind also erledigt.

Für den ListIcon Code mussen wahrscheinlich ein komplett neues Beispiel ins CodeArchiv, da dieser sich nur äußerst schwer an PB v4 anpassen lässt.

traumatic · Beitrag von **traumatic** » 12.12.2006 18:20

André: http://files.connection-refused.org/bmp ... 03_pb4.zip

Code: Alles auswählen

;..................................................................................
;
; tiny purebasic-opengl example | traumatic!2002 [traumatic@connection-refused.org]
;
;..................................................................................
;
;
;
;
; 20.06.2002  - displays text using a bitmap font and draws a tunnel in the background
;
;               filesize: 32.800 bytes (upx-compressed)
; 
; 27.06.2002  - filesize is now 16.928 bytes (upx-compressed)
;               due to texture-generation (->initPlasma())
;
; 28.06.2002  - added three different 'texture-generation-modes' can be toggled
;               by passing "-1", "-2" or "-3" as parameters
;
;               guess all bugs are gone now (screenresolution-switching)
;               glScissor-problem on some cards
;
;
; 12.12.2006 -  converted to pb4 on public demand - omg, what an ugly code... *sigh*
;               do yourself a favour and DON'T (read: DO NOT!) take this to learn from it!
;
;               note: I let "procedure modulo()" in as this is just meant to be
;                     compileable in pb4, not nice.
;

; opengl headers
XIncludeFile "pfd.pbh"
XIncludeFile "gl.pbh"
XIncludeFile "glu.pbh"

; windows headers
XIncludeFile "wingdi.pbh"
XIncludeFile "winuser.pbh"


Import "opengl32.lib"
  gluPerspective(a.d, b.d, c.d, e.d)
  glOrtho(a.d, b.d, c.d, d.d, e.d, f.d)
EndImport


#WNDTITLE = ""  ; App-Title
#FPS_TIMER = 1                    ; Timer to calculate FramesPerSecond
#FPS_INTERVAL = 1000              ; Calculate FPS every 1000 ms

ProgParam$ = ProgramParameter()

;
; variables
;


ElapsedTime.l     ; Elapsed time between frames

Global h_Wnd.l  ; global window handle
Global h_DC.l   ; global device context
Global h_RC.l   ; OpenGL rendering context

WndProcMsg.MSG


#appWidth = 640
#appHeight = 480


; tunnel
Structure TCoord  ; Texture Coordinates
  u.f
  v.f
EndStructure

Structure PCoord  ; Polygon Coordinates
  x.f
  y.f
  z.f
EndStructure

Global Dim imgArray.PCoord(32,32)
Global Dim texcord.TCoord(32,32)


; bmpfont
#fntSize = 32



;------------------------------------------------------------------
;  taken from glLibOnly2.pb
;
Procedure.l WndProc(hWnd,Msg,wParam,lParam)
  Shared quit
  
  If Msg=#WM_KEYDOWN  ; Set the pressed key (wparam) To equal true so we can check If its pressed
    quit=1
    ProcedureReturn 0
  EndIf


  If Msg=#WM_SYSCOMMAND   ; Intercept System Commands
  ; screensaver trying to start? monitor trying to enter powersaving?
    If wParam=#SC_SCREENSAVE ;Or wParam=#SC_MONITORPOWER ; (0F170h - winuser.h)
      ProcedureReturn 0   ; Prevent From Happening
    EndIf
  EndIf

  ProcedureReturn DefWindowProc_(hWnd, Msg, wParam, lParam)
EndProcedure

; ------------------------------------------------------------------
; Properly destroys the window created at startup (no memory leaks)
; ------------------------------------------------------------------
Procedure glKillWnd(FullscreenFlag.b);
  If FullscreenFlag = 1 ;  Change back To non fullscreen
    ChangeDisplaySettings_(0, 0)
    ShowCursor_(1)
  EndIf
  
  ; Makes current rendering context not current and releases the device
  ; context that is used by the rendering context.
  If wglMakeCurrent_(h_DC, 0) = 0
    MessageBox_(0, "Release of DC And RC failed!", "error?!", #MB_OK | #MB_ICONERROR)
  EndIf

  ; Attempts to delete the rendering context
  If wglDeleteContext_(h_RC) = 0
    MessageBox_(0, "Release of rendering context failed!", "error?!", #MB_OK | #MB_ICONERROR)
    h_RC = 0
  EndIf
  
  ; Attempts to release the device context
  If (h_DC = 1) And (ReleaseDC_(h_Wnd, h_DC) <> 0)
    MessageBox_(0, "Release of device context failed!", "error?!", #MB_OK | #MB_ICONERROR)
    h_DC = 0
  EndIf
  
  ; Attempts to destroy the window
  If (h_Wnd <> 0) And (DestroyWindow_(h_Wnd) = 0)
    MessageBox_(0, "Unable To destroy window!", "error?!", #MB_OK | #MB_ICONERROR)
    h_Wnd = 0
  EndIf

  ; Attempts to unregister the window class
  If UnregisterClass_("OpenGL", h_Instance) = 0
    MessageBox_(0, "Unable To unregister window class!", "error?!", #MB_OK | #MB_ICONERROR)
    h_Instance = 0
  EndIf
EndProcedure


;
; Creates the window and attaches an OpenGL rendering context to it
;
Procedure glCreateWnd(wWidth.l, wHeight.l, PixelDepth.b, FullscreenFlag.b)

  ClassName.s = "OpenGL"

  wndClass.WNDCLASS         ; Window class

  dwStyle.l                 ; Window styles
  dwExStyle.l               ; Extended window styles
  dmScreenSettings.DEVMODE  ; Screen settings (fullscreen, etc...)
  PixelFormat.l             ; Settings For the OpenGL rendering
  h_Instance.l               ; Current instance
  pfd.PIXELFORMATDESCRIPTOR ; Settings for the OpenGL window

  h_Instance = GetModuleHandle_(0);       Grab An Instance For Our Window
  
  ; Set up the window class
    wndClass\style         = #CS_HREDRAW | #CS_VREDRAW | #CS_OWNDC                
    ;                        CS_HREDRAW -> Redraws entire window If length changes
    ;                        CS_VREDRAW -> Redraws entire window If height changes
    ;                        CS_OWNDC   -> Unique device context For the window

    wndClass\hIcon         = LoadIcon_(0,#IDI_WINLOGO)
    wndClass\lpfnWndProc   = @WndProc() ; Set the window procedure to our func WndProc
    wndClass\hInstance     = h_Instance;
    wndClass\hCursor       = LoadCursor_(0, #IDC_ARROW);
    wndCLass\lpszClassName = @ClassName

  If RegisterClass_(wndClass) = 0 ; Attempt To register the window class
    MessageBox_(0, "Failed To register the window class!", "error?!", #MB_OK | #MB_ICONERROR)
    ProcedureReturn 0
  EndIf
  
  ; change to fullscreen if desired
  If FullscreenFlag = 1
    ; Set parameters For the screen setting
      dmScreenSettings\dmSize = SizeOf(DEVMODE)
      dmScreenSettings\dmPelsWidth  = wWidth       ; Window width
      dmScreenSettings\dmPelsHeight = wHeight      ; Window height
      dmScreenSettings\dmBitsPerPel = PixelDepth  ; Window color depth
      dmScreenSettings\dmFields     = #DM_PELSWIDTH | #DM_PELSHEIGHT | #DM_BITSPERPEL

   ; try to change screen mode to fullscreen
   If ChangeDisplaySettings_(dmScreenSettings, #CDS_FULLSCREEN) = #DISP_CHANGE_FAILED
      MessageBox_(0, "unable To switch to fullscreen!", "error?!", #MB_OK | #MB_ICONERROR)
      FullscreenFlag = 0
    EndIf
  EndIf


  ; If we are still in fullscreen then
  If FullscreenFlag = 1
    ; Creates a popup window | Doesn't draw within child windows | Doesn't draw within sibling windows
    dwStyle = #WS_POPUP | #WS_CLIPCHILDREN | #WS_CLIPSIBLINGS
    dwExStyle = #WS_EX_APPWINDOW   ; Top level window
    ShowCursor_(0)                 ; Turn of the cursor (gets in the way)
  Else
    ; Creates an overlapping window | Doesn't draw within child windows | Doesn't draw within sibling windows
    dwStyle = #WS_OVERLAPPEDWINDOW | #WS_CLIPCHILDREN | #WS_CLIPSIBLINGS
    ;  Top level window | Border with a raised edge
    dwExStyle = #WS_EX_APPWINDOW | #WS_EX_WINDOWEDGE
  EndIf

  ; Attempt To create the actual window
  
  ; given Parameters are as follows:
  ; Extended window styles , Class name , Window title (caption) , Window styles
  ; Window position , Size of window , No parent window , No menu , Instance , Pass nothing To WM_CREATE
 
  h_Wnd = CreateWindowEx_(dwExStyle, "OpenGL", #WNDTITLE, dwStyle, 0, 0, wWidth, wHeight, 0, 0, h_Instance, 0)

  If h_Wnd = 0 
    MessageBox_(0, "Unable To create window!", "error?!", #MB_OK | #MB_ICONERROR)
    glKillWnd(FullscreenFlag)  ; Undo all the settings we've changed
    ProcedureReturn 0
  EndIf

  ; Try To get a device context
  h_DC = GetDC_(h_Wnd)
  
  If h_DC = 0
    glKillWnd(FullscreenFlag)
    MessageBox_(0, "Unable to get device context!", "error?!", #MB_OK | #MB_ICONERROR)
    ProcedureReturn 0
  EndIf

  ; Settings For the OpenGL window
  pfd\nSize           = SizeOf(PIXELFORMATDESCRIPTOR) ; Size Of This Pixel Format Descriptor
  pfd\nVersion        = 1                    ; The version of this data structure
                      ; Buffer supports drawing To window | Buffer supports OpenGL drawing | Supports double buffering
  pfd\dwFlags         = #PFD_DRAW_TO_WINDOW | #PFD_SUPPORT_OPENGL | #PFD_DOUBLEBUFFER
  pfd\iPixelType      = #PFD_TYPE_RGBA        ; RGBA color format
  pfd\cColorBits      = PixelDepth;           ; OpenGL color depth
  pfd\cRedBits        = 0;                    ; Number of red bitplanes
  pfd\cRedShift       = 0;                    ; Shift count for red bitplanes
  pfd\cGreenBits      = 0;                    ; Number of green bitplanes
  pfd\cGreenShift     = 0;                    ; Shift count for green bitplanes
  pfd\cBlueBits       = 0;                    ; Number of blue bitplanes
  pfd\cBlueShift      = 0;                    ; Shift count for blue bitplanes
  pfd\cAlphaBits      = 0;                    ; Not supported
  pfd\cAlphaShift     = 0;                    ; Not supported
  pfd\cAccumBits      = 0;                    ; No accumulation buffer
  pfd\cAccumRedBits   = 0;                    ; Number of red bits in a-buffer
  pfd\cAccumGreenBits = 0;                    ; Number of green bits in a-buffer
  pfd\cAccumBlueBits  = 0;                    ; Number of blue bits in a-buffer
  pfd\cAccumAlphaBits = 0;                    ; Number of alpha bits in a-buffer
  pfd\cDepthBits      = 16;                   ; Specifies the depth of the depth buffer
  pfd\cStencilBits    = 0;                    ; Turn off stencil buffer
  pfd\cAuxBuffers     = 0;                    ; Not supported
  pfd\iLayerType      = #PFD_MAIN_PLANE;      ; Ignored
  pfd\bReserved       = 0;                    ; Number of overlay and underlay planes
  pfd\dwLayerMask     = 0;                    ; Ignored
  pfd\dwVisibleMask   = 0;                    ; Transparent color of underlay plane
  pfd\dwDamageMask    = 0;                    ; Ignored

  ; Attempts To find the pixel format supported by a device context that
  ; is the best match To a given pixel format specification.
  PixelFormat = ChoosePixelFormat_(h_DC, @pfd)
  If PixelFormat = 0
    glKillWnd(FullscreenFlag)
    MessageBox_(0, "Unable To find a suitable pixel format", "error?!", #MB_OK | #MB_ICONERROR)
    ProcedureReturn 0
  EndIf

  ; Sets the specified device context's pixel format To the format specified by the PixelFormat.
  If SetPixelFormat_(h_DC, PixelFormat, @pfd) = 0
    glKillWnd(FullscreenFlag);
    MessageBox_(0, "Unable To set required pixel format", "error?!", #MB_OK | #MB_ICONERROR)
    ProcedureReturn 0
  EndIf

  ; Create a OpenGL rendering context
  h_RC = wglCreateContext_(h_DC)
  
  If h_RC = 0
    glKillWnd(FullscreenFlag)
    MessageBox_(0, "Unable To create an OpenGL rendering context", "error?!", #MB_OK | #MB_ICONERROR)
    ProcedureReturn 0
  EndIf

  ; Makes the specified OpenGL rendering context the calling thread's current rendering context
  If wglMakeCurrent_(h_DC, h_RC) = 0
    glKillWnd(FullscreenFlag);
    MessageBox_(0, "Unable To activate OpenGL rendering context", "error?!", #MB_OK | #MB_ICONERROR)
    ProcedureReturn 0
  EndIf

  ; Settings To ensure that the window is the topmost window
  ShowWindow_(h_Wnd, #SW_SHOW)
  SetForegroundWindow_(h_Wnd)
  SetFocus_(h_Wnd)

  ProcedureReturn 1
EndProcedure


;------------------------------------------------------------------


;
; anyone knows why pb doesn't have % ?
;
Procedure.l modulo(x,y)
  ; x % y ~ x - (x / y) * y
  ProcedureReturn x-(x/y)*y
EndProcedure

;
;
;
Procedure drawTunnelNew(ElapsedTime.f, wireframe)
  Shared tunnelTex, plasmaTex
  
  glDisable_(#GL_FOG)

  glEnable_(#GL_CULL_FACE)                             ; do not calculate inside of poly's
  glDisable_(#GL_BLEND)
  glDisable_(#GL_LIGHTING)

  glClear_(#GL_COLOR_BUFFER_BIT | #GL_DEPTH_BUFFER_BIT);     Clear The Screen And The Depth Buffer
  glLoadIdentity_()
 
   glTranslatef_(0.0, 0.0, -4.2)

 
   glPolygonMode_(#GL_FRONT, #GL_FILL)
   glPolygonMode_(#GL_BACK, #GL_FILL)

 ; 'ElapsedTime' is used as the angle here
 For i.b=0 To 32
  For j.b=0 To 32
    ; precalc texture-coordinates (this way only works for 24bit images)
    texcord(i,j)\u = (i / 32.0 + Cos(((ElapsedTime*3) + 8 * j) / 60.0) / 2)
    texcord(i,j)\v = (j / 32.0 + ((ElapsedTime*3) + j) / 120)
  
    ; setup tunnel
    imgArray(i,j)\x = (3.0 - j/12.0)*(Cos(2.0*#PI/32*i)+ 2*Sin((ElapsedTime+2*j)/29) + Cos((ElapsedTime+2*j)/13) - 2*Sin(ElapsedTime/29) - Cos(ElapsedTime/13))
    imgArray(i,j)\y = (3.0 - j/12.0)*(Sin(2.0*#PI/32*i)+ 2*Cos((ElapsedTime+2*j)/33) + Sin((ElapsedTime+2*j)/17) - 2*Cos(ElapsedTime/33) - Sin(ElapsedTime/17))
    imgArray(i,j)\z = -j
  Next
 Next


 glColor3f_(0.8, 1.0, 0.9)
 glEnable_(#GL_TEXTURE_2D)
 glBindTexture_(#GL_TEXTURE_2D, plasmaTex)


  ; draw cylinder for tunnel
  For xl.b=0 To 31
   glBegin_(#GL_QUADS)
    For yl.b=0 To 31
 
     glTexCoord2f_(texcord(xl,yl)\u, texcord(xl,yl)\v)
     glVertex3f_(imgArray(xl,yl)\x, imgArray(xl,yl)\y, imgArray(xl,yl)\z)

     glTexCoord2f_(texcord(xl+1,yl)\u, texcord(xl+1,yl)\v)
     glVertex3f_(imgArray(xl+1,yl)\x, imgArray(xl+1,yl)\y, imgArray(xl,yl)\z)

     glTexCoord2f_(texcord(xl+1,yl+1)\u, texcord(xl+1,yl+1)\v)
     glVertex3f_(imgArray(xl+1,yl+1)\x, imgArray(xl+1,yl+1)\y, imgArray(xl,yl+1)\z)

     glTexCoord2f_(texcord(xl,yl+1)\u, texcord(xl,yl+1)\v)
     glVertex3f_(imgArray(xl,yl+1)\x, imgArray(xl,yl+1)\y, imgArray(xl,yl+1)\z)

    Next
   glEnd_()
  Next  

  glMatrixMode_(#GL_PROJECTION)   ; Switch to projection matrix
  glPopMatrix_()                  ; Restore the old projection matrix
  glMatrixMode_(#GL_MODELVIEW)    ; Return to modelview matrix
  glPopMatrix_()                  ; Restore old modelview matrix
  glDisable_(#GL_TEXTURE_2D)      ; Turn on textures, don't want our text textured
  glPopAttrib_()                  ; Restore depth testing      

  glEnable_(#GL_BLEND) 
  glDisable_(#GL_CULL_FACE)
  glEnable_(#GL_FOG)
  glEnable_(#GL_LIGHTING)
  glEnable_(#GL_DEPTH_TEST) 
EndProcedure

;
; create textures
;
Procedure _CreateTexture(pData.l, mode.s, mipmapping.b, bmpWidth.l, bmpHeight.l)

  If pData = 0
    MessageBox_(0, "unable to load texture", ":textureLib", #MB_OK | #MB_ICONERROR)
  Else

  glGenTextures_(1, @texture)
  glBindTexture_(#GL_TEXTURE_2D, texture)
  glTexEnvi_(#GL_TEXTURE_ENV, #GL_TEXTURE_ENV_MODE, #GL_MODULATE)       ; Texture blends with object background
  glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_MAG_FILTER, #GL_LINEAR)  ; only first two can be used
  
  If mipmapping = 1
    glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_MIN_FILTER, #GL_LINEAR_MIPMAP_LINEAR)  ; all of the above can be used
  Else
    glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_MIN_FILTER, #GL_LINEAR)  ; all of the above can be used
  EndIf


  Select mode
    Case LCase("rgb")
      If mipmapping = 1
        gluBuild2DMipmaps_(#GL_TEXTURE_2D, #GL_RGB, bmpWidth, bmpHeight, #GL_RGB, #GL_UNSIGNED_BYTE, pData):
      Else
        glTexImage2D_(#GL_TEXTURE_2D, 0, #GL_RGB, bmpWidth, bmpHeight, 0, #GL_RGB, #GL_UNSIGNED_BYTE, pData)   ; Use when not wanting mipmaps to be built by openGL
      EndIf
    
    Case LCase("rgba")
      If mipmapping = 1
        gluBuild2DMipmaps_(#GL_TEXTURE_2D, #GL_RGBA, bmpWidth, bmpHeight, #GL_RGBA, #GL_UNSIGNED_BYTE, pData)   ;
      Else
        glTexImage2D_(#GL_TEXTURE_2D, 0, #GL_RGBA, bmpWidth, bmpHeight, 0, #GL_RGBA, #GL_UNSIGNED_BYTE, pData)   ; Use when not wanting mipmaps to be built by openGL
      EndIf

    Case LCase("luminance")
      If mipmapping = 1
        gluBuild2DMipmaps_(#GL_TEXTURE_2D, #GL_LUMINANCE, bmpWidth, bmpHeight, #GL_LUMINANCE, #GL_UNSIGNED_BYTE, pData)
      Else
        glTexImage2D_(#GL_TEXTURE_2D, 0, #GL_LUMINANCE, bmpWidth, bmpHeight, 0, #GL_LUMINANCE, #GL_UNSIGNED_BYTE, pData)   ; Use when not wanting mipmaps to be built by openGL
      EndIf
      
  EndSelect

  EndIf
  ProcedureReturn texture
EndProcedure 

;
; load BMPs from memory-locations (IncludeBinary)
; loads 8, 16 and 24bit bmps
;
Procedure loadBMPTextureMem(memloc.l, mode.s, depth.b, mipmapping.b)
  FileHeader.BITMAPFILEHEADER
  InfoHeader.BITMAPINFOHEADER

  ; read the bitmap file header
  FileHeader\bfType                 = PeekW(memloc +0) ;2
  FileHeader\bfSize                 = PeekL(memloc +2) ;4
  FileHeader\bfReserved1            = PeekW(memloc +6) ;2
  FileHeader\bfReserved2            = PeekW(memloc +8) ;2
  FileHeader\bfOffBits              = PeekL(memloc+10) ;4

  ; check if it's a valid bmp-file
  If FileHeader\bfType <> $4D42
    ; MessageBox_(0, "invalid bmpfile @"+Str(memlocation), "error?!", #MB_OK)
    ProcedureReturn 0
  EndIf


  ; read the bitmap information header
  InfoHeader\biSize          = PeekL(memloc+14) ;4
  InfoHeader\biWidth         = PeekL(memloc+18) ;4
  InfoHeader\biHeight        = PeekL(memloc+22) ;4
  InfoHeader\biPlanes        = PeekW(memloc+26) ;2
  InfoHeader\biBitCount      = PeekW(memloc+28) ;2
  InfoHeader\biCompression   = PeekL(memloc+30) ;4
  InfoHeader\biSizeImage     = PeekL(memloc+34) ;4
  InfoHeader\biXPelsPerMeter = PeekL(memloc+38) ;4
  InfoHeader\biYPelsPerMeter = PeekL(memloc+42) ;4
  InfoHeader\biClrUsed       = PeekL(memloc+46) ;4
  InfoHeader\biClrImportant  = PeekL(memloc+50) ;4

  If InfoHeader\biSizeImage = 0
    InfoHeader\biSizeImage = (InfoHeader\biWidth * InfoHeader\biHeight * InfoHeader\biBitCount / 8)
  EndIf

  ; allocate enough mem to store the bitmap
  Dim bitmapImage.b (InfoHeader\biSizeImage)

;  bitmapImage = AllocateMemory(0,InfoHeader\biSizeImage,0)

  ; read in the bitmap image data
  For i.l=FileHeader\bfOffBits To InfoHeader\biSizeImage
    bitmapImage(i2) = PeekB(memloc+i)
    i2.l+1
  Next

  If depth>8
  ; swap BGR to RGB
    For i.l=0 To InfoHeader\biSizeImage Step 3
      tempRGB.l = bitmapImage(i)
      bitmapImage(i) = bitmapImage(i+2)
      bitmapImage(i+2) = tempRGB
    Next    
  EndIf 

  ; create texture
  texture = _CreateTexture(bitmapImage(), mode.s, mipmapping.b, InfoHeader\biWidth, InfoHeader\biHeight)

  ; cleanup
;  FreeMemory(0)
  Dim bitmapImage.b(0)

  ProcedureReturn texture
EndProcedure


;
; generates a plasma-like-texture
;
Procedure initPlasma(size.b, mode.s)
  Dim plasma.b(size*size*3)

  For i=0 To size*size*3 Step 3
    Temp = 114 * #PI * i/512
    val  = Sin(temp/2) * 128 + 8
    PokeB(@plasma(i), val)
  Next

  For i=1 To size*size*3 Step 3
    Temp =4 * #PI * i/512
    val  = Sin(temp/2) * 128 + 8
    PokeB(@plasma(i), val)
  Next

  For i=2 To size*size*3 Step 3
    Temp = 16 * #PI * i/512
    val  = Sin(temp/2) * 128 + 8
    PokeB(@plasma(i), val)
  Next

 
  Shared plasmaTex
  plasmaTex = _CreateTexture(plasma(), mode.s, 1, size, size)  ; this looks good ;)

  ; clean up
  Dim plasma.b(0)
EndProcedure


;
; this is due to problems with the real glScissors
; doh! what a waste...
;
Procedure drawScissor(y.f)
  ; render a blank quad
  glLoadIdentity_()
  x.f=-2.5
  z.f=-3.0

  glDisable_(#GL_FOG)
  glDisable_(#GL_BLEND)
  glDisable_(#GL_LIGHTING)
 
  glColor3f_(0, 0, 0.1)

  glTranslatef_(x.f, y, z)
  
  glBegin_(#GL_QUADS)
    glVertex2f_(0.0,0.0)
    glVertex2f_(0.0,0.5)
    glVertex2f_(5.0,0.5)
    glVertex2f_(5.0,0.0)
  glEnd_()

  glEnable_(#GL_LIGHTING)
  glEnable_(#GL_BLEND)
  glEnable_(#GL_FOG)
EndProcedure

;------------------------------------------------------------------

;
; build the font displaylists
;
Procedure BuildFont()
  Shared base.l, fontTex
  base.l = glGenLists_(128)                       ; Creating 256 Display Lists

  glBindTexture_(#GL_TEXTURE_2D, fontTex)         ; Select Our Font Texture

  For loop.l = 0 To 128                           ; Loop Through All 256 Lists
    cx.f = ( modulo(loop, 16) ) / 16               ; X Position Of Current Character
    cy.f = ( Round(loop/16,0) ) / 8               ; Y Position Of Current Character
  
    glNewList_(base+loop, #GL_COMPILE)            ; Start Building A List
    glBegin_(#GL_QUADS)                           ; Use A Quad For Each Character
      glTexCoord2f_(cx, 1.0 - cy.f - 0.0625*2)                     ; Texture Coord (Bottom Left)
      glVertex2i_(0, 0)                           ; Vertex Coord (Bottom Left)
      glTexCoord2f_(cx + 0.0625, 1.0 - cy.f - 0.0625*2) ; Texture Coord (Bottom Right)
      glVertex2i_(#fntSize, 0)                           ; Vertex Coord (Bottom Right)
      glTexCoord2f_(cx + 0.0625, 1.0 - cy)    ; Texture Coord (Top Right)
      glVertex2i_(#fntSize, #fntSize)                          ; Vertex Coord (Top Right)
      glTexCoord2f_(cx, 1.0 - cy)               ; Texture Coord (Top Left)
      glVertex2i_(0, #fntSize)                           ; Vertex Coord (Top Left)
    glEnd_()                                      ; Done Building Our Quad (Character)

    glTranslatef_(#fntSize-(#fntSize/3), 0.0, 0.0)
    glEndList_()                                  ; Done Building The Display List
  Next                                            ; Loop Until All 256 Are Built
EndProcedure

;
; delete the font displaylists from mem
;
Procedure KillFont()
  glDeleteLists_(base, 128) ; Delete All 256 Display Lists
EndProcedure
 
;
; print a single char
;
Procedure glPrintChar(x.f, y.f, alpha.f, scale.f, char.s)
  Shared base, fontTex

  glPolygonMode_(#GL_BACK,#GL_FILL)
  glPolygonMode_(#GL_FRONT,#GL_FILL)
  glDisable_(#GL_LIGHTING)

  glEnable_(#GL_TEXTURE_2D)
  glEnable_(#GL_BLEND)
  glBindTexture_(#GL_TEXTURE_2D, fontTex);			 Select Our Font Texture
  glDisable_(#GL_DEPTH_TEST);					 Disables Depth Testing
  glMatrixMode_(#GL_PROJECTION);					 Select The Projection Matrix
  glPushMatrix_();						 Store The Projection Matrix
  glLoadIdentity_();						 Reset The Projection Matrix
  glOrtho(0, #appWidth, 0, #appHeight, -100, 100);				 Set Up An Ortho Screen
  glMatrixMode_(#GL_MODELVIEW);					 Select The Modelview Matrix
  glPushMatrix_();						 Store The Modelview Matrix
  glLoadIdentity_();						 Reset The Modelview Matrix
  glTranslatef_(x, y, 0)
  glColor3f_(alpha.f, alpha.f, alpha.f)
  glScalef_(scale.f, scale.f, 1.0)

  glCallList_(Asc(char)-31);			 Write The Text To The Screen
  glMatrixMode_(#GL_PROJECTION);					 Select The Projection Matrix
  glPopMatrix_();						 Restore The Old Projection Matrix
  glMatrixMode_(#GL_MODELVIEW);					 Select The Modelview Matrix
  glPopMatrix_();						 Restore The Old Projection Matrix
  glEnable_(#GL_DEPTH_TEST);					 Enables Depth Testing
  glDisable_(#GL_BLEND)
  glDisable_(#GL_TEXTURE_2D)
  
  glEnable_(#GL_LIGHTING)
EndProcedure

;
;
;
Procedure glResizeWnd2()
  
  glViewport_(0, 0, #appWidth, #appHeight);     Set the viewport for the OpenGL window
  glMatrixMode_(#GL_PROJECTION);         Change Matrix Mode to Projection
  glLoadIdentity_();                    Reset View

  gluPerspective(45.0, #appWidth/#appHeight, 1.0, 100.0);   Do the perspective calculations. Last value = max clipping depth

  glMatrixMode_(#GL_MODELVIEW);          Return to the modelview matrix
  glLoadIdentity_();                    Reset View
EndProcedure


;------------------------------------------------------------------
;  Initialise OpenGL                                               
;------------------------------------------------------------------
Procedure glInit2()
  glShadeModel_(#GL_SMOOTH);                  Enables Smooth Color Shading
  glEnable_(#GL_DEPTH_TEST);                  Enable Depth Buffer
  glDepthFunc_(#GL_LESS);		            The Type Of Depth Test To Do
  glBlendFunc_(#GL_SRC_ALPHA, #GL_ONE)

  glHint_(#GL_PERSPECTIVE_CORRECTION_HINT, #GL_NICEST);   Realy Nice perspective calculations

  glEnable_(#GL_TEXTURE_2D);                      Enable Texture Mapping

  Shared fontTex
  fontTex = LoadBMPTextureMem(?fonttex, "luminance", 8, 0)
;  tunnelTex= LoadBMPTextureMem(?tunneltex, "rgb", 24, 0)  
  BuildFont()
EndProcedure

;------------------------------------------------------------------

; main
;If MessageBox_(0, "run fullscreen?", "[100% PureBasic]", #MB_YESNO | #MB_ICONQUESTION) = 6
;  FullscreenFlag = 1
;Else
  FullscreenFlag = 0
;EndIf

; open screen
If glCreateWnd(#appWidth, #appHeight, 32, FullscreenFlag) = 0
  End
EndIf

; generate different textures based on parameter
If ProgParam$ = "-1" Or ProgParam$ = ""
  initPlasma(16, "luminance")
EndIf

If ProgParam$ = "-2"
  initPlasma(32, "rgb")
EndIf

If ProgParam$ = "-3"
  initPlasma(48, "luminance")
EndIf
  
glInit2()

AppStart = GetTickCount_() ; get starttime of app


  ; resize window
; glViewport_(0,0,#appWidth,#appHeight);											 Reset The Current Viewport
                   
 glMatrixMode_(#GL_PROJECTION);											 Select The Projection Matrix
 glLoadIdentity_();														 Reset The Projection Matrix

 gluPerspective(45.0, #appWidth/#appHeight, 1.0, 100.0)

 glMatrixMode_(#GL_MODELVIEW);												 Select The Modelview Matrix
 glLoadIdentity_();	

;
;
;
Procedure readText2(delay)
  Shared txt$, txt2$, al.f;, sl.f,kk.f

  ; using threads and delay() lets me don't care about anything ;)
  Repeat

    Read txt$
    Read tmd$
         
    al.f = 0  ; 'alpha'  
    
    ; single letters
;    If txt$<>"+++"
      For lc=1 To Len(txt$)
        txt2$ = Mid(txt$, 1, lc)

;          If Mid(txt$,lc,1) = "§"
;            yl+50
;          EndIf

        sl.f+0.05
              
        ; 'fade-in'
        If al.f<0.7
          al.f+0.06
        EndIf
        
        
        ; only delay if letter isn't a [space]    

        If Mid(txt$, lc, 1) <> " "
          Delay(delay)
;        kk+0.01
        EndIf

      Next
;    EndIf


    ; reset text
    If txt$ = "###"
      Restore txtdata
      txt2$ = txt$
    EndIf
 
    
    
    Delay(Val(tmd$))
  ForEver
EndProcedure



CreateThread(@readText2(), 20) ; variable is the delay-time

;
; MAIN - LOOP
;
Repeat

;  ExamineKeyboard()
     
  If PeekMessage_(@WndProcMsg, 0, 0, 0, #PM_REMOVE)  ; Check If there is a message For this window
    ;translate And dispatch the message To this window
    TranslateMessage_(@WndProcMsg)
    DispatchMessage_(@WndProcMsg)
  EndIf
    
  FPSCount+1    ; Increment FPS Counter

  LastTime = ElapsedTime
  ElapsedTime = GetTickCount_() - AppStart     ; Calculate Elapsed Time
  ElapsedTime = (LastTime + ElapsedTime) / 2 ; Average it out for smoother movement

    drawTunnelNew(ElapsedTime*0.02, 0)
 
    If txt2$<>"###"
   
      i2.f=ElapsedTime*0.003
      
      x3l.w = 0 : y3l.w = 0
      
      For i = 1 To Len(txt$)
        txt3$ = Mid(txt2$, i, 1)

        ; waveblur
;        glPrintChar(32 + x3l*22+Sin(i2+i/4+sl)*4, 345-y3l, 0.4, 1.0 + Sin(i2+i/4+sl)*0.03, txt3$)
;        glPrintChar(32 + x3l*22+Cos(i2+i/4+sl)*0.5, 345-y3l, 0.9, 1.0 + Sin(i2+i/4+sl)*0.03, txt3$)

        glPrintChar(32 + x3l*22+Cos(i2+i/4+sl)*0.5, 345-y3l, 0.2, 1.0 + Sin(i2+i/4+sl)*0.03, txt3$)
        glPrintChar(32 + x3l*22+Sin(i2+i/4+sl)*4, 345-y3l, 0.6, 1.0 + Sin(i2+i/4+sl)*0.03, txt3$)

        ; oldskool - sin movement
;        glPrintChar(x3l*20, 280+Sin(i2+i/4+sl)*15 - y3l, 0.1+Sin(i2+i/4+sl)*0.5, 1, txt3$)
;        glPrintChar(52 + x3l*22, 345+Sin(i2+i/4+sl)*15 - y3l - 30, 0.1+Sin(i2+i/4+sl)*0.4, 0.9, txt3$)

        ; new line
        If txt3$="§"
          x3l=0
          y3l+30
        Else
          x3l+1
        EndIf  
          
      Next
      
    EndIf

  ; draw 'tv-screen'
  drawScissor(0.8)
  drawScissor(-1.3)
  
  ; display the scene (flipscreens)
  SwapBuffers_(h_DC)

  Delay(2)    ; don't lock up cpu

Until quit=1


;
; quit app
;
glKillWnd(FullscreenFlag)
End


;
;------------------------------------------------------------------
;
DataSection
  fonttex:
  IncludeBinary "20thCentury_8bit_sm2.bmp"

  txtdata:
  ; "text", "time" - § means new line
  Data.s "+++++++++++++++++++++++++§+                       +§+        WELCOME        +§+     TO THIS SMALL     +§+     DEMONSTRATION     +§+       in 100 %        +§+      PUREBASIC!!      +§+                       +§+++++++++++++++++++++++++§", "6000"
  Data.s "+++++++++++++++++++++++++§+                       +§+                       +§+ FOR MORE INFORMATION  +§+     PLEASE VISIT      +§+   www.purebasic.com   +§+                       +§+                       +§+++++++++++++++++++++++++§", "6000"
  Data.s "###"    ; end of text
EndDataSection

Andre · Beitrag von **Andre** » 25.12.2006 17:42

Hallo zusammen,
habe die Liste der offenen Codes im ersten Beitrag nochmals auf den neuesten Stand gebracht, nachdem auch freak und traumatic beim Konvertieren geholfen haben.
Für jetzt noch offenen Codes müssten sich entweder noch Helfer finden, oder diese Codes fliegen in der "Final" des neuen CodeArchivs raus.

Wer es in den News von www.PureArea.net noch nicht mitbekommen hat: die zu PB v4 kompatiblen Codes sind jetzt auch online abrufbar im CodeArchiv: http://www.purearea.net/pb/CodeArchiv/CodeArchiv.html
(Auf der Startseite gibt es auch noch einen Link zu den Codes in der zu PBv3.93 kompatiblen Ausgabe. Die konvertierten Codes sind alle gut an der Kennzeichnung mit "(updated for PB4.00 by ....)" hinter dem originalen Autor erkennbar.)

Ein Download-Archiv gibts dann, wenn das neue CodeArchiv fertiggestellt ist. Termin: when it's done...

Andre · Beitrag von **Andre** » 03.01.2007 23:35

Sagt mal, hat evtl. einer Linux-Nutzer unter euch Lust, die Codes im CodeArchiv auf ihre Lauffähigkeit unter PB Linux zu testen?

Ich könnte dann den OS-Tag in den betroffenen Codes entsprechend erweitern. Also z.B. so:

Code: Alles auswählen

; OS: Windows, Linux

Für diesen Zweck würde ich den bisherigen Stand des CodeArchivs auf Wunsch auch als Archiv zur Verfügung stellen.

Interessenten melden sich bitte direkt bei mir per Email: andre [at] purearea.net

Danke

blbltheworm · Beitrag von **blbltheworm** » 04.01.2007 23:55

Ich war jetzt schon länger nicht mehr hier.
Seh ich das richtig, das nur noch 4 Codes fehlen?

Ich drück euch die Daumen, dass sich schnell jemand findet der diese konvertieren kann, denn ich bin leider nicht gut genug dafür

.

Also weiter so

Gruß,
Jochen

Leonhard · Beitrag von **Leonhard** » 05.01.2007 02:11

Windows_System - Screenshots
http://www.purearea.net/pb/CodeArchiv/W ... _SnagIt.pb

Code: Alles auswählen

; English forum: http://www.purebasic.fr/english/viewtopic.php?t=6477&highlight=
; Author: cecilcheah
; Date: 11. June 2003
; OS: Windows
; Demo: 

; Fully functional Screen Capture (like SnagIt)
; ---------------------------------------------
; Feature: 
; Left mouse down o start cpature 
; Drag while left mouse is still down to define a rectangle to capture.
; Left mouse up to finish capture 
; Hotkey (Shift + Ctrl + F11) to start capture. 
;
; When the capture start, it will sit there until someone press the hot keys and then you
; should start the capturing process. The captured image will be in the clipboard. 


;Drag with left mouse button to select a part of the screen 
;Release the left button to paste it as a bitmap to the clipboard and end 

Window_Width  = GetSystemMetrics_(#SM_CXSCREEN) 
Window_Height = GetSystemMetrics_(#SM_CYSCREEN) 

corner1.POINT 
corner2.POINT 

; Added by Andre to work without include picture
CreateImage(1,200,200)
CreateImage(2,200,200)

If OpenWindow(0,100,150,291,155,"TBK Capture (STRG + F11 für Screenshot)",#PB_Window_SystemMenu) 
  CreateGadgetList(WindowID(0)) 
  TextGadget(2, 10, 10, WindowWidth(0)-20, WindowHeight(0)-20, "STRG + F11 für einen Screenshot drücken, danach auf dem Bildschirm den bereich auswählen, der in der Zwischenablage gespeichert werden soll")
  RegisterHotKey_(WindowID(0),1, #MOD_CONTROL,#VK_F11) 
  
  Repeat 
    WindowEvent = WaitWindowEvent()
    
    Select EventWindow()
      Case 0 ;{ Normale, 1. Fenster
        If WindowEvent = #WM_HOTKEY
          Pic_desktop = CreateImage(1, Window_Width, Window_Height) 
          
          hDC = StartDrawing(ImageOutput(1)) 
            BitBlt_(hDC, 0, 0, Window_Width, Window_Height, GetDC_(GetDesktopWindow_()), 0, 0, #SRCCOPY) 
          StopDrawing()
          
          OpenWindow(1, 0, 0, Window_Width, Window_Height, "Capturing", #WS_POPUP) 
          CreateGadgetList(WindowID(1)) 
          StartDrawing(WindowOutput(1))
            DrawImage(ImageID(1), 0, 0)      
            DrawingMode(#PB_2DDrawing_XOr | #PB_2DDrawing_Outlined) 
            GetCursorPos_(@corner2) 
            Box(corner1\x, corner1\y, corner2\x-corner1\x, corner2\y-corner1\y, $FFFFFF) 
          StopDrawing()
          Layer1_desktop = CreateImage(2, Window_Width, Window_Height) 
          
          hWnd1 = FindWindow_(0, "Capturing") 
          SetForegroundWindow_(hWnd1) 
        EndIf
      ;}
      Case 1 ;{ Das Fenster, auf dem man den Bereich auswählt
        Select WindowEvent
          Case #WM_MOUSEMOVE ;{
            If drawbox And SettingCursor=0 
              StartDrawing(WindowOutput(1)) 
                DrawImage(ImageID(1), 0, 0)      
                DrawingMode(#PB_2DDrawing_XOr | #PB_2DDrawing_Outlined) 
                GetCursorPos_(@corner2) 
                Box(corner1\x, corner1\y, corner2\x-corner1\x, corner2\y-corner1\y, $FFFFFF) 
              StopDrawing() 
              SettingCursor = 1 
              SetCursorPos_(corner2\x, corner2\y) 
            Else 
              SettingCursor = 0 
            EndIf 
          ;}
          Case #WM_LBUTTONDOWN ;{
            GetCursorPos_(@corner1)
            Debug corner1\x
            drawbox = 1
          ;}
          Case #WM_LBUTTONUP ;{
            StartDrawing(WindowOutput(1)) ; don't grab the boxlines 
              DrawImage(ImageID(1),0,0)                    
            StopDrawing() 
            
            ;CreateCompatibleBitmap_ cannot handle negative width/height values... 
            If corner1\x > corner2\x
              Swap corner2\x, corner1\x
            EndIf 
            If corner1\y > corner2\y
              Swap corner2\y, corner1\y
            EndIf
            
            GrabImage(1, 0, corner1\x, corner1\y, corner2\x-corner1\x, corner2\y-corner1\y)
            SetClipboardImage(0)
            
            MessageRequester("", "Das Bild wurde in die Zwischenablage kopiert", #MB_ICONINFORMATION) 
            
            drawbox = 0
            Break
          ;}
        EndSelect
      ;}
    EndSelect
  ForEver 
EndIf 

End

Leonhard · Beitrag von **Leonhard** » 05.01.2007 03:07

Ich war grad an http://www.purearea.net/pb/CodeArchiv/I ... +delete.pb (ricardo) und hab leider festgestellt, das jeder Pop3-Server anders antwortet und da es dadurch sehr schwehr ist, diesen SourceCode richtig zu übersetzen. Wer will, kann ja weiter esperimentieren. Ich habs zu mindest noch nicht da zu gebracht, das die anzahl der Mails im Postfach angezeigt werden.

Hier zum experimentieren: DEAD LINK