1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179:
| unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, OpenGL;
type TForm1 = class(TForm) Button1: TButton; Button2: TButton; Button3: TButton; Panel1: TPanel; Panel2: TPanel; Panel3: TPanel; PaintBox1: TPaintBox; PaintBox2: TPaintBox; PaintBox3: TPaintBox; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); private hrc1, hrc2, hrc3 : HGLRC; dc1, dc2, dc3 : hdc; procedure SetDCPixelFormat(Handle : HDC); public end;
type TFillMemoDemo = class(TThread) private Fwinkel : Single; Fdc : hdc; Fhrc : HGLRC; FData : string; FDelay : integer; procedure DrawScene; protected procedure Execute; override; procedure FillMemo; public constructor Create( const pdc : hdc; const phrc : HGLRC; const p_iDelay : integer); end;
var Form1: TForm1; MyThread1, MyThread2, MyThread3 : TFillMemoDemo;
implementation
{$R *.dfm}
procedure TForm1.SetDCPixelFormat(Handle: HDC); var pfd: TPixelFormatDescriptor; nPixelFormat: Integer; begin FillChar(pfd, SizeOf(pfd), 0); with pfd do begin nSize := sizeof(pfd); nVersion := 1; dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER; iPixelType:= PFD_TYPE_RGBA; cColorBits:= 24; cDepthBits:= 32; iLayerType:= PFD_MAIN_PLANE; end; nPixelFormat := ChoosePixelFormat(Handle, @pfd); SetPixelFormat(Handle, nPixelFormat, @pfd); end;
constructor TFillMemoDemo.Create; begin inherited Create(False); Fwinkel := 0; Fdc := pdc; Fhrc := Phrc; FDelay := p_iDelay; FreeOnTerminate := true; Priority := tpNormal; end;
procedure TFillMemoDemo.DrawScene; begin glLoadIdentity; glRotatef(Fwinkel, 0, 0, 1); glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); glBegin(GL_TRIANGLES); glColor3f(1.0, 0, 0); glVerTex2f(-0.5, -0.5); glColor3f(0, 1.0, 0); glVerTex2f(0.5, -0.5); glColor3f(0, 0, 1.0); glVerTex2f(-0, 0.5); glEnd; SwapBuffers(fDC); end;
procedure TFillMemoDemo.FillMemo; begin FWinkel := FWinkel + 2; if FWinkel >= 360 then FWinkel := 0; wglMakeCurrent(fdc, fhrc); DrawScene; wglMakeCurrent(0, 0); end;
procedure TFillMemoDemo.Execute; begin while not Terminated do begin Synchronize(FillMemo); Sleep(FDelay); end; end;
procedure TForm1.Button1Click(Sender: TObject); begin if Button1.Caption = 'Stop' then begin MyThread1.Terminate; Button1.Caption := 'Start'; end else begin MyThread1 := TFillMemoDemo.Create(dc1, hrc1, 10); Button1.Caption := 'Stop'; end; end;
procedure TForm1.Button2Click(Sender: TObject); begin if Button2.Caption = 'Stop' then begin MyThread2.Terminate; Button2.Caption := 'Start'; end else begin MyThread2 := TFillMemoDemo.Create(dc2, hrc2, 100); Button2.Caption := 'Stop'; end; end;
procedure TForm1.Button3Click(Sender: TObject); begin if Button3.Caption = 'Stop' then begin MyThread3.Terminate; Button3.Caption := 'Start'; end else begin MyThread3 := TFillMemoDemo.Create(dc3, hrc3, 500); Button3.Caption := 'Stop'; end; end;
procedure TForm1.FormCreate(Sender: TObject); begin Button1.Caption := 'Start'; Button2.Caption := 'Start'; Button3.Caption := 'Start'; dc1 := GetDC(Panel1.Handle); dc2 := GetDC(Panel2.Handle); dc3 := GetDC(Panel3.Handle); SetDCPixelFormat(dc1); SetDCPixelFormat(dc2); SetDCPixelFormat(dc3); hrc1 := wglCreateContext(dc1); hrc2 := wglCreateContext(dc2); hrc3 := wglCreateContext(dc3); end;
procedure TForm1.FormDestroy(Sender: TObject); begin wglDeleteContext(hrc1); wglDeleteContext(hrc2); wglDeleteContext(hrc3); end;
end. |