unit DSTimeLine; interface uses Classes, Windows, Graphics, Controls, Messages, ImgList, cxLookAndFeels, cxClasses, cxControls, cxGraphics, cxLookAndFeelPainters, cxStyles, cxCustomData, cxScrollBar, StdCtrls, Forms, cxNavigator, dsTimeEdit, ExtCtrls, ActiveX, Contnrs; const cScaleW = 50; VHeaderSize = 22; BarHeight = 32; maMove = 1; maStart = 2; maDuration = 3; maDurationPrev = 4; stStartTime = 0; stViewTime = 1; cTextFormatTimes: array [0..3] of string = ( '%2.2d:%2.2d', '%2.2d:%2.2d:%2.2d', '%2.2d:%2.2d:%2.2d:%2.2d', '%2.2d:%2.2d:%2.2d.%3.3d'); type TDSTimeLineDrawHeaderMode = (dhmNone, dhmCaption, dhmImage, dhmImageAndCaption); TDSTimeline = class; TDSTimeLineItem = class; TDSTimeLineSubItem = class; TDSOnGetItemText = procedure(Sender: TDSTimeline; Item: TDSTimeLineSubItem; var Text: WideString) of object; TDSTimeLineKeyItem = class private FID: int64; FCaption: string; FData: Pointer; FTag: integer; FStartTime: int64; FDuration: int64; FSelected: boolean; FParentLine: TDSTimeLineItem; FViewDeltaDuration: int64; FViewDeltaTime: int64; FOnPaint: TNotifyEvent; FDataObject: TObject; procedure SetCaption(const Value: string); procedure SetDuration(const Value: int64); procedure SetSelected(const Value: boolean); procedure SetStartTime(const Value: int64); procedure SetViewDeltaDuration(const Value: int64); procedure SetViewDeltaTime(const Value: int64); //procedure WMPaint(var Message: TWMPaint);// message WM_PAINT; protected property ViewDeltaTime: int64 read FViewDeltaTime write SetViewDeltaTime; property ViewDeltaDuration: int64 read FViewDeltaDuration write SetViewDeltaDuration; public constructor Create(AOwner: TControl); destructor Destroy; override; //procedure Paint; override; property ParentLine: TDSTimeLineItem read FParentLine write FParentLine; property ID: int64 read FID write FID; property Caption: string read FCaption write SetCaption; property Data: Pointer read FData write FData; property DataObject: TObject read FDataObject write FDataObject; property Tag: Integer read FTag write FTag; property StartTime: int64 read FStartTime write SetStartTime; property Duration: int64 read FDuration write SetDuration; property Selected: boolean read FSelected write SetSelected; property OnPaint: TNotifyEvent read FOnPaint write FOnPaint; end; TDSTimeLineSubItem = class private FID: int64; FCaption: string; FData: Pointer; FTag: integer; FStartTime: int64; FDuration: int64; FSelected: boolean; FParent: TDSTimeLineItem; FPrev: TDSTimeLineSubItem; FNext: TDSTimeLineSubItem; FViewDeltaDuration: int64; FViewDeltaTime: int64; FDataObject: TObject; FImageIndex: Integer; FEndTime: int64; procedure SetCaption(const Value: string); procedure SetStartTime(const Value: int64); procedure SetDuration(const Value: int64); procedure SetStartTimeInternal(const Value: int64); procedure SetDurationInternal(const Value: int64); procedure SetSelected(const Value: boolean); procedure SetViewDeltaDuration(const Value: int64); procedure SetViewDeltaTime(const Value: int64); procedure SetViewDeltaDurationInternal(const Value: int64); procedure SetViewDeltaTimeInternal(const Value: int64); procedure SetImageIndex(const Value: Integer); procedure SetEndTime(const Value: int64); procedure SetEndTimeInternal(const Value: int64); function GetViewDuration: int64; function GetViewEndTime: int64; function GetViewStartTime: int64; public constructor Create; property Parent: TDSTimeLineItem read FParent write FParent; property ID: int64 read FID write FID; property Caption: string read FCaption write SetCaption; property Data: Pointer read FData write FData; property DataObject: TObject read FDataObject write FDataObject; property Tag: integer read FTag write FTag; property StartTime: int64 read FStartTime write SetStartTime; property Duration: int64 read FDuration write SetDuration; property EndTime: int64 read FEndTime write SetEndTime; property ViewStartTime: int64 read GetViewStartTime; property ViewDuration: int64 read GetViewDuration; property ViewEndTime: int64 read GetViewEndTime; property ViewDeltaTime: int64 read FViewDeltaTime write SetViewDeltaTime; property ViewDeltaDuration: int64 read FViewDeltaDuration write SetViewDeltaDuration; property Selected: boolean read FSelected write SetSelected; property Next: TDSTimeLineSubItem read FNext write FNext; property Prev: TDSTimeLineSubItem read FPrev write FPrev; property ImageIndex: Integer read FImageIndex write SetImageIndex; destructor Destroy; override; end; TFXItem = class private function GetEndTime: Int64; procedure SetEndTime(const Value: Int64); public StartTime: Int64; Duration: Int64; property EndTime: Int64 read GetEndTime write SetEndTime; end; TFXList = class(TObjectList) private FTrack: TDSTimeLineItem; function GetFX(Index: Integer): TFXItem; public constructor Create(Track: TDSTimeLineItem); procedure AddFx(Item1, Item2: TDSTimeLineSubItem); procedure CalcFx(Start: Int64 = 0; Duration: Int64 = $7FFFFFFFFFFFFFFF); procedure CheckFxForIntersections; function IntersectFx(Primary, Secondary: TFXItem): boolean; procedure FindMaxNotIntersectedTime(var StartTime, EndTime: Int64); property FX[Index: Integer]: TFXItem read GetFX; end; TDSTimeLineItem = class(TList) private FKeyList: TList; FID: int64; FCaption: string; FTag: integer; FData: Pointer; FHot: boolean; FVisible: boolean; FSelected: boolean; FImageIndex: Integer; FTimeLine: TDSTimeLine; FFx: TFXList; FHeaderDrawMode: TDSTimeLineDrawHeaderMode; function Get(Index: Integer): TDSTimeLineSubItem; procedure Put(Index: Integer; const Value: TDSTimeLineSubItem); procedure SetCaption(const Value: string); procedure LinkUpdate; procedure SetHot(const Value: boolean); procedure SetVisible(const Value: boolean); function GetKeys(Index: integer): TDSTimeLineKeyItem; procedure SetKeys(Index: integer; const Value: TDSTimeLineKeyItem); procedure SetSelected(const Value: boolean); procedure SetImageIndex(const Value: Integer); procedure SetHeaderDrawMode(const Value: TDSTimeLineDrawHeaderMode); function AddItemInternal(aItem: TDSTimeLineSubItem): boolean; function RemoveItemInternal(aItem: TDSTimeLineSubItem): boolean; protected procedure Notify(Ptr: Pointer; Action: TListNotification); override; public constructor Create(TimeLine: TDSTimeLine); destructor Destroy; override; function AddItem(aItem: TDSTimeLineSubItem): boolean; function RemoveItem(aItem: TDSTimeLineSubItem): boolean; function AddKey(aItem: TDSTimeLineKeyItem): integer; function KeyAtTime(aTime: int64; aDirection: integer): TDSTimeLineKeyItem; procedure SortKeys; function ItemAtTime(aTime: int64): TDSTimeLineSubItem; function Remove(Item: Pointer): Integer; procedure SortBy(sType: integer); function KeyCount: integer; procedure DeleteKey(index: integer); property Items[Index: Integer]: TDSTimeLineSubItem read Get write Put; property Keys[Index: integer]: TDSTimeLineKeyItem read GetKeys write SetKeys; property ID: int64 read FID write FID; property Caption: string read FCaption write SetCaption; property ImageIndex: Integer read FImageIndex write SetImageIndex; property Data: Pointer read FData write FData; property Tag: integer read FTag write FTag; property Hot: boolean read FHot write SetHot; property Selected: boolean read FSelected write SetSelected; property Visible: boolean read FVisible write SetVisible; property HeaderDrawMode: TDSTimeLineDrawHeaderMode read FHeaderDrawMode write SetHeaderDrawMode; end; TTimeLineBar = class(TCustomControl) cCanvas: TcxCanvas; Back: TBitmap; private function GetTimeLine: TDSTimeLine; procedure WMEraseBkgnd(var message: TWmEraseBkgnd); message WM_ERASEBKGND; procedure WMLButtonDown(var message: TWMLButtonDown); message WM_LBUTTONDOWN; procedure WMRButtonDown(var message: TWMRButtonDown); message WM_RBUTTONDOWN; procedure WMRButtonUp(var message: TWMLButtonUp); message WM_LBUTTONUP; procedure WMMouseMove(var message: TWMMouseMove); message WM_MOUSEMOVE; procedure ProcessPaint; procedure DrawFace; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Paint; override; property Timeline: TDSTimeLine read GetTimeLine; end; TTimeLineEdit = class(TCustomControl) private ItemColorSel: DWORD; ItemColor: DWORD; ItemColorFx: DWORD; Gx, Gy: integer; MoveAction: Cardinal; cCanvas: TcxCanvas; Back: TBitmap; ItemBitmapSel: TBitmap; ItemBitmap: TBitmap; ItemBitmapFx: TBitmap; KeyBitmap: TBitmap; SelKeyBitmap: TBitmap; PrevHot: TDSTimeLineItem; procedure WMEraseBkgnd(var message: TWmEraseBkgnd); message WM_ERASEBKGND; procedure WMMouseMove(var message: TWMMouseMove); message WM_MOUSEMOVE; procedure WMLButtonDown(var message: TWMLButtonDown); message WM_LBUTTONDOWN; // procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN; procedure WMLButtonUp(var message: TWMLButtonUp); message WM_LBUTTONUP; procedure WMGetDlgCode(var message: TWMGetDlgCode); message WM_GETDLGCODE; procedure WMLButtonDblClk(var message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; procedure CMEnter(var message: TCMGotFocus); message CM_ENTER; procedure WMKeyDown(var message: TWMKeyDown); message WM_KEYDOWN; procedure WMSysKeyDown(var message: TWMKeyDown); message WM_SYSKEYDOWN; procedure WMKeyUp(var message: TWMKeyUp); message WM_KEYUP; procedure WMSysKeyUp(var message: TWMKeyUp); message WM_SYSKEYUP; procedure WMChar(var message: TWMChar); message WM_CHAR; private FSelectedKey: TDSTimeLineKeyItem; function GetTimeLine: TDSTimeLine; procedure OnKeyPaint(Sender: TObject); procedure AlignKeys; procedure SetSelectedKey(const Value: TDSTimeLineKeyItem); property SelectedKey: TDSTimeLineKeyItem read FSelectedKey write SetSelectedKey; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Paint; override; function KeyAtPos(Line: TDSTimeLineItem; x, y: integer): TDSTimeLineKeyItem; property Timeline: TDSTimeLine read GetTimeLine; procedure DefaultHandler(var message); override; function CanFocus: Boolean; override; end; TOnKeyPosChange = procedure(Sender: TDSTimeline; aKey: TDSTimeLineKeyItem) of object; TOnItemPosChanging = procedure(Sender: TDSTimeline; Items: TList) of object; TOnItemPosChange = procedure(Sender: TDSTimeline; Items: TList; var Validate: boolean) of object; TOnTimePositionChange = procedure(Sender: TDSTimeline; NewPosition: Int64) of object; TOnDrawItem = procedure(Sender: TDSTimeline; Canvas: TcxCanvas; aRect: TRect; Item: TDSTimeLineSubItem; var TextRect: TRect) of object; TOnDrawLine = procedure(Sender: TDSTimeline; Canvas: TcxCanvas; aRect: TRect; Item: TDSTimeLineItem) of object; TOnPositionStateChange = procedure(Sender: TDSTimeline) of object; TOnItemSelected = procedure(AItem: TDSTimeLineSubItem; ASelected: Boolean) of object; TDSTimeLineDropHelper = class; IExposeDropHelper = interface function Expose: TDSTimeLineDropHelper; end; TDSTimeLineDropHelper = class(TInterfacedObject, IDropTarget, IExposeDropHelper) public dataObj: IDataObject; Accept: Boolean; Timeline: TDSTimeline; function DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HRESULT; stdcall; function DragLeave: HRESULT; stdcall; function DragOver(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HRESULT; stdcall; function Drop(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HRESULT; stdcall; function Expose: TDSTimeLineDropHelper; function QueryGetData(const format: Cardinal): boolean; function GetData(const format: Cardinal; out medium: TStgMedium): boolean; constructor Create(Timeline: TDSTimeline); reintroduce; end; TDSTimeLineController = class(TComponent) private FTimeLine : TDSTimeLine; protected procedure CheckExistingLine(Line: TDSTimeLineItem); virtual; procedure CheckExistingItems; virtual; public property TimeLine: TDSTimeLine read FTimeLine; function AddItemToLine(Line: TDSTimeLineItem; Item: TDSTimeLineSubItem): boolean; virtual; function RemoveItemFromLine(Line: TDSTimeLineItem; Item: TDSTimeLineSubItem): boolean; virtual; procedure SetItemDuration(Item: TDSTimeLineSubItem; Value: Int64); virtual; procedure SetItemStartTime(Item: TDSTimeLineSubItem; Value: Int64); virtual; procedure SetItemEndTime(Item: TDSTimeLineSubItem; Value: Int64); virtual; procedure SetItemViewDeltaTime(Item: TDSTimeLineSubItem; Value: Int64); virtual; procedure SetItemViewDeltaDuration(Item: TDSTimeLineSubItem; Value: Int64); virtual; procedure CheckMoveAction(var MoveAction: Cardinal; var Cursor: TCursor); virtual; end; TDSTimeline = class(TWinControl, IcxNavigator, IcxLookAndFeelPainterListener) private GChange: Boolean; GTextStep: integer; TimeLine: TTimeLineEdit; Bar: TTimeLineBar; sbVert: TcxScrollBar; sbHorz: TcxScrollBar; SpinEdit: TdsTimeEdit; Nav: TcxNavigator; Notifier: TcxNavigatorControlNotifier; FDuration: int64; FPosition: int64; FRowHeight: integer; FScale: single; FSelection: TList; FList: TList; SelChanged: boolean; UniSelection: boolean; FOnDrawItem: TOnDrawItem; FOnDrawLine: TOnDrawLine; FOnItemPosChange: TOnItemPosChange; FOnItemPosChanging: TOnItemPosChanging; FOnPositionStateChange: TOnPositionStateChange; FFirstRowWidth: integer; FFocusedLine: integer; FOnKeyPosChange: TOnKeyPosChange; FSelectedLine: integer; FOnItemSelected: TOnItemSelected; FOnSelectionChanged: TNotifyEvent; FOnTimePositionChange: TOnTimePositionChange; FItemsLineChangeAllowed: Boolean; FImageList: TcustomImageList; FMinRowHeight: integer; FHeaderDrawMode: TDSTimeLineDrawHeaderMode; FSupportoleDrop: Boolean; FDropHelper: IDropTarget; FGetItemText: TDSOnGetItemText; FController: TDSTimeLineController; procedure WMPaint(var message: TWMPaint); message WM_PAINT; procedure WMEraseBkgnd(var message: TWmEraseBkgnd); message WM_ERASEBKGND; procedure InitNavigator; procedure CalcScrollBars; function GetCount: integer; function GetItems(index: integer): TDSTimeLineItem; function GetSelItems(index: integer): TDSTimeLineSubItem; procedure SetCount(const Value: integer); procedure SetDuration(const Value: int64); procedure SetItems(index: integer; const Value: TDSTimeLineItem); procedure SetPosition(const Value: int64); procedure SetRowHeight(const Value: integer); procedure SetScale(const Value: single); procedure SetSelItems(index: integer; const Value: TDSTimeLineSubItem); procedure ScrollEvent(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); procedure TimeEditChange(Sender: TObject); function IsSelectionUnique: boolean; /// function CanAppend: Boolean; function CanDelete: Boolean; function CanEdit: Boolean; function CanInsert: Boolean; function IsActive: Boolean; function IsBof: Boolean; function IsBookmarkAvailable: Boolean; function IsEditing: Boolean; function IsEof: Boolean; procedure ClearBookmark; procedure DoAction(AButtonIndex: Integer); function GetNotifier: TcxNavigatorControlNotifier; function IsActionSupported(AButtonIndex: Integer): Boolean; procedure FitToWindow; procedure SetFirstRowWidth(const Value: integer); procedure SetFocusedLine(const Value: integer); function GetSelectedKey: TDSTimeLineKeyItem; procedure SetSelectedLine(const Value: integer); function GetItemsBoundsRect: TRect; function GetRowHeight: integer; procedure SetImageList(const Value: TcustomImageList); procedure SetMinRowHeight(const Value: integer); procedure SetHeaderDrawMode(const Value: TDSTimeLineDrawHeaderMode); procedure SetOleSupportDrop(const Value: Boolean); procedure SetController(const Value: TDSTimeLineController); protected procedure Resize; override; procedure PaintWindow(DC: HDC); override; procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Delete(Index: integer); overload; procedure Delete(ALineItem: TDSTimeLineItem); overload; function TimeToPos(aTime: int64): integer; function PosToTime(aPos: integer): int64; function Add: TDSTimeLineItem; function AddKeyInPosition(LineIdx: integer): TDSTimeLineKeyItem; function AddKey(LineIdx: integer; InPos: int64): TDSTimeLineKeyItem; function Insert(index: integer): TDSTimeLineItem; function ItemAtPos(x, y: integer): TDSTimeLineItem; function IndexOf(ALineItem: TDSTimeLineItem): Integer; procedure Move(OldIdx, NewIdx: integer); procedure Clear; procedure DragDrop(Source: TObject; X, Y: Integer); override; function SelCount: integer; procedure PainterChanged(APainter: TcxCustomLookAndFeelPainterClass); property SelItems[index: integer]: TDSTimeLineSubItem read GetSelItems write SetSelItems; procedure ClearSelection; procedure AddToSelection(aItem: TDSTimeLineSubItem); procedure RemoveFromSelection(aItem: TDSTimeLineSubItem); procedure SetKeyPosition(aTime: int64); property Lines[index: integer]: TDSTimeLineItem read GetItems write SetItems; property SelectedKey: TDSTimeLineKeyItem read GetSelectedKey; property ItemsBoundsRect: TRect read GetItemsBoundsRect; published property ImageList: TcustomImageList read FImageList write SetImageList; property TimeDuration: int64 read FDuration write SetDuration; property TimePosition: int64 read FPosition write SetPosition; property Scale: single read FScale write SetScale; property Count: integer read GetCount write SetCount; property RowHeight: integer read GetRowHeight write SetRowHeight; property MinRowHeight: integer read FMinRowHeight write SetMinRowHeight; property FirstRowWidth: integer read FFirstRowWidth write SetFirstRowWidth; property FocusedLine: integer read FFocusedLine write SetFocusedLine; property SelectedLine: integer read FSelectedLine write SetSelectedLine DEFAULT -1; property ItemsLineChangeAllowed: Boolean read FItemsLineChangeAllowed write FItemsLineChangeAllowed DEFAULT TRUE; property PopupMenu; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnMouseWheel; property OnMouseWheelDown; property OnMouseWheelUp; property OnContextPopup; property OnDragOver; property OnDragDrop; property OnDblClick; property Align; property OnItemPosChanging: TOnItemPosChanging read FOnItemPosChanging write FOnItemPosChanging; property OnItemPosChange: TOnItemPosChange read FOnItemPosChange write FOnItemPosChange; property OnTimePositionChange: TOnTimePositionChange read FOnTimePositionChange write FOnTimePositionChange; property OnDrawItem: TOnDrawItem read FOnDrawItem write FOnDrawItem; property OnDrawLine: TOnDrawLine read FOnDrawLine write FOnDrawLine; property OnPositionStateChange: TOnPositionStateChange read FOnPositionStateChange write FOnPositionStateChange; property OnKeyPosChange: TOnKeyPosChange read FOnKeyPosChange write FOnKeyPosChange; property OnItemSelected: TOnItemSelected read FOnItemSelected write FOnItemSelected; property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write FOnSelectionChanged; property HeaderDrawMode: TDSTimeLineDrawHeaderMode read FHeaderDrawMode write SetHeaderDrawMode; property SupportOleDrop: Boolean read FSupportoleDrop write SetOleSupportDrop; property OnGetItemText: TDSOnGetItemText read FGetItemText write FGetItemText; property Controller: TDSTimeLineController read FController write SetController; end; implementation uses Math, MyTypes, SysUtils, MemBmpUtils, cxSpinEdit, cxEdit; {$R DSTImeLine.res} procedure FillChar32(const D: Pointer; const Value: dword; const count: dword); var i: integer; DST: PDWORD; begin i := count div 4; DST := D; while i > 0 do begin DST^ := Value; inc(DST); dec(i); end; end; function Time2Str(T: int64): string; var h, m, s, f: integer; begin h := (T div 1000) div 3600; m := ((T div 1000) div 60) mod 60; s := (T div 1000) mod 60; f := (T mod 1000); result := Format(cTextFormatTimes[3], [h, m, s, f]); end; function IncColor(Clr: DWORD; val: integer): DWORD; var C: TRGBQuad absolute Clr; begin C.rgbBlue := Min(255, Max(0, C.rgbBlue + val)); C.rgbGreen := Min(255, Max(0, C.rgbGreen + val)); C.rgbRed := Min(255, Max(0, C.rgbRed + val)); result := Clr; end; procedure DrawBar(B32: TBitmap; Rc: TRect; Color: DWORD; Step: integer = 32); var ClrF: array of DWORD; ClrO: array of DWORD; r, g, b: single; i, w, h: integer; face: DWORD; SS: single; P: PRGBA; Alpha: int64; begin if (Rc.Left >= Rc.Right) or (Rc.Top >= Rc.Bottom) then exit; if Rc.Top < 0 then Rc.Top := 0; if Rc.Left < 0 then Rc.Left := 0; if Rc.Right >= B32.Width then Rc.Right := B32.Width - 1; if Rc.Bottom >= B32.Height then Rc.Bottom := B32.Height - 1; h := Rc.Bottom - Rc.Top; if h < 3 then exit; w := Rc.Right - Rc.Left; if w < 3 then exit; SetLength(ClrF, h + 1); SetLength(ClrO, h + 1); face := (Color); SS := (Step * 2) / h; r := GetRValue(face) + Step * 2; g := GetGValue(face) + Step * 2; b := GetBValue(face) + Step * 2; if r < 0 then r := 0; if g < 0 then g := 0; if b < 0 then b := 0; if r > 255 then r := 255; if g > 255 then g := 255; if b > 255 then b := 255; Alpha := (Color shr 24); Alpha := Alpha or (Alpha shl 16) or (Alpha shl 32) or (Alpha shl 48); P := B32.ScanLine[Rc.Top]; inc(P, Rc.Left); for i := 0 to h - 1 do begin ClrF[i] := RGB(Trunc(r), Trunc(g), Trunc(b)); ClrO[i] := IncColor(ClrF[i], -30); r := r - SS; g := g - SS; b := b - SS; end; //MixLine_Final(P, @ClrO[0], w, $FF); //for I := 0 to List.Count - 1 do //inc(2); if w > 4 then FillChar32(P, ClrO[0], w * 4); { PDWORD(DWORD(P)-(B32.Width-1)*4)^ := ClrO[1]; MixColor_Final(PDWORD(DWORD(P)-(B32.Width-2)*4), @ClrF[1], w-2, Alpha); PDWORD(DWORD(P)-(B32.Width-w+2)*4)^ := ClrO[1]; } inc(P, B32.Width * 2); for i := 1 to h - 1 do begin P := B32.ScanLine[{(B32.Height-1)-}Rc.Top + i]; inc(P, Rc.Left); //OSD(inttostr(i)); //FillChar32(P, ClrF[i], w*4); MixColor_Final(P, @ClrF[i], w, Alpha); //MixLine_Final(P, @ClrO[i], 1, $FF); P^.dwColor := ClrO[i]; inc(P, w - 1); //MixLine_Final(P, @ClrO[i], 1, $FF); P^.dwColor := ClrO[i]; inc(P, B32.Width - w + 1); end; dec(P, 1 * B32.Width); //FillChar32(P, ClrO[h-1], w*4); if w > 4 then FillChar32(P, ClrO[h - 1], w * 4); //MixLine_Final(P, @ClrO[h-1], w, $FF); asm emms end; SetLength(ClrF, 0); SetLength(ClrO, 0); end; procedure CreateToolBarBitmap(var Bmp: TBitmap; Step: integer = 32); var r, g, b: single; i: integer; face: DWORD; SS: single; P: PRGBA; begin face := ColorToRGB(Bmp.Canvas.Brush.Color); SS := (Step * 2) / Bmp.Height; r := GetRValue(face) + Step * 2; g := GetGValue(face) + Step * 2; b := GetBValue(face) + Step * 2; if r < 0 then r := 0; if g < 0 then g := 0; if b < 0 then b := 0; if r > 255 then r := 255; if g > 255 then g := 255; if b > 255 then b := 255; for i := 0 to Bmp.Height - 1 do with Bmp.canvas do begin Pen.color := RGB(Trunc(r), Trunc(g), Trunc(b)); MoveTo(0, i); LineTo(Bmp.Height, i); r := r - SS; g := g - SS; b := b - SS; end; //////////// /// P := Bmp.ScanLine[Bmp.Height - 1]; for i := 0 to Bmp.Height - 1 do begin P^.ColorVal := IncColor(P^.dwColor, -30); inc(P, Bmp.Width); end; // P := Bmp.ScanLine[Bmp.Height-1]; end; { TDSTimeLine } procedure TDSTimeline.Clear; begin while Count <> 0 do Delete(0); end; procedure TDSTimeline.ClearBookmark; begin end; procedure TDSTimeline.ClearSelection; var I: Integer; begin while FSelection.Count <> 0 do RemoveFromSelection(TDSTimeLineSubItem(FSelection[0])); SelectedLine := -1; for I := 0 to Count - 1 do Lines[i].Selected := false; end; constructor TDSTimeline.Create; begin inherited Create(AOwner); //DoubleBuffered := true; TimeLine := TTimeLineEdit.Create(Self); Bar := TTimeLineBar.Create(Self); InitNavigator; FFirstRowWidth := VHeaderSize; sbVert := TcxScrollBar.Create(Self); sbHorz := TcxScrollBar.Create(Self); sbVert.Parent := Self; sbHorz.Parent := Self; sbVert.Kind := sbVertical; sbHorz.Kind := sbHorizontal; sbVert.Enabled := FALSE; sbHorz.Enabled := FALSE; sbHorz.ParentCtl3D := FALSE; sbHorz.Ctl3D := FALSE; sbVert.ParentCtl3D := FALSE; sbVert.Ctl3D := FALSE; TimeLine.Ctl3D := FALSE; Bar.Ctl3D := FALSE; //csOpaque in ControlStyle sbVert.OnScroll := ScrollEvent; sbHorz.OnScroll := ScrollEvent; SpinEdit := TdsTimeEdit.Create(Self); SpinEdit.Parent := Self; SpinEdit.Properties.TimeFormat := tfHourMinSecMili; SpinEdit.Properties.ValueType := vtInt; SpinEdit.MediaTime := 0; SpinEdit.Properties.OnChange := TimeEditChange; SpinEdit.Properties.Alignment.Horz := taCenter; SpinEdit.Properties.Alignment.Vert := taVCenter; Nav.Parent := Self; Bar.Parent := Self; Width := 500; Height := 320; FDuration := 10 * 10000000; FScale := 1; TimeLine.Parent := Self; FSelection := TList.Create; FList := TList.Create; MinRowHeight := 22; RowHeight := 22; FItemsLineChangeAllowed := TRUE; FSelectedLine := -1; FHeaderDrawMode := dhmCaption; FSupportoleDrop := FALSE; end; procedure TDSTimeline.Delete(index: integer); var i, k: Integer; AItem: TDSTimeLineItem; begin AItem := TDSTimeLineItem(FList[index]); for i := Pred(AItem.Count) downto 0 do begin k := FSelection.IndexOf(AItem.Items[i]); if k <> -1 then RemoveFromSelection(TDSTimeLineSubItem(FSelection[k])); TDSTimeLineSubItem(AItem.Items[i]).Free; AItem.Delete(i); end; AItem.Free; FList.delete(index); CalcScrollBars; end; procedure TDSTimeline.Delete(ALineItem: TDSTimeLineItem); begin Delete(IndexOf(ALineItem)); end; destructor TDSTimeline.Destroy; begin FSelection.Free; FList.Free; inherited; end; procedure TDSTimeline.DoAction(AButtonIndex: Integer); var //SegDur:double; Key: TDSTimeLineKeyItem; AOldPos: Int64; begin AOldPos := TimePosition; case AButtonIndex of 0: TimePosition := 0; 2: begin if SelectedLine >= 0 then begin Key := Lines[SelectedLine].KeyAtTime(TimePosition, -1); if Key <> NIL then TimePosition := Key.StartTime; end else TimePosition := TimePosition - 10000000; end; 3: begin if SelectedLine >= 0 then begin Key := Lines[SelectedLine].KeyAtTime(TimePosition, 1); if Key <> NIL then TimePosition := Key.StartTime; end else TimePosition := TimePosition + 10000000; end; 5: TimePosition := FDuration; 13: FitToWindow; end; // SegDur := (FDuration / 10000000); sbHorz.Position := FirstRowWidth + Trunc((FPosition / 10000000) * FScale * cScaleW) - (Timeline.Width div 2); if Assigned(OnPositionStateChange) then OnPositionStateChange(Self); if (AOldPos <> TimePosition) and Assigned(OnTimePositionChange) then OnTimePositionChange(Self, TimePosition); end; procedure TDSTimeline.DragDrop(Source: TObject; X, Y: Integer); begin inherited; end; procedure TDSTimeline.DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var pt: TPoint; begin inherited; if Accept then begin pt := Point(X - TimeLine.Left, Y - TimeLine.Top); FocusedLine := FList.IndexOf(ItemAtPos(pt.X, pt.Y)); end; end; procedure TDSTimeline.FitToWindow; begin Scale := ((TimeLine.Width - FirstRowWidth) / (cScaleW * (FDuration / 10000000))); sbHorz.Position := 0; end; function TDSTimeline.GetCount: integer; begin result := FList.Count; end; function TDSTimeline.GetItems(index: integer): TDSTimeLineItem; begin result := TDSTimeLineItem(FList[index]); end; function TDSTimeline.GetItemsBoundsRect: TRect; begin Result := Timeline.BoundsRect; end; function TDSTimeline.GetNotifier: TcxNavigatorControlNotifier; begin result := Notifier; end; function TDSTimeline.GetRowHeight: integer; begin if FRowHeight = -1 then if Count = 0 then result := MinRowHeight else result := Max(Round(TimeLine.Height / Count), FMinRowHeight) else result := FRowHeight; end; function TDSTimeline.GetSelectedKey: TDSTimeLineKeyItem; begin result := Timeline.SelectedKey; end; function TDSTimeline.GetSelItems(index: integer): TDSTimeLineSubItem; begin result := TDSTimeLineSubItem(FSelection[index]); end; function TDSTimeline.IndexOf(ALineItem: TDSTimeLineItem): Integer; begin Result := FList.IndexOf(ALineItem); end; procedure TDSTimeline.InitNavigator; begin Nav := TcxNavigator.Create(Self); Nav.Parent := Self; Notifier := TcxNavigatorControlNotifier.Create; Nav.Control := Self; with Nav.Buttons do begin //First; PriorPage.Visible := FALSE; //Prior; //Next; NextPage.Visible := FALSE; //Last; Insert.Visible := FALSE; Append.Visible := FALSE; Delete.Visible := FALSE; Edit.Visible := FALSE; Post.Visible := FALSE; Cancel.Visible := FALSE; Refresh.Visible := FALSE; //SaveBookmark; SaveBookmark.Hint := 'Fit to window'; GotoBookmark.Visible := FALSE; Filter.Visible := FALSE; end; Nav.Width := 90; end; function TDSTimeline.Insert(index: integer): TDSTimeLineItem; begin result := TDSTimeLineItem.Create(self); FList.Insert(index, result); CalcScrollBars; end; function TDSTimeline.IsActionSupported(AButtonIndex: Integer): Boolean; begin result := TRUE; end; function TDSTimeline.IsActive: Boolean; begin result := TRUE; end; function TDSTimeline.IsBof: Boolean; begin result := FPosition = 0; end; function TDSTimeline.IsBookmarkAvailable: Boolean; begin result := TRUE; end; function TDSTimeline.IsEditing: Boolean; begin result := TRUE; end; function TDSTimeline.IsEof: Boolean; begin result := FPosition >= FDuration; end; function TDSTimeline.IsSelectionUnique: boolean; var i: integer; P: Pointer; begin result := TRUE; i := FSelection.Count - 1; if i < 0 then exit; P := SelItems[i].Parent; dec(i); while (i >= 0) do begin if SelItems[i].Parent <> P then break; dec(i); end; result := i < 0; end; procedure TDSTimeline.ScrollEvent(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); begin TimeLine.Invalidate; Bar.Invalidate; end; function TDSTimeline.ItemAtPos(x, y: integer): TDSTimeLineItem; var i: integer; begin result := NIL; i := ((y) div RowHeight) + sbVert.Position;// c := Count-(sbVert.Height div RowHeight); if (i >= 0) and (i < Count) then result := Lines[i]; end; procedure TDSTimeline.Move(OldIdx, NewIdx: integer); begin FList.Move(OldIdx, NewIdx); end; procedure TDSTimeline.PainterChanged(APainter: TcxCustomLookAndFeelPainterClass); begin Resize; end; procedure TDSTimeline.PaintWindow(DC: HDC); begin //inherited; end; function TDSTimeline.PosToTime(aPos: integer): int64; begin result := Trunc(10000000 * (aPos / (FScale * cScaleW))); end; procedure TDSTimeline.RemoveFromSelection(aItem: TDSTimeLineSubItem); var i: integer; begin i := FSelection.IndexOf(aItem); if i >= 0 then begin aItem.Selected := FALSE; FSelection.Delete(i); aItem.Selected := false; UniSelection := IsSelectionUnique; SelChanged := TRUE; if Assigned(OnItemSelected) then OnItemSelected(aItem, FALSE); end; end; procedure TDSTimeline.Resize; begin //if Nav.Control=nil then exit; inherited; if GTextStep = 0 then GTextStep := TimeLine.Canvas.TextWidth('00:00:00.000'); SpinEdit.Width := GTextStep + 32; Bar.Top := 0; Bar.Left := 0; Bar.Width := Width; Bar.Height := 32; sbVert.Left := Width - sbVert.Width; sbVert.Top := BarHeight; sbVert.Height := Height - (BarHeight + sbHorz.Height); sbHorz.Left := SpinEdit.Width; sbHorz.Top := Height - sbHorz.Height; sbHorz.Width := Width - (SpinEdit.Width + Nav.Width); Nav.Height := sbHorz.Height + 1; Nav.Top := sbHorz.Top; Nav.Left := Width - Nav.Width; TimeLine.Top := BarHeight - 1; TimeLine.Left := 0; TimeLine.Width := Width - sbVert.Width; TimeLine.Height := Height - sbHorz.Height - BarHeight + 1; SpinEdit.Left := 0; SpinEdit.Top := sbHorz.Top - 2; CalcScrollBars; end; function TDSTimeline.Add: TDSTimeLineItem; begin result := TDSTimeLineItem.Create(self); FList.Add(result); result.Caption := inttostr(FList.Count); CalcScrollBars; end; function TDSTimeline.SelCount: integer; begin result := FSelection.Count; end; procedure TDSTimeline.SetController(const Value: TDSTimeLineController); begin if assigned(FController) then FreeAndNil(FController); FController := Value; if assigned(FController) then begin FController.FTimeLine := Self; FController.CheckExistingItems; end; end; procedure TDSTimeline.SetCount(const Value: integer); begin end; procedure TDSTimeline.SetDuration(const Value: int64); begin FDuration := Value; CalcScrollBars; Invalidate; end; procedure TDSTimeline.SetFirstRowWidth(const Value: integer); begin FFirstRowWidth := Value; end; procedure TDSTimeline.SetImageList(const Value: TcustomImageList); begin FImageList := Value; Invalidate; end; procedure TDSTimeline.SetItems(index: integer; const Value: TDSTimeLineItem); begin end; procedure TDSTimeline.SetKeyPosition(aTime: int64); begin if TImeline.SelectedKey <> NIL then begin TImeline.SelectedKey.StartTime := aTime; invalidate; end; end; procedure TDSTimeline.SetMinRowHeight(const Value: integer); begin FMinRowHeight := Value; SetRowHeight(FRowHeight); end; procedure TDSTimeline.SetOleSupportDrop(const Value: Boolean); begin if Value = FSupportoleDrop then exit; if not Value then begin RevokeDragDrop(Handle); FDropHelper := NIL; end; FSupportoleDrop := Value; if Value then begin FDropHelper := TDSTimeLineDropHelper.Create(self); RegisterDragDrop(Handle, FDropHelper); end; end; procedure TDSTimeline.SetPosition(const Value: int64); begin if (FPosition = Value) or (GChange) then exit; GChange := TRUE; FPosition := Max(0, Value); SpinEdit.MediaTime := FPosition; TimeLine.Invalidate; Bar.Invalidate; SpinEdit.Invalidate; Notifier.RefreshNavigatorButtons; GChange := FALSE; end; procedure TDSTimeline.SetRowHeight(const Value: integer); begin FRowHeight := Value; TimeLine.Invalidate; end; procedure TDSTimeline.SetScale(const Value: single); begin FScale := Value; CalcScrollBars; Invalidate; end; procedure TDSTimeline.SetFocusedLine(const Value: integer); var L: TDSTimeLineItem; begin FFocusedLine := Value; if (Value > -1) and (Value < FList.Count) then begin L := Lines[Value]; if (L <> TimeLine.PrevHot) then begin if TimeLine.PrevHot <> NIL then TimeLine.PrevHot.Hot := FALSE; if (L <> NIL) then begin L.Hot := TRUE; end; TimeLine.PrevHot := L; end; end else begin if assigned(TimeLine.PrevHot) then begin TimeLine.PrevHot.Hot := FALSE; TimeLine.PrevHot := NIL; end; end; Invalidate; end; procedure TDSTimeline.SetHeaderDrawMode(const Value: TDSTimeLineDrawHeaderMode); begin FHeaderDrawMode := Value; Invalidate; end; procedure TDSTimeline.SetSelectedLine(const Value: integer); begin if (FSelectedLine <> Value) and (FSelectedLine >= 0) and (FList.Count > FSelectedLine) then Lines[FSelectedLine].Selected := FALSE; if (Value >= 0) and (Value < Count) then Lines[Value].Selected := TRUE; FSelectedLine := Value; end; procedure TDSTimeline.SetSelItems(index: integer; const Value: TDSTimeLineSubItem); begin end; function TDSTimeline.AddKey(LineIdx: integer; InPos: int64): TDSTimeLineKeyItem; begin result := TDSTimeLineKeyItem.Create(Self); result.OnPaint := TimeLine.OnKeyPaint; //result.Parent := Self; result.StartTime := InPos; Lines[LineIdx].AddKey(result); Timeline.AlignKeys; end; function TDSTimeline.AddKeyInPosition(LineIdx: integer): TDSTimeLineKeyItem; begin result := TDSTimeLineKeyItem.Create(Self); result.OnPaint := TimeLine.OnKeyPaint; //result.Parent := Self; result.StartTime := TimePosition; Lines[LineIdx].AddKey(result); Timeline.AlignKeys; end; procedure TDSTimeline.AddToSelection(aItem: TDSTimeLineSubItem); begin if FSelection.IndexOf(aItem) < 0 then begin FSelection.Add(aItem); UniSelection := IsSelectionUnique; SelChanged := TRUE; aItem.Selected := true; if Assigned(OnItemSelected) then OnItemSelected(aItem, TRUE); end; end; procedure TDSTimeline.TimeEditChange(Sender: TObject); var AOldPos: Int64; begin AOldPos := TimePosition; TimePosition := SpinEdit.MediaTime; if (AOldPos <> TimePosition) and Assigned(OnTimePositionChange) then OnTimePositionChange(Self, TimePosition); end; function TDSTimeline.TimeToPos(aTime: int64): integer; begin result := Trunc((aTime / 10000000) * FScale * cScaleW); end; procedure TDSTimeline.CalcScrollBars; var c: integer; begin c := Trunc((cScaleW * FScale * (FDuration / 10000000))); sbHorz.Max := Max(1, c - (Width - 50)); sbHorz.Enabled := sbHorz.Max > 1; if RowHeight = 0 then c := 0 else c := Count - (sbVert.Height div RowHeight); sbVert.Enabled := c >= 1; if sbVert.Enabled then begin if c > sbVert.Max then sbVert.Position := c - sbVert.Max; sbVert.Max := c; end else begin sbVert.Position := 0; sbVert.Enabled := FALSE; end; end; function TDSTimeline.CanAppend: Boolean; begin result := TRUE; end; function TDSTimeline.CanDelete: Boolean; begin result := TRUE; end; function TDSTimeline.CanEdit: Boolean; begin result := TRUE; end; function TDSTimeline.CanInsert: Boolean; begin result := TRUE; end; procedure TDSTimeline.WMEraseBkgnd(var message: TWmEraseBkgnd); begin message.Result := 1; end; procedure TDSTimeline.WMPaint(var message: TWMPaint); begin inherited; message.Result := 1; end; { TTimeLine } procedure TTimeLineEdit.AlignKeys; //var i,y,q,sp:integer; // R:TRect; begin { i := Timeline.sbVert.Position; y := 2; R.Left := 0; R.Right := Timeline.FirstRowWidth+1; while i= 0) and (sx < 16) and (sy >= 0) and (sy < 16) then begin //OSD(inttostr(sx)+' '+inttostr(sy)); if KeyBitmap.Canvas.Pixels[sx, sy] <> clFuchsia then begin result := Line.Keys[i]; exit; end; end; end; end; procedure TTimeLineEdit.OnKeyPaint(Sender: TObject); begin Canvas.BrushCopy(Rect(0, 0, 16, 16), KeyBitmap, Rect(0, 0, 16, 16), clFuchsia); end; procedure TTimeLineEdit.Paint; var SegDur: double; SegW: single; x: single; R: TRect; TextRect: TRect; procedure DrawItems; var i, y, x, sp, d, q, J: integer; R, R2, R3, TR: TRect; FS: TFontStyles; Line: TDSTimeLineItem; Drawmode: TDSTimeLineDrawHeaderMode; Text: WideString; Strt, Dur: Int64; begin i := Timeline.sbVert.Position; y := 2; R.Left := 0; R.Right := Timeline.FirstRowWidth + 1; x := Timeline.FirstRowWidth + Min(Width, Trunc(SegDur * SegW) - Timeline.sbHorz.Position); while i < TimeLine.Count do begin cCanvas.Pen.Color := RootLookAndFeel.Painter.DefaultVGridLineColor; R.Top := y - 1; R.Bottom := y + TimeLine.RowHeight; cCanvas.MoveTo(Timeline.FirstRowWidth, R.Bottom - 1); cCanvas.LineTo(x, R.Bottom - 1); Drawmode := Timeline.FHeaderDrawMode; if TimeLine.Lines[i].HeaderDrawMode <> dhmNone then DrawMode := TimeLine.Lines[i].HeaderDrawMode; TextRect := R; InflateRect(TextRect, -4, -4); case Drawmode of dhmNone: begin RootLookAndFeel.Painter.DrawHeaderControlSection(cCanvas, R, TextRect, [], cxBordersAll, cxbsHot, //cxbsDefault, taCenter, vaCenter, FALSE, FALSE, '', Font, 0, 0); end; dhmCaption: begin RootLookAndFeel.Painter.DrawHeaderControlSection(cCanvas, R, TextRect, [], cxBordersAll, cxbsHot, //cxbsDefault, taCenter, vaCenter, FALSE, FALSE, TimeLine.Lines[i].Caption, Font, 0, 0); end; dhmImage: begin RootLookAndFeel.Painter.DrawHeaderControlSection(cCanvas, R, TextRect, [], cxBordersAll, cxbsHot, //cxbsDefault, taCenter, vaCenter, FALSE, FALSE, '', Font, 0, 0); with TimeLine do if assigned(ImageList) and (Lines[i].ImageIndex > -1) then begin ImageList.Draw(cCanvas.Canvas, TextRect.Left + ((TextRect.Right - TextRect.Left) div 2 - ImageList.Width div 2), TextRect.Top + ((TextRect.Bottom - TextRect.Top) div 2 - ImageList.Height div 2), Lines[i].ImageIndex); end; end; dhmImageAndCaption: begin with TimeLine do if assigned(ImageList) and (Lines[i].ImageIndex > -1) then TextRect.Top := TextRect.Top + ImageList.Height; RootLookAndFeel.Painter.DrawHeaderControlSection(cCanvas, R, TextRect, [], cxBordersAll, cxbsHot, //cxbsDefault, taCenter, vaCenter, FALSE, FALSE, TimeLine.Lines[i].Caption, Font, 0, 0); with TimeLine do if assigned(ImageList) and (Lines[i].ImageIndex > -1) then begin TextRect.Top := TextRect.Top - ImageList.Height * 2; ImageList.Draw(cCanvas.Canvas, TextRect.Left + ((TextRect.Right - TextRect.Left) div 2 - ImageList.Width div 2), TextRect.Top + ((TextRect.Bottom - TextRect.Top) div 2 - ImageList.Height div 2), Lines[i].ImageIndex); end; end; end; if TimeLine.Lines[i].Selected then begin R3 := R; R3.Left := 1; R3.Right := Width; R3.Bottom := R3.Bottom - 1; DrawBar(Back, R3, $80007FBF); end; if TimeLine.Lines[i].Hot then begin R3 := R; R3.Left := Timeline.FirstRowWidth + 1; R3.Right := Width; R3.Bottom := R3.Bottom - 1; DrawBar(Back, R3, $40FFFFFF); end; Line := TimeLine.Lines[i]; Line.SortBy(stViewTime); Line.FFX.CalcFx(TimeLine.PosToTime(TimeLine.sbHorz.Position - 5), TimeLine.PosToTime(TimeLine.sbHorz.Position + Width + 5)); for q := 0 to Line.Count - 1 do begin sp := Timeline.FirstRowWidth + Round(((Line.Items[q].ViewStartTime) / 10000000) * SegW) - TimeLine.sbHorz.Position; d := Max(4, Round(((Line.Items[q].ViewDuration) / 10000000) * SegW)); R2 := Rect(1 + sp, R.Top + 1, sp + d + 1, R.Bottom - 1); R2.Left := Max(R2.Left, Timeline.FirstRowWidth); if R2.Right - R2.Left > 2 then begin TR := R2; TR.Left := Max(R2.Left + 2, Timeline.FirstRowWidth); TR.Right := Max(R2.right - 2, Timeline.FirstRowWidth); Strt := Line.Items[q].ViewStartTime; Dur := Line.Items[q].ViewEndTime; Line.FFx.FindMaxNotIntersectedTime(Strt, Dur); TR.Left := Timeline.FirstRowWidth + Timeline.TimeToPos(Strt) - TimeLine.sbHorz.Position + 3; TR.Right := Timeline.FirstRowWidth + Timeline.TimeToPos(Dur) - TimeLine.sbHorz.Position - 3; cCanvas.Font.Style := cCanvas.Font.Style - [fsBold]; if assigned(Timeline.OnGetItemText) then Timeline.OnGetItemText(TimeLine, Line.Items[q], Text) else Text := Line.Items[q].Caption; if Line.Items[q].Selected then begin DrawBar(Back, R2, $D0000000 or ItemColorSel); with TimeLine do if assigned(ImageList) and (Line.Items[q].ImageIndex > -1) then begin ImageList.Draw(cCanvas.Canvas, TR.Left + 2, TR.Top + ((TR.Bottom - TR.Top) div 2 - ImageList.Height div 2), Line.Items[q].ImageIndex); inc(TR.Left, ImageList.Width + 4); end; if assigned(Timeline.OnDrawItem) then begin Timeline.OnDrawItem(TimeLine, cCanvas, R2, Line.Items[q], TR); end; cCanvas.Font.Color := RootLookAndFeel.Painter.DefaultHeaderTextColor; cCanvas.Brush.Style := bsClear; cCanvas.DrawTexT(Text, TR, cxAlignLeft or cxAlignVCenter or cxShowEndEllipsis or cxSingleLine); end else begin DrawBar(Back, R2, $D0000000 or ItemColor); with TimeLine do if assigned(ImageList) and (Line.Items[q].ImageIndex > -1) then begin ImageList.Draw(cCanvas.Canvas, TR.Left + 2, TR.Top + ((TR.Bottom - TR.Top) div 2 - ImageList.Height div 2), Line.Items[q].ImageIndex); inc(TR.Left, ImageList.Width + 4); end; if assigned(Timeline.OnDrawItem) then begin Timeline.OnDrawItem(TimeLine, cCanvas, R2, Line.Items[q], TR); end; cCanvas.Font.Color := RootLookAndFeel.Painter.DefaultHeaderBackgroundTextColor; cCanvas.Brush.Style := bsClear; cCanvas.DrawTexT(Text, TR, cxAlignLeft or cxAlignVCenter or cxShowEndEllipsis or cxSingleLine); end; with Line.FFx do if Count > 0 then begin for J := 0 to Count - 1 do begin R2.Left := Timeline.FirstRowWidth + Timeline.TimeToPos(FX[J].StartTime) - TimeLine.sbHorz.Position; R2.Right := Timeline.FirstRowWidth + Timeline.TimeToPos(FX[J].EndTime) - TimeLine.sbHorz.Position; DrawBar(Back, R2, $A0000000 or ItemColorFx); cCanvas.Brush.Style := BsClear; cCanvas.Font.Color := ItemBitmapFx.Canvas.Font.Color;//RootLookAndFeel.Painter.DefaultHeaderBackgroundTextColor; FS := Font.Style; cCanvas.Font.Style := cCanvas.Font.Style + [fsBold]; cCanvas.DrawTexT('Fx', R2, cxAlignHCenter or cxAlignVCenter or cxShowEndEllipsis or cxSingleLine); Font.Style := Fs; end; end; end; end; ////////////////////// Draw Keys cCanvas.Brush.Style := bsClear; for q := 0 to TimeLine.Lines[i].KeyCount - 1 do begin sp := Timeline.FirstRowWidth + Trunc(((TimeLine.Lines[i].Keys[q].ViewDeltaTime + TimeLine.Lines[i].Keys[q].StartTime) / 10000000) * SegW) - TimeLine.sbHorz.Position; if TimeLine.Lines[i].Keys[q] = SelectedKey then cCanvas.Canvas.BrushCopy(Rect(sp - 7, r.Top + 3, sp + 8, r.Top + 3 + 15), selkeybitmap, Rect(0, 0, 15, 15), clFuchsia) else cCanvas.Canvas.BrushCopy(Rect(sp - 7, r.Top + 3, sp + 8, r.Top + 3 + 15), keybitmap, Rect(0, 0, 15, 15), clFuchsia); end; inc(i); inc(y, TimeLine.RowHeight); end; // Line.SetEmpty; // Line.Free; end; begin Back.Width := Width; Back.Height := Height; SegDur := (TimeLine.FDuration / 10000000); SegW := TimeLine.FScale * cScaleW; ItemBitmapSel.Height := TimeLine.RowHeight; {$WARNINGS OFF} if ItemColorSel <> RootLookAndFeel.Painter.DefaultHeaderBackgroundColor then begin ItemColorSel := RootLookAndFeel.Painter.DefaultHeaderBackgroundColor; ItemBitmapSel.Canvas.Brush.Color := IncColor(RootLookAndFeel.Painter.DefaultHeaderBackgroundColor, 30); CreateToolBarBitmap(ItemBitmapSel); end; ItemBitmap.Height := TimeLine.RowHeight; if ItemColor <> RootLookAndFeel.Painter.DefaultHeaderColor then begin ItemColor := RootLookAndFeel.Painter.DefaultHeaderColor; ItemBitmap.Canvas.Brush.Color := ItemColor; CreateToolBarBitmap(ItemBitmap); end; {$WARNINGS ON} ItemBitmapFx.Height := TimeLine.RowHeight; if ItemColorFx <> IncColor(RootLookAndFeel.Painter.DefaultHeaderBackgroundColor, -$15) then begin ItemColorFx := IncColor(RootLookAndFeel.Painter.DefaultHeaderBackgroundColor, -$15); ItemBitmapFx.Canvas.Brush.Color := ItemColorFx; ItemBitmapFx.Canvas.Font.Color := IncColor(RootLookAndFeel.Painter.DefaultHeaderBackgroundTextColor, 0); CreateToolBarBitmap(ItemBitmapFx); end; R := ClientRect; RootLookAndFeel.Painter.DrawHeaderControlSection(cCanvas, R, R, [], cxBordersAll, cxbsDisabled, //cxbsDefault, taLeftJustify, vaTop, FALSE, FALSE, '', NIL, 0, 0); R.Left := Timeline.FirstRowWidth; R.Right := Timeline.FirstRowWidth + Trunc(SegDur * SegW) - TDSTimeLine(Parent).sbHorz.Position; RootLookAndFeel.Painter.DrawHeaderControlSection(cCanvas, R, R, [{nLeft, nTop, nRight, nBottom}], cxBordersAll, cxbsHot, //cxbsDefault, taLeftJustify, vaTop, FALSE, FALSE, '', NIL, 0, 0); // Draw Lines x := -TimeLine.sbHorz.Position + TimeLine.FirstRowWidth; while x < Width + TimeLine.GTextStep do begin if x >= -SegW then begin if x < Width then begin cCanvas.Pen.Color := RootLookAndFeel.Painter.DefaultVGridLineColor; cCanvas.MoveTo(Round(x), 1); cCanvas.LineTo(Round(x), Height - 2); end; end; x := x + SegW; end; DrawItems; x := Timeline.FirstRowWidth + (Timeline.FPosition / 10000000) * SegW - Timeline.sbHorz.Position; cCanvas.Pen.Mode := pmCopy; cCanvas.Pen.Style := psDot; cCanvas.Pen.Color := $FF;// cCanvas.Brush.Color := $FFFFFF;// cCanvas.MoveTo(Round(x), 1); cCanvas.LineTo(Round(x), Height - 2); cCanvas.Pen.Style := psSolid; TimeLine.Bar.Paint; Canvas.Draw(0, 0, Back); end; procedure TTimeLineEdit.SetSelectedKey(const Value: TDSTimeLineKeyItem); begin FSelectedKey := Value; end; procedure TTimeLineEdit.WMChar(var message: TWMChar); begin if Assigned(Timeline.OnKeyPress) then Timeline.DoKeyPress(message); inherited; end; procedure TTimeLineEdit.WMEraseBkgnd(var message: TWmEraseBkgnd); begin message.Result := 1; end; procedure TTimeLineEdit.WMLButtonDblClk(var message: TWMLButtonDblClk); begin Timeline.DblClick; end; procedure TTimeLineEdit.WMLButtonDown(var message: TWMLButtonDown); var P, AOldPos: int64; L: TDSTimeLineItem; Item: TDSTimeLineSubItem; Shift: TShiftState; I: Integer; begin if not Focused then SetFocus; Shift := KeysToShiftState(message.Keys); P := Trunc(10000000 * ((Timeline.sbHorz.Position + message.XPos - Timeline.FirstRowWidth) / (Timeline.FScale * cScaleW))); L := Timeline.ItemAtPos(message.XPos, message.YPos); Gx := message.XPos; Gy := message.YPos; if Assigned(L) then begin Item := NIL; SelectedKey := KeyAtPos(L, Gx, Gy mod TimeLine.RowHeight); Timeline.SelectedLine := Timeline.FocusedLine; if Gx >= Timeline.FirstRowWidth then Item := L.ItemAtTime(P); if (MoveAction = maDurationPrev) and (Item <> NIL) then begin Item := Item.Prev; MoveAction := maDuration; end; if ((Item = NIL) or not Item.Selected) and (not (ssShift in Shift)) and (not (ssCtrl in Shift)) then Timeline.ClearSelection; if Assigned(Item) then begin if (ssCtrl in Shift) then begin Item.Selected := not Item.Selected; if Item.Selected then Timeline.AddToSelection(Item) else Timeline.RemoveFromSelection(Item); end else begin Item.Selected := TRUE; Timeline.AddToSelection(Item); end; end else begin if message.XPos > Timeline.FirstRowWidth then begin AOldPos := Timeline.TimePosition; Timeline.ClearSelection; Timeline.TimePosition := P; if (AOldPos <> Timeline.TimePosition) and Assigned(Timeline.OnTimePositionChange) then Timeline.OnTimePositionChange(Timeline, Timeline.TimePosition); end else begin // Line Select for I := 0 to L.Count - 1 do begin L.Items[i].Selected := TRUE; Timeline.AddToSelection(L.Items[i]); end; end; end; end else begin SelectedKey := NIL; AOldPos := Timeline.TimePosition; Timeline.ClearSelection; Timeline.TimePosition := P; if (AOldPos <> Timeline.TimePosition) and Assigned(Timeline.OnTimePositionChange) then Timeline.OnTimePositionChange(Timeline, Timeline.TimePosition); end; message.Result := 0; inherited; if Timeline.SelChanged then begin Invalidate; if Assigned(Timeline.OnSelectionChanged) then Timeline.OnSelectionChanged(Timeline); end; Timeline.SelChanged := FALSE; if Assigned(Timeline.OnMouseDown) then Timeline.OnMouseDown(Timeline, mbLeft, Shift, message.XPos, message.YPos); end; procedure TTimeLineEdit.WMGetDlgCode(var message: TWMGetDlgCode); begin inherited; message.Result := message.Result or DLGC_WANTTAB or DLGC_WANTALLKEYS; end; procedure TTimeLineEdit.WMKeyDown(var message: TWMKeyDown); var i: Integer; begin if Assigned(Timeline.OnKeyDown) then Timeline.DoKeyDown(message); inherited; if message.CharCode = VK_ESCAPE then begin MoveAction := 0; for i := 0 to Timeline.SelCount - 1 do begin Timeline.SelItems[i].ViewDeltaTime := 0; Timeline.SelItems[i].ViewDeltaDuration := 0; end; Perform(WM_LBUTTONUP, 0, 0); end; end; procedure TTimeLineEdit.WMKeyUp(var message: TWMKeyUp); begin if Assigned(Timeline.OnKeyUp) then Timeline.DoKeyUp(message); inherited; end; procedure TTimeLineEdit.WMLButtonUp(var message: TWMLButtonUp); var i: integer; SS: TShiftState; AValidate, APosOrDurationChanged: Boolean; begin message.Result := 0; inherited; SS := KeysToShiftState(message.Keys); AValidate := TRUE; APosOrDurationChanged := FALSE; for i := 0 to Timeline.SelCount - 1 do begin if AValidate then begin Timeline.SelItems[i].StartTime := Timeline.SelItems[i].StartTime + Timeline.SelItems[i].ViewDeltaTime; Timeline.SelItems[i].Duration := Timeline.SelItems[i].Duration + Timeline.SelItems[i].ViewDeltaDuration; end; APosOrDurationChanged := (Timeline.SelItems[i].ViewDeltaTime <> 0) or (Timeline.SelItems[i].ViewDeltaDuration <> 0); Timeline.SelItems[i].ViewDeltaTime := 0; Timeline.SelItems[i].ViewDeltaDuration := 0; end; if Timeline.SelectedLine >= 0 then Timeline.Lines[Timeline.SelectedLine].SortKeys; if APosOrDurationChanged and Assigned(Timeline.OnItemPosChange) then Timeline.OnItemPosChange(Timeline, Timeline.FSelection, AValidate); if Assigned(Timeline.OnMouseUp) then Timeline.OnMouseUp(Timeline, mbLeft, SS, message.XPos, message.YPos); Invalidate; end; procedure TTimeLineEdit.WMMouseMove(var message: TWMMouseMove); var DTime, P, AOldPos: int64; L: TDSTimeLineItem; Item: TDSTimeLineSubItem; x, y: integer; Curs: TCursor; i: Integer; SS: TSHiftState; begin SS := KeysToShiftState(message.Keys); if ssLeft in SS then begin if Timeline.FSelection.Count <> 0 then begin DTime := Timeline.PosToTime(message.XPos - Gx); for i := 0 to Timeline.SelCount - 1 do begin //OSD(SelItems[i].Caption); case MoveAction of maMove: begin Timeline.SelItems[i].ViewDeltaTime := DTime; if Timeline.ItemsLineChangeAllowed and Timeline.UniSelection then begin y := (message.YPos div Timeline.RowHeight); if (y >= 0) and (y < Timeline.Count) then begin if Timeline.Lines[y] <> Timeline.SelItems[i].Parent then begin Timeline.SelItems[i].Parent.RemoveItem(Timeline.SelItems[i]); Timeline.Lines[y].AddItem(Timeline.SelItems[i]); end; end; end; end; maStart: begin Timeline.SelItems[i].ViewDeltaTime := DTime; Timeline.SelItems[i].ViewDeltaDuration := -DTime; end; maDuration: begin Timeline.SelItems[i].ViewDeltaDuration := DTime; end; maDurationPrev: ; end; end; if Assigned(Timeline.OnItemPosChanging) then Timeline.OnItemPosChanging(Timeline, Timeline.FSelection); invalidate; end else begin P := Trunc(10000000 * ((Timeline.sbHorz.Position + message.XPos - Timeline.FirstRowWidth) / (Timeline.FScale * cScaleW))); if P < 0 then P := 0; if SelectedKey <> NIL then begin SelectedKey.StartTime := P; if Assigned(TimeLine.OnKeyPosChange) then TimeLine.OnKeyPosChange(TimeLine, SelectedKey); invalidate; end else begin AOldPos := Timeline.TimePosition; Timeline.TimePosition := P; if (AOldPos <> Timeline.TimePosition) and Assigned(Timeline.OnTimePositionChange) then Timeline.OnTimePositionChange(Timeline, Timeline.TimePosition); end; end; end else if SS = [] then begin Curs := crDefault; MoveAction := 0; P := Trunc(10000000 * ((Timeline.sbHorz.Position + message.XPos - Timeline.FirstRowWidth) / (Timeline.FScale * cScaleW))); L := Timeline.ItemAtPos(message.XPos, message.YPos); Timeline.FFocusedLine := Timeline.FList.IndexOf(L); if (L <> PrevHot) then begin if PrevHot <> NIL then PrevHot.Hot := FALSE; if (L <> NIL) then begin L.Hot := TRUE; end; PrevHot := L; Invalidate; end; if L <> NIL then begin Item := L.ItemAtTime(P); if Item <> NIL then begin MoveAction := maMove; x := Timeline.TimeToPos(P - Item.StartTime); if (x >= 0) and (x < 3) then begin Curs := crHSplit; MoveAction := maStart; end; if MoveAction = maMove then begin x := Abs(Timeline.TimeToPos(P - (Item.StartTime + Item.Duration))); if (x >= 0) and (x < 3) then begin Curs := crHSplit; MoveAction := maDuration; end else //Prev Item if (Item.Prev <> NIL) then begin x := Abs(Timeline.TimeToPos(P - (Item.Prev.StartTime + Item.Prev.Duration))); if (x >= 0) and (x < 3) then begin Curs := crHSplit; MoveAction := maDurationPrev; end; end; end; if assigned(TimeLine.Controller) then TimeLine.Controller.CheckMoveAction(MoveAction, Curs); end; end; Cursor := Curs; end; if Assigned(TimeLine.OnMouseMove) then TimeLine.OnMouseMove(TimeLine, SS, message.XPos, message.YPos); end; {procedure TTimeLineEdit.WMRButtonDown(var Message: TWMRButtonDown); var M: TWMRButtonDown; begin inherited; M := Message; M.Keys := (M.Keys and ($FFFFFFFF xor MK_LBUTTON)) or MK_RBUTTON; WMLButtonDown(M); end; } procedure TTimeLineEdit.WMSysKeyDown(var message: TWMKeyDown); begin if Assigned(Timeline.OnKeyDown) then Timeline.DoKeyDown(message); inherited; end; procedure TTimeLineEdit.WMSysKeyUp(var message: TWMKeyUp); begin if Assigned(Timeline.OnKeyUp) then Timeline.DoKeyUp(message); inherited; end; { TDSTimeLineItem } function TDSTimeLineItem.AddItem(aItem: TDSTimeLineSubItem): boolean; begin if assigned(FTimeLine.Controller) then result := FTimeLine.Controller.AddItemToLine(Self, aItem) else result := AddItemInternal(aItem); end; procedure TDSTimeLineItem.DeleteKey(index: integer); begin TDSTimeLineKeyItem(FKeyList[index]).free; FKeyList.delete(index); end; destructor TDSTimeLineItem.Destroy; begin while Count <> 0 do begin Items[0].Free; Delete(0); end; while KeyCount <> 0 do begin DeleteKey(0); end; FreeAndNil(FKeyList); FreeAndNil(FFx); inherited; end; function TDSTimeLineItem.Get(Index: Integer): TDSTimeLineSubItem; begin result := TDSTimeLineSubItem(inherited Items[index]); end; function TDSTimeLineItem.GetKeys(Index: integer): TDSTimeLineKeyItem; begin result := TDSTimeLineKeyItem(FKeyList[index]); end; function TDSTimeLineItem.ItemAtTime(aTime: int64): TDSTimeLineSubItem; var i: integer; begin i := Count - 1; while (i >= 0) do begin if (aTime >= Items[i].StartTime) and (aTime < Items[i].StartTime + Items[i].Duration) then break; dec(i); end; if i >= 0 then result := Items[i] else result := NIL; end; function TDSTimeLineItem.KeyAtTime(aTime: int64; aDirection: integer): TDSTimeLineKeyItem; var i: integer; begin i := KeyCount - 1; result := NIL; if aDirection = 0 then begin while (i >= 0) and (aTime <> Keys[i].StartTime) do dec(i); if i >= 0 then result := Keys[i]; end else if aDirection > 0 then begin i := 0; while (i < KeyCount) and (aTime >= Keys[i].StartTime) do inc(i); if i < KeyCount then result := Keys[i]; end else if aDirection < 0 then begin while (i >= 0) and (aTime <= Keys[i].StartTime) do dec(i); if i >= 0 then result := Keys[i]; end; end; function TDSTimeLineItem.KeyCount: integer; begin result := FKeyList.Count; end; procedure TDSTimeLineItem.LinkUpdate; var i: integer; Prev: TDSTimeLineSubItem; begin Prev := NIL; for I := 0 to Count - 1 do begin Items[i].Prev := Prev; if i < Count - 1 then Items[i].Next := Items[i + 1].Next else Items[i].Next := NIL; Prev := Items[i]; end; end; function TDSTimeLineItem.AddItemInternal(aItem: TDSTimeLineSubItem): boolean; begin result := false; if IndexOf(aItem) >= 0 then exit; aItem.Parent := Self; Add(aItem); result := true; end; function TDSTimeLineItem.AddKey(aItem: TDSTimeLineKeyItem): integer; begin result := FKeyList.Add(aItem); SortKeys; end; constructor TDSTimeLineItem.Create; begin FKeyList := TList.Create; FTimeLine := TimeLine; FImageIndex := -1; FHeaderDrawMode := dhmNone; FFx := TFXList.Create(self); inherited Create; end; procedure TDSTimeLineItem.Notify(Ptr: Pointer; Action: TListNotification); begin LinkUpdate; end; procedure TDSTimeLineItem.Put(Index: Integer; const Value: TDSTimeLineSubItem); begin inherited Items[index] := Pointer(Value); end; function TDSTimeLineItem.Remove(Item: Pointer): Integer; begin raise EListError.Create('Use RemoveItem method!'); end; function TDSTimeLineItem.RemoveItem(aItem: TDSTimeLineSubItem): boolean; begin if assigned(FTimeLine.Controller) then result := FTimeLine.Controller.RemoveItemFromLine(Self, aItem) else result := RemoveItemInternal(aItem); end; function TDSTimeLineItem.RemoveItemInternal(aItem: TDSTimeLineSubItem): boolean; begin result := inherited Remove(aItem) > -1; end; procedure TDSTimeLineItem.SetCaption(const Value: string); begin FCaption := Value; end; procedure TDSTimeLineItem.SetHeaderDrawMode(const Value: TDSTimeLineDrawHeaderMode); begin FHeaderDrawMode := Value; FTimeLine.Invalidate; end; procedure TDSTimeLineItem.SetHot(const Value: boolean); begin FHot := Value; end; procedure TDSTimeLineItem.SetImageIndex(const Value: Integer); begin FImageIndex := Value; FTimeLine.Invalidate; end; procedure TDSTimeLineItem.SetKeys(Index: integer; const Value: TDSTimeLineKeyItem); begin FKeyList[index] := Value; end; procedure TDSTimeLineItem.SetSelected(const Value: boolean); begin FSelected := Value; end; procedure TDSTimeLineItem.SetVisible(const Value: boolean); //var i:integer; begin FVisible := Value; //for I := 0 to KeyCount - 1 do // Keys[i].Visible := Value; end; function SortCompareStartTime(Item1, Item2: Pointer): Integer; begin result := CompareValue(TDSTimeLineSubItem(Item1).StartTime, TDSTimeLineSubItem(Item2).StartTime); if result = 0 then CompareValue(TDSTimeLineSubItem(Item1).Parent.IndexOf(Item1), TDSTimeLineSubItem(Item2).Parent.IndexOf(Item2)); end; function SortCompareViewTime(Item1, Item2: Pointer): Integer; begin result := CompareValue(TDSTimeLineSubItem(Item1).ViewStartTime, TDSTimeLineSubItem(Item2).ViewStartTime); if result = 0 then CompareValue(TDSTimeLineSubItem(Item1).Parent.IndexOf(Item1), TDSTimeLineSubItem(Item2).Parent.IndexOf(Item2)); end; procedure TDSTimeLineItem.SortBy(sType: integer); begin case sType of 0: Sort(SortCompareStartTime); 1: Sort(SortCompareViewTime); end; end; function SortKeyCompareStartTime(Item1, Item2: Pointer): Integer; begin if TDSTimeLineKeyItem(Item1).FStartTime + TDSTimeLineKeyItem(Item1).FViewDeltaTime > TDSTimeLineKeyItem(Item2).FStartTime + TDSTimeLineKeyItem(Item2).FViewDeltaTime then result := 1 else if TDSTimeLineKeyItem(Item1).FStartTime + TDSTimeLineKeyItem(Item1).FViewDeltaTime < TDSTimeLineKeyItem(Item2).FStartTime + TDSTimeLineKeyItem(Item2).FViewDeltaTime then result := -1 else result := 0; end; procedure TDSTimeLineItem.SortKeys; begin FKeyList.Sort(SortKeyCompareStartTime); end; { TDSTimeLineSubItem } constructor TDSTimeLineSubItem.Create; begin inherited Create; FImageIndex := -1; end; destructor TDSTimeLineSubItem.Destroy; begin if assigned(FDataObject) then FreeAndNil(FDataObject); inherited; end; function TDSTimeLineSubItem.GetViewDuration: int64; begin result := FDuration + FViewDeltaDuration; end; function TDSTimeLineSubItem.GetViewEndTime: int64; begin result := FStartTime + FDuration + FViewDeltaTime + FViewDeltaDuration; end; function TDSTimeLineSubItem.GetViewStartTime: int64; begin result := FStartTime + FViewDeltaTime; end; procedure TDSTimeLineSubItem.SetCaption(const Value: string); begin FCaption := Value; end; procedure TDSTimeLineSubItem.SetDuration(const Value: int64); begin if assigned(FParent) and assigned(FParent.FTimeLine.Controller) then FParent.FTimeLine.Controller.SetItemDuration(Self, Value) else SetDurationInternal(Value); end; procedure TDSTimeLineSubItem.SetDurationInternal(const Value: int64); begin FDuration := Value; FEndTime := FStartTime + FDuration; end; procedure TDSTimeLineSubItem.SetEndTime(const Value: int64); begin if assigned(FParent) and assigned(FParent.FTimeLine.Controller) then FParent.FTimeLine.Controller.SetItemEndTime(Self, Value) else SetEndTimeInternal(Value); end; procedure TDSTimeLineSubItem.SetEndTimeInternal(const Value: int64); begin FEndTime := Value; FDuration := FEndTime - FStartTime; end; procedure TDSTimeLineSubItem.SetImageIndex(const Value: Integer); begin FImageIndex := Value; if assigned(Parent) then Parent.FTimeLine.Invalidate; end; procedure TDSTimeLineSubItem.SetSelected(const Value: boolean); begin FSelected := Value; end; procedure TDSTimeLineSubItem.SetStartTime(const Value: int64); begin if assigned(FParent) and assigned(FParent.FTimeLine.Controller) then FParent.FTimeLine.Controller.SetItemStartTime(Self, Value) else SetStartTimeInternal(Value); end; procedure TDSTimeLineSubItem.SetStartTimeInternal(const Value: int64); begin FStartTime := Value; FEndTime := FStartTime + FDuration; end; procedure TDSTimeLineSubItem.SetViewDeltaDuration(const Value: int64); begin if assigned(FParent) and assigned(FParent.FTimeLine.Controller) then FParent.FTimeLine.Controller.SetItemViewDeltaDuration(Self, Value) else SetViewDeltaDurationInternal(Value); end; procedure TDSTimeLineSubItem.SetViewDeltaDurationInternal(const Value: int64); begin FViewDeltaDuration := Value; if Duration + Value < 0 then FViewDeltaDuration := -Duration + 10000; end; procedure TDSTimeLineSubItem.SetViewDeltaTime(const Value: int64); begin if assigned(FParent) and assigned(FParent.FTimeLine.Controller) then FParent.FTimeLine.Controller.SetItemViewDeltaTime(Self, Value) else SetViewDeltaTimeInternal(Value); end; procedure TDSTimeLineSubItem.SetViewDeltaTimeInternal(const Value: int64); begin FViewDeltaTime := Value; if StartTime + Value < 0 then FViewDeltaTime := -StartTime; end; { TTimeLineBar } constructor TTimeLineBar.Create(AOwner: TComponent); begin inherited; Back := TBitmap.Create; Back.PixelFormat := pf32bit; ControlStyle := ControlStyle + [csCaptureMouse]; cCanvas := TcxCanvas.Create(Back.Canvas); //DoubleBuffered := true; end; destructor TTimeLineBar.Destroy; begin cCanvas.Free; Back.Free; inherited; end; procedure TTimeLineBar.DrawFace; begin Canvas.Draw(0, 0, Back); end; function TTimeLineBar.GetTimeLine: TDSTimeLine; begin result := TDSTimeLine(Parent); end; procedure TTimeLineBar.ProcessPaint; var R: TRect; SegDur: double; SegW: single; procedure DrawTimes; var i: integer; q, Step, FNext, x: Single; StartTime: int64; s: String; R: TRect; ls: single; P: array[0..3] of TPoint; procedure CheckText(XPos: integer; Time: int64; Little: boolean = FALSE); var lw: integer; begin if FNext + 10 + (TimeLine.GTextStep div 2) < XPos then begin if (Little) and (XPos + 10 + (TimeLine.GTextStep div 2) >= x + SegW) then exit; s := Time2Str(Time); lw := cCanvas.TextWidth(s) div 2; R.Left := XPos - lw; R.Right := XPos + lw; cCanvas.DrawTexT(s, R, cxAlignHCenter or cxAlignVCenter); FNext := R.Right; end; end; begin x := 1; ls := 1; Step := 1; if SegW < 10 then begin Step := 0; ls := 1; end else if SegW < 100 then begin Step := 1; ls := SegW / 2; end else if SegW <= 1000 then begin q := (SegW / 100) + 1; Step := q; ls := SegW / q; end else ; StartTime := 0; R.Top := 0; R.Bottom := 22; FNext := -$FFFF; cCanvas.Brush.Color := RootLookAndFeel.Painter.DefaultHeaderTextColor; cCanvas.Pen.Color := RootLookAndFeel.Painter.DefaultHeaderTextColor; cCanvas.Brush.style := bsClear; x := -TimeLine.sbHorz.Position + Timeline.FirstRowWidth; while x < Width + Timeline.GTextStep do begin if x >= -SegW then begin cCanvas.Pen.Color := RootLookAndFeel.Painter.DefaultVGridBandLineColor; cCanvas.MoveTo(Round(x), 22); cCanvas.LineTo(Round(x), 30); CheckText(Round(X), StartTime); cCanvas.Pen.Color := RootLookAndFeel.Painter.DefaultVGridBandLineColor; q := FNext; for I := 1 to Trunc(Step) - 1 do begin cCanvas.MoveTo(Round(x) + Trunc(ls * i), 26); cCanvas.LineTo(Round(x) + Trunc(ls * i), 30); if Step > 0 then CheckText(Round(x + ls * i), Round(StartTime + (i * (1000 / Step))), TRUE); end; FNext := q; end; inc(StartTime, 1000); x := x + SegW; end; x := Timeline.FirstRowWidth + Trunc((Timeline.FPosition / 10000000) * SegW) - Timeline.sbHorz.Position; cCanvas.Brush.Style := bsSolid; cCanvas.Pen.Color := RootLookAndFeel.Painter.DefaultSelectionColor; cCanvas.Brush.Color := cCanvas.Pen.Color; P[0].X := Round(x - 5); P[0].Y := 23; P[3].X := Round(x - 5); P[3].Y := 23; P[1].X := Round(x); P[1].Y := 28; P[2].X := Round(x + 5); P[2].Y := 23; cCanvas.Polygon(P); end; begin Back.Width := Width; Back.Height := Height; SegDur := (TDSTimeLine(Parent).FDuration / 10000000); SegW := TDSTimeLine(Parent).Scale * cScaleW; RootLookAndFeel.Painter.DrawHeaderControlSection(cCanvas, ClientRect, ClientRect, [], cxBordersAll, cxbsDisabled, //cxbsDefault, taLeftJustify, vaTop, FALSE, FALSE, '', NIL, 0, 0); R := ClientRect; R.Top := 19; R.Bottom := 32; RootLookAndFeel.Painter.DrawHeaderControlSection(cCanvas, R, R, [{nLeft, nTop, nRight, nBottom}], cxBordersAll, cxbsDisabled, //cxbsDefault, taLeftJustify, vaTop, FALSE, FALSE, '', NIL, 0, 0); R.Left := Timeline.FirstRowWidth; R.Right := Timeline.FirstRowWidth + Trunc(SegDur * SegW) - TDSTimeLine(Parent).sbHorz.Position; ; RootLookAndFeel.Painter.DrawHeaderControlSection(cCanvas, R, R, [{nLeft, nTop, nRight, nBottom}], cxBordersAll, cxbsHot, //cxbsDefault, taLeftJustify, vaTop, FALSE, FALSE, '', NIL, 0, 0); DrawTimes; end; procedure TTimeLineBar.Paint; begin ProcessPaint; DrawFace; end; procedure TTimeLineBar.WMEraseBkgnd(var message: TWmEraseBkgnd); begin message.Result := 1; end; procedure TTimeLineBar.WMLButtonDown(var message: TWMLButtonDown); var P, AOldPos: Int64; Shift: TShiftState; begin SetCapture(Handle); P := Trunc(10000000 * ((Timeline.sbHorz.Position + message.XPos - Timeline.FirstRowWidth) / (Timeline.FScale * cScaleW))); if P < 0 then P := 0; AOldPos := Timeline.TimePosition; Timeline.TimePosition := P; if (AOldPos <> Timeline.TimePosition) and Assigned(Timeline.OnTimePositionChange) then Timeline.OnTimePositionChange(Timeline, Timeline.TimePosition); Shift := KeysToShiftState(message.Keys); if Assigned(Timeline.OnMouseDown) then Timeline.OnMouseDown(Timeline, mbLeft, Shift, Message.XPos, Message.YPos); end; procedure TTimeLineBar.WMRButtonDown(var message: TWMRButtonDown); var Shift: TShiftState; begin Shift := KeysToShiftState(message.Keys); if Assigned(Timeline.OnMouseDown) then Timeline.OnMouseDown(Timeline, mbRight, Shift, Message.XPos, Message.YPos); end; procedure TTimeLineBar.WMRButtonUp(var message: TWMLButtonUp); begin SetCapture(0); end; procedure TTimeLineBar.WMMouseMove(var message: TWMMouseMove); var P, AOldPos: int64; SS: TShiftState; begin SS := KeysToShiftState(message.Keys); if ssLeft in SS then begin P := Trunc(10000000 * ((Timeline.sbHorz.Position + message.XPos - Timeline.FirstRowWidth) / (Timeline.FScale * cScaleW))); if P < 0 then P := 0; AOldPos := Timeline.TimePosition; Timeline.TimePosition := P; if (AOldPos <> Timeline.TimePosition) and Assigned(Timeline.OnTimePositionChange) then Timeline.OnTimePositionChange(Timeline, Timeline.TimePosition); end; end; { TDSTimeLineKeyItem } constructor TDSTimeLineKeyItem.Create(AOwner: TControl); begin inherited Create; Tag := 0; FData := NIL; FDataObject := NIL; end; destructor TDSTimeLineKeyItem.Destroy; begin if assigned(FDataObject) then FreeAndNil(FDataObject); inherited; end; procedure TDSTimeLineKeyItem.SetCaption(const Value: string); begin FCaption := Value; end; procedure TDSTimeLineKeyItem.SetDuration(const Value: int64); begin FDuration := Value; end; procedure TDSTimeLineKeyItem.SetSelected(const Value: boolean); begin FSelected := Value; end; procedure TDSTimeLineKeyItem.SetStartTime(const Value: int64); begin FStartTime := Value; end; procedure TDSTimeLineKeyItem.SetViewDeltaDuration(const Value: int64); begin FViewDeltaDuration := Value; end; procedure TDSTimeLineKeyItem.SetViewDeltaTime(const Value: int64); begin FViewDeltaTime := Value; end; { TDSTimeLineDropHelper } constructor TDSTimeLineDropHelper.Create(Timeline: TDSTimeline); begin inherited Create; self.Timeline := Timeline; end; function TDSTimeLineDropHelper.DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HRESULT; begin result := S_OK; self.dataObj := dataObj; pt := TimeLine.ScreenToClient(pt); Timeline.DragOver(self, pt.X, pt.Y, dsDragEnter, Accept); if accept then begin dwEffect := DROPEFFECT_COPY; end else dwEffect := DROPEFFECT_NONE; end; function TDSTimeLineDropHelper.DragLeave: HRESULT; begin Timeline.DragOver(self, 0, 0, dsDragLeave, Accept); Accept := FALSE; dataObj := NIL; result := S_OK; end; function TDSTimeLineDropHelper.DragOver(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HRESULT; begin Result := S_OK; pt := TimeLine.ScreenToClient(pt); Timeline.DragOver(self, pt.X, pt.Y, dsDragEnter, Accept); if Accept then begin dwEffect := DROPEFFECT_COPY; end else dwEffect := DROPEFFECT_NONE; end; function TDSTimeLineDropHelper.Drop(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HRESULT; begin pt := TimeLine.ScreenToClient(pt); TimeLine.DragDrop(self, pt.X, pt.Y); result := S_OK; end; function TDSTimeLineDropHelper.Expose: TDSTimeLineDropHelper; begin result := self; end; function TDSTimeLineDropHelper.GetData(const format: Cardinal; out medium: TStgMedium): boolean; var pvEnum: IEnumFORMATETC; dwFetch: Integer; lpFormat: TFormatEtc; begin result := FALSE; if Succeeded(dataObj.EnumFormatEtc(DATADIR_GET, pvEnum)) then begin while Succeeded(pvEnum.Next(1, lpFormat, @dwFetch)) and (dwFetch = 1) do begin if lpFormat.cfFormat = format then begin result := TRUE; dataObj.GetData(lpFormat, medium); exit; end; end; end; end; function TDSTimeLineDropHelper.QueryGetData(const format: Cardinal): boolean; var pvEnum: IEnumFORMATETC; dwFetch: Integer; lpFormat: TFormatEtc; begin result := FALSE; if Succeeded(dataObj.EnumFormatEtc(DATADIR_GET, pvEnum)) then begin while Succeeded(pvEnum.Next(1, lpFormat, @dwFetch)) and (dwFetch = 1) do begin if lpFormat.cfFormat = format then begin result := TRUE; exit; end; end; end; end; { TFXList } procedure TFXList.AddFx(Item1, Item2: TDSTimeLineSubItem); var Fx: TFXItem; tmp: TDSTimeLineSubItem; begin if Item1.ViewStartTime > Item2.ViewStartTime then begin tmp := Item1; Item1 := Item2; Item2 := tmp; end; if Item2.ViewStartTime < Item1.ViewEndTime then begin //have intersection Fx := TFXItem.Create; Fx.StartTime := Item2.ViewStartTime; if Item2.ViewEndTime < Item1.ViewEndTime then Fx.Duration := Item2.ViewDuration //total overlaping else Fx.Duration := Item1.ViewEndTime - Item2.ViewStartTime; //partial overlaping Add(Fx); end; end; procedure TFXList.CalcFx(Start, Duration: Int64); var I: Integer; J: Integer; EndTime: Int64; begin Clear; EndTime := Start + Duration; for I := 0 to FTrack.Count - 2 do begin if ((FTrack.Items[i].ViewStartTime > Start) and (FTrack.Items[i].ViewStartTime < EndTime)) or ((FTrack.Items[i].ViewEndTime > Start) and (FTrack.Items[i].ViewEndTime < EndTime)) then for J := I + 1 to FTrack.Count - 1 do begin AddFx(FTrack.Items[i], FTrack.Items[J]); end; end; CheckFxForIntersections; end; procedure TFXList.CheckFxForIntersections; var I: Integer; begin for I := Count - 1 downto 1 do begin if IntersectFx(FX[i - 1], FX[i]) then Delete(i); end; end; constructor TFXList.Create(Track: TDSTimeLineItem); begin inherited Create; OwnsObjects := TRUE; FTrack := Track; end; procedure TFXList.FindMaxNotIntersectedTime(var StartTime, EndTime: Int64); var I: Integer; begin for I := 0 to Count - 1 do begin if ((Fx[I].StartTime >= StartTime) and (FX[i].StartTime <= EndTime)) and ((Fx[I].EndTime >= StartTime) and (FX[i].EndTime <= EndTime)) then begin if Fx[i].StartTime - StartTime > EndTime - Fx[i].EndTime then begin EndTime := Fx[i].StartTime; end else begin StartTime := Fx[i].EndTime; end; end else begin if ((Fx[I].StartTime >= StartTime) and (FX[i].StartTime <= EndTime)) or ((Fx[I].EndTime >= StartTime) and (FX[i].EndTime <= EndTime)) then begin if (Fx[I].StartTime < StartTime) then begin StartTime := Fx[I].EndTime; end else begin EndTime := Fx[I].StartTime; end; end; end; end; end; function TFXList.GetFX(Index: Integer): TFXItem; begin result := TFXItem(Items[Index]); end; function TFXList.IntersectFx(Primary, Secondary: TFXItem): boolean; begin result := FALSE; if (Secondary.StartTime >= Primary.StartTime) and (Secondary.StartTime <= Primary.EndTime) then begin result := TRUE; if Secondary.EndTime > Primary.EndTime then Primary.EndTime := Secondary.EndTime; end; end; { TFXItem } function TFXItem.GetEndTime: Int64; begin result := StartTime + Duration; end; procedure TFXItem.SetEndTime(const Value: Int64); begin Duration := Value - StartTime; end; { TDSTimeLineController } function TDSTimeLineController.AddItemToLine(Line: TDSTimeLineItem; Item: TDSTimeLineSubItem): boolean; begin result := Line.AddItemInternal(Item); end; procedure TDSTimeLineController.CheckExistingItems; var I: Integer; begin for I := 0 to FTimeLine.Count - 1 do begin CheckExistingLine(FTimeLine.Lines[i]); end; end; procedure TDSTimeLineController.CheckExistingLine(Line: TDSTimeLineItem); begin //Do nothing end; procedure TDSTimeLineController.CheckMoveAction(var MoveAction: Cardinal; var Cursor: TCursor); begin // Do nothing by default end; function TDSTimeLineController.RemoveItemFromLine(Line: TDSTimeLineItem; Item: TDSTimeLineSubItem): boolean; begin result := Line.RemoveItemInternal(Item); end; procedure TDSTimeLineController.SetItemDuration(Item: TDSTimeLineSubItem; Value: Int64); begin Item.SetDurationInternal(Value); end; procedure TDSTimeLineController.SetItemEndTime(Item: TDSTimeLineSubItem; Value: Int64); begin Item.SetEndTimeInternal(Value); end; procedure TDSTimeLineController.SetItemStartTime(Item: TDSTimeLineSubItem; Value: Int64); begin Item.SetStartTimeInternal(Value); end; procedure TDSTimeLineController.SetItemViewDeltaDuration( Item: TDSTimeLineSubItem; Value: Int64); begin Item.SetViewDeltaDurationInternal(Value); end; procedure TDSTimeLineController.SetItemViewDeltaTime(Item: TDSTimeLineSubItem; Value: Int64); begin Item.SetViewDeltaTimeInternal(Value); end; end.