Он у мну не открылся =( я тут поэкспериментировала с прозрачным фоном, на один image поместила второй такой же, тока фон ему прозрачный задала, а на нижний фон сунула картинку, всё норм, фон восстанавливается, а сам флаг безобразного цвета, плюс на 4м цикле цвета вообще пропадают, в общем кидаю код чтобы понятнее было =) Подскажи пожалуйста как сделать чтобы уже нормально было
Код:
procedure TForm1.Button1Click(Sender: TObject);
procedure Flag (x,y:integer);
begin
with image2.Canvas do
begin
Pen.Color:=clBlack;
Brush.Color:=clWhite;
rectangle(x,y,x+image1.Width div 2,y-image1.Height div 2);
brush.Color:=clBlue;
rectangle(x,y-image1.Height div 6,x+image1.Width div 2,y-image1.Height div 3);
Brush.Color:=clRed;
rectangle(x,y,x+image1.Width div 2,y-image1.Height div 6);
end;
end;
var i,j:integer;
begin
with image2.Canvas do
begin
image2.Transparent:=true;
fillrect(image1.ClientRect);
Form1.DoubleBuffered:=true;
pen.Mode:=pmXOR;
for i:=0 to image1.Width div 2 do
begin
Flag(i,image1.Height div 2);
application.ProcessMessages;
image2.Transparent:=true;
fillrect(image1.ClientRect);
end;
for j:=image1.Height div 2 to image1.Height do
begin
Flag(i,j);
application.ProcessMessages;
image2.Transparent:=true;
fillrect(image1.ClientRect);
end;
for i:=image1.Width div 2 downto 0 do
begin
Flag(i,j);
application.ProcessMessages;
image2.Transparent:=true;
fillrect(image1.ClientRect);
end;
for j:=image1.Height downto image1.Height div 2 do
begin
Flag(i,j);
application.ProcessMessages;
image2.Transparent:=true;
fillrect(image1.ClientRect);
Flag(i,j);
end;
end;
end;
end.