1 {******************************************************************}
2 {* IPANIM.PAS - Provides basic animation support. You should not *}
3 {* need to create an instance of this class, instead you should *}
4 {* inherit your animated graphics class from this class. *}
5 {******************************************************************}
6
7 (* ***** BEGIN LICENSE BLOCK *****
8 * Version: MPL 1.1
9 *
10 * The contents of this file are subject to the Mozilla Public License Version
11 * 1.1 (the "License"); you may not use this file except in compliance with
12 * the License. You may obtain a copy of the License at
13 * http://www.mozilla.org/MPL/
14 *
15 * Software distributed under the License is distributed on an "AS IS" basis,
16 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
17 * for the specific language governing rights and limitations under the
18 * License.
19 *
20 * The Original Code is TurboPower Internet Professional
21 *
22 * The Initial Developer of the Original Code is
23 * TurboPower Software
24 *
25 * Portions created by the Initial Developer are Copyright (C) 2000-2002
26 * the Initial Developer. All Rights Reserved.
27 *
28 * Contributor(s):
29 *
30 * ***** END LICENSE BLOCK ***** *)
31
32 { Global defines potentially affecting this unit }
33 {$I IPDEFINE.INC}
34
35 unit IpAnim;
36
37 interface
38
39 uses
40 LCLType,
41 GraphType,
42 LCLIntf,
43 SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
44 ExtCtrls, IpConst;
45
46 const
47
48 // Constants for the default settings of some properties
49
50 DefaultAggressiveDrawing : Boolean = False;
51 DefaultFrameChangeNotify : Boolean = False;
52
53 type
54
55 // Various disposal methods
56
57 TDisposalMethod = (NODISPOSALMETHOD, DONOTDISPOSE, OVERWRITEWITHBKGCOLOR,
58 OVERWRITEWITHPREVIOUS);
59
60 TIpAnimationFrameList = class;
61
62 // Event Types
63
64 TOnBeforeFrameChange = procedure ( Sender : TObject;
65 CurrentFrame : Integer;
66 var NewFrame : Integer;
67 Frames : TIpAnimationFrameList;
68 var CanChange : boolean) of object;
69
70 TOnAfterFrameChange = procedure (Sender : TObject;
71 CurrentFrame : Integer;
72 Frames : TIpAnimationFrameList)
73 of object;
74
75 // Exception Classes
76
77 EAnimationError = class(Exception); // GIF Decoding errors
78 EFrameListError = class (Exception); // GIF Frame List errors
79
80 // TIpAnimationFrame
81
82 {
83 TIpAnimationFrame holds one frame of an animation. It also keeps track
84 of the x and y offsets for the frame and the size of this frame.
85 }
86
87 TIpAnimationFrame = class(TObject)
88
89 private
90 FBitmap : TBitmap; // bitmap for this frame
91 FXOffset : Integer; // X Offset for this frame
92 FYOffset : Integer; // Y Offset for this frame
93 FDelayTime : Integer; // Time in 1/100 second til next frame
94 FDisposalMethod : TDisposalMethod; // Disposal Method
95 FTransparent : Boolean;
96 FTransparentColor : TColor;
97
98 protected
99
100 procedure SetBitmap (v : TBitmap);
101 procedure SetDelayTime (v : Integer);
102 procedure SetXOffset (v : Integer);
103 procedure SetYOffset (v : Integer);
104
105 public
106
107 constructor Create;
108 destructor Destroy; override;
109
110 published
111
112 property Bitmap : TBitmap read FBitmap write SetBitmap;
113 property DelayTime : Integer read FDelayTime write SetDelayTime;
114 property DisposalMethod : TDisposalMethod
115 read FDisposalMethod write FDisposalMethod default DONOTDISPOSE;
116 property Transparent : Boolean
117 read FTransparent write FTransparent;
118 property TransparentColor : TColor
119 read FTransparentColor write FTransparentColor;
120 property XOffset : Integer read FXOffset write SetXOffset default 0;
121 property YOffset : Integer read FYOffset write SetYOffset default 0;
122
123 end;
124
125
126 {
127 TIpAnimationFrameList holds a list of Frames.
128 }
129
130 TIpAnimationFrameList = class(TObject)
131 private
132
133 FReferenceCounter : Integer; // Internal reference counter
134 FList : TList;
135
136 protected
137
GetCountnull138 function GetCount : Integer;
139 procedure SetCount (v : Integer);
GetItemnull140 function GetItem(Index : Integer): TIpAnimationFrame;
141 procedure SetItem(Index : Integer; AFrame : TIpAnimationFrame);
142 procedure RegisterFrames; virtual;
143 procedure ReleaseFrames; virtual;
144
145 public
146 constructor Create;
147 destructor Destroy; override;
148
149 // public methods
150
Addnull151 function Add(AFrame : TIpAnimationFrame): Integer;
152 procedure Assign (Source : TIpAnimationFrameList); virtual;
153 procedure Clear;
IndexOfnull154 function IndexOf(AFrame : TIpAnimationFrame): Integer;
155 procedure Insert(Index : Integer; AFrame : TIpAnimationFrame);
Removenull156 function Remove(AFrame : TIpAnimationFrame): Integer;
157
158 // properties
159
160 property Count : Integer read GetCount write SetCount;
161 property Items[Index: Integer]: TIpAnimationFrame
162 read GetItem write SetItem; default;
163 property List : TList read FList write FList;
164
165 end;
166
167 {
168 TFreeGIFImage holds a decopressed GIF image.
169 }
170
171 TIpAnimatedGraphic = class(TGraphic)
172
173 private
174
175 FNumFrames : Integer; // Number of frames in an animation
176 FAnimate : boolean; // Animated image or not indicator
177 FRealWidth : Integer; // Real width of the image
178 FRealHeight : Integer; // Real height of the image
179
180 FBitmap : TBitmap; // bitmap of the current frame
181
182 FDelayTime : Integer; // Delay in 100ths of a second
183 FCurrentFrame : Integer; // Index of the current frame
184 FDisposalMethod : TDisposalMethod; // Disposal method for the cur frm
185 FAggressiveDrawing : Boolean; // steal a canvas and write to it?
186 FFrameChangeNotify : Boolean; // trigger OnChange events?
187
188 FTransparent : Boolean;
189 FTransparentColor : TColor;
190 FBackgroundColor : TColor;
191
192 FTimer : TTimer; // Animation Timer
193 FImages : TIpAnimationFrameList;
194
195 FOnBeforeFrameChange : TOnBeforeFrameChange;
196 FOnAfterFrameChange : TOnAfterFrameChange;
197
198 FDrawingCanvas : TCanvas; // Canvas that will be "stolen" for
199 // animation purposes.
200 FDrawingRect : TRect;
201
202 FDestinationCanvas : TCanvas; // User specified canvas to write to.
203 FDestinationRect : TRect; // User specified rectangle to write to.
204
205 protected
206
207 // Property Access
208
209 procedure ChangeFrame (NewFrame : Integer); virtual;
210 procedure ClearFrame ( CurrentFrame : TBitmap;
211 NewFrame : TIpAnimationFrame;
212 DisposalMethod : TDisposalMethod;
213 var DefaultDrawing : Boolean); virtual;
214 procedure Draw( ACanvas : TCanvas;
215 const Rect : TRect); override;
216 procedure FreeAnimationFrames; virtual;
GetAnimatenull217 function GetAnimate : boolean;
GetEmptynull218 function GetEmpty : Boolean; override;
GetHeightnull219 function GetHeight : Integer; override;
GetWidthnull220 function GetWidth : Integer; override;
221 procedure Initialize; virtual;
222 procedure SetAggressiveDrawing (v : Boolean);
223 procedure SetAnimate (v : boolean);
224 procedure SetBitmap (v : TBitmap);
225 procedure SetDelayTime (v : Integer);
226 procedure SetDestinationCanvas (v : TCanvas);
227 procedure SetDestinationRect (v : TRect);
228 procedure SetDisposalMethod (v : TDisposalMethod);
229 procedure SetDrawingCanvas (v : TCanvas);
230 procedure SetDrawingRect (v : TRect);
231 procedure SetFrameChangeNotify (v : Boolean);
232 procedure SetHeight (v : Integer); override;
233 procedure SetImages (v : TIpAnimationFrameList);
234 procedure SetNumFrames (v : Integer);
235 procedure SetWidth (v : Integer); override;
236 procedure TimerTimeoutHandler (Sender : TObject); virtual;
237
238 public
239
240 constructor Create; override;
241 destructor Destroy; override;
242
243 procedure Assign(Source : TPersistent); override;
244 procedure AssignTo (Dest : TPersistent); override;
245
246 procedure LoadFromStream (Stream: TStream); override;
247
StartAnimationnull248 function StartAnimation : boolean; virtual;
249 procedure StopAnimation; virtual;
250
251
252 // Properties
253
254 property AggressiveDrawing : Boolean
255 read FAggressiveDrawing write SetAggressiveDrawing;
256 property Animate : boolean read GetAnimate write SetAnimate;
257 property BackgroundColor : TColor
258 read FBackgroundColor write FBackgroundColor;
259 property Bitmap : TBitmap read FBitmap write SetBitmap;
260 property CurrentFrameIndex : Integer read FCurrentFrame write ChangeFrame;
261 property DelayTime : Integer read FDelayTime write SetDelayTime;
262 property DestinationCanvas : TCanvas
263 read FDestinationCanvas write SetDestinationCanvas;
264 property DestinationRect : TRect
265 read FDestinationRect write SetDestinationRect;
266 property DrawingCanvas : TCanvas
267 read FDrawingCanvas write SetDrawingCanvas;
268 property DrawingRect : TRect
269 read FDrawingRect write SetDrawingRect;
270 property DisposalMethod : TDisposalMethod
271 read FDisposalMethod write SetDisposalMethod;
272 property FrameChangeNotify : Boolean
273 read FFrameChangeNotify write SetFrameChangeNotify;
274 property Height : Integer read getHeight write setHeight;
275 property Images : TIpAnimationFrameList read FImages write SetImages;
276 property NumFrames : Integer read FNumFrames write SetNumFrames;
277 property Transparent : boolean read FTransparent write FTransparent;
278 property TransparentColor : TColor
279 read FTransparentColor write FTransparentColor;
280 property Width : Integer read getWidth write setWidth;
281
282 // Events
283
284 property OnAfterFrameChange : TOnAfterFrameChange
285 read FOnAfterFrameChange
286 write FOnAfterFrameChange;
287 property OnBeforeFrameChange : TOnBeforeFrameChange
288 read FOnBeforeFrameChange
289 write FOnBeforeFrameChange;
290 published
291
292 end;
293
294 implementation
295
296 // TFreeGIFFrame
297
298 constructor TIpAnimationFrame.Create;
299 begin
300 inherited Create;
301
302 FBitmap := TBitmap.create;
303
304 XOffset := 0;
305 YOffset := 0;
306 DisposalMethod := NODISPOSALMETHOD;
307 end;
308
309 destructor TIpAnimationFrame.Destroy;
310 begin
311 FBitmap.Free;
312 FBitmap := nil;
313
314 inherited Destroy;
315 end;
316
317 procedure TIpAnimationFrame.SetBitmap (v : TBitmap);
318 begin
319 FBitmap.Assign (v);
320 end;
321
322 procedure TIpAnimationFrame.SetDelayTime (v : Integer);
323 begin
324 if v <> FDelayTime then
325 FDelayTime := v;
326 end;
327
328 procedure TIpAnimationFrame.SetXOffset (v : Integer);
329 begin
330 if v <> FXOffset then
331 FXOffset := v;
332 end;
333
334 procedure TIpAnimationFrame.SetYOffset (v : Integer);
335 begin
336 if v <> FYOffset then
337 FYOffset := v;
338 end;
339
340 // TIpAnimationFrameList
341
342 constructor TIpAnimationFrameList.Create;
343 begin
344 inherited Create;
345
346 FList := TList.Create;
347
348 FReferenceCounter := 0;
349 end;
350
351 destructor TIpAnimationFrameList.Destroy;
352 begin
353 FList.Free;
354 inherited Destroy;
355 end;
356
Addnull357 function TIpAnimationFrameList.Add(AFrame : TIpAnimationFrame) : Integer;
358 begin
359 Result := FList.Add (AFrame)
360 end;
361
362 procedure TIpAnimationFrameList.Assign (Source : TIpAnimationFrameList);
363 var
364 i : Integer;
365 begin
366 Clear;
367 FList.Capacity := Source.List.Capacity;
368 FList.Count := Source.List.Count;
369 for i := 0 to Source.List.Count - 1 do
370 FList.Items[i] := Source.List.Items[i];
371
372 RegisterFrames;
373 end;
374
375 procedure TIpAnimationFrameList.Clear;
376 begin
377 FList.Clear;
378 end;
379
GetCountnull380 function TIpAnimationFrameList.GetCount : Integer;
381 begin
382 result := FList.Count;
383 end;
384
GetItemnull385 function TIpAnimationFrameList.GetItem(Index : Integer) :
386 TIpAnimationFrame;
387 begin
388
389 if (Index >= FList.Count) or (Index < 0) then begin
390 Result := nil;
391 Exit;
392 end;
393
394 if (FList.Items[Index]=nil) then begin
395 Result := nil;
396 Exit;
397 end;
398
399 if TObject (FList.Items[Index]) is TIpAnimationFrame then
400 Result := TObject (FList.Items[Index]) as TIpAnimationFrame
401 else
402 raise EFrameListError.CreateFmt(sBadFrameListObject,
403 [TObject(FList.Items[Index]).ClassName]);
404 end;
405
TIpAnimationFrameList.IndexOfnull406 function TIpAnimationFrameList.IndexOf(AFrame : TIpAnimationFrame) : Integer;
407 begin
408 Result := FList.IndexOf (AFrame);
409 end;
410
411 procedure TIpAnimationFrameList.Insert(Index : Integer;
412 AFrame : TIpAnimationFrame);
413 begin
414 FList.Insert (Index, AFrame);
415 end;
416
417 procedure TIpAnimationFrameList.RegisterFrames;
418 begin
419 inc(FReferenceCounter);
420 end;
421
422 procedure TIpAnimationFrameList.ReleaseFrames;
423 var
424 i : Integer;
425 begin
426 dec (FReferenceCounter);
427 if FReferenceCounter >= 0 then
428 exit;
429
430 for i := 0 to FList.Count - 1 do begin
431 if (FList.Items[i]<>nil) then
432 if TObject(FList.Items[i]) is TIpAnimationFrame then
433 TIpAnimationFrame (FList.Items[i]).Free;
434 FList.Items[i] := nil;
435 end;
436
437 Clear;
438 FList.Count := 0;
439 end;
440
TIpAnimationFrameList.Removenull441 function TIpAnimationFrameList.Remove(AFrame : TIpAnimationFrame) : Integer;
442 begin
443 Result := FList.Remove (AFrame);
444 end;
445
446 procedure TIpAnimationFrameList.SetCount (v : Integer);
447 begin
448 if v <> FList.Count then
449 FList.Count := v;
450 end;
451
452 procedure TIpAnimationFrameList.SetItem(Index : Integer;
453 AFrame : TIpAnimationFrame);
454 begin
455 FList.Items[Index] := AFrame;
456 end;
457
458 // TIpAnimatedGraphic
459
460 constructor TIpAnimatedGraphic.Create;
461 begin
462 inherited Create;
463
464 FBitmap := TBitmap.create;
465
466 FImages := TIpAnimationFrameList.create;
467
468 FTimer := TTimer.create(nil);
469 FTimer.Enabled := False;
470 FTImer.OnTimer := TimerTimeoutHandler;
471
472 FDrawingCanvas := nil;
473 FDestinationCanvas := nil;
474
475 FAggressiveDrawing := DefaultAggressiveDrawing;
476
477 FFrameChangeNotify := DefaultFrameChangeNotify;
478
479 end;
480
481 destructor TIpAnimatedGraphic.Destroy;
482 begin
483 FTimer.Free;
484 FTimer := nil;
485
486 FBitmap.Free;
487 FBitmap := nil;
488
489 FreeAnimationFrames;
490
491 FImages.Free;
492 FImages := nil;
493
494 inherited Destroy;
495 end;
496
497 procedure TIpAnimatedGraphic.Assign (Source : TPersistent);
498 begin
499 if Source is TIpAnimatedGraphic then
500 with Source as TIpAnimatedGraphic do begin
501 Self.Bitmap.assign(Bitmap);
502 Self.Images.Assign(Images);
503 Self.NumFrames := NumFrames;
504 Self.Animate := Animate;
505 Self.Width := Width;
506 Self.Height := Height;
507 Self.CurrentFrameIndex := 0;
508 Self.DelayTime := DelayTime;
509 Self.DisposalMethod := DisposalMethod;
510 Self.AggressiveDrawing := AggressiveDrawing;
511 Self.FrameChangeNotify := FrameChangeNotify;
512 Self.DrawingCanvas := DrawingCanvas;
513 end
514 else
515 inherited Assign (Source);
516 end;
517
518 procedure TIpAnimatedGraphic.AssignTo (Dest : TPersistent);
519 begin
520 if (Dest is TBitmap) then
521 Dest.Assign(Bitmap)
522 else
523 inherited AssignTo(Dest);
524 end;
525
526 procedure TIpAnimatedGraphic.ChangeFrame (NewFrame : Integer);
527 var
528 DefaultDrawing : Boolean;
529 begin
530 if (NewFrame < 0) or (NewFrame >= NumFrames) then
531 exit;
532
533 FCurrentFrame := NewFrame;
534
535 FBitmap.Width := FRealWidth;
536 FBitmap.Height := FRealHeight;
537 DisposalMethod := Images[NewFrame].DisposalMethod;
538
539 DefaultDrawing := True;
540 ClearFrame (FBitmap, Images[NewFrame],
541 Images[NewFrame].DisposalMethod, DefaultDrawing);
542
543 if DefaultDrawing then
544 FBitmap.Canvas.CopyRect (Rect (Images[NewFrame].XOffset,
545 Images[NewFrame].YOffset,
546 Images[NewFrame].XOffset + Images[NewFrame].Bitmap.Width,
547 Images[NewFrame].YOffset + Images[NewFrame].Bitmap.Height),
548 Images[NewFrame].Bitmap.Canvas,
549 Rect (0,
550 0,
551 Images[NewFrame].Bitmap.Width,
552 Images[NewFrame].Bitmap.Height));
553
554 if AggressiveDrawing then begin
555 if assigned(FDrawingCanvas) then begin
556 // Do a quick and dirty verification that the handle that we stole
557 // from the .Draw method is still good. We do this by calling
558 // GetDeviceCaps with the handle and verifying that there is something
559 // there. If this is ok, we can then update the bitmap with the next
560 // frame.
561 if GetDeviceCaps (FDrawingCanvas.Handle, HORZSIZE) <> 0 then begin
562 if Animate and Transparent then
563 FDrawingCanvas.CopyRect (FDrawingRect, FBitmap.Canvas,
564 Rect (0, 0,
565 FBitmap.Width,
566 FBitmap.Height))
567 else
568 Draw (FDrawingCanvas, FDrawingRect);
569 end;
570 end;
571 end;
572
573 if assigned(FDestinationCanvas) then begin
574 if Animate and Transparent then
575 FDestinationCanvas.CopyRect (FDestinationRect, FBitmap.Canvas,
576 Rect (0, 0,
577 FBitmap.Width,
578 FBitmap.Height))
579 else
580 Draw (FDestinationCanvas, DestinationRect);
581 end;
582
583 // An alternate way to cause the animation to occur is to use the OnChange
584 // event to notify the parent application that the image has changed. The
585 // problem with this is that the resulting flicker is... severe....
586
587 if (assigned (OnChange)) and FrameChangeNotify then
588 OnChange (self);
589
590 if (assigned (FOnAfterFrameChange)) then
591 FOnAfterFrameChange (Self, NewFrame, Images);
592
593 end;
594
595 procedure TIpAnimatedGraphic.ClearFrame ( CurrentFrame : TBitmap;
596 NewFrame : TIpAnimationFrame;
597 DisposalMethod : TDisposalMethod;
598 var DefaultDrawing : Boolean);
599 var
600 i : Integer;
601 x, y : Integer;
602 UseTransparentCopy : Boolean;
603
604 begin
605 if (CurrentFrame=nil) then ;
606 // Basic clear frame. This should work for just about anything.
607 DefaultDrawing := False;
608 UseTransparentCopy := False;
609
610 case DisposalMethod of
611
612 NODISPOSALMETHOD :
613 // do nothing in this case - leave the old image
614 begin
615 UseTransparentCopy := NewFrame.Transparent;
616 end;
617
618 DONOTDISPOSE :
619 // do nothing in this case - leave the old image
620 begin
621 UseTransparentCopy := NewFrame.Transparent;
622 end;
623
624 OVERWRITEWITHBKGCOLOR :
625 begin
626 // Fill with the background color
627 Bitmap.Canvas.Brush.Color := BackgroundColor;
628 Bitmap.Canvas.FillRect (Rect(NewFrame.XOffset,
629 NewFrame.YOffset,
630 NewFrame.XOffset + NewFrame.Bitmap.Width,
631 NewFrame.YOffset + NewFrame.Bitmap.Height));
632 end;
633 OVERWRITEWITHPREVIOUS :
634 // Try to find the last do not dispose frame and fill the canvas with
635 // that.
636 begin
637 i := CurrentFrameIndex;
638 while (i >= 0) and (FNumFrames > 1) and
639 (Images[i].DisposalMethod <> DONOTDISPOSE) do
640 dec (i);
641 if (i >= 0) and (i < FNumFrames) and (FNumFrames > 1) then begin
642 if Images[i].DisposalMethod = DONOTDISPOSE then
643 Bitmap.Canvas.CopyRect (Rect (Images[i].XOffset,
644 Images[i].YOffset,
645 Images[i].XOffset + Images[i].Bitmap.Width,
646 Images[i].YOffset + Images[i].Bitmap.Height),
647 Images[i].Bitmap.Canvas,
648 Rect (0,
649 0,
650 Images[i].Bitmap.Width,
651 Images[i].Bitmap.Height));
652 UseTransparentCopy := NewFrame.Transparent;
653 end
654 else
655 UseTransparentCopy := NewFrame.Transparent;
656 end;
657
658 end;
659
660 // This is not a generally recommended way of handling transparency.
661 // However, it gets the timing more accurate.
662
663 if UseTransparentCopy then begin
664 if Images[FCurrentFrame].Bitmap <> nil then
665 for x := 0 to Images[FCurrentFrame].Bitmap.Width - 1 do
666 for y := 0 to Images[FCurrentFrame].Bitmap.Height - 1 do
667 if Images[FCurrentFrame].Bitmap.Canvas.Pixels[x, y] <>
668 Images[FCurrentFrame].TransparentColor then begin
669 if (x + Images[FCurrentFrame].XOffset < Bitmap.Width) and
670 (y + Images[FCurrentFrame].YOffset < Bitmap.Height) then
671 Bitmap.Canvas.Pixels[x + Images[FCurrentFrame].XOffset,
672 y + Images[FCurrentFrame].YOffset] :=
673 Images[FCurrentFrame].Bitmap.Canvas.Pixels[x, y];
674 end;
675 end else
676 Bitmap.Canvas.CopyRect (Rect (NewFrame.XOffset,
677 NewFrame.YOffset,
678 NewFrame.XOffset + NewFrame.Bitmap.Width,
679 NewFrame.YOffset + NewFrame.Bitmap.Height),
680 NewFrame.Bitmap.Canvas,
681 Rect (0,
682 0,
683 NewFrame.Bitmap.Width,
684 NewFrame.Bitmap.Height));
685
686 end;
687
688 procedure TIpAnimatedGraphic.Draw( ACanvas : TCanvas;
689 const Rect : TRect);
690 begin
691
692 // Since a TGraphic has no visible portion (for trapping paints) and no
693 // knowledge of what component owns it, the animation can be tricky. This
694 // is resolved by "stealing" the canvas from wherever this graphic is going
695 // to be drawn and then using that canvas for the animation updates.
696
697 if AggressiveDrawing then begin
698 DrawingCanvas := ACanvas;
699 DrawingRect := Rect;
700 end;
701
702 end;
703
704 procedure TIpAnimatedGraphic.FreeAnimationFrames;
705 begin
706 Images.ReleaseFrames;
707 end;
708
GetAnimatenull709 function TIpAnimatedGraphic.GetAnimate : boolean;
710 begin
711 result := FAnimate;
712 end;
713
TIpAnimatedGraphic.GetEmptynull714 function TIpAnimatedGraphic.GetEmpty : Boolean;
715 begin
716 result := (Height = 0) or (Width = 0);
717 end;
718
TIpAnimatedGraphic.GetHeightnull719 function TIpAnimatedGraphic.GetHeight : Integer;
720 begin
721 Result := FRealHeight;
722 end;
723
GetWidthnull724 function TIpAnimatedGraphic.GetWidth : Integer;
725 begin
726 result := FRealWidth;
727 end;
728
729 procedure TIpAnimatedGraphic.Initialize;
730 begin
731 // Reset the frame count
732
733 NumFrames := 0;
734 FCurrentFrame := 0;
735 Animate := False;
736
737 // Free up any stray bitmaps
738
739 FreeAnimationFrames;
740
741 end;
742
743 procedure TIpAnimatedGraphic.LoadFromStream (Stream: TStream);
744 {
745 LoadFromStream should never be called at this level. The classes that
746 inherit from this class should implement their own load code.
747
748 Should LoadFromStream get called, TIpAnimatedGraphic will create a default
749 image.
750 }
751 begin
752 if (Stream=nil) then ;
753 Width := 50;
754 Height := 50;
755 Bitmap.Canvas.Brush.Color := clWhite;
756 Bitmap.Canvas.FillRect (Rect (0, 0, 49, 49));
757 Bitmap.Canvas.Pen.Color := clRed;
758 Bitmap.Canvas.TextOut (0, 0, 'X');
759 end;
760
761 procedure TIpAnimatedGraphic.SetAggressiveDrawing (v : Boolean);
762 begin
763 if v <> FAggressiveDrawing then
764 FAggressiveDrawing := v;
765 end;
766
767 procedure TIpAnimatedGraphic.SetAnimate (v : boolean);
768 begin
769 if v <> FAnimate then begin
770 if v then
771 FAnimate := StartAnimation
772 else begin
773 FAnimate := False;
774 StopAnimation;
775 end;
776 end;
777 end;
778
779 procedure TIpAnimatedGraphic.SetBitmap (v : TBitmap);
780 begin
781 FBitmap.Assign (v);
782 end;
783
784 procedure TIpAnimatedGraphic.SetDelayTime (v : Integer);
785 begin
786 if v <> FDelayTime then
787 FDelayTime := v;
788 end;
789
790 procedure TIpAnimatedGraphic.SetDestinationCanvas (v : TCanvas);
791 begin
792
793 // Destination Canvas is a weird property. It IS the canvas to which the
794 // drawing will take place. We use := to assign it.
795
796 if v <> FDestinationCanvas then
797 FDestinationCanvas := v;
798 end;
799
800 procedure TIpAnimatedGraphic.SetDestinationRect (v : TRect);
801 begin
802 FDestinationRect := v;
803 end;
804
805 procedure TIpAnimatedGraphic.SetDisposalMethod (v : TDisposalMethod);
806 begin
807 if v <> FDisposalMethod then
808 FDisposalMethod := v;
809 end;
810
811 procedure TIpAnimatedGraphic.SetDrawingCanvas (v : TCanvas);
812 begin
813
814 // Drawing Canvas is a weird property. It IS the canvas to which the drawing
815 // will take place. We use := to assign it.
816
817 if v <> FDrawingCanvas then
818 FDrawingCanvas := v;
819 end;
820
821 procedure TIpAnimatedGraphic.SetDrawingRect (v : TRect);
822 begin
823
824 // Drawing Rect is a weird property. It IS the rectangle on the canvas to
825 // hich the drawing will take place. We use := to assign it.
826
827 FDrawingRect := v;
828 end;
829
830 procedure TIpAnimatedGraphic.SetFrameChangeNotify (v : Boolean);
831 begin
832 if v <> FFrameChangeNotify then
833 FFrameChangeNotify := v;
834 end;
835
836 procedure TIpAnimatedGraphic.SetHeight(v : Integer);
837 begin
838 if v <> FRealHeight then begin
839 FBitmap.height := v;
840 FRealHeight := v;
841 end;
842 end;
843
844 procedure TIpAnimatedGraphic.SetImages (v : TIpAnimationFrameList);
845 var
846 i : integer;
847 begin
848 FImages.List.Clear;
849 FImages.List.Capacity := v.List.Capacity;
850 FImages.List.Count := v.List.Count;
851 for i := 0 to v.List.Count - 1 do
852 FImages.List.Add(v.List[i]);
853 end;
854
855 procedure TIpAnimatedGraphic.SetNumFrames (v : Integer);
856 begin
857 if v <> FNumFrames then
858 FNumFrames := v;
859 end;
860
861 procedure TIpAnimatedGraphic.SetWidth(v : Integer);
862 begin
863 if v <> FRealWidth then begin
864 FBitmap.Width := v;
865 FRealWidth := v;
866 end;
867 end;
868
StartAnimationnull869 function TIpAnimatedGraphic.StartAnimation : boolean;
870 begin
871 Result := True;
872 FTimer.Enabled := False;
873 if NumFrames > 1 then begin
874 if FDelayTime <= 1 then
875 FTimer.Interval := 100
876 else
877 FTimer.Interval := Images[0].DelayTime * 10;
878 FTimer.Enabled := True;
879 end else
880 Result := False;
881 end;
882
883 procedure TIpAnimatedGraphic.StopAnimation;
884 begin
885 FTimer.Enabled := False;
886 end;
887
888 procedure TIpAnimatedGraphic.TimerTimeoutHandler (Sender : TObject);
889 var
890 NewFrame : Integer;
891 CanChange : Boolean;
892
893 begin
894 if NumFrames < 1 then
895 exit;
896
897 FTimer.Enabled := False;
898 try
899 NewFrame := FCurrentFrame;
900
901 Inc (NewFrame);
902 if (NewFrame >= NumFrames) then
903 NewFrame := 0;
904
905 CanChange := True;
906 if Assigned (FOnBeforeFrameChange) then
907 FOnBeforeFrameChange (self,
908 FCurrentFrame,
909 NewFrame,
910 Images,
911 CanChange);
912
913 if CanChange then
914 ChangeFrame (NewFrame);
915
916 if NumFrames >= 1 then begin
917 FTimer.Interval := Images[FCurrentFrame].DelayTime * 10;
918 if FTImer.Interval < 10 then
919 FTImer.Interval := 50;
920 end else
921 FTimer.Interval := 32767;
922
923 finally
924 FTimer.Enabled := True;
925 end;
926 end;
927
928 end.
929