gradform.pas

动态提示控件

       read FGradientStartColor
       write SetGradientStartColor
       default DEF_GRADIENT_START_COLOR;
    {: The rightmost gradient color. This is the color that is used at the
       end of the caption (the far right), and is gradually faded from the
       <See Property=TdfsGradientForm.GradientStartColor Text=GradientStartColor>.
       <Related A=GradientStartColor;GradientColors> }
    property GradientStopColor: TColor
       read FGradientStopColor
       write SetGradientStopColor
       stored StoreGradientStopColor
       default DEF_GRADIENT_STOP_COLOR;
    property GradientInactiveStartColor: TColor
       read FGradientInactiveStartColor
       write SetGradientInactiveStartColor
       default DEF_GRADIENT_INACTIVE_START_COLOR;
    property GradientInactiveStopColor: TColor
       read FGradientInactiveStopColor
       write SetGradientInactiveStopColor
       stored StoreGradientInactiveStopColor
       default DEF_GRADIENT_INACTIVE_STOP_COLOR;
    {: Determines if and when the gradient caption should be painted.
     <UL>
     <LI>gfpAlways <TAB> The gradient should always be drawn.
     <LI>gfpActive <TAB> Only draw the gradient when the form is active.
     <LI>gfpNever  <TAB> Never draw the gradient.
     </UL> }
    property PaintGradient: TGFPaintWhen
       read FPaintGradient
       write SetPaintGradient
       default DEF_PAINT_GRADIENT;
    property UseWin98Gradient: boolean
       read FUseWin98Gradient
       write SetUseWin98Gradient
       default DEF_USE_WIN98_GRADIENT;
    property UseDithering: boolean
       read FUseDithering
       write SetUseDithering
       default DEF_USE_DITHERING;
    property Logo: TBitmap
       read FLogo
       write SetLogo;
    property InactiveLogo: TBitmap
       read FInactiveLogo
       write SetInactiveLogo;
    property LogoAlign: TGFLogoAlign
       read FLogoAlign
       write SetLogoAlign
       default laRight;
    property LogoLayered: Boolean
       read FLogoLayered
       write SetLogoLayered
       default FALSE;
    {: This event is fired after the icon, buttons and gradient are painted,
       but just before the text is painted.  It is not fired if the caption is
       painted but not as a gradient, that is if
       <See TdfsGradientForm.PaintGradient Text=PaintGradient> is gfpNever or
       gfpActive and the form is not active.<BR><BR> <B>Sender</B> is the
       TdfsGradientForm that is being painted.<BR><BR><B>Canvas</B> is the drawing
       surface that is being painted.  Anything you want to appear on the
       caption must be drawn on this canvas.  This canvas is not the actual
       caption canvas, it is a memory bitmap (non-visible).  This prevents
       flicker as many things are being drawn since the actual visible drawing
       only happens when the entire drawing operation is complete.<BR><BR>
       <B>R</B> is a rectangle that describes the area in which you can draw.
       When the event is first fired, this rectangle will be the entire caption
       less the system icon on the left (if any) and the caption buttons on the
       right (if any).  After performing your drawing operations, this value
       should be modified so that the area you have painted is subtracted out.
       This prevents the gradient from painting over what you have just done. }
    property OnCaptionPaint: TGFOnCaptionPaint
       read FOnCaptionPaint
       write FOnCaptionPaint;
  end;
  
implementation

{$R GRADFORM.RES}

// A variant record (known as a union in C) to allow easy access to the
// individual red, // green, and blue values of a TColorRef (RGB) value.
type
  TRGBMap = packed record
    case boolean of
      TRUE:  ( RGBVal: DWORD );
      FALSE: ( Red,
               Green,
               Blue,
               Unused: byte );
  end;


var
  EntrancyFlag: boolean;

{: Create creates and initializes an instance of TdfsGradientForm. Call Create
   to instantiate a TdfsGradientForm at runtime.  After calling the inherited
   constructor, Create initializes the following properties:<BR>
   <UL>
   <LI>UsingDefaultGradientStopColor to TRUE.
   <LI>CaptionTextColor to clWhite.
   <LI>GradientStartColor to clBlack.
   <LI>GradientStopColor to clActiveCaption.
   <LI>GradientColors to <See DEF_GRADIENT_COLORS>.
   <LI>PaintGradient to gpfAlways.
   </UL> }
constructor TdfsGradientForm.Create(AOwner: TComponent);
var
  VerInfo: TOSVersionInfo;
begin
  // We set our new property values first so that they will be valid in the
  // OnCreate event handler.  The inherited Create is what calls that event, so
  // we set up first.

  FLogo := TBitmap.Create;
  FInactiveLogo := TBitmap.Create;
  FLogoLayered := FALSE;
  FLogoAlign := laRight;

  // Are we running under Win98, and should we let it do it for us?
  VerInfo.dwOSVersionInfoSize := SizeOf(VerInfo);
  if GetVersionEx(VerInfo) then
    // this will also catch NT 5.
    FRunningOnWin98 := (VerInfo.dwMajorVersion >= 5) or
       ((VerInfo.dwMajorVersion >= 4) and (VerInfo.dwMinorVersion > 0))
  else
    FRunningOnWin98 := FALSE;

  // Are we running on a 16-color system?
  FSystemIs16Color := GetSystemColorBitDepth = 4;

  // Don't paint 16-color by default
  FPaint16Color := FALSE;

  FUseWin98Gradient := DEF_USE_WIN98_GRADIENT;
  FUseDithering := DEF_USE_DITHERING;
  FUsingDefaultGradientStopColor := TRUE;
  FUsingDefaultGradientInactiveStopColor := TRUE;
  FCaptionTextColor := DEF_CAPTION_TEXT_COLOR;
  FInactiveCaptionTextColor := DEF_INACTIVE_CAPTION_TEXT_COLOR;
  // Set gradient start and stop colors.
  FGradientStartColor := DEF_GRADIENT_START_COLOR;
  FGradientStopColor := DEF_GRADIENT_STOP_COLOR;
  FGradientInactiveStartColor := DEF_GRADIENT_INACTIVE_START_COLOR;
  FGradientInactiveStopColor := DEF_GRADIENT_INACTIVE_STOP_COLOR;
  // Set the number of colors to use to create the gradient fill.
  FGradientColors := DEF_GRADIENT_COLORS;
  // Should we paint the gradient when window is inactive.
  FPaintGradient := DEF_PAINT_GRADIENT;
  FOnCaptionPaint := NIL;
  FChangingActivationState := FALSE;
  // Caption font stuff
  FUseSystemCaptionFont := TRUE;
  FCaptionFont := TFont.Create;
  UpdateCaptionFont;

  // Calculate the colors we need to paint the gradient.
  CalculateColors;
//**  CaptionFontHandle := 0;

//  inherited Create(AOwner);

  CreateNew(AOwner {$IFDEF DFS_CPPB_1}, 1 {$ENDIF});
  if (ClassType <> TdfsGradientForm) and not (csDesigning in ComponentState) then
  begin
    FCreating := TRUE;
    try
      if not InitInheritedComponent(Self, TdfsGradientForm) then
        {$IFDEF DFS_COMPILER_2}
        raise EResNotFound.CreateResFmt(sResNotFound, [ClassName]);
        {$ELSE}
        raise EResNotFound.CreateFmt(sResNotFound, [ClassName]);
        {$ENDIF}
    finally
      FCreating := FALSE;
    end;

    // All versions of Delphi, and C4 and up.
    {$IFDEF DFS_DELPHI}
      {$DEFINE DFS_DO_ONCREATE}
    {$ENDIF}
    {$IFDEF DFS_CPPB_4_UP}
      {$DEFINE DFS_DO_ONCREATE}
    {$ENDIF}
    {$IFDEF DFS_DO_ONCREATE}
    try
      if {$IFDEF DFS_COMPILER_4_UP} OldCreateOrder and {$ENDIF}
         assigned(OnCreate) then
        OnCreate(Self);
    except
      Application.HandleException(Self);
    end;
    {$UNDEF DFS_DO_ONCREATE}
    {$ENDIF}
  end;
end;


{: Destroy destroys an instance of TdfsGradientForm. Do not call Destroy
   directly in an application. Instead, call Free. Free verifies that the
   instance is not already freed, and only then calls Destroy.<BR>
   Destroy is used to free resources allocated in the
   <See Method=TdfsGradientForm.Create Text=Create> constructor. }
destructor TdfsGradientForm.Destroy;
begin
  FLogo.Free;
  FInactiveLogo.Free;
  FCaptionFont.Free;
  // Clean up the font we created.
//**  if CaptionFontHandle <> 0 then
//**    DeleteObject(CaptionFontHandle);
    
  inherited Destroy;
end;


procedure TdfsGradientForm.Loaded;
begin
  inherited Loaded;
  // Create a font for the caption bar.
//**  CreateCaptionFontHandle;
end;


procedure TdfsGradientForm.CreateWnd;
begin
  inherited CreateWnd;
  if (not InhibitGradient) and (FormStyle = fsMDIForm) then
  begin
    FGradClientInstance := MakeObjectInstance(GradClientWndProc);
    FGradDefClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
    SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(FGradClientInstance));
  end else
    FGradClientInstance := NIL;
//**  if not (csLoading in ComponentState) then
    // Create a font for the caption bar.
//**    CreateCaptionFontHandle;
end;

procedure TdfsGradientForm.DestroyWnd;
begin
  if (FormStyle = fsMDIForm) and assigned(FGradClientInstance) then
  begin
    SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(FGradDefClientProc));
    FreeObjectInstance(FGradClientInstance);
  end;

  inherited DestroyWnd;
end;

procedure TdfsGradientForm.SetGradientColors(Val: integer);
begin
  if (Val = FGradientColors) or (Val < MIN_GRADIENT_COLORS) or
     (Val > MAX_GRADIENT_COLORS) then
    exit;

  FGradientColors := Val;
  // The number of colors have changed, we need to recalculate the colors we
  // use to paint.
  CalculateColors;
  InvalidateCaption;
end;

procedure TdfsGradientForm.SetCaptionTextColor(Color: TColor);
begin
  if FCaptionTextColor = Color then
    exit;

  FCaptionTextColor := Color;
  InvalidateCaption;
end;

procedure TdfsGradientForm.SetInactiveCaptionTextColor(Color: TColor);
begin
  if FInactiveCaptionTextColor = Color then
    exit;

  FInactiveCaptionTextColor := Color;
  InvalidateCaption;
end;

procedure TdfsGradientForm.SetGradientStartColor(Color : TColor);
begin
  FGradientStartColor := Color;
  // The colors have changed, we need to recalculate the colors we use to paint.
  CalculateColors;
  InvalidateCaption;
end;

procedure TdfsGradientForm.SetGradientStopColor(Color : TColor);
begin
  FGradientStopColor := Color;
  FUsingDefaultGradientStopColor := FGradientStopColor = clActiveCaption;
  // The colors have changed, we need to recalculate the colors we use to paint.
  CalculateColors;
  InvalidateCaption;
end;

procedure TdfsGradientForm.SetGradientInactiveStartColor(Color : TColor);
begin
  FGradientInactiveStartColor := Color;
  // The colors have changed, we need to recalculate the colors we use to paint.
  CalculateColors;
  InvalidateCaption;
end;

procedure TdfsGradientForm.SetGradientInactiveStopColor(Color : TColor);
begin
  FGradientInactiveStopColor := Color;
  FUsingDefaultGradientInactiveStopColor :=
     (FGradientInactiveStopColor = clInactiveCaption);
  // The colors have changed, we need to recalculate the colors we use to paint.
  CalculateColors;
  InvalidateCaption;
end;

procedure TdfsGradientForm.SetPaintGradient(Val: TGFPaintWhen);
begin
  if FPaintGradient = Val then
     exit;

  FPaintGradient := Val;
  InvalidateCaption;
end;

procedure TdfsGradientForm.SetCaptionText(const Val: string);
begin
  if EntrancyFlag then
    exit;

  EntrancyFlag := TRUE;
  try
    // Have to do this so the MDI window menus get updated and application
    // titles get updated (taskbar and Alt-Tab text)
    inherited Caption := Val;

    FCaptionText := Val;
    if (not InhibitGradient) and HandleAllocated and IsWindowVisible(Handle) then
    begin
      if (FormStyle = fsMDIChild) {and FChangingActivationState} then
      begin