Hallo allemaal,
Ik krijg met het onderstaande programma het niet voor elkaar om op een achtergrond (met foto) een rechte lijn te tekenen. Wie heeft hier een oplossing voor?
Met een vriendelijke groet, Frans
Code:
UNIT Unit1;
{$mode objfpc}{$H+}
INTERFACE
USES
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
BGRABitmap, BGRABitmapTypes, BGRABlend,
BGRAColorInt,
BGRADefaultBitmap, BGRAFillInfo, BGRAFilters,
BGRAGradients,
BGRAPath, BGRAPen,
BGRAPolygon, BGRAPolygonAliased, BGRAResample,
BGRASSE, BGRAText, BGRATextFX,
BGRAGrayscaleMask,
BGRAThumbnail;
TYPE
{ TForm1 }
TForm1 = CLASS(TForm)
Image1: TImage;
PROCEDURE Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: INTEGER);
PROCEDURE Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: INTEGER);
PROCEDURE Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: INTEGER);
PRIVATE
PUBLIC
END;
VAR
Form1: TForm1;
Bmp: TBGRABitmap;
X1, Y1: INTEGER;
IMPLEMENTATION
{$R *.lfm}
{ TForm1 }
PROCEDURE TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: INTEGER);
BEGIN
X1 := X;
Y1 := Y;
Bmp := TBGRABitmap.Create(Image1.Width, Image1.Height);
END;
PROCEDURE TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: INTEGER);
BEGIN
IF ssLeft IN Shift THEN
BEGIN
Bmp.Canvas.Line(X, Y, X1, Y1);
Bmp.Canvas.Pen.Width := 5;
Bmp.Canvas.Pen.Color := clRed;
Bmp.Draw(Image1.Canvas, 0, 0, False); //Transparent
END;
END;
PROCEDURE TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: INTEGER);
BEGIN
Bmp.Free;
END;
END.
Bookmarks