outlookbar.pas

企业ERP管理系统

        Inc(ATop,dy);
        SleepEx(AniStepTiem, False);
      end;
    finally
      bm.Free;
    end;
  end;
begin
  if Value <> FPageIndex then
  begin
    if HandleAllocated then
    begin
      FAnimating := True;
      Ani(Pages[FPageIndex], Pages[Value]);
      FAnimating := False;
    end;
    FPageIndex := Value;
    Invalidate; //????
  end;
end;

procedure TCustomOutlookBar.SetLargeImages(Value: TCustomImageList);
begin
  if LargeImages <> nil then
    LargeImages.UnRegisterChanges(FLargeChangeLink);
  FLargeImages := Value;
  if LargeImages <> nil then
  begin
    LargeImages.RegisterChanges(FLargeChangeLink);
    LargeImages.FreeNotification(Self);
  end;
  Invalidate;
end;

procedure TCustomOutlookBar.SetSmallImages(Value: TCustomImageList);
begin
  if SmallImages <> nil then
    SmallImages.UnRegisterChanges(FSmallChangeLink);
  FSmallImages := Value;
  if SmallImages <> nil then
  begin
    SmallImages.RegisterChanges(FSmallChangeLink);
    SmallImages.FreeNotification(Self);
  end;
  Invalidate;
end;

procedure TCustomOutlookBar.CMMouseLeave(var Message:TMessage);
begin
  inherited;
  MouseMove([], -1, -1)
end;

procedure TCustomOutlookBar.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  end;
end;

procedure TCustomOutlookBar.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  ow, oh:Integer;
  rt: TRect;
begin
  ow := Width;
  oh := Height;
  inherited;
  if ow <> AWidth then
  begin
    Invalidate;
    Exit;
  end;
  if oh = Height then Exit;
  if oh < Height then
  begin
    Invalidate;
  end
  else
  begin
    rt := GetWorkArea;
    if CanScrollDown then rt.Top := GetScrollDownRect.Top
      else rt.Top := rt.Bottom;
    rt.Bottom := ClientHeight;
  end;
  RedrawWindow(Handle, @rt, 0, RDW_INVALIDATE);
end;

procedure TCustomOutlookBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  m: TOutlookBarItem;
  p: TOutlookBarPage;
  ds: TDrawOutlookBarPageTitleBorderStyle;
begin
  if (Pages.Count = 0) or (Button <> mbLeft) then
  begin
    inherited;
    Exit;
  end;
  if ptinRect(GetWorkArea, Point(X, Y)) then
  begin
    if CanScrollDown and ptInRect(GetScrollDownRect,Point(X, Y)) then
    begin
      FScrollDownDown := True;
      DrawScrollButtons;
    end else
      if CanScrollUp and ptInRect(GetScrollUpRect,Point(X, Y)) then
      begin
        FScrollUpDown := True;
        DrawScrollButtons;
      end else
      begin
        m := GetItemAt(X, Y);
        if Assigned(m) and ptInRect(GetItemBorderRect(m, GetItemRect(m), True),Point(X, Y)) then
        begin
          m.FDown := True;
          DrawItemBorder(m, GetItemRect(m), [dsRedraw]);
        end;
      end;
  end
  else
  begin
    p := GetPageAt(X, Y);
    if Assigned(p) and (p.Index <> PageIndex) then
    begin
      ds:=[dsDown];
      p.FDown := True;
      DrawPageTitleBorder(p, GetPageTitleRect(p), ds);
    end;
  end;
  inherited;
end;

procedure TCustomOutlookBar.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  ds: TDrawOutlookBarPageTitleBorderStyle;
  p: TOutlookBarPage;
  im: TOutlookBarItem;
  i, pi: Integer;
  rt: TRect;
begin
  inherited;
  if Pages.Count = 0 then Exit;
  for i := 0 to Pages.Count - 1 do
  begin
    if Pages[i].FDown then
    begin
      p:=Pages[i];
      if ptinRect(GetPageTitleRect(p), Point(X, Y)) then ds := [dsDown] else ds := [dsHot];
      DrawPageTitleBorder(p, GetPageTitleRect(p), ds);
      Exit;
    end;
  end;
  im := GetFirstVisibleItem;
  while Assigned(im) do
  begin
    if im.FDown then
    begin
      if ptInRect(GetItemBorderRect(im, GetItemRect(im), True),Point(X, Y)) then ds := [dsDown] else ds := [dsHot];
      DrawItemBorder(im, GetItemRect(im), ds);
      Exit;
    end;
    im := im.GetNextVisible;
  end;
  rt := GetWorkArea;
  if ptinRect(rt, Point(X, Y)) then
  begin
    Cursor := crDefault;
    if FScrollUpDown then
      if ptInRect(GetScrollUpRect,Point(X, Y)) then
        DrawFrameControl(Canvas.Handle, GetScrollUpRect,DFC_SCROLL,DFCS_SCROLLUP or DFCS_PUSHED)
      else
        DrawFrameControl(Canvas.Handle, GetScrollUpRect,DFC_SCROLL,DFCS_SCROLLUP)
    else
      if FScrollDownDown then
        if ptInRect(GetScrollDownRect,Point(X, Y)) then
          DrawFrameControl(Canvas.Handle, GetScrollDownRect,DFC_SCROLL,DFCS_SCROLLDown or DFCS_PUSHED)
        else
          DrawFrameControl(Canvas.Handle, GetScrollDownRect,DFC_SCROLL,DFCS_SCROLLDown);
  end else Cursor := crHandPoint;
  if Flat then
  begin
    p := GetPageAt(X, Y);
    if Assigned(p) then pi := p.Index else pi := -1;
    for i := 0 to Pages.Count - 1 do
    begin
      if (pi = i) and (i <> PageIndex) then
        ds := [dsFlat, dsHot] else ds := [dsFlat];
      DrawPageTitleBorder(Pages[i], GetPageTitleRect(Pages[i]), ds);
    end;

    im := Pages[PageIndex].Items.GetVisibleItem(Pages[PageIndex].FOffset);
    while Assigned(im) and (GetItemRect(im).Top < rt.Bottom) do
    begin
      if ptinRect(rt, Point(X, Y)) and ptinRect(GetItemBorderRect(im, GetItemRect(im), True), Point(X, Y)) then
        ds := [dsFlat, dsHot] else ds := [dsFlat];
      DrawItemBorder(im, GetItemRect(im), ds);
      im := im.GetNextVisible;
    end;
  end;
end;

procedure TCustomOutlookBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  p: TOutlookBarPage;
  i: Integer;
  im: TOutlookBarItem;
  ds: TDrawOutlookBarPageTitleBorderStyle;
begin
  inherited;
  if Pages.Count = 0 then Exit;
  for i := 0 to Pages.Count - 1 do
  begin
    if Pages[i].FDown then
    begin
      p:=Pages[i];
      p.FDown := False;
      if ptinRect(GetPageTitleRect(p), Point(X, Y)) then
      begin
        ds:=[dsHot];
        ClickPageTitle(p);
      end
      else
        ds:=[dsRedraw];
      DrawPageTitleBorder(p, GetPageTitleRect(p), ds);
      Exit;
    end;
  end;
  im := GetFirstVisibleItem;
  while Assigned(im) do
  begin
    if im.FDown then
    begin
      im.FDown := False;
      if ptInRect(GetItemBorderRect(im, GetItemRect(im), True),Point(X, Y)) then
      begin
        ds := [dsHot];
        im.Expanded := (not im.Expanded) and (im.Count > 0);
        ClickItem(im);
      end
      else
        ds:=[dsRedraw];
      DrawItemBorder(im, GetItemRect(im), ds);
      Exit;
    end;
    im := im.GetNextVisible;
  end;
  if ptinRect(GetWorkArea, Point(X, Y)) then
  begin
    if FScrollUpDown or FScrollDownDown then
    begin
      if FScrollUpDown then
      begin
        FScrollUpDown := False;
        if ptinRect(GetScrollUpRect, Point(X, Y)) then ScrollUp;
      end;
      if FScrollDownDown then
      begin
        FScrollDownDown := False;
        if ptinRect(GetScrollDownRect, Point(X, Y)) then ScrollDown;
      end;
      DrawScrollButtons;
    end;
  end;
end;

procedure TCustomOutlookBar.Paint;
var
  rt: TRect;
  i: Integer;
  ps, pe: TOutlookBarPage;
begin
  if Pages.Count = 0 then
  begin
    rt := Canvas.ClipRect;
    Brush.Color := Color;
    Canvas.FillRect(rt);
  end
  else
  begin
    rt := Canvas.ClipRect;
    ps := GetPageAt(rt.Left, rt.Top);
    if ps = nil then ps := Pages[0];
    pe := GetPageAt(rt.Right, rt.Bottom);
    if pe = nil then if ptinRect(GetWorkArea, rt.BottomRight) then
      pe := Pages[PageIndex] else pe := Pages[Pages.Count - 1];
    for i := ps.Index to pe.Index do
    begin
      DrawPageTitle(Pages[i], GetPageTitleRect(Pages[i]));
    end;
    DrawItems(rt);
  end;
end;

procedure TCustomOutlookBar.LayoutChanged;
var
  I, T, W, H: Integer;
begin
  FWorkArea := ClientRect;
  if Pages.Count = 0 then Exit;
  MeasurePageTitle(Pages[0], W, H);
//  Pages[0].FRect := Rect(0, 0, ClientWidth, H);
  T := H;
  for I := 1 to FPageIndex do
  begin
    MeasurePageTitle(Pages[I], W, H);
//    Pages[I].FRect := Rect(0, T, ClientWidth, T + H);
    Inc(T, H);
  end;
  for I := Pages.Count - 1 downto FPageIndex + 1 do
  begin
  end;
end;

procedure TCustomOutlookBar.ClickPageTitle(Page: TOutlookBarPage);
begin
  PageIndex := Page.Index;
  if Assigned(FOnPageChange) then FOnPageChange(Self);
end;

procedure TCustomOutlookBar.ClickItem(Item: TOutlookBarItem);
begin
  if Assigned(OnItemClick) then OnItemClick(Self, Item);
end;

function TCustomOutlookBar.GetWorkArea: TRect;
begin
  if Pages.Count = 0 then Result := ClientRect else
  begin
    Result := GetPageTitleRect(Pages[PageIndex]);
    Result.Left := 0;
    Result.Right := ClientWidth;
    Result.Top := Result.Bottom;
    if PageIndex = Pages.Count - 1 then
      Result.Bottom := ClientHeight else
        Result.Bottom := GetPageTitleRect(Pages[PageIndex+1]).Top;
  end;
end;

function TCustomOutlookBar.GetPageTitleRect(Page: TOutlookBarPage): TRect;
var
  aw, ah: Integer;
begin
  MeasurePageTitle(Page, aw, ah);
  if Page.Index <= PageIndex then
  begin
    if Page.Index = 0 then
      Result := Classes.Rect(0, 0, ClientWidth, ah)
    else
    begin
      Result := GetPageTitleRect(Pages[Page.Index - 1]);
      with Result do
      begin
        Top := Bottom;
        Inc(Bottom, ah);
      end;
    end;
  end
  else
  begin
    if Page.Index = Pages.Count - 1 then
      Result := Classes.Rect(0, ClientHeight - ah, ClientWidth, ClientHeight)
    else
    begin
      Result := GetPageTitleRect(Pages[Page.Index + 1]);
      with Result do
      begin
        Bottom := Top;
        Dec(Top, ah);
      end;
    end;
  end;
end;

const
  ItemIndent = 4;

function TCustomOutlookBar.GetItemRect(Item: TOutlookBarItem): TRect;
var
  aw, ah, oh, i: Integer;
  p: TOutlookBarItem;
begin
  SetRectEmpty(Result);
//  if Item.Page.Index <> PageIndex then Exit;
  if Item = Item.Page.Items.GetVisibleItem(0) then
  begin
    oh := 0;
    p := Item;
    for i := 0 to Pages[PageIndex].FOffset - 1 do
    begin
      MeasureItem(p, aw, ah);
      Inc(oh, ah);
      p:=p.GetNextVisible;
      if not Assigned(p) then Break;
    end;
    MeasureItem(Item, aw, ah);
    Result := GetWorkArea;
    with Result do
    begin
//      Inc(Left);
//      Dec(Right);
      Top := Top + ItemIndent;
      Bottom := Top + ah -  oh;
    end;
  end
  else
  begin
    MeasureItem(Item, aw, ah);
    p := Item.GetPrevVisible;
    if Assigned(p) then
    begin
      Result := GetItemRect(p);
      Result.Top := Result.Bottom;
      Result.Bottom := Result.Top + ah;
    end;
  end;
//  case Item.Page.IconStyle of
//    isLarge:
//    with Result do
//    begin