unit ImgTrb;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ComCtrls, StdCtrls, QGraphics;
type
TTBItem = (tbThumb, tbChannel, tbTicks);
TTrackBar2 =
class(TTrackBar)
private
fBackBmp : TBitmap;
fSliderBmp : TBitmap;
fTransparentColor : TColor;
procedure CNNotify(
var Message: TWMNotify);
message CN_NOTIFY;
function DrawItem(aCanvas: TCanvas;aRect: TRect; aItem: TTBItem): Boolean;
protected
{..}
public
{..}
published
{..}
end;
implementation
function TTrackBar2.DrawItem(aCanvas: TCanvas;aRect: TRect; aItem: TTBItem): Boolean;
begin
result := false;
case aItem
of
tbChannel:
begin
if (
not fBackBmp.Empty)
and (fBackBmp.Width > 0)
and(fBackBmp.Height > 0)
then begin
TransparentBlt(aCanvas.Handle, aRect.Left, aRect.Top,(aRect.Right - aRect.Left),
(aRect.Bottom - aRect.Top),
//<---- Fehlermeldung Inkompatible Typen !
fBackBmp.Canvas.Handle, 0, 0, fBackBmp.Width, fBackBmp.Height,
fTransparentColor);
result := true;
end;
end;
tbThumb:
begin
if (
not fSliderBmp.Empty)
and (fSliderBmp.Width > 0)
and(fSliderBmp.Height > 0)
then begin
TransparentBlt(aCanvas.Handle, aRect.Left, aRect.Top,(aRect.Right - aRect.Left),
(aRect.Bottom - aRect.Top),
fSliderBmp.Canvas.Handle, 0, 0, fSliderBmp.Width, fSliderBmp.Height,
fTransparentColor);
result := true;
end;
end;
end;
end;
procedure TTrackBar2.CNNotify(
var Message: TWMNotify);
var
lRect : TRect;
lCanvas : TCanvas;
lIsDrawn : Boolean;
begin
if (
Message.NMHdr^.code = NM_CUSTOMDRAW)
then begin
with PNMCustomDraw(
Message.NMHdr)^
do begin
(* Default-Result für Standard-Zeichnen setzen *)
Message.Result := CDRF_DODEFAULT;
case dwDrawStage
of
CDDS_PREPAINT:
begin
(* wichtig !, damit künftig ItemDraw-Messages gesendet werden *)
Message.Result := CDRF_NOTIFYITEMDRAW
or CDRF_NOTIFYPOSTPAINT;
end;
CDDS_ITEMPREPAINT:
begin
lCanvas := TCanvas.Create;
lCanvas.Handle := hdc;
lRect := rc;
try
try
lIsDrawn := false;
case dwItemSpec
of
(* Trackbar-Teile selbst zeichnen *)
TBCD_THUMB : lIsDrawn := DrawItem(lCanvas, lRect, tbThumb);
TBCD_TICS : lIsDrawn := DrawItem(lCanvas, lRect, tbTicks);
TBCD_CHANNEL : lIsDrawn := DrawItem(lCanvas, lRect, tbChannel);
end;
(* verhindern, dass Standard gezeichnet wird *)
if lIsDrawn
then Message.Result := CDRF_SKIPDEFAULT;
(* sicher ist sicher, dass der Teil dargestellt wird, falls ein
Fehler aufgetreten ist *)
except
Message.Result := CDRF_DODEFAULT;
end;
finally
lCanvas.Handle := 0;
lCanvas.Free;
end;
end;
end;
end;
end else inherited;
end;
end.