chart.bas

Powerbasic 对GDI 的操作 很漂亮的代码!

'+--------------------------------------------------------------------------+
'|                                  CHART                                   |
'|                              (OpenGL demo)                               |
'|            Example that shows you how to use the GDImage.dll             |
'|                                                                          |
'+--------------------------------------------------------------------------+
'|                                                                          |
'|                         Author Patrice TERRIER                           |
'|                                                                          |
'|                           copyright (c) 2005                             |
'|                                                                          |
'|                Patrice Terrier http://www.zapsolution.com                |
'|                                                                          |
'+--------------------------------------------------------------------------+
'|                  Project started on : 12-24-2005 (MM-DD-YYYY)            |
'|                        Last revised : 12-30-2005 (MM-DD-YYYY)            |
'+--------------------------------------------------------------------------+
#COMPILE EXE "chart.exe"

'//DECLARE SUB skDebug LIB "SKENGINE.DLL" (BYVAL Msg$)

'-----------------------------------------------------------------
' Equates:  83
'-----------------------------------------------------------------
%WINAPI                                         = 1
%TRUE                                           = 1
%FALSE                                          = 0
%NULL                                           = 0
%ERROR_ALREADY_EXISTS                           = 183
%ANSI_VAR_FONT                                  = 12
%SW_RESTORE                                     = 9
%VK_PGUP                                        = &H21
%VK_PGDN                                        = &H22
%VK_LEFT                                        = &H25
%VK_UP                                          = &H26
%VK_RIGHT                                       = &H27
%VK_DOWN                                        = &H28
%GCL_HCURSOR                                    = -12
%WM_DESTROY                                     = &H2
%WM_SIZE                                        = &H5
%WM_ACTIVATE                                    = &H6
%WM_PAINT                                       = &HF
%WM_QUIT                                        = &H12
%WM_SETFONT                                     = &H30
%WM_KEYDOWN                                     = &H100
%WM_COMMAND                                     = &H111
%WM_MOUSEMOVE                                   = &H200
%WM_LBUTTONDOWN                                 = &H201
%WM_LBUTTONUP                                   = &H202
%WM_RBUTTONDOWN                                 = &H204
%WM_RBUTTONUP                                   = &H205
%WS_OVERLAPPED                                  = &H0
%WS_CHILD                                       = &H40000000
%WS_VISIBLE                                     = &H10000000
%WS_CLIPSIBLINGS                                = &H04000000
%WS_CLIPCHILDREN                                = &H02000000
%WS_CAPTION                                     = &H00C00000  ' WS_BORDER OR WS_DLGFRAME
%WS_SYSMENU                                     = &H00080000
%WS_THICKFRAME                                  = &H00040000
%WS_TABSTOP                                     = &H00010000
%WS_MINIMIZEBOX                                 = &H00020000
%WS_MAXIMIZEBOX                                 = &H00010000
%WS_OVERLAPPEDWINDOW                            = %WS_OVERLAPPED OR %WS_CAPTION OR %WS_SYSMENU OR %WS_THICKFRAME OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX
%WS_EX_WINDOWEDGE                               = &H00000100
%WS_EX_STATICEDGE                               = &H00020000
%WS_EX_APPWINDOW                                = &H00040000
%CS_VREDRAW                                     = &H1
%CS_HREDRAW                                     = &H2
%PM_REMOVE                                      = &H0001
%SM_CXSCREEN                                    = 0
%SM_CYSCREEN                                    = 1
%MB_ICONHAND                                    = &H00000010&
%IDC_ARROW                                      = 32512&
%IDC_SIZEALL                                    = 32646&
%IDC_HAND                                       = 32649&
%SS_CENTER                                      = &H00000001
%SS_SUNKEN                                      = &H00001000
%GL_LESS                                        = &H0201
%GL_DEPTH_BUFFER_BIT                            = &H00000100
%GL_COLOR_BUFFER_BIT                            = &H00004000
%GL_LINES                                       = &H0001
%GL_LINE_STRIP                                  = &H0003
%GL_QUADS                                       = &H0007
%GL_SRC_ALPHA                                   = &H0302
%GL_ONE_MINUS_SRC_ALPHA                         = &H0303
%GL_UNSIGNED_BYTE                               = &H1401
%GL_FRONT                                       = &H0404
%GL_LINE_SMOOTH                                 = &H0B20
%GL_LIGHTING                                    = &H0B50
%GL_COLOR_MATERIAL                              = &H0B57
%GL_DEPTH_TEST                                  = &H0B71
%GL_BLEND                                       = &H0BE2
%GL_PERSPECTIVE_CORRECTION_HINT                 = &H0C50
%GL_TEXTURE_2D                                  = &H0DE1
%GL_NICEST                                      = &H1102
%GL_LIGHT1                                      = &H4001
%GL_AMBIENT                                     = &H1200
%GL_DIFFUSE                                     = &H1201
%GL_POSITION                                    = &H1203
%GL_COMPILE                                     = &H1300
%GL_AMBIENT_AND_DIFFUSE                         = &H1602
%GL_RGB                                         = &H1907
%GL_SMOOTH                                      = &H1D01
%GL_LINEAR                                      = &H2601
%GL_TEXTURE_MAG_FILTER                          = &H2800
%GL_TEXTURE_MIN_FILTER                          = &H2801
%GLU_SMOOTH                                     = 100000

'-----------------------------------------------------------------
' TYPE and UNION structures:  7
'-----------------------------------------------------------------
TYPE RECT
  nLeft AS LONG
  nTop AS LONG
  nRight AS LONG
  nBottom AS LONG
END TYPE

TYPE POINTAPI
  x AS LONG
  y AS LONG
END TYPE

TYPE POINTS
  x AS INTEGER
  y AS INTEGER
END TYPE

TYPE tagMSG
  hwnd AS DWORD
  message AS DWORD
  wParam AS LONG
  lParam AS LONG
  time AS DWORD
  pt AS POINTAPI
END TYPE

TYPE SECURITY_ATTRIBUTES
  nLength AS DWORD
  lpSecurityDescriptor AS LONG
  bInheritHandle AS LONG
END TYPE

TYPE WNDCLASSEX
    cbSize AS DWORD
    STYLE AS DWORD
    lpfnWndProc AS LONG
    cbClsExtra AS LONG
    cbWndExtra AS LONG
    hInstance AS DWORD
    hIcon AS DWORD
    hCursor AS DWORD
    hbrBackground AS DWORD
    lpszMenuName AS ASCIIZ PTR
    lpszClassName AS ASCIIZ PTR
    hIconSm AS DWORD
END TYPE

TYPE PAINTSTRUCT
  hDC AS DWORD
  fErase AS LONG
  rcPaint AS RECT
  fRestore AS LONG
  fIncUpdate AS LONG
  rgbReserved(0 TO 31) AS BYTE
END TYPE

'-----------------------------------------------------------------
' Declared Functions:  39
'-----------------------------------------------------------------
DECLARE FUNCTION AdjustWindowRectEx LIB "USER32.DLL" ALIAS "AdjustWindowRectEx" (lpRect AS RECT, BYVAL dsStyle AS LONG, BYVAL bMenu AS LONG, BYVAL dwEsStyle AS DWORD) AS LONG
DECLARE FUNCTION BeginPaint LIB "USER32.DLL" ALIAS "BeginPaint" (BYVAL hWnd AS DWORD, lpPaint AS PAINTSTRUCT) AS LONG
DECLARE FUNCTION CloseHandle LIB "KERNEL32.DLL" ALIAS "CloseHandle" (BYVAL hObject AS DWORD) AS LONG
DECLARE FUNCTION CreateMutex LIB "KERNEL32.DLL" ALIAS "CreateMutexA" (lpMutexAttributes AS SECURITY_ATTRIBUTES, BYVAL bInitialOwner AS LONG, lpName AS ASCIIZ) AS LONG
DECLARE FUNCTION CreateWindowEx LIB "USER32.DLL" ALIAS "CreateWindowExA" (BYVAL dwExStyle AS DWORD, lpClassName AS ASCIIZ, lpWindowName AS ASCIIZ, BYVAL dwStyle AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG, _
    BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, BYVAL hWndParent AS DWORD, BYVAL hMenu AS DWORD, BYVAL hInstance AS DWORD, lpParam AS ANY) AS DWORD
DECLARE FUNCTION DefWindowProc LIB "USER32.DLL" ALIAS "DefWindowProcA" (BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
DECLARE FUNCTION DispatchMessage LIB "USER32.DLL" ALIAS "DispatchMessageA" (lpMsg AS tagMSG) AS LONG
DECLARE FUNCTION EndPaint LIB "USER32.DLL" ALIAS "EndPaint" (BYVAL hWnd AS DWORD, lpPaint AS PAINTSTRUCT) AS LONG
DECLARE FUNCTION FindWindow LIB "USER32.DLL" ALIAS "FindWindowA" (lpClassName AS ASCIIZ, lpWindowName AS ASCIIZ) AS LONG
DECLARE FUNCTION FreeLibrary LIB "KERNEL32.DLL" ALIAS "FreeLibrary" (BYVAL hLibModule AS DWORD) AS LONG
DECLARE FUNCTION GetClassInfoEx LIB "USER32.DLL" ALIAS "GetClassInfoExA" (BYVAL hInst AS DWORD, lpszClass AS ASCIIZ, lpWndClass AS WNDCLASSEX) AS LONG
DECLARE FUNCTION GetClientRect LIB "USER32.DLL" ALIAS "GetClientRect" (BYVAL hwnd AS DWORD, lpRect AS RECT) AS LONG
DECLARE FUNCTION GetDlgItem LIB "USER32.DLL" ALIAS "GetDlgItem" (BYVAL hDlg AS DWORD, BYVAL nIDDlgItem AS LONG) AS DWORD
DECLARE FUNCTION GetFocus LIB "USER32.DLL" ALIAS "GetFocus" () AS DWORD
DECLARE FUNCTION GetForegroundWindow LIB "USER32.DLL" ALIAS "GetForegroundWindow" () AS DWORD
DECLARE FUNCTION GetLastError LIB "KERNEL32.DLL" ALIAS "GetLastError" () AS LONG
DECLARE FUNCTION GetProcAddress LIB "KERNEL32.DLL" ALIAS "GetProcAddress" (BYVAL hModule AS DWORD, lpProcName AS ASCIIZ) AS LONG
DECLARE FUNCTION GetStockObject LIB "GDI32.DLL" ALIAS "GetStockObject" (BYVAL nIndex AS LONG) AS DWORD
DECLARE FUNCTION GetSystemMetrics LIB "USER32.DLL" ALIAS "GetSystemMetrics" (BYVAL nIndex AS LONG) AS LONG
DECLARE FUNCTION GetWindowText LIB "USER32.DLL" ALIAS "GetWindowTextA" (BYVAL hWnd AS DWORD, lpString AS ASCIIZ, BYVAL cch AS LONG) AS LONG
DECLARE FUNCTION glGenLists LIB "opengl32.dll" ALIAS "glGenLists" (BYVAL range&) AS DWORD
DECLARE FUNCTION glGetError LIB "opengl32.dll" ALIAS "glGetError" () AS DWORD
DECLARE FUNCTION gluNewQuadric  LIB "glu32.dll" ALIAS "gluNewQuadric"  () AS LONG
DECLARE FUNCTION IsIconic LIB "USER32.DLL" ALIAS "IsIconic" (BYVAL hWnd AS DWORD) AS LONG
DECLARE FUNCTION LoadCursor LIB "USER32.DLL" ALIAS "LoadCursorA" (BYVAL hInstance AS DWORD, lpCursorName AS ASCIIZ) AS DWORD
DECLARE FUNCTION LoadIcon LIB "USER32.DLL" ALIAS "LoadIconA" (BYVAL hInstance AS DWORD, lpIconName AS ASCIIZ) AS DWORD
DECLARE FUNCTION LoadLibrary LIB "KERNEL32.DLL" ALIAS "LoadLibraryA" (lpLibFileName AS ASCIIZ) AS LONG
DECLARE FUNCTION MessageBox LIB "USER32.DLL" ALIAS "MessageBoxA" (BYVAL hWnd AS DWORD, lpText AS ASCIIZ, lpCaption AS ASCIIZ, BYVAL dwType AS DWORD) AS LONG
DECLARE FUNCTION PeekMessage LIB "USER32.DLL" ALIAS "PeekMessageA" (lpMsg AS tagMSG, BYVAL hWnd AS DWORD, BYVAL dwMsgFilterMin AS DWORD, BYVAL dwMsgFilterMax AS DWORD, BYVAL dwRemoveMsg AS DWORD) AS LONG
DECLARE FUNCTION RegisterClassEx LIB "USER32.DLL" ALIAS "RegisterClassExA" (pcWndClassEx AS WNDCLASSEX) AS WORD
DECLARE FUNCTION ScreenToClient LIB "USER32.DLL" ALIAS "ScreenToClient" (BYVAL hWnd AS DWORD, lpPoint AS POINTAPI) AS LONG
DECLARE FUNCTION SendMessage LIB "USER32.DLL" ALIAS "SendMessageA" (BYVAL hWnd AS DWORD, BYVAL dwMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
DECLARE FUNCTION SetClassLong LIB "USER32.DLL" ALIAS "SetClassLongA" (BYVAL hWnd AS DWORD, BYVAL nIndex AS LONG, BYVAL dwNewLong AS DWORD) AS LONG
DECLARE FUNCTION SetFocus LIB "USER32.DLL" ALIAS "SetFocus" (BYVAL hWnd AS DWORD) AS LONG
DECLARE FUNCTION SetForegroundWindow LIB "USER32.DLL" ALIAS "SetForegroundWindow" (BYVAL hWnd AS DWORD) AS LONG
DECLARE FUNCTION SetRect LIB "USER32.DLL" ALIAS "SetRect" (lpRect AS RECT, BYVAL X1 AS LONG, BYVAL Y1 AS LONG, BYVAL X2 AS LONG, BYVAL Y2 AS LONG) AS LONG
DECLARE FUNCTION ShowWindow LIB "USER32.DLL" ALIAS "ShowWindow" (BYVAL hWnd AS DWORD, BYVAL nCmdShow AS LONG) AS LONG
DECLARE FUNCTION TranslateMessage LIB "USER32.DLL" ALIAS "TranslateMessage" (lpMsg AS tagMSG) AS LONG
DECLARE FUNCTION WindowFromPoint LIB "USER32.DLL" ALIAS "WindowFromPoint" (BYVAL xPoint AS LONG, BYVAL yPoint AS LONG) AS LONG

'-----------------------------------------------------------------
' Declared Subs:  34
'-----------------------------------------------------------------
DECLARE SUB apiSleep LIB "KERNEL32.DLL" ALIAS "Sleep" (BYVAL dwMilliseconds AS DWORD)
DECLARE SUB glBegin LIB "opengl32.dll" ALIAS "glBegin" (BYVAL mode AS DWORD)
DECLARE SUB glBindTexture LIB "opengl32.dll" ALIAS "glBindTexture" (BYVAL ntarget AS DWORD, BYVAL texture AS DWORD)
DECLARE SUB glBlendFunc LIB "opengl32.dll" ALIAS "glBlendFunc" (BYVAL sfactor AS DWORD, BYVAL dfactor AS DWORD)
DECLARE SUB glCallList LIB "opengl32.dll" ALIAS "glCallList" (BYVAL list AS DWORD)
DECLARE SUB glClear LIB "opengl32.dll" ALIAS "glClear" (BYVAL mask AS DWORD)
DECLARE SUB glClearColor LIB "opengl32.dll" ALIAS "glClearColor" (BYVAL red AS SINGLE, BYVAL green AS SINGLE, BYVAL blue AS SINGLE, BYVAL alpha AS SINGLE)
DECLARE SUB glClearDepth LIB "opengl32.dll" ALIAS "glClearDepth" (BYVAL depth AS DOUBLE)
DECLARE SUB glColor4fv LIB "opengl32.dll" ALIAS "glColor4fv" (v AS ANY)
DECLARE SUB glColorMaterial LIB "opengl32.dll" ALIAS "glColorMaterial" (BYVAL face AS DWORD, BYVAL mode AS DWORD)
DECLARE SUB glDepthFunc LIB "opengl32.dll" ALIAS "glDepthFunc" (BYVAL func AS DWORD)
DECLARE SUB glEnable LIB "opengl32.dll" ALIAS "glEnable" (BYVAL cap AS DWORD)
DECLARE SUB glEnd LIB "opengl32.dll" ALIAS "glEnd" ()
DECLARE SUB glEndList LIB "opengl32.dll" ALIAS "glEndList" ()
DECLARE SUB glGenTextures LIB "opengl32.dll" ALIAS "glGenTextures" (BYVAL n&, textures AS ANY)
DECLARE SUB glHint LIB "opengl32.dll" ALIAS "glHint" (BYVAL ntarget AS DWORD, BYVAL mode AS DWORD)
DECLARE SUB glLightfv LIB "opengl32.dll" ALIAS "glLightfv" (BYVAL light AS DWORD, BYVAL pname AS DWORD, params AS ANY)
DECLARE SUB glLineWidth LIB "opengl32.dll" ALIAS "glLineWidth" (BYVAL nwidth AS SINGLE)
DECLARE SUB glLoadIdentity LIB "opengl32.dll" ALIAS "glLoadIdentity" ()
DECLARE SUB glNewList LIB "opengl32.dll" ALIAS "glNewList" (BYVAL list AS DWORD, BYVAL mode AS DWORD)
DECLARE SUB glRotatef LIB "opengl32.dll" ALIAS "glRotatef" (BYVAL angle AS SINGLE, BYVAL x AS SINGLE, BYVAL y AS SINGLE, BYVAL z AS SINGLE)
DECLARE SUB glShadeModel LIB "opengl32.dll" ALIAS "glShadeModel" (BYVAL mode AS DWORD)
DECLARE SUB glTexCoord2f LIB "opengl32.dll" ALIAS "glTexCoord2f" (BYVAL s AS SINGLE, BYVAL t AS SINGLE)
DECLARE SUB glTexImage2D LIB "opengl32.dll" ALIAS "glTexImage2D" (BYVAL ntarget AS DWORD, BYVAL level&, BYVAL internalformat&, BYVAL nwidth&, BYVAL height&, BYVAL border&, BYVAL format AS DWORD, BYVAL ntype AS DWORD, npixels AS ANY)
DECLARE SUB glTexParameteri LIB "opengl32.dll" ALIAS "glTexParameteri" (BYVAL ntarget AS DWORD, BYVAL pname AS DWORD, BYVAL param&)
DECLARE SUB glTranslatef LIB "opengl32.dll" ALIAS "glTranslatef" (BYVAL x AS SINGLE, BYVAL y AS SINGLE, BYVAL z AS SINGLE)
DECLARE SUB gluCylinder    LIB "glu32.dll" ALIAS "gluCylinder"    (BYVAL qobj AS ANY, BYVAL baseRadius#, BYVAL topRadius#, BYVAL nheight#, BYVAL slices&, BYVAL stacks AS LONG)
DECLARE SUB gluDeleteQuadric    LIB "glu32.dll" ALIAS "gluDeleteQuadric"   (BYVAL state AS ANY)
DECLARE SUB gluDisk   LIB "glu32.dll" ALIAS "gluDisk"   (BYVAL qobj AS ANY, BYVAL innerRadius#, BYVAL outerRadius#, BYVAL slices&, BYVAL loops AS LONG)
DECLARE SUB gluQuadricNormals   LIB "glu32.dll" ALIAS "gluQuadricNormals"  (BYVAL quadObject AS ANY, BYVAL normals AS DWORD)
DECLARE SUB gluQuadricTexture   LIB "glu32.dll" ALIAS "gluQuadricTexture"  (BYVAL quadObject AS ANY, BYVAL textureCoords AS DWORD)' ANY)
DECLARE SUB glVertex3f LIB "opengl32.dll" ALIAS "glVertex3f" (BYVAL x AS SINGLE, BYVAL y AS SINGLE, BYVAL z AS SINGLE)
DECLARE SUB glColor4f LIB "opengl32.dll" ALIAS "glColor4f" (BYVAL red AS SINGLE, BYVAL green AS SINGLE, BYVAL blue AS SINGLE, BYVAL alpha AS SINGLE)
DECLARE SUB InitCommonControls LIB "COMCTL32.DLL" ALIAS "InitCommonControls" ()
DECLARE SUB PostQuitMessage LIB "USER32.DLL" ALIAS "PostQuitMessage" (BYVAL nExitCode AS LONG)