Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Delphi PNG image displays rectangle BUG around when move / load image

Tags:

image

png

delphi

around png image appears strange rectangle on Load image or when image is moved.

Rectangle appears rarely in 24bit PNG, or jpg, but with 32bit PNG is problem. Does anyone know what causes it? PNG are created in Photoshop. I tried also gimp but same problem.

24BitPNG-BetterResult

32BitPNG-BAD-BUG

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, pngimage, jpeg, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Timer1: TTimer;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Label1: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  png:TPngImage;
  rs:TResourceStream;
  ms:TMemoryStream;

implementation

{$R *.dfm}
{$R FB.RES}

procedure TForm1.Button1Click(Sender: TObject);
begin
 rs:=TResourceStream.Create(hInstance,'24bitpng',RT_RCDATA);
 png:=TPngImage.Create;
 png.LoadFromStream(rs);
 Image1.Picture.Graphic:=png;
 rs.Free;
 Label1.Caption:=Button1.Caption;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 rs:=TResourceStream.Create(hInstance,'32bitpng',RT_RCDATA);
 png:=TPngImage.Create;
 png.LoadFromStream(rs);
 Image1.Picture.Graphic:=png;
 rs.Free;
 Label1.Caption:=Button2.Caption;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Form1.Close;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
Timer1.Enabled:=True;
Image2.Left:=0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered:=True;  //This did the job, now no flickering around

Form1.BorderStyle:=bsnone;
Form1.Position:=poScreenCenter;
Label1.Caption:=Button1.Caption;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    Screen.Cursor:=crSizeAll;
    ReleaseCapture;
    SendMessage(Form1.Handle, WM_SYSCOMMAND, 61458, 0) ;
    Screen.Cursor:=crDefault;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 if image2.Left<300 then
 image2.Left:=image2.Left+2
 else
 Timer1.Enabled:=False;

end;

end.

This i tried.

...
protected
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;

...

begin

procedure TForm1.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;


end.
like image 756
Nafalem Avatar asked Mar 11 '14 13:03

Nafalem


1 Answers

Your basic approach is flawed. You are not expected to use TImage controls to show animations. These controls are designed for displaying static images. As a crude solution you could enable double buffering for the form. Do this by setting DoubleBuffered to True. This has side-effects that may be undesirable. In any case, the entire approach should make you feel queasy.

The right approach is to render the entire image to a drawing surface. In an ideal world you would have a single windowed control that rendered the background in response to WM_ERASEBKGND, and then painted the dynamic content in response to WM_PAINT. This is what I would do.

As a simpler half way house you could use a TPaintBox or perhaps even the form's OnPaint handler. These approaches would have you painting the entire image in response to WM_PAINT. That should be free of flicker. If not then perhaps you'll need to resort to painting to an off-screen bitmap and then blitting that to the paint surface.

like image 179
David Heffernan Avatar answered Sep 28 '22 02:09

David Heffernan