gradform.pas

动态提示控件

            end;

            Inc(x, HorizTileWidth[Index]);
            // inserting the extra pixels if necessary
            if PixelsToInsert <> 0 then
            begin
              PixelsNow := PixelsToInsert div (DitherColors - 2);
              if i < PixelsToInsert mod (DitherColors - 2) then
                Inc(PixelsNow);
              PatBlt(Canvas.Handle, x, 0, x + PixelsNow, Height, PATCOPY);
              Inc(x, PixelsNow);
            end;
          end;
          FromColor := ToColor;
        end;
      finally
        TileBitmap.Free;
        MaskBitmap.Free;
        ImageList.Free;
      end;

      BitBlt(HDC(DC), R.Left, R.Top, Width, Height,
         OffScreenBitmap.Canvas.Handle, 0, 0, SRCCOPY);
    finally
      OffScreenBitmap.Free;
    end;

  end else begin
    // "Banded" style gradient

    // This may look backwards, but it's not.  If the device capabilities
    // indicate that there are palette entries (more than 0), then we are in
    // a low color mode.  This is because when in high color mode or above,
    // Windows doesn't use palettes; each pixel knows it's RGB value.
    if (GetDeviceCaps(HDC(DC), SIZEPALETTE) > 0) or 
       (Width < GradientColors) then
    begin
      // Low color gradient, slower

      // Determine how large each band should be in order to cover the
      // rectangle (one band for every color intensity level).
      Step := Width / FGradientColors;

      // Start filling bands
      for Band := 0 to (FGradientColors-1) do
      begin
        // Create a brush with the appropriate color for this band
        Brush := CreateSolidBrush(Colors[ord(Active)][Band]);
        // Select that brush into the temporary DC.
        OldBrush := SelectObject(HDC(DC), Brush);
        try
          // Fill the rectangle using the selected brush -- PatBlt is faster
          // than FillRect
          PatBlt(HDC(DC), round(Band*Step) + R.Left, 0,
             round((Band+1)*Step) - round(Band*Step), Height, PATCOPY);
        finally
          // Clean up the brush
          SelectObject(HDC(DC), OldBrush);
          DeleteObject(Brush);
        end;
      end; // for
    end else begin
      // High color gradient, faster
      TmpDC := CreateCompatibleDC(HDC(DC));
      TmpBmp := CreateCompatibleBitmap(HDC(DC), FGradientColors, 1);
      OldBmp := SelectObject(TmpDC, TmpBmp);
      try
        // Start filling bands
        for Band := 0 to (FGradientColors-1) do
          SetPixel(TmpDC, Band, 0, Colors[ord(Active)][Band]);
        StretchBlt(HDC(DC), R.Left, 0, Width, Height, TmpDC, 0, 0,
           FGradientColors-1, 1, SRCCOPY);
      finally
        SelectObject(TmpDC, OldBmp);
        DeleteObject(TmpBmp);
        DeleteDC(TmpDC);
      end;
    end;
  end;
end;

procedure TdfsGradientForm.PaintCaptionText(DC: DFS_HDC; R: TRect; Active: boolean);
var
  OldColor: TColorRef;
  OldMode: integer;
  OldFont: HFont;
  CaptionText: string;
begin
  CaptionText := Caption;
  // Have to turn off complete boolean eval for this "if" statement.  I never
  // have it on anyway, but some do.
  {$IFOPT B+} {$DEFINE DFS_RESET_BOOL_EVAL} {$B-} {$ENDIF}
  if ((FormStyle = fsMDIForm) and (ActiveMDIChild <> NIL) and
      (ActiveMDIChild.WindowState = wsMaximized)) then
    CaptionText := CaptionText + ' - [' + ActiveMDIChild.Caption + ']';
  {$IFDEF DFS_RESET_BOOL_EVAL} {$B+} {$UNDEF DFS_RESET_BOOL_EVAL} {$ENDIF}

  Inc(R.Left, 2);

  // Set the color to paint the text with.
  if Active then
    OldColor := SetTextColor(HDC(DC), ColorToRGB(FCaptionTextColor))
  else
    OldColor := SetTextColor(HDC(DC), ColorToRGB(FInactiveCaptionTextColor));
  // Set the background text painting mode to transparent so that drawing text
  // doesn't distrub the gradient we just painted.  If you didn't do this, then
  // drawing text would also fill the text rectangle with a solid background
  // color, screwing up our gradient.
  OldMode := SetBkMode(HDC(DC), TRANSPARENT);
  // Select in the system defined caption font (see Create constructor).
  if FCaptionFont.Handle <> 0 then
//**  if CaptionFontHandle <> 0 then
    OldFont := SelectObject(HDC(DC), FCaptionFont.Handle)
//**    OldFont := SelectObject(HDC(DC), CaptionFontHandle)
  else
    OldFont := 0;
  try
    // Draw the text making it left aligned, centered vertically, allowing no
    // line breaks.
    DrawText(HDC(DC), PChar(CaptionText), -1, R, DT_LEFT or DT_VCENTER or
       DT_SINGLELINE or DT_END_ELLIPSIS);
  finally
    // Clean up all the drawing objects.
    if OldFont <> 0 then
      SelectObject(HDC(DC), OldFont);
    SetBkMode(HDC(DC), OldMode);
    SetTextColor(HDC(DC), OldColor);
  end;
end;

// Paint the min/max/help/close buttons.
procedure TdfsGradientForm.PaintCaptionButtons(DC: DFS_HDC; var Rect: TRect);
var
  BtnWidth: integer;
  Flag: UINT;
  SrcRect: TRect;
  ABorderStyle: TFormBorderStyle;
  ABorderIcons: TBorderIcons;
begin
  SrcRect := Rect;
  InflateRect(SrcRect, -2, -2);
  if csDesigning in ComponentState then
  begin
    // While designing, the min/max buttons are always shown in a sizeable frame
    ABorderStyle := bsSizeable;
    ABorderIcons := [biSystemMenu, biMinimize, biMaximize];
  end else begin
    ABorderStyle := BorderStyle;
    ABorderIcons := BorderIcons;
  end;

  if ABorderStyle in [bsToolWindow, bsSizeToolWin] then
  begin
    // Tool windows only have the close button, nothing else.
    with SrcRect do
      Left := Right - (GetSystemMetrics(SM_CXSMSIZE)) + 2;
    Flag := DFCS_CAPTIONCLOSE;
    if (GetClassLong(Handle, GCL_STYLE) and CS_NOCLOSE) <> 0 then
      Flag := Flag or DFCS_INACTIVE;
    DrawFrameControl(HDC(DC), SrcRect, DFC_CAPTION, Flag);
    Rect.Right := SrcRect.Left-5;
  end else begin
    BtnWidth := GetSystemMetrics(SM_CXSMICON)-2;
    { Windows is loopy.  It always returns an even number, no matter what }
    if (Odd(BtnWidth) XOR Odd(Rect.Bottom-Rect.Top)) then
      inc(BtnWidth);
    SrcRect.Left := SrcRect.Right - BtnWidth - 2;
    // if it has system menu, it has a close button.
    if biSystemMenu in ABorderIcons then
    begin
      Flag := DFCS_CAPTIONCLOSE;
      if (GetClassLong(Handle, GCL_STYLE) and CS_NOCLOSE) <> 0 then
        Flag := Flag or DFCS_INACTIVE;
      DrawFrameControl(HDC(DC), SrcRect, DFC_CAPTION, Flag);
      OffsetRect(SrcRect, -BtnWidth-4, 0);
      Dec(Rect.Right,BtnWidth+4);
    end;
    // Minimize and Maximized don't show up at all if BorderStyle is bsDialog or
    // if neither of them are enabled.
    if (ABorderStyle in [bsSizeable, bsSingle]) and
       (ABorderIcons * [biMinimize, biMaximize] <> []) then
    begin
      if WindowState = wsMaximized then
        Flag := DFCS_CAPTIONRESTORE
      else
        Flag := DFCS_CAPTIONMAX;
      // if it doesn't have max in style, then it shows up disabled.
      if not (biMaximize in ABorderIcons) then
        Flag := Flag or DFCS_INACTIVE;

      DrawFrameControl(HDC(DC), SrcRect, DFC_CAPTION, Flag);
      OffsetRect(SrcRect, -BtnWidth-2, 0);
      Dec(Rect.Right,BtnWidth+2);

      if WindowState = wsMinimized then
        Flag := DFCS_CAPTIONRESTORE
      else
        Flag := DFCS_CAPTIONMIN;
      // if it doesn't have min in style, then it shows up disabled.
      if not (biMinimize in ABorderIcons) then
        Flag := Flag or DFCS_INACTIVE;

      DrawFrameControl(HDC(DC), SrcRect, DFC_CAPTION, Flag);
      OffsetRect(SrcRect, -BtnWidth-2, 0);
      Dec(Rect.Right,BtnWidth+2);
    end;

    // Help only shows up in bsDialog style, and bsSizeable, bsSingle when there
    // is no min or max button.
    if biHelp in ABorderIcons then
    begin
      if ((ABorderStyle in [bsSizeable, bsSingle]) and
         (ABorderIcons * [biMinimize, biMaximize] = [])) or
         (ABorderStyle = bsDialog) then
      begin
        DrawFrameControl(HDC(DC), SrcRect, DFC_CAPTION, DFCS_CAPTIONHELP);
        Dec(Rect.Right,BtnWidth+2);
      end;
    end;

    Dec(Rect.Right, 3);
  end;
end;


function TdfsGradientForm.DrawCaption(FormDC: DFS_HDC; Active: boolean): TRect;
var
  R: TRect;
  OldBmp,
  Bmp: HBitmap;
  BmpDC: HDC;
  BmpCanvas: TCanvas;
  w,h:integer;
  IsLogoGradient : Boolean;
  GradientRect, LogoRect : TRect;
  LogoWidth : Integer;
  CurrentLogo : TBitmap;
begin
  // Get only the portion we need to draw.
  R := GetCaptionRect;
  Result := R;

  // Convert to logical (0-based) coordinates
  OffsetRect(R, -R.Left, -R.Top);

  W := R.Right - R.Left;
  H := R.Bottom - R.Top;

  // Create a temporary device context to draw on.  Drawing on a temporary DC
  // and copying it to the real DC accomplishes two things:
  // 1) It is faster because Windows doesn't have to draw anything in the
  //    temporary DC on the screen, it only draws when you paint something on a
  //    real DC.  Then it just draws everything at once when we copy it, instead
  //    of drawing a little, do some calculations, draw a little, etc.
  // 2) It looks much better because it is drawn faster.  It reduces the
  //    "flicker" that you would see from each individual part being drawn,
  //    especially the gradient bands.
  BmpDC := CreateCompatibleDC(HDC(FormDC));
  Bmp := CreateCompatibleBitmap(HDC(FormDC), W, H);
  OldBmp := SelectObject(BmpDC, Bmp);

  try
    // If there's a logo bitmap, we need a solid background
    // behind the menu icon, the caption buttons, and the
    // logo; so we need to delay drawing of the gradient
    // until after the menu and buttons are painted.
    IsLogoGradient := FALSE;

    if (FPaintGradient = gfpAlways) or
       (Active and (FPaintGradient = gfpActive)) then
    begin
      if (Assigned (FLogo)) and (not FLogo.Empty) then
      begin
        IsLogoGradient := TRUE;
        FillRectSolid(DFS_HDC (BmpDC), R, Active, GradientStartColor,
          GradientInactiveStartColor);
      end
      else
        // Draw the gradient background in the temporary DC
        FillRectGradient(DFS_HDC(BmpDC), R, UseDithering, Active)
    end
    else
      FillRectSolid(DFS_HDC(BmpDC), R, Active, GetSysColor(COLOR_ACTIVECAPTION),
        GetSysColor(COLOR_INACTIVECAPTION));

    Inc(R.Left, 1);
    // Do we need to paint an icon for the system menu?
    if not ((FormStyle = fsMDIChild) and (WindowState = wsMaximized)) then
    begin
      if IsLogoGradient then
      begin
        // Start by drawing the solid-color end of the bar.
        // There's a solid color under the menu icon if the
        // logo is left-aligned, or under the caption buttons
        // if the logo is right-aligned.
        if LogoAlign = laLeft then
        begin
          if ((biSystemMenu in BorderIcons) and
             (BorderStyle in [bsSingle, bsSizeable])) or
             (csDesigning in ComponentState) then
          begin
            FillRectSolid(DFS_HDC (BmpDC), R, Active, GradientStartColor,
              GradientInactiveStartColor);
            // PaintMenuIcon will adjust the rect so that future drawing operations
            // happen in the right spot.
            PaintMenuIcon(DFS_HDC(BmpDC), R, Active);
          end;
        end
        else  // LogoAlign = laRight
        begin
          FillRectSolid(DFS_HDC(BmpDC), R, Active, GradientStopColor,
            GradientInactiveStopColor);
          PaintCaptionButtons(DFS_HDC(BmpDC), R);
        end;

        if (not Active) and (not FInactiveLogo.Empty) then
          CurrentLogo := FInactiveLogo
        else
          CurrentLogo := FLogo;

        LogoWidth := CurrentLogo.Width;

        if LogoAlign = laLeft then
          LogoRect := Rect(R.Left, R.Top, R.Left + LogoWidth, R.Bottom)
        else
          LogoRect := Rect(R.Right - LogoWidth, R.Top, R.Right, R.Bottom);

        // Make sure LogoRect doesn't fall off the edge
        // of our drawable area (between icon and buttons)
        IntersectRect (LogoRect, LogoRect, R);

        if LogoAlign = laLeft then
          GradientRect := Rect(LogoRect.Right, R.Top, R.Right, R.Bottom)
        else
          GradientRect := Rect(R.Left, R.Top, LogoRect.Left, R.Bottom);

        if GradientRect.Right > GradientRect.Left then
          FillRectGradient(DFS_HDC(BmpDC), GradientRect, UseDithering, Active);

        BitBlt(BmpDC, LogoRect.Left, (LogoRect.Bottom - LogoRect.Top -
          CurrentLogo.Height) div 2 + LogoRect.Top, LogoRect.Right -