Hi Kostas,
Now i have the following problem:
I am trying to do some animations.
I am calling for every frame of the animation 'Application.processmessages'.
As Felipe suggested, you need to use timers for animations. If you're using a
TPaintBox32 instance then you can call
TPaintBox32.Repaint inside the
OnTimer event handler (and then you can redraw your frame in the
TPaintBox32.OnPaint handler.)
A different option, which might be slightly faster (if you want to control the whole screen via Graphics32), would be to use
TForm.OnPaint and a separate paint buffer. Below are some of the changes I did to Graphics32's
GradLinesEx example in order to get good performance:
uses
LazCanvas, customdrawnint, LCLProc, ... ;
procedure TFormGradientLines.FormPaint(Sender: TObject);
var
LazCanvas: TLazCanvas;
W, H: Integer;
begin
LazCanvas := TLazCanvas(Canvas.Handle);
W := LazCanvas.Width;
H := LazCanvas.Height;
Buffer.SetSize(W, H);
RepaintBuffer;
Buffer.DrawTo(Canvas.Handle, 0, 0);
end;
procedure TFormGradientLines.Timer1Timer(Sender: TObject);
begin
Repaint;
end;
function TFormGradientLines.MyDisableFormBackgroundDrawingProc(AForm: TCustomForm): Boolean;
begin
Result := AForm = Self; // disable drawing only for self
end;
procedure TFormGradientLines.FormCreate(Sender: TObject);
begin
Buffer := TBitmap32.Create;
FadeCount := 0;
DrawPasses := 2;
CDWidgetset.DisableFormBackgroundDrawingProc := @MyDisableFormBackgroundDrawingProc;
end;
procedure TFormGradientLines.RepaintBuffer;
var
I, J: Integer;
P: PColor32;
begin
for J := 0 to DrawPasses - 1 do
for I := 0 to High(Lines) do
begin
Lines[I].Advance(1);
Lines[I].Paint;
end;
if FadeCount > 0 then
begin
if Pass = 0 then with Buffer do
begin
P := @Bits[0];
for I := 0 to Width * Height -1 do
begin
BlendMem($10000000, P^);
Inc(P);
end;
EMMS;
end;
Dec(Pass);
if (Pass < 0) or (Pass > FadeCount) then Pass := FadeCount;
end;
end;
Edit: I also made some changes to
GR32_Backends_LCL_CustomDrawn. The problem here is that you get the wrong colors (BGRA instead of ARGB.) This has been discussed a bit in the GR32 newsgroups and it seems this is a problem with some other backends as well. A solution might be to have conditional defines that would adjust the
TColor32Entry record to either ARGB or BGRA memory layout.
procedure TransferBits(Src, Dst: TLazIntfImage; X, Y, XSrc, YSrc,
SrcWidth, SrcHeight: Integer); overload;
var
I, H: Integer;
Depth: Integer;
X1, Y1, X2, Y2, SrcLine, DstLine, CopyBytes: Integer;
PSrc, PDst: PByte;
begin
Depth := Src.DataDescription.Depth shr 3;
SrcLine := Src.Width * Depth;
DstLine := Dst.Width * Depth;
PSrc := Src.PixelData;
PDst := Dst.PixelData;
if (X >= Dst.Width) or (Y >= Dst.Height) then Exit;
X1 := X;
Y1 := Y;
X2 := Min(X + SrcWidth, Dst.Width);
Y2 := Min(Y + SrcHeight, Dst.Height);
CopyBytes := (X2 - X1) * Depth;
Inc(PSrc, XSrc * Depth + SrcLine * YSrc);
Inc(PDst, X * Depth + DstLine * Y);
for I := 0 to SrcHeight - 1 do
begin
System.Move(PSrc^, PDst^, CopyBytes);
Inc(PSrc, SrcLine);
Inc(PDst, DstLine);
end;
end;
procedure TransferBits(Src, Dst: TLazIntfImage); overload;
begin
TransferBits(Src, Dst, 0, 0, 0, 0, Src.Width, Src.Height);
end;
procedure TLCLBackend.DoPaint(ABuffer: TBitmap32; AInvalidRects: TRectList;
ACanvas: TCanvas; APaintBox: TCustomPaintBox32);
var
Src, Dst: TLazCanvas;
begin
Dst := TLazCanvas(ACanvas.Handle);
Src := TLazCanvas(Canvas.Handle);
if Dst.Image is TLazIntfImage then
TransferBits(TLazIntfImage(Src.Image), TLazIntfImage(Dst.Image))
else
Dst.CopyRect(0, 0, Src, Rect(0,0,Src.Width,Src.Height));
end;
Recent
