shintmanager.pas

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

  FBmpTopLeft: TPoint;
  StepB, Blend : real;
  StepCount : integer;
  procedure CreateAlphaBmp;
  var
    x, y : integer;
    FastDst : TacFast32;
    FastShadow : TacFast24;
    FastMask : TacFast24;
    FastBody : TacFast24;
    c : TsColor;
  begin
    FBlend.SourceConstantAlpha := Round(255 - 2.55 * Manager.HintKind.Transparency);
    FreeAndNil(AlphaBmp);  { MemoryLeak : ONT }
    AlphaBmp := CreateBmp32(w, h);
    FBmpSize.cx := w;
    FBmpSize.cy := h;
    FBmpTopLeft := Point(0, 0);

    FastDst := TacFast32.Create;
    FastShadow := TacFast24.Create;
    FastMask := TacFast24.Create;
    FastBody := TacFast24.Create;

    PrepareMask;
    FreeAndNil(BodyBmp);  { MemoryLeak : ONT }
    BodyBmp := GetBody;
    FillDC(Manager.FCacheBmp.Canvas.Handle, Classes.Rect(0, 0, w, h), clWhite);
    PaintShadow(Manager.FCacheBmp);

    AlphaBmp.PixelFormat := pf32bit;
    if FastDst.Attach(AlphaBmp) and FastShadow.Attach(Manager.FCacheBmp) and FastMask.Attach(MaskBmp) and FastBody.Attach(BodyBmp) then begin
      for y := 0 to h - 1 do for x := 0 to w - 1 do begin
        if FastMask.Pixels[x, y].R = 255 then begin
          c.I := 0;
          c.A := 255 - FastShadow.Pixels[x, y].R;
        end
        else begin
          c := FastBody.Pixels[x, y];
          c.A := 255
        end;
        FastDst[x, y] := c;
      end;
    end;
    FreeAndnil(FastDst);
    FreeAndnil(FastMask);
    FreeAndnil(FastShadow); // v4.82
    FreeAndnil(FastBody); // v4.82
    if Assigned(BodyBmp) then FreeAndNil(BodyBmp);
  end;
begin
  if not Assigned(Manager) or (Manager.HintKind.Style = hsNone) {or not HandleAllocated }then exit;

  if Manager.Skinned and Layered
    then SetClassLong(Handle, GCL_STYLE, GetClassLong(Handle, GCL_STYLE) or NCS_DROPSHADOW)
    else SetClassLong(Handle, GCL_STYLE, GetClassLong(Handle, GCL_STYLE) and not NCS_DROPSHADOW);

  Caption := AHint;
  if (FHintLocation.X = 0) or (FHintLocation.Y = 0) then p := GetMousePosition else p := FHintLocation;
  w := WidthOf(Rect);
  h := HeightOf(Rect);
  OffsetRect(Rect, p.x - Rect.Left, p.y - Rect.Top);
  UpdateBoundsRect(Rect);
  FMousePos := Manager.FDefaultMousePos;
  t := not (FMousePos in [mpLeftBottom, mpRightBottom]);
  l := not (FMousePos in [mpRightTop, mpRightBottom]);
  if FMousePos in [mpLeftBottom, mpRightBottom] then OffsetRect(Rect, 0, - h);
  if FMousePos in [mpRightTop, mpRightBottom] then OffsetRect(Rect, -w, 0);
  Auto := False; // Calc arrow position
  if Rect.Bottom > Screen.DesktopHeight then begin Rect.Top := p.y - h; t := False; Auto := True end;
  if Rect.Top < Screen.DesktopTop then begin Rect.Top := p.y; t := True; Auto := True end;
  if Rect.Right > Screen.DesktopWidth then begin Rect.Left := p.x - w; l := False; Auto := True end;
  if Rect.Left < Screen.DesktopLeft then begin Rect.Left := p.x; l := True; Auto := True end;
  if Auto then begin if t then begin if l then FMousePos := mpLeftTop else FMousePos := mpRightTop end else if l then FMousePos := mpLeftBottom else FMousePos := mpRightBottom end;
  Rect.Right := Rect.Left + w;
  Rect.Bottom := Rect.Top + h;

  Manager.FCacheBmp.Width := w;
  Manager.FCacheBmp.Height := h;

  if Layered then begin
    SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, w, h, SWP_NOACTIVATE);
    CreateAlphaBmp;
    DC := GetDC(0);
    SetWindowLong(Handle, GWL_EXSTYLE, DWord(GetWindowLong(Handle, GWL_EXSTYLE)) or WS_EX_LAYERED);
    UpdateLayeredWindow(Handle, DC, nil, @FBmpSize, AlphaBmp.Canvas.Handle, @FBmpTopLeft, clNone, @FBlend, ULW_ALPHA);
    // Show window with hint
    if Manager.Animated and IsNTFamily then begin
{$IFNDEF ACHINTS}
      if Manager.Skinned then i := DefaultManager.gd[SkinIndex].Transparency else
{$ENDIF}
      i := Manager.HintKind.Transparency;
      i := Max(0, Min(100, i));
      if not (csDestroying in ComponentState) then begin
        StepCount := max(DefAnimationTime div DelayValue, 1);
        StepB := Round((100 - i) * 2.55) / StepCount;
        Blend := 0;
        FBlend.SourceConstantAlpha := 0;
        UpdateLayeredWindow(Handle, DC, nil, @FBmpSize, AlphaBmp.Canvas.Handle, @FBmpTopLeft, clNone, @FBlend, ULW_ALPHA);
        ShowWindow(Handle, SW_SHOWNOACTIVATE);
        RedrawWindow(Handle, nil, 0, RDW_NOERASE or RDW_UPDATENOW or RDW_ALLCHILDREN);
        for i := 0 to StepCount - 1 do begin
          Blend := Blend + StepB;
          FBlend.SourceConstantAlpha := Round(Blend);
          if not (csDestroying in ComponentState)
            then UpdateLayeredWindow(Handle, DC, nil, @FBmpSize, AlphaBmp.Canvas.Handle, @FBmpTopLeft, clNone, @FBlend, ULW_ALPHA)
            else break;
          Sleep(DelayValue);
        end;
      end;
    end
    else begin
      if IsNTFamily then begin
        FBlend.SourceConstantAlpha := Round((100 - Manager.HintKind.Transparency) * 2.55);
        UpdateLayeredWindow(Handle, DC, nil, @FBmpSize, AlphaBmp.Canvas.Handle, @FBmpTopLeft, clNone, @FBlend, ULW_ALPHA);
        ShowWindow(Handle, SW_SHOWNOACTIVATE);
      end
      else SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, w, h, SWP_SHOWWINDOW or SWP_NOACTIVATE);
    end;
    ReleaseDC(0, DC);
    if AlphaBmp <> nil then FreeAndNil(AlphaBmp);
  end
  else begin
    DC := GetDC(0); // grabbing
    if DC = 0 then begin {$IFNDEF ACHINTS}ShowError('GDI error (out of resources)');{$ENDIF} Exit end;
    if not Assigned(ScreenBmp) then ScreenBmp := CreateBmp24(w, h) else begin ScreenBmp.Width := w; ScreenBmp.Height := h end;
    BitBlt(ScreenBmp.Canvas.Handle, 0, 0, w, h, DC, Rect.Left, Rect.Top, SrcCopy);
    ReleaseDC(0, DC);
    if Assigned(ScreenBmp) then BitBlt(Manager.FCacheBmp.Canvas.Handle, 0, 0, w, h, ScreenBmp.Canvas.Handle, 0, 0, SrcCopy);
    SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, w, h, SWP_SHOWWINDOW or SWP_NOACTIVATE);
  end;
  Manager.FHintPos.x := -1; // v5.27
end;

constructor TsCustomHintWindow.Create(AOwner: TComponent);
begin
  inherited;
  dx := 0;
  dy := 0;
  FHintLocation.X := 0;
  FHintLocation.Y := 0;
  BorderWidth := 0;
  SkinIndex := -1;
  BorderIndex := -1;
  BGIndex := -1;
  with FBlend do begin
    BlendOp := AC_SRC_OVER;
    BlendFlags := 0;
    AlphaFormat := AC_SRC_ALPHA;
  end;
end;

procedure TsCustomHintWindow.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style and not WS_BORDER or WS_EX_TRANSPARENT;
end;

function TsCustomHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect;
var
  sHTML : TsHtml;
begin
  if HintFrame <> nil then begin
    Result := Rect(0, 0, HintFrame.Width, HintFrame.Height);
    Inc(Result.Right, iffi(Manager.HintKind.ShadowEnabled, Manager.HintKind.ShadowOffset, 0));
    Inc(Result.Bottom, iffi(Manager.HintKind.ShadowEnabled, Manager.HintKind.ShadowOffset, 0));
  end
  else if Assigned(Manager) then begin
{$IFNDEF ACHINTS}
    if Manager.Skinned and Assigned(DefaultManager) and DefaultManager.Active then begin
      SkinIndex := DefaultManager.GetSkinIndex(Manager.SkinSection);
      if SkinIndex > -1 then begin
        BorderIndex := DefaultManager.GetMaskIndex(Manager.SkinSection, s_BordersMask);
        BGIndex := DefaultManager.GetTextureIndex(SkinIndex, Manager.SkinSection, s_Pattern);
      end
      else begin
        SkinIndex := DefaultManager.GetSkinIndex(s_Edit);
        BorderIndex := DefaultManager.GetMaskIndex(s_Edit, s_BordersMask);
        BGIndex := DefaultManager.GetTextureIndex(SkinIndex, s_Edit, s_Pattern);
      end;
    end;
{$ENDIF}
    Result := Rect(0, 0, Manager.HintKind.FMaxWidth, 0);
{$IFNDEF ACHINTS}
    if Manager.Skinned then Manager.FCacheBmp.Canvas.Font.Assign(Screen.HintFont) else
{$ENDIF}
    Manager.FCacheBmp.Canvas.Font.Assign(Manager.HintKind.Font);
    if Manager.FHTMLMode then begin
      sHTML := TsHtml.Create;
      sHTML.Init(Manager.FCacheBmp, aHint, Result);
      Result := sHTML.HtmlText;
      FreeAndNil(sHTML);
    end
    else DrawText(Manager.FCacheBmp.Canvas.Handle, PChar(AHint), -1, Result,
      DT_CALCRECT or DT_CENTER or DT_VCENTER or DT_WORDBREAK or DT_NOPREFIX or DrawTextBiDiModeFlagsReadingOnly);
    if ((Manager.HintKind.Style = hsBalloon) or (Manager.HintKind.Style = hsEllipse)) and (WidthOf(Result) < 50) then Result.Right := Result.Left + 50;

    if Manager.Skinned then begin
      Inc(Result.Right, SkinMargin(0) + SkinMargin(2) + SkinBorderWidth * 2);
      Inc(Result.Bottom, SkinMargin(1) + SkinMargin(3) + SkinBorderWidth * 2);
    end
    else begin
      Inc(Result.Right, (Manager.HintKind.MarginH + Manager.HintKind.FBevelWidth) * 2);
      Inc(Result.Bottom, (Manager.HintKind.MarginV + Manager.HintKind.FBevelWidth) * 2);
    end;

    Inc(Result.Right, iffi(Manager.HintKind.ShadowEnabled, Manager.HintKind.ShadowOffset, 0));
    Inc(Result.Bottom, iffi(Manager.HintKind.ShadowEnabled, Manager.HintKind.ShadowOffset, 0));
  end;
end;

procedure TsCustomHintWindow.WMEraseBkGND(var Message: TWMPaint);
begin
  Message.Result := 1;
end;

procedure TsCustomHintWindow.WMNCPaint(var Message: TWMPaint);
begin
  if Assigned(Manager) then PrepareMask;
  Message.Result := 1;
end;

procedure TsCustomHintWindow.Paint;
begin
  if Assigned(Manager) then with Manager do begin
    if HintKind.ShadowEnabled then PaintShadow;
    FreeAndNil(BodyBmp);  { MemoryLeak : ONT }
//    BodyBmp := nil;
    BodyBmp := GetBody;
    try
      if not Assigned(MaskBmp) then PrepareMask;
      if Assigned(MaskBmp) and Assigned(BodyBmp) then SumByMask(FCacheBmp, BodyBmp, MaskBmp, ClientRect);
      BitBlt(Canvas.Handle, 0, 0, FCacheBmp.Width, FCacheBmp.Height, FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
    finally
      if Assigned(MaskBmp) then FreeAndNil(MaskBmp);
      if Assigned(BodyBmp) then FreeAndNil(BodyBmp);
    end;
  end;
end;

procedure TsCustomHintWindow.PaintBG(Bmp: TBitmap; aRect: TRect);
var
  ci : TCacheInfo;
begin
  ci.Bmp := Manager.FCacheBmp; ci.X := 0; ci.Y := 0; ci.Ready := True;
  Manager.PaintBG(Bmp, aRect, ci);
end;

procedure TsCustomHintWindow.TextOut(Bmp: TBitmap);
var
  R : TRect;
  SaveIndex : hdc;
  sHTML : TsHtml;
  TempBmp : TBitmap;
{$IFNDEF ACHINTS}
  Flags: Integer;
{$ENDIF}
begin
  R := MainRect;
  if HintFrame <> nil then begin
    HintFrame.Visible := False;
    HintFrame.Left := R.Left;
    HintFrame.Top := R.Top;
    HintFrame.Parent := Self;
    TempBmp := CreateBmp24(HintFrame.Width, HintFrame.Height);

    if (DefaultManager <> nil) and DefaultManager.Active then begin
      HintFrame.Visible := True;
      SaveIndex := SaveDC(Bmp.Canvas.Handle);
      TempBmp.Canvas.Lock;
//      MoveWindowOrg(Bmp.Canvas.Handle, R.Left, R.Top);
//      IntersectClipRect(Bmp.Canvas.Handle, 0, 0, HintFrame.Width, HintFrame.Height);
      SkinPaintTo(TempBmp, HintFrame);
      TempBmp.Canvas.UnLock;
      RestoreDC(TempBmp.Canvas.Handle, SaveIndex);
    end;

    BitBlt(Bmp.Canvas.Handle, R.Left, R.Top, HintFrame.Width, HintFrame.Height, TempBmp.Canvas.Handle, 0, 0, SRCCOPY);
    FreeAndNil(TempBmp);
    if Assigned(HintFrame) then FreeAndNil(HintFrame);
  end
  else begin
    if Manager.Skinned then begin
      R.Left := R.Left + SkinMargin(0) + SkinBorderWidth;
      R.Top := R.Top + SkinMargin(1) + SkinBorderWidth;
      R.Right := R.Right - SkinMargin(2) - SkinBorderWidth;
      R.Bottom := R.Bottom - SkinMargin(3) - SkinBorderWidth;
    end
    else begin
      InflateRect(R, - Manager.HintKind.MarginH - Manager.HintKind.BevelWidth - dx div 2,
                     - Manager.HintKind.MarginV - Manager.HintKind.BevelWidth - dy div 2);
    end;
    Bmp.Canvas.Brush.Style := bsClear;
    Bmp.Canvas.Pen.Style := psSolid;

  {$IFNDEF ACHINTS}
    if Manager.Skinned then Bmp.Canvas.Font.Assign(Screen.HintFont) else
  {$ENDIF}
    Bmp.Canvas.Font.Assign(Manager.HintKind.Font);
    if Manager.FHTMLMode then begin
  {$IFNDEF ACHINTS}
      if Manager.Skinned then Bmp.Canvas.Font.Color := DefaultManager.gd[SkinIndex].Fontcolor[1];
  {$ENDIF}
      sHTML := TsHtml.Create;
      sHTML.Init(Bmp, Caption, R);
      sHTML.HtmlText;
      FreeAndNil(sHTML);
    end
    else begin
  {$IFNDEF ACHINTS}
      if Manager.Skinned then begin
        Flags := DT_EXPANDTABS or DT_WORDBREAK or DT_CENTER;
        WriteTextEx(BMP.Canvas, PChar(Text), True, R, Flags, SkinIndex, False, DefaultManager);
      end else
  {$ENDIF}
        DrawText(Bmp.Canvas.Handle, PChar(Caption), -1, R, DT_CENTER or DT_NOPREFIX or DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
    end;
  end;
end;

function TsCustomHintWindow.MainRect: TRect;
var
  ShadowOffset : integer;
begin
  ShadowOffset := iffi(Manager.HintKind.ShadowEnabled, Manager.HintKind.ShadowOffset, 0);
  Result.Left  := 0;
  Result.Right := Width - ShadowOffset;
  Result.Top  := 0;
  Result.Bottom := Height - ShadowOffset;
end;

procedure TsCustomHintWindow.PaintBorder(Bmp: TBitmap);
var
  R: TRect;
begin
  if Manager.HintKind.FBevelWidth > 0 then begin
    Bmp.Canvas.Pen.Style := psSolid;
    R := MainRect;
    inc(R.Left);
    inc(R.Top);
  end;
end;

function TsCustomHintWindow.ShadowTransparency: integer;
begin
  if acHintsInEditor then Result := Manager.HintKind.ShadowTransparency else begin
    Result := Manager.HintKind.Transparency * integer(Manager.HintKind.Transparency > 0);
    Result := SumTrans(Result, Manager.HintKind.ShadowTransparency);
  end
end;

procedure TsCustomHintWindow.WndProc(var Message: TMessage);
begin
{$IFDEF LOGGED}
  AddToLog(Message);
{$ENDIF}
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_GETCACHE : GlobalCacheInfo := MakeCacheInfo(BodyBmp);
    AC_CHILDCHANGED : Message.LParam := 1;
  end;
  inherited;
end;

destructor TsCustomHintWindow.Destroy;
begin
  FreeAndNil(ScreenBmp);  { No need to : ONT }
  FreeAndNil(AlphaBmp);   { MemoryLeak : ONT }
  FreeAndNil(MaskBmp);    { MemoryLeak : ONT }
  FreeAndNil(BodyBmp);    { MemoryLeak : ONT }
  inherited;                                        
end;

function TsCustomHintWindow.GetMousePosition: TPoint;
begin
  if Manager.FHintPos.x = -1 then Result := Mouse.CursorPos else Result := Manager.FHintPos;
end;

procedure TsCustomHintWindow.PrepareMask;
begin
  rgn := 0;
  FreeAndNil(MaskBmp);  { MemoryLeak : ONT }
  MaskBmp := GetMask;
{$IFNDEF ACHINTS}
  if Assigned(MaskBmp) and Manager.Skinned then begin // Defining window region by MaskBmp
    GetRgnFromBmp(rgn, MaskBmp, clwhite);
    SetWindowRgn(Handle, rgn, False);
  end
  else SetWindowRgn(Handle, 0, False);
{$ENDIF}
end;