向大家求教：矢量画多边形比例太大时出现异常(200分)

我在做一个缩小放大的矢量画图程序，当比例太大时画多边形出现异常：
屏幕上出现了奇怪的线条。（打印也一样）
这此线条好像是连接到坐标零点（0，0），但跟踪发现，没有一个坐标是为0的。
这是为什么？

下面是实例程序，运行一下就可见分晓。
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
//根据缩放比例和坐标平移输出画图
procedure ExportTo(Cnv: TCanvas; AWidth, AHeight: Integer;
AScale, ACenterX, ACenterY: Double);
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ExportTo(Cnv: TCanvas; AWidth, AHeight: Integer;
AScale, ACenterX, ACenterY: Double);
var
Rect: TRect;
pWinExt, pViewExt: PSize;
pWinOrg, pViewOrg: PPoint;
Imm: Integer;
pPto: PPoint;

procedure SaveGraphicMode;
begin

pWinExt := New(PSize);
pViewExt := New(PSize);
pWinOrg := New(PPoint);
pViewOrg := New(PPoint);
pPto := New(PPoint);
Imm := GetMapMode(Cnv.Handle);
getWindowExtEx(Cnv.Handle, pWinExt^);
getWindowOrgEx(Cnv.Handle, pWinOrg^);
getViewportExtEx(Cnv.Handle, pViewExt^);
GetViewPortOrgEx(Cnv.Handle, pViewOrg^);

end;

procedure MapGraphicMode(Cnv: TCanvas; CvWidth, CvHeight: Integer);
begin //这个映射是为了使屏幕中心为(ACenterX,ACenterY)
SetMapMode(Cnv.Handle, MM_ISOTROPIC);
SetWindowExtEx(Cnv.Handle, Round(360 * 16.0), Round(180 * 16.0), nil);
SetWindowOrgEx(Cnv.Handle, Round(ACenterX), Round(ACenterY), nil);

SetViewportExtEx(Cnv.Handle, CvWidth, -CvHeight, nil);
SetViewportOrgEx(Cnv.Handle, Round(CvWidth / 2), Round(CvHeight / 2), nil);
end;

procedure RestoreGraphicMode;
begin
SetMapMode(Cnv.Handle, Imm);
SetWindowExtEx(Cnv.Handle, pWinExt^.cX, pWinExt^.cY, nil);
SetWindowOrgEx(Cnv.Handle, pWinOrg^.X, pWinOrg^.Y, nil);
SetViewportExtEx(Cnv.Handle, pViewExt^.cX, pViewExt^.cY, nil);
SetViewportOrgEx(Cnv.Handle, pViewOrg^.X, pViewOrg^.Y, nil);
Dispose(pWinExt);
Dispose(pViewExt);
Dispose(pWinOrg);
Dispose(pViewOrg);
Dispose(pPto);
end;

procedure DrawIt;
var
APoints: array[0..4] of TPoint;
VectCounts: array[0..0] of Integer;
PolyCount: Integer;
SclX: Double;
SclY: Double;
OrgX: Double;
OrgY: Double;
function GetDrX(X: Integer): Integer;
var
R: Int64;
begin
R := Round((X - OrgX) * SclX);
if R > High(Integer) then
R := High(Integer)
else if R < Low(Integer) then
R := Low(Integer);
Result := R;
end;
function GetDrY(Y: Integer): Integer;
var
R: Int64;
begin
R := Round((Y - OrgY) * SclY);
if R > High(Integer) then
R := High(Integer)
else if R < Low(Integer) then
R := Low(Integer);
Result := R;
end;
const
RctW = 100;
RctH = 100;
begin
OrgX := ACenterX;
OrgY := ACenterY;
SclX := AScale;
SclY := AScale;

//;左下界:-24176.01, -17054.55
//;右上界:-18897.51, -12732.45
//SetLength(APoints, 5);
APoints[0].X := GetDrX(0);
APoints[0].Y := GetDrY(0);
APoints[1].X := GetDrX(100);
APoints[1].Y := GetDrY(10);
APoints[2].X := GetDrX(110);
APoints[2].Y := GetDrY(110);
APoints[3].X := GetDrX(10);
APoints[3].Y := GetDrY(100);
APoints[4].X := GetDrX(0);
APoints[4].Y := GetDrY(0);
//SetLength(VectCounts, 1);
VectCounts[0] := 5;
PolyCount := 1;
Canvas.Pen.Color := clRed;
Canvas.Brush.Style := bsClear;
PolyPolygon(Canvas.Handle, APoints, VectCounts, PolyCount);
end;
begin
SaveGraphicMode;

Cnv.Pen.Style := psSolid;
Cnv.Pen.Color := Color;
Cnv.Brush.Color := clWhite;
Cnv.Brush.Style := bsSolid;
Rect.Left := 0;
Rect.Top := 0;
Rect.Right :=AWidth ;
Rect.Bottom := AHeight;
Cnv.Rectangle(Rect);
Cnv.Pen.Color := clBlack;
Cnv.Pen.Width := 0;
Cnv.Pen.Style := psSolid;

MapGraphicMode(Cnv, AWidth, AHeight);


Cnv.Pen.Color := clFuchsia;
Cnv.Brush.Style := bsClear;

DrawIt;

RestoreGraphicMode;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ExportTo(Canvas, Width, Height, 10, 50, 50);
//正常
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ExportTo(Canvas, Width, Height, 40000000, 50, 50);
//比例太大就有异赏
end;

end.

怎么没人理我：（
这问题烦死我了，我以后要少用WINAPI，M$的东西不大可靠

你是不是在win98下画的？
98下面的逻辑坐标系设置我记得应该是16位的，不能设得太大
2000下是32位的，当然也有一定的范围
不过ExportTo(Canvas, Width, Height, 40000000, 50, 50);
这里面的40000000在2000下应该是足够的

如果是98的话，还是自己做缩放平移吧。。。。。。。。。。。。。。。。

另外补充一下，2000下的GDI还是有一些函数无法用32位的
比如CreatePolygonRgn,坐标点的坐标大小是有限制的，X,Y不能超过32768...................,点数量也是有限制的
据msdn上说这是由于系统分配给GDI资源有限的限制

你说得很对，WIN98下很多API都只能有16位，但我是在WIN2000下。

CreatePolygonRgn坐标大小有限制，那可能是因为需要很多资源，我觉得可以理解，不能
对Windows要求太高嘛。

我觉得WINDOWS要是出错或资源不足，它就应该报错返回，不该画出来，现在我怎么办？

楼上的说得也很有道理，刚刚查了一下win32下只有2M的GDI资源
看来api真的很不可靠？


我也是做GIS的，也用过win32的逻辑窗口－－》视口的坐标变换来实现缩放
那时我用的坐标值比40000000大也没问题啊,不过多次放大以后也会发生绘图异常
不过这时候
SetWindowExtEx(Cnv.Handle, pWinExt^.cX, pWinExt^.cY, nil);
SetWindowOrgEx(Cnv.Handle, pWinOrg^.X, pWinOrg^.Y, nil);
SetViewportExtEx(Cnv.Handle, pViewExt^.cX, pViewExt^.cY, nil);
SetViewportOrgEx(Cnv.Handle, pViewOrg^.X, pViewOrg^.Y, nil);
里面应该会有返回错误值0的，然后设置回原来的值就行啦

我看mapinfo里面多次放大以后也会异常，难道也是。。。。。。。。。。。。。？

本来想调试一下顶楼的程序
确发现家里的机器没有win2k................
都怪diablo2,2000下不能免cd................

看来这200分要离我而去了

Huzzz，有空交流一下吧
my oicq 2930915
mail:bornkilled@21cn.com

唉！mapinfo无论缩小放大都会有问题，但并不影响整体效果；我的程序却因为这一下
整个画面乱如麻。难道真没办法？

在我看来GIS并不需要用WIN的映射，你应该自己做坐标映射，因为GIS中的地理数据是
多源数据，单一的画布坐标映射是不够的。当然，用WINDOWS的坐标映射是有一些特殊
效果的好处，但它更多的是为图像处理而非CAD考虑的。我用它是因为有些地方使用了
WMF格式需要平移、缩放。

BornKilled：So sorry！我有一个QQ号码，但从未用过，已经忘了。

有办法：必须做裁剪。我的教材《计算机地图制图》中有。
http://c_a_c.myetang.com

裁剪：是个好办法，将坐标范围降低，我试过了，可以。

（不过打印还是有乱线出来，这我就不弄不懂了？？？？？）

对了,yysun老师
http://c_a_c.myetang.com这里刊登的您的大作怎么还是只有1，5，12章啊
好像多年前就是这几章吧
拜托能不能多出几章阿

Huzzz，打印前也应该裁减啊。

BornKilled,
应该向科学出版社去买《计算机地图制图》，不过好象才印了2000本。
我收到读者的 email，说他们在台湾和马来西亚买到了这本书。

要是能买到我就不问了。。。。。。。。。。。。
出版社一般都不肯邮购，本地的新华书店也没有（南京）

yysun老师：
打印和屏幕画图用的是同一个过程ExportTo，只是CANVAS变为打印机的：

with Printer do
begin
if Width >= Height then
begin
X := PageWidth;
Y := PageWidth * Height div Width;
end
else
begin
X := PageHeight * Width div Height;
Y := PageHeight;
end;

Title := PrnTitle;
BeginDoc;

ExportTo(Printer.Canvas, X, Y, Scale, CenterX,CenterY);//XY为宽度和高度

EndDoc;
end;

而且打印出来的图形是超出了窗口（0，0，X，Y）的！？SetViewportExtEx好像不起作用

SOMEBODY HELP ME！大比例画多边形（WINDOWS API），为什么会打印出乱线？

我的程序打印时要提示：“请注意：打印可能会出乱线！是否继续？（Y/N）”
多没面子：`(
不甘心

我的多边形裁剪函数，请多提意见。
第一个参数是你用来裁剪的一个参照多边形区域；
第二个参数是你要裁剪的地物，可以是多边形和折线；
第三个参数是指定要裁剪的地物的类型；1-point,2-line,3-poly

procedure GetClipRgn(GeoRect : TGeoRect;var BufList : TList; ShpType : integer);
var
I,Side : integer; {Side指定剪切边的左、上、右、下}
TempList : TList;
PP : PGeoPoint;
XX,YY : Double;

X1,Y1,X2,Y2 : Double;
Accepted : Boolean;
BufPArray : PXYArray;
IsFirstPointCalc : Integer; //第一点是否是求出来的,1：初始值，2：原来链表值，3：求出的值
begin
for Side := 1 to 4 do begin
TempList := BufList;
BufList := TList.Create;

Accepted := FALSE;
IsFirstPointCalc := 1;
for I := 0 to TempList.Count - 1 do begin
//判断点是否该被取得}
Case Side of
1 : begin
Accepted := PGeoPoint(TempList.Items)^.X > GeoRect.Left;
end;
2 : begin
Accepted := PGeoPoint(TempList.Items)^.Y > GeoRect.Top;
end;
3 : begin
Accepted := PGeoPoint(TempList.Items)^.X < GeoRect.Right;
end;
4 : begin
Accepted := PGeoPoint(TempList.Items)^.Y < GeoRect.Bottom;
end;
end;

if Accepted then begin
GetMem(PP,SizeOf(TGeoPoint));
PP^.X := PGeoPoint(TempList.Items)^.X;
PP^.Y := PGeoPoint(TempList.Items)^.Y;
BufList.Add(PP);
if IsFirstPointCalc = 1 then IsFirstPointCalc := 2;
end;

if I < TempList.Count - 1 then begin
case Side of
1 : begin {左}
X1 := GeoRect.Left; Y1 := GeoRect.Top;
X2 := GeoRect.Left; Y2 := GeoRect.Bottom;
end;
2 : begin {上}
X1 := GeoRect.Left; Y1 := GeoRect.Top;
X2 := GeoRect.Right; Y2 := GeoRect.Top;
end;
3 : begin {右}
X1 := GeoRect.Right; Y1 := GeoRect.Top;
X2 := GeoRect.Right; Y2 := GeoRect.Bottom;
end;
4 : begin
X1 := GeoRect.Left; Y1 := GeoRect.Bottom;
X2 := GeoRect.Right; Y2 := GeoRect.Bottom;
end;
end;

if GetIntersectedPoint(X1,Y1,X2,Y2,PGeoPoint(TempList.Items)^.X,PGeoPoint(TempList.Items)^.Y,PGeoPoint(TempList.Items[I+1])^.X,PGeoPoint(TempList.Items[I+1])^.Y,XX,YY,2) then begin
GetMem(PP,SizeOf(TGeoPoint));
PP^.X := XX;
PP^.Y := YY;
BufList.Add(PP);
if IsFirstPointCalc = 1 then IsFirstPointCalc := 3;
end;
end
else begin
//将多边形封闭}
if ShpType = 3 then begin
if (BufList.Count > 0) and (IsFirstPointCalc = 3) then begin
GetMem(PP,SizeOf(TGeoPoint));
PP^.X := PGeoPoint(BufList.Items[0])^.X;
PP^.Y := PGeoPoint(BufList.Items[0])^.Y;
BufList.Add(PP);
end;
end;
end;
end;{for I}

for I := 0 to TempList.Count - 1 do begin
FreeMem(TempList.Items,SizeOf(TGeoPoint));
end;
TempList.Free;
end;{for Side}
//test
if BufList.Count < 0 then
ShowMessage('Error 3!');
//
end;

//获得X1,Y1,X2,Y2的交点，无交点时返回FALSE,Flag为1时交点必须位于两个矩形交叉区域内，Flag为2时交点为广义交点，即直线的延长线有效
//注意：Flag为2时前四个参数一定为剪切线}
function GetIntersectedPoint(X1,Y1,X2,Y2,X3,Y3,X4,Y4 : Double;var XX,YY : double;Flag : integer):Boolean;
var
K1,K2,B1,B2 : double; {二条直线的斜率}
V1,V2 : Boolean; {有斜率为无穷大的线存在}
// V1,V2 : integer; {1 :初始值,2:TRUE, 3 : FALSE}
begin
//X1,Y1,X2,Y2 为第一条直线,X3,Y3,X4,Y4 为第二条直线}
V1 := FALSE;
V2 := FALSE;

K1 := 1.7 * 10e308;
K2 := 5 * 10 - 324;
B1 := K1;
B2 := K2;
if Abs(X2-X1)>0.00000000001 then begin
K1 := (Y2-Y1)/(X2-X1);
B1 := Y1-K1*X1;
end
else begin
XX := X1;
V1 := TRUE;
end;

if Abs(X4-X3)>0.00000000001 then begin
K2 := (Y4-Y3)/(X4-X3);
B2 := Y3-K2*X3;
end
else begin
XX := X3;
V2 := TRUE;
end;


if (Abs(K1 - K2) < 0.000000000000001) or (V1 and V2) then begin
Result := FALSE;
Exit;
end;

if (not V1) and (not V2) then begin
XX := (B1-B2)/(K2-K1);
YY := K1*XX+B1;
end
else if V2 then begin
YY := K1*XX+B1;
end else begin
YY := K2*XX+B2;
end;

if Flag = 1 then begin
//如果计算出来的交点位于两个矩形的公共区域，则为真交点}
if (IsPtInRect(XX,YY,X1,Y1,X2,Y2)) and (IsPtInRect(XX,YY,X3,Y3,X4,Y4)) then
result := TRUE
else
result := FALSE;
end
else
if Flag = 2 then begin
if (IsPtInRect(XX,YY,X3,Y3,X4,Y4)) then
result := TRUE
else
result := FALSE;
end;
end;

function IsPtInRect(X, Y: Double; X1,Y1,X2,Y2 : double):Boolean;
const
Buf : double = 10e-10;
begin
Result := (X > MinValue([X1,X2])- Buf) and (X < MaxValue([X1,X2]) + Buf) and (Y > MinValue([Y1,Y2]) - Buf) and (Y < MaxValue([Y1,Y2]) + Buf);
end;

吕兄：非常感谢！这么多东西，我得先去研究一下

一定要用画图窗口矩形去裁剪吗？直接由WINDOWS设置画图区不行吗？

另：你的程序有C++风格啊（我喜欢）！
另：我觉得那个求两线段交点的函数写得好，佩服！

裁剪，原来是这样！非常感谢大家的帮助