shintmanager.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

  GradientArray : TsGradArray;

  procedure FillCanvas(bmp : TBitmap); begin
    BMP.Canvas.Pen.Style := psClear;
    BMP.Canvas.Brush.Style := bsSolid;
    BMP.Canvas.Brush.Color := ColortoRGB(HintKind.Color);
    BMP.Canvas.Rectangle(aRect.Left, aRect.Top, aRect.Right + 1, aRect.Bottom + 1);
  end;
  procedure PaintAddons(var aBmp : TBitmap);
  var bmp : TBitmap;
  begin
    iDrawed := False;
    // BGImage painting
    if (HintKind.TexturePercent > 0) then begin
      TileBitmap(aBmp.Canvas, Rect(aRect.Left, aRect.Top, aRect.Right, aRect.Bottom), HintKind.Texture.Graphic);
      iDrawed := True;
    end
    else begin
      FillCanvas(aBmp);
    end;
    // BGGradient painting
    if (HintKind.GradientPercent > 0) then begin
      if iDrawed then begin
        bmp := TBitmap.Create;
        try
          bmp.PixelFormat := pf24bit;
          bmp.Width := WidthOf(aRect);
          bmp.Height := HeightOf(aRect);

          if Length(HintKind.GradientData) > 0 then PaintGrad(Bmp, Rect(0, 0, Bmp.Width, Bmp.Height), GradientArray) else FillCanvas(Bmp);

          TransColor.A := 0;
          TransColor.R := IntToByte(HintKind.TexturePercent shl 8 div 100); TransColor.G := TransColor.R; TransColor.B := TransColor.R;
          SumBmpRect(aBmp, Bmp, TransColor, Rect(0, 0, Bmp.Width - 1, Bmp.Height{ - 1}), Point(aRect.Left, aRect.Top));
        finally
          FreeAndNil(Bmp);
        end;
      end
      else begin
        if Length(HintKind.GradientData) > 0 then begin
          PaintGrad(aBmp, aRect, GradientArray);
        end
        else begin
          FillCanvas(aBmp);
        end;
      end;
    end;
    case HintKind.GradientPercent + HintKind.TexturePercent of
      1..99 : begin
        BlendColorRect(aBmp, aRect, (HintKind.GradientPercent + HintKind.TexturePercent),
                         HintKind.Color);
      end;
      100 : begin end
      else begin
        aBMP.Canvas.Pen.Style := psClear;
        aBMP.Canvas.Brush.Style := bsSolid;
        aBMP.Canvas.Brush.Color := ColortoRGB(HintKind.Color);
        Rectangle(aBMP.Canvas.Handle, aRect.Left, aRect.Top, aRect.Right + 1, aRect.Bottom + 1);
      end;
    end;
  end;
begin
  if not acHintsInEditor then Transparency := 0 else Transparency := HintKind.Transparency;
  aRect := R;
  // Properties definition from skin file
  if HintKind.GradientPercent > 0 then begin
    PrepareGradArray(HintKind.GradientData, GradientArray);
    if Length(GradientArray) = 0 then HintKind.GradientPercent := 0;
  end;

  if ci.Ready and (Transparency = 100) then begin
    if BGBmp <> ci.Bmp then begin
      BitBlt(BGBmp.Canvas.Handle, aRect.Left, aRect.Top, WidthOf(aRect), HeightOf(aRect),
        ci.Bmp.Canvas.Handle, ci.X, ci.Y, SRCCOPY);
    end;
  end
  else if not ci.Ready or (Transparency = 0) then begin
    PaintAddons(BGBmp);
  end
  else if ci.Ready and (Transparency > 0) then begin
    TempBmp := TBitmap.Create;

    try
      TempBmp.Width := WidthOf(aRect);
      TempBmp.Height := HeightOf(aRect);
      TempBmp.PixelFormat := pf24bit;
      OffsetRect(aRect, - aRect.Left, - aRect.Top);
      PaintAddons(TempBmp);
      aRect := R;
      TransColor.A := 0;
      TransColor.R := IntToByte(Transparency shl 8 div 100);
      TransColor.G := TransColor.R;
      TransColor.B := TransColor.R;

      if ci.Bmp <> BGBmp then begin
        BitBlt(BGBmp.Canvas.Handle, aRect.Left, aRect.Top, WidthOf(aRect), HeightOf(aRect),
             ci.Bmp.Canvas.Handle, ci.X, ci.Y, SRCCOPY);
      end;
      SumBmpRect(BGBmp, TempBmp, TransColor, Rect(0, 0, WidthOf(aRect), HeightOf(aRect)), Point(aRect.Left, aRect.Top));

    finally
      FreeAndNil(TempBmp);
    end;
  end;
end;

procedure TsHintManager.SetNewStyle(hs: TsHintStyle);
begin
  if not (csDesigning in ComponentState) then begin
    case hs of
      hsNone : begin
        Manager := nil;
        HintWindowClass := TsSimplyHintWindow;
      end;
      hsStandard : begin
        Manager := nil;
        HintWindowClass := THintWindow;
      end;
      hsSimply : begin
        Manager := Self;
        HintWindowClass := TsSimplyHintWindow;
      end;
      hsComics : begin
        Manager := Self;
        HintWindowClass := TsComicsHintWindow;
      end;
      hsEllipse : begin
        Manager := Self;
        HintWindowClass := TsEllipseHintWindow;
      end;
      hsBalloon : begin
        Manager := Self;
        HintWindowClass := TsBalloonHintWindow;
      end;
    end;
  end;
end;

procedure TsHintManager.SetPredefinitions(const Value: TsHintsPredefinitions);
begin
//  if csLoading in ComponentState then Exit;
  FPredefinitions := Value;
end;

procedure TsHintManager.ShowHint(TheControl: TControl; HintText: String); // Added by Matthew Bieschke
Var
  HL: TPoint; // Hint location
  HintRect: TRect;
begin
  FTempHint := nil;
  // Is control valid ?
  If Assigned(TheControl) Then Begin
    HL.X := 0;
    HL.Y := 0;
  End;
  // Does hint need to be created ?
  If not Assigned(FTempHint) Then Case HintKind.Style of
    hsBalloon: FTempHint := TsBalloonHintWindow.Create(Self);
    hsComics: FTempHint := TsComicsHintWindow.Create(Self);
    hsEllipse: FTempHint := TsEllipseHintWindow.Create(Self);
    hsSimply: FTempHint := TsSimplyHintWindow.Create(Self);
  end;
  // Was hint creation successful ?
  If Assigned(FTempHint) Then With FTempHint Do Begin
    HintRect := CalcHintRect(HintKind.MaxWidth, HintText, NIL);
    HintLocation := TheControl.ClientToScreen(HL);
    HintLocation := Point(HintLocation.x + TheControl.Width div 2, HintLocation.Y + TheControl.Height div 3); 
    ActivateHint(HintRect, HintText);
  End;
end;

procedure TsHintManager.HideHint;
begin
  FreeAndNil(FTempHint);
end;

procedure TsHintManager.UpdateProperties;
begin
  case FPredefinitions of
    shSimply : begin // Simply with shadow
      HintKind.BevelWidth := 1;
      HintKind.MarginH := 4;
      HintKind.MarginV := 2;
      HintKind.MaxWidth := 240;
      HintKind.Color := clInfoBk;
      HintKind.Transparency := 0;
      HintKind.ColorBorderTop := 0;
      HintKind.ColorBorderBottom := 0;
      HintKind.Bevel := 1;
      HintKind.GradientPercent := 0;
      HintKind.GradientData := '';
      HintKind.ShadowBlur := 3;
      HintKind.ShadowOffset := 6;
      HintKind.ShadowTransparency := 40;
      HintKind.ShadowEnabled := True;
      HintKind.Font.Assign(Screen.HintFont);
      HintKind.Font.Style := [];
      HintKind.Font.Color := clBlack;
      HintKind.Style := hsSimply;
    end;
    shGradient : begin // Gradient
      HintKind.BevelWidth := 1;
      HintKind.MarginH := 6;
      HintKind.MarginV := 3;
      HintKind.MaxWidth := 240;
      HintKind.Color := 11992314;
      HintKind.Transparency := 10;
      HintKind.ColorBorderTop := clWhite;
      HintKind.ColorBorderBottom := 32896;
      HintKind.Bevel := 1;
      HintKind.GradientPercent := 100;
      HintKind.GradientData := '167827;6865090;24;2;0;6865090;6865090;24;2;0;6865090;15400959;24;2;0;15400959;6865090;24;2;0;6865090;6865090;0;2;0';
      HintKind.ShadowBlur := 5;
      HintKind.ShadowOffset := 6;
      HintKind.ShadowTransparency := 50;
      HintKind.ShadowEnabled := True;
      HintKind.Font.Assign(Screen.HintFont);
      HintKind.Font.Style := [];
      HintKind.Font.Color := clBlack;
      HintKind.Style := hsSimply;
    end;
    shTransparent : begin // Simply transparent 2
      HintKind.BevelWidth := 0;
      HintKind.MarginH := 13;
      HintKind.MarginV := 5;
      HintKind.MaxWidth := 240;
      HintKind.Color := 11992314;
      HintKind.Transparency := 20;
      HintKind.ColorBorderTop := 16777215;
      HintKind.ColorBorderBottom := clOlive;
      HintKind.Bevel := 1;
      HintKind.GradientPercent := 0;
      HintKind.GradientData := '';
      HintKind.ShadowBlur := 3;
      HintKind.ShadowOffset := 10;
      HintKind.ShadowTransparency := 70;
      HintKind.ShadowEnabled := True;
      HintKind.Font.Assign(Screen.HintFont);
      HintKind.Font.Style := [];
      HintKind.Font.Color := clBlack;
      HintKind.Style := hsSimply;
    end;
    shEllipse : begin // Ellipse transparent
      HintKind.BevelWidth := 1;
      HintKind.ExOffset := 16;
      HintKind.MarginH := 6;
      HintKind.MarginV := 12;
      HintKind.MaxWidth := 240;
      HintKind.Color := 12778748;
      HintKind.Transparency := 5;
      HintKind.ColorBorderTop := 32896;
      HintKind.ColorBorderBottom := clBlack;
      HintKind.Bevel := 1;
      HintKind.GradientPercent := 100;
      HintKind.GradientData := '7728127;16777215;99;0;0;16777215;16777215;0;0;0';
      HintKind.ShadowBlur := 4;
      HintKind.ShadowOffset := 16;
      HintKind.ShadowTransparency := 75;
      HintKind.ShadowEnabled := True;
      HintKind.Font.Assign(Screen.HintFont);
      HintKind.Font.Style := [];
      HintKind.Font.Color := clBlack;
      HintKind.Style := hsEllipse;
    end;
    shBalloon : begin // Baloon
      HintKind.BevelWidth := 6;
      HintKind.ExOffset := 18;
      HintKind.MarginH := 6;
      HintKind.MarginV := 6;
      HintKind.MaxWidth := 240;
      HintKind.Color := 12778748;
      HintKind.Transparency := 10;
      HintKind.ColorBorderTop := 4227200;
      HintKind.ColorBorderBottom := 4227200;
      HintKind.Bevel := 1;
      HintKind.GradientPercent := 0;
      HintKind.GradientData := '';
      HintKind.ShadowBlur := 6;
      HintKind.ShadowOffset := 8;
      HintKind.ShadowTransparency := 70;
      HintKind.ShadowEnabled := True;
      HintKind.Font.Assign(Screen.HintFont);
      HintKind.Font.Style := [];
      HintKind.Font.Color := clBlack;
      HintKind.Style := hsBalloon;
    end;
    shComicsGradient : begin // Comics gradient
      HintKind.BevelWidth := 1;
      HintKind.ExOffset := 24;
      HintKind.MarginH := 15;
      HintKind.MarginV := 7;
      HintKind.MaxWidth := 180;
      HintKind.Radius := 21;
      HintKind.Color := 16757839;
      HintKind.Transparency := 8;
      HintKind.ColorBorderTop := 4194304;
      HintKind.ColorBorderBottom := 4194304;
      HintKind.Bevel := 1;
      HintKind.GradientPercent := 100;
      HintKind.GradientData := '16753188;16777215;99;0;0;16777215;16777215;0;0;0';
      HintKind.ShadowBlur := 10;
      HintKind.ShadowOffset := 7;
      HintKind.ShadowTransparency := 28;
      HintKind.ShadowEnabled := True;
      HintKind.Font.Assign(Screen.HintFont);
      HintKind.Font.Style := [];
      HintKind.Font.Color := clBlack;
      HintKind.Style := hsComics;
    end;
    shComicsTransparent : begin // Comics transparent
      HintKind.BevelWidth := 1;
      HintKind.ExOffset := 19;
      HintKind.MarginH := 15;
      HintKind.MarginV := 8;
      HintKind.MaxWidth := 180;
      HintKind.Radius := 13;
      HintKind.Color := 12778748;
      HintKind.Transparency := 10;
      HintKind.ColorBorderTop := clBlack;
      HintKind.ColorBorderBottom := clBlack;
      HintKind.Bevel := 1;
      HintKind.GradientPercent := 0;
      HintKind.GradientData := '';
      HintKind.ShadowBlur := 4;
      HintKind.ShadowOffset := 7;
      HintKind.ShadowTransparency := 45;
      HintKind.ShadowEnabled := True;
      HintKind.Font.Assign(Screen.HintFont);
      HintKind.Font.Style := [];
      HintKind.Font.Color := clBlack;
      HintKind.Style := hsComics;
    end;
    shStandard : HintKind.Style := hsStandard;
    shNone : HintKind.Style := hsNone;
  end;
end;

procedure TsHintManager.AfterConstruction;
begin
  inherited;
{$IFNDEF ACHINTS}
  if FSkinSection = '' then FSkinSection := s_Hint;
{$ENDIF}
  SetNewStyle(HintKind.Style);
end;

function TsHintManager.GetAnimated: boolean;
begin
  Result := FAnimated;
end;

function TsHintManager.Skinned: boolean;
begin
{$IFNDEF ACHINTS}
  Result := Assigned(Manager) and Assigned(DefaultManager) and UseSkinData;
  if Result then Result := (Manager.SkinSection <> '') and (DefaultManager.GetSkinIndex(Manager.SkinSection) > -1);
{$ELSE}
  Result := False
{$ENDIF}
end;

{$IFNDEF ACHINTS}
procedure TsHintManager.SetSkinData(const Value: boolean);
begin
  FUseSkinData := Value;
  if not Value and not (csDesigning in ComponentState) then begin
    SetNewStyle(HintKind.Style);
    UpdateProperties;
  end;
end;
{$ENDIF}

procedure TsHintManager.SetPauseHide(const Value: integer);
begin
  if FPauseHide <> Value then begin
    FPauseHide := Value;
    Application.HintHidePause := FPauseHide;
  end;
end;

{ TsCustomHintWindow }

procedure TsCustomHintWindow.ActivateHint(Rect: TRect; const AHint: string);
var
  DC: HDC;
  w, h, i : integer;
  t, l : boolean;
  p : TPoint;
  Auto : boolean;

  FBmpSize: TSize;