Форум: "Начинающим";
Текущий архив: 2006.10.22;
Скачать: [xml.tar.bz2];
Вниздвижение текста в режиме XOR Найти похожие ветки
← →
lesser (2006-10-03 20:52) [0]Здравствуйте. Подскажите, пожалуйста, как двигать текст по форме (мышью),чтобы не оставалось следов. С фигурами спокойно получается, а с текстом..
Вывод текста с помощью TextRect, получается лучше, чем TextOut но приводит к затиранию фона, потом при перемещении справа налево след все равно остается.
← →
Zeqfreed © (2006-10-03 21:35) [1]
type
TMovableText = class
FCanvas : TCanvas;
FTmp : TBitmap;
FText : String;
FPos : TPoint;
private
procedure Erase();
procedure Draw();
procedure SetPosition(const Value: TPoint);
public
constructor Create(Canvas : TCanvas; Text : String; X, Y : Integer);
destructor Destroy(); override;
procedure Move(XOffset : Integer = 0; YOffset : Integer = 0);
procedure Repaint();
property Position : TPoint read FPos write SetPosition;
end;
implementation
constructor TMovableText.Create(Canvas : TCanvas; Text: String; X, Y: Integer);
begin
inherited Create;
if not Assigned(Canvas) or (Text = "") then
raise Exception.Create("Creation failed");
FCanvas := Canvas;
FText := Text;
FPos.X := X;
FPos.Y := Y;
FTmp := TBitmap.Create();
FTmp.Width := FCanvas.TextWidth(FText);
FTmp.Height := FCanvas.TextHeight(FText);
Draw();
end;
destructor TMovableText.Destroy;
begin
Erase();
FTmp.Free;
inherited;
end;
procedure TMovableText.Draw();
var
r : TRect;
begin
BitBlt(FTmp.Canvas.Handle, 0, 0, FTmp.Width, FTmp.Height, FCanvas.Handle, FPos.X, FPos.Y, SRCCOPY);
SetRect(r, FPos.X, FPos.Y, FPos.X + FTmp.Width, FPos.Y + FTmp.Height);
DrawText(FCanvas.Handle, PChar(FText), length(FText), r, DT_VCENTER or DT_SINGLELINE);
end;
procedure TMovableText.Erase;
begin
BitBlt(FCanvas.Handle, FPos.X, FPos.Y, FTmp.Width, FTmp.Height, FTmp.Canvas.Handle, 0, 0, SRCCOPY);
end;
procedure TMovableText.Move(XOffset, YOffset: Integer);
begin
Erase();
Inc(FPos.X, XOffset);
Inc(FPos.Y, YOffset);
Draw();
end;
procedure TMovableText.Repaint;
begin
Draw();
end;
procedure TMovableText.SetPosition(const Value: TPoint);
begin
if (FPos.X <> Value.X) and (FPos.Y <> Value.Y) then
Move(Value.X - FPos.X, Value.Y - FPos.Y);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
mt := TMovableText.Create(Form1.Canvas, "Hello, World!", 0, 0);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
mt.Free;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Tag := 1;
MouseMove([], X, Y);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if (Tag <> 1) then Exit;
mt.Move(X - mt.Position.X, Y - mt.Position.Y);
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Tag := 0;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
mt.Repaint();
end;
Как один из вариантов. Выбирать конкретный механизм надо в зависимости от условий задачи.
← →
lesser (2006-10-04 14:16) [2]Спасибо.
Задача у меня правда несколько сложнее чем просто движение текста - надо еще и непрерывно менять текст по мере его движения (то есть это измерение кривой скользящим курсором).
Попробую переделать указанную программу чтобы TMovableText.Move
стирала старый текст, а рисовала новый.
Страницы: 1 вся ветка
Форум: "Начинающим";
Текущий архив: 2006.10.22;
Скачать: [xml.tar.bz2];
Память: 0.45 MB
Время: 0.047 c