Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi TextInRectangel liefert nichts (https://www.delphipraxis.net/212878-textinrectangel-liefert-nichts.html)

Delbor 17. Apr 2023 19:39

Delphi-Version: 5

TextInRectangel liefert nichts
 
Hi zusammen

Das hat schon mal funktioniert - ich wüsste nicht, warum:
Delphi-Quellcode:
procedure TAlexPdfFormular.FOnMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  const Tolerance = 2.0;
  var  WebLinkIndex: Integer; LdfView : TPdfView;
begin
  FMarkedText := False;
  LdfView := (Sender as TPdfView);
  Pdf1.PageNumber := LdfView.PageNumber;
  if not LdfView.Active then
    Exit;
  LdfView.SetFocus;
  WebLinkIndex := LdfView.WebLinkAtPos(X, Y);
  if WebLinkIndex <> -1 then
    ShellExecute(0, 'open', PChar(string(LdfView.WebLink[WebLinkIndex].Url)), '', '', SW_SHOWNORMAL)
  else
    if SSRight in Shift then
    begin
      FMarkedText := True;
      FMouseMarked.x:=x;
      FMouseMarked.y:=y;
      FCurrentMarked.X := x;
      FCurrentMarked.Y := y; ;
    end;
 end;
Delphi-Quellcode:
procedure TAlexPdfFormular.FOnMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  const Tolerance = 2.0;
  var SelectedIndex: Integer; NeedRepaint: Boolean; S: String; LdfView : TPdfView;
begin
  LdfView := (Sender as TPdfView);
  if LdfView.Active then
    Pdf1.PageNumber := LdfView.PageNumber;
  if not LdfView.Active then
    Exit;
  if SSRight in Shift then
  begin
    TextMarkedField(pmnotxor,FCurrentMarked.X,FCurrentMarked.Y, LdfView);        // : TPDFView
    FCurrentMarked.X := x;
    FCurrentMarked.Y := y; ;
    TextMarkedField(pmnotxor,FCurrentMarked.X,FCurrentMarked.Y, LdfView);
  end;
end;
Delphi-Quellcode:
procedure TAlexPdfFormular.TextMarkedField(mode: TPenMode; x, y: Integer;
  LdfView: TPDFView);
  var S: String; TheRect: TRect;
begin
  LdfView.Canvas.Pen.Mode:= mode; // Wieder Image.Canvas o.ä.
  LdfView.Canvas.Brush.Color := clNone;
  LdfView.Canvas.Pen.Color := clBlack;
  LdfView.Canvas.Pen.style:=psSolid;
  LdfView.Canvas.Brush.Style := bsClear;
  LdfView.Canvas.Rectangle(FMouseMarked.x,FMouseMarked.y,x,y);
  S := LdfView.TextInRectangle(FMouseMarked.X,FMouseMarked.Y,X,Y);
  Self.MemoPdfText.Lines.Add(S);
end;
Delphi-Quellcode:
procedure TAlexPdfFormular.FOnMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var Text: WString; LdfView : TPdfView;
begin
  LdfView := (Sender as TPdfView);
  if LdfView.Active then
  begin
    Pdf1.PageNumber := LdfView.PageNumber;
    Pdf1.Active := true;
    if FMarkedText then
    begin
      Text := LdfView.TextInRectangle(FMouseMarked.X,FMouseMarked.Y,X,Y);
      LdfView.Canvas.Rectangle(FMouseMarked.X,FMouseMarked.Y,X,Y);
      RzPCtrlPdfText.ActivePage := RzTbsMemo;
      MemoPdfText.Lines.Add(Text);
      FMarkedText := False;
    end;
  end;
  if Assigned(FOnSelectedPdfTextEvent) then
    FOnSelectedPdfTextEvent(Sender,Text);
end;
Hintergrund : Ich erzeuge eine Reihe von TPdfView-Objekten, für jede Seite eines PDF-Dokumentes eins. Wird das PDF angezeigt, soll per Maus ein einzelnes Wort oder ein Text markiert und kopiert werden. Diese Objekte bieten eine Funktion TextInRectangel, die innerhalb eines angegebenen Rechtecks liegenden Text zurückgibt - oder zurückgeben sollte. Aber genau das tut se mit diesem Code nicht.

Was mache ich falsch?

Gruss
Delbor

Blup 24. Apr 2023 18:28

AW: TextInRectangel liefert nichts
 
Wird der ausgewählte Bereich zumindest richtig markiert?

Delbor 25. Apr 2023 09:27

AW: TextInRectangel liefert nichts
 
Hi Blubb

Der ausgewählte Bereich wird korrekt markiert und nach MouseUp auch korrekt gelöscht (nur die Markierung).
Bevor ich das Formular einführte, hab ich das auf einem Frame gemacht. Da bin ich aber davon weggekommen und hab das erstmal auf einer alleinstehenden Form in einer separaten exe ausgetestet. Da funktioniert das von Anfang an anstandslos und tut das immer noch.

Ich muss mir Tortoisegit wieder mal vornehmen, um die beiden Codes zu vergleichen - einfach nur den fehlerhaften Code zu ersetzen, ohne zu wissen, wo's harzt, ist eine schlechte Idee.


Gruss
Delbor


Alle Zeitangaben in WEZ +1. Es ist jetzt 10:45 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz