const
cLevelCount = 6;
cLevelList: array[0 .. Pred(cLevelCount)] of TRecordLevel =
(
(rColor: clWhite; rLevel: 0),
(rColor: clRed; rLevel: 1),
(rColor: clBlue; rLevel: 2),
(rColor: clYellow; rLevel: 3),
(rColor: clGreen; rLevel: 4),
(rColor: clBlack; rLevel: 5)
);
type
TRecordLevel = record
rColor: TColor;
rLevel: Byte;
end;
{
例子:
Picture3D(Image3D.Picture.Bitmap, Image2D.Picture.Bitmap,
ImageMask.Picture.Bitmap, cLevelList);
}
procedure Picture3D(mBitmap3D,mBitmap2D,mBitmapMask:TBitmap;mLevelList:array of TRecordLevel);//制作三维立体画
var
X, Y, I, J, W: Integer;
vColor: TColor;
begin
mBitmap3D.Assign(nil);
W := mBitmapMask.Width;
mBitmap3D.Width := W * Succ(mBitmap2D.Width div W);
mBitmap3D.Height := mBitmap2D.Height;
mBitmap3D.Canvas.Draw(0, 0, mBitmapMask);
for I := 0 to (mBitmap2D.Width div W) do begin
for Y := 0 to mBitmapMask.Height - 1 do begin
for X := 0 to Pred(W) do begin
vColor := mBitmap2D.Canvas.Pixels[X + W * I, Y];
for J := Low(mLevelList) to High(mLevelList) do
if mLevelList[J].rColor = vColor then begin
if X + mLevelList[J].rLevel >= W then
mBitmapMask.Canvas.Pixels[X, Y]
:= mBitmapMask.Canvas.Pixels[X + mLevelList[J].rLevel - W, Y]
else
mBitmapMask.Canvas.Pixels[X, Y]
:= mBitmapMask.Canvas.Pixels[X + mLevelList[J].rLevel, Y];
Break;
end;
end;
end;
mBitmap3D.Canvas.Draw(W * Succ(I), 0, mBitmapMask);
end;
end;