Алгоритм закарски

← →
-Deniska- (2006-10-18 14:19) [0]

Подкиньте идею как реализвать алгоритм вывода с последлующей плавной закраской текста на канве битмапа.
Типа как на караоке аппаратах текст плавно (т.е. по частят каждая буква) закрашивается.

← →
Jeer © (2006-10-18 14:37) [1]

"я русский выучил бы лишь за то.."

← →
Vovan#1 (2006-10-18 15:33) [2]

Делаешь маску для букв. Красишь фон и налагаешь на него такую часть маски, которая уже пропелась.

← →
-deniska- (2006-10-18 15:38) [3]

Да ладно, осваиваю быстрый набор ;)
Не успеваю мыслить, - руки только и летают, ещё и не потем буквам:)

Вообщем вывел на канве.TexOut(x,y, "а б в г д")
Далее нужно за определённое время закрасить выводимую строку по буквам, что бы и закраска каждой буквы шла по частям.
Как организовать это наложение\закраску?

← →
-deniska- (2006-10-18 15:39) [4]

2 Vovan#1

Если не затруднит,
как делается маска?

← →
-deniska- (2006-10-18 16:12) [5]

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
myBMP: TBitMap;

const
myStr: String = "А Б В Г Д"; // Текст для вывода

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
myBMP:= TBitmap.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
myBMP.Free;
end;

procedure TForm1.FormClick(Sender: TObject);
begin
myBMP.Canvas.Brush:= Form1.Canvas.Brush;
myBMP.Canvas.Font.Color := clBlack; myBMP.Canvas.Font.Style := [fsBold];
myBMP.Canvas.Font.Name := "Arial"; myBMP.Canvas.Font.Size := 30;
SetBkMode(myBMP.Canvas.Handle,TRANSPARENT);
myBMP.Width:= myBMP.Canvas.TextWidth(myStr); myBMP.Height:= myBMP.Canvas.TextHeight(myStr);
myBMP.Canvas.TextOut(0, 0, myStr);
form1.Canvas.Draw(20,20, myBMP);
Timer1.Interval:= 100; Timer1.Enabled:= true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
// Нужно постепенно закрасить буквы по 1 сек. на каждую
// не кодом, а хотя бы простым текстом pleas напишите кто занет
end;

end.

← →
-deniska- (2006-10-18 18:35) [6]

С маской примерно так?
Если да, то скорость обработки маловата.
Нельзя ли как-то увеличить, а то при таймере в 0.001 закраска 5 букв где-то около 3 сек. происходит или другой вариант может какой есть наложения?

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
myBMP: TBitMap; // Маска
paintBMP: TBitMap; // Закраска
BMP: TBitMap; // Результат

myRect: TRect;

const
myStr: String = "А Б В Г Д"; // Текст для вывода

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
myBMP:= TBitmap.Create; paintBMP:= TBitmap.Create; BMP:= TBitmap.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
myBMP.Free; paintBMP.Free; BMP.Free;
end;

procedure TForm1.FormClick(Sender: TObject);
begin
myBMP.Canvas.Brush.Color:= clWhite; // Прозрачный для маски
myBMP.Canvas.Font.Color := clBlack; // Черный цвет для заливки
myBMP.Canvas.Font.Style := [fsBold]; myBMP.Canvas.Font.Name := "Arial"; myBMP.Canvas.Font.Size := 30;

myBMP.Width:= myBMP.Canvas.TextWidth(myStr); myBMP.Height:= myBMP.Canvas.TextHeight(myStr);
myBMP.Canvas.TextOut(0, 0, myStr); // Нарисовал маску выводимого текста

paintBMP.Width:= myBMP.Width; paintBMP.Height:= myBMP.Height; BMP.Width:= myBMP.Width; BMP.Height:= myBMP.Height; // Установил размеры

paintBMP.Canvas.Brush.Color:= clMaroon; // Цвет заливки основной
paintBMP.Canvas.FillRect(paintBMP.Canvas.ClipRect);
paintBMP.Canvas.Brush.Color:= clBlue; // Цвет дальнейшей закраски

BMP.Canvas.Brush:= Form1.Brush;

myRect:= Rect(0, 0, 0, paintBMP.Height); // Переменная для закраски по времени

Timer1.Interval:= 1; Timer1.Enabled:= true;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin

myRect.Right:= myRect.Right + 1; // Увеличиваем переменную для закраски по времени

if myRect.Right > paintBMP.Width then begin
Timer1.Enabled:= False; MessageBeep(0);
end else begin
BMP.Canvas.FillRect(BMP.Canvas.ClipRect);
BMP.Canvas.CopyMode := cmSrcAnd; BMP.Canvas.CopyRect(myBMP.Canvas.ClipRect, myBMP.Canvas, myBMP.Canvas.ClipRect); // Скопировал маску
paintBMP.Canvas.FillRect(myRect); // Увеличил область закраски
BMP.Canvas.CopyMode := cmSrcPaint; BMP.Canvas.CopyRect(paintBMP.Canvas.ClipRect, paintBMP.Canvas, paintBMP.Canvas.ClipRect); // Скопировал закраску
SetBkMode(BMP.Canvas.Handle,TRANSPARENT);
form1.Canvas.Draw(0,0, bmp);

end;

Application.ProcessMessages;

end;

end.

Алгоритм закарски Найти похожие ветки