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
 
hoika

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

Rechteck an (unter) Maus-Position malen

  Alt 29. Jun 2010, 14: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 15:06 Uhr)
  Mit Zitat antworten Zitat
 


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 10:37 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