fcoutlooklist.pas

一套及时通讯的原码

  if OutlookList.Layout = loVertical then inc(result.cy, Padding) else inc(result.cx, Padding);
  if OutlookList.Images <> nil then
  begin
    if OutlookList.ItemLayout in [blGlyphTop, blGlyphBottom] then
      inc(result.cy, TImageList(OutlookList.Images).Height + Separation)
    else
      {$ifdef fcDelphi4Up} //7/27/99-PYW-Added extra padding for textrect
      inc(result.cx,8+GlyphOffset+TImageList(OutlookList.Images).Width + Separation);
      {$else}
      inc(result.cx,TImageList(OutlookList.Images).Width + Separation);
      {$endif}
  end;
  if (OutlookList.Layout = loHorizontal) and (OutlookList.ItemsWidth > 0) then result.cx := OutlookList.ItemsWidth;
end;

function TfcOutlookListItem.SpacingSize: Integer;
begin
  if OutlookList.Layout = loVertical then result := GetItemSize(True).cy
  else result := GetItemSize(True).cx;
end;

function TfcOutlookListItem.IsVisible(Completely: Boolean): Boolean;
begin
  result := False;
  if OutlookList.TopItem = nil then Exit;
  result := (Index >= OutlookList.TopItem.Index) and (Index <= OutlookList.BottomItem.Index) and
            visible; // 5/5/03
  if result and Completely then with OutlookList do
    result := (ItemRect.Right <= Width) and (ItemRect.Bottom <= Height);
end;

procedure TfcOutlookListItem.Paint;
var BoundsRect, TextRect, IconRect, TempIconRect: TRect;
    StartBounds: PInteger;
    DefaultDrawing: Boolean;
    GlyphPos, TextPos: TPoint;
    Flags: integer;
    r: TRect;
begin
  GetUpdateRect(OutlookList.handle, r, False);
  GetUpdateRect(OutlookList.parent.handle, r, False);
  if OutlookList.Layout = loVertical then StartBounds := @BoundsRect.Top else StartBounds := @BoundsRect.Left;
  BoundsRect := DisplayRect(drBounds, -1);
  TextRect := DisplayRect(drLabel, StartBounds^);
  IconRect := DisplayRect(drIcon, StartBounds^);

  FItemRect := BoundsRect;

  with OutlookList do
  begin
    PaintCanvas.Brush.Color := Color;
    PaintCanvas.Font.Color := Font.Color;
    if IsEffectiveItemHilite and MouseOnItem and self.Enabled then
    begin
        PaintCanvas.Font.Color := HotTrackTextColor
    end;
    //9/10/99 - Make certain that selected color is the same as the hottracktextcolor.
    if self.Selected then PaintCanvas.Font.Color := HotTrackTextColor;
    if IsEffectiveItemHilite and IsDown then OffsetRect(TextRect, 1, 1);
  end;

  DefaultDrawing := True;
  GlyphPos := IconRect.TopLeft;
  TextPos := TextRect.TopLeft;
  {$ifdef fcDelphi4Up}
  if (GlyphOffset>0) and (OutlookList.Images <> nil) then
  begin //7/9/99 - PYW - Adjust based on ItemLayout
     if (OutlookList.ItemLayout = blGlyphLeft) then begin
        TextPos.X := FItemRect.Left+4+TImageList(OutlookList.Images).Width + GlyphOffset + Separation;
        if OutlookList.IsEffectiveItemHilite and IsDown then inc(TextPos.X);
        GlyphPos.X:= FItemRect.Left+GlyphOffset;
     end
     else if (OutlookList.ItemLayout = blGlyphRight) then begin
        TextPos.X := FItemRect.Left+3;
        if OutlookList.IsEffectiveItemHilite and IsDown then inc(TextPos.X);
        GlyphPos.X := FItemRect.Right - TImageList(OutlookList.Images).Width - GlyphOffset - 1;
     end;
  end;
  {$endif}

  OutlookList.DoDrawItem(self, GlyphPos, TextPos, DefaultDrawing);

  OffsetRect(IconRect, GlyphPos.x - IconRect.Left, GlyphPos.y - IconRect.Top);
  OffsetRect(TextRect, TextPos.x - TextRect.Left, TextPos.y - TextRect.Top);
  TempIconRect := IconRect;

 {$ifdef fcDelphi4Up}
  if OutlookList.Layout = loVertical then begin
 {$endif}
     if not OutlookList.IsEffectiveItemHilite then
       UnionRect(FButtonRect, IconRect, TextRect);
 {$ifdef fcDelphi4Up}
  end;
 {$endif}
  if OutlookList.IsEffectiveItemHilite then FButtonRect := BoundsRect;

  if DefaultDrawing then
    with OutlookList do
  begin
    PaintButton(TempIconRect);
    SetBkMode(PaintCanvas.Handle, Windows.TRANSPARENT);
    SetTextColor(PaintCanvas.Handle, PaintCanvas.Font.Color);
    Flags:= DT_END_ELLIPSIS or DT_WORDBREAK;
    {$ifdef fcDelphi4Up}
    case TextAlignment of
      taLeftJustify : Flags:= Flags or DT_LEFT;
      taCenter : Flags:= Flags or DT_CENTER;
      taRightJustify : Flags := Flags or DT_RIGHT;
    end;
    //7/27/99 - PYW - Added GlyphOffset and Alignment support
    if (GlyphOffset > 0) and
       ((OutlookList.ItemLayout=blGlyphLeft) or (OutlookList.ItemLayout=blGlyphRight)) then begin
       TextRect.Left := FItemRect.Left+3;
       TextRect.Right := FItemRect.Right-4;

       if (OutlookList.ItemLayout=blGlyphLeft) then begin
           if (OutlookList.Images <> nil) then
              TextRect.Left:= IconRect.Right+Separation;
       end
       else begin
          if (OutlookList.Images <> nil) then
             TextRect.Right := IconRect.Left-Separation;
       end;

       if OutlookList.IsEffectiveItemHilite and IsDown then begin
          inc(TextRect.Left);
          inc(TextRect.Right);
       end;
    end;
    {$else}
    Flags:= Flags or DT_CENTER;
    {$endif}

    //7/27/99-PYW- Moved this portion here in the Horizontal layout case, because
    //             TextRect Width has changed and the ButtonRect needs to be updated
    //             for the control.
    {$ifdef fcDelphi4Up}
    if OutlookList.Layout = loHorizontal then begin
      if not OutlookList.IsEffectiveItemHilite then
        UnionRect(FButtonRect, IconRect, TextRect);
    end;
    {$endif}

// Commented as with default colors, the text blends to the background
//    if not self.Enabled then
//       PaintCanvas.Font.Color:= clGrayText;
    if not self.Enabled then PaintCanvas.Font.Color := ItemDisabledTextColor;
    DrawText(PaintCanvas.Handle, PChar(self.Text), Length(self.Text), TextRect, Flags);
  end;

end;


function TfcOutlookListItem.IsDown: Boolean;
begin
  result := (MouseOnItem and MouseDownOnItem) or Selected;
end;

procedure TfcOutlookListItem.PaintButton(IconRect: TRect);
var Down: Boolean;
    Offset: TPoint;
    PaintRect: TRect;
  function ImageListSize: TSize;
  begin
    result := fcSize(0, 0);
    if OutlookList.Images <> nil then with TImageList(OutlookList.Images) do
      result := fcSize(Width, Height);
  end;
var OldBrush, OldPen: TColor;
begin
  with Outlooklist do
  begin
    Down := IsDown;

    OldBrush := PaintCanvas.Brush.Color;
    OldPen := PaintCanvas.Pen.Color;

    if not OutlookList.IsEffectiveItemHilite then
       PaintRect:= IconRect
    else
       PaintRect:= ButtonRect;

    { 6/18/99 }
    {$ifdef fcDelphi4Up}
    if self.Selected and (FItemSelectedDitherColor<>clNone) then
       fcDither(PaintCanvas, PaintRect, PaintCanvas.Brush.Color, FItemSelectedDitherColor)
    {$else}
    if self.Selected then fcDither(PaintCanvas, PaintRect, PaintCanvas.Brush.Color, clBtnHighlight)
    {$endif}
    else if (ItemHotTrackColor <> Color) and (ItemHotTrackColor <> clNone) and MouseOnItem and self.Enabled then
    begin
      PaintCanvas.Brush.Color := ItemHotTrackColor;
      PaintCanvas.FillRect(PaintRect);
    end;

    PaintCanvas.Pen.Color := Color;
    if self.Selected or (MouseOnItem and Down and self.Enabled) then
       PaintCanvas.Pen.Color := FItemShadowColor
    else if MouseOnItem and self.Enabled then
       PaintCanvas.Pen.Color := FItemHighlightColor else PaintCanvas.Pen.Color := clNone;

    if PaintCanvas.Pen.Color <> clNone then
       with PaintRect do PaintCanvas.PolyLine([Point(Left, Bottom - 1), Point(Left, Top), Point(Right - 1, Top)]);

    if self.Selected or (MouseOnItem and Down and self.Enabled) then
       PaintCanvas.Pen.Color := FItemHighlightColor
    else if MouseOnItem and self.Enabled then
       PaintCanvas.Pen.Color := FItemShadowColor else PaintCanvas.Pen.Color := clNone;

    if PaintCanvas.Pen.Color <> clNone then with PaintRect do
       PaintCanvas.PolyLine([Point(Left, Bottom - 1), Point(Right - 1, Bottom - 1), Point(Right - 1, Top)]);

    with ImageListSize do
      Offset := Point(IconRect.Left + (fcRectWidth(IconRect) div 2 - cx div 2), IconRect.Top + (fcRectHeight(IconRect) div 2 - cy div 2));
    if IsEffectiveItemHilite and Down then Offset := Point(Offset.x + 1, Offset.y + 1);
    if Images <> nil then fcImageListDraw(Images, ImageIndex, PaintCanvas, Offset.x, Offset.y, ILD_NORMAL, True { self.enabled});
    if self = TopItem then PaintScrollButton(sbUp);
    if self = BottomItem then
      PaintScrollButton(sbDown);

    PaintCanvas.Brush.Color := OldBrush;
    PaintCanvas.Pen.Color := OldPen;
  end;
end;

procedure TfcOutlookListItem.Invalidate(Erase: Boolean);
var r: TRect;
begin
  r := DisplayRect(drBounds, -1);
  r.Top:= r.Top -1;
  InvalidateRect(OutlookList.Handle, @r, Erase);
end;

constructor TfcOutlookListItems.Create(AOutlookList: TfcCustomOutlookList; ACollectionItemClass: TfcOutlookListItemClass);
begin
  inherited Create(ACollectionItemClass);
  FOutlookList := AOutlookList;
end;

function TfcOutlookListItems.GetOwner: TPersistent;
begin
  result := OutlookList;
end;

function TfcOutlookListItems.GetItems(Index: Integer): TfcOutlookListItem;
begin
  result := inherited Items[Index] as TfcOutlookListItem;
end;

procedure TfcOutlookListItems.Update(Item: TCollectionItem);
begin
  OutlookList.Invalidate;
end;

function TfcOutlookListItems.Add: TfcOutlookListItem;
begin
  result := inherited Add as TfcOutlookListItem;
end;

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

constructor TfcCustomOutlookList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReflector, csAcceptsControls] - [csCaptureMouse];
  Color := clBtnShadow;
  FBorderStyle := bsSingle;
  FChangeLink := TChangeLink.Create;
  FChangeLink.OnChange := ImageListChange;
  FItems := TfcOutlookListItems.Create(self, TfcOutlookListItem);
  FItemLayout := blGlyphTop;
  FItemHotTrackColor := Color;
  FItemDisabledTextColor:= clBtnFace;
  FItemSpacing := 20;
  FItemHighlightColor := clBtnFace;
  FItemShadowColor := clBtnText;
  FPaintBitmap := TBitmap.Create;
  FPaintBitmap.Width := Width;
  FPaintBitmap.Height := Height;
  FScrollButtonsVisible := True;
  FScrollInterval := 250;

  {$ifdef fcDelphi4Up}
  FItemSelectedDitherColor:= clBtnHighlight;
  {$endif}

  Font.Color := clWhite;
  Transparent := False;
end;

destructor TfcCustomOutlookList.Destroy;
begin
  FPaintBitmap.Free;
  FChangeLink.Free;
  FItems.Free;
  FreeHintWindow;

  inherited;
end;

procedure TfcCustomOutlookList.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if BorderStyle = bsSingle then with Params do
  begin
    Style := Style and not WS_BORDER;
    ExStyle := ExStyle or WS_EX_CLIENTEDGE;
  end;
end;

procedure TfcCustomOutlookList.Loaded;
begin
  inherited;
  ClickStyle := ClickStyle;
  UpdateScrollButtonsRect;
end;

procedure TfcCustomOutlookList.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var i: Integer;
    pt: TPoint;
begin
  inherited;

  HintWindow.Free;
  HintWindow:= nil;

  if Button <> mbLeft then Exit;

  pt := Point(x, y);

  if PtInRect(FUpButtonRect, pt) then FScrollButtonDown := sbUp
  else if PtInRect(FDownButtonRect, pt) then FScrollButtonDown := sbDown
  else FScrollButtonDown := sbNone;
  if (FScrollButtonDown <> sbNone) and ScrollButtonVisible(FScrollButtonDown) then
  begin
    FOldCapture := GetCapture;
    SetCapture(Handle);
    InvalidateScrollButton(FScrollButtonDown);
    SetTimer(Handle, ScrollTimerID, ScrollInterval, nil);
  end else
    if (TopItem <> nil) then for i := TopItem.Index to BottomItem.Index do
    begin
      if not Items[i].visible then continue; // 5/5/03
      if not Items[i].Enabled then continue; // 5/5/03
      if PtInRect(Items[i].ButtonRect, pt) then
      begin
        Items[i].MouseDownOnItem := True;
        Break;
      end
    end;
end;

Function TfcCustomOutlookList.GetImager: TfcCustomImager;
begin
   result:=nil;
   if OutlookPage=nil then exit;
   if TfcOutlookPage(OutlookPage).OutlookBar=nil then exit;
   result:= TfcOutlookPage(OutlookPage).OutlookBar.Imager;
end;

procedure TfcCustomOutlookList.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var OldScrollButtonDown: TfcScrollButtonStyle;
    i: Integer;
    pt: TPoint;
begin
  inherited;
  if Button <> mbLeft then Exit;

  pt := Point(x, y);

  if TopItem <> nil then
    for i := TopItem.Index to BottomItem.Index do
    begin
      if not Items[i].visible then continue; // 5/5/03
      if i>=Items.Count then break;  // 2/7/2002-Added to handle case where ItemClick deletes an item.
      if Items[i].MouseDownOnItem and PtInRect(Items[i].ButtonRect, pt) then ItemClick(Items[i]);
      Items[i].MouseDownOnItem := False;
    end;

  OldScrollButtonDown := FScrollButtonDown;
  if ScrollButtonVisible(FScrollButtonDown) then case FScrollButtonDown of
    sbUp: if PtInRect(FUpButtonRect, pt) then ScrollButtonClick;
    sbDown: if PtInRect(FDownButtonRect, pt) then ScrollButtonClick;
  end;
  if (FScrollButtonDown <> sbNone) then
  begin
    KillTimer(Handle, ScrollTimerID);
    ReleaseCapture;