[Vayrus]

Приветствую форумчане, в общем, грабли, не совсем понял в чем проблема, различные способы выставления прозрачности фона дают эффект смазывания текста при его скроллинге, в статическом положении все норм, подскажите, где ошибка?

Код:

procedure TForm1.FormResize(Sender: TObject);
begin
  InitDraw;
end;

procedure TForm1.InitDraw;
begin
  y := Height; 
  bm.Width := Width; // ширина как у формы
  bm.Height := Height; // высота как у формы
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  S: string;
begin
  bm := TBitmap.Create; // создаем объект TBitmap
  InitDraw;
  bm.Canvas.Font.Size := fontsize;
  bm.Canvas.Brush.Style := bsClear;
  //
  bm.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'bg.bmp');
  Timer1.Enabled := True; // включаем таймер
end;

procedure TForm1.OutText(Bmp: TBitmap; S: string; xoffset, yoffset: Integer);
var
  T: string;
  oldbkmode: Integer;
begin
  // InValidateRect(Bmp.Canvas.handle,NIL,True);
  with Bmp.Canvas do
  begin
    // oldbkmode := SetBkMode(Handle, Transparent);
    if Copy(S, 1, 1) = '#' then
    begin
      T := Copy(S, 2, Length(S));
      Font.Color := $000576DC; // делаем цвет оранжевым
      // SetBkMode(Handle, TRANSPARENT);
      TextOut((ClientWidth - maxlen { TextExtent(S).cx } ) div 2 - 10 - xoffset,
        yoffset { + fontsize } { TextExtent(S).cy } , T);
    end
    else
    begin
      Font.Color := clWhite;
      // SetBkMode(Handle, TRANSPARENT);
      TextOut((ClientWidth - maxlen { TextExtent(S).cx } ) div 2 - xoffset,
        yoffset { + fontsize } { TextExtent(S).cy } , S);
    end;
    // SetBkMode(Handle, oldbkmode);
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i, offset: Integer;
  S: string;
begin
  y := y - 1;
  if y = -maxh then
    y := Height;
  { else if y = 10 then
    Sleep(1000); }
  offset := y;
  //
  with bm.Canvas do
  begin
    // InValidateRect(handle, NIL, True);
    for i := 0 to ListBox1.Items.Count - 1 do
    begin
      S := ListBox1.Items[i];
      OutText(bm, S, 0, offset);
      Inc(offset, interval);//Можно изящнее, в ListBox1 есть соотв. свойства
    end;
    Canvas.Draw(0, 0, bm); // вырисовываем на форме объект Bitmap }
  end;
  //
  Application.ProcessMessages;
end;

[angvelem]

Нужен временный битмап, где уже хранится картинка и куда будет дополнительно выводится текст.

[Vayrus]

Сообщение от angvelem

Нужен временный битмап, где уже хранится картинка и куда будет дополнительно выводится текст.

В смысле, создать 2 битмапа, один чисто с картинкой, а другой для отрисовки текста?

[angvelem]

Должен быть битмап с неизменяемой картинкой. Далее копируем этот битмап в другой, куда и выводим текст. А уже полученный битмап выводим куда нужно. На TImage, TPaint или непосредственно на канву формы.

Кстати, в таймере Application.ProcessMessages лишнее.

[Vayrus]

Сообщение от angvelem

Должен быть битмап с неизменяемой картинкой. Далее копируем этот битмап в другой, куда и выводим текст. А уже полученный битмап выводим куда нужно. На TImage, TPaint или непосредственно на канву формы.

Кстати, в таймере Application.ProcessMessages лишнее.

1. Даже если просто без картинки текст смазывается при попытке сделать его фон прозрачным.
2. Почему ProcessMessages лишний, интересно ? (разницы, правда, что с ним, что без него не заметил)

[angvelem]

1. Именно из-за прозрачности так и происходит, 2 битмапа спасут отца Русской демократии.
2. Потому как бессмысленно. Как таймер может подвесить программу, что приходится использовать ProcessMessages?

[Vayrus]

Сообщение от angvelem

1. Именно из-за прозрачности так и происходит, 2 битмапа спасут отца Русской демократии.
2. Потому как бессмысленно. Как таймер может подвесить программу, что приходится использовать ProcessMessages?

То ли не с той ноги встал, то ли что, но те же грабли, даже с 2 битмапами: гружу в отдельный битмап картинку, отрисовываю на канвасе, потом накладываю битмап с текстом, короче, таже ситуёвина

[angvelem]

Ещё раз.
1. Имеем два битмапа. В первом картинка, второй буферный.
2. С первого копируем во второй.
3. После копирования выводим текст (во второй!).
4. Второй выводим на канву формы.
5. Возвращаемся к пункту 2.

[Vayrus]

Сообщение от angvelem

Ещё раз.
1. Имеем два битмапа. В первом картинка, второй буферный.
2. С первого копируем во второй.
3. После копирования выводим текст (во второй!).
4. Второй выводим на канву формы.
5. Возвращаемся к пункту 2.

Код:

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  S: string;
begin
  bm := TBitmap.Create; // создаем объект TBitmap
  fon := TBitmap.Create; 
  InitDraw;
  bm.Canvas.Font.Size := fontsize;
  bm.Canvas.Brush.Style := bsClear;
//
//********************************* ADDED
//Loading Background From File
  fon.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'bg.bmp');
//Draw Background To BM.Canvas
  bm.Canvas.Draw(0, 0, fon);
  //
//*********************************
  Timer1.Enabled := True; // включаем таймер
end;

Как то так, или отрисовку вставить в процедуру таймера, но, тогда, неизбежно мерцание.

[angvelem]

Уф. Скинь проект.

[Vayrus]

Сообщение от angvelem

Уф. Скинь проект.

DOWNLOAD

.................................................. ..............................

[M.A.D.M.A.N.]

Так пойдет?


З.Ы. Временный битмап нинужын!

[angvelem]

Примерно так.

[M.A.D.M.A.N.]

Сообщение от angvelem

Примерно так.

А я без второго битмапа обошелся, бе-бе-бе.

[angvelem]

Ну и прАздравляю, бе-бе-бе.