⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fcoutlookbar.pas

📁 一套及时通讯的原码
💻 PAS
📖 第 1 页 / 共 3 页
字号:
    ButtonRect: TRect;
    InvalidButton: TWinControl;
  //4/15/99 - PYW - Check to see if any child of one of the Outlookpages has a control with the
  //                align property not set to alNone.
  function ChildHasAlignmentSet: boolean;
  var alignset:boolean;
      i,j:integer;
  begin
    alignset := False;
    for i := 0 to Count - 1 do
       with TfcOutlookPage(Items[i]), Panel do
       begin
         if OutlookList = nil then
         begin
            for j:=0 to ControlCount - 1 do
            begin
               if Controls[j].Align <> alNone then begin
                  alignset := True;
                  break;
               end;
            end;
         end;
       end;
       result := alignset;
  end;

{  function IsNonRectangularButton(Control: TControl): boolean;
  var button: TfcCustomImageBtn;
  begin
     result:= False;
     if (Control is TfcCustomImageBtn) then
     begin
        button:= TfcCustomImageBtn(control);
         if ((Control is TfcCustomShapeBtn) and
            ((Control as TfcCustomShapeBtn).Shape <> bsRect)) then result:= True
         else if (not (Control is TfcCustomShapeBtn) and
            (button.TransparentColor <> clNullColor)) then result:= True
     end
  end;
}
  procedure CleanUp;
  var i:integer;
  begin
    ArrangingControls := False;
    OutlookBar.AnimatingControls := False;
    List.Free;
    for i := 0 to Count - 1 do
      with TfcOutlookPage(Items[i]) do
        if OutlookList <> nil then OutlookList.ScrollButtonsVisible := True;
  end;

begin
  if ArrangingControls or AddingControls then Exit;
  ArrangingControls := True;
//  OutlookBar.AnimatingControls := True; { Don't use this flag, RSW }

  if OutlookBar.Layout = loVertical then PanelHeight := ButtonGroup.ClientHeight
  else PanelHeight := ButtonGroup.ClientWidth;
  PanelHeight := PanelHeight - VisibleCount * OutlookBar.ButtonSize;

  List := TList.Create;

  ControlTop := 0;
  if OutlookBar.PanelAlignment = paTop then inc(ControlTop, PanelHeight);

  OldPanel := nil;
  OldPanelIndex:= -1;
  for i := 0 to Count - 1 do
    with TfcOutlookPage(Items[i]), Panel do
    begin
      if OutlookList <> nil then OutlookList.ScrollButtonsVisible := False;
      if Visible then begin
        OldPanel := TfcOutlookPage(Items[i]).Panel;
        OldPanelIndex:= i;
      end
      else begin
        Visible := False;
        Top := -Height;
      end;
    end;

  if not OutlookBar.ShowButtons then
  begin
    if OldPanel <> nil then OldPanel.Visible := False;
    if OutlookBar.Selected <> nil then with (OutlookBar.Selected as TfcOutlookPage).Panel do
    begin
      BoundsRect := OutlookBar.ClientRect;
      Visible := True;
    end;
    CleanUp;
    exit;
  end;

  for i := 0 to VisibleCount - 1 do with OutlookBar do
  begin
    CurItem := TfcOutlookPage(VisibleItems[i]);
    Item := TfcGroupAnimateItem.Create;
    Item.MainItem := TfcAnimateListItem.Create;
    Item.MainItem.Control := CurItem.Button;
    Item.MainItem.OrigRect := CurItem.Button.BoundsRect;
    Item.SecondItem := nil;
    if Layout = loVertical then
      Item.MainItem.FinalRect := Rect(0, ControlTop, ClientWidth, ControlTop + ButtonSize)
    else Item.MainItem.FinalRect := Rect(ControlTop, 0, ControlTop + ButtonSize, ClientHeight);

    if CurItem.Selected or ((OldPanel <> nil) and (OldPanel = CurItem.Panel)) then
    begin
      with CurItem.Button.BoundsRect do
        if CurItem.Selected then case PanelAlignment of
          paDynamic: if Layout = loVertical then CurItem.Panel.BoundsRect := Rect(Left, Bottom, Right, Bottom)
                 else CurItem.Panel.BoundsRect := Rect(Right, Top, Right, Bottom);
          paTop: if Layout = loVertical then CurItem.Panel.BoundsRect := Rect(Left, 0, Right, 0)
                 else CurItem.Panel.BoundsRect := Rect(0, Top, 0, Bottom);
          paBottom: if Layout= loVertical then CurItem.Panel.BoundsRect := Rect(Left, ClientHeight - PanelHeight, Right, ClientHeight - PanelHeight)
                 else CurItem.Panel.BoundsRect := Rect(ClientWidth - PanelHeight, Top, ClientWidth - PanelHeight, Bottom);
        end;
      CurItem.Panel.Visible := True;

      Item.SecondItem := TfcAnimateListItem.Create;
      Item.SecondItem.Control := CurItem.Panel;
      Item.SecondItem.OrigRect := CurItem.Panel.BoundsRect;

      if CurItem.Selected then
      begin
        with Item.MainItem.FinalRect do case OutlookBar.PanelAlignment of
          paDynamic: begin
            if Layout = loVertical then Item.SecondItem.FinalRect := Rect(Left, Bottom, Right, Bottom + PanelHeight)
            else Item.SecondItem.FinalRect := Rect(Right, Top, Right + PanelHeight, Bottom);
            inc(ControlTop, PanelHeight);
          end;
          paTop: if Layout = loVertical then Item.SecondItem.FinalRect := Rect(Left, 0, Right, PanelHeight)
            else Item.SecondItem.FinalRect := Rect(0, Top, PanelHeight, Bottom);
          paBottom: if Layout = loVertical then Item.SecondItem.FinalRect := Rect(Left, OutlookBar.ClientHeight - PanelHeight, Right, OutlookBar.ClientHeight)
            else Item.SecondItem.FinalRect := Rect(OutlookBar.ClientWidth - PanelHeight, Top, OutlookBar.ClientWidth, Bottom);
        end;
      end else with Item.MainItem.FinalRect do begin
        if Layout = loVertical then Item.SecondItem.FinalRect := Rect(Left, Bottom, Right, Bottom)
        else Item.SecondItem.FinalRect := Rect(Right, Top, Right, Bottom);
      end;
    end;

    inc(ControlTop, OutlookBar.ButtonSize);

    List.Add(Item);
  end;

  ASteps := OutlookBar.Animation.Steps;
  AInterval := OutlookBar.Animation.Interval;
  //4/15/99 - PYW - Check to see if any child of one of the Outlookpages has a control with the
  //                align property not set to alNone.
  if not OutlookBar.InAnimation or (csDesigning in OutlookBar.ComponentState) or
     not OutlookBar.Animation.Enabled or ChildHasAlignmentSet then
  begin
    OutlookBar.AnimatingControls := False;
    ASteps := 1;
    AInterval := 0;
  end;

  for i:= 0 to count-1 do
     TfcOutlookButton(Items[i].Button).DisableButton:= True;

  fcAnimateControls(OutlookBar, OutlookBar.Canvas, List, AInterval, ASteps, AnimateSetBounds);

  if (OldPanel <> nil) and (OutlookBar.Selected <> nil) and ((OutlookBar.Selected as TfcOutlookPage).Panel <> OldPanel) then
  begin
    OldPanel.Visible := False;
    OldPanel.Top := -OutlookBar.Height;
  end;

  for i := 0 to List.Count - 1 do
    with TfcGroupAnimateItem(List[i]) do
    begin
      if SecondItem <> nil then
      begin
{         if SecondItem.Control.Visible then with SecondItem.Control do
         begin
           for j := 0 to ControlCount - 1 do
             if IsNonRectangularButton(Controls[j]) then
             begin
               r := SecondItem.Control.Controls[j].BoundsRect;
               InvalidateRect(SecondItem.Control.Handle, @r, False);
             end;
         end;}
         SecondItem.Free;
      end;
      MainItem.Free;
      Free;
    end;

  CleanUp;
  for i:= 0 to count-1 do
     TfcOutlookButton(Items[i].Button).DisableButton:= False;

{  if (ASteps=1) and (Outlookbar.Selected<>nil) and
     (OldPanelIndex<OutlookBar.Selected.Index) then
  begin
     InvalidButton:= OutlookBar.Selected.Button;
     if (InvalidButton<>nil) and
        OutlookBar.IsNonRectangularButton(InvalidButton) then
     begin
        ButtonRect:= InvalidButton.BoundsRect;
        InvalidateRect(OutlookBar.Handle, @ButtonRect, True);
     end
  end;
}
  { 5/12/99 - RSW - Clear background for any background area of image shaped buttons,
    and execute code even for steps=1 }
  { Repaint current selection if its a non-rectangular button}
  if (ASteps>=1) and (OldPanelIndex>=0) and (OutlookBar.Selected<>nil) then
  begin
     { This button needs to be repainted if its a shape button }
     if OldPanelIndex<OutlookBar.Selected.index then
     begin
        { Repaint OldPanelIndex + 1 to Seleccted.Index }
        for i:= OldPanelIndex+1 to OutlookBar.Selected.Index do
        begin
           InvalidButton:= TfcOutlookPage(Items[i]).Button;
           if not OutlookBar.IsNonRectangularButton(InvalidButton) then continue;
           ButtonRect:= InvalidButton.BoundsRect;
           InvalidateRect(OutlookBar.Handle, @ButtonRect, True);
        end
     end
     else begin
        { Repaint SelectedIndex + 1 to OldPanelIndex }
        for i:= OutlookBar.Selected.Index+1 to OldPanelIndex do
        begin
           InvalidButton:= TfcOutlookPage(Items[i]).Button;
           if not OutlookBar.IsNonRectangularButton(InvalidButton) then continue;
           ButtonRect:= InvalidButton.BoundsRect;
           InvalidateRect(OutlookBar.Handle, @ButtonRect, True);
        end
     end
  end

end;

function TfcOutlookPages.Add: TfcOutlookPage;
begin
  result := TfcOutlookPage(inherited Add);
  if Count = 1 then result.GotSelected;
end;

function TfcOutlookPages.AddItem: TfcCollectionItem;
begin
  result := Add;
end;

constructor TfcCustomOutlookBar.Create(AOwner: TComponent);
begin
  inherited;
  FOptions := [cboAutoCreateOutlookList];
  FAnimation := TfcAnimation.Create;
  FButtonSize := 20;
  FShowButtons := True;
  FChangeLink := TfcChangeLink.Create;
  FChangeLink.OnChange := ImagerChange;
  AutoBold := False;
  BorderStyle := bsSingle;
  ShowDownAsUp := False;
end;

destructor TfcCustomOutlookBar.Destroy;
begin
  FAnimation.Free;
  FChangeLink.Free;
  inherited;
end;

procedure TfcCustomOutlookBar.EnableAnimation;
begin
  inc(FAnimationLock);
end;

procedure TfcCustomOutlookBar.DisableAnimation;
begin
  dec(FAnimationLock);
end;

function TfcCustomOutlookBar.GetCollectionClass: TfcButtonGroupItemsClass;
begin
  result := TfcOutlookPages;
end;

function TfcCustomOutlookBar.ResizeToControl(Control: TControl; DoResize: Boolean): TSize;
begin
  result := fcSize(Width, Height);
end;

procedure TfcCustomOutlookBar.ButtonPressed;
begin
  EnableAnimation;
  if FItems.ArrangingControls then
  begin
    if OldSelected <> nil then OldSelected.Button.Down := True;
  end else inherited;
  DisableAnimation;
end;

procedure TfcCustomOutlookBar.CreateWnd;
begin
  inherited;
end;

procedure TfcCustomOutlookBar.GetChildren(Proc: TGetChildProc; Root: TComponent);
var i: Integer;
begin
  inherited;
  for i := 0 to FItems.Count - 1 do
    Proc(TfcOutlookPage(FItems[i]).Panel);
end;

procedure TfcCustomOutlookBar.ImagerChange(Sender: TObject);
begin
  invalidate;
//  inherited;
end;

procedure TfcCustomOutlookBar.Loaded;
var i, j, k: Integer;
begin
  for i := 0 to ControlCount - 1 do
    if Controls[i] is TfcOutlookPanel then
      for j := 0 to FItems.Count - 1 do
        if TfcOutlookPage(FItems[j]).Panel = nil then
          with TfcOutlookPage(FItems[j]) do
        begin
          Panel := Controls[i] as TfcOutlookPanel;
          for k := 0 to Panel.ControlCount - 1 do
            if Panel.Controls[k] is TfcOutlookList then
            begin
              FOutlookList := Panel.Controls[k] as TfcOutlookList;
              Break;
            end;
          Break;
        end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -