ColorWheel and ValueBar implementation including color mapping routines.

These components will allow us to implement a color selection dialog.

2 files changed, 711 insertions, 0 deletions

diff --git a/src/gui/fpg_colormapping.pas b/src/gui/fpg_colormapping.pas
new file mode 100644
index 00000000..9f486bbf
--- /dev/null
+++ b/src/gui/fpg_colormapping.pas
@@ -0,0 +1,138 @@
+{
+    fpGUI  -  Free Pascal GUI Library
+
+    Copyright (C) 2006 - 2009 See the file AUTHORS.txt, included in this
+    distribution, for details of the copyright.
+
+    See the file COPYING.modifiedLGPL, included in this distribution,
+    for details about redistributing fpGUI.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+    Description:
+      This unit contains some color conversion/mapping functions.
+}
+
+unit fpg_ColorMapping;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, fpg_base;
+
+ // IN these functions the following definitions apply:
+ // Hue: 0 - 1535
+ //   red = 0  green = 512  blue = 1024
+ // Saturation: 0 - 1
+ //   grey (no color) = 0  max color = 1
+ // Value: 0 - 1
+ //   black =0   max brightness = 1
+
+procedure RGBToHSV(C: TfpgColor; out Hue: longint; out Saturation, Value: double);
+function HSVToRGB(const H: longint; const S, V: double): TfpgColor;
+
+implementation
+
+uses
+  Math;
+
+procedure RGBToHSV(C: TfpgColor; out Hue: longint; out Saturation, Value: double);
+var
+  r, g, b: longint;
+  hi, lo: longint;
+  d:   longint;
+  rgb: TRGBTriple;
+begin
+  rgb   := fpgColorToRGBTriple(C);
+  r     := rgb.Red;
+  g     := rgb.Green;
+  b     := rgb.Blue;
+  hi    := max(max(r, g), b);
+  lo    := min(min(r, g), b);
+  d     := hi - lo;
+  Value := hi / 256;
+  if d > 0 then
+  begin
+    if r = hi then
+      Hue := 256 * (g - b) div d
+    else if g = hi then
+      Hue := 512 + 256 * (b - r) div d
+    else
+      Hue := 1024 + 256 * (r - g) div d;
+    if Hue < 0 then
+      Hue := Hue + 1536;
+  end
+  else
+    Hue := 0; // doesn't matter (grey: Sat = 0)
+
+  if hi > 0 then
+    Saturation := d / hi
+  else
+    Saturation := 0; // doesn't matter (black: Val = 0
+end;
+
+function HSVToRGB(const H: longint; const S, V: double): TfpgColor;
+var
+  r, g, b: longint;
+  rgb:     TRGBTriple;
+begin
+  if (h < 0) or (h > 1535) or (S < 0) or (S > 1) or (V < 0) or (V > 1) then
+  begin
+    // Invalid value, use black
+    Result := 0;
+    exit;
+  end;
+  case h div 256 of
+    0:
+    begin
+      r := 255;
+      g := h;
+      b := 0;
+    end;
+    1:
+    begin
+      r := 511 - h;
+      g := 255;
+      b := 0;
+    end;
+    2:
+    begin
+      r := 0;
+      g := 255;
+      b := h - 512;
+    end;
+    3:
+    begin
+      r := 0;
+      g := 1023 - h;
+      b := 255;
+    end;
+    4:
+    begin
+      r := h - 1024;
+      g := 0;
+      b := 255;
+    end;
+    5:
+    begin
+      r := 255;
+      g := 0;
+      b := 1535 - h;
+    end;
+  end;
+  r      := Trunc(V * (255 - S * (255 - r)));
+  g      := Trunc(V * (255 - S * (255 - g)));
+  b      := Trunc(V * (255 - S * (255 - b)));
+  rgb.Red := r;
+  rgb.Green := g;
+  rgb.Blue := b;
+  Result := RGBTripleTofpgColor(rgb);
+end;
+
+
+end.
+
diff --git a/src/gui/fpg_colorwheel.pas b/src/gui/fpg_colorwheel.pas
new file mode 100644
index 00000000..103ce35d
--- /dev/null
+++ b/src/gui/fpg_colorwheel.pas
@@ -0,0 +1,573 @@
+{
+    fpGUI  -  Free Pascal GUI Library
+
+    Copyright (C) 2006 - 2009 See the file AUTHORS.txt, included in this
+    distribution, for details of the copyright.
+
+    See the file COPYING.modifiedLGPL, included in this distribution,
+    for details about redistributing fpGUI.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+    Description:
+      This unit implements color selectors using a ColorWheel and
+      a ValueBar. Color results are in HSV format.
+}
+
+unit fpg_ColorWheel;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, fpg_base, fpg_main, fpg_widget;
+
+type
+  // forward declaration
+  TfpgValueBar = class;
+
+  TfpgColorWheel = class(TfpgWidget)
+  protected
+    FValueBar: TfpgValueBar;
+    FHue: longint;
+    FSaturation: double;
+    FMarginWidth: longint;
+    FCursorSize: longint;
+    FWhiteAreaPercent: longint; // 0 to 50 percent of circle radius that is pure white
+    FOnChange: TNotifyEvent;
+    FImage: TfpgImage; // cached colorwheel image
+    procedure   HSFromPoint(X, Y: longint; out H: longint; out S: double);
+    procedure   DrawCursor;
+    procedure   SetMarginWidth(NewWidth: longint);
+    procedure   SetCursorSize(NewSize: longint);
+    procedure   SetValueBar(AValueBar: TfpgValueBar);
+    procedure   SetWhiteAreaPercent(WhiteAreaPercent: longint);
+    procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
+    function    DrawWidth: longint;
+    function    DrawHeight: longint;
+    procedure   Change;
+    procedure   HandlePaint; override;
+    procedure   HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override;
+    procedure   HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override;
+    procedure   HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor  Destroy; override;
+    property    Hue: longint Read FHue;
+    property    Saturation: double Read FSaturation;
+    procedure   SetSelectedColor(const NewColor: TfpgColor);
+  published
+    property    BackgroundColor;
+    property    ValueBar: TfpgValueBar Read FValueBar Write SetValueBar;
+    property    MarginWidth: longint Read FMarginWidth Write SetMarginWidth;
+    property    CursorSize: longint Read FCursorSize Write SetCursorSize;
+    property    WhiteAreaPercent: longint Read FWhiteAreaPercent Write SetWhiteAreaPercent;
+    property    OnChange: TNotifyEvent Read FOnChange Write FOnChange;
+  end;
+
+
+  TfpgValueBar = class(TfpgWidget)
+  protected
+    FColorWheel: TfpgColorWheel;
+    FHue: longint;
+    FSaturation: double;
+    FValue: double;
+    FMarginWidth: longint;
+    FCursorHeight: longint;
+    FOnChange: TNotifyEvent;
+    procedure   DrawCursor;
+    procedure   SetMarginWidth(NewWidth: longint);
+    procedure   SetValue(Value: double);
+    procedure   SetCursorHeight(CursorHeight: longint);
+    function    GetSelectedColor: TfpgColor;
+    procedure   Change;
+    function    DrawWidth: longint;
+    function    DrawHeight: longint;
+    function    ValueFromY(Y: longint): real;
+    procedure   DrawLine(Y: longint);
+    procedure   HandlePaint; override;
+    procedure   HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override;
+    procedure   HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override;
+    procedure   HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure   SetHS(Hue: longint; Sat: double);
+  published
+    property    BackgroundColor;
+    property    Value: double Read FValue Write SetValue;
+    property    SelectedColor: TfpgColor Read GetSelectedColor;
+    property    MarginWidth: longint Read FMarginWidth Write SetMarginWidth;
+    property    CursorHeight: longint Read FCursorHeight Write SetCursorHeight;
+    property    OnChange: TNotifyEvent Read FOnChange Write FOnChange;
+  end;
+
+
+implementation
+
+uses
+  fpg_ColorMapping;
+
+const
+  RadToHue: double = 1536 / (2 * pi);
+
+
+function AngleFrom(x, y: double): double;
+  // Quadrants are laid out as follows:
+  //
+  //     1|0
+  //   ---+----
+  //     2|3
+begin
+  if X = 0 then
+  begin
+    if Y > 0 then
+      Result := pi / 2
+    else
+      Result := 3 * pi / 2;
+  end
+  else
+  begin
+    Result := arctan(abs(y) / abs(x));
+    if (x < 0) and (y >= 0) then
+      // quadrant 1
+      Result := pi - Result
+    else if (x < 0) and (y < 0) then
+      // quadrant 2
+      Result := Result + pi
+    else if (x >= 0) and (y < 0) then
+      // quadrant 3
+      Result := 2 * pi - Result;
+  end;
+end;
+
+
+{ TfpgColorWheel }
+
+function TfpgColorWheel.DrawWidth: longint;
+begin
+  Result := Width - FMarginWidth * 2;
+end;
+
+function TfpgColorWheel.DrawHeight: longint;
+begin
+  Result := Height - FMarginWidth * 2;
+end;
+
+procedure TfpgColorWheel.SetSelectedColor(const NewColor: TfpgColor);
+var
+  Value: double;
+begin
+  RGBToHSV(NewColor, FHue, FSaturation, Value);
+  Change;
+  if FValueBar <> nil then
+    FValueBar.Value := Value;
+end;
+
+procedure TfpgColorWheel.Change;
+begin
+  if FValueBar <> nil then
+    FValueBar.SetHS(FHue, FSaturation);
+  if FOnChange <> nil then
+    FOnChange(self);
+  Invalidate;
+end;
+
+procedure TfpgColorWheel.HandlePaint;
+var
+  x, y: longint;
+  lHue: longint;
+  lsaturation: double;
+  c:    TfpgColor;
+begin
+  // clear background rectangle
+  Canvas.Clear(BackgroundColor);
+
+  // margins too big
+  if (Width < MarginWidth * 2) or (Height < MarginWidth * 2) then
+    Exit;  //==>
+
+  if csDesigning in ComponentState then
+  begin
+    // When designing, don't draw colors
+    // but draw an outline
+    Canvas.SetLineStyle(1, lsDash);
+    Canvas.DrawRectangle(GetClientRect);
+    Canvas.Color := clHilite1;
+    Canvas.DrawArc(Width div 2, Height div 2, DrawWidth div 2 + 1,
+        DrawHeight div 2 + 1, 45, 180);
+    Canvas.Color := clShadow1;
+    Canvas.DrawArc(Width div 2, Height div 2, DrawWidth div 2 + 1,
+        DrawHeight div 2 + 1, 225, 180);
+    Exit;  //==>
+  end;
+
+  if FImage = nil then
+  begin
+    // we must only do this once, because it's very slow
+    FImage := TfpgImage.Create;
+    FImage.AllocateImage(32, DrawWidth, DrawHeight);
+    FImage.UpdateImage;
+    for X := 0 to DrawWidth - 1 do
+    begin
+      for Y := 0 to DrawHeight - 1 do
+      begin
+        // work out hue and saturation for point
+        HSFromPoint(X, Y, lHue, lSaturation);
+        if lSaturation <= 1.0 then
+        begin
+          // point is within wheel
+          C := HSVToRGB(lHue, lSaturation, 1.0);
+          // draw the pixel
+          Canvas.Pixels[X + FMarginWidth, Y + FMarginWidth] := C;
+          FImage.Colors[x, y] := c;
+        end
+        else
+          // point is outside wheel. Also incase color is alias, lookup the RGB values.
+          FImage.Colors[x, y] := fpgColorToRGB(BackgroundColor);
+      end;
+    end;
+  end
+  else
+  begin
+    // paint buffer image seeing that we have it
+    Canvas.DrawImage(FMarginWidth, FMarginWidth, FImage);
+  end;
+
+  DrawCursor;
+end;
+
+procedure TfpgColorWheel.HandleLMouseDown(x, y: integer; shiftstate: TShiftState);
+begin
+  inherited HandleLMouseDown(x, y, shiftstate);
+  Dec(X, FMarginWidth);
+  Dec(Y, FMarginWidth);
+  HSFromPoint(X, Y, FHue, FSaturation);
+  if FSaturation > 1.0 then
+    FSaturation := 1.0;
+  Change;
+  CaptureMouse;
+end;
+
+procedure TfpgColorWheel.HandleMouseMove(x, y: integer; btnstate: word;
+  shiftstate: TShiftState);
+begin
+  inherited HandleMouseMove(x, y, btnstate, shiftstate);
+  // is mouse still captured (LButton down)?
+  if ((btnstate and MOUSE_LEFT) = 0) then
+    Exit;  //==>
+  Dec(X, FMarginWidth);
+  Dec(Y, FMarginWidth);
+  HSFromPoint(X, Y, FHue, FSaturation);
+  if FSaturation > 1.0 then
+    FSaturation := 1.0;
+  Change;
+end;
+
+procedure TfpgColorWheel.HandleLMouseUp(x, y: integer; shiftstate: TShiftState);
+begin
+  inherited HandleLMouseUp(x, y, shiftstate);
+  ReleaseMouse;
+end;
+
+constructor TfpgColorWheel.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FMarginWidth := 5;
+  FCursorSize := 5;
+  Width  := 100;
+  Height := 100;
+  Name   := 'ColorWheel';
+  FWhiteAreaPercent := 10;
+end;
+
+destructor TfpgColorWheel.Destroy;
+begin
+  if FImage <> nil then
+    FImage.Free;
+  inherited Destroy;
+end;
+
+// Calculate hue and saturation for a given point in the color wheel
+procedure TfpgColorWheel.HSFromPoint(X, Y: longint; out H: longint; out S: double);
+var
+  xp, yp: double;
+  halfw, halfh: longint;
+begin
+  halfw := DrawWidth div 2;
+  halfh := DrawHeight div 2;
+  xp    := (x - halfw) / halfw; // x as -1..1
+  yp    := (y - halfh) / halfh; // y as -1..1
+  H     := Trunc(RadToHue * AngleFrom(xp, -yp));
+  S     := sqrt(xp * xp + yp * yp);
+  // scale saturation and limit to white, for white area
+  S     := S * (1 + (FWhiteAreaPercent / 100.0)) - (FWhiteAreaPercent / 100.0);
+  if S < 0 then
+    S := 0;
+end;
+
+procedure TfpgColorWheel.DrawCursor;
+var
+  Angle: Double;
+  X, Y: longint;
+  S: Double;
+  a: Double;
+  len: longint;
+begin
+  Angle := FHue/RadToHue;
+
+  // Scale distance from centre for white area
+  S := FSaturation;
+  if S > 0 then
+  begin
+    a := FWhiteAreaPercent / 100.0;
+    S := (S * (1 - a)) + a;
+  end;
+
+  // work out point for selected hue and saturation
+  X := Trunc(Width div 2+cos(Angle) * S * (DrawWidth div 2));
+  Y := Trunc(Height div 2+sin(Angle) * S * -(DrawHeight div 2));
+
+  // draw a crosshair with centre at mouse cursor position
+  len := FCursorSize*2 + 2; // length of crosshair lines
+  Canvas.XORFillRectangle($FFFFFF, X-FCursorSize, Y, len, 2);
+  Canvas.XORFillRectangle($FFFFFF, X, Y-FCursorSize, 2, len);
+end;
+
+procedure TfpgColorWheel.SetMarginWidth(NewWidth: longint);
+begin
+  FMarginWidth := NewWidth;
+  if WinHandle = 0 then
+    Exit; //==>
+  Invalidate;
+end;
+
+procedure TfpgColorWheel.SetCursorSize(NewSize: longint);
+begin
+  FCursorSize := NewSize;
+  if WinHandle = 0 then
+    Exit; //==>
+  Invalidate;
+end;
+
+procedure TfpgColorWheel.SetValueBar(AValueBar: TfpgValueBar);
+begin
+  if FValueBar <> nil then
+    // tell the old value bar it's no longer controlled by this wheel
+    FValueBar.FColorWheel := nil;
+  FValueBar := AValueBar;
+  if FValueBar <> nil then
+  begin
+    // Tell value bar it is controlled by this component
+    FValueBar.FColorWheel := Self;
+    // request notification when other is freed
+    FValueBar.FreeNotification(Self);
+  end;
+end;
+
+procedure TfpgColorWheel.SetWhiteAreaPercent(WhiteAreaPercent: longint);
+begin
+  if WhiteAreaPercent > 50 then
+    WhiteAreaPercent := 50;
+
+  if WhiteAreaPercent < 0 then
+    WhiteAreaPercent := 0;
+
+  FWhiteAreaPercent := WhiteAreaPercent;
+  Invalidate;
+end;
+
+procedure TfpgColorWheel.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if Operation = opRemove then
+  begin
+    if AComponent = FValueBar then
+      FValueBar := nil;
+  end;
+end;
+
+
+{ TfpgValueBar }
+
+procedure TfpgValueBar.DrawLine(Y: longint);
+var
+  DrawVal: double;
+  c: TfpgColor;
+begin
+  DrawVal := ValueFromY(Y);
+  C := HSVToRGB(FHue, FSaturation, DrawVal);
+  Canvas.Color := c;
+  Canvas.DrawLine(FMarginWidth, Y, Width - FMarginWidth - 1, Y);
+end;
+
+procedure TfpgValueBar.HandlePaint;
+var
+  y: longint;
+  r: TfpgRect;
+begin
+  //  inherited HandlePaint;
+  Canvas.Clear(BackgroundColor);
+
+  if csDesigning in ComponentState then
+  begin
+    // when designing just draw
+    // a rectangle to indicate
+    Canvas.SetLineStyle(1, lsDash);
+    Canvas.DrawRectangle(GetClientRect);
+    if (Width < MarginWidth * 2) or (Height < MarginWidth * 2) then
+      Exit;  //==>
+    r := GetClientRect;
+    InflateRect(r, FMarginWidth, FMarginWidth);
+    Canvas.DrawRectangle(r);
+    exit;
+  end;
+
+  // Draw margins
+  r.left := 0;
+  r.setbottom(0);
+  r.setright(FMarginWidth - 1);
+  r.top := Height - 1;
+  Canvas.Color := BackgroundColor;
+  Canvas.FillRectangle(r);  // left
+  r.left := Width - FMarginWidth;
+  r.setright(Width - 1);
+  Canvas.FillRectangle(r); // right
+  r.left := FMarginWidth;
+  r.setright(Width - FMarginWidth - 1);
+  r.setbottom(Height - FMarginWidth);
+  r.top := Height - 1;
+  Canvas.FillRectangle(r);  // top
+  r.setbottom(0);
+  r.top := FMarginWidth - 1;
+  Canvas.FillRectangle(r); // bottom
+
+  if (Width < MarginWidth * 2) or (Height < MarginWidth * 2) then
+    Exit; //==>
+
+  for Y := 0 to DrawHeight - 1 do
+    DrawLine(Y + FMarginWidth);
+
+  DrawCursor;
+end;
+
+procedure TfpgValueBar.HandleLMouseDown(x, y: integer; shiftstate: TShiftState);
+begin
+  inherited HandleLMouseDown(x, y, shiftstate);
+  FValue := ValueFromY(Y);
+  Change;
+  CaptureMouse;
+end;
+
+procedure TfpgValueBar.HandleMouseMove(x, y: integer; btnstate: word;
+  shiftstate: TShiftState);
+begin
+  inherited HandleMouseMove(x, y, btnstate, shiftstate);
+  if ((btnstate and MOUSE_LEFT) = 0) then
+    Exit; //==>
+  FValue := ValueFromY(Y);
+  Change;
+end;
+
+procedure TfpgValueBar.HandleLMouseUp(x, y: integer; shiftstate: TShiftState);
+begin
+  inherited HandleLMouseUp(x, y, shiftstate);
+  ReleaseMouse;
+end;
+
+constructor TfpgValueBar.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FMarginWidth := 5;
+  FValue  := 1.0;
+  Width   := 100;
+  Height  := 100;
+  Name    := 'ValueBar';
+  FCursorHeight := 10;
+end;
+
+procedure TfpgValueBar.SetHS(Hue: longint; Sat: double);
+begin
+  FHue := Hue;
+  FSaturation := Sat;
+  Invalidate;
+  Change;
+end;
+
+procedure TfpgValueBar.SetValue(Value: double);
+begin
+  FValue := Value;
+  Change;
+end;
+
+function TfpgValueBar.DrawWidth: longint;
+begin
+  Result := Width - FMarginWidth * 2;
+end;
+
+function TfpgValueBar.DrawHeight: longint;
+begin
+  Result := Height - FMarginWidth * 2;
+end;
+
+procedure TfpgValueBar.DrawCursor;
+var
+  Y: longint;
+  r: TfpgRect;
+begin
+  if (Width < MarginWidth * 2) or
+     (Height < MarginWidth * 2) then
+    Exit;  //==>
+
+  Y := Trunc((FValue * DrawHeight) + FMarginWidth);
+
+  r.SetRect(FMarginWidth-1, Y - (FCursorHeight div 2), DrawWidth+1, FCursorHeight);
+  Canvas.Color := GetSelectedColor;
+  Canvas.FillRectangle(r);
+
+  Canvas.Color := clBlack;
+  Canvas.DrawControlFrame(r);
+end;
+
+procedure TfpgValueBar.SetMarginWidth(NewWidth: longint);
+begin
+  if MarginWidth < 0 then
+    MarginWidth := 0;
+  FMarginWidth := NewWidth;
+  Invalidate;
+end;
+
+procedure TfpgValueBar.SetCursorHeight(CursorHeight: longint);
+begin
+  if CursorHeight < 3 then
+    CursorHeight := 3;
+  FCursorHeight := CursorHeight;
+  Invalidate;
+end;
+
+function TfpgValueBar.GetSelectedColor: TfpgColor;
+begin
+  Result := HSVToRGB(FHue, FSaturation, FValue);
+end;
+
+function TfpgValueBar.ValueFromY(Y: longint): real;
+begin
+  Result := (Y - MarginWidth) / (DrawHeight - 1);
+  if Result < 0 then
+    Result := 0;
+  if Result > 1.0 then
+    Result := 1.0;
+end;
+
+procedure TfpgValueBar.Change;
+begin
+  Invalidate;
+  if FOnChange <> nil then
+    FOnChange(self);
+end;
+
+
+end.
+