Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 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
15-1159440657
Rule
2006-09-28 14:50
2006.10.22
Ну почему такие трудности с легализацией в Москве


2-1159680977
APiC
2006-10-01 09:36
2006.10.22
Вычисления


2-1159968026
m-kirill-2003
2006-10-04 17:20
2006.10.22
Обновление формы и пауза в программе


15-1159418753
Climber
2006-09-28 08:45
2006.10.22
sql-запросы


15-1159269184
Knight
2006-09-26 15:13
2006.10.22
Программы направления "Домашняя бухгалтерия"





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский