lazarus/examples/dockmanager/easytree/zoneheader.inc

type
  TDockHeaderImageKind =
  (
    dhiRestore,
    dhiClose
  );

  TDockHeaderImages = array[TDockHeaderImageKind] of TCustomBitmap;

const
  DockHeaderImageNames: array[TDockHeaderImageKind] of String =
  (
{ dhiRestore } 'easy_dock_restore',
{ dhiClose   } 'easy_dock_close'
  );

var
  DockBtnImages: TDockHeaderImages;


procedure CreateDockHeaderImages;
var
  ImageKind: TDockHeaderImageKind;
begin
  for ImageKind := Low(TDockHeaderImageKind) to High(TDockHeaderImageKind) do
    DockBtnImages[ImageKind] := CreateBitmapFromLazarusResource(DockHeaderImageNames[ImageKind]);
end;

procedure DestroyDockHeaderImages;
var
  ImageKind: TDockHeaderImageKind;
begin
  for ImageKind := Low(TDockHeaderImageKind) to High(TDockHeaderImageKind) do
    FreeAndNil(DockBtnImages[ImageKind]);
end;


{ TEasyDockHeader }

type
  TZonePartMap = record
    dTop, dBottom, dLeft, dRight: integer;
  end;

const //zone decoration sizes
  dSizer = 4;
  dBorder = 2; //frame and inner bevel
  dDist = 1; //button distance
  dButton = 14; //include some space for themes
  dHeader = dButton + 2*dBorder; // 22 - dSizer; //splitter outside header!

(* Zone part map.
  In portrait mode (header on top), the zone rectangle is adjusted according
  to the given offsets. In landscape mode (header on the left), the offsets
  have to be applied to the rotated coordinates.

  Positive offsets mean self-relative adjustment, towards the opposite edge.
  This operation has highest precedence.
  Negative offsets mean adjustment relative to the adjusted opposite edge.

  zpAll excludes the splitter and client area.
  zpCaption excludes borders and buttons from zpAll.
*)
{$IFDEF newSplitter}
(*
  The map reflects new splitter placement (past client area),
  and no restore button.
*)
HeaderPartMap: array[TEasyZonePart] of TZonePartMap = (
  (),    //zpNowhere
  (dTop:dHeader; dBottom:0),    //zpClient
  (dTop:0; dBottom:-dHeader),    //zpAll
  (dTop:dBorder; dBottom:-dButton; dLeft:dBorder; dRight:dBorder+dButton),    //zpCaption
  (dTop:-dSizer),    //zpSizer
  {$IFDEF restore}
  (...),    //zpRestoreButton
  {$ENDIF}
  (dTop:dBorder; dBottom:-dButton; dLeft:-dButton; dRight:dBorder)    //zpCloseButton
);
{$ELSE}
(* Sizer in header, just before caption
*)
HeaderPartMap: array[TEasyZonePart] of TZonePartMap = (
  (),    //zpNowhere - not in any zone
  (dTop:dHeader+dSizer; dBottom:0),    //zpClient - on client control
  (dTop:dSizer; dBottom:-dHeader),    //zpAll - total header rect
  (dTop:dSizer+dBorder; dBottom:-dButton; dLeft:dBorder; dRight:dBorder+dButton),    //zpCaption
  (dTop:0; dBottom:-dSizer),    //zpSizer - splitter/sizer
  {$IFDEF restore}
  (dTop:dSizer+dBorder; dBottom:-dButton; dLeft:-dButton; dRight:dButton+2*dBorder)    //zpRestoreButton,  // header restore button
  {$ENDIF}
  (dTop:dSizer+dBorder; dBottom:-dButton; dLeft:-dButton; dRight:dBorder)    //zpCloseButton     // header close button
);
{$ENDIF}

constructor TEasyDockHeader.Create;

  procedure dump;
  var
    r, r2: TRect;
  const
    hc = true;
    orn = doVertical;
  begin
    r := Rect(0, 0, 200, 200); //LTBR
    r2 := GetRectOfPart(r, orn, zpAll, hc);
    DebugLn('%s (%d,%d)-(%d,%d)', ['header ', r2.Top, r2.Left, r2.Bottom, r2.Right]);
    r2 := GetRectOfPart(r, orn, zpCaption, hc);
    DebugLn('%s (%d,%d)-(%d,%d)', ['caption', r2.Top, r2.Left, r2.Bottom, r2.Right]);
    r2 := GetRectOfPart(r, orn, zpCloseButton, hc);
    DebugLn('%s (%d,%d)-(%d,%d)', ['closer ', r2.Top, r2.Left, r2.Bottom, r2.Right]);
    r2 := GetRectOfPart(r, orn, zpClient, hc);
    DebugLn('%s (%d,%d)-(%d,%d)', ['client ', r2.Top, r2.Left, r2.Bottom, r2.Right]);
    r2 := GetRectOfPart(r, orn, zpSizer, hc);
    DebugLn('%s (%d,%d)-(%d,%d)', ['sizer  ', r2.Top, r2.Left, r2.Bottom, r2.Right]);
  end;

begin
  HeaderSize := dHeader; //some meaningful value?
//debug
  //dump;
end;

class function TEasyDockHeader.GetRectOfPart(ARect: TRect; AOrientation: TDockOrientation;
  APart: TEasyZonePart; HasSplitter: boolean): TRect;
begin
(* ARect is (must be) TLBR zone rectangle, on input.
*)
  if (APart = zpNowhere) or ((APart = zpSizer) and not HasSplitter) then begin
    Result := Rect(0,0,0,0);
    exit;
  end;

  Result := ARect;
  with HeaderPartMap[APart] do begin
    if AOrientation = doVertical then begin //portrait
      if dTop > 0 then
        inc(Result.Top, dTop);
      if dBottom > 0 then
        dec(Result.Bottom, dBottom)
      else if dBottom < 0 then
        Result.Bottom := Result.Top - dBottom;
      if dTop < 0 then
        Result.Top := Result.Bottom + dTop;
      if dLeft > 0 then
        inc(Result.Left, dLeft);
      if dRight > 0 then
        dec(Result.Right, dRight)
      else if dRight < 0 then
        Result.Right := Result.Left + dRight;
      if dLeft < 0 then
        Result.Left := Result.Right + dLeft;
    {$IFDEF newSplitter}
    //handle client w/o splitter
      if (APart = zpClient) and HasSplitter then
        dec(Result.Bottom, dSizer);
    {$ELSE}
    {$ENDIF}
    end else begin //landscape
      if dTop > 0 then
        inc(Result.Left, dTop);
      if dBottom > 0 then
        dec(Result.Right, dBottom)
      else if dBottom < 0 then
        Result.Right := Result.Left - dBottom;
      if dTop < 0 then
        Result.Left := Result.Right + dTop;

      if dLeft > 0 then
        dec(Result.Bottom, dLeft);
      if dRight > 0 then
        inc(Result.Top, dRight)
      else if dRight < 0 then
        Result.Top := Result.Bottom + dRight;
      if dLeft < 0 then
        Result.Bottom := Result.Top - dLeft;
    {$IFDEF newSplitter}
    //handle client w/o splitter
      if (APart = zpClient) and HasSplitter then
        dec(Result.Right, dSizer);
    {$ELSE}
    {$ENDIF}
    end;
  end;
end;

function TEasyDockHeader.FindPart(AZone: TEasyZone; MousePos: TPoint; fButtonDown: boolean): TEasyZonePart;
var
  SubRect, r: TRect;
  Control: TControl;
  Part: TEasyZonePart;
  aHandle : HWND;

  function MouseInPart(APart: TEasyZonePart): boolean;
  begin
  //on hit: retain Part and SubRect
    SubRect := GetRectOfPart(r, Control.DockOrientation, APart, AZone.HasSizer);
    Result := PtInRect(SubRect, MousePos);
    if Result then
      Part := APart;
  end;

begin
(* Called from mouse message handler (only!).
  Remember draw state of current zone.
*)
  r := AZone.GetBounds;
  if (AZone.FChildControl = nil) or not PtInRect(r, MousePos) then
  //possibly empty root zone
    Result := zpNowhere
  else begin
    Control := AZone.FChildControl;
    if MouseInPart(zpSizer) or MouseInPart(zpCloseButton)
    {$IFDEF restore}
      or MouseInPart(zpRestoreButton)
    {$ENDIF}
    or MouseInPart(zpClient)
    then
      //all done, result stored in Part
    else
      Part := zpCaption; //include borders
  end;

  aHandle:=AZone.GetHandle;
//check old state changed - buttons also change state on mouse enter/exit
  if (self.MouseZone <> nil) //else Mouse... invalid
  and ((MouseZone <> AZone) or (MousePart in HeaderButtons)) then
      InvalidateRect(aHandle, @PartRect, false); //old button
//check new state
  if (Part in HeaderButtons) then begin
    InvalidateRect(aHandle, @SubRect, false); //refresh button
  end;
//set new state
  MouseZone := AZone;
  MousePart := Part;
  MouseDown := fButtonDown;
  PartRect := SubRect;
//done
  Result := Part;
end;

procedure TEasyDockHeader.Draw(AZone: TEasyZone; ACanvas: TCanvas; ACaption: string; const MousePos: TPoint);
(* Problem with colors on other than win32 widgetsets (gtk2...)
*)
const
  clBack = clHighlight;
  clFont = clHighlightText;

var
  IsMouseDown: Boolean;

  //procedure DrawButton(ARect: TRect; IsMouseDown, IsMouseOver: Boolean; ABitmap: TCustomBitmap); inline;
  procedure DrawButton(ARect: TRect; ABitmap: TCustomBitmap);
  const
    // ------------- Pressed, Hot -----------------------
    BtnDetail: array[Boolean, Boolean] of TThemedToolBar =
    (
     (ttbButtonNormal, ttbButtonHot),
     (ttbButtonNormal, ttbButtonPressed)
    );
  var
    Details: TThemedElementDetails;
    dx, dy: integer;
    IsMouseOver: boolean;
  begin
    ACanvas.FillRect(ARect);
    IsMouseOver := PtInRect(ARect, MousePos);
    Details := ThemeServices.GetElementDetails(BtnDetail[IsMouseDown, IsMouseOver]);
    ThemeServices.DrawElement(ACanvas.Handle, Details, ARect);
    ARect := ThemeServices.ContentRect(ACanvas.Handle, Details, ARect);
  //move button into rect, excluding border
    dx := (ARect.Right - ARect.Left - ABitmap.Width) div 2;
    dy := (ARect.Bottom - ARect.Top - ABitmap.Height) div 2;
    ACanvas.Draw(ARect.Left + dx, ARect.Top + dy, ABitmap);
  end;

var
  BtnRect: TRect;
  ARect, DrawRect: TRect;
  // LCL doesn't handle orientation in TFont
  OldFont, RotatedFont: HFONT;
  OldMode: Integer;
  ALogFont: TLogFont;
  AOrientation: TDockOrientation;
  AControl: TControl;
begin
(* Some colors inavailable on some widgetsets!
*)
  IsMouseDown := (GetKeyState(VK_LBUTTON) and $80) <> 0;
//debug
  AControl := AZone.FChildControl;
  AOrientation := AControl.DockOrientation;

  ARect := AZone.GetBounds;
  ACanvas.Brush.Color := clBtnFace;

//draw splitter?
  if AZone.HasSizer then begin
  // border?
    BtnRect := GetRectOfPart(ARect, AOrientation, zpSizer, AZone.HasSizer);
    ACanvas.FillRect(BtnRect);
  end;

//erase - which color(s)?
  DrawRect := GetRectOfPart(ARect, AOrientation, zpAll, AZone.HasSizer);
  //ACanvas.Brush.Color := clBack; // clActiveCaption;
  ACanvas.FillRect(DrawRect);

//border
  InflateRect(DrawRect, -1, -1); //outer bevel?
  ACanvas.Brush.Color := clBtnShadow;
  ACanvas.FrameRect(DrawRect); //1 pixel border
  //InflateRect(DrawRect, -1, -1); //inner bevel?
    //the value is not used any more!
  ACanvas.Brush.Color := clBtnFace;

// draw caption
  //ACanvas.Font.Color := clFont; //clCaptionText;
  DrawRect := GetRectOfPart(ARect, AOrientation, zpCaption, AZone.HasSizer);

  OldMode := SetBkMode(ACanvas.Handle, TRANSPARENT);

//for some reason the caption is not offset properly?
  if AOrientation = doVertical then begin
    inc(DrawRect.Left, 2);
    DrawText(ACanvas.Handle, PChar(ACaption), -1, DrawRect, DT_LEFT or DT_SINGLELINE or DT_VCENTER)
  end else begin
    OldFont := 0;
    if GetObject(ACanvas.Font.Reference.Handle, SizeOf(ALogFont), @ALogFont) <> 0 then
    begin
      ALogFont.lfEscapement := 900;
      RotatedFont := CreateFontIndirect(ALogFont);
      if RotatedFont <> 0 then
        OldFont := SelectObject(ACanvas.Handle, RotatedFont);
    end;
    // from msdn: DrawText doesnot support font with orientation and escapement <> 0
    //TextOut(ACanvas.Handle, DrawRect.Left, DrawRect.Bottom, PChar(ACaption), Length(ACaption));
    TextOut(ACanvas.Handle, DrawRect.Left-2, DrawRect.Bottom-2, PChar(ACaption), Length(ACaption));
    if OldFont <> 0 then
      DeleteObject(SelectObject(ACanvas.Handle, OldFont));
  end;
  SetBkMode(ACanvas.Handle, OldMode);

// buttons - which colors to use?
  ACanvas.Brush.Color := clBtnFace;
  //ACanvas.Pen.Color := clButtonText;

// draw close button
  BtnRect := GetRectOfPart(ARect, AOrientation, zpCloseButton, AZone.HasSizer);
  DrawButton(BtnRect, DockBtnImages[dhiClose]);

{$IFDEF restore}
// draw restore button
  BtnRect := GetRectOfPart(ARect, AOrientation, zpRestoreButton, AZone.HasSizer);
  DrawButton(BtnRect, DockBtnImages[dhiRestore]);
{$ENDIF}
end;