如何让窗体的一位图显示具有百叶窗效果?(100分)

S

swpihwd

Unregistered / Unconfirmed
GUEST, unregistred user!
如何让窗体的一位图显示具有百叶窗效果? 谢谢!
 
//从以前的程序中截了一端自己改改吧
procedure tform1.byc;
var block,i,h:integer;
begin
image2.Visible :=true;
h:=0;
case combobox1.ItemIndex of
0:begin
block:=image1.height div 15;
repeat
h:=h+1;
for i:=0 to 14 do
begin
image2.Canvas.CopyRect (rect(0,i*block,image1.width,i*block+h),image1.canvas,rect(0,i*block,image1.width,i*block+h));
end;
image2.Refresh ;
s:=3;
timer1.Enabled :=true;
repeat
application.ProcessMessages ;
until timer1.Enabled=false;
until h>=block;
image2.Canvas.CopyRect (rect(0,0,image1.width,image1.height),image1.canvas,rect(0,0,image1.width,image1.height));
end;
1:begin
block:=image1.width div 20;
repeat
h:=h+1;
for i:=0 to 20 do
begin
image2.Canvas.CopyRect (rect(i*block,0,i*block+h,image1.height),image1.canvas,rect(i*block,0,i*block+h,image1.height));
end;
image2.Refresh ;
s:=3;
timer1.Enabled :=true;
repeat
application.ProcessMessages ;
until timer1.Enabled=false;
until h>=block;
image2.Canvas.CopyRect (rect(0,0,image1.width,image1.height),image1.canvas,rect(0,0,image1.width,image1.height));
end;
end;
end;
 
粘上可用的例子
procedure TForm1.Button4Click(Sender: TObject);
var
newbmp:TBitmap;
i,j,bmpheight,bmpwidth:integer;
begin
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
i:=0;
while i< =bmpheight do
begin
j:=i;
while j >0 do
begin
newbmp.Canvas.CopyRect(Rect(0,j-1,bmpwidth,j),
image1.Canvas,
Rect(0,bmpheight-i+j-1,bmpwidth,bmpheight-i+j));
newbmp.Canvas.CopyRect(Rect(0,bmpheight-j,bmpwidth,bmpheight-j+1),
image1.Canvas,
Rect(0,i-j,bmpwidth,i-j+1));
j:=j-2;
end;
form1.Canvas.Draw(120,100,newbmp);
i:=i+2;
end;
newbmp.free;
end;
 
如果想简单的话就用控件,如abc6.0,picshow
 
大家很积极阿,
 
对呀,来晚了
推荐个控件吧
TPicShow
有好多中特效
 
顶部