Скачать: CL | DM;

движение текста в режиме 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 вся ветка

Скачать: CL | DM;



Память: 0.46 MB
Время: 0.032 c