Einzelnen Beitrag anzeigen

hoika

Registriert seit: 5. Jul 2006
Ort: Magdeburg
8.276 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