22.05.2015, 10:09
|
|
Исполняемый Ретровирус
|
|
Регистрация: 09.08.2008
Адрес: Umbrella Corporation
Сообщения: 743
Репутация: 1293
|
|
Смазывание текста при перемещение по 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;
|