fcoutlooklist.pas

一套及时通讯的原码

destructor TfcOutlookPanel.Destroy;
begin
   inherited;
end;

procedure TfcOutlookPanel.SetTransparent(Value: Boolean);
begin
  if FTransparent <> Value then
  begin
    FTransparent := Value;
    if Parent <> nil then Parent.Invalidate;
  end;
end;

procedure TfcOutlookPanel.WndProc(var Message: TMessage);
begin
  inherited;
end;

procedure TfcOutlookPanel.AlignControls(AControl: TControl; var Rect: TRect);
//var OutlookBar: TfcCustomOutlookBar;
begin
  {  4/14/99 - RSW - During animating do not align controls }
{  if (Parent is TfcCustomOutlookBar) then
  begin
     OutlookBar:=TfcCustomOutlookBar(Parent);
     if OutlookBar.AnimatingControls then exit;
  end;}
  inherited;
  if AControl is TGraphicControl then Invalidate;
end;

procedure TfcOutlookPanel.Paint;
var FPaintImageBitmap: TBitmap;
    OutlookBar: TfcCustomOutlookBar;
    OffsetClipRect: TRect;
//    curPanel: TfcOutlookPanel;
    r, r1, ir: TRect;
    j: integer;
begin
  { 4/10/99 - RSW - Paint imager area for ClipRect area }
  if (Parent is TfcCustomOutlookBar) then
  begin
     OutlookBar:=TfcCustomOutlookBar(Parent);
     if Transparent and (not OutlookBar.AnimatingControls) and
       (OutLookBar.Imager <> nil) then
     begin
        FPaintImageBitmap := TBitmap.Create;
        FPaintImageBitmap.Width := OutlookBar.Width;
        FPaintImageBitmap.Height := OutlookBar.Height;

        if OutlookBar.Imager.DrawStyle=dsTile then
           OutlookBar.Imager.WorkBitmap.TileDraw(
             FPaintImageBitmap.Canvas, Rect(0,0,OutlookBar.Width, OutlookBar.Height))
        else
          FPaintImageBitmap.Canvas.StretchDraw(
             Rect(0,0,OutlookBar.Width, OutlookBar.Height),
             OutlookBar.Imager.WorkBitmap);

        with Canvas.ClipRect do
          OffsetClipRect:= Rect(Left + BoundsRect.Left, Top + BoundsRect.Top,
                                Right+ BoundsRect.Left, Bottom+BoundsRect.Top);
        Canvas.CopyRect(Canvas.ClipRect, FPaintImageBitmap.Canvas, OffsetClipRect);
        FPaintImageBitmap.Free;
     end;

  end;

  if GetWindowLong(Parent.Handle, GWL_STYLE) and WS_CLIPCHILDREN = WS_CLIPCHILDREN then
  begin
    SetWindowLong(Parent.Handle, GWL_STYLE,
      GetWindowLong(Parent.Handle, GWL_STYLE) and not WS_CLIPCHILDREN);
    Invalidate;
  end;

  { 4/15/99 - RSW - only invalidate controls that intersect with cliprect.
    Neccesary when controls alClient }
  if (Parent is TfcCustomOutlookBar) then
  begin
     if not TfcCustomOutlookBar(Parent).InAnimation then exit;
     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 }

        r1:= TfcOutlookBar(parent).canvas.cliprect;
        if IntersectRect(ir, r1, r) then begin
           offsetRect(r, -left, -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;

{  for i := 0 to ControlCount - 1 do
    if Controls[i] is TWinControl then
      InvalidateRect((Controls[i] as TWinControl).Handle, nil, False);}
end;

procedure TfcOutlookPanel.CMControlListChange(var Message: TCMControlListChange);
begin
  inherited;
  if (Message.Inserting = False) and (Message.Control is TfcCustomOutlookList) then Invalidate;
end;

procedure TfcOutlookPanel.WMEraseBkgnd(var Message: TWMEraseBkGnd);
var  j: integer;
//var Rgn, TmpRgn: HRGN;
begin
  for j := 0 to ControlCount - 1 do // RSW - 3/19/99 - If contain outlooklist then don't erase
    if Controls[j] is TfcOutlookList then
      if not (Controls[j] as TfcOutlookList).Transparent then
      begin
        Message.result:=1;
        exit;
      end;

  if not Transparent or not Animating and ((Parent is TfcCustomOutlookBar) and ((Parent as TfcCustomOutlookBar).Imager = nil)) then
  begin
    inherited;
    Exit;
  end;

  if FInEraseBkGnd then Exit;
  if not TfcOutlookPage(OutlookPage).OutlookBar.AnimatingControls then exit; { RSW }
{  FInEraseBkGnd := True;
  Message.result := 1;

  if FPreventUpdate then Exit;
  if Parent <> nil then
  begin
    Rgn := CreateRectRgn(0, 0, Width, Height);
    TmpRgn := CreateRectRgn(0, 0, 0, 0);
    fcGetChildRegions(self, True, TmpRgn, Point(0, 0), RGN_OR);
    CombineRgn(Rgn, Rgn, TmpRgn, RGN_DIFF);
    DeleteObject(TmpRgn);
    OffsetRgn(Rgn, Left, Top);

    InvalidateRgn(Parent.Handle, Rgn, False);
    Parent.Update;

    DeleteObject(Rgn);
  end;
  FInEraseBkGnd := False;}
end;

constructor TfcOutlookListItem.Create(Collection: TCollection);
begin
  inherited;
  FSeparation := 10;
  {$ifdef fcDelphi4Up}
  FTextAlignment:= taCenter;
  {$endif}
  FVisible:= True;
  FEnabled:= True;
end;

destructor TfcOutlookListItem.Destroy;
begin
  if OutlookList.FTopItem = self then OutlookList.TopItem := nil;
  //5/10/2002-PYW-Moved before inherited.
  if FActionLink <> nil then // 10/10/01 - PYW - Actionlink not getting freed so free it.
  begin
    FActionLink.Free;
    FActionLink := nil;
  end;
  inherited;
end;

function TfcOutlookListItem.GetDisplayName: string; { 4/26/99 - RSW }
begin
  Result := Text;
  if Result = '' then Result := inherited GetDisplayName;
end;

function TfcOutlookListItem.GetSelected: Boolean;
begin
  if OutlookList.ClickStyle = csSelect then result := FSelected else result := False;
end;

function TfcOutlookListItem.GetOutlookList: TfcCustomOutlookList;
begin
  result := (Collection as TfcOutlookListItems).OutlookList;
end;

procedure TfcOutlookListItem.SetImageIndex(Value: Integer);
begin
  if FImageIndex <> Value then
  begin
    FImageIndex := Value;
    Invalidate(True);
  end;
end;

procedure TfcOutlookListItem.SetEnabled(Value: boolean);
begin
   FEnabled:= Value;
   Invalidate(True);
end;

procedure TfcOutlookListItem.SetVisible(Value: boolean);
begin
   if Value=FVisible then exit;
   FVisible:= Value;
   RefreshDesign;
   if OutlookList.TopItem=self then
   begin
     if not Value then
        OutlookList.TopItem := OutlookList.GetNextVisibleItem(OutlookList.TopItem)
//     else
//        OutlookList.TopItem := OutlookList.GetPriorVisibleItem(OutlookList.TopItem)
   end;
{   if OutlookList.BottomItem=self then
   begin
     if not Value then
     begin
        OutlookList.BottomItem := OutlookList.GetPriorVisibleItem(OutlookList.TopItem)
     end
   end;
}
   OutlookList.UpdateButtonRects;
//   OutlookList.UpdateMouseOnItem;
   OutlookList.Invalidate;
end;

procedure TfcOutlookListItem.SetHint(Value: String);
begin
   FHint:= Value;
end;

procedure TfcOutlookListItem.SetMouseDownOnItem(Value: Boolean);
begin
  if FMouseDownOnItem <> Value then
  begin
    FMouseDownOnItem := Value;
    if not Selected then Invalidate(False);
  end;
end;

procedure TfcCustomOutlookList.CNChar(var Message: TWMChar);
begin
  if not (csDesigning in ComponentState) then
    with Message do
    begin
      if not Focused then
         Result := 0  // 3/28/01 - don't use inherited as it may call accelerators if capture is true
      else
         inherited;
    end;
end;

procedure TfcOutlookListItem.SetMouseOnItem(Value: Boolean);
begin
  if not (csDesigning in Outlooklist.ComponentState) and ((FMouseOnItem <> Value) or (Value and (GetCapture <> OutlookList.Handle))) then
  begin
    FMouseOnItem := Value;
    if not FMouseOnItem then
       MouseDownOnItem := False;
    //9/10/99 - Make certain that Button is always invalidated
{    if not Selected then }Invalidate(False);
    if Value and (GetCapture <> OutlookList.Handle) then windows.SetCapture(OutlookList.Handle);
  end;
end;

procedure TfcOutlookListItem.SetSelected(Value: Boolean);
var i: Integer;
begin
  if FSelected <> Value then
  begin
    if Value then for i := 0 to OutlookList.Items.Count - 1 do
      if OutlookList.Items[i] <> self then
        OutlookList.Items[i].Selected := False;
    FSelected := Value;
    Invalidate(not FSelected);
  end;
end;

procedure TfcOutlookListItem.SetSeparation(Value: Integer);
begin
  if FSeparation <> Value then
  begin
    FSeparation := Value;
    Invalidate(True);
  end;
end;

function TfcOutlookListItem.DisplayRect(Code: TDisplayCode; AStartPos: Integer): TRect;
var i: Integer;
    ItemSize, ItemSizeNoPad: TSize;
    Offset: Integer;
    TextSize: TSize;
    tempRect: TRect;
  function ImageListSize: TSize;
  begin
    result := fcSize(0, 0);
    if OutlookList.Images <> nil then with TImageList(OutlookList.Images) do
      result := fcSize(Width, Height);
  end;
begin
  SetRectEmpty(result);

  if IsVisible(False) then
    with OutlookList do
    begin
      ItemSize := GetItemSize(True);
      ItemSizeNoPad := GetItemSize(False);

      Offset := 0;
      if AStartPos = -1 then
      begin
        for i := TopItem.Index to BottomItem.Index do
          if Index = Items[i].Index then Break else
          begin
             if Items[i].Visible then
                inc(Offset, Items[i].SpacingSize);
          end
      end else Offset := AStartPos;

      if Layout = loVertical then
      begin
        result.Top := Offset;
        result.Bottom := result.Top + ItemSize.cy;
        result.Right := ClientWidth;
      end else begin
        inc(result.Left, Offset);
        result.Right := result.Left + ItemSize.cx;
        result.Bottom := ClientHeight;
      end;

      tempRect:= Result; { 7/9/99 - PYW -Compute height and consider carrige returns }
      if (ImageListSize.cx > 0) and {7/9/99 - Adjust based on ItemLayout and glyph}
         (OutlookList.ItemLayout=blglyphLeft) then
         tempRect.Left := {$ifdef fcDelphi4Up}GlyphOffset+{$endif}tempRect.Left+Separation + ImageListSize.cx + 4;

      TextSize.cy:= DrawText(PaintCanvas.Handle, PChar(self.Text), Length(self.Text), TempRect, DT_CALCRECT or DT_CENTER or DT_END_ELLIPSIS or DT_WORDBREAK);
      TextSize.cx:= TempRect.Right-TempRect.Left;

      case Code of
        drBounds, drSelectBounds: ;
        drIcon: begin
          fcCalcButtonLayout(Point(result.Left + fcRectWidth(result) div 2, result.Top + fcRectHeight(result) div 2),
            nil, @result, TextSize, ImageListSize, ItemLayout, self.Separation);
          InflateRect(result, 2, 2);
        end;
        drLabel: begin
          fcCalcButtonLayout(Point(result.Left + fcRectWidth(result) div 2, result.Top + fcRectHeight(result) div 2),
            @result, nil, TextSize, ImageListSize, ItemLayout, self.Separation);
        end;
      end;
    end;
end;

{$ifdef fcDelphi4Up}
procedure TfcOutlookListItem.SetTextAlignment(Value: TAlignment);
begin
  if FTextAlignment <> Value then
  begin
    FTextAlignment := Value;
    RefreshDesign;
    Invalidate(True);
  end;
end;

procedure TfcOutlookListItem.SetGlyphOffset(Value: integer);
begin
  if FGlyphOffset <> Value then
  begin
    FGlyphOffset := Value;
    RefreshDesign;
    Invalidate(True);
  end;
end;
{$endif}

procedure TfcOutlookListItem.SetText(Value: string);
begin
  if FText <> Value then
  begin
    FText := Value;
    RefreshDesign;
    Invalidate(True);
  end;
end;

function TfcOutlookListItem.GetItemSize(IncludePadding: Boolean): TSize;
var Padding: Integer;
begin
  result := OutlookList.PaintCanvas.TextExtent(Text);
  Padding := 0;
  if IncludePadding then inc(Padding, OutlookList.ItemSpacing);