📄 graphwin.pas.~92~
字号:
procedure TForm1.Open1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
CurrentFile := OpenDialog1.FileName;
SaveStyles;
Image.Picture.LoadFromFile(CurrentFile);
RestoreStyles;
end;
end;
procedure TForm1.Save1Click(Sender: TObject);
var
MYJPEG: TJPEGImage;
begin
if CurrentFile <> EmptyStr then
if Pos('.jps', CurrentFile) <> 0 then
begin
MYJPEG := TJPEGImage.Create;
with MYJPEG do
begin
Assign(Image.Picture.Bitmap);
SaveToFile(CurrentFile); // 保存路径
Free;
end
end
else
Image.Picture.SaveToFile(CurrentFile) // 具体执行保存过程
else
Saveas1Click(Sender);
end;
procedure TForm1.Saveas1Click(Sender: TObject);
begin
if SaveDialog1.Execute then
begin
CurrentFile := SaveDialog1.FileName;
Save1Click(Sender);
end;
end;
procedure TForm1.New1Click(Sender: TObject);
var
Bitmap: TBitmap;
begin
NewBMPForm := TNewBMPForm.Create(Self);
with NewBMPForm do
begin
ActiveControl := WidthEdit;
WidthEdit.Text := IntToStr(Image.Picture.Graphic.Width);
HeightEdit.Text := IntToStr(Image.Picture.Graphic.Height);
if ShowModal <> idCancel then
begin
Bitmap := nil;
try
Bitmap := TBitmap.Create;
Bitmap.Width := StrToInt(WidthEdit.Text);
Bitmap.Height := StrToInt(HeightEdit.Text);
SaveStyles;
Image.Picture.Graphic := Bitmap;
RestoreStyles;
CurrentFile := EmptyStr;
finally
Bitmap.Free;
end;
end;
end;
NewBMPForm.Free;
end;
procedure TForm1.Copy1Click(Sender: TObject);
begin
Clipboard.Assign(Image.Picture);
end;
procedure TForm1.Cut1Click(Sender: TObject);
var
ARect: TRect;
begin
Copy1Click(Sender);
with Image.Canvas do
begin
CopyMode := cmWhiteness;
ARect := Rect(0, 0, Image.Width, Image.Height);
CopyRect(ARect, Image.Canvas, ARect);
CopyMode := cmSrcCopy;
end;
end;
procedure TForm1.Paste1Click(Sender: TObject);
var
Bitmap: TBitmap;
begin
if Clipboard.HasFormat(CF_BITMAP) then
begin
Bitmap := TBitmap.Create;
try
Bitmap.Assign(Clipboard);
Image.Canvas.Draw(0, 0, Bitmap);
finally
Bitmap.Free;
end;
end;
end;
procedure TForm1.SaveStyles;
begin
with Image.Canvas do
begin
BrushStyle := Brush.Style;
PenStyle := Pen.Style;
PenWide := Pen.Width;
end;
end;
procedure TForm1.RestoreStyles;
begin
with Image.Canvas do
begin
Brush.Style := BrushStyle;
Pen.Style := PenStyle;
Pen.Width := PenWide;
end;
end;
{ 这个过程实现将点的世界坐标系转换为图像坐标系，即计算点的立体图像对 }
procedure ConvertWCSToICS(vPd (*屏幕到眼睛所在平面的距离*): Real; var
p3D: T3DPoint);
begin
// 算点p3D的立体图像对的坐标
with p3D do
begin
I1X := Round(((X - h) * vPd / Z) * 28.35 + 1293.14);
// 1293.14 = 400 +800 + 3.25 * 28.35
I1Y := Round((Y * vPd / Z) * 28.35 + 300);
I2X := Round(((X + h) * vPd / Z) * 28.35 + 307.86);
// 400 - 3.25 * 28.35 = 307.86
I2Y := I1Y;
end;
end;
procedure DrawLine(var s3D, d3D: T3DPoint);
begin
// 绘制s3D的I2和I1，绘成圆，外接正方形边长为4个像素
with Form1.Image.Canvas do
begin
with s3D do
begin
Ellipse(I2X - 2, I2Y - 2, I2X + 2, I2Y + 2);
// 左眼看到的点I2，绘制在左图
Ellipse(I1X - 2, I1Y - 2, I1X + 2, I1Y + 2);
// 右眼看到的点I1，绘制在右图
end;
// 绘制d3D的I2和I1，绘成圆，外接正方形边长为4个像素
with d3D do
begin
Ellipse(I2X - 2, I2Y - 2, I2X + 2, I2Y + 2);
// 左眼看到的点I2，绘制在左图
Ellipse(I1X - 2, I1Y - 2, I1X + 2, I1Y + 2);
// 右眼看到的点I1，绘制在右图
end;
// 连接s3D的I2和d3D的I2
MoveTo(s3D.I2X, s3D.I2Y);
LineTo(d3D.I2X, d3D.I2Y);
// 连接s3D的I1和d3D的I1
MoveTo(s3D.I1X, s3D.I1Y);
LineTo(d3D.I1X, d3D.I1Y);
end;
end;
procedure DrawPolygon(var s1_3D, s2_3D, s3_3D, s4_3D: T3DPoint);
begin
with Form1.Image.Canvas do
begin
// 填充左眼看到的面
Polygon([Point(s1_3D.I2X, s1_3D.I2Y), Point(s2_3D.I2X, s2_3D.I2Y),
Point(s3_3D.I2X, s3_3D.I2Y), Point(s4_3D.I2X, s4_3D.I2Y)]);
// 填充左眼看到的面
Polygon([Point(s1_3D.I1X, s1_3D.I1Y), Point(s2_3D.I1X, s2_3D.I1Y),
Point(s3_3D.I1X, s3_3D.I1Y), Point(s4_3D.I1X, s4_3D.I1Y)]);
end;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////
// 图像像素单位与厘米单位对应关系：1cm = 28.35px；h = 3.25cm；
// 默认值Pd = 40cm，Od = 80cm
// 这个过程绘制立体直线，端点分别是W和U。W在世界坐标系中的坐标默认为(5cm, 5cm, 80cm),
// 对应在α平面（计算机平面）内的立体图像对为I1(4.125, 2.5, 40)，I2(0.875, 2.5, 40)。U在世界
// 坐标系中的坐标为(15, 15, 80)，对应在α平面内的立体图像对为K1(9.125, 7.5, 40)，
// K2(5.875, 7.5, 40)。图片尺寸为800像素*600像素。布局为左图(左眼所见)/右图(右眼所见)
// 则：I1(4.125, 2.5, 40)通过4.125×28.35＝116.94375，2.5×28.35＝70.875，
// 得到I1(116.94375, 70.875)取整得I1(117, 71)再加上I1x+400+800=117+1200，I1y+300=371
// 得到I1(1317, 371)，(右眼所见)
// I2(0.875, 2.5, 40)通过0.875×28.35＝24.806，2.5×28.35＝70.875得到I2(24.806, 70.875)
// 取整得到I2(25, 71)再加上I2x+400=117+400，I2y+300=371坐标系平移得到I2(517, 363)，(左眼所见) 。
// K1(8.75, 7.5, 40)通过8.75×28.35＝240.06，7.5×28.35＝212.625得到K1(240.06, 212.625)
// 取整得到K1(240, 213)加上（1200，300）像素的坐标系平移量得K1(1440,513)
// K2(6.25, 7.5, 40) 通过6.25×28.35＝177.18，7.5×28.35＝212.625得K2(177.18，212.625)
// 取整得K2(177，213)加（400，300）坐标系平移K2(577，513)。
////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////
// 负视差情形
// 图像像素单位与厘米单位对应关系：1cm = 28.35px；h = 3.25cm；
// 默认值Pd = 40cm，Od = 20cm
// 这个过程绘制立体直线，端点分别是W和U。W在世界坐标系中的坐标默认为(5cm, 5cm, 20cm),
// 对应在α平面（监视器屏幕）内的立体图像对为I1(6.75, 10, 40)，I2(13.25, 10, 40)。U在世界
// 坐标系中的坐标为(15, 15, 20)，对应在α平面内的立体图像对为K1(26.75, 30, 40)，
// K2(33.25, 30, 40)。图片尺寸为800像素*600像素。布局为左图(左眼所见)/右图(右眼所见)
// 则：I1(6.75, 10, 40)通过6.75×28.35＝191.3625，10×28.35＝283.5，
// 得到I1(191.3625, 283.5)取整得I1(191, 283)再加上I1x+400+800=191+1200，I1y+300=583
// 得到I1(1391, 583)，(右眼所见)
// I2(13.25, 10, 40)通过13.25×28.35＝375.6375，10×28.35＝283.5得到I2(375.6375, 283.5)
// 取整得到I2(376, 283)再加上I2x+400=376+400，I2y+300=583坐标系平移得到I2(767, 583)，(左眼所见) 。
// K1(26.75, 30, 40)通过26.75×28.35＝757.025，30×28.35＝850.5得到K1(757.025, 850.5)
// 取整得到K1(757, 850)加上（1200，300）像素的坐标系平移量得K1(1957,1150)
// K2(33.25, 30, 40)通过33.25×28.35＝942.6375，30×28.35＝850.5得K2(942.6375，850.5)
// 取整得K2(943，850)加(400，300)坐标系平移K2(1343，1150)。
////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TForm1.miCubeClick(Sender: TObject);
var
i: Integer; // 循环变量
begin
OKBottomDlg := TOKBottomDlg.Create(Self);
OKBottomDlg.ShowModal;
OKBottomDlg.Free;
if U.Z = 0 then
Exit;
// 清除画布
FormCreate(Sender);
// 保存原来的Styles
SaveStyles;
// 设置线型、颜色
with Image.Canvas do
begin
Pen.Style := psSolid;
Pen.Width := 3;
Brush.Color := clGray;
end;
with sCube do
begin
// 计算立方体各顶点在世界坐标系中的坐标
// A
with vertex[0] do
begin
X := cX - hLen;
Y := cY - hLen;
Z := cZ - hLen;
end;
// B
with vertex[1] do
begin
X := cX + hLen;
Y := cY - hLen;
Z := cZ - hLen;
end;
// C
with vertex[2] do
begin
X := cX + hLen;
Y := cY + hLen;
Z := cZ - hLen;
end;
// D
with vertex[3] do
begin
X := cX - hLen;
Y := cY + hLen;
Z := cZ - hLen;
end;
// E
with vertex[4] do
begin
X := cX - hLen;
Y := cY - hLen;
Z := cZ + hLen;
end;
// F
with vertex[5] do
begin
X := cX + hLen;
Y := cY - hLen;
Z := cZ + hLen;
end;
// G
with vertex[6] do
begin
X := cX + hLen;
Y := cY + hLen;
Z := cZ + hLen;
end;
// H
with vertex[7] do
begin
X := cX - hLen;
Y := cY + hLen;
Z := cZ + hLen;
end;
// 计算各点的立体图像对
for i := 0 to 7 do
ConvertWCSToICS(Pd, vertex[i]);
{ 填充各个面 }
// 填充AEHD
DrawPolygon(vertex[0], vertex[4], vertex[7], vertex[3]);
// 填充BFGC
DrawPolygon(vertex[1], vertex[5], vertex[6], vertex[2]);
// 填充AEFB
DrawPolygon(vertex[0], vertex[4], vertex[5], vertex[1]);
// 填充DHGC
DrawPolygon(vertex[3], vertex[7], vertex[6], vertex[2]);
end;
with Image.Canvas do
begin
// 算点W的立体图像对的坐标
W.I1X := Round(((W.X - h) * Pd / W.Z) * 28.35 + 1293.14);
// 1293.14 = 400 +800 + 3.25 * 28.35
W.I1Y := Round((W.Y * Pd / W.Z) * 28.35 + 300);
W.I2X := Round(((W.X + h) * Pd / W.Z) * 28.35 + 307.86);
// 400 - 3.25 * 28.35 = 307.86
W.I2Y := W.I1Y;
U.I1X := Round(((U.X - h) * Pd / U.Z) * 28.35 + 1293.14);
// 1293.14 = 400 +800 + 3.25 * 28.35
U.I1Y := Round((U.Y * Pd / U.Z) * 28.35 + 300);
U.I2X := Round(((U.X + h) * Pd / U.Z) * 28.35 + 307.86);
// 400 - 3.25 * 28.35 = 307.86
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -