unit unit_oglframe00;
{$mode delphi}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Dialogs,
LCLIntf, Graphics,
OpenGLContext, gl, glu;
type
{ TOGLFrame00 }
TOGLFrame00 = class(TFrame)
private
{ private declarations }
MyObj: TObject;
public
{ public declarations }
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
end;
TOGLControl = Class(TOpenGLControl)
private
{ private declarations }
public
{ public declarations }
procedure Idle(Sender:TObject; var Done:boolean);
procedure MouseMI(Sender: TOBject);
procedure MouseMO(Sender: TOBject);
procedure Move(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure DnKey(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure Wheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure ZoomSheet(Zoom: Boolean);
procedure FillSheet(Sender: TObject);
procedure MakeGrids();
procedure SetColors();
end;
TGridPointX = Record
GPointX: Integer;
XLocalD: Double;
XLocalS: String;
XMajorG: Boolean;
end;
TGridPointY = Record
GPointY: Integer;
YLocalD: Double;
YLocalS: String;
YMajorG: Boolean;
end;
var
OGLFrame00: TOGLFrame00;
OGLControl: TOGLControl;
GridArrayX: Array of TGridPointX;
GridArrayY: Array of TGridPointY;
MouseX: TGridPointX;
MouseY: TGridPointY;
SPointA: TPoint;
SPointB: TPoint;
RPointA: TPoint;
RPointB: TPoint;
BaseLevel: Double;
ZoomLevel: Double;
CursR: Byte;
CursG: Byte;
CursB: Byte;
MajGR: Byte;
MajGG: Byte;
MajGB: Byte;
MinGR: Byte;
MinGG: Byte;
MinGB: Byte;
BackR: Byte;
BackG: Byte;
BackB: Byte;
implementation
uses
unit_main,
unit_schvars00;
constructor TOGLFrame00.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
MyObj := TObject.Create;
OGLControl := TOGLControl.Create(OGLFrame00);
With OGLControl do
begin
Align := alClient;
Parent := Self;
Cursor := crNone;
OnResize := FillSheet;
OnMouseMove := Move;
OnMouseWheel := Wheel;
OnKeyDown := DnKey;
OnMouseEnter := MouseMI;
OnMouseLeave := MouseMO;
Application.OnIdle := Idle;
AutoResizeViewport := true;
end;
end;
destructor TOGLFrame00.Destroy;
begin
SetLength(GridArrayX,0);
SetLength(GridArrayY,0);
OGLControl.Free;
MyObj.Free;
inherited Destroy;
end;
procedure TOGLControl.MouseMI(Sender: TOBject);
begin
OGLControl.SetFocus;
end;
procedure TOGLControl.MouseMO(Sender: TOBject);
begin
Form1.Memo1.SetFocus;
end;
procedure TOGLControl.Move(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
Index: Integer;
begin
If (X > RPointA.X) and (X < RPointB.X) then
begin
Index := Trunc(High(GridArrayX)*(X - RPointA.X)/(RPointB.X - RPointA.X));
If Index > High(GridArrayX) then Index := High(GridArrayX);
If Index < 0 then Index := 0;
MouseX.GPointX := GridArrayX[Index].GPointX;
MouseX.XLocalD := GridArrayX[Index].XLocalD;
MouseX.XLocalS := GridArrayX[Index].XLocalS;
end;
If (Y > RPointA.Y) and (Y < RPointB.Y) then
begin
Index := Trunc(High(GridArrayY)*(Y - RPointA.Y)/(RPointB.Y - RPointA.Y));
If Index > High(GridArrayY) then Index := High(GridArrayY);
If Index < 0 then Index := 0;
MouseY.GPointY := GridArrayY[Index].GPointY;
MouseY.YLocalD := GridArrayY[Index].YLocalD;
MouseY.YLocalS := GridArrayY[Index].YLocalS;
end;
end;
procedure TOGLControl.Wheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
If WheelDelta > 0 then ZoomSheet(Boolean(0))
else ZoomSheet(Boolean(1));
end;
procedure TOGLControl.DnKey(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
Case Key of
33: ZoomSheet(Boolean(1));
34: ZoomSheet(Boolean(0));
35: FillSheet(Nil);
end;
end;
procedure TOGLControl.FillSheet(Sender: TObject);
begin
With unit_schvars00.SCHVars do
begin
If SheetX/OGLControl.Width >= SheetY/OGLControl.Height
then BaseLevel := (OGLControl.Width - 20)/SheetX
else BaseLevel := (OGLControl.Height - 20)/SheetY;
end;
ZoomLevel := 1;
MakeGrids();
end;
procedure TOGLControl.ZoomSheet(Zoom: Boolean);
begin
If Zoom then ZoomLevel := ZoomLevel*SQRT(2)
else ZoomLevel := ZoomLevel/SQRT(2);
MakeGrids();
end;
procedure TOGLControl.MakeGrids();
var
Count: Integer;
Width: Integer;
PointI: Integer;
PointD: Double;
DGrid: Double;
IGrid: Double;
ZoomTotal: Double;
begin
With unit_schvars00.SCHVars do
begin
ZoomTotal := BaseLevel*ZoomLevel;
DGrid := SchMult/SchDivi;
IGrid := DGrid*ZoomTotal;
SPointA.X := Trunc(OGLControl.Width div 2 - ZoomTotal*SheetX/2);
SPointA.Y := Trunc(OGLControl.Height div 2 - ZoomTotal*SheetY/2);
SPointB.X := Trunc(OGLControl.Width div 2 + ZoomTotal*SheetX/2);
SPointB.Y := Trunc(OGLControl.Height div 2 + ZoomTotal*SheetY/2);
RPointA.X := SPointA.X;
RPointA.Y := SPointA.Y;
RPointB.X := SPointB.X;
RPointB.Y := SPointB.Y;
If RPointA.X < 0 then RPointA.X := -1;
If RPointA.Y < 0 then RPointA.Y := -1;
If RPointB.X > OGLControl.Width then RPointB.X := OGLControl.Width + 1;
If RPointB.Y > OGLControl.Height then RPointB.Y := OGLControl.Height + 1;
Count := Trunc((RPointA.X - SPointA.X)/IGrid);
PointI := Trunc(SPointA.X + Count * IGrid);
Width := 1;
While PointI < RPointB.X do
begin
PointD := Count * DGrid;
PointI := Trunc(SPointA.X + Count * IGrid);
SetLength(GridArrayX,Width);
GridArrayX[Width-1].GPointX := PointI;
GridArrayX[Width-1].XLocalD := PointD;
GridArrayX[Width-1].XLocalS := FloatToStrF(PointD,ffFixed,5,5);
If Count mod SchDivi = 0
then GridArrayX[Width-1].XMajorG := True
else GridArrayX[Width-1].XMajorG := False;
INC(Count);
INC(Width);
end;
If GridArrayX[High(GridArrayX)].GPointX > SPointB.X
then SetLength(GridArrayX,Length(GridArrayX) - 1);
Count := Trunc((RPointA.Y - SPointA.Y)/IGrid);
PointI := Trunc(SPointA.Y + Count * IGrid);
Width := 1;
While PointI < RPointB.Y do
begin
PointD := Count * DGrid;
PointI := Trunc(SPointA.Y + Count * IGrid);
SetLength(GridArrayY,Width);
GridArrayY[Width-1].GPointY := PointI;
GridArrayY[Width-1].YLocalD := PointD;
GridArrayY[Width-1].YLocalS := FloatToStrF(PointD,ffFixed,5,5);
If Count mod SchDivi = 0
then GridArrayY[Width-1].YMajorG := True
else GridArrayY[Width-1].YMajorG := False;
INC(Count);
INC(Width);
end;
If GridArrayY[High(GridArrayY)].GPointY > SPointB.Y
then SetLength(GridArrayY,Length(GridArrayY) - 1);
end;
end;
procedure TOGLControl.SetColors();
begin
With unit_schvars00.SCHVars do
begin
CursR := GetRValue(CursCol);
CursG := GetGValue(CursCol);
CursB := GetBValue(CursCol);
MajGR := GetRValue(MajGCol);
MajGG := GetGValue(MajGCol);
MajGB := GetBValue(MajGCol);
MinGR := GetRValue(MinGCol);
MinGG := GetGValue(MinGCol);
MinGB := GetBValue(MinGCol);
BackR := GetRValue(BackCol);
BackG := GetGValue(BackCol);
BackB := GetBValue(BackCol);
end;
end;
procedure TOGLControl.Idle(Sender:TObject; var Done:boolean);
var
Count: Integer;
begin
glClearColor(1, 1, 1, 1);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glMatrixMode (GL_PROJECTION);
glLoadIdentity();
glOrtho (0, OGLControl.Width, OGLControl.Height, 0, 0, 1);
glDisable(GL_DEPTH_TEST);
glMatrixMode (GL_MODELVIEW);
glLoadIdentity();
glColor3f(BackR/255, BackG/255, BackB/255);
glBegin(GL_QUADS);
glVertex2f(RPointA.X,RpointA.Y);
glVertex2f(RPointB.X,RpointA.Y);
glVertex2f(RPointB.X,RpointB.Y);
glVertex2f(RPointA.X,RpointB.Y);
glEnd();
With unit_schvars00.SCHVars do
begin
If SchGMin then
begin
glColor3f(MinGR/255, MinGG/255, MinGB/255);
Count := 0;
While Count < High(GridArrayX) do
begin
glBegin(GL_LINES);
glVertex2f(GridArrayX[Count].GPointX, RPointA.Y);
glVertex2f(GridArrayX[Count].GPointX, RPointB.Y);
glEnd;
Count := Count + 1;
end;
Count := 0;
While Count < High(GridArrayY) do
begin
glBegin(GL_LINES);
glVertex2f(RPointA.X, GridArrayY[Count].GPointY);
glVertex2f(RPointB.X, GridArrayY[count].GPointY);
glEnd;
Count := Count + 1;
end;
end;
If SchGMaj then
begin
glColor3f(MajGR/255, MajGG/255, MajGB/255);
Count := SchDivi;
While Count < High(GridArrayX) do
begin
glBegin(GL_LINES);
glVertex2f(GridArrayX[Count].GPointX, RPointA.Y);
glVertex2f(GridArrayX[Count].GPointX, RPointB.Y);
glEnd;
Count := Count + SchDivi;
end;
Count := SchDivi;
While Count < High(GridArrayY) do
begin
glBegin(GL_LINES);
glVertex2f(RPointA.X, GridArrayY[Count].GPointY);
glVertex2f(RPointB.X, GridArrayY[count].GPointY);
glEnd;
Count := Count + SchDivi;
end;
end;
end;
glColor3f(0, 0, 1);
glBegin(GL_LINE_LOOP);
glVertex2f(RPointA.X,RpointA.Y);
glVertex2f(RPointB.X,RpointA.Y);
glVertex2f(RPointB.X,RpointB.Y);
glVertex2f(RPointA.X,RpointB.Y);
glEnd();
glColor3f(CursR/255, CursG/255, CursB/255);
glBegin(GL_LINES);
glVertex2f(MouseX.GPointX,0);
glVertex2f(MouseX.GPointX,OGLControl.Height);
glEnd;
glBegin(GL_LINES);
glVertex2f(0,MouseY.GPointY);
glVertex2f(OGLControl.Width,MouseY.GPointY);
glEnd;
glFlush;
OGLControl.SwapBuffers;
Done := True;
Form1.Status.Panels[0].Text := MouseX.XLocalS;
Form1.Status.Panels[1].Text := MouseY.YLocalS;
end;
initialization
{$I unit_oglframe00.lrs}
end.