Как убрать мерцание при изменении яркости в Image

[werrey]

Здравствуйте.
В нижеприведённом примере прозрачная картинка(png) лежит поверх Image, в котором регулируется изменение яркости.
При изменении яркости Image, происходит мерцание картинки(png),лежащей поверх основной.
Как это можно исправить?

Код:

Unit Unit1;

 Interface

 Uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
       ExtCtrls, StdCtrls, ComCtrls, pngimage;

 Type
  TForm1 = Class(TForm)
    Label1: TLabel;
    OrigImage: TImage;
    Label2: TLabel;
    DestImage: TImage;
    TrackBar1: TTrackBar;
    Label3: TLabel;
    ValueLbl: TLabel;
    Image1: TImage;
    Procedure FormCreate(Sender: TObject);
    Procedure TrackBar1Change(Sender: TObject);
  End;

 Var Form1 :TForm1;

 Const MaxPixelCount   =  32768;

 Type
    pRGBArray  =  ^TRGBArray;
    TRGBArray  =  ARRAY[0..MaxPixelCount-1] OF TRGBTriple;

 function Min(a, b: integer): integer;
 function Max(a, b: integer): integer;

 Implementation



 {$R *.DFM}

 Procedure TForm1.FormCreate(Sender: TObject);
  Begin
   OrigImage.Picture.LoadFromFile('1.bmp');
   DestImage.Picture.LoadFromFile('1.bmp');
    Image1.Picture.LoadFromFile('2.png');

   OrigImage.Picture.Bitmap.PixelFormat := pf24bit;
   DestImage.Picture.Bitmap.PixelFormat := pf24bit;

   TrackBar1.Position := 0;
   ValueLbl.Caption := '0'
 End;

 Procedure TForm1.TrackBar1Change(Sender: TObject);
  Var      i, j, value :integer;
      OrigRow, DestRow :pRGBArray;
  Begin
    // get brightness increment value
    value := TTrackBar(Sender).Position;

   if value <= 0 Then ValueLbl.Caption := IntToStr(value)
   Else ValueLbl.Caption := Format('+%d', [value]);

   // for each row of pixels
   For i := 0 to OrigImage.Picture.Height - 1 Do
    Begin
     OrigRow := OrigImage.Picture.Bitmap.ScanLine[i];
     DestRow := DestImage.Picture.Bitmap.ScanLine[i];
     // for each pixel in row
     For j := 0 to OrigImage.Picture.Width - 1 Do
      Begin
        //add brightness value to pixel's RGB values
        If value > 0 Then
         Begin
          // RGB values must be less than 256
          DestRow[j].rgbtRed := Min(255, OrigRow[j].rgbtRed + value);
          DestRow[j].rgbtGreen := Min(255, OrigRow[j].rgbtGreen + value);
          DestRow[j].rgbtBlue := Min(255, OrigRow[j].rgbtBlue + value);
         End
         Else
          Begin
           // RGB values must be greater or equal than 0
           DestRow[j].rgbtRed := Max(0, OrigRow[j].rgbtRed + value);
           DestRow[j].rgbtGreen := Max(0, OrigRow[j].rgbtGreen + value);
           DestRow[j].rgbtBlue := Max(0, OrigRow[j].rgbtBlue + value);
          End;
         End;
      End;

      DestImage.Repaint;
 End;

 Function Min(a, b: integer): integer;
  Begin
   if a < b Then result := a
   Else result := b;
 End;

 Function Max(a, b: integer): integer;
  Begin
   If a > b Then result := a
   Else result := b;
 End;

End.

Пример, в котором можно увидеть мерцание, при изменении яркости:

[artemavd]

Попробуй поставить свойство DoubleBuffered = True. Вообще, подобная тема много раз обсуждалась.

[werrey]

Сообщение от artemavd

Попробуй поставить свойство DoubleBuffered = True. Вообще, подобная тема много раз обсуждалась.

Это не помогает, Вы посмотрите пожалуйста скомпилированный проект, там если ползунком менять яркость, то происходит мерцание наложенной картинки.

Вопрос не решен.

[voronuk]

Не удержался... Не юзайте Repaint, рано или поздно наступите на грабли, юзайте Invalidate (извините что не по теме, в остальном код почти верный, молодцы что юзаете Scanline). Мерцание происходит из за: Image1.Picture.LoadFromFile('2.png' ) - Image1 винда перерисовывает самостоятельно, без Вашего участия - отселя и мигание.
Чтоб не мигало: 2.png-> во временный битмап- > изменили фон + наложили на фон битмап 2.png -> отобразили.

[werrey]

Сообщение от voronuk

Не удержался... Не юзайте Repaint, рано или поздно наступите на грабли, юзайте Invalidate (извините что не по теме, в остальном код почти верный, молодцы что юзаете Scanline). Мерцание происходит из за: Image1.Picture.LoadFromFile('2.png' ) - Image1 винда перерисовывает самостоятельно, без Вашего участия - отселя и мигание.
Чтоб не мигало: 2.png-> во временный битмап- > изменили фон + наложили на фон битмап 2.png -> отобразили.

Спасибо, а как это реализовать, можно по подробней?

[GreyScall]

Сообщение от voronuk

Не юзайте Repaint, рано или поздно наступите на грабли, юзайте Invalidate

хм... И который же Invalidate() Вы имели ввиду..? TWinControl.Invalidate() или Windows.InvalidateRect() ?
Впрочем не важно... Посмотрите реализацию Repaint() - оно использует и то и то...

Сообщение от voronuk

Image1 винда перерисовывает самостоятельно, без Вашего участия - отселя и мигание.

Не совсем... TImage это не Static-окно, а так сказать "рисованный" компонент VCL... Его отрисовкой занимается сама VCL...

Сообщение от voronuk

Чтоб не мигало: 2.png-> во временный битмап- > изменили фон + наложили на фон битмап 2.png -> отобразили.

Примерно это и делает DoubleBuffered...

Сообщение от werrey

Это не помогает, Вы посмотрите пожалуйста скомпилированный проект ...

Ну во-первых у Вас там как раз нет "DoubleBuffered:=True;" (оно должно быть в FormCreate()), а во вторых нужно делать не "DestImage.Repaint();", а просто "Repaint();"...

В остальное не всматривался...

[voronuk]

Спасибо, а как это реализовать, можно по подробней?

DestImage.Picture.Bitmap.Canvas.Dra w(0,0,Image1.Picture.Graphic);

+ Поставте DestImage на панель
+ Поставте свойство DestImage.Stretch в false (если оно Вам ненано)

Подкорректированный код в аттаче