fcoutlooklist.pas

一套及时通讯的原码

    SetCapture(FOldCapture);
    FScrollButtonDown := sbNone;
    InvalidateScrollButton(OldScrollButtonDown);
  end;
end;

type
  TOutlookListHintWindow=class(THintWindow)
  public
     HintItem: TfcOutlookListItem;
     HintRect: TRect;
  end;

procedure TfcCustomOutlookList.MouseMove(Shift: TShiftState; X, Y: Integer);
var pt, cursorpt: TPoint;
    i,j: Integer;
    DoReleaseCapture: Boolean;
    TempMouseOnItem: boolean;
    OutlookBar: TfcCustomOutlookBar;
    HintRect: TRect;
begin

  inherited;

  pt := Point(x, y);

  DoReleaseCapture := True;
  if TopItem <> nil then for i := TopItem.Index to BottomItem.Index do
  begin
    if not Items[i].visible then continue; // 5/5/03

    TempMouseOnItem:= False;{ 3/23/00 - Use temporary variable as setting
      property loses capture }
    if FindVCLWindow(ClientToScreen(pt)) = self then
    begin
       if PtInRect(Items[i].ButtonRect, pt) and (pt.x < Width) and (pt.y < Height) then
          TempMouseOnItem:= True;
    end;
    if TempMouseOnItem then DoReleaseCapture := False;

    if (not Items[i].MouseOnItem) and (TempMouseOnItem) and (Items[i].Enabled) and
       not (csDestroying in ComponentState) and (Items[i].Hint<>'') then
    begin
      if HintWindow=nil then
      begin
        HintWindow:= TOutlookListHintWindow.create(parent);
      end;

      if HintTimer=nil then
      begin
        HintTimer:= TTimer.create(nil);
        HintTimer.OnTimer:=HintTimerEvent;
        HintTimer.Interval:=250;
      end;
      HintTimer.Enabled:= True;
      HintWindow.Color:= GetSysColor(COLOR_INFOBK);
      HintWindow.Canvas.Brush.Color:= GetSysColor(COLOR_INFOBK);
      HintWindow.Canvas.Font:= self.Font;
      HintWindow.Canvas.Font.Color:= GetSysColor(COLOR_INFOTEXT);
      HintWindow.Canvas.Pen.Color:= clBlack;
      HintRect.Left:= Items[i].FButtonRect.Left;
      HintRect.Top:= Items[i].FButtonRect.Top;
      cursorPt.x:= HintRect.Left;
      cursorpt.y:= HintRect.Top;
      cursorPt:= ClientToScreen(cursorPt);
      HintRect.Left:= cursorpt.X;
      HintRect.Top:= cursorpt.y;

      HintRect.Right:= HintRect.Left + HintWindow.Canvas.TextWidth(Items[i].Hint) + 8;
      HintRect.Bottom:= HintRect.Top + HintWindow.Canvas.TextHeight(Items[i].Hint) + 3;
      TOutlookListHintWindow(HintWindow).HintItem:= Items[i];
      TOutlookListHintWindow(HintWindow).HintRect:= HintRect;
    end
    else if (not Items[i].MouseOnItem) and (TempMouseOnItem) and (Items[i].Enabled) and
       not (csDestroying in ComponentState) then
    begin
       FreeHintWindow;
    end;

    Items[i].MouseOnItem:= TempMouseOnItem;

    // Important for themes so that control is invalidated
    // We do this by sending CMMouseLeave to button which
    // is responsible for invalidating control
    if TempMouseOnItem and (TfcOutlookPage(OutlookPage).OutlookBar<>nil) then
    begin
       OutlookBar:= TfcOutlookPage(OutlookPage).OutlookBar;
       with OutlookBar.OutlookItems do begin
          // Iterate through hot buttons and set Hot to false and invalidate
          // this button
          for j:= 0 to count-1 do
             if Items[j].Button.hot then
             begin
                Items[j].Button.hot:= false;
                Items[j].Button.Perform(CM_MOUSELEAVE, 0, 0);
//                Items[j].Button.invalidate;
             end
       end
    end

  end;
  if DoReleaseCapture and (GetCapture = Handle) then
    ReleaseCapture;

  if PtInRect(FUpButtonRect, pt) then MouseInScrollButton := sbUp
  else if PtInRect(FDownButtonRect, pt) then MouseInScrollButton := sbDown
  else MouseInScrollButton := sbNone;
end;

procedure TfcCustomOutlookList.Notification(AComponent: TComponent; Operation: TOperation);
var i: integer;
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FImageList) then
  begin
    FImageList := nil; // So UnRegisterChanges in .SetImageList will not be called
    Images := nil;  // So Invalidate will be called
  end
  else if Operation = opRemove then
  begin
     if AComponent = Action then begin
        { Iterate through items and remove matching item's action property }
        for i := 0 to Items.Count - 1 do
           if AComponent = Items[i].Action then
              Items[i].Action:= nil;
     end
  end

end;

procedure TfcCustomOutlookList.CMDesignHitTest(var Message: TCMDesignHitTest);
begin
  inherited;
  if PtInRect(FUpButtonRect, SmallPointToPoint(Message.Pos)) or
     PtInRect(FDownButtonRect, SmallPointToPoint(Message.Pos)) then
    Message.Result := 1;
end;

procedure TfcCustomOutlookList.WMEraseBkgnd(var Message: TWMEraseBkGnd);
begin

//  inherited;
  Message.result := 1;  { 3/19/99 - RSW Prevents flicker when animating.  If
                          this is a problem, may want to add flag so that this
                          code will only execute during animation, and call inherited otherwise}
end;

procedure TfcCustomOutlookList.WMSize(var Message: TWMSize);
begin
  inherited;
  FPaintBitmap.Free;
  FPaintBitmap := TBitmap.Create;
  FPaintBitmap.Width := ClientWidth;
  FPaintBitmap.Height := ClientHeight;
  UpdateScrollButtonsRect;
end;

procedure TfcCustomOutlookList.WMTimer(var Message: TWMTimer);
begin
  inherited;
  if (Message.TimerID = ScrollTimerId) then
    with ScreenToClient(fcGetCursorPos) do
        if ScrollButtonVisible(FScrollButtonDown) then 
      case FScrollButtonDown of
        sbUp: if PtInRect(FUpButtonRect, Point(x, y)) then ScrollButtonClick;
        sbDown: if PtInRect(FDownButtonRect, Point(x, y)) then ScrollButtonClick;
      end;
end;

procedure TfcCustomOutlookList.DoDrawItem(Item: TfcOutlookListItem; var GlyphPos, TextPos: TPoint; var DefaultDrawing: Boolean);
begin
  if Assigned(FOnDrawItem) then FOnDrawItem(self, Item, GlyphPos, TextPos, DefaultDrawing);
end;

procedure TfcCustomOutlookList.ImageListChange(Sender: TObject);
begin
  Invalidate;
end;

procedure TfcCustomOutlookList.InvalidateScrollButton(Button: TfcScrollButtonStyle);
begin
  case Button of
    sbUp: InvalidateRect(Handle, @FUpButtonRect, False);
    sbDown: InvalidateRect(Handle, @FDownButtonRect, False);
  end;
end;

function TfcCustomOutlookList.GetBottomItem: TfcOutlookListItem;
var i: Integer;
    Total: Integer;
begin
  result := nil;
  if TopItem = nil then Exit;
  result := TopItem;
  Total := 0;
  for i := TopItem.Index to Items.Count - 1 do
  begin
    if not Items[i].visible then continue; //5/5/03
    result := Items[i];
    inc(Total, Items[i].SpacingSize);
    if ((Layout = loVertical) and (Total > ClientHeight)) or
       ((Layout = loHorizontal) and (Total > ClientWidth)) then Break;
  end;
end;

function TfcCustomOutlookList.GetPaintCanvas: TCanvas;
begin
  result := FPaintBitmap.Canvas;
end;

function TfcCustomOutlookList.GetSelected: TfcOutlookListItem;
var i: Integer;
begin
  result := nil;
  for i := 0 to Items.Count - 1 do
  begin
    if Items[i].Selected then
    begin
      result := Items[i];
      Break;
    end;
  end;
end;

function TfcCustomOutlookList.GetListItems(Index: Integer): TfcOutlookListItem;
begin
  result := Items[Index] as TfcOutlookListItem;
end;

function TfcCustomOutlookList.GetTopItem: TfcOutlookListItem;
var i: integer;
begin
  if (FTopItem = nil) and (Items.Count > 0) then // 5/5/03
  begin
     i:= 0;
     while (i<Items.count) and (not Items[i].visible) do
     begin
       inc(i);
     end;
     if i<Items.count then
        FTopItem:= Items[i];
  end;

  result := FTopItem;
end;

procedure TfcCustomOutlookList.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;

procedure TfcCustomOutlookList.SetClickStyle(Value: TfcCustomOutlookListClickStyle);
begin
  FClickStyle := Value;
end;

procedure TfcCustomOutlookList.SetImageList(Value: TCustomImageList);
begin
  if (FImageList <> nil) then FImageList.UnregisterChanges(FChangeLink);
  FImageList := Value;
  if Value <> nil then
  begin
    Value.FreeNotification(self);
    Value.RegisterChanges(FChangeLink);
  end;
  Invalidate;
end;

procedure TfcCustomOutlookList.SetItemLayout(Value: TButtonLayout);
begin
  if FItemLayout <> Value then
  begin
    FItemLayout := Value;
    Invalidate;
  end;
end;

procedure TfcCustomOutlookList.SetItemHighlightColor(Value: TColor);
begin
  if FItemHighlightColor <> Value then
  begin
    FItemHighlightColor := Value;
    Invalidate;
  end;
end;

procedure TfcCustomOutlookList.SetItemDisabledTextColor(Value: TColor);
begin
  if FItemDisabledTextColor <> Value then
  begin
    FItemDisabledTextColor := Value;
    Invalidate;
  end;
end;

procedure TfcCustomOutlookList.SetItemShadowColor(Value: TColor);
begin
  if FItemShadowColor <> Value then
  begin
    FItemShadowColor := Value;
    Invalidate;
  end;
end;

procedure TfcCustomOutlookList.SetItems(Value: TfcOutlookListItems);
begin
  FItems.Assign(Value);
end;

procedure TfcCustomOutlookList.SetItemSpacing(Value: Integer);
begin
  if FItemSpacing <> Value then
  begin
    FItemSpacing := Value;
    if Odd(FItemSpacing) then inc(FItemSpacing);
    Invalidate;
  end;
end;

procedure TfcCustomOutlookList.SetItemsWidth(Value: Integer);
begin
  if FItemsWidth <> Value then
  begin
    FItemsWidth := Value;
    Invalidate;
  end;
end;

procedure TfcCustomOutlookList.SetLayout(Value: TfcLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    Invalidate;
  end;
end;

procedure TfcCustomOutlookList.SetMouseInScrollButton(Value: TfcScrollButtonStyle);
begin
  if (FMouseInScrollButton <> Value) and ScrollButtonVisible(Value) then
  begin
    InvalidateScrollButton(FMouseInScrollButton);
    FMouseInScrollButton := Value;
    InvalidateScrollButton(Value);
  end;
end;

procedure TfcCustomOutlookList.SetScrollButtonsVisible(Value: Boolean);
begin
  if FScrollButtonsVisible <> Value then
  begin
    FScrollButtonsVisible := Value;
    Invalidate;
  end;
end;

procedure TfcCustomOutlookList.SetTopItem(Value: TfcOutlookListItem);
begin
  if FTopItem <> Value then
  begin
    FTopItem := Value;
    Invalidate;
  end;
end;

function TfcCustomOutlookList.GetFirstVisibleItem: TfcOutlookListItem;
var i: integer;
begin
   result:= nil;
   for i:= 0 to Items.count-1 do
   begin
       if items[i].visible then
       begin
          result:= items[i];
          exit;
       end;
  end;
end;

function TfcCustomOutlookList.ScrollButtonVisible(Button: TfcScrollButtonStyle): Boolean;
begin
  result := False;
  case Button of
    sbUp: result := not ((TopItem = nil) or (TopItem = GetFirstVisibleItem));
    sbDown: begin
      result := (TopItem<>nil) and (GetNextVisibleItem(BottomItem)<>nil);
    end;