Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Звук, графика и видео > Мерцание изображения

Автор: BlackStorm 5.5.2005, 08:34

есть такая процедура,

Код


procedure TForm1.Timer1Timer(Sender: TObject);
var
 s : string;
 n : integer;
 d : TDateTime;
begin
 d := Time ;
 s := FormatDateTime ('s',d) ;
 label1.Caption := s ;
 n := StrToInt (s) ;
 SecLabel.Caption := Sec[n]
end;

На форме лежит картинка и лабел, картинка выше лабела.

интервал таймера 1 секунда, Sec[n] это элемнт из массива констант,
возникающая проблема мерцание при присвоении нового каптиона лабелу он как бы выскакивает на поверхность и происходит мерцание.

вопрос можно ли этого избежать? И если можно то как?
заранее спасибо за помощь.

Автор: Dufe 5.5.2005, 12:17

Я бы использовал на канвасе картинки TextOut().
Необходимо сделать копию кусочка картинки, куда выводится текст. И перерисовывать его на канвас картинки(я полагаю Image1.Canvas.Draw()). Если мерцание останется, DoubleBuffered:=True;

Автор: FireFly 6.5.2005, 13:14

{На форме картинка TImage с любым изображением (Image1.Picture) и таймер. Каждую секунду на фоне картинки выводится текст с количеством секунд}

Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
 end;

var
  Form1: TForm1;
  fon:tbitmap;
  RectSource,RectDest:Trect;
  LeftTextPos,TopTextPos,RightTextPos,BottomTextPos:word;

  const
// левая позиция текста в картинке
LeftShift:word=10;
//верхняя позиция текста в картинке
TopShift:word=10;
//шаблон выводимого текста
outstring:shortstring = 'Текущие секунды - ';
// название шрифта
TxtFontName:shortstring = 'Times New Roman';
//Размер шрифта
TxtFontSize: byte = 24;
//цвет текста
TxtFontColor: Tcolor=clYellow;
//интервал таймера в секундах
TimerInterval: byte = 1;

implementation

{$R *.DFM}

procedure TForm1.Timer1Timer(Sender: TObject);
var
s : shortstring;
d : TDateTime;
begin
d := Time ;
s := FormatDateTime ('s',d) ;
SetBkMode(image1.Canvas.Handle,TRANSPARENT);
image1.canvas.copyrect(RectDest,fon.canvas,RectSource);
image1.canvas.textout(LeftTextPos,TopTextPos,outstring + s);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
x:byte;
begin
Fon:=tbitmap.create;
image1.canvas.Font.color:=TxtFontColor;
image1.canvas.font.size:=TxtFontSize;
image1.canvas.font.name:=TxtFontName;
Fon.canvas.Font.color:=image1.canvas.Font.color;
Fon.canvas.font.size:=image1.canvas.font.size;
Fon.canvas.font.name:=image1.canvas.font.name;
//x это ширина "секунд". От фонаря и с запасом :-)
x:=Fon.canvas.TextWidth('55')+4;
Fon.width:=Fon.canvas.TextWidth(outstring)+x;
Fon.height:=Fon.canvas.TextHeight(outstring);
LeftTextPos:=image1.left+LeftShift;
TopTextPos:=image1.top+TopShift;
RightTextPos:=LeftTextPos+Fon.width;
BottomTextPos:=TopTextPos+Fon.height;
RectSource:=rect(0,0,Fon.width,Fon.Height);
RectDest:=rect(LeftTextPos,TopTextPos,RightTextPos,BottomTextPos);
Fon.canvas.copyrect(RectSource,image1.canvas,RectDest);
Timer1.Interval:=1000*TimerInterval;
Timer1.Enabled:=true;
end;

end.

Автор: drinkOut 8.5.2005, 21:40

Можно так же попробовать:

Код


Self.AlphaBlend := true;