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:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:

unit MMKnopf;

interface
uses  Windows, Controls, Classes, Types, Variants, Math, Graphics, mmUtils,
      Dialogs, SysUtils, ExtCtrls, GraphUtil;

type
  TonChange = procedure (Sender: TObject; Value: Integer) of Object;
  TonMessage = procedure (Sender: TObject; msg: String) of Object;

  TDrehKnopf = class(TGraphicControl)
    private
      pWert,pWinkel: Integer;
      pTickerInt:Integer;
      pMin,pMax,pRand,pRadius: Integer;
      pTurn: Boolean;
      pTicker: Boolean;
      pMinW, pMaxW: Integer;
      pBorder: Boolean;
      pColor, pBack: TColor;

      FonChange : TonChange;
      FonMessage : TonMessage;

      procedure setBool(Index: Integer; val: Boolean);
      procedure setColor(Index: Integer; val:TColor);
      procedure setInts(Index,val:Integer);

      function Wert2Winkel(val:Integer):Single;
      function Winkel2Wert(val:Single):Integer;
      function Blend(const Factor: Double; const Color1, Color2: TColor): TColor;
    protected
      procedure Paint();override;
      procedure Resize();override;

      procedure MouseDown(Button: TMouseButton ;Shift : TShiftState;X,Y : Integer);override;
      procedure MouseUp(Button: TMouseButton ;Shift : TShiftState;X,Y : Integer);override;
      procedure MouseMove(Shift : TShiftState;X,Y : Integer);override;
    public
      constructor Create(AOwner: TComponent);override;
      destructor Destroy();override;
    published
      property Min:Integer Index 0 read pMin write setInts;
      property Max:Integer Index 1 read pMax write setInts;
      property Value:Integer Index 2 read pWert write setInts;
      property MinWinkel: Integer Index 3 read pMinW write setInts;
      property MaxWinkel: Integer Index 4 read pMaxW write setInts;
      property ShowTicker: Boolean Index 1 read pTicker write setBool;
      property TickerInt:Integer Index 7 read pTickerInt write setInts;
      property Border:Boolean Index 0 read pBorder write setBool;
      property BackColor:TColor Index 0 read pBack write setColor;
      property Color:TColor Index 1 read pColor write setColor;
      property RandBreite:Integer Index 5 read pRand write setInts;
      property Radius:Integer Index 6 read pRadius write setInts;

      property onChange:TonChange read FonChange write FonChange;
      property onMessage:TonMessage read FonMessage write FonMessage;
      property onClick;
      property onDblClick;
  end;

const
  HalfPi = 1.57079632679489661923;

procedure register;

implementation
{$R MMKnopf.res}

Constructor TDrehKnopf.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Color := clBlue;
  pMin := 0;
  pMax := 100;
  pMinW := 20;
  pMaxW := 340;
  pWert := 0;
  pWinkel := Floor(Wert2Winkel(pWert));
  pTurn := False;
  pTicker := True;
  pTickerInt := 10;
  pBorder := True;
  pBack := clBtnFace;
  pColor := clBlack;
  pRadius := 100;
  pRand := 10;
end;

Destructor TDrehKnopf.Destroy;
begin
  inherited Destroy;
end;

function TDrehKnopf.Blend(const Factor: Double; const Color1, Color2: TColor): TColor;
var
  Factor2: Double;
begin
  // Farbe für Farbverlauf ermitteln
  Factor2 := 1.0 - Factor;
  with TRGBQuad(Result) do
  begin
    rgbBlue := Trunc(Factor * TRGBQuad(Color1).rgbBlue + Factor2 * TRGBQuad(Color2).rgbBlue);
    rgbGreen := Trunc(Factor * TRGBQuad(Color1).rgbGreen + Factor2 * TRGBQuad(Color2).rgbGreen);
    rgbRed := Trunc(Factor * TRGBQuad(Color1).rgbRed + Factor2 * TRGBQuad(Color2).rgbRed);
    rgbReserved := 0;
  end;
end;

procedure TDrehKnopf.Paint;
var
  ra,px,py,mp,r1,r2,v,u,i,Size: Integer;
  p1,p2: TPoint;
  w: Single;
  c1,c2,c3: TColor;
begin
  with Self.Canvas do begin
    Pen.Style := psClear;
    Pen.Width := 1;
    if pBorder then
      pen.Style := psSolid;
    Pen.Color := pColor;
    Brush.Color := pBack;
    Brush.Style := bsClear;

    // Rahmen zeichnen
    mp := Floor(pRadius * 10 / 8);
    //Rectangle(0,0,Width,Height);

    Pen.Style := psSolid;
    Pen.Color := clBlack;
    c1 := ColorAdjustLuma(pBack,50,False);
    c2 := ColorAdjustLuma(pBack,-50,False);

    // Kreise zeichnen

    // äußerer Kreis mit Farbverlauf
    Brush.Color := c1;
    Brush.Style := bsclear;
    r1 := mp - pRadius;
    r2 := mp + pRadius;
    Size := r2 - r1 + 1;

    Brush.Style := bsSolid;
    Pen.Style := psClear;
    for i := 0 to Size do
    begin
      c3 := Blend(Cos(I * HalfPi / Size), c1, pBack);
      Brush.Color := c3;
      Pie(r1, r1, r2, r2, r1 + i + 1,r1,r1 + i - 1,r1);
      Pie(r1, r1, r2, r2, r1, r1 + i - 1, r1, r1 + i + 1);
    end;

    for i := 0 to Size do
    begin
      c3 := Blend(Cos(I * HalfPi / Size), pBack, c2);
      Brush.Color := c3;
      Pie(r1, r1, r2, r2, r2,r1 + i + 1,r2,r1 + i - 1);
      Pie(r1, r1, r2, r2, r1 + i - 1, r2, r1 + i + 1, r2);
    end;

    Pen.Style := psSolid;
    Brush.Style := bsClear;
    Ellipse(r1,r1,r2,r2);

    // innerer Kreis
    r1 := mp - pRadius + pRand;
    r2 := mp + pRadius - pRand;
    Brush.Color := pBack;
    Brush.Style := bsSolid;
    Pen.Style := psClear;
    Ellipse(r1,r1,r2,r2);

    // Anzeiger zeichnen
    Pen.Style := psSolid;
    w := pWinkel;
    w := DegToRad(w);
    u := Floor(pRadius/4);
    px := mp - Floor(sin(w) * (pRadius - pRand));
    py := mp + Floor(cos(w) * (pRadius - pRand));
    MoveTo(px,py);
    px := mp - Floor(sin(w) * (pRadius - pRand - u));
    py := mp + Floor(cos(w) * (pRadius - pRand - u));
    LineTo(px,py);

    // Ticker zeichnen
    if pTicker then begin
      v := pMin;
      repeat
        w := Wert2Winkel(v);
        w := DegToRad(w);
        if (v = pMin) OR ((v mod 50) = 0) then
          Pen.Width := 2
        else
          Pen.Width := 1;
        ra := mp;
        px := mp - Floor(sin(w) * pRadius);
        py := mp + Floor(cos(w) * pRadius);
        MoveTo(px,py);
        ra := Floor(mp/10*8);
        px := mp - Floor(sin(w) * mp);
        py := mp + Floor(cos(w) * mp);
        LineTo(px,py);

        v := v + pTickerInt;
      until (v > pMax);
      v := v - pTickerInt;
      w := Wert2Winkel(v);
      w := DegToRad(w);
      Pen.Width := 2;
      ra := mp;
      px := mp - Floor(sin(w) * pRadius);
      py := mp + Floor(cos(w) * pRadius);
      MoveTo(px,py);
      ra := Floor(mp/10*8);
      px := mp - Floor(sin(w) * mp);
      py := mp + Floor(cos(w) * mp);
      LineTo(px,py);
    end;
  end;
end;

procedure TDrehKnopf.Resize;
begin
  // Im Designmodus automatisch an Größe anpassen
  if csDesigning in Self.ComponentState then begin
    if Width > Height then
      pRadius := Floor(Height / 20 * 8)
    else
      pRadius := Floor(Width / 20 * 8);
  end;
  inherited;
end;

procedure TDrehKnopf.setInts(Index: Integer; val: Integer);
begin
  // Setze verschiedene Integer-Werte
  case index of
    0:  // Min
      begin
        pMin := val;
      end;
    1:  // Max
      begin
        pMax := val;
      end;
    2:  // Value
      begin
        if (val >= pMin) and (val <= pMax) then begin
          pWert := val;
          pWinkel := Floor(Wert2Winkel(val));
        end;
      end;
    3:  // Min-Winkel
      begin
        pMinW := val;
      end;
    4:  // Max-Winkel
      begin
        pMaxW := val;
      end;
    5:  // Randbreite
      begin
        if (val > -1) AND ( val < pRadius) then begin
          pRand := val;
        end;
      end;
    6:  // Radius
      begin
        if (val > 0) then begin
          pRadius := val;
        end;
      end;
    7:  // Ticker-Interval
      begin
        if val > 0 then
          pTickerInt := val;
      end;
  end;
  Repaint;
end;

procedure TDrehKnopf.setColor(Index: Integer; val: TColor);
begin
  // Setze verschiedene Farb-Werte
  case Index of
    0:  // Hintergrund
      begin
        pBack := val;
      end;
    1:  // Stift
      begin
        pColor := val;
      end;
  end;
  Repaint;
end;

procedure TDrehKnopf.setBool(Index: Integer; val: Boolean);
begin
  // Setze verschiedene Boolean-Werte
  case Index of
    0:  // Rahmen anzeigen
      begin
        pBorder := val;
      end;
    1:  // Ticker anzeigen
      begin
        pTicker := val;
      end;
  end;
  Repaint;
end;

procedure TDrehKnopf.MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
var
  mp,v,w: Integer;
  p1,p2: TPoint;
begin
  pTurn := True;
  // Drehung des Controls erst bei MousMove
{  mp := Floor(pRadius * 10 / 8);
  p1 := Point(mp,mp);
  p2 := Point(X,Y);
  w := Floor(KoordToWink(p1,p2));
  w := w + 90;
  if w > 359 then w := w - 360;
  if not (w >= pMinW) then w := pMinW;
  if w > pMaxW then w := pMaxW;
  v := Winkel2Wert(w);
  if Assigned(FonChange) then
    FonChange(Self,v);
  pWinkel := w;
  pWert := v;
  Repaint;}
  Inherited;
end;

procedure TDrehKnopf.MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
begin
  pTurn := False;
  inherited;
end;

procedure TDrehKnopf.MouseMove(Shift: TShiftState; X: Integer; Y: Integer);
var
  mp,v,w: Integer;
  p1,p2: TPoint;
begin
  inherited;
  if not pTurn then exit;

  mp := Floor(pRadius * 10 / 8);
  p1 := Point(mp,mp);
  p2 := Point(X,Y);
  w := Floor(KoordToWink(p1,p2));
  w := w + 90;
  if w > 359 then w := w - 360;
  if not(w >= pMinW) then w := pMinW;
  if w > pMaxw then w := pMaxw;

  v := Winkel2Wert(w);
  if Assigned(FonChange) then
    FonChange(Self,v);
  pWinkel := w;
  pWert := v;
  Repaint;
end;

function TDrehKnopf.Wert2Winkel(val: Integer):Single;
var
  res : Single;
begin
  // Umrechnung von Value in Winkel
  res := ((val-pMin) * (pMaxw - pMinw)) / (pMax - pMin) + pMinw;

  Result := res;
end;

function TDrehKnopf.Winkel2Wert(val: Single):Integer;
var
  res: Integer;
begin
  // Umrechnung von Winkel in Value
  res := Floor((pMax - pMin) * (val-pMinw) / (pMaxw - pMinw));
  res := res + pMin;

  Result := res;
end;

procedure Register;
begin
  RegisterComponents('mtm', [TDrehKnopf]);
end;

end.