fcoutlookbar.pas

一套及时通讯的原码

  inherited;

  FItems.ArrangingControls := True;
  for i := 0 to FItems.Count - 1 do OutlookItems[i].Panel.Visible := False;
  FItems.ArrangingControls := False;
  FItems.ArrangeControls;
end;

procedure TfcCustomOutlookBar.Notification(AComponent: TComponent; AOperation: TOperation);
var i: Integer;
begin
  inherited;
  if (AOperation = opRemove) and (AComponent = FImager) then
  begin
     FImager := nil;
     if not (csDestroying in ComponentState) then Invalidate;
  end
  else if (AOperation = opRemove) and not (csDestroying in ComponentState) then
    for i := 0 to FItems.Count - 1 do
      if AComponent = OutlookItems[i].OutlookList then
      begin
        OutlookItems[i].FOutlookList := nil;
        Break;
      end;
end;

procedure TfcCustomOutlookBar.Paint;
var i, j: Integer;
    TmpRgn, ClipRgn: HRGN;
    ir, r, r1: TRect;
    curPanel: TfcOutlookPanel;

    function HaveNonRectangularOutlookButton: boolean;
    var i: integer;
    begin
       result:= False;
       for i := 0 to OutlookItems.Count - 1 do
       begin
           if IsNonRectangularButton(OutlookItems[i].Button) then
           begin
              result:= True;
              break;
           end
       end
    end;

begin
  if (OutlookItems.Count = 0) and (Imager = nil) then
  begin
    inherited;
    Exit;
  end;

  if (FImager <> nil) or
     { 5/2/99 - RSW - Go into this path if contain non-rectangular outlook button
       Can likely go into this path even in rectangular case, but this would
       require more testing }
      HaveNonRectangularOutlookButton then
  begin
    if not AnimatingControls then
    begin
      { Clip out outlookbuttons and visible panel's child controls from imager's area to paint }
      ClipRgn := CreateRectRgn(0, 0, 0, 0);

      for i := 0 to OutlookItems.Count - 1 do
      begin
        // 4/19/99 Changed to get button's region, instead of just its rectangle
        with OutlookItems[i].Button do
        begin
          TmpRgn := TfcOutlookButton(OutlookItems[i].Button).CreateRegion(False, Down);
          OffsetRgn(TmpRgn, Left, Top);
        end;
        CombineRgn(ClipRgn, ClipRgn, TmpRgn, RGN_OR);
        DeleteObject(TmpRgn);

        with OutlookItems[i], Panel do
          if Visible then
          begin
             if FImager=nil then
             begin
               TmpRgn := CreateRectRgn(Panel.Left, Panel.Top, Panel.Left + Panel.Width, Panel.Top + Panel.Height);
               CombineRgn(ClipRgn, ClipRgn, TmpRgn, RGN_OR); { Only paint button area }
               DeleteObject(TmpRgn);
             end;
            fcGetChildRegions(Panel, False, ClipRgn, Point(Left, Top), RGN_OR);
          end;
      end;
      TmpRgn := CreateRectRgn(0, 0, ClientWidth, ClientHeight);
      CombineRgn(ClipRgn, TmpRgn, ClipRgn, RGN_DIFF);
      DeleteObject(TmpRgn);
      SelectClipRgn(Canvas.Handle, ClipRgn);
      DeleteObject(ClipRgn);  //4/2/99 - Does not seem neccesary

    end;

    if (FImager <> nil) then
    begin
       if FImager.WorkBitmap.Empty then FImager.UpdateWorkBitmap;

       if FImager.DrawStyle=dsTile then
          FImager.WorkBitmap.TileDraw(Canvas, ClientRect)
       else
          Canvas.StretchDraw(ClientRect, FImager.WorkBitmap);
    end
    else begin
       Canvas.Brush.Color:= Color;
       Canvas.FillRect(ClientRect);
    end;
    SelectClipRgn(Canvas.Handle, 0);
  end else if (csDesigning in ComponentState) then inherited;

  if (csDesigning in ComponentState) or (csDestroying in ComponentState) or (FItems = nil) then Exit;

  // Code in here to prevent the Child controls in the panel from going invisible
//  exit;
  for i := 0 to FItems.Count - 1 do
    if TfcOutlookPage(FItems[i]).Panel.Visible then
    begin
      with TfcOutlookPage(FItems[i]).Panel do
      begin
        curPanel:= TfcOutlookPage(FItems[i]).Panel;
        for j := 0 to ControlCount - 1 do if Controls[j] is TWinControl then
        begin
          r := Controls[j].BoundsRect;
          offsetRect(r, left, top); { Adjust to outlookbar coordinates }

          with self.Canvas.ClipRect do
          begin
            r1:= self.canvas.cliprect;
            if IntersectRect(ir, r1, r) then {or
//          if fcRectInRect(r, self.Canvas.ClipRect) then
//            if PtInRect(r, TopLeft) or PtInRect(r, BottomRight) or
//               PtInRect(r, Point(Right, Top)) or PtInRect(r, Point(Left, Bottom)) then}
            begin
              IntersectRect(r, self.Canvas.ClipRect, r);
              offsetRect(r, -curPanel.left, -curPanel.top); { Adjust to outlookbar coordinates }
              offsetRect(r, -Controls[j].BoundsRect.Left, -Controls[j].BoundsRect.top);
              InvalidateRect((Controls[j] as TWinControl).Handle, @r, False);
            end
          end
        end;
      end;
      Break;
    end;
end;

function TfcCustomOutlookBar.InAnimation: Boolean;
begin
  result := not (FAnimationLock = 0);
end;

function TfcCustomOutlookBar.GetActivePage: TfcCustomBitBtn;
begin
  result := nil;
  if Selected <> nil then result := Selected.Button;
end;

function TfcCustomOutlookBar.GetItems: TfcOutlookPages;
begin
  result := TfcOutlookPages(inherited ButtonItems);
end;

procedure TfcCustomOutlookBar.SetActivePage(Value: TfcCustomBitBtn);
begin
  Selected := FItems.FindButton(Value);
end;

procedure TfcCustomOutlookBar.SetAnimatingControls(Value: Boolean);
var i: Integer;
begin
  FAnimatingControls := Value;
  for i := 0 to OutlookItems.Count - 1 do
    OutlookItems[i].Panel.Animating := Value;
end;

procedure TfcCustomOutlookBar.SetButtonSize(Value: Integer);
begin
  if FButtonSize <> Value then
  begin
    FButtonSize := Value;
    FItems.ArrangeControls;
  end;
end;

procedure TfcCustomOutlookBar.SetImager(Value: TfcCustomImager);
begin
  if FImager <> nil then FImager.UnRegisterChanges(FChangeLink);
  if Value<>FImager then
  begin
     FImager := Value;
     if Value <> nil then
     begin
       Value.FreeNotification(self);
       Value.RegisterChanges(FChangeLink);
       Value.Parent := self;
       Value.Align := alNone;
//       if Value.DrawStyle <> dsStretch then
          Value.DrawStyle := dsTile;
       Value.Left:= 0;
       Value.Top:= 0;
       Value.Width:= 25;
       Value.Height:= 25;
       Value.Transparent:= False; { 4/30/99 }

       Value.Visible := False;
     end;
     Invalidate; { 4/20/99 RSW }
  end
end;

procedure TfcCustomOutlookBar.SetItems(Value: TfcOutlookPages);
begin
  inherited ButtonItems := Value;
end;

procedure TfcCustomOutlookBar.SetName(const NewName: TComponentName);
var i: Integer;
begin
  for i := 0 to FItems.Count - 1 do
  begin
    if Copy(OutlookItems[i].Panel.Name, 1, Length(Name)) = Name then
      OutlookItems[i].Panel.Name := NewName + fcSubstring(OutlookItems[i].Panel.Name, Length(Name) + 1, 0);
    if (cboAutoCreateOutlookList in Options) and
       (OutlookItems[i].Panel.ControlCount > 0) and (OutlookItems[i].Panel.Controls[0] is TListView) and
       (Copy(OutlookItems[i].Panel.Controls[0].Name, 1, Length(Name)) = Name) then
      OutlookItems[i].Panel.Controls[0].Name := NewName + fcSubstring(OutlookItems[i].Panel.Controls[0].Name, Length(Name) + 1, 0);
  end;
  inherited;
end;

procedure TfcCustomOutlookBar.SetOptions(Value: TfcCustomOutlookBarOptions);
var ChangedOptions: TfcCustomOutlookBarOptions;
begin
  if FOptions <> Value then
  begin
    ChangedOptions := (FOptions - Value) + (Value - FOptions);
    FOptions := Value;
{    if not (csLoading in ComponentState) and (cboTransparentPanels in ChangedOptions) then
      for i := 0 to FItems.Count - 1 do OutlookItems[i].Panel.Transparent := cboTransparentPanels in FOptions;}
  end;
end;

procedure TfcCustomOutlookBar.SetPanelAlignment(Value: TfcPanelAlignment);
begin
  if FPanelAlignment <> Value then
  begin
    FPanelAlignment := Value;
    if not (csLoading in ComponentState) then FItems.ArrangeControls;
  end;
end;

procedure TfcCustomOutlookBar.SetShowButtons(Value: Boolean);
var i: Integer;
begin
  if FShowButtons <> Value then
  begin
    FShowButtons := Value;
    if not (csLoading in ComponentState) then
      for i := 0 to FItems.Count - 1 do with FItems[i].Button do
    begin
      Visible := Value;
      if Value then BringToFront else SendToBack;
    end;
    if not (csLoading in ComponentState) then
    begin
      FItems.ArrangingControls := False;
      FItems.ArrangeControls;
    end;
  end;
end;

procedure TfcCustomOutlookBar.CMControlListChange(var Message: TCMControlListChange);
begin
  inherited;
end;

procedure TfcCustomOutlookBar.CMControlChange(var Message: TCMControlChange);
begin
  inherited;
  if Message.Control is TfcCustomImager then
  begin
    if Message.Inserting then
    begin
       if Imager<>FImager then { RSW }
          Imager := Message.Control as TfcCustomImager;
    end
    else Imager := nil;
  end;
end;

{ 3/12/99 - RSW - Prevent flicker }
procedure TfcCustomOutlookBar.WMEraseBkgnd(var Message: TWMEraseBkGnd);
begin
  Message.result := 1;
end;

procedure TfcCustomOutlookBar.WMPaint(var Message: TWMPaint);
begin
  inherited;
end;

procedure TfcCustomOutlookBar.CMFontChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;  { 4/27/99 }
  Update;
end;

function TfcCustomOutlookBar.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 TfcCustomOutlookBar.WndProc(var Message: TMessage);
begin
  inherited;
end;

initialization
  RegisterClasses([TfcOutlookPanel]);
end.