Einzelnen Beitrag anzeigen

Bjoerk

Registriert seit: 28. Feb 2011
Ort: Mannheim
1.384 Beiträge
 
Delphi 10.4 Sydney
 
#10

AW: TBitmap Grössenänderung langsam

  Alt 16. Mär 2015, 22:17
Kann da auch keine Verzögerung feststellen?

Beispiel:

Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox1MouseEnter(Sender: TObject);
    procedure PaintBox1MouseLeave(Sender: TObject);
  private
    FGraphic: TBitmap;
    FP: TPoint;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FGraphic := TBitmap.Create;
  PaintBox1.Left := 0;
  PaintBox1.Top := 0;
  PaintBox1.Align := alNone;
  PaintBox1.Width := 3000;
  PaintBox1.Height := 3000;
  FGraphic.Width := PaintBox1.Width;
  FGraphic.Height :=PaintBox1.Height;
  ScrollBox1.DoubleBuffered := true;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FGraphic.Free;
end;

procedure TForm1.PaintBox1MouseEnter(Sender: TObject);
begin
  ShowCursor(false);
end;

procedure TForm1.PaintBox1MouseLeave(Sender: TObject);
begin
  ShowCursor(true);
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  FP := Point(X, Y);
  PaintBox1.Invalidate;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.Draw(0, 0, FGraphic);
  PaintBox1.Canvas.MoveTo(FP.X, 0);
  PaintBox1.Canvas.LineTo(FP.X, PaintBox1.Height);
  PaintBox1.Canvas.MoveTo(0, FP.Y);
  PaintBox1.Canvas.LineTo (PaintBox1.Width, FP.Y);
end;

end.
  Mit Zitat antworten Zitat