diff --git a/components/tvplanit/examples/fulldemo/demomain.lfm b/components/tvplanit/examples/fulldemo/demomain.lfm index b431ecaaa..26c97946f 100644 --- a/components/tvplanit/examples/fulldemo/demomain.lfm +++ b/components/tvplanit/examples/fulldemo/demomain.lfm @@ -9,7 +9,7 @@ object MainForm: TMainForm Menu = MainMenu1 OnCloseQuery = FormCloseQuery OnCreate = FormCreate - LCLVersion = '1.4.4.0' + LCLVersion = '1.7' object Panel1: TPanel Left = 120 Height = 580 @@ -581,9 +581,9 @@ object MainForm: TMainForm AllowRearrange = True BackgroundColor = clActiveCaption BackgroundMethod = bmNormal - BorderStyle = bsNone + BorderStyle = bsSingle ButtonHeight = 20 - DrawingStyle = dsEtchedButton + DrawingStyle = dsCoolTab FolderCollection = < item Version = 'v1.04' diff --git a/components/tvplanit/source/vpnavbar.pas b/components/tvplanit/source/vpnavbar.pas index a49e68e6c..7f23fc077 100644 --- a/components/tvplanit/source/vpnavbar.pas +++ b/components/tvplanit/source/vpnavbar.pas @@ -306,6 +306,7 @@ type procedure RemoveContainer(Container: TVpFolderContainer); procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseLeave; override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; @@ -1820,6 +1821,12 @@ begin end; {=====} +procedure TVpCustomNavBar.MouseLeave; +begin + FHotFolder := -1; + Invalidate; +end; + procedure TVpCustomNavBar.MouseMove(Shift: TShiftState; X, Y: Integer); var ItemIndex: Integer; diff --git a/components/tvplanit/source/vpnavbarpainter.pas b/components/tvplanit/source/vpnavbarpainter.pas index cd8495efb..23c6ae078 100644 --- a/components/tvplanit/source/vpnavbarpainter.pas +++ b/components/tvplanit/source/vpnavbarpainter.pas @@ -1,6 +1,6 @@ -unit VpNavBarPainter; +{$I vp.inc} -{$mode objfpc}{$H+} +unit VpNavBarPainter; interface @@ -49,22 +49,23 @@ type bkMode: Integer; procedure DrawBackground(Canvas: TCanvas; R: TRect); - procedure DrawCoolTab(Canvas: TCanvas; R: TRect); - function DrawDefButton(Canvas: TCanvas; R: TRect; - IsFocused, IsMouseOver: Boolean): TRect; - function DrawEtchedButton(Canvas: TCanvas; R: TRect; - IsFocused, IsMouseOver: Boolean): TRect; - function DrawNavTab(Canvas: TCanvas; const Client: TRect; - BevelWidth: Integer; TabColor: TColor; TabNumber: Integer; - CoolTab, IsFocused, IsMouseOver: Boolean): TRect; - procedure DrawStandardTab(Canvas: TCanvas; R: TRect; TabColor: TColor; TabCount: Integer); + + function DrawCoolTab(Canvas: TCanvas; R: TRect; ATabIndex: Integer; + ATabColor: TColor): TRect; + function DrawDefButton(Canvas: TCanvas; R: TRect; ATabIndex: Integer): TRect; + function DrawEtchedButton(Canvas: TCanvas; R: TRect; ATabIndex: Integer): TRect; + function DrawStandardTab(Canvas: TCanvas; R: TRect; ATabIndex: Integer; + ATabColor: TColor): TRect; + + function IsFocused(ATabIndex: Integer): Boolean; + function IsMouseOverFolder(ATabIndex: Integer): Boolean; + function IsMouseOverItem(ATabIndex: Integer): Boolean; protected procedure DrawActiveFolderItems(Canvas: TCanvas; var CurPos: Integer); procedure DrawBottomFolderButtons(Canvas: TCanvas; ARect: TRect; var CurPos: Integer); - function DrawTab(Canvas: TCanvas; R: TRect; ATabIndex: Integer; - IsFocused, IsMouseOver: Boolean): TRect; + procedure DrawTab(Canvas: TCanvas; R: TRect; ATabIndex: Integer); procedure DrawTopFolderButtons(Canvas: TCanvas; ARect: TRect; DrawFolder: Boolean; var CurPos: Integer); @@ -383,19 +384,10 @@ begin MyRect := ARect; Canvas.Font := FNavBar.Font; - SetBkMode(Canvas.Handle, bkMode); +// SetBkMode(Canvas.Handle, bkMode); // todo---> SetBkColor(Canvas.Handle, bkColor); - case FDrawingStyle of - dsDefButton: // Regular button style - CurPos := FNavBar.ClientHeight - FButtonHeight; - dsEtchedButton: // Etched style (Outlook98) - CurPos := FNavBar.ClientHeight - FButtonHeight - 1; - dsCoolTab: // Cool tab - CurPos := FNavBar.ClientHeight - FButtonHeight; - dsStandardTab: // Regular tab - CurPos := FNavBar.ClientHeight - FButtonHeight; - end; + CurPos := FNavBar.ClientHeight - FButtonHeight; for I := FNavBar.FolderCount-1 downto FActiveFolder+1 do begin MyRect.Top := CurPos; @@ -403,216 +395,175 @@ begin FNavBar.Folders[I].Rect := MyRect; {Draw the bottom tabs based on the selected style...} - DrawTab(Canvas, MyRect, I, I = FHotFolder, I = nabLastMouseOverItem); + DrawTab(Canvas, MyRect, I); Dec(CurPos, FButtonHeight); end; end; -procedure TVpNavBarPainter.DrawCoolTab(Canvas: TCanvas; R: TRect); -{$IFNDEF VERSION4} +{ Draw a "cool" tab button. + Returns the usable text area inside the tab rect.} +function TVpNavBarPainter.DrawCoolTab(Canvas: TCanvas; R: TRect; + ATabIndex: Integer; ATabColor: TColor): TRect; var Points: array[1..5] of TPoint; -{$ENDIF} begin + Result := R; with Canvas do begin - Pen.Color := clBlack; + {Fill the tab area} + Brush.Style := bsSolid; + if (ATabIndex = 0) then + Brush.Color := clBtnFace + else + Brush.Color := ATabColor; + FillRect(R); {Draw the bottom, left line} + Pen.Color := clBlack; MoveTo(R.Left, R.Bottom - 1); LineTo(R.Left + 5, R.Bottom - 1); {Draw the bottom, left curve} - {$IFNDEF VERSION4} - Points[1] := Point(R.Left + 5, R.Bottom - 1); - Points[2] := Point(R.Left + 11, R.Bottom - 2); - Points[3] := Point(R.Left + 12, R.Bottom - 7); - Points[4] := Point(R.Left + 13, R.Bottom - 9); + Points[1] := Point(R.Left + 5, R.Bottom - 1); {Start point} + Points[2] := Point(R.Left + 11, R.Bottom - 2); {Control point} + Points[3] := Point(R.Left + 12, R.Bottom - 7); {Control point} + Points[4] := Point(R.Left + 13, R.Bottom - 9); {End point} + {$IFNDEF VERSION4} {$IFDEF CBuilder} PolyBezier(Points); {$ELSE} Polyline(Points); {$ENDIF} {$ELSE} - PolyBezier([ - Point(R.Left + 5, R.Bottom - 1), {StartPoint} - Point(R.Left + 11, R.Bottom - 2), {ControlPoint} - Point(R.Left + 12, R.Bottom - 7), {ControlPoint} - Point(R.Left + 13, R.Bottom - 9) {EndPoint} - ]); + PolyBezier([Points[1], Points[2], Points[3], Points[4]]); {$ENDIF} {Draw the left side of the tab} MoveTo(R.Left + 13, R.Bottom - 9); - LineTo(R.Left + 13, R.Top + 9); + LineTo(R.Left + 13, R.Top + 8); {Draw the top, left corner of the tab} - {$IFNDEF VERSION4} - Points[1] := Point(R.Left + 13, R.Top + 9); - Points[2] := Point(R.Left + 14, R.Top + 7); - Points[3] := Point(R.Left + 15, R.Top + 2); - Points[4] := Point(R.Left + 21, R.Top + 1); + Points[1] := Point(R.Left + 13, R.Top + 8); {Start point} + Points[2] := Point(R.Left + 14, R.Top + 6); {Control point} + Points[3] := Point(R.Left + 15, R.Top + 1); {Control point} + Points[4] := Point(R.Left + 21, R.Top + 0); {End point} + {$IFNDEF VERSION4} {$IFDEF CBuilder} PolyBezier(Points); {$ELSE} Polyline(Points); {$ENDIF} {$ELSE} - PolyBezier([ - Point(R.Left + 13, R.Top + 9), {StartPoint} - Point(R.Left + 14, R.Top + 7), {ControlPoint} - Point(R.Left + 15, R.Top + 2), {ControlPoint} - Point(R.Left + 21, R.Top + 1) {EndPoint} - ]); + PolyBezier([Points[1], Points[2], Points[3], Points[4]]); {$ENDIF} {Draw the top of the tab} - MoveTo(R.Left + 21, R.Top + 1); - LineTo(R.Right - 16, R.Top + 1); + MoveTo(R.Left + 21, R.Top); + LineTo(R.Right - 16, R.Top); - {Draw the Top, Right corner of the tab} - {$IFNDEF VERSION4} - Points[1] := Point(R.Right - 16, R.Top + 1); - Points[2] := Point(R.Right - 10, R.Top + 2); - Points[3] := Point(R.Right - 9, R.Top + 7); - Points[4] := Point(R.Right - 8, R.Top + 9); + {Draw the top right corner of the tab} + Points[1] := Point(R.Right - 16, R.Top); + Points[2] := Point(R.Right - 10, R.Top + 1); + Points[3] := Point(R.Right - 9, R.Top + 6); + Points[4] := Point(R.Right - 8, R.Top + 8); + {$IFNDEF VERSION4} {$IFDEF CBuilder} PolyBezier(Points); {$ELSE} Polyline(Points); {$ENDIF} - {$ELSE} - PolyBezier([ - Point(R.Right - 16, R.Top + 1), {StartPoint} - Point(R.Right - 10, R.Top + 2), {ControlPoint} - Point(R.Right - 9, R.Top + 7), {ControlPoint} - Point(R.Right - 8, R.Top + 9) {EndPoint} - ]); + {$ELSE} + PolyBezier([Points[1], Points[2], Points[3], Points[4]]); {$ENDIF} {Draw the right side of the tab} - MoveTo(R.Right - 8, R.Top + 9); + MoveTo(R.Right - 8, R.Top + 8); LineTo(R.Right - 8, R.Bottom - 9); {Draw the bottom, Right curve of the tab which should finish against the right side.} - {$IFNDEF VERSION4} Points[1] := Point(R.Right - 8, R.Bottom - 9); Points[2] := Point(R.Right - 7, R.Bottom - 7); Points[3] := Point(R.Right - 6, R.Bottom - 2); Points[4] := Point(R.Right, R.Bottom - 1); + {$IFNDEF VERSION4} {$IFDEF CBuilder} Canvas.PolyBezier(Points); {$ELSE} Canvas.Polyline(Points); {$ENDIF} {$ELSE} - PolyBezier([ - Point(R.Right - 8, R.Bottom - 9), {StartPoint} - Point(R.Right - 7, R.Bottom - 7), {ControlPoint} - Point(R.Right - 6, R.Bottom - 2), {ControlPoint} - Point(R.Right, R.Bottom - 1) {EndPoint} - ]); + PolyBezier([Points[1], Points[2], Points[3], Points[4]]); {$ENDIF} + + if ATabIndex = 0 then begin + Brush.Color := ATabColor; + FloodFill((R.Left + R.Right) div 2, (R.Top + R.Bottom) div 2, clBtnFace, fsSurface); + end; end; + + Result := Rect(R.Left + 1, R.Top + 2, R.Right - 2, R.Bottom); end; +{ Draw regular buttons + Returns the usable text area inside the tab rect.} function TVpNavBarPainter.DrawDefButton(Canvas: TCanvas; R: TRect; - IsFocused, IsMouseOver: Boolean): TRect; + ATabIndex: Integer): TRect; var tb: TThemedButton; details: TThemedElementDetails; begin - {Draw regular buttons} + Result := R; + if ThemeServices.ThemesEnabled then begin - if IsMouseOver then - tb := tbPushButtonHot - else - if FNavBar.Focused and nabMouseDown then + if IsMouseOverFolder(ATabIndex) and nabMouseDown then tb := tbPushButtonPressed + else + if IsMouseOverFolder(ATabIndex) then + tb := tbPushButtonHot else tb := tbPushButtonNormal; details := ThemeServices.GetElementDetails(tb); + InflateRect(R, 1, 1); ThemeServices.DrawElement(Canvas.Handle, details, R); - InflateRect(R, -1, -1); - if IsFocused then OffsetRect(R, -1, -1); // Focused end; - Result := R; //TODO: TR := DrawButtonFace(DrawBmp.Canvas, MyRect, 1, bsNew, False, // (I = FHotFolder) and nabMouseDown, False); end; -{Draw regular etched (Win98 style) buttons} +{ Draw regular etched (Win98 style) buttons + Returns the usable text area inside the tab rect.} function TVpNavBarPainter.DrawEtchedButton(Canvas: TCanvas; R: TRect; - IsFocused, IsMouseOver: Boolean): TRect; + ATabIndex: Integer): TRect; begin with Canvas do begin Brush.Color := clBtnFace; FillRect(R); - Pen.Color := clBtnShadow; - Brush.Style := bsClear; - Rectangle(R.Left, R.Top, R.Right - 1, R.Bottom); - Pen.Color := clBtnHighlight; - MoveTo(R.Left + 1, R.Bottom - 2); - LineTo(R.Left + 1, R.Top + 1); - LineTo(R.Right - 2, R.Top + 1); - { Draw border around control. } - MoveTo(Width - 1, FNavBar.Top); - LineTo(Width - 1, FNavBar.Height - 1); - LineTo(0, FNavBar.Height - 1); - Pen.Color := clWindowFrame; - MoveTo(Width - 1, R.Bottom); - LineTo(1, R.Bottom); - LineTo(1, FNavBar.Height - 1); + // InflateRect(R, -1, -1); + if IsMouseOverFolder(ATabIndex) then + Frame3D(R, 1, bvLowered) else + Frame3D(r, 1, bvRaised); end; Result := R; end; -{DrawNavTab - returns the usable text area inside the tab rect.} -function TVpNavBarPainter.DrawNavTab(Canvas: TCanvas; const Client: TRect; - BevelWidth: Integer; TabColor: TColor; TabNumber: Integer; - CoolTab, IsFocused, IsMouseOver: Boolean): TRect; -var - R: TRect; +{ Draw a "standard" tab button. + Returns the usable text area inside the tab rect.} +function TVpNavBarPainter.DrawStandardTab(Canvas: TCanvas; R: TRect; + ATabIndex: Integer; ATabColor: TColor): TRect; begin - R := Client; + Result := R; - with Canvas do begin - Brush.Color := clBtnFace; - Brush.Style := bsSolid; - Pen.Color := TabColor; + {fill the tab area} + Canvas.Brush.Style := bsSolid; + Canvas.Brush.Color := clBtnFace; + Canvas.FillRect(R); - {fill the tab area} - Polygon([ - Point(R.Left, R.Bottom), - Point(R.Left, R.Top), - Point(R.Right, R.Top), - Point(R.Right, R.Bottom) - ]); - - if CoolTab then - { --- Draw Cool Tabs --- } - DrawCoolTab(Canvas, R) - else - { --- Draw Standard Tabs --- } - DrawStandardTab(Canvas, R, TabColor, TabNumber) - end; - - Result := Rect(Client.Left + 1, Client.Top + 2, Client.Right - 2, Client.Bottom); - if IsFocused then OffsetRect(Result, -1, -1); -end; - -procedure TVpNavBarPainter.DrawStandardTab(Canvas: TCanvas; R: TRect; - TabColor: TColor; TabCount: Integer); -begin - dec(R.Top); - - if TabCount > 0 then begin - Canvas.Brush.Color := TabColor; + {fill the tab area} + if ATabIndex > 0 then begin + Canvas.Brush.Color := ATabColor; Canvas.Brush.Style := bsSolid; - Canvas.Pen.Color := TabColor; - - {fill the tab area} + Canvas.Pen.Color := ATabColor; Canvas.Polygon([ Point(R.Left, R.Bottom), Point(R.Left, R.Top), @@ -621,11 +572,10 @@ begin ]); end; - Canvas.Brush.Color := TabColor; - Canvas.Brush.Style := bsSolid; - {Draw Tab} - Canvas.Pen.Color := TabColor; + Canvas.Brush.Color := ATabColor; + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Color := ATabColor; Canvas.Polygon([ Point(R.Left + 10, R.Bottom - 1), Point(R.Left + 10, R.Top + 3), @@ -657,49 +607,65 @@ begin Point(R.Left + 12, R.Top + 2), Point(R.Right - 2, R.Top + 2), Point(R.Right - 1, R.Top + 3), - Point(R.Right - 1, R.Bottom - 1)]); + Point(R.Right - 1, R.Bottom - 1) + ]); - {draw shadow} + Result := Rect(R.Left + 1, R.Top + 2, R.Right - 2, R.Bottom); end; -function TVpNavBarPainter.DrawTab(Canvas: TCanvas; R: TRect; ATabIndex: Integer; - IsFocused, IsMouseOver: Boolean): TRect; +procedure TVpNavBarPainter.DrawTab(Canvas: TCanvas; R: TRect; ATabIndex: Integer); var - Buf: array[0..255] of Char; + displayTxt: String; TR: TRect; Flags: Integer; lOffset: Integer; + folder: TVpNavFolder; + savedFontstyle: TFontStyles; begin case FDrawingStyle of dsDefButton: - Result := DrawDefButton(Canvas, R, IsFocused, IsMouseOver); + TR := DrawDefButton(Canvas, R, ATabIndex); dsEtchedButton: - Result := DrawEtchedButton(Canvas, R, IsFocused, IsMouseOver); + TR := DrawEtchedButton(Canvas, R,ATabIndex); dsCoolTab: - Result := DrawNavTab(Canvas, R, 1, FBackgroundColor, ATabIndex, true, IsFocused, IsMouseOver); + TR := DrawCoolTab(Canvas, R, ATabIndex, FBackgroundColor); dsStandardTab: - {Draw regular old tabs} - Result := DrawNavTab(Canvas, R, 1, FBackgroundColor, ATabIndex, false, IsFocused, IsMouseOver); + TR := DrawStandardTab(Canvas, R, ATabIndex, FBackgroundColor); end; - TR := Result; +// if IsMouseOverFolder(ATabIndex) then +// OffsetRect(TR, -1, -1); - StrPLCopy(Buf, FNavBar.Folders[ATabIndex].DisplayName, 255); - Inc(TR.Top); - Flags := DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX; - if FNavBar.Folders[ATabIndex].Enabled then begin - DrawText(Canvas.Handle, Buf, StrLen(Buf), TR, Flags); - if (ATabIndex = FHotFolder) and not nabMouseDown then begin + //inc(TR.Top); + + folder := FNavBar.Folders[ATabIndex]; + displayTxt := folder.DisplayName; + + savedFontstyle := Canvas.Font.Style; + if folder.Enabled then begin + SetBkMode(Canvas.Handle, TRANSPARENT); + if IsMouseOverFolder(ATabIndex) then + Canvas.Font.Style := Canvas.Font.Style + [fsBold]; + Flags := DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX; + DrawText(Canvas.Handle, PChar(displayTxt), Length(displayTxt), TR, Flags); + + if IsMouseOverFolder(ATabIndex) and not nabMouseDown then begin case FDrawingStyle of dsDefButton: begin { Regular button style. } - InflateRect(TR, 1, 1); - inc(TR.Left); - Canvas.Frame3D(TR, 1, bvRaised); +// InflateRect(TR, 1, 1); + // inc(TR.Left); + // Canvas.Frame3D(TR, 1, bvRaised); end; dsEtchedButton: begin { Etched style (Outlook98). } +// InflateRect(TR, 1, 1); + // inc(TR.Top); + // inc(TR.Left); + // Canvas.Frame3D(TR, 1, bvRaised); + { + Canvas.Pen.Color := clWindowFrame; Canvas.MoveTo(TR.Right - 2, TR.Top); Canvas.LineTo(TR.Right - 2, TR.Bottom - 1); @@ -714,21 +680,25 @@ begin Canvas.LineTo(1, TR.Bottom - lOffset); if ATabIndex = FActiveFolder then Canvas.Pixels[1, TR.Bottom - lOffset] := clBtnHighlight; + } end; end; // case end; - end else + + end + else begin {use shadow text for inactive folder text} Canvas.Font.Color := clHighlightText; SetBkMode(Canvas.Handle, OPAQUE); - DrawText(Canvas.Handle, Buf, -1, TR, Flags); + DrawText(Canvas.Handle, PChar(displayTxt), Length(displayTxt), TR, Flags); SetBkMode(Canvas.Handle, TRANSPARENT); Canvas.Font.Color := clBtnShadow; OffsetRect(TR, -2, -1); - DrawText(Canvas.Handle, Buf, -1, TR, Flags); + DrawText(Canvas.Handle, PChar(displayTxt), Length(displayTxt), TR, Flags); Canvas.Font.Color := FNavBar.Font.Color; end; + Canvas.Font.Style := savedFontStyle; end; procedure TVpNavBarPainter.DrawTopFolderButtons(Canvas: TCanvas; @@ -736,7 +706,6 @@ procedure TVpNavBarPainter.DrawTopFolderButtons(Canvas: TCanvas; var I: Integer; MyRect: TRect; - TR: TRect; begin CurPos := 0; MyRect := ARect; @@ -749,7 +718,7 @@ begin FNavBar.Folders[I].Rect := MyRect; {Draw the top tabs based on the selected style...} - TR := DrawTab(Canvas, MyRect, I, I = FHotFolder, I = nabLastMouseOverItem); + DrawTab(Canvas, MyRect, I); Inc(CurPos, FButtonHeight); end; end else begin @@ -768,6 +737,21 @@ begin end; end; +function TVpNavBarPainter.IsFocused(ATabIndex: Integer): Boolean; +begin + Result := ATabIndex = FHotFolder; +end; + +function TVpNavBarPainter.IsMouseOverFolder(ATabIndex: Integer): Boolean; +begin + Result := ATabIndex = FHotFolder; +end; + +function TVpNavBarPainter.IsMouseOverItem(ATabIndex: Integer): Boolean; +begin + Result := ATabIndex = nabLastMouseOverItem; +end; + procedure TVpNavBarPainter.Paint; var DrawBmp: TBitmap; @@ -812,679 +796,15 @@ begin { Draw the folder buttons at the bottom } DrawBottomFolderButtons(DrawBmp.Canvas, MyRect, CurPos); - finally + { Copy the buffer bitmap to the control } FNavBar.Canvas.CopyMode := cmSrcCopy; - FNavBar.Canvas.CopyRect(FNavBar.ClientRect, DrawBmp.Canvas, FNavBar.ClientRect); - DrawBmp.Free; - end; -end; + FNavBar.Canvas.CopyRect(MyRect, DrawBmp.Canvas, MyRect); - - - - -(* -var - I, J: Integer; - X: Integer; - W, H: Integer; - CurPos: Integer; - lOffset: Integer; - BkMode: Integer; - LabelWidth: Integer; - Flags: Integer; - MyRect: TRect; - TR: TRect; -// ContainerRect: TRect; -// FolderType: TVpFolderType; - BkColor: TColor; - Folder: TVpNavFolder; - Item: TVpNavBtnItem; - DrawBmp: TBitmap; - Text: string; - Buf: array[0..255] of Char; - DrawFolder: Boolean; - BM: TBitmap; - RowStart: Integer; - ILeft: Integer; - IHeight: Integer; - IWidth: integer; - Details: TThemedElementDetails; - TB: TThemedButton; -begin - if nabChanging then - Exit; - - DrawBmp := TBitMap.Create; - try - DrawBmp.Width := ClientWidth; - DrawBmp.Height := ClientHeight; - - DrawBmp.Canvas.Font := Self.Font; - with DrawBmp.Canvas do begin - Pen.Color := FBackgroundColor; - Brush.Color := FBackgroundColor; - - MyRect := ClientRect; - - DrawFolder := (FolderCount > 0); - if DrawFolder then - TR := nabGetFolderArea(FActiveFolder) - else - TR := ClientRect; - - if FBackgroundImage.Empty or (FBackgroundMethod = bmNone) then - Rectangle(TR.Left, TR.Top, TR.Right, TR.Bottom) - else begin - case FBackgroundMethod of - bmNormal: - Draw(TR.Left, TR.Top, FBackgroundImage); - bmStretch: - StretchDraw(TR, FBackgroundImage); - bmTile: - begin - {Tile the background in the default folder} - RowStart := 0; - IHeight := FBackgroundImage.Height; - IWidth := FBackgroundImage.Width; - ILeft := 0; - while (RowStart < ClientRect.Bottom) do begin - while (ILeft < ClientRect.Right) do begin - Draw(TR.Left + ILeft, RowStart, FBackgroundImage); - Inc(ILeft, IWidth); - end; - ILeft := 0; - Inc(RowStart, IHeight) - end; - end; - end; - end; - - CurPos := 0; - if FolderCount = 0 then begin - nabScrollUpBtn.Visible := False; - nabScrollDownBtn.Visible := False; - Exit; - end; - - {draw the folder buttons at the top} - if DrawFolder then begin - for I := 0 to FActiveFolder do begin - MyRect.Top := CurPos; - MyRect.Bottom := CurPos + FButtonHeight; - Folders[I].lfRect := MyRect; - - {Draw the top tabs based on the selected style...} - case FDrawingStyle of - dsDefButton: - begin - {Draw regular buttons} - if ThemeServices.ThemesEnabled then begin - if (I = nabLastMouseOverItem) then - TB := tbPushButtonHot - else - if (I = FHotFolder) and nabMouseDown then - TB := tbPushButtonPressed - else - TB := tbPushButtonNormal; - Details := ThemeServices.GetElementDetails(TB); - ThemeServices.DrawElement(Handle, details, MyRect); - TR := MyRect; - InflateRect(TR, -1, -1); - if I = FHotFolder then OffsetRect(TR, -1, -1); // Focused - end; -//TODO: TR := DrawButtonFace(DrawBmp.Canvas, MyRect, 1, bsNew, False, -// (I = FHotFolder) and nabMouseDown, False); - end; - - dsEtchedButton: - begin - {Draw regular etched (Win98 style) buttons} - Brush.Color := clBtnFace; - FillRect(MyRect); - Pen.Color := clBtnShadow; - Brush.Style := bsClear; - Rectangle(MyRect.Left, MyRect.Top, MyRect.Right - 1, MyRect.Bottom); - Pen.Color := clBtnHighlight; - MoveTo(MyRect.Left + 1, MyRect.Bottom - 2); - LineTo(MyRect.Left + 1, MyRect.Top + 1); - LineTo(MyRect.Right - 2, MyRect.Top + 1); - { Draw border around control. } - MoveTo(Width - 1, Top); - LineTo(Width - 1, Height - 1); - LineTo(0, Height - 1); - Pen.Color := clWindowFrame; - MoveTo(Width - 1, MyRect.Bottom); - LineTo(1, MyRect.Bottom); - LineTo(1, Height - 1); - TR := MyRect; - end; - - dsCoolTab: - begin - {Draw cool (Netscape Sidebar style) tabs} - TR := DrawNavTab( - DrawBmp.Canvas, {Canvas} - MyRect, {Client Rect} - 1, {Bevel Width} - FBackgroundColor, {Tab Color} - I, {Tab Number} - true, {Cool Tabs?} - (I = FHotFolder), {Is Focused} - (I = nabLastMouseOverItem) {MouseOverItem} - ); - end; - - dsStandardTab: - begin - {Draw regular old tabs} - TR := DrawNavTab( - DrawBmp.Canvas, {Canvas} - MyRect, {Client Rect} - 1, {Bevel Width} - FBackgroundColor, {Tab Color} - I, {Tab Number} - false, {Cool Tabs?} - (I = FHotFolder), {Is Focused} - (I = nabLastMouseOverItem) {MouseOverItem} - ); - end; - - end; - StrPLCopy(Buf, Folders[I].lfDisplayName, 255); - Inc(TR.Top); - Flags := DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX; - if Folders[I].Enabled then begin - DrawText(DrawBmp.Canvas.Handle, Buf, StrLen(Buf), TR, Flags); - if (I = FHotFolder) and not nabMouseDown then begin - case FDrawingStyle of - dsDefButton: - begin - { Regular button style. } - InflateRect(TR,1,1); - inc(TR.Left); - DrawBmp.Canvas.Frame3D(TR, 1,bvRaised); - end; - - dsEtchedButton: - begin - { Etched style (Outlook98). } - Pen.Color := clWindowFrame; - MoveTo(TR.Right - 2, TR.Top); - LineTo(TR.Right - 2, TR.Bottom - 1); - LineTo(0, TR.Bottom - 1); - Pen.Color := clBtnShadow; - if I = ActiveFolder then - lOffset := 1 - else - lOffset := 2; - MoveTo(TR.Right - 3, TR.Top - 2); - LineTo(TR.Right - 3, TR.Bottom - lOffset); - LineTo(1, TR.Bottom - lOffset); - if I = ActiveFolder then - Pixels[1, TR.Bottom - lOffset] := clBtnHighlight; - end; - end; // case - end; - end else - begin - {use shadow text for inactive folder text} - DrawBmp.Canvas.Font.Color := clHighlightText; - SetBkMode(Canvas.Handle, OPAQUE); - DrawText(DrawBmp.Canvas.Handle, Buf, -1, TR, Flags); - SetBkMode(DrawBmp.Canvas.Handle, TRANSPARENT); - DrawBmp.Canvas.Font.Color := clBtnShadow; - OffsetRect(TR, -2, -1); - DrawText(DrawBmp.Canvas.Handle, Buf, -1, TR, Flags); - DrawBmp.Canvas.Font.Color := Self.Font.Color; - end; - Inc(CurPos, FButtonHeight); - end; - end else - begin - if FDrawingStyle = dsEtchedButton then begin - { Draw border around control. } - Pen.Color := clBtnHighlight; - MoveTo(Width - 1, Top); - LineTo(Width - 1, Height - 1); - LineTo(0, Height - 1); - Pen.Color := clWindowFrame; - MoveTo(0, Height - 1); - LineTo(0, 1); - LineTo(Width - 2, 1); - end; - CurPos := 0; - end; - -//TODO: -{ BkMode := GetBkMode(Handle); - BkColor := GetBkColor(Handle); - SetBkColor(Handle, DWord(FBackgroundColor)); - SetBkMode(Handle, TRANSPARENT); -} - { draw the items for the active folder } - Folder := Folders[FActiveFolder]; - - if Folder.FolderType = ftDefault then - if Folder.ItemCount > 0 then begin - Inc(CurPos, 8); - with nabItemsRect do begin - Top := CurPos; - Left := 0; - Right := ClientWidth; - Bottom := ClientHeight - (FolderCount - FActiveFolder - 1) * FButtonHeight + 1; - end; - - for J := 0 to Folder.ItemCount-1 do - TVpNavBtnItem(Folder.Items[J]).FLabelRect.Bottom := nabItemsRect.Bottom + 1; - - for J := nabTopItem to Folder.ItemCount-1 do begin - if (FSelectedItem = J) then - DrawBmp.Canvas.Font := FSelectedItemFont - else - DrawBmp.Canvas.Font := FItemFont; - - Item := Folder.Items[J]; - { If the caption is empty at designtime then display the item's } - { name instead } - if (csDesigning in ComponentState) and (Item.Caption = '') then - Text := Item.Name - else - Text := Item.Caption; - - if Folder.IconSize = isLarge then begin {large icons} - { glyph is at the top } - with Item.FIconRect do begin - { If an image list is assigned then use the image } - { size. If no image list is assinged then assume } - { a 32 x 32 image size. } - if Assigned(FImages) then begin - W := FImages.Width + 2; - H := FImages.Height + 2; - end else begin - W := 32; - H := 32; - end; - Top := CurPos; - Bottom := CurPos + H; - Left := (ClientWidth - W) shr 1; - Right := Left + W; - if Top > nabItemsRect.Bottom then - Break; - - if FShowButtons then begin - if FActiveItem = J then begin - if nabMouseDown then - Pen.Color := clBlack - else - Pen.Color := clWhite; - MoveTo(Left-1, Bottom+1); - LineTo(Left-1, Top-1); - LineTo(Right+1, Top-1); - if nabMouseDown then - Pen.Color := clWhite - else - Pen.Color := clBlack; - LineTo(Right+1, Bottom+1); - LineTo(Left-1, Bottom+1); - end else begin - Pen.Color := FBackgroundColor; - Brush.Color := FBackgroundColor; - end; - if Assigned(FImages) and - (Item.IconIndex >= 0) and - (Item.IconIndex < FImages.Count) then - FImages.Draw(DrawBmp.Canvas, Item.FIconRect.Left + 2, - Item.FIconRect.Top + 2, Item.IconIndex); - {make the icon's bottom blend into the label's top} - Item.FIconRect.Bottom := Item.FIconRect.Bottom + 4; - end; - end; - Inc(CurPos, H + 4); - - {now, draw the text} - with Item.FLabelRect do begin - Top := CurPos; - Bottom := CurPos + (FButtonHeight shl 1) - 7; - Left := 0; - Right := ClientWidth - 1; - Item.liDisplayName := GetLargeIconDisplayName(DrawBmp.Canvas, Item.FLabelRect, Text); - X := DrawBmp.Canvas.TextWidth(Item.liDisplayName); - Left := (ClientWidth - X) div 2; - if Left < 5 then - Left := 5; - Right := Left + X; - if Right > ClientWidth-5 then - Right := ClientWidth-5; - if Top > nabItemsRect.Bottom then - Break; - end; - - StrPLCopy(Buf, Item.liDisplayName, 255); - DrawText(DrawBmp.Canvas.Handle, Buf, Length(Item.liDisplayName), Item.FLabelRect, - DT_CENTER or DT_VCENTER or DT_WORDBREAK or DT_CALCRECT); - LabelWidth := RectWidth(Item.FLabelRect); - with Item.FLabelRect do begin - Left := (ClientWidth - LabelWidth) div 2; - Right := Left + LabelWidth + 1; - end; - BkMode := SetBkMode(DrawBmp.Canvas.Handle, TRANSPARENT); - Inc(CurPos, DrawText( - DrawBmp.Canvas.Handle, Buf, Length(Item.liDisplayName), - Item.FLabelRect, DT_CENTER or DT_VCENTER or DT_WORDBREAK) - ); - SetBkMode(DrawBmp.Canvas.Handle, BkMode); - - Inc(CurPos, FItemSpacing); - end else begin {small icons} - {glyph is at the left} - with Item.FIconRect do begin - Top := CurPos; - lOffset := Abs(DrawBmp.Canvas.Font.Height) div 2; - if lOffset > 8 then - Top := Top + lOffset - 8; - Bottom := Top + 16; - Left := 8; - Right := Left + 16; - if Top > nabItemsRect.Bottom then - Break; - - if FShowButtons then begin - if FActiveItem = J then begin - if nabMouseDown then - Pen.Color := clBlack - else - Pen.Color := clWhite; - MoveTo(Left-1, Bottom+1); - LineTo(Left-1, Top-1); - LineTo(Right+1, Top-1); - if nabMouseDown then - Pen.Color := clWhite - else - Pen.Color := clBlack; - LineTo(Right+1, Bottom+1); - LineTo(Left-1, Bottom+1); - Brush.Color := FBackgroundColor; - end else begin - Pen.Color := FBackgroundColor; - Brush.Color := FBackgroundColor; - Rectangle( - Item.FIconRect.Left - 1, - Item.FIconRect.Top - 1, - Item.FIconRect.Right + 1, - Item.FIconRect.Bottom + 1 - ); - end; - if Assigned(FImages) then begin - BM := TBitmap.Create; - try - BM.Width := FImages.Width; - BM.Height := FImages.Height; - FImages.Draw(BM.Canvas, 0, 0, Item.IconIndex); -//TODO: DrawBmp.Canvas.BrushCopy(Item.FIconRect, BM, -// Rect(0, 0, BM.Width, BM.Height), BM.Canvas.Pixels[0, -// BM.Height-1]); - finally - BM.Free; - end; - end; - end; - {make the icon's right blend into the label's left} - Item.FIconRect.Right := Item.FIconRect.Right + 3; - end; - - {now, draw the text} - with Item.FLabelRect do begin - Top := CurPos; - Bottom := CurPos + (FButtonHeight shl 1) -7; - Left := Item.FIconRect.Right; - X := Self.ClientWidth - Left - 7; - Right := Left + X; - if Top > nabItemsRect.Bottom then - Break; - end; - Item.liDisplayName := - GetDisplayString(DrawBmp.Canvas, Text, 1, RectWidth(Item.FLabelRect)); - StrPLCopy(Buf, Item.liDisplayName, 255); - DrawText(DrawBmp.Canvas.Handle, Buf, Length(Item.liDisplayName), - Item.FLabelRect, DT_LEFT or DT_VCENTER or DT_CALCRECT); - LabelWidth := RectWidth(Item.FLabelRect); - with Item.FLabelRect do - Right := Left + LabelWidth + 1; - DrawText(DrawBmp.Canvas.Handle, Buf, Length(Item.liDisplayName), - Item.FLabelRect, DT_LEFT or DT_VCENTER); - - Inc(CurPos, FItemSpacing); - end; - end; - end; - - {now, draw the folder buttons at the bottom} - DrawBmp.Canvas.Font := Self.Font; - SetBkMode(Handle, BkMode); - SetBkColor(Handle, BkColor); - - case FDrawingStyle of - { Regular button style. } - dsDefButton : - CurPos := ClientHeight - FButtonHeight; - { Etched style (Outlook98). } - dsEtchedButton : - CurPos := ClientHeight - FButtonHeight - 1; - { Cool Tab } - dsCoolTab: - CurPos := ClientHeight - FButtonHeight; - { Regular Tab } - dsStandardTab: - CurPos := ClientHeight - FButtonHeight; - end; - - for I := FolderCount-1 downto FActiveFolder+1 do begin - MyRect.Top := CurPos; - MyRect.Bottom := CurPos + FButtonHeight; - Folders[I].lfRect := MyRect; - case FDrawingStyle of - dsDefButton : - begin - {Regular Old Buttons} - if ThemeServices.ThemesEnabled then begin - if (I = nabLastMouseOverItem) then - TB := tbPushButtonHot - else - if (I = FHotFolder) and nabMouseDown then - TB := tbPushButtonPressed - else - TB := tbPushButtonNormal; - Details := ThemeServices.GetElementDetails(TB); - ThemeServices.DrawElement(Handle, details, MyRect); - TR := MyRect; - InflateRect(TR, -1, -1); - if I = FHotFolder then OffsetRect(TR, -1, -1); // Focused - end; - - //TODO: TR := DrawButtonFace(DrawBmp.Canvas, MyRect, 1, bsNew, False, -// (I = FHotFolder) and nabMouseDown, False); - end; - - dsEtchedButton : - begin - {Etched (Outlook98 style) buttons} - Brush.Color := clBtnFace; - FillRect(MyRect); - Pen.Color := clBtnShadow; - Brush.Style := bsClear; - Rectangle(MyRect.Left, MyRect.Top, MyRect.Right - 1, MyRect.Bottom); - Pen.Color := clBtnHighlight; - MoveTo(MyRect.Left + 1, MyRect.Bottom - 2); - LineTo(MyRect.Left + 1, MyRect.Top + 1); - LineTo(MyRect.Right - 2, MyRect.Top + 1); - Pen.Color := clBtnHighlight; - MoveTo(Width - 1, 0); - LineTo(Width - 1, Height); - TR := MyRect; - end; - - dsCoolTab: - begin - {Draw cool (Netscape Sidebar style) tabs} - TR := DrawNavTab( - DrawBmp.Canvas, {Canvas} - MyRect, {Client Rect} - 1, {Bevel Width} - FBackgroundColor, {Tab Color} - I, {Tab Number} - true, {Cool Tabs?} - (I = FHotFolder), {Is Focused} - (I = nabLastMouseOverItem) {MouseOverItem} - ); - end; - - dsStandardTab: - begin - {Draw regular old tabs} - TR := DrawNavTab( - DrawBmp.Canvas, {Canvas} - MyRect, {Client Rect} - 1, {Bevel Width} - FBackgroundColor, {Tab Color} - I, {Tab Number} - false, {Cool Tabs?} - (I = FHotFolder), {Is Focused} - (I = nabLastMouseOverItem) {MouseOverItem} - ); - end; - - end; - Inc(TR.Top); - StrPLCopy(Buf, Folders[I].lfDisplayName, 255); - Flags := DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX; - if Folders[I].Enabled then begin - DrawText(DrawBmp.Canvas.Handle, Buf, StrLen(Buf), TR, Flags); - if (I = FHotFolder) and not nabMouseDown then begin - case FDrawingStyle of - dsDefButton: - begin - { Regular button style. } - InflateRect(TR,1,1); - inc(TR.Left); - DrawBmp.Canvas.Frame3D(TR,1,bvRaised); - end; - - dsEtchedButton : - begin - { Etched (Outlook98 style). } - Pen.Color := clWindowFrame; - MoveTo(TR.Right - 2, TR.Top); - LineTo(TR.Right - 2, TR.Bottom - 1); - LineTo(0, TR.Bottom - 1); - Pen.Color := clBtnShadow; - MoveTo(TR.Right - 3, TR.Top - 2); - LineTo(TR.Right - 3, TR.Bottom - 2); - LineTo(1, TR.Bottom - 2); - end; - end; - end; - end else begin - {use shadow text for inactive folder text} - DrawBmp.Canvas.Font.Color := clHighlightText; - SetBkMode(Canvas.Handle, OPAQUE); - DrawText(DrawBmp.Canvas.Handle, Buf, -1, TR, Flags); - SetBkMode(DrawBmp.Canvas.Handle, TRANSPARENT); - DrawBmp.Canvas.Font.Color := clBtnShadow; - OffsetRect(TR, -2, -1); - DrawText(DrawBmp.Canvas.Handle, Buf, -1, TR, Flags); - DrawBmp.Canvas.Font.Color := Self.Font.Color; - end; - Dec(CurPos, FButtonHeight); - end; - - if not (csDesigning in ComponentState) then begin - {show the top scroll button} - if nabShowScrollUp then begin - nabScrollUpBtn.Top := Folders[FActiveFolder].lfRect.Bottom + 5; - nabScrollUpBtn.Left := ClientWidth - 20; - nabScrollUpBtn.Visible := True; - end else - nabScrollUpBtn.Visible := False; - - {show the bottom scroll button} - if nabShowScrollDown then begin - if FActiveFolder = FolderCount-1 then - {there are no folders beyond the active one} - nabScrollDownBtn.Top := ClientHeight -20 - else - nabScrollDownBtn.Top := Folders[FActiveFolder+1].lfRect.Top - 20; - nabScrollDownBtn.Left := ClientWidth - 20; - nabScrollDownBtn.Visible := True; - end else - nabScrollDownBtn.Visible := False; - end; - - {if we're dragging, show the drag marker} - if (nabDragFromItem <> -1) or nabExternalDrag then begin - if (nabDropY <> -1) then begin - { Don't draw the drag marker if we're doing external } - { dragging and the cursor is over an item. } - if nabExternalDrag then - if not nabFolderAccept or nabCursorOverItem then - Exit; - Pen.Color := clBlack; - Brush.Color := clBlack; - MoveTo(5, nabDropY); - LineTo(ClientWidth - 5, nabDropY); - DrawBmp.Canvas.Polygon([ - Point(3, nabDropY+4), - Point(7, nabDropY), - Point(3, nabDropY-4) - ]); - DrawBmp.Canvas.FloodFill(5, nabDropY, clBlack, fsBorder); - DrawBmp.Canvas.Polygon([ - Point(ClientWidth-3,nabDropY+4), - Point(ClientWidth-7,nabDropY), - Point(ClientWidth-3,nabDropY-4) - ]); - DrawBmp.Canvas.FloodFill(ClientWidth-5, nabDropY, clBlack, fsBorder); - end; - end; - end; finally - Canvas.CopyMode := cmSrcCopy; - Canvas.CopyRect(ClientRect, DrawBmp.Canvas, ClientRect); DrawBmp.Free; end; - - {For container style folders...} - - {Hide the containers for all inactive folders} - for I := 0 to FFolders.Count - 1 do begin - if I <> FActiveFolder then begin - if Folders[i].FolderType = ftContainer then - with Containers[Folders[i].ContainerIndex] do begin - Width := 0; - Height := 0; - Visible := false; - end; - end; - end; - - Folder := Folders[FActiveFolder]; - TR := nabGetFolderArea(FActiveFolder); - - if Folder.FolderType = ftContainer then - with Containers[Folder.ContainerIndex] do begin - {Position and show the folder's container} - Height := TR.Bottom - TR.Top; - Top := TR.Top; - Left := TR.Left; - Width := TR.Right - TR.Left; - Visible := true; - BringToFront; - - for I := 0 to ControlCount - 1 do - Controls[i].Invalidate; - end; end; -*) + { Given a string, and a rectangle, find the string that can be displayed using two lines. Add ellipsis to the end of each line if necessary and