mbColorLib: Fix painting issues of mbColorPalette

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5516 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/mbColorLib/HexaColorPicker.pas

@@ -104,7 +104,6 @@ type
 
     function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
-//    procedure KeyDownInterface(var Key: Word; Shift: TShiftState); override;
     procedure Paint; override;
     procedure Resize; override;
 
@@ -347,7 +346,7 @@ begin
   try
  //   OffScreen.PixelFormat := pf32bit;
     OffScreen.Width := Width;
-    OffScreen.Height := HeightOf(FColorCombRect) + HeightOf(FBWCombRect);
+    OffScreen.Height := HeightOfRect(FColorCombRect) + HeightOfRect(FBWCombRect);
     //Parent background
     {$IFDEF FPC}
     if Color = clDefault then

components/mbColorLib/examples/fulldemo/main.lfm

@@ -42,9 +42,9 @@ object Form1: TForm1
     Height = 363
     Top = 6
     Width = 403
-    ActivePage = TabSheet2
+    ActivePage = TabSheet3
     Anchors = [akTop, akLeft, akRight, akBottom]
-    TabIndex = 1
+    TabIndex = 2
     TabOrder = 0
     OnMouseMove = PageControl1MouseMove
     object TabSheet1: TTabSheet
@@ -56,7 +56,7 @@ object Form1: TForm1
         Height = 287
         Top = 8
         Width = 377
-        SelectedColor = 553990
+        SelectedColor = 685062
         HSPickerHintFormat = 'H: %h S: %s'#13'Hex: %hex'
         LPickerHintFormat = 'Luminance: %l'
         Anchors = [akTop, akLeft, akRight, akBottom]
@@ -208,8 +208,8 @@ object Form1: TForm1
         Height = 253
         Top = 8
         Width = 385
-        HorzScrollBar.Page = 75
+        HorzScrollBar.Page = 385
-        VertScrollBar.Page = 234
+        VertScrollBar.Page = 250
         Anchors = [akTop, akLeft, akRight, akBottom]
         BorderStyle = bsNone
         ClientHeight = 253
@@ -217,10 +217,10 @@ object Form1: TForm1
         TabOrder = 3
         object mbColorPalette1: TmbColorPalette
           Left = 0
-          Height = 234
+          Height = 250
           Top = 0
           Width = 385
-          Align = alTop
+          Anchors = [akTop, akLeft, akRight, akBottom]
           Colors.Strings = (
             'clBlack'
             '$00330000'
@@ -481,7 +481,6 @@ object Form1: TForm1
           )
           HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %h'
           AutoHeight = True
-          CellStyle = csCorel
           TabOrder = 0
           OnSelColorChange = mbColorPalette1SelColorChange
           OnMouseMove = mbColorPalette1MouseMove
@@ -505,7 +504,7 @@ object Form1: TForm1
         Text = 'soAscending'
       end
       object ComboBox3: TComboBox
-        Left = 124
+        Left = 127
         Height = 23
         Top = 300
         Width = 87
@@ -561,7 +560,7 @@ object Form1: TForm1
         Width = 15
         Anchors = [akLeft, akBottom]
         Min = 0
-        OnChanging = UpDown1Changing
+        OnChangingEx = UpDown1ChangingEx
         Position = 18
         TabOrder = 7
         Thousands = False

components/mbColorLib/examples/fulldemo/main.pas

@@ -140,6 +140,8 @@ type
     procedure HRingPicker1Change(Sender: TObject);
     procedure HRingPicker1MouseMove(Sender: TObject; Shift: TShiftState; X,
       Y: Integer);
+    procedure UpDown1ChangingEx(Sender: TObject; var AllowChange: Boolean;
+      NewValue: SmallInt; Direction: TUpDownDirection);
     procedure VColorPicker2Change(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure CheckBox1Click(Sender: TObject);
@@ -149,7 +151,6 @@ type
     procedure ComboBox2Change(Sender: TObject);
     procedure ComboBox3Change(Sender: TObject);
     procedure ComboBox4Change(Sender: TObject);
-    procedure UpDown1Changing(Sender: TObject; var AllowChange: Boolean);
     procedure CbWebSsafeClick(Sender: TObject);
     procedure Button5Click(Sender: TObject);
     procedure CbSwatchStyleClick(Sender: TObject);
@@ -167,6 +168,9 @@ implementation
 {$R *.lfm}
 {$R mxico.res} //MXS icon resource file, for internet shortcut only
 
+uses
+  RGBHSLUtils;
+
 procedure TForm1.tb1Change(Sender: TObject);
 begin
 sc.opacity := tb1.position;
@@ -314,6 +318,9 @@ end;
 // only for internet shortcuts
 procedure TForm1.FormCreate(Sender: TObject);
 begin
+  MaxHue := 360;
+  MaxSat := 240;
+  MaxLum := 240;
   with TIniFile.Create(ExtractFilePath(Application.ExeName) + '\MXS Website.url') do
   try
     WriteString('InternetShortcut','URL', 'http://mxs.bergsoft.net');
@@ -360,11 +367,11 @@ begin
 mbcolorpalette1.CellStyle := tcellstyle(combobox4.ItemIndex);
 end;
 
-procedure TForm1.UpDown1Changing(Sender: TObject;
+procedure TForm1.UpDown1ChangingEx(Sender: TObject; var AllowChange: Boolean;
-  var AllowChange: Boolean);
+  NewValue: SmallInt; Direction: TUpDownDirection);
 begin
  allowchange := true;
-mbcolorpalette1.CellSize := abs(updown1.Position);
+ mbcolorpalette1.CellSize := abs(NewValue);
 end;
 
 procedure TForm1.CbWebSsafeClick(Sender: TObject);

components/mbColorLib/mbBasicPicker.pas

@@ -38,6 +38,7 @@ type
     function MouseOnPicker(X, Y: Integer): Boolean; virtual;
     procedure PaintParentBack; virtual; overload;
     procedure PaintParentBack(ACanvas: TCanvas); overload;
+    procedure PaintParentBack(ACanvas: TCanvas; ARect: TRect); overload;
     procedure PaintParentBack(ABitmap: TBitmap); overload;
     function ShowHintWindow(APoint: TPoint; AText: String): Boolean; virtual;
     {$IFDEF DELPHI}
@@ -58,7 +59,7 @@ type
 implementation
 
 uses
-  LCLIntf;
+  LCLIntf, mbUtils;
 
 const
   HINT_SHOW_DELAY = 50;
@@ -183,7 +184,6 @@ begin
   {$ENDIF}
     ABitmap.Canvas.Brush.Color := Color;
   ABitmap.Canvas.FillRect(ABitmap.Canvas.ClipRect);
-//  Canvas.Draw(0, 0, ABitmap);
 
   {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI}
   if ParentBackground then
@@ -200,6 +200,12 @@ begin
 end;
 
 procedure TmbBasicPicker.PaintParentBack(ACanvas: TCanvas);
+var
+  R: TRect;
+begin
+  R := Rect(0, 0, Width, Height);
+  PaintParentBack(ACanvas, R);
+  (*
 var
   OffScreen: TBitmap;
 begin
@@ -217,6 +223,27 @@ begin
   finally
     Offscreen.Free;
   end;
+  *)
+end;
+
+procedure TmbBasicPicker.PaintParentBack(ACanvas: TCanvas; ARect: TRect);
+var
+  OffScreen: TBitmap;
+begin
+  Offscreen := TBitmap.Create;
+  try
+  //  Offscreen.PixelFormat := pf32bit;
+    if Color = clDefault then begin
+      Offscreen.Transparent := true;
+      Offscreen.TransparentColor := clForm; //GetDefaultColor(dctBrush);
+    end;
+    Offscreen.Width := WidthOfRect(ARect);
+    Offscreen.Height := HeightOfRect(ARect);
+    PaintParentBack(Offscreen);
+    ACanvas.Draw(ARect.Left, ARect.Top, Offscreen);
+  finally
+    Offscreen.Free;
+  end;
 end;
 
 // Build and show the hint window

components/mbColorLib/mbColorPalette.pas

@@ -33,7 +33,6 @@ type
    FMouseLoc: TMouseLoc;
    FMouseOver, FMouseDown, FAutoHeight: boolean;
    FColCount, FRowCount, FTop, FLeft, FIndex, FCheckedIndex, FCellSize, FTotalCells: integer;
-   FTempBmp: TBitmap;
    //PBack: TBitmap;
    FState: TColorCellState;
    FColors, FNames: TStrings;
@@ -72,13 +71,13 @@ type
   protected
    procedure Paint; override;
    procedure PaintTransparentGlyph(ACanvas: TCanvas; R: TRect);
-   procedure DrawCell(clr: string);
+   procedure DrawCell(ACanvas: TCanvas; AColor: string);
    procedure DrawCellBack(ACanvas: TCanvas; R: TRect; AIndex: integer);
    procedure ColorsChange(Sender: TObject);
    procedure Click; override;
    procedure Resize; override;
    procedure SelectCell(i: integer);
-   procedure CreateWnd; override;
+//   procedure CreateWnd; 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;
@@ -173,6 +172,9 @@ type
 
 implementation
 
+uses
+  mbUtils;
+
 { TmbColorPalette }
 
 constructor TmbColorPalette.Create(AOwner: TComponent);
@@ -182,16 +184,13 @@ begin
 // DoubleBuffered := true;
 // PBack := TBitmap.Create;
 // PBack.PixelFormat := pf32bit;
-  FTempBmp := TBitmap.Create;
- //FTempBmp.PixelFormat := pf32bit;
   {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI}
   ParentBackground := true;
   {$ENDIF} {$ENDIF}
   TabStop := true;
   ParentShowHint := true;
   ShowHint := false;
-  Width := 180;
+  SetInitialBounds(0, 0, 180, 126);
-  Height := 126;
   FMouseLoc := mlNone;
   FMouseOver := false;
   FMouseDown := false;
@@ -221,7 +220,7 @@ end;
 destructor TmbColorPalette.Destroy;
 begin
   //PBack.Free;
-  FTempBmp.Free;
+  FBufferBmp.Free;
   FNames.Free;
   FColors.Free;
   inherited Destroy;
@@ -232,6 +231,7 @@ begin
   if Parent = nil then
     exit;
   FColCount := Width div FCellSize;
+  {7
   if FAutoHeight and (FColCount <> 0) then
   begin
     if FColors.Count mod FColCount > 0 then
@@ -240,8 +240,11 @@ begin
       Height := (FColors.Count div FColCount) * FCellSize;
   end;
   if Height = 0 then Height := FCellSize;
+  }
   FRowCount := Height div FCellSize;
+  {
   Width := FColCount * FCellSize;
+  }
 end;
 
 function TmbColorPalette.GetTotalRowCount: integer;
@@ -251,13 +254,16 @@ begin
   else
     Result := 0;
 end;
-
+                                 (*
 procedure TmbColorPalette.CreateWnd;
 begin
   inherited;
+  {
   CalcAutoHeight;
   Invalidate;
+  }
 end;
+*)
                    (*
 procedure TmbColorPalette.PaintParentBack;
 {$IFDEF DELPHI_7_UP}
@@ -297,15 +303,19 @@ end;                 *)
 procedure TmbColorPalette.Paint;
 var
   i: integer;
+  bmp: TBitmap;
 begin
 {  PBack.Width := Width;
   PBack.Height := Height;
   PaintParentBack(PBack);
  }
   //make bmp
-  FTempBmp.Width := Width;
+  if FBufferBmp = nil then
-  FTempBmp.Height := Height;
+    FBufferBmp := TBitmap.Create;
-  PaintParentBack(FTempBmp);
+  FBufferBmp.Width := Width;
+  FBufferBmp.Height := Height;
+  PaintParentBack(FBufferBmp);
+  FBufferBmp.Transparent := false;  // a transparent bitmap does not show the selection ?!
 
   //reset counters
   FTotalCells := FColors.Count - 1;
@@ -316,12 +326,29 @@ begin
   for i := 0 to FColors.Count - 1 do
   begin
     if FColors.Strings[i] <> '' then
-      DrawCell(FColors.Strings[i]);
+      DrawCell(FBufferBmp.Canvas, FColors.Strings[i]);
     Inc(FLeft);
   end;
 
   //draw the bmp
-  Canvas.Draw(0, 0, FTempBmp);
+  if Color = clDefault then
+  begin
+    // Use temporary bitmap to draw the buffer bitmap transparently
+    bmp := TBitmap.Create;
+    try
+      bmp.SetSize(Width, Height);
+      if Color = clDefault then begin
+        bmp.Transparent := true;
+        bmp.TransparentColor := clForm;
+      end;
+      bmp.Canvas.Draw(0, 0, FBufferBmp);
+      Canvas.Draw(0, 0, bmp);
+    finally
+      bmp.Free;
+    end;
+  end
+  else
+    Canvas.Draw(0, 0, FBufferBmp);
 
   //csDesiging border
   if csDesigning in ComponentState then
@@ -335,7 +362,7 @@ begin
   end;
 end;
 
-procedure TmbColorPalette.DrawCell(clr: string);
+procedure TmbColorPalette.DrawCell(ACanvas: TCanvas; AColor: string);
 var
   R: Trect;
   FCurrentIndex: integer;
@@ -343,7 +370,7 @@ var
   Handled: boolean;
 begin
   // set props
-  if (FLeft + 1) * FCellSize > FTempBmp.Width then
+  if (FLeft + 1) * FCellSize > Width then
   begin
     Inc(FTop);
     FLeft := 0;
@@ -377,41 +404,42 @@ begin
     FState := ccsNone;
 
   //paint
-  DrawCellBack(FTempBmp.Canvas, R, FCurrentIndex);
+  DrawCellBack(ACanvas, R, FCurrentIndex);
 
   // fire the event
   Handled := false;
+  c := mbStringToColor(AColor);
   if Assigned(FOnPaintCell) then
     case FCellStyle of
       csDefault:
-        FOnPaintCell(FTempBmp.Canvas, R, mbStringToColor(clr), FCurrentIndex, FState, FTStyle, Handled);
+        FOnPaintCell(ACanvas, R, c, FCurrentIndex, FState, FTStyle, Handled);
       csCorel:
         if FColCount = 1 then
-          FOnPaintCell(FTempBmp.Canvas, R, mbStringToColor(clr), FCurrentIndex, FState, FTStyle, Handled)
+          FOnPaintCell(ACanvas, R, c, FCurrentIndex, FState, FTStyle, Handled)
         else
-          FOnPaintCell(FTempBmp.Canvas, Rect(R.Left, R.Top, R.Right + 1, R.Bottom), mbStringToColor(clr), FCurrentIndex, FState, FTStyle, Handled);
+          FOnPaintCell(ACanvas, Rect(R.Left, R.Top, R.Right + 1, R.Bottom), c,
+            FCurrentIndex, FState, FTStyle, Handled);
     end;
 
   if not Handled then
   begin
     // if standard colors draw the rect
-    c := mbStringToColor(clr);
+    if not SameText(AColor, 'clCustom') and not SameText(AColor, 'clTransparent') then
-    if not SameText(clr, 'clCustom') and not SameText(clr, 'clTransparent') then
       case FCellStyle of
         csDefault:
           begin
             InflateRect(R, -3, -3);
             if Enabled then
             begin
-              FTempBmp.Canvas.Brush.Color := c;
+              ACanvas.Brush.Color := c;
-              FTempBmp.Canvas.Pen.Color := clBtnShadow;
+              ACanvas.Pen.Color := clBtnShadow;
             end
             else
             begin
-              FTempBmp.Canvas.Brush.Color := clGray;
+              ACanvas.Brush.Color := clGray;
-              FTempBmp.Canvas.Pen.Color := clGray;
+              ACanvas.Pen.Color := clGray;
             end;
-            FTempBmp.Canvas.Rectangle(R);
+            ACanvas.Rectangle(R);
             Exit;
           end;
 
@@ -429,17 +457,17 @@ begin
                 Dec(R.Right);
             end;
             if Enabled then
-              FTempBmp.Canvas.Brush.Color := c
+              ACanvas.Brush.Color := c
             else
-              FTempBmp.Canvas.Brush.Color := clGray;
+              ACanvas.Brush.Color := clGray;
-            FTempBmp.Canvas.FillRect(R);
+            ACanvas.FillRect(R);
             Exit;
           end;
       end;
 
     //if transparent draw the glyph
-    if SameText(clr, 'clTransparent') then
+    if SameText(AColor, 'clTransparent') then
-      PaintTransparentGlyph(FTempBmp.Canvas, R);
+      PaintTransparentGlyph(ACanvas, R);
   end;
 end;
 
@@ -454,7 +482,7 @@ begin
        with ThemeServices do
         if Enabled then
          case FState of
-          ccsNone: ;
+          ccsNone: ; //PaintParentBack(ACanvas, R);
 //          ccsNone: ACanvas.CopyRect(R, PBack.Canvas, R);
           ccsOver: DrawElement(ACanvas.Handle, GetElementDetails(ttbButtonHot), R);
           ccsDown: DrawElement(ACanvas.Handle, GetElementDetails(ttbButtonPressed), R);
@@ -586,6 +614,7 @@ begin
     else if FColCount > 1 then
       Inc(R.Right);
   end;
+
   with ACanvas do
     case FTStyle of
       tsPhotoshop:
@@ -660,7 +689,7 @@ end;
 procedure TmbColorPalette.Resize;
 begin
   inherited;
-  //CalcAutoHeight;    // wp: will cause a ChangedBounds endless loop
+  CalcAutoHeight;    // wp: will cause a ChangedBounds endless loop
   Invalidate;
 end;
 

components/mbColorLib/mbutils.pas

@@ -15,8 +15,12 @@ function PtInCircle(p, ctr: TPoint; Radius: Integer): Boolean;
 
 function HighContrastColor(AColor: TColor): TColor;
 
-function HeightOf(R: TRect): Integer;
+function HeightOfRect(R: TRect): Integer;
-function WidthOf(R: TRect): Integer;
+function WidthOfRect(R: TRect): Integer;
+function IsEmptyRect(R: TRect): Boolean;
+
+const
+  EMPTY_RECT: TRect = (Left: -1; Top: -1; Right: -1; Bottom: -1);
 
 implementation
 
@@ -53,16 +57,21 @@ begin
   Result := sqr(p.x - ctr.x) + sqr(p.y - ctr.y) <= sqr(Radius);
 end;
 
-function HeightOf(R: TRect): Integer;
+function HeightOfRect(R: TRect): Integer;
 begin
   Result := R.Bottom - R.Top;
 end;
 
-function WidthOf(R: TRect): Integer;
+function WidthOfRect(R: TRect): Integer;
 begin
   Result := R.Right - R.Left;
 end;
 
+function IsEmptyRect(R: TRect): Boolean;
+begin
+  Result := (R.Left = -1) and (R.Top = -1) and (R.Right = -1) and (R.Bottom = -1);
+end;
+
 function HighContrastColor(AColor: TColor): TColor;
 begin
   if GetRValue(AColor) + GetGValue(AColor) + GetBValue(AColor) > 3*128 then