VPF::GDI+ Быстрая отрисовка. - Форум программистов

ivan219

Дата 30.7.2007, 18:39 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

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

Код


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Button1: TButton;
    XPManifest1: TXPManifest;
    procedure A(Max, Rmax: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  PosAr: Array of TPointFDynArray;
  FPos: Integer;
  Flag: Boolean = True;
implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 if Flag and (FPos<100) then Inc(FPos)
 else
  begin
   Dec(FPos);
   Flag:=False;
   if FPos = 0 then Flag:=True;
  end;
 Invalidate;
end;

procedure TForm1.A(Max, Rmax: Integer);
var
  F, X, Y: Extended;
  FPos, Rmin: Integer;
begin
 SetLength(PosAr,Max+1,2);
 for FPos:=0 to Max do
  begin
   F:=270 * FPos / Max + 45;
   SinCos(DegToRad(F), X, Y);
   if FPos mod 10 = 0 then Rmin:=Round(0.82*Rmax)
   else
    if FPos mod 5 = 0 then Rmin:=Round(0.88*Rmax)
    else Rmin:=Round(0.94*Rmax);
   PosAr[FPos,0]:=MakePoint(Rmax + X* Rmin,Rmax + Y* Rmin);
   PosAr[FPos,1]:=MakePoint(Rmax + X* Rmax,Rmax + Y* Rmax);
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
//  FontFamily : TGPFontFamily;
  GraphicsGDIPlus : TGPGraphics;
  Pen: TGPPen;
  SolidBrush: TGPSolidBrush;
 // Font       : TGPFont;
  I: Integer;
begin
 GraphicsGDIPlus:=TGPGraphics.Create(Canvas.Handle);
 Pen:=TGPPen.Create(MakeColor(200, 0, 0, 0), 2);
 SolidBrush:=TGPSolidBrush.Create(MakeColor(255, 0, 0, 0));
// FontFamily :=TGPFontFamily.Create('Times New Roman');
// Font:=TGPFont.Create(FontFamily, 18, FontStyleRegular, UnitPixel);
 GraphicsGDIPlus.SetSmoothingMode(SmoothingModeAntiAlias);
 GraphicsGDIPlus.SetTextRenderingHint(TextRenderingHintAntiAlias);

 if PosAr=Nil then A(100, 100);
 
 for I:=0 to High(PosAr) do
  GraphicsGDIPlus.DrawLine(Pen,  PosAr[I,0].X,
                                 PosAr[I,0].Y,
                                 PosAr[I,1].X,
                                 PosAr[I,1].Y);
{ for I:=0 to 10 do
  GraphicsGDIPlus.DrawString(IntToStr(I), -1, Font,
                             MakePoint(
                             PosAr[I*10,0].X,
                             PosAr[I*10,0].Y),
                             solidBrush); }
 GraphicsGDIPlus.DrawLine(Pen,100,100,PosAr[FPos,1].X,PosAr[FPos,1].Y);
 GraphicsGDIPlus.FillEllipse(SolidBrush,95,95,10,10);

 GraphicsGDIPlus.Free;
 Pen.Free;
 SolidBrush.Free;
// FontFamily.Free;
// Font.Free;
end;
end.

При отрисовке происходит мирцание, почему знаю а вот как от этого избавится не знаю.
Как избавится от мирцания учитывая что картинка постоянно меняется???

Это сообщение отредактировал(а) ivan219 - 30.7.2007, 18:41

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

Мой первый сайт и моя первая программа!!!!!

Alexeis

Дата 30.7.2007, 20:09 (ссылка)

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

Загрузка ...

Амеба

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

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

Класс TGPGraphics умеет работать также и с TGPBitmap (рисовать на его поверхности), который отлично подойдет для классической двойной буферизации.

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

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

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

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

s-mike

Дата 30.7.2007, 20:38 (ссылка)

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

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 425
Регистрация: 16.1.2005
Где: Киев

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

Для начала можно попробовать старый добрый DoubleBuffered. Мерцание тут не из-за GDI+, а потому что VCL перед отрисовкой всегда зачищает фон.

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

Преферанс для Android на базе исходников Марьяжа

ivan219

Дата 30.7.2007, 21:40 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

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

Сделал через TBitmap через TGPBitmap невыходит smile

Код


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Button1: TButton;
    XPManifest1: TXPManifest;
    Edit1: TEdit;
    procedure Timer1Timer(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  PosAr: Array of TPointFDynArray;
  FPos: Integer;
  Flag: Boolean = True;
  Bm: TBitmap;
  
implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 if Flag and (FPos<100) then Inc(FPos)
 else
  begin
   Dec(FPos);
   Flag:=False;
   if FPos = 0 then Flag:=True;
  end;
 Invalidate;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  GraphicsGDIPlus: TGPGraphics;
  Pen: TGPPen;
begin
 Canvas.Draw(0, 0, Bm);
 GraphicsGDIPlus:=TGPGraphics.Create(Canvas.Handle);
 Pen:=TGPPen.Create(MakeColor(200, 0, 0, 0), 2);
 GraphicsGDIPlus.SetSmoothingMode(SmoothingModeAntiAlias);
 GraphicsGDIPlus.DrawLine(Pen,100,100,PosAr[FPos,1].X,PosAr[FPos,1].Y);
 GraphicsGDIPlus.Free;
 Pen.Free;
 Edit1.Text:=IntToStr(FPos);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  GraphicsGDIPlus: TGPGraphics;
  Pen: TGPPen;
  SolidBrush: TGPSolidBrush;
  FontFamily : TGPFontFamily;
  Font       : TGPFont;
  F, X, Y: Extended;
  FPos, Rmin, I, Max, Rmax: Integer;
begin
 DoubleBuffered:=True;
 Bm:=TBitmap.Create;
 Bm.PixelFormat:=pf24bit;
 Bm.Width:=201;
 Bm.Height:=201;
 Max:=100;
 Rmax:=100;
 I:=0; 
 SetLength(PosAr,Max+1,2);
 for FPos:=Max downto 0 do
  begin
   F:=270 * FPos / Max + 45;
   SinCos(DegToRad(F), X, Y);
   if FPos mod 10 = 0 then Rmin:=Round(0.82*Rmax)
   else
    if FPos mod 5 = 0 then Rmin:=Round(0.88*Rmax)
    else Rmin:=Round(0.94*Rmax);
   PosAr[I,0]:=MakePoint(Rmax + X* Rmin,Rmax + Y* Rmin);
   PosAr[I,1]:=MakePoint(Rmax + X* Rmax,Rmax + Y* Rmax);
   Inc(I);
  end;
 GraphicsGDIPlus:=TGPGraphics.Create(Bm.Canvas.Handle);
 Pen:=TGPPen.Create(MakeColor(200, 0, 0, 0), 2);
 SolidBrush:=TGPSolidBrush.Create(MakeColor(255, 0, 0, 0));
 FontFamily :=TGPFontFamily.Create('Times New Roman');
 Font:=TGPFont.Create(FontFamily, 18, FontStyleRegular, UnitPixel);
 GraphicsGDIPlus.SetSmoothingMode(SmoothingModeAntiAlias);
 GraphicsGDIPlus.SetTextRenderingHint(TextRenderingHintAntiAlias);
 for I:=0 to High(PosAr) do
  GraphicsGDIPlus.DrawLine(Pen, PosAr[I,0].X, PosAr[I,0].Y,
                                PosAr[I,1].X, PosAr[I,1].Y);
 GraphicsGDIPlus.FillEllipse(SolidBrush,96,96,8,8);
 Pen.SetWidth(1);
 GraphicsGDIPlus.DrawEllipse(Pen,0,0,200,200);
 for I:=0 to 10 do
  GraphicsGDIPlus.DrawString(IntToStr(I), -1, Font,
                             MakePoint(
                             PosAr[I*10,0].X,
                             PosAr[I*10,0].Y-20),
                             solidBrush);
 GraphicsGDIPlus.Free;
 Pen.Free;
 SolidBrush.Free;
 FontFamily.Free;
 Font.Free;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Bm.Free;
end;
end.

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

Мой первый сайт и моя первая программа!!!!!

Alexeis

Дата 30.7.2007, 23:08 (ссылка)

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

Загрузка ...

Амеба

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

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

s-mike,

Цитата(s-mike @ 30.7.2007, 20:38

)

старый добрый DoubleBuffered

при каждой перерисовке создает новый битмап размеров на всю форму и по окончанию его удаляет и так при каждой перерисовке идет нехилый расход процессорного времени. Т.е. весьма не оптимальный способ, особенно при наличии конртолов на форме которые будут всякий раз перерисовываться.
Я как-то засекал, 13 мс уходит только на отрисовку такого битмапа (при большой форме), а если еще и рисовать на нем и создавать его каждый кадр, так вообще тормоза обеспечены.

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

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