diff --git a/components/spktoolbar/SpkGUITools/SpkGUITools.pas b/components/spktoolbar/SpkGUITools/SpkGUITools.pas new file mode 100644 index 000000000..35a2524ff --- /dev/null +++ b/components/spktoolbar/SpkGUITools/SpkGUITools.pas @@ -0,0 +1,2380 @@ +unit SpkGuiTools; + +{$DEFINE SPKGUITOOLS} + +interface + +{$MESSAGE HINT 'W tym module konsekwentnie każdy rect opisuje dokładny prostokąt (a nie, jak w przypadku WINAPI - bez dolnej i prawej krawędzi)'} + +uses Windows, Graphics, SysUtils, Math, Classes, Controls, ImgList, + SpkGraphTools, SpkMath; + +type TCornerPos = (cpLeftTop, cpRightTop, cpLeftBottom, cpRightBottom); + TCornerKind = (cpRound, cpNormal); + TBackgroundKind = (bkSolid, bkVerticalGradient, bkHorizontalGradient, + bkConcave); + +type TGUITools = class(TObject) + private + protected + class procedure FillGradientRectangle(ACanvas: TCanvas; Rect: T2DIntRect; ColorFrom: TColor; ColorTo: TColor; GradientKind: TBackgroundKind); + + class procedure SaveClipRgn(DC : HDC; var OrgRgnExists : boolean; var OrgRgn : HRGN); + class procedure RestoreClipRgn(DC : HDC; OrgRgnExists : boolean; var OrgRgn : HRGN); + public + // *** Lines *** + + // Performance: + // w/ClipRect: Bitmap is faster (2x) + // wo/ClipRect: Canvas is faster (a little) + class procedure DrawHLine(ABitmap : TBitmap; + x1, x2 : integer; + y : integer; + Color : TColor); overload; inline; + class procedure DrawHLine(ABitmap : TBitmap; + x1, x2 : integer; + y : integer; + Color : TColor; + ClipRect : T2DIntRect); overload; inline; + class procedure DrawHLine(ACanvas : TCanvas; + x1, x2 : integer; + y : integer; + Color : TColor); overload; inline; + class procedure DrawHLine(ACanvas : TCanvas; + x1, x2 : integer; + y : integer; + Color : TColor; + ClipRect : T2DIntRect); overload; inline; + + + // Performance: + // w/ClipRect: Bitmap is faster (2x) + // wo/ClipRect: Canvas is faster (a little) + class procedure DrawVLine(ABitmap : TBitmap; + x : integer; + y1, y2 : integer; + Color : TColor); overload; inline; + class procedure DrawVLine(ABitmap : TBitmap; + x : integer; + y1, y2 : integer; + Color : TColor; + ClipRect : T2DIntRect); overload; inline; + class procedure DrawVLine(ACanvas : TCanvas; + x : integer; + y1, y2 : integer; + Color : TColor); overload; inline; + class procedure DrawVLine(ACanvas : TCanvas; + x : integer; + y1, y2 : integer; + Color : TColor; + ClipRect : T2DIntRect); overload; inline; + + // *** Background and frame tools *** + + // Performance: + // w/ClipRect: Bitmap is faster (extremely) + // wo/ClipRect: Bitmap is faster (extremely) + class procedure DrawAARoundCorner(ABitmap : TBitmap; + Point : T2DIntVector; + Radius : integer; + CornerPos : TCornerPos; + Color : TColor); overload; inline; + class procedure DrawAARoundCorner(ABitmap : TBitmap; + Point : T2DIntVector; + Radius : integer; + CornerPos : TCornerPos; + Color : TColor; + ClipRect : T2DIntRect); overload; inline; + class procedure DrawAARoundCorner(ACanvas : TCanvas; + Point : T2DIntVector; + Radius : integer; + CornerPos : TCornerPos; + Color : TColor); overload; inline; + class procedure DrawAARoundCorner(ACanvas : TCanvas; + Point : T2DIntVector; + Radius : integer; + CornerPos : TCornerPos; + Color : TColor; + ClipRect : T2DIntRect); overload; inline; + + // Performance: + // w/ClipRect: Bitmap is faster (extremely) + // wo/ClipRect: Bitmap is faster (extremely) + class procedure DrawAARoundFrame(ABitmap : TBitmap; + Rect : T2DIntRect; + Radius : integer; + Color : TColor); overload; inline; + class procedure DrawAARoundFrame(ABitmap : TBitmap; + Rect : T2DIntRect; + Radius : integer; + Color : TColor; + ClipRect : T2DIntRect); overload; inline; + class procedure DrawAARoundFrame(ACanvas : TCanvas; + Rect : T2DIntRect; + Radius : integer; + Color : TColor); overload; inline; + class procedure DrawAARoundFrame(ACanvas : TCanvas; + Rect : T2DIntRect; + Radius : integer; + Color : TColor; + ClipRect : T2DIntRect); overload; inline; + + class procedure RenderBackground(ABuffer : TBitmap; + Rect : T2DIntRect; + Color1, Color2 : TColor; + BackgroundKind : TBackgroundKind); inline; + + class procedure CopyRoundCorner(ABuffer : TBitmap; + ABitmap : TBitmap; + SrcPoint : T2DIntVector; + DstPoint : T2DIntVector; + Radius : integer; + CornerPos : TCornerPos; + Convex : boolean = true); overload; inline; + class procedure CopyRoundCorner(ABuffer : TBitmap; + ABitmap : TBitmap; + SrcPoint : T2DIntVector; + DstPoint : T2DIntVector; + Radius : integer; + CornerPos : TCornerPos; + ClipRect : T2DIntRect; + Convex : boolean = true); overload; inline; + + class procedure CopyCorner(ABuffer : TBitmap; + ABitmap: TBitmap; + SrcPoint : T2DIntVector; + DstPoint: T2DIntVector; + Radius: integer); overload; inline; + class procedure CopyCorner(ABuffer : TBitmap; + ABitmap: TBitmap; + SrcPoint : T2DIntVector; + DstPoint: T2DIntVector; + Radius: integer; + ClipRect : T2DIntRect); overload; inline; + + class procedure CopyRectangle(ABuffer : TBitmap; + ABitmap: TBitmap; + SrcPoint : T2DIntVector; + DstPoint: T2DIntVector; + Width: integer; + Height : integer); overload; inline; + class procedure CopyRectangle(ABuffer : TBitmap; + ABitmap : TBitmap; + SrcPoint : T2DIntVector; + DstPoint : T2DIntVector; + Width : integer; + Height : integer; + ClipRect : T2DIntRect); overload; inline; + class procedure CopyMaskRectangle(ABuffer : TBitmap; + AMask : TBitmap; + ABitmap : TBitmap; + SrcPoint : T2DIntVector; + DstPoint : T2DIntVector; + Width : integer; + Height : integer); overload; inline; + class procedure CopyMaskRectangle(ABuffer : TBitmap; + AMask : TBitmap; + ABitmap : TBitmap; + SrcPoint : T2DIntVector; + DstPoint : T2DIntVector; + Width : integer; + Height : integer; + ClipRect : T2DIntRect); overload; inline; + + // Performance (RenderBackground + CopyRoundRect vs DrawRoundRect): + // w/ClipRect : Bitmap faster for smaller radiuses, Canvas faster for larger + // wo/ClipRect : Bitmap faster for smaller radiuses, Canvas faster for larger + class procedure CopyRoundRect(ABuffer : TBitmap; + ABitmap : TBitmap; + SrcPoint : T2DIntVector; + DstPoint : T2DIntVector; + Width, Height : integer; + Radius : integer; + LeftTopRound : boolean = true; + RightTopRound : boolean = true; + LeftBottomRound : boolean = true; + RightBottomRound : boolean = true); overload; inline; + class procedure CopyRoundRect(ABuffer : TBitmap; + ABitmap : TBitmap; + SrcPoint : T2DIntVector; + DstPoint : T2DIntVector; + Width, Height : integer; + Radius : integer; + ClipRect : T2DIntRect; + LeftTopRound : boolean = true; + RightTopRound : boolean = true; + LeftBottomRound : boolean = true; + RightBottomRound : boolean = true); overload; inline; + + + class procedure DrawRoundRect(ACanvas : TCanvas; + Rect : T2DIntRect; + Radius : integer; + ColorFrom : TColor; + ColorTo : TColor; + GradientKind : TBackgroundKind; + LeftTopRound : boolean = true; + RightTopRound : boolean = true; + LeftBottomRound : boolean = true; + RightBottomRound : boolean = true); overload; inline; + class procedure DrawRoundRect(ACanvas : TCanvas; + Rect : T2DIntRect; + Radius : integer; + ColorFrom : TColor; + ColorTo : TColor; + GradientKind : TBackgroundKind; + ClipRect : T2DIntRect; + LeftTopRound : boolean = true; + RightTopRound : boolean = true; + LeftBottomRound : boolean = true; + RightBottomRound : boolean = true); overload; inline; + + class procedure DrawRegion(ACanvas : TCanvas; + Region : HRGN; + Rect : T2DIntRect; + ColorFrom : TColor; + ColorTo : TColor; + GradientKind : TBackgroundKind); overload; inline; + class procedure DrawRegion(ACanvas : TCanvas; + Region : HRGN; + Rect : T2DIntRect; + ColorFrom : TColor; + ColorTo : TColor; + GradientKind : TBackgroundKind; + ClipRect : T2DIntRect); overload; inline; + + // Imagelist tools + class procedure DrawImage(ABitmap : TBitmap; + Imagelist : TImageList; + ImageIndex : integer; + Point : T2DIntVector); overload; inline; + class procedure DrawImage(ABitmap : TBitmap; + Imagelist : TImageList; + ImageIndex : integer; + Point : T2DIntVector; + ClipRect : T2DIntRect); overload; inline; + class procedure DrawImage(ACanvas : TCanvas; + Imagelist : TImageList; + ImageIndex : integer; + Point : T2DIntVector); overload; inline; + class procedure DrawImage(ACanvas : TCanvas; + Imagelist : TImageList; + ImageIndex : integer; + Point : T2DIntVector; + ClipRect : T2DIntRect); overload; inline; + + class procedure DrawDisabledImage(ABitmap : TBitmap; + Imagelist : TImageList; + ImageIndex : integer; + Point : T2DIntVector); overload; inline; + class procedure DrawDisabledImage(ABitmap : TBitmap; + Imagelist : TImageList; + ImageIndex : integer; + Point : T2DIntVector; + ClipRect : T2DIntRect); overload; inline; + class procedure DrawDisabledImage(ACanvas : TCanvas; + Imagelist : TImageList; + ImageIndex : integer; + Point : T2DIntVector); overload; inline; + class procedure DrawDisabledImage(ACanvas : TCanvas; + Imagelist : TImageList; + ImageIndex : integer; + Point : T2DIntVector; + ClipRect : T2DIntRect); overload; inline; + + // Text tools + class procedure DrawText(ABitmap : TBitmap; + x, y : integer; + AText : string; + TextColor : TColor); overload; inline; + class procedure DrawText(ABitmap : TBitmap; + x, y : integer; + AText : string; + TextColor : TColor; + ClipRect : T2DIntRect); overload; inline; + class procedure DrawMarkedText(ACanvas : TCanvas; + x, y : integer; + AText : string; + AMarkPhrase : string; + TextColor : TColor; + CaseSensitive : boolean = false); overload; inline; + class procedure DrawMarkedText(ACanvas : TCanvas; + x, y : integer; + AText : string; + AMarkPhrase : string; + TextColor : TColor; + ClipRect : T2DIntRect; + CaseSensitive : boolean = false); overload; inline; + class procedure DrawText(ACanvas : TCanvas; + x, y : integer; + AText : string; + TextColor : TColor); overload; inline; + class procedure DrawText(ACanvas : TCanvas; + x, y : integer; + AText : string; + TextColor : TColor; + ClipRect : T2DIntRect); overload; inline; + class procedure DrawFitWText(ABitmap : TBitmap; + x1, x2 : integer; + y : integer; + AText : string; + TextColor : TColor; + Align : TAlignment); overload; inline; + class procedure DrawFitWText(ACanvas : TCanvas; + x1, x2 : integer; + y : integer; + AText : string; + TextColor : TColor; + Align : TAlignment); overload; inline; + + class procedure DrawOutlinedText(ABitmap : TBitmap; + x, y : integer; + AText : string; + TextColor : TColor; + OutlineColor : TColor); overload; inline; + class procedure DrawOutlinedText(ABitmap : TBitmap; + x, y : integer; + AText : string; + TextColor : TColor; + OutlineColor : TColor; + ClipRect : T2DIntRect); overload; inline; + class procedure DrawOutlinedText(ACanvas : TCanvas; + x, y : integer; + AText : string; + TextColor : TColor; + OutlineColor : TColor); overload; inline; + class procedure DrawOutlinedText(ACanvas : TCanvas; + x, y : integer; + AText : string; + TextColor : TColor; + OutlineColor : TColor; + ClipRect : T2DIntRect); overload; inline; + class procedure DrawFitWOutlinedText(ABitmap: TBitmap; + x1, x2 : integer; + y: integer; + AText: string; + TextColor, + OutlineColor: TColor; + Align: TAlignment); overload; inline; + class procedure DrawFitWOutlinedText(ACanvas: TCanvas; + x1, x2 : integer; + y: integer; + AText: string; + TextColor, + OutlineColor: TColor; + Align: TAlignment); overload; inline; + end; + +implementation + +{ TSpkGUITools } + +class procedure TGUITools.CopyRoundCorner(ABuffer, ABitmap: TBitmap; SrcPoint, + DstPoint: T2DIntVector; Radius: integer; CornerPos: TCornerPos; + ClipRect: T2DIntRect; Convex: boolean); + +var BufferRect, BitmapRect : T2DIntRect; + OrgSrcRect, UnClippedDstRect, OrgDstRect : T2DIntRect; + SrcRect : T2DIntRect; + Offset : T2DIntVector; + Center: T2DIntVector; + y: Integer; + SrcLine: Pointer; + DstLine: Pointer; + SrcPtr, DstPtr : PByte; + x: Integer; + Dist : double; + +begin +if (ABuffer.PixelFormat<>pf24bit) or (ABitmap.PixelFormat<>pf24bit) then + raise exception.create('TSpkGUITools.CopyRoundCorner: Tylko 24-bitowe bitmapy są akceptowane!'); + +// Sprawdzanie poprawności +if Radius<1 then + exit; + +if (ABuffer.width=0) or (ABuffer.height=0) or + (ABitmap.width=0) or (ABitmap.height=0) then exit; + +BufferRect:=T2DIntRect.create(0, 0, ABuffer.width-1, ABuffer.height-1); +if not(BufferRect.IntersectsWith(T2DIntRect.create(SrcPoint.x, + SrcPoint.y, + SrcPoint.x+Radius-1, + SrcPoint.y+Radius-1), + OrgSrcRect)) then exit; + +BitmapRect:=T2DIntRect.create(0, 0, ABitmap.width-1, ABitmap.height-1); +if not(BitmapRect.IntersectsWith(T2DIntRect.create(DstPoint.x, + DstPoint.y, + DstPoint.x+Radius-1, + DstPoint.y+Radius-1), + UnClippedDstRect)) then exit; + +if not(ClipRect.IntersectsWith(UnClippedDstRect, OrgDstRect)) then + exit; + +Offset:=DstPoint - SrcPoint; + +if not(OrgSrcRect.IntersectsWith(OrgDstRect - Offset, SrcRect)) then exit; + +// Ustalamy pozycję środka łuku +case CornerPos of + cpLeftTop: Center:=T2DIntVector.create(SrcPoint.x + radius - 1, SrcPoint.y + Radius - 1); + cpRightTop: Center:=T2DIntVector.create(SrcPoint.x, SrcPoint.y + Radius - 1); + cpLeftBottom: Center:=T2DIntVector.Create(SrcPoint.x + radius - 1, SrcPoint.y); + cpRightBottom: Center:=T2DIntVector.Create(SrcPoint.x, SrcPoint.y); +end; + +// Czy jest cokolwiek do przetworzenia? +if Convex then + begin + if (SrcRect.left<=SrcRect.right) and (SrcRect.top<=SrcRect.bottom) then + for y := SrcRect.top to SrcRect.bottom do + begin + SrcLine:=ABuffer.ScanLine[y]; + DstLine:=ABitmap.ScanLine[y+Offset.y]; + + SrcPtr:=pointer(integer(SrcLine) + 3*SrcRect.left); + DstPtr:=pointer(integer(DstLine) + 3*(SrcRect.left + Offset.x)); + for x := SrcRect.left to SrcRect.right do + begin + Dist:=Center.DistanceTo(T2DIntVector.create(x, y)); + if Dist <= (Radius-1) then + Move(SrcPtr^,DstPtr^,3); + + inc(SrcPtr,3); + inc(DstPtr,3); + end; + end; + end +else + begin + if (SrcRect.left<=SrcRect.right) and (SrcRect.top<=SrcRect.bottom) then + for y := SrcRect.top to SrcRect.bottom do + begin + SrcLine:=ABuffer.ScanLine[y]; + DstLine:=ABitmap.ScanLine[y+Offset.y]; + + SrcPtr:=pointer(integer(SrcLine) + 3*SrcRect.left); + DstPtr:=pointer(integer(DstLine) + 3*(SrcRect.left + Offset.x)); + for x := SrcRect.left to SrcRect.right do + begin + Dist:=Center.DistanceTo(T2DIntVector.create(x, y)); + if Dist >= (Radius-1) then + Move(SrcPtr^,DstPtr^,3); + + inc(SrcPtr,3); + inc(DstPtr,3); + end; + end; + end; +end; + +class procedure TGUITools.CopyRoundRect(ABuffer, ABitmap: TBitmap; SrcPoint, + DstPoint: T2DIntVector; Width, Height, Radius: integer; ClipRect: T2DIntRect; + LeftTopRound, RightTopRound, LeftBottomRound, RightBottomRound: boolean); + +begin +if (ABuffer.PixelFormat<>pf24bit) or (ABitmap.PixelFormat<>pf24bit) then + raise exception.create('TSpkGUITools.CopyBackground: Tylko 24-bitowe bitmapy są akceptowane!'); + +// Sprawdzamy poprawność +if Radius<0 then + exit; + +if (Radius>Width div 2) or (Radius>Height div 2) then exit; + +if (ABuffer.width=0) or (ABuffer.height=0) or + (ABitmap.width=0) or (ABitmap.height=0) then exit; + +{$REGION 'Wypełniamy prostokąty'} +// Góra +CopyRectangle(ABuffer, + ABitmap, + T2DIntPoint.create(SrcPoint.x + radius, SrcPoint.y), + T2DIntPoint.create(DstPoint.x + radius, DstPoint.y), + width - 2*radius, + radius, + ClipRect); +// Dół +CopyRectangle(ABuffer, + ABitmap, + T2DIntPoint.create(SrcPoint.x + radius, SrcPoint.y + height - radius), + T2DIntPoint.create(DstPoint.x + radius, DstPoint.y + height - radius), + width - 2*radius, + radius, + ClipRect); +// Środek +CopyRectangle(ABuffer, + ABitmap, + T2DIntPoint.create(SrcPoint.x, SrcPoint.y + radius), + T2DIntPoint.create(DstPoint.x, DstPoint.y + radius), + width, + height - 2*radius, + ClipRect); +{$ENDREGION} + +// Wypełniamy narożniki + +{$REGION 'Lewy górny'} +if LeftTopRound then + TGUITools.CopyRoundCorner(ABuffer, + ABitmap, + T2DIntPoint.Create(SrcPoint.x, SrcPoint.y), + T2DIntPoint.Create(DstPoint.x, DstPoint.y), + Radius, + cpLeftTop, + ClipRect, + true) +else + TGUITools.CopyCorner(ABuffer, + ABitmap, + T2DIntPoint.Create(SrcPoint.x, SrcPoint.y), + T2DIntPoint.Create(DstPoint.x, DstPoint.y), + Radius, + ClipRect); +{$ENDREGION} + +{$REGION 'Prawy górny'} +if RightTopRound then + TGUITools.CopyRoundCorner(ABuffer, + ABitmap, + T2DIntPoint.Create(SrcPoint.x + Width - Radius, SrcPoint.y), + T2DIntPoint.Create(DstPoint.x + Width - Radius, DstPoint.y), + Radius, + cpRightTop, + ClipRect, + true) +else + TGUITools.CopyCorner(ABuffer, + ABitmap, + T2DIntPoint.Create(SrcPoint.x + Width - Radius, SrcPoint.y), + T2DIntPoint.Create(DstPoint.x + Width - Radius, DstPoint.y), + Radius, + ClipRect); +{$ENDREGION} + +{$REGION 'Lewy dolny'} +if LeftBottomRound then + TGUITools.CopyRoundCorner(ABuffer, + ABitmap, + T2DIntPoint.Create(SrcPoint.x, SrcPoint.y + Height - Radius), + T2DIntPoint.Create(DstPoint.x, DstPoint.y + Height - Radius), + Radius, + cpLeftBottom, + ClipRect, + true) +else + TGUITools.CopyCorner(ABuffer, + ABitmap, + T2DIntPoint.Create(SrcPoint.x, SrcPoint.y + Height - Radius), + T2DIntPoint.Create(DstPoint.x, DstPoint.y + Height - Radius), + Radius, + ClipRect); +{$ENDREGION} + +{$REGION 'Prawy dolny'} +if RightBottomRound then + TGUITools.CopyRoundCorner(ABuffer, + ABitmap, + T2DIntPoint.Create(SrcPoint.x + Width - Radius, SrcPoint.y + Height - Radius), + T2DIntPoint.Create(DstPoint.x + Width - Radius, DstPoint.y + Height - Radius), + Radius, + cpRightBottom, + ClipRect, + true) +else + TGUITools.CopyCorner(ABuffer, + ABitmap, + T2DIntPoint.Create(SrcPoint.x + Width - Radius, SrcPoint.y + Height - Radius), + T2DIntPoint.Create(DstPoint.x + Width - Radius, DstPoint.y + Height - Radius), + Radius, + ClipRect); +{$ENDREGION'} +end; + +class procedure TGUITools.CopyRoundRect(ABuffer : TBitmap; ABitmap: TBitmap; SrcPoint, + DstPoint: T2DIntVector; Width, Height, Radius: integer; LeftTopRound, + RightTopRound, LeftBottomRound, RightBottomRound: boolean); + +begin +if (ABuffer.PixelFormat<>pf24bit) or (ABitmap.PixelFormat<>pf24bit) then + raise exception.create('TSpkGUITools.CopyBackground: Tylko 24-bitowe bitmapy są akceptowane!'); + +// Sprawdzamy poprawność +if Radius<0 then + exit; + +if (Radius>Width div 2) or (Radius>Height div 2) then exit; + +if (ABuffer.width=0) or (ABuffer.height=0) or + (ABitmap.width=0) or (ABitmap.height=0) then exit; + +{$REGION 'Wypełniamy prostokąty'} +// Góra +CopyRectangle(ABuffer, + ABitmap, + T2DIntPoint.create(SrcPoint.x + radius, SrcPoint.y), + T2DIntPoint.create(DstPoint.x + radius, DstPoint.y), + width - 2*radius, + radius); +// Dół +CopyRectangle(ABuffer, + ABitmap, + T2DIntPoint.create(SrcPoint.x + radius, SrcPoint.y + height - radius), + T2DIntPoint.create(DstPoint.x + radius, DstPoint.y + height - radius), + width - 2*radius, + radius); +// Środek +CopyRectangle(ABuffer, + ABitmap, + T2DIntPoint.create(SrcPoint.x, SrcPoint.y + radius), + T2DIntPoint.create(DstPoint.x, DstPoint.y + radius), + width, + height - 2*radius); +{$ENDREGION} + +// Wypełniamy narożniki +{$REGION 'Lewy górny'} +if LeftTopRound then + TGUITools.CopyRoundCorner(ABuffer, + ABitmap, + T2DIntPoint.Create(SrcPoint.x, SrcPoint.y), + T2DIntPoint.Create(DstPoint.x, DstPoint.y), + Radius, + cpLeftTop, + true) +else + TGUITools.CopyCorner(ABuffer, + ABitmap, + T2DIntPoint.Create(SrcPoint.x, SrcPoint.y), + T2DIntPoint.Create(DstPoint.x, DstPoint.y), + Radius); +{$ENDREGION} + +{$REGION 'Prawy górny'} +if RightTopRound then + TGUITools.CopyRoundCorner(ABuffer, + ABitmap, + T2DIntPoint.Create(SrcPoint.x + Width - Radius, SrcPoint.y), + T2DIntPoint.Create(DstPoint.x + Width - Radius, DstPoint.y), + Radius, + cpRightTop, + true) +else + TGUITools.CopyCorner(ABuffer, + ABitmap, + T2DIntPoint.Create(SrcPoint.x + Width - Radius, SrcPoint.y), + T2DIntPoint.Create(DstPoint.x + Width - Radius, DstPoint.y), + Radius); +{$ENDREGION} + +{$REGION 'Lewy dolny'} +if LeftBottomRound then + TGUITools.CopyRoundCorner(ABuffer, + ABitmap, + T2DIntPoint.Create(SrcPoint.x, SrcPoint.y + Height - Radius), + T2DIntPoint.Create(DstPoint.x, DstPoint.y + Height - Radius), + Radius, + cpLeftBottom, + true) +else + TGUITools.CopyCorner(ABuffer, + ABitmap, + T2DIntPoint.Create(SrcPoint.x, SrcPoint.y + Height - Radius), + T2DIntPoint.Create(DstPoint.x, DstPoint.y + Height - Radius), + Radius); +{$ENDREGION} + +{$REGION 'Prawy dolny'} +if RightBottomRound then + TGUITools.CopyRoundCorner(ABuffer, + ABitmap, + T2DIntPoint.Create(SrcPoint.x + Width - Radius, SrcPoint.y + Height - Radius), + T2DIntPoint.Create(DstPoint.x + Width - Radius, DstPoint.y + Height - Radius), + Radius, + cpRightBottom, + true) +else + TGUITools.CopyCorner(ABuffer, + ABitmap, + T2DIntPoint.Create(SrcPoint.x + Width - Radius, SrcPoint.y + Height - Radius), + T2DIntPoint.Create(DstPoint.x + Width - Radius, DstPoint.y + Height - Radius), + Radius); +{$ENDREGION'} +end; + +class procedure TGUITools.CopyRectangle(ABuffer, ABitmap: TBitmap; SrcPoint, + DstPoint: T2DIntVector; Width, Height: integer); + +var BufferRect, BitmapRect : T2DIntRect; + SrcRect, DstRect : T2DIntRect; + ClippedSrcRect : T2DIntRect; + Offset : T2DIntVector; + y: Integer; + SrcLine: Pointer; + DstLine: Pointer; + +begin +if (ABuffer.PixelFormat<>pf24bit) or (ABitmap.PixelFormat<>pf24bit) then + raise exception.create('TSpkGUITools.CopyRoundCorner: Tylko 24-bitowe bitmapy są akceptowane!'); + +// Sprawdzanie poprawności +if (Width<1) or (Height<1) then + exit; + +if (ABuffer.width=0) or (ABuffer.height=0) or + (ABitmap.width=0) or (ABitmap.height=0) then exit; + +// Przycinamy źródłowy rect do obszaru źródłowej bitmapy +BufferRect:=T2DIntRect.create(0, 0, ABuffer.width-1, ABuffer.height-1); + +if not(BufferRect.IntersectsWith(T2DIntRect.create(SrcPoint.x, + SrcPoint.y, + SrcPoint.x+Width-1, + SrcPoint.y+Height-1), + SrcRect)) then exit; + +// Przycinamy docelowy rect do obszaru docelowej bitmapy +BitmapRect:=T2DIntRect.create(0, 0, ABitmap.width-1, ABitmap.height-1); +if not(BitmapRect.IntersectsWith(T2DIntRect.create(DstPoint.x, + DstPoint.y, + DstPoint.x+Width-1, + DstPoint.y+Height-1), + DstRect)) then exit; + +// Liczymy offset źródłowego do docelowego recta +Offset:=DstPoint - SrcPoint; + +// Sprawdzamy, czy nałożone na siebie recty: źródłowy i docelowy przesunięty o +// offset mają jakąś część wspólną +if not(SrcRect.IntersectsWith(DstRect - Offset, ClippedSrcRect)) then exit; + +// Jeśli jest cokolwiek do przetworzenia, wykonaj operację +if (ClippedSrcRect.left<=ClippedSrcRect.right) and (ClippedSrcRect.top<=ClippedSrcRect.bottom) then + for y := ClippedSrcRect.top to ClippedSrcRect.bottom do + begin + SrcLine:=ABuffer.ScanLine[y]; + DstLine:=ABitmap.ScanLine[y+Offset.y]; + + Move(pointer(integer(SrcLine) + 3*ClippedSrcRect.left)^, + pointer(integer(DstLine) + 3*(ClippedSrcRect.left + Offset.x))^, + 3*ClippedSrcRect.Width); + end; +end; + +class procedure TGUITools.CopyCorner(ABuffer : TBitmap; ABitmap: TBitmap; + SrcPoint, DstPoint: T2DIntVector; Radius: integer); + +begin +CopyRectangle(ABuffer, ABitmap, SrcPoint, DstPoint, Radius, Radius); +end; + +class procedure TGUITools.CopyCorner(ABuffer, ABitmap: TBitmap; SrcPoint, + DstPoint: T2DIntVector; Radius: integer; ClipRect: T2DIntRect); +begin +CopyRectangle(ABuffer, ABitmap, SrcPoint, DstPoint, Radius, Radius, ClipRect); +end; + +class procedure TGUITools.CopyMaskRectangle(ABuffer, AMask, ABitmap: TBitmap; + SrcPoint, DstPoint: T2DIntVector; Width, Height: integer); + +var BufferRect, BitmapRect : T2DIntRect; + SrcRect, DstRect : T2DIntRect; + ClippedSrcRect : T2DIntRect; + Offset : T2DIntVector; + y: Integer; + SrcLine: Pointer; + MaskLine: Pointer; + DstLine: Pointer; + i: Integer; + +begin +if (ABuffer.PixelFormat<>pf24bit) or (ABitmap.PixelFormat<>pf24bit) then + raise exception.create('TSpkGUITools.CopyRoundCorner: Tylko 24-bitowe bitmapy są akceptowane!'); + +if (AMask.PixelFormat<>pf8bit) then + raise exception.create('TSpkGUITools.CopyRoundCorner: Tylko 8-bitowe maski są akceptowane!'); + +// Sprawdzanie poprawności +if (Width<1) or (Height<1) then + exit; + +if (ABuffer.width=0) or (ABuffer.height=0) or + (ABitmap.width=0) or (ABitmap.height=0) then exit; + +if (ABuffer.Width<>AMask.Width) or + (ABuffer.Height<>AMask.Height) then exit; + +// Przycinamy źródłowy rect do obszaru źródłowej bitmapy +BufferRect:=T2DIntRect.create(0, 0, ABuffer.width-1, ABuffer.height-1); + +if not(BufferRect.IntersectsWith(T2DIntRect.create(SrcPoint.x, + SrcPoint.y, + SrcPoint.x+Width-1, + SrcPoint.y+Height-1), + SrcRect)) then exit; + +// Przycinamy docelowy rect do obszaru docelowej bitmapy +BitmapRect:=T2DIntRect.create(0, 0, ABitmap.width-1, ABitmap.height-1); +if not(BitmapRect.IntersectsWith(T2DIntRect.create(DstPoint.x, + DstPoint.y, + DstPoint.x+Width-1, + DstPoint.y+Height-1), + DstRect)) then exit; + +// Liczymy offset źródłowego do docelowego recta +Offset:=DstPoint - SrcPoint; + +// Sprawdzamy, czy nałożone na siebie recty: źródłowy i docelowy przesunięty o +// offset mają jakąś część wspólną +if not(SrcRect.IntersectsWith(DstRect - Offset, ClippedSrcRect)) then exit; + +// Jeśli jest cokolwiek do przetworzenia, wykonaj operację +if (ClippedSrcRect.left<=ClippedSrcRect.right) and (ClippedSrcRect.top<=ClippedSrcRect.bottom) then + for y := ClippedSrcRect.top to ClippedSrcRect.bottom do + begin + SrcLine:=ABuffer.ScanLine[y]; + SrcLine:=pointer(integer(SrcLine) + 3 * ClippedSrcRect.left); + + MaskLine:=AMask.ScanLine[y]; + MaskLine:=pointer(integer(MaskLine) + ClippedSrcRect.left); + + DstLine:=ABitmap.ScanLine[y+Offset.y]; + DstLine:=pointer(integer(DstLine) + 3 * (ClippedSrcRect.left + Offset.x)); + + for i := 0 to ClippedSrcRect.Width - 1 do + begin + if PByte(MaskLine)^<128 then + Move(SrcLine^,DstLine^,3); + + SrcLine:=pointer(integer(SrcLine)+3); + DstLine:=pointer(integer(DstLine)+3); + MaskLine:=pointer(integer(MaskLine)+1); + end; + end; +end; + +class procedure TGUITools.CopyMaskRectangle(ABuffer, AMask, ABitmap: TBitmap; + SrcPoint, DstPoint: T2DIntVector; Width, Height: integer; + ClipRect: T2DIntRect); + +var BufferRect, BitmapRect : T2DIntRect; + SrcRect, DstRect : T2DIntRect; + ClippedSrcRect, ClippedDstRect : T2DIntRect; + Offset : T2DIntVector; + y: Integer; + SrcLine: Pointer; + DstLine: Pointer; + i: Integer; + MaskLine: Pointer; + +begin +if (ABuffer.PixelFormat<>pf24bit) or (ABitmap.PixelFormat<>pf24bit) then + raise exception.create('TSpkGUITools.CopyMaskRectangle: Tylko 24-bitowe bitmapy są akceptowane!'); +if AMask.PixelFormat<>pf8bit then + raise exception.create('TSpkGUITools.CopyMaskRectangle: Tylko 8-bitowe maski są akceptowane!'); + +// Sprawdzanie poprawności +if (Width<1) or (Height<1) then + exit; + +if (ABuffer.width=0) or (ABuffer.height=0) or + (ABitmap.width=0) or (ABitmap.height=0) then exit; + +if (ABuffer.Width<>AMask.Width) or + (ABuffer.Height<>AMask.Height) then + raise exception.create('TSpkGUITools.CopyMaskRectangle: Maska ma nieprawidłowe rozmiary!'); + +// Przycinamy źródłowy rect do obszaru źródłowej bitmapy +BufferRect:=T2DIntRect.create(0, 0, ABuffer.width-1, ABuffer.height-1); +if not(BufferRect.IntersectsWith(T2DIntRect.create(SrcPoint.x, + SrcPoint.y, + SrcPoint.x+Width-1, + SrcPoint.y+Height-1), + SrcRect)) then exit; + +// Przycinamy docelowy rect do obszaru docelowej bitmapy +BitmapRect:=T2DIntRect.create(0, 0, ABitmap.width-1, ABitmap.height-1); +if not(BitmapRect.IntersectsWith(T2DIntRect.create(DstPoint.x, + DstPoint.y, + DstPoint.x+Width-1, + DstPoint.y+Height-1), + DstRect)) then exit; + +// Dodatkowo przycinamy docelowy rect +if not(DstRect.IntersectsWith(ClipRect, ClippedDstRect)) then + Exit; + +// Liczymy offset źródłowego do docelowego recta +Offset:=DstPoint - SrcPoint; + +// Sprawdzamy, czy nałożone na siebie recty: źródłowy i docelowy przesunięty o +// offset mają jakąś część wspólną +if not(SrcRect.IntersectsWith(ClippedDstRect - Offset, ClippedSrcRect)) then exit; + +// Jeśli jest cokolwiek do przetworzenia, wykonaj operację +if (ClippedSrcRect.left<=ClippedSrcRect.right) and (ClippedSrcRect.top<=ClippedSrcRect.bottom) then + for y := ClippedSrcRect.top to ClippedSrcRect.bottom do + begin + SrcLine:=ABuffer.ScanLine[y]; + SrcLine:=pointer(integer(SrcLine) + 3 * ClippedSrcRect.left); + + MaskLine:=AMask.ScanLine[y]; + MaskLine:=pointer(integer(MaskLine) + ClippedSrcRect.left); + + DstLine:=ABitmap.ScanLine[y+Offset.y]; + DstLine:=pointer(integer(DstLine) + 3 * (ClippedSrcRect.left + Offset.x)); + + for i := 0 to ClippedSrcRect.width - 1 do + begin + if PByte(MaskLine)^<128 then + Move(SrcLine^, DstLine^, 3); + + SrcLine:=pointer(integer(SrcLine)+3); + DstLine:=pointer(integer(DstLine)+3); + MaskLine:=pointer(integer(MaskLine)+1); + end; + end; +end; + +class procedure TGUITools.CopyRectangle(ABuffer, ABitmap: TBitmap; SrcPoint, + DstPoint: T2DIntVector; Width, Height: integer; ClipRect: T2DIntRect); + +var BufferRect, BitmapRect : T2DIntRect; + SrcRect, DstRect : T2DIntRect; + ClippedSrcRect, ClippedDstRect : T2DIntRect; + Offset : T2DIntVector; + y: Integer; + SrcLine: Pointer; + DstLine: Pointer; + +begin +if (ABuffer.PixelFormat<>pf24bit) or (ABitmap.PixelFormat<>pf24bit) then + raise exception.create('TSpkGUITools.CopyRoundCorner: Tylko 24-bitowe bitmapy są akceptowane!'); + +// Sprawdzanie poprawności +if (Width<1) or (Height<1) then + exit; + +if (ABuffer.width=0) or (ABuffer.height=0) or + (ABitmap.width=0) or (ABitmap.height=0) then exit; + +// Przycinamy źródłowy rect do obszaru źródłowej bitmapy +BufferRect:=T2DIntRect.create(0, 0, ABuffer.width-1, ABuffer.height-1); +if not(BufferRect.IntersectsWith(T2DIntRect.create(SrcPoint.x, + SrcPoint.y, + SrcPoint.x+Width-1, + SrcPoint.y+Height-1), + SrcRect)) then exit; + +// Przycinamy docelowy rect do obszaru docelowej bitmapy +BitmapRect:=T2DIntRect.create(0, 0, ABitmap.width-1, ABitmap.height-1); +if not(BitmapRect.IntersectsWith(T2DIntRect.create(DstPoint.x, + DstPoint.y, + DstPoint.x+Width-1, + DstPoint.y+Height-1), + DstRect)) then exit; + +// Dodatkowo przycinamy docelowy rect +if not(DstRect.IntersectsWith(ClipRect, ClippedDstRect)) then + Exit; + +// Liczymy offset źródłowego do docelowego recta +Offset:=DstPoint - SrcPoint; + +// Sprawdzamy, czy nałożone na siebie recty: źródłowy i docelowy przesunięty o +// offset mają jakąś część wspólną +if not(SrcRect.IntersectsWith(ClippedDstRect - Offset, ClippedSrcRect)) then exit; + +// Jeśli jest cokolwiek do przetworzenia, wykonaj operację +if (ClippedSrcRect.left<=ClippedSrcRect.right) and (ClippedSrcRect.top<=ClippedSrcRect.bottom) then + for y := ClippedSrcRect.top to ClippedSrcRect.bottom do + begin + SrcLine:=ABuffer.ScanLine[y]; + DstLine:=ABitmap.ScanLine[y+Offset.y]; + + Move(pointer(integer(SrcLine) + 3*ClippedSrcRect.left)^, + pointer(integer(DstLine) + 3*(ClippedSrcRect.left + Offset.x))^, + 3*ClippedSrcRect.Width); + end; +end; + +class procedure TGUITools.CopyRoundCorner(ABuffer: TBitmap; ABitmap: TBitmap; + SrcPoint, DstPoint: T2DIntVector; Radius: integer; CornerPos: TCornerPos; + Convex: boolean); + +var BufferRect, BitmapRect : T2DIntRect; + OrgSrcRect, OrgDstRect : T2DIntRect; + SrcRect : T2DIntRect; + Offset : T2DIntVector; + Center: T2DIntVector; + y: Integer; + SrcLine: Pointer; + DstLine: Pointer; + SrcPtr, DstPtr : PByte; + x: Integer; + Dist : double; + +begin +if (ABuffer.PixelFormat<>pf24bit) or (ABitmap.PixelFormat<>pf24bit) then + raise exception.create('TSpkGUITools.CopyRoundCorner: Tylko 24-bitowe bitmapy są akceptowane!'); + +// Sprawdzanie poprawności +if Radius<1 then + exit; + +if (ABuffer.width=0) or (ABuffer.height=0) or + (ABitmap.width=0) or (ABitmap.height=0) then exit; + +BufferRect:=T2DIntRect.create(0, 0, ABuffer.width-1, ABuffer.height-1); +if not(BufferRect.IntersectsWith(T2DIntRect.create(SrcPoint.x, + SrcPoint.y, + SrcPoint.x+Radius-1, + SrcPoint.y+Radius-1), + OrgSrcRect)) then exit; + +BitmapRect:=T2DIntRect.create(0, 0, ABitmap.width-1, ABitmap.height-1); +if not(BitmapRect.IntersectsWith(T2DIntRect.create(DstPoint.x, + DstPoint.y, + DstPoint.x+Radius-1, + DstPoint.y+Radius-1), + OrgDstRect)) then exit; + +Offset:=DstPoint - SrcPoint; + +if not(OrgSrcRect.IntersectsWith(OrgDstRect - Offset, SrcRect)) then exit; + +// Ustalamy pozycję środka łuku + +case CornerPos of + cpLeftTop: Center:=T2DIntVector.create(SrcPoint.x + radius - 1, SrcPoint.y + Radius - 1); + cpRightTop: Center:=T2DIntVector.create(SrcPoint.x, SrcPoint.y + Radius - 1); + cpLeftBottom: Center:=T2DIntVector.Create(SrcPoint.x + radius - 1, SrcPoint.y); + cpRightBottom: Center:=T2DIntVector.Create(SrcPoint.x, SrcPoint.y); +end; + +// Czy jest cokolwiek do przetworzenia? +if Convex then + begin + if (SrcRect.left<=SrcRect.right) and (SrcRect.top<=SrcRect.bottom) then + for y := SrcRect.top to SrcRect.bottom do + begin + SrcLine:=ABuffer.ScanLine[y]; + DstLine:=ABitmap.ScanLine[y+Offset.y]; + + SrcPtr:=pointer(integer(SrcLine) + 3*SrcRect.left); + DstPtr:=pointer(integer(DstLine) + 3*(SrcRect.left + Offset.x)); + for x := SrcRect.left to SrcRect.right do + begin + Dist:=Center.DistanceTo(T2DVector.create(x, y)); + if Dist <= (Radius-1) then + Move(SrcPtr^,DstPtr^,3); + + inc(SrcPtr,3); + inc(DstPtr,3); + end; + end; + end +else + begin + if (SrcRect.left<=SrcRect.right) and (SrcRect.top<=SrcRect.bottom) then + for y := SrcRect.top to SrcRect.bottom do + begin + SrcLine:=ABuffer.ScanLine[y]; + DstLine:=ABitmap.ScanLine[y+Offset.y]; + + SrcPtr:=pointer(integer(SrcLine) + 3*SrcRect.left); + DstPtr:=pointer(integer(DstLine) + 3*(SrcRect.left + Offset.x)); + for x := SrcRect.left to SrcRect.right do + begin + Dist:=Center.DistanceTo(T2DVector.create(x, y)); + if Dist >= (Radius-1) then + Move(SrcPtr^,DstPtr^,3); + + inc(SrcPtr,3); + inc(DstPtr,3); + end; + end; + end; +end; + +class procedure TGUITools.DrawAARoundCorner(ABitmap: TBitmap; Point: T2DIntVector; + Radius: integer; CornerPos: TCornerPos; Color: TColor); + +var CornerRect : T2DIntRect; + Center : T2DIntVector; + Line : PByte; + Ptr : PByte; + colorR, colorG, colorB : byte; + x, y : integer; + RadiusDist : double; + OrgCornerRect: T2DIntRect; + BitmapRect: T2DIntRect; + +begin +if ABitmap.PixelFormat<>pf24bit then + raise exception.create('TSpkGUITools.DrawAARoundCorner: Bitmapa musi być w trybie 24-bitowym!'); + +// Sprawdzamy poprawność +if Radius<1 then + exit; +if (ABitmap.width=0) or (ABitmap.height=0) then + exit; + +// Źródłowy rect... +OrgCornerRect:=T2DIntRect.create(Point.x, + Point.y, + Point.x + radius - 1, + Point.y + radius - 1); + +// ...przycinamy do rozmiarów bitmapy +BitmapRect:=T2DIntRect.create(0, 0, ABitmap.width-1, ABitmap.height-1); +if not(BitmapRect.intersectsWith(OrgCornerRect, CornerRect)) then + exit; + +// Jeśli nie ma czego rysować, wychodzimy +if (CornerRect.left>CornerRect.right) or (CornerRect.top>CornerRect.bottom) then + exit; + +// Szukamy środka łuku - zależnie od rodzaju narożnika +case CornerPos of + cpLeftTop: Center:=T2DIntVector.create(Point.x + radius - 1, Point.y + Radius - 1); + cpRightTop: Center:=T2DIntVector.create(Point.x, Point.y + Radius - 1); + cpLeftBottom: Center:=T2DIntVector.Create(Point.x + radius - 1, Point.y); + cpRightBottom: Center:=T2DIntVector.Create(Point.x, Point.y); +end; + +Color:=ColorToRGB(Color); + +colorR:=GetRValue(Color); +colorG:=GetGValue(Color); +ColorB:=GetBValue(Color); + +for y := CornerRect.top to CornerRect.bottom do + begin + Line:=ABitmap.ScanLine[y]; + for x := CornerRect.left to CornerRect.right do + begin + RadiusDist:=1 - abs((Radius - 1) - Center.DistanceTo(T2DIntVector.create(x, y))); + if RadiusDist>0 then + begin + Ptr:=pointer(integer(Line) + 3*x); + Ptr^:=round(Ptr^ + (ColorB - Ptr^) * RadiusDist); inc(Ptr); + Ptr^:=round(Ptr^ + (ColorG - Ptr^) * RadiusDist); inc(Ptr); + Ptr^:=round(Ptr^ + (ColorR - Ptr^) * RadiusDist); + end; + end; + end; +end; + +class procedure TGUITools.DrawAARoundCorner(ABitmap: TBitmap; + Point: T2DIntVector; Radius: integer; CornerPos: TCornerPos; Color: TColor; + ClipRect: T2DIntRect); + +var CornerRect : T2DIntRect; + Center : T2DIntVector; + Line : PByte; + Ptr : PByte; + colorR, colorG, colorB : byte; + x, y : integer; + RadiusDist : double; + OrgCornerRect: T2DIntRect; + UnClippedCornerRect : T2DIntRect; + BitmapRect: T2DIntRect; + +begin +if ABitmap.PixelFormat<>pf24bit then + raise exception.create('TSpkGUITools.DrawAARoundCorner: Bitmapa musi być w trybie 24-bitowym!'); + +// Sprawdzamy poprawność +if Radius<1 then + exit; +if (ABitmap.width=0) or (ABitmap.height=0) then + exit; + +// Źródłowy rect... +OrgCornerRect:=T2DIntRect.create(Point.x, + Point.y, + Point.x + radius - 1, + Point.y + radius - 1); + +// ...przycinamy do rozmiarów bitmapy +BitmapRect:=T2DIntRect.create(0, 0, ABitmap.width-1, ABitmap.height-1); +if not(BitmapRect.intersectsWith(OrgCornerRect, UnClippedCornerRect)) then + exit; + +// ClipRect +if not(UnClippedCornerRect.IntersectsWith(ClipRect, CornerRect)) then + exit; + +// Jeśli nie ma czego rysować, wychodzimy +if (CornerRect.left>CornerRect.right) or (CornerRect.top>CornerRect.bottom) then + exit; + +// Szukamy środka łuku - zależnie od rodzaju narożnika +case CornerPos of + cpLeftTop: Center:=T2DIntVector.create(Point.x + radius - 1, Point.y + Radius - 1); + cpRightTop: Center:=T2DIntVector.create(Point.x, Point.y + Radius - 1); + cpLeftBottom: Center:=T2DIntVector.Create(Point.x + radius - 1, Point.y); + cpRightBottom: Center:=T2DIntVector.Create(Point.x, Point.y); +end; + +Color:=ColorToRGB(Color); + +colorR:=GetRValue(Color); +colorG:=GetGValue(Color); +ColorB:=GetBValue(Color); + +for y := CornerRect.top to CornerRect.bottom do + begin + Line:=ABitmap.ScanLine[y]; + for x := CornerRect.left to CornerRect.right do + begin + RadiusDist:=1 - abs((Radius - 1) - Center.DistanceTo(T2DIntVector.create(x, y))); + if RadiusDist>0 then + begin + Ptr:=pointer(integer(Line) + 3*x); + Ptr^:=round(Ptr^ + (ColorB - Ptr^) * RadiusDist); inc(Ptr); + Ptr^:=round(Ptr^ + (ColorG - Ptr^) * RadiusDist); inc(Ptr); + Ptr^:=round(Ptr^ + (ColorR - Ptr^) * RadiusDist); + end; + end; + end; +end; + +class procedure TGUITools.DrawAARoundCorner(ACanvas: TCanvas; + Point: T2DIntVector; Radius: integer; CornerPos: TCornerPos; Color: TColor); + +var Center : T2DIntVector; + OrgColor : TColor; + x, y : integer; + RadiusDist : double; + CornerRect: T2DIntRect; + +begin +// Sprawdzamy poprawność +if Radius<1 then + exit; + +// Źródłowy rect... +CornerRect:=T2DIntRect.create(Point.x, + Point.y, + Point.x + radius - 1, + Point.y + radius - 1); + +// Szukamy środka łuku - zależnie od rodzaju narożnika +case CornerPos of + cpLeftTop: Center:=T2DIntVector.create(Point.x + radius - 1, Point.y + Radius - 1); + cpRightTop: Center:=T2DIntVector.create(Point.x, Point.y + Radius - 1); + cpLeftBottom: Center:=T2DIntVector.Create(Point.x + radius - 1, Point.y); + cpRightBottom: Center:=T2DIntVector.Create(Point.x, Point.y); +end; + +Color:=ColorToRGB(Color); + +for y := CornerRect.top to CornerRect.bottom do + begin + for x := CornerRect.left to CornerRect.right do + begin + RadiusDist:=1 - abs((Radius - 1) - Center.DistanceTo(T2DIntVector.create(x, y))); + if RadiusDist>0 then + begin + OrgColor:=ACanvas.Pixels[x, y]; + ACanvas.Pixels[x, y]:=TColorTools.Shade(OrgColor, Color, RadiusDist); + end; + end; + end; +end; + +class procedure TGUITools.DrawAARoundCorner(ACanvas: TCanvas; + Point: T2DIntVector; Radius: integer; CornerPos: TCornerPos; Color: TColor; + ClipRect: T2DIntRect); + +var UseOrgClipRgn : boolean; + ClipRgn : HRGN; + OrgRgn : HRGN; + +begin +// Zapamiętywanie oryginalnego ClipRgn i ustawianie nowego +SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn); + +ClipRgn:=CreateRectRgn(ClipRect.left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1); +if UseOrgClipRgn then + CombineRgn(ClipRgn, ClipRgn, OrgRgn, RGN_AND); + +SelectClipRgn(ACanvas.Handle, ClipRgn); + +DrawAARoundCorner(ACanvas, Point, Radius, CornerPos, Color); + +// Przywracanie poprzedniego ClipRgn i usuwanie wykorzystanych regionów +RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn); +DeleteObject(ClipRgn); +end; + +class procedure TGUITools.DrawAARoundFrame(ABitmap: TBitmap; Rect: T2DIntRect; + Radius: integer; Color: TColor; ClipRect: T2DIntRect); +begin +if ABitmap.PixelFormat<>pf24bit then + raise exception.create('TGUITools.DrawAARoundFrame: Bitmapa musi być w trybie 24-bitowym!'); + +if (Radius<1) then + exit; + +if (Radius>Rect.width div 2) or (Radius>Rect.height div 2) then + exit; + +// DrawAARoundCorner jest zabezpieczony przed rysowaniem poza obszarem +DrawAARoundCorner(ABitmap, T2DIntVector.create(Rect.left, Rect.top), Radius, cpLeftTop, Color, ClipRect); +DrawAARoundCorner(ABitmap, T2DIntVector.create(Rect.right - Radius + 1, Rect.top), Radius, cpRightTop, Color, ClipRect); +DrawAARoundCorner(ABitmap, T2DIntVector.create(Rect.left, Rect.bottom - Radius + 1), Radius, cpLeftBottom, Color, ClipRect); +DrawAARoundCorner(ABitmap, T2DIntVector.create(Rect.Right - Radius + 1, Rect.Bottom - Radius + 1), Radius, cpRightBottom, Color, ClipRect); + +ABitmap.Canvas.Pen.color:=Color; +ABitmap.Canvas.pen.style:=psSolid; + +// Draw*Line są zabezpieczone przed rysowaniem poza obszarem +DrawVLine(ABitmap, Rect.left, rect.top + Radius, rect.bottom - Radius, Color, ClipRect); +DrawVLine(ABitmap, Rect.right, rect.top + Radius, rect.bottom - Radius, Color, ClipRect); +DrawHLine(ABitmap, Rect.left + Radius, Rect.right - Radius, rect.top, Color, ClipRect); +DrawHLine(ABitmap, Rect.left + Radius, Rect.right - Radius, rect.bottom, Color, ClipRect); +end; + +class procedure TGUITools.DrawAARoundFrame(ABitmap: TBitmap; Rect: T2DIntRect; + Radius: integer; Color: TColor); + +begin +if ABitmap.PixelFormat<>pf24bit then + raise exception.create('TGUITools.DrawAARoundFrame: Bitmapa musi być w trybie 24-bitowym!'); + +if (Radius<1) then + exit; + +if (Radius>Rect.width div 2) or (Radius>Rect.height div 2) then + exit; + +// DrawAARoundCorner jest zabezpieczony przed rysowaniem poza obszarem +DrawAARoundCorner(ABitmap, T2DIntVector.create(Rect.left, Rect.top), Radius, cpLeftTop, Color); +DrawAARoundCorner(ABitmap, T2DIntVector.create(Rect.right - Radius + 1, Rect.top), Radius, cpRightTop, Color); +DrawAARoundCorner(ABitmap, T2DIntVector.create(Rect.left, Rect.bottom - Radius + 1), Radius, cpLeftBottom, Color); +DrawAARoundCorner(ABitmap, T2DIntVector.create(Rect.Right - Radius + 1, Rect.Bottom - Radius + 1), Radius, cpRightBottom, Color); + +ABitmap.canvas.Pen.color:=Color; +ABitmap.canvas.pen.style:=psSolid; + +// Draw*Line są zabezpieczone przed rysowaniem poza obszarem +DrawVLine(ABitmap, Rect.left, rect.top + Radius, rect.bottom - Radius, Color); +DrawVLine(ABitmap, Rect.right, rect.top + Radius, rect.bottom - Radius, Color); +DrawHLine(ABitmap, Rect.left + Radius, Rect.right - Radius, rect.top, Color); +DrawHLine(ABitmap, Rect.left + Radius, Rect.right - Radius, rect.bottom, Color); +end; + +class procedure TGUITools.DrawFitWText(ABitmap: TBitmap; x1, x2, y: integer; + AText: string; TextColor: TColor; Align : TAlignment); + +var tw : integer; + s : string; + +begin +with ABitmap.Canvas do + begin + s:=AText; + tw:=TextWidth(s); + // Jeśli tekst się zmieści, rysujemy + if tw<=(x2-x1+1) then + case Align of + taLeftJustify : TextOut(x1,y,AText); + taRightJustify : TextOut(x2-tw+1,y,AText); + taCenter : TextOut(x1 + ((x2-x1 - tw) div 2), y, AText); + end + else + begin + while (s<>'') and (tw>(x2-x1+1)) do + begin + delete(s,length(s),1); + tw:=TextWidth(s+'...'); + end; + if tw<=(x2-x1+1) then + TextOut(x1, y, s+'...'); + end; + end; +end; + +class procedure TGUITools.DrawHLine(ACanvas: TCanvas; x1, x2, y: integer; + Color: TColor); + +var tmp : integer; + +begin +if x20 do + begin + if MarkPos>1 then + begin + // Rysowanie tekstu przed wyróżnionym + ACanvas.Font.Style:=ACanvas.Font.Style - [fsBold]; + s:=copy(DrawText, 1, MarkPos-1); + + ACanvas.TextOut(x1, y, s); + inc(x1, ACanvas.TextWidth(s)+1); + + delete(DrawText, 1, MarkPos-1); + delete(BaseText, 1, MarkPos-1); + end; + + // Rysowanie wyróżnionego tekstu + ACanvas.Font.Style:=ACanvas.Font.Style + [fsBold]; + s:=copy(DrawText, 1, MarkTextLength); + + ACanvas.TextOut(x1, y, s); + inc(x1, ACanvas.TextWidth(s)+1); + + delete(DrawText, 1, MarkTextLength); + delete(BaseText, 1, MarkTextLength); + + MarkPos:=pos(MarkText, BaseText); + end; + +if Length(BaseText)>0 then + begin + ACanvas.Font.Style:=ACanvas.Font.Style - [fsBold]; + ACanvas.TextOut(x1, y, DrawText); + end; +end; + +class procedure TGUITools.DrawImage(ACanvas: TCanvas; Imagelist: TImageList; + ImageIndex: integer; Point: T2DIntVector); +begin +ImageList.Draw(ACanvas, Point.x, Point.y, ImageIndex); +end; + +class procedure TGUITools.DrawOutlinedText(ACanvas: TCanvas; x, y: integer; + AText: string; TextColor, OutlineColor: TColor); +begin +with Acanvas do + begin + brush.style:=bsClear; + font.color:=OutlineColor; + TextOut(x-1, y-1, AText); + TextOut(x, y-1, AText); + TextOut(x+1, y-1, AText); + TextOut(x-1, y, AText); + TextOut(x+1, y, AText); + TextOut(x-1, y+1, AText); + TextOut(x, y+1, AText); + TextOut(x+1, y+1, AText); + + font.color:=TextColor; + TextOut(x, y, AText); + end; +end; + +class procedure TGUITools.DrawOutlinedText(ACanvas: TCanvas; x, y: integer; + AText: string; TextColor, OutlineColor: TColor; ClipRect: T2DIntRect); + +var WinAPIClipRect : TRect; + +begin +WinAPIClipRect:=ClipRect.ForWinAPI; +with ACanvas do + begin + brush.style:=bsClear; + font.color:=OutlineColor; + TextRect(WinAPIClipRect, x-1, y-1, AText); + TextRect(WinAPIClipRect, x, y-1, AText); + TextRect(WinAPIClipRect, x+1, y-1, AText); + TextRect(WinAPIClipRect, x-1, y, AText); + TextRect(WinAPIClipRect, x+1, y, AText); + TextRect(WinAPIClipRect, x-1, y+1, AText); + TextRect(WinAPIClipRect, x, y+1, AText); + TextRect(WinAPIClipRect, x+1, y+1, AText); + + font.color:=TextColor; + TextRect(WinAPIClipRect, x, y, AText); + end; +end; + +class procedure TGUITools.DrawHLine(ABitmap: TBitmap; x1, x2, y: integer; + Color: TColor); + +var LineRect : T2DIntRect; + BitmapRect : T2DIntRect; + tmp: Integer; + +begin +if ABitmap.PixelFormat<>pf24bit then + raise exception.create('TGUITools.DrawHLine: Bitmapa musi być w trybie 24-bitowym!'); + +if x2pf24bit then + raise exception.create('TGUITools.DrawHLine: Bitmapa musi być w trybie 24-bitowym!'); + +if x2Rect.width) or (Radius*2>Rect.height) then + exit; + +// Zapamiętywanie oryginalnego ClipRgn i ustawianie nowego +SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn); + +if not(LeftTopRound) and not(RightTopRound) and not(LeftBottomRound) and not (RightBottomRound) then + begin + RoundRgn:=CreateRectRgn(Rect.Left, Rect.Top, Rect.Right + 1, Rect.Bottom + 1); + end +else + begin + RoundRgn:=CreateRoundRectRgn(Rect.Left, Rect.Top, Rect.Right +2, Rect.Bottom + 2, Radius*2, Radius*2); + + if not(LeftTopRound) then + begin + TmpRgn:=CreateRectRgn(Rect.left, Rect.Top, Rect.left + Radius, Rect.Top + Radius); + CombineRgn(RoundRgn, RoundRgn, TmpRgn, RGN_OR); + DeleteObject(TmpRgn); + end; + + if not(RightTopRound) then + begin + TmpRgn:=CreateRectRgn(Rect.right - Radius + 1, Rect.Top, Rect.Right + 1, Rect.Top + Radius); + CombineRgn(RoundRgn, RoundRgn, TmpRgn, RGN_OR); + DeleteObject(TmpRgn); + end; + + if not(LeftBottomRound) then + begin + TmpRgn:=CreateRectRgn(Rect.left, Rect.Bottom - Radius + 1, Rect.Left + Radius, Rect.Bottom + 1); + CombineRgn(RoundRgn, RoundRgn, TmpRgn, RGN_OR); + DeleteObject(TmpRgn); + end; + + if not(RightBottomRound) then + begin + TmpRgn:=CreateRectRgn(Rect.right - Radius + 1, Rect.Bottom - Radius + 1, Rect.Right + 1, Rect.Bottom + 1); + CombineRgn(RoundRgn, RoundRgn, TmpRgn, RGN_OR); + DeleteObject(TmpRgn); + end; + end; + +if UseOrgClipRgn then + CombineRgn(RoundRgn, RoundRgn, OrgRgn, RGN_AND); + +SelectClipRgn(ACanvas.Handle, RoundRgn); + +ColorFrom:=ColorToRGB(ColorFrom); +ColorTo:=ColorToRGB(ColorTo); + +FillGradientRectangle(ACanvas, Rect, ColorFrom, ColorTo, GradientKind); + +// Przywracanie poprzedniego ClipRgn i usuwanie wykorzystanych regionów +RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn); +DeleteObject(RoundRgn); +end; + +class procedure TGUITools.DrawOutlinedText(ABitmap: TBitmap; x, y: integer; + AText: string; TextColor, OutlineColor: TColor); +begin +with ABitmap.canvas do + begin + brush.style:=bsClear; + font.color:=OutlineColor; + TextOut(x-1, y-1, AText); + TextOut(x, y-1, AText); + TextOut(x+1, y-1, AText); + TextOut(x-1, y, AText); + TextOut(x+1, y, AText); + TextOut(x-1, y+1, AText); + TextOut(x, y+1, AText); + TextOut(x+1, y+1, AText); + + font.color:=TextColor; + TextOut(x, y, AText); + end; +end; + +class procedure TGUITools.DrawText(ABitmap: TBitmap; x, y: integer; + AText: string; TextColor: TColor; ClipRect: T2DIntRect); + +var WinAPIClipRect : TRect; + +begin +WinAPIClipRect:=ClipRect.ForWinAPI; +with ABitmap.canvas do + begin + brush.style:=bsClear; + font.color:=TextColor; + TextRect(WinAPIClipRect, x, y, AText); + end; +end; + +class procedure TGUITools.DrawFitWOutlinedText(ABitmap: TBitmap; x1, x2, y: integer; + AText: string; TextColor, OutlineColor: TColor; Align : TAlignment); + +var tw : integer; + s : string; + +begin +with ABitmap.Canvas do + begin + s:=AText; + tw:=TextWidth(s) + 2; + // Jeśli tekst się zmieści, rysujemy + if tw<=(x2-x1+1) then + case Align of + taLeftJustify : TGUITools.DrawOutlinedText(ABitmap,x1, y, AText, TextColor, OutlineColor); + taRightJustify : TGUITools.DrawOutlinedText(ABitmap,x2-tw+1, y, AText, TextColor, OutlineColor); + taCenter : TGUITools.DrawOutlinedText(ABitmap,x1 + ((x2-x1 - tw) div 2), y, AText, TextColor, OutlineColor); + end + else + begin + while (s<>'') and (tw>(x2-x1+1)) do + begin + delete(s,length(s),1); + tw:=TextWidth(s+'...')+2; + end; + if tw<=(x2-x1+1) then + TGUITools.DrawOutlinedText(ABitmap, x1, y, s+'...', TextColor, OutlineColor); + end; + end; +end; + +class procedure TGUITools.DrawFitWOutlinedText(ACanvas: TCanvas; x1, x2, + y: integer; AText: string; TextColor, OutlineColor: TColor; + Align: TAlignment); + +var tw : integer; + s : string; + +begin +with ACanvas do + begin + s:=AText; + tw:=TextWidth(s) + 2; + // Jeśli tekst się zmieści, rysujemy + if tw<=(x2-x1+1) then + case Align of + taLeftJustify : TGUITools.DrawOutlinedText(ACanvas,x1, y, AText, TextColor, OutlineColor); + taRightJustify : TGUITools.DrawOutlinedText(ACanvas,x2-tw+1, y, AText, TextColor, OutlineColor); + taCenter : TGUITools.DrawOutlinedText(ACanvas,x1 + ((x2-x1 - tw) div 2), y, AText, TextColor, OutlineColor); + end + else + begin + while (s<>'') and (tw>(x2-x1+1)) do + begin + delete(s,length(s),1); + tw:=TextWidth(s+'...')+2; + end; + if tw<=(x2-x1+1) then + TGUITools.DrawOutlinedText(ACanvas, x1, y, s+'...', TextColor, OutlineColor); + end; + end; +end; + +class procedure TGUITools.FillGradientRectangle(ACanvas: TCanvas; Rect: T2DIntRect; ColorFrom: TColor; ColorTo: TColor; GradientKind: TBackgroundKind); +var + Mesh: array of _GRADIENT_RECT; + GradientVertice: array of _TRIVERTEX; + ConcaveColor: TColor; +begin + case GradientKind of + bkSolid: + begin + ACanvas.brush.color := ColorFrom; + ACanvas.fillrect(Rect.ForWinAPI); + end; + bkVerticalGradient, bkHorizontalGradient: + begin + setlength(GradientVertice, 2); + with GradientVertice[0] do + begin + x := Rect.left; + y := Rect.top; + Red := GetRValue(ColorFrom) shl 8; + Green := GetGValue(ColorFrom) shl 8; + Blue := GetBValue(ColorFrom) shl 8; + Alpha := 255 shl 8; + end; + with GradientVertice[1] do + begin + x := Rect.Right + 1; + y := Rect.bottom + 1; + Red := GetRValue(ColorTo) shl 8; + Green := GetGValue(ColorTo) shl 8; + Blue := GetBValue(ColorTo) shl 8; + Alpha := 255 shl 8; + end; + setlength(Mesh, 1); + Mesh[0].UpperLeft := 0; + Mesh[0].LowerRight := 1; + if GradientKind = bkVerticalGradient then + GradientFill(ACanvas.Handle, @GradientVertice[0], 2, @Mesh[0], 1, GRADIENT_FILL_RECT_V) + else + GradientFill(ACanvas.Handle, @GradientVertice[0], 2, @Mesh[0], 1, GRADIENT_FILL_RECT_H); + end; + bkConcave: + begin + ConcaveColor:=TColorTools.Brighten(ColorFrom, 20); + + setlength(GradientVertice, 4); + with GradientVertice[0] do + begin + x := Rect.left; + y := Rect.top; + Red := GetRValue(ColorFrom) shl 8; + Green := GetGValue(ColorFrom) shl 8; + Blue := GetBValue(ColorFrom) shl 8; + Alpha := 255 shl 8; + end; + with GradientVertice[1] do + begin + x := Rect.Right + 1; + y := Rect.Top + (Rect.height) div 4; + Red := GetRValue(ConcaveColor) shl 8; + Green := GetGValue(ConcaveColor) shl 8; + Blue := GetBValue(ConcaveColor) shl 8; + Alpha := 255 shl 8; + end; + with GradientVertice[2] do + begin + x := Rect.left; + y := Rect.Top + (Rect.height) div 4; + Red := GetRValue(ColorTo) shl 8; + Green := GetGValue(ColorTo) shl 8; + Blue := GetBValue(ColorTo) shl 8; + Alpha := 255 shl 8; + end; + with GradientVertice[3] do + begin + x := Rect.Right + 1; + y := Rect.bottom + 1; + Red := GetRValue(ColorFrom) shl 8; + Green := GetGValue(ColorFrom) shl 8; + Blue := GetBValue(ColorFrom) shl 8; + Alpha := 255 shl 8; + end; + setlength(Mesh, 2); + Mesh[0].UpperLeft := 0; + Mesh[0].LowerRight := 1; + Mesh[1].UpperLeft := 2; + Mesh[1].LowerRight := 3; + GradientFill(ACanvas.Handle, @GradientVertice[0], 4, @Mesh[0], 2, GRADIENT_FILL_RECT_V); + end; + end; +end; + +class procedure TGUITools.DrawFitWText(ACanvas: TCanvas; x1, x2, y: integer; + AText: string; TextColor: TColor; Align: TAlignment); + +var tw : integer; + s : string; + +begin +with ACanvas do + begin + s:=AText; + tw:=TextWidth(s); + // Jeśli tekst się zmieści, rysujemy + if tw<=(x2-x1+1) then + case Align of + taLeftJustify : TextOut(x1,y,AText); + taRightJustify : TextOut(x2-tw+1,y,AText); + taCenter : TextOut(x1 + ((x2-x1 - tw) div 2), y, AText); + end + else + begin + while (s<>'') and (tw>(x2-x1+1)) do + begin + delete(s,length(s),1); + tw:=TextWidth(s+'...'); + end; + if tw<=(x2-x1+1) then + TextOut(x1, y, s+'...'); + end; + end; +end; + +class procedure TGUITools.RenderBackground(ABuffer: TBitmap; + Rect: T2DIntRect; Color1, Color2: TColor; BackgroundKind: TBackgroundKind); + +var TempRect : T2DIntRect; + +begin +if ABuffer.PixelFormat<>pf24bit then + raise exception.create('TGUITools.RenderBackground: Bitmapa musi być w trybie 24-bitowym!'); +if (rect.left>rect.right) or (rect.top>rect.bottom) then + exit; + +// Zarówno metoda FillRect jak i WinAPI'owe rysowanie gradientów jest +// zabezpieczone przed rysowaniem poza obszarem płótna. +case BackgroundKind of + bkSolid: begin + ABuffer.Canvas.brush.Color:=Color1; + ABuffer.Canvas.brush.style:=bsSolid; + ABuffer.Canvas.Fillrect(Rect.ForWinAPI); + end; + bkVerticalGradient: begin + TGradientTools.VGradient(ABuffer.canvas, Color1, Color2, Rect.ForWinAPI); + end; + bkHorizontalGradient: begin + TGradientTools.HGradient(ABuffer.canvas, Color1, Color2, Rect.ForWinAPI); + end; + bkConcave: begin + TempRect:=T2DIntRect.create(rect.Left, + rect.top, + rect.right, + rect.Top + (rect.bottom - rect.top) div 4); + TGradientTools.VGradient(ABuffer.Canvas, + Color1, + TColorTools.Shade(Color1, Color2, 20), + TempRect.ForWinAPI + ); + + TempRect:=T2DIntRect.create(rect.Left, + rect.top + (rect.bottom - rect.top) div 4 + 1, + rect.right, + rect.bottom); + TGradientTools.VGradient(ABuffer.Canvas, + Color2, + Color1, + TempRect.ForWinAPI + ); + end; +end; + +end; + +class procedure TGUITools.RestoreClipRgn(DC: HDC; OrgRgnExists: boolean; + var OrgRgn: HRGN); + +begin +if OrgRgnExists then + SelectClipRgn(DC, OrgRgn) else + SelectClipRgn(DC, 0); +DeleteObject(OrgRgn); +end; + +class procedure TGUITools.SaveClipRgn(DC: HDC; var OrgRgnExists: boolean; + var OrgRgn: HRGN); + +var i : integer; + +begin +OrgRgn:=CreateRectRgn(0, 0, 1, 1); +i:=GetClipRgn(DC, OrgRgn); +OrgRgnExists:=(i=1); +end; + +class procedure TGUITools.DrawText(ABitmap: TBitmap; x, y: integer; AText: string; + TextColor: TColor); +begin +with ABitmap.canvas do + begin + brush.style:=bsClear; + font.color:=TextColor; + TextOut(x, y, AText); + end; +end; + +class procedure TGUITools.DrawVLine(ABitmap: TBitmap; x, y1, y2: integer; + Color: TColor); + +var LineRect : T2DIntRect; + BitmapRect : T2DIntRect; + tmp: Integer; + +begin +if ABitmap.PixelFormat<>pf24bit then + raise exception.create('TGUITools.DrawHLine: Bitmapa musi być w trybie 24-bitowym!'); + +if y2pf24bit then + raise exception.create('TGUITools.DrawHLine: Bitmapa musi być w trybie 24-bitowym!'); + +if y2Rect.width div 2) or (Radius>Rect.height div 2) then + exit; + +// DrawAARoundCorner jest zabezpieczony przed rysowaniem poza obszarem +DrawAARoundCorner(ACanvas, T2DIntVector.create(Rect.left, Rect.top), Radius, cpLeftTop, Color); +DrawAARoundCorner(ACanvas, T2DIntVector.create(Rect.right - Radius + 1, Rect.top), Radius, cpRightTop, Color); +DrawAARoundCorner(ACanvas, T2DIntVector.create(Rect.left, Rect.bottom - Radius + 1), Radius, cpLeftBottom, Color); +DrawAARoundCorner(ACanvas, T2DIntVector.create(Rect.Right - Radius + 1, Rect.Bottom - Radius + 1), Radius, cpRightBottom, Color); + +ACanvas.Pen.color:=Color; +ACanvas.pen.style:=psSolid; + +// Draw*Line są zabezpieczone przed rysowaniem poza obszarem +DrawVLine(ACanvas, Rect.left, rect.top + Radius, rect.bottom - Radius, Color); +DrawVLine(ACanvas, Rect.right, rect.top + Radius, rect.bottom - Radius, Color); +DrawHLine(ACanvas, Rect.left + Radius, Rect.right - Radius, rect.top, Color); +DrawHLine(ACanvas, Rect.left + Radius, Rect.right - Radius, rect.bottom, Color); +end; + +class procedure TGUITools.DrawAARoundFrame(ACanvas: TCanvas; Rect: T2DIntRect; + Radius: integer; Color: TColor; ClipRect: T2DIntRect); + +var UseOrgClipRgn : boolean; + ClipRgn : HRGN; + OrgRgn : HRGN; + +begin +// Zapamiętywanie oryginalnego ClipRgn i ustawianie nowego +SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn); + +ClipRgn:=CreateRectRgn(ClipRect.left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1); +if UseOrgClipRgn then + CombineRgn(ClipRgn, ClipRgn, OrgRgn, RGN_AND); + +SelectClipRgn(ACanvas.Handle, ClipRgn); + +DrawAARoundFrame(ACanvas, Rect, Radius, Color); + +// Przywracanie poprzedniego ClipRgn i usuwanie wykorzystanych regionów +RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn); +DeleteObject(ClipRgn); +end; + +class procedure TGUITools.DrawDisabledImage(ABitmap: TBitmap; + Imagelist: TImageList; ImageIndex: integer; Point: T2DIntVector; + ClipRect: T2DIntRect); +begin +DrawDisabledImage(ABitmap.Canvas, ImageList, ImageIndex, Point, ClipRect); +end; + +class procedure TGUITools.DrawDisabledImage(ABitmap: TBitmap; + Imagelist: TImageList; ImageIndex: integer; Point: T2DIntVector); +begin +DrawDisabledImage(ABitmap.Canvas, ImageList, ImageIndex, Point); +end; + +class procedure TGUITools.DrawDisabledImage(ACanvas: TCanvas; + Imagelist: TImageList; ImageIndex: integer; Point: T2DIntVector; + ClipRect: T2DIntRect); + +var UseOrgClipRgn: Boolean; + OrgRgn: HRGN; + ClipRgn: HRGN; + DCStackPos : integer; + +begin +// Zapamiętywanie oryginalnego ClipRgn i ustawianie nowego +SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn); + +ClipRgn:=CreateRectRgn(ClipRect.left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1); +if UseOrgClipRgn then + CombineRgn(ClipRgn, ClipRgn, OrgRgn, RGN_AND); + +SelectClipRgn(ACanvas.Handle, ClipRgn); + +// Hack poprawiający błąd w ImageList.Draw, który nie przywraca poprzedniego +// koloru czcionki dla płótna +DcStackPos:=SaveDC(ACanvas.Handle); +ImageList.Draw(ACanvas, Point.x, Point.y, ImageIndex, false); +RestoreDC(ACanvas.Handle, DcStackPos); + +RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn); + +DeleteObject(ClipRgn); +end; + +class procedure TGUITools.DrawDisabledImage(ACanvas: TCanvas; + Imagelist: TImageList; ImageIndex: integer; Point: T2DIntVector); + +var DCStackPos : integer; + +begin +DcStackPos:=SaveDC(ACanvas.Handle); +ImageList.Draw(ACanvas, Point.x, Point.y, ImageIndex, false); +RestoreDC(ACanvas.Handle, DcStackPos); +end; + +end. diff --git a/components/spktoolbar/SpkGraphTools/SpkGraphTools.pas b/components/spktoolbar/SpkGraphTools/SpkGraphTools.pas new file mode 100644 index 000000000..c86616611 --- /dev/null +++ b/components/spktoolbar/SpkGraphTools/SpkGraphTools.pas @@ -0,0 +1,555 @@ +unit SpkGraphTools; + +{$DEFINE SPKGRAPHTOOLS} + +interface + +uses Windows, Graphics, Classes, Math, Sysutils, Dialogs, + SpkMath; + +const NUM_ZERO = 0.00000001; + +(******************************************************************************* +* * +* Proste struktury * +* * +*******************************************************************************) + +type // Wskaźnik do tablicy TRGBTriple + PRGBTripleArray = ^TRGBTripleArray; + // Tablica TRGBTriple (używana podczas operacji ze ScanLine) + TRGBTripleArray = array[word] of TRGBTriple; + +type THSLTriple = record + H, S, L : extended; + end; + +type // Typ używany podczas rysowania gradientów + TRIVERTEX = packed record + x,y : DWORD; + Red, + Green, + Blue, + Alpha : Word; + end; + +type // Rodzaj gradientu + TGradientType = (gtVertical, gtHorizontal); + // Rodzaj linii gradientowej (miejsce rozmycia) + TGradientLineShade = (lsShadeStart, lsShadeEnds, lsShadeCenter, lsShadeEnd); + // Rodzaj linii gradientowej (wypukłość) + TGradient3dLine = (glRaised, glLowered); + +(******************************************************************************* +* * +* Nagłówki dla zewnętrznych funkcji * +* * +*******************************************************************************) + +function GradientFill(DC : hDC; pVertex : Pointer; dwNumVertex : DWORD; pMesh : Pointer; dwNumMesh, dwMode: DWORD) : DWord; stdcall; external 'msimg32.dll'; + +(******************************************************************************* +* * +* Klasy narzędziowe * +* * +*******************************************************************************) + +type TColorTools = class(TObject) + private + protected + public + class function Darken(kolor : TColor; percentage : byte) : TColor; + class function Brighten(kolor : TColor; percentage : byte) : TColor; + class function Shade(kol1,kol2 : TColor; percentage : byte) : TColor; overload; + class function Shade(kol1,kol2 : TColor; Step : extended) : TColor; overload; + class function AddColors(c1, c2 : TColor) : TColor; + class function MultiplyColors(c1, c2 : TColor) : TColor; + class function MultiplyColor(color : TColor; scalar : integer) : TColor; overload; + class function MultiplyColor(color : TColor; scalar : extended) : TColor; overload; + class function percent(min, pos, max : integer) : byte; + class function RGB2HSL(ARGB : TRGBTriple) : THSLTriple; + class function HSL2RGB(AHSL : THSLTriple) : TRGBTriple; + class function RgbTripleToColor(ARgbTriple : TRGBTriple) : TColor; + class function ColorToRgbTriple(AColor : TColor) : TRGBTriple; + class function ColorToGrayscale(AColor : TColor) : TColor; + end; + +type TGradientTools = class(TObject) + private + protected + public + class procedure HGradient(canvas : TCanvas; cStart,cEnd : TColor; rect : T2DIntRect); overload; + class procedure HGradient(canvas : TCanvas; cStart,cEnd : TColor; p1, p2 : TPoint); overload; + class procedure HGradient(canvas : TCanvas; cStart,cEnd : TColor; x1,y1,x2,y2 : integer); overload; + + class procedure VGradient(canvas : TCanvas; cStart,cEnd : TColor; rect : T2DIntRect); overload; + class procedure VGradient(canvas : TCanvas; cStart,cEnd : TColor; p1, p2 : TPoint); overload; + class procedure VGradient(canvas : TCanvas; cStart,cEnd : TColor; x1,y1,x2,y2 : integer); overload; + + class procedure Gradient(canvas : TCanvas; cStart,cEnd : TColor; rect : T2DIntRect; GradientType : TGradientType); overload; + class procedure Gradient(canvas : TCanvas; cStart,cEnd : TColor; p1, p2 : TPoint; GradientType : TGradientType); overload; + class procedure Gradient(canvas : TCanvas; cStart,cEnd : TColor; x1,y1,x2,y2 : integer; GradientType : TGradientType); overload; + + class procedure HGradientLine(canvas : TCanvas; cBase, cShade : TColor; x1, x2 , y : integer; ShadeMode : TGradientLineShade); + class procedure VGradientLine(canvas : TCanvas; cBase, cShade : TColor; x, y1 , y2 : integer; ShadeMode : TGradientLineShade); + + class procedure HGradient3dLine(canvas : TCanvas; x1,x2,y : integer; ShadeMode : TGradientLineShade; A3dKind : TGradient3dLine = glLowered); + class procedure VGradient3dLine(canvas : TCanvas; x,y1,y2 : integer; ShadeMode : TGradientLineShade; A3dKind : TGradient3dLine = glLowered); + end; + +type TTextTools = class + private + protected + public + class procedure OutlinedText(Canvas : TCanvas; x, y : integer; text : string); + end; + +implementation + +{ TColorTools } + +class function TColorTools.Darken(kolor : TColor; percentage : byte) : TColor; + +var r,g,b : byte; + +begin +r:=round(GetRValue(ColorToRGB(kolor))*(100-percentage)/100); +g:=round(GetGValue(ColorToRGB(kolor))*(100-percentage)/100); +b:=round(GetBValue(ColorToRGB(kolor))*(100-percentage)/100); +result:=rgb(r,g,b); +end; + +class function TColorTools.Brighten(kolor : TColor; percentage : byte) : TColor; + +var r,g,b : byte; + +begin +r:=round(GetRValue(ColorToRGB(kolor))+( (255-GetRValue(ColorToRGB(kolor)))*(percentage/100) )); +g:=round(GetGValue(ColorToRGB(kolor))+( (255-GetGValue(ColorToRGB(kolor)))*(percentage/100) )); +b:=round(GetBValue(ColorToRGB(kolor))+( (255-GetBValue(ColorToRGB(kolor)))*(percentage/100) )); +result:=rgb(r,g,b); +end; + +class function TColorTools.Shade(kol1,kol2 : TColor; percentage : byte) : TColor; + +var r,g,b : byte; + +begin +r:=round(GetRValue(ColorToRGB(kol1))+( (GetRValue(ColorToRGB(kol2))-GetRValue(ColorToRGB(kol1)))*(percentage/100) )); +g:=round(GetGValue(ColorToRGB(kol1))+( (GetGValue(ColorToRGB(kol2))-GetGValue(ColorToRGB(kol1)))*(percentage/100) )); +b:=round(GetBValue(ColorToRGB(kol1))+( (GetBValue(ColorToRGB(kol2))-GetBValue(ColorToRGB(kol1)))*(percentage/100) )); +result:=rgb(r,g,b); +end; + +class function TColorTools.Shade(kol1,kol2 : TColor; Step : extended) : TColor; + +var r,g,b : byte; + +begin +r:=round(GetRValue(ColorToRGB(kol1))+( (GetRValue(ColorToRGB(kol2))-GetRValue(ColorToRGB(kol1)))*(Step) )); +g:=round(GetGValue(ColorToRGB(kol1))+( (GetGValue(ColorToRGB(kol2))-GetGValue(ColorToRGB(kol1)))*(Step) )); +b:=round(GetBValue(ColorToRGB(kol1))+( (GetBValue(ColorToRGB(kol2))-GetBValue(ColorToRGB(kol1)))*(Step) )); +result:=rgb(r,g,b); +end; + +class function TColorTools.AddColors(c1, c2 : TColor) : TColor; + +begin +result:=rgb(max( 0,min( 255,GetRValue(c1)+GetRValue(c2) ) ), + max( 0,min( 255,GetGValue(c1)+GetGValue(c2) ) ), + max( 0,min( 255,GetBValue(c1)+GetBValue(c2) ) )); +end; + +class function TColorTools.MultiplyColors(c1, c2 : TColor) : TColor; + +begin +result:=rgb(max( 0,min( 255,GetRValue(c1)*GetRValue(c2) ) ), + max( 0,min( 255,GetGValue(c1)*GetGValue(c2) ) ), + max( 0,min( 255,GetBValue(c1)*GetBValue(c2) ) )); +end; + +class function TColorTools.MultiplyColor(color : TColor; scalar : integer) : TColor; + +begin +result:=rgb(max( 0,min( 255,GetRValue(color)*scalar ) ), + max( 0,min( 255,GetGValue(color)*scalar ) ), + max( 0,min( 255,GetBValue(color)*scalar ) )); +end; + +class function TColorTools.MultiplyColor(color : TColor; scalar : extended) : TColor; + +begin +result:=rgb(max( 0,min( 255,round(GetRValue(color)*scalar) ) ), + max( 0,min( 255,round(GetGValue(color)*scalar) ) ), + max( 0,min( 255,round(GetBValue(color)*scalar) ) )); +end; + +class function TColorTools.Percent(min, pos, max : integer) : byte; + +begin +if max=min then result:=max else + result:=round((pos-min)*100/(max-min)); +end; + +{.$MESSAGE WARN 'Porównywanie liczb rzeczywistych? Trzeba poprawić'} +class function TColorTools.RGB2HSL(ARGB : TRGBTriple) : THSLTriple; + +var RGBmin, RGBmax : extended; + R, G, B : extended; + H, S, L : extended; + +begin +R:=ARGB.rgbtRed/255; +G:=ARGB.rgbtGreen/255; +B:=ARGB.rgbtBlue/255; + +RGBmin:=min(R,min(G,B)); +RGBmax:=max(R,min(G,B)); + +H:=0; +if RGBmax=RGBmin then + begin + // H jest nieoznaczone, ale przyjmijmy zero dla sensowności obliczeń + H:=0; + end else +if (R=RGBmax) and (G>=B) then + begin + H:=(pi/3)*((G-B)/(RGBmax-RGBmin))+0; + end else +if (R=RGBmax) and (G0.5) then + begin + S:=((RGBmax-RGBmin)/(2-2*L)); + end; + +result.H:=H/(2*pi); +result.S:=S; +result.L:=L; +end; + +class function TColorTools.HSL2RGB(AHSL : THSLTriple) : TRGBTriple; + +var R, G, B : extended; + TR, TG, TB : extended; + Q, P : extended; + + function ProcessColor(Tc : extended) : extended; + + begin + if (Tc<(1/6)) then + result:=P+((Q-P)*6.0*Tc) else + if (Tc<(1/2)) then + result:=Q else + if (Tc<(2/3)) then + result:=P+((Q-P)*((2/3)-Tc)*6.0) else + result:=P; + end; + +begin +if AHSL.S1) then TR:=TR-1; + + if (TG<0) then TG:=TG+1 else + if (TG>1) then TG:=TG-1; + + if (TB<0) then TB:=TB+1 else + if (TB>1) then TB:=TB-1; + + R:=ProcessColor(TR); + G:=ProcessColor(TG); + B:=ProcessColor(TB); + end; + +result.rgbtRed:=round(255*R); +result.rgbtGreen:=round(255*G); +result.rgbtBlue:=round(255*B); +end; + +class function TColorTools.RgbTripleToColor(ARgbTriple : TRGBTriple) : TColor; + +begin +result:=rgb(ARgbTriple.rgbtRed,ARgbTriple.rgbtGreen,ARgbTriple.rgbtBlue); +end; + +class function TColorTools.ColorToGrayscale(AColor: TColor): TColor; + +var avg : byte; + +begin +avg:=(GetRValue(Acolor) + GetGValue(AColor) + GetBValue(AColor)) div 3; +result:=rgb(avg,avg,avg); +end; + +class function TColorTools.ColorToRgbTriple(AColor : TColor) : TRGBTriple; + +begin +result.rgbtRed:=GetRValue(AColor); +result.rgbtGreen:=GetGValue(AColor); +result.rgbtBlue:=GetBValue(AColor); +end; + +{ TGradientTools } + +class procedure TGradientTools.HGradient(canvas : TCanvas; cStart,cEnd : TColor; rect : T2DIntRect); + +var vert : array[0..1] of TRIVERTEX; + gRect : _GRADIENT_RECT; + Col1,Col2 : TColor; + +begin +Col1:=ColorToRGB(cStart); +Col2:=ColorToRGB(cEnd); +with vert[0] do + begin + x:=rect.left; + y:=rect.top; + Red:=GetRValue(Col1) shl 8; + Green:=GetGValue(Col1) shl 8; + Blue:=GetBValue(Col1) shl 8; + Alpha:=0; + end; + +with vert[1] do + begin + x:=rect.right; + y:=rect.bottom; + Red:=GetRValue(Col2) shl 8; + Green:=GetGValue(Col2) shl 8; + Blue:=GetBValue(Col2) shl 8; + Alpha:=0; + end; + +gRect.UpperLeft:=0; +gRect.LowerRight:=1; +GradientFill(canvas.Handle,@vert,2,@gRect,1,GRADIENT_FILL_RECT_H); +end; + +class procedure TGradientTools.HGradient(canvas : TCanvas; cStart,cEnd : TColor; p1, p2 : TPoint); + +begin +HGradient(canvas,cstart,cend,rect(p1.x,p1.y,p2.x,p2.y)); +end; + +class procedure TGradientTools.HGradient(canvas : TCanvas; cStart,cEnd : TColor; x1,y1,x2,y2 : integer); + +begin +HGradient(canvas,cstart,cend,rect(x1,y1,x2,y2)); +end; + +class procedure TGradientTools.VGradient(canvas : TCanvas; cStart,cEnd : TColor; rect : T2DIntRect); + +var vert : array[0..1] of TRIVERTEX; + gRect : _GRADIENT_RECT; + Col1,Col2 : TColor; + +begin +Col1:=ColorToRGB(cStart); +Col2:=ColorToRGB(cEnd); +with vert[0] do + begin + x:=rect.left; + y:=rect.top; + Red:=GetRValue(Col1) shl 8; + Green:=GetGValue(Col1) shl 8; + Blue:=GetBValue(Col1) shl 8; + Alpha:=0; + end; + +with vert[1] do + begin + x:=rect.right; + y:=rect.bottom; + Red:=GetRValue(Col2) shl 8; + Green:=GetGValue(Col2) shl 8; + Blue:=GetBValue(Col2) shl 8; + Alpha:=0; + end; + +gRect.UpperLeft:=0; +gRect.LowerRight:=1; +GradientFill(canvas.Handle,@vert,2,@gRect,1,GRADIENT_FILL_RECT_V); +end; + +class procedure TGradientTools.VGradient(canvas : TCanvas; cStart,cEnd : TColor; p1, p2 : TPoint); + +begin +VGradient(canvas,cstart,cend,rect(p1.x,p1.y,p2.x,p2.y)); +end; + +class procedure TGradientTools.VGradient(canvas : TCanvas; cStart,cEnd : TColor; x1,y1,x2,y2 : integer); + +begin +VGradient(canvas,cstart,cend,rect(x1,y1,x2,y2)); +end; + +class procedure TGradientTools.Gradient(canvas : TCanvas; cStart,cEnd : TColor; rect : T2DIntRect; GradientType : TGradientType); + +begin +if GradientType=gtVertical then VGradient(canvas, cStart, cEnd, rect) else + HGradient(canvas, cStart, cEnd, rect); +end; + +class procedure TGradientTools.Gradient(canvas : TCanvas; cStart,cEnd : TColor; p1, p2 : TPoint; GradientType : TGradientType); + +begin +if GradientType=gtVertical then VGradient(canvas, cStart, cEnd, p1, p2) else + HGradient(canvas, cStart, cEnd, p1, p2); +end; + +class procedure TGradientTools.Gradient(canvas : TCanvas; cStart,cEnd : TColor; x1,y1,x2,y2 : integer; GradientType : TGradientType); + +begin +if GradientType=gtVertical then VGradient(canvas, cStart, cEnd, x1, y1, x2, y2) else + HGradient(canvas, cStart, cEnd, x1, y1, x2, y2); +end; + +class procedure TGradientTools.HGradientLine(canvas : TCanvas; cBase, cShade : TColor; x1, x2 , y : integer; ShadeMode : TGradientLineShade); + +var i : integer; + +begin +if x1=x2 then exit; +if x1>x2 then + begin + i:=x1; + x1:=x2; + x2:=i; + end; +case ShadeMode of + lsShadeStart : HGradient(canvas,cShade,cBase,rect(x1,y,x2,y+1)); + lsShadeEnds : begin + i:=(x1+x2) div 2; + HGradient(canvas,cShade,cBase,rect(x1,y,i,y+1)); + HGradient(canvas,cBase,cShade,rect(i,y,x2,y+1)); + end; + lsShadeCenter : begin + i:=(x1+x2) div 2; + HGradient(canvas,cBase,cShade,rect(x1,y,i,y+1)); + HGradient(canvas,cShade,cBase,rect(i,y,x2,y+1)); + end; + lsShadeEnd : HGradient(canvas,cBase,cShade,rect(x1,y,x2,y+1)); +end; +end; + +class procedure TGradientTools.VGradientLine(canvas : TCanvas; cBase, cShade : TColor; x, y1 , y2 : integer; ShadeMode : TGradientLineShade); + +var i : integer; + +begin +if y1=y2 then exit; +if y1>y2 then + begin + i:=y1; + y1:=y2; + y2:=i; + end; +case ShadeMode of + lsShadeStart : VGradient(canvas,cShade,cBase,rect(x,y1,x+1,y2)); + lsShadeEnds : begin + i:=(y1+y2) div 2; + VGradient(canvas,cShade,cBase,rect(x,y1,x+1,i)); + VGradient(canvas,cBase,cShade,rect(x,i,x+1,y2)); + end; + lsShadeCenter : begin + i:=(y1+y2) div 2; + VGradient(canvas,cBase,cShade,rect(x,y1,x+1,i)); + VGradient(canvas,cShade,cBase,rect(x,i,x+1,y2)); + end; + lsShadeEnd : VGradient(canvas,cBase,cShade,rect(x,y1,x+1,y2)); +end; +end; + +class procedure TGradientTools.HGradient3dLine(canvas : TCanvas; x1,x2,y : integer; ShadeMode : TGradientLineShade; A3dKind : TGradient3dLine = glLowered); + +begin +if A3dKind = glRaised then + begin + HGradientLine(canvas,clBtnHighlight,clBtnFace,x1,x2,y,ShadeMode); + HGradientLine(canvas,clBtnShadow,clBtnFace,x1,x2,y+1,ShadeMode); + end else + begin + HGradientLine(canvas,clBtnShadow,clBtnFace,x1,x2,y,ShadeMode); + HGradientLine(canvas,clBtnHighlight,clBtnFace,x1,x2,y+1,ShadeMode); + end; +end; + +class procedure TGradientTools.VGradient3dLine(canvas : TCanvas; x,y1,y2 : integer; ShadeMode : TGradientLineShade; A3dKind : TGradient3dLine = glLowered); + +begin +if A3dKind = glLowered then + begin + VGradientLine(canvas,clBtnFace,clBtnHighlight,x,y1,y2,ShadeMode); + VGradientLine(canvas,clBtnFace,clBtnShadow,x+1,y1,y2,ShadeMode); + end else + begin + VGradientLine(canvas,clBtnFace,clBtnShadow,x,y1,y2,ShadeMode); + VGradientLine(canvas,clBtnFace,clBtnHighlight,x+1,y1,y2,ShadeMode); + end; +end; + +{ TTextTools } + +class procedure TTextTools.OutlinedText(Canvas : TCanvas; x, y : integer; text : string); + +var TmpColor : TColor; + TmpBrushStyle : TBrushStyle; + +begin +TmpColor:=Canvas.Font.color; +TmpBrushStyle:=Canvas.Brush.style; + +Canvas.brush.style:=bsClear; + +Canvas.font.color:=clBlack; +Canvas.TextOut(x-1,y,text); +Canvas.TextOut(x+1,y,text); +Canvas.TextOut(x,y-1,text); +Canvas.TextOut(x,y+1,text); + +Canvas.font.color:=TmpColor; +Canvas.TextOut(x,y,text); + +Canvas.Brush.Style:=TmpBrushStyle; +end; + +end. diff --git a/components/spktoolbar/SpkMath/SpkMath.pas b/components/spktoolbar/SpkMath/SpkMath.pas new file mode 100644 index 000000000..d22df2f8d --- /dev/null +++ b/components/spktoolbar/SpkMath/SpkMath.pas @@ -0,0 +1,1378 @@ +unit SpkMath; + +{$DEFINE SPKMATH} + +interface + +{TODO: Zastanowić się, czy wszystkie niejawne casty mają sens} + +uses Windows, Math, SysUtils; + +const NUM_ZERO = 1e-12; + +type TRectCorner = (rcLeftTop, rcRightTop, rcLeftBottom, rcRightBottom); + +type // Dwuwymiarowy wektor o całkowitych współrzędnych + T2DIntVector = record + x, y : integer; + public + constructor Create(Ax, Ay : integer); + class operator Implicit(i : integer) : T2DIntVector; + class operator Explicit(i : integer) : T2DIntVector; + class operator Implicit(vector : T2DIntVector) : string; + class operator Explicit(vector : T2DIntVector) : string; + class operator Implicit(point : TPoint) : T2DIntVector; + class operator Explicit(point : TPoint) : T2DIntVector; + class operator Implicit(vector : T2DIntVector) : TPoint; + class operator Explicit(vector : T2DIntVector) : TPoint; + class operator Positive(vector : T2DIntVector) : T2DIntVector; + class operator Negative(vector : T2DIntVector) : T2DIntVector; + class operator Add(left, right : T2DIntVector) : T2DIntVector; + class operator Subtract(left, right : T2DIntVector) : T2DIntVector; + class operator Multiply(left, right : T2DIntVector) : integer; + class operator Multiply(scalar : integer; right : T2DIntVector) : T2DIntVector; + class operator Multiply(left : T2DIntVector; scalar : integer) : T2DIntVector; + class operator Trunc(value : T2DIntVector) : T2DIntVector; + class operator Round(value : T2DIntVector) : T2DIntVector; + function Length : extended; + function DistanceTo(AVector : T2DIntVector) : double; + end; + +type // Punkt w przestrzeni dwuwymiarowej o całkowitych współrzędnych + T2DIntPoint = T2DIntVector; + +type // Prostokąt w przestrzeni dwuwymiarowej o całkowitych współrzędnych + T2DIntRect = record + public + constructor Create(ALeft, ATop, ARight, ABottom : integer); overload; + constructor Create(ATopLeft : T2DIntVector; ABottomRight : T2DIntVector); overload; + class operator Implicit(ARect : T2DIntRect) : TRect; + class operator Explicit(ARect : T2DIntRect) : TRect; + class operator Implicit(ARect : TRect) : T2DIntRect; + class operator Explicit(ARect : TRect) : T2DIntRect; + class operator Implicit(ARect : T2DIntRect) : string; + class operator Explicit(ARect : T2DIntRect) : string; + class operator Add(ARect : T2DIntRect; AVector : T2DIntVector) : T2DIntRect; + class operator Add(AVector : T2DIntVector; ARect : T2DIntRect) : T2DIntRect; + class operator Subtract(ARect : T2DIntRect; AVector : T2DIntVector) : T2DIntRect; + class operator Subtract(AVector : T2DIntVector; ARect : T2DIntRect) : T2DIntRect; + function Contains(APoint : T2DIntPoint) : boolean; + function IntersectsWith(ARect : T2DIntRect) : boolean; overload; + function IntersectsWith(ARect : T2DIntRect; var Intersection : T2DIntRect) : boolean; overload; + procedure Move(dx, dy : integer); overload; + procedure Move(AVector : T2DIntVector); overload; + function Moved(dx, dy : integer) : T2DIntRect; overload; + function Moved(AVector : T2DIntVector) : T2DIntRect; overload; + function GetVertex(ACorner : TRectCorner) : T2DIntVector; + procedure Split(var LeftTop, RightTop, LeftBottom, RightBottom : T2DIntRect); + procedure ExpandBy(APoint : T2DIntPoint); + function Width : integer; + function Height : integer; + function ForWinAPI : TRect; + + case integer of + 0 : (Left, Top, Right, Bottom : integer); + 1 : (TopLeft : T2DIntVector; BottomRight : T2DIntVector); + end; + +type // Wektor w przestrzeni dwuwymiarowej o rzeczywistych współrzędnych + T2DVector = record + x, y : extended; + public + constructor Create(Ax, Ay : extended); + class operator Implicit(i : integer) : T2DVector; + class operator Explicit(i : integer) : T2DVector; + class operator Implicit(e : extended) : T2DVector; + class operator Explicit(e : extended) : T2DVector; + class operator Implicit(vector : T2DVector) : string; + class operator Explicit(vector : T2DVector) : string; + class operator Implicit(vector : T2DIntVector) : T2DVector; + class operator Explicit(vector : T2DIntVector) : T2DVector; + class operator Implicit(vector : T2DVector) : T2DIntVector; + class operator Explicit(vector : T2DVector) : T2DIntVector; + class operator Positive(vector : T2DVector) : T2DVector; + class operator Negative(vector : T2DVector) : T2DVector; + class operator Add(left, right : T2DVector) : T2DVector; + class operator Subtract(left, right : T2DVector) : T2DVector; + class operator Multiply(left, right : T2DVector) : extended; + class operator Multiply(scalar : extended; right : T2DVector) : T2DVector; + class operator Multiply(left : T2DVector; scalar : extended) : T2DVector; + class operator Divide(left : T2DIntVector; scalar : extended) : T2DVector; + class operator Divide(left : T2DVector; scalar : extended) : T2DVector; + class operator Trunc(vector : T2DVector) : T2DIntVector; + class operator Round(vector : T2DVector) : T2DIntVector; + function Length : extended; + procedure Normalize; + function Normalized : T2DVector; + function UpNormal : T2DVector; + function DownNormal : T2DVector; + procedure ProjectTo(vector : T2DVector); + function ProjectedTo(vector : T2DVector) : T2DVector; + function Scale(dx, dy : extended) : T2DVector; + function LiesInsideCircle(APoint : T2DVector; radius : extended) : boolean; + function OrientationWith(AVector : T2DVector) : integer; + function CrossProductWith(AVector : T2DVector) : extended; + function DistanceFromAxis(APoint : T2DVector; AVector : T2DVector) : extended; + end; + +type // Punkt w przestrzeni dwuwymiarowej o rzeczywistych współrzędnych + T2DPoint = T2DVector; + +type // Prostokąt w przestrzeni dwuwymiarowej o rzeczywistych współrzędnych + T2DRect = record + public + constructor Create(ALeft, ATop, ARight, ABottom : extended); overload; + constructor Create(ATopLeft : T2DVector; ABottomRight : T2DVector); overload; + class operator Implicit(ARect : T2DRect) : TRect; + class operator Explicit(ARect : T2DRect) : TRect; + class operator Implicit(ARect : TRect) : T2DRect; + class operator Explicit(ARect : TRect) : T2DRect; + class operator Implicit(ARect : T2DRect) : T2DIntRect; + class operator Explicit(ARect : T2DRect) : T2DIntRect; + class operator Implicit(ARect : T2DIntRect) : T2DRect; + class operator Explicit(ARect : T2DIntRect) : T2DRect; + class operator Implicit(ARect : T2DRect) : string; + class operator Explicit(ARect : T2DRect) : string; + function Contains(APoint : T2DPoint) : boolean; + function IntersectsWith(ARect : T2DRect) : boolean; + procedure Move(dx, dy : extended); overload; + procedure Move(Vector : T2DVector); overload; + function Moved(dx, dy : extended) : T2DRect; overload; + function Moved(Vector : T2DVector) : T2DRect; overload; + function GetVertex(ACorner : TRectCorner) : T2DVector; + procedure Split(var LeftTop, RightTop, LeftBottom, RightBottom : T2DRect); + procedure ExpandBy(APoint : T2DPoint); + function Width : extended; + function Height : extended; + procedure SetCenteredWidth(ANewWidth : extended); + procedure SetCenteredHeight(ANewHeight : extended); + + case integer of + 0 : (Left, Top, Right, Bottom : extended); + 1 : (TopLeft : T2DVector; BottomRight : T2DVector); + end; + +type // Wektor w przestrzeni trójwymiarowej o rzeczywistych współrzędnych + T3DVector = record + x, y, z : extended; + public + constructor create(Ax, Ay, Az : extended); + class operator Implicit(i : integer) : T3DVector; + class operator Explicit(i : integer) : T3DVector; + class operator Implicit(e : extended) : T3DVector; + class operator Explicit(e : extended) : T3DVector; + class operator Implicit(vector : T2DIntVector) : T3DVector; + class operator Explicit(vector : T2DIntVector) : T3DVector; + class operator Implicit(vector : T2DVector) : T3DVector; + class operator Explicit(vector : T2DVector) : T3DVector; + class operator Implicit(vector : T3DVector) : string; + class operator Explicit(vector : T3DVector) : string; + class operator Negative(vector : T3DVector) : T3DVector; + class operator Positive(vector : T3DVector) : T3DVector; + class operator Add(left, right : T3DVector) : T3DVector; + class operator Subtract(left, right : T3DVector) : T3DVector; + class operator Multiply(left, right : T3DVector) : extended; + class operator Multiply(scalar : extended; right : T3DVector) : T3DVector; + class operator Multiply(left : T3DVector; scalar : extended) : T3DVector; + class operator Divide(left : T3DVector; scalar : extended) : T3DVector; + function Length : extended; + procedure Normalize; + function Normalized : T3DVector; + function UpNormalTo(vector : T3DVector) : T3DVector; + function DownNormalTo(vector : T3DVector) : T3DVector; + procedure ProjectTo(vector : T3DVector); + function ProjectedTo(vector : T3DVector) : T3DVector; + function Scale(dx, dy, dz : extended) : T3DVector; + function LiesInsideSphere(APoint : T3DVector; radius : extended) : boolean; + function DistanceFromAxis(APoint : T3DVector; AVector : T3DVector) : extended; + end; + +implementation + +{ T2DIntVector } + +class operator T2DIntVector.Add(left, right: T2DIntVector): T2DIntVector; +begin +result.x:=left.x+right.x; +result.y:=left.y+right.y; +end; + +constructor T2DIntVector.Create(Ax, Ay: integer); +begin +self.x:=Ax; +self.y:=Ay; +end; + +function T2DIntVector.DistanceTo(AVector: T2DIntVector): double; +begin +result:=sqrt(sqr(self.x - AVector.x) + sqr(self.y - AVector.y)); +end; + +class operator T2DIntVector.Explicit(i: integer): T2DIntVector; +begin +result.x:=i; +result.y:=0; +end; + +class operator T2DIntVector.Explicit(vector: T2DIntVector): string; +begin +result:='[x='+IntToStr(vector.x)+'; y='+IntToStr(vector.y)+']'; +end; + +class operator T2DIntVector.Implicit(vector: T2DIntVector): string; +begin +result:='[x='+IntToStr(vector.x)+'; y='+IntToStr(vector.y)+']'; +end; + +class operator T2DIntVector.Implicit(i: integer): T2DIntVector; +begin +result.x:=i; +result.y:=0; +end; + +function T2DIntVector.Length: extended; +begin +result:=sqrt(sqr(Self.x)+sqr(self.y)); +end; + +class operator T2DIntVector.Multiply(left: T2DIntVector; + scalar: integer): T2DIntVector; +begin +result.x:=left.x*scalar; +result.y:=left.y*scalar; +end; + +class operator T2DIntVector.Multiply(left, right: T2DIntVector): integer; +begin +result:=left.x*right.x + left.y*right.y; +end; + +class operator T2DIntVector.Multiply(scalar: integer; + right: T2DIntVector): T2DIntVector; +begin +result.x:=scalar*right.x; +result.y:=scalar*right.y; +end; + +class operator T2DIntVector.Negative(vector: T2DIntVector): T2DIntVector; +begin +result.x:=-vector.x; +result.y:=-vector.y; +end; + +class operator T2DIntVector.Positive(vector: T2DIntVector): T2DIntVector; +begin +result.x:=vector.x; +result.y:=vector.y; +end; + +class operator T2DIntVector.Round(value: T2DIntVector): T2DIntVector; +begin +result.x:=value.x; +result.y:=value.y; +end; + +class operator T2DIntVector.Subtract(left, right: T2DIntVector): T2DIntVector; +begin +result.x:=left.x-right.x; +result.y:=left.y-right.y; +end; + +class operator T2DIntVector.Trunc(value: T2DIntVector): T2DIntVector; +begin +result.x:=value.x; +result.y:=value.y; +end; + +class operator T2DIntVector.Explicit(point: TPoint): T2DIntVector; +begin +result.x:=point.x; +result.y:=point.y; +end; + +class operator T2DIntVector.Explicit(vector: T2DIntVector): TPoint; +begin +result.x:=vector.x; +result.y:=vector.y; +end; + +class operator T2DIntVector.Implicit(point: TPoint): T2DIntVector; +begin +result.x:=point.x; +result.y:=point.y; +end; + +class operator T2DIntVector.Implicit(vector: T2DIntVector): TPoint; +begin +result.x:=vector.x; +result.y:=vector.y; +end; + +{ T2DVector } + +class operator T2DVector.Add(left, right: T2DVector): T2DVector; +begin +result.x:=left.x+right.x; +result.y:=left.y+right.y; +end; + +constructor T2DVector.Create(Ax, Ay: extended); +begin +self.x:=Ax; +self.y:=Ay; +end; + +class operator T2DVector.Divide(left: T2DIntVector; + scalar: extended): T2DVector; +begin +if abs(scalar)0 then + begin + result.x:=self.y/len; + result.y:=-self.x/len; + end +else + begin + result.x:=-self.y/len; + result.y:=self.x/len; + end; +end; + +class operator T2DVector.Explicit(vector: T2DVector): string; +begin +result:='[x='+FloatToStr(vector.x)+'; y='+FloatToStr(vector.y)+']'; +end; + +class operator T2DVector.Explicit(i: integer): T2DVector; +begin +result.x:=i; +result.y:=0; +end; + +class operator T2DVector.Explicit(e: extended): T2DVector; +begin +result.x:=e; +result.y:=0; +end; + +class operator T2DVector.Explicit(vector: T2DIntVector): T2DVector; +begin +result.x:=vector.x; +result.y:=vector.y; +end; + +class operator T2DVector.Explicit(vector: T2DVector): T2DIntVector; +begin +result.x:=round(vector.x); +result.y:=round(vector.y); +end; + +class operator T2DVector.Implicit(vector: T2DVector): string; +begin +result:='[x='+FloatToStr(vector.x)+'; y='+FloatToStr(vector.y)+']'; +end; + +class operator T2DVector.Implicit(vector: T2DIntVector): T2DVector; +begin +result.x:=vector.x; +result.y:=vector.y; +end; + +class operator T2DVector.Implicit(i: integer): T2DVector; +begin +result.x:=i; +result.y:=0; +end; + +class operator T2DVector.Implicit(e: extended): T2DVector; +begin +result.x:=e; +result.y:=0; +end; + +class operator T2DVector.Implicit(vector: T2DVector): T2DIntVector; +begin +result.x:=round(vector.x); +result.y:=round(vector.y); +end; + +function T2DVector.Length: extended; +begin +result:=sqrt(sqr(self.x)+sqr(self.y)); +end; + +function T2DVector.LiesInsideCircle(APoint: T2DPoint; + radius: extended): boolean; + +var Temp : T2DVector; + +begin +Temp:=APoint - self; +result:=Temp.Length <= radius; +end; + +class operator T2DVector.Multiply(left, right: T2DVector): extended; +begin +result:=left.x*right.x + left.y*right.y; +end; + +class operator T2DVector.Multiply(left: T2DVector; scalar: extended): T2DVector; +begin +result.x:=left.x*scalar; +result.y:=left.y*scalar; +end; + +class operator T2DVector.Multiply(scalar: extended; + right: T2DVector): T2DVector; +begin +result.x:=scalar*right.x; +result.y:=scalar*right.y; +end; + +class operator T2DVector.Negative(vector: T2DVector): T2DVector; +begin +result.x:=-vector.x; +result.y:=-vector.y; +end; + +procedure T2DVector.Normalize; + +var len : extended; + +begin +len:=self.Length; +if lenNUM_ZERO then result:=1 else + result:=0; +end; + +class operator T2DVector.Positive(vector: T2DVector): T2DVector; +begin +result.x:=vector.x; +result.y:=vector.y; +end; + +function T2DVector.CrossProductWith(AVector: T2DVector): extended; +begin +result:=self.x * AVector.y - self.y * AVector.x; +end; + +function T2DVector.ProjectedTo(vector: T2DVector): T2DVector; + +var product : extended; + len : extended; + +begin +len:=vector.Length; +if abs(len)0 then + begin + result.x:=-self.y/len; + result.y:=self.x/len; + end +else + begin + result.x:=self.y/len; + result.y:=-self.x/len; + end; +end; + +{ T3DVector } + +class operator T3DVector.Add(left, right: T3DVector): T3DVector; +begin +result.x:=left.x+right.x; +result.y:=left.y+right.y; +result.z:=left.z+right.z; +end; + +constructor T3DVector.create(Ax, Ay, Az: extended); +begin +self.x:=Ax; +self.y:=Ay; +self.z:=Az; +end; + +function T3DVector.DistanceFromAxis(APoint, AVector: T3DVector): extended; + +var temp, proj : T3DVector; + +begin +temp:=self-APoint; +proj:=temp.ProjectedTo(AVector); +result:=(temp - proj).Length; +end; + +class operator T3DVector.Divide(left: T3DVector; scalar: extended): T3DVector; +begin +if abs(scalar)0 then + begin + result.x:=-result.x; + result.y:=-result.y; + result.z:=-result.z; + end; +end; + +class operator T3DVector.Explicit(vector: T2DIntVector): T3DVector; +begin +result.x:=vector.x; +result.y:=vector.y; +result.z:=0; +end; + +class operator T3DVector.Explicit(i: integer): T3DVector; +begin +result.x:=i; +result.y:=0; +result.z:=0; +end; + +class operator T3DVector.Explicit(e: extended): T3DVector; +begin +result.x:=e; +result.y:=0; +result.z:=0; +end; + +class operator T3DVector.Explicit(vector: T2DVector): T3DVector; +begin +result.x:=vector.x; +result.y:=vector.y; +result.z:=0; +end; + +class operator T3DVector.Explicit(vector: T3DVector): string; +begin +result:='[x='+FloatToStr(vector.x)+'; y='+FloatToStr(vector.y)+'; z='+FloatToStr(vector.z)+']'; +end; + +class operator T3DVector.Implicit(vector: T2DIntVector): T3DVector; +begin +result.x:=vector.x; +result.y:=vector.y; +result.z:=0; +end; + +class operator T3DVector.Implicit(vector: T2DVector): T3DVector; +begin +result.x:=vector.x; +result.y:=vector.y; +result.z:=0; +end; + +class operator T3DVector.Implicit(i: integer): T3DVector; +begin +result.x:=i; +result.y:=0; +result.z:=0; +end; + +class operator T3DVector.Implicit(e: extended): T3DVector; +begin +result.x:=e; +result.y:=0; +result.z:=0; +end; + +class operator T3DVector.Implicit(vector: T3DVector): string; +begin +result:='[x='+FloatToStr(vector.x)+'; y='+FloatToStr(vector.y)+'; z='+FloatToStr(vector.z)+']'; +end; + +function T3DVector.Length: extended; +begin +result:=sqrt(sqr(self.x)+sqr(self.y)+sqr(self.z)); +end; + +function T3DVector.LiesInsideSphere(APoint: T3DVector; + radius: extended): boolean; + +var Temp : T3DVector; + +begin +Temp:=APoint - self; +result:=Temp.Length <= radius; +end; + +class operator T3DVector.Multiply(left: T3DVector; scalar: extended): T3DVector; +begin +result.x:=left.x*scalar; +result.y:=left.y*scalar; +result.z:=left.z*scalar; +end; + +class operator T3DVector.Multiply(scalar: extended; + right: T3DVector): T3DVector; +begin +result.x:=scalar*right.x; +result.y:=scalar*right.y; +result.z:=scalar*right.z; +end; + +class operator T3DVector.Multiply(left, right: T3DVector): extended; +begin +result:=left.x*right.x + left.y*right.y + left.z*right.z; +end; + +class operator T3DVector.Negative(vector: T3DVector): T3DVector; +begin +result.x:=-vector.x; +result.y:=-vector.y; +result.z:=-vector.z; +end; + +procedure T3DVector.Normalize; + +var len : extended; + +begin +len:=self.Length; +if len=self.Left) and (APoint.x<=self.Right) and + (APoint.y>=self.Top) and (APoint.y<=self.Bottom); +end; + +constructor T2DIntRect.Create(ALeft, ATop, ARight, ABottom: integer); +begin +self.left:=ALeft; +self.top:=ATop; +self.right:=ARight; +self.bottom:=ABottom; +end; + +constructor T2DIntRect.Create(ATopLeft, ABottomRight: T2DIntVector); +begin +self.TopLeft:=ATopLeft; +self.BottomRight:=ABottomRight; +end; + +class operator T2DIntRect.Explicit(ARect: T2DIntRect): TRect; +begin +result.left:=ARect.left; +result.top:=ARect.top; +result.Right:=ARect.Right; +result.bottom:=ARect.bottom; +end; + +procedure T2DIntRect.ExpandBy(APoint: T2DIntPoint); +begin +self.left:=min(self.left,APoint.x); +self.right:=max(self.right,APoint.x); +self.top:=min(self.top,APoint.y); +self.bottom:=max(self.bottom,APoint.y); +end; + +class operator T2DIntRect.Explicit(ARect: TRect): T2DIntRect; +begin +result.left:=ARect.left; +result.top:=ARect.top; +result.Right:=ARect.Right; +result.bottom:=ARect.bottom; +end; + +function T2DIntRect.GetVertex(ACorner: TRectCorner): T2DIntVector; +begin +case ACorner of + rcLeftTop : result:=T2DIntVector.create(self.left, self.top); + rcRightTop : result:=T2DIntVector.create(self.right, self.top); + rcLeftBottom : result:=T2DIntVector.create(self.left, self.bottom); + rcRightBottom : result:=T2DIntVector.create(self.right, self.bottom); +end; +end; + +function T2DIntRect.Height: integer; +begin +result:=self.bottom-self.top+1; +end; + +class operator T2DIntRect.Implicit(ARect: T2DIntRect): TRect; +begin +result.left:=ARect.left; +result.top:=ARect.top; +result.Right:=ARect.Right; +result.bottom:=ARect.bottom; +end; + +class operator T2DIntRect.Implicit(ARect: TRect): T2DIntRect; +begin +result.left:=ARect.left; +result.top:=ARect.top; +result.Right:=ARect.Right; +result.bottom:=ARect.bottom; +end; + +class operator T2DIntRect.Implicit(ARect: T2DIntRect): string; +begin +result:='('+inttostr(ARect.left)+', '+inttostr(ARect.top)+', '+inttostr(ARect.right)+', '+inttostr(ARect.bottom)+')'; +end; + +function T2DIntRect.IntersectsWith(ARect : T2DIntRect; + var Intersection: T2DIntRect): boolean; + +var XStart, XWidth, YStart, YWidth : integer; + +begin +if self.left<=ARect.left then + begin + if ARect.left<=self.right then + begin + XStart:=ARect.Left; + XWidth:=min(ARect.right, self.Right) - ARect.left + 1; + end else + begin + XStart:=0; + XWidth:=0; + end; + end else + begin + if self.Left<=ARect.right then + begin + XStart:=self.left; + XWidth:=min(ARect.right, self.right) - self.left + 1; + end else + begin + XStart:=0; + XWidth:=0; + end; + end; + +if self.top<=ARect.top then + begin + if ARect.top<=self.bottom then + begin + YStart:=ARect.Top; + YWidth:=min(ARect.bottom, self.bottom) - ARect.top + 1; + end else + begin + YStart:=0; + YWidth:=0; + end; + end else + begin + if self.Top<=ARect.bottom then + begin + YStart:=self.top; + YWidth:=min(ARect.bottom, self.bottom) - self.top + 1; + end else + begin + YStart:=0; + YWidth:=0; + end; + end; + +Intersection:=T2DIntRect.create(XStart, YStart, XStart+XWidth-1, YStart+YWidth-1); +result:=(XWidth>0) and (YWidth>0); +end; + +function T2DIntRect.IntersectsWith(ARect: T2DIntRect): boolean; +begin +result:=( max(ARect.left, self.left) <= min(ARect.right, self.right) ) + and + ( max(ARect.Top, self.top) <= min(ARect.bottom, self.bottom) ); +end; + +procedure T2DIntRect.Move(dx, dy: integer); +begin +inc(left, dx); +inc(right, dx); +inc(top, dx); +inc(bottom, dx); +end; + +procedure T2DIntRect.Move(AVector: T2DIntVector); +begin +inc(self.left,AVector.x); +inc(self.right, AVector.x); +inc(self.top, AVector.y); +inc(self.Bottom, AVector.y); +end; + +function T2DIntRect.Moved(AVector: T2DIntVector): T2DIntRect; +begin +result.left:=self.left+AVector.x; +result.Right:=self.right+AVector.x; +result.top:=self.top+AVector.y; +result.bottom:=self.bottom+AVector.y; +end; + +procedure T2DIntRect.Split(var LeftTop, RightTop, LeftBottom, + RightBottom: T2DIntRect); +begin +if self.left = self.right then + begin + LeftTop.left:=self.left; + LeftTop.right:=self.right; + + LeftBottom.left:=self.left; + LeftBottom.right:=self.right; + + RightTop.left:=self.left; + RightTop.right:=self.right; + + RightBottom.left:=self.left; + RightBottom.right:=self.right; + end else + begin + LeftTop.left:=self.left; + LeftTop.right:=self.left+(self.right-self.left) div 2; + + LeftBottom.left:=self.left; + LeftBottom.right:=self.left+(self.right-self.left) div 2; + + RightTop.left:=self.left+(self.right-self.left) div 2 + 1; + RightTop.right:=self.right; + + RightBottom.left:=self.left+(self.right-self.left) div 2 + 1; + RightBottom.right:=self.right; + end; + +if self.top = self.bottom then + begin + LeftTop.top:=self.top; + LeftTop.bottom:=self.bottom; + + LeftBottom.top:=self.top; + LeftBottom.bottom:=self.bottom; + + RightTop.top:=self.top; + RightTop.bottom:=self.bottom; + + RightBottom.top:=self.top; + RightBottom.bottom:=self.bottom; + end else + begin + LeftTop.top:=self.top; + LeftTop.bottom:=self.top+(self.bottom-self.top) div 2; + + LeftBottom.top:=self.top; + LeftBottom.bottom:=self.top+(self.bottom-self.top) div 2; + + RightTop.top:=self.top+(self.bottom-self.top) div 2 + 1; + RightTop.bottom:=self.bottom; + + RightBottom.top:=self.top+(self.bottom-self.top) div 2 + 1; + RightBottom.bottom:=self.bottom; + end; +end; + +class operator T2DIntRect.Subtract(AVector: T2DIntVector; + ARect: T2DIntRect): T2DIntRect; +begin +result:=T2DIntRect.Create(AVector.x - ARect.left, + AVector.y - ARect.top, + AVector.x - ARect.Right, + AVector.y - ARect.bottom); +end; + +class operator T2DIntRect.Subtract(ARect: T2DIntRect; + AVector: T2DIntVector): T2DIntRect; +begin +result:=T2DIntRect.Create(ARect.left - AVector.x, + ARect.top - AVector.y, + ARect.Right - AVector.x, + ARect.bottom - AVector.y); +end; + +function T2DIntRect.Width: integer; +begin +result:=self.right-self.left+1; +end; + +function T2DIntRect.Moved(dx, dy: integer): T2DIntRect; +begin +result.left:=self.left+dx; +result.Right:=self.right+dx; +result.top:=self.top+dy; +result.bottom:=self.bottom+dy; +end; + +class operator T2DIntRect.Explicit(ARect: T2DIntRect): string; +begin +result:='('+inttostr(ARect.left)+', '+inttostr(ARect.top)+', '+inttostr(ARect.right)+', '+inttostr(ARect.bottom)+')'; +end; + +function T2DIntRect.ForWinAPI: TRect; +begin +result.left:=self.left; +result.top:=self.top; +result.right:=self.right+1; +result.bottom:=self.bottom+1; +end; + +{ T2DRect } + +function T2DRect.Contains(APoint: T2DPoint): boolean; +begin +result:=(APoint.x>=self.Left) and (APoint.y<=self.Right) and + (APoint.y>=self.Top) and (APoint.y<=self.Bottom); +end; + +constructor T2DRect.Create(ALeft, ATop, ARight, ABottom: extended); +begin +self.left:=ALeft; +self.top:=ATop; +self.right:=ARight; +self.bottom:=ABottom; +end; + +constructor T2DRect.Create(ATopLeft, ABottomRight: T2DVector); +begin +self.TopLeft:=ATopLeft; +self.BottomRight:=ABottomRight; +end; + +class operator T2DRect.Explicit(ARect: TRect): T2DRect; +begin +result.left:=ARect.left; +result.top:=ARect.top; +result.Right:=ARect.Right; +result.bottom:=ARect.bottom; +end; + +class operator T2DRect.Explicit(ARect: T2DRect): TRect; +begin +result.left:=round(ARect.left); +result.top:=round(ARect.top); +result.Right:=round(ARect.Right); +result.bottom:=round(ARect.bottom); +end; + +class operator T2DRect.Explicit(ARect: T2DRect): T2DIntRect; +begin +result.left:=round(ARect.left); +result.top:=round(ARect.top); +result.Right:=round(ARect.Right); +result.bottom:=round(ARect.bottom); +end; + +procedure T2DRect.ExpandBy(APoint: T2DPoint); +begin +self.left:=min(self.left,APoint.x); +self.right:=max(self.right,APoint.x); +self.top:=min(self.top,APoint.y); +self.bottom:=max(self.bottom,APoint.y); +end; + +class operator T2DRect.Explicit(ARect: T2DIntRect): T2DRect; +begin +result.left:=ARect.left; +result.top:=ARect.top; +result.Right:=ARect.Right; +result.bottom:=ARect.bottom; +end; + +function T2DRect.GetVertex(ACorner: TRectCorner): T2DVector; +begin +case ACorner of + rcLeftTop : result:=T2DVector.Create(self.left, self.top); + rcRightTop : result:=T2DVector.Create(self.right, self.top); + rcLeftBottom : result:=T2DVector.Create(self.left, self.bottom); + rcRightBottom : result:=T2DVector.Create(self.right, self.bottom); +end; +end; + +function T2DRect.Height: extended; +begin +result:=self.bottom-self.top; +end; + +class operator T2DRect.Implicit(ARect: TRect): T2DRect; +begin +result.left:=ARect.left; +result.top:=ARect.top; +result.Right:=ARect.Right; +result.bottom:=ARect.bottom; +end; + +class operator T2DRect.Implicit(ARect: T2DRect): TRect; +begin +result.left:=round(ARect.left); +result.top:=round(ARect.top); +result.Right:=round(ARect.Right); +result.bottom:=round(ARect.bottom); +end; + +class operator T2DRect.Implicit(ARect: T2DRect): T2DIntRect; +begin +result.left:=round(ARect.left); +result.top:=round(ARect.top); +result.Right:=round(ARect.Right); +result.bottom:=round(ARect.bottom); +end; + +class operator T2DRect.Implicit(ARect: T2DIntRect): T2DRect; +begin +result.left:=ARect.left; +result.top:=ARect.top; +result.Right:=ARect.Right; +result.bottom:=ARect.bottom; +end; + +function T2DRect.IntersectsWith(ARect: T2DRect): boolean; +begin +result:=( ( (ARect.left>=self.left) and (ARect.left<=self.left) ) or + ( (ARect.right>=self.right) and (ARect.right<=self.right) ) or + ( (self.left>=ARect.left) and (self.left<=ARect.right) ) or + ( (self.right>=ARect.left) and (self.right<=ARect.right) ) ) + and + ( ( (ARect.top>=self.top) and (ARect.top<=self.top) ) or + ( (ARect.bottom>=self.bottom) and (ARect.bottom<=self.bottom) ) or + ( (self.top>=ARect.top) and (self.top<=ARect.bottom) ) or + ( (self.bottom>=ARect.top) and (self.bottom<=ARect.bottom) ) ); +end; + +procedure T2DRect.Move(dx, dy: extended); +begin +self.left:=self.left+dx; +self.right:=self.right+dx; +self.top:=self.top+dy; +self.bottom:=self.bottom+dy; +end; + +function T2DRect.Moved(dx, dy: extended): T2DRect; +begin +result.left:=self.left+dx; +result.right:=self.right+dx; +result.top:=self.top+dy; +result.bottom:=self.bottom+dy; +end; + +procedure T2DRect.Move(Vector: T2DVector); +begin +self.left:=self.left+vector.x; +self.right:=self.right+vector.x; +self.top:=self.top+vector.y; +self.bottom:=self.bottom+vector.y; +end; + +function T2DRect.Moved(Vector: T2DVector): T2DRect; +begin +result.left:=self.left+Vector.x; +result.right:=self.right+Vector.x; +result.top:=self.top+Vector.y; +result.bottom:=self.bottom+Vector.y; +end; + +procedure T2DRect.SetCenteredHeight(ANewHeight: extended); + +var center : extended; + +begin +if (ANewHeight<0) then + raise exception.create('T2DRect.SetCenteredHeight: Nowa wysokość mniejsza od zera!'); + +center:=self.top+(self.bottom-self.top)/2; +self.top:=center-(ANewHeight/2); +self.bottom:=center+(ANewHeight/2); +end; + +procedure T2DRect.SetCenteredWidth(ANewWidth: extended); + +var center : extended; + +begin +if (ANewWidth<0) then + raise exception.create('T2DRect.SetCenteredWidth: Nowa szerokość mniejsza od zera!'); + +center:=self.left+(self.right-self.left)/2; +self.left:=center-(ANewWidth/2); +self.right:=center+(ANewWidth/2); +end; + +procedure T2DRect.Split(var LeftTop, RightTop, LeftBottom, + RightBottom: T2DRect); +begin +LeftTop.left:=self.left; +LeftTop.right:=self.left+(self.right-self.left)/2; + +LeftBottom.left:=self.left; +LeftBottom.right:=self.left+(self.right-self.left)/2; + +RightTop.left:=self.left+(self.Right-self.left)/2; +RightTop.Right:=self.right; + +RightBottom.left:=self.left+(self.right-self.left)/2; +RightBottom.right:=self.right; + + +LeftTop.top:=self.top; +LeftTop.bottom:=self.top+(self.bottom-self.top)/2; + +LeftBottom.top:=self.top; +LeftBottom.bottom:=self.top+(self.bottom-self.top)/2; + +RightTop.top:=self.top+(self.bottom-self.top)/2; +RightTop.bottom:=self.bottom; + +RightBottom.top:=self.top+(self.bottom-self.top)/2; +RightBottom.bottom:=self.bottom; +end; + +function T2DRect.Width: extended; +begin +result:=self.right-self.left; +end; + +class operator T2DRect.Explicit(ARect: T2DRect): string; +begin +result:='('+floattostr(ARect.left)+', '+floattostr(ARect.top)+', '+floattostr(ARect.right)+', '+floattostr(ARect.bottom)+')'; +end; + +class operator T2DRect.Implicit(ARect: T2DRect): string; +begin +result:='('+floattostr(ARect.left)+', '+floattostr(ARect.top)+', '+floattostr(ARect.right)+', '+floattostr(ARect.bottom)+')'; +end; + +end. \ No newline at end of file diff --git a/components/spktoolbar/SpkToolbar - designtime/GFX/Button-add.bmp b/components/spktoolbar/SpkToolbar - designtime/GFX/Button-add.bmp new file mode 100644 index 000000000..1e7ca4630 Binary files /dev/null and b/components/spktoolbar/SpkToolbar - designtime/GFX/Button-add.bmp differ diff --git a/components/spktoolbar/SpkToolbar - designtime/GFX/Button-remove.bmp b/components/spktoolbar/SpkToolbar - designtime/GFX/Button-remove.bmp new file mode 100644 index 000000000..249c6ebd7 Binary files /dev/null and b/components/spktoolbar/SpkToolbar - designtime/GFX/Button-remove.bmp differ diff --git a/components/spktoolbar/SpkToolbar - designtime/GFX/Button.bmp b/components/spktoolbar/SpkToolbar - designtime/GFX/Button.bmp new file mode 100644 index 000000000..d04f7d4d5 Binary files /dev/null and b/components/spktoolbar/SpkToolbar - designtime/GFX/Button.bmp differ diff --git a/components/spktoolbar/SpkToolbar - designtime/GFX/Move-down.bmp b/components/spktoolbar/SpkToolbar - designtime/GFX/Move-down.bmp new file mode 100644 index 000000000..864f687d7 Binary files /dev/null and b/components/spktoolbar/SpkToolbar - designtime/GFX/Move-down.bmp differ diff --git a/components/spktoolbar/SpkToolbar - designtime/GFX/Move-up.bmp b/components/spktoolbar/SpkToolbar - designtime/GFX/Move-up.bmp new file mode 100644 index 000000000..61e731bed Binary files /dev/null and b/components/spktoolbar/SpkToolbar - designtime/GFX/Move-up.bmp differ diff --git a/components/spktoolbar/SpkToolbar - designtime/GFX/Pane-add.bmp b/components/spktoolbar/SpkToolbar - designtime/GFX/Pane-add.bmp new file mode 100644 index 000000000..7bdc42888 Binary files /dev/null and b/components/spktoolbar/SpkToolbar - designtime/GFX/Pane-add.bmp differ diff --git a/components/spktoolbar/SpkToolbar - designtime/GFX/Pane-remove.bmp b/components/spktoolbar/SpkToolbar - designtime/GFX/Pane-remove.bmp new file mode 100644 index 000000000..1565accaa Binary files /dev/null and b/components/spktoolbar/SpkToolbar - designtime/GFX/Pane-remove.bmp differ diff --git a/components/spktoolbar/SpkToolbar - designtime/GFX/Pane.bmp b/components/spktoolbar/SpkToolbar - designtime/GFX/Pane.bmp new file mode 100644 index 000000000..4f3d24c45 Binary files /dev/null and b/components/spktoolbar/SpkToolbar - designtime/GFX/Pane.bmp differ diff --git a/components/spktoolbar/SpkToolbar - designtime/GFX/Tab-add.bmp b/components/spktoolbar/SpkToolbar - designtime/GFX/Tab-add.bmp new file mode 100644 index 000000000..d1fcda098 Binary files /dev/null and b/components/spktoolbar/SpkToolbar - designtime/GFX/Tab-add.bmp differ diff --git a/components/spktoolbar/SpkToolbar - designtime/GFX/Tab-remove.bmp b/components/spktoolbar/SpkToolbar - designtime/GFX/Tab-remove.bmp new file mode 100644 index 000000000..98b2ebe8a Binary files /dev/null and b/components/spktoolbar/SpkToolbar - designtime/GFX/Tab-remove.bmp differ diff --git a/components/spktoolbar/SpkToolbar - designtime/GFX/Tab.bmp b/components/spktoolbar/SpkToolbar - designtime/GFX/Tab.bmp new file mode 100644 index 000000000..4ff439297 Binary files /dev/null and b/components/spktoolbar/SpkToolbar - designtime/GFX/Tab.bmp differ diff --git a/components/spktoolbar/SpkToolbar - designtime/GFX/Template.xcf b/components/spktoolbar/SpkToolbar - designtime/GFX/Template.xcf new file mode 100644 index 000000000..6c0201216 Binary files /dev/null and b/components/spktoolbar/SpkToolbar - designtime/GFX/Template.xcf differ diff --git a/components/spktoolbar/SpkToolbar - designtime/SpkToolbarEditor.pas b/components/spktoolbar/SpkToolbar - designtime/SpkToolbarEditor.pas new file mode 100644 index 000000000..b6463c5bf --- /dev/null +++ b/components/spktoolbar/SpkToolbar - designtime/SpkToolbarEditor.pas @@ -0,0 +1,368 @@ +unit SpkToolbarEditor; + +interface + +uses Windows, Controls, Classes, DesignEditors, DesignIntf, TypInfo, Dialogs, + SysUtils, + spkToolbar, spkt_Tab, spkt_Pane, spkt_Appearance, + spkte_EditWindow, spkte_AppearanceEditor; + +const PROPERTY_CONTENTS_NAME = 'Contents'; + PROPERTY_CONTENTS_VALUE = 'Open editor...'; + +type TAddContentsFilter = class(TSelectionEditor, ISelectionPropertyFilter) + public + procedure FilterProperties(const ASelection: IDesignerSelections; const ASelectionProperties: IInterfaceList); + end; + +type TSpkToolbarContentsEditor = class(TBasePropertyEditor, IProperty, IPropertyKind) + private + protected + FPropList : PInstPropList; + FPropCount : integer; + FDesigner : IDesigner; + FToolbar : TSpkToolbar; + + procedure SetPropEntry(Index: Integer; AInstance: TPersistent; + APropInfo: PPropInfo); override; + procedure Initialize; override; + public + constructor Create(const ADesigner: IDesigner; APropCount: Integer); override; + destructor Destroy; override; + + procedure Activate; + function AllEqual: Boolean; + function AutoFill: Boolean; + procedure Edit; + function HasInstance(Instance: TPersistent): Boolean; + function GetAttributes: TPropertyAttributes; + function GetEditLimit: Integer; + function GetEditValue(out Value: string): Boolean; + function GetName: string; + procedure GetProperties(Proc: TGetPropProc); + function GetPropInfo: PPropInfo; + function GetPropType: PTypeInfo; + function GetValue: string; + procedure GetValues(Proc: TGetStrProc); + procedure Revert; + procedure SetValue(const Value: string); + function ValueAvailable: Boolean; + + function GetKind: TTypeKind; + + property PropCount : integer read FPropCount; + property Designer : IDesigner read FDesigner; + property Toolbar : TSpkToolbar read FToolbar write FToolbar; + end; + +type TSpkToolbarCaptionEditor = class(TStringProperty) + private + protected + public + procedure SetValue(const Value: string); override; + end; + +type TSpkToolbarAppearanceEditor = class(TClassProperty) + private + protected + public + function GetAttributes: TPropertyAttributes; override; + procedure Edit; override; + end; + +type TSpkToolbarEditor = class(TComponentEditor) + protected + procedure DoOpenContentsEditor; + public + procedure Edit; override; + procedure ExecuteVerb(Index: Integer); override; + function GetVerb(Index: Integer): string; override; + function GetVerbCount: Integer; override; + end; + +var EditWindow : TfrmEditWindow; + +implementation + +{ TSpkToolbarEditor } + +procedure TSpkToolbarContentsEditor.Activate; +begin +// +end; + +function TSpkToolbarContentsEditor.AllEqual: Boolean; +begin +result:=FPropCount = 1; +end; + +function TSpkToolbarContentsEditor.AutoFill: Boolean; +begin +result:=false; +end; + +constructor TSpkToolbarContentsEditor.Create(const ADesigner: IDesigner; + APropCount: Integer); +begin + inherited Create(ADesigner, APropCount); + FDesigner:=ADesigner; + FPropCount:=APropCount; + FToolbar:=nil; + GetMem(FPropList, APropCount * SizeOf(TInstProp)); + FillChar(FPropList^, APropCount * SizeOf(TInstProp), 0); +end; + +destructor TSpkToolbarContentsEditor.Destroy; +begin + if FPropList <> nil then + FreeMem(FPropList, FPropCount * SizeOf(TInstProp)); + inherited; +end; + +procedure TSpkToolbarContentsEditor.Edit; +begin + EditWindow.SetData(FToolbar,self.Designer); + EditWindow.Show; +end; + +function TSpkToolbarContentsEditor.GetAttributes: TPropertyAttributes; +begin +result:=[paDialog, paReadOnly]; +end; + +function TSpkToolbarContentsEditor.GetEditLimit: Integer; +begin +result:=0; +end; + +function TSpkToolbarContentsEditor.GetEditValue(out Value: string): Boolean; +begin +Value:=GetValue; +result:=true; +end; + +function TSpkToolbarContentsEditor.GetKind: TTypeKind; +begin +result:=tkClass; +end; + +function TSpkToolbarContentsEditor.GetName: string; +begin +result:=PROPERTY_CONTENTS_NAME; +end; + +procedure TSpkToolbarContentsEditor.GetProperties(Proc: TGetPropProc); +begin +// +end; + +function TSpkToolbarContentsEditor.GetPropInfo: PPropInfo; +begin +Result:=nil; +end; + +function TSpkToolbarContentsEditor.GetPropType: PTypeInfo; +begin +Result:=nil; +end; + +function TSpkToolbarContentsEditor.GetValue: string; +begin +result:=PROPERTY_CONTENTS_VALUE; +end; + +procedure TSpkToolbarContentsEditor.GetValues(Proc: TGetStrProc); +begin +// +end; + +function TSpkToolbarContentsEditor.HasInstance(Instance: TPersistent): Boolean; +begin + result:=EditWindow.Toolbar = Instance; +end; + +procedure TSpkToolbarContentsEditor.Initialize; +begin + inherited; +end; + +procedure TSpkToolbarContentsEditor.Revert; +begin +// +end; + +procedure TSpkToolbarContentsEditor.SetPropEntry(Index: Integer; AInstance: TPersistent; + APropInfo: PPropInfo); +begin +with FPropList^[Index] do + begin + Instance := AInstance; + PropInfo := APropInfo; + end; +end; + +procedure TSpkToolbarContentsEditor.SetValue(const Value: string); +begin +// +end; + +function TSpkToolbarContentsEditor.ValueAvailable: Boolean; +begin +result:=true; +end; + +{ TSelectionFilter } + +procedure TAddContentsFilter.FilterProperties( + const ASelection: IDesignerSelections; + const ASelectionProperties: IInterfaceList); + +var ContentsEditor : TSpkToolbarContentsEditor; + Prop : IProperty; + i : integer; + Added : boolean; + +begin +if ASelection.Count<>1 then + exit; + +if ASelection[0] is TSpkToolbar then + begin + ContentsEditor:=TSpkToolbarContentsEditor.Create(inherited Designer, 1); + ContentsEditor.Toolbar:=ASelection[0] as TSpkToolbar; + + i:=0; + Added:=false; + while (iPROPERTY_CONTENTS_NAME) then + begin + ASelectionProperties.Insert(i, ContentsEditor); + Added:=true; + end; + inc(i); + end; + + if not(Added) then + ASelectionProperties.Add(ContentsEditor as IProperty); + end; +end; + +{ TSpkToolbarEditor } + +procedure TSpkToolbarEditor.DoOpenContentsEditor; + +var Component : TComponent; + Toolbar : TSpkToolbar; + Designer : IDesigner; + +begin +Component:=self.GetComponent; +if not(assigned(Component)) then + exit; + +if not(Component is TSpkToolbar) then + exit; + +Toolbar:=Component as TSpkToolbar; +Designer:=self.GetDesigner; + +EditWindow.SetData(Toolbar,Designer); +EditWindow.Show; +end; + +procedure TSpkToolbarEditor.Edit; + +begin +DoOpenContentsEditor; +end; + +procedure TSpkToolbarEditor.ExecuteVerb(Index: Integer); +begin +case Index of + 0 : DoOpenContentsEditor; +end; +end; + +function TSpkToolbarEditor.GetVerb(Index: Integer): string; +begin +case Index of + 0 : result:='Contents editor...'; +end; +end; + +function TSpkToolbarEditor.GetVerbCount: Integer; +begin +result:=1; +end; + +{ TSpkToolbarCaptionEditor } + +procedure TSpkToolbarCaptionEditor.SetValue(const Value: string); +begin + inherited; + EditWindow.RefreshNames; +end; + +{ TSpkToolbarAppearanceEditor } + +procedure TSpkToolbarAppearanceEditor.Edit; + +var Obj : TObject; + Toolbar : TSpkToolbar; + Tab : TSpkTab; + AppearanceEditor : tfrmAppearanceEditWindow; + +begin +Obj:=GetComponent(0); +if Obj is TSpkToolbar then + begin + Toolbar:=(Obj as TSpkToolbar); + + AppearanceEditor:=TfrmAppearanceEditWindow.Create(nil); + try + AppearanceEditor.Appearance.Assign(Toolbar.Appearance); + if AppearanceEditor.ShowModal = mrOK then + begin + Toolbar.Appearance.Assign(AppearanceEditor.Appearance); + Modified; + end; + finally + AppearanceEditor.Free; + end; + + end else +if Obj is TSpkTab then + begin + Tab:=(Obj as TSpkTab); + + AppearanceEditor:=TfrmAppearanceEditWindow.Create(nil); + try + AppearanceEditor.Appearance.Assign(Tab.CustomAppearance); + if AppearanceEditor.ShowModal = mrOK then + begin + Tab.CustomAppearance.Assign(AppearanceEditor.Appearance); + Modified; + end; + finally + AppearanceEditor.Free; + end; + + end; +end; + +function TSpkToolbarAppearanceEditor.GetAttributes: TPropertyAttributes; +begin + result:=inherited GetAttributes + [paDialog] - [paMultiSelect]; +end; + +initialization + +EditWindow:=TfrmEditWindow.create(nil); + +finalization + +EditWindow.Free; + +end. diff --git a/components/spktoolbar/SpkToolbar - designtime/spkte_AppearanceEditor.dfm b/components/spktoolbar/SpkToolbar - designtime/spkte_AppearanceEditor.dfm new file mode 100644 index 000000000..d65572e0b --- /dev/null +++ b/components/spktoolbar/SpkToolbar - designtime/spkte_AppearanceEditor.dfm @@ -0,0 +1,1062 @@ +object frmAppearanceEditWindow: TfrmAppearanceEditWindow + Left = 349 + Top = 120 + Caption = 'Toolbar appearance editor' + ClientHeight = 527 + ClientWidth = 565 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object gbPreview: TGroupBox + AlignWithMargins = True + Left = 3 + Top = 351 + Width = 559 + Height = 137 + Align = alTop + Caption = ' Preview ' + TabOrder = 0 + object tbPreview: TSpkToolbar + AlignWithMargins = True + Left = 5 + Top = 18 + Width = 549 + Color = clBtnFace + Appearance.Tab.TabHeaderFont.Charset = DEFAULT_CHARSET + Appearance.Tab.TabHeaderFont.Color = 9126421 + Appearance.Tab.TabHeaderFont.Height = -13 + Appearance.Tab.TabHeaderFont.Name = 'Calibri' + Appearance.Tab.TabHeaderFont.Style = [] + Appearance.Tab.BorderColor = 14922381 + Appearance.Tab.GradientFromColor = 16115934 + Appearance.Tab.GradientToColor = 15587527 + Appearance.Tab.GradientType = bkConcave + Appearance.Pane.CaptionFont.Charset = DEFAULT_CHARSET + Appearance.Pane.CaptionFont.Color = 11168318 + Appearance.Pane.CaptionFont.Height = -12 + Appearance.Pane.CaptionFont.Name = 'Calibri' + Appearance.Pane.CaptionFont.Style = [] + Appearance.Pane.BorderDarkColor = 14335646 + Appearance.Pane.BorderLightColor = 16315117 + Appearance.Pane.GradientFromColor = 16115934 + Appearance.Pane.GradientToColor = 15587527 + Appearance.Pane.GradientType = bkConcave + Appearance.Pane.CaptionBgColor = 15849922 + Appearance.Element.CaptionFont.Charset = DEFAULT_CHARSET + Appearance.Element.CaptionFont.Color = 9126421 + Appearance.Element.CaptionFont.Height = -12 + Appearance.Element.CaptionFont.Name = 'Calibri' + Appearance.Element.CaptionFont.Style = [] + Appearance.Element.IdleFrameColor = 14727067 + Appearance.Element.IdleGradientFromColor = 15653832 + Appearance.Element.IdleGradientToColor = 15323324 + Appearance.Element.IdleGradientType = bkConcave + Appearance.Element.IdleInnerLightColor = 15852501 + Appearance.Element.IdleInnerDarkColor = 15520702 + Appearance.Element.IdleCaptionColor = 11631958 + Appearance.Element.HotTrackFrameColor = 10211293 + Appearance.Element.HotTrackGradientFromColor = 14351615 + Appearance.Element.HotTrackGradientToColor = 5101567 + Appearance.Element.HotTrackGradientType = bkConcave + Appearance.Element.HotTrackInnerLightColor = 12972543 + Appearance.Element.HotTrackInnerDarkColor = 8045272 + Appearance.Element.HotTrackCaptionColor = 8864367 + Appearance.Element.ActiveFrameColor = 5535371 + Appearance.Element.ActiveGradientFromColor = 7126014 + Appearance.Element.ActiveGradientToColor = 4035324 + Appearance.Element.ActiveGradientType = bkConcave + Appearance.Element.ActiveInnerLightColor = 961020 + Appearance.Element.ActiveInnerDarkColor = 961020 + Appearance.Element.ActiveCaptionColor = 8405614 + TabIndex = 0 + Tabs = ( + 'SpkTab1') + object SpkTab1: TSpkTab + CustomAppearance.Tab.TabHeaderFont.Charset = DEFAULT_CHARSET + CustomAppearance.Tab.TabHeaderFont.Color = 9126421 + CustomAppearance.Tab.TabHeaderFont.Height = -13 + CustomAppearance.Tab.TabHeaderFont.Name = 'Calibri' + CustomAppearance.Tab.TabHeaderFont.Style = [] + CustomAppearance.Tab.BorderColor = 14922381 + CustomAppearance.Tab.GradientFromColor = 16115934 + CustomAppearance.Tab.GradientToColor = 15587527 + CustomAppearance.Tab.GradientType = bkConcave + CustomAppearance.Pane.CaptionFont.Charset = DEFAULT_CHARSET + CustomAppearance.Pane.CaptionFont.Color = 11168318 + CustomAppearance.Pane.CaptionFont.Height = -12 + CustomAppearance.Pane.CaptionFont.Name = 'Calibri' + CustomAppearance.Pane.CaptionFont.Style = [] + CustomAppearance.Pane.BorderDarkColor = 14335646 + CustomAppearance.Pane.BorderLightColor = 16315117 + CustomAppearance.Pane.GradientFromColor = 16115934 + CustomAppearance.Pane.GradientToColor = 15587527 + CustomAppearance.Pane.GradientType = bkConcave + CustomAppearance.Pane.CaptionBgColor = 15849922 + CustomAppearance.Element.CaptionFont.Charset = DEFAULT_CHARSET + CustomAppearance.Element.CaptionFont.Color = 9126421 + CustomAppearance.Element.CaptionFont.Height = -12 + CustomAppearance.Element.CaptionFont.Name = 'Calibri' + CustomAppearance.Element.CaptionFont.Style = [] + CustomAppearance.Element.IdleFrameColor = 14727067 + CustomAppearance.Element.IdleGradientFromColor = 15653832 + CustomAppearance.Element.IdleGradientToColor = 15323324 + CustomAppearance.Element.IdleGradientType = bkConcave + CustomAppearance.Element.IdleInnerLightColor = 15852501 + CustomAppearance.Element.IdleInnerDarkColor = 15520702 + CustomAppearance.Element.IdleCaptionColor = 11631958 + CustomAppearance.Element.HotTrackFrameColor = 10211293 + CustomAppearance.Element.HotTrackGradientFromColor = 14351615 + CustomAppearance.Element.HotTrackGradientToColor = 5101567 + CustomAppearance.Element.HotTrackGradientType = bkConcave + CustomAppearance.Element.HotTrackInnerLightColor = 12972543 + CustomAppearance.Element.HotTrackInnerDarkColor = 8045272 + CustomAppearance.Element.HotTrackCaptionColor = 8864367 + CustomAppearance.Element.ActiveFrameColor = 5535371 + CustomAppearance.Element.ActiveGradientFromColor = 7126014 + CustomAppearance.Element.ActiveGradientToColor = 4035324 + CustomAppearance.Element.ActiveGradientType = bkConcave + CustomAppearance.Element.ActiveInnerLightColor = 961020 + CustomAppearance.Element.ActiveInnerDarkColor = 961020 + CustomAppearance.Element.ActiveCaptionColor = 8405614 + Caption = 'Sample toolbar' + OverrideAppearance = False + Visible = True + Panes = ( + 'SpkPane1' + 'SpkPane2' + 'SpkPane3') + object SpkPane1: TSpkPane + Caption = 'Sample large buttons' + Visible = True + Items = ( + 'SpkLargeButton1' + 'SpkLargeButton3' + 'SpkLargeButton2') + object SpkLargeButton1: TSpkLargeButton + Visible = True + Enabled = True + ButtonKind = bkButton + Caption = 'Default' + LargeImageIndex = -1 + end + object SpkLargeButton3: TSpkLargeButton + Visible = True + Enabled = True + ButtonKind = bkButtonDropdown + Caption = 'Button and dropdown' + LargeImageIndex = -1 + end + object SpkLargeButton2: TSpkLargeButton + Visible = True + Enabled = True + ButtonKind = bkDropdown + Caption = 'Dropdown' + LargeImageIndex = -1 + end + end + object SpkPane2: TSpkPane + Caption = 'Sample small buttons' + Visible = True + Items = ( + 'SpkSmallButton1' + 'SpkSmallButton2' + 'SpkSmallButton3') + object SpkSmallButton1: TSpkSmallButton + Visible = True + Enabled = True + ButtonKind = bkButton + Caption = 'Default' + ShowCaption = True + TableBehaviour = tbBeginsRow + GroupBehaviour = gbSingleItem + HideFrameWhenIdle = True + ImageIndex = -1 + end + object SpkSmallButton2: TSpkSmallButton + Visible = True + Enabled = True + ButtonKind = bkButtonDropdown + Caption = 'Button and dropdown' + ShowCaption = True + TableBehaviour = tbBeginsRow + GroupBehaviour = gbSingleItem + HideFrameWhenIdle = True + ImageIndex = -1 + end + object SpkSmallButton3: TSpkSmallButton + Visible = True + Enabled = True + ButtonKind = bkDropdown + Caption = 'Dropdown' + ShowCaption = True + TableBehaviour = tbBeginsRow + GroupBehaviour = gbSingleItem + HideFrameWhenIdle = True + ImageIndex = -1 + end + end + object SpkPane3: TSpkPane + Caption = 'Tool buttons' + Visible = True + Items = ( + 'SpkSmallButton4' + 'SpkSmallButton5' + 'SpkSmallButton6' + 'SpkSmallButton7' + 'SpkSmallButton8') + object SpkSmallButton4: TSpkSmallButton + Visible = True + Enabled = True + ButtonKind = bkButton + Caption = 'Button' + ShowCaption = False + TableBehaviour = tbContinuesRow + GroupBehaviour = gbBeginsGroup + HideFrameWhenIdle = False + ImageIndex = -1 + end + object SpkSmallButton5: TSpkSmallButton + Visible = True + Enabled = True + ButtonKind = bkButton + Caption = 'Button' + ShowCaption = False + TableBehaviour = tbContinuesRow + GroupBehaviour = gbContinuesGroup + HideFrameWhenIdle = False + ImageIndex = -1 + end + object SpkSmallButton6: TSpkSmallButton + Visible = True + Enabled = True + ButtonKind = bkButton + Caption = 'Button' + ShowCaption = False + TableBehaviour = tbContinuesRow + GroupBehaviour = gbEndsGroup + HideFrameWhenIdle = False + ImageIndex = -1 + end + object SpkSmallButton7: TSpkSmallButton + Visible = True + Enabled = True + ButtonKind = bkButton + Caption = 'Btn1' + ShowCaption = True + TableBehaviour = tbBeginsRow + GroupBehaviour = gbSingleItem + HideFrameWhenIdle = False + ImageIndex = -1 + end + object SpkSmallButton8: TSpkSmallButton + Visible = True + Enabled = True + ButtonKind = bkButton + Caption = 'Btn2' + ShowCaption = True + TableBehaviour = tbContinuesRow + GroupBehaviour = gbSingleItem + HideFrameWhenIdle = False + ImageIndex = -1 + end + end + end + end + end + object PageControl1: TPageControl + AlignWithMargins = True + Left = 3 + Top = 3 + Width = 559 + Height = 342 + ActivePage = TabSheet5 + Align = alTop + TabOrder = 1 + object TabSheet1: TTabSheet + Caption = 'Tab' + ExplicitLeft = 3 + ExplicitTop = 28 + ExplicitWidth = 545 + ExplicitHeight = 281 + object Label2: TLabel + Left = 12 + Top = 43 + Width = 30 + Height = 13 + Caption = 'Frame' + end + object Label3: TLabel + Left = 12 + Top = 74 + Width = 66 + Height = 13 + Caption = 'Gradient from' + end + object Label4: TLabel + Left = 12 + Top = 105 + Width = 54 + Height = 13 + Caption = 'Gradient to' + end + object Label5: TLabel + Left = 12 + Top = 136 + Width = 63 + Height = 13 + Caption = 'Gradient kind' + end + object Label6: TLabel + Left = 12 + Top = 175 + Width = 78 + Height = 13 + Caption = 'Tab header font' + end + object sTabRectangle: TShape + Left = 96 + Top = 27 + Width = 137 + Height = 136 + Visible = False + end + object pTabFrame: TPanel + Left = 104 + Top = 37 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 0 + OnClick = pTabFrameClick + end + object pTabGradientFrom: TPanel + Left = 104 + Top = 68 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 1 + OnClick = pTabGradientFromClick + end + object pTabGradientTo: TPanel + Left = 104 + Top = 99 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 2 + OnClick = pTabGradientToClick + end + object cbTabGradientKind: TComboBox + Left = 104 + Top = 133 + Width = 121 + Height = 21 + Style = csDropDownList + ItemHeight = 13 + ItemIndex = 0 + TabOrder = 3 + Text = 'None' + OnChange = cbTabGradientKindChange + Items.Strings = ( + 'None' + 'Horizontal' + 'Vertical' + 'Concave') + end + object pTabHeaderFont: TPanel + Left = 104 + Top = 169 + Width = 73 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Font' + TabOrder = 4 + OnClick = pTabHeaderFontClick + end + object pTabHeaderFontColor: TPanel + Left = 183 + Top = 169 + Width = 42 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 5 + OnClick = pTabHeaderFontColorClick + end + object cbLinkTab: TCheckBox + Left = 96 + Top = 4 + Width = 153 + Height = 17 + Caption = 'Link with pane and idle item' + TabOrder = 6 + OnClick = cbLinkTabClick + end + end + object TabSheet2: TTabSheet + Caption = 'Pane' + ImageIndex = 1 + ExplicitLeft = 5 + ExplicitTop = 28 + ExplicitWidth = 545 + ExplicitHeight = 281 + object Label8: TLabel + Left = 12 + Top = 40 + Width = 56 + Height = 13 + Caption = 'Border dark' + end + object Label21: TLabel + Left = 12 + Top = 71 + Width = 55 + Height = 13 + Caption = 'Border light' + end + object Label9: TLabel + Left = 12 + Top = 102 + Width = 66 + Height = 13 + Caption = 'Gradient from' + end + object Label10: TLabel + Left = 12 + Top = 133 + Width = 54 + Height = 13 + Caption = 'Gradient to' + end + object Label11: TLabel + Left = 12 + Top = 161 + Width = 63 + Height = 13 + Caption = 'Gradient kind' + end + object Label12: TLabel + Left = 12 + Top = 201 + Width = 96 + Height = 13 + Caption = 'Caption background' + end + object Label13: TLabel + Left = 12 + Top = 232 + Width = 85 + Height = 13 + Caption = 'Pane caption font' + end + object sPaneRectangle: TShape + Left = 115 + Top = 26 + Width = 137 + Height = 163 + end + object pPaneBorderDark: TPanel + Left = 123 + Top = 34 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 0 + OnClick = pPaneBorderDarkClick + end + object pPaneBorderLight: TPanel + Left = 123 + Top = 65 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 1 + OnClick = pPaneBorderLightClick + end + object pPaneGradientFrom: TPanel + Left = 123 + Top = 96 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 2 + OnClick = pPaneGradientFromClick + end + object pPaneGradientTo: TPanel + Left = 123 + Top = 127 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 3 + OnClick = pPaneGradientToClick + end + object cbPaneGradientKind: TComboBox + Left = 123 + Top = 158 + Width = 121 + Height = 21 + Style = csDropDownList + ItemHeight = 13 + ItemIndex = 0 + TabOrder = 4 + Text = 'None' + OnChange = cbPaneGradientKindChange + Items.Strings = ( + 'None' + 'Horizontal' + 'Vertical' + 'Concave') + end + object pPaneCaptionBackground: TPanel + Left = 123 + Top = 195 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 5 + OnClick = pPaneCaptionBackgroundClick + end + object pPaneCaptionFont: TPanel + Left = 123 + Top = 226 + Width = 73 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Font' + TabOrder = 6 + OnClick = pPaneCaptionFontClick + end + object pPaneCaptionFontColor: TPanel + Left = 202 + Top = 226 + Width = 42 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 7 + OnClick = pPaneCaptionFontColorClick + end + object cbLinkPane: TCheckBox + Left = 115 + Top = 3 + Width = 153 + Height = 17 + Caption = 'Link with tab and idle item' + TabOrder = 8 + OnClick = cbLinkPaneClick + end + end + object TabSheet3: TTabSheet + Caption = 'Item' + ImageIndex = 2 + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 273 + ExplicitHeight = 373 + object sItemRectangle: TShape + Left = 112 + Top = 26 + Width = 137 + Height = 240 + Visible = False + end + object Label1: TLabel + Left = 12 + Top = 57 + Width = 30 + Height = 13 + Caption = 'Frame' + end + object Label7: TLabel + Left = 12 + Top = 88 + Width = 66 + Height = 13 + Caption = 'Gradient from' + end + object Label14: TLabel + Left = 12 + Top = 119 + Width = 54 + Height = 13 + Caption = 'Gradient to' + end + object Label25: TLabel + Left = 12 + Top = 147 + Width = 63 + Height = 13 + Caption = 'Gradient kind' + end + object Label26: TLabel + Left = 12 + Top = 278 + Width = 45 + Height = 13 + Caption = 'Item font' + end + object Label27: TLabel + Left = 120 + Top = 32 + Width = 121 + Height = 13 + Alignment = taCenter + AutoSize = False + Caption = 'Idle' + end + object Label28: TLabel + Left = 12 + Top = 177 + Width = 63 + Height = 13 + Caption = 'Caption color' + end + object Label29: TLabel + Left = 12 + Top = 208 + Width = 76 + Height = 13 + Caption = 'Inner dark color' + end + object Label30: TLabel + Left = 12 + Top = 239 + Width = 75 + Height = 13 + Caption = 'Inner light color' + end + object Label15: TLabel + Left = 255 + Top = 32 + Width = 121 + Height = 13 + Alignment = taCenter + AutoSize = False + Caption = 'Hottrack' + end + object Label16: TLabel + Left = 391 + Top = 32 + Width = 121 + Height = 13 + Alignment = taCenter + AutoSize = False + Caption = 'Active' + end + object pItemFont: TPanel + Left = 120 + Top = 272 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Font' + TabOrder = 0 + OnClick = pItemFontClick + end + object cbItemIdleGradientKind: TComboBox + Left = 120 + Top = 144 + Width = 121 + Height = 21 + Style = csDropDownList + ItemHeight = 13 + ItemIndex = 0 + TabOrder = 1 + Text = 'None' + OnChange = cbItemIdleGradientKindChange + Items.Strings = ( + 'None' + 'Horizontal' + 'Vertical' + 'Concave') + end + object pItemIdleGradientTo: TPanel + Left = 120 + Top = 113 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 2 + OnClick = pItemIdleGradientToClick + end + object pItemIdleGradientFrom: TPanel + Left = 120 + Top = 82 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 3 + OnClick = pItemIdleGradientFromClick + end + object pItemIdleFrame: TPanel + Left = 120 + Top = 51 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 4 + OnClick = pItemIdleFrameClick + end + object pItemIdleCaptionColor: TPanel + Left = 120 + Top = 171 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 5 + OnClick = pItemIdleCaptionColorClick + end + object pItemIdleInnerDark: TPanel + Left = 120 + Top = 202 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 6 + OnClick = pItemIdleInnerDarkClick + end + object pItemIdleInnerLight: TPanel + Left = 120 + Top = 233 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 7 + OnClick = pItemIdleInnerLightClick + end + object cbItemHottrackGradientKind: TComboBox + Left = 255 + Top = 144 + Width = 121 + Height = 21 + Style = csDropDownList + ItemHeight = 13 + ItemIndex = 0 + TabOrder = 8 + Text = 'None' + OnChange = cbItemHottrackGradientKindChange + Items.Strings = ( + 'None' + 'Horizontal' + 'Vertical' + 'Concave') + end + object pItemHottrackGradientTo: TPanel + Left = 255 + Top = 113 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 9 + OnClick = pItemHottrackGradientToClick + end + object pItemHottrackGradientFrom: TPanel + Left = 255 + Top = 82 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 10 + OnClick = pItemHottrackGradientFromClick + end + object pItemHottrackFrame: TPanel + Left = 255 + Top = 51 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 11 + OnClick = pItemHottrackFrameClick + end + object pItemHottrackCaptionColor: TPanel + Left = 255 + Top = 171 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 12 + OnClick = pItemHottrackCaptionColorClick + end + object pItemHottrackInnerDark: TPanel + Left = 255 + Top = 202 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 13 + OnClick = pItemHottrackInnerDarkClick + end + object pItemHottrackInnerLight: TPanel + Left = 255 + Top = 233 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 14 + OnClick = pItemHottrackInnerLightClick + end + object cbItemActiveGradientKind: TComboBox + Left = 391 + Top = 144 + Width = 121 + Height = 21 + Style = csDropDownList + ItemHeight = 13 + ItemIndex = 0 + TabOrder = 15 + Text = 'None' + OnChange = cbItemActiveGradientKindChange + Items.Strings = ( + 'None' + 'Horizontal' + 'Vertical' + 'Concave') + end + object pItemActiveGradientTo: TPanel + Left = 391 + Top = 113 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 16 + OnClick = pItemActiveGradientToClick + end + object pItemActiveGradientFrom: TPanel + Left = 391 + Top = 82 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 17 + OnClick = pItemActiveGradientFromClick + end + object pItemActiveFrame: TPanel + Left = 391 + Top = 51 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 18 + OnClick = pItemActiveFrameClick + end + object pItemActiveCaptionColor: TPanel + Left = 391 + Top = 171 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 19 + OnClick = pItemActiveCaptionColorClick + end + object pItemActiveInnerDark: TPanel + Left = 391 + Top = 202 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 20 + OnClick = pItemActiveInnerDarkClick + end + object pItemActiveInnerLight: TPanel + Left = 391 + Top = 233 + Width = 121 + Height = 25 + BevelInner = bvRaised + BevelOuter = bvLowered + Caption = 'Color' + ParentBackground = False + TabOrder = 21 + OnClick = pItemActiveInnerLightClick + end + object cbLinkItem: TCheckBox + Left = 112 + Top = 3 + Width = 137 + Height = 17 + Caption = 'Link with tab and pane' + TabOrder = 22 + OnClick = cbLinkItemClick + end + end + object TabSheet4: TTabSheet + Caption = 'Import / export' + ImageIndex = 3 + object bImport: TButton + Left = 119 + Top = 3 + Width = 110 + Height = 25 + Caption = 'Import from XML' + TabOrder = 0 + OnClick = bImportClick + end + object bExport: TButton + Left = 3 + Top = 3 + Width = 110 + Height = 25 + Caption = 'Export to XML' + TabOrder = 1 + OnClick = bExportClick + end + object mXML: TMemo + Left = 3 + Top = 34 + Width = 539 + Height = 244 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Courier New' + Font.Style = [] + ParentFont = False + TabOrder = 2 + end + end + object TabSheet5: TTabSheet + Caption = 'Tools' + ImageIndex = 4 + object Label17: TLabel + Left = 3 + Top = 8 + Width = 83 + Height = 13 + Caption = 'Reset to defaults' + end + object bReset: TButton + Left = 120 + Top = 3 + Width = 105 + Height = 25 + Caption = 'Reset' + TabOrder = 0 + OnClick = bResetClick + end + end + end + object bOK: TButton + Left = 343 + Top = 494 + Width = 104 + Height = 25 + Caption = 'OK' + Default = True + ModalResult = 1 + TabOrder = 2 + end + object bCancel: TButton + Left = 453 + Top = 494 + Width = 104 + Height = 25 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 3 + end + object cdColorDialog: TColorDialog + Left = 7 + Top = 459 + end + object fdFontDialog: TFontDialog + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Left = 39 + Top = 459 + end +end diff --git a/components/spktoolbar/SpkToolbar - designtime/spkte_AppearanceEditor.pas b/components/spktoolbar/SpkToolbar - designtime/spkte_AppearanceEditor.pas new file mode 100644 index 000000000..39d20ecc1 --- /dev/null +++ b/components/spktoolbar/SpkToolbar - designtime/spkte_AppearanceEditor.pas @@ -0,0 +1,740 @@ +unit spkte_AppearanceEditor; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, ExtCtrls, StdCtrls, ComCtrls, + SpkGUITools, SpkXMLParser, + spkt_Buttons, spkt_BaseItem, spkt_Pane, spkt_Types, spkt_Tab, SpkToolbar, + spkt_Appearance; + +type + TfrmAppearanceEditWindow = class(TForm) + gbPreview: TGroupBox; + tbPreview: TSpkToolbar; + SpkTab1: TSpkTab; + SpkPane1: TSpkPane; + SpkLargeButton1: TSpkLargeButton; + SpkLargeButton3: TSpkLargeButton; + SpkLargeButton2: TSpkLargeButton; + SpkPane2: TSpkPane; + SpkSmallButton1: TSpkSmallButton; + SpkSmallButton2: TSpkSmallButton; + SpkSmallButton3: TSpkSmallButton; + SpkPane3: TSpkPane; + SpkSmallButton4: TSpkSmallButton; + SpkSmallButton5: TSpkSmallButton; + SpkSmallButton6: TSpkSmallButton; + SpkSmallButton7: TSpkSmallButton; + SpkSmallButton8: TSpkSmallButton; + PageControl1: TPageControl; + TabSheet1: TTabSheet; + TabSheet2: TTabSheet; + TabSheet3: TTabSheet; + Label2: TLabel; + pTabFrame: TPanel; + pTabGradientFrom: TPanel; + Label3: TLabel; + Label4: TLabel; + pTabGradientTo: TPanel; + cbTabGradientKind: TComboBox; + Label5: TLabel; + Label6: TLabel; + pTabHeaderFont: TPanel; + Label8: TLabel; + pPaneBorderDark: TPanel; + pPaneBorderLight: TPanel; + Label21: TLabel; + Label9: TLabel; + pPaneGradientFrom: TPanel; + pPaneGradientTo: TPanel; + Label10: TLabel; + Label11: TLabel; + cbPaneGradientKind: TComboBox; + pPaneCaptionBackground: TPanel; + Label12: TLabel; + Label13: TLabel; + pPaneCaptionFont: TPanel; + Label1: TLabel; + Label7: TLabel; + Label14: TLabel; + Label25: TLabel; + Label26: TLabel; + pItemFont: TPanel; + cbItemIdleGradientKind: TComboBox; + pItemIdleGradientTo: TPanel; + pItemIdleGradientFrom: TPanel; + pItemIdleFrame: TPanel; + Label27: TLabel; + Label28: TLabel; + pItemIdleCaptionColor: TPanel; + Label29: TLabel; + pItemIdleInnerDark: TPanel; + Label30: TLabel; + pItemIdleInnerLight: TPanel; + cbItemHottrackGradientKind: TComboBox; + pItemHottrackGradientTo: TPanel; + pItemHottrackGradientFrom: TPanel; + pItemHottrackFrame: TPanel; + Label15: TLabel; + pItemHottrackCaptionColor: TPanel; + pItemHottrackInnerDark: TPanel; + pItemHottrackInnerLight: TPanel; + cbItemActiveGradientKind: TComboBox; + pItemActiveGradientTo: TPanel; + pItemActiveGradientFrom: TPanel; + pItemActiveFrame: TPanel; + Label16: TLabel; + pItemActiveCaptionColor: TPanel; + pItemActiveInnerDark: TPanel; + pItemActiveInnerLight: TPanel; + bOK: TButton; + bCancel: TButton; + cdColorDialog: TColorDialog; + fdFontDialog: TFontDialog; + pTabHeaderFontColor: TPanel; + pPaneCaptionFontColor: TPanel; + TabSheet4: TTabSheet; + bImport: TButton; + bExport: TButton; + mXML: TMemo; + sTabRectangle: TShape; + cbLinkTab: TCheckBox; + sPaneRectangle: TShape; + cbLinkPane: TCheckBox; + cbLinkItem: TCheckBox; + sItemRectangle: TShape; + TabSheet5: TTabSheet; + Label17: TLabel; + bReset: TButton; + procedure pTabFrameClick(Sender: TObject); + procedure pTabGradientFromClick(Sender: TObject); + procedure pTabGradientToClick(Sender: TObject); + procedure pPaneBorderDarkClick(Sender: TObject); + procedure pPaneBorderLightClick(Sender: TObject); + procedure pPaneGradientFromClick(Sender: TObject); + procedure pPaneGradientToClick(Sender: TObject); + procedure pPaneCaptionBackgroundClick(Sender: TObject); + procedure pItemIdleFrameClick(Sender: TObject); + procedure pItemIdleGradientFromClick(Sender: TObject); + procedure pItemIdleGradientToClick(Sender: TObject); + procedure pItemIdleCaptionColorClick(Sender: TObject); + procedure pItemIdleInnerDarkClick(Sender: TObject); + procedure pItemIdleInnerLightClick(Sender: TObject); + procedure pItemHottrackFrameClick(Sender: TObject); + procedure pItemHottrackGradientFromClick(Sender: TObject); + procedure pItemHottrackGradientToClick(Sender: TObject); + procedure pItemHottrackCaptionColorClick(Sender: TObject); + procedure pItemHottrackInnerDarkClick(Sender: TObject); + procedure pItemHottrackInnerLightClick(Sender: TObject); + procedure pItemActiveFrameClick(Sender: TObject); + procedure pItemActiveGradientFromClick(Sender: TObject); + procedure pItemActiveGradientToClick(Sender: TObject); + procedure pItemActiveCaptionColorClick(Sender: TObject); + procedure pItemActiveInnerDarkClick(Sender: TObject); + procedure pItemActiveInnerLightClick(Sender: TObject); + procedure pTabHeaderFontClick(Sender: TObject); + procedure pPaneCaptionFontClick(Sender: TObject); + procedure pItemFontClick(Sender: TObject); + procedure cbTabGradientKindChange(Sender: TObject); + procedure cbPaneGradientKindChange(Sender: TObject); + procedure cbItemIdleGradientKindChange(Sender: TObject); + procedure cbItemHottrackGradientKindChange(Sender: TObject); + procedure cbItemActiveGradientKindChange(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure pTabHeaderFontColorClick(Sender: TObject); + procedure pPaneCaptionFontColorClick(Sender: TObject); + procedure bExportClick(Sender: TObject); + procedure bImportClick(Sender: TObject); + procedure cbLinkTabClick(Sender: TObject); + procedure cbLinkPaneClick(Sender: TObject); + procedure cbLinkItemClick(Sender: TObject); + procedure bResetClick(Sender: TObject); + private + { Private declarations } + procedure SetLinkedFrameColor(AColor : TColor); + procedure SetLinkedGradientFromColor(AColor : TColor); + procedure SetLinkedGradientToColor(AColor : TColor); + procedure SetLinkedGradientKind(AKindIndex : integer); + + function GetAppearance: TSpkToolbarAppearance; + procedure SetAppearance(const Value: TSpkToolbarAppearance); + + procedure SwitchAttributesLink(const Value : boolean); + + function ChangeColor(Panel : TPanel) : boolean; + procedure SetPanelColor(Panel: TPanel; AColor : TColor); + function ChangeFont(Panel : TPanel) : boolean; + procedure SetPanelFont(Panel : TPanel; AFont : TFont); + procedure SetComboGradientKind(Combo : TComboBox; GradientType : TBackgroundKind); + procedure LoadAppearance(AAppearance : TSpkToolbarAppearance); + public + property Appearance : TSpkToolbarAppearance read GetAppearance write SetAppearance; + { Public declarations } + end; + +var + frmAppearanceEditWindow: TfrmAppearanceEditWindow; + +implementation + +{$R *.dfm} + +{ TForm3 } + +procedure TfrmAppearanceEditWindow.SetAppearance(const Value: TSpkToolbarAppearance); +begin +tbPreview.Appearance.Assign(Value); +end; + +procedure TfrmAppearanceEditWindow.SetComboGradientKind(Combo: TComboBox; + GradientType: TBackgroundKind); +begin +case GradientType of + bkSolid: Combo.itemindex:=0; + bkHorizontalGradient: Combo.itemindex:=1; + bkVerticalGradient: Combo.itemindex:=2; + bkConcave: Combo.itemindex:=3; +end; +end; + +procedure TfrmAppearanceEditWindow.SetLinkedFrameColor(AColor: TColor); +begin +tbPreview.Appearance.Tab.BorderColor:=AColor; +SetPanelColor(pTabFrame, AColor); + +tbPreview.Appearance.Pane.BorderDarkColor:=AColor; +SetPanelColor(pPaneBorderDark, AColor); + +tbPreview.Appearance.Element.IdleFrameColor:=AColor; +SetPanelColor(pItemIdleFrame, AColor); +end; + +procedure TfrmAppearanceEditWindow.SetLinkedGradientFromColor(AColor: TColor); +begin +tbPreview.Appearance.Tab.GradientFromColor:=AColor; +SetPanelColor(pTabGradientFrom, AColor); + +tbPreview.Appearance.Pane.GradientFromColor:=AColor; +SetPanelColor(pPaneGradientFrom, AColor); + +tbPreview.Appearance.Element.IdleGradientFromColor:=AColor; +SetPanelColor(pItemIdleGradientFrom, AColor); +end; + +procedure TfrmAppearanceEditWindow.SetLinkedGradientKind(AKindIndex: integer); + +var Kind : TBackgroundKind; + +begin +case AKindIndex of + 0 : Kind:=bkSolid; + 1 : Kind:=bkHorizontalGradient; + 2 : Kind:=bkVerticalGradient; + 3 : Kind:=bkConcave; +else Kind:=bkSolid; +end; + +tbPreview.Appearance.Tab.GradientType:=Kind; +SetComboGradientKind(cbTabGradientKind, Kind); + +tbPreview.Appearance.Pane.GradientType:=Kind; +SetComboGradientKind(cbPaneGradientKind, Kind); + +tbPreview.Appearance.Element.IdleGradientType:=Kind; +SetComboGradientKind(cbItemIdleGradientKind, Kind); +end; + +procedure TfrmAppearanceEditWindow.SetLinkedGradientToColor(AColor: TColor); +begin +tbPreview.Appearance.Tab.GradientToColor:=AColor; +SetPanelColor(pTabGradientTo, AColor); + +tbPreview.Appearance.Pane.GradientToColor:=AColor; +SetPanelColor(pPaneGradientTo, AColor); + +tbPreview.Appearance.Element.IdleGradientToColor:=AColor; +SetPanelColor(pItemIdleGradientTo, AColor); +end; + +procedure TfrmAppearanceEditWindow.SetPanelColor(Panel: TPanel; AColor : TColor); +begin + Panel.Color := AColor; + if Panel.Color<>AColor then + Showmessage('lipa!'); + if (GetRValue(AColor) + GetGValue(AColor) + GetBValue(AColor)) div 3 >= 128 then + Panel.Font.Color := clBlack + else + Panel.Font.Color := clWhite; + Panel.Caption := '$' + IntToHex(AColor, 8); +end; + +procedure TfrmAppearanceEditWindow.SetPanelFont(Panel: TPanel; AFont: TFont); +begin +Panel.Font.assign(AFont); +Panel.Caption:=AFont.Name+', '+inttostr(AFont.Size); +end; + +procedure TfrmAppearanceEditWindow.SwitchAttributesLink(const Value: boolean); +begin +cbLinkTab.checked:=Value; +cbLinkPane.Checked:=Value; +cbLinkItem.Checked:=Value; + +sTabRectangle.visible:=Value; +sPaneRectangle.Visible:=Value; +sItemRectangle.Visible:=Value; +end; + +procedure TfrmAppearanceEditWindow.cbItemHottrackGradientKindChange(Sender: TObject); +begin +case (Sender as TCombobox).ItemIndex of + 0 : tbPreview.Appearance.Element.HottrackGradientType:=bkSolid; + 1 : tbPreview.Appearance.Element.HottrackGradientType:=bkHorizontalGradient; + 2 : tbPreview.Appearance.Element.HottrackGradientType:=bkVerticalGradient; + 3 : tbPreview.Appearance.Element.HottrackGradientType:=bkConcave; +end; +end; + +procedure TfrmAppearanceEditWindow.cbItemIdleGradientKindChange(Sender: TObject); +begin +case (Sender as TCombobox).ItemIndex of + 0 : tbPreview.Appearance.Element.IdleGradientType:=bkSolid; + 1 : tbPreview.Appearance.Element.IdleGradientType:=bkHorizontalGradient; + 2 : tbPreview.Appearance.Element.IdleGradientType:=bkVerticalGradient; + 3 : tbPreview.Appearance.Element.IdleGradientType:=bkConcave; +end; + +if cbLinkItem.Checked then + SetLinkedGradientKind((Sender as TComboBox).ItemIndex); +end; + +procedure TfrmAppearanceEditWindow.cbLinkItemClick(Sender: TObject); +begin +SwitchAttributesLink(cbLinkItem.Checked); +end; + +procedure TfrmAppearanceEditWindow.cbLinkPaneClick(Sender: TObject); +begin +SwitchAttributesLink(cbLinkPane.Checked); +end; + +procedure TfrmAppearanceEditWindow.cbLinkTabClick(Sender: TObject); +begin +SwitchAttributesLink(cbLinkTab.Checked); +end; + +procedure TfrmAppearanceEditWindow.cbTabGradientKindChange(Sender: TObject); +begin +case (Sender as TCombobox).ItemIndex of + 0 : tbPreview.Appearance.Tab.GradientType:=bkSolid; + 1 : tbPreview.Appearance.Tab.GradientType:=bkHorizontalGradient; + 2 : tbPreview.Appearance.Tab.GradientType:=bkVerticalGradient; + 3 : tbPreview.Appearance.Tab.GradientType:=bkConcave; +end; + +if cbLinkTab.Checked then + SetLinkedGradientKind((Sender as TComboBox).ItemIndex); +end; + +function TfrmAppearanceEditWindow.ChangeColor(Panel: TPanel): boolean; +begin +cdColorDialog.Color:=Panel.Color; +if cdColorDialog.Execute then + begin + SetPanelColor(Panel, cdColorDialog.Color); + result:=true + end +else + result:=false; +end; + +function TfrmAppearanceEditWindow.ChangeFont(Panel: TPanel): boolean; +begin +fdFontDialog.Font.assign(Panel.font); +if fdFontDialog.Execute then + begin + SetPanelFont(Panel, fdFontDialog.Font); + result:=true; + end +else + result:=false; +end; + +procedure TfrmAppearanceEditWindow.FormShow(Sender: TObject); +begin +LoadAppearance(tbPreview.Appearance); +end; + +function TfrmAppearanceEditWindow.GetAppearance: TSpkToolbarAppearance; +begin +result:=tbPreview.Appearance; +end; + +procedure TfrmAppearanceEditWindow.LoadAppearance(AAppearance: TSpkToolbarAppearance); +begin +with AAppearance do + begin + with Tab do + begin + SetPanelColor(pTabFrame, BorderColor); + SetPanelColor(pTabGradientFrom, GradientFromColor); + SetPanelColor(pTabGradientTo, GradientToColor); + SetComboGradientKind(cbTabGradientKind, GradientType); + SetPanelFont(pTabHeaderFont, TabHeaderFont); + SetPanelColor(pTabHeaderFontColor, TabHeaderFont.Color); + end; + + with Pane do + begin + SetPanelColor(pPaneBorderDark, BorderDarkColor); + SetPanelColor(pPaneBorderLight, BorderLightColor); + SetPanelColor(pPaneGradientFrom, GradientFromColor); + SetPanelColor(pPaneGradientTo, GradientToColor); + SetComboGradientKind(cbPaneGradientKind, GradientType); + SetPanelColor(pPaneCaptionBackground, CaptionBgColor); + SetPanelFont(pPaneCaptionFont, CaptionFont); + SetPanelColor(pPaneCaptionFontColor, CaptionFont.Color); + end; + + with Element do + begin + SetPanelFont(pItemFont, CaptionFont); + + SetPanelColor(pItemIdleFrame, IdleFrameColor); + SetPanelColor(pItemIdleGradientFrom, IdleGradientFromColor); + SetPanelColor(pItemIdleGradientTo, IdleGradientToColor); + SetComboGradientKind(cbItemIdleGradientKind, IdleGradientType); + SetPanelColor(pItemIdleCaptionColor, IdleCaptionColor); + SetPanelColor(pItemIdleInnerDark, IdleInnerDarkColor); + SetPanelColor(pItemIdleInnerLight, IdleInnerLightColor); + + SetPanelColor(pItemHottrackFrame, HottrackFrameColor); + SetPanelColor(pItemHottrackGradientFrom, HottrackGradientFromColor); + SetPanelColor(pItemHottrackGradientTo, HottrackGradientToColor); + SetComboGradientKind(cbItemHottrackGradientKind, HottrackGradientType); + SetPanelColor(pItemHottrackCaptionColor, HottrackCaptionColor); + SetPanelColor(pItemHottrackInnerDark, HottrackInnerDarkColor); + SetPanelColor(pItemHottrackInnerLight, HottrackInnerLightColor); + + SetPanelColor(pItemActiveFrame, ActiveFrameColor); + SetPanelColor(pItemActiveGradientFrom, ActiveGradientFromColor); + SetPanelColor(pItemActiveGradientTo, ActiveGradientToColor); + SetComboGradientKind(cbItemActiveGradientKind, ActiveGradientType); + SetPanelColor(pItemActiveCaptionColor, ActiveCaptionColor); + SetPanelColor(pItemActiveInnerDark, ActiveInnerDarkColor); + SetPanelColor(pItemActiveInnerLight, ActiveInnerLightColor); + end; + end; +end; + +procedure TfrmAppearanceEditWindow.pItemActiveCaptionColorClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + tbPreview.Appearance.Element.ActiveCaptionColor:=(Sender as TPanel).Color; +end; + +procedure TfrmAppearanceEditWindow.pItemActiveFrameClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + tbPreview.Appearance.Element.ActiveFrameColor:=(Sender as TPanel).Color; +end; + +procedure TfrmAppearanceEditWindow.pItemActiveGradientFromClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + tbPreview.Appearance.Element.ActiveGradientFromColor:=(Sender as TPanel).Color; +end; + +procedure TfrmAppearanceEditWindow.bExportClick(Sender: TObject); + +var Xml : TSpkXMLParser; + Node : TSpkXMLNode; + +begin +XML:=TSpkXMLParser.Create; +try + Node:=XML['Appearance',true]; + tbPreview.Appearance.SaveToXML(Node); + + mXML.Clear; + mXml.Text:=XML.Generate; +finally + XML.Free; +end; +end; + +procedure TfrmAppearanceEditWindow.bImportClick(Sender: TObject); + +var XML : TSpkXMLParser; + Node: TSpkXMLNode; + +begin +tbPreview.BeginUpdate; +XML:=TSpkXMLParser.Create; +try + XML.Parse(PChar(mXML.text)); + Node:=XML['Appearance',false]; + if assigned(Node) then + tbPreview.Appearance.LoadFromXML(Node); + LoadAppearance(tbPreview.Appearance); +finally + XML.Free; + tbPreview.EndUpdate; + tbPreview.ForceRepaint; +end; +end; + +procedure TfrmAppearanceEditWindow.bResetClick(Sender: TObject); +begin +tbPreview.Appearance.Reset; +LoadAppearance(tbPreview.Appearance); +end; + +procedure TfrmAppearanceEditWindow.cbItemActiveGradientKindChange(Sender: TObject); +begin +case (Sender as TCombobox).ItemIndex of + 0 : tbPreview.Appearance.Element.ActiveGradientType:=bkSolid; + 1 : tbPreview.Appearance.Element.ActiveGradientType:=bkHorizontalGradient; + 2 : tbPreview.Appearance.Element.ActiveGradientType:=bkVerticalGradient; + 3 : tbPreview.Appearance.Element.ActiveGradientType:=bkConcave; +end; +end; + +procedure TfrmAppearanceEditWindow.pItemActiveGradientToClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + tbPreview.Appearance.Element.ActiveGradientToColor:=(Sender as TPanel).Color; +end; + +procedure TfrmAppearanceEditWindow.pItemActiveInnerDarkClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + tbPreview.Appearance.Element.ActiveInnerDarkColor:=(Sender as TPanel).Color; +end; + +procedure TfrmAppearanceEditWindow.pItemActiveInnerLightClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + tbPreview.Appearance.Element.ActiveInnerLightColor:=(Sender as TPanel).Color; +end; + +procedure TfrmAppearanceEditWindow.pItemHottrackCaptionColorClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + tbPreview.Appearance.Element.HotTrackCaptionColor:=(Sender as TPanel).Color; +end; + +procedure TfrmAppearanceEditWindow.pItemHottrackFrameClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + tbPreview.Appearance.Element.HotTrackFrameColor:=(Sender as TPanel).Color; +end; + +procedure TfrmAppearanceEditWindow.pItemHottrackGradientFromClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + tbPreview.Appearance.Element.HotTrackGradientFromColor:=(Sender as TPanel).Color; +end; + +procedure TfrmAppearanceEditWindow.pItemHottrackGradientToClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + tbPreview.Appearance.Element.HotTrackGradientToColor:=(Sender as TPanel).Color; +end; + +procedure TfrmAppearanceEditWindow.pItemHottrackInnerDarkClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + tbPreview.Appearance.Element.HotTrackInnerDarkColor:=(Sender as TPanel).Color; +end; + +procedure TfrmAppearanceEditWindow.pItemHottrackInnerLightClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + tbPreview.Appearance.Element.HotTrackInnerLightColor:=(Sender as TPanel).Color; +end; + +procedure TfrmAppearanceEditWindow.pItemIdleCaptionColorClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + tbPreview.Appearance.Element.IdleCaptionColor:=(Sender as TPanel).Color; +end; + +procedure TfrmAppearanceEditWindow.pItemIdleFrameClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + begin + tbPreview.Appearance.Element.IdleFrameColor:=(Sender as TPanel).Color; + + if cbLinkItem.Checked then + SetLinkedFrameColor((Sender as TPanel).Color); + end; +end; + +procedure TfrmAppearanceEditWindow.pItemIdleGradientFromClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + begin + tbPreview.Appearance.Element.IdleGradientFromColor:=(Sender as TPanel).Color; + + if cbLinkItem.Checked then + SetLinkedGradientFromColor((Sender as TPanel).Color); + end; +end; + +procedure TfrmAppearanceEditWindow.pItemIdleGradientToClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + begin + tbPreview.Appearance.Element.IdleGradientToColor:=(Sender as TPanel).Color; + + if cbLinkItem.Checked then + SetLinkedGradientToColor((Sender as TPanel).Color); + end; +end; + +procedure TfrmAppearanceEditWindow.pItemIdleInnerDarkClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + tbPreview.Appearance.Element.IdleInnerDarkColor:=(Sender as TPanel).Color; +end; + +procedure TfrmAppearanceEditWindow.pItemIdleInnerLightClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + tbPreview.Appearance.Element.IdleInnerLightColor:=(Sender as TPanel).Color; +end; + +procedure TfrmAppearanceEditWindow.pItemFontClick(Sender: TObject); +begin +if ChangeFont(Sender as TPanel) then + tbPreview.Appearance.Element.CaptionFont.Assign((Sender as TPanel).Font); +tbPreview.ForceRepaint; +end; + +procedure TfrmAppearanceEditWindow.pPaneBorderDarkClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + begin + tbPreview.Appearance.Pane.BorderDarkColor:=(Sender as TPanel).Color; + + if cbLinkPane.Checked then + SetLinkedFrameColor((Sender as TPanel).Color); + end; +end; + +procedure TfrmAppearanceEditWindow.pPaneBorderLightClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + tbPreview.Appearance.Pane.BorderLightColor:=(Sender as TPanel).Color; +end; + +procedure TfrmAppearanceEditWindow.pPaneCaptionBackgroundClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + tbPreview.Appearance.Pane.CaptionBgColor:=(Sender as TPanel).Color; +end; + +procedure TfrmAppearanceEditWindow.pPaneCaptionFontClick(Sender: TObject); +begin +if ChangeFont(Sender as TPanel) then + tbPreview.Appearance.Pane.CaptionFont.Assign((Sender as TPanel).Font); +tbPreview.ForceRepaint; +end; + +procedure TfrmAppearanceEditWindow.pPaneCaptionFontColorClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + begin + tbPreview.Appearance.Pane.CaptionFont.Color:=((Sender as TPanel).Color); + pPaneCaptionFont.Font.color:=((Sender as TPanel).Color); + end; +end; + +procedure TfrmAppearanceEditWindow.pPaneGradientFromClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + begin + tbPreview.Appearance.Pane.GradientFromColor:=(Sender as TPanel).Color; + + if cbLinkPane.Checked then + SetLinkedGradientFromColor((Sender as TPanel).Color); + end; +end; + +procedure TfrmAppearanceEditWindow.cbPaneGradientKindChange(Sender: TObject); +begin +case (Sender as TCombobox).ItemIndex of + 0 : tbPreview.Appearance.Pane.GradientType:=bkSolid; + 1 : tbPreview.Appearance.Pane.GradientType:=bkHorizontalGradient; + 2 : tbPreview.Appearance.Pane.GradientType:=bkVerticalGradient; + 3 : tbPreview.Appearance.Pane.GradientType:=bkConcave; +end; + +if cbLinkPane.Checked then + SetLinkedGradientKind((Sender as TComboBox).ItemIndex); +end; + +procedure TfrmAppearanceEditWindow.pPaneGradientToClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + begin + tbPreview.Appearance.Pane.GradientToColor:=(Sender as TPanel).Color; + + if cbLinkPane.Checked then + SetLinkedGradientToColor((Sender as TPanel).Color); + end; +end; + +procedure TfrmAppearanceEditWindow.pTabFrameClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + begin + tbPreview.Appearance.Tab.BorderColor:=(Sender as TPanel).Color; + + if cbLinkTab.checked then + SetLinkedFrameColor((Sender as TPanel).Color); + end; +end; + +procedure TfrmAppearanceEditWindow.pTabGradientFromClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + begin + tbPreview.Appearance.Tab.GradientFromColor:=(Sender as TPanel).Color; + + if cbLinkTab.Checked then + SetLinkedGradientFromColor((Sender as TPanel).Color); + end; +end; + +procedure TfrmAppearanceEditWindow.pTabGradientToClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + begin + tbPreview.Appearance.Tab.GradientToColor:=(Sender as TPanel).Color; + + if cbLinkTab.Checked then + SetLinkedGradientToColor((Sender as TPanel).Color); + end; +end; + +procedure TfrmAppearanceEditWindow.pTabHeaderFontClick(Sender: TObject); +begin +if ChangeFont(Sender as TPanel) then + tbPreview.Appearance.Tab.TabHeaderFont.Assign((Sender as TPanel).Font); +tbPreview.ForceRepaint; +end; + +procedure TfrmAppearanceEditWindow.pTabHeaderFontColorClick(Sender: TObject); +begin +if ChangeColor(Sender as TPanel) then + begin + tbPreview.Appearance.Tab.TabHeaderFont.Color:=((Sender as TPanel).Color); + pTabHeaderFont.Font.color:=((Sender as TPanel).Color); + end; +end; + +end. diff --git a/components/spktoolbar/SpkToolbar - designtime/spkte_EditWindow.dfm b/components/spktoolbar/SpkToolbar - designtime/spkte_EditWindow.dfm new file mode 100644 index 000000000..407629435 --- /dev/null +++ b/components/spktoolbar/SpkToolbar - designtime/spkte_EditWindow.dfm @@ -0,0 +1,782 @@ +object frmEditWindow: TfrmEditWindow + Left = 457 + Top = 186 + Caption = 'Toolbar contents editor' + ClientHeight = 368 + ClientWidth = 341 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + OnActivate = FormActivate + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object tvStructure: TTreeView + Left = 0 + Top = 28 + Width = 341 + Height = 340 + Align = alClient + HideSelection = False + Images = ilTreeImages + Indent = 19 + MultiSelectStyle = [] + PopupMenu = pmStructure + RightClickSelect = True + TabOrder = 0 + OnChange = tvStructureChange + OnEdited = tvStructureEdited + OnKeyDown = tvStructureKeyDown + ExplicitLeft = 3 + ExplicitTop = 31 + end + object tbToolBar: TToolBar + AlignWithMargins = True + Left = 3 + Top = 3 + Width = 335 + Height = 22 + Caption = 'tbToolBar' + DrawingStyle = dsGradient + Images = ilActionImages + Indent = 4 + ParentShowHint = False + ShowHint = True + TabOrder = 1 + object tbAddTab: TToolButton + Left = 4 + Top = 0 + Action = aAddTab + end + object tbRemoveTab: TToolButton + Left = 27 + Top = 0 + Action = aRemoveTab + end + object ToolButton3: TToolButton + Left = 50 + Top = 0 + Width = 8 + Caption = 'ToolButton3' + ImageIndex = 2 + Style = tbsSeparator + end + object tbAddPane: TToolButton + Left = 58 + Top = 0 + Action = aAddPane + end + object tbRemovePane: TToolButton + Left = 81 + Top = 0 + Action = aRemovePane + end + object ToolButton6: TToolButton + Left = 104 + Top = 0 + Width = 8 + Caption = 'ToolButton6' + ImageIndex = 4 + Style = tbsSeparator + end + object tbAddItem: TToolButton + Left = 112 + Top = 0 + Action = aAddLargeButton + DropdownMenu = pmAddItem + Style = tbsDropDown + end + object tbRemoveItem: TToolButton + Left = 150 + Top = 0 + Action = aRemoveItem + end + object ToolButton9: TToolButton + Left = 173 + Top = 0 + Width = 8 + Caption = 'ToolButton9' + ImageIndex = 6 + Style = tbsSeparator + end + object tbMoveUp: TToolButton + Left = 181 + Top = 0 + Action = aMoveUp + end + object tbMoveDown: TToolButton + Left = 204 + Top = 0 + Action = aMoveDown + end + end + object ilTreeImages: TImageList + Left = 8 + Top = 32 + Bitmap = { + 494C010103000400040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000001000000001002000000000000010 + 000000000000000000000000000000000000F7ECE300F7ECE300F7ECE300F7EC + E300F7ECE300F7ECE300F7ECE300F7ECE300F7ECE300F7ECE300F7ECE300F7EC + E300F7ECE300F7ECE300F7ECE300F7ECE3000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000F8D2B300F7ECE300F7ECE300F7EC + E300F7ECE300F7ECE300F7ECE300F7ECE300F7ECE300F7ECE300F7ECE300F7EC + E300F7ECE300F7ECE300F8D2B300ECC2A00000000000D5B49400BC997600BC99 + 7600BC997600BC997600BC997600BC997600BC997600BC997600BC997600BC99 + 7600BC997600BC997600D5B4940000000000000000000000000000000000B791 + 6B00B7916B00B7916B00B7916B00B7916B00B7916B00B7916B00B7916B00B791 + 6B00B7916B000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000EBC59400F8D2B400F6EBE200F7EC + E300F7EBE300F7EBE300F6EBE200F7EBE300F6EBE300F6EBE200F6ECE300F7EB + E300F7EBE300F8D2B400EBC5940000000000D2AF8E00B9967300FDE8D500FFF0 + E200FFF0E200FFF0E200FFF0E200FFF0E200FFF0E200FFF0E200FFF0E200FFF0 + E200FFF0E200FDE8D500B9967300D2AF8E000000000000000000B7916B00FFED + DF00FFEDDF00FFEDDF00FFEDDF00FFEDDF00FFEDDF00FFEDDF00FFEDDF00FFED + DF00FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000ECC1A000F8EDE500F8ED + E500F8EDE400F8EDE500F8EDE500F8EDE500F8EDE500F8EDE500F8EDE500F8EC + E500F8EDE500ECC1A0000000000000000000B9947000FDE5D200EDAF6E00EDAF + 6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF + 6E00EDAF6E00EDAF6E00FDE5D200B99470000000000000000000B7916B00FFED + DF00F1C9A200F0CAA100F1C9A200F0C9A100F0C9A200F1C9A100F0CAA100F1C9 + A100FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000E2B28E00F9EFE700F9EE + E600F9EFE700F9EFE700F9EEE700F9EEE700F9EFE700F9EFE700F9EEE700F9EF + E700F9EEE700E2B28E000000000000000000B7916B00FFEDDF00EDAF6E00EDAF + 6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF + 6E00EDAF6E00EDAF6E00FFEDDF00B7916B000000000000000000B7916B00FFED + DF00EEC49C00EEC49C00EEC59C00EEC49B00EEC49B00EEC49B00EEC49B00EFC4 + 9C00FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000E2B28E00FAF0E800FAF0 + E900FAF1E900FAF0E800FAF1E800FBF0E900FAF0E900FAF0E800FAF0E800FAF1 + E900FAF0E900E2B28E000000000000000000B7916B00FFEDDF00EDAF6E00EDAF + 6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF + 6E00EDAF6E00EDAF6E00FFEDDF00B7916B000000000000000000B7916B00FFED + DF00ECBF9600EBBF9600EBBF9600ECBF9600ECBF9600EBBF9600ECBF9500ECBF + 9600FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000E2B28E00FBF2EB00FBF2 + EA00FBF1EB00FBF2EB00FBF2EB00FBF2EA00FCF2EB00FBF1EB00FBF1EB00FBF2 + EB00FBF1EA00E2B28E000000000000000000B7916B00FFEDDF00F2CCA400F2CC + A400F2CCA400F2CCA400F2CCA400F2CCA400F2CCA400F2CCA400F2CCA400F2CC + A400F2CCA400F2CCA400FFEDDF00B7916B000000000000000000B7916B00FFED + DF00E9B99000E9BA9000E9BA9100E9BA9100E9BA9000E9BA9000E9BA9000E9BA + 9000FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000E2B28E00FCF3ED00FCF4 + ED00FDF3ED00FCF3ED00FCF4ED00FCF3ED00FDF3ED00FCF3ED00FCF4ED00FCF3 + ED00FCF4ED00E2B28E000000000000000000B7916B00FFEDDF00EABF9400EABF + 9400EABF9400EABF9400EABF9400EABF9400EABF9400EABF9400EABF9400EABF + 9400EABF9400EABF9400FFEDDF00B7916B000000000000000000B7916B00FFED + DF00E6B48A00E6B58A00E7B48A00E6B48A00E6B58B00E6B58A00E7B58B00E7B5 + 8A00FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000ECC1A000FBEDC600FEF5 + EF00FDF6EE00FDF5EF00FDF5EF00FEF6EF00FDF6EF00FDF5EF00FDF5EF00FEF5 + EF00FBEDC600ECC1A0000000000000000000B7916B00FFEDDF00E5B18900E5B1 + 8900E5B18900E5B18900E5B18900E5B18900E5B18900E5B18900E5B18900E5B1 + 8900E5B18900E5B18900FFEDDF00B7916B000000000000000000B7916B00FFED + DF00E4B08500E4B08500E4AF8500E4B08500E4B08500E4AF8500E4AF8500E4B0 + 8500FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000F8D2B400EBC59400F9EA + D900FFF6F000FEF6F000FEF6F000FEF6F000FEF6F000FEF6F000FFF6F000F9EA + D900EBC59400F8D2B4000000000000000000B7916B00FFEDDF00E2AC8100E2AC + 8100E2AC8100E2AC8100E2AC8100E2AC8100E2AC8100E2AC8100E2AC8100E2AC + 8100E2AC8100E2AC8100FFEDDF00B7916B000000000000000000B7916B00FFED + DF00E2AC8100E2AC8100E2AC8100E2AC8100E2AC8100E1AC8000E2AC8100E2AC + 8100FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000F8D2B300ECC2 + A000E5B89700E5B89700E5B89700E5B89700E5B89700E5B89700E5B89700ECC2 + A000F8D2B300000000000000000000000000B7916B00FFEDDF00E8B48B00E8B4 + 8B00E8B48B00E8B48B00E8B48B00E8B48B00E8B48B00E8B48B00E8B48B00E8B4 + 8B00E8B48B00E8B48B00FFEDDF00B7916B000000000000000000B7916B00FFED + DF00E7B68C00E7B68C00E7B68C00E7B68C00E7B68C00E7B68C00E7B68C00E7B6 + 8C00FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000B9947000FDE5D200E8B48B00E8B4 + 8B00E8B48B00E8B48B00E8B48B00E8B48B00E8B48B00E8B48B00E8B48B00E8B4 + 8B00E8B48B00E8B48B00FDE5D200B99470000000000000000000B7916B00FFED + DF00E9BA9100E9BA9100E9BA9100E9BA9100E9BA9100E9BA9100E9BA9100E9BA + 9100FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000D2AF8E00B9967300FDE8D500FFF0 + E200FFF0E200FFF0E200FFF0E200FFF0E200FFF0E200FFF0E200FFF0E200FFF0 + E200FFF0E200FDE8D500B9967300D2AF8E000000000000000000B7916B00FFED + DF00EEC49B00EEC49B00EEC49B00EEC49B00EEC49B00EEC49B00EEC49B00EEC4 + 9B00FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000D5B49400BC997600BC99 + 7600BC997600BC997600BC997600BC997600BC997600BC997600BC997600BC99 + 7600BC997600BC997600D5B49400000000000000000000000000B7916B00FFED + DF00FFEDDF00FFEDDF00FFEDDF00FFEDDF00FFEDDF00FFEDDF00FFEDDF00FFED + DF00FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000B791 + 6B00B7916B00B7916B00B7916B00B7916B00B7916B00B7916B00B7916B00B791 + 6B00B7916B000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000100000000100010000000000800000000000000000000000 + 000000000000000000000000FFFFFF000000FFFFFFFF000000008001E0070000 + 00010000C003000080030000C003000080030000C003000080030000C0030000 + 80030000C003000080030000C003000080030000C003000080030000C0030000 + C0070000C0030000FFFF0000C0030000FFFF0000C0030000FFFF8001C0030000 + FFFFFFFFE0070000FFFFFFFFFFFF000000000000000000000000000000000000 + 000000000000} + end + object ilActionImages: TImageList + Left = 40 + Top = 32 + Bitmap = { + 494C010108000C00040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000003000000001002000000000000030 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000D0966B00D0966B00D0966B00D0966B00D0966B00D0966B00D0966B000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000D0966B000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000B791 + 6B00B7916B00B7916B00B7916B00B7916B00B7916B00B7916B00B7916B00B791 + 6B00B7916B00000000000000000000000000000000000000000000000000B791 + 6B00B7916B00B7916B00B7916B00B7916B00B7916B00B7916B00B7916B00B791 + 6B00B7916B000000000000000000000000000000000000000000000000000000 + 0000D0966B00E8DACE00E8DACE00E8DACE00E8DACE00E7DACE00D0966B000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000D0966B00F0E6DE00D0966B0000000000000000000000 + 0000000000000000000000000000000000000000000000000000B7916B00FFED + DF00FFEDDF00FFEDDF00FFEDDF00FFEDDF00FFEDDF00FFEDDF00FFEDDF00FFED + DF00FFEDDF00B7916B0000000000000000000000000000000000B7916B00FFED + DF00FFEDDF00FFEDDF00FFEDDF00FFEDDF00FFEDDF00FFEDDF00FFEDDF00FFED + DF00FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 0000D0966B00D0966B00D0966B00D0966B00D0966B00D0966B00D0966B000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000D0966B00F0E6DE00F0E6DE00F0E6DE00D0966B00000000000000 + 0000000000000000000000000000000000000000000000000000B7916B00FFED + DF00F1C9A200F0CAA100F1C9A200F0C9A100F0C9A200F1C9A100F0CAA100F1C9 + A100FFEDDF00B7916B0000000000000000000000000000000000B7916B00FFED + DF00F1C9A200F0CAA100F1C9A200F0C9A100F0C9A200F1C9A100F0CAA100F1C9 + A100FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000D0966B00F0E5DE00F0E5DE00F0E5DE00F0E5DE00F0E5DE00D0966B000000 + 0000000000000000000000000000000000000000000000000000B7916B00FFED + DF00EEC49C00EEC49C00EEC59C00EEC49B00EEC49B00EEC49B00EEC49B00EFC4 + 9C00FFEDDF00B7916B0000000000000000000000000000000000B7916B00FFED + DF00EEC49C00EEC49C00EEC59C00EEC49B00EEC49B00EEC49B00EEC49B00EFC4 + 9C00FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 0000D0966B00D0966B00D0966B00D0966B00D0966B00D0966B00D0966B000000 + 000000000000000000000000000000000000000000000000000000000000D096 + 6B00EEE4DC00EEE4DC00EFE4DC00EEE4DB00EFE4DC00EFE4DC00EFE4DC00D096 + 6B00000000000000000000000000000000000000000000000000B7916B00FFED + DF000235CC00EBBF9600EBBF9600ECBF9600ECBF9600EBBF9600ECBF9500ECBF + 9600FFEDDF00B7916B0000000000000000000000000000000000B7916B00FFED + DF00ECBF9600EBBF9600EBBF9600ECBF9600ECBF9600EBBF9600ECBF9500ECBF + 9600FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 0000D0966B00EBDED400EADFD400EADED400EBDED400EBDED400D0966B000000 + 0000000000000000000000000000000000000000000000000000D0966B00EEE3 + DB00EEE3DB00EEE3DB00EEE3DA00EEE3DB00EEE4DA00EEE3DA00EEE3DA00EEE3 + DA00D0966B000000000000000000000000000000000000000000B7916B00FFED + DF000235CC00E9BA9000E9BA9100E9BA9100E9BA9000E9BA9000E9BA9000E9BA + 9000FFEDDF00B7916B0000000000000000000000000000000000B7916B00FFED + DF00E9B99000E9BA9000E9BA9100E9BA9100E9BA9000E9BA9000E9BA9000E9BA + 9000FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 0000D0966B00ECE0D600ECDFD500ECDFD600ECDFD600ECE0D500D0966B000000 + 00000000000000000000000000000000000000000000D0966B00EDE2D800EDE2 + D800EDE2D900EDE2D900EDE2D900EDE2D800EDE2D900EDE2D900EDE2D800EDE2 + D800EDE2D800D0966B000000000000000000000000000468FF00B7916B00FFED + DF000235CC00E6B58A00E7B48A000436CD00E6B58B00E6B58A00E7B58B00E7B5 + 8A00FFEDDF00B7916B0000000000000000001A47D200002EC300000D8F00000D + 8F00E6B48A00000D8F00000D8F00000D8F00000D8F00E6B58A00E7B58B00E7B5 + 8A00FFEDDF00B7916B00000000000000000000000000D0966B00D0966B00D096 + 6B00D0966B00EDE1D700EDE1D700ECE1D700ECE1D700EDE1D700D0966B00D096 + 6B00D0966B00D0966B00000000000000000000000000D0966B00D0966B00D096 + 6B00D0966B00EDE1D700EDE1D700ECE1D700ECE1D700EDE1D700D0966B00D096 + 6B00D0966B00D0966B00000000000000000000000000000000000436CD00FFED + DF000235CC00E4B085000267FF00E4B08500E4B08500E4AF8500E4AF8500E4B0 + 8500FFEDDF00B7916B00000000000000000000000000466BDD001947D200000D + 8F00E4B08500000D8F00001094001C299E00E4B08500E4AF8500E4AF8500E4B0 + 8500FFEDDF00B7916B00000000000000000000000000D0966B00EDE2D800EDE2 + D800EDE2D900EDE2D900EDE2D900EDE2D800EDE2D900EDE2D900EDE2D800EDE2 + D800EDE2D800D0966B0000000000000000000000000000000000000000000000 + 0000D0966B00ECE0D600ECDFD500ECDFD600ECDFD600ECE0D500D0966B000000 + 0000000000000000000000000000000000000000000000000000B7916B000267 + FF000235CC000267FF00E2AC8100E2AC8100E2AC8100E1AC8000E2AC8100E2AC + 8100FFEDDF00B7916B00000000000000000000000000000000005D7DE3000025 + B6000012970000159C00001FAC00E2AC8100E2AC8100E1AC8000E2AC8100E2AC + 8100FFEDDF00B7916B0000000000000000000000000000000000D0966B00EEE3 + DB00EEE3DB00EEE3DB00EEE3DA00EEE3DB00EEE4DA00EEE3DA00EEE3DA00EEE3 + DA00D0966B000000000000000000000000000000000000000000000000000000 + 0000D0966B00EBDED400EADFD400EADED400EBDED400EBDED400D0966B000000 + 000000000000000000000000000000000000000000000235CC000235CC000033 + CC0033CCFF000234CC000234CC000234CC00E7B68C00E7B68C00E7B68C00E7B6 + 8C00FFEDDF00B7916B0000000000000000000000000000000000B7916B002752 + D600002CC0000019A200E7B68C00E7B68C00E7B68C00E7B68C00E7B68C00E7B6 + 8C00FFEDDF00B7916B000000000000000000000000000000000000000000D096 + 6B00EEE4DC00EEE4DC00EFE4DC00EEE4DB00EFE4DC00EFE4DC00EFE4DC00D096 + 6B00000000000000000000000000000000000000000000000000000000000000 + 0000D0966B00D0966B00D0966B00D0966B00D0966B00D0966B00D0966B000000 + 0000000000000000000000000000000000000000000000000000B7916B000267 + FF000235CC000267FF00E9BA9100E9BA9100E9BA9100E9BA9100E9BA9100E9BA + 9100FFEDDF00B7916B0000000000000000000000000000000000B7916B002F59 + D8000033CC0000119500E9BA9100E9BA9100E9BA9100E9BA9100E9BA9100E9BA + 9100FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 0000D0966B00F0E5DE00F0E5DE00F0E5DE00F0E5DE00F0E5DE00D0966B000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000468FF00FFED + DF000235CC00EEC49B000468FF00EEC49B00EEC49B00EEC49B00EEC49B00EEC4 + 9B00FFEDDF00B7916B00000000000000000000000000000000000C3DCF002D57 + D7002F59D8001242D100000D8F00EEC49B00EEC49B00EEC49B00EEC49B00EEC4 + 9B00FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 000000000000D0966B00F0E6DE00F0E6DE00F0E6DE00D0966B00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000D0966B00D0966B00D0966B00D0966B00D0966B00D0966B00D0966B000000 + 000000000000000000000000000000000000000000000436CD00B7916B00FFED + DF000235CC00FFEDDF00FFEDDF000436CD00FFEDDF00FFEDDF00FFEDDF00FFED + DF00FFEDDF00B7916B000000000000000000000000002D57D700325BD800355D + D900FFEDDF005073E0000020AE00000D8F00FFEDDF00FFEDDF00FFEDDF00FFED + DF00FFEDDF00B7916B0000000000000000000000000000000000000000000000 + 00000000000000000000D0966B00F0E6DE00D0966B0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000D0966B00E8DACE00E8DACE00E8DACE00E8DACE00E7DACE00D0966B000000 + 000000000000000000000000000000000000000000000000000000000000B791 + 6B000235CC00B7916B00B7916B00B7916B00B7916B00B7916B00B7916B00B791 + 6B00B7916B000000000000000000000000004B6FDF005879E2004E71DF00365E + DA00B7916B005C7DE300335CD9000030C700001BA600B7916B00B7916B00B791 + 6B00B7916B000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000D0966B000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000D0966B00D0966B00D0966B00D0966B00D0966B00D0966B00D0966B000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000235CC000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000E7D9CD00E7D9CD00E7D9CD00E7D9 + CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9 + CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9 + CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9 + CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000E8B78F00E7D9CD00E7D9CD00E7D9 + CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9 + CD00E7D9CD00E7D9CD00E8B78F00D9A37700E8B78F00E7D9CD00E7D9CD00E7D9 + CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9CD00E7D9 + CD00E7D9CD00E7D9CD00E8B78F00D9A3770000000000D5B49400BC997600BC99 + 7600BC997600BC997600BC997600BC997600BC997600BC997600BC997600BC99 + 7600BC997600BC997600D5B494000000000000000000D5B49400BC997600BC99 + 7600BC997600BC997600BC997600BC997600BC997600BC997600BC997600BC99 + 7600BC997600BC997600D5B4940000000000D8A76700E8B79100E6D8CC00E7D9 + CD00E7D8CD00E7D8CD00E6D8CC00E7D8CD00E6D8CD00E6D8CC00E6D9CD00E7D8 + CD00E7D8CD00E8B79100D8A7670000000000D8A76700E8B79100E6D8CC00E7D9 + CD00E7D8CD00E7D8CD00E6D8CC00E7D8CD00E6D8CD00E6D8CC00E6D9CD00E7D8 + CD00E7D8CD00E8B79100D8A7670000000000D2AF8E00B9967300FDE8D500FFF0 + E200FFF0E200FFF0E200FFF0E200FFF0E200FFF0E200FFF0E200FFF0E200FFF0 + E200FFF0E200FDE8D500B9967300D2AF8E00D2AF8E00B9967300FDE8D500FFF0 + E200FFF0E200FFF0E200FFF0E200FFF0E200FFF0E200FFF0E200FFF0E200FFF0 + E200FFF0E200FDE8D500B9967300D2AF8E0000000000D9A17700E8DAD000E8DA + D000E8DACF00E8DAD000E8DAD000E8DAD000E8DAD000E8DAD000E8DAD000E8D9 + D000E8DAD000D9A17700000000000000000000000000D9A17700E8DAD000E8DA + D000E8DACF00E8DAD000E8DAD000E8DAD000E8DAD000E8DAD000E8DAD000E8D9 + D000E8DAD000D9A177000000000000000000B9947000FDE5D200EDAF6E00EDAF + 6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF + 6E00EDAF6E00EDAF6E00FDE5D200B9947000B9947000FDE5D200EDAF6E00EDAF + 6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF + 6E00EDAF6E00EDAF6E00FDE5D200B994700000000000CC8E6000EADDD300EADC + D100EADDD300EADDD300EADCD300EADCD300EADDD300EADDD300EADCD300EADD + D300EADCD300CC8E6000000000000000000000000000CC8E6000EADDD300EADC + D100EADDD300EADDD300EADCD300EADCD300EADDD300EADDD300EADCD300EADD + D300EADCD300CC8E60000000000000000000B7916B00FFEDDF00EDAF6E00EDAF + 6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF + 6E00EDAF6E00EDAF6E00FFEDDF00B7916B00B7916B00FFEDDF00EDAF6E00EDAF + 6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF + 6E00EDAF6E00EDAF6E00FFEDDF00B7916B0000000000CC8E6000EBDED400EBDE + D5000235CC00EBDED400EBDFD400ECDED500EBDED500EBDED400EBDED400EBDF + D500EBDED500CC8E6000000000000000000000000000CC8E6000EBDED400EBDE + D500EBDFD500EBDED400EBDFD400ECDED500EBDED500EBDED400EBDED400EBDF + D500EBDED500CC8E60000000000000000000B7916B00FFEDDF00EDAF6E00EDAF + 6E000235CC00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF + 6E00EDAF6E00EDAF6E00FFEDDF00B7916B00B7916B00FFEDDF00EDAF6E00EDAF + 6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF6E00EDAF + 6E00EDAF6E00EDAF6E00FFEDDF00B7916B0000000000CC8E6000ECE1D800ECE1 + D6000235CC00ECE1D800ECE1D800ECE1D600EEE1D800ECDFD800ECDFD800ECE1 + D800ECDFD600CC8E6000000000000000000000000000CC8E6000ECE1D800ECE1 + D600ECDFD800ECE1D800ECE1D800ECE1D600EEE1D800ECDFD800ECDFD800ECE1 + D800ECDFD600CC8E60000000000000000000B7916B00FFEDDF00F2CCA400F2CC + A4000235CC00F2CCA400F2CCA400F2CCA400F2CCA400F2CCA400F2CCA400F2CC + A400F2CCA400F2CCA400FFEDDF00B7916B00B7916B00FFEDDF00F2CCA400F2CC + A400F2CCA400F2CCA400F2CCA400F2CCA400F2CCA400F2CCA400F2CCA400F2CC + A400F2CCA400F2CCA400FFEDDF00B7916B00000000000468FF00EEE2DA00EEE3 + DA000235CC00EEE2DA00EEE3DA000436CD00EFE2DA00EEE2DA00EEE3DA00EEE2 + DA00EEE3DA00CC8E600000000000000000001A47D200002EC300000D8F00000D + 8F00EFE2DA00000D8F00000D8F00000D8F00000D8F00EEE2DA00EEE3DA00EEE2 + DA00EEE3DA00CC8E60000000000000000000B7916B000468FF00EABF9400EABF + 94000235CC00EABF9400EABF94000436CD00EABF9400EABF9400EABF9400EABF + 9400EABF9400EABF9400FFEDDF00B7916B001A47D200002EC300000D8F00000D + 8F00EABF9400000D8F00000D8F00000D8F00000D8F00EABF9400EABF9400EABF + 9400EABF9400EABF9400FFEDDF00B7916B0000000000D9A177000436CD00F0E5 + DD000235CC00EFE5DD000267FF00F0E6DD00EFE6DD00EFE5DD00EFE5DD00F0E5 + DD00ECDAA800D9A17700000000000000000000000000466BDD001947D200000D + 8F00EFE6DC00000D8F00001094001C299E00EFE6DD00EFE5DD00EFE5DD00F0E5 + DD00ECDAA800D9A177000000000000000000B7916B00FFEDDF000436CD00E5B1 + 89000235CC00E5B189000267FF00E5B18900E5B18900E5B18900E5B18900E5B1 + 8900E5B18900E5B18900FFEDDF00B7916B00B7916B00466BDD001947D200000D + 8F00E5B18900000D8F00001094001C299E00E5B18900E5B18900E5B18900E5B1 + 8900E5B18900E5B18900FFEDDF00B7916B0000000000E8B79100D8A767000267 + FF000235CC000267FF00F0E6DE00F0E6DE00F0E6DE00F0E6DE00F1E6DE00EAD6 + C000D8A76700E8B79100000000000000000000000000E8B791005D7DE3000025 + B6000012970000159C00001FAC00F0E6DE00F0E6DE00F0E6DE00F1E6DE00EAD6 + C000D8A76700E8B791000000000000000000B7916B00FFEDDF00E2AC81000267 + FF000235CC000267FF00E2AC8100E2AC8100E2AC8100E2AC8100E2AC8100E2AC + 8100E2AC8100E2AC8100FFEDDF00B7916B00B7916B00FFEDDF005D7DE3000025 + B6000012970000159C00001FAC00E2AC8100E2AC8100E2AC8100E2AC8100E2AC + 8100E2AC8100E2AC8100FFEDDF00B7916B00000000000235CC000235CC000033 + CC0033CCFF000234CC000234CC000234CC00D0966B00D0966B00D0966B00D9A3 + 7700E8B78F000000000000000000000000000000000000000000E8B78F002752 + D600002CC0000019A200D0966B00D0966B00D0966B00D0966B00D0966B00D9A3 + 7700E8B78F00000000000000000000000000B7916B000235CC000235CC000033 + CC0033CCFF000234CC000234CC000234CC00E8B48B00E8B48B00E8B48B00E8B4 + 8B00E8B48B00E8B48B00FFEDDF00B7916B00B7916B00FFEDDF00E8B48B002752 + D600002CC0000019A200E8B48B00E8B48B00E8B48B00E8B48B00E8B48B00E8B4 + 8B00E8B48B00E8B48B00FFEDDF00B7916B000000000000000000000000000267 + FF000235CC000267FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000002F59 + D8000033CC000011950000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000B9947000FDE5D200E8B48B000267 + FF000235CC000267FF00E8B48B00E8B48B00E8B48B00E8B48B00E8B48B00E8B4 + 8B00E8B48B00E8B48B00FDE5D200B9947000B9947000FDE5D200E8B48B002F59 + D8000033CC0000119500E8B48B00E8B48B00E8B48B00E8B48B00E8B48B00E8B4 + 8B00E8B48B00E8B48B00FDE5D200B994700000000000000000000468FF000000 + 00000235CC00000000000468FF00000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000C3DCF002D57 + D7002F59D8001242D100000D8F00000000000000000000000000000000000000 + 000000000000000000000000000000000000D2AF8E00B99673000468FF00FFF0 + E2000235CC00FFF0E2000468FF00FFF0E200FFF0E200FFF0E200FFF0E200FFF0 + E200FFF0E200FDE8D500B9967300D2AF8E00D2AF8E00B99673000C3DCF002D57 + D7002F59D8001242D100000D8F00FFF0E200FFF0E200FFF0E200FFF0E200FFF0 + E200FFF0E200FDE8D500B9967300D2AF8E00000000000436CD00000000000000 + 00000235CC0000000000000000000436CD000000000000000000000000000000 + 000000000000000000000000000000000000000000002D57D700325BD800355D + D900000000005073E0000020AE00000D8F000000000000000000000000000000 + 000000000000000000000000000000000000000000000436CD00BC997600BC99 + 76000235CC00BC997600BC9976000436CD00BC997600BC997600BC997600BC99 + 7600BC997600BC997600D5B4940000000000000000002D57D700325BD800355D + D900BC9976005073E0000020AE00000D8F00BC997600BC997600BC997600BC99 + 7600BC997600BC997600D5B49400000000000000000000000000000000000000 + 00000235CC000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000004B6FDF005879E2004E71DF00365E + DA00000000005C7DE300335CD9000030C700001BA60000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000235CC000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000004B6FDF005879E2004E71DF00365E + DA00000000005C7DE300335CD9000030C700001BA60000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000235CC000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000235CC000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000300000000100010000000000800100000000000000000000 + 000000000000000000000000FFFFFF0000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FFFFFFFFF01FFEFFE007E007F01FFC7F + C003C003F01FF83FC003C003FFFFF01FC003C003F01FE00FC003C003F01FC007 + C003C003F01F80038003000380038003C00380038003F01FC003C003C007F01F + 8003C003E00FF01FC003C003F01FFFFFC003C003F83FF01F80038003FC7FF01F + E0070007FEFFF01FF7FFFFFFFFFFFFFF00000000FFFFFFFF0000000080018001 + 0001000100000000800380030000000080038003000000008003800300000000 + 8003800300000000800300030000000080038003000000008003800300000000 + 8007C00700000000E3FFE3FF00000000D5FFC1FF00000000B6FF88FF80018001 + F7FF087FF7FF087FF7FFFFFFF7FFFFFF00000000000000000000000000000000 + 000000000000} + end + object ActionList1: TActionList + Images = ilActionImages + Left = 72 + Top = 32 + object aAddTab: TAction + Caption = 'Add tab' + Hint = 'Add tab' + ImageIndex = 0 + OnExecute = aAddTabExecute + end + object aRemoveTab: TAction + Caption = 'Remove tab' + Hint = 'Remove tab' + ImageIndex = 1 + OnExecute = aRemoveTabExecute + end + object aAddPane: TAction + Caption = 'Add pane' + Hint = 'Add pane' + ImageIndex = 2 + OnExecute = aAddPaneExecute + end + object aRemovePane: TAction + Caption = 'Remove pane' + Hint = 'Remove pane' + ImageIndex = 3 + OnExecute = aRemovePaneExecute + end + object aAddSmallButton: TAction + Caption = 'SpkSmallButton' + Hint = 'Add SmallButton' + ImageIndex = 4 + OnExecute = aAddSmallButtonExecute + end + object aAddLargeButton: TAction + Caption = 'SpkLargeButton' + Hint = 'Add SpkLargeButton' + ImageIndex = 4 + OnExecute = aAddLargeButtonExecute + end + object aRemoveItem: TAction + Caption = 'Remove item' + Hint = 'Remove item' + ImageIndex = 5 + OnExecute = aRemoveItemExecute + end + object aMoveUp: TAction + Caption = 'Move up' + Hint = 'Move item up' + ImageIndex = 6 + OnExecute = aMoveUpExecute + end + object aMoveDown: TAction + Caption = 'Move down' + Hint = 'Move item down' + ImageIndex = 7 + OnExecute = aMoveDownExecute + end + end + object pmAddItem: TPopupMenu + Left = 8 + Top = 64 + object SpkLargeButton1: TMenuItem + Action = aAddLargeButton + end + object SpkSmallButton1: TMenuItem + Action = aAddSmallButton + end + end + object pmStructure: TPopupMenu + Images = ilActionImages + Left = 40 + Top = 64 + object Addtab1: TMenuItem + Action = aAddTab + end + object Removetab1: TMenuItem + Action = aRemoveTab + end + object N1: TMenuItem + Caption = '-' + end + object Addpane1: TMenuItem + Action = aAddPane + end + object Removepane1: TMenuItem + Action = aRemovePane + end + object N2: TMenuItem + Caption = '-' + end + object Additem1: TMenuItem + Caption = 'Add item' + object SpkLargeButton2: TMenuItem + Action = aAddLargeButton + end + object SpkSmallButton2: TMenuItem + Action = aAddSmallButton + end + end + object Removeitem1: TMenuItem + Action = aRemoveItem + end + object N3: TMenuItem + Caption = '-' + end + object Moveup1: TMenuItem + Action = aMoveUp + end + object Movedown1: TMenuItem + Action = aMoveDown + end + end +end diff --git a/components/spktoolbar/SpkToolbar - designtime/spkte_EditWindow.pas b/components/spktoolbar/SpkToolbar - designtime/spkte_EditWindow.pas new file mode 100644 index 000000000..1886b51c0 --- /dev/null +++ b/components/spktoolbar/SpkToolbar - designtime/spkte_EditWindow.pas @@ -0,0 +1,1174 @@ +unit spkte_EditWindow; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, DesignIntf, DesignEditors, StdCtrls, ImgList, ComCtrls, ToolWin, + ActnList, Menus, + spkToolbar, spkt_Tab, spkt_Pane, spkt_BaseItem, spkt_Buttons, spkt_Types; + +type TCreateItemFunc = function(Pane : TSpkPane) : TSpkBaseItem; + +type + TfrmEditWindow = class(TForm) + tvStructure: TTreeView; + ilTreeImages: TImageList; + tbToolBar: TToolBar; + tbAddTab: TToolButton; + ilActionImages: TImageList; + tbRemoveTab: TToolButton; + ToolButton3: TToolButton; + tbAddPane: TToolButton; + tbRemovePane: TToolButton; + ActionList1: TActionList; + aAddTab: TAction; + aRemoveTab: TAction; + aAddPane: TAction; + aRemovePane: TAction; + ToolButton6: TToolButton; + aMoveUp: TAction; + aMoveDown: TAction; + tbMoveUp: TToolButton; + tbMoveDown: TToolButton; + ToolButton9: TToolButton; + tbAddItem: TToolButton; + tbRemoveItem: TToolButton; + pmAddItem: TPopupMenu; + SpkLargeButton1: TMenuItem; + aAddLargeButton: TAction; + aRemoveItem: TAction; + aAddSmallButton: TAction; + SpkSmallButton1: TMenuItem; + pmStructure: TPopupMenu; + Addtab1: TMenuItem; + Removetab1: TMenuItem; + N1: TMenuItem; + Addpane1: TMenuItem; + Removepane1: TMenuItem; + N2: TMenuItem; + Additem1: TMenuItem; + SpkLargeButton2: TMenuItem; + SpkSmallButton2: TMenuItem; + Removeitem1: TMenuItem; + N3: TMenuItem; + Moveup1: TMenuItem; + Movedown1: TMenuItem; + procedure tvStructureChange(Sender: TObject; Node: TTreeNode); + procedure aAddTabExecute(Sender: TObject); + procedure aRemoveTabExecute(Sender: TObject); + procedure aAddPaneExecute(Sender: TObject); + procedure aRemovePaneExecute(Sender: TObject); + procedure aMoveUpExecute(Sender: TObject); + procedure aMoveDownExecute(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure aAddLargeButtonExecute(Sender: TObject); + procedure aRemoveItemExecute(Sender: TObject); + procedure aAddSmallButtonExecute(Sender: TObject); + procedure tvStructureKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure FormActivate(Sender: TObject); + procedure tvStructureEdited(Sender: TObject; Node: TTreeNode; + var S: string); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + private + { Private declarations } + protected + FToolbar : TSpkToolbar; + FDesigner : IDesigner; + + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + + procedure CheckActionsAvailability; + + procedure AddItem(CreateItemFunc : TCreateItemFunc); + function GetItemCaption(Item : TSpkBaseItem) : string; + procedure SetItemCaption(Item : TSpkBaseItem; const Value : String); + + procedure DoRemoveTab; + procedure DoRemovePane; + procedure DoRemoveItem; + + function CheckValidTabNode(Node : TTreeNode) : boolean; + function CheckValidPaneNode(Node : TTreeNode) : boolean; + function CheckValidItemNode(Node : TTreeNode) : boolean; + public + { Public declarations } + function ValidateTreeData : boolean; + procedure BuildTreeData; + procedure RefreshNames; + + procedure SetData(AToolbar : TSpkToolbar; ADesigner : IDesigner); + + property Toolbar : TSpkToolbar read FToolbar; + end; + +var + frmEditWindow: TfrmEditWindow; + +implementation + +{$R *.dfm} + +{ TfrmEditWindow } + +procedure TfrmEditWindow.aAddLargeButtonExecute(Sender: TObject); + + function CreateLargeButton(Pane : TSpkPane) : TSpkBaseItem; + + begin + result:=Pane.Items.AddLargeButton; + end; + +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +AddItem(@CreateLargeButton); +end; + +procedure TfrmEditWindow.aAddPaneExecute(Sender: TObject); + +var Obj : TObject; + Node : TTreeNode; + NewNode : TTreeNode; + Tab : TSpkTab; + Pane : TSpkPane; + DesignObj : IDesignObject; + +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +Node:=tvStructure.Selected; +if Node = nil then + raise Exception.create('TfrmEditWindow.aAddPaneExecute: Brak zaznaczonego obiektu!'); +if Node.Data = nil then + raise Exception.create('TfrmEditWindow.aAddPaneExecute: Uszkodzona struktura drzewa!'); + +Obj:=TObject(Node.Data); +if Obj is TSpkTab then + begin + Tab:=Obj as TSpkTab; + Pane:=Tab.Panes.Add; + NewNode:=tvStructure.Items.AddChild(Node, Pane.Caption); + NewNode.Data:=Pane; + NewNode.ImageIndex:=1; + NewNode.SelectedIndex:=1; + NewNode.Selected:=true; + CheckActionsAvailability; + + DesignObj:=PersistentToDesignObject(Pane); + FDesigner.SelectComponent(DesignObj); + end else +if Obj is TSpkPane then + begin + if not(CheckValidPaneNode(Node)) then + raise exception.create('TfrmEditWindow.aAddPaneExecute: Uszkodzona struktura drzewa!'); + + Tab:=TSpkTab(Node.Parent.Data); + Pane:=Tab.Panes.Add; + NewNode:=tvStructure.Items.AddChild(Node.Parent, Pane.Caption); + NewNode.Data:=Pane; + NewNode.ImageIndex:=1; + NewNode.SelectedIndex:=1; + NewNode.Selected:=true; + CheckActionsAvailability; + + DesignObj:=PersistentToDesignObject(Pane); + FDesigner.SelectComponent(DesignObj); + end else +if Obj is TSpkBaseItem then + begin + if not(CheckValidItemNode(Node)) then + raise exception.create('TfrmEditWindow.aAddPaneExecute: Uszkodzona struktura drzewa!'); + + Tab:=TSpkTab(Node.Parent.Parent.Data); + Pane:=Tab.Panes.Add; + NewNode:=tvStructure.Items.AddChild(Node.Parent.Parent, Pane.Caption); + NewNode.Data:=Pane; + NewNode.ImageIndex:=1; + NewNode.SelectedIndex:=1; + NewNode.Selected:=true; + CheckActionsAvailability; + + DesignObj:=PersistentToDesignObject(Pane); + FDesigner.SelectComponent(DesignObj); + end else + raise exception.create('TfrmEditWindow.aAddPaneExecute: Nieprawidłowy obiekt podwieszony pod gałęzią!'); +end; + +procedure TfrmEditWindow.aAddSmallButtonExecute(Sender: TObject); + + function CreateSmallButton(Pane : TSpkPane) : TSpkBaseItem; + + begin + result:=Pane.Items.AddSmallButton; + end; + +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +AddItem(@CreateSmallButton); +end; + +procedure TfrmEditWindow.aAddTabExecute(Sender: TObject); + +var Node : TTreeNode; + Tab : TSpkTab; + DesignObj : IDesignObject; + +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +Tab:=FToolbar.Tabs.Add; +Node:=tvStructure.Items.AddChild(nil, Tab.Caption); +Node.Data:=Tab; +Node.ImageIndex:=0; +Node.SelectedIndex:=0; +Node.Selected:=true; +CheckActionsAvailability; + +DesignObj:=PersistentToDesignObject(Tab); +FDesigner.SelectComponent(DesignObj); +end; + +procedure TfrmEditWindow.AddItem(CreateItemFunc : TCreateItemFunc); + +var Node : TTreeNode; + Obj : TObject; + Pane: TSpkPane; + Item: TSpkBaseItem; + NewNode: TTreeNode; + DesignObj: IDesignObject; + s: string; + +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +Node:=tvStructure.Selected; +if Node = nil then + raise Exception.Create('TfrmEditWindow.AddItem: Brak zaznaczonego obiektu!'); +if Node.Data = nil then + raise Exception.Create('TfrmEditWindow.AddItem: Uszkodzona struktura drzewa!'); + +Obj:=TObject(Node.Data); +if Obj is TSpkPane then + begin + Pane:=Obj as TSpkPane; + Item:=CreateItemFunc(Pane); + s:=GetItemCaption(Item); + NewNode:=tvStructure.Items.AddChild(Node, s); + NewNode.Data:=Item; + NewNode.ImageIndex:=2; + NewNode.SelectedIndex:=2; + NewNode.Selected:=true; + CheckActionsAvailability; + + DesignObj:=PersistentToDesignObject(Item); + FDesigner.SelectComponent(DesignObj); + end else +if Obj is TSpkBaseItem then + begin + if not(CheckValidItemNode(Node)) then + raise exception.create('TfrmEditWindow.AddItem: Uszkodzona struktura drzewa!'); + + Pane:=TSpkPane(Node.Parent.Data); + Item:=CreateItemFunc(Pane); + s:=GetItemCaption(Item); + NewNode:=tvStructure.Items.AddChild(Node.Parent, s); + NewNode.Data:=Item; + NewNode.ImageIndex:=2; + NewNode.SelectedIndex:=2; + NewNode.Selected:=true; + CheckActionsAvailability; + + DesignObj:=PersistentToDesignObject(Item); + FDesigner.SelectComponent(DesignObj); + end else + raise exception.create('TfrmEditWindow.AddItem: Nieprawidłowy obiekt podwieszony pod gałęzią!'); +end; + +procedure TfrmEditWindow.aMoveDownExecute(Sender: TObject); + +var Node : TTreeNode; + Tab : TSpkTab; + Pane : TSpkPane; + Obj : TObject; + index: Integer; + Item: TSpkBaseItem; + +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +Node:=tvStructure.Selected; +if Node = nil then + raise exception.create('TfrmEditWindow.aMoveDownExecute: Nie zaznaczono obiektu do przesunięcia!'); +if Node.Data = nil then + raise exception.create('TfrmEditWindow.aMoveDownExecute: Uszkodzona struktura drzewa!'); + +Obj:=TObject(Node.Data); + +if Obj is TSpkTab then + begin + if not(CheckValidTabNode(Node)) then + raise exception.create('TfrmEditWindow.aMoveDownExecute: Uszkodzona struktura drzewa!'); + + Tab:=TSpkTab(Node.Data); + index:=FToolbar.Tabs.IndexOf(Tab); + if (index=-1) then + raise exception.create('TfrmEditWindow.aMoveDownExecute: Uszkodzona struktura drzewa!'); + if (index=FToolbar.Tabs.Count-1) then + raise exception.create('TfrmEditWindow.aMoveDownExecute: Nie można przesunąć w dół ostatniego elementu!'); + + FToolbar.Tabs.Exchange(index,index+1); + FToolbar.TabIndex:=index+1; + + Node.GetNextSibling.MoveTo(Node, naInsert); + Node.Selected:=true; + CheckActionsAvailability; + end else +if Obj is TSpkPane then + begin + if not(CheckValidPaneNode(Node)) then + raise exception.create('TfrmEditWindow.aMoveDownExecute: Uszkodzona struktura drzewa!'); + + Pane:=TSpkPane(Node.Data); + Tab:=TSpkTab(Node.Parent.Data); + + index:=Tab.Panes.IndexOf(Pane); + if (index=-1) then + raise exception.create('TfrmEditWindow.aMoveDownExecute: Uszkodzona struktura drzewa!'); + if (index=Tab.Panes.Count-1) then + raise exception.create('TfrmEditWindow.aMoveDownExecute: Nie można przesunąć w dół ostatniego elementu!'); + + Tab.Panes.Exchange(index, index+1); + + Node.GetNextSibling.MoveTo(Node, naInsert); + Node.Selected:=true; + CheckActionsAvailability; + end else +if Obj is TSpkBaseItem then + begin + if not(CheckValidItemNode(Node)) then + raise exception.create('TfrmEditWindow.aMoveDown.Execute: Uszkodzona struktura drzewa!'); + + Item:=TSpkBaseItem(Node.Data); + Pane:=TSpkPane(Node.Parent.Data); + + index:=Pane.Items.IndexOf(Item); + if (index=-1) then + raise exception.create('TfrmEditWindow.aMoveDownExecute: Uszkodzona struktura drzewa!'); + if (index=Pane.Items.Count-1) then + raise exception.create('TfrmEditWindow.aMoveDownExecute: Nie można przesunąć w dół ostatniego elementu!'); + + Pane.Items.Exchange(index, index+1); + + Node.GetNextSibling.MoveTo(Node, naInsert); + Node.Selected:=true; + CheckActionsAvailability; + end else + raise exception.create('TfrmEditWindow.aMoveDownExecute: Nieprawidłowy obiekt podwieszony pod gałęzią!'); +end; + +procedure TfrmEditWindow.aMoveUpExecute(Sender: TObject); + +var Node : TTreeNode; + Tab : TSpkTab; + Pane : TSpkPane; + Obj : TObject; + index: Integer; + Item: TSpkBaseItem; + +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +Node:=tvStructure.Selected; +if Node = nil then + raise exception.create('TfrmEditWindow.aMoveUpExecute: Nie zaznaczono obiektu do przesunięcia!'); +if Node.Data = nil then + raise exception.create('TfrmEditWindow.aMoveUpExecute: Uszkodzona struktura drzewa!'); + +Obj:=TObject(Node.Data); + +if Obj is TSpkTab then + begin + if not(CheckValidTabNode(Node)) then + raise exception.create('TfrmEditWindow.aMoveUpExecute: Uszkodzona struktura drzewa!'); + + Tab:=TSpkTab(Node.Data); + index:=FToolbar.Tabs.IndexOf(Tab); + if (index=-1) then + raise exception.create('TfrmEditWindow.aMoveUpExecute: Uszkodzona struktura drzewa!'); + if (index=0) then + raise exception.create('TfrmEditWindow.aMoveUpExecute: Nie można przesunąć do góry pierwszego elementu!'); + + FToolbar.Tabs.Exchange(index,index-1); + FToolbar.TabIndex:=index-1; + + Node.MoveTo(Node.getPrevSibling, naInsert); + Node.Selected:=true; + CheckActionsAvailability; + end else +if Obj is TSpkPane then + begin + if not(CheckValidPaneNode(Node)) then + raise exception.create('TfrmEditWindow.aMoveUpExecute: Uszkodzona struktura drzewa!'); + + Pane:=TSpkPane(Node.Data); + Tab:=TSpkTab(Node.Parent.Data); + + index:=Tab.Panes.IndexOf(Pane); + if (index=-1) then + raise exception.create('TfrmEditWindow.aMoveUpExecute: Uszkodzona struktura drzewa!'); + if (index=0) then + raise exception.create('TfrmEditWindow.aMoveUpExecute: Nie można przesunąć do góry pierwszego elementu!'); + + Tab.Panes.Exchange(index, index-1); + + Node.MoveTo(Node.GetPrevSibling, naInsert); + Node.Selected:=true; + CheckActionsAvailability; + end else +if Obj is TSpkBaseItem then + begin + if not(CheckValidItemNode(Node)) then + raise exception.create('TfrmEditWindow.aMoveUpExecute: Uszkodzona struktura drzewa!'); + + Item:=TSpkBaseItem(Node.Data); + Pane:=TSpkPane(Node.Parent.Data); + + index:=Pane.Items.IndexOf(Item); + if (index=-1) then + raise exception.create('TfrmEditWindow.aMoveUpExecute: Uszkodzona struktura drzewa!'); + if (index=0) then + raise exception.create('TfrmEditWindow.aMoveUpExecute: Nie można przesunąć do góry pierwszego elementu!'); + + Pane.Items.Exchange(index, index-1); + + Node.MoveTo(Node.GetPrevSibling, naInsert); + Node.Selected:=true; + CheckActionsAvailability; + end else + raise exception.create('TfrmEditWindow.aMoveUpExecute: Nieprawidłowy obiekt podwieszony pod gałęzią!'); +end; + +procedure TfrmEditWindow.aRemoveItemExecute(Sender: TObject); + +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +DoRemoveItem; +end; + +procedure TfrmEditWindow.aRemovePaneExecute(Sender: TObject); + +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +DoRemovePane; +end; + +procedure TfrmEditWindow.aRemoveTabExecute(Sender: TObject); + +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +DoRemoveTab; +end; + +procedure TfrmEditWindow.CheckActionsAvailability; + +var Node : TTreeNode; + Obj : TObject; + Tab : TSpkTab; + Pane : TSpkPane; + index : integer; + Item: TSpkBaseItem; + +begin +if (FToolbar=nil) or (FDesigner=nil) then + begin + // Brak toolbara lub designera + + aAddTab.Enabled:=false; + aRemoveTab.Enabled:=false; + aAddPane.Enabled:=false; + aRemovePane.Enabled:=false; + aAddLargeButton.Enabled:=false; + aAddSmallButton.Enabled:=false; + aRemoveItem.Enabled:=false; + aMoveUp.Enabled:=false; + aMoveDown.Enabled:=false; + end +else + begin + Node:=tvStructure.Selected; + + if Node = nil then + begin + // Pusty toolbar + aAddTab.Enabled:=true; + aRemoveTab.Enabled:=false; + aAddPane.Enabled:=false; + aRemovePane.Enabled:=false; + aAddLargeButton.Enabled:=false; + aAddSmallButton.Enabled:=false; + aRemoveItem.Enabled:=false; + aMoveUp.Enabled:=false; + aMoveDown.Enabled:=false; + end + else + begin + Obj:=TObject(Node.Data); + if Obj=nil then + raise exception.create('TfrmEditWindow.CheckActionsAvailability: Nieprawidłowe dane w gałęzi!'); + + if Obj is TSpkTab then + begin + Tab:=Obj as TSpkTab; + + if not(CheckValidTabNode(Node)) then + raise exception.create('TfrmEditWindow.CheckActionsAvailability: Uszkodzona struktura drzewa!'); + + aAddTab.Enabled:=true; + aRemoveTab.Enabled:=true; + aAddPane.Enabled:=true; + aRemovePane.Enabled:=false; + aAddLargeButton.Enabled:=false; + aAddSmallButton.Enabled:=false; + aRemoveItem.Enabled:=false; + + index:=FToolbar.Tabs.IndexOf(Tab); + if index=-1 then + raise exception.create('TfrmEditWindow.CheckActionsAvailability: Uszkodzona struktura drzewa!'); + + aMoveUp.enabled:=(index>0); + aMoveDown.enabled:=(index0); + aMoveDown.Enabled:=(index0); + aMoveDown.Enabled:=(indexnil) and + (Node.Data<>nil) and + (TObject(Node.Data) is TSpkBaseItem) and + CheckValidPaneNode(Node.Parent); +end; + +function TfrmEditWindow.CheckValidPaneNode(Node: TTreeNode): boolean; +begin +result:=false; +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +{$B-} +result:=(Node<>nil) and + (Node.Data<>nil) and + (TObject(Node.Data) is TSpkPane) and + CheckValidTabNode(Node.Parent); +end; + +function TfrmEditWindow.CheckValidTabNode(Node: TTreeNode): boolean; +begin +result:=false; +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +{$B-} +result:=(Node<>nil) and + (Node.Data<>nil) and + (TObject(Node.Data) is TSpkTab); +end; + +procedure TfrmEditWindow.FormActivate(Sender: TObject); +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +if not(ValidateTreeData) then + BuildTreeData; +end; + +procedure TfrmEditWindow.FormCreate(Sender: TObject); +begin +FToolbar:=nil; +FDesigner:=nil; +end; + +procedure TfrmEditWindow.FormDestroy(Sender: TObject); +begin +if FToolbar<>nil then + FToolbar.RemoveFreeNotification(self); +end; + +procedure TfrmEditWindow.FormShow(Sender: TObject); +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +BuildTreeData; +end; + +function TfrmEditWindow.GetItemCaption(Item: TSpkBaseItem): string; +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +if Item is TSpkBaseButton then + begin + result:=TSpkBaseButton(Item).Caption; + end else + result:=''; +end; + +procedure TfrmEditWindow.Notification(AComponent: TComponent; + Operation: TOperation); +begin + inherited; + + if (AComponent = FToolbar) and (Operation = opRemove) then + begin + // Właśnie zwalniany jest toolbar, którego zawartość wyświetla okno + // edytora. Trzeba posprzątać zawartość - w przeciwnym wypadku okno + // będzie miało referencje do już usuniętych elementów toolbara, co + // skończy się AVami... + + SetData(nil, nil); + end; +end; + +procedure TfrmEditWindow.SetItemCaption(Item: TSpkBaseItem; const Value : string); +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +if Item is TSpkBaseButton then + TSpkBaseButton(Item).Caption:=Value; +end; + +procedure TfrmEditWindow.SetData(AToolbar: TSpkToolbar; ADesigner: IDesigner); + +begin +if FToolbar<>nil then + FToolbar.RemoveFreeNotification(self); + +FToolbar:=AToolbar; +FDesigner:=ADesigner; + +if FToolbar<>nil then + FToolbar.FreeNotification(self); + +BuildTreeData; +end; + +procedure TfrmEditWindow.DoRemoveItem; +var + Item: TSpkBaseItem; + index: Integer; + Node: TTreeNode; + Pane: TSpkPane; + NextNode: TTreeNode; +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + + Node := tvStructure.Selected; + if not (CheckValidItemNode(Node)) then + raise Exception.Create('TfrmEditWindow.aRemoveItemExecute: Uszkodzona struktura drzewa!'); + Item := TSpkBaseItem(Node.Data); + Pane := TSpkPane(Node.Parent.Data); + index := Pane.Items.IndexOf(Item); + if index = -1 then + raise exception.create('TfrmEditWindow.aRemoveItemExecute: Uszkodzona struktura drzewa!'); + if Node.getPrevSibling <> nil then + NextNode := Node.getPrevSibling + else if Node.GetNextSibling <> nil then + NextNode := Node.getNextSibling + else + NextNode := Node.Parent; + Pane.Items.Delete(index); + tvStructure.Items.delete(node); + NextNode.Selected := true; + CheckActionsAvailability; +end; + +procedure TfrmEditWindow.DoRemovePane; +var + Pane: TSpkPane; + NextNode: TTreeNode; + index: Integer; + Node: TTreeNode; + Tab: TSpkTab; +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + + Node := tvStructure.Selected; + if not (CheckValidPaneNode(Node)) then + raise exception.create('TfrmEditWindow.aRemovePaneExecute: Uszkodzona struktura drzewa!'); + Pane := TSpkPane(Node.Data); + Tab := TSpkTab(Node.Parent.Data); + index := Tab.Panes.IndexOf(Pane); + if index = -1 then + raise Exception.create('TfrmEditWindow.aRemovePaneExecute: Uszkodzona struktura drzewa!'); + if Node.GetPrevSibling <> nil then + NextNode := Node.GetPrevSibling + else if Node.GetNextSibling <> nil then + NextNode := Node.GetNextSibling + else + NextNode := Node.Parent; + Tab.Panes.Delete(index); + tvStructure.Items.Delete(Node); + NextNode.Selected := true; + CheckActionsAvailability; +end; + +procedure TfrmEditWindow.DoRemoveTab; +var + Node: TTreeNode; + Tab: TSpkTab; + index: Integer; + NextNode: TTreeNode; + DesignObj: IDesignObject; +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + + Node := tvStructure.Selected; + if not (CheckValidTabNode(Node)) then + raise exception.create('TfrmEditWindow.aRemoveTabExecute: Uszkodzona struktura drzewa!'); + Tab := TSpkTab(Node.Data); + index := FToolbar.Tabs.IndexOf(Tab); + if index = -1 then + raise exception.create('TfrmEditWindow.aRemoveTabExecute: Uszkodzona struktura drzewa!'); + if Node.GetPrevSibling <> nil then + NextNode := Node.GetPrevSibling + else if Node.GetNextSibling <> nil then + NextNode := Node.GetNextSibling + else + NextNode := nil; + FToolbar.Tabs.Delete(index); + tvStructure.Items.Delete(Node); + if assigned(NextNode) then + begin + // Zdarzenie OnChange wyzwoli aktualizację zaznaczonego obiektu w + // Object Inspectorze + NextNode.Selected := true; + CheckActionsAvailability; + end + else + begin + // Nie ma już żadnych obiektów na liście, ale coś musi zostać wyświetlone w + // Object Inspectorze - wyświetlamy więc samego toolbara (w przeciwnym + // wypadku IDE będzie próbowało wyświetlić w Object Inspectorze właściwości + // właśnie zwolnionego obiektu, co skończy się, powiedzmy, niezbyt miło) + DesignObj := PersistentToDesignObject(FToolbar); + FDesigner.SelectComponent(DesignObj); + CheckActionsAvailability; + end; +end; + +procedure TfrmEditWindow.BuildTreeData; +var + i: Integer; + panenode: TTreeNode; + j: Integer; + tabnode: TTreeNode; + k : Integer; + itemnode: TTreeNode; + Obj: TSpkBaseItem; + s: string; +begin + Caption:='Editing TSpkToolbar contents'; + tvStructure.Items.Clear; + + if (FToolbar<>nil) and (FDesigner<>nil) then + begin + if FToolbar.Tabs.Count > 0 then + for i := 0 to FToolbar.Tabs.Count - 1 do + begin + tabnode := tvStructure.Items.AddChild(nil, FToolbar.Tabs[i].Caption); + tabnode.ImageIndex := 0; + tabnode.SelectedIndex := 0; + tabnode.Data := FToolbar.Tabs[i]; + if FToolbar.Tabs[i].Panes.Count > 0 then + for j := 0 to FToolbar.Tabs.Items[i].Panes.Count - 1 do + begin + panenode := tvStructure.Items.AddChild(tabnode, FToolbar.Tabs[i].Panes[j].Caption); + panenode.ImageIndex := 1; + panenode.SelectedIndex := 1; + panenode.Data := FToolbar.Tabs[i].Panes[j]; + if FToolbar.Tabs[i].Panes[j].Items.Count > 0 then + for k := 0 to FToolbar.Tabs[i].Panes[j].Items.Count - 1 do + begin + Obj:=FToolbar.Tabs[i].Panes[j].Items[k]; + s:=GetItemCaption(Obj); + + itemnode:=tvStructure.Items.AddChild(panenode,s); + itemnode.Imageindex:=2; + itemnode.Selectedindex:=2; + itemnode.Data:=Obj; + end; + end; + end; + end; + + if tvStructure.Items.Count > 0 then + tvStructure.Items[0].Selected := true; + CheckActionsAvailability; +end; + +procedure TfrmEditWindow.RefreshNames; + +var tabnode, panenode, itemnode : TTreeNode; + Obj: TSpkBaseItem; + s: string; + +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +tabnode:=tvStructure.Items.GetFirstNode; +while tabnode<>nil do + begin + if not(CheckValidTabNode(tabnode)) then + raise exception.create('TfrmEditWindow.RefreshNames: Uszkodzona struktura drzewa!'); + + tabnode.Text:=TSpkTab(tabnode.Data).Caption; + + panenode:=tabnode.getFirstChild; + while panenode<>nil do + begin + if not(CheckValidPaneNode(panenode)) then + raise exception.create('TfrmEditWindow.RefreshNames: Uszkodzona struktura drzewa!'); + + panenode.Text:=TSpkPane(panenode.Data).Caption; + + itemnode:=panenode.getFirstChild; + while itemnode<>nil do + begin + if not(CheckValidItemNode(itemnode)) then + raise exception.create('TfrmEditWindow.RefreshNames: Uszkodzona struktura drzewa!'); + + Obj:=TSpkBaseItem(itemnode.Data); + s:=GetItemCaption(Obj); + + itemnode.Text:=s; + + itemnode:=itemnode.getNextSibling; + end; + + panenode:=panenode.getNextSibling; + end; + + tabnode:=tabnode.getNextSibling; + end; +end; + +procedure TfrmEditWindow.tvStructureChange(Sender: TObject; Node: TTreeNode); + +var Obj : TObject; + Tab : TSpkTab; + Pane : TSpkPane; + Item : TSpkBaseItem; + DesignObj : IDesignObject; + index : integer; + +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +if assigned(Node) then + begin + Obj:=TObject(Node.Data); + + if Obj=nil then + raise exception.create('TfrmEditWindow.tvStructureChange: Nieprawidłowe dane w gałęzi!'); + + if Obj is TSpkTab then + begin + Tab:=Obj as TSpkTab; + DesignObj:=PersistentToDesignObject(Tab); + FDesigner.SelectComponent(DesignObj); + + index:=FToolbar.Tabs.IndexOf(Tab); + if index=-1 then + raise exception.create('TfrmEditWindow.tvStructureChange: Uszkodzona struktura drzewa!'); + FToolbar.TabIndex:=index; + end else + if Obj is TSpkPane then + begin + Pane:=Obj as TSpkPane; + DesignObj:=PersistentToDesignObject(Pane); + FDesigner.SelectComponent(DesignObj); + + if not(CheckValidPaneNode(Node)) then + raise exception.create('TfrmEditWindow.tvStructureChange: Uszkodzona struktura drzewa!'); + + Tab:=TSpkTab(Node.Parent.Data); + + index:=FToolbar.Tabs.IndexOf(Tab); + if index=-1 then + raise exception.create('TfrmEditWindow.tvStructureChange: Uszkodzona struktura drzewa!'); + FToolbar.TabIndex:=index; + end else + if Obj is TSpkBaseItem then + begin + Item:=Obj as TSpkBaseItem; + DesignObj:=PersistentToDesignObject(Item); + FDesigner.SelectComponent(DesignObj); + + if not(CheckValidItemNode(Node)) then + raise exception.create('TfrmEditWindow.tvStructureChange: Uszkodzona struktura drzewa!'); + + Tab:=TSpkTab(Node.Parent.Parent.Data); + + index:=FToolbar.Tabs.IndexOf(Tab); + if index=-1 then + raise exception.create('TfrmEditWindow.tvStructureChange: Uszkodzona struktura drzewa!'); + FToolbar.TabIndex:=index; + end else + raise exception.create('TfrmEditWindow.tvStructureChange: Nieprawidłowy obiekt podwieszony pod gałęzią!'); + end else + begin + DesignObj:=PersistentToDesignObject(FToolbar); + FDesigner.SelectComponent(DesignObj); + end; + +CheckActionsAvailability; +end; + +procedure TfrmEditWindow.tvStructureEdited(Sender: TObject; Node: TTreeNode; + var S: string); +var + Tab: TSpkTab; + Pane: TSpkPane; + Item: TSpkBaseItem; + +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +if Node.Data = nil then + raise exception.create('TfrmEditWindow.tvStructureEdited: Uszkodzona struktura drzewa!'); + +if TObject(Node.Data) is TSpkTab then + begin + Tab:=TObject(Node.Data) as TSpkTab; + Tab.Caption:=S; + + FDesigner.Modified; + end else +if TObject(Node.Data) is TSpkPane then + begin + Pane:=TObject(Node.Data) as TSpkPane; + Pane.Caption:=S; + + FDesigner.Modified; + end else +if TObject(Node.Data) is TSpkBaseItem then + begin + Item:=TObject(Node.Data) as TSpkBaseItem; + SetItemCaption(Item, S); + + FDesigner.Modified; + end else + raise exception.create('TfrmEditWindow.tvStructureEdited: Uszkodzona struktura drzewa!'); +end; + +procedure TfrmEditWindow.tvStructureKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +if Key = VK_DELETE then + begin + if tvStructure.Selected<>nil then + begin + // Sprawdzamy, jakiego rodzaju obiekt jest zaznaczony - wystarczy + // przetestować typ podwieszonego obiektu. + if TObject(tvStructure.Selected.Data) is TSpkTab then + begin + DoRemoveTab; + end else + if TObject(tvStructure.Selected.Data) is TSpkPane then + begin + DoRemovePane; + end else + if TObject(tvStructure.Selected.Data) is TSpkBaseItem then + begin + DoRemoveItem; + end else + raise exception.create('TfrmEditWindow.tvStructureKeyDown: Uszkodzona struktura drzewa!'); + end; + end; +end; + +function TfrmEditWindow.ValidateTreeData: boolean; + +var + i: Integer; + TabsValid: Boolean; + TabNode: TTreeNode; + j: Integer; + PanesValid: Boolean; + PaneNode: TTreeNode; + k: Integer; + ItemsValid: Boolean; + ItemNode: TTreeNode; + +begin +result:=false; +if (FToolbar=nil) or (FDesigner=nil) then + exit; + +i:=0; +TabsValid:=true; +TabNode:=tvStructure.Items.GetFirstNode; + +while (inil); + + if TabsValid then + TabsValid:=TabsValid and (TabNode.Data = FToolbar.Tabs[i]); + + if TabsValid then + begin + j:=0; + PanesValid:=true; + PaneNode:=TabNode.GetFirstChild; + + while (jnil); + + if PanesValid then + PanesValid:=PanesValid and (PaneNode.Data = FToolbar.Tabs[i].Panes[j]); + + if PanesValid then + begin + k:=0; + ItemsValid:=true; + ItemNode:=PaneNode.GetFirstChild; + + while (knil); + + if ItemsValid then + ItemsValid:=ItemsValid and (ItemNode.Data = FToolbar.Tabs[i].Panes[j].Items[k]); + + if ItemsValid then + begin + inc(k); + ItemNode:=ItemNode.GetNextSibling; + end; + end; + + // Ważne! Trzeba sprawdzić, czy w drzewie nie ma dodatkowych + // elementów! + ItemsValid:=ItemsValid and (ItemNode = nil); + + PanesValid:=PanesValid and ItemsValid; + end; + + if PanesValid then + begin + inc(j); + PaneNode:=PaneNode.GetNextSibling; + end; + end; + + // Ważne! Trzeba sprawdzić, czy w drzewie nie ma dodatkowych + // elementów! + PanesValid:=PanesValid and (PaneNode = nil); + + TabsValid:=TabsValid and PanesValid; + end; + + if TabsValid then + begin + inc(i); + TabNode:=TabNode.GetNextSibling; + end; + end; + +// Ważne! Trzeba sprawdzić, czy w drzewie nie ma dodatkowych +// elementów! +TabsValid:=TabsValid and (TabNode = nil); + +result:=TabsValid; +end; + +end. diff --git a/components/spktoolbar/SpkToolbar/SpkToolbar.pas b/components/spktoolbar/SpkToolbar/SpkToolbar.pas new file mode 100644 index 000000000..b2a758209 --- /dev/null +++ b/components/spktoolbar/SpkToolbar/SpkToolbar.pas @@ -0,0 +1,1485 @@ +unit SpkToolbar; + +(******************************************************************************* +* * +* Plik: SpkToolbar.pas * +* Opis: Główny komponent toolbara * +* Copyright: (c) 2009 by Spook. Jakiekolwiek użycie komponentu bez * +* uprzedniego uzyskania licencji od autora stanowi złamanie * +* prawa autorskiego! * +* * +*******************************************************************************) + +interface + +uses Windows, Graphics, SysUtils, Controls, Classes, Messages, Math, Dialogs, + Types, + SpkGraphTools, SpkGUITools, SpkMath, SpkXMLParser, + spkt_Appearance, spkt_BaseItem, spkt_Const, spkt_Dispatch, spkt_Tab, + spkt_Pane, spkt_Exceptions, spkt_Types; + +type /// Typ opisujący regiony toolbara, które są używane podczas + /// obsługi interakcji z myszą + TSpkMouseToolbarElement = (teNone, teToolbarArea, teTabs, teTabContents); + +type TSpkToolbar = class; + + /// Klasa dyspozytora służąca do bezpiecznego przyjmowania + /// informacji oraz żądań od pod-elementów + TSpkToolbarDispatch = class(TSpkBaseToolbarDispatch) + private + /// Komponent toolbara, który przyjmuje informacje i żądania + /// od pod-elementów + FToolbar : TSpkToolbar; + protected + public + // ******************* + // *** Konstruktor *** + // ******************* + + /// Konstruktor + constructor Create(AToolbar : TSpkToolbar); + + // ****************************************************************** + // *** Implementacja abstrakcyjnych metod TSpkBaseToolbarDispatch *** + // ****************************************************************** + + /// Metoda wywoływana, gdy zmieni się zawartość obiektu wyglądu + /// zawierającego kolory i czcionki używane do rysowania toolbara. + /// + procedure NotifyAppearanceChanged; override; + /// Metoda wywoływana, gdy zmieni się lista pod-elementów jednego + /// z elementów toolbara + procedure NotifyItemsChanged; override; + /// Metoda wywoływana, gdy zmieni się rozmiar lub położenie + /// (metryka) jednego z elementów toolbara + procedure NotifyMetricsChanged; override; + /// Metoda wywoływana, gdy zmieni się wygląd jednego z elementów + /// toolbara, nie wymagający jednak przebudowania metryk. + procedure NotifyVisualsChanged; override; + /// Metoda żąda dostarczenia przez toolbar pomocniczej + /// bitmapy używanej - przykładowo - do obliczania rozmiarów renderowanego + /// tekstu + function GetTempBitmap : TBitmap; override; + /// Metoda przelicza współrzędne toolbara na współrzędne + /// ekranu, co umożliwia - na przykład - rozwinięcie popup menu. + function ClientToScreen(Point : T2DIntPoint) : T2DIntPoint; override; + end; + + /// Rozszerzony pasek narzędzi inspirowany Microsoft Fluent + /// UI + TSpkToolbar = class(TCustomControl) + private + /// Instancja obiektu dyspozytora przekazywanego elementom + /// toolbara + FToolbarDispatch : TSpkToolbarDispatch; + + /// Bufor w którym rysowany jest toolbar + FBuffer : TBitmap; + /// Pomocnicza bitmapa przekazywana na życzenie elementom + /// toolbara + FTemporary : TBitmap; + + /// Tablica rectów "uchwytów" zakładek + FTabRects : array of T2DIntRect; + /// Cliprect obszaru "uchwytów" zakładek + FTabClipRect : T2DIntRect; + /// Cliprect obszaru zawartości zakładki + FTabContentsClipRect : T2DIntRect; + + /// Element toolbara znajdujący się obecnie pod myszką + FMouseHoverElement : TSpkMouseToolbarElement; + /// Element toolbara mający obecnie wyłączność na otrzymywanie + /// komunikatów od myszy + FMouseActiveElement : TSpkMouseToolbarElement; + + /// "Uchwyt" zakładki, nad którym znajduje się obecnie mysz + /// + FTabHover : integer; + + /// Flaga informująca o tym, czy metryki toolbara i jego elementów + /// są aktualne + FMetricsValid : boolean; + /// Flaga informująca o tym, czy zawartość bufora jest aktualna + /// + FBufferValid : boolean; + /// Flaga InternalUpdating pozwala na zablokowanie walidacji + /// metryk i bufora w momencie, gdy komponent przebudowuje swoją zawartość. + /// FInternalUpdating jest zapalana i gaszona wewnętrznie, przez komponent. + /// + FInternalUpdating : boolean; + /// Flaga IUpdating pozwala na zablokowanie walidacji + /// metryk i bufora w momencie, gdy użytkownik przebudowuje zawartość + /// komponentu. FUpdating jest sterowana przez użytkownika. + FUpdating : boolean; + protected + /// Instancja obiektu wyglądu, przechowującego kolory i czcionki + /// używane podczas renderowania komponentu + FAppearance : TSpkToolbarAppearance; + /// Zakładki toolbara + FTabs : TSpkTabs; + /// Indeks wybranej zakładki + FTabIndex : integer; + /// Lista małych obrazków elementów toolbara + FImages : TImageList; + /// Lista małych obrazków w stanie "disabled". Jeśli nie jest + /// przypisana, obrazki w stanie "disabled" będą generowane automatycznie. + /// + FDisabledImages : TImageList; + /// Lista dużych obrazków elementów toolbara + FLargeImages : TImageList; + /// Lista dużych obrazków w stanie "disabled". Jeśli nie jest + /// przypisana, obrazki w stanie "disabled" będą generowane automatycznie. + /// + FDisabledLargeImages : TImageList; + + // ******************************************* + // *** Zarządzanie stanem metryki i bufora *** + // ******************************************* + + /// Metoda gasi flagi: FMetricsValid oraz FBufferValid + procedure SetMetricsInvalid; + /// Metoda gasi flagę FBufferValid + procedure SetBufferInvalid; + /// Metoda waliduje metryki toolbara i jego elementów + procedure ValidateMetrics; + /// Metoda waliduje zawartość bufora + procedure ValidateBuffer; + /// Metoda włącza tryb wewnętrznej przebudowy - zapala flagę + /// FInternalUpdating + procedure InternalBeginUpdate; + /// Metoda wyłącza tryb wewnętrznej przebudowy - gasi flagę + /// FInternalUpdating + procedure InternalEndUpdate; + + // ******************************************** + // *** Pokrycie metod z dziedziczonych klas *** + // ******************************************** + + /// Zmiana rozmiaru komponentu + procedure Resize; override; + /// Metoda wywoływana po opuszczeniu obszaru komponentu przez + /// wskaźnik myszy + procedure MouseLeave; + /// Metoda wywoływana po wciśnięciu przycisku myszy + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + /// Metoda wywoływana, gdy nad komponentem przesunie się wskaźnik + /// myszy + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + /// Metoda wywoływana po puszczeniu przycisku myszy + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + /// Metoda wywoływana, gdy cały komponent wczyta się z DFMa + /// + procedure Loaded; override; + /// Metoda wywoływana, gdy komponent staje się Ownerem innego + /// komponentu, bądź gdy jeden z jego pod-komponentów jest zwalniany + /// + procedure Notification(AComponent: TComponent; + Operation: TOperation); override; + + // ****************************************** + // *** Obsługa zdarzeń myszy dla zakładek *** + // ****************************************** + + /// Metoda wywoływana po opuszczeniu przez wskaźnik myszy obszaru + /// "uchwytów" zakładek + procedure TabMouseLeave; + /// Metoda wywoływana po wciśnięciu przycisku myszy, gdy wskaźnik + /// jest nad obszarem zakładek + procedure TabMouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); + /// Metoda wywoływana, gdy mysz przesunie się ponad obszarem + /// "uchwytów" zakładek + procedure TabMouseMove(Shift: TShiftState; X, Y: Integer); + /// Metoda wywoływana, gdy jeden z przycisków myszy zostanie + /// puszczony, gdy obszar zakładek był aktywnym elementem toolbara + /// + procedure TabMouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); + + // ****************** + // *** Pomocnicze *** + // ****************** + + /// Metoda sprawdza, czy choć jedna zakładka ma ustawioną flagę + /// widoczności (Visible) + function AtLeastOneTabVisible : boolean; + + // *************************** + // *** Obsługa komunikatów *** + // *************************** + + /// Komunikat odbierany, gdy mysz opuści obszar komponentu + /// + procedure CMMouseLeave(var msg : TMessage); message CM_MOUSELEAVE; + + // ******************************** + // *** Obsługa designtime i DFM *** + // ******************************** + + /// Metoda zwraca elementy, które mają zostać zapisane jako + /// pod-elementy komponentu + procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; + /// Metoda pozwala na zapisanie lub odczytanie dodatkowych + /// własności komponentu + procedure DefineProperties(Filer : TFiler); override; + + // ************************* + // *** Gettery i settery *** + // ************************* + + /// Getter dla własności Height + function GetHeight: integer; + /// Setter dla własności Appearance + procedure SetAppearance(const Value: TSpkToolbarAppearance); + /// Getter dla własności Color + function GetColor: TColor; + /// Setter dla własności Color + procedure SetColor(const Value: TColor); + /// Setter dla własności TabIndex + procedure SetTabIndex(const Value: integer); + /// Setter dla własności Images + procedure SetImages(const Value: TImageList); + /// Setter dla własności DisabledImages + procedure SetDisabledImages(const Value : TImageList); + /// Setter dla własności LargeImages + procedure SetLargeImages(const Value : TImageList); + /// Setter dla własności DisabledLargeImages + procedure SetDisabledLargeImages(const Value : TImageList); + public + + // *********************************** + // *** Obsługa zdarzeń dyspozytora *** + // *********************************** + + /// Reakcja na zmianę struktury elementów toolbara + procedure NotifyItemsChanged; + /// Reakcja na zmianę metryki elementów toolbara + procedure NotifyMetricsChanged; + /// Reakcja na zmianę wyglądu elementów toolbara + procedure NotifyVisualsChanged; + /// Reakcja na zmianę zawartości klasy wyglądu toolbara + procedure NotifyAppearanceChanged; + /// Metoda zwraca instancję pomocniczej bitmapy + function GetTempBitmap : TBitmap; + + // ******************************** + // *** Konstruktor i destruktor *** + // ******************************** + + /// Konstruktor + constructor Create(AOwner : TComponent); override; + /// Destruktor + destructor Destroy; override; + + // ***************** + // *** Rysowanie *** + // ***************** + + /// Metoda odrysowuje zawartość komponentu + procedure Paint; override; + /// Metoda wymusza przebudowanie metryk i bufora + procedure ForceRepaint; + /// Metoda przełącza komponent w tryb aktualizacji zawartości + /// poprzez zapalenie flagi FUpdating + procedure BeginUpdate; + /// Metoda wyłącza tryb aktualizacji zawartości poprzez zgaszenie + /// flagi FUpdating + procedure EndUpdate; + + // ************************* + // *** Obsługa elementów *** + // ************************* + + /// Metoda wywoływana w momencie, gdy jedna z zakładek + /// jest zwalniana + /// Nie należy wywoływać metody FreeingTab z kodu! Jest ona + /// wywoływana wewnętrznie, a jej zadaniem jest zaktualizowanie wewnętrznej + /// listy zakładek. + procedure FreeingTab(ATab : TSpkTab); + + // ************************** + // *** Dostęp do zakładek *** + // ************************** + + /// Własność daje dostę do zakładek w trybie runtime. Do edycji + /// zakładek w trybie designtime służy odpowiedni edytor, zaś zapisywanie + /// i odczytywanie z DFMa jest zrealizowane manualnie. + property Tabs : TSpkTabs read FTabs; + published + /// Kolor tła komponentu + property Color : TColor read GetColor write SetColor; + /// Obiekt zawierający atrybuty wyglądu toolbara + property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance; + /// Wysokość toolbara (tylko do odczytu) + property Height : integer read GetHeight; + /// Aktywna zakładka + property TabIndex : integer read FTabIndex write SetTabIndex; + /// Lista małych obrazków + property Images : TImageList read FImages write SetImages; + /// Lista małych obrazków w stanie "disabled" + property DisabledImages : TImageList read FDisabledImages write SetDisabledImages; + /// Lista dużych obrazków + property LargeImages : TImageList read FLargeImages write SetLargeImages; + /// Lista dużych obrazków w stanie "disabled" + property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages; + end; + +implementation + +{ TSpkToolbarDispatch } + +function TSpkToolbarDispatch.ClientToScreen(Point: T2DIntPoint): T2DIntPoint; +begin + if FToolbar<>nil then + result:=FToolbar.ClientToScreen(Point) else + result:=T2DIntPoint.Create(-1,-1); +end; + +constructor TSpkToolbarDispatch.Create(AToolbar: TSpkToolbar); +begin + inherited Create; + FToolbar:=AToolbar; +end; + +function TSpkToolbarDispatch.GetTempBitmap: TBitmap; +begin + if FToolbar<>nil then + result:=FToolbar.GetTempBitmap else + result:=nil; +end; + +procedure TSpkToolbarDispatch.NotifyAppearanceChanged; +begin + if FToolbar<>nil then + FToolbar.NotifyAppearanceChanged; +end; + +procedure TSpkToolbarDispatch.NotifyMetricsChanged; +begin + if FToolbar<>nil then + FToolbar.NotifyMetricsChanged; +end; + +procedure TSpkToolbarDispatch.NotifyItemsChanged; +begin + if FToolbar<>nil then + FToolbar.NotifyItemsChanged; +end; + +procedure TSpkToolbarDispatch.NotifyVisualsChanged; +begin + if FToolbar<>nil then + FToolbar.NotifyVisualsChanged; +end; + +{ TSpkToolbar } + +function TSpkToolbar.AtLeastOneTabVisible: boolean; + +var i : integer; + TabVisible : boolean; + +begin +result:=FTabs.count>0; +if result then + begin + TabVisible:=false; + i:=FTabs.count-1; + while (i>=0) and not(TabVisible) do + begin + TabVisible:=FTabs[i].Visible; + dec(i); + end; + result:=result and TabVisible; + end; +end; + +procedure TSpkToolbar.BeginUpdate; +begin + FUpdating:=true; +end; + +procedure TSpkToolbar.CMMouseLeave(var msg: TMessage); +begin + inherited; + MouseLeave; +end; + +constructor TSpkToolbar.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + // Inicjacja dziedziczonych własności + inherited Align:=alTop; + inherited AlignWithMargins:=true; + inherited Height:=TOOLBAR_HEIGHT; + inherited Doublebuffered:=true; + + // Inicjacja wewnętrznych pól danych + FToolbarDispatch:=TSpkToolbarDispatch.Create(self); + + FBuffer:=TBitmap.create; + FBuffer.PixelFormat:=pf24bit; + + FTemporary:=TBitmap.create; + FTemporary.Pixelformat:=pf24bit; + + setlength(FTabRects,0); + FTabClipRect:=T2DIntRect.create(0,0,0,0); + FTabContentsClipRect:=T2DIntRect.create(0,0,0,0); + + FMouseHoverElement:=teNone; + FMouseActiveElement:=teNone; + + FTabHover:=-1; + + FMetricsValid:=false; + FBufferValid:=false; + FInternalUpdating:=false; + FUpdating:=false; + + // Inicjacja pól + FAppearance:=TSpkToolbarAppearance.Create(FToolbarDispatch); + + FTabs:=TSpkTabs.Create(self); + FTabs.ToolbarDispatch:=FToolbarDispatch; + FTabs.Appearance:=FAppearance; + + FTabIndex:=-1; + + FImages:=nil; + FDisabledImages:=nil; + FLargeImages:=nil; + FDisabledLargeImages:=nil; +end; + +procedure TSpkToolbar.DefineProperties(Filer: TFiler); +begin + inherited DefineProperties(Filer); + + Filer.DefineProperty('Tabs',FTabs.ReadNames,FTabs.WriteNames,true); +end; + +destructor TSpkToolbar.Destroy; +begin + // Zwalniamy pola + FTabs.Free; + + FAppearance.Free; + + // Zwalniamy wewnętrzne pola + FTemporary.Free; + FBuffer.Free; + + FToolbarDispatch.Free; + + inherited Destroy; +end; + +procedure TSpkToolbar.EndUpdate; +begin + FUpdating:=false; + + ValidateMetrics; + ValidateBuffer; + Repaint; +end; + +procedure TSpkToolbar.ForceRepaint; +begin +SetMetricsInvalid; +SetBufferInvalid; +Repaint; +end; + +procedure TSpkToolbar.FreeingTab(ATab: TSpkTab); +begin +FTabs.RemoveReference(ATab); +end; + +procedure TSpkToolbar.GetChildren(Proc: TGetChildProc; Root: TComponent); + +var i : integer; + +begin +inherited; + +if FTabs.Count>0 then + for i := 0 to FTabs.Count - 1 do + Proc(FTabs.Items[i]); +end; + +function TSpkToolbar.GetColor: TColor; +begin +result:=inherited Color; +end; + +function TSpkToolbar.GetHeight: integer; +begin +result:=inherited Height; +end; + +function TSpkToolbar.GetTempBitmap: TBitmap; +begin +result:=FTemporary; +end; + +procedure TSpkToolbar.InternalBeginUpdate; +begin + FInternalUpdating:=true; +end; + +procedure TSpkToolbar.InternalEndUpdate; +begin + FInternalUpdating:=false; + + // Po wewnętrznych zmianach odświeżamy metryki i bufor + ValidateMetrics; + ValidateBuffer; + Repaint; +end; + +procedure TSpkToolbar.Loaded; +begin +inherited; + +InternalBeginUpdate; + +if FTabs.ListState = lsNeedsProcessing then + begin + FTabs.ProcessNames(self.Owner); + end; + +InternalEndUpdate; + +// Proces wewnętrznego update'u zawsze odświeża na końcu metryki i bufor oraz +// odrysowuje komponent. +end; + +procedure TSpkToolbar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, + Y: Integer); + +begin + // Podczas procesu przebudowy mysz jest ignorowana. + if FInternalUpdating or FUpdating then + exit; + + inherited MouseDown(Button, Shift, X, Y); + + // Możliwe, że został wciśnięty kolejny przycisk myszy. W takiej sytuacji + // aktywny obiekt otrzymuje kolejną notyfikację. + if FMouseActiveElement=teTabs then + begin + TabMouseDown(Button, Shift, X, Y); + end else + if FMouseActiveElement=teTabContents then + begin + if FTabIndex<>-1 then + FTabs[FTabIndex].MouseDown(Button, Shift, X, Y); + end else + if FMouseActiveElement = teToolbarArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia + end else + // Jeśli nie ma aktywnego elementu, aktywnym staje się ten, który obecnie + // jest pod myszą. + if FMouseActiveElement=teNone then + begin + if FMouseHoverElement = teTabs then + begin + FMouseActiveElement:=teTabs; + TabMouseDown(Button, Shift, X, Y); + end else + if FMouseHoverElement = teTabContents then + begin + FMouseActiveElement:=teTabContents; + if FTabIndex<>-1 then + FTabs[FTabIndex].MouseDown(Button, Shift, X, Y); + end else + if FMouseHoverElement = teToolbarArea then + begin + FMouseActiveElement:=teToolbarArea; + + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia + end; + end; +end; + +procedure TSpkToolbar.MouseLeave; + +begin + // Podczas procesu przebudowy mysz jest ignorowana. + if FInternalUpdating or FUpdating then + exit; + + // MouseLeave nie ma szans być zawołane dla obiektu aktywnego, bo po + // wciśnięciu przycisku myszy każdy jej ruch jest przekazywany jako + // MouseMove. Jeśli mysz wyjedzie za obszar komponentu, MouseLeave + // zostanie zawołany zaraz po MouseUp - ale MouseUp czyści aktywny + // obiekt. + if FMouseActiveElement = teNone then + begin + // Jeśli nie ma obiektu aktywnego, obsługujemy elementy pod myszą + if FMouseHoverElement = teTabs then + begin + TabMouseLeave; + end else + if FMouseHoverElement = teTabContents then + begin + if FTabIndex<>-1 then + FTabs[FTabIndex].MouseLeave; + end else + if FMouseHoverElement = teToolbarArea then + begin + // Placeholder, jeśli będzie potrzeba obsługi tego zdarzenia + end; + end; + + FMouseHoverElement:=teNone; +end; + +procedure TSpkToolbar.MouseMove(Shift: TShiftState; X, Y: Integer); + +var NewMouseHoverElement : TSpkMouseToolbarElement; + MousePoint : T2DIntVector; + +begin + // Podczas procesu przebudowy mysz jest ignorowana. + if FInternalUpdating or FUpdating then + exit; + + inherited MouseMove(Shift, X, Y); + + // Sprawdzamy, który obiekt jest pod myszą + MousePoint:=T2DIntVector.create(x,y); + + if FTabClipRect.Contains(MousePoint) then + NewMouseHoverElement:=teTabs else + if FTabContentsClipRect.Contains(MousePoint) then + NewMouseHoverElement:=teTabContents else + if (X>=0) and (Y>=0) and (X-1 then + FTabs[FTabIndex].MouseMove(Shift, X, Y); + end else + if FMouseActiveElement = teToolbarArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia + end else + if FMouseActiveElement = teNone then + begin + // Jeśli element pod myszą się zmienia, informujemy poprzedni element o + // tym, że mysz opuszcza jego obszar + if NewMouseHoverElement<>FMouseHoverElement then + begin + if FMouseHoverElement = teTabs then + begin + TabMouseLeave; + end else + if FMouseHoverElement = teTabContents then + begin + if FTabIndex<>-1 then + FTabs[FTabIndex].MouseLeave; + end else + if FMouseHoverElement = teToolbarArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia + end; + end; + + // Element pod myszą otrzymuje MouseMove + if NewMouseHoverElement = teTabs then + begin + TabMouseMove(Shift, X, Y); + end else + if NewMouseHoverElement = teTabContents then + begin + if FTabIndex<>-1 then + FTabs[FTabIndex].MouseMove(Shift, X, Y); + end else + if NewMouseHoverElement = teToolbarArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia + end; + end; + +FMouseHoverElement:=NewMouseHoverElement; +end; + +procedure TSpkToolbar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, + Y: Integer); + +var ClearActive: Boolean; + +begin + // Podczas procesu przebudowy mysz jest ignorowana. + if FInternalUpdating or FUpdating then + exit; + + inherited MouseUp(Button, Shift, X, Y); + + ClearActive:=not(ssLeft in Shift) and not(ssMiddle in Shift) and not(ssRight in Shift); + + // Jeśli jest jakiś aktywny obiekt, to on ma wyłączność na otrzymywanie + // komunikatów + if FMouseActiveElement=teTabs then + begin + TabMouseUp(Button, Shift, X, Y); + end else + if FMouseActiveElement=teTabContents then + begin + if FTabIndex<>-1 then + FTabs[FTabIndex].MouseUp(Button, Shift, X, Y); + end else + if FMouseActiveElement = teToolbarArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia + end; + + // Jeśli puszczono ostatni przycisk i mysz nie znajduje się nad aktywnym + // obiektem, trzeba dodatkowo wywołać MouseLeave dla aktywnego i MouseMove + // dla obiektu pod myszą. + if ClearActive and (FMouseActiveElement<>FMouseHoverElement) then + begin + if FMouseActiveElement = teTabs then + TabMouseLeave else + if FMouseActiveElement = teTabContents then + begin + if FTabIndex<>-1 then + FTabs[FTabIndex].MouseLeave; + end else + if FMouseActiveElement = teToolbarArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia + end; + + if FMouseHoverElement=teTabs then + TabMouseMove(Shift, X, Y) else + if FMouseHoverElement=teTabContents then + begin + if FTabIndex<>-1 then + FTabs[FTabIndex].MouseMove(Shift, X, Y); + end else + if FMouseHoverElement = teToolbarArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia + end; + end; + + // MouseUp gasi aktywny obiekt, o ile zostały puszczone wszystkie + // przyciski + if ClearActive then + FMouseActiveElement:=teNone; +end; + +procedure TSpkToolbar.Notification(AComponent: TComponent; + Operation: TOperation); + +var Tab : TSpkTab; + Pane : TSpkPane; + Item : TSpkBaseItem; + +begin + inherited; + + if AComponent is TSpkTab then + begin + FreeingTab(AComponent as TSpkTab); + end else + if AComponent is TSpkPane then + begin + Pane:=AComponent as TSpkPane; + if (Pane.Parent<>nil) and (Pane.Parent is TSpkTab) then + begin + Tab:=Pane.Parent as TSpkTab; + Tab.FreeingPane(Pane); + end; + end else + if AComponent is TSpkBaseItem then + begin + Item:=AComponent as TSpkBaseItem; + if (Item.Parent<>nil) and (Item.Parent is TSpkPane) then + begin + Pane:=Item.Parent as TSpkPane; + Pane.FreeingItem(Item); + end; + end; +end; + +procedure TSpkToolbar.NotifyAppearanceChanged; +begin + SetMetricsInvalid; + + if not(FInternalUpdating or FUpdating) then + Repaint; +end; + +procedure TSpkToolbar.NotifyMetricsChanged; +begin + SetMetricsInvalid; + + if not(FInternalUpdating or FUpdating) then + Repaint; +end; + +procedure TSpkToolbar.NotifyItemsChanged; +begin + // Poprawianie TabIndex o ile zachodzi taka potrzeba + if not(AtLeastOneTabVisible) then FTabIndex:=-1 + else + begin + FTabIndex:=max(0,min(FTabs.count-1,FTabIndex)); + + // Wiem, że przynajmniej jedna zakładka jest widoczna (z wcześniejszego + // warunku), więc poniższa pętla na pewno się zakończy. + while not(FTabs[FTabIndex].Visible) do + FTabIndex:=(FTabIndex + 1) mod FTabs.count; + end; + FTabHover:=-1; + + SetMetricsInvalid; + + if not(FInternalUpdating or FUpdating) then + Repaint; +end; + +procedure TSpkToolbar.NotifyVisualsChanged; +begin + SetBufferInvalid; + + if not(FInternalUpdating or FUpdating) then + Repaint; +end; + +procedure TSpkToolbar.Paint; + +begin +// Jeśli trwa proces przebudowy (wewnętrznej lub użytkownika), walidacja metryk +// i bufora nie jest przeprowadzana, jednak bufor jest rysowany w takiej +// postaci, w jakiej został zapamiętany przed rozpoczęciem procesu przebudowy. +if not(FInternalUpdating or FUpdating) then + begin + if not(FMetricsValid) then + ValidateMetrics; + if not(FBufferValid) then + ValidateBuffer; + end; + +self.canvas.draw(0, 0, FBuffer); +end; + +procedure TSpkToolbar.Resize; +begin + inherited Height:=TOOLBAR_HEIGHT; + + SetMetricsInvalid; + SetBufferInvalid; + + if not(FInternalUpdating or FUpdating) then + Repaint; + + inherited; +end; + +procedure TSpkToolbar.SetBufferInvalid; +begin +FBufferValid:=false; +end; + +procedure TSpkToolbar.SetColor(const Value: TColor); +begin +inherited Color:=Value; +SetBufferInvalid; + +if not(FInternalUpdating or FUpdating) then + Repaint; +end; + +procedure TSpkToolbar.SetDisabledImages(const Value: TImageList); +begin + FDisabledImages := Value; + FTabs.DisabledImages := Value; + SetMetricsInvalid; + + if not(FInternalUpdating or FUpdating) then + Repaint; +end; + +procedure TSpkToolbar.SetDisabledLargeImages(const Value: TImageList); +begin + FDisabledLargeImages := Value; + FTabs.DisabledLargeImages := Value; + SetMetricsInvalid; + + if not(FInternalUpdating or FUpdating) then + Repaint; +end; + +procedure TSpkToolbar.SetImages(const Value: TImageList); +begin + FImages := Value; + FTabs.Images := Value; + SetMetricsInvalid; + + if not(FInternalUpdating or FUpdating) then + Repaint; +end; + +procedure TSpkToolbar.SetLargeImages(const Value: TImageList); +begin + FLargeImages := Value; + FTabs.LargeImages := Value; + SetMetricsInvalid; + + if not(FInternalUpdating or FUpdating) then + Repaint; +end; + +procedure TSpkToolbar.SetMetricsInvalid; +begin +FMetricsValid:=false; +FBufferValid:=false; +end; + +procedure TSpkToolbar.SetTabIndex(const Value: integer); +begin + if not(AtLeastOneTabVisible) then FTabIndex:=-1 + else + begin + FTabIndex:=max(0,min(FTabs.count-1, Value)); + + // Wiem, że przynajmniej jedna zakładka jest widoczna (z wcześniejszego + // warunku), więc poniższa pętla na pewno się zakończy. + while not(FTabs[FTabIndex].Visible) do + FTabIndex:=(FTabIndex + 1) mod FTabs.count; + end; + FTabHover:=-1; + + SetMetricsInvalid; + + if not(FInternalUpdating or FUpdating) then + Repaint; +end; + +procedure TSpkToolbar.TabMouseDown(Button: TMouseButton; Shift: TShiftState; X, + Y: Integer); + +var SelTab: Integer; + TabRect: T2DIntRect; + i: Integer; + +begin +// Podczas procesu przebudowy mysz jest ignorowana. +if FInternalUpdating or FUpdating then + exit; + +SelTab:=-1; +if AtLeastOneTabVisible then + for i := 0 to FTabs.count - 1 do + if FTabs[i].visible then + begin + if FTabClipRect.IntersectsWith(FTabRects[i], TabRect) then + if TabRect.Contains(T2DIntPoint.Create(x, y)) then + SelTab:=i; + end; + +// Jeśli kliknięta została któraś zakładka, różna od obecnie zaznaczonej, +// zmień zaznaczenie. +if (Button = mbLeft) and (SelTab<>-1) and (SelTab<>FTabIndex) then + begin + FTabIndex:=SelTab; + SetMetricsInvalid; + Repaint; + end; +end; + +procedure TSpkToolbar.TabMouseLeave; +begin +// Podczas procesu przebudowy mysz jest ignorowana. +if FInternalUpdating or FUpdating then + exit; + +if FTabHover<>-1 then + begin + FTabHover:=-1; + SetBufferInvalid; + Repaint; + end; +end; + +procedure TSpkToolbar.TabMouseMove(Shift: TShiftState; X, Y: Integer); + +var NewTabHover : integer; + TabRect : T2DIntRect; + i : integer; + +begin +// Podczas procesu przebudowy mysz jest ignorowana. +if FInternalUpdating or FUpdating then + exit; + +NewTabHover:=-1; +if AtLeastOneTabVisible then + for i := 0 to FTabs.count - 1 do + if FTabs[i].Visible then + begin + if FTabClipRect.IntersectsWith(FTabRects[i], TabRect) then + if TabRect.Contains(T2DIntPoint.Create(x, y)) then + NewTabHover:=i; + end; + +if NewTabHover<>FTabHover then + begin + FTabHover:=NewTabHover; + SetBufferInvalid; + Repaint; + end; +end; + +procedure TSpkToolbar.TabMouseUp(Button: TMouseButton; Shift: TShiftState; X, + Y: Integer); +begin +// Podczas procesu przebudowy mysz jest ignorowana. +if FInternalUpdating or FUpdating then + exit; + +// Zakładki nie potrzebują obsługi MouseUp. +end; + +procedure TSpkToolbar.SetAppearance(const Value: TSpkToolbarAppearance); +begin + FAppearance.assign(Value); + + SetBufferInvalid; + if not(FInternalUpdating or FUpdating) then + Repaint; +end; + +procedure TSpkToolbar.ValidateBuffer; + + procedure DrawBackgroundColor; + + begin + FBuffer.canvas.brush.color:=Color; + FBuffer.canvas.brush.style:=bsSolid; + FBuffer.canvas.fillrect(Rect(0, 0, self.width, self.height)); + end; + + procedure DrawBody; + + var FocusedAppearance : TSpkToolbarAppearance; + i: Integer; + + begin + // Pobieramy appearance aktualnie zaznaczonej zakładki (bądź + // FToolbarAppearance, jeśli zaznaczona zakładka nie ma ustawionego + // OverrideAppearance + if (FTabIndex<>-1) and (FTabs[FTabIndex].OverrideAppearance) then + FocusedAppearance:=FTabs[FTabIndex].CustomAppearance else + FocusedAppearance:=FAppearance; + + TGuiTools.DrawRoundRect(FBuffer.Canvas, + T2DIntRect.Create(0, + TOOLBAR_TAB_CAPTIONS_HEIGHT, + self.width-1, + self.Height-1), + TOOLBAR_CORNER_RADIUS, + FocusedAppearance.Tab.GradientFromColor, + FocusedAppearance.Tab.GradientToColor, + FocusedAppearance.Tab.GradientType); + TGuiTools.DrawAARoundCorner(FBuffer, + T2DIntPoint.Create(0, TOOLBAR_TAB_CAPTIONS_HEIGHT), + TOOLBAR_CORNER_RADIUS, + cpLeftTop, + FocusedAppearance.Tab.BorderColor); + TGuiTools.DrawAARoundCorner(FBuffer, + T2DIntPoint.Create(self.width - TOOLBAR_CORNER_RADIUS, TOOLBAR_TAB_CAPTIONS_HEIGHT), + TOOLBAR_CORNER_RADIUS, + cpRightTop, + FocusedAppearance.Tab.BorderColor); + TGuiTools.DrawAARoundCorner(FBuffer, + T2DIntPoint.Create(0, self.height - TOOLBAR_CORNER_RADIUS), + TOOLBAR_CORNER_RADIUS, + cpLeftBottom, + FocusedAppearance.Tab.BorderColor); + TGuiTools.DrawAARoundCorner(FBuffer, + T2DIntPoint.Create(self.width - TOOLBAR_CORNER_RADIUS, self.height - TOOLBAR_CORNER_RADIUS), + TOOLBAR_CORNER_RADIUS, + cpRightBottom, + FocusedAppearance.Tab.BorderColor); + TGuiTools.DrawVLine(FBuffer, 0, TOOLBAR_TAB_CAPTIONS_HEIGHT + TOOLBAR_CORNER_RADIUS, self.height - TOOLBAR_CORNER_RADIUS, FocusedAppearance.Tab.BorderColor); + TGuiTools.DrawHLine(FBuffer, TOOLBAR_CORNER_RADIUS, self.Width-TOOLBAR_CORNER_RADIUS, self.height-1, FocusedAppearance.Tab.BorderColor); + TGuiTools.DrawVLine(FBuffer, self.width-1, TOOLBAR_TAB_CAPTIONS_HEIGHT + TOOLBAR_CORNER_RADIUS, self.height - TOOLBAR_CORNER_RADIUS, FocusedAppearance.Tab.BorderColor); + + if not(AtLeastOneTabVisible) then + begin + // Jeśli nie ma zakładek, rysujemy poziomą linię + TGuiTools.DrawHLine(FBuffer, TOOLBAR_CORNER_RADIUS, self.width - TOOLBAR_CORNER_RADIUS, TOOLBAR_TAB_CAPTIONS_HEIGHT, FocusedAppearance.Tab.BorderColor); + end + else + begin + // Jeśli są, pozostawiamy miejsce na zakładki + // Szukamy ostatniej widocznej + i:=FTabs.count-1; + while not(FTabs[i].Visible) do + dec(i); + + // Tylko prawa część, reszta będzie narysowana wraz z zakładkami + if FTabRects[i].Right-1) and (FTabs[FTabIndex].OverrideAppearance) then + FocusedAppearance:=FTabs[FTabIndex].CustomAppearance else + FocusedAppearance:=FAppearance; + + if FTabs.count>0 then + for i := 0 to FTabs.count - 1 do + if FTabs[i].Visible then + begin + // Jest sens rysować? + if not(FTabClipRect.IntersectsWith(FTabRects[i])) then + continue; + + // Pobieramy appearance rysowanej właśnie zakładki + if (FTabs[i].OverrideAppearance) then + CurrentAppearance:=FTabs[i].CustomAppearance else + CurrentAppearance:=FAppearance; + + TabRect:=FTabRects[i]; + + // Rysujemy zakładkę + if i = FTabIndex then + begin + if i = FTabHover then + begin + DrawTab(i, + CurrentAppearance.Tab.BorderColor, + TColorTools.Brighten(TColorTools.Brighten(CurrentAppearance.Tab.GradientFromColor, 50),50), + CurrentAppearance.Tab.GradientFromColor, + CurrentAppearance.Tab.TabHeaderFont.Color); + end + else + begin + DrawTab(i, + CurrentAppearance.Tab.BorderColor, + TColorTools.Brighten(CurrentAppearance.Tab.GradientFromColor, 50), + CurrentAppearance.Tab.GradientFromColor, + CurrentAppearance.Tab.TabHeaderFont.color); + end; + + DrawTabText(i, CurrentAppearance.Tab.TabHeaderFont); + end + else + begin + if i = FTabHover then + begin + DrawTab(i, + TColorTools.Shade(self.Color,CurrentAppearance.Tab.BorderColor,50), + TColorTools.Shade(self.color,TColorTools.brighten(CurrentAppearance.Tab.GradientFromColor,50),50), + TColorTools.Shade(self.color,CurrentAppearance.Tab.GradientFromColor, 50), + CurrentAppearance.Tab.TabHeaderFont.color); + end; + + // Dolna kreska + // Uwaga: Niezależnie od zakładki rysowana kolorem appearance + // aktualnie zaznaczonej zakładki! + DrawBottomLine(i, FocusedAppearance.Tab.BorderColor); + + // Tekst + DrawTabText(i, CurrentAppearance.Tab.TabHeaderFont); + end; + end; + end; + + procedure DrawTabContents; + + begin + if FTabIndex<>-1 then + FTabs[FTabIndex].Draw(FBuffer, FTabContentsClipRect); + end; + +begin +if FInternalUpdating or FUpdating then + exit; +if FBufferValid then + exit; + +// ValidateBuffer może być wywołane tylko wtedy, gdy metrics zostały obliczone. +// Metoda zakłada, że bufor ma już odpowiednie rozmiary oraz że wszystkie +// recty, zarówno toolbara jak i elementów podrzędnych, zostały poprawnie +// obliczone. + +// *** Tło komponentu *** +DrawBackgroundColor; + +// *** Generowanie tła dla toolbara *** +DrawBody; + +// *** Zakładki *** +DrawTabs; + +// *** Zawartość zakładek *** +DrawTabContents; + +// Bufor jest poprawny +FBufferValid:=true; +end; + +procedure TSpkToolbar.ValidateMetrics; + +var i : integer; + x : integer; + TabWidth: Integer; + TabAppearance : TSpkToolbarAppearance; + +begin +if FInternalUpdating or FUpdating then + exit; +if FMetricsValid then + exit; + +FBuffer.SetSize(self.width, self.height); + +// *** Zakładki *** + +// Cliprect zakładek (zawgórną ramkę komponentu) +FTabClipRect:=T2DIntRect.Create(TOOLBAR_CORNER_RADIUS, + 0, + self.width - TOOLBAR_CORNER_RADIUS - 1, + TOOLBAR_TAB_CAPTIONS_HEIGHT); + +// Recty nagłówków zakładek (zawierają górną ramkę komponentu) +setlength(FTabRects, FTabs.Count); +if FTabs.count>0 then + begin + x:=TOOLBAR_CORNER_RADIUS; + for i := 0 to FTabs.count - 1 do + if FTabs[i].Visible then + begin + // Pobieramy appearance zakładki + if FTabs[i].OverrideAppearance then + TabAppearance:=FTabs[i].CustomAppearance else + TabAppearance:=FAppearance; + FBuffer.Canvas.font.assign(TabAppearance.Tab.TabHeaderFont); + + TabWidth:=2 + // Ramka + 2*TAB_CORNER_RADIUS + // Zaokrąglenia + 2*TOOLBAR_TAB_CAPTIONS_TEXT_HPADDING + // Wewnętrzne marginesy + max(TOOLBAR_MIN_TAB_CAPTION_WIDTH, + FBuffer.Canvas.TextWidth(FTabs.Items[i].Caption)); // Szerokość tekstu + + FTabRects[i].Left:=x; + FTabRects[i].Right:=x + TabWidth - 1; + FTabRects[i].Top:=0; + FTabRects[i].Bottom:=TOOLBAR_TAB_CAPTIONS_HEIGHT; + + x:=FTabRects[i].right+1; + end + else + begin + FTabRects[i]:=T2DIntRect.Create(-1,-1,-1,-1); + end; + end; + +// *** Tafle *** + +if FTabIndex<>-1 then + begin + // Rect obszaru zakładki + FTabContentsClipRect:=T2DIntRect.Create(TOOLBAR_BORDER_WIDTH + TAB_PANE_LEFTPADDING, + TOOLBAR_TAB_CAPTIONS_HEIGHT + TOOLBAR_BORDER_WIDTH + TAB_PANE_TOPPADDING, + self.width - 1 - TOOLBAR_BORDER_WIDTH - TAB_PANE_RIGHTPADDING, + self.Height - 1 - TOOLBAR_BORDER_WIDTH - TAB_PANE_BOTTOMPADDING); + + FTabs[FTabIndex].Rect:=FTabContentsClipRect; + end; + +FMetricsValid:=true; +end; + +end. diff --git a/components/spktoolbar/SpkToolbar/spkt_Appearance.pas b/components/spktoolbar/SpkToolbar/spkt_Appearance.pas new file mode 100644 index 000000000..3bb560dea --- /dev/null +++ b/components/spktoolbar/SpkToolbar/spkt_Appearance.pas @@ -0,0 +1,1171 @@ +unit spkt_Appearance; + +(******************************************************************************* +* * +* Plik: spkt_Appearance.pas * +* Opis: Klasy bazowe dla klas wyglądu elementów toolbara * +* Copyright: (c) 2009 by Spook. Jakiekolwiek użycie komponentu bez * +* uprzedniego uzyskania licencji od autora stanowi złamanie * +* prawa autorskiego! * +* * +*******************************************************************************) + +interface + +uses Windows, Graphics, Classes, Forms, SysUtils, + SpkGraphTools, SpkGUITools, SpkXMLParser, SpkXMLTools, + spkt_Dispatch, spkt_Exceptions; + +type TSpkTabAppearance = class(TPersistent) + private + FDispatch : TSpkBaseAppearanceDispatch; + protected + FTabHeaderFont : TFont; + FBorderColor : TColor; + FGradientFromColor : TColor; + FGradientToColor : TColor; + FGradientType : TBackgroundKind; + + // *** Gettery i settery *** + + procedure SetHeaderFont(const Value: TFont); + procedure SetBorderColor(const Value: TColor); + procedure SetGradientFromColor(const Value: TColor); + procedure SetGradientToColor(const Value: TColor); + procedure SetGradientType(const Value: TBackgroundKind); + public + // *** Konstruktor, destruktor, assign *** + // Appearance musi mieć assign, bo występuje jako własność + // opublikowana. + procedure Assign(Source : TPersistent); override; + constructor Create(ADispatch : TSpkBaseAppearanceDispatch); + procedure SaveToXML(Node : TSpkXMLNode); + procedure LoadFromXML(Node : TSpkXMLNode); + destructor Destroy; override; + procedure Reset; + published + property TabHeaderFont : TFont read FTabHeaderFont write SetHeaderFont; + property BorderColor : TColor read FBorderColor write SetBorderColor; + property GradientFromColor : TColor read FGradientFromColor write SetGradientFromColor; + property GradientToColor : TColor read FGradientToColor write SetGradientToColor; + property GradientType : TBackgroundKind read FGradientType write SetGradientType; + end; + +type TSpkPaneAppearance = class(TPersistent) + private + FDispatch : TSpkBaseAppearanceDispatch; + protected + FCaptionFont : TFont; + FBorderDarkColor : TColor; + FBorderLightColor : TColor; + FCaptionBgColor : TColor; + FGradientFromColor : TColor; + FGradientToColor : TColor; + FGradientType : TBackgroundKind; + + procedure SetCaptionFont(const Value: TFont); + procedure SetBorderDarkColor(const Value: TColor); + procedure SetBorderLightColor(const Value: TColor); + procedure SetGradientFromColor(const Value: TColor); + procedure SetGradientToColor(const Value: TColor); + procedure SetGradientType(const Value: TBackgroundKind); + procedure SetCaptionBgColor(const Value: TColor); + public + procedure Assign(Source : TPersistent); override; + constructor Create(ADispatch : TSpkBaseAppearanceDispatch); + procedure SaveToXML(Node : TSpkXMLNode); + procedure LoadFromXML(Node : TSpkXMLNode); + destructor Destroy; override; + procedure Reset; + published + property CaptionFont : TFont read FCaptionFont write SetCaptionFont; + property BorderDarkColor : TColor read FBorderDarkColor write SetBorderDarkColor; + property BorderLightColor : TColor read FBorderLightColor write SetBorderLightColor; + property GradientFromColor : TColor read FGradientFromColor write SetGradientFromColor; + property GradientToColor : TColor read FGradientToColor write SetGradientToColor; + property GradientType : TBackgroundKind read FGradientType write SetGradientType; + property CaptionBgColor : TColor read FCaptionBgColor write SetCaptionBgColor; + end; + +type TSpkElementAppearance = class(TPersistent) + private + FDispatch : TSpkBaseAppearanceDispatch; + protected + FCaptionFont : TFont; + FIdleFrameColor : TColor; + FIdleGradientFromColor : TColor; + FIdleGradientToColor : TColor; + FIdleGradientType : TBackgroundKind; + FIdleInnerLightColor : TColor; + FIdleInnerDarkColor : TColor; + FIdleCaptionColor : TColor; + FHotTrackFrameColor : TColor; + FHotTrackGradientFromColor : TColor; + FHotTrackGradientToColor : TColor; + FHotTrackGradientType : TBackgroundKind; + FHotTrackInnerLightColor : TColor; + FHotTrackInnerDarkColor : TColor; + FHotTrackCaptionColor : TColor; + FActiveFrameColor : TColor; + FActiveGradientFromColor : TColor; + FActiveGradientToColor : TColor; + FActiveGradientType : TBackgroundKind; + FActiveInnerLightColor : TColor; + FActiveInnerDarkColor : TColor; + FActiveCaptionColor : TColor; + + procedure SetActiveCaptionColor(const Value: TColor); + procedure SetActiveFrameColor(const Value: TColor); + procedure SetActiveGradientFromColor(const Value: TColor); + procedure SetActiveGradientToColor(const Value: TColor); + procedure SetActiveGradientType(const Value: TBackgroundKind); + procedure SetActiveInnerDarkColor(const Value: TColor); + procedure SetActiveInnerLightColor(const Value: TColor); + procedure SetCaptionFont(const Value: TFont); + procedure SetHotTrackCaptionColor(const Value: TColor); + procedure SetHotTrackFrameColor(const Value: TColor); + procedure SetHotTrackGradientFromColor(const Value: TColor); + procedure SetHotTrackGradientToColor(const Value: TColor); + procedure SetHotTrackGradientType(const Value: TBackgroundKind); + procedure SetHotTrackInnerDarkColor(const Value: TColor); + procedure SetHotTrackInnerLightColor(const Value: TColor); + procedure SetIdleCaptionColor(const Value: TColor); + procedure SetIdleFrameColor(const Value: TColor); + procedure SetIdleGradientFromColor(const Value: TColor); + procedure SetIdleGradientToColor(const Value: TColor); + procedure SetIdleGradientType(const Value: TBackgroundKind); + procedure SetIdleInnerDarkColor(const Value: TColor); + procedure SetIdleInnerLightColor(const Value: TColor); + public + procedure Assign(Source : TPersistent); override; + constructor Create(ADispatch : TSpkBaseAppearanceDispatch); + procedure SaveToXML(Node : TSpkXMLNode); + procedure LoadFromXML(Node : TSpkXMLNode); + destructor Destroy; override; + procedure Reset; + published + property CaptionFont : TFont read FCaptionFont write SetCaptionFont; + property IdleFrameColor : TColor read FIdleFrameColor write SetIdleFrameColor; + property IdleGradientFromColor : TColor read FIdleGradientFromColor write SetIdleGradientFromColor; + property IdleGradientToColor : TColor read FIdleGradientToColor write SetIdleGradientToColor; + property IdleGradientType : TBackgroundKind read FIdleGradientType write SetIdleGradientType; + property IdleInnerLightColor : TColor read FIdleInnerLightColor write SetIdleInnerLightColor; + property IdleInnerDarkColor : TColor read FIdleInnerDarkColor write SetIdleInnerDarkColor; + property IdleCaptionColor : TColor read FIdleCaptionColor write SetIdleCaptionColor; + property HotTrackFrameColor : TColor read FHotTrackFrameColor write SetHotTrackFrameColor; + property HotTrackGradientFromColor : TColor read FHotTrackGradientFromColor write SetHotTrackGradientFromColor; + property HotTrackGradientToColor : TColor read FHotTrackGradientToColor write SetHotTrackGradientToColor; + property HotTrackGradientType : TBackgroundKind read FHotTrackGradientType write SetHotTrackGradientType; + property HotTrackInnerLightColor : TColor read FHotTrackInnerLightColor write SetHotTrackInnerLightColor; + property HotTrackInnerDarkColor : TColor read FHotTrackInnerDarkColor write SetHotTrackInnerDarkColor; + property HotTrackCaptionColor : TColor read FHotTrackCaptionColor write SetHotTrackCaptionColor; + property ActiveFrameColor : TColor read FActiveFrameColor write SetActiveFrameColor; + property ActiveGradientFromColor : TColor read FActiveGradientFromColor write SetActiveGradientFromColor; + property ActiveGradientToColor : TColor read FActiveGradientToColor write SetActiveGradientToColor; + property ActiveGradientType : TBackgroundKind read FActiveGradientType write SetActiveGradientType; + property ActiveInnerLightColor : TColor read FActiveInnerLightColor write SetActiveInnerLightColor; + property ActiveInnerDarkColor : TColor read FActiveInnerDarkColor write SetActiveInnerDarkColor; + property ActiveCaptionColor : TColor read FActiveCaptionColor write SetActiveCaptionColor; + end; + +type TSpkToolbarAppearance = class; + + TSpkToolbarAppearanceDispatch = class(TSpkBaseAppearanceDispatch) + private + FToolbarAppearance : TSpkToolbarAppearance; + protected + public + constructor Create(AToolbarAppearance : TSpkToolbarAppearance); + procedure NotifyAppearanceChanged; override; + end; + + TSpkToolbarAppearance = class(TPersistent) + private + FAppearanceDispatch : TSpkToolbarAppearanceDispatch; + protected + FTab : TSpkTabAppearance; + FPane : TSpkPaneAppearance; + FElement : TSpkElementAppearance; + + FDispatch : TSpkBaseAppearanceDispatch; + + procedure SetElementAppearance(const Value: TSpkElementAppearance); + procedure SetPaneAppearance(const Value: TSpkPaneAppearance); + procedure SetTabAppearance(const Value: TSpkTabAppearance); + public + procedure NotifyAppearanceChanged; + + constructor Create(ADispatch : TSpkBaseAppearanceDispatch); reintroduce; + destructor Destroy; override; + procedure Assign(Source : TPersistent); override; + procedure Reset; + procedure SaveToXML(Node : TSpkXMLNode); + procedure LoadFromXML(Node : TSpkXMLNode); + published + property Tab : TSpkTabAppearance read FTab write SetTabAppearance; + property Pane : TSpkPaneAppearance read FPane write SetPaneAppearance; + property Element : TSpkElementAppearance read FElement write SetElementAppearance; + end; + +implementation + +{ TSpkBaseToolbarAppearance } + +procedure TSpkTabAppearance.Assign(Source: TPersistent); + +var SrcAppearance : TSpkTabAppearance; + +begin + if Source is TSpkTabAppearance then + begin + SrcAppearance:=TSpkTabAppearance(Source); + + FTabHeaderFont.assign(SrcAppearance.TabHeaderFont); + FBorderColor:=SrcAppearance.BorderColor; + FGradientFromColor:=SrcAppearance.GradientFromColor; + FGradientToColor:=SrcAppearance.GradientToColor; + FGradientType:=SrcAppearance.GradientType; + + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; + end else + raise AssignException.create('TSpkToolbarAppearance.Assign: Nie mogę przypisać obiektu '+Source.ClassName+' do TSpkToolbarAppearance!'); +end; + +constructor TSpkTabAppearance.Create( + ADispatch: TSpkBaseAppearanceDispatch); +begin + inherited Create; + FDispatch:=ADispatch; + + FTabHeaderFont:=TFont.Create; + + Reset; +end; + +destructor TSpkTabAppearance.Destroy; +begin + FTabHeaderFont.Free; + inherited; +end; + +procedure TSpkTabAppearance.LoadFromXML(Node: TSpkXMLNode); + +var Subnode : TSpkXMLNode; + +begin +if not(assigned(Node)) then + exit; + +Subnode:=Node['TabHeaderFont',false]; +if assigned(Subnode) then + TSpkXMLTools.Load(Subnode, FTabHeaderFont); + +Subnode:=Node['BorderColor',false]; +if assigned(Subnode) then + FBorderColor:=Subnode.TextAsColor; + +Subnode:=Node['GradientFromColor',false]; +if assigned(Subnode) then + FGradientFromColor:=Subnode.TextAsColor; + +Subnode:=Node['GradientToColor',false]; +if assigned(Subnode) then + FGradientToColor:=Subnode.TextAsColor; + +Subnode:=Node['GradientType',false]; +if assigned(Subnode) then + FGradientType:=TBackgroundKind(Subnode.TextAsInteger); +end; + +procedure TSpkTabAppearance.Reset; +begin + if screen.fonts.IndexOf('Calibri') >= 0 then + begin + FTabHeaderFont.Charset := DEFAULT_CHARSET; + FTabHeaderFont.Color := rgb(21, 66, 139); + FTabHeaderFont.Name := 'Calibri'; + FTabHeaderFont.Orientation := 0; + FTabHeaderFont.Pitch := fpDefault; + FTabHeaderFont.Size := 10; + FTabHeaderFont.Style := []; + end + else if screen.fonts.IndexOf('Verdana') >= 0 then + begin + FTabHeaderFont.Charset := DEFAULT_CHARSET; + FTabHeaderFont.Color := rgb(21, 66, 139); + FTabHeaderFont.Name := 'Verdana'; + FTabHeaderFont.Orientation := 0; + FTabHeaderFont.Pitch := fpDefault; + FTabHeaderFont.Size := 10; + FTabHeaderFont.Style := []; + end + else + begin + FTabHeaderFont.Charset := DEFAULT_CHARSET; + FTabHeaderFont.Color := rgb(21, 66, 139); + FTabHeaderFont.Name := 'Arial'; + FTabHeaderFont.Orientation := 0; + FTabHeaderFont.Pitch := fpDefault; + FTabHeaderFont.Size := 10; + FTabHeaderFont.Style := []; + end; + FBorderColor := rgb(141, 178, 227); + FGradientFromColor := rgb(222, 232, 245); + FGradientToColor := rgb(199, 216, 237); + FGradientType := bkConcave; +end; + +procedure TSpkTabAppearance.SaveToXML(Node: TSpkXMLNode); + +var Subnode : TSpkXMLNode; + +begin +if not(assigned(Node)) then + exit; + +Subnode:=Node['TabHeaderFont',true]; +TSpkXMLTools.Save(Subnode, FTabHeaderFont); + +Subnode:=Node['BorderColor',true]; +Subnode.TextAsColor:=FBorderColor; + +Subnode:=Node['GradientFromColor',true]; +Subnode.TextAsColor:=FGradientFromColor; + +Subnode:=Node['GradientToColor',true]; +Subnode.TextAsColor:=FGradientToColor; + +Subnode:=Node['GradientType',true]; +Subnode.TextAsInteger:=integer(FGradientType); +end; + +procedure TSpkTabAppearance.SetBorderColor(const Value: TColor); +begin + FBorderColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkTabAppearance.SetGradientFromColor(const Value: TColor); +begin + FGradientFromColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkTabAppearance.SetGradientToColor(const Value: TColor); +begin + FGradientToColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkTabAppearance.SetGradientType(const Value: TBackgroundKind); +begin + FGradientType := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkTabAppearance.SetHeaderFont(const Value: TFont); +begin + FTabHeaderFont.assign(Value); + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +{ TSpkPaneAppearance } + +procedure TSpkPaneAppearance.Assign(Source: TPersistent); + +var SrcAppearance : TSpkPaneAppearance; + +begin + if Source is TSpkPaneAppearance then + begin + SrcAppearance:=TSpkPaneAppearance(Source); + + FCaptionFont.assign(SrcAppearance.CaptionFont); + FBorderDarkColor := SrcAppearance.BorderDarkColor; + FBorderLightColor := SrcAppearance.BorderLightColor; + FCaptionBgColor := SrcAppearance.CaptionBgColor; + FGradientFromColor := SrcAppearance.GradientFromColor; + FGradientToColor := SrcAppearance.GradientToColor; + FGradientType := SrcAppearance.GradientType; + + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; + end else + raise AssignException.create('TSpkPaneAppearance.Assign: Nie mogę przypisać obiektu '+Source.ClassName+' do TSpkPaneAppearance!'); +end; + +constructor TSpkPaneAppearance.Create(ADispatch: TSpkBaseAppearanceDispatch); +begin + inherited Create; + + FDispatch:=ADispatch; + + FCaptionFont:=TFont.Create; + + Reset; +end; + +destructor TSpkPaneAppearance.Destroy; +begin + FCaptionFont.Free; + inherited Destroy; +end; + +procedure TSpkPaneAppearance.LoadFromXML(Node: TSpkXMLNode); + +var Subnode : TSpkXMLNode; + +begin +if not(assigned(Node)) then + exit; + +Subnode:=Node['CaptionFont',false]; +if assigned(Subnode) then + TSpkXMLTools.Load(Subnode, FCaptionFont); + +Subnode:=Node['BorderDarkColor',false]; +if assigned(Subnode) then + FBorderDarkColor:=Subnode.TextAsColor; + +Subnode:=Node['BorderLightColor',false]; +if assigned(Subnode) then + FBorderLightColor:=Subnode.TextAsColor; + +Subnode:=Node['CaptionBgColor',false]; +if assigned(Subnode) then + FCaptionBgColor:=Subnode.TextAsColor; + +Subnode:=Node['GradientFromColor',false]; +if assigned(Subnode) then + FGradientFromColor:=Subnode.TextAsColor; + +Subnode:=Node['GradientToColor',false]; +if assigned(Subnode) then + FGradientToColor:=Subnode.TextAsColor; + +Subnode:=Node['GradientType',false]; +if assigned(Subnode) then + FGradientType:=TBackgroundKind(Subnode.TextAsInteger); +end; + +procedure TSpkPaneAppearance.Reset; +begin + if screen.fonts.IndexOf('Calibri') >= 0 then + begin + FCaptionFont.Name := 'Calibri'; + FCaptionFont.Size := 9; + FCaptionFont.color := rgb(62, 106, 170); + FCaptionFont.Style := []; + FCaptionFont.Charset := DEFAULT_CHARSET; + FCaptionFont.Orientation := 0; + FCaptionFont.Pitch := fpDefault; + end + else if screen.fonts.IndexOf('Verdana') >= 0 then + begin + FCaptionFont.Name := 'Verdana'; + FCaptionFont.Size := 9; + FCaptionFont.color := rgb(62, 106, 170); + FCaptionFont.Style := []; + FCaptionFont.Charset := DEFAULT_CHARSET; + FCaptionFont.Orientation := 0; + FCaptionFont.Pitch := fpDefault; + end + else + begin + FCaptionFont.Name := 'Arial'; + FCaptionFont.Size := 9; + FCaptionFont.color := rgb(62, 106, 170); + FCaptionFont.Style := []; + FCaptionFont.Charset := DEFAULT_CHARSET; + FCaptionFont.Orientation := 0; + FCaptionFont.Pitch := fpDefault; + end; + FBorderDarkColor := rgb(158, 190, 218); + FBorderLightColor := rgb(237, 242, 248); + FCaptionBgColor := rgb(194, 217, 241); + FGradientFromColor := rgb(222, 232, 245); + FGradientToColor := rgb(199, 216, 237); + FGradientType := bkConcave; +end; + +procedure TSpkPaneAppearance.SaveToXML(Node: TSpkXMLNode); + +var Subnode : TSpkXMLNode; + +begin +if not(assigned(Node)) then + exit; + +Subnode:=Node['CaptionFont',true]; +TSpkXMLTools.Save(Subnode, FCaptionFont); + +Subnode:=Node['BorderDarkColor',true]; +Subnode.TextAsColor:=FBorderDarkColor; + +Subnode:=Node['BorderLightColor',true]; +Subnode.TextAsColor:=FBorderLightColor; + +Subnode:=Node['CaptionBgColor',true]; +Subnode.TextAsColor:=FCaptionBgColor; + +Subnode:=Node['GradientFromColor',true]; +Subnode.TextAsColor:=FGradientFromColor; + +Subnode:=Node['GradientToColor',true]; +Subnode.TextAsColor:=FGradientToColor; + +Subnode:=Node['GradientType',true]; +Subnode.TextAsInteger:=integer(FGradientType); +end; + +procedure TSpkPaneAppearance.SetBorderDarkColor(const Value: TColor); +begin +FBorderDarkColor:=Value; +if assigned(FDispatch) then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkPaneAppearance.SetBorderLightColor(const Value: TColor); +begin + FBorderLightColor:=Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkPaneAppearance.SetCaptionBgColor(const Value: TColor); +begin + FCaptionBgColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkPaneAppearance.SetGradientFromColor(const Value: TColor); +begin + FGradientFromColor:=Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkPaneAppearance.SetGradientToColor(const Value: TColor); +begin + FGradientToColor:=Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkPaneAppearance.SetGradientType(const Value: TBackgroundKind); +begin + FGradientType:=Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkPaneAppearance.SetCaptionFont(const Value: TFont); +begin + FCaptionFont.assign(Value); + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +{ TSpkElementAppearance } + +procedure TSpkElementAppearance.Assign(Source: TPersistent); + +var SrcAppearance : TSpkElementAppearance; + +begin + if Source is TSpkElementAppearance then + begin + SrcAppearance:=TSpkElementAppearance(Source); + + FCaptionFont.assign(SrcAppearance.CaptionFont); + FIdleFrameColor := SrcAppearance.IdleFrameColor; + FIdleGradientFromColor := SrcAppearance.IdleGradientFromColor; + FIdleGradientToColor := SrcAppearance.IdleGradientToColor; + FIdleGradientType := SrcAppearance.IdleGradientType; + FIdleInnerLightColor := SrcAppearance.IdleInnerLightColor; + FIdleInnerDarkColor := SrcAppearance.IdleInnerDarkColor; + FIdleCaptionColor := SrcAppearance.IdleCaptionColor; + FHotTrackFrameColor := SrcAppearance.HotTrackFrameColor; + FHotTrackGradientFromColor := SrcAppearance.HotTrackGradientFromColor; + FHotTrackGradientToColor := SrcAppearance.HotTrackGradientToColor; + FHotTrackGradientType := SrcAppearance.HotTrackGradientType; + FHotTrackInnerLightColor := SrcAppearance.HotTrackInnerLightColor; + FHotTrackInnerDarkColor := SrcAppearance.HotTrackInnerDarkColor; + FHotTrackCaptionColor := SrcAppearance.HotTrackCaptionColor; + FActiveFrameColor := SrcAppearance.ActiveFrameColor; + FActiveGradientFromColor := SrcAppearance.ActiveGradientFromColor; + FActiveGradientToColor := SrcAppearance.ActiveGradientToColor; + FActiveGradientType := SrcAppearance.ActiveGradientType; + FActiveInnerLightColor := SrcAppearance.ActiveInnerLightColor; + FActiveInnerDarkColor := SrcAppearance.ActiveInnerDarkColor; + FActiveCaptionColor := SrcAppearance.ActiveCaptionColor; + + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; + end else + raise AssignException.create('TSpkElementAppearance.Assign: Nie mogę przypisać obiektu '+Source.ClassName+' do TSpkElementAppearance!'); +end; + +constructor TSpkElementAppearance.Create(ADispatch: TSpkBaseAppearanceDispatch); +begin + inherited Create; + + FDispatch:=ADispatch; + + FCaptionFont:=TFont.Create; + + Reset; +end; + +destructor TSpkElementAppearance.Destroy; +begin + FCaptionFont.Free; + inherited Destroy; +end; + +procedure TSpkElementAppearance.LoadFromXML(Node: TSpkXMLNode); + +var Subnode : TSpkXMLNode; + +begin +if not(assigned(Node)) then + exit; + +Subnode:=Node['CaptionFont',false]; +if assigned(Subnode) then + TSpkXMLTools.Load(Subnode, FCaptionFont); + +// *** Idle *** + +Subnode:=Node['IdleFrameColor',false]; +if assigned(Subnode) then + FIdleFrameColor:=Subnode.TextAsColor; + +Subnode:=Node['IdleGradientFromColor',false]; +if assigned(Subnode) then + FIdleGradientFromColor:=Subnode.TextAsColor; + +Subnode:=Node['IdleGradientToColor',false]; +if assigned(Subnode) then + FIdleGradientToColor:=Subnode.TextAsColor; + +Subnode:=Node['IdleGradientType',false]; +if assigned(Subnode) then + FIdleGradientType:=TBackgroundKind(Subnode.TextAsInteger); + +Subnode:=Node['IdleInnerLightColor',false]; +if assigned(Subnode) then + FIdleInnerLightColor:=Subnode.TextAsColor; + +Subnode:=Node['IdleInnerDarkColor',false]; +if assigned(Subnode) then + FIdleInnerDarkColor:=Subnode.TextAsColor; + +Subnode:=Node['IdleCaptionColor',false]; +if assigned(Subnode) then + FIdleCaptionColor:=Subnode.TextAsColor; + +// *** Hottrack *** + +Subnode:=Node['HottrackFrameColor',false]; +if assigned(Subnode) then + FHottrackFrameColor:=Subnode.TextAsColor; + +Subnode:=Node['HottrackGradientFromColor',false]; +if assigned(Subnode) then + FHottrackGradientFromColor:=Subnode.TextAsColor; + +Subnode:=Node['HottrackGradientToColor',false]; +if assigned(Subnode) then + FHottrackGradientToColor:=Subnode.TextAsColor; + +Subnode:=Node['HottrackGradientType',false]; +if assigned(Subnode) then + FHottrackGradientType:=TBackgroundKind(Subnode.TextAsInteger); + +Subnode:=Node['HottrackInnerLightColor',false]; +if assigned(Subnode) then + FHottrackInnerLightColor:=Subnode.TextAsColor; + +Subnode:=Node['HottrackInnerDarkColor',false]; +if assigned(Subnode) then + FHottrackInnerDarkColor:=Subnode.TextAsColor; + +Subnode:=Node['HottrackCaptionColor',false]; +if assigned(Subnode) then + FHottrackCaptionColor:=Subnode.TextAsColor; + +// *** Active *** + +Subnode:=Node['ActiveFrameColor',false]; +if assigned(Subnode) then + FActiveFrameColor:=Subnode.TextAsColor; + +Subnode:=Node['ActiveGradientFromColor',false]; +if assigned(Subnode) then + FActiveGradientFromColor:=Subnode.TextAsColor; + +Subnode:=Node['ActiveGradientToColor',false]; +if assigned(Subnode) then + FActiveGradientToColor:=Subnode.TextAsColor; + +Subnode:=Node['ActiveGradientType',false]; +if assigned(Subnode) then + FActiveGradientType:=TBackgroundKind(Subnode.TextAsInteger); + +Subnode:=Node['ActiveInnerLightColor',false]; +if assigned(Subnode) then + FActiveInnerLightColor:=Subnode.TextAsColor; + +Subnode:=Node['ActiveInnerDarkColor',false]; +if assigned(Subnode) then + FActiveInnerDarkColor:=Subnode.TextAsColor; + +Subnode:=Node['ActiveCaptionColor',false]; +if assigned(Subnode) then + FActiveCaptionColor:=Subnode.TextAsColor; +end; + +procedure TSpkElementAppearance.Reset; +begin + if screen.fonts.IndexOf('Calibri') >= 0 then + begin + FCaptionFont.Name := 'Calibri'; + FCaptionFont.Size := 9; + FCaptionFont.Style := []; + FCaptionFont.Charset := DEFAULT_CHARSET; + FCaptionFont.Orientation := 0; + FCaptionFont.Pitch := fpDefault; + FCaptionFont.Color := rgb(21, 66, 139); + end + else if screen.fonts.IndexOf('Verdana') >= 0 then + begin + FCaptionFont.Name := 'Verdana'; + FCaptionFont.Size := 8; + FCaptionFont.Style := []; + FCaptionFont.Charset := DEFAULT_CHARSET; + FCaptionFont.Orientation := 0; + FCaptionFont.Pitch := fpDefault; + FCaptionFont.Color := rgb(21, 66, 139); + end + else + begin + FCaptionFont.Name := 'Arial'; + FCaptionFont.Size := 8; + FCaptionFont.Style := []; + FCaptionFont.Charset := DEFAULT_CHARSET; + FCaptionFont.Orientation := 0; + FCaptionFont.Pitch := fpDefault; + FCaptionFont.Color := rgb(21, 66, 139); + end; + + FIdleFrameColor := rgb(155, 183, 224); + FIdleGradientFromColor := rgb(200, 219, 238); + FIdleGradientToColor := rgb(188, 208, 233); + FIdleGradientType := bkConcave; + FIdleInnerLightColor := rgb(213, 227, 241); + FIdleInnerDarkColor := rgb(190, 211, 236); + FIdleCaptionColor := rgb(86, 125, 177); + FHotTrackFrameColor := rgb(221, 207, 155); + FHotTrackGradientFromColor := rgb(255, 252, 218); + FHotTrackGradientToColor := rgb(255, 215, 77); + FHotTrackGradientType := bkConcave; + FHotTrackInnerLightColor := rgb(255, 241, 197); + FHotTrackInnerDarkColor := rgb(216, 194, 122); + FHotTrackCaptionColor := rgb(111, 66, 135); + FActiveFrameColor := rgb(139, 118, 84); + FActiveGradientFromColor := rgb(254, 187, 108); + FActiveGradientToColor := rgb(252, 146, 61); + FActiveGradientType := bkConcave; + FActiveInnerLightColor := rgb(252, 169, 14); + FActiveInnerDarkColor := rgb(252, 169, 14); + FActiveCaptionColor := rgb(110, 66, 128); +end; + +procedure TSpkElementAppearance.SaveToXML(Node: TSpkXMLNode); + +var Subnode : TSpkXMLNode; + +begin +if not(assigned(Node)) then + exit; + +Subnode:=Node['CaptionFont',true]; +TSpkXMLTools.Save(Subnode, FCaptionFont); + +// *** Idle *** + +Subnode:=Node['IdleFrameColor',true]; +Subnode.TextAsColor:=FIdleFrameColor; + +Subnode:=Node['IdleGradientFromColor',true]; +Subnode.TextAsColor:=FIdleGradientFromColor; + +Subnode:=Node['IdleGradientToColor',true]; +Subnode.TextAsColor:=FIdleGradientToColor; + +Subnode:=Node['IdleGradientType',true]; +Subnode.TextAsInteger:=integer(FIdleGradientType); + +Subnode:=Node['IdleInnerLightColor',true]; +Subnode.TextAsColor:=FIdleInnerLightColor; + +Subnode:=Node['IdleInnerDarkColor',true]; +Subnode.TextAsColor:=FIdleInnerDarkColor; + +Subnode:=Node['IdleCaptionColor',true]; +Subnode.TextAsColor:=FIdleCaptionColor; + +// *** Hottrack *** + +Subnode:=Node['HottrackFrameColor',true]; +Subnode.TextAsColor:=FHottrackFrameColor; + +Subnode:=Node['HottrackGradientFromColor',true]; +Subnode.TextAsColor:=FHottrackGradientFromColor; + +Subnode:=Node['HottrackGradientToColor',true]; +Subnode.TextAsColor:=FHottrackGradientToColor; + +Subnode:=Node['HottrackGradientType',true]; +Subnode.TextAsInteger:=integer(FHottrackGradientType); + +Subnode:=Node['HottrackInnerLightColor',true]; +Subnode.TextAsColor:=FHottrackInnerLightColor; + +Subnode:=Node['HottrackInnerDarkColor',true]; +Subnode.TextAsColor:=FHottrackInnerDarkColor; + +Subnode:=Node['HottrackCaptionColor',true]; +Subnode.TextAsColor:=FHottrackCaptionColor; + +// *** Active *** + +Subnode:=Node['ActiveFrameColor',true]; +Subnode.TextAsColor:=FActiveFrameColor; + +Subnode:=Node['ActiveGradientFromColor',true]; +Subnode.TextAsColor:=FActiveGradientFromColor; + +Subnode:=Node['ActiveGradientToColor',true]; +Subnode.TextAsColor:=FActiveGradientToColor; + +Subnode:=Node['ActiveGradientType',true]; +Subnode.TextAsInteger:=integer(FActiveGradientType); + +Subnode:=Node['ActiveInnerLightColor',true]; +Subnode.TextAsColor:=FActiveInnerLightColor; + +Subnode:=Node['ActiveInnerDarkColor',true]; +Subnode.TextAsColor:=FActiveInnerDarkColor; + +Subnode:=Node['ActiveCaptionColor',true]; +Subnode.TextAsColor:=FActiveCaptionColor; +end; + +procedure TSpkElementAppearance.SetActiveCaptionColor( + const Value: TColor); +begin + FActiveCaptionColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetActiveFrameColor(const Value: TColor); +begin + FActiveFrameColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetActiveGradientFromColor( + const Value: TColor); +begin + FActiveGradientFromColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetActiveGradientToColor( + const Value: TColor); +begin + FActiveGradientToColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetActiveGradientType( + const Value: TBackgroundKind); +begin + FActiveGradientType := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetActiveInnerDarkColor( + const Value: TColor); +begin + FActiveInnerDarkColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetActiveInnerLightColor( + const Value: TColor); +begin + FActiveInnerLightColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetCaptionFont(const Value: TFont); +begin + FCaptionFont.assign(Value); + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetHotTrackCaptionColor( + const Value: TColor); +begin + FHotTrackCaptionColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetHotTrackFrameColor( + const Value: TColor); +begin + FHotTrackFrameColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetHotTrackGradientFromColor( + const Value: TColor); +begin + FHotTrackGradientFromColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetHotTrackGradientToColor( + const Value: TColor); +begin + FHotTrackGradientToColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetHotTrackGradientType( + const Value: TBackgroundKind); +begin + FHotTrackGradientType := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetHotTrackInnerDarkColor( + const Value: TColor); +begin + FHotTrackInnerDarkColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetHotTrackInnerLightColor( + const Value: TColor); +begin + FHotTrackInnerLightColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetIdleCaptionColor(const Value: TColor); +begin + FIdleCaptionColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetIdleFrameColor(const Value: TColor); +begin + FIdleFrameColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetIdleGradientFromColor( + const Value: TColor); +begin + FIdleGradientFromColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetIdleGradientToColor( + const Value: TColor); +begin + FIdleGradientToColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetIdleGradientType( + const Value: TBackgroundKind); +begin + FIdleGradientType := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetIdleInnerDarkColor( + const Value: TColor); +begin + FIdleInnerDarkColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkElementAppearance.SetIdleInnerLightColor( + const Value: TColor); +begin + FIdleInnerLightColor := Value; + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; +end; + +{ TSpkToolbarAppearanceDispatch } + +constructor TSpkToolbarAppearanceDispatch.Create( + AToolbarAppearance: TSpkToolbarAppearance); +begin +inherited Create; +FToolbarAppearance:=AToolbarAppearance; +end; + +procedure TSpkToolbarAppearanceDispatch.NotifyAppearanceChanged; +begin +if FToolbarAppearance<>nil then + FToolbarAppearance.NotifyAppearanceChanged; +end; + +{ TSpkToolbarAppearance } + +procedure TSpkToolbarAppearance.Assign(Source: TPersistent); + +var Src : TSpkToolbarAppearance; + +begin + if Source is TSpkToolbarAppearance then + begin + Src:=TSpkToolbarAppearance(Source); + + self.FTab.assign(Src.Tab); + self.FPane.assign(Src.Pane); + self.FElement.Assign(Src.Element); + + if FDispatch<>nil then + FDispatch.NotifyAppearanceChanged; + end else + raise AssignException.create('TSpkToolbarAppearance.Assign: Nie mogę przypisać obiektu '+Source.ClassName+' do TSpkToolbarAppearance!'); +end; + +constructor TSpkToolbarAppearance.Create(ADispatch : TSpkBaseAppearanceDispatch); +begin + inherited Create; + FDispatch:=ADispatch; + FAppearanceDispatch:=TSpkToolbarAppearanceDispatch.Create(self); + FTab:=TSpkTabAppearance.Create(FAppearanceDispatch); + FPane:=TSpkPaneAppearance.create(FAppearanceDispatch); + FElement:=TSpkElementAppearance.create(FAppearanceDispatch); +end; + +destructor TSpkToolbarAppearance.Destroy; +begin + FElement.Free; + FPane.Free; + FTab.Free; + FAppearanceDispatch.Free; + inherited; +end; + +procedure TSpkToolbarAppearance.LoadFromXML(Node: TSpkXMLNode); + +var Subnode : TSpkXMLNode; + +begin +Tab.Reset; +Pane.Reset; +Element.Reset; + +if not(assigned(Node)) then + exit; + +Subnode:=Node['Tab',false]; +if assigned(Subnode) then + Tab.LoadFromXML(Subnode); + +Subnode:=Node['Pane',false]; +if assigned(Subnode) then + Pane.LoadFromXML(Subnode); + +Subnode:=Node['Element',false]; +if assigned(Subnode) then + Element.LoadFromXML(Subnode); +end; + +procedure TSpkToolbarAppearance.NotifyAppearanceChanged; +begin + if assigned(FDispatch) then + FDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkToolbarAppearance.Reset; +begin + FTab.Reset; + FPane.Reset; + FElement.Reset; + if assigned(FAppearanceDispatch) then + FAppearanceDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkToolbarAppearance.SaveToXML(Node: TSpkXMLNode); + +var Subnode : TSpkXMLNode; + +begin +Subnode:=Node['Tab',true]; +FTab.SaveToXML(Subnode); + +Subnode:=Node['Pane',true]; +FPane.SaveToXML(Subnode); + +Subnode:=Node['Element',true]; +FElement.SaveToXML(Subnode); +end; + +procedure TSpkToolbarAppearance.SetElementAppearance( + const Value: TSpkElementAppearance); +begin + FElement.assign(Value); +end; + +procedure TSpkToolbarAppearance.SetPaneAppearance(const Value: TSpkPaneAppearance); +begin + FPane.assign(Value); +end; + +procedure TSpkToolbarAppearance.SetTabAppearance(const Value: TSpkTabAppearance); +begin + FTab.assign(Value); +end; + +end. diff --git a/components/spktoolbar/SpkToolbar/spkt_BaseItem.pas b/components/spktoolbar/SpkToolbar/spkt_BaseItem.pas new file mode 100644 index 000000000..7c165e3bf --- /dev/null +++ b/components/spktoolbar/SpkToolbar/spkt_BaseItem.pas @@ -0,0 +1,154 @@ +unit spkt_BaseItem; + +(******************************************************************************* +* * +* Plik: spkt_BaseItem.pas * +* Opis: Moduł zawierający bazową klasę dla elementu tafli. * +* Copyright: (c) 2009 by Spook. Jakiekolwiek użycie komponentu bez * +* uprzedniego uzyskania licencji od autora stanowi złamanie * +* prawa autorskiego! * +* * +*******************************************************************************) + +interface + +uses Windows, Graphics, Classes, Controls, + SpkMath, SpkGUITools, SpkGraphTools, + spkt_Appearance, spkt_Exceptions, spkt_Dispatch, spkt_Types; + +type TSpkItemSize = (isLarge, isNormal); + TSpkItemTableBehaviour = (tbBeginsRow, tbBeginsColumn, tbContinuesRow); + TSpkItemGroupBehaviour = (gbSingleItem, gbBeginsGroup, gbContinuesGroup, gbEndsGroup); + +type TSpkBaseItem = class abstract(TSpkComponent) + private + protected + FRect : T2DIntRect; + FToolbarDispatch : TSpkBaseToolbarDispatch; + FAppearance : TSpkToolbarAppearance; + FImages : TImageList; + FDisabledImages : TImageList; + FLargeImages : TImageList; + FDisabledLargeImages : TImageList; + FVisible : boolean; + FEnabled : boolean; + + procedure SetVisible(const Value: boolean); virtual; + procedure SetEnabled(const Value: boolean); virtual; + procedure SetRect(const Value: T2DIntRect); virtual; + procedure SetImages(const Value: TImageList); virtual; + procedure SetDisabledImages(const Value : TImageList); virtual; + procedure SetLargeImages(const Value: TImageList); virtual; + procedure SetDisabledLargeImages(const Value: TImageList); virtual; + procedure SetAppearance(const Value: TSpkToolbarAppearance); + public + constructor Create(AOwner : TComponent); override; + destructor Destroy; override; + + procedure MouseLeave; virtual; abstract; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); virtual; abstract; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); virtual; abstract; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); virtual; abstract; + + function GetWidth : integer; virtual; abstract; + function GetTableBehaviour : TSpkItemTableBehaviour; virtual; abstract; + function GetGroupBehaviour : TSpkItemGroupBehaviour; virtual; abstract; + function GetSize : TSpkItemSize; virtual; abstract; + procedure Draw(ABuffer : TBitmap; ClipRect : T2DIntRect); virtual; abstract; + + property ToolbarDispatch : TSpkBaseToolbarDispatch read FToolbarDispatch write FToolbarDispatch; + property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance; + property Images : TImageList read FImages write SetImages; + property DisabledImages : TImageList read FDisabledImages write SetDisabledImages; + property LargeImages : TImageList read FLargeImages write SetLargeImages; + property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages; + + property Rect : T2DIntRect read FRect write SetRect; + published + property Visible : boolean read FVisible write SetVisible; + property Enabled : boolean read FEnabled write SetEnabled; + end; + +type TSpkBaseItemClass = class of TSpkBaseItem; + +implementation + +{ TSpkBaseItem } + +constructor TSpkBaseItem.Create(AOwner : TComponent); +begin + inherited Create(AOwner); + + FRect:=T2DIntRect.create(0, 0, 0, 0); + FToolbarDispatch:=nil; + FAppearance:=nil; + FImages:=nil; + FDisabledImages:=nil; + FLargeImages:=nil; + FDisabledLargeImages:=nil; + FVisible:=true; + FEnabled:=true; +end; + +destructor TSpkBaseItem.Destroy; +begin + { Pozostałe operacje } + inherited Destroy; +end; + +procedure TSpkBaseItem.SetAppearance(const Value: TSpkToolbarAppearance); +begin + FAppearance := Value; + + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyMetricsChanged; +end; + +procedure TSpkBaseItem.SetDisabledImages(const Value: TImageList); +begin + FDisabledImages := Value; +end; + +procedure TSpkBaseItem.SetDisabledLargeImages(const Value: TImageList); +begin +FDisabledLargeImages:=Value; +end; + +procedure TSpkBaseItem.SetEnabled(const Value: boolean); +begin + if Value<>FEnabled then + begin + FEnabled:=Value; + if FToolbarDispatch<>nil then + FToolbarDispatch.NotifyVisualsChanged; + end; +end; + +procedure TSpkBaseItem.SetImages(const Value: TImageList); +begin + FImages := Value; +end; + +procedure TSpkBaseItem.SetLargeImages(const Value: TImageList); +begin + FLargeImages := Value; +end; + +procedure TSpkBaseItem.SetRect(const Value: T2DIntRect); +begin + FRect := Value; +end; + +procedure TSpkBaseItem.SetVisible(const Value: boolean); +begin + if Value<>FVisible then + begin + FVisible:=Value; + if FToolbarDispatch<>nil then + FToolbarDispatch.NotifyMetricsChanged; + end; +end; + +end. diff --git a/components/spktoolbar/SpkToolbar/spkt_Buttons.pas b/components/spktoolbar/SpkToolbar/spkt_Buttons.pas new file mode 100644 index 000000000..8ac9db474 --- /dev/null +++ b/components/spktoolbar/SpkToolbar/spkt_Buttons.pas @@ -0,0 +1,2022 @@ +unit spkt_Buttons; + +(******************************************************************************* +* * +* Plik: spkt_Buttons.pas * +* Opis: Moduł zawierający komponenty przycisków dla toolbara. * +* Copyright: (c) 2009 by Spook. Jakiekolwiek użycie komponentu bez * +* uprzedniego uzyskania licencji od autora stanowi złamanie * +* prawa autorskiego! * +* * +*******************************************************************************) + +interface + +uses Windows, Graphics, Classes, Controls, Menus, ImgList, ActnList, Math, + Types, Dialogs, + SpkGuiTools, SpkGraphTools, SpkMath, + spkt_Const, spkt_BaseItem, spkt_Exceptions, spkt_Tools; + +type TSpkButtonState = (bsIdle, + bsBtnHottrack, bsBtnPressed, + bsDropdownHottrack, bsDropdownPressed); + TSpkMouseButtonElement = (beNone, beButton, beDropdown); + TSpkButtonKind = (bkButton, bkButtonDropdown, bkDropdown); + +type TSpkBaseButton = class; + + TSpkButtonActionLink = class(TActionLink) + private + protected + FClient : TSpkBaseButton; + + procedure AssignClient(AClient: TObject); override; + function IsCaptionLinked: Boolean; override; + function IsEnabledLinked: Boolean; override; + function IsVisibleLinked: Boolean; override; + function IsOnExecuteLinked: Boolean; override; + procedure SetCaption(const Value: string); override; + procedure SetEnabled(Value: Boolean); override; + procedure SetVisible(Value: Boolean); override; + procedure SetOnExecute(Value: TNotifyEvent); override; + public + end; + + TSpkBaseButton = class abstract(TSpkBaseItem) + private + FMouseHoverElement : TSpkMouseButtonElement; + FMouseActiveElement : TSpkMouseButtonElement; + protected + FCaption : string; + FOnClick : TNotifyEvent; + + FActionLink : TSpkButtonActionLink; + + FButtonState : TSpkButtonState; + + FButtonRect : T2DIntRect; + FDropdownRect : T2DIntRect; + + FButtonKind : TSpkButtonKind; + FDropdownMenu : TPopupMenu; + + // *** Obsługa rysowania *** + + /// Zadaniem metody w odziedziczonych klasach jest obliczenie + /// rectów przycisku i menu dropdown w zależności od FButtonState + procedure CalcRects; virtual; abstract; + + function GetDropdownPoint : T2DIntPoint; virtual; abstract; + + // *** Obsługa akcji *** + + procedure ActionChange(Sender : TObject); + + // *** Gettery i settery *** + + procedure SetEnabled(const Value : boolean); override; + procedure SetDropdownMenu(const Value : TPopupMenu); + procedure SetRect(const Value: T2DIntRect); override; + procedure SetCaption(const Value : string); + procedure SetAction(const Value : TBasicAction); + procedure SetButtonKind(const Value : TSpkButtonKind); + function GetAction: TBasicAction; + public + constructor Create(AOwner : TComponent); override; + + procedure MouseLeave; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + published + property ButtonKind : TSpkButtonKind read FButtonKind write SetButtonKind; + property DropdownMenu : TPopupMenu read FDropdownMenu write SetDropdownMenu; + property Caption : string read FCaption write SetCaption; + property Action : TBasicAction read GetAction write SetAction; + property OnClick : TNotifyEvent read FOnClick write FOnClick; + end; + +type TSpkLargeButton = class(TSpkBaseButton) + private + procedure FindBreakPlace(s : string; out Position : integer; out Width : integer); + protected + FLargeImageIndex : integer; + + procedure CalcRects; override; + function GetDropdownPoint : T2DIntPoint; override; + procedure SetLargeImageIndex(const Value: integer); + public + constructor Create(AOwner : TComponent); override; + function GetWidth : integer; override; + function GetTableBehaviour : TSpkItemTableBehaviour; override; + function GetGroupBehaviour : TSpkItemGroupBehaviour; override; + function GetSize : TSpkItemSize; override; + procedure Draw(ABuffer : TBitmap; ClipRect : T2DIntRect); override; + published + property LargeImageIndex : integer read FLargeImageIndex write SetLargeImageIndex; + end; + +type TSpkSmallButton = class(TSpkBaseButton) + private + protected + FImageIndex : integer; + + FTableBehaviour : TSpkItemTableBehaviour; + FGroupBehaviour : TSPkItemGroupBehaviour; + FHideFrameWhenIdle : boolean; + FShowCaption : boolean; + + procedure CalcRects; override; + function GetDropdownPoint : T2DIntPoint; override; + procedure ConstructRects(var BtnRect, DropRect : T2DIntRect); + procedure SetImageIndex(const Value : integer); + procedure SetGroupBehaviour(const Value: TSpkItemGroupBehaviour); + procedure SetHideFrameWhenIdle(const Value: boolean); + procedure SetTableBehaviour(const Value: TSpkItemTableBehaviour); + procedure SetShowCaption(const Value: boolean); + public + constructor Create(AOwner : TComponent); override; + + function GetWidth : integer; override; + function GetTableBehaviour : TSpkItemTableBehaviour; override; + function GetGroupBehaviour : TSpkItemGroupBehaviour; override; + function GetSize : TSpkItemSize; override; + procedure Draw(ABuffer : TBitmap; ClipRect : T2DIntRect); override; + published + property ShowCaption : boolean read FShowCaption write SetShowCaption; + property TableBehaviour : TSpkItemTableBehaviour read FTableBehaviour write SetTableBehaviour; + property GroupBehaviour : TSpkItemGroupBehaviour read FGroupBehaviour write SetGroupBehaviour; + property HideFrameWhenIdle : boolean read FHideFrameWhenIdle write SetHideFrameWhenIdle; + property ImageIndex : integer read FImageIndex write SetImageIndex; + end; + +implementation + +{ TSpkButtonActionLink } + +procedure TSpkButtonActionLink.AssignClient(AClient: TObject); +begin + inherited AssignClient(AClient); + FClient:=TSpkBaseButton(AClient); +end; + +function TSpkButtonActionLink.IsCaptionLinked: Boolean; +begin +result:=(inherited IsCaptionLinked) and + (assigned(FClient)) and + (FClient.Caption = (Action as TCustomAction).Caption); +end; + +function TSpkButtonActionLink.IsEnabledLinked: Boolean; +begin +result:=(inherited IsEnabledLinked) and + (assigned(FClient)) and + (FClient.Enabled = (Action as TCustomAction).Enabled); +end; + +function TSpkButtonActionLink.IsOnExecuteLinked: Boolean; +begin + Result := inherited IsOnExecuteLinked and + (@TSpkBaseButton(FClient).OnClick = @Action.OnExecute); +end; + +function TSpkButtonActionLink.IsVisibleLinked: Boolean; +begin +result:=(inherited IsVisibleLinked) and + (assigned(FClient)) and + (FClient.Visible = (Action as TCustomAction).Visible); +end; + +procedure TSpkButtonActionLink.SetCaption(const Value: string); +begin + if IsCaptionLinked then FClient.Caption := Value; +end; + +procedure TSpkButtonActionLink.SetEnabled(Value: Boolean); +begin + if IsEnabledLinked then FClient.Enabled := Value; +end; + +procedure TSpkButtonActionLink.SetOnExecute(Value: TNotifyEvent); +begin + if IsOnExecuteLinked then FClient.OnClick := Value; +end; + +procedure TSpkButtonActionLink.SetVisible(Value: Boolean); +begin + if IsVisibleLinked then FClient.Visible := Value; +end; + +{ TSpkBaseButton } + +procedure TSpkBaseButton.ActionChange(Sender: TObject); +begin + if Sender is TCustomAction then + with TCustomAction(Sender) do + begin + if (Self.Caption = '') or (Self.Caption = 'Button') then + Self.Caption := Caption; + if (Self.Enabled = True) then + Self.Enabled := Enabled; + if (Self.Visible = True) then + Self.Visible := Visible; + if not Assigned(Self.OnClick) then + Self.OnClick := OnExecute; + end; +end; + +constructor TSpkBaseButton.Create(AOwner : TComponent); +begin + inherited Create(AOwner); + FCaption:='Button'; + FOnClick:=nil; + FActionLink:=nil; + FButtonState:=bsIdle; + FButtonRect:=T2DIntRect.Create(0, 0, 1, 1); + FButtonKind:=bkButton; + FDropdownRect:=T2DIntRect.Create(0, 0, 1, 1); + FDropdownMenu:=nil; + FMouseHoverElement:=beNone; + FMouseActiveElement:=beNone; +end; + +function TSpkBaseButton.GetAction: TBasicAction; +begin +if assigned(FActionLink) then + result:=FActionLink.Action else + result:=nil; +end; + +procedure TSpkBaseButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, + Y: Integer); +begin +if FEnabled then + begin + // Przyciski reagują tylko na lewy przycisk myszy + if Button <> mbLeft then + exit; + + if FMouseActiveElement = beButton then + begin + if FButtonState<>bsBtnPressed then + begin + FButtonState:=bsBtnPressed; + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end else + if FMouseActiveElement = beDropdown then + begin + if FButtonState<>bsDropdownPressed then + begin + FButtonState:=bsDropdownPressed; + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end else + if FMouseActiveElement = beNone then + begin + if FMouseHoverElement = beButton then + begin + FMouseActiveElement:=beButton; + + if FButtonState<>bsBtnPressed then + begin + FButtonState:=bsBtnPressed; + if FToolbarDispatch<>nil then + FToolbarDispatch.NotifyVisualsChanged; + end; + end else + if FMouseHoverElement = beDropdown then + begin + FMouseActiveElement:=beDropdown; + + if FButtonState<>bsDropdownPressed then + begin + FButtonState:=bsDropdownPressed; + if FToolbarDispatch<>nil then + FToolbarDispatch.NotifyVisualsChanged; + end; + end; + end; + end +else + begin + FMouseHoverElement:=beNone; + FMouseActiveElement:=beNone; + if FButtonState<>bsIdle then + begin + FButtonState:=bsIdle; + + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end; +end; + +procedure TSpkBaseButton.MouseLeave; +begin +if FEnabled then + begin + if FMouseActiveElement = beNone then + begin + if FMouseHoverElement = beButton then + begin + // Placeholder, gdyby zaszła potrzeba obsługi tego zdarzenia + end else + if FMouseHoverElement = beDropdown then + begin + // Placeholder, gdyby zaszła potrzeba obsługi tego zdarzenia + end; + end; + + if FButtonState<>bsIdle then + begin + FButtonState:=bsIdle; + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end +else + begin + FMouseHoverElement:=beNone; + FMouseActiveElement:=beNone; + if FButtonState<>bsIdle then + begin + FButtonState:=bsIdle; + + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end; +end; + +procedure TSpkBaseButton.MouseMove(Shift: TShiftState; X, Y: Integer); + +var NewMouseHoverElement : TSpkMouseButtonElement; + +begin +if FEnabled then + begin + if FButtonRect.Contains(T2DIntPoint.Create(X,Y)) then + NewMouseHoverElement:=beButton else + if (FButtonKind = bkButtonDropdown) and + (FDropdownRect.Contains(T2DIntPoint.Create(X,Y))) then + NewMouseHoverElement:=beDropdown else + NewMouseHoverElement:=beNone; + + if FMouseActiveElement = beButton then + begin + if (NewMouseHoverElement = beNone) and (FButtonState<>bsIdle) then + begin + FButtonState:=bsIdle; + if FToolbarDispatch<>nil then + FToolbarDispatch.NotifyVisualsChanged; + end else + if (NewMouseHoverElement = beButton) and (FButtonState<>bsBtnPressed) then + begin + FButtonState:=bsBtnPressed; + if FToolbarDispatch<>nil then + FToolbarDispatch.NotifyVisualsChanged; + end; + end else + if FMouseActiveElement = beDropdown then + begin + if (NewMouseHoverElement = beNone) and (FButtonState<>bsIdle) then + begin + FButtonState:=bsIdle; + if FToolbarDispatch<>nil then + FToolbarDispatch.NotifyVisualsChanged; + end else + if (NewMouseHoverElement = beDropdown) and (FButtonState<>bsDropdownPressed) then + begin + FButtonState:=bsDropdownPressed; + if FToolbarDispatch<>nil then + FToolbarDispatch.NotifyVisualsChanged; + end; + end else + if FMouseActiveElement = beNone then + begin + // Z uwagi na uproszczoną obsługę myszy w przycisku, nie ma potrzeby + // informować poprzedniego elementu o tym, że mysz opuściła jego obszar. + + if NewMouseHoverElement = beButton then + begin + if FButtonState<>bsBtnHottrack then + begin + FButtonState:=bsBtnHottrack; + if FToolbarDispatch<>nil then + FToolbarDispatch.NotifyVisualsChanged; + end; + end else + if NewMouseHoverElement = beDropdown then + begin + if FButtonState<>bsDropdownHottrack then + begin + FButtonState:=bsDropdownHottrack; + if FToolbarDispatch<>nil then + FToolbarDispatch.NotifyVisualsChanged; + end; + end; + end; + + FMouseHoverElement:=NewMouseHoverElement; + end +else + begin + FMouseHoverElement:=beNone; + FMouseActiveElement:=beNone; + if FButtonState<>bsIdle then + begin + FButtonState:=bsIdle; + + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end; +end; + +procedure TSpkBaseButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, + Y: Integer); + +var ClearActive : boolean; + DropPoint: T2DIntPoint; + +begin +if FEnabled then + begin + // Przyciski reagują tylko na lewy przycisk myszy + if Button <> mbLeft then + exit; + + ClearActive:=not(ssLeft in Shift); + + if FMouseActiveElement = beButton then + begin + // Zdarzenie zadziała tylko wtedy, gdy przycisk myszy został puszczony nad + // przyciskiem + if FMouseHoverElement = beButton then + begin + if FButtonKind in [bkButton, bkButtonDropdown] then + begin + if assigned(FOnClick) then + FOnClick(self) + end else + if FButtonKind = bkDropdown then + begin + if assigned(FDropdownMenu) then + begin + DropPoint:=FToolbarDispatch.ClientToScreen(GetDropdownPoint); + FDropdownMenu.Popup(DropPoint.x, DropPoint.y); + end; + end; + end; + end else + if FMouseActiveElement = beDropDown then + begin + // Zdarzenie zadziała tylko wtedy, gdy przycisk myszy został puszczony nad + // przyciskiem DropDown + + if FMouseHoverElement = beDropDown then + begin + if assigned(FDropdownMenu) then + begin + DropPoint:=FToolbarDispatch.ClientToScreen(GetDropdownPoint); + FDropdownMenu.Popup(DropPoint.x, DropPoint.y); + end; + end; + end; + + if (ClearActive) and (FMouseActiveElement<>FMouseHoverElement) then + begin + // Z uwagi na uproszczoną obsługę, nie ma potrzeby informować poprzedniego + // elementu o tym, że mysz opuściła jego obszar. + + if FMouseHoverElement = beButton then + begin + if FButtonState<>bsBtnHottrack then + begin + FButtonState:=bsBtnHottrack; + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end else + if FMouseHoverElement = beDropdown then + begin + if FButtonState<>bsDropdownHottrack then + begin + FButtonState:=bsDropdownHottrack; + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end else + if FMouseHoverElement = beNone then + begin + if FButtonState <> bsIdle then + begin + FButtonState:=bsIdle; + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end; + end; + + if ClearActive then + begin + FMouseActiveElement:=beNone; + end; + end +else + begin + FMouseHoverElement:=beNone; + FMouseActiveElement:=beNone; + if FButtonState<>bsIdle then + begin + FButtonState:=bsIdle; + + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end; +end; + +procedure TSpkBaseButton.SetAction(const Value: TBasicAction); +begin + if Value = nil then + begin + FActionLink.Free; + FActionLink := nil; + end + else + begin + if FActionLink = nil then + FActionLink := TSpkButtonActionLink.Create(self); + FActionLink.Action := Value; + FActionLink.OnChange := ActionChange; + ActionChange(Value); + end; +end; + +procedure TSpkBaseButton.SetButtonKind(const Value: TSpkButtonKind); +begin + FButtonKind:=Value; + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyMetricsChanged; +end; + +procedure TSpkBaseButton.SetCaption(const Value: string); +begin + FCaption:=Value; + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyMetricsChanged; +end; + +procedure TSpkBaseButton.SetDropdownMenu(const Value: TPopupMenu); +begin + FDropdownMenu:=Value; + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyMetricsChanged; +end; + +procedure TSpkBaseButton.SetEnabled(const Value: boolean); +begin + inherited; + if not(FEnabled) then + begin + // Jeśli przycisk został wyłączony, zostaje natychmiast przełączony + // w stan Idle i zerowane są elementy aktywne i pod myszą. Jeśli został + // włączony, jego stan zmieni się podczas pierwszej akcji myszy. + + FMouseHoverElement:=beNone; + FMouseActiveElement:=beNone; + + if FButtonState<>bsIdle then + begin + FButtonState:=bsIdle; + + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end; +end; + +procedure TSpkBaseButton.SetRect(const Value: T2DIntRect); +begin + inherited; + CalcRects; +end; + +{ TSpkLargeButton } + +procedure TSpkLargeButton.CalcRects; +begin +if FButtonKind = bkButtonDropdown then + begin + FButtonRect:=T2DIntRect.Create(FRect.Left, FRect.Top, FRect.Right, FRect.Bottom - LARGEBUTTON_DROPDOWN_FIELD_SIZE); + FDropdownRect:=T2DIntRect.Create(FRect.Left, FRect.Bottom - LARGEBUTTON_DROPDOWN_FIELD_SIZE + 1, FRect.Right, FRect.Bottom); + end +else + begin + FButtonRect:=FRect; + FDropdownRect:=T2DIntRect.Create(0, 0, 0, 0); + end; +end; + +constructor TSpkLargeButton.Create(AOwner: TComponent); +begin + inherited; + FLargeImageIndex:=-1; +end; + +procedure TSpkLargeButton.Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); + +var FrameColor: TColor; + InnerLightColor: TColor; + InnerDarkColor: TColor; + GradientFromColor: TColor; + GradientToColor: TColor; + GradientKind : TBackgroundKind; + DrawRgn, TmpRgn : HRGN; + x: Integer; + y: Integer; + + FontColor: TColor; + BreakPos: Integer; + BreakWidth: Integer; + s: string; + TextHeight: Integer; + +begin +if FToolbarDispatch=nil then + exit; +if FAppearance=nil then + exit; + +if (FRect.width<2*LARGEBUTTON_RADIUS) or (FRect.Height<2*LARGEBUTTON_RADIUS) then + exit; + +if FButtonKind in [bkButton, bkDropdown] then + begin + {$REGION 'Tryb bez dodatkowego przycisku z rozwijanym menu'} + // *** Tło *** + if not(FEnabled) then + begin + {$REGION 'Tło dla disabled'} + // Brak tła + {$ENDREGION} + end else + if FButtonState = bsIdle then + begin + {$REGION 'Tło dla Idle'} + // Brak tła + {$ENDREGION} + end else + if FButtonState = bsBtnHottrack then + begin + {$REGION 'Tło dla HotTrack'} + TGuiTools.DrawRoundRect(ABuffer.Canvas, + T2DIntRect.Create(FButtonRect.left, + FButtonRect.Top, + FButtonRect.Right, + FButtonRect.Bottom), + LARGEBUTTON_RADIUS, + FAppearance.Element.HotTrackGradientFromColor, + FAppearance.Element.HotTrackGradientToColor, + FAppearance.Element.HotTrackGradientType, + ClipRect); + + TGuiTools.DrawAARoundFrame(ABuffer, + T2DIntRect.Create(FButtonRect.left+1, + FButtonRect.top+1, + FButtonRect.right-1, + FButtonRect.Bottom-1), + LARGEBUTTON_RADIUS, + FAppearance.Element.HotTrackInnerLightColor, + ClipRect); + TGuiTools.DrawAARoundFrame(ABuffer, + FButtonRect, + LARGEBUTTON_RADIUS, + FAppearance.Element.HotTrackFrameColor, + ClipRect); + {$ENDREGION} + end else + if FButtonState = bsBtnPressed then + begin + {$REGION 'Tło dla Pressed'} + TGuiTools.DrawRoundRect(ABuffer.Canvas, + T2DIntRect.Create(FButtonRect.left, + FButtonRect.Top, + FButtonRect.Right, + FButtonRect.Bottom), + LARGEBUTTON_RADIUS, + FAppearance.Element.ActiveGradientFromColor, + FAppearance.Element.ActiveGradientToColor, + FAppearance.Element.ActiveGradientType, + ClipRect); + + + TGuiTools.DrawAARoundFrame(ABuffer, + T2DIntRect.Create(FButtonRect.left+1, + FButtonRect.top+1, + FButtonRect.right-1, + FButtonRect.Bottom-1), + LARGEBUTTON_RADIUS, + FAppearance.Element.ActiveInnerLightColor, + ClipRect); + TGuiTools.DrawAARoundFrame(ABuffer, + FButtonRect, + LARGEBUTTON_RADIUS, + FAppearance.Element.ActiveFrameColor, + ClipRect); + {$ENDREGION} + end else + raise InternalException.create('TSpkLargeButton.Draw: Nieprawidłowa wartość FButtonState!'); + + // *** Ikona *** + if not(FEnabled) then + begin + {$REGION 'Ikona wyłączona'} + if (FLargeImageIndex>=0) and + (FDisabledLargeImages<>nil) and + (FLargeImageIndex=0) and + (FLargeImages<>nil) and + (FLargeImageIndex=0) and + (FLargeImages<>nil) and + (FLargeImageIndex0 then + begin + // Tekst złamany + TextHeight:=ABuffer.Canvas.Textheight('Wy'); + + s:=copy(FCaption, 1, BreakPos-1); + x:=FRect.Left + (FRect.width - ABuffer.Canvas.Textwidth(s)) div 2; + y:=FRect.Top + LARGEBUTTON_CAPTION_TOP_RAIL - TextHeight div 2; + TGUITools.DrawText(ABuffer.Canvas, x, y, s, FontColor, ClipRect); + + s:=copy(FCaption, BreakPos+1, length(FCaption) - BreakPos); + x:=FRect.Left + (FRect.width - ABuffer.Canvas.Textwidth(s)) div 2; + y:=FRect.Top + LARGEBUTTON_CAPTION_BOTTOM_RAIL - TextHeight div 2; + TGUITools.DrawText(ABuffer.Canvas, x, y, s, FontColor, ClipRect); + end + else + begin + // Tekst nie złamany + TextHeight:=ABuffer.Canvas.Textheight('Wy'); + + x:=FButtonRect.Left + (FButtonRect.width - ABuffer.Canvas.Textwidth(FCaption)) div 2; + y:=FRect.Top + LARGEBUTTON_CAPTION_TOP_RAIL - TextHeight div 2; + TGUITools.DrawText(ABuffer.Canvas, x, y, FCaption, FontColor, ClipRect); + end; + + if FButtonKind = bkDropdown then + begin + // Chevron strzałki w dół + + if not(FEnabled) then + begin + case FButtonState of + bsIdle: FontColor:=TColorTools.ColorToGrayscale(FAppearance.Element.IdleCaptionColor); + bsBtnHottrack, + bsDropdownHottrack : FontColor:=TColorTools.ColorToGrayscale(FAppearance.Element.HotTrackCaptionColor); + bsBtnPressed, + bsDropdownPressed: FontColor:=TColorTools.ColorToGrayscale(FAppearance.ELement.ActiveCaptionColor); + end; + end + else + begin + case FButtonState of + bsIdle: FontColor:=FAppearance.Element.IdleCaptionColor; + bsBtnHottrack, + bsDropdownHottrack : FontColor:=FAppearance.Element.HotTrackCaptionColor; + bsBtnPressed, + bsDropdownPressed: FontColor:=FAppearance.ELement.ActiveCaptionColor; + end; + end; + + ABuffer.Canvas.Font.Charset:=DEFAULT_CHARSET; + ABuffer.Canvas.Font.Name:='Marlett'; + ABuffer.Canvas.Font.Size:=8; + ABuffer.Canvas.Font.Style:=[]; + ABuffer.Canvas.Font.Orientation:=0; + + x:=FButtonRect.Left + (FButtonRect.width - ABuffer.Canvas.Textwidth('u')) div 2; + y:=FButtonRect.bottom - ABuffer.Canvas.Textheight('u') - LARGEBUTTON_CHEVRON_HMARGIN; + TGUITools.DrawText(ABuffer.Canvas, x, y, 'u', FontColor, ClipRect); + end; + + {$ENDREGION} + end +else + begin + {$REGION 'Tryb z rozwijanym menu'} + // *** Tło *** + if not(FEnabled) then + begin + {$REGION 'Tło dla Disabled'} + // + {$ENDREGION} + end else + if FButtonState = bsIdle then + begin + {$REGION 'Tło dla Idle'} + // + {$ENDREGION} + end else + if (FButtonState = bsBtnHottrack) or (FButtonState = bsDropdownHottrack) or + (FButtonState = bsBtnPressed) or (FButtonState = bsDropdownPressed) then + begin + {$REGION 'Tło dla aktywnego'} + + // *** Przycisk *** + + {$REGION 'Ustalanie kolorów'} + if FButtonState = bsBtnHottrack then + begin + FrameColor:=FAppearance.Element.HotTrackFrameColor; + InnerLightColor:=FAppearance.Element.HotTrackInnerLightColor; + GradientFromColor:=FAppearance.Element.HotTrackGradientFromColor; + GradientToColor:=FAppearance.Element.HotTrackGradientToColor; + GradientKind:=FAppearance.Element.HotTrackGradientType; + end else + if FButtonState = bsBtnPressed then + begin + FrameColor:=FAppearance.Element.ActiveFrameColor; + InnerLightColor:=FAppearance.Element.ActiveInnerLightColor; + GradientFromColor:=FAppearance.Element.ActiveGradientFromColor; + GradientToColor:=FAppearance.Element.ActiveGradientToColor; + GradientKind:=FAppearance.Element.ActiveGradientType; + end + else + begin + FrameColor:=TColorTools.Brighten(FAppearance.Element.HotTrackFrameColor,40); + InnerLightColor:=TColorTools.Brighten(FAppearance.Element.HotTrackInnerLightColor,40); + GradientFromColor:=TColorTools.Brighten(FAppearance.Element.HotTrackGradientFromColor,40); + GradientToColor:=TColorTools.Brighten(FAppearance.Element.HotTrackGradientToColor,40); + GradientKind:=FAppearance.Element.HotTrackGradientType; + end; + {$ENDREGION} + + {$REGION 'Tło przycisku'} + DrawRgn:=CreateRectRgn(FButtonRect.Left, + FButtonRect.Top + LARGEBUTTON_RADIUS, + FButtonRect.Right + 1, + FButtonRect.Bottom); + + TmpRgn:=CreateRectRgn(FButtonRect.left + LARGEBUTTON_RADIUS, + FButtonRect.Top, + FButtonRect.right - LARGEBUTTON_RADIUS + 1, + FButtonRect.Top + LARGEBUTTON_RADIUS); + CombineRgn(DrawRgn, DrawRgn, TmpRgn, RGN_OR); + DeleteObject(TmpRgn); + + TmpRgn:=CreateEllipticRgn(FButtonRect.Left, + FButtonRect.Top, + FButtonRect.Left + 2 * LARGEBUTTON_RADIUS + 1, + FButtonRect.Top + 2 * LARGEBUTTON_RADIUS + 1); + CombineRgn(DrawRgn, DrawRgn, TmpRgn, RGN_OR); + DeleteObject(TmpRgn); + + TmpRgn:=CreateEllipticRgn(FButtonRect.Right - 2 * LARGEBUTTON_RADIUS + 1, + FButtonRect.Top, + FButtonRect.Right + 2, + FButtonRect.Top + 2 * LARGEBUTTON_RADIUS + 1); + CombineRgn(DrawRgn, DrawRgn, TmpRgn, RGN_OR); + DeleteObject(TmpRgn); + + TGuiTools.DrawRegion(ABuffer.Canvas, + DrawRgn, + FRect, + GradientFromColor, + GradientToColor, + GradientKind, + ClipRect); + DeleteObject(DrawRgn); + {$ENDREGION} + + {$REGION 'Ramka przycisku'} + // Wewnętrzna ramka + TGuiTools.DrawAARoundCorner(ABuffer, + T2DIntPoint.Create(FButtonRect.Left + 1, FButtonRect.Top + 1), + LARGEBUTTON_RADIUS, + cpLeftTop, + InnerLightColor, + ClipRect); + TGuiTools.DrawAARoundCorner(ABuffer, + T2DIntPoint.Create(FButtonRect.Right - LARGEBUTTON_RADIUS, FButtonRect.Top + 1), + LARGEBUTTON_RADIUS, + cpRightTop, + InnerLightColor, + ClipRect); + TGuiTools.DrawHLine(ABuffer, + FButtonRect.Left + LARGEBUTTON_RADIUS + 1, + FButtonRect.Right - LARGEBUTTON_RADIUS - 1, + FButtonRect.Top + 1, + InnerLightColor, + ClipRect); + TGuiTools.DrawVLine(ABuffer, + FButtonRect.Left + 1, + FButtonRect.Top + LARGEBUTTON_RADIUS + 1, + FButtonRect.Bottom, + InnerLightColor, + ClipRect); + TGuiTools.DrawVLine(ABuffer, + FButtonRect.Right - 1, + FButtonRect.Top + LARGEBUTTON_RADIUS + 1, + FButtonRect.Bottom, + InnerLightColor, + ClipRect); + + if FButtonState = bsBtnPressed then + TGuiTools.DrawHLine(ABuffer, + FButtonRect.Left + 1, + FButtonRect.Right - 1, + FButtonRect.Bottom, + FrameColor, + ClipRect) else + TGuiTools.DrawHLine(ABuffer, + FButtonRect.Left + 1, + FButtonRect.Right - 1, + FButtonRect.Bottom, + InnerLightColor, + ClipRect); + + // Zewnętrzna ramka + TGuiTools.DrawAARoundCorner(ABuffer, + T2DIntPoint.Create(FButtonRect.Left, FButtonRect.Top), + LARGEBUTTON_RADIUS, + cpLeftTop, + FrameColor, + ClipRect); + TGuiTools.DrawAARoundCorner(ABuffer, + T2DIntPoint.Create(FButtonRect.Right - LARGEBUTTON_RADIUS + 1, FButtonRect.Top), + LARGEBUTTON_RADIUS, + cpRightTop, + FrameColor, + ClipRect); + TGuiTools.DrawHLine(ABuffer, + FButtonRect.Left + LARGEBUTTON_RADIUS, + FButtonRect.Right - LARGEBUTTON_RADIUS, + FButtonRect.Top, + FrameColor, + ClipRect); + TGuiTools.DrawVLine(ABuffer, + FButtonRect.Left, + FButtonRect.Top + LARGEBUTTON_RADIUS, + FButtonRect.Bottom, + FrameColor, + ClipRect); + TGuiTools.DrawVLine(ABuffer, + FButtonRect.Right, + FButtonRect.Top + LARGEBUTTON_RADIUS, + FButtonRect.Bottom, + FrameColor, + ClipRect); + {$ENDREGION} + + // *** Dropdown *** + + {$REGION 'Ustalanie kolorów'} + if FButtonState = bsDropdownHottrack then + begin + FrameColor:=FAppearance.Element.HotTrackFrameColor; + InnerLightColor:=FAppearance.Element.HotTrackInnerLightColor; + InnerDarkColor:=FAppearance.Element.HotTrackInnerDarkColor; + GradientFromColor:=FAppearance.Element.HotTrackGradientFromColor; + GradientToColor:=FAppearance.Element.HotTrackGradientToColor; + GradientKind:=FAppearance.Element.HotTrackGradientType; + end else + if FButtonState = bsDropdownPressed then + begin + FrameColor:=FAppearance.Element.ActiveFrameColor; + InnerLightColor:=FAppearance.Element.ActiveInnerLightColor; + InnerDarkColor:=FAppearance.Element.ActiveInnerDarkColor; + GradientFromColor:=FAppearance.Element.ActiveGradientFromColor; + GradientToColor:=FAppearance.Element.ActiveGradientToColor; + GradientKind:=FAppearance.Element.ActiveGradientType; + end + else + begin + FrameColor:=TColorTools.Brighten(FAppearance.Element.HotTrackFrameColor,20); + InnerLightColor:=TColorTools.Brighten(FAppearance.Element.HotTrackInnerLightColor,20); + InnerDarkColor:=TColorTools.Brighten(FAppearance.Element.HotTrackInnerDarkColor,20); + GradientFromColor:=TColorTools.Brighten(FAppearance.Element.HotTrackGradientFromColor,20); + GradientToColor:=TColorTools.Brighten(FAppearance.Element.HotTrackGradientToColor,20); + GradientKind:=FAppearance.Element.HotTrackGradientType; + end; + {$ENDREGION} + + {$REGION 'Tło dropdown'} + DrawRgn:=CreateRectRgn(FDropdownRect.left, + FDropdownRect.Top, + FDropdownRect.Right + 1, + FDropdownRect.Bottom - LARGEBUTTON_RADIUS + 1); + + TmpRgn:=CreateRectRgn(FDropdownRect.left + LARGEBUTTON_RADIUS, + FDropdownRect.Bottom - LARGEBUTTON_RADIUS + 1, + FDropdownRect.Right - LARGEBUTTON_RADIUS + 1, + FDropdownRect.Bottom + 1); + CombineRgn(DrawRgn, DrawRgn, TmpRgn, RGN_OR); + DeleteObject(TmpRgn); + + TmpRgn:=CreateEllipticRgn(FDropdownRect.Left, + FDropdownRect.bottom - 2 * LARGEBUTTON_RADIUS + 1, + FDropdownRect.left + 2 * LARGEBUTTON_RADIUS + 1, + FDropdownRect.Bottom + 2); + CombineRgn(DrawRgn, DrawRgn, TmpRgn, RGN_OR); + DeleteObject(TmpRgn); + + TmpRgn:=CreateEllipticRgn(FDropdownRect.Right - 2 * LARGEBUTTON_RADIUS + 1, + FDropdownRect.Bottom - 2 * LARGEBUTTON_RADIUS + 1, + FDropdownRect.Right + 2, + FDropdownRect.Bottom + 2); + CombineRgn(DrawRgn, DrawRgn, TmpRgn, RGN_OR); + DeleteObject(TmpRgn); + + TGuiTools.DrawRegion(ABuffer.Canvas, + DrawRgn, + FRect, + GradientFromColor, + GradientToColor, + GradientKind, + ClipRect); + DeleteObject(DrawRgn); + {$ENDREGION} + + {$REGION 'Ramka dropdown'} + // Wewnętrzna ramka + + TGuiTools.DrawAARoundCorner(ABuffer, + T2DIntPoint.Create(FDropdownRect.Left + 1, FDropdownRect.Bottom - LARGEBUTTON_RADIUS), + LARGEBUTTON_RADIUS, + cpLeftBottom, + InnerLightColor); + TGuiTools.DrawAARoundCorner(ABuffer, + T2DIntPoint.Create(FDropdownRect.right - LARGEBUTTON_RADIUS, FDropdownRect.Bottom - LARGEBUTTON_RADIUS), + LARGEBUTTON_RADIUS, + cpRightBottom, + InnerLightColor); + TGuiTools.DrawHLine(ABuffer, + FDropdownRect.Left + LARGEBUTTON_RADIUS + 1, + FDropdownRect.Right - LARGEBUTTON_RADIUS - 1, + FDropdownRect.Bottom - 1, + InnerLightColor, + ClipRect); + TGuiTools.DrawVLine(ABuffer, + FDropdownRect.Left + 1, + FDropDownRect.Top + 1, + FDropDownRect.Bottom - LARGEBUTTON_RADIUS - 1, + InnerLightColor, + ClipRect); + TGuiTools.DrawVLine(ABuffer, + FDropdownRect.Right - 1, + FDropDownRect.Top + 1, + FDropDownRect.Bottom - LARGEBUTTON_RADIUS - 1, + InnerLightColor, + ClipRect); + + if FButtonState = bsDropdownPressed then + TGuiTools.DrawHLine(ABuffer, + FDropdownRect.Left + 1, + FDropdownRect.Right - 1, + FDropdownRect.Top, + FrameColor, + ClipRect) + else + TGuiTools.DrawHLine(ABuffer, + FDropdownRect.Left + 1, + FDropdownRect.Right - 1, + FDropdownRect.Top, + InnerDarkColor, + ClipRect); + + + // Zewnętrzna ramka + TGuiTools.DrawAARoundCorner(ABuffer, + T2DIntPoint.Create(FDropdownRect.Left, FDropdownRect.Bottom - LARGEBUTTON_RADIUS + 1), + LARGEBUTTON_RADIUS, + cpLeftBottom, + FrameColor); + TGuiTools.DrawAARoundCorner(ABuffer, + T2DIntPoint.Create(FDropdownRect.right - LARGEBUTTON_RADIUS + 1, FDropdownRect.Bottom - LARGEBUTTON_RADIUS + 1), + LARGEBUTTON_RADIUS, + cpRightBottom, + FrameColor); + TGuiTools.DrawHLine(ABuffer, + FDropdownRect.Left + LARGEBUTTON_RADIUS, + FDropdownRect.Right - LARGEBUTTON_RADIUS, + FDropdownRect.Bottom, + FrameColor, + ClipRect); + TGuiTools.DrawVLine(ABuffer, + FDropdownRect.Left, + FDropDownRect.Top, + FDropDownRect.Bottom - LARGEBUTTON_RADIUS, + FrameColor, + ClipRect); + TGuiTools.DrawVLine(ABuffer, + FDropdownRect.Right, + FDropDownRect.Top, + FDropDownRect.Bottom - LARGEBUTTON_RADIUS, + FrameColor, + ClipRect); + {$ENDREGION} + + {$ENDREGION} + end else + raise InternalException.create('TSpkLargeButton.Draw: Nieprawidłowa wartość FButtonState!'); + + // *** Ikona *** + if not(FEnabled) then + begin + {$REGION 'Ikona wyłączona'} + if (FLargeImageIndex>=0) and + (FDisabledLargeImages<>nil) and + (FLargeImageIndex=0) and + (FLargeImages<>nil) and + (FLargeImageIndex=0) and + (FLargeImages<>nil) and + (FLargeImageIndex0 then + for i := 1 to length(s) do + if s[i]=' ' then + begin + if i>1 then + BeforeWidth:=Bitmap.Canvas.TextWidth(copy(s,1,i-1)) else + BeforeWidth:=0; + + if inil then + GlyphWidth:=2 * LARGEBUTTON_GLYPH_MARGIN + FLargeImages.Width else + GlyphWidth:=0; + +// *** Tekst *** +if FButtonKind = bkButton then + begin + // Łamiemy etykietę + FindBreakPlace(FCaption,BreakPos,RowWidth); + TextWidth:=2 * LARGEBUTTON_CAPTION_HMARGIN + RowWidth; + end +else + begin + // Nie łamiemy etykiety + Bitmap.canvas.font.assign(FAppearance.Element.CaptionFont); + TextWidth:=2 * LARGEBUTTON_CAPTION_HMARGIN + Bitmap.Canvas.TextWidth(FCaption); + end; + +result:=max(LARGEBUTTON_MIN_WIDTH, max(GlyphWidth, TextWidth)); +end; + +procedure TSpkLargeButton.SetLargeImageIndex(const Value: integer); +begin +FLargeImageIndex:=Value; + +if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyMetricsChanged; +end; + +{ TSpkSmallButton } + +procedure TSpkSmallButton.CalcRects; + +var RectVector : T2DIntVector; + +begin +ConstructRects(FButtonRect, FDropdownRect); +RectVector:=T2DIntVector.Create(FRect.Left, FRect.Top); +FButtonRect:=FButtonRect + RectVector; +FDropdownRect:=FDropdownRect + RectVector; +end; + +procedure TSpkSmallButton.ConstructRects(var BtnRect, DropRect: T2DIntRect); + +var BtnWidth : integer; + DropdownWidth: Integer; + Bitmap : TBitmap; + TextWidth: Integer; + AdditionalPadding: Boolean; + +begin +BtnRect:=T2DIntRect.Create(0, 0, 0, 0); +DropRect:=T2DIntRect.Create(0, 0, 0, 0); + +if not(assigned(FToolbarDispatch)) then + exit; +if not(assigned(FAppearance)) then + exit; + +Bitmap:=FToolbarDispatch.GetTempBitmap; +if not(assigned(Bitmap)) then + exit; + +// *** Niezależnie od rodzaju, musi być miejsce dla ikony i/lub tekstu *** + +BtnWidth:=0; +AdditionalPadding:=false; + +// Ikona +if FImageIndex<>-1 then + begin + BtnWidth:=BtnWidth + SMALLBUTTON_PADDING + SMALLBUTTON_GLYPH_WIDTH; + AdditionalPadding:=true; + end; + +// Tekst +if FShowCaption then + begin + Bitmap.Canvas.Font.assign(FAppearance.Element.CaptionFont); + TextWidth:=Bitmap.Canvas.TextWidth(FCaption); + + BtnWidth:=BtnWidth + SMALLBUTTON_PADDING + TextWidth; + AdditionalPadding:=true; + end; + +// Padding za tekstem lub ikoną +if AdditionalPadding then + BtnWidth:=BtnWidth + SMALLBUTTON_PADDING; + +// Szerokość zawartości przycisku musi wynosić co najmniej SMALLBUTTON_MIN_WIDTH +BtnWidth:=max(SMALLBUTTON_MIN_WIDTH, BtnWidth); + +// *** Dropdown *** +case FButtonKind of + bkButton: begin + // Lewa krawędź przycisku + if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then + BtnWidth:=BtnWidth + SMALLBUTTON_HALF_BORDER_WIDTH else + BtnWidth:=BtnWidth + SMALLBUTTON_BORDER_WIDTH; + + // Prawa krawędź przycisku + if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then + BtnWidth:=BtnWidth + SMALLBUTTON_HALF_BORDER_WIDTH else + BtnWidth:=BtnWidth + SMALLBUTTON_BORDER_WIDTH; + + BtnRect:=T2DIntRect.Create(0, 0, BtnWidth - 1, PANE_ROW_HEIGHT - 1); + DropRect:=T2DIntRect.Create(0, 0, 0, 0); + end; + bkButtonDropdown: begin + // Lewa krawędź przycisku + if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then + BtnWidth:=BtnWidth + SMALLBUTTON_HALF_BORDER_WIDTH else + BtnWidth:=BtnWidth + SMALLBUTTON_BORDER_WIDTH; + + // Prawa krawędź przycisku + BtnWidth:=BtnWidth + SMALLBUTTON_HALF_BORDER_WIDTH; + + // Lewa krawędź i zawartość pola dropdown + DropdownWidth:=SMALLBUTTON_HALF_BORDER_WIDTH + SMALLBUTTON_DROPDOWN_WIDTH; + + // Prawa krawędź pola dropdown + if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then + DropdownWidth:=DropdownWidth + SMALLBUTTON_HALF_BORDER_WIDTH else + DropdownWidth:=DropdownWidth + SMALLBUTTON_BORDER_WIDTH; + + BtnRect:=T2DIntRect.Create(0, 0, BtnWidth - 1, PANE_ROW_HEIGHT - 1); + DropRect:=T2DIntRect.Create(BtnRect.right+1, + 0, + BtnRect.right+DropdownWidth, + PANE_ROW_HEIGHT - 1); + end; + bkDropdown: begin + // Lewa krawędź przycisku + if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then + BtnWidth:=BtnWidth + SMALLBUTTON_HALF_BORDER_WIDTH else + BtnWidth:=BtnWidth + SMALLBUTTON_BORDER_WIDTH; + + // Prawa krawędź przycisku + if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then + BtnWidth:=BtnWidth + SMALLBUTTON_HALF_BORDER_WIDTH else + BtnWidth:=BtnWidth + SMALLBUTTON_BORDER_WIDTH; + + // Dodatkowy obszar na dropdown + miejsce na środkową krawędź, + // dla kompatybilności wymiarów z dkButtonDropdown + BtnWidth:=BtnWidth + SMALLBUTTON_BORDER_WIDTH + SMALLBUTTON_DROPDOWN_WIDTH; + + BtnRect:=T2DIntRect.Create(0, 0, BtnWidth - 1, PANE_ROW_HEIGHT - 1); + DropRect:=T2DIntRect.Create(0, 0, 0, 0); + end; +end; +end; + +constructor TSpkSmallButton.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FImageIndex:=-1; + FTableBehaviour:=tbContinuesRow; + FGroupBehaviour:=gbSingleItem; + FHideFrameWhenIdle:=false; + FShowCaption:=true; +end; + +procedure TSpkSmallButton.Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); +var + FontColor: TColor; + x: Integer; + y: Integer; +begin +if FToolbarDispatch=nil then + exit; +if FAppearance=nil then + exit; + +if (FRect.width<2*LARGEBUTTON_RADIUS) or (FRect.Height<2*LARGEBUTTON_RADIUS) then + exit; + +// *** Przycisk *** + +// Tło i ramka +{$REGION 'Rysowanie przycisku'} +if (FButtonState = bsIdle) and (not(FHideFrameWhenIdle)) then + begin + with FAppearance.Element do + TButtonTools.DrawButton(ABuffer, + FButtonRect, + IdleFrameColor, + IdleInnerLightColor, + IdleInnerDarkColor, + IdleGradientFromColor, + IdleGradientToColor, + IdleGradientType, + (FGroupBehaviour in [gbContinuesGroup, gbEndsGroup]), + (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) or (FButtonKind = bkButtonDropdown), + false, + false, + SMALLBUTTON_RADIUS, + ClipRect); + end else +if (FButtonState=bsBtnHottrack) then + begin + with FAppearance.Element do + TButtonTools.DrawButton(ABuffer, + FButtonRect, + HotTrackFrameColor, + HotTrackInnerLightColor, + HotTrackInnerDarkColor, + HotTrackGradientFromColor, + HotTrackGradientToColor, + HotTrackGradientType, + (FGroupBehaviour in [gbContinuesGroup, gbEndsGroup]), + (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) or (FButtonKind = bkButtonDropdown), + false, + false, + SMALLBUTTON_RADIUS, + ClipRect); + end else +if (FButtonState = bsBtnPressed) then + begin + with FAppearance.Element do + TButtonTools.DrawButton(ABuffer, + FButtonRect, + ActiveFrameColor, + ActiveInnerLightColor, + ActiveInnerDarkColor, + ActiveGradientFromColor, + ActiveGradientToColor, + ActiveGradientType, + (FGroupBehaviour in [gbContinuesGroup, gbEndsGroup]), + (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) or (FButtonKind = bkButtonDropdown), + false, + false, + SMALLBUTTON_RADIUS, + ClipRect); + end else +if (FButtonState in [bsDropdownHottrack, bsDropdownPressed]) then + begin + with FAppearance.Element do + TButtonTools.DrawButton(ABuffer, + FButtonRect, + TColorTools.Brighten(HotTrackFrameColor,40), + TColorTools.Brighten(HotTrackInnerLightColor,40), + TColorTools.Brighten(HotTrackInnerDarkColor,40), + TColorTools.Brighten(HotTrackGradientFromColor,40), + TColorTools.Brighten(HotTrackGradientToColor,40), + HotTrackGradientType, + (FGroupBehaviour in [gbContinuesGroup, gbEndsGroup]), + (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) or (FButtonKind = bkButtonDropdown), + false, + false, + SMALLBUTTON_RADIUS, + ClipRect); + end; +{$ENDREGION} + +// Ikona +if not(FEnabled) then + begin + {$REGION 'Ikona wyłączona'} + if (FImageIndex>=0) and + (FDisabledImages<>nil) and + (FImageIndex=0) and + (FImages<>nil) and + (FImageIndex=0) and + (FImages<>nil) and + (FImageIndex-1 then + x:=x + 2 * SMALLBUTTON_PADDING + SMALLBUTTON_GLYPH_WIDTH else + x:=x + SMALLBUTTON_PADDING; + y:=FButtonRect.Top + (FButtonRect.Height - ABuffer.Canvas.TextHeight('Wy')) div 2; + + TGUITools.DrawText(ABuffer.Canvas, + x, + y, + FCaption, + FontColor, + ClipRect); + end; + +// *** Dropdown *** +if FButtonKind = bkButton then + begin + // Nic dodatkowego do rysowania + end else +if FButtonKind = bkButtonDropdown then + begin + // Tło i ramka + {$REGION 'Rysowanie dropdowna'} + if (FButtonState = bsIdle) and (not(FHideFrameWhenIdle)) then + begin + with FAppearance.Element do + TButtonTools.DrawButton(ABuffer, + FDropdownRect, + IdleFrameColor, + IdleInnerLightColor, + IdleInnerDarkColor, + IdleGradientFromColor, + IdleGradientToColor, + IdleGradientType, + true, + (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]), + false, + false, + SMALLBUTTON_RADIUS, + ClipRect); + end else + if (FButtonState in [bsBtnHottrack, bsBtnPressed]) then + begin + with FAppearance.Element do + TButtonTools.DrawButton(ABuffer, + FDropdownRect, + TColorTools.Brighten(HottrackFrameColor, 40), + TColorTools.Brighten(HottrackInnerLightColor, 40), + TColorTools.Brighten(HottrackInnerDarkColor, 40), + TColorTools.Brighten(HottrackGradientFromColor, 40), + TColorTools.Brighten(HottrackGradientToColor, 40), + HottrackGradientType, + true, + (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]), + false, + false, + SMALLBUTTON_RADIUS, + ClipRect); + + end else + if (FButtonState = bsDropdownHottrack) then + begin + with FAppearance.Element do + TButtonTools.DrawButton(ABuffer, + FDropdownRect, + HottrackFrameColor, + HottrackInnerLightColor, + HottrackInnerDarkColor, + HottrackGradientFromColor, + HottrackGradientToColor, + HottrackGradientType, + true, + (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]), + false, + false, + SMALLBUTTON_RADIUS, + ClipRect); + end else + if (FButtonState = bsDropdownPressed) then + begin + with FAppearance.Element do + TButtonTools.DrawButton(ABuffer, + FDropdownRect, + ActiveFrameColor, + ActiveInnerLightColor, + ActiveInnerDarkColor, + ActiveGradientFromColor, + ActiveGradientToColor, + ActiveGradientType, + true, + (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]), + false, + false, + SMALLBUTTON_RADIUS, + ClipRect); + end; + + // Chevron + if not(FEnabled) then + begin + FontColor:=clNone; + case FButtonState of + bsIdle: FontColor:=TColorTools.ColorToGrayscale(FAppearance.Element.IdleCaptionColor); + bsBtnHottrack, + bsDropdownHottrack : FontColor:=TColorTools.ColorToGrayscale(FAppearance.Element.HotTrackCaptionColor); + bsBtnPressed, + bsDropdownPressed: FontColor:=TColorTools.ColorToGrayscale(FAppearance.ELement.ActiveCaptionColor); + end; + end + else + begin + FontColor:=clNone; + case FButtonState of + bsIdle: FontColor:=FAppearance.Element.IdleCaptionColor; + bsBtnHottrack, + bsDropdownHottrack : FontColor:=FAppearance.Element.HotTrackCaptionColor; + bsBtnPressed, + bsDropdownPressed: FontColor:=FAppearance.ELement.ActiveCaptionColor; + end; + end; + + ABuffer.Canvas.Font.Charset:=DEFAULT_CHARSET; + ABuffer.Canvas.Font.Name:='Marlett'; + ABuffer.Canvas.Font.Size:=8; + ABuffer.Canvas.Font.Style:=[]; + ABuffer.Canvas.Font.Orientation:=0; + + if FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup] then + x:=FDropdownRect.Right - SMALLBUTTON_HALF_BORDER_WIDTH - (SMALLBUTTON_DROPDOWN_WIDTH + ABuffer.Canvas.Textwidth('u')) div 2 + 1 else + x:=FDropdownRect.Right - SMALLBUTTON_BORDER_WIDTH - (SMALLBUTTON_DROPDOWN_WIDTH + ABuffer.Canvas.Textwidth('u')) div 2 + 1; + y:=FDropdownRect.top + (FDropdownRect.height - ABuffer.Canvas.Textheight('u')) div 2; + TGUITools.DrawText(ABuffer.Canvas, x, y, 'u', FontColor, ClipRect); + {$ENDREGION} + end else +if FButtonKind = bkDropdown then + begin + // Chevron dropdown + + if not(FEnabled) then + begin + FontColor:=clNone; + case FButtonState of + bsIdle: FontColor:=TColorTools.ColorToGrayscale(FAppearance.Element.IdleCaptionColor); + bsBtnHottrack, + bsDropdownHottrack : FontColor:=TColorTools.ColorToGrayscale(FAppearance.Element.HotTrackCaptionColor); + bsBtnPressed, + bsDropdownPressed: FontColor:=TColorTools.ColorToGrayscale(FAppearance.ELement.ActiveCaptionColor); + end; + end + else + begin + FontColor:=clNone; + case FButtonState of + bsIdle: FontColor:=FAppearance.Element.IdleCaptionColor; + bsBtnHottrack, + bsDropdownHottrack : FontColor:=FAppearance.Element.HotTrackCaptionColor; + bsBtnPressed, + bsDropdownPressed: FontColor:=FAppearance.ELement.ActiveCaptionColor; + end; + end; + + ABuffer.Canvas.Font.Charset:=DEFAULT_CHARSET; + ABuffer.Canvas.Font.Name:='Marlett'; + ABuffer.Canvas.Font.Size:=8; + ABuffer.Canvas.Font.Style:=[]; + ABuffer.Canvas.Font.Orientation:=0; + + if FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup] then + x:=FButtonRect.Right - SMALLBUTTON_HALF_BORDER_WIDTH - (SMALLBUTTON_DROPDOWN_WIDTH + ABuffer.Canvas.Textwidth('u')) div 2 + 1 else + x:=FButtonRect.Right - SMALLBUTTON_BORDER_WIDTH - (SMALLBUTTON_DROPDOWN_WIDTH + ABuffer.Canvas.Textwidth('u')) div 2 + 1; + y:=FButtonRect.top + (FButtonRect.height - ABuffer.Canvas.Textheight('u')) div 2; + TGUITools.DrawText(ABuffer.Canvas, x, y, 'u', FontColor, ClipRect); + end; + +{$ENDREGION} +end; + +function TSpkSmallButton.GetDropdownPoint: T2DIntPoint; +begin +if FButtonKind in [bkButtonDropdown, bkDropdown] then + result:=T2DIntPoint.Create(FButtonRect.left, FButtonRect.bottom+1) else + result:=T2DIntPoint.Create(0,0); +end; + +function TSpkSmallButton.GetGroupBehaviour: TSpkItemGroupBehaviour; +begin + result:=FGroupBehaviour; +end; + +function TSpkSmallButton.GetSize: TSpkItemSize; +begin + result:=isNormal; +end; + +function TSpkSmallButton.GetTableBehaviour: TSpkItemTableBehaviour; +begin + result:=FTableBehaviour; +end; + +function TSpkSmallButton.GetWidth: integer; + +var BtnRect, DropRect : T2DIntRect; + +begin +result:=-1; + +if FToolbarDispatch=nil then + exit; +if FAppearance=nil then + exit; + +ConstructRects(BtnRect, DropRect); + +if FButtonKind = bkButtonDropdown then + result:=DropRect.Right+1 else + result:=BtnRect.Right+1; +end; + +procedure TSpkSmallButton.SetGroupBehaviour( + const Value: TSpkItemGroupBehaviour); +begin + FGroupBehaviour := Value; + + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyMetricsChanged; +end; + +procedure TSpkSmallButton.SetHideFrameWhenIdle(const Value: boolean); +begin + FHideFrameWhenIdle := Value; + + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; +end; + +procedure TSpkSmallButton.SetImageIndex(const Value: integer); +begin + FImageIndex:=Value; + + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyMetricsChanged; +end; + +procedure TSpkSmallButton.SetShowCaption(const Value: boolean); +begin + FShowCaption := Value; + + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyMetricsChanged; +end; + +procedure TSpkSmallButton.SetTableBehaviour( + const Value: TSpkItemTableBehaviour); +begin + FTableBehaviour := Value; + + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyMetricsChanged; +end; + +initialization + +RegisterClass(TSpkLargeButton); +RegisterClass(TSpkSmallButton); + +finalization + +UnRegisterClass(TSpkLargeButton); +UnRegisterClass(TSpkSmallButton); + +end. diff --git a/components/spktoolbar/SpkToolbar/spkt_Const.pas b/components/spktoolbar/SpkToolbar/spkt_Const.pas new file mode 100644 index 000000000..b0b8b405e --- /dev/null +++ b/components/spktoolbar/SpkToolbar/spkt_Const.pas @@ -0,0 +1,190 @@ +unit spkt_Const; + +(******************************************************************************* +* * +* Plik: spkt_Const.pas * +* Opis: Stałe wykorzystywane do obliczania geometrii toolbara * +* Copyright: (c) 2009 by Spook. Jakiekolwiek użycie komponentu bez * +* uprzedniego uzyskania licencji od autora stanowi złamanie * +* prawa autorskiego! * +* * +*******************************************************************************) + +interface + +const // **************** + // *** Elementy *** + // **************** + + LARGEBUTTON_DROPDOWN_FIELD_SIZE = 29; + LARGEBUTTON_GLYPH_MARGIN = 1; + LARGEBUTTON_CAPTION_HMARGIN = 3; + LARGEBUTTON_MIN_WIDTH = 24; + LARGEBUTTON_RADIUS = 4; + LARGEBUTTON_BORDER_SIZE = 2; + LARGEBUTTON_CHEVRON_HMARGIN = 4; + LARGEBUTTON_CAPTION_TOP_RAIL = 45; + LARGEBUTTON_CAPTION_BOTTOM_RAIL = 58; + + SMALLBUTTON_GLYPH_WIDTH = 16; + SMALLBUTTON_BORDER_WIDTH = 2; + SMALLBUTTON_HALF_BORDER_WIDTH = 1; + SMALLBUTTON_PADDING = 2; + SMALLBUTTON_DROPDOWN_WIDTH = 11; + SMALLBUTTON_RADIUS = 4; + SMALLBUTTON_MIN_WIDTH = 2 * SMALLBUTTON_PADDING + SMALLBUTTON_GLYPH_WIDTH; + + // ******************** + // *** Obszar tafli *** + // ******************** + + /// Maksymalna wysokość obszaru, który może zająć zawartość + /// tafli z elementami + MAX_ELEMENT_HEIGHT = 67; + + /// Wysokość pojedynczego wiersza elementów tafli + PANE_ROW_HEIGHT = 22; + + PANE_FULL_ROW_HEIGHT = 3 * PANE_ROW_HEIGHT; + + /// Wewnętrzny pionowy margines pomiędzy pierwszym elementem a + /// taflą w przypadku wersji jednowierszowej + PANE_ONE_ROW_TOPPADDING = 22; + /// Wewnętrzny pionowy margines pomiędzy ostatnim elementem + /// a taflą w przypadku wersji jednowierszowej + PANE_ONE_ROW_BOTTOMPADDING = 23; + + /// Odległość pomiędzy wierszami w przypadku wersji dwuwierszowej + /// + PANE_TWO_ROWS_VSPACER = 7; + /// Wewnętrzny pionowy margines pomiędzy pierwszym elementem a + /// taflą w przypadku wersji dwuwierszowej + PANE_TWO_ROWS_TOPPADDING = 8; + /// Wewnętrzny pionowy margines pomiędzy ostatnim elementem + /// a taflą w przypadku wersji dwuwierszowej + PANE_TWO_ROWS_BOTTOMPADDING = 8; + + /// Odległość pomiędzy wierszami w przypadku wersji + /// trzywierszowej + PANE_THREE_ROWS_VSPACER = 0; + /// Wewnętrzny pionowy margines pomiędzy pierwszym elementem a + /// taflą w przypadku wersji trzywierszowej + PANE_THREE_ROWS_TOPPADDING = 0; + /// Wewnętrzny pionowy margines pomiędzy ostatnim elementem + /// a taflą w przypadku wersji trzywierszowej + PANE_THREE_ROWS_BOTTOMPADDING = 1; + + PANE_FULL_ROW_TOPPADDING = PANE_THREE_ROWS_TOPPADDING; + + PANE_FULL_ROW_BOTTOMPADDING = PANE_THREE_ROWS_BOTTOMPADDING; + + /// Odległość pomiędzy lewą krawędzią a pierwszym elementem + /// tafli + PANE_LEFT_PADDING = 2; + + /// Odległość pomiędzy ostatnim elementem tafli a prawą krawędzią + /// + PANE_RIGHT_PADDING = 2; + + /// Odległość pomiędzy dwoma kolumnami wewnątrz tafli + PANE_COLUMN_SPACER = 4; + + /// Odległość pomiędzy dwoma osobnymi grupami wewnętrz wiersza + /// w tafli + PANE_GROUP_SPACER = 4; + + // ************* + // *** Tafla *** + // ************* + + /// Wysokość obszaru tytułu tafli + PANE_CAPTION_HEIGHT = 15; + + PANE_CORNER_RADIUS = 3; + + /// Szerokość/wysokość ramki tafli + /// Nie należy zmieniać tej stałej! + PANE_BORDER_SIZE = 2; + + /// Połowa szerokości ramki tafli + /// Nie należy zmieniać tej stałej! + PANE_BORDER_HALF_SIZE = 1; + + /// Wysokość całej tafli (uwzględniając ramkę) + PANE_HEIGHT = MAX_ELEMENT_HEIGHT + PANE_CAPTION_HEIGHT + 2 * PANE_BORDER_SIZE; + + /// Poziomy margines etykiety zakładki + PANE_CAPTION_HMARGIN = 6; + + // *********************** + // *** Obszar zakładki *** + // *********************** + + /// Promień zaokrąglenia zakładki + TAB_CORNER_RADIUS = 4; + + /// Lewy wewnętrzny margines zakładki + TAB_PANE_LEFTPADDING = 2; + /// Prawy wewnętrzny margines zakładki + TAB_PANE_RIGHTPADDING = 2; + /// Górny wewnętrzny margines zakładki + TAB_PANE_TOPPADDING = 2; + /// Dolny wewnętrzny margines zakładki + TAB_PANE_BOTTOMPADDING = 1; + /// Odległość pomiędzy taflami + TAB_PANE_HSPACING = 3; + + /// Szerokość/wysokość ramki zakładki (nie należy zmieniać!) + /// + TAB_BORDER_SIZE = 1; + /// Wysokość zakładki + TAB_HEIGHT = PANE_HEIGHT + TAB_PANE_TOPPADDING + TAB_PANE_BOTTOMPADDING + TAB_BORDER_SIZE; + + // *************** + // *** Toolbar *** + // *************** + + TOOLBAR_BORDER_WIDTH = 1; + + TOOLBAR_CORNER_RADIUS = 3; + + /// Wysokość etykiet z nazwami zakładek + TOOLBAR_TAB_CAPTIONS_HEIGHT = 22; + /// Poziomy margines wewnętrznego tytułu zakładki + TOOLBAR_TAB_CAPTIONS_TEXT_HPADDING = 4; + + TOOLBAR_MIN_TAB_CAPTION_WIDTH = 32; + + /// Sumaryczna wysokość toolbara + TOOLBAR_HEIGHT = TOOLBAR_TAB_CAPTIONS_HEIGHT + + TAB_HEIGHT; + +implementation + +initialization + +{$IFDEF DEBUG} +// Sprawdzanie poprawności + +// Łuk dużego przycisku +assert(LARGEBUTTON_RADIUS * 2 <= LARGEBUTTON_DROPDOWN_FIELD_SIZE); + +// Tafla, wersja z jednym wierszem +assert(PANE_ROW_HEIGHT + + PANE_ONE_ROW_TOPPADDING + + PANE_ONE_ROW_BOTTOMPADDING <= MAX_ELEMENT_HEIGHT); + +// Tafla, wersja z dwoma wierszami +assert(2*PANE_ROW_HEIGHT + + PANE_TWO_ROWS_TOPPADDING + + PANE_TWO_ROWS_VSPACER + + PANE_TWO_ROWS_BOTTOMPADDING <= MAX_ELEMENT_HEIGHT); + +// Tafla, wersja z trzema wierszami +assert(3*PANE_ROW_HEIGHT + + PANE_THREE_ROWS_TOPPADDING + + 2*PANE_THREE_ROWS_VSPACER + + PANE_THREE_ROWS_BOTTOMPADDING <= MAX_ELEMENT_HEIGHT); +{$ENDIF} + +end. diff --git a/components/spktoolbar/SpkToolbar/spkt_Dispatch.pas b/components/spktoolbar/SpkToolbar/spkt_Dispatch.pas new file mode 100644 index 000000000..a10bca7cc --- /dev/null +++ b/components/spktoolbar/SpkToolbar/spkt_Dispatch.pas @@ -0,0 +1,45 @@ +unit spkt_Dispatch; + +(******************************************************************************* +* * +* Plik: spkt_Dispatch.pas * +* Opis: Bazowe klasy dyspozytorów pośredniczących pomiędzy elementami * +* toolbara. * +* Copyright: (c) 2009 by Spook. Jakiekolwiek użycie komponentu bez * +* uprzedniego uzyskania licencji od autora stanowi złamanie * +* prawa autorskiego! * +* * +*******************************************************************************) + +interface + +uses Windows, Classes, Controls, Graphics, + SpkMath; + +type TSpkBaseDispatch = class abstract(TObject) + private + protected + public + end; + +type TSpkBaseAppearanceDispatch = class abstract(TSpkBaseDispatch) + private + protected + public + procedure NotifyAppearanceChanged; virtual; abstract; + end; + +type TSpkBaseToolbarDispatch = class abstract(TSpkBaseAppearanceDispatch) + private + protected + public + procedure NotifyItemsChanged; virtual; abstract; + procedure NotifyMetricsChanged; virtual; abstract; + procedure NotifyVisualsChanged; virtual; abstract; + function GetTempBitmap : TBitmap; virtual; abstract; + function ClientToScreen(Point : T2DIntPoint) : T2DIntPoint; virtual; abstract; + end; + +implementation + +end. diff --git a/components/spktoolbar/SpkToolbar/spkt_Exceptions.pas b/components/spktoolbar/SpkToolbar/spkt_Exceptions.pas new file mode 100644 index 000000000..853d684f6 --- /dev/null +++ b/components/spktoolbar/SpkToolbar/spkt_Exceptions.pas @@ -0,0 +1,24 @@ +unit spkt_Exceptions; + +(******************************************************************************* +* * +* Plik: spkt_Exceptions.pas * +* Opis: Klasy wyjątków toolbara * +* Copyright: (c) 2009 by Spook. Jakiekolwiek użycie komponentu bez * +* uprzedniego uzyskania licencji od autora stanowi złamanie * +* prawa autorskiego! * +* * +*******************************************************************************) + +interface + +uses SysUtils; + +type InternalException = class(Exception); + AssignException = class(Exception); + RuntimeException = class(Exception); + ListException = class(Exception); + +implementation + +end. diff --git a/components/spktoolbar/SpkToolbar/spkt_Items.pas b/components/spktoolbar/SpkToolbar/spkt_Items.pas new file mode 100644 index 000000000..916f8e16a --- /dev/null +++ b/components/spktoolbar/SpkToolbar/spkt_Items.pas @@ -0,0 +1,253 @@ +unit spkt_Items; + +(******************************************************************************* +* * +* Plik: spkt_Items.pas * +* Opis: Moduł zawiera klasę kolekcji elementów tafli. * +* Copyright: (c) 2009 by Spook. Jakiekolwiek użycie komponentu bez * +* uprzedniego uzyskania licencji od autora stanowi złamanie * +* prawa autorskiego! * +* * +*******************************************************************************) + +interface + +uses Windows, Classes, Controls, SysUtils, Dialogs, + SpkXMLParser, + spkt_Appearance, spkt_Dispatch, spkt_BaseItem, spkt_Exceptions, spkt_Types, + spkt_Buttons; + +type TSpkItems = class(TSpkCollection) + private + FToolbarDispatch : TSpkBaseToolbarDispatch; + FAppearance : TSpkToolbarAppearance; + FImages : TImageList; + FDisabledImages : TImageList; + FLargeImages : TImageList; + FDisabledLargeImages : TImageList; + + // *** Gettery i settery *** + procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); + function GetItems(index: integer): TSpkBaseItem; reintroduce; + procedure SetAppearance(const Value: TSpkToolbarAppearance); + procedure SetImages(const Value: TImageList); + procedure SetDisabledImages(const Value : TImageList); + procedure SetLargeImages(const Value : TImageList); + procedure SetDisabledLargeImages(const Value : TImageList); + public + // *** Konstruktor, destruktor *** + constructor Create(RootComponent : TComponent); override; + destructor Destroy; override; + + function AddLargeButton : TSpkLargeButton; + function AddSmallButton : TSpkSmallButton; + + // *** Reakcja na zmiany listy *** + procedure Notify(Item: TComponent; Operation : TOperation); override; + procedure Update; override; + + property Items[index : integer] : TSpkBaseItem read GetItems; default; + property ToolbarDispatch : TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch; + property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance; + property Images : TImageList read FImages write SetImages; + property DisabledImages : TImageList read FDisabledImages write SetDisabledImages; + property LargeImages : TImageList read FLargeImages write SetLargeImages; + property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages; + end; + +implementation + +{ TSpkItems } + +function TSpkItems.AddLargeButton: TSpkLargeButton; + +var Owner, Parent : TComponent; + i: Integer; + +begin +if FRootComponent<>nil then + begin + Owner:=FRootComponent.Owner; + Parent:=FRootComponent; + end +else + begin + Owner:=nil; + Parent:=nil; + end; + +result:=TSpkLargeButton.Create(Owner); +result.Parent:=Parent; + +if FRootComponent<>nil then + begin + i:=1; + while FRootComponent.Owner.FindComponent('SpkLargeButton'+inttostr(i))<>nil do + inc(i); + + result.Name:='SpkLargeButton'+inttostr(i); + end; + +AddItem(result); +end; + +function TSpkItems.AddSmallButton: TSpkSmallButton; + +var Owner, Parent : TComponent; + i: Integer; + +begin +if FRootComponent<>nil then + begin + Owner:=FRootComponent.Owner; + Parent:=FRootComponent; + end +else + begin + Owner:=nil; + Parent:=nil; + end; + +result:=TSpkSmallButton.Create(Owner); +result.Parent:=Parent; + +if FRootComponent<>nil then + begin + i:=1; + while FRootComponent.Owner.FindComponent('SpkSmallButton'+inttostr(i))<>nil do + inc(i); + + result.Name:='SpkSmallButton'+inttostr(i); + end; + +AddItem(result); +end; + +constructor TSpkItems.Create(RootComponent : TComponent); +begin +inherited Create(RootComponent); +FToolbarDispatch:=nil; +FAppearance:=nil; +FImages:=nil; +FDisabledImages:=nil; +FLargeImages:=nil; +FDisabledLargeImages:=nil; +end; + +destructor TSpkItems.Destroy; +begin + inherited Destroy; +end; + +function TSpkItems.GetItems(index: integer): TSpkBaseItem; +begin +result:=TSpkBaseItem(inherited Items[index]); +end; + +procedure TSpkItems.Notify(Item: TComponent; + Operation : TOperation); +begin + inherited Notify(Item, Operation); + + case Operation of + opInsert: begin + // Ustawienie dyspozytora na nil spowoduje, że podczas + // przypisywania własności nie będą wołane metody Notify* + TSpkBaseItem(Item).ToolbarDispatch:=nil; + + TSpkBaseItem(Item).Appearance:=FAppearance; + TSpkBaseItem(Item).Images:=FImages; + TSpkBaseItem(Item).DisabledImages:=FDisabledImages; + TSpkBaseItem(Item).LargeImages:=FLargeImages; + TSpkBaseItem(Item).DisabledLargeImages:=FDisabledLargeImages; + TSpkBaseItem(Item).ToolbarDispatch:=FToolbarDispatch; + end; + opRemove: begin + if not(csDestroying in Item.ComponentState) then + begin + TSpkBaseItem(Item).ToolbarDispatch:=nil; + TSpkBaseItem(Item).Appearance:=nil; + TSpkBaseItem(Item).Images:=nil; + TSpkBaseItem(Item).DisabledImages:=nil; + TSpkBaseItem(Item).LargeImages:=nil; + TSpkBaseItem(Item).DisabledLargeImages:=nil; + end; + end; + end; +end; + +procedure TSpkItems.SetAppearance(const Value: TSpkToolbarAppearance); + +var i: Integer; + +begin + FAppearance := Value; + if self.Count>0 then + for i := 0 to self.count - 1 do + Items[i].Appearance:=FAppearance; +end; + +procedure TSpkItems.SetDisabledImages(const Value: TImageList); + +var i: Integer; + +begin + FDisabledImages := Value; + if self.Count>0 then + for i := 0 to self.count - 1 do + Items[i].DisabledImages:=FDisabledImages; +end; + +procedure TSpkItems.SetDisabledLargeImages(const Value: TImageList); + +var i: Integer; + +begin + FDisabledLargeImages := Value; + if self.Count>0 then + for i := 0 to self.count - 1 do + Items[i].DisabledLargeImages:=FDisabledLargeImages; +end; + +procedure TSpkItems.SetImages(const Value: TImageList); + +var i: Integer; + +begin + FImages := Value; + if self.Count>0 then + for i := 0 to self.count - 1 do + Items[i].Images:=FImages; +end; + +procedure TSpkItems.SetLargeImages(const Value: TImageList); + +var i: Integer; + +begin + FLargeImages := Value; + if self.Count>0 then + for i := 0 to self.count - 1 do + Items[i].LargeImages:=FLargeImages; +end; + +procedure TSpkItems.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); + +var i : integer; + +begin + FToolbarDispatch := Value; + if self.Count>0 then + for i := 0 to self.count - 1 do + Items[i].ToolbarDispatch:=FToolbarDispatch; +end; + +procedure TSpkItems.Update; +begin + inherited Update; + + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyItemsChanged; +end; + +end. diff --git a/components/spktoolbar/SpkToolbar/spkt_Pane.pas b/components/spktoolbar/SpkToolbar/spkt_Pane.pas new file mode 100644 index 000000000..1b6f64fdd --- /dev/null +++ b/components/spktoolbar/SpkToolbar/spkt_Pane.pas @@ -0,0 +1,1065 @@ +unit spkt_Pane; + +(******************************************************************************* +* * +* Plik: spkt_Pane.pas * +* Opis: Komponent tafli toolbara * +* Copyright: (c) 2009 by Spook. Jakiekolwiek użycie komponentu bez * +* uprzedniego uzyskania licencji od autora stanowi złamanie * +* prawa autorskiego! * +* * +*******************************************************************************) + +interface + +uses Windows, Graphics, Controls, Classes, SysUtils, Math, Dialogs, Types, + SpkGraphTools, SpkGUITools, SpkMath, + spkt_Appearance, spkt_Const, spkt_Dispatch, spkt_Exceptions, + spkt_BaseItem, spkt_Items, spkt_Types; + +type TSpkPaneState = (psIdle, psHover); + +type TSpkMousePaneElementType = (peNone, pePaneArea, peItem); + + TSpkMousePaneElement = record + ElementType : TSpkMousePaneElementType; + ElementIndex : integer; + end; + + T2DIntRectArray = array of T2DIntRect; + TSpkPaneItemsLayout = record + Rects : T2DIntRectArray; + Width : integer; + end; + +type TSpkPane = class; + + TSpkPane = class(TSpkComponent) + private + FPaneState : TSpkPaneState; + + FMouseHoverElement : TSpkMousePaneElement; + FMouseActiveElement : TSpkMousePaneElement; + protected + FCaption : string; + FRect : T2DIntRect; + FToolbarDispatch : TSpkBaseToolbarDispatch; + FAppearance : TSpkToolbarAppearance; + FImages : TImageList; + FDisabledImages : TImageList; + FLargeImages : TImageList; + FDisabledLargeImages : TImageList; + FVisible : boolean; + FItems : TSpkItems; + + // *** Generowanie layoutu elementów *** + function GenerateLayout: TSpkPaneItemsLayout; + + // *** Obsługa designtime i DFM *** + procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; + procedure DefineProperties(Filer : TFiler); override; + procedure Loaded; override; + + // *** Gettery i settery *** + procedure SetCaption(const Value: string); + procedure SetVisible(const Value: boolean); + procedure SetAppearance(const Value: TSpkToolbarAppearance); + procedure SetImages(const Value: TImageList); + procedure SetDisabledImages(const Value : TImageList); + procedure SetLargeImages(const Value: TImageList); + procedure SetDisabledLargeImages(const Value : TImageList); + procedure SetRect(ARect : T2DIntRect); + procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); + public + // *** Konstruktor, destruktor *** + constructor Create(AOwner : TComponent); override; + destructor Destroy; override; + + // *** Obsługa gryzonia *** + procedure MouseLeave; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); + procedure MouseMove(Shift: TShiftState; X, Y: Integer); + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); + + // *** Geometria i rysowanie *** + function GetWidth : integer; + procedure Draw(ABuffer : TBitmap; ClipRect : T2DIntRect); + function FindItemAt(x, y: integer): integer; + + // *** Obsługa elementów *** + procedure FreeingItem(AItem : TSpkBaseItem); + + property ToolbarDispatch : TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch; + property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance; + property Rect : T2DIntRect read FRect write SetRect; + property Images : TImageList read FImages write SetImages; + property DisabledImages : TImageList read FDisabledImages write SetDisabledImages; + property LargeImages : TImageList read FLargeImages write SetLargeImages; + property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages; + property Items : TSpkItems read FItems; + published + property Caption : string read FCaption write SetCaption; + property Visible : boolean read FVisible write SetVisible; + end; + +type TSpkPanes = class(TSpkCollection) + private + protected + FToolbarDispatch : TSpkBaseToolbarDispatch; + FAppearance : TSpkToolbarAppearance; + FImages : TImageList; + FDisabledImages : TImageList; + FLargeImages : TImageList; + FDisabledLargeImages : TImageList; + + // *** Gettery i settery *** + procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); + function GetItems(index: integer): TSpkPane; reintroduce; + procedure SetAppearance(const Value: TSpkToolbarAppearance); + procedure SetImages(const Value: TImageList); + procedure SetDisabledImages(const Value : TImageList); + procedure SetLargeImages(const Value: TImageList); + procedure SetDisabledLargeImages(const Value : TImageList); + public + // *** Konstruktor, destruktor *** + constructor Create(RootComponent : TComponent); override; + destructor Destroy; override; + + // *** Dodawanie i wstawianie elementów *** + function Add : TSpkPane; + function Insert(index : integer) : TSpkPane; + + // *** Reakcja na zmiany listy *** + procedure Notify(Item: TComponent; Operation : TOperation); override; + procedure Update; override; + + property Items[index : integer] : TSpkPane read GetItems; default; + property ToolbarDispatch : TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch; + property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance; + property Images : TImageList read FImages write SetImages; + property DisabledImages : TImageList read FDisabledImages write SetDisabledImages; + property LargeImages : TImageList read FLargeImages write SetLargeImages; + property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages; + end; + +implementation + +{ TSpkPane } + +procedure TSpkPane.SetRect(ARect: T2DIntRect); + +var Pt : T2DIntPoint; + i : integer; + Layout : TSpkPaneItemsLayout; + +begin +FRect:=ARect; + +// Obliczamy layout +Layout:=GenerateLayout; + +Pt:=T2DIntPoint.create(ARect.left + PANE_BORDER_SIZE + PANE_LEFT_PADDING, ARect.top + PANE_BORDER_SIZE); +if length(Layout.Rects)>0 then + begin + for i := 0 to high(Layout.Rects) do + FItems[i].Rect:=Layout.Rects[i] + Pt; + end; +end; + +procedure TSpkPane.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); + +begin + FToolbarDispatch := Value; + FItems.ToolbarDispatch:=FToolbarDispatch; +end; + +constructor TSpkPane.Create(AOwner : TComponent); +begin + inherited Create(AOwner); + + FPaneState:=psIdle; + FMouseHoverElement.ElementType:=peNone; + FMouseHoverElement.ElementIndex:=-1; + FMouseActiveElement.ElementType:=peNone; + FMouseActiveElement.ElementIndex:=-1; + + FCaption:='Pane'; + FRect:=T2DIntRect.create(0,0,0,0); + + FToolbarDispatch:=nil; + FAppearance:=nil; + FImages:=nil; + FDisabledImages:=nil; + FLargeImages:=nil; + FDisabledLargeImages:=nil; + + FVisible:=true; + + FItems:=TSpkItems.Create(self); + FItems.ToolbarDispatch:=FToolbarDispatch; + FItems.Appearance:=FAppearance; +end; + +procedure TSpkPane.DefineProperties(Filer: TFiler); +begin + inherited DefineProperties(Filer); + + Filer.DefineProperty('Items',FItems.ReadNames,FItems.WriteNames,true); +end; + +destructor TSpkPane.Destroy; +begin + FItems.Free; + + inherited Destroy; +end; + +procedure TSpkPane.Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); + +var x: Integer; + y: Integer; + BgFromColor, BgToColor, CaptionColor, FontColor, BorderLightColor, + BorderDarkColor : TColor; + i: Integer; + +begin +// W niektórych warunkach nie jesteśmy w stanie rysować: +// * Brak dyspozytora +if FToolbarDispatch=nil then + exit; +// * Brak appearance +if FAppearance=nil then + exit; + +if FPaneState = psIdle then + begin + // psIdle + BgFromColor:=FAppearance.Pane.GradientFromColor; + BgToColor:=FAppearance.Pane.GradientToColor; + CaptionColor:=FAppearance.Pane.CaptionBgColor; + FontColor:=FAppearance.Pane.CaptionFont.Color; + BorderLightColor:=FAppearance.Pane.BorderLightColor; + BorderDarkColor:=FAppearance.Pane.BorderDarkColor; + end else + begin + // psHover + BgFromColor:=TColorTools.Brighten(FAppearance.Pane.GradientFromColor,20); + BgToColor:=TColorTools.Brighten(FAppearance.Pane.GradientToColor,20); + CaptionColor:=TColorTools.Brighten(FAppearance.Pane.CaptionBgColor,20); + FontColor:=TColorTools.Brighten(FAppearance.Pane.CaptionFont.Color,20); + BorderLightColor:=TColorTools.Brighten(FAppearance.Pane.BorderLightColor,20); + BorderDarkColor:=TColorTools.Brighten(FAppearance.Pane.BorderDarkColor,20); + end; + +// Tło +TGuiTools.DrawRoundRect(ABuffer.Canvas, + T2DIntRect.Create(FRect.left, + FRect.top, + FRect.right - PANE_BORDER_HALF_SIZE, + FRect.Bottom - PANE_BORDER_HALF_SIZE), + PANE_CORNER_RADIUS, + BgFromColor, + BgToColor, + FAppearance.Pane.GradientType, + ClipRect); + +// Tło etykiety tafli +TGuiTools.DrawRoundRect(ABuffer.Canvas, + T2DIntRect.Create(FRect.Left, + FRect.Bottom - PANE_CAPTION_HEIGHT - PANE_BORDER_HALF_SIZE, + FRect.right - PANE_BORDER_HALF_SIZE, + FRect.bottom - PANE_BORDER_HALF_SIZE), + PANE_CORNER_RADIUS, + CaptionColor, + clNone, + bkSolid, + ClipRect, + false, + false, + true, + true); + +// Etykieta tafli +ABuffer.Canvas.Font.assign(FAppearance.Pane.CaptionFont); +x:=FRect.left + (FRect.width - ABuffer.Canvas.TextWidth(FCaption)) div 2; +y:=FRect.Bottom - PANE_BORDER_SIZE - PANE_CAPTION_HEIGHT + 1 + + (PANE_CAPTION_HEIGHT - ABuffer.Canvas.TextHeight('Wy')) div 2; + +TGUITools.DrawText(ABuffer.Canvas, + x, + y, + FCaption, + FontColor, + ClipRect); + +// Ramki +TGUITools.DrawAARoundFrame(ABuffer, + T2DIntRect.create(FRect.left+1, + FRect.top+1, + FRect.Right, + FRect.bottom), + PANE_CORNER_RADIUS, + BorderLightColor, + ClipRect); +TGUITools.DrawAARoundFrame(ABuffer, + T2DIntRect.create(FRect.left, + FRect.top, + FRect.Right-1, + FRect.bottom-1), + PANE_CORNER_RADIUS, + BorderDarkColor, + ClipRect); + +// Elementy +if FItems.Count>0 then + for i := 0 to FItems.Count - 1 do + begin + if FItems[i].Visible then + Fitems[i].Draw(ABuffer, ClipRect); + end; +end; + +function TSpkPane.FindItemAt(x, y : integer) : integer; + +var i : integer; + +begin +result:=-1; +i:=FItems.count-1; +while (i>=0) and (result=-1) do + begin + if FItems[i].Visible then + begin + if FItems[i].Rect.Contains(T2DIntVector.create(x,y)) then + result:=i; + end; + dec(i); + end; +end; + +procedure TSpkPane.FreeingItem(AItem: TSpkBaseItem); +begin +FItems.RemoveReference(AItem); +end; + +function TSpkPane.GenerateLayout: TSpkPaneItemsLayout; + +type TLayoutRow = array of integer; + TLayoutColumn = array of TLayoutRow; + TLayout = array of TLayoutColumn; + +var Layout : TLayout; + CurrentColumn : integer; + CurrentRow : integer; + CurrentItem : integer; + c, r, i: Integer; + ItemTableBehaviour : TSpkItemTableBehaviour; + ItemGroupBehaviour : TSpkItemGroupBehaviour; + ItemSize : TSpkItemSize; + ForceNewColumn : boolean; + LastX : integer; + MaxRowX : integer; + ColumnX : integer; + rows: Integer; + ItemWidth: Integer; + tmpRect : T2DIntRect; + +begin +setlength(result.Rects,FItems.count); +result.Width:=0; + +if FItems.count=0 then + exit; + +// Notatka: algorytm jest skonstruowany w ten sposób, że trójka: CurrentColumn, +// CurrentRow oraz CurrentItem wskazuje na element, którego jeszcze nie +// ma (zaraz za ostatnio dodanym elementem). + +setlength(Layout,1); +CurrentColumn:=0; + +setlength(Layout[CurrentColumn],1); +CurrentRow:=0; + +setlength(Layout[CurrentColumn][CurrentRow],0); +CurrentItem:=0; + +ForceNewColumn:=false; + +for i := 0 to FItems.count - 1 do + begin + ItemTableBehaviour := FItems[i].GetTableBehaviour; + ItemSize := FItems[i].GetSize; + + // Rozpoczęcie nowej kolumny? + if (i=0) or + (ItemSize = isLarge) or + (ItemTableBehaviour = tbBeginsColumn) or + ((ItemTableBehaviour = tbBeginsRow) and (CurrentRow = 2)) or + (ForceNewColumn) then + begin + // Jeśli już jesteśmy na początku nowej kolumny, nie ma nic do roboty. + if (CurrentRow<>0) or (CurrentItem<>0) then + begin + setlength(Layout, length(Layout)+1); + CurrentColumn:=high(Layout); + + setlength(Layout[CurrentColumn], 1); + CurrentRow:=0; + + setlength(Layout[CurrentColumn][CurrentRow],0); + CurrentItem:=0; + end; + end else + // Rozpoczęcie nowego wiersza? + if (ItemTableBehaviour = tbBeginsRow) then + begin + // Jeśli już jesteśmy na początku nowego wiersza, nie ma nic do roboty. + if CurrentItem <> 0 then + begin + setlength(Layout[CurrentColumn], length(Layout[CurrentColumn])+1); + inc(CurrentRow); + CurrentItem:=0; + end; + end; + + ForceNewColumn:=ItemSize = isLarge; + + // Jeśli element jest widoczny, dodajemy go w aktualnej kolumnie i aktualnym + // wierszu. + if FItems[i].Visible then + begin + setlength(Layout[CurrentColumn][CurrentRow], length(Layout[CurrentColumn][CurrentRow])+1); + Layout[CurrentColumn][CurrentRow][CurrentItem]:=i; + + inc(CurrentItem); + end; + end; + +// W tym miejscu mamy gotowy layout. Teraz trzeba obliczyć pozycje i rozmiary +// Rectów. + +// Najpierw wypełniamy je pustymi danymi, które zapełnią miejsce elementów +// niewidocznych. +for i := 0 to FItems.count - 1 do + result.Rects[i]:=T2DIntRect.create(-1, -1, -1, -1); + +MaxRowX:=0; + +// Teraz iterujemy po layoucie, ustalając recty. +if length(Layout)>0 then + for c := 0 to high(Layout) do + begin + if c>0 then + begin + LastX:=MaxRowX + PANE_COLUMN_SPACER; + MaxRowX:=LastX; + end + else + begin + LastX:=MaxRowX; + end; + + ColumnX:=LastX; + + rows:=length(Layout[c]); + if rows>0 then + for r := 0 to rows - 1 do + begin + LastX:=ColumnX; + + if length(Layout[c][r])>0 then + for i := 0 to high(Layout[c][r]) do + begin + ItemGroupBehaviour:=FItems[Layout[c][r][i]].GetGroupBehaviour; + ItemSize:=FItems[Layout[c][r][i]].GetSize; + ItemWidth:=FItems[Layout[c][r][i]].GetWidth; + + if ItemSize = isLarge then + begin + tmpRect.top:=PANE_FULL_ROW_TOPPADDING; + tmpRect.bottom:=tmpRect.top + PANE_FULL_ROW_HEIGHT - 1; + tmpRect.left:=LastX; + tmpRect.right:=LastX + ItemWidth - 1; + + LastX:=tmpRect.right + 1; + if LastX>MaxRowX then + MaxRowX:=LastX; + end + else + begin + if ItemGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then + begin + tmpRect.Left:=LastX; + tmpRect.right:=tmpRect.Left + ItemWidth - 1; + end + else + begin + // Jeśli element nie jest pierwszy, musi zostać + // odsunięty marginesem od poprzedniego + if i>0 then + tmpRect.Left:=LastX + PANE_GROUP_SPACER else + tmpRect.Left:=LastX; + tmpRect.right:=tmpRect.Left + ItemWidth - 1; + end; + + {$REGION 'Obliczanie tmpRect.top i bottom'} + case rows of + 1 : begin + tmpRect.top:=PANE_ONE_ROW_TOPPADDING; + tmpRect.bottom:=tmpRect.top + PANE_ROW_HEIGHT - 1; + end; + 2 : begin + case r of + 0 : begin + tmpRect.top:=PANE_TWO_ROWS_TOPPADDING; + tmpRect.bottom:=tmpRect.top + PANE_ROW_HEIGHT - 1; + end; + 1 : begin + tmpRect.top:=PANE_TWO_ROWS_TOPPADDING + PANE_ROW_HEIGHT + PANE_TWO_ROWS_VSPACER; + tmpRect.bottom:=tmpRect.top + PANE_ROW_HEIGHT - 1; + end; + end; + end; + 3 : begin + case r of + 0 : begin + tmpRect.top:=PANE_THREE_ROWS_TOPPADDING; + tmpRect.bottom:=tmpRect.top + PANE_ROW_HEIGHT - 1; + end; + 1 : begin + tmpRect.top:=PANE_THREE_ROWS_TOPPADDING + PANE_ROW_HEIGHT + PANE_THREE_ROWS_VSPACER; + tmpRect.bottom:=tmpRect.top + PANE_ROW_HEIGHT - 1; + end; + 2 : begin + tmpRect.top:=PANE_THREE_ROWS_TOPPADDING + 2 * PANE_ROW_HEIGHT + 2 * PANE_THREE_ROWS_VSPACER; + tmpRect.bottom:=tmpRect.top + PANE_ROW_HEIGHT - 1; + end; + end; + end; + end; + {$ENDREGION} + + LastX:=tmpRect.right + 1; + if LastX>MaxRowX then + MaxRowX:=LastX; + end; + + Result.Rects[Layout[c][r][i]]:=tmpRect; + end; + end; + end; +// W tym miejscu MaxRowX wskazuje na pierwszy piksel za najbardziej wysuniętym +// w prawo elementem - ergo jest równy szerokości całego layoutu. +Result.Width:=MaxRowX; +end; + +procedure TSpkPane.GetChildren(Proc: TGetChildProc; Root: TComponent); +var + i: Integer; +begin +inherited; + +if FItems.Count>0 then + for i := 0 to FItems.Count - 1 do + Proc(FItems.Items[i]); +end; + +function TSpkPane.GetWidth: integer; + +var tmpBitmap : TBitmap; + PaneCaptionWidth, PaneElementsWidth : integer; + TextW : integer; + ElementsW : integer; + Layout : TSpkPaneItemsLayout; + +begin +// Przygotowywanie... +result:=-1; +if FToolbarDispatch=nil then + exit; +if FAppearance=nil then + exit; + +tmpBitmap:=FToolbarDispatch.GetTempBitmap; +if tmpBitmap=nil then + exit; +tmpBitmap.Canvas.font.assign(FAppearance.Pane.CaptionFont); + +// *** Minimalna szerokość tafli (tekstu) *** +TextW:=tmpBitmap.Canvas.TextWidth(FCaption); +PaneCaptionWidth:=2*PANE_BORDER_SIZE + + 2*PANE_CAPTION_HMARGIN + + TextW; + +// *** Szerokość elementów tafli *** +Layout:=GenerateLayout; +ElementsW:=Layout.Width; +PaneElementsWidth:=PANE_BORDER_SIZE + PANE_LEFT_PADDING + ElementsW + PANE_RIGHT_PADDING + PANE_BORDER_SIZE; + +// *** Ustawianie szerokości tafli *** +result:=max(PaneCaptionWidth, PaneElementsWidth); +end; + +procedure TSpkPane.Loaded; +begin + inherited; + if FItems.ListState = lsNeedsProcessing then + FItems.ProcessNames(self.Owner); +end; + +procedure TSpkPane.MouseDown(Button: TMouseButton; Shift: TShiftState; X, + Y: Integer); +begin +if FMouseActiveElement.ElementType = peItem then + begin + if FMouseActiveElement.ElementIndex<>-1 then + FItems[FMouseActiveElement.ElementIndex].MouseDown(Button, Shift, X, Y); + end else +if FMouseActiveElement.ElementType = pePaneArea then + begin + FPaneState:=psHover; + end else +if FMouseActiveElement.ElementType = peNone then + begin + if FMouseHoverElement.ElementType = peItem then + begin + if FMouseHoverElement.ElementIndex<>-1 then + begin + FMouseActiveElement.ElementType:=peItem; + FMouseActiveElement.ElementIndex:=FMouseHoverElement.ElementIndex; + + FItems[FMouseHoverElement.ElementIndex].MouseDown(Button, Shift, X, Y); + end + else + begin + FMouseActiveElement.ElementType:=pePaneArea; + FMouseActiveElement.ElementIndex:=-1; + end; + end else + if FMouseHoverElement.ElementType = pePaneArea then + begin + FMouseActiveElement.ElementType:=pePaneArea; + FMouseActiveElement.ElementIndex:=-1; + + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia. + end; + end; +end; + +procedure TSpkPane.MouseLeave; +begin +if FMouseActiveElement.ElementType = peNone then + begin + if FMouseHoverElement.ElementType = peItem then + begin + if FMouseHoverElement.ElementIndex<>-1 then + FItems[FMouseHoverElement.ElementIndex].MouseLeave; + end else + if FMouseHoverElement.ElementType = pePaneArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia. + end; + end; + +FMouseHoverElement.ElementType:=peNone; +FMouseHoverElement.ElementIndex:=-1; + +// Niezależnie od tego, który element był aktywny / pod myszą, trzeba +// wygasić HotTrack. +if FPaneState<>psIdle then + begin + FPaneState:=psIdle; + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; +end; + +procedure TSpkPane.MouseMove(Shift: TShiftState; X, Y: Integer); + +var i : integer; + NewMouseHoverElement : TSpkMousePaneElement; + +begin +// MouseMove jest wywoływany tylko, gdy tafla jest aktywna, bądź gdy +// mysz rusza się wewnątrz jej obszaru. Wobec tego zawsze należy +// w tej sytuacji zapalić HotTrack. + +if FPaneState = psIdle then + begin + FPaneState:=psHover; + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + +// Szukamy obiektu pod myszą +i:=FindItemAt(x, y); +if i<>-1 then + begin + NewMouseHoverElement.ElementType:=peItem; + NewMouseHoverElement.ElementIndex:=i; + end else +if (X>=FRect.left) and (Y>=FRect.top) and + (X<=FRect.right) and (Y<=FRect.bottom) then + begin + NewMouseHoverElement.ElementType:=pePaneArea; + NewMouseHoverElement.ElementIndex:=-1; + end else + begin + NewMouseHoverElement.ElementType:=peNone; + NewMouseHoverElement.ElementIndex:=-1; + end; + +if FMouseActiveElement.ElementType = peItem then + begin + if FMouseActiveElement.ElementIndex<>-1 then + FItems[FMouseActiveElement.ElementIndex].MouseMove(Shift, X, Y); + end else +if FMouseActiveElement.ElementType = pePaneArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia + end else +if FMouseActiveElement.ElementType = peNone then + begin + // Jeśli element pod myszą się zmienia, informujemy poprzedni element o + // tym, że mysz opuszcza jego obszar + if (NewMouseHoverElement.ElementType<>FMouseHoverElement.ELementType) or + (NewMouseHoverElement.ElementIndex<>FMouseHoverElement.ElementIndex) then + begin + if FMouseHoverElement.ElementType = peItem then + begin + if FMouseHoverElement.ElementIndex<>-1 then + FItems[FMouseHoverElement.ElementIndex].MouseLeave; + end else + if FMouseHoverElement.ElementType = pePaneArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia + end; + end; + + if NewMouseHoverElement.ElementType = peItem then + begin + if NewMouseHoverElement.ElementIndex<>-1 then + FItems[NewMouseHoverElement.ElementIndex].MouseMove(Shift, X, Y); + end else + if NewMouseHoverElement.ElementType = pePaneArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia + end; + end; + +FMouseHoverElement:=NewMouseHoverElement; +end; + +procedure TSpkPane.MouseUp(Button: TMouseButton; Shift: TShiftState; X, + Y: Integer); + +var ClearActive : boolean; + +begin +ClearActive:=not(ssLeft in Shift) and not(ssMiddle in Shift) and not(ssRight in Shift); + +if FMouseActiveElement.ElementType = peItem then + begin + if FMouseActiveElement.ElementIndex<>-1 then + FItems[FMouseActiveElement.ElementIndex].MouseUp(Button, Shift, X, Y); + end else +if FMouseActiveElement.ElementType = pePaneArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia. + end; + +if ClearActive and + (FMouseActiveElement.ElementType<>FMouseHoverElement.ElementType) or + (FMouseActiveElement.ElementIndex<>FMouseHoverElement.ElementIndex) then + begin + if FMouseActiveElement.ElementType = peItem then + begin + if FMouseActiveElement.ElementIndex<>-1 then + FItems[FMouseActiveElement.ElementIndex].MouseLeave; + end else + if FMouseActiveElement.ElementType = pePaneArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia. + end; + + if FMouseHoverElement.ElementType = peItem then + begin + if FMouseActiveElement.ElementIndex<>-1 then + FItems[FMouseActiveElement.ElementIndex].MouseMove(Shift, X, Y); + end else + if FMouseHoverElement.ElementType = pePaneArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia. + end else + if FMouseHoverElement.ElementType = peNone then + begin + if FPaneState<>psIdle then + begin + FPaneState:=psIdle; + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end; + end; + +if ClearActive then + begin + FMouseActiveElement.ElementType:=peNone; + FMouseActiveElement.ElementIndex:=-1; + end; +end; + +procedure TSpkPane.SetAppearance(const Value: TSpkToolbarAppearance); +begin + FAppearance := Value; + FItems.Appearance := Value; +end; + +procedure TSpkPane.SetCaption(const Value: string); +begin + FCaption := Value; + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyMetricsChanged; +end; + +procedure TSpkPane.SetDisabledImages(const Value: TImageList); +begin + FDisabledImages := Value; + FItems.DisabledImages:=FDisabledImages; +end; + +procedure TSpkPane.SetDisabledLargeImages(const Value: TImageList); +begin + FDisabledLargeImages := Value; + FItems.DisabledLargeImages:=FDisabledLargeImages; +end; + +procedure TSpkPane.SetImages(const Value: TImageList); +begin + FImages := Value; + FItems.Images:=FImages; +end; + +procedure TSpkPane.SetLargeImages(const Value: TImageList); +begin + FLargeImages := Value; + FItems.LargeImages:=FLargeImages; +end; + +procedure TSpkPane.SetVisible(const Value: boolean); +begin + FVisible := Value; + + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyItemsChanged; +end; + +{ TSpkPanes } + +function TSpkPanes.Add: TSpkPane; + +var Owner, Parent : TComponent; + i: Integer; + +begin +if FRootComponent<>nil then + begin + Owner:=FRootComponent.Owner; + Parent:=FRootComponent; + end +else + begin + Owner:=nil; + Parent:=nil; + end; + +result:=TSpkPane.Create(Owner); +result.Parent:=Parent; + +if FRootComponent<>nil then + begin + i:=1; + while FRootComponent.Owner.FindComponent('SpkPane'+inttostr(i))<>nil do + inc(i); + + result.Name:='SpkPane'+inttostr(i); + end; + +AddItem(result); +end; + +constructor TSpkPanes.Create(RootComponent : TComponent); +begin + inherited Create(RootComponent); + FToolbarDispatch:=nil; + FAppearance:=nil; + FImages:=nil; + FDisabledImages:=nil; + FLargeImages:=nil; + FDisabledLargeImages:=nil; +end; + +destructor TSpkPanes.Destroy; +begin + inherited Destroy; +end; + +function TSpkPanes.GetItems(index: integer): TSpkPane; +begin + result:=TSpkPane(inherited Items[index]); +end; + +function TSpkPanes.Insert(index: integer): TSpkPane; + +var Owner, Parent : TComponent; + i: Integer; + +begin +if (index<0) or (index>self.Count) then + raise InternalException.create('TSpkPanes.Insert: Nieprawidłowy indeks!'); + +if FRootComponent<>nil then + begin + Owner:=FRootComponent.Owner; + Parent:=FRootComponent; + end +else + begin + Owner:=nil; + Parent:=nil; + end; + +result:=TSpkPane.Create(Owner); +result.Parent:=Parent; + +if FRootComponent<>nil then + begin + i:=1; + while FRootComponent.Owner.FindComponent('SpkPane'+inttostr(i))<>nil do + inc(i); + + result.Name:='SpkPane'+inttostr(i); + end; + +InsertItem(index,result); +end; + +procedure TSpkPanes.Notify(Item: TComponent; + Operation : TOperation); +begin + inherited Notify(Item, Operation); + + case Operation of + opInsert: begin + // Ustawienie dyspozytora na nil spowoduje, że podczas + // przypisywania własności nie będą wołane metody Notify* + TSpkPane(Item).ToolbarDispatch:=nil; + + TSpkPane(Item).Appearance:=FAppearance; + TSpkPane(Item).Images:=FImages; + TSpkPane(Item).DisabledImages:=FDisabledImages; + TSpkPane(Item).LargeImages:=FLargeImages; + TSpkPane(Item).DisabledLargeImages:=FDisabledLargeImages; + TSpkPane(Item).ToolbarDispatch:=FToolbarDispatch; + end; + opRemove: begin + if not(csDestroying in Item.ComponentState) then + begin + TSpkPane(Item).ToolbarDispatch:=nil; + TSpkPane(Item).Appearance:=nil; + TSpkPane(Item).Images:=nil; + TSpkPane(Item).DisabledImages:=nil; + TSpkPane(Item).LargeImages:=nil; + TSpkPane(Item).DisabledLargeImages:=nil; + end; + end; + end; +end; + +procedure TSpkPanes.SetImages(const Value: TImageList); +var + I: Integer; +begin + FImages := Value; + if self.Count>0 then + for I := 0 to self.count - 1 do + Items[i].Images:=Value; +end; + +procedure TSpkPanes.SetLargeImages(const Value: TImageList); +var + I: Integer; +begin + FLargeImages := Value; + if self.Count>0 then + for I := 0 to self.count - 1 do + Items[i].LargeImages:=Value; +end; + +procedure TSpkPanes.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); + +var i : integer; + +begin + FToolbarDispatch := Value; + if self.Count>0 then + for i := 0 to self.count - 1 do + Items[i].ToolbarDispatch:=FToolbarDispatch; +end; + +procedure TSpkPanes.SetAppearance(const Value: TSpkToolbarAppearance); + +var i: Integer; + +begin + FAppearance := Value; + if self.Count>0 then + for i := 0 to self.count - 1 do + Items[i].Appearance:=FAppearance; + + if FToolbarDispatch<>nil then + FToolbarDispatch.NotifyMetricsChanged; +end; + +procedure TSpkPanes.SetDisabledImages(const Value: TImageList); + +var I: Integer; + +begin + FDisabledImages := Value; + if self.Count>0 then + for I := 0 to self.count - 1 do + Items[i].DisabledImages:=Value; +end; + +procedure TSpkPanes.SetDisabledLargeImages(const Value: TImageList); + +var + I: Integer; +begin + FDisabledLargeImages := Value; + if self.Count>0 then + for I := 0 to self.count - 1 do + Items[i].DisabledLargeImages:=Value; +end; + +procedure TSpkPanes.Update; +begin + inherited Update; + + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyItemsChanged; +end; + +initialization + +RegisterClass(TSpkPane); + +finalization + +UnregisterClass(TSpkPane); + +end. diff --git a/components/spktoolbar/SpkToolbar/spkt_Tab.pas b/components/spktoolbar/SpkToolbar/spkt_Tab.pas new file mode 100644 index 000000000..b39dd1475 --- /dev/null +++ b/components/spktoolbar/SpkToolbar/spkt_Tab.pas @@ -0,0 +1,805 @@ +unit spkt_Tab; + +(******************************************************************************* +* * +* Plik: spkt_Tab.pas * +* Opis: Komponent zakładki toolbara * +* Copyright: (c) 2009 by Spook. Jakiekolwiek użycie komponentu bez * +* uprzedniego uzyskania licencji od autora stanowi złamanie * +* prawa autorskiego! * +* * +*******************************************************************************) + +interface + +uses Windows, Graphics, Controls, Classes, SysUtils, + SpkGraphTools, SpkGUITools, SpkMath, + spkt_Appearance, spkt_Const, spkt_Dispatch, spkt_Exceptions, + spkt_Pane, spkt_Types; + +type TSpkTab = class; + + TSpkMouseTabElementType = (etNone, etTabArea, etPane); + + TSpkMouseTabElement = record + ElementType : TSpkMouseTabElementType; + ElementIndex : integer; + end; + + TSpkTabAppearanceDispatch = class(TSpkBaseAppearanceDispatch) + private + FTab : TSpkTab; + protected + public + // *** Konstruktor *** + constructor Create(ATab : TSpkTab); + + // *** Implementacja metod odziedziczonych po TSpkBaseTabDispatch *** + procedure NotifyAppearanceChanged; override; + end; + + TSpkTab = class(TSpkComponent) + private + FAppearanceDispatch : TSpkTabAppearanceDispatch; + FAppearance : TSpkToolbarAppearance; + + FMouseHoverElement : TSpkMouseTabElement; + FMouseActiveElement : TSpkMouseTabElement; + protected + FToolbarDispatch : TSpkBaseToolbarDispatch; + FCaption : string; + FVisible : boolean; + FOverrideAppearance : boolean; + FCustomAppearance : TSpkToolbarAppearance; + + FPanes : TSpkPanes; + FRect : T2DIntRect; + + FImages : TImageList; + FDisabledImages : TImageList; + FLargeImages : TImageList; + FDisabledLargeImages : TImageList; + + // *** Makro ustawia odpowiednie appearance taflom *** + procedure SetPaneAppearance; inline; + + // *** Wyszukiwanie tafli *** + function FindPaneAt(x, y : integer) : integer; + + // *** Obsługa designtime i DFM *** + procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; + procedure DefineProperties(Filer : TFiler); override; + procedure Loaded; override; + + // *** Gettery i settery *** + procedure SetCaption(const Value: string); + procedure SetCustomAppearance(const Value: TSpkToolbarAppearance); + procedure SetOverrideAppearance(const Value: boolean); + procedure SetVisible(const Value: boolean); + procedure SetAppearance(const Value: TSpkToolbarAppearance); + procedure SetImages(const Value: TImageList); + procedure SetDisabledImages(const Value : TImageList); + procedure SetLargeImages(const Value : TImageList); + procedure SetDisabledLargeImages(const Value : TImageList); + procedure SetRect(ARect : T2DIntRect); + procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); + public + // *** Konstruktor, destruktor *** + constructor Create(AOwner : TComponent); override; + destructor Destroy; override; + + // *** Geometria, obsługa tafli, rysowanie *** + function AtLeastOnePaneVisible: boolean; + procedure Draw(ABuffer : TBitmap; AClipRect : T2DIntRect); + + // *** Obsługa gryzonia *** + procedure MouseLeave; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); + procedure MouseMove(Shift: TShiftState; X, Y: Integer); + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); + + // *** Obsługa zdarzeń dyspozytora *** + procedure NotifyAppearanceChanged; + + // *** Obsługa elementów *** + procedure FreeingPane(APane : TSpkPane); + + property ToolbarDispatch : TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch; + property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance; + + property Panes : TSpkPanes read FPanes; + property Rect : T2DIntRect read FRect write SetRect; + property Images : TImageList read FImages write SetImages; + property DisabledImages : TImageList read FDisabledImages write SetDisabledImages; + property LargeImages : TImageList read FLargeImages write SetLargeImages; + property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages; + published + property CustomAppearance : TSpkToolbarAppearance read FCustomAppearance write SetCustomAppearance; + property Caption : string read FCaption write SetCaption; + property OverrideAppearance : boolean read FOverrideAppearance write SetOverrideAppearance; + property Visible : boolean read FVisible write SetVisible; + end; + +type TSpkTabs = class(TSpkCollection) + private + protected + FToolbarDispatch : TSpkBaseToolbarDispatch; + FAppearance : TSpkToolbarAppearance; + FImages : TImageList; + FDisabledImages : TImageList; + FLargeImages : TImageList; + FDisabledLargeImages : TImageList; + + procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); + function GetItems(index: integer): TSpkTab; reintroduce; + procedure SetAppearance(const Value: TSpkToolbarAppearance); + procedure SetImages(const Value: TImageList); + procedure SetDisabledImages(const Value : TImageList); + procedure SetLargeImages(const Value : TImageList); + procedure SetDisabledLargeImages(const Value : TImageList); + public + constructor Create(RootComponent : TComponent); override; + destructor Destroy; override; + + function Add : TSpkTab; + function Insert(index : integer) : TSpkTab; + + procedure Notify(Item: TComponent; Operation : TOperation); override; + procedure Update; override; + + property Items[index : integer] : TSpkTab read GetItems; default; + property ToolbarDispatch : TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch; + property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance; + property Images : TImageList read FImages write SetImages; + property DisabledImages : TImageList read FDisabledImages write SetDisabledImages; + property LargeImages : TImageList read FLargeImages write SetLargeImages; + property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages; + end; + +implementation + +{ TSpkTabDispatch } + +constructor TSpkTabAppearanceDispatch.Create(ATab: TSpkTab); +begin + inherited Create; + FTab:=ATab; +end; + +procedure TSpkTabAppearanceDispatch.NotifyAppearanceChanged; +begin + if assigned(FTab) then + FTab.NotifyAppearanceChanged; +end; + +{ TSpkTab } + +function TSpkTab.AtLeastOnePaneVisible: boolean; + +var i : integer; + PaneVisible : boolean; + +begin +result:=FPanes.count>0; +if result then + begin + PaneVisible:=false; + i:=FPanes.count-1; + while (i>=0) and not(PaneVisible) do + begin + PaneVisible:=FPanes[i].Visible; + dec(i); + end; + result:=result and PaneVisible; + end; +end; + +procedure TSpkTab.SetRect(ARect: T2DIntRect); + +var x, i : integer; + tw : integer; + tmpRect : T2DIntRect; + +begin +FRect:=ARect; + +if AtLeastOnePaneVisible then + begin + x:=ARect.left; + for i := 0 to FPanes.count - 1 do + if FPanes[i].Visible then + begin + tw:=FPanes[i].GetWidth; + + tmpRect.Left:=x; + tmpRect.top:=ARect.Top; + tmpRect.right:=x + tw - 1; + tmpRect.bottom:=ARect.bottom; + + FPanes[i].Rect:=tmpRect; + + x:=x + tw + TAB_PANE_HSPACING; + end + else + begin + FPanes[i].Rect:=T2DIntRect.create(-1,-1,-1,-1); + end; + end; +end; + +procedure TSpkTab.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); + +begin + FToolbarDispatch := Value; + FPanes.ToolbarDispatch:=FToolbarDispatch; +end; + +constructor TSpkTab.Create(AOwner : TComponent); +begin + inherited Create(AOwner); + + FAppearanceDispatch:=TSpkTabAppearanceDispatch.create(self); + FAppearance:=nil; + FMouseHoverElement.ElementType:=etNone; + FMouseHoverElement.ElementIndex:=-1; + FMouseActiveElement.ElementType:=etNone; + FMouseActiveElement.ElementIndex:=-1; + + FToolbarDispatch:=nil; + FCaption:='Tab'; + FVisible:=true; + FOverrideAppearance:=false; + FCustomAppearance:=TSpkToolbarAppearance.Create(FAppearanceDispatch); + + FPanes:=TSpkPanes.Create(self); + FPanes.ToolbarDispatch:=FToolbarDispatch; + + FRect:=T2DIntRect.create(0,0,0,0); + + FImages:=nil; + FDisabledImages:=nil; + FLargeImages:=nil; + FDisabledLargeImages:=nil; + + SetPaneAppearance; +end; + +procedure TSpkTab.DefineProperties(Filer: TFiler); +begin + inherited DefineProperties(Filer); + + Filer.DefineProperty('Panes',FPanes.ReadNames,FPanes.WriteNames,true); +end; + +destructor TSpkTab.Destroy; +begin + FPanes.Free; + FCustomAppearance.Free; + FAppearanceDispatch.Free; + + inherited Destroy; +end; + +procedure TSpkTab.Draw(ABuffer: TBitmap; AClipRect: T2DIntRect); + +var LocalClipRect : T2DIntRect; + i : integer; + +begin +if AtLeastOnePaneVisible then + for i := 0 to FPanes.Count - 1 do + if FPanes[i].visible then + begin + if AClipRect.IntersectsWith(FPanes[i].Rect, LocalClipRect) then + FPanes[i].Draw(ABuffer, LocalClipRect); + end; +end; + +function TSpkTab.FindPaneAt(x, y: integer): integer; + +var i : integer; + +begin +result:=-1; +i:=FPanes.count-1; +while (i>=0) and (result=-1) do + begin + if FPanes[i].Visible then + begin + if FPanes[i].Rect.Contains(T2DIntVector.create(x,y)) then + result:=i; + end; + dec(i); + end; +end; + +procedure TSpkTab.FreeingPane(APane: TSpkPane); +begin +FPanes.RemoveReference(APane); +end; + +procedure TSpkTab.GetChildren(Proc: TGetChildProc; Root: TComponent); + +var i: Integer; + +begin +inherited; + +if FPanes.Count>0 then + for i := 0 to FPanes.Count - 1 do + Proc(FPanes.Items[i]); +end; + +procedure TSpkTab.Loaded; +begin + inherited; + + if FPanes.ListState = lsNeedsProcessing then + FPanes.ProcessNames(self.Owner); +end; + +procedure TSpkTab.MouseDown(Button: TMouseButton; Shift: TShiftState; X, + Y: Integer); +begin +if FMouseActiveElement.ElementType = etPane then + begin + if FMouseActiveElement.ElementIndex<>-1 then + FPanes[FMouseActiveElement.ElementIndex].MouseDown(Button, Shift, X, Y); + end else +if FMouseActiveElement.ElementType = etTabArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia. + end else +if FMouseActiveElement.ElementType = etNone then + begin + if FMouseHoverElement.ElementType = etPane then + begin + if FMouseHoverElement.ElementIndex<>-1 then + begin + FMouseActiveElement.ElementType:=etPane; + FMouseActiveElement.ElementIndex:=FMouseHoverElement.ElementIndex; + + FPanes[FMouseHoverElement.ElementIndex].MouseDown(Button, Shift, X, Y); + end + else + begin + FMouseActiveElement.ElementType:=etTabArea; + FMouseActiveElement.ElementIndex:=-1; + end; + end else + if FMouseHoverElement.ElementType = etTabArea then + begin + FMouseActiveElement.ElementType:=etTabArea; + FMouseActiveElement.ElementIndex:=-1; + + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia. + end; + end; +end; + +procedure TSpkTab.MouseLeave; +begin +if FMouseActiveElement.ElementType = etNone then + begin + if FMouseHoverElement.ElementType = etPane then + begin + if FMouseHoverElement.ElementIndex<>-1 then + FPanes[FMouseHoverElement.ElementIndex].MouseLeave; + end else + if FMouseHoverElement.ElementType = etTabArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia. + end; + end; + +FMouseHoverElement.ElementType:=etNone; +FMouseHoverElement.ElementIndex:=-1; +end; + +procedure TSpkTab.MouseMove(Shift: TShiftState; X, Y: Integer); + +var i : integer; + NewMouseHoverElement : TSpkMouseTabElement; + +begin +// Szukamy obiektu pod myszą +i:=FindPaneAt(x, y); +if i<>-1 then + begin + NewMouseHoverElement.ElementType:=etPane; + NewMouseHoverElement.ElementIndex:=i; + end else +if (X>=FRect.left) and (Y>=FRect.top) and + (X<=FRect.right) and (Y<=FRect.bottom) then + begin + NewMouseHoverElement.ElementType:=etTabArea; + NewMouseHoverElement.ElementIndex:=-1; + end else + begin + NewMouseHoverElement.ElementType:=etNone; + NewMouseHoverElement.ElementIndex:=-1; + end; + +if FMouseActiveElement.ElementType = etPane then + begin + if FMouseActiveElement.ElementIndex<>-1 then + begin + FPanes[FMouseActiveElement.ElementIndex].MouseMove(Shift, X, Y); + end; + end else +if FMouseActiveElement.ElementType = etTabArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia + end else +if FMouseActiveElement.ElementType = etNone then + begin + // Jeśli element pod myszą się zmienia, informujemy poprzedni element o + // tym, że mysz opuszcza jego obszar + if (NewMouseHoverElement.ElementType<>FMouseHoverElement.ElementType) or + (NewMouseHoverElement.ElementIndex<>FMouseHoverElement.ElementIndex) then + begin + if FMouseHoverElement.ElementType = etPane then + begin + if FMouseHoverElement.ElementIndex<>-1 then + FPanes[FMouseHoverElement.ElementIndex].MouseLeave; + end else + if FMouseHoverElement.ElementType = etTabArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia + end; + end; + + if NewMouseHoverElement.ElementType = etPane then + begin + if NewMouseHoverElement.ElementIndex<>-1 then + FPanes[NewMouseHoverElement.ElementIndex].MouseMove(Shift, X, Y); + end else + if NewMouseHoverElement.ElementType = etTabArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia + end; + end; + +FMouseHoverElement:=NewMouseHoverElement; +end; + +procedure TSpkTab.MouseUp(Button: TMouseButton; Shift: TShiftState; X, + Y: Integer); + +var ClearActive : boolean; + +begin +ClearActive:=not(ssLeft in Shift) and not(ssMiddle in Shift) and not(ssRight in Shift); + +if FMouseActiveElement.ElementType = etPane then + begin + if FMouseActiveElement.ElementIndex<>-1 then + FPanes[FMouseActiveElement.ElementIndex].MouseUp(Button, Shift, X, Y); + end else +if FMouseActiveElement.ElementType = etTabArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia. + end; + +if ClearActive and + (FMouseActiveElement.ElementType<>FMouseHoverElement.ElementType) or + (FMouseActiveElement.ElementIndex<>FMouseHoverElement.ElementIndex) then + begin + if FMouseActiveElement.ElementType = etPane then + begin + if FMouseActiveElement.ElementIndex<>-1 then + FPanes[FMouseActiveElement.ElementIndex].MouseLeave; + end else + if FMouseActiveElement.ElementType = etTabArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia. + end; + + if FMouseHoverElement.ElementType = etPane then + begin + if FMouseHoverElement.ElementIndex<>-1 then + FPanes[FMouseHoverElement.ElementIndex].MouseMove(Shift, X, Y); + end else + if FMouseHoverElement.ElementType = etTabArea then + begin + // Placeholder, jeśli zajdzie potrzeba obsługi tego zdarzenia. + end; + end; + +if ClearActive then + begin + FMouseActiveElement.ElementType:=etNone; + FMouseActiveElement.ElementIndex:=-1; + end; +end; + +procedure TSpkTab.NotifyAppearanceChanged; +begin + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyAppearanceChanged; +end; + +procedure TSpkTab.SetCustomAppearance(const Value: TSpkToolbarAppearance); +begin + FCustomAppearance.assign(Value); +end; + +procedure TSpkTab.SetDisabledImages(const Value: TImageList); +begin + FDisabledImages := Value; + FPanes.DisabledImages := Value; +end; + +procedure TSpkTab.SetDisabledLargeImages(const Value: TImageList); +begin + FDisabledLargeImages := Value; + FPanes.DisabledLargeImages := Value; +end; + +procedure TSpkTab.SetImages(const Value: TImageList); +begin + FImages := Value; + FPanes.Images := Value; +end; + +procedure TSpkTab.SetLargeImages(const Value: TImageList); +begin + FLargeImages := Value; + FPanes.LargeImages := Value; +end; + +procedure TSpkTab.SetAppearance(const Value: TSpkToolbarAppearance); +begin + FAppearance:=Value; + + SetPaneAppearance; + + if FToolbarDispatch<>nil then + FToolbarDispatch.NotifyMetricsChanged; +end; + +procedure TSpkTab.SetCaption(const Value: string); +begin + FCaption := Value; + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyMetricsChanged; +end; + +procedure TSpkTab.SetOverrideAppearance(const Value: boolean); +begin + FOverrideAppearance := Value; + + SetPaneAppearance; + + if FToolbarDispatch<>nil then + FToolbarDispatch.NotifyMetricsChanged; +end; + +procedure TSpkTab.SetPaneAppearance; +begin +if FOverrideAppearance then + FPanes.Appearance:=FCustomAppearance else + FPanes.Appearance:=FAppearance; + +// Metoda pełni rolę makra - dlatego nie powiadamia dyspozytora o zmianie. +end; + +procedure TSpkTab.SetVisible(const Value: boolean); +begin + FVisible := Value; + if FToolbarDispatch<>nil then + FToolbarDispatch.NotifyItemsChanged; +end; + +{ TSpkTabs } + +function TSpkTabs.Add: TSpkTab; + +var Owner, Parent : TComponent; + i: Integer; + +begin +if FRootComponent<>nil then + begin + Owner:=FRootComponent.Owner; + Parent:=FRootComponent; + end +else + begin + Owner:=nil; + Parent:=nil; + end; + +result:=TSpkTab.create(Owner); +result.Parent:=Parent; + +if FRootComponent<>nil then + begin + i:=1; + while FRootComponent.Owner.FindComponent('SpkTab'+inttostr(i))<>nil do + inc(i); + + result.Name:='SpkTab'+inttostr(i); + end; + +AddItem(result); +end; + +constructor TSpkTabs.Create(RootComponent : TComponent); +begin + inherited Create(RootComponent); + FToolbarDispatch:=nil; + FAppearance:=nil; + FImages:=nil; + FDisabledImages:=nil; + FLargeImages:=nil; + FDisabledLargeImages:=nil; +end; + +destructor TSpkTabs.Destroy; +begin + inherited Destroy; +end; + +function TSpkTabs.GetItems(index: integer): TSpkTab; +begin + result:=TSpkTab(inherited Items[index]); +end; + +function TSpkTabs.Insert(index: integer): TSpkTab; + +var Owner, Parent : TComponent; + i: Integer; + +begin +if (index<0) or (index>=self.Count) then + raise InternalException.create('TSpkTabs.Insert: Nieprawidłowy indeks!'); + +if FRootComponent<>nil then + begin + Owner:=FRootComponent.Owner; + Parent:=FRootComponent; + end +else + begin + Owner:=nil; + Parent:=nil; + end; + +result:=TSpkTab.create(Owner); +result.Parent:=Parent; + +if FRootComponent<>nil then + begin + i:=1; + while FRootComponent.Owner.FindComponent('SpkTab'+inttostr(i))<>nil do + inc(i); + + result.Name:='SpkTab'+inttostr(i); + end; +InsertItem(index, result); +end; + +procedure TSpkTabs.Notify(Item: TComponent; + Operation : TOperation); +begin + inherited Notify(Item, Operation); + + case Operation of + opInsert: begin + // Ustawienie dyspozytora na nil spowoduje, że podczas + // przypisywania własności nie będą wołane metody Notify* + TSpkTab(Item).ToolbarDispatch:=nil; + + TSpkTab(Item).Appearance:=self.FAppearance; + TSpkTab(Item).Images:=self.FImages; + TSpkTab(Item).DisabledImages:=self.FDisabledImages; + TSpkTab(Item).LargeImages:=self.FLargeImages; + TSpkTab(Item).DisabledLargeImages:=self.FDisabledLargeImages; + TSpkTab(Item).ToolbarDispatch:=self.FToolbarDispatch; + end; + opRemove: begin + if not(csDestroying in Item.ComponentState) then + begin + TSpkTab(Item).ToolbarDispatch:=nil; + TSpkTab(Item).Appearance:=nil; + TSpkTab(Item).Images:=nil; + TSpkTab(Item).DisabledImages:=nil; + TSpkTab(Item).LargeImages:=nil; + TSpkTab(Item).DisabledLargeImages:=nil; + end; + end; + end; +end; + +procedure TSpkTabs.SetAppearance(const Value: TSpkToolbarAppearance); + +var i: Integer; + +begin + FAppearance := Value; + + if self.count>0 then + for i := 0 to self.count - 1 do + self.Items[i].Appearance:=FAppearance; +end; + +procedure TSpkTabs.SetDisabledImages(const Value: TImageList); + +var i: Integer; + +begin + FDisabledImages := Value; + + if self.Count>0 then + for i := 0 to self.count - 1 do + Items[i].DisabledImages:=Value; +end; + +procedure TSpkTabs.SetDisabledLargeImages(const Value: TImageList); + +var i: Integer; + +begin + FDisabledLargeImages := Value; + + if self.Count>0 then + for i := 0 to self.count - 1 do + Items[i].DisabledLargeImages:=Value; +end; + +procedure TSpkTabs.SetImages(const Value: TImageList); + +var i: Integer; + +begin + FImages := Value; + + if self.Count>0 then + for i := 0 to self.count - 1 do + Items[i].Images:=Value; +end; + +procedure TSpkTabs.SetLargeImages(const Value: TImageList); + +var i: Integer; + +begin + FLargeImages := Value; + + if self.Count>0 then + for i := 0 to self.count - 1 do + Items[i].LargeImages:=Value; +end; + +procedure TSpkTabs.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); + +var i : integer; + +begin + FToolbarDispatch := Value; + + if self.Count>0 then + for i := 0 to self.count - 1 do + self.Items[i].ToolbarDispatch:=FToolbarDispatch; +end; + +procedure TSpkTabs.Update; +begin + inherited Update; + + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyItemsChanged; +end; + +initialization + +RegisterClass(TSpkTab); + +finalization + +UnRegisterClass(TSpkTab); + +end. diff --git a/components/spktoolbar/SpkToolbar/spkt_Tools.pas b/components/spktoolbar/SpkToolbar/spkt_Tools.pas new file mode 100644 index 000000000..32c2af52d --- /dev/null +++ b/components/spktoolbar/SpkToolbar/spkt_Tools.pas @@ -0,0 +1,196 @@ +unit spkt_Tools; + +(******************************************************************************* +* * +* Plik: spkt_Tools.pas * +* Opis: Klasy narzędziowe ułatwiające renderowanie toolbara. * +* Copyright: (c) 2009 by Spook. Jakiekolwiek użycie komponentu bez * +* uprzedniego uzyskania licencji od autora stanowi złamanie * +* prawa autorskiego! * +* * +*******************************************************************************) + +interface + +uses Windows, Graphics, SysUtils, + SpkMath, SpkGraphTools, SpkGUITools; + +type TButtonTools = class sealed(TObject) + private + protected + public + class procedure DrawButton(Bitmap : TBitmap; + Rect : T2DIntRect; + FrameColor, + InnerLightColor, + InnerDarkColor, + GradientFrom, + GradientTo : TColor; + GradientKind : TBackgroundKind; + LeftEdgeOpen, + RightEdgeOpen, + TopEdgeOpen, + BottomEdgeOpen : boolean; + Radius : integer; + ClipRect : T2DIntRect); + end; + +implementation + +{ TButtonTools } + +class procedure TButtonTools.DrawButton(Bitmap: TBitmap; + Rect: T2DIntRect; FrameColor, InnerLightColor, InnerDarkColor, GradientFrom, + GradientTo: TColor; GradientKind: TBackgroundKind; LeftEdgeOpen, + RightEdgeOpen, TopEdgeOpen, BottomEdgeOpen: boolean; Radius: integer; + ClipRect : T2DIntRect); + +var x1, x2, y1, y2 : integer; + LeftClosed, TopClosed, RightClosed, BottomClosed : byte; + +begin +if (Rect.Width<6) or (Rect.Height<6) or + (Rect.Width < 2*radius) or (Rect.Height < 2*Radius) then + exit; + +if LeftEdgeOpen then LeftClosed:=0 else LeftClosed:=1; +if RightEdgeOpen then RightClosed:=0 else RightClosed:=1; +if TopEdgeOpen then TopClosed:=0 else TopClosed:=1; +if BottomEdgeOpen then BottomClosed:=0 else BottomClosed:=1; + +TGuiTools.DrawRoundRect(Bitmap.Canvas, + Rect, + Radius, + GradientFrom, + GradientTo, + GradientKind, + ClipRect, + not(LeftEdgeOpen or TopEdgeOpen), + not(RightEdgeOpen or TopEdgeOpen), + not(LeftEdgeOpen or BottomEdgeOpen), + not(RightEdgeOpen or BottomEdgeOpen)); + +// Wewnętrzna krawędź +// *** Góra *** +x1:=Rect.Left + radius * TopClosed * LeftClosed + LeftClosed; +x2:=Rect.Right - radius * TopClosed * RightClosed - RightClosed; +y1:=Rect.Top + TopClosed; +TGuiTools.DrawHLine(Bitmap, x1, x2, y1, InnerLightColor, ClipRect); + +// *** Dół *** +x1:=Rect.Left + radius * BottomClosed * LeftClosed + LeftClosed; +x2:=Rect.Right - radius * BottomClosed * RightClosed - RightClosed; +y1:=Rect.Bottom - BottomClosed; +if BottomEdgeOpen then + TGuiTools.DrawHLine(Bitmap, x1, x2, y1, InnerDarkColor, ClipRect) else + TGuiTools.DrawHLine(Bitmap, x1, x2, y1, InnerLightColor, ClipRect); + +// *** Lewo *** +y1:=Rect.Top + Radius * LeftClosed * TopClosed + TopClosed; +y2:=Rect.Bottom - Radius * LeftClosed * BottomClosed - BottomClosed; +x1:=Rect.Left + LeftClosed; +TGuiTools.DrawVLine(Bitmap, x1, y1, y2, InnerLightColor, ClipRect); + +// *** Prawo *** +y1:=Rect.Top + Radius * RightClosed * TopClosed + TopClosed; +y2:=Rect.Bottom - Radius * RightClosed * BottomClosed - BottomClosed; +x1:=Rect.Right - RightClosed; +if RightEdgeOpen then + TGuiTools.DrawVLine(Bitmap, x1, y1, y2, InnerDarkColor, ClipRect) else + TGuiTools.DrawVLine(Bitmap, x1, y1, y2, InnerLightColor, ClipRect); + +// Zaokrąglone narożniki +if not(LeftEdgeOpen or TopEdgeOpen) then + TGuiTools.DrawAARoundCorner(Bitmap, + T2DIntPoint.create(Rect.left + 1, Rect.Top + 1), + Radius, + cpLeftTop, + InnerLightColor, + ClipRect); +if not(RightEdgeOpen or TopEdgeOpen) then + TGuiTools.DrawAARoundCorner(Bitmap, + T2DIntPoint.create(Rect.right - radius, Rect.Top + 1), + Radius, + cpRightTop, + InnerLightColor, + ClipRect); +if not(LeftEdgeOpen or BottomEdgeOpen) then + TGuiTools.DrawAARoundCorner(Bitmap, + T2DIntPoint.create(Rect.left + 1, Rect.bottom - radius), + Radius, + cpLeftBottom, + InnerLightColor, + ClipRect); +if not(RightEdgeOpen or BottomEdgeOpen) then + TGuiTools.DrawAARoundCorner(Bitmap, + T2DIntPoint.create(Rect.right - radius, Rect.bottom - radius), + Radius, + cpRightBottom, + InnerLightColor, + ClipRect); + +// Zewnętrzna krawędź +// Zaokrąglone narożniki +if not(TopEdgeOpen) then + begin + x1:=Rect.Left + Radius * LeftClosed; + x2:=Rect.Right - Radius * RightClosed; + y1:=Rect.Top; + TGuiTools.DrawHLine(Bitmap, x1, x2, y1, FrameColor, ClipRect); + end; + +if not(BottomEdgeOpen) then + begin + x1:=Rect.Left + Radius * LeftClosed; + x2:=Rect.Right - Radius * RightClosed; + y1:=Rect.Bottom; + TGuiTools.DrawHLine(Bitmap, x1, x2, y1, FrameColor, ClipRect); + end; + +if not(LeftEdgeOpen) then + begin + y1:=Rect.Top + Radius * TopClosed; + y2:=Rect.Bottom - Radius * BottomClosed; + x1:=Rect.Left; + TGuiTools.DrawVLine(Bitmap, x1, y1, y2, FrameColor, ClipRect); + end; + +if not(RightEdgeOpen) then + begin + y1:=Rect.Top + Radius * TopClosed; + y2:=Rect.Bottom - Radius * BottomClosed; + x1:=Rect.Right; + TGuiTools.DrawVLine(Bitmap, x1, y1, y2, FrameColor, ClipRect); + end; + +if not(LeftEdgeOpen or TopEdgeOpen) then + TGuiTools.DrawAARoundCorner(Bitmap, + T2DIntPoint.create(Rect.left, Rect.Top), + Radius, + cpLeftTop, + FrameColor, + ClipRect); +if not(RightEdgeOpen or TopEdgeOpen) then + TGuiTools.DrawAARoundCorner(Bitmap, + T2DIntPoint.create(Rect.right - radius + 1, Rect.Top), + Radius, + cpRightTop, + FrameColor, + ClipRect); +if not(LeftEdgeOpen or BottomEdgeOpen) then + TGuiTools.DrawAARoundCorner(Bitmap, + T2DIntPoint.create(Rect.left, Rect.bottom - radius + 1), + Radius, + cpLeftBottom, + FrameColor, + ClipRect); +if not(RightEdgeOpen or BottomEdgeOpen) then + TGuiTools.DrawAARoundCorner(Bitmap, + T2DIntPoint.create(Rect.right - radius + 1, Rect.bottom - radius + 1), + Radius, + cpRightBottom, + FrameColor, + ClipRect); +end; + +end. diff --git a/components/spktoolbar/SpkToolbar/spkt_Types.pas b/components/spktoolbar/SpkToolbar/spkt_Types.pas new file mode 100644 index 000000000..6b9d45978 --- /dev/null +++ b/components/spktoolbar/SpkToolbar/spkt_Types.pas @@ -0,0 +1,302 @@ +unit spkt_Types; + +(******************************************************************************* +* * +* Plik: spkt_Types.pas * +* Opis: Definicje typów używanych podczas pracy toolbara * +* Copyright: (c) 2009 by Spook. Jakiekolwiek użycie komponentu bez * +* uprzedniego uzyskania licencji od autora stanowi złamanie * +* prawa autorskiego! * +* * +*******************************************************************************) + +interface + +uses Windows, Controls, Classes, ContNrs, SysUtils, Dialogs, + spkt_Exceptions; + +type TSpkListState = (lsNeedsProcessing, lsReady); + +type TSpkComponent = class(TComponent) + private + protected + FParent : TComponent; + + // *** Gettery i settery *** + function GetParent: TComponent; + procedure SetParent(const Value: TComponent); + public + // *** Konstruktor *** + constructor Create(AOwner : TComponent); override; + + // *** Obsługa parenta *** + function HasParent : boolean; override; + function GetParentComponent : TComponent; override; + procedure SetParentComponent(Value : TComponent); override; + + property Parent : TComponent read GetParent write SetParent; + end; + +type TSpkCollection = class(TPersistent) + private + protected + FList : TObjectList; + FNames : TStringList; + FListState : TSpkListState; + FRootComponent : TComponent; + + // *** Metody reakcji na zmiany w liście *** + procedure Notify(Item : TComponent; Operation : TOperation); virtual; + procedure Update; virtual; + + // *** Wewnętrzne metody dodawania i wstawiania elementów *** + procedure AddItem(AItem : TComponent); + procedure InsertItem(index : integer; AItem : TComponent); + + // *** Gettery i settery *** + function GetItems(index: integer): TComponent; virtual; + public + // *** Konstruktor, destruktor *** + constructor Create(RootComponent : TComponent); reintroduce; virtual; + destructor Destroy; override; + + // *** Obsługa listy *** + procedure Clear; + function Count : integer; + procedure Delete(index : integer); virtual; + function IndexOf(Item : TComponent) : integer; + procedure Remove(Item : TComponent); virtual; + procedure RemoveReference(Item : TComponent); + procedure Exchange(item1, item2 : integer); + procedure Move(IndexFrom, IndexTo : integer); + + // *** Reader, writer i obsługa designtime i DFM *** + procedure WriteNames(Writer : TWriter); virtual; + procedure ReadNames(Reader : TReader); virtual; + procedure ProcessNames(Owner : TComponent); virtual; + + property ListState : TSpkListState read FListState; + property Items[index : integer] : TComponent read GetItems; default; + end; + +implementation + +{ TSpkCollection } + +procedure TSpkCollection.AddItem(AItem: TComponent); +begin +// Ta metoda może być wywoływana bez przetworzenia nazw (w szczególności, metoda +// przetwarzająca nazwy korzysta z AddItem) + +Notify(AItem, opInsert); +FList.Add(AItem); + +Update; +end; + +procedure TSpkCollection.Clear; +begin +FList.Clear; + +Update; +end; + +function TSpkCollection.Count: integer; +begin +result:=FList.Count; +end; + +constructor TSpkCollection.Create(RootComponent : TComponent); +begin +inherited Create; +FRootComponent:=RootComponent; + +FNames:=TStringList.create; + +FList:=TObjectList.Create; +FList.OwnsObjects:=true; + +FListState:=lsReady; +end; + +procedure TSpkCollection.Delete(index: integer); +begin +if (index<0) or (index>=FList.count) then + raise InternalException.Create('TSpkCollection.Delete: Nieprawidłowy indeks!'); + +Notify(TComponent(FList[index]), opRemove); + +FList.Delete(index); + +Update; +end; + +destructor TSpkCollection.Destroy; +begin + FNames.Free; + FList.Free; + inherited; +end; + +procedure TSpkCollection.Exchange(item1, item2: integer); +begin +FList.Exchange(item1, item2); +Update; +end; + +function TSpkCollection.GetItems(index: integer): TComponent; +begin +if (index<0) or (index>=FList.Count) then + raise InternalException.create('TSpkCollection.GetItems: Nieprawidłowy indeks!'); + +result:=TComponent(FList[index]); +end; + +function TSpkCollection.IndexOf(Item: TComponent): integer; +begin +result:=FList.IndexOf(Item); +end; + +procedure TSpkCollection.InsertItem(index: integer; AItem: TComponent); +begin +if (index<0) or (index>FList.Count) then + raise InternalException.Create('TSpkCollection.Insert: Nieprawidłowy indeks!'); + +Notify(AItem, opInsert); + +FList.Insert(index, AItem); + +Update; +end; + +procedure TSpkCollection.Move(IndexFrom, IndexTo: integer); +begin +if (indexFrom<0) or (indexFrom>=FList.Count) or + (indexTo<0) or (indexTo>=FList.Count) then + raise InternalException.Create('TSpkCollection.Move: Nieprawidłowy indeks!'); + +FList.Move(IndexFrom, IndexTo); + +Update; +end; + +procedure TSpkCollection.Notify(Item: TComponent; Operation: TOperation); +begin +// +end; + +procedure TSpkCollection.ProcessNames(Owner : TComponent); + +var s : string; + +begin +FList.Clear; + +if Owner<>nil then + for s in FNames do + AddItem(Owner.FindComponent(s)); + +FNames.Clear; +FListState:=lsReady; +end; + +procedure TSpkCollection.ReadNames(Reader: TReader); + +begin +Reader.ReadListBegin; + +FNames.Clear; +while not(Reader.EndOfList) do + FNames.Add(Reader.ReadString); + +Reader.ReadListEnd; + +FListState:=lsNeedsProcessing; +end; + +procedure TSpkCollection.Remove(Item: TComponent); + +var i : integer; + +begin +i:=FList.IndexOf(Item); + +if i>=0 then + begin + Notify(Item, opRemove); + + FList.Delete(i); + + Update; + end; +end; + +procedure TSpkCollection.RemoveReference(Item: TComponent); + +var i : integer; + +begin +i:=FList.IndexOf(Item); + +if i>=0 then + begin + Notify(Item, opRemove); + + FList.Extract(Item); + + Update; + end; +end; + +procedure TSpkCollection.Update; +begin +// +end; + +procedure TSpkCollection.WriteNames(Writer: TWriter); + +var Item : pointer; + +begin +Writer.WriteListBegin; + +for Item in FList do + Writer.WriteString(TComponent(Item).Name); + +Writer.WriteListEnd; +end; + +{ TSpkComponent } + +constructor TSpkComponent.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FParent:=nil; +end; + +function TSpkComponent.GetParent: TComponent; +begin + result:=GetParentComponent; +end; + +function TSpkComponent.GetParentComponent: TComponent; +begin + result:=FParent; +end; + +function TSpkComponent.HasParent: boolean; +begin + result:=FParent<>nil; +end; + +procedure TSpkComponent.SetParent(const Value: TComponent); +begin + SetParentComponent(Value); +end; + +procedure TSpkComponent.SetParentComponent(Value: TComponent); +begin + FParent:=Value; +end; + +end.