Hallo,
ich lese einen text in eine TList ein und zeichne ihn.
Jetzt zeichne ich ein makierungs rechteck, da jedes zeichnen ein vireck ist prüfe ich nur noch nach welche obj. in den makierungs fehld liegt.

das klappt auch wunderbar nur bis auf einen schönheits fehler.
Ich würde gerne nur ganze buchstaben makieren und keine halben.
ich hoffe ihr könnt es nachvollzien was ich vorhabe.
ich habe hier einen qullcode geschrieben der leider nicht funktioniert !

mein zile ist es auf ein ganzen buchstaben zu runden bzw. obj.
mein qullcode:

zusammenfalten · markieren

Delphi-Quellcode:

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  sx,sy,i:Integer;
  v,v1,v2:TRect;
begin
  if ssLeft in shift then begin
    bufbmp.Canvas.pen:=oldpen;
    bufbmp.Canvas.Brush:=oldBrush;
  
    bufbmp.Canvas.Brush.color:=clBlack;
    bufbmp.Canvas.Brush.Style:=bsSolid;
    bufbmp.Canvas.Rectangle(0,0,paintbox1.Width,paintbox1.Height);
    bufbmp.Canvas.Brush:=oldBrush;
    bufbmp.Canvas.Pen:=oldPen;
    bufbmp.Canvas.pen.color:=clAqua;

    for i:=0 to obj.count-1 do begin
      v1.left:=tCharItem(obj.items[i]).cx;
      v1.top:=tCharItem(obj.items[i]).cy;
      v1.Right:=v1.left+bufbmp.Canvas.TextWidth(tCharItem(obj.items[i]).Char);
      v1.Bottom:=v1.top+bufbmp.Canvas.TextHeight(tCharItem(obj.items[i]).Char);

      v2.left:=mx;
      v2.top:=my;
      v2.Right:=x;
      v2.Bottom:=y;

      if IntersectRect(v,v2,v1) = True then begin
        sx:=x+(v1.right-v1.left)+v.Left;
        break;
      end;
    end;
    caption:=IntTostr(sx);

    bufbmp.canvas.Rectangle(mx,my,sx,y);
    bufbmp.Canvas.Brush:=oldBrush;
    bufbmp.Canvas.Pen:=oldPen;
    DrawText;

  end;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TOBject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i,m:integer;
  v,v1,v2:TRect;
  

begin
  for i:=0 to obj.count-1 do begin
      v1.left:=tCharItem(obj.items[i]).cx;
      v1.top:=tCharItem(obj.items[i]).cy;
      v1.Right:=v1.left+bufbmp.Canvas.TextWidth(tCharItem(obj.items[i]).Char);
      v1.Bottom:=v1.top+bufbmp.Canvas.TextHeight(tCharItem(obj.items[i]).Char);

      v2.left:=mx;
      v2.top:=my;
      v2.Right:=x;
      v2.Bottom:=y;

      if IntersectRect(v,v2,v1) = True then begin
        if ord(tCharItem(obj.items[i]).Char) = 0 then
          memo2.lines.add(#13#10);
          
        if (Memo2.Lines.Count = 0)then
          Memo2.Lines.Add(tCharItem(obj.items[i]).Char)
        else
          Memo2.Lines.Strings[Memo2.Lines.Count-1]:=Memo2.Lines.Strings[Memo2.Lines.Count-1]+tCharItem(obj.items[i]).Char ;
      end;
    end;
end;

in mousemove wird das rechteck gezeichnet und in mouseup wird endschieden was der user makiert hat !

vielen dank im voraus !

mit folgenden qullcode habe ich den ersten schrit geschaft:

zusammenfalten · markieren

Delphi-Quellcode:

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  sx,sy,i:Integer;
  v,v1,v2:TRect;
begin
  if ssLeft in shift then begin
    bufbmp.Canvas.pen:=oldpen;
    bufbmp.Canvas.Brush:=oldBrush;
  
    bufbmp.Canvas.Brush.color:=clBlack;
    bufbmp.Canvas.Brush.Style:=bsSolid;
    bufbmp.Canvas.Rectangle(0,0,paintbox1.Width,paintbox1.Height);
    bufbmp.Canvas.Brush:=oldBrush;
    bufbmp.Canvas.Pen:=oldPen;
    bufbmp.Canvas.pen.color:=clAqua;

    for i:=0 to obj.count-1 do begin
      v1.left:=tCharItem(obj.items[i]).cx;
      v1.top:=tCharItem(obj.items[i]).cy;
      v1.Right:=v1.left+bufbmp.Canvas.TextWidth(tCharItem(obj.items[i]).Char);
      v1.Bottom:=v1.top+bufbmp.Canvas.TextHeight(tCharItem(obj.items[i]).Char);


      v2.left:=mx;
      v2.top:=my;
      v2.Right:=x;
      v2.Bottom:=y;

      if IntersectRect(v,v2,v1) = True then begin
// ShowMessage(IntTostr(v1.right) + '\' + IntTostr(x));
// sx:=x+v1.right;
// memo2.lines.add();
       caption:=IntTostr(v1.Right-x) ;
       sx:=x+(v1.Right-x);
// break;
      end;
    end;

    bufbmp.canvas.Rectangle(mx,my,sx,y);
    bufbmp.Canvas.Brush:=oldBrush;
    bufbmp.Canvas.Pen:=oldPen;
    DrawText;

  end;
end;

im moment muss ich noch y und mx und my anpassen aber ich denke das werde ich schaffen !!!