Registriert seit: 8. Okt 2006
Ort: St.Gallen/Schweiz
1.186 Beiträge
Delphi 11 Alexandria
|
TextInRectangel liefert nichts
17. Apr 2023, 20:39
Delphi-Version: 5
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
Roger Man muss und kann nicht alles wissen - man muss nur wissen, wo es steht.
Frei nach Albert Einstein
http://roase.ch
|
|
Zitat
|