Results 1 to 2 of 2

Thread: BGRABitmap resize gaat niet goed

  1. #1

    BGRABitmap resize gaat niet goed

    Hallo allemaal,

    Ik hoop dat jullie mij kunnen helpen met een oplossing. Ik heb al van alles geprobeerd maar kom er niet uit.

    Het probleem is dat met MouseWheel de Ondergrond wordt vergroot/verkleind. Op de ondergrond wordt een VirtualScreen weergegeven met de afmetingen 200 * 100 pixels.
    Wat er nu gebeurd is dat de afmetingen van VirtualScreen niet constant blijven maar worden vergroot of verkleind. Het gevolg is nu dat er een vervaging optreed bij het herhaaldelijk vergroten/verkleinen. Hoe los je dit op?

    Opmerking:
    -------------
    In LazPaint blijft de afmeting van het tekenvlak constant. Het programma zit echter zodanig ingewikkeld in elkaar dat het niet mogelijk is om dit om te bouwen tot een programma met grootte buttons. (O.a. noodzakelijk voor mensen met een handicap met een slechte hand coördinatie, o.a. mensen met trillende handen (Parkison)).

    Alvast bedankt en een groet van Frans.

    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.

  2. #2
    mov rax,marcov; push rax marcov's Avatar
    Join Date
    Apr 2004
    Location
    Ehv, Nl
    Posts
    10,357
    BGRAReplace(OnderGrond, OnderGrond.resample(X1, Y1));

    Je vervangt hier ondergrond met een resampling van ondergrond? Dat zorgt voor de problemen, resample hier altijd van een vaste grootte beeld naar een beeld dat varieert qua grootte.

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
  •