gradform.pas

动态提示控件

        if WindowState = wsMaximized then
          // Need to cause main form's caption to be redrawn, not the MDI child.
          SetWindowPos(Application.MainForm.Handle, 0, 0, 0, 0, 0,
             SWP_DRAWFRAME or SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE
             or SWP_NOZORDER)
        else
          InvalidateCaption;
      end else
        Draw(IsActiveWindow);
    end;

  finally
    EntrancyFlag := FALSE;
  end;
end;

procedure TdfsGradientForm.SetUseWin98Gradient(Val: boolean);
begin
  if Val <> FUseWin98Gradient then
  begin
    FUseWin98Gradient := Val;
    if HandleAllocated then
    begin
      RecreateWnd;
      // hmmm, how to get it to show again in the IDE?
    end;
  end;
end;

procedure TdfsGradientForm.SetUseDithering(Val: boolean);
begin
  if Val <> FUseDithering then
  begin
    FUseDithering := Val;
    InvalidateCaption;
  end;
end;

function TdfsGradientForm.IsActiveWindow: boolean;
begin
  if FormStyle = fsMDIChild then
    if assigned(Application.MainForm) then
      Result := (GetActiveWindow = Application.MainForm.Handle) and
                (TForm(Application.MainForm).ActiveMDIChild = Self)
    else
      Result := FALSE
  else
    Result := GetActiveWindow=Handle;
end;

procedure TdfsGradientForm.CalculateColors;
var
  LoColor, HiColor: TRGBMap;
  RedPct,
  GreenPct,
  BluePct: real;
  x,
  Band: integer;
begin
  // Get colors for both active and inactive captions.
  for x := 0 to 1 do
  begin
    if x = 0 then   // inactive captions
    begin
      LoColor.RGBVal := ColorToRGB(FGradientInactiveStartColor);
      HiColor.RGBVal := ColorToRGB(FGradientInactiveStopColor);
    end else begin    // active caption
      LoColor.RGBVal := ColorToRGB(FGradientStartColor);
      HiColor.RGBVal := ColorToRGB(FGradientStopColor);
    end;
    // Figure out the percentage of each RGB value needed for banding
    RedPct   := (HiColor.Red - LoColor.Red)/ (FGradientColors-1);
    GreenPct := (HiColor.Green - LoColor.Green) / (FGradientColors-1);
    BluePct  := (HiColor.Blue - LoColor.Blue) / (FGradientColors-1);
    // Use the percentage of each color to create each band color.
    for Band := 0 to (FGradientColors-1) do
      Colors[x][Band] := RGB(LoColor.Red + round(RedPct * (Band)),
         LoColor.Green + round(GreenPct * (Band)),
         LoColor.Blue + round(BluePct * (Band)));
  end;
end;

//**
{procedure TdfsGradientForm.CreateCaptionFontHandle;
var
  NCM: TNonClientMetrics;
begin
  if CaptionFontHandle <> 0 then
    DeleteObject(CaptionFontHandle);
  NCM.cbSize := SizeOf(NCM);
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCM, 0) then
  begin
    if BorderStyle in [bsToolWindow, bsSizeToolWin] then
      CaptionFontHandle := CreateFontIndirect(NCM.lfSmCaptionFont)
    else
      CaptionFontHandle := CreateFontIndirect(NCM.lfCaptionFont);
  end else
    CaptionFontHandle := 0;
end;
}

// The caption rect is the rectangle we are interested in painting.  This will
// be the area that contains the caption icon, text and buttons.
function TdfsGradientForm.GetCaptionRect: TRect;
begin
  // Designing mode always draws the form as bsSizeable
  if csDesigning in ComponentState then
  begin
    GetWindowRect(Handle, Result);
    // Convert rect from screen (absolute) to client (0 based) coordinates.
    OffsetRect(Result, -Result.Left, -Result.Top);
    // Shrink rectangle to allow for window border.  We let Windows paint it.
    InflateRect(Result, -GetSystemMetrics(SM_CXSIZEFRAME),
       -GetSystemMetrics(SM_CYSIZEFRAME));
    Result.Bottom := Result.Top + GetSystemMetrics(SM_CYCAPTION) - 1;
  end else begin
    // if we have no border style, then just set the rectange empty.
    if BorderStyle = bsNone then
      SetRectEmpty(Result)
    else begin
      GetWindowRect(Handle, Result);
      // Convert rect from screen (absolute) to client (0 based) coordinates.
      OffsetRect(Result, -Result.Left, -Result.Top);
      // Shrink rectangle to allow for window border.  We let Windows paint it.
      if (WindowState = wsMinimized) or (BorderStyle in [bsToolWindow, bsSingle,
        bsDialog]) then
        InflateRect(Result, -GetSystemMetrics(SM_CXFIXEDFRAME),
          -GetSystemMetrics(SM_CYFIXEDFRAME))
      else if BorderStyle in [bsSizeable, bsSizeToolWin] then
        InflateRect(Result, -GetSystemMetrics(SM_CXSIZEFRAME),
          -GetSystemMetrics(SM_CYSIZEFRAME));

      // Set the appropriate height of caption bar.
      if BorderStyle in [bsToolWindow, bsSizeToolWin] then
        Result.Bottom := Result.Top + GetSystemMetrics(SM_CYSMCAPTION) - 1
      else
        Result.Bottom := Result.Top + GetSystemMetrics(SM_CYCAPTION) - 1;
    end;
  end;
end;

// Paint the icon for the system menu.
procedure TdfsGradientForm.PaintMenuIcon(DC: DFS_HDC; var R: TRect; Active: boolean);
{$IFDEF DFS_COMPILER_2}
const
  LR_COPYFROMRESOURCE = $4000; // Missing from WINDOWS.PAS in Delphi 2!
{$ENDIF}
var
  SmallCopy,
  IconHandle: HIcon;
  Size: integer;
begin
  // Does the form have an icon assigned to it?
  if Icon.Handle <> 0 then
    IconHandle := Icon.Handle
  // If not, does the application have an icon?
  else if Application.Icon.Handle <> 0 then
    IconHandle := Application.Icon.Handle
  // If not, then just use the system defined application icon.
  else
    IconHandle := LoadIcon(0, IDI_APPLICATION);

  Size := GetSystemMetrics(SM_CXSMICON);
  SmallCopy := CopyImage(IconHandle, IMAGE_ICON, Size, Size,
     LR_COPYFROMRESOURCE);
  with R do
    // Let CopyImage() make get us a nice 16x16 version of the icon and we'll
    // paint it.
    DrawIconEx(HDC(DC), Left+1, Top+1, SmallCopy, 0, 0, 0, 0, DI_NORMAL);
  DestroyIcon(SmallCopy);
  Inc(R.Left, Size+1);
end;

// Paint the given rectangle with the system solid color.
procedure TdfsGradientForm.FillRectSolid(DC: DFS_HDC; const R: TRect;
  Active: boolean; ActiveColor, InactiveColor : TColor);
var
  OldBrush,
  Brush: HBrush;
begin
  // Create a brush with the appropriate color\
  if Active then
    Brush := CreateSolidBrush(ColorToRGB(ActiveColor))
  else
    Brush := CreateSolidBrush(ColorToRGB(InactiveColor));
  // 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
    with R do
      PatBlt(HDC(DC), Left, Top, Right-Left, Bottom-Top, PATCOPY);
  finally
    // Clean up the brush
    SelectObject(HDC(DC), OldBrush);
    DeleteObject(Brush);
  end;
end;

// Paint the given rectangle with the gradient pattern.
procedure TdfsGradientForm.FillRectGradient(DC: DFS_HDC; const R: TRect;
   Dithered, Active: boolean);
  function MaxInt(I1, I2: integer): integer;
  begin
    if I1 > I2 then
      Result := I1
    else
      Result := I2;
  end;
  function MinInt(I1, I2: integer): integer;
  begin
    if I1 < I2 then
      Result := I1
    else
      Result := I2;
  end;
const
  HorizTileWidth: array[0..1] of Integer = (69, 14);
  HorizTileHeight: array[0..1] of Integer = (30, 28);
  TileResName: array[0..1] of String = ('DFS_DITHGRADMASK1','DFS_DITHGRADMASK2');
var
  OldBmp,
  TmpBmp: HBitmap;
  TmpDC: HDC;
  OldBrush,
  Brush: HBrush;
  Step: real;
  Band: integer;

  Width, Height: Integer;
  StartColor, StopColor: DWORD;
  x, y, i: Integer;
  RStart, GStart, BStart: Integer;
  RDiff, GDiff, BDiff: Integer;
  DitherColors, Index: Integer;
  TileBitmap,
  MaskBitmap,
  OffScreenBitmap: TBitmap;
  FromColor,
  ToColor: TColor;
  PixelsToInsert, PixelsNow: Integer;
  ImageList: TImageList;
begin
  Width := R.Right - R.Left;
  if Width < 1 then exit;
  Height := R.Bottom - R.Top;

  StartColor := 0;
  Index := 0;
  RStart := 0;
  GStart := 0;
  BStart := 0;
  RDiff := 0;
  GDiff := 0;
  BDiff := 0;

  if Dithered then
  begin
    // Dithered style gradient
    if Active then
    begin
      StartColor := ColorToRGB(FGradientStartColor);
      StopColor := ColorToRGB(FGradientStopColor);
    end else begin
      StartColor := ColorToRGB(FGradientInactiveStartColor);
      StopColor := ColorToRGB(FGradientInactiveStopColor);
    end;

    RStart := GetRValue(StartColor);
    GStart := GetGValue(StartColor);
    BStart := GetBValue(StartColor);
    RDiff  := GetRValue(StopColor) - RStart;
    GDiff  := GetGValue(StopColor) - GStart;
    BDiff  := GetBValue(StopColor) - BStart;

    if (Abs(RDiff) + Abs(GDiff) + Abs(BDiff)) / Width < 200.0 / 280.0 then
      Index := 0
    else
      Index := 1;

    // Want dithering, but make sure it will look good.
    if (Width < HorizTileWidth[Index] shl 1) or (GetDeviceCaps(HDC(DC),
       SIZEPALETTE) > 0) then
      Dithered := FALSE; // Low color mode, dithering will look horrible.
  end;

  if Dithered then
  begin
    OffScreenBitmap := TBitmap.Create;
    try
      OffScreenBitmap.Width := Width;
      OffScreenBitmap.Height := Height;

      // if dithering is on, we caluclate the number of colors from the width
      DitherColors := (Width div HorizTileWidth[Index]) + 1;
      if Width mod HorizTileWidth[Index] > 0 then
      // if the width is not the multiple of HorizTileWidth, additional pixels
      // must be inserted between the tiles
        PixelsToInsert := Width - (DitherColors - 1) * HorizTileWidth[Index]
      else
        PixelsToInsert := 0;

      // setting up the temp bitmap and loading the tile mask
      ImageList := TImageList.CreateSize(HorizTileWidth[Index],
         HorizTileHeight[Index]);
      MaskBitmap := TBitmap.Create;
      TileBitmap := TBitmap.Create;
      try
        MaskBitmap.LoadFromResourceName(HInstance, TileResName[Index]);
        TileBitmap.Width := HorizTileWidth[Index];
        TileBitmap.Height := HorizTileHeight[Index];

        x := 0;
        FromColor := StartColor;
        for i := 1 to DitherColors do
        begin
          // calculating the next color
          ToColor := RGB(
             MinInt(MaxInt(RStart + MulDiv(i, RDiff, DitherColors - 1), 0), 255),
             MinInt(MaxInt(GStart + MulDiv(i, GDiff, DitherColors - 1), 0), 255),
             MinInt(MaxInt(BStart + MulDiv(i, BDiff, DitherColors - 1), 0), 255));
          // colorizing the tile mask
          TileBitmap.Canvas.Brush.Color := FromColor;
          PatBlt(TileBitmap.Canvas.Handle, 0, 0, HorizTileWidth[Index],
             HorizTileHeight[Index], PATCOPY);
          if ImageList.Count = 0 then
            ImageList.Add(TileBitmap, MaskBitmap)
          else
            ImageList.Replace(0, TileBitmap, MaskBitmap);
          with OffScreenBitmap do
          begin
            // painting the tile mask
            Canvas.Brush.Color := ToColor;
            PatBlt(Canvas.Handle, x, 0, x + HorizTileWidth[Index], Height,
               PATCOPY);

            y := 0;
            while y < Height do
            begin
              ImageList.Draw(Canvas, x, y, 0);
              Inc(y, HorizTileHeight[Index]);