代码如下:
控件:
unit XhGLPanel;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls, Dialogs,
  Forms, OpenGL, VectorGeometry;type
  TXhGLDrawMode = (gldmNomal, gldmRubber);
  TXhGLPanel = class(TCustomPanel)
  private
    { Private declarations }
    DC: HDC;
    RC: HGLRC;
    FColor, FBKColor: TColor;    FZoomFactor: Double;
    FOrigX, FOrigY: Double;    procedure InitDC;
    procedure InitGL;    procedure PreparePixelFormat(var DC: HDC);
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;    procedure InitView();
    procedure BeginRubber();
    procedure EndRubber();    procedure SetBKColor(Value: TColor);
    procedure SetColor(Value: TColor);
    procedure SetZoomFactor(Value: Double);
  protected
    { Protected declarations }
    FOnPaint:TNotifyEvent;
    FOnInit:TNotifyEvent;
    FOnPreInit:TNotifyEvent;
    FOnResize:TNotifyEvent;    procedure Paint;override;
    procedure Resize;override;
    procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
    procedure WMCreate(var Msg:TWMCreate); message WM_CREATE;
    procedure CreateParams(var Params: TCreateParams); override;  public
    { Public declarations }
    constructor Create(Owner:TComponent); override;
    procedure Line(X1, Y1, X2, Y2: Double; ADrawMode: TXhGLDrawMode = gldmNomal);
    procedure Circle(X, Y, Radius: Double; ADrawMode: TXhGLDrawMode = gldmNomal);
    procedure Rect(X1, Y1, X2, Y2: Double; ADrawMode: TXhGLDrawMode = gldmNomal);    procedure Move(DX, DY: Double);    procedure ScreenToWorld(var X, Y: Double);
    procedure WorldToScreen(var X, Y: Double);
  published
    { Published declarations }
    property Alignment;
    property Align;
    property DragCursor;
    property DragMode;
    property Enabled;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property BKColor: TColor read FColor write SetBKColor;
    property Color: TColor write SetColor;
    property ZoomFactor: Double read FZoomFactor write SetZoomFactor;    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;    property OnInit:TNotifyEvent read FOnInit write FOnInit;
    property OnPreInit:TNotifyEvent read FOnPreInit write FOnPreInit;    property OnResize:TNotifyEvent read FOnResize write FOnResize;
    property OnPaint:TNotifyEvent read FOnPaint write FOnPaint;
  end;  const
    GL_COLOR_LOGIC_OP = $0BF2;
procedure Register;implementationprocedure Register;
begin
  RegisterComponents('SXH', [TXhGLPanel]);
end;constructor TXhGLPanel.Create;
begin
  inherited;
  FZoomFactor := 0.005;
  FOrigX      := 0.0;
  FOrigY      := 0.0;
  FBKColor    := clBlack;
  Width       := 300;
  Height      := 300;
end;procedure TXhGLPanel.InitDC;
begin
  DC := GetDC(Handle);
  PreparePixelFormat(DC);
end;procedure TXhGLPanel.InitGL;
begin
{
  glViewport(0, 0, ClientWidth, ClientHeight);
  glDisable(GL_LIGHTING);
  //glShadeModel(GL_FLAT);
  glEnable(GL_BLEND);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
  glEnable(GL_DEPTH_TEST);
  //glDepthMask(GL_TRUE);
  glDepthFunc(GL_LESS);  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  glOrtho(0, 300, 300, 0, 0, 1);
  glDisable(GL_DEPTH_TEST);
  glMatrixMode(GL_MODELVIEW);  glLoadIdentity();
}  glViewport(0, 0, ClientWidth, ClientHeight);
  glMatrixMode(GL_PROJECTION);    // 设置当前矩阵为投影矩阵。
  glLoadIdentity();       // 重置当前指定的矩阵为单位矩阵
  glMatrixMode(GL_MODELVIEW);     // 设置当前矩阵为模型视图矩阵
  glLoadIdentity();       // 重置当前指定的矩阵为单位矩阵end;procedure TXhGLPanel.PreparePixelFormat(var DC: HDC);
var
  PFD: TPixelFormatDescriptor;
  PixelFormat: Integer;
begin
  FillChar(PFD, SizeOf(TPixelFormatDescriptor), 0);  with PFD do
  begin
    nSize        := SizeOf(TPixelFormatDescriptor);
    nVersion     := 1;
    dwFlags      := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
    iPixelType   := PFD_TYPE_RGBA;
    cColorBits   := 32;  // 16位颜色
    cStencilBits := 24;
    cDepthBits   := 32;  // 32位深度缓冲
    iLayerType   := PFD_MAIN_PLANE;
  end;  PixelFormat := ChoosePixelFormat(DC, @PFD);
  if PixelFormat = 0 then
    Raise Exception.Create('ChoosePixelFormat failed!');
  SetPixelFormat(DC, PixelFormat, @PFD);
end;procedure TXhGLPanel.WMCreate(var Msg:TWMCreate);
begin
  InitDC;
  RC := wglCreateContext(DC);
  wglMakeCurrent(DC, RC);  InitGL;  if Assigned(FOnInit) then FOnInit(self);
end;procedure TXhGLPanel.WMDestroy(var Msg: TWMDestroy);
begin
  wglMakeCurrent(0, 0);
  wglDeleteContext(RC);
  ReleaseDC(Handle, DC);
end;procedure TXhGLPanel.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  Message.Result := 1;
end;procedure TXhGLPanel.CreateParams(var Params: TCreateParams);
begin
  inherited;
  with Params do
  begin
    Style := Style or WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
    WindowClass.Style := CS_VREDRAW or CS_HREDRAW or CS_OWNDC;
  end;
end;procedure TXhGLPanel.InitView();
var
  W, H: Double;
begin
  W := FZoomFactor / 2 * ClientWidth;
  H := FZoomFactor / 2 * ClientHeight;  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  glOrtho(FOrigX - W, FOrigX + W,
          FOrigY - H, FOrigY + H, -1.0, 1.0);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity();
end;procedure TXhGLPanel.Paint;
var
  OldDC: HDC;
  OldRC: HGLRC;
begin
  OldDC := wglGetCurrentDC();
OldRC := wglGetCurrentContext();
  wglMakeCurrent(DC, RC);  glClearColor(GetRValue(FBKColor), GetGValue(FBKColor), GetBValue(FBKColor), 0.0);
  //glClearDepth(1.0);
  glClear(GL_COLOR_BUFFER_BIT);// or GL_DEPTH_BUFFER_BIT);  InitView();  glLoadIdentity();  if Assigned(FOnPaint) then
  begin
    FOnPaint(Self);
    glFlush();
    SwapBuffers(DC);
  end;  wglMakeCurrent(OldDC, OldRC);
end;procedure TXhGLPanel.Resize;
var
  H: Integer;
  OldDC: HDC;
  OldRC: HGLRC;
begin
  //inherited;  OldDC := wglGetCurrentDC();
OldRC := wglGetCurrentContext();
  wglMakeCurrent(DC, RC);  H := ClientHeight;
  if H = 0 then H := 1;
  glViewport(0, 0, ClientWidth, H);  if Assigned(FOnResize) then FOnResize(Self);  wglMakeCurrent(OldDC, OldRC);end;procedure TXhGLPanel.BeginRubber;
begin
  //glDrawBuffer( GL_FRONT );
  //glDisable( GL_LIGHTING );
  glDepthMask( GL_FALSE );
  glEnable(GL_COLOR_LOGIC_OP);
  glLogicOp(GL_XOR);
end;procedure TXhGLPanel.EndRubber;
begin
  glDisable(GL_COLOR_LOGIC_OP);
  SwapBuffers(DC);
end;procedure TXhGLPanel.Line(X1, Y1, X2, Y2: Double;
  ADrawMode: TXhGLDrawMode = gldmNomal);
var
  IsRubber: Boolean;
begin
  IsRubber := ADrawMode = gldmRubber;
  if IsRubber then BeginRubber;
  glBegin(GL_LINES);
  glVertex2f(X1, Y1);
  glVertex2f(X2, Y2);
  glEnd;
  if IsRubber then EndRubber;
end;procedure TXhGLPanel.Circle(X, Y, Radius: Double;
  ADrawMode: TXhGLDrawMode = gldmNomal);
var
  I, N: Integer;
  s, c : TSingleArray;
  IsRubber: Boolean;
begin
  IsRubber := ADrawMode = gldmRubber;
  if IsRubber then BeginRubber;
  glEnable(GL_LINE_STIPPLE);
  glBegin(GL_LINE_STRIP);
  N := Round(Radius)+10;
  SetLength(s, N);
  SetLength(c, N);
  Dec(N);  PrepareSinCosCache(s, c, 0, 90);
  ScaleFloatArray(s, Radius);
  ScaleFloatArray(c, Radius);  // first quadrant (top right)
  for I := 0 to N do
    glVertex2f(X + c[I], Y - s[I]);
  // second quadrant (top left)
  for I := N-1 downto 0 do
    glVertex2f(X - c[I], Y - s[I]);
  // third quadrant (bottom left)
  for I := 1 to N do
    glVertex2f(X - c[I], Y + s[I]);
  // fourth quadrant (bottom right)
  for I := N - 1 downto 0 do
    glVertex2f(X + c[I], Y + s[I]);  glEnd;  if IsRubber then EndRubber;
end;procedure TXhGLPanel.Rect(X1, Y1, X2, Y2: Double;
  ADrawMode: TXhGLDrawMode = gldmNomal);
var
  IsRubber: Boolean;
begin
  IsRubber := ADrawMode = gldmRubber;
  if IsRubber then BeginRubber;
  glBegin(GL_LINE_LOOP);
  glVertex2f(x1, y1);
  glVertex2f(x2, y1);
  glVertex2f(x2, y2);
  glVertex2f(x1, y2);
  glEnd;
  if IsRubber then EndRubber;
end;procedure TXhGLPanel.SetBKColor(Value: TColor);
var
  R, G, B: Byte;
begin
  FBKColor := Value;
  Invalidate;
end;procedure TXhGLPanel.SetColor(Value: TColor);
var
  R, G, B: Byte;
begin
  R := GetRValue(Value);
  G := GetGValue(Value);
  B := GetBValue(Value);
  glColor3f(R, G, B);
end;procedure TXhGLPanel.SetZoomFactor(Value: Double);
begin
  FZoomFactor := Value;
  Invalidate;
end;procedure TXhGLPanel.Move(DX, DY: Double);
begin
  FOrigX := FOrigX - DX;
  FOrigY := FOrigY - DY;
  Invalidate;
end;procedure TXhGLPanel.ScreenToWorld(var X, Y: Double);
begin
  X := (X - ClientWidth / 2.0) * FZoomFactor + FOrigX;
  Y := -(Y - CLientHeight / 2.0) * FZoomFactor + FOrigY;
end;procedure TXhGLPanel.WorldToScreen(var X, Y: Double);
begin
  X := ((X - FOrigX) / FZoomFactor) + ClientWidth / 2.0;
Y := -((Y - FOrigY) / FZoomFactor) + ClientHeight / 2.0;
end;
end.

解决方案 »

  1.   


    主窗口:
    TForm1 = class(TForm)
        procedure MouseDown(Sender: TObject; Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
        procedure MouseMove(Sender: TObject; Shift: TShiftState; X,
          Y: Integer);
        procedure MouseUp(Sender: TObject; Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
        procedure Button8Click(Sender: TObject);
      private
        { Private declarations }
        XhGLPanel1: TXhGLPanel;
        mX, mY: Double;
        IsMouseDown: Boolean;
      public
        { Public declarations }
      end;var
      Form1: TForm1;implementation{$R *.dfm}
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      XhGLPanel1 := TXhGLPanel.Create(Self);
      XhGLPanel1.Parent  := Self;
      XhGLPanel1.Visible := True;
      //XhGLPanel1.Width   := 400;
      //XhGLPanel1.Height  := 400;
      XhGLPanel1.OnPaint := XhGLPanel1Paint;
      XhGLPanel1.Cursor := crCross;
      //XhGLPanel1.Align   := alClient;
      XhGLPanel1.SendToBack;  XhGLPanel1.OnMouseDown := MouseDown;
      XhGLPanel1.OnMouseMove := MouseMove;
      XhGLPanel1.OnMouseUp := MouseUp;
    end;procedure TForm1.MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    begin
      mX := X;
      mY := Y;
      XhGLPanel1.ScreenToWorld(mX, mY);
      IsMouseDown := True;
    end;procedure TForm1.MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    var
      DX, DY: Double;
    begin
      if IsMouseDown then
      begin
        DX := X;
        DY := Y;
        XhGLPanel1.ScreenToWorld(DX, DY);
        XhGLPanel1.Move(DX - mX, DY - mY);    mX := DX;
        mY := DY;
      end;
    end;procedure TForm1.MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    begin
      IsMouseDown := False;
    end;
      

  2.   

    procedure TForm1.XhGLPanel1Paint(Sender: TObject);
    begin
        XhGLPanel1.Circle(0.1, -0.1, 0.4);
    end;
      

  3.   

    已解决,闪烁是OnPaint的Inherited造成的;
    OpenGL的坐标不是这样的,呵呵,不看书是不行的