Autor Beitrag
bluescreen25
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 27

WIN 2000, WIN XP
Delphi 7
BeitragVerfasst: So 15.10.06 14:19 
Hallo, ich habe hier im Forum www.delphi-forum.de/...ht=trackbar+++eigene

einen Vorschlag für eine Bitmap fähige abgeleitete Trackbar gesehen, bekomme diese ab nicht am laufen.

Hier mein Versuch bislang:
ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
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),
                         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.


Hier die Fehlermeldung : Inkompatible Typen : HDC und QPainterH
ausblenden Delphi-Quelltext
1:
2:
TransparentBlt(aCanvas.Handle, aRect.Left, aRect.Top,(aRect.Right - aRect.Left),
                         (aRect.Bottom - aRect.Top),


Vielleicht hat einer Erbarmen und schaut mal darüber.
Zum Vergleich den Thread oben schaunen.

Grüße bluescreen25

_________________
...und ich dachte Delphi wäre ein Programmgenerator mit nur einem Button...