|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
||||
|
||||
Смазывание текста при перемещение по Canvas Bitmap'а
Приветствую форумчане, в общем, грабли, не совсем понял в чем проблема, различные способы выставления прозрачности фона дают эффект смазывания текста при его скроллинге, в статическом положении все норм, подскажите, где ошибка?
Код:
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; |
#2
|
||||
|
||||
Нужен временный битмап, где уже хранится картинка и куда будет дополнительно выводится текст.
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
#3
|
||||
|
||||
Цитата:
В смысле, создать 2 битмапа, один чисто с картинкой, а другой для отрисовки текста? |
#4
|
||||
|
||||
Должен быть битмап с неизменяемой картинкой. Далее копируем этот битмап в другой, куда и выводим текст. А уже полученный битмап выводим куда нужно. На TImage, TPaint или непосредственно на канву формы.
Кстати, в таймере Application.ProcessMessages лишнее. Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
#5
|
||||
|
||||
Цитата:
1. Даже если просто без картинки текст смазывается при попытке сделать его фон прозрачным. 2. Почему ProcessMessages лишний, интересно ? (разницы, правда, что с ним, что без него не заметил) |
#6
|
||||
|
||||
1. Именно из-за прозрачности так и происходит, 2 битмапа спасут отца Русской демократии.
2. Потому как бессмысленно. Как таймер может подвесить программу, что приходится использовать ProcessMessages? Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
#7
|
||||
|
||||
Цитата:
То ли не с той ноги встал, то ли что, но те же грабли, даже с 2 битмапами: гружу в отдельный битмап картинку, отрисовываю на канвасе, потом накладываю битмап с текстом, короче, таже ситуёвина |
#8
|
||||
|
||||
Ещё раз.
1. Имеем два битмапа. В первом картинка, второй буферный. 2. С первого копируем во второй. 3. После копирования выводим текст (во второй!). 4. Второй выводим на канву формы. 5. Возвращаемся к пункту 2. Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
Этот пользователь сказал Спасибо angvelem за это полезное сообщение: | ||
Alegun (22.05.2015)
|
#9
|
||||
|
||||
Цитата:
Код:
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; Как то так, или отрисовку вставить в процедуру таймера, но, тогда, неизбежно мерцание. |
#10
|
||||
|
||||
Уф. Скинь проект.
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
#12
|
||||
|
||||
Так пойдет?
З.Ы. Временный битмап нинужын! — Как тебя понимать? — Понимать меня не обязательно. Обязательно меня любить и кормить вовремя. На Delphi, увы, больше не программирую. Рекомендуемая литература по программированию Последний раз редактировалось M.A.D.M.A.N., 22.05.2015 в 11:21. |
#13
|
||||
|
||||
Примерно так.
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. Последний раз редактировалось angvelem, 22.05.2015 в 11:37. |
#14
|
||||
|
||||
Цитата:
— Как тебя понимать? — Понимать меня не обязательно. Обязательно меня любить и кормить вовремя. На Delphi, увы, больше не программирую. Рекомендуемая литература по программированию |
#15
|
||||
|
||||
Ну и прАздравляю, бе-бе-бе.
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |