rxgrdcpt.pas

RX Library contains a large number of components, objects and routines for Borland Delphi with full

procedure TRxGradientCaption.Update;
var
  Rgn: HRgn;
begin
  if not (csDesigning in ComponentState) and (Owner is TCustomForm) and
    not (csLoading in ComponentState) then
  begin
    CheckToggleHook;
    FWindowActive := False;
    if (Form <> nil) and Form.HandleAllocated and Form.Visible then begin
      if Active then begin
        FWindowActive := (GetActiveWindow = Form.Handle) and
          IsForegroundTask;
      end;
      with Form do
        Rgn := CreateRectRgn(Left, Top, Left + Width, Top + Height);
      try
        SendMessage(Form.Handle, WM_NCPAINT, Rgn, 0);
      finally
        DeleteObject(Rgn);
      end;
    end;
  end;
end;

procedure TRxGradientCaption.CalculateGradientParams(var R: TRect;
  var Icons: TBorderIcons);
var
  I: TBorderIcon;
  BtnCount: Integer;
begin
  GetWindowRect(Form.Handle, R);
  Icons := Form.BorderIcons;
  case Form.BorderStyle of
    bsDialog: Icons := Icons * [biSystemMenu, biHelp];
    bsToolWindow, bsSizeToolWin: Icons := Icons * [biSystemMenu];
    else begin
      if not (biSystemMenu in Icons) then
        Icons := Icons - [biMaximize, biMinimize];
      if (Icons * [biMaximize, biMinimize] <> []) then
        Icons := Icons - [biHelp];
    end;
  end;
  BtnCount := 0;
  for I := Low(TBorderIcon) to High(TBorderIcon) do
    if I in Icons then Inc(BtnCount);
  if (biMinimize in Icons) and not (biMaximize in Icons) then
    Inc(BtnCount)
  else if not (biMinimize in Icons) and (biMaximize in Icons) then
    Inc(BtnCount);
  case Form.BorderStyle of
    bsToolWindow, bsSingle, bsDialog:
      InflateRect(R, -GetSystemMetrics(SM_CXFIXEDFRAME),
        -GetSystemMetrics(SM_CYFIXEDFRAME));
    bsSizeable, bsSizeToolWin:
      InflateRect(R, -GetSystemMetrics(SM_CXSIZEFRAME),
        -GetSystemMetrics(SM_CYSIZEFRAME));
  end;
  if Form.BorderStyle in [bsToolWindow, bsSizeToolWin] then begin
    R.Bottom := R.Top + GetSystemMetrics(SM_CYSMCAPTION) - 1;
    Dec(R.Right, BtnCount * GetSystemMetrics(SM_CXSMSIZE));
  end
  else begin
    R.Bottom := R.Top + GetSystemMetrics(SM_CYCAPTION) - 1;
    Dec(R.Right, BtnCount * GetSystemMetrics(SM_CXSIZE));
  end;
end;

{$IFDEF RX_D4}
function TRxGradientCaption.IsRightToLeft: Boolean;
var
  F: TForm;
begin
  F := Form;
  if F <> nil then Result := F.IsRightToLeft
  else Result := Application.IsRightToLeft;
end;
{$ENDIF}

procedure TRxGradientCaption.DrawGradientCaption(DC: HDC);
var
  R, DrawRect: TRect;
  Icons: TBorderIcons;
  C: TColor;
  Ico: HIcon;
  Image: TBitmap;
  S: string;
  IconCreated, DrawNext: Boolean;
  I, J, SumWidth: Integer;

  procedure SetCaptionFont(Index: Integer);
  begin
    if (Index < 0) or Captions[Index].ParentFont then
      Image.Canvas.Font.Assign(Self.Font)
    else Image.Canvas.Font.Assign(Captions[Index].Font);
    if not FWindowActive then begin
      if Index < 0 then
        Image.Canvas.Font.Color := FFontInactiveColor
      else
        Image.Canvas.Font.Color := Captions[Index].InactiveColor;
    end;
  end;

  function DrawStr(GluePrev, GlueNext: Boolean; PrevIndex: Integer): Boolean;
  const
    Points = '...';
  var
    Text: string;
    Flags: Longint;
  begin
    if Length(S) > 0 then begin
      Text := MinimizeText(S, Image.Canvas, R.Right - R.Left);
      if GlueNext and (Text = S) then begin
        if (Image.Canvas.TextWidth(Text + '.') >= R.Right - R.Left) then begin
          if GluePrev then Text := Points
          else Text := Text + Points;
        end;
      end;
      if (Text <> Points) or GluePrev then begin
        if (Text = Points) and GluePrev then begin
          SetCaptionFont(-1);
          if PrevIndex > 0 then begin
            if FWindowActive then
              Image.Canvas.Font.Color := Captions[PrevIndex].Font.Color
            else
              Image.Canvas.Font.Color := Captions[PrevIndex].InactiveColor;
          end;
        end;
        Flags := DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX;
{$IFDEF RX_D4}
        if IsRightToLeft then
          Flags := Flags or DT_RIGHT or DT_RTLREADING else
{$ENDIF}
        Flags := Flags or DT_LEFT;
        DrawText(Image.Canvas.Handle, PChar(Text), -1, R, Flags);
{$IFDEF RX_D4}
        if IsRightToLeft then
          Dec(R.Right, Image.Canvas.TextWidth(Text)) else
{$ENDIF}
        Inc(R.Left, Image.Canvas.TextWidth(Text));
      end;
      Result := (Text = S);
    end
    else Result := True;
  end;

begin
  if Form.BorderStyle = bsNone then Exit;
  Image := TBitmap.Create;
  try
    CalculateGradientParams(R, Icons);
    GetWindowRect(Form.Handle, DrawRect);
    OffsetRect(R, -DrawRect.Left, -DrawRect.Top);
    DrawRect := R;
    Image.Width := WidthOf(R);
    Image.Height := HeightOf(R);
    R := Rect(-Image.Width div 4, 0, Image.Width, Image.Height);
    if SysGradient then begin
      if FWindowActive then C := clGradientActiveCaption
      else C := clGradientInactiveCaption;
    end
    else begin
      if FWindowActive then C := clActiveCaption
      else C := clInactiveCaption;
    end;
    if (FWindowActive and GradientActive) or
      (not FWindowActive and GradientInactive) then
    begin
      GradientFillRect(Image.Canvas, R, FStartColor, C, fdLeftToRight,
        FGradientSteps);
    end
    else begin
      Image.Canvas.Brush.Color := C;
      Image.Canvas. FillRect(R);
    end;
    R.Left := 0;
    if (biSystemMenu in Icons) and (Form.BorderStyle in [bsSizeable,
      bsSingle]) then
    begin
      IconCreated := False;
      if Form.Icon.Handle <> 0 then
        Ico := Form.Icon.Handle
      else if Application.Icon.Handle <> 0 then begin
        Ico := LoadImage(HInstance, 'MAINICON', IMAGE_ICON,
          GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON), 0);
        IconCreated := Ico <> 0;
        if not IconCreated then Ico := Application.Icon.Handle;
      end
      else Ico := LoadIcon(0, IDI_APPLICATION);
      DrawIconEx(Image.Canvas.Handle, R.Left + 1 + (R.Bottom + R.Top -
        GetSystemMetrics(SM_CXSMICON)) div 2, (R.Bottom + R.Top -
        GetSystemMetrics(SM_CYSMICON)) div 2, Ico,
        GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON),
        0, 0, DI_NORMAL);
      if IconCreated then DestroyIcon(Ico);
      Inc(R.Left, R.Bottom - R.Top);
    end;
    if (FFormCaption <> '') or ((Captions <> nil) and (Captions.Count > 0)) then
    begin
      SumWidth := 2;
      SetBkMode(Image.Canvas.Handle, TRANSPARENT);
      Inc(R.Left, 2);
      if FHideDirection = hdLeftToRight then begin
        for I := 0 to Captions.Count - 1 do
          if Captions[I].Visible then
            SumWidth := SumWidth + Captions[I].TextWidth;
        SumWidth := SumWidth + TextWidth;
        J := 0;
        while (SumWidth > (R.Right - R.Left)) and (J < Captions.Count) do
        begin
          SumWidth := SumWidth - Captions[J].TextWidth;
          while (J < Captions.Count - 1) and Captions[J].GlueNext do begin
            SumWidth := SumWidth - Captions[J + 1].TextWidth;
            Inc(J);
          end;
          Inc(J);
        end;
        for I := J to Captions.Count do begin
          if I < Captions.Count then begin
            if Captions[I].Visible then begin
              S := Captions[I].Caption;
              SetCaptionFont(I);
            end
            else S := '';
          end
          else begin
            S := FFormCaption;
            SetCaptionFont(-1);
          end;
          DrawStr(I = Captions.Count, False, -1);
        end;
      end
      else begin
        DrawNext := True;
        J := 0;
        if Captions <> nil then begin
          while (SumWidth < (R.Right - R.Left)) and (J < Captions.Count) do
          begin
            if Captions[J].Visible then begin
              SumWidth := SumWidth + Captions[J].TextWidth;
              while Captions[J].GlueNext and (J < Captions.Count - 1) do
              begin
                SumWidth := SumWidth + Captions[J + 1].TextWidth;
                Inc(J);
              end;
            end;
            Inc(J);
          end;
          for I := 0 to J - 1 do begin
            if Captions[I].Visible and DrawNext then begin
              S := Captions[I].Caption;
              if S <> '' then begin
                SetCaptionFont(I);
                DrawNext := DrawStr(((I > 0) and Captions[I - 1].GlueNext) or
                  (I = 0), Captions[I].GlueNext, I - 1) and
                  (Captions[I].GlueNext or (R.Right > R.Left));
              end;
            end;
          end;
        end;
        if (R.Right > R.Left) and DrawNext and (FFormCaption <> '') then
        begin
          S := FFormCaption;
          SetCaptionFont(-1);
          DrawStr(False, False, -1);
        end;
      end;
    end;
    BitBlt(DC, DrawRect.Left, DrawRect.Top, Image.Width, Image.Height,
      Image.Canvas.Handle, 0, 0, SRCCOPY);
  finally
    Image.Free;
  end;
end;

procedure TRxGradientCaption.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
end;

procedure TRxGradientCaption.FontChanged(Sender: TObject);
var
  I: Integer;
begin
  FDefaultFont := False;
  if (Captions <> nil) then begin
    Captions.BeginUpdate;
    try
      for I := 0 to Captions.Count - 1 do
        if Captions[I].ParentFont then Captions[I].SetParentFont(True);
    finally
      Captions.EndUpdate;
    end;
  end
  else if Active then Update;
end;

function TRxGradientCaption.GetTextWidth: Integer;
var
  Canvas: TCanvas;
  PS: TPaintStruct;
begin
  BeginPaint(Application.Handle, PS);
  try
    Canvas := TCanvas.Create;
    try
      Canvas.Handle := PS.hDC;
      Canvas.Font := FFont;
      Result := Canvas.TextWidth(FFormCaption);
    finally
      Canvas.Free;
    end;
  finally
    EndPaint(Application.Handle, PS);
  end;
end;

procedure TRxGradientCaption.SetGradientSteps(Value: Integer);
begin
  if FGradientSteps <> Value then begin
    FGradientSteps := Value;
    if Active and ((FWindowActive and GradientActive) or
      (not FWindowActive and GradientInactive)) then Update;
  end;
end;

procedure TRxGradientCaption.SetGradientActive(Value: Boolean);
begin
  if FGradientActive <> Value then begin
    FGradientActive := Value;
    if Active and FWindowActive then Update;
  end;
end;

procedure TRxGradientCaption.SetGradientInactive(Value: Boolean);
begin
  if FGradientInactive <> Value then begin
    FGradientInactive := Value;
    if Active and not FWindowActive then Update;
  end;
end;

procedure TRxGradientCaption.SetFontInactiveColor(Value: TColor);
begin
  if FFontInactiveColor <> Value then begin
    FFontInactiveColor := Value;
    if Active and not FWindowActive then Update;
  end;
end;

procedure TRxGradientCaption.SetHideDirection(Value: THideDirection);
begin
  if FHideDirection <> Value then begin
    FHideDirection := Value;
    if Active then Update;
  end;
end;

{$ENDIF WIN32}

end.