jvqrollout.pas

East make Tray Icon in delphi

    Exit;
  if FInsideButton then
  begin
    FInsideButton := False;
    FMouseDown := False;
  end;
  RedrawControl(False);
end;


procedure TJvCustomRollOut.DrawButtonFrame;
var
  R: TRect;
  TopC, BottomC: TColor;
  FIndex: Integer; 
  WS: WideString; 
begin
  if FPlacement = plTop then
    FButtonRect := Rect(BevelWidth, BevelWidth, Width - BevelWidth, FButtonHeight + BevelWidth)
  else
    FButtonRect := Rect(BevelWidth, BevelWidth, FButtonHeight + BevelWidth, Height - BevelWidth);

  R := FButtonRect;
  Canvas.Brush.Color := Colors.ButtonColor;
  if Canvas.Brush.Color <> clNone then
    Canvas.FillRect(R);

  if FMouseDown and FInsideButton then
  begin
    TopC := Colors.ButtonBottom;
    BottomC := Colors.ButtonTop;
  end
  else
  if FInsideButton then
  begin
    TopC := Colors.ButtonTop;
    BottomC := Colors.ButtonBottom;
  end
{ else
  if Focused then
  begin
    TopC := clHighlight;
    BottomC := clHighlight;
  end}
  else
  begin
    TopC := Colors.Color;
    BottomC := Colors.Color;
  end;
//  if not (csDesigning in ComponentState) then
  InternalFrame3D(Canvas, R, TopC, BottomC, 1);
  if Collapsed then
    FIndex := ImageOptions.IndexCollapsed
  else
    FIndex := ImageOptions.IndexExpanded;

  R := FButtonRect;
  if FPlacement = plTop then
  begin
    if Assigned(ImageOptions.Images) then
    begin
      ImageOptions.Images.Draw(Canvas, ImageOptions.Offset + BevelWidth,
        BevelWidth + (FButtonHeight - ImageOptions.Images.Height) div 2, FIndex);
      R.Left := ImageOptions.Images.Width + ImageOptions.Offset * 2 + BevelWidth;
    end
    else
      R.Left := ImageOptions.Offset * 2 + BevelWidth;
    R.Top := R.Top - (Canvas.TextHeight(Caption) - (FButtonRect.Bottom - FButtonRect.Top)) div 2 + BevelWidth div 2;
  end
  else
  begin
    if Assigned(ImageOptions.Images) then
    begin
      ImageOptions.Images.Draw(Canvas, BevelWidth + (FButtonHeight - ImageOptions.Images.Width) div 2,
        ImageOptions.Offset + BevelWidth, FIndex);
      R.Top := ImageOptions.Images.Height + ImageOptions.Offset * 2 + BevelWidth;
    end
    else
      R.Top := ImageOptions.Offset * 2 + BevelWidth;
    R.Left := R.Left + (Canvas.TextHeight(Caption) + (FButtonRect.Right - FButtonRect.Left)) div 2 + BevelWidth div 2;
  end;
  Canvas.Font := Font;
  if FInsideButton then
    Canvas.Font.Color := Colors.HotTrackText;

  if Length(Caption) > 0 then
  begin
    SetBkMode(Canvas.Handle, Transparent);
    if FMouseDown and FInsideButton then
      OffsetRect(R, 1, 1);  
    WS := Caption;
    SetPenColor(Canvas.Handle, Font.Color);
    if Placement = plLeft then
      DrawText(Canvas, WS, -1, R, DT_VCENTER, 270)
    else
      DrawText(Canvas, WS, -1, R, DT_VCENTER, 0) 
  end;
  if ShowFocus and Focused then
  begin
    R := FButtonRect;
    InflateRect(R, -2, -2);
    Canvas.DrawFocusRect(R);
  end;
end;

procedure TJvCustomRollOut.Paint;
var
  R: TRect;
begin
  R := ClientRect;
  if Colors.Color <> clNone then
  begin
    Canvas.Brush.Color := Colors.Color;
    DrawThemedBackground(Self, Canvas, R);
  end;
  InternalFrame3D(Canvas, R, Colors.FrameTop, Colors.FrameBottom, BevelWidth);
  if Colors.FrameTop = clNone then
  begin
    Dec(R.Left);
    Dec(R.Top);
  end;
  if Colors.FrameBottom = clNone then
  begin
    Inc(R.Right);
    Inc(R.Bottom);
  end;
  DrawButtonFrame;
end;

procedure TJvCustomRollOut.Collapse;
begin
  SetCollapsed(True);
end;

procedure TJvCustomRollOut.Expand;
begin
  SetCollapsed(False);
end;

procedure TJvCustomRollOut.UpdateGroup;
var
  Msg: TMessage;
begin
  if (FGroupIndex <> 0) and (Parent <> nil) then
  begin
    Msg.Msg := CM_EXPANDED;
    Msg.WParam := FGroupIndex;
    Msg.LParam := Longint(Self);
    Msg.Result := 0;  
    BroadcastMsg(Parent, Msg); 
  end;
end;

procedure TJvCustomRollOut.CMExpanded(var Msg: TMessage);
var
  Sender: TJvCustomRollOut;
begin
  if Msg.WParam = FGroupIndex then
  begin
    Sender := TJvCustomRollOut(Msg.LParam);
    if (Sender <> Self) then
    begin
      SetCollapsed(True);
      CheckChildTabStops;
      Invalidate;
    end;
  end;
end;

(*
function IsAccel(VK: Word; const Str: string): Boolean;
var
  P: Integer;
begin
  P := Pos('&', Str);
  Result := (P <> 0) and (P < Length(Str)) and
    (AnsiCompareText(Str[P + 1], Char(VK)) = 0);
end;
*)

function TJvCustomRollOut.WantKey(Key: Integer; Shift: TShiftState;
  const KeyText: WideString): Boolean;
begin
  Result := Enabled and (IsAccel(Key, Caption) and (ssAlt in Shift)) or ((Key = VK_SPACE) and Focused);
  if Result then
  begin
    SetCollapsed(not FCollapsed);
    if CanFocus then
      SetFocus;
  end
  else
    Result := inherited WantKey(Key, Shift, KeyText);
end;

procedure TJvCustomRollOut.DoColorsChange(Sender: TObject);
begin
  RedrawControl(True);
end;

procedure TJvCustomRollOut.DoImageOptionsChange(Sender: TObject);
begin
  RedrawControl(True);
end;

procedure TJvCustomRollOut.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (ImageOptions <> nil) and (AComponent = ImageOptions.Images) then
    ImageOptions.Images := nil;
end;

procedure TJvCustomRollOut.ParentColorChanged;
begin
  inherited ParentColorChanged;
  Colors.Color := Color;
end;

function TJvCustomRollOut.MouseIsOnButton: Boolean;
var
  P: TPoint;
  R: TRect;
begin
  GetCursorPos(P);
  P := ScreenToClient(P);
  R := FButtonRect;
  // (p3) include edges in hit test
  InflateRect(R, 1, 1);
  Result := PtInRect(R, P);
end;

procedure TJvCustomRollOut.DoExit;
begin
  CheckChildTabStops;
  inherited DoExit;
  Invalidate;
end;

procedure TJvCustomRollOut.DoEnter;
begin
  CheckChildTabStops;
  inherited DoEnter;
  Invalidate;
end;

procedure TJvCustomRollOut.SetShowFocus(const Value: Boolean);
begin
  if FShowFocus <> Value then
  begin
    FShowFocus := Value;
    if Focused then
      Invalidate;
  end;
end;

procedure TJvCustomRollOut.CheckChildTabStops;
begin
  if csDesigning in ComponentState then
    Exit;
  if Collapsed then
    GetChildTabStops
  else
    SetChildTabStops;
end;

procedure TJvCustomRollOut.GetChildTabStops;
var
  I: Integer;
begin
  if FTabStops = nil then
  begin
    FTabStops := TStringList.Create;
    FTabStops.Sorted := True;
  end;
  for I := 0 to ControlCount - 1 do
    if (Controls[I] is TWinControl) and (TWinControl(Controls[I]).TabStop) then
    begin
      FTabStops.AddObject(Controls[I].Name, Controls[I]);
      TWinControl(Controls[I]).TabStop := False;
    end;
end;

procedure TJvCustomRollOut.SetChildTabStops;
var
  I: Integer;
begin
  if FTabStops <> nil then
  begin
    for I := 0 to FTabStops.Count - 1 do
      if FindChildControl(FTabStops[I]) <> nil then
        TWinControl(FTabStops.Objects[I]).TabStop := True;
    FreeAndNil(FTabStops);
  end;
end;

procedure TJvCustomRollOut.ClearChildTabStops;
begin
  FreeAndNil(FTabStops);
end;

//=== { TJvRollOutAction } ===================================================

destructor TJvRollOutAction.Destroy;
begin
  if RollOut <> nil then
    RollOut.RemoveFreeNotification(Self);
  inherited Destroy;
end;

function TJvRollOutAction.Execute: Boolean;
begin
  Result := inherited Execute;
  if Result then
  begin 
    if ActionComponent is TJvCustomRollOut then
    begin
      if LinkCheckedToCollapsed then
        TJvCustomRollOut(ActionComponent).Collapsed := not Checked
      else
        TJvCustomRollOut(ActionComponent).Collapsed := not TJvCustomRollOut(ActionComponent).Collapsed;
    end
    else 
    if RollOut <> nil then
    begin
      if LinkCheckedToCollapsed then
        RollOut.Collapsed := not Checked
      else
        RollOut.Collapsed := not RollOut.Collapsed;
    end;
  end;
end;  

procedure TJvRollOutAction.ExecuteTarget(Target: TObject);
begin
  inherited ExecuteTarget(Target);
  if Target is TJvCustomRollOut then
  begin
    if LinkCheckedToCollapsed then
      TJvCustomRollOut(Target).Collapsed := not Checked
    else
      TJvCustomRollOut(Target).Collapsed := not TJvCustomRollOut(Target).Collapsed;
  end
  else
    if RollOut <> nil then
    begin
      if LinkCheckedToCollapsed then
        RollOut.Collapsed := not Checked
      else
        RollOut.Collapsed := not RollOut.Collapsed;
    end;
end;

function TJvRollOutAction.HandlesTarget(Target: TObject): Boolean;
begin
  Result := ((RollOut <> nil) and (Target = RollOut) or
    (RollOut = nil) and (Target is TJvCustomRollOut)) and TJvCustomRollOut(Target).Enabled;
end;

procedure TJvRollOutAction.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if AComponent = RollOut then
    RollOut := nil;
end;

procedure TJvRollOutAction.SetLinkCheckedToCollapsed(const Value: Boolean);
begin
  if FLinkCheckedToCollapsed <> Value then
  begin
    FLinkCheckedToCollapsed := Value;
    if FLinkCheckedToCollapsed then
    begin
      if RollOut <> nil then
        RollOut.Collapsed := not Checked
      else 
      if ActionComponent is TJvCustomRollOut then
        TJvCustomRollOut(ActionComponent).Collapsed := not Checked; 
    end;
  end;
end;

procedure TJvRollOutAction.SetRollOut(const Value: TJvCustomRollOut);
begin
  if FRollOut <> Value then
  begin
    if FRollOut <> nil then
      FRollOut.RemoveFreeNotification(Self);
    FRollOut := Value;
    if FRollOut <> nil then
      FRollOut.FreeNotification(Self);
  end;
end;

procedure TJvRollOutAction.UpdateTarget(Target: TObject);
begin
  if LinkCheckedToCollapsed then
    Checked := not (Target as TJvCustomRollOut).Collapsed;
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQRollOut.pas,v $';
    Revision: '$Revision: 1.27 $';
    Date: '$Date: 2005/02/20 23:43:40 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.