三维立体画原代码（不是zswang写的那个），谁能用D6重新写下？

应该是很容易，没用一个控件，只是他用的Borland Pascal for Windows版本太老了，里面有个不知名的函数，用于指针的操作，高手应该能搞的定吧！

我将关键的代码贴在这里吧，看看整理下就好了
const
  Max_Sird_Size = 2048;     { Change this and DialogBox in SIRD.RES, if needed }
type
  { Generic Type for RGB and depth maps }
  MapType    = record
                 XRes,YRes   : longint;
                 BaseAdr     : Pointer;  { South-West corner! }
                 BytesPerLine: longint;
                 MemHandle   : THandle;
               end;  DepthType  = MapType;  { Type for Depth Pictures }
  RGBMapType = MapType;  { Type for Texture Picture }  PtrRec         = record Lo, Hi: Word end;    { to get from longints to seg:ofs }
  TexToUseType = (UseRandomDots,UseColoredRandomDots,UseTexturePicture);  { Type of array to hold constraints: }
  SameArrType  = array[0..Max_Sird_Size-1] of integer;  { Type of array to hold pixels for one SIRD line: }
  PixArrType   = array[0..Max_Sird_Size-1] of record r,g,b: byte; end;这是用到的几个函数
procedure incP1(var p: pointer); (* increments p by 1 *)
var newp: longint;
begin
  longint(p):=longint(p)+1;
  if loWord(longint(p))=0 then p:=pointer(longint(p)+__AddSegInc)
end;procedure incP(var p: pointer; toAdd: word); (* increments p by toAdd *)
var newp: longint;
begin
  newp:=longint(p)+toAdd;
  if loWord(newp)<loWord(longint(p)) then p:=pointer(newp+__AddSegInc)
  else p:=pointer(newp);
end;procedure decP(var p: pointer; toSubtract: word); (* decrements p by toAdd *)
var newp: longint;
begin
  newp:=longint(p)-toSubtract;
  if loWord(newp)>loWord(longint(p)) then p:=pointer(newp-__AddSegInc)
  else p:=pointer(newp);
end;function ADDToBase(p: pointer; l:longint): pointer;
{ 如果能解决这个函数我就成功了Adds l to the pointer p. p must have the offset 0. }
begin
  ADDToBase:=ptr(ptrrec(p).hi+ PtrRec(l).hi*Ofs(AHIncr),ptrrec(l).lo);
end;关键部分
procedure MakeSameArr(pDepth: pointer; xDepthStep: single; Cnt: integer;
                      EyeDist: single; Resolution: integer;
                      var SameArr: SameArrType);
{这个函数没问题，不用修改
  Calculation of constraints for one scan line in the SIRD output.  pDepth     points to the memory with the depth information for this
             line (one byte per pixel, 0 is far away, 255 is nearby)  xDepthStep is the step size to do in the depth buffer for one step
             in the SIRD line. This variable is needed, because the
             depth picture resolution and the SIRD-Resolution don磘
             have to be the same.  Cnt        is the number of Pixels in one SIRD output line.  EyeDist    is the distance of the eyes in Inch.  Resolution is the output resolution of the SIRD in DPI.  SameArr    holds the Result of the procedure. It磗 funct6ionality
             is explained in the text.
}const zScal=1.0/255.0;    { Depth scaling factor                       }
      mu   =1.0/3.0;      { Distance of the near plane to the far      }var   x         : integer;{ Position in the SIRD line                  }
      xdo,xd    : integer;{ old, actual position in the depth buffer   }
      depx      : single; { real actual position in depth buffer       }
      p,ph      : pointer;{ pointers into depth buffer                 }
      Z         : single; { normalized depth buffer value at x         }
      Zorg      : integer;{ unnormalized depth buffer value at x       }
      E         : single; { Eyes distance [in pixels of the SIRD]      }
      left,right: integer;{ separated projections of the actual pixels }
      s         : integer;{ separation [in pixels of the SIRD]         }
      visible   : boolean;{ true, if both eyes can see the point       }
      t,ts,zt   : integer;{ used for hidden surface removal            }
      ft        : single; { used for hidden surface removal            }
      l         : integer;{ value of SameArr[left], see text           }begin
  for x:=0 to Cnt-1 do SameArr[x]:=x; { All values are "unconstrained" }
  E:=round(EyeDist*Resolution);       { EyeDist [in pixels of the SIRD]}
  ft:=2/(zScal*mu*E);                 { Factor for hidden surface      }
  depx:=0; xdo:=0; xd:=0; p:=pDepth;  { Set up step variables and ptr. }
  for x:=0 to Cnt-1 do begin          { for all x of the SIRD line:    }
    Zorg:=byte(p^);                   { Get the depth                  }
    Z:=zorg * zScal;                  { Scale it to 0.0..1.0           }
    s:=round((1.0-mu*Z)*E/(2.0-mu*Z));      { Calculate separation     }
    left:=x-s div 2; right:=left+s;         { this would be seen       }
    if (0<=left) and (right<Cnt) then begin { if both are in the SIRD: }
      t:=1;               { test x+-t, whether it hides x, start at t=1}
      repeat
        zt:=Zorg+round((2-mu*z)*t*ft); { the biggest z allowed (0..255)}
        ts:=round(t*xDepthStep);       { transform t into  depth buffer}
        ph:=p; decP(ph,ts);            { get depth pixel at x-t        }
        visible:=byte(ph^)<zt;         { is it hiding the pixel at x?  }
        if visible then begin          { no? May be the one at x+t does}
          ph:=p; incP(ph,ts);          { get depth pixel at x+t        }
          visible:=byte(ph^)<zt;       { is it hiding the pixel at x?  }
        end;
        inc(t);                          { For the next time           }
      until (not visible) or (zt>255); { until hidden or in front of }
      if visible then begin              { if seen from both eyes:     }
        l:=SameArr[left];                         { set up l, see text }
        while (l<>left) and (l<>right) do begin   { ---- see text ---- }
          if (l<right) then begin                 { ---- see text ---- }
            left:=l; l:=SameArr[left];            { ---- see text ---- }
          end else begin                          { ---- see text ---- }
            SameArr[left]:=right; left:=right;    { ---- see text ---- }
            l:=SameArr[left]; right:=l;           { ---- see text ---- }
          end;                                    { ---- see text ---- }
        end;                                      { ---- see text ---- }
        SameArr[left]:=right;                     { Set the constraint }
      end;
    end;
    depx:=depx+xDepthStep;       { Do a real step for the depth buffer }
    xd:=round(depx);             { This is the integer coordinate of it}
    incP(p,xd-xdo);              { Get the next depth address          }
    xdo:=xd;                     { For the next address-increment      }
  end;
end;

procedure TMainWindow.CMDoSIRD(var Msg: TMessage);
{这段代码是执行过程，连窗口都是动态创建的
说明：这里有三个图象分别是TheDepth(http://xianjun.vicp.net/temp/504524.jpg)，TheRGBMap(http://xianjun.vicp.net/temp/mask-4.bmp)，TheSIRD，你可以用TBitmap来代替。TheDepth是前景，TheRGBMap是背景，TheSIRD为输出图象 Calculate the complete SIRD }
var BytesNeeded,BytesPerLine: longint;
    oldCur: HCursor;
    ThisSortOfTex: TexToUseType;
    y:integer;
    pSird,pS,pDepth,pDeptho,pTex: pointer;
    DepthXStep,DepthYStep: single;
    x: integer;
    MaxSep: integer;
    xtex,ytex:integer;
    texstep:single;
begin
  if SIRDBMPWind<>NIL then SIRDBMPWind^.Done;
  if TexBMPWind<>Nil then TexBMPWind^.Redraw(Nil);
  if DepthBMPWind<>Nil then DepthBMPWind^.Redraw(Nil);
  ThisSortOfTex:=SortOfTexToUse;
  if (ThisSortOfTex=UseTexturePicture) and (TexBMPWind=Nil) then begin
    messagebox(HWindow,'Texture enabled but not loaded, choose one!',
                       'SIRD', MB_TASKMODAL or MB_ICONEXCLAMATION or MB_OK);
    ThisSortOfTex:=UseRandomDots;
  end;
  OldCur:=SetCursor(LoadCursor(0, idc_Wait));
  (* Generate DIB for the SIRD: *)
  BytesPerLine:=(XRes*3+3) and not 3;
  BytesNeeded:=BytesPerLine * YRes;
  TheSIRD.XRes:=XRes;
  TheSIRD.YRes:=YRes;
  with TheSIRD do begin
    HasPal:=FALSE;
    DIBMemHandle:=GlobalAlloc(gmem_Moveable, BytesNeeded);
    if DIBMemHandle<>0 then PixMem := GlobalLock(DIBMemHandle) else exit;
    with BitMapInfo.bmiHeader do begin
      biSize:=sizeof(TBitMapInfoHeader);
      biWidth:=XRes;          biHeight:=YRes;
      biPlanes:=1;            biBitCount:=24;
      biCompression:=BI_RGB;  biSizeImage:=BytesNeeded;
      biXPelsPerMeter := round(DPI*InchPerMeter);
      biYPelsPerMeter := biXPelsPerMeter;
      biClrUsed       := 0;   biClrImportant  := 0;
    end;
  end;
  (* Set up pointers for depth buffer and SIRD image *)
  pSird:=TheSIRD.PixMem;
  pDepth:=TheDepth.BaseAdr;
  pDeptho:=NIL;
  DepthXStep:=(TheDepth.XRes-1)/(XRes-1); (* Steps for depth buffer   *)
  DepthYStep:=(TheDepth.YRes-1)/(YRes-1);
  MaxSep:=round(EyeDist*DPI*0.5);      (* Separation for far plane    *)
  for y:=0 to YRes-1 do begin          (* for all scans in SIRD:      *)
    SetPercentage(y/yRes*100);         (* show process                *)
    if pDepth<>pDeptho then            (* did we step in y for depth? *)
      (* Calculate the constraints: *)
      MakeSameArr(pDepth,DepthXStep,XRes,EyeDist,DPI,SameArr);
    pDeptho:=pDepth;                             (* for the next scan *)
    if ThisSortOfTex=UseRandomDots then begin    (* black & white RDs *)
      for x:=XRes-1 downto 0 do begin
        if SameArr[x]=x then with PixArr[x] do begin  (* free choice? *)
          r:=lo(255+random(2)); g:=r; b:=r;
        end else PixArr[x]:=PixArr[SameArr[x]];
      end;
    end else if ThisSortOfTex=UseColoredRandomDots then begin
      for x:=XRes-1 downto 0 do begin
        if SameArr[x]=x then with PixArr[x] do begin
          r:=random(255);
          g:=random(255);
          b:=random(255);
        end else PixArr[x]:=PixArr[SameArr[x]];
      end;
    end else begin
      texstep:=TheRGBMap.XRes/MaxSep;             (* step in texture  *)
      if not AllowMag then if texstep<1.0 then texstep:=1.0;      ytex:=round(y*texstep) mod TheRGBMap.YRes;        (* y in texture *)
      for x:=XRes-1 downto 0 do begin
        if SameArr[x]=x then with PixArr[x] do begin    (* free choice? *)
          xtex:=round(x*texstep) mod TheRGBMap.XRes;    (* x in texture *)
          pTex:=AddToBase(TheRGBMap.BaseAdr,TheRGBMap.BytesPerLine*yTex+xTex*3);
          (* Copy the pixel: *)
          b:=byte(pTex^); incP1(pTex);
          g:=byte(pTex^); incP1(pTex);
          r:=byte(pTex^);
        end else PixArr[x]:=PixArr[SameArr[x]];        (* constrained *)
      end;
    end;    (* copy Pixels of PixArr to SIRD-DIB: *)
    pS:=pSird;
    for x:=0 to XRes-1 do with PixArr[x] do begin
      byte(ps^):=b; incP1(ps);
      byte(ps^):=g; incP1(ps);
      byte(ps^):=r; incP1(ps);
    end;
    (* Increment pointers to SIRD and depth buffer: *)
    incP(pSird,BytesPerLine);
    pDepth:=AddToBase(TheDepth.BaseAdr,round(y*DepthYStep)*TheDepth.BytesPerLine);
  end;  SetPercentage(-1);
  (* Show the DIB: *)
  SIRDBMPWind:=PBMPWnd(SirdApp.MakeWindow(New(PBMPWnd,Init(@Self,TheSIRD,SirdW,'SIRD-Output'))));
  (* Enable saving: *)
  SetMenuEntry(cm_SaveSird,0);
  SetCursor(OldCur);
end;

你说的那个函数，实际上应该是地址的运算操作，因为在Win31下面，地址是要分段的，因此可能等价于下面代码；
function ADDToBase(p: pointer; l: longint): pointer;
{ Adds l to the pointer p. p must have the offset 0. }
begin
Result := Pointer(Integer(p) + l);
// ADDToBase := ptr(ptrrec(p).hi + PtrRec(l).hi * Ofs(AHIncr), ptrrec(l).lo);
end;
主要是不明白他的功能是什么，如果明白，自己写一个就好了，上面的那些函数，都因为地址是16位的，因此需要处理段信息，在Win32下面，这些都没有必要了。

调试易

三维立体画原代码（不是zswang写的那个），谁能用D6重新写下？

解决方案 »