Einzelnen Beitrag anzeigen

Benutzerbild von turboPASCAL
turboPASCAL

Registriert seit: 8. Mai 2005
Ort: Sondershausen
4.274 Beiträge
 
Delphi 6 Personal
 
#5

Re: Rechteck auf Canvas verschieben - altes Rechteck bleibt

  Alt 23. Jul 2005, 09:18
Moin, Moin.

Es ist ja noch recht Früh, aber du verschiebst doch nur das Label, die Grafik (Bitmap ?) wird doch nicht auf die Form bzw, Label gezeichnet oder ?


//Edit: so sollte es fnktionieren (solange man das Label nicht verschiebt)

Delphi-Quellcode:
procedure TForm1.WPRichTextLabel1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  // alte Positionen merken
  if Button = mbLeft then begin
    xm := Mouse.CursorPos.X;
    ym := Mouse.CursorPos.y;
    lx := WPRichTextLabel1.Left;
    ly := WPRichTextLabel1.Top;
  end;
end;

procedure TForm1.WPRichTextLabel1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  // Textfeld verschieben
  if Shift = [ssLeft] then begin
    WPRichTextLabel1.Left := lx + (Mouse.CursorPos.x - xm);
    WPRichTextLabel1.Top := ly + (Mouse.CursorPos.y - ym);
  end;

  // Hier noch estwas zu Zeichnen bringt nix da die
  // TLabel.Paint -Methode im Anschluss aufgerufen wird
  // die alles wieder "übermalt"

  // Position merken
  lastX1 := WPRichTextLabel1.Left - 1;
  lastY1 := WPRichTextLabel1.Top - 1;
  lastX2 := WPRichTextLabel1.Left + WPRichTextLabel1.width + 1;
  lastY2 := WPRichTextLabel1.Top + WPRichTextLabel1.Height + 1;
end;

procedure TForm1.WPRichTextLabel1MouseEnter(Sender: TObject);
begin
  // Wenn man auf den Text geht > Rehteck anzeigen
  WPRichTextLabel1.Canvas.Pen.Color:= clBlack;
  WPRichTextLabel1.Canvas.Pen.Style := psDash;
  WPRichTextLabel1.Canvas.Brush.Style := bsClear;

  WPRichTextLabel1.Canvas.Pen.Mode:= pmNotXor;
  WPRichTextLabel1.Canvas.Rectangle(WPRichTextLabel1.ClientRect);
  WPRichTextLabel1.Canvas.Pen.Mode := pmCopy;

  // Position merken
  lastX1 := WPRichTextLabel1.Left - 1;
  lastY1 := WPRichTextLabel1.Top - 1;
  lastX2 := WPRichTextLabel1.Left + WPRichTextLabel1.width + 1;
  lastY2 := WPRichTextLabel1.Top + WPRichTextLabel1.Height + 1;
end;

procedure TForm1.WPRichTextLabel1MouseLeave(Sender: TObject);
begin
  // altes Rechteck löschen wenn man den Text verlässt
  With WPRichTextLabel1 do
  begin
    Canvas.Pen.Color:= clBlack;
    Canvas.Pen.Style := psDash;
    Canvas.Brush.Style := bsClear;

    Canvas.Pen.Mode:= pmNotXor;
    Canvas.Rectangle(ClientRect);
    Canvas.Pen.Mode := pmCopy;
  end;
end;
Damit das Rechteck auch beim verschieben sichtbar bleibt müsste man die TLabel.Paint -Methode überschreiben.
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser
  Mit Zitat antworten Zitat