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;