skinhint.pas

DynamicSkinForm.v9.15.For.Delphi.BCB 很好的皮肤控件

{*******************************************************************}
{                                                                   }
{       Almediadev Visual Component Library                         }
{       DynamicSkinForm                                             }
{       Version 9.15                                                }
{                                                                   }
{       Copyright (c) 2000-2008 Almediadev                          }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{       Home:  http://www.almdev.com                                }
{       Support: [e-mail]                                 }
{                                                                   }
{*******************************************************************}

{$P+,S-,W-,R-}
{$WARNINGS OFF}
{$HINTS OFF}

unit SkinHint;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  SkinData, ExtCtrls, ImgList;

type

  TspSkinHint = class;

  TspSkinHintWindow = class(THintWindow)
  private
    NewClRect: TRect;
    NewLTPoint, NewRTPoint,
    NewLBPoint, NewRBPoint: TPoint;
    FspHint: TspSkinHint;
    DrawBuffer: TBitMap;
    FSD:  TspSkinData;
    SI: TBitMap;
    FRgn: HRGN;
    OldAlphaBlend: Boolean;
    OldAlphaBlendValue: Integer;
    procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
    procedure WMEraseBkGnd(var Msg: TWMEraseBkgnd); message WM_EraseBkgnd;
    function FindHintComponent: TspSkinHint;
    procedure CalcHintSize(Cnvs: TCanvas; S: String; var W, H: Integer);
    procedure CalcHintSizeEx(Cnvs: TCanvas; AHint, AHintTitle: String;
      AImageIndex: Integer; AImageList: TCustomImageList;
      var W, H: Integer);
    procedure CheckText(var S: String);
  protected
    AExtendedStyle: Boolean;
    procedure SetHintWindowRegion;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; override;
    procedure PaintEx;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ActivateHint(Rect: TRect; const AHint: string); override;
    procedure ActivateHintEx(Rect: TRect;
      const AHintTitle, AHint: string; AImageIndex: Integer; AImageList: TCustomImageList);
  end;

  TspSkinHint = class(TComponent)
  private
    FOnShowHint: TShowHintEvent;
    FActive: Boolean;
    FSD: TspSkinData;
    HW: TspSkinHintWindow;
    FAlphaBlendSupport: Boolean;
    FDefaultFont: TFont;
    FUseSkinFont: Boolean;
    HintTimer: TTimer;
    HintText: String;
    FLineSeparator: String;
    procedure SetDefaultFont(Value: TFont);
    procedure SetActive(Value: Boolean);
    procedure SetAlphaBlendSupport(Value: Boolean);
    procedure HintTime1(Sender: TObject);
    procedure HintTimeEx1(Sender: TObject);
    procedure HintTime2(Sender: TObject);
  protected
    FHintTitle: String;
    FHintImageIndex: Integer;
    FHintImageList: TCustomImageList;
    FAlphaBlend: Boolean;
    FAlphaBlendValue: Byte;
    FAlphaBlendAnimation: Boolean;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure SetSkinData(Value: TspSkinData);
    procedure SelfOnShowHint(var HintStr: string;
                             var CanShow: Boolean; var HintInfo: THintInfo);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetCursorHeightMargin: Integer;
    procedure ActivateHint(P: TPoint; const AHint: string);
    procedure ActivateHint2(const AHint: string);

    procedure ActivateHintEx(P: TPoint;
      const AHintTitle, AHint: string;
      AImageIndex: Integer; AImageList: TCustomImageList);

    procedure ActivateHintEx2(const AHintTitle, AHint: string;
     AImageIndex: Integer; AImageList: TCustomImageList);

    procedure HideHint;
    function IsVisible: Boolean; 
  published
    property LineSeparator: String read FLineSeparator write FLineSeparator;
    property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
    property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
    property AlphaBlendSupport: Boolean read FAlphaBlendSupport
                                        write SetAlphaBlendSupport;
    property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
    property AlphaBlendValue: Byte
      read FAlphaBlendValue write FAlphaBlendValue;
    property AlphaBlendAnimation: Boolean
      read FAlphaBlendAnimation write FAlphaBlendAnimation;
    property SkinData: TspSkinData read FSD write SetSkinData;
    property Active: Boolean read FActive write SetActive;
    property OnShowHint: TShowHintEvent read FOnShowHint write FOnShowHint;
  end;

implementation

 Uses spUtils, spEffBmp, SkinCtrls;

const
  CS_DROPSHADOW_ = $20000;

constructor TspSkinHintWindow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SI := TBitMap.Create;
  FRgn := 0;
  OldAlphaBlend := False;
  OldAlphaBlendValue := 0;
end;

destructor TspSkinHintWindow.Destroy;
begin
  SI.Free;
  inherited Destroy;
  if FRgn <> 0 then DeleteObject(FRgn);
end;

procedure TspSkinHintWindow.CheckText(var S: String);
var
  I: Integer;
begin
  while Pos(FspHint.LineSeparator, S) <> 0 do
  begin
    I := Pos(FspHint.LineSeparator, S);
    Delete(S, I, Length(FspHint.LineSeparator));
    Insert(#10, S, I);
    Insert(#13, S, I + 1);
  end;
end;

procedure TspSkinHintWindow.WMNCPaint(var Message: TMessage);
begin
end;

procedure TspSkinHintWindow.SetHintWindowRegion;
var
  TempRgn: HRgn;
  MaskPicture: TBitMap;
begin
  if (FSD <> nil) and (FSD.HintWindow.MaskPictureIndex <> -1)
  then
    begin
      TempRgn := FRgn;
      with FSD.HintWindow do
      begin
        MaskPicture := TBitMap(FSD.FActivePictures[MaskPictureIndex]);
        CreateSkinRegion
          (FRgn, LTPoint, RTPoint, LBPoint, RBPoint, ClRect,
           NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewClRect,
           MaskPicture, Width, Height);
      end;
      SetWindowRgn(Handle, FRgn, False);
      if TempRgn <> 0 then DeleteObject(TempRgn);
    end
  else
    if FRgn <> 0 then
    begin
      SetWindowRgn(Handle, 0, False);
      DeleteObject(FRgn);
      FRgn := 0;
    end;
end;

procedure TspSkinHintWindow.CalcHintSizeEx(Cnvs: TCanvas; AHint, AHintTitle: String;
             AImageIndex: Integer; AImageList: TCustomImageList;
             var W, H: Integer);
var
  R: TRect;
  TH, PW, PH, OX, OY: Integer;
begin
  R := Rect(0, 0, 0, 0);
  DrawText(Cnvs.Handle, PChar(AHint), -1, R, DT_CALCRECT or DT_LEFT);
  W := RectWidth(R);
  H := RectHeight(R);
  TH := 0;
  if AHintTitle <> ''
  then
    begin
      R := Rect(0, 0, 0, 0);
      DrawText(Cnvs.Handle, PChar(AHintTitle), -1, R, DT_CALCRECT or DT_LEFT);
      H := H + RectHeight(R) + 10;
      if RectWidth(R) > W then W := RectWidth(R);
      TH := RectHeight(R);
    end;

  if (AImageList <> nil) and (AImageIndex >= 0) and (AImageIndex < AImageList.Count)
  then
    begin
      W := W + AImageList.Width + 10;
      if AImageList.Height + TH + 5 > H then
        H := AImageList.Height + TH + 5;
    end;

  if FSD <> nil
  then
    begin
      W := W + 10;
      with FSD.HintWindow do
      begin
        PW := TBitMap(FSD.FActivePictures[WindowPictureIndex]).Width;
        PH := TBitMap(FSD.FActivePictures[WindowPictureIndex]).Height;
        W := W + ClRect.Left + (PW - ClRect.Right);
        H := H + ClRect.Top + (PH - ClRect.Bottom);

        OX := W - PW;
        OY := H - PH;

        if RTPoint.X + OX < LTPoint.X
        then
          begin
            W := W + LTPoint.X - (RTPoint.X + OX);
            OX := W - PW;
          end;

        if RBPoint.X + OX < LBPoint.X
        then
          begin
            W := W + LBPoint.X - (RBPoint.X + OX);
            OX := W - PW;
          end;

        if LBPoint.Y + OY < LTPoint.Y
        then
          begin
            H := H + LTPoint.Y - (LBPoint.Y + OY);
            OY := H - PH;
          end;

        if RBPoint.Y + OY < RTPoint.Y
        then
          begin
            H := H + RTPoint.Y - (RBPoint.Y + OY);
            OX := H - PH;
          end;

        NewClRect := ClRect;
        Inc(NewClRect.Right, OX);
        Inc(NewClRect.Bottom, OY);
        NewLTPoint := LTPoint;
        NewRTPoint := Point(RTPoint.X + OX, RTPoint.Y);
        NewLBPoint := Point(LBPoint.X, LBPoint.Y + OY);
        NewRBPoint := Point(RBPoint.X + OX, RBPoint.Y + OY);
      end;
    end
  else
    begin
      Inc(W, 4);
      Inc(H, 4);
    end;
end;

procedure TspSkinHintWindow.CalcHintSize(Cnvs: TCanvas; S: String; var W, H: Integer);
var
  R: TRect;
  PW, PH, OX, OY: Integer;
begin
  R := Rect(0, 0, 0, 0);
  DrawText(Cnvs.Handle, PChar(S), -1, R, DT_CALCRECT or DT_LEFT);
  W := RectWidth(R);
  H := RectHeight(R);
  if FSD <> nil
  then
    begin
      with FSD.HintWindow do
      begin
        PW := TBitMap(FSD.FActivePictures[WindowPictureIndex]).Width;
        PH := TBitMap(FSD.FActivePictures[WindowPictureIndex]).Height;
        W := W + ClRect.Left + (PW - ClRect.Right);
        H := H + ClRect.Top + (PH - ClRect.Bottom);

        W := W + 5;

        OX := W - PW;
        OY := H - PH;

        if RTPoint.X + OX < LTPoint.X
        then
          begin
            W := W + LTPoint.X - (RTPoint.X + OX);
            OX := W - PW;
          end;

        if RBPoint.X + OX < LBPoint.X
        then
          begin
            W := W + LBPoint.X - (RBPoint.X + OX);
            OX := W - PW;
          end;

        if LBPoint.Y + OY < LTPoint.Y
        then
          begin
            H := H + LTPoint.Y - (LBPoint.Y + OY);
            OY := H - PH;
          end;

        if RBPoint.Y + OY < RTPoint.Y
        then
          begin
            H := H + RTPoint.Y - (RBPoint.Y + OY);
            OX := H - PH;
          end;

        NewClRect := ClRect;
        Inc(NewClRect.Right, OX);
        Inc(NewClRect.Bottom, OY);
        NewLTPoint := LTPoint;
        NewRTPoint := Point(RTPoint.X + OX, RTPoint.Y);
        NewLBPoint := Point(LBPoint.X, LBPoint.Y + OY);
        NewRBPoint := Point(RBPoint.X + OX, RBPoint.Y + OY);
      end;
    end
  else
    begin
      Inc(W, 4);
      Inc(H, 4);
    end;
end;


function TspSkinHintWindow.FindHintComponent;
var
  i: Integer;
begin
  Result := nil;
  if (Application.MainForm <> nil) and
     (Application.MainForm.ComponentCount > 0)
  then
    with Application.MainForm do
      for i := 0 to ComponentCount - 1 do
       if (Components[i] is TspSkinHint) and
          (TspSkinHint(Components[i]).Active)
       then
         begin
           Result := TspSkinHint(Components[i]);
           Break;
         end;
end;

procedure TspSkinHintWindow.ActivateHintEx(Rect: TRect;
   const AHintTitle, AHint: string; AImageIndex: Integer;
   AImageList: TCustomImageList);
const
  WS_EX_LAYERED = $80000;
  AnimationStep = 1;
var
  HintWidth, HintHeight: Integer;
  CanSkin: Boolean;
  i: Integer;
  TickCount, ABV: Integer;
  S: String;
begin
  AExtendedStyle := True;
  FspHint := FindHintComponent;
  if FspHint = nil then Exit;
  if not FspHint.Active then Exit;
  CanSkin := ((FspHint.FSD <> nil) and (not FspHInt.FSD.Empty) and
             (FspHint.FSD.HintWindow.WindowPictureIndex <> -1));
  //
  if CanSkin then FSD := FspHint.FSD else FSD := nil;

  if FSD <> nil
  then
    begin
      with Canvas, FSD.HintWindow do
      begin
        if FspHint.UseSkinFont
        then
          begin
            Font.Height := FontHeight;
            Font.Name := FontName;
            Font.Style := FontStyle;
          end
        else
          Font.Assign(FspHint.FDefaultFont);
      end;
    end
  else
    with Canvas do
    begin
      Font.Assign(FspHint.FDefaultFont);