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:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:

unit democtrl;
//
// purpose: How to write a simple KOL control part 1
//  author: © 2004, Thaddy de Koning
// Remarks: This a simple trackbar like control for audio
//          It is derived from a simple panel, but could have been derived
//          from a paintbox too. The panel has some extra possibilities, like
//          borders and some extra built in message processing that is helpfull.
//          We employ a simple technique that has two drawing routines.
//          One draws a background on a bitmap that stays buffered.
//          One draws the ticker or indicator and uses simple xor painting
//          The colors of the tracker are stored in the color, color1 and color2
//          properties of the panel. The tracker position is returned in the
//          panel's tag.
//          All other information needed is stored in a data object that is
//          attached to the panel's CustomObj property.
//          The Min and Max values are set at creation time in the constructor
//          function.
//          All tracker specific messahges will be handled in a special wndproc
//          that we attach to the panel.
//          What we have is a clean KOL control.

interface
uses
  windows, messages, kol;

type
  PTrackerData = ^TTrackerData;
  TTrackerData = object(TOBj)
  private
    FMaxValue:integer;  //FMinValue assumed 0 by design. this is a demo after all.
    FXpos:Integer;
    Fowner:Pcontrol;    // to reference ourselves if needed.
    FBkGnd:PBitmap;     // bitmap to draw the background on. Note you can also load
                        // this with a physical bitmap from file or resource.
    procedure PaintBackGround; // Draws the bitmap. Must be redrawn after resize
                               // but you have to do this yourself :-) easy enough!
    procedure PaintTracker(sender:PControl;DC:HDC);
  protected
    procedure SetXPos(value: integer);
    destructor Destroy;virtual;
  public
    property Pos: Integer read FXPos write SetXPos;
  end;

  // constructor;
  function NewTracker(aOwner:PControl;EdgeStyle:TEdgeStyle;ThumbColor,FieldColor:Tcolor;t,l,h,w,startpos:integer;MaxValue:integer = 100):PControl;

implementation
  var vorschub: byte = 0;
  // handles mousemove. Could also handle paint here and resize (for the bitmap).
  function WndProcTracker( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
  begin
    Result:=false;             // default
    case msg.message of
    WM_SIZE:
        begin
          PTrackerdata(sender.CustomObj).FBkGnd.Width:=sender.Clientwidth;
          PTrackerdata(sender.CustomObj).FBkGnd.Height:=sender.ClientHeight;
          PTrackerdata(sender.CustomObj).PaintBackground;
          sender.Invalidate;
        end;
    WM_MOUSEMOVE:
         // If the left mousebutton is down
         if Boolean (msg.wparam and MK_LBUTTON) then //and
         // Allow a margin to grab the "thumb"
//         (Abs(Loword(Msg.lparam) - PTrackerdata(sender.CustomObj).FXPos) < vorschub) then
         begin
           PTrackerdata(sender.CustomObj).FXpos:=Min(Max(LOWORD(msg.lParam),vorschub),sender.Clientwidth-vorschub);
           sender.Invalidate;
           if Assigned(sender.OnChange) then
             sender.OnChange(sender);
           result:=true;
         end;
    WM_LBUTTONDOWN:
         // If the left mousebutton is down
         if Boolean (msg.wparam and MK_LBUTTON) //and
         // Allow a margin to grab the "thumb"
//         (Abs(Loword(Msg.lparam) - PTrackerdata(sender.CustomObj).FXPos) < 5) then
         then
         begin
           PTrackerdata(sender.CustomObj).FXpos:=Min(Max(LOWORD(msg.lParam),vorschub),sender.Clientwidth-vorschub);
           sender.Invalidate;
           if Assigned(sender.OnChange) then
             sender.OnChange(sender);
           result:=true;
         end;
    else
      Result:=False;
    end;
  end;

  function NewTracker(aOwner:PControl;EdgeStyle:TEdgeStyle;ThumbColor,FieldColor:Tcolor;t,l,h,w,startpos:integer;MaxValue:integer = 100):PControl;
  var
    data:PTrackerData;
    srcRect: TRect;
  begin
    Result:=NewPanel(aOwner,EdgeStyle).setsize(100,20);
    New(Data,Create);
    Result.CustomObj:=Data;            // create the trackerdata object
    Data.Fowner:=Result;
    Result.Color1:=ThumbColor;         // whatever, it's an example
    Result.Color2:=FieldColor;         // idem, but we need to set them
                                       // otherwise they're both black.
    Data.FMaxValue:=MaxValue;          // maximum value, min is assumed to be 0;
//    Data.FBkGnd:=NewBitmap(Result.clientwidth,Result.clientHeight);
    Data.FBkGnd:=NewBitmap(w,h);
    result.height := h;
    result.Width := w;
    result.Top := t;
    result.left := l;

// copy background from Owner's canvas, requires Owner 2 b painted b4 creation
// of Trackbar
// otherwise use provided background bmp:
//  Data.FBkGnd.Assign (BackBMP);

    srcRect.left := l;
    srcRect.top := t;
    srcRect.Right := l+w;
    srcRect.Bottom := t+h;
//    srcRect := rect(l,t,l+w,t+h); doesnt work o_0
    Data.FbkGnd.canvas.CopyRect(Data.FbkGnd.BoundsRect,aOwner.Canvas, srcRect);
// draw horizontal line
    Data.FbkGnd.canvas.Pen.Penwidth:=1;
    Data.FbkGnd.canvas.Pen.color:=FieldColor;
    Data.FbkGnd.canvas.moveto(0,(h div 2));
    Data.FbkGnd.canvas.LineTo(w,(h div 2));


//    Data.FXpos:=data.Fowner.clientwidth div 2;
    Data.FXpos:=(startpos * 10) div (MaxValue * 10 div w);
//    Data.PaintBackGround;
    Result.tag:=0;        // set tag to minimum.
    Result.AttachProc(WndprocTracker);
    Result.OnPaint:=data.PaintTracker;
  end;
{ TTrackerData }

procedure TTrackerdata.SetXPos(Value: integer);
begin
   FXPos := Value;
end;

destructor TTrackerData.Destroy;
begin
  if Assigned(FOwner) and FOwner.IsprocAttached(WndProcTracker) then
  Fowner.DetachProc(WndProcTracker);
  FBkGnd.Free;
  inherited;
end;

procedure TTrackerData.PaintBackGround;
begin
  // something very simple
  if assigned(FBkGnd) then
  begin
//    FBkGnd.LoadFromFile ('trackback2.bmp');
{    FBkGnd.Canvas.Brush.Color:=FOwner.Color;
    FBkGnd.canvas.fillrect(FBkGnd.Boundsrect);
    FBkGnd.canvas.Pen.Color:=Fowner.Color2;
    FBkGnd.Canvas.RoundRect(3,3,FBkGnd.width-3,FBkGnd.Height-3,3,3); }
  end;
end;

procedure TTrackerData.PaintTracker(sender: PControl; DC: HDC);
var
  T:integer;
begin
  FBkGnd.Draw(dc,0,0);            // Draws the background
  with PTrackerdata(sender.CustomObj)^ do
  begin
//    if (sender.tag <> 0) and (sender.tag <= sender.clientwidth) then
//      FXPos := Sender.Tag;
    sender.canvas.Pen.Penwidth:=3;
    sender.canvas.Pen.color:=Fowner.color1;
    sender.canvas.moveto(FXpos,3);
    sender.canvas.LineTo(FXPos,sender.Clientheight-3);
    // Now calculate the actual value.
    // Scale first. we have a margin of 5 pixels on both sides,
    // see how FXpos is calculated. Subtract this from the clientwidth
    // to obtain the relative maximum value then scale it to FMaxValue
    // and store it in the tag.
    T:=(FXpos - vorschub) * FMaxValue div (sender.clientwidth - vorschub * 2);
    sender.tag:=T;

  end;
end;

end.