zswang(伴水)(被黑中)的DBGrid打印程序确实不错，无以为谢，150相赠

[awen800]

[知足常乐]

awen800：

DBGrid打印程序是zswang(伴水)(被黑中)给你的,有原代码吗？

你能否给我一个，非常感谢！

[e-mail]

[urchinjj]

师傅给你们什么了？
给俺也看看，嘿嘿

[王集鹄]

//谢谢

//送你以下代码

type
TRecordLevel = record
rColor: TColor;
rLevel: Byte;
end;

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)
);

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; { Picture3D }

procedure TForm1.Button1Click(Sender: TObject);
begin
Picture3D(Image1.Picture.Bitmap, Image1.Picture.Bitmap, Image1.Picture.Bitmap, cLevelList);
// ~~~~~~~~~~~~~~~~空图片 ~~~~~~~~~~~2维图片 ~~~~~~~~~~背景图片
end;

[王集鹄]

TRecordLevel = record
rColor: TColor; //相应色
rLevel: Byte; //响应深度
end;


2维图片:长并且宽
背景图片:高并且窄

[awen800]

to zswang(伴水)(被黑中):
谢谢!我是做MIS的,如果你有好的能共用的代码,麻烦通知我一下,我是太懒了.
to urchinjj(懒刺猬):
你怎么这么好奇啊?
to V_Lucky(Lucky):
http://www.csdn.net/Expert/topic/433/433591.shtm

[awen800]

不好意思,打个折,给了两位up各10分

[知足常乐]

谢谢

我看到了