aoutlbar.pas

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

  Color := clGray;
  FBkGround := TAutoOutLookBarBackGround.Create;
  FBkGround.OnChange := DoBkPictureChange;

  FActiveGroupIndex := 0;
  FActiveGroup := Nil;
  FScrollTimerID := -1;
  FHintTimerID := -1;
  FSpaceHeight := 7;
  FScrollDelay := 300;
  BevelInner := bvNone;
  BevelOuter := bvNone;
//  FDragMode := dmAutomatic;
  Height := 300;
  Width := 150;
  FDestDropItemIndex := Nil;
  FEnableDraging := False;
  FIsDropBottom := True;
  FTransparentImages := False;
  FAssignFlag := False;
  FOldActiveGroupIndex := -1;
  FCanSelected := False;
  FHintWindow := THintWindow.Create(self);
  FHintWindowShowing := False;
end;

destructor TAutoOutLookBar.Destroy;
begin
  Store := Nil;
  FHintWindow.Free;  
  FImageList.Free;
  FGroupFont.Free;
  FItemFont.Free;
  FGroups.Free;
  FBkPicture.Free;
  FBkGround.Free;
  inherited Destroy;
end;

procedure TAutoOutLookBar.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if(Operation = opRemove) then begin
    if(AComponent = FGroupPopupMenu) then FGroupPopupMenu := Nil;
    if(AComponent = FItemPopupMenu) then FItemPopupMenu := Nil;
    if(AComponent = FStore) then Store := Nil;  
  end
end;


procedure TAutoOutLookBar.Assign(Source: TPersistent);
begin
  if(Source is TAutoOutLookBar) then begin
    FAssignFlag := True;
    Store := TAutoOutLookBar(Source).Store;
    SetGroups(TAutoOutLookBar(Source).Groups);
    FAssignFlag := False;
    Repaint;
  end;
end;

function TAutoOutLookBar.GetGroupCount : Integer;
begin
  Result := FGroups.Count;
end;

procedure TAutoOutLookBar.SetActiveGroup(Value : TAutoOutLookGroup);
begin
  if(FActiveGroup <> Value) And
  Not (csDestroying in ComponentState)then begin
    DoItemMouseFocused(Nil, False);
    SetMouseFocusedItem(Nil);
    FMouseFocusedItemIsDown := False;
    DestDropItemIndex := Nil;
    if(Value = NIl) And (FGroups.Count > 0) then
      FActiveGroup := FGroups[0]
    else  FActiveGroup := Value;
    if(FActiveGroup <> Nil) then begin
     ActiveGroupIndex := FActiveGroup.Index;
     FActiveGroup.FTopVisibleItem := 0;
    end else ActiveGroupIndex := -1;
    if Assigned(FOnChangeActiveGroup) then
      FOnChangeActiveGroup(self);
    Repaint;
  end;
end;

procedure TAutoOutLookBar.SetActiveGroupIndex(Value : Integer);
Var
  i : Integer;
begin
  if(FActiveGroupIndex <> Value) then begin
    FOldActiveGroupIndex := FActiveGroupIndex;  
    if(Value < 0) Or (Value >= FGroups.Count) then
      FActiveGroupIndex := 0
    else begin
      if(FActiveGroupIndex > -1) And (FActiveGroupIndex < FGroups.Count) then
         for i := 0 to FGroups[FActiveGroupIndex].Items.Count - 1 do begin
           FGroups[FActiveGroupIndex].Items[i].FVisible := False;
           FGroups[FActiveGroupIndex].Items[i].FPartialVisible := False;
         end;  
      FActiveGroupIndex := Value;
    end;
  end;
  if(FGroups.Count > 0) And (FActiveGroupIndex < FGroups.Count) then
    ActiveGroup := FGroups[FActiveGroupIndex];
end;

procedure TAutoOutLookBar.SetBkGround(Value : TAutoOutLookBarBackGround);
begin
  FBkGround := Value;
  Repaint;
end;

procedure TAutoOutLookBar.SetBkPicture(Value : TPicture);
begin
  FBkPicture.Graphic := Value.Graphic;
end;

procedure TAutoOutLookBar.SetCanSelected(Value : Boolean);
begin
  if(FCanSelected <> Value) then begin
    FCanSelected := Value;
    if(FSelectedItem <> Nil) then
      DoItemSelected(Nil);
  end;
end;

procedure TAutoOutLookBar.SetGroupFont(Value : TFont);
begin
  FGroupFont.Assign(Value);
  Repaint;
end;

procedure TAutoOutLookBar.SetGroups(Value : TAutoOutLookGroups);
begin
  FGroups.Assign(Value);
  ActiveGroupIndex := 0;
  Repaint;
end;

procedure TAutoOutLookBar.SetItemFont(Value : TFont);
begin
  FItemFont.Assign(Value);
  Repaint;
end;

procedure TAutoOutLookBar.SetStore(Value : TAutoOutLookBarStore);
begin
  if(FStore <> Value) then begin
    if Not (csLoading in ComponentState) then
      FGroups.Clear;
    if Not (csDestroying in ComponentState) And (csDesigning in ComponentState) then
      Invalidate;
    if(FStore <> Nil) And Not (csDestroying in FStore.ComponentState) then
      FStore.FBars.Remove(self);
    FStore := Value;
    if(FStore <> Nil) then
      FStore.FBars.Add(self);
  end;
end;

procedure TAutoOutLookBar.SetTransparentImages(Value : Boolean);
begin
  if(FTransparentImages <> Value) then begin
    FTransparentImages := Value;
    Repaint;
  end;
end;

procedure TAutoOutLookBar.SetScrollDelay(Value : Integer);
begin
  if(Value > 0) then
   FScrollDelay := Value;
end;

procedure TAutoOutLookBar.SetSpaceHeight(Value : Integer);
begin
  if(FSpaceHeight <> Value) And (Value > 4) then begin
    FSpaceHeight := Value;
    DrawItems;
  end;
end;

procedure TAutoOutLookBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Var
  r : TRect;
  p : TPoint;
  FHeight : Integer;
  Group : TAutoOutLookGroup;
  Item : TAutoOutLookItem;
begin
  if (Button = mbRight) then begin
    PopupMenu := Nil;
    item := GetFocusedItem(X, Y);
    if(item <> Nil) And (item.StoredItem <> Nil) then begin
      if(item.StoredItem.PopupMenu <> Nil) then
        PopupMenu := item.StoredItem.PopupMenu
      else PopupMenu := FItemPopupMenu;
    end
    else PopupMenu := FGroupPopupMenu;
  end;

  inherited  MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) then begin
    // IsRenameGroup  Or Is RenameItem ?
    if (IsEditing) then begin
      EndEdit(True);
      exit;
    end;
    r := FPaintRect;
    FHeight := FGroupHeight + 1;
    p.X := X;
    p.Y := Y;
    Group := GetGroupAtPos(p);
    if(Group <> Nil) then
      ActiveGroupIndex := Group.Index
    else begin
     //ScrollButtons ?
     if(X >= r.Right - ScrollButtonIndention - 1 - ScrollButtonHeight)
     And (X <= r.Right - ScrollButtonIndention - 1) then begin
       if FScrollButtonUpIsVisible And Not FScrollButtonUpIsDown
       And (Y >= r.Top + (FActiveGroupIndex + 1) * FHeight + ScrollButtonIndention)
       And (Y <= r.Top + (FActiveGroupIndex + 1) * FHeight + ScrollButtonIndention + ScrollButtonHeight) then begin
         FScrollButtonUpIsDown := True;
         FScrollTimerID := SetTimer(Handle, 1, FScrollDelay, @ScrollButtonsTimerProc);
         FActiveGroup.TopVisibleItem:= FActiveGroup.TopVisibleItem - 1;
       end;
       if FScrollButtonDownIsVisible And Not FScrollButtonDownIsDown
       And (Y <= r.Bottom - (Groups.Count - 1 - FActiveGroupIndex) *FHeight - ScrollButtonIndention)
       And (Y >=  r.Bottom - (Groups.Count - 1 - FActiveGroupIndex) *FHeight - ScrollButtonIndention - ScrollButtonHeight) then begin
         FScrollButtonDownIsDown := True;
         FScrollTimerID := SetTimer(Handle, 1, FScrollDelay, @ScrollButtonsTimerProc);
         FActiveGroup.TopVisibleItem:= FActiveGroup.TopVisibleItem + 1;
       end
     end else begin
       item := GetFocusedItem(X, Y);
       if(item <> Nil) then begin
         DoItemMouseFocused(Item, True);
         if(CanSelected) then
           DoItemSelected(Item);         
         FEnableDraging := True;
         FPointDragging.X := X;
         FPointDragging.Y := Y;
       end;
     end;
   end;
 end;
end;

procedure TAutoOutLookBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Var
  Item : TAutoOutLookItem;
begin
  inherited  MouseUp(Button, Shift, X, Y);
  if FScrollButtonDownIsDown or FScrollButtonUpIsDown then begin
    FScrollButtonDownIsDown := False;
    FScrollButtonUpIsDown := False;
    DrawScrollButtons;
  end else
  if Not Dragging And FEnableDraging then begin
    FEnableDraging := False;
    item := GetFocusedItem(X, Y);
    if(item <> Nil) then
       DoItemClick(item);
   end;
end;

procedure TAutoOutLookBar.MouseMove(Shift: TShiftState; X, Y: Integer);
Var
  Item, OldItem : TAutoOutLookItem;
begin
  inherited MouseMove(Shift, X, Y);
  OldItem := FMouseFocusedItem;
  Item := GetFocusedItem(X, Y);
  if Not FEnableDraging then
    DoItemMouseFocused(Item, False);

  if Not (csDesigning in ComponentState) And (DragMode = dmAutomatic) then begin
    if FEnableDraging And (((Item = Nil) And (OldItem <> NIl))
    Or ((Item <> Nil) And ((X < FPointDragging.X - 5) Or (X > FPointDragging.X + 5)
    Or (Y < FPointDragging.Y - 5) Or (Y > FPointDragging.Y + 5)))) then begin
      if(FMouseFocusedItem = NIl) then
        FMouseFocusedItem := OldItem;
      inherited DragMode := dmAutomatic;
      FEnableDraging := False;
      BeginDrag(True);
    end
    else inherited DragMode := dmManual;
  end;
end;

procedure TAutoOutLookBar.Paint;
begin
  if FAssignFlag Or IsMakingUpdate then exit;
  if (FStore = Nil) Or (FActiveGroupIndex = -1) then begin
    Canvas.Brush.Color := Color;
    DrawFillRect(ClientRect);
    exit;
  end;

  //Make it faster !!!
  FGroupHeight := GetGroupHeight;
  FPaintRect := GetPaintRect;
  FCanvasDC := Canvas.Handle;

  if (FOldActiveGroupIndex = ActiveGroupIndex)
  Or (FOldActiveGroupIndex = -1) then
    inherited Paint;
    
  DrawTopGroups;
  DrawBottomGroups;

  if (FOldActiveGroupIndex <> ActiveGroupIndex)
  And (FOldActiveGroupIndex <> -1) And (ActiveGroup <> Nil) then
    MakeGroupScrolling;

  DrawItems;

end;

procedure TAutoOutLookBar.WndProc(var Message : TMessage);
begin
  if(FHintWindowShowing) then
    with Message do
      if((Msg >= WM_KEYFIRST) and (Msg <= WM_KEYLAST)) or
      ((Msg = CM_ACTIVATE) or (Msg = CM_DEACTIVATE)) or
      (Msg = CM_APPKEYDOWN) or (Msg = CM_APPSYSCOMMAND) or
      (Msg = WM_COMMAND) or ((Msg > WM_MOUSEMOVE) and
      (Msg <= WM_MOUSELAST)) or (Msg = WM_NCMOUSEMOVE) then
         HintActivate(False);
  inherited WndProc(Message);
end;

function TAutoOutLookBar.GetFontHeight(AFont : TFont) : Integer;
var
  DC: HDC;
  SaveFont: HFont;
  Metrics: TTextMetric;
begin
  DC := GetDC(0);
  SaveFont := SelectObject(DC, AFont.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  Result := Metrics.tmHeight;
end;

function TAutoOutLookBar.GetGroupHeight : Integer;
begin
  Result := GetFontHeight(FGroupFont) + 4;
end;

function TAutoOutLookBar.GetItemHeight : Integer;
begin
  Result := GetFontHeight(FItemFont) + 2;
  if(GetSmallImageHeight > Result) then
    Result := GetSmallImageHeight;
end;

function TAutoOutLookBar.GetGroupRect(Index : Integer) : TRect;
Var
  r : TRect;
begin
  SetRectEmpty(Result);
  if (Index > -1) And (Index < FGroups.Count) then begin
     r := FPaintRect;
     Result.Left := r.Left;
     Result.Right := r.Right;
     if(Index <= FActiveGroupIndex) then
       Result.Top := r.Top + Index * (FGroupHeight + 1)
     else Result.Top := r.Bottom - (Groups.Count - Index) * (FGroupHeight + 1);
     Result.Bottom := Result.Top + FGroupHeight;
  end;
end;

function TAutoOutLookBar.GetTopFirstBottomGroup : Integer;
Var
  r : TRect;
begin
  if (FActiveGroupIndex + 1 < FGroups.Count) then begin
    r := GetGroupRect(FActiveGroupIndex + 1);
    Result := r.Top;
  end else begin
    r := FPaintRect;
    Result := r.Bottom - FSpaceHeight;
  end;
end;

function TAutoOutLookBar.GetPaintRect : TRect;
Var
  dxy : Integer;
begin
  Result := ClientRect;
  dxy := BevelWidth + BorderWidth;
  InflateRect(Result, - dxy,  - dxy);
  Inc(Result.Bottom, 2);
end;

function TAutoOutLookBar.GetLargeImageHeight : Integer;
begin
  if(Store <> Nil) And (Store.LargeImages <> Nil) then
    Result := Store.LargeImages.Height
  else Result := acOutLookDefaultLargeImageHeight;
end;

function TAutoOutLookBar.GetLargeImageWidth : Integer;
begin
  if(Store <> Nil) And (Store.LargeImages <> Nil) then
    Result := Store.LargeImages.Width
  else Result := acOutLookDefaultLargeImageWidth;
end;

function TAutoOutLookBar.GetSmallImageHeight : Integer;
begin
  if(Store <> Nil) And (Store.SmallImages <> Nil) then