skinhint.pas

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

procedure TspSkinHintWindow.Paint;
var
  R: TRect;
  kf: Double;
  EB1, EB2: TspEffectBmp;
  B: TBitMap;
  W, H, X, Y: Integer;
begin
 if AExtendedStyle
  then
    begin
      PaintEx;
      Exit;
    end;
  //
  if (Width <= 0) or (Height <= 0) then Exit;
  DrawBuffer := TBitMap.Create;
  DrawBuffer.Width := Width;
  DrawBuffer.Height := Height;
  //
  if FSD <> nil
  then
    with DrawBuffer.Canvas, FSD.HintWindow do
    begin
      B := TBitMap(FSD.FActivePictures[WindowPictureIndex]);
      CreateSkinImageBS(LTPoint, RTPoint, LBPoint, RBPoint,
      CLRect, NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint,
      NewClRect, DrawBuffer, B,
      Rect(0, 0, B.Width, B.Height), Width, Height, True,
      FSD.HintWindow.LeftStretch, FSD.HintWindow.TopStretch,
      FSD.HintWindow.RightStretch, FSD.HintWindow.BottomStretch, StretchEffect, StretchType);
    end
  else
    with DrawBuffer.Canvas do
    begin
      Brush.Color := clInfoBk;
      FillRect(ClientRect);
      R := ClientRect;
      Frame3D(DrawBuffer.Canvas, R, clBtnShadow, clBtnShadow, 1);
    end;
  //
  if FSD <> nil
  then
    with DrawBuffer.Canvas, FSD.HintWindow do
    begin
      Brush.Style := bsClear;
      if FspHint.UseSkinFont
      then
        begin
          Font.Height := FontHeight;
          Font.Style := FontStyle;
          Font.Name := FontName;
        end
      else
        Font.Assign(FspHint.FDefaultFont);

      if (FspHint.SkinData <> nil) and (FspHint.SkinData.ResourceStrData <> nil)
      then
        Font.CharSet := FspHint.SkinData.ResourceStrData.CharSet
      else
        Font.CharSet := FspHint.DefaultFont.CharSet;

      Font.Color := FontColor;
      R := Rect(0, 0, 0, 0);
      DrawText(Handle, PChar(Caption), -1, R, DT_CALCRECT or DT_LEFT);
      W := RectWidth(R);
      H := RectHeight(R);
      X := NewClRect.Left + RectWidth(NewClRect) div 2 - W div 2;
      Y := NewClRect.Top + RectHeight(NewClRect) div 2 - H div 2;
      R := Rect(X, Y, X + W, Y + H);
      DrawText(Handle, PChar(Caption), -1, R, DT_LEFT);
    end
  else
    with DrawBuffer.Canvas do
    begin
      Font.Assign(FspHint.FDefaultFont);
      if (FspHint.SkinData <> nil) and (FspHint.SkinData.ResourceStrData <> nil)
      then
        Font.CharSet := FspHint.SkinData.ResourceStrData.CharSet
      else
        Font.CharSet := FspHint.DefaultFont.CharSet;

      Font.Color := clInfoText;
      Brush.Style := bsClear;
      R := Rect(2, 2, Width - 2, Height - 2);
      DrawText(Handle, PChar(Caption), -1, R, DT_LEFT);
    end;
  //
  if FspHint.AlphaBlend and not FspHint.AlphaBlendSupport
  then
    begin
      EB1 := TspEffectBmp.CreateFromhWnd(DrawBuffer.Handle);
      SI.Width := DrawBuffer.Width;
      EB2 := TspEffectBmp.CreateFromhWnd(SI.Handle);
      kf := 1 - FspHint.AlphaBlendValue / 255;
      EB1.Morph(EB2, kf);
      EB1.Draw(DrawBuffer.Canvas.Handle, 0, 0);
      EB1.Free;
      EB2.Free;
    end;
  //
  Canvas.Draw(0, 0, DrawBuffer);
  DrawBuffer.Free;
end;

procedure TspSkinHintWindow.WMEraseBkGnd(var Msg: TWMEraseBkgnd);
begin
  Msg.Result := 1;
end;

constructor TspSkinHint.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLineSeparator := '@';
  HintTimer := nil;
  FDefaultFont := TFont.Create;
  FUseSkinFont := True;
  FAlphaBlend := False;
  FAlphaBlendValue := 200;
  FAlphaBlendSupport := True;
  FSD := nil;
  FActive := True;
  HW := TspSkinHintWindow.Create(Self);
  HW.Visible := False;
  if not (csDesigning in ComponentState)
  then
    begin
      HintWindowClass := TspSkinHintWindow;
      with Application do begin
        ShowHint := not ShowHint;
        ShowHint := not ShowHint;
        OnShowHint := SelfOnShowHint;
        Application.HintShortPause := 100;
      end;
    end;
end;

destructor TspSkinHint.Destroy;
begin
  HW.Free;
  FDefaultFont.Free;
  if HintTimer <> nil then HintTimer.Free;
  inherited Destroy;
end;

function TspSkinHint.IsVisible: Boolean;
begin
  Result := (HW <> nil) and HW.Visible;
end;

function TspSkinHint.GetCursorHeightMargin: Integer;
  var
    IconInfo: TIconInfo;
    BitmapInfoSize, BitmapBitsSize, ImageSize: DWORD;
    Bitmap: PBitmapInfoHeader;
    Bits: Pointer;
    BytesPerScanline: Integer;

      function FindScanline(Source: Pointer; MaxLen: Cardinal;
        Value: Cardinal): Cardinal; assembler;
      asm
              PUSH    ECX
              MOV     ECX,EDX
              MOV     EDX,EDI
              MOV     EDI,EAX
              POP     EAX
              REPE    SCASB
              MOV     EAX,ECX
              MOV     EDI,EDX
      end;

  begin
    { Default value is entire icon height }
    Result := GetSystemMetrics(SM_CYCURSOR);
    if GetIconInfo(GetCursor, IconInfo) then
    try
      GetDIBSizes(IconInfo.hbmMask, BitmapInfoSize, BitmapBitsSize);
      Bitmap := AllocMem(DWORD(BitmapInfoSize) + BitmapBitsSize);
      try
      Bits := Pointer(DWORD(Bitmap) + BitmapInfoSize);
      if GetDIB(IconInfo.hbmMask, 0, Bitmap^, Bits^) and
        (Bitmap^.biBitCount = 1) then
      begin
        { Point Bits to the end of this bottom-up bitmap }
        with Bitmap^ do
        begin
          BytesPerScanline := ((biWidth * biBitCount + 31) and not 31) div 8;
          ImageSize := biWidth * BytesPerScanline;
          Bits := Pointer(DWORD(Bits) + BitmapBitsSize - ImageSize);
          { Use the width to determine the height since another mask bitmap
            may immediately follow }
          Result := FindScanline(Bits, ImageSize, $FF);
          { In case the and mask is blank, look for an empty scanline in the
            xor mask. }
          if (Result = 0) and (biHeight >= 2 * biWidth) then
            Result := FindScanline(Pointer(DWORD(Bits) - ImageSize),
            ImageSize, $00);
          Result := Result div BytesPerScanline;
        end;
        Dec(Result, IconInfo.yHotSpot);
      end;
      finally
        FreeMem(Bitmap, BitmapInfoSize + BitmapBitsSize);
      end;
    finally
      if IconInfo.hbmColor <> 0 then DeleteObject(IconInfo.hbmColor);
      if IconInfo.hbmMask <> 0 then DeleteObject(IconInfo.hbmMask);
    end;
end;

procedure TspSkinHint.SetDefaultFont(Value: TFont);
begin
  FDefaultFont.Assign(Value);
end;

procedure TspSkinHint.SetAlphaBlendSupport(Value: Boolean);
begin
  if Value
  then
    begin
      if not CheckW2KWXP and not (csDesigning in ComponentState)
      then
        Value := False;
    end;
  FAlphaBlendSupport := Value;
end;

procedure TspSkinHint.SetSkinData;
begin
  FSD := Value;
end;

procedure TspSkinHint.Notification;
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;

procedure TspSkinHint.SetActive(Value: Boolean);
var
  i: Integer;
begin
  FActive := Value;
  if FActive and (Application.MainForm <> nil)
  then
    with Application.MainForm do
      for i := 0 to ComponentCount-1 do
        if (Components[i] is TspSkinHint) and (Components[i] <> Self)
        then
          if TspSkinHint(Components[i]).Active
          then TspSkinHint(Components[i]).Active := False;

  if not (csDesigning in ComponentState) and FActive
  then Application.OnShowHint := SelfOnShowHint;
end;

procedure TspSkinHint.SelfOnShowHint(var HintStr: string;
                                 var CanShow: Boolean; var HintInfo: THintInfo);
begin
  FHintTitle := '';
  FHintImageIndex := 0;
  FHintImageList := nil;
  if HintInfo.HintControl is TspSkinControl
  then
    with TspSkinControl(HintInfo.HintControl) do
    begin
      Self.FHintTitle := HintTitle;
      Self.FHintImageIndex := HintImageIndex;
      Self.FHintImageList := HintImageList;
    end
  else                                                      
  if HintInfo.HintControl is TspGraphicSkinControl
  then
    with TspGraphicSkinControl(HintInfo.HintControl) do
    begin
      Self.FHintTitle := HintTitle;
      Self.FHintImageIndex := HintImageIndex;
      Self.FHintImageList := HintImageList;
    end;
  if Assigned(FOnShowHint) then FOnShowHint(HintStr, CanShow, HintInfo);
end;

procedure TspSkinHint.HintTime1(Sender: TObject);
var
  R: TRect;
  P: TPoint;
begin
  if HintTimer = nil then Exit;
  GetCursorPos(P);
  P.Y := P.Y + GetCursorHeightMargin;
  R := Rect(P.X, P.Y, P.X, P.Y);
  HW.ActivateHint(R, HintText);
  HW.Visible := True;
  HintTimer.Enabled := False;
  HintTimer.Interval := Application.HintHidePause;
  HintTimer.OnTimer := HintTime2;
  HintTimer.Enabled := True;
end;

procedure TspSkinHint.HintTimeEx1(Sender: TObject);
var
  R: TRect;
  P: TPoint;
begin
  if HintTimer = nil then Exit;
  GetCursorPos(P);
  P.Y := P.Y + GetCursorHeightMargin;
  R := Rect(P.X, P.Y, P.X, P.Y);
  HW.ActivateHintEx(R, FHintTitle, HintText, FHintImageIndex, FHintImageList);
  HW.Visible := True;
  HintTimer.Enabled := False;
  HintTimer.Interval := Application.HintHidePause;
  HintTimer.OnTimer := HintTime2;
  HintTimer.Enabled := True;
end;


procedure TspSkinHint.HintTime2(Sender: TObject);
begin
  HideHint;
end;

procedure TspSkinHint.ActivateHintEx(P: TPoint;
      const AHintTitle, AHint: string;
      AImageIndex: Integer; AImageList: TCustomImageList);
var
  R: TRect;
begin
  R := Rect(P.X, P.Y, P.X, P.Y);
  HW.ActivateHintEx(R, AHintTitle, AHint, AImageIndex, AImageList);
  HW.Visible := True;
end;

procedure TspSkinHint.ActivateHintEx2(const AHintTitle, AHint: string;
   AImageIndex: Integer; AImageList: TCustomImageList);
begin
  if HintTimer <> nil
  then
    begin
      HintTimer.Enabled := False;
      HintTimer.Free;
      HintTimer := nil;
    end;

  FHintTitle := AHintTitle;
  FHintImageIndex := AImageIndex;
  FHintImageList := AImageList;
  HintText := AHint;
  HintTimer := TTimer.Create(Self);
  HintTimer.Enabled := False;
  HintTimer.Interval := Application.HintPause;
  HintTimer.OnTimer := HintTimeEx1;
  HintTimer.Enabled := True;
end;

procedure TspSkinHint.ActivateHint2(const AHint: string);
begin
  if HintTimer <> nil
  then
    begin
      HintTimer.Enabled := False;
      HintTimer.Free;
      HintTimer := nil;
    end;
  HintText := AHint;
  Self.FHintTitle := '';
  Self.FHintImageList := nil;
  Self.FHintImageIndex := 0;
  HintTimer := TTimer.Create(Self);
  HintTimer.Enabled := False;
  HintTimer.Interval := Application.HintPause;
  HintTimer.OnTimer := HintTime1;
  HintTimer.Enabled := True;
end;

procedure TspSkinHint.ActivateHint(P: TPoint; const AHint: string);
var
  R: TRect;
begin
  Self.FHintTitle := '';
  Self.FHintImageList := nil;
  Self.FHintImageIndex := 0;
  R := Rect(P.X, P.Y, P.X, P.Y);
  HW.ActivateHint(R, AHint);
  HW.Visible := True;
end;

procedure TspSkinHint.HideHint;
begin
  if HintTimer <> nil
  then
    begin
      HintTimer.Enabled := False;
      HintTimer.Free;
      HintTimer := nil;
    end;
  if HW.Visible
  then
    begin
      HW.Visible := False;
      SetWindowPos(HW.Handle, HWND_TOPMOST, 0, 0, 0,
        0, SWP_HideWINDOW or SWP_NOACTIVATE or SWP_NOSIZE);
      Self.FHintTitle := '';
      Self.FHintImageList := nil;
      Self.FHintImageIndex := 0;
    end;    
end;

end.