Changeset 217 for Docking/CoolDocking/UCDManager.pas

Timestamp:

Mar 22, 2011, 11:32:28 AM (13 years ago)

Author:

george

Message:

• Fixed: If control docked to panel owned by main form then it was possible to redock main form to conjoin form.
• Modified: Header title is now painted to canvas instead of use of TLabel. This will be necessary to draw rotated text later.
• Added: Length of header title is now reduced to not overlap to header buttons area.

File:

• Docking/CoolDocking/UCDManager.pas (modified) (10 diffs)

Docking/CoolDocking/UCDManager.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, UCDCommon, Controls, Contnrs, Dialogs,
-  UCDPopupMenu, LCLType, LMessages, Graphics, Buttons,
+  UCDPopupMenu, LCLType, LCLIntf, LMessages, Graphics, Buttons,
   UCDConjoinForm, Menus, StdCtrls, ExtCtrls, Forms;
 
@@ -30 +30 @@
   TCDHeader = class(TPanel)
   private
+    MyFont: hFont;
     procedure CloseButtonClick(Sender: TObject);
     procedure PaintExecute(Sender: TObject);
@@ -35 +36 @@
   public
     Buttons: TObjectList; // TList<TCDHeaderButton>
-    Title: TLabel;
     Icon: TImage;
     ManagerItem: TCDManagerItem;
@@ -67 +67 @@
     procedure SetHideType(const AValue: TCDHideType);
   public
-    Control: TControl;
+    Control: TWinControl;
     Manager: TCDManager;
     procedure DockPanelMouseDown(Sender: TObject; Button: TMouseButton;
@@ -139 +139 @@
   end;
 
-function HeaderPosToTabPos(HeaderPos: THeaderPos): TTabPosition;
-
 
 implementation
@@ -148 +146 @@
   UCDResource;
 
-function HeaderPosToTabPos(HeaderPos: THeaderPos): TTabPosition;
-begin
-  case HeaderPos of
-    hpBottom: Result := tpBottom;
-    hpLeft: Result := tpLeft;
-    hpTop: Result := tpTop;
-    hpRight: Result := tpRight;
-    hpAuto: Result := tpTop;
-  end;
+function CreateRotatedFont(F: TFont; Angle: Integer): Integer;
+var
+  LF: TLogFont;
+begin
+  FillChar(LF, SizeOf(LF), #0);
+  with LF do begin
+    lfHeight := F.Height;
+    lfWidth := 0;
+    lfEscapement := Angle * 10;
+    lfOrientation := 0;
+    if fsBold in F.Style then
+      lfWeight := FW_BOLD
+    else
+      lfWeight := FW_NORMAL;
+    lfItalic := Byte(fsItalic in F.Style);
+    lfUnderline := Byte(fsUnderline in F.Style);
+    lfStrikeOut := Byte(fsStrikeOut in F.Style);
+    lfCharSet := DEFAULT_CHARSET;
+    StrPCopy(lfFaceName, F.Name);
+    lfQuality := DEFAULT_QUALITY;
+    {everything else as default}
+    lfOutPrecision := OUT_DEFAULT_PRECIS;
+    lfClipPrecision := CLIP_DEFAULT_PRECIS;
+    case F.Pitch of
+      fpVariable: lfPitchAndFamily := VARIABLE_PITCH;
+      fpFixed: lfPitchAndFamily := FIXED_PITCH;
+    else
+      lfPitchAndFamily := DEFAULT_PITCH;
+    end;
+  end;
+  Result := CreateFontIndirect(LF);
 end;
 
@@ -179 +199 @@
   if FHeaderPos=AValue then exit;
   FHeaderPos:=AValue;
+
   //Paint(Self);
 end;
@@ -580 +601 @@
   inherited Create(TheOwner);
   OnPaint := PaintExecute;
-
-  Title := TLabel.Create(Self);
-  with Title do begin
-    Parent := Self;
-    Visible := True;
-    Top := 4;
-    Left := 6;
-    BevelInner := bvNone;
-    BevelOuter := bvNone;
-  end;
+  //MyFont := CreateRotatedFont(Canvas.Font, 90);
+
   Buttons := TObjectList.Create;
 
@@ -642 +655 @@
 var
   Points: array of TPoint;
-begin
+  TitleLeft: Integer;
+  TitleWidth: Integer;
+  TitleMaxWidth: Integer;
+  I: Integer;
+  Title: string;
+  R: TRect;
+begin
+  with TCDManager(TWinControl(ManagerItem.Control).DockManager) do
+  case HeaderPos of
+    hpLeft: begin
+      Align := alLeft;
+      Width := GrabberSize;
+    end;
+    hpTop, hpAuto: begin
+      Align := alTop;
+      Height := GrabberSize;
+    end;
+    hpRight: begin
+      Align := alRight;
+      Width := GrabberSize;
+    end;
+    hpBottom: begin
+      Align := alBottom;
+      Height := GrabberSize;
+    end;
+  end;
+
   if (ManagerItem.Control as TWinControl).Focused then
-  Title.Font.Style := Font.Style + [fsBold]
-  else Title.Font.Style := Font.Style - [fsBold];
-
-  if Icon.Picture.Width > 0 then Title.Left := 8 + Icon.Picture.Width
-    else Title.Left := 6;
-  Title.Caption := ManagerItem.Control.Caption;
+  Canvas.Font.Style := Canvas.Font.Style + [fsBold]
+  else Canvas.Font.Style := Canvas.Font.Style - [fsBold];
+
   RearrangeButtons;
 
@@ -689 +725 @@
     Pen.Color := BorderColor;
     Polyline(Points);
+
+    Canvas.Brush.Style := bsClear;
+    TitleMaxWidth := Self.Width - 6;
+    for I := 0 to Buttons.Count - 1 do
+      if TCDHeaderButton(Buttons[I]).Visible then
+        Dec(TitleMaxWidth, TCDHeaderButton(Buttons[I]).Icon.Width + 2);
+    if Icon.Picture.Width > 0 then begin
+      TitleLeft := 8 + Icon.Picture.Width;
+      Dec(TitleMaxWidth, Icon.Picture.Width + 2)
+    end else TitleLeft := 6;
+
+    //SelectObject(Canvas.Handle, MyFont);
+    Title := ManagerItem.Control.Caption;
+    if (TextWidth(Title) > TitleMaxWidth) then begin
+      while (Length(Title) > 0) and (TextWidth(Title + '...') > TitleMaxWidth) do begin
+        Delete(Title, Length(Title), 1);
+      end;
+      Title := Title + '...';
+    end;
+
+    R := Rect(TitleLeft, 4, TitleLeft + TitleMaxWidth, 4 + TextHeight(Title));
+    TextRect(R, TitleLeft, 4, Title);
   end;
 end;