VPF::моргание при анимации в GDI+ - Форум программистов

stalkerok

Дата 16.6.2009, 10:39 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 62
Регистрация: 28.12.2007

Репутация: нет
Всего: нет

Помогите избавиться от моргания, пробовал frmMain.DoubleBuffered:= true; но тогда нет прорисовки.

Код


unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, GDIPAPI, GDIPOBJ, ExtCtrls, StdCtrls, IniFiles;

type
  TfrmMain = class(TForm)
    imgMain: TImage;
    Timer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormPaint(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
  private
  public
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

var
  graphics : TGPGraphics;
  SolidBrush: TGPSolidBrush;
  Pen: TGPPen;
  ox, oy: integer;

//******************************************************************************
//Create
procedure CreateGraphics();
begin
  graphics.SetSmoothingMode(SmoothingModeAntiAlias);
  Pen := TGPPen.Create(MakeColor(100, 0, 0, 255));
  SolidBrush := TGPSolidBrush.Create(MakeColor(150, 255, 0, 0));
  //frmMain.DoubleBuffered:= true;
end;

//******************************************************************************
//Free
procedure FreeGraphics();
begin
  Pen.Free;
  SolidBrush.Free;
end;

//******************************************************************************
//Figure
procedure CreateFigure();
begin
  graphics.DrawLine(Pen, ox, oy, ox+100, oy+100);
  graphics.FillEllipse(SolidBrush, ox-3, oy-3, 6, 6);
end;

//******************************************************************************
//Close
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeGraphics;
end;

//******************************************************************************
//Main
procedure TfrmMain.FormCreate(Sender: TObject);
var
  i: integer;
begin
  ox:=0;
  oy:=0;
end;

//******************************************************************************
//Paint
procedure TfrmMain.FormPaint(Sender: TObject);
begin
  graphics:= TGPGraphics.Create(frmMain.imgMain.Canvas.Handle);
  CreateGraphics;
  graphics.Clear(MakeColor(255, 255, 255, 255));
  try
    CreateFigure;
  finally
    graphics.Free;
  end;
end;

//******************************************************************************
//Timer
procedure TfrmMain.TimerTimer(Sender: TObject);
begin
  ox:=ox+1;
  oy:=oy+1;
  if ox>=300 then ox:=0;
  if oy>=300 then oy:=0;
  frmMain.Repaint;
end;

end.

Alexeis

Дата 16.6.2009, 11:10 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Нужно делает двойную буферизацию средствами GDI+. Создать битмапку TGPBitmap, рисовать на него, а потом его отрисовать на экран, т.е. на TGPGraphics

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

stalkerok

Дата 16.6.2009, 11:28 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 62
Регистрация: 28.12.2007

Репутация: нет
Всего: нет

Alexeis а как это сделать? можно пример.
спасибо!

Alexeis

Дата 16.6.2009, 11:33 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Код


procedure TForm1.PaintGPBitmap;
var GDI,g: TGPGraphics;
    Img: TGPBitmap;
begin
  GDI := TGPGraphics.Create(Self.Canvas.Handle);
  Img := TGPBitmap.Create(ClientWidth, ClientHeight, PixelFormat32bppRGB);
  g := TGPGraphics.Create(Img);

  g.Clear(MakeColor(255,255,255));
  PaintText(g);
  g.Free;

  GDI.DrawImage(Img, 0, 0);
  GDI.Free;
  Img.Free;
end;

отсюда

--------------------

stalkerok

Дата 16.6.2009, 12:10 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 62
Регистрация: 28.12.2007

Репутация: нет
Всего: нет

Спасибо!!!!
может кому пригодиться:

Код


unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, GDIPAPI, GDIPOBJ, ExtCtrls, StdCtrls, IniFiles;

type
    TfrmMain = class(TForm)
    Timer: TTimer;
    procedure TimerTimer(Sender: TObject);
  private
    procedure CreateFigure(Gdi: TGPGraphics);
    procedure Paint;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

var
  ox, oy: integer;

//******************************************************************************
//Figure
procedure TfrmMain.CreateFigure(Gdi: TGPGraphics);
var
  SolidBrush: TGPSolidBrush;
  Pen: TGPPen;
begin
  Pen := TGPPen.Create(MakeColor(100, 0, 0, 255));
  SolidBrush := TGPSolidBrush.Create(MakeColor(150, 255, 0, 0));
  Gdi.DrawLine(Pen, ox, oy, ox+100, oy+100);
  Gdi.FillEllipse(SolidBrush, ox-3, oy-3, 6, 6);
  Pen.Free;
  SolidBrush.Free;
end;

//******************************************************************************
//Paint
procedure TfrmMain.Paint;
var
  graphics_buf: TGPGraphics;
  graphics : TGPGraphics;
  graphics_img: TGPBitmap;
begin
  graphics:= TGPGraphics.Create(Self.Canvas.Handle);
  graphics_img:= TGPBitmap.Create(ClientWidth, ClientHeight, PixelFormat32bppRGB);
  graphics_buf:= TGPGraphics.Create(graphics_img);
  graphics_buf.SetSmoothingMode(SmoothingModeAntiAlias);
  graphics_buf.Clear(MakeColor(255, 255, 255, 255));
  CreateFigure(graphics_buf);
  graphics_buf.Free;
  graphics.DrawImage(graphics_img, 0, 0);
  graphics.Free;
  graphics_img.Free;
end;

//******************************************************************************
//Timer
procedure TfrmMain.TimerTimer(Sender: TObject);
begin
  ox:=ox+1;
  oy:=oy+1;
  if ox>=300 then ox:=0;
  if oy>=300 then oy:=0;
  Paint;
end;

end.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »