aoutlbar.pas

来自「delphi编程控件」· PAS 代码 · 共 2,084 行 · 第 1/5 页

  property Align;
  property BkGround : TAutoOutLookBarBackGround read FBkGround write SetBkGround;
  property BkPicture : TPicture read FBkPicture write SetBkPicture;
  property Color;
  property CanSelected : Boolean read FCanSelected write SetCanSelected;
  property GroupFont : TFont read FGroupFont write SetGroupFont;
  property Groups : TAutoOutLookGroups read FGroups write SetGroups;
  // Have to be defined after property Groups !
  property ActiveGroupIndex : Integer read FActiveGroupIndex write SetActiveGroupIndex;
  property GroupPopupMenu : TPopupMenu read FGroupPopupMenu write FGroupPopupMenu;
  property ItemFont : TFont read FItemFont write SetItemFont;
  property ItemPopupMenu : TPopupMenu read FItemPopupMenu write FItemPopupMenu;
  property ScrollDelay : Integer read FScrollDelay write SetScrollDelay;
  property SpaceHeight : Integer read FSpaceHeight write SetSpaceHeight;
  property Store : TAutoOutLookBarStore read FStore write SetStore;
  property TransparentImages : Boolean read FTransparentImages write SetTransparentImages;
  property OnItemClick : TAutoOutLookBarItemClickEvent read FOnItemClick write FOnItemClick;  
  property OnDeleteItem : TAutoOutLookBarDeleteItemEvent read FOnDeleteItem write FOnDeleteItem;
  property OnChangeActiveGroup : TNotifyEvent read FOnChangeActiveGroup write FOnChangeActiveGroup;
  property OnChangeFocusedItem : TNotifyEvent read FOnChangeFocusedItem write FOnChangeFocusedItem;
  property OnChangeGroupCaption : TAutoOutLookBarChangeGroupCaptionEvent
           read FOnChangeGroupCaption write FOnChangeGroupCaption;
  property OnChangeSelectedItem : TNotifyEvent read FOnChangeSelectedItem
           write FOnChangeSelectedItem;           
  property BorderStyle;
  property DragCursor;
  property DragMode read FDragMode write FDragMode;
  property Enabled;
  property Ctl3D;
  property Locked;
  property ParentColor;
  property ParentCtl3D;
  property ParentShowHint;
  property ShowHint;
  property Visible;
  property OnAfterEdit : TNotifyEvent read FOnAfterEdit write FOnAfterEdit;  
  property OnBeforeEdit : TNotifyEvent read FOnBeforeEdit write FOnBeforeEdit;
  property OnClick;
  property OnDblClick;
  property OnDragDrop;
  property OnDragDropItem : TAutoOutLookBarDragDropItemEvent read FOnDragDropItem
                          write FOnDragDropItem;
  property OnDragOver;
  property OnEndDrag;
  property OnEnter;
  property OnExit;
  property OnMouseDown;
  property OnMouseEnter : TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
  property OnMouseLeave : TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  property OnMouseMove;
  property OnMouseUp;
  property OnResize;
  property OnStartDrag;
end;

TAutoOutLookPopupMenuOption = (aomIconType, aomAddGroup, aomRemoveGroup,
               aomCustomize, aomRenameGroup, aomRenameItem, aomRemoveItem);

TAutoOutLookPopupMenuOptions = set of TAutoOutLookPopupMenuOption;

TAutoOutLookPopupMenu = class(TPopupMenu)
private
  FOptions : TAutoOutLookPopupMenuOptions;
  List : TList;
  Bar : TAutoOutLookBar;
  Group : TAutoOutLookGroup;
  FOnAfterClick : TNotifyEvent;
  FOnPopupClose : TNotifyEvent;
protected
  procedure BarMenuClick(Sender : TObject);
  procedure DestroyBarItems;
public
  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;

  procedure Popup(X, Y: Integer); override;
published
  property Options : TAutoOutLookPopupMenuOptions read FOptions write FOptions;
  property OnAfterClick : TNotifyEvent read FOnAfterClick write FOnAfterClick;
  property OnPopupClose : TNotifyEvent read FOnPopupClose write FOnPopupClose;
end;

EAutoOutLookBarError = class(Exception);

TAutoOutLookBarDragObject = class(TObject)
private
  FStoredItem : TAutoOutLookStoredItem;
  FItem : TAutoOutLookItem;
  FDeleteItem : Boolean;
public
  constructor Create(Control : TControl; var DragObject: TDragObject;
            AItem : TAutoOutLookItem; AStoredItem : TAutoOutLookStoredItem);
  function EndDrag(Target: TObject; X, Y: Integer) : TAutoOutLookItem;
  property DeleteItem : Boolean read FDeleteItem write FDeleteItem;
  property Item : TAutoOutLookItem read FItem;
  property StoredItem : TAutoOutLookStoredItem read FStoredItem;
end;

Var
 AutoOutLookBarDragObject : TAutoOutLookBarDragObject;

implementation
{$R aoutlbar.res}

{$IFDEF INCLUDE_DESIGNTIME}
  uses autostrs, aclconst, aoutlsed, aoutlbcs, agraphic;
{$ELSE}
  uses autostrs, aclconst, aoutlbcs, agraphic;
{$ENDIF}

const
  ScrollButtonHeight = 16;
  ScrollButtonIndention = 3;

procedure DrawBmpOnCanvas(ACanvas : TCanvas; APicture : TPicture;
          ADrawRect : TRect; AWidth, AHeight : Integer);
Var
  dLeft, dTop, dWidth, dHeight, sLeft, sTop  : Integer;
  ABmp : TBitmap;
  ACreatedFlag : Boolean;
begin
  dTop := ADrawRect.Top;
  ABmp := Nil;
  ACreatedFlag := False;
  if(APicture.Graphic is TBitmap) then
    ABmp := APicture.Bitmap;
  if(APicture.Graphic is TIcon)
  Or (APicture.Graphic is TMetaFile)then begin
    ABmp := TBitmap.Create;
    ABmp.Height := APicture.Graphic.Height;
    ABmp.Width := APicture.Graphic.Height;
    ABmp.Canvas.Draw(0, 0, APicture.Graphic);
    ACreatedFlag := True;
  end;

  if(ABmp = Nil) then begin
    ACanvas.FillRect(ADrawRect);
    exit;
  end; 
  while (dTop < ADrawRect.Bottom) do begin
     if(dTop mod ABmp.Height <> 0) then
       sTop := dTop - (dTop div ABmp.Height) * ABmp.Height
     else sTop := 0;
     dHeight := ABmp.Height - sTop;
     if(dTop + dHeight > ADrawRect.Bottom) then
       dHeight := ADrawRect.Bottom - dTop;
     dLeft := ADrawRect.Left;
     while (dLeft < ADrawRect.Right) do begin
       if(dLeft mod ABmp.Width <> 0) then
         sLeft := dLeft - (dLeft div ABmp.Width) * ABmp.Width
       else sLeft := 0;
       dWidth := ABmp.Width - sLeft;
       if(dLeft + dWidth > ADrawRect.Right) then
         dWidth := ADrawRect.Right - dLeft;
       BitBlt(ACanvas.Handle, dLeft, dTop, dWidth, dHeight,
         ABmp.Canvas.Handle, sLeft, sTop, SRCCOPY);
       dLeft := ABmp.Width * ((dLeft div ABmp.Width) + 1);         
     end;
     dTop := ABmp.Height * ((dTop div ABmp.Height) + 1);
  end;
  if ACreatedFlag then
    ABmp.Free;
end;  

procedure DrawDifColorsOnCanvas(ACanvas : TCanvas; ABeginColor, AEndColor : TColor;
          AIsHorz : Boolean; ADrawRect : TRect; AWidth, AHeight : Integer);
Const
  cdXY = 3;
Var
  dColor : Integer;
  AColor : TColor;
  OldColor : TColor;
  r : TRect;
begin
  OldColor := ACanvas.Brush.Color;
  dColor := (AEndColor - ABeginColor) * cdXY div AHeight;
  r := ADrawRect;
  if AIsHorz then begin
    r.Top := ADrawRect.Top;
    AColor := ABeginColor + dColor * (r.Top div cdXY);
    while (r.Top < ADrawRect.Bottom) do begin
      r.Bottom := r.Top + cdXY;
      if(r.Bottom > ADrawRect.Bottom) then
        r.Bottom := ADrawRect.Bottom;
      ACanvas.Brush.Color := AColor;
      ACanvas.FillRect(r);
      if(r.Top mod cdXY <> 0) then
        Dec(r.Top, r.Top mod cdXY);
      Inc(r.Top, cdXY);
      Inc(AColor, dColor);
    end;
  end else begin
    r.Left := ADrawRect.Left;
    AColor := ABeginColor + dColor * (r.Left div cdXY);
    while (r.Left < ADrawRect.Right) do begin
      r.Right := r.Left + cdXY;
      if(r.Right > ADrawRect.Right) then
        r.Right := ADrawRect.Right;
      ACanvas.Brush.Color := AColor;
      ACanvas.FillRect(r);
      if(r.Left mod cdXY <> 0) then
        Dec(r.Left, r.Left mod cdXY);
      Inc(r.Left, cdXY);
      Inc(AColor, dColor);
    end;
  end;
  ACanvas.Brush.Color := OldColor;
end;


type
{TAutoOutLookStoredItemsStoreStrings}
TAutoOutLookStoredItemsStoreStrings = class(TStringList)
private
  Owner : TAutoOutLookBarStore;

  procedure ChangeCategory(OldCategory, NewCategory : Integer);
public
  constructor Create(AOwner : TAutoOutLookBarStore);
  procedure Clear; override;
  procedure Delete(Index: Integer); override;
  procedure Insert(Index: Integer; const S: string); override;
  procedure Exchange(Index1, Index2: Integer); override;
  procedure Move(CurIndex, NewIndex: Integer); override;
end;

{TAutoOutLookStoredItemsStoreStrings}

constructor TAutoOutLookStoredItemsStoreStrings.Create(AOwner : TAutoOutLookBarStore);
begin
  inherited Create;
  Owner := AOwner;
  if Not (csLoading in Owner.ComponentState) then
    Add(LoadStr(AS_OLB_DEFAULTGROUP));
end;

procedure TAutoOutLookStoredItemsStoreStrings.ChangeCategory(OldCategory, NewCategory : Integer);
Var
  i : Integer;
  List : TList;
begin
  if (OldCategory > -1) And (OldCategory < Count)
  And (NewCategory > -1) And (NewCategory < Count) then begin
    List := TList.Create;
    Owner.GetItemsByCategory(Strings[OldCategory], List);
    for i := 0 to List.Count - 1 do
      TAutoOutLookStoredItem(List[i]).Category := NewCategory;
    List.Free;
  end;
end;

procedure TAutoOutLookStoredItemsStoreStrings.Clear;
begin
  if(Owner.Count > 0) And Not (csLoading in Owner.ComponentState) then
    raise EAutoOutLookBarError.Create(LoadStr(AE_OLB_CANTDELETEGROUP))
  else begin
    inherited Clear;
    if Not (csLoading in Owner.ComponentState) then
      Add(LoadStr(AS_OLB_DEFAULTGROUP));
  end;

end;

procedure TAutoOutLookStoredItemsStoreStrings.Delete(Index: Integer);
Var
  i : Integer;
begin
  if (Index > -1 ) And (Index < Count) And (Owner.GetCountByCategory(Strings[Index]) > 0) then
    raise EAutoOutLookBarError.Create(LoadStr(AE_OLB_CANTDELETEGROUP))
  else begin
    if (Index > -1 ) And (Index < Count) then
      for i := Index to Count - 1 do
        ChangeCategory(i + 1, i);
    inherited Delete(Index);
  end;
  if Count = 0 then
      Add(LoadStr(AS_OLB_DEFAULTGROUP));
end;

procedure TAutoOutLookStoredItemsStoreStrings.Insert(Index: Integer; const S: string);
var
  i : Integer;
begin
  inherited Insert(Index, S);
  if(Index < Count) And (Index > -1) then
    for i := Count -  1  downto Index + 1 do
      ChangeCategory(i - 1, i);
end;

procedure TAutoOutLookStoredItemsStoreStrings.Exchange(Index1, Index2: Integer);
Var
  i : Integer;
  List1 : TList;
  List2 : TList;
begin
  if (Index1 > -1) And (Index1 < Count)
  And (Index2 > -1) And (Index2 < Count) then begin
    List1 := TList.Create;
    List2 := TList.Create;
    Owner.GetItemsByCategory(Strings[Index1], List1);
    Owner.GetItemsByCategory(Strings[Index2], List2);
    for i := 0 to List1.Count - 1 do
      TAutoOutLookStoredItem(List1[i]).Category := Index2;
    for i := 0 to List2.Count - 1 do
      TAutoOutLookStoredItem(List2[i]).Category := Index1;
    List1.Free;
    List2.Free;
  end;
  inherited Exchange(Index1, Index2);
end;

procedure TAutoOutLookStoredItemsStoreStrings.Move(CurIndex, NewIndex: Integer);
Var
  i : Integer;
begin
  if(CurIndex < NewIndex) then begin
    for i := CurIndex + 1 to NewIndex do
      ChangeCategory(i, i - 1);
  end else
    for i := NewIndex to CurIndex - 1 do
      ChangeCategory(i, i + 1);
  inherited Move(CurIndex, NewIndex);
end;

{TAutoOutLookStoredItem}
constructor TAutoOutLookStoredItem.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCaption := LoadStr(AS_OLB_DEFAULTITEMCAPTION);
  FLargeImage := -1;
  FSmallImage := -1;  
end;

destructor TAutoOutLookStoredItem.Destroy;
begin
  if(FStore <> Nil) then
    FStore.RemoveItem(self);
  inherited Destroy;
end;

procedure TAutoOutLookStoredItem.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if(Operation = opRemove) And (AComponent = FPopupMenu) then
    FPopupMenu := Nil;
end;


function TAutoOutLookStoredItem.GetParentComponent: TComponent;
begin
  Result := FStore;
end;

function TAutoOutLookStoredItem.HasParent: Boolean;
begin
  HasParent := True;
end;

procedure TAutoOutLookStoredItem.ReadState(Reader: TReader);
begin
  inherited ReadState(Reader);
  if Reader.Parent is TAutoOutLookBarStore then Store := TAutoOutLookBarStore(Reader.Parent);
end;

procedure TAutoOutLookStoredItem.SetParentComponent(AParent: TComponent);
begin
  if not (csLoading in ComponentState) then Store := AParent as TAutoOutLookBarStore;
end;

procedure TAutoOutLookStoredItem.SetCaption(Value : String);
begin
  if (FCaption <> Value) then begin
    FCaption := Value;
    if(FStore <> Nil) then
      FStore.UpdateItem(self);
  end;
end;

procedure TAutoOutLookStoredItem.SetHint(Value : String);
begin
  if (FHint <> Value) then begin
    FHint := Value;
    if(FStore <> Nil) then
      FStore.UpdateItem(self);
  end;
end;

procedure TAutoOutLookStoredItem.DoClick(Sender : TObject; Item : TAutoOutLookItem);
begin
  if Assigned(FOnClick) then
    FOnClick(Sender, Item);
end;

procedure TAutoOutLookStoredItem.SetCategory(Value : Integer);
begin
  if(csLoading in ComponentState) then
    FCategory := Value
  else
    if(FStore <> Nil) And (Value > - 1)
    And (Value < FStore.Categories.Count) then begin
      FCategory := Value;
      {$IFDEF INCLUDE_DESIGNTIME}
      FStore.UpdateEditorItem(self)
      {$ENDIF}
    end;
end;

procedure TAutoOutLookStoredItem.SetLargeImage(Value : Integer);
begin
  if (FLargeImage <> Value) then begin
    FLargeImage := Value;
    if(FStore <> Nil) then
      FStore.UpdateItem(self);
  end;
end;

procedure TAutoOutLookStoredItem.SetSmallImage(Value : Integer);