camphillogl.pas

一个用Delphi编写的很好的屏保程序

unit CamphillOGL;
interface
uses
  SysUtils,
  Math,
  Windows,
  Messages,
  ScreenSaver,
  glFont,
  Geometry,
  OpenGL12,
  CamphillSetup;

procedure InitialiseOGL(Window: hWnd; Mode: TSSMode);
procedure DoneOGL(Window: hWnd);
procedure RunOGL(Window: hWnd);

implementation
type
  Float4 = array[0..3] of Single;
  Int4 = array[0..3] of Integer;

  TVtx = array[0..2] of Single;
  TNml = TVtx;
  TPlane = array[0..3] of Integer;

const
  xc = 0; yc = 1; zc = 2;
  RawPts = 12*4;
  Z1 = 1200; X1 = 0; Y1 = 4010;
  Z2 = 300;  X2 = 4573; Y2 = 2638;
  Z3 = 200;  X3 = 0; Y3 = 0;


var
  Settings: TSettings;

type
  TColor3f = array[0..2] of TGLFloat;

procedure GetColor(Col: Cardinal; var C3f: TColor3f);
begin
  C3f[0]:= GetRValue(Col)/$FF;
  C3f[1]:= GetGValue(Col)/$FF;
  C3f[2]:= GetBValue(Col)/$FF
end;

var
  LastTicks: DWORD = 0;
  Rot: Single;

  Pts: array[0..RawPts-1] of TVtx =
   ((160, 0,      0), //0
    (514, 0,      0), //1
    (1125,1190,  0), //2
    (2853,1704,  0), //3
    (3223,2375,  0), //4
    (4415,2346,  0), //5
    (X2,   Y2,  0),    //6
    (0,    Y1,  0),    //7
    (0,    3695,  0), //8
    (1678,3086,  0), //9
    (1452,2518,  0), //10
    (714, 2360,  0), //11
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0),
    (0, 0, 0));//11

  Polychrome: array[0..RawPts-1] of TColor3f;

  Nrm: array[0..3] of TNml;
  BackColour,
  BodyColour,
  TextColour: TColor3f;

  glf: TglFont;


procedure CalcNormal(const V: array of Integer; var N: TNml);
var
  i: Integer;
  a, b: TNml;
  MagN: Double;
  P0, P1, P3: TNml;
begin
  {calculate normal vector}
  {a is P0-P1 b is P3 - P0}
  P0:= Pts[V[0]];
  P1:= Pts[V[1]];
  P3:= Pts[V[2]];
  for i:= 0 to 2 do
  begin
    a[i]:= P1[i]-P0[i];
    b[i]:= P3[i]-P0[i]
  end;
  N[0]:= a[1]*b[2] - a[2]*b[1];
  N[1]:= a[2]*b[0] - a[0]*b[2];
  N[2]:= a[0]*b[1] - a[1]*b[0];
  MagN:= Sqrt(N[0]*N[0]+N[1]*N[1]+N[2]*N[2]);
  for i:= 0 to 2 do N[i]:= N[i]/MagN;
end;

procedure SetupPts;
function ZCoord(x, y: Double): Double;
const
  b = (z1-z3)/y1;
  c = z3;
  a = (z2 - b*y2 - c)/x2;
begin
  Result:= a*x + b*y +c
end;

var
  i: Integer;
begin
  for i:= 0 to 11 do
  begin
    Pts[i, zc]:= ZCoord(Pts[i, xc], Pts[i, yc]);

    Pts[i+1*12, yc]:= Pts[i, yc];
    Pts[i+1*12, xc]:= Pts[i, xc];
    Pts[i+1*12, zc]:= -Pts[i, zc];

    Pts[i+2*12, yc]:= Pts[i, yc];
    Pts[i+2*12, xc]:= -Pts[i, xc];
    Pts[i+2*12, zc]:= -Pts[i, zc];

    Pts[i+3*12, yc]:= Pts[i, yc];
    Pts[i+3*12, xc]:= -Pts[i, xc];
    Pts[i+3*12, zc]:= Pts[i, zc];
  end;
  CalcNormal([7+0*12,0+0*12,6+0*12], Nrm[0]);
  CalcNormal([0+1*12,7+1*12,6+1*12], Nrm[1]);
  CalcNormal([0+2*12,6+2*12,7+2*12], Nrm[2]);
  CalcNormal([7+3*12,6+3*12,0+3*12], Nrm[3]);

  GetColor(Settings.BackColour, BackColour);
  GetColor(Settings.BodyColour, BodyColour);
  GetColor(Settings.TextColour, TextColour);

  GetColor(Settings.Polychrome[0], Polychrome[0]);
  Polychrome[1]:= Polychrome[0];

  GetColor(Settings.Polychrome[1], Polychrome[2]);
  Polychrome[11]:= Polychrome[2];

  GetColor(Settings.Polychrome[2], Polychrome[3]);
  Polychrome[10]:= Polychrome[3];

  GetColor(Settings.Polychrome[3], Polychrome[4]);
  Polychrome[9]:= Polychrome[4];

  GetColor(Settings.Polychrome[4], Polychrome[5]);
  Polychrome[6]:= Polychrome[5];

  GetColor(Settings.Polychrome[5], Polychrome[7]);
  Polychrome[8]:= Polychrome[7];
  for i:= 1 to 3 do
    Move(Polychrome[0], Polychrome[i*12], Sizeof(TColor3f)*12)
end;

procedure Plane( const P: Int4);
var
  Nrm: TNml;
begin
  CalcNormal(P, Nrm);
  glNormal3fv(@Nrm);
  glArrayElement(P[0]);
  glArrayElement(P[1]);
  glArrayElement(P[2]);
  glArrayElement(P[3]);
end;

procedure ShPlane(P1, P2: Integer);
var
  p: Int4;
begin
  p[0]:= P1;
  P[1]:= P1+12;
  P[2]:= P2+12;
  P[3]:= P2;
  Plane(p)
end;

procedure DoLogo;

procedure DefaultMtl;
const
  specular: array[0..3] of TGLFloat = (0.4, 0.8, 0.8, 1);
  shininess: TGLFloat = 50.0;
begin
  glMaterialfv(GL_FRONT, GL_SPECULAR, @specular);
  glMaterialfv(GL_FRONT, GL_SHININESS, @shininess)
end;

var
  te: TVector3f;

begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;

  with Settings do
    gluLookAt(0, LookHeight, LookDist, 0, 2000, 0, 0, 1, 0);

  glPolygonMode(GL_FRONT_AND_BACK, GL_FILL);

  if Settings.Text <> '' then
  begin
    glPushMatrix;
    glf.TextExtent(Settings.Text, te);
    if Settings.TextRotating then
      glRotatef(-Rot, 0, 1, 0);
    glTranslatef(-te[0]/2, -te[1], te[2]/2);
    glColor3f(TextColour[0], TextColour[2], TextColour[2]);
    glf.WriteStr(Settings.Text);
    glPopMatrix;
  end;

  glEnableClientState(GL_VERTEX_ARRAY);
  glVertexPointer(3, GL_FLOAT, 0, @Pts);
  if Settings.Rainbow then
  begin
    glEnableClientState(GL_COLOR_ARRAY);
    glColorPointer(3, GL_FLOAT, 0, @Polychrome);
  end else
  begin
    glDisableClientState(GL_COLOR_ARRAY);
  end;

  glEnable(GL_COLOR_MATERIAL);
  glColorMaterial(GL_FRONT, GL_AMBIENT_AND_DIFFUSE);

  DefaultMtl;
  if not Settings.Rainbow then
    glColor3fv(@BodyColour);

  glRotatef(Rot, 0, 1, 0);
  glBegin(GL_QUADS);
  glNormal3fv(@Nrm[0]); //quadrant 0
  glArrayElement(0);
  glArrayElement(1);
  glArrayElement(2);
  glArrayElement(11);

  glArrayElement(11);
  glArrayElement(2);
  glArrayElement(3);
  glArrayElement(10);

  glArrayElement(10);
  glArrayElement(3);
  glArrayElement(4);
  glArrayElement(9);

  glArrayElement(9);
  glArrayElement(4);
  glArrayElement(5);
  glArrayElement(6);

  glArrayElement(8);
  glArrayElement(9);
  glArrayElement(6);
  glArrayElement(7);

  glNormal3fv(@Nrm[1]); //quadrant 1
  glArrayElement(0+12);
  glArrayElement(11+12);
  glArrayElement(2+12);
  glArrayElement(1+12);

  glArrayElement(2+12);
  glArrayElement(11+12);
  glArrayElement(10+12);
  glArrayElement(3+12);

  glArrayElement(3+12);
  glArrayElement(10+12);
  glArrayElement(9+12);
  glArrayElement(4+12);

  glArrayElement(9+12);
  glArrayElement(6+12);
  glArrayElement(5+12);
  glArrayElement(4+12);

  glArrayElement(7+12);
  glArrayElement(6+12);
  glArrayElement(9+12);
  glArrayElement(8+12);


  glNormal3fv(@Nrm[2]); //quadrant 2
  glArrayElement(0+24);
  glArrayElement(1+24);
  glArrayElement(2+24);
  glArrayElement(11+24);

  glArrayElement(11+24);
  glArrayElement(2+24);
  glArrayElement(3+24);
  glArrayElement(10+24);

  glArrayElement(10+24);
  glArrayElement(3+24);
  glArrayElement(4+24);
  glArrayElement(9+24);

  glArrayElement(9+24);
  glArrayElement(4+24);
  glArrayElement(5+24);
  glArrayElement(6+24);


  glArrayElement(8+24);
  glArrayElement(9+24);
  glArrayElement(6+24);
  glArrayElement(7+24);

  glNormal3fv(@Nrm[3]); //quadrant 3
  glArrayElement(0+36);
  glArrayElement(11+36);
  glArrayElement(2+36);
  glArrayElement(1+36);

  glArrayElement(2+36);
  glArrayElement(11+36);
  glArrayElement(10+36);
  glArrayElement(3+36);

  glArrayElement(3+36);
  glArrayElement(10+36);
  glArrayElement(9+36);
  glArrayElement(4+36);

  glArrayElement(9+36);
  glArrayElement(6+36);
  glArrayElement(5+36);
  glArrayElement(4+36);

  glArrayElement(7+36);
  glArrayElement(6+36);
  glArrayElement(9+36);
  glArrayElement(8+36);

  ShPlane(1, 2);
  ShPlane(2, 3);
  ShPlane(3, 4);
  ShPlane(4, 5);
  ShPlane(5, 6);
  ShPlane(6, 7);
  ShPlane(8, 9);
  ShPlane(9, 10);
  ShPlane(10, 11);
  ShPlane(11, 0);

  ShPlane(1+24, 2+24);
  ShPlane(2+24, 3+24);
  ShPlane(3+24, 4+24);
  ShPlane(4+24, 5+24);
  ShPlane(5+24, 6+24);
  ShPlane(6+24, 7+24);
  ShPlane(8+24, 9+24);
  ShPlane(9+24, 10+24);
  ShPlane(10+24, 11+24);
  ShPlane(11+24, 0+24);
  glEnd;

  glFlush;
  SwapBuffers(wglGetCurrentDC)
end;

procedure RunOGL(Window: hWnd);
var
  Ticks: DWORD;
  ms: DWORD;
begin
  Ticks:= GetTickCount;
  if LastTicks <> 0 then
  begin
    ms:= Ticks - LastTicks;
    Rot:= Rot + Settings.Speed*360*ms/500000;
    if Rot > 360 then
      Rot:= Rot - 360
  end;
  LastTicks:= Ticks;
  DoLogo
end;

procedure SetDCPixelFormat(DC: HDC);
var
  pfd: TPixelFormatDescriptor;
  nPixelFormat: Integer;
begin
  FillChar(pfd, SizeOf(pfd), 0);
  with pfd do begin
    nSize     := sizeof(pfd);                               // Size of this structure
    nVersion  := 1;                                         // Version number
    dwFlags   := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL
                  or PFD_DOUBLEBUFFER;
    iPixelType:= PFD_TYPE_RGBA;                             // RGBA pixel values
    cColorBits:= 16;                                        // 24-bit color
    cDepthBits:= 32;                                        // 32-bit depth buffer
    iLayerType:= PFD_MAIN_PLANE;                            // Layer type
  end;
  nPixelFormat := ChoosePixelFormat(DC, @pfd);
  if nPixelFormat = 0 then
    RaiseLastWin32Error;
  SetPixelFormat(DC, nPixelFormat, @pfd)
end;

procedure InitialiseOGL(Window: hWnd; Mode: TSSMode);
const
  light_position: array[0..3] of TGLFloat = (4000, 2000, 6000, 0);
  white_light: array[0..3] of TGLFloat = (1, 1, 1, 1);
  ambient_light: array[0..3] of TGLFloat = (0.2, 0.3, 0.3, 1);

var
  FruH, FruW: Integer;
  R: TRect;
  W, H: Integer;
  RC: HGLRC;
  DC: HDC;
begin
  if InitOpenGl then
  begin
    ReadSettings(Settings);
    SetupPts;
    DC:= GetDC(Window);
    SetDCPixelFormat(DC);
    RC:= wglCreateContext(DC);
    wglMakeCurrent(DC, RC);

    glClearColor(BackColour[0], BackColour[1], BackColour[2], 1);
    glShadeModel(GL_SMOOTH);
    glLightfv(GL_LIGHT0, GL_POSITION, @light_position);
    glLightfv(GL_LIGHT0, GL_DIFFUSE, @white_light);
    glLightfv(GL_LIGHT0, GL_SPECULAR, @white_light);
    glLightfv(GL_LIGHT0, GL_AMBIENT, @ambient_light);
    glEnable(GL_LIGHTING);
    glEnable(GL_LIGHT0);
    glEnable(GL_DEPTH_TEST);

    {resize}
    GetWindowRect(Window, R);
    W:= R.Right - R.Left;
    H:= R.Bottom - R.Top;
    glViewport(0, 0, W, H);
    glMatrixMode(GL_PROJECTION);
    glLoadIdentity;
    FruW:= 1200;
    FruH:= FruW*H div W;
    glFrustum(-FruW, FruW, -FruH, FruH, 3100, 30000);
    with Settings do
       glf:= TglFont.Create(
          TextFont,
          TextItalic,
          TextBold,
          TextOutline,
          FontDepth/10);
    glf.FontHeight:= FruH;
    DoLogo
  end;
end;

procedure DoneOGL(Window: hWnd);
var
  FRC: HGLRC;
  DC: hDC;
begin
  FRC:= wglGetCurrentContext;
  DC:= wglGetCurrentDC;
  wglMakeCurrent(0, 0);
  ReleaseDC(Window, DC);
  wglDeleteContext(FRC);
  glf.Free
end;

end.