Results 1 to 6 of 6

Thread: Tekenen op het canvas van rechte lijn (BGRABitmap)

  1. #1

    Tekenen op het canvas van rechte lijn (BGRABitmap)

    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.

  2. #2
    Volgens mij gaat het in ieder geval niet goed in je mouse up event. Je freed daar je bitmap die je net getekend hebt.

  3. #3
    In MouseDown wordt BMP gemaakt.

  4. #4
    Silly member NGLN's Avatar
    Join Date
    Aug 2004
    Location
    Werkendam
    Posts
    5,133
    Wat precies krijg je niet voor elkaar? Zie je niets? Zie je iets, maar onverwacht? Komt er een foutmelding? Help ons helpen.
    (Sender as TNLDUser).Signature := 'Groeten van Albert';

  5. #5
    Wanner je een rechte lijn gaat tekenen dan staat de muiscursor aan het begin van de lijn. Daarna verplaats je de muiscursor en wordt de lijn getekend. Maar als je daarna de muiscursor van de getekende lijn naar beneden of boven beweegt wordt er een waaier getekend en dat is niet de bedoeling.

  6. #6
    Quote Originally Posted by Dubbeld View Post
    Maar als je daarna de muiscursor van de getekende lijn naar beneden of boven beweegt wordt er een waaier getekend en dat is niet de bedoeling.
    MouseMove wordt ook uitgevoerd bij elke beweging van de muis. Je krijgt dus heel veel lijnen (en dus een waaier).

    Als je een lijn wilt hebben kun je beter de bmp elke keer in MouseMove weer leegmaken.

    En niet alleen dat, je tekent ook over image1 heen. Dus die moet je ook herladen.

    Ik denk dat je de hele approach moet herdenken.
    (B.v. Een temp image eroverheenleggen die je ook elke keer weer leegmaakt)

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •