Показать сообщение отдельно
  #2  
Старый 26.03.2009, 19:37
san-46 san-46 вне форума
Активный
 
Регистрация: 25.04.2008
Сообщения: 383
Репутация: 33
По умолчанию

Пример, когда "бегущая" строка не затирает фон формы, кокой бы он ни был (однородный, рисованный или картинка).
Код:
procedure TForm1.FormCreate(Sender: TObject);
begin
  s := 'Это большой пример для маленькой компании.';
  sam := TBitmap.Create;
  buf := TBitmap.Create;

  x := ClientWidth;
  y := 60;
  sam.Canvas.Font.Color := clRed;
  sam.Canvas.Font.Name := 'Arial';
  sam.Canvas.Font.Size := 15;
  sam.Canvas.Font.Style := [fsBold];
  sam.Width := sam.Canvas.TextWidth(s);
  sam.Height := sam.Canvas.TextHeight('Wg');
  buf.Assign(sam); //bmp для сохранения фона, по которому топает строка

  BufRct := Rect(X, Y, sam.Width+X, Y + sam.Height);
  //вначале спасаем кусок фона, на котором еще нет бегущей строки
  //это лучше делать не здесь, а уже после создания формы и ее полной прорисовки
  buf.Canvas.CopyRect(Rect(0, 0, sam.Width, sam.Height), Canvas, BufRct);

  TW := sam.Canvas.TextWidth(s);
  Timer1.Enabled:= True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  SetBkMode(sam.Canvas.Handle, TRANSPARENT);
  SetBkMode(buf.Canvas.Handle, TRANSPARENT);
  //прежний прямоугольник
  BufRct := Rect(X, Y, sam.Width+X, Y + sam.Height);
  //востановление фона из buf на форме и на "sam" (очистка)
  Canvas.CopyRect(BufRct, buf.Canvas, Rect(0, 0, sam.Width, sam.Height));
  sam.Canvas.CopyRect(Rect(0, 0, sam.Width, sam.Height), buf.Canvas, 
              Rect(0, 0, sam.Width, sam.Height));

  X := X - 1;
  If X <= -TW  then
    X := ClientWidth;

  //новый прямоугольник после изменения координат 
  BufRct := Rect(X, Y, sam.Width+X, Y + sam.Height);
  //сохраняем фон
  buf.Canvas.CopyRect(Rect(0, 0, sam.Width, sam.Height), Canvas, BufRct);
  //пишем текст в bmp
  sam.Canvas.TextOut(0, 0, s);
  //выводим на форму
  Canvas.CopyRect(BufRct, sam.Canvas, Rect(0, 0, sam.Width, sam.Height));
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  sam.Free; buf.Free
end;
Код выполняется с небольшими огрехами, которые, при желании, не сложно задавить.
__________________
Не забывайте делать резервные копии
Ответить с цитированием