Показать сообщение отдельно
  #15  
Старый 06.05.2011, 00:55
Аватар для Antidelphik
Antidelphik Antidelphik вне форума
Новичок
 
Регистрация: 28.04.2011
Сообщения: 67
Репутация: 10
По умолчанию

Он у мну не открылся =( я тут поэкспериментировала с прозрачным фоном, на один 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.
Ответить с цитированием