(* ImageEn Build 7.0.0.06.2637 @ 7-4-17 14:58:42.679 *) (* Copyright (c) 1998-2017 by Carlotta Calandra. All rights reserved. Copyright (c) 2011-2017 by Xequte Software. This software comes without express or implied warranty. In no case shall the author be liable for any damage or unwanted behavior of any computer hardware and/or software. Author grants you the right to include the component in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE. ImageEn, IEvolution and ImageEn ActiveX may not be included in any commercial, shareware or freeware libraries or components. www.ImageEn.com *) (* File version 1009 *) unit ieanimation; {$R-} {$Q-} {$I ie.inc} interface uses Windows, Messages, SysUtils, Classes, SyncObjs, iexBitmaps, {$ifdef IEHASTYPES} Types, {$endif} {$ifdef IEHASUITYPES} System.UITypes, {$endif} Graphics, hyiedefs; type /////////////////////////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////////////////////////////////////// // TIEAnimation {!! TIEAnimationGetImageInfoEvent Declaration TIEAnimationGetImageInfoEvent = procedure(Sender: TObject; imageIndex: integer; isVisible: boolean; var imageWidth: integer; var imageHeight: integer; var text: WideString) of object; Description Event called when only the image info is needed (not the whole image). Parameter Description Sender The caller, a subclass of class. imageIndex Index of the required image info. isVisible False if the required image may not be visible (hence you can provide estimated values). imageWidth Return value for image width. imageHeight Return value for image height text Return value for image textual info (ie a filename).

!!} TIEAnimationGetImageInfoEvent = procedure(Sender: TObject; imageIndex: integer; isVisible: boolean; var imageWidth: integer; var imageHeight: integer; var text: WideString) of object; {!! TIEAnimationGetImageEvent Declaration TIEAnimationGetImageEvent = procedure(Sender: TObject; imageIndex: integer; var image: ; var text: WideString) of object; Description Event called when the whole image is needed. Parameter Description Sender The caller, a subclass of class. imageIndex Index of the required image. image Return value for image bitmap. text Return value for image textual info (ie a filename).

!!} TIEAnimationGetImageEvent = procedure(Sender: TObject; imageIndex: integer; var image: TIEBitmap; var text: WideString) of object; {!! TIEAnimationReleaseImageEvent Declaration TIEAnimationReleaseImageEvent = procedure(Sender: TObject; imageIndex: integer; var image: ) of object; Description Event called when the image can be released. Parameter Description Sender The caller, a subclass of class. imageIndex Index of the image to release. image The bitmap to release.

!!} procedure TIEAnimation.SetupEvents(getImage: TIEAnimationGetImageEvent; releaseImage: TIEAnimationReleaseImageEvent; getImageInfo: TIEAnimationGetImageInfoEvent); begin m_getImageInfo := getImageInfo; m_getImage := getImage; m_releaseImage := releaseImage; SetInitialValues(0, ImageCount-1); SetEndValues(); end; function TIEAnimation.GetImageCount(): integer; begin result := length(m_images); end; {!! TIEAnimation.ImageCount Declaration property ImageCount: integer; Description Specifies the number of images that TIEAnimation should handle. This value could not match the number of visible images. Setting this property reinitializes the animation and set the current image to 0. !!} procedure TIEAnimation.SetImageCount(value: integer); var i: integer; begin FreeImageInfo(0, length(m_images)-1); SetLength(m_images, value); for i := 0 to length(m_images)-1 do m_images[i] := TIEAnimationImageInfo.Create(); m_currentImage := 0; SetInitialValues(0, length(m_images)-1); SetEndValues(); end; {!! TIEAnimation.DeleteImage Declaration procedure DeleteImage(imageIndex: integer); Description Removes the specified image. !!} procedure TIEAnimation.DeleteImage(imageIndex: integer); begin FreeImageInfo(imageIndex, imageIndex); m_currentImage := imin(m_currentImage, length(m_images)-1); SetStartEndValues(); end; {!! TIEAnimation.InsertImage Declaration procedure InsertImage(imageIndex: integer); Description Inserts a new image at specified position. !!} procedure TIEAnimation.InsertImage(imageIndex: integer); var i: integer; begin SetLength(m_images, length(m_images)+1); for i := length(m_images)-1 downto imageIndex+1 do m_images[i] := m_images[i-1]; m_images[imageIndex] := TIEAnimationImageInfo.Create(); m_currentImage := imageIndex; SetInitialValues(imageIndex, imageIndex); SetStartEndValues(); end; procedure TIEAnimation.FreeImageInfo(first, last: integer); var i: integer; count: integer; begin count := last - first + 1; for i := first to last do m_images[i].Free(); for i := last+1 to length(m_images)-1 do begin m_images[first] := m_images[i]; inc(first); end; SetLength(m_images, length(m_images)-count); end; {!! TIEAnimation.Destroy Declaration destructor Destroy(); override; Description Destroys the TIEAnimation object. You should call this destructor on your subclass. !!} destructor TIEAnimation.Destroy(); begin FreeImageInfo(0, length(m_images)-1); FreeAndNil(m_canvasCriticalSection); FreeAndNil(m_borderPen); IEGDIPUnLoadLibrary(); inherited; end; {!! TIEAnimation.SetInitialValues Declaration procedure SetInitialValues(first, last: integer); virtual; Description Sets initial animation values (image position, rotation, etc). This is called one time when the object is initialized. This method need to be overloaded to implement animations. Parameter Description first Index of first image to set values. last Index of last image to set values..

!!} procedure TIEAnimation.SetInitialValues(first, last: integer); var i: integer; begin for i := first to last do begin Images[i].startTime := GetTickCount(); Images[i].startAlpha := 255; Images[i].startAngleX := 0.0; Images[i].startAngleY := 0.0; Images[i].startCenterX := 0; Images[i].startCenterY := 0; Images[i].startWidth := 0; Images[i].startHeight := 0; end; NeedRefresh := true; end; {!! TIEAnimation.SetStartValues Declaration procedure SetStartValues(); virtual; Description Sets starting values (image position, rotation, etc) whenever the animation is about to begin. This method needs to be overloaded to implement animations. !!} procedure TIEAnimation.SetStartValues(); var i: integer; begin for i := 0 to ImageCount-1 do begin Images[i].startTime := GetTickCount(); Images[i].startAlpha := Images[i].lastAlpha; Images[i].startAngleX := Images[i].lastAngleX; Images[i].startAngleY := Images[i].lastAngleY; Images[i].startCenterX := Images[i].lastCenterX; Images[i].startCenterY := Images[i].lastCenterY; Images[i].startWidth := Images[i].lastWidth; Images[i].startHeight := Images[i].lastHeight; end; NeedRefresh := true; end; {!! TIEAnimation.SetEndValues Declaration procedure SetEndValues(); virtual; Description Sets ending values (image position, rotation, etc) whenever the animation is about to begin. This method needs to be overloaded to implement animations. !!} procedure TIEAnimation.SetEndValues(); var i: integer; begin for i := 0 to length(m_images)-1 do Images[i].endTime := Images[i].startTime + AnimDuration; NeedRefresh := true; end; {!! TIEAnimation.Font Declaration property Font: TFont; Description The font of the text if is enabled. Default values: Height: 18; Style: [fsBold]; Color: clWhite; Name: 'Arial' Example ImageEnMView1.Animation.Font.Color := clRed; ImageEnMView1.Animation.Font.Height := 30; ImageEnMView1.Animation.Font.Name := 'Tahoma'; ImageEnMView1.Animation.Font..Style := [fsBold]; ImageEnMView1.Update; !!} procedure TIEAnimation.SetFont(const Value: TFont); begin fFont := Value; NeedRefresh := true; end; {!! TIEAnimation.RestartAnimation Declaration procedure RestartAnimation(); Description Restarts the animation. !!} procedure TIEAnimation.RestartAnimation(); begin SetStartEndValues(); end; {!! TIEAnimation.Images Declaration property Images[index: integer]: ; Description Get or set the animation parameters for the image of the specified index. Example animation.Images[0].startAngleX := 45; !!} function TIEAnimation.GetImages(idx: integer): TIEAnimationImageInfo; begin result := m_images[idx]; end; function TIEAnimation.isVisible(const coords: TIEQuadCoords): boolean; begin result := IEPointInRect(coords.x0, coords.y0, 0, 0, m_viewWidth-1, m_viewHeight-1) or IEPointInRect(coords.x1, coords.y1, 0, 0, m_viewWidth-1, m_viewHeight-1) or IEPointInRect(coords.x2, coords.y2, 0, 0, m_viewWidth-1, m_viewHeight-1) or IEPointInRect(coords.x3, coords.y3, 0, 0, m_viewWidth-1, m_viewHeight-1); end; {!! TIEAnimation.Display Declaration procedure Display(dest: ); virtual; abstract; Description This method must be implemented by the subclass. It should loop among images calling for each image. Parameter Description dest The destination bitmap.

!!} {!! TIEAnimation.drawImage Declaration function drawImage(dest: ; imageIndex: integer): boolean; virtual; Description Draws the specified image. This method reads the timers to draw the image correctly (at calculated position, rotation, etc...). Returns true when the image doesn't need to be drawn again (the animation is finished). Parameter Description dest The destination bitmap. Must be at least and pixels. imageIndex The image index to draw.

!!} function TIEAnimation.drawImage(dest: TIEBitmap; imageIndex: integer): boolean; var image: TIEAnimationImageInfo; thisStep: double; // 0..1 bmp, abmp: TIEBitmap; lastCenterX, lastCenterY: integer; lastAngleX, lastAngleY: double; lastWidth, lastHeight: integer; lastAlpha: integer; text: WideString; begin image := m_images[imageIndex]; thisStep := (GetTickCount()-image.startTime) / (image.endTime-image.startTime); // linear 0..1 if thisStep < 0.0 then thisStep := 0.0; if thisStep > 1.0 then thisStep := 1.0; thisStep := thisStep*thisStep*thisStep + 1.0*3.0*thisStep*thisStep*(1.0-thisStep) + 0.1*3.0*thisStep*(1.0-thisStep)*(1.0-thisStep); // bezier-bicubic if thisStep >= 1.0 then begin // go directly to ending values image.startAlpha := image.endAlpha; image.startAngleX := image.endAngleX; image.startAngleY := image.endAngleY; image.startCenterX := image.endCenterX; image.startCenterY := image.endCenterY; image.startWidth := image.endWidth; image.startHeight := image.endHeight; end; lastAlpha := trunc( image.startAlpha + (image.endAlpha - image.startAlpha) * thisStep ); lastCenterX := trunc( image.startCenterX + (image.endCenterX - image.startCenterX) * thisStep ); lastCenterY := trunc( image.startCenterY + (image.endCenterY - image.startCenterY) * thisStep ); lastAngleX := image.startAngleX + (image.endAngleX - image.startAngleX) * thisStep; lastAngleY := image.startAngleY + (image.endAngleY - image.startAngleY) * thisStep; lastWidth := trunc( image.startWidth + (image.endWidth - image.startWidth) * thisStep ); lastHeight := trunc( image.startHeight + (image.endHeight - image.startHeight) * thisStep ); result := (lastCenterX <> image.endCenterX) or (lastCenterY <> image.endCenterY) or (lastAngleX <> image.endAngleX) or (lastAngleY <> image.endAngleY) or (lastWidth <> image.endWidth) or (lastHeight <> image.endHeight) or (lastAlpha <> image.endAlpha); image.lastAlpha := lastAlpha; image.lastCenterX := lastCenterX; image.lastCenterY := lastCenterY; image.lastAngleX := lastAngleX; image.lastAngleY := lastAngleY; image.lastWidth := lastWidth; image.lastHeight := lastHeight; if (image.lastWidth = 0) or (image.lastHeight = 0) then exit; // calculate image rect IEProjectBitmap1(nil, nil, image.lastCenterX, image.lastCenterY, // centerDstX, centerDstY image.lastWidth, image.lastHeight, // dstWidth, dstHeight 0, 0, // translateX, translateY m_depth, // depth image.lastAngleX, image.lastAngleY, // rotateX, rotateY m_shadowAlphaMin, m_shadowAlphaMax, // specularAlphaMin, specularAlphaMax image.lastCoords, // output coordinates ieovoCALCRECTONLY, true, image.lastAlpha); if isVisible(image.lastCoords) and (image.lastWidth > 0) and (image.lastHeight > 0) then begin bmp := nil; DoGetImage(imageIndex, bmp, text); abmp := TIEBitmap.Create(image.lastWidth, image.lastHeight, bmp.PixelFormat); if result then _IEResampleIEBitmap(bmp, abmp, m_framesZoomFilter, nil, nil) else _IEResampleIEBitmap(bmp, abmp, m_lastFrameZoomFilter, nil, nil); abmp.PixelFormat := ie24RGB; IEProjectBitmap1(abmp, dest, 0, 0, // centerDstX, centerDstY 0, 0, // dstWidth, dstHeight 0, 0, // translateX, translateY 0.0, // depth 0.0, 0.0, // rotateX, rotateY m_shadowAlphaMin, m_shadowAlphaMax, // specularAlphaMin, specularAlphaMax image.lastCoords, // output coordinates ieovoDRAWONLY, true, image.lastAlpha); abmp.Free(); DoReleaseImage(imageIndex, bmp); // draw border if m_showBorder then PaintBorder(imageIndex, dest); end; end; {!! TIEAnimation.FindImageAt Declaration function FindImageAt(X, Y: integer): integer; Description Returns the index of the image that is under the specified coordinates, or -1 if there is no image. Parameter Description X Horizontal coordinate. Y Vertical coordinate.

!!} function TIEAnimation.FindImageAt(X, Y: integer): integer; function IsInsideImage(i: integer): boolean; begin if (i >= length(m_images)) or (i < 0) then result := false else with m_images[i].lastCoords do result := IEISPointInPoly(X, Y, [Point(x0, y0), Point(x1, y1), Point(x2, y2), Point(x3, y3)]); end; var i: integer; begin // look for current image if IsInsideImage(m_currentImage) then begin result := m_currentImage; exit; end else begin // look on the left for i := m_currentImage-1 downto 0 do if IsInsideImage(i) then begin result := i; exit; end; // look on the right for i := m_currentImage+1 to length(m_images)-1 do if IsInsideImage(i) then begin result := i; exit; end; end; result := -1; end; // thread safe procedure TIEAnimation.PaintBorder(i: integer; dest: TIEBitmap); begin if assigned(m_borderPen) then begin m_canvasCriticalSection.Enter(); try with TIECanvas.Create(dest.Canvas) do begin Pen.Style := m_borderPen.Style; Pen.Mode := m_borderPen.Mode; Pen.Color := m_borderPen.Color; Pen.Width := m_borderPen.Width; Brush.style := bsClear; with m_images[i].lastCoords do begin MoveTo(x0, y0); LineTo(x1, y1); LineTo(x2, y2); LineTo(x3, y3); LineTo(x0, y0); end; Free(); end; finally m_canvasCriticalSection.Leave(); end; end; end; {!! TIEAnimation.PaintText Declaration procedure PaintText(posY: integer; dest: ); Description Paints the text (ie filename) at the specified row. You should call this method inside method. Parameter Description posY Vertical position where to draw the text. dest The destination bitmap.

!!} procedure TIEAnimation.PaintText(posY: integer; dest: TIEBitmap); const Default_Font_Height = 18; // Fixed font height used prior to v5.0.7 var posX: integer; text: WideString; iw, ih: integer; iTextOffsetY: Integer; begin if m_showText then begin with TIECanvas.Create(dest.Canvas) do begin Brush.Style := bsClear; Font.Assign(fFont); DoGetImageInfo(CurrentImage, true, iw, ih, text); posX := Images[CurrentImage].endCenterX - TextWidth(text) div 2; // Adjust text position for increased font size, while maintaining legacy support iTextOffsetY := (Default_Font_Height - fFont.Height) div 2; TextOut(posX, posY + iTextOffsetY, text); Free(); end; end; end; {!! TIEAnimation.PaintScrollBar Declaration procedure PaintScrollBar(dest: ); Description Paints the scroll bar. You should call this method inside method. Parameter Description dest The destination bitmap.

Example procedure TMainForm.ImageEnView1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin // directly move to the clicked scrollbar position if m_animation.IsInsideScrollbar(X, Y) then m_animation.MoveScrollbarSliderTo(X); end; !!} procedure TIEAnimation.MoveScrollbarSliderTo(X: integer); begin CurrentImage := round((X - m_lastScrollbarBoundRect.x - m_lastScrollbarSlideRect.width / 2) / (m_lastScrollbarBoundRect.width / ImageCount)); end; {!! TIEAnimation.IsInsideScrollbarSlider Declaration function IsInsideScrollbarSlider(X, Y: integer): boolean; Description Returns true if the specified coordinates are inside the scrollbar slider. This function is useful to start dragging the scrollbar slider. Parameter Description X Horizontal coordinate. Y Vertical coordinate.

!!} procedure TIEAnimation.DoGetImageInfo(imageIndex: integer; isVisible: boolean; var imageWidth: integer; var imageHeight: integer; var text: WideString); var image: TIEBitmap; begin if assigned(m_getImageInfo) then m_getImageInfo(self, imageindex, isVisible, imageWidth, imageHeight, text) else begin DoGetImage(imageIndex, image, text); imageWidth := image.Width; imageHeight := image.Height; DoReleaseImage(imageIndex, image); end; end; {!! TIEAnimation.DoGetImage Declaration procedure DoGetImage(imageIndex: integer; var image: ; var text: WideString); Description Calls the event, assigned on creation. Parameter Description imageIndex Index of the required image. image Return value for image bitmap. text Return value for image textual info (ie a filename).

!!} procedure TIEAnimation.DoGetImage(imageIndex: integer; var image: TIEBitmap; var text: WideString); begin if assigned(m_getImage) then m_getImage(self, imageIndex, image, text) else raise EIEException.Create('GetImageEvent not assigned'); end; {!! TIEAnimation.DoReleaseImage Declaration procedure DoReleaseImage(imageIndex: integer; var image: TIEBitmap); Description Calls the event, if assigned on creation. Parameter Description imageIndex Index of the image to release. image The bitmap to release.