Code:
UNIT Unit1;
{$mode objfpc}{$H+}
INTERFACE
USES Math,
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
BGRABitmap,
BGRABitmapTypes, BGRABlend, BGRAColorInt,
BGRADefaultBitmap,
BGRAFillInfo, BGRAGradients,
BGRAPath, BGRAPen,
BGRAPolygon, BGRAPolygonAliased,
BGRASSE, BGRAText,
BGRAGrayscaleMask,
Types;
TYPE
{ TForm1 }
TForm1 = CLASS(TForm)
Label1: TLabel;
Label2: TLabel;
Panel1: TPanel;
PROCEDURE FormCreate(Sender: TObject);
PROCEDURE FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: INTEGER);
PROCEDURE FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: INTEGER; MousePos: TPoint; VAR Handled: BOOLEAN);
PROCEDURE FormPaint(Sender: TObject);
PROCEDURE PaintImage;
PRIVATE
PUBLIC
OnderGrond: TBGRABitmap;
VirtualScreen: TBGRABitmap;
X1, Y1: INTEGER;
END;
VAR
Form1: TForm1;
IMPLEMENTATION
{$R *.lfm}
{ TForm1 }
PROCEDURE TForm1.FormCreate(Sender: TObject);
BEGIN
X1 := ClientWidth;
Y1 := ClientHeight;
Ondergrond := TBGRABitmap.Create(X1, Y1, clYellow);
VirtualScreen := TBGRABitmap.Create(200, 100);
VirtualScreen.DrawCheckers(Rect(0, 0, 200, 100), clWhite, clGray);
VirtualScreen.Canvas.Pen.Style := psSolid;
VirtualScreen.Canvas.Pen.Width := 5;
VirtualScreen.Canvas.Pen.Color := clRed;
VirtualScreen.Canvas.Brush.Style := bsClear;
VirtualScreen.Canvas.Rectangle(1,1,200,100);
Ondergrond.PutImage(10, 10, VirtualScreen, dmDrawWithTransparency);
END;
PROCEDURE TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: INTEGER);
BEGIN
Label1.Caption := IntToStr(X) + ' ' + IntToStr(Y);
END;
PROCEDURE TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: INTEGER; MousePos: TPoint; VAR Handled: BOOLEAN);
BEGIN
IF WheelDelta > 0 THEN
BEGIN
Inc(X1, 10);
Inc(Y1, 10);
END
ELSE BEGIN
Dec(X1, 10);
Dec(Y1, 10);
END;
Ondergrond.ResampleFilter := rfBestQuality;
BGRAReplace(OnderGrond, OnderGrond.resample(X1, Y1));
Label2.Caption := IntToStr(VirtualScreen.Width) + ' ' + IntToStr(VirtualScreen.Height);
PaintImage;
END;
PROCEDURE TForm1.FormPaint(Sender: TObject);
BEGIN
PaintImage;
END;
PROCEDURE TForm1.PaintImage;
BEGIN
Ondergrond.Draw(Canvas, 0, Panel1.Height + 50);
END;
END.
Bookmarks