jvggroupbox.pas

East make Tray Icon in delphi

          NewR.Top - Glyph.Height) div 2),
          fwoNone, DrawState, True,
          GetPixel(Glyph.Canvas.Handle, 0, Glyph.Height - 1)
          {TransparentColor},
          {DisabledMaskColor} 0);
      end;

      ExtTextOutExt((Handle), (NewR.Left + GlyphWidth + Interspace),
        (NewR.Top), NewR, Caption,
        IIF(Enabled, FCaptionTextStyle, fstPushed), fgoDelineatedText in
        Options,
        {fNeedUpdateOnlyMainText} False, Color.Text, Color.Delineate,
        Colors.Highlight, Colors.Shadow,
        FIllumination, nil {Gradient}, Font);

    end;
  end;
  //  if Transparent then for I:=0 to ComponentCount-1 do
  //    TControl(Components[I]).Repaint;
  if Assigned(AfterPaint) then
    AfterPaint(Self);
end;

procedure TJvgGroupBox.Collapse(fCollapse: Boolean);
var
  I: Integer;
  AnotherExpandedWasFound: Boolean;
begin
  if csLoading in ComponentState then
    Exit;

  if fCollapse then
  begin
    if Align = alClient then
      Exit;
    if (FGroupIndex <> 0) and (fgoOneAlwaysExpanded in Options) then
    begin //...One Stay Always Expanded in group
      AnotherExpandedWasFound := False;
      for I := 0 to Owner.ComponentCount - 1 do
        with TControl(Owner) do
          if (Components[I] is TJvgGroupBox) and
            (TJvgGroupBox(Components[I]).GroupIndex = FGroupIndex) then
            if (not TJvgGroupBox(Components[I]).Collapsed) and
              (Components[I] <> Self) then
            begin
              AnotherExpandedWasFound := True;
              Break;
            end; //...are another expanded controls in group
      if not AnotherExpandedWasFound then
        Exit; //..i'm last- can't collapse
    end;
  end
  else
  if (FGroupIndex <> 0) and (fgoCollapseOther in Options) then
    for I := 0 to Owner.ComponentCount - 1 do
      with TControl(Owner) do
        if (Components[I] is TJvgGroupBox) and
          (TJvgGroupBox(Components[I]).GroupIndex = FGroupIndex) and
          (Components[I] <> Self) then
          TJvgGroupBox(Components[I]).Collapsed := True;

  Collapse_(fCollapse);
  if fCollapse and Assigned(FOnCollapsed) then
    FOnCollapsed(Self);
  if not fCollapse and Assigned(FOnExpanded) then
    FOnExpanded(Self);
end;

procedure TJvgGroupBox.Collapse_(fCollapse: Boolean);
var
  I {, Step}: Integer;
  {  DC: HDC;
    pt: TPoint;
    R, CR: TRect;
    Scroll: HRGN;
    SpaceBrush: HBRUSH;
    fFirst: Boolean;
    LastTickCount: Integer;}
begin
  if Align = alClient then
    Exit;

  FCollapsed := fCollapse;
  if fCollapse then
  begin
    FullHeight := Height;
    if fgoResizeParent in Options then
      Parent.Height := Parent.Height - (FullHeight - CaptionRect.Bottom);
    Height := CaptionRect.Bottom + 1;

    //...set all Children invisible
    if (fgoHideChildrenWhenCollapsed in Options) or (fgoSaveChildFocus in Options) then
      for I := 0 to Owner.ComponentCount - 1 do
        with TControl(Owner) do
          if (Components[I] is TControl) and
            (TControl(Components[I]).Parent = Self) then
          begin
            if (fgoSaveChildFocus in Options) and (Components[I] is TWinControl) and
              TWinControl(Components[I]).Focused then
              ChildFocusedControl := TWinControl(Components[I]);
            if fgoHideChildrenWhenCollapsed in Options then //...hide
              TControl(Components[I]).Visible := False;
          end;
  end
  else
  begin
    if fgoResizeParent in Options then
      Parent.Height := Parent.Height + (FullHeight - CaptionRect.Bottom);
    Height := FullHeight;

    //...set all Children visible
    if fgoHideChildrenWhenCollapsed in Options then
      for I := 0 to Owner.ComponentCount - 1 do
        with TControl(Owner) do
          if (Components[I] is TControl) and
            (TControl(Components[I]).Parent = Self) then
            TControl(Components[I]).Visible := True;

    if ChildFocusedControl <> nil then
    try
      ChildFocusedControl.SetFocus;
    except
    end;
  end;

  Exit; { patch for win 98 }

  (*
  if fCollapse then
  begin
    //...prepare image

    if FImage=nil then FImage := TBitmap.Create;
    FImage.Height := Height;
    FImage.Width := Width;
    GetWindowImage( Self, True{fDrawSelf}, True{fDrawChildWindows}, FImage.Canvas.Handle );

    DC := GetDC(HWND_DESKTOP);
    CR := ClientRect; Dec(CR.Bottom,CaptionRect.Bottom);
    pt.X := 0; pt.Y := CaptionRect.Bottom+1;//16;
    pt := ClientToScreen(pt);
    offsetRect( CR, pt.X, pt.Y );
    R := CR;
    Scroll := CreateRectRgn( R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top );
    Inc( R.Top );
    I := Height-Canvas.TextHeight('0y');
    // Step := 1;//max( Height div 100, 1 );

    SpaceBrush := CreateSolidBrush( ColorToRGB(TGroupBox(Parent).Color) );
    // fFirst := True; LastTickCount := GetTickCount;
    FullHeight := Height;
    if fgoFluentlyCollapse in Options then
    while Height > CaptionRect.Bottom+1 do
    begin
      Application.ProcessMessages;
//      ScrollDC( DC, 0, -Step, R, CR,  Scroll, nil);
      //if fFirst then
//      begin
//        FillRect( DC, Rect( R.Left, R.Bottom-Step, R.Right, R.Bottom ), SpaceBrush );
//        fFirst := False;
//      end;
      Height := max(CaptionRect.Bottom, Height - Height * 30 div 100);
      ValidateRect(Handle, @CaptionRect);
//      while GetTickCount - LastTickCount <= 0 do;
//      Step := GetTickCount - LastTickCount; if Step > 20 then Step := 20;
//      LastTickCount := GetTickCount;
    end;
    DeleteObject(SpaceBrush);
//    FullHeight := Height;
    Height := CaptionRect.Bottom+1;//max( Canvas.TextHeight(Caption), 16 );
    DeleteObject( Scroll );
    ReleaseDC(HWND_DESKTOP, DC);

  end
  else
  begin//..expanded

    if fgoFluentlyExpand in Options then
    while Height < FullHeight do
    begin
      Application.ProcessMessages;
      Height := Height + 1;
      ValidateRect(Handle, @CaptionRect);
    end;
    Height := FullHeight;
  end;
  InValidateRect(Handle, @CaptionRect, False);
  FCollapsed := fCollapse;
  *)
end;

procedure TJvgGroupBox.SmthChanged(Sender: TObject);
begin
  Invalidate;
end;

procedure TJvgGroupBox.SetCaptionAlignment(Value: TCaptionAlignment);
begin
  if FCaptionAlignment <> Value then
  begin
    FCaptionAlignment := Value;
    Invalidate;
  end;
end;

procedure TJvgGroupBox.SetCaptionTextStyle(Value: TglTextStyle);
begin
  if FCaptionTextStyle <> Value then
  begin
    FCaptionTextStyle := Value;
    Invalidate;
  end;
end;

procedure TJvgGroupBox.SetCollapsed(Value: Boolean);
begin
  if FCollapsed <> Value then
  begin
    if not (fgoCanCollapse in Options) and Value then
      Exit;
    FCollapsed := Value;
    if csLoading in ComponentState then
      Exit;
    Collapse_(Value);
  end;
end;

procedure TJvgGroupBox.SetOptions(Value: TglGroupBoxOptions);
begin
  if FOptions <> Value then
  begin
    FOptions := Value;
    //  if not(fgoCanCollapse in Options) then Collapsed := False;
    if Assigned(Parent) then
      CalcShadowAndHighlightColors((Parent as TWinControl).Brush.Color,
        TJvgLabelColors(Colors));
    Invalidate;
  end;
end;

procedure TJvgGroupBox.SetTransparent(Value: Boolean);
begin
  if FTransparent <> Value then
  begin
    FTransparent := Value;
    RecreateWnd;
  end;
end;

procedure TJvgGroupBox.SetTransparentCaption(Value: Boolean);
begin
  if FTransparentCaption <> Value then
  begin
    FTransparentCaption := Value;
    RecreateWnd;
  end;
end;

procedure TJvgGroupBox.SetGroupIndex(Value: Integer);
var
  I: Integer;
begin
  if FGroupIndex = Value then
    Exit;
  FGroupIndex := Value;
  if csLoading in ComponentState then
    Exit;
  if (not Collapsed) and (FGroupIndex <> 0) then
    for I := 0 to Owner.ComponentCount - 1 do
      with TControl(Owner) do
        if (Components[I] is TJvgGroupBox) and
          (TJvgGroupBox(Components[I]).GroupIndex = FGroupIndex) and
          (Components[I] <> Self) then
          TJvgGroupBox(Components[I]).Collapsed := True;
end;

function TJvgGroupBox.GetGlyphCollapsed: TBitmap;
begin
  if FGlyphCollapsed = nil then
    FGlyphCollapsed := TBitmap.Create;
  Result := FGlyphCollapsed;
end;

procedure TJvgGroupBox.SetGlyphCollapsed(Value: TBitmap);
begin
  GlyphCollapsed.Assign(Value);
  Invalidate;
end;

function TJvgGroupBox.GetGlyphExpanded: TBitmap;
begin
  if FGlyphExpanded = nil then
    FGlyphExpanded := TBitmap.Create;
  Result := FGlyphExpanded;
end;

procedure TJvgGroupBox.SetGlyphExpanded(Value: TBitmap);
begin
  GlyphExpanded.Assign(Value);
  Invalidate;
end;

function TJvgGroupBox.GetCaption: string;
begin
  Result := inherited Caption;
end;

procedure TJvgGroupBox.SetCaption(const Value: string);
begin
  inherited Caption := Value;
  // (obones) force the computation of CaptionRect so that
  // we don't need to paint to have the correct values.
  ComputeCaptionRect;
end;

procedure TJvgGroupBox.ComputeCaptionRect;
var
  R: TRect;
  I, RW, GlyphWidth: Integer;
  Interspace: Integer;
begin
  Canvas.Font.Assign(Self.Font);
  
  Interspace := 2;
  R := Rect(FCaptionShift.X, 0, 0, Canvas.TextHeight(Text) - FCaptionShift.Y);

  if Assigned(FGlyphExpanded) then
    GlyphWidth := FGlyphExpanded.Width
  else
    GlyphWidth := 0;
  if Assigned(FGlyphCollapsed) then
    GlyphWidth := Max(FGlyphCollapsed.Width, GlyphWidth);

  Windows.DrawText(Canvas.Handle, PChar(Text), Length(Text), R, DT_LEFT or DT_SINGLELINE or DT_CALCRECT);

  Inc(R.Right, Interspace + GlyphWidth);
  with CaptionBorder do
  begin
    I := 0;
    if Inner <> bvNone then
    begin
      Inc(I, 2);
      if Bold then
        Inc(I);
    end;
    if Outer <> bvNone then
    begin
      Inc(I, 2);
      if Bold then
        Inc(I);
    end;

    Inc(R.Right, I);
    Inc(R.Bottom, I);
  end;

  RW := R.Right - R.Left;
  case FCaptionAlignment of
    fcaLeft:
      begin
        R.Right := RW;
        R.Left := 0;
      end;
    fcaRight:
      begin
        R.Left := Width - RW - 1;
        R.Right := R.Left + RW;
      end;
    fcaCenter:
      begin
        R.Left := (Width - RW) div 2;
        R.Right := R.Left + RW;
      end;
    fcaWidth:
      begin
        R.Left := 0;
        R.Right := Width - 1;
      end;
  end;
  if fgoDelineatedText in Options then
    Inc(R.Bottom, 2);
  if CaptionTextStyle = fstShadow then
  begin
    if fgoDelineatedText in Options then
      Inc(R.Bottom, FIllumination.ShadowDepth - 2)
    else
      Inc(R.Bottom, FIllumination.ShadowDepth);
  end
  else
  if CaptionTextStyle <> fstNone then
    Inc(R.Bottom, 2);

  CaptionRect := R;
end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

end.