AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) Rechteck an (unter) Maus-Position malen
Thema durchsuchen
Ansicht
Themen-Optionen

Rechteck an (unter) Maus-Position malen

Ein Thema von hoika · begonnen am 29. Jun 2010 · letzter Beitrag vom 29. Jun 2010
Antwort Antwort
hoika

Registriert seit: 5. Jul 2006
Ort: Magdeburg
8.275 Beiträge
 
Delphi 10.4 Sydney
 
#1

Rechteck an (unter) Maus-Position malen

  Alt 29. Jun 2010, 15:55
Hallo #,

der angehängte Code soll folgendes machen.
Beim Bewegen der Maus soll an der Maus-Position etwas (hier ein Rechteck) gemalt werden.
Um beim Bewegen den originalen Form-Zustand wiederherzustellen,
habe ich mir beim Programmstart dem Client-Bereich des Forms in ein Bitmap geladen.

Vor dem Neuzeichnen wird der alte Form-Zustand wieder in seinen alten Platz geschrieben.

Problem:
es funktioniert nicht richtig.

Nehme statt // XXX das // YYY, geht es, aber die Performance ist mieser.

Ich mache doch gar nix verkehrt ;( Oder ?

Was komisch ist, setzte ich Form.Color z.B. auf clBlue
und speichere das Bitmap nach dem Sichern ins Bitmap ab,
ist es trotzdem weiss !


Hülfe !


Danke

Heiko


PS:
Das ganze soll in ein großes System eingebaut werden,
ist also nur der Test.


Delphi-Quellcode:
unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ieview, imageenview;

type
  TForm2 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormActivate(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure DrawRect(theCanvas: TCanvas; X, Y: Integer);
  public
    { Public-Deklarationen }
  end;

var
  Form2: TForm2;
  OldX, OldY: integer;
  bmRestore: TBitmap;

const
  C_Width = 40;
  C_Height = 20;


implementation

{$R *.dfm}

procedure TForm2.DrawRect(theCanvas: TCanvas; X, Y: Integer);
var
  Poly: array of TPoint;
begin
  SetLength(Poly, 5);

  Poly[0].X:= X;
  Poly[0].Y:= Y;
  Poly[1].X:= X+40;
  Poly[1].Y:= Y;
  Poly[2].X:= X+40;
  Poly[2].Y:= Y+20;
  Poly[3].X:= X;
  Poly[3].Y:= Y+20;
  Poly[4].X:= X;
  Poly[4].Y:= Y;

  SetPolyFillMode(theCanvas.Handle, ALTERNATE);
  theCanvas.Brush.Color:= clBlue;
  with theCanvas do
  begin
    Polygon(Poly);
  end;

  SetLength(Poly, 0);
  Poly:= NIL;
end;

procedure TForm2.FormActivate(Sender: TObject);
begin
  BitBlt(bmRestore.Handle, 0, 0, ClientWidth, ClientHeight,
    Self.Canvas.Handle, 0, 0, SRCCOPY);
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  OldX:= -1;
  OldY:= -1;

  Self.Canvas.Pen.Color := clBlue;
  Self.Canvas.Pen.Width := 1;

  bmRestore:= TBitmap.Create;
  bmRestore.Width := ClientWidth;
  bmRestore.Height := ClientHeight;
  bmRestore.PixelFormat := pf24bit;

// bmRestore.PixelFormat := pf24bit;

end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
  bmRestore.Free;
end;

procedure TForm2.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key=VK_RETURN then
  begin
    BitBlt(Self.Canvas.Handle, 0, 0, ClientWidth, ClientHeight,
     bmRestore.Canvas.Handle, 0, 0, SRCCOPY);
  end;
end;

procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin

  if OldX<>-1 then
  begin
   { Wiederherstellen des ursprünglichen Inhaltes }

   // XXX
    BitBlt(Self.Canvas.Handle, OldX, OldY, C_Width, C_Height,
      bmRestore.Canvas.Handle, OldX, OldY, SRCCOPY);

   // YYY

// BitBlt(Self.Canvas.Handle, 0, 0, ClientWidth, ClientHeight,
// bmRestore.Canvas.Handle, 0, 0, SRCCOPY);


  end;

  // Invalidate;
  DrawRect(Self.Canvas, X, Y);

  OldX := X;
  OldY := Y;

  Exit;
end;


end.
Heiko

Geändert von hoika (29. Jun 2010 um 16:06 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Bummi
Bummi

Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
 
Delphi XE3 Enterprise
 
#2

AW: Rechteck an (unter) Maus-Position malen

  Alt 29. Jun 2010, 16:05
ohne Zwischenspeicherung und wiederherstellung:

Delphi-Quellcode:
procedure TForm5.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  invalidate;
end;

procedure TForm5.FormPaint(Sender: TObject);
var
  p:Tpoint;
begin

   p := ScreenToClient(Mouse.CursorPos);
  Canvas.rectangle(p.X - 5, p.Y - 5, p.X + 5, p.Y + 5);
end;
Thomas Wassermann H₂♂
Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)
  Mit Zitat antworten Zitat
Benutzerbild von mleyen
mleyen

Registriert seit: 10. Aug 2007
609 Beiträge
 
FreePascal / Lazarus
 
#3

AW: Rechteck an (unter) Maus-Position malen

  Alt 29. Jun 2010, 16:06
Zum Verständnis: Bringt folgendes das gewünschte Ergebnis?

Tausch mal
  // Invalidate; mit
  Self.Repaint; aus.

Aber falls noch mehr dazukommt würde ich eher mit einem Hier im Forum suchenOffscreenbitmap arbeiten.

Geändert von mleyen (29. Jun 2010 um 16:10 Uhr)
  Mit Zitat antworten Zitat
hoika

Registriert seit: 5. Jul 2006
Ort: Magdeburg
8.275 Beiträge
 
Delphi 10.4 Sydney
 
#4

AW: Rechteck an (unter) Maus-Position malen

  Alt 29. Jun 2010, 16:11
Hallo,

Invalidate zwingt aber das Form, sich komplett zu malen,
genau das will ich vermeiden.

OffScreenBitmap-Suche war erfolglos (der Link auf Luckies ist tot).


Heiko
Heiko
  Mit Zitat antworten Zitat
Benutzerbild von Bummi
Bummi

Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
 
Delphi XE3 Enterprise
 
#5

AW: Rechteck an (unter) Maus-Position malen

  Alt 29. Jun 2010, 16:16
ein eigener Mauscursor würde Dir nicht den gewünschen Effekt bringen?
Thomas Wassermann H₂♂
Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)
  Mit Zitat antworten Zitat
hoika

Registriert seit: 5. Jul 2006
Ort: Magdeburg
8.275 Beiträge
 
Delphi 10.4 Sydney
 
#6

AW: Rechteck an (unter) Maus-Position malen

  Alt 29. Jun 2010, 16:17
Hallo,

eigener Mauszeiger bringt nichts, TRechteck war nur als Bsp gedacht.
Aber: OffScreenBitmap

Ich dussel, so etwa habe ich es ja gedacht.
Die Frage ist nur, wenn es 24bit-Bilder sind,
ob das normale BitBlt dass dann kann.
Muss ich mal sehen.

Danke

#Update#
Mit dem OffScreenBitmap scheint es zu gehen,
ist ja praktisch ein DoubleBuffered nachgebaut.

Jetzt mal sehen, was die schicke Komponente sagt,
wo ich das benutzen muss.


Heiko
Heiko

Geändert von hoika (29. Jun 2010 um 16:35 Uhr)
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 12:31 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz