- 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;
- 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); // Size of this structure
- nVersion := 1; // Version number
- dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER; // Flags
- iPixelType:= PFD_TYPE_RGBA; // RGBA pixel values
- cColorBits:= 24; // 24-bit color
- cDepthBits:= 32; // 32-bit depth buffer
- iLayerType:= PFD_MAIN_PLANE; // Layer type
- 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.