![]() |
Label mit Alpha-Wert
SirThornberry hat
![]()
Delphi-Quellcode:
Hinweisen zur Verwendung:
unit uAlphaLabel;
interface uses windows, graphics, classes, StdCtrls; type TLabel = class(StdCtrls.TLabel) private fAlphaVal: Byte; procedure FSetAlphaVal(AAlpha: Byte); public constructor Create(AOwner: TComponent); override; procedure Paint; override; published property AlphaVal: Byte read fAlphaVal write FSetAlphaVal default 255; end; implementation constructor TLabel.Create(AOwner: TComponent); begin inherited Create(AOwner); Transparent := True; fAlphaVal := 255; end; procedure TLabel.Paint; type PCanvas = ^TCanvas; var LBitmap: TBitmap; LOldCanvas: TCanvas; LBlendFunc: TBlendFunction; begin if fAlphaVal = 255 then inherited Paint else begin LBitmap := TBitmap.Create; LBitmap.Width := Width; LBitmap.Height := Height; BitBlt(LBitmap.Canvas.Handle, 0, 0, Width, Height, Canvas.Handle, 0, 0, SRCCOPY); LOldCanvas := Canvas; PCanvas(@Canvas)^ := LBitmap.Canvas; inherited Paint; PCanvas(@Canvas)^ := LOldCanvas; LBlendFunc.BlendOp := AC_SRC_OVER; LBlendFunc.BlendFlags := 0; LBlendFunc.SourceConstantAlpha := fAlphaVal; LBlendFunc.AlphaFormat := 0; windows.AlphaBlend(Canvas.Handle, 0, 0, Width, Height, LBitmap.Canvas.Handle, 0, 0, Width, Height, LBlendFunc); LBitmap.Free; end; end; procedure TLabel.FSetAlphaVal(AAlpha: Byte); begin if AAlpha <> fAlphaVal then begin fAlphaVal := AAlpha; Repaint; end; end; end. Zitat:
|
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:09 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz