outlookbar.pas

企业ERP管理系统

//      Inc(Left, (Right - Left - aw) div 2 - 2);
//      Inc(Top, (Bottom - Top - ah) div 2 - 2);
//      Right := Left + aw + 4;
//      Bottom := Top + ah + 4;
//    end;
//    isSmall: with Result do Right := Left + ItemIndent * 2;
//  end;
end;

function TCustomOutlookBar.GetItemBorderRect(Item: TOutlookBarItem; ARect: 
    TRect; IncludeCaption: Boolean = False): TRect;
var
  i, lb, tb, lt, tt: Integer;
  s: TSize;
  ml: TCustomImageList;
begin
  ml := nil;
  Canvas.Font := Font;
  s := Canvas.TextExtent(Item.Caption);
  case Item.Page.IconStyle of
    isLarge:
    begin
      i := ARect.Right - ARect.Left;
      tb := ItemIndent + ARect.Top;
      lt := (i - s.Cx) div 2 + ARect.Left;
      if Assigned(LargeImages) then
      begin
        ml := LargeImages;
        tt := tb + LargeImages.Height + ItemIndent;
        lb := (i - LargeImages.Width) div 2 + ARect.Left;
      end
      else
      begin
        tt := tb;
        lb := 0;
      end;
    end;
    isSmall:
    begin
      i := ARect.Bottom - ARect.Top;
      lb := ItemIndent + ARect.Left;
      tt := (i - s.Cy) div 2 + ARect.Top;
      if Assigned(SmallImages) then
      begin
        ml := SmallImages;
        lt := lb + SmallImages.Height + ItemIndent;
        tb := (i - SmallImages.Height) div 2 + ARect.Top;
        s := Canvas.TextExtent(Item.Caption);
      end
      else
      begin
        lt := lb;
        tb := 0;
      end;
    end;
  else
    lt := 0;
    tt := 0;
    lb := 0;
    tb := 0;
  end;
  if Assigned(ml) then
  begin
    Result.Left := lb - 2;
    Result.Top := tb - 2;
    Result.Right := Result.Left + ml.Width + 4;
    Result.Bottom := Result.Top + ml.Height + 4;
    if IncludeCaption then
      case Item.Page.IconStyle of
        isLarge:;
        isSmall: Result.Right := Result.Right + s.cx + 4;
      end;
  end
  else
  begin
    Result.Left := lt - 2;
    Result.Top := tt - 2;
    Result.Right := Result.Left + s.cx + 4;
    Result.Bottom := Result.Top + s.cy + 4;
  end;
  OffsetRect(Result, Item.Level shl 4, 0);
end;

procedure TCustomOutlookBar.DrawPageTitle(Page:TOutlookBarPage; const ARect:TRect);
var
  s:TSize;
begin
  with Canvas do
  begin
    Brush.Color := clBtnFace; //????
    Canvas.Font := Font;
    Canvas.Font.Color := clBtnText;
    s := TextExtent(Page.Caption);
    with ARect Do
      TextRect(ARect, Left + (Right - Left - s.Cx) div 2,
        Top + (Bottom - Top - s.Cy) div 2, Page.Caption);
  end;
  DrawPageTitleBorder(Page, ARect,[dsRedraw]);
end;

procedure TCustomOutlookBar.DrawPageTitleBorder(Page:TOutlookBarPage; const ARect:TRect; ADrawStyle: TDrawOutlookBarPageTitleBorderStyle);
var
  pt:TPoint;
  rt:TRect;
begin
//  if (Page.FLastDrawTitleBorderStyle = ADrawStyle) and not (dsRedraw in ADrawStyle) then Exit;
  Page.FLastDrawTitleBorderStyle := ADrawStyle;
  if dsRedraw in Page.FLastDrawTitleBorderStyle then
  begin
    Page.FLastDrawTitleBorderStyle := [];
    if Flat then Include(Page.FLastDrawTitleBorderStyle, dsFlat);
    if Page.FDown then Include(Page.FLastDrawTitleBorderStyle, dsDown);
    GetCursorPos(pt);
    pt := ScreenToClient(pt);
    if ptinRect(rt, pt) then Include(Page.FLastDrawTitleBorderStyle, dsHot);
  end;
  rt := ARect;
  Canvas.Brush.Color := clBtnface; //????
  Canvas.FrameRect(rt);
  InflateRect(rt, -1, -1);
  Canvas.FrameRect(rt);
  //删除边框

  rt := ARect;
  if dsDown in Page.FLastDrawTitleBorderStyle then
  begin
    DrawEdge(Canvas.Handle, rt, BDR_SUNKENINNER, BF_TOPLEFT);
    DrawEdge(Canvas.Handle, rt, BDR_SUNKENOUTER, BF_BOTTOMRIGHT);
    InflateRect(rt, -1, -1);
    DrawEdge(Canvas.Handle, rt, BDR_SUNKENOUTER, BF_TOPLEFT);
    DrawEdge(Canvas.Handle, rt, BDR_SUNKENINNER, BF_BOTTOMRIGHT);
  end
  else
    if dsFlat in Page.FLastDrawTitleBorderStyle then
    begin
      if dsHot in Page.FLastDrawTitleBorderStyle then
      begin
        DrawEdge(Canvas.Handle, rt, BDR_RAISEDINNER, BF_TopLeft);
        DrawEdge(Canvas.Handle, rt, BDR_RAISEDOuter, BF_BottomRight);
        InflateRect(rt, -1, -1);
        DrawEdge(Canvas.Handle, rt, BDR_RAISEDInner, BF_BottomRight);
      end
      else
      begin
        DrawEdge(Canvas.Handle, rt, BDR_RAISEDINNER, BF_RECT);
        InflateRect(rt, -1, -1);
      end;
    end
    else
      DrawEdge(Canvas.Handle, rt, EDGE_RAISED, BF_RECT);
end;

procedure TCustomOutlookBar.DrawItems(const ARect: TRect);
var
  rt, wkrt, irt: TRect;
  n: TOutlookBarItem;
  orgn, rgn: HRGN;
begin
  wkrt := GetWorkArea;
  IntersectRect(rt, ARect, wkrt);
  if IsRectEmpty(rt) then Exit;
  Canvas.Brush.Color := Color;
  Canvas.FillRect(rt);
  if Pages.Count = 0 then Exit;
  n := GetItemAt(ARect.Left, ARect.Top);
  if not Assigned(n) then n := Pages[PageIndex].Items.GetVisibleItem(Pages[PageIndex].FOffset);
  orgn := CreateRectRgnIndirect(rt);
  rgn := CreateRectRgnIndirect(rt);
  try
    GetClipRgn(Canvas.Handle, orgn);
    SelectClipRgn(Canvas.Handle, rgn);
    while Assigned(n) do
    begin
      irt := GetItemRect(n);
      if irt.Top > rt.Bottom then Break;
      DrawItem(n, irt);
      DrawItemBorder(n, irt, [dsRedraw]);
      n := n.GetNextVisible;
    end;
    SelectClipRgn(Canvas.Handle, orgn);
  finally
    DeleteObject(rgn);
    DeleteObject(orgn);
  end;
  if not FAnimating then DrawScrollButtons;
  DrawEdge(Canvas.Handle, wkrt, BDR_SUNKENINNER, BF_TopLeft);
end;

procedure TCustomOutlookBar.MeasurePageTitle(Page:TOutlookBarPage; var Width, Height: Integer);
var
  S: string;
begin
  if Page.Caption = EmptyStr then S := 'Wg' else S := Page.Caption;
  TextSize(Font, S, Width, Height);
  Inc(Width,8); //????
  Inc(Height,8); //????
end;

procedure TCustomOutlookBar.MeasureItem(Item:TOutlookBarItem; var Width, Height: Integer);
begin
  TextSize(Font, Item.Caption, Width, Height);
  case Item.Page.IconStyle of
    isLarge:
    begin
      if Assigned(LargeImages) then
      begin
        if LargeImages.Width > Width then Width := LargeImages.Width;
        Inc(Height, LargeImages.Height + ItemIndent);
      end;
    end;
    isSmall:
    begin
      if Assigned(SmallImages) then
      begin
        if SmallImages.Height > Height then Height := SmallImages.Height;
        Inc(Width, SmallImages.Width + ItemIndent);
      end;
    end;
  end;
  Inc(Width, ItemIndent shl 1);
  Inc(Height, ItemIndent shl 1);
end;

procedure TCustomOutlookBar.DrawItem(Item:TOutlookBarItem; const ARect: TRect);
var
  i, lb, tb, lt, tt: Integer;
  s: TSize;
  ml: TCustomImageList;
begin
  ml := nil;
  Canvas.Font := Font; //????
  Canvas.Font.Color := clHighLightText;
  s := Canvas.TextExtent(Item.Caption);
  case Item.Page.IconStyle of
    isLarge:
    begin
      i := ARect.Right - ARect.Left;
      tb := ItemIndent + ARect.Top;
      lt := (i - s.Cx) div 2 + ARect.Left;
      if Assigned(LargeImages) then
      begin
        ml := LargeImages;
        tt := tb + LargeImages.Height + ItemIndent;
        lb := (i - LargeImages.Width) div 2 + ARect.Left;
      end
      else
      begin
        tt := tb;
        lb := 0;
      end;
    end;
    isSmall:
    begin
      i := ARect.Bottom - ARect.Top;
      lb := ItemIndent + ARect.Left;
      tt := (i - s.Cy) div 2 + ARect.Top;
      if Assigned(SmallImages) then
      begin
        ml := SmallImages;
        lt := lb + SmallImages.Height + ItemIndent;
        tb := (i - SmallImages.Height) div 2 + ARect.Top;
        s := Canvas.TextExtent(Item.Caption);
      end
      else
      begin
        lt := lb;
        tb := 0;
      end;
    end;
  else
    lt := 0;
    tt := 0;
    lb := 0;
    tb := 0;
  end;
  Inc(lb, Item.Level shl 4);
  Inc(lt, Item.Level shl 4);
  if Assigned(ml) then ml.Draw(Canvas, lb, tb, Item.ImageIndex);
  Canvas.TextOut(lt, tt, Item.Caption);
//  DrawItemBorder(Item, ARect, [dsRedraw]);
end;

procedure TCustomOutlookBar.DrawItemBorder(Item: TOutlookBarItem; const ARect: TRect; ADrawStyle: TDrawOutlookBarPageTitleBorderStyle);
var
  rt: TRect;
  pt: TPoint;
//  orgn, rgn:HRGN;
begin
  if (Item.FLastDrawBorderStyle = ADrawStyle) and not (dsRedraw in ADrawStyle) then Exit;
  rt := GetItemBorderRect(Item, ARect);
  Item.FLastDrawBorderStyle := ADrawStyle;
  if dsRedraw in Item.FLastDrawBorderStyle then
  begin
    Item.FLastDrawBorderStyle := [];
    if Flat then Include(Item.FLastDrawBorderStyle, dsFlat);
    if Item.FDown then Include(Item.FLastDrawBorderStyle, dsDown);
    GetCursorPos(pt);
    pt := ScreenToClient(pt);
    if ptinRect(rt, pt) then Include(Item.FLastDrawBorderStyle, dsHot);
  end;

  if Item.Expanded then Include(Item.FLastDrawBorderStyle, dsDown);

//  GetClipRgn(Canvas.Handle, orgn);
//  rgn := CreateRectRgnIndirect(GetWorkArea);
//  SelectClipRgn(Canvas.HAndle, rgn);
  with GetWorkArea do IntersectClipRect(Canvas.Handle, Left, Top, Right, Bottom);

  if dsDown in Item.FLastDrawBorderStyle then
    DrawEdge(Canvas.Handle, rt, BDR_SUNKENINNER, BF_RECT)
  else
    if dsFlat in Item.FLastDrawBorderStyle then
    begin
      if dsHot in Item.FLastDrawBorderStyle then
        DrawEdge(Canvas.Handle, rt, BDR_RAISEDOUTER, BF_RECT)
      else
      begin
        Canvas.Brush.Color := Color;
        Canvas.FrameRect(rt);
      end;
    end
    else
      DrawEdge(Canvas.Handle, rt, BDR_RAISEDOUTER, BF_RECT);
//      DrawEdge(Canvas.Handle, rt, EDGE_RAISED, BF_RECT);
//  SelectClipRgn(Canvas.HAndle, orgn);
//  DeleteObject(rgn)
end;

function TCustomOutlookBar.GetPageAt(X, Y: Integer): TOutlookBarPage;
var
  i:Integer;
  rt:TRect;
  pt:TPoint;
  aw,ah:Integer;
begin
  if Pages.Count = 0 then
  begin
    Result := nil;
    Exit;
  end;
  pt := Point(X, Y);
  rt := Rect(0, 0, ClientWidth, ClientHeight);
  for i := Pages.Count - 1 downto PageIndex + 1 do
  begin
    MeasurePageTitle(Pages[i], aw, ah);
    rt.Top := rt.Bottom - ah;
    if ptInRect(rt, pt) then
    begin
      Result := Pages[i];
      Exit;
    end;
    rt.Bottom := rt.Top;
  end;
  rt := Rect(0,0,ClientWidth,0);
  for i := 0 to PageIndex do
  begin
    MeasurePageTitle(Pages[i], aw, ah);
    rt.Bottom := rt.Top + ah;
    if ptInRect(rt, pt) then
    begin
      Result := Pages[i];
      Exit;
    end;
    rt.Top := rt.Bottom;
  end;
  Result := nil;
end;

function TCustomOutlookBar.GetItemAt(X, Y: Integer): TOutlookBarItem;
var
  rt: TRect;
begin
  Result := nil;
  rt := GetWorkArea;
  if not ptinRect(rt, Point(X, Y)) then Exit;
  if Pages.Count = 0 then Exit;
  with Pages[PageIndex] do
  begin
    Result := Items.GetVisibleItem(FOffset);
    if not Assigned(Result) then Exit;
    rt := GetItemRect(Result);
    while not ptInRect(rt, Point(X, Y)) do
    begin
      Result := Result.GetNextVisible;
      if not Assigned(Result) then Exit;
      rt := GetItemRect(Result);
    end;
  end;
end;

function TCustomOutlookBar.GetFirstVisibleItem: TOutlookBarItem;
begin
  Result := nil;
  if (Pages.Count = 0) or (Pages[PageIndex].Items.Count = 0) then Exit;
  Result := Pages[PageIndex].Items[0];
  if not Result.CanVisible then Result := Result.GetNextVisible;
end;

procedure TCustomOutlookBar.UpdateItem(Item: TOutlookBarItem);
var
  rt: TRect;
begin
  if Assigned(Item) then
  begin
    if Item.Page.Index <> PageIndex then Exit;
    rt := GetItemRect(Item);
  end else rt := GetWorkArea;
  RedrawWindow(Handle, @rt, 0, RDW_INVALIDATE);
end;

procedure TCustomOutlookBar.UpdatePage(Page: TOutlookBarPage);
var
  rt: TRect;
begin
  if Assigned(Page) then rt := GetPageTitleRect(Page) else rt := ClientRect;
  RedrawWindow(Handle, @rt, 0, RDW_INVALIDATE);
  if Assigned(Page) and (Page.Index = PageIndex) then UpdateItem(nil);
end;

end.