pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

mbColorLib: Fix flickering and other painting issues of HexaColorPicker

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5510 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-12-15 23:26:03 +00:00
parent 7b0c779480
commit 8b7b1a7469
3 changed files with 87 additions and 58 deletions
Download Patch File Download Diff File Expand all files Collapse all files

116
components/mbColorLib/HexaColorPicker.pas
View File

@@ -83,8 +83,8 @@ type
procedure Initialize; procedure Initialize;
procedure DrawAll; procedure DrawAll;
procedure SetSelectedColor(const Value: TColor); procedure SetSelectedColor(const Value: TColor);
procedure DrawCombControls; procedure DrawCombControls(ACanvas: TCanvas);
procedure DrawComb(Canvas: TCanvas; X, Y, Size: Integer); procedure DrawComb(ACanvas: TCanvas; X, Y, Size: Integer);
procedure HandleCustomColors(var Message: {$IFDEF FPC}TLMMouse{$ELSE}TWMMouse{$ENDIF}); procedure HandleCustomColors(var Message: {$IFDEF FPC}TLMMouse{$ELSE}TWMMouse{$ENDIF});
procedure CalculateCombLayout; procedure CalculateCombLayout;
procedure EndSelection; procedure EndSelection;
@@ -100,7 +100,7 @@ type
function GetNextCombIndex(i: integer): integer; function GetNextCombIndex(i: integer): integer;
function GetPreviousCombIndex(i: integer): integer; function GetPreviousCombIndex(i: integer): integer;
protected protected
procedure CreateWnd; override; // procedure CreateWnd; override;
procedure Paint; override; procedure Paint; override;
procedure Resize; override; procedure Resize; override;
procedure WheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure WheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
@@ -201,7 +201,8 @@ uses
constructor THexaColorPicker.Create(AOwner: TComponent); constructor THexaColorPicker.Create(AOwner: TComponent);
begin begin
inherited; inherited;
ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque]; //ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque];
// FBufferBmp := TBitmap.Create;
FRadius := 90; FRadius := 90;
FSliderWidth := 12; FSliderWidth := 12;
DoubleBuffered := true; DoubleBuffered := true;
@@ -228,23 +229,27 @@ begin
OnMouseWheelUp := WheelUp; OnMouseWheelUp := WheelUp;
OnMouseWheelDown := WheelDown; OnMouseWheelDown := WheelDown;
FIntensityText := 'Intensity'; FIntensityText := 'Intensity';
{
MaxHue := 360; MaxHue := 360;
MaxLum := 255; MaxLum := 255;
MaxSat := 255; MaxSat := 255;
}
end; end;
destructor THexaColorPicker.Destroy; destructor THexaColorPicker.Destroy;
begin begin
FBWCombs := nil; FBWCombs := nil;
FColorCombs := nil; FColorCombs := nil;
FBufferBmp.Free;
inherited; inherited;
end; end;
(*
procedure THexaColorPicker.CreateWnd; procedure THexaColorPicker.CreateWnd;
var var
rw, rh: integer; rw, rh: integer;
begin begin
inherited; inherited;
{
SetSelectedColor(clBlack); SetSelectedColor(clBlack);
if (Width >= 93) and (Height >= 85) then if (Width >= 93) and (Height >= 85) then
begin begin
@@ -255,7 +260,8 @@ begin
rh := Round((24/53)*(Height - 6)); rh := Round((24/53)*(Height - 6));
SetRadius(Min(rw, rh)); SetRadius(Min(rw, rh));
end; end;
end; }
end; *)
procedure THexaColorPicker.Initialize; procedure THexaColorPicker.Initialize;
var var
@@ -274,7 +280,7 @@ begin
FCenterIntensity := 1; FCenterIntensity := 1;
end; end;
procedure THexaColorPicker.DrawComb(Canvas: TCanvas; X, Y: Integer; Size: Integer); procedure THexaColorPicker.DrawComb(ACanvas: TCanvas; X, Y: Integer; Size: Integer);
var var
I: Integer; I: Integer;
P: array[0..5] of TPoint; P: array[0..5] of TPoint;
@@ -284,15 +290,15 @@ begin
P[I].X := Round(FCombCorners[I].X * Size + X); P[I].X := Round(FCombCorners[I].X * Size + X);
P[I].Y := Round(FCombCorners[I].Y * Size + Y); P[I].Y := Round(FCombCorners[I].Y * Size + Y);
end; end;
Canvas.Polygon(P); ACanvas.Polygon(P);
end; end;
procedure THexaColorPicker.DrawCombControls; procedure THexaColorPicker.DrawCombControls(ACanvas: TCanvas);
var var
I, Index: Integer; I, Index: Integer;
XOffs, YOffs, Count: Integer; XOffs, YOffs, Count: Integer;
dColor: Single;
OffScreen: TBitmap; OffScreen: TBitmap;
R: TRect;
{$IFDEF DELPHI_7_UP} {$IFDEF DELPHI} {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI}
MemDC: HDC; MemDC: HDC;
OldBMP: HBITMAP; OldBMP: HBITMAP;
@@ -331,6 +337,7 @@ begin
with OffScreen.Canvas do with OffScreen.Canvas do
begin begin
Pen.Style := psClear; Pen.Style := psClear;
// draw color combs from FColorCombs array // draw color combs from FColorCombs array
XOffs := FRadius + FColorCombRect.Left; XOffs := FRadius + FColorCombRect.Left;
YOffs := FRadius + FColorCombRect.Top; YOffs := FRadius + FColorCombRect.Top;
@@ -343,6 +350,7 @@ begin
Pen.color := FColorCombs[I].Color; Pen.color := FColorCombs[I].Color;
DrawComb(OffScreen.Canvas, FColorCombs[I].Position.X + XOffs, FColorCombs[I].Position.Y + YOffs, FCombSize); DrawComb(OffScreen.Canvas, FColorCombs[I].Position.X + XOffs, FColorCombs[I].Position.Y + YOffs, FCombSize);
end; end;
// mark selected comb // mark selected comb
if FCustomIndex > 0 then if FCustomIndex > 0 then
begin begin
@@ -361,6 +369,7 @@ begin
Pen.Mode := pmCopy; Pen.Mode := pmCopy;
Pen.Width := 1; Pen.Width := 1;
end; end;
// draw white-to-black combs // draw white-to-black combs
XOffs := FColorCombRect.Left; XOffs := FColorCombRect.Left;
YOffs := FColorCombRect.Bottom - 4; YOffs := FColorCombRect.Bottom - 4;
@@ -379,6 +388,7 @@ begin
end else end else
DrawComb(OffScreen.Canvas, FBWCombs[I].Position.X + XOffs, FBWCombs[I].Position.Y + YOffs, FCombSize); DrawComb(OffScreen.Canvas, FBWCombs[I].Position.X + XOffs, FBWCombs[I].Position.Y + YOffs, FCombSize);
end; end;
// mark selected comb // mark selected comb
if FCustomIndex < 0 then if FCustomIndex < 0 then
begin begin
@@ -399,7 +409,7 @@ begin
if Index in [0, High(FBWCombs)] then if Index in [0, High(FBWCombs)] then
begin begin
if Index = High(FBWCombs) then begin if Index = High(FBWCombs) then begin
Pen.Color := clWhite; Pen.Color := rgb(254, 254, 254); //clWhite;
Pen.Mode := pmXOR; Pen.Mode := pmXOR;
end; end;
if ((FColorCombs[0].Color = Cardinal(clWhite)) and (Index = 0)) or if ((FColorCombs[0].Color = Cardinal(clWhite)) and (Index = 0)) or
@@ -414,40 +424,45 @@ begin
Pen.Mode := pmCopy; Pen.Mode := pmCopy;
Pen.Width := 1; Pen.Width := 1;
end; end;
// Slider
if FSliderVisible then if FSliderVisible then
begin begin
// center-color trackbar // center-color trackbar
XOffs := FSliderRect.Left; R := FSliderRect;
YOffs := FSliderRect.Top; R.Right := R.Left + FSliderWidth;
Count := FSliderRect.Bottom - FSliderRect.Top - 1;
dColor := 255 / Count;
Pen.Style := psSolid; Pen.Style := psSolid;
// b&w ramp GradientFill(R, clWhite, clBlack, gdVertical);
for I := 0 to Count do
begin
Pen.Color := RGB(Round((Count - I) * dColor), Round((Count - I) * dColor), Round((Count - I) * dColor));
MoveTo(XOffs, YOffs + I);
LineTo(XOffs + FSliderWidth, YOffs + I);
end;
// draw marker // draw marker
Inc(XOffs, FSliderWidth + 1); Count := FSliderRect.Bottom - FSliderRect.Top - 1;
Inc(YOffs, Round(Count * (1 - FCenterIntensity))); XOffs := FSliderRect.Left + FSliderWidth + 1;
YOffs := FSliderRect.Top + Round(Count * (1 - FCenterIntensity));;
Pen.Color := clBlack;
case FMarker of case FMarker of
smArrow: smArrow:
begin begin
if not FNewArrowStyle then if not FNewArrowStyle then
begin begin
Brush.Color := clBlack; Brush.Color := clBlack;
Polygon([Point(XOffs, YOffs), Point(XOffs + 6, YOffs - 4), Point(XOffs + 6, YOffs + 4)]) Polygon([
Point(XOffs, YOffs),
Point(XOffs + 6, YOffs - 4),
Point(XOffs + 6, YOffs + 4)
])
end end
else else
begin begin
Brush.Color := clWhite; Brush.Color := clWhite;
Pen.Color := clBtnShadow; Pen.Color := clBtnShadow;
Polygon([ Polygon([
Point(XOffs, YOffs), Point(XOffs + 4, YOffs - 4), Point(XOffs + 6, YOffs - 4), Point(XOffs, YOffs),
Point(XOffs + 7, YOffs - 3), Point(XOffs + 7, YOffs + 3), Point(XOffs + 4, YOffs - 4),
Point(XOffs + 6, YOffs + 4), Point(XOffs + 4, YOffs + 4)]); Point(XOffs + 6, YOffs - 4),
Point(XOffs + 7, YOffs - 3),
Point(XOffs + 7, YOffs + 3),
Point(XOffs + 6, YOffs + 4),
Point(XOffs + 4, YOffs + 4)]);
end; end;
end; end;
smRect: smRect:
@@ -462,7 +477,7 @@ begin
Pen.Style := psClear; Pen.Style := psClear;
end; end;
end; end;
Canvas.Draw(0, 0, OffScreen); ACanvas.Draw(0, 0, OffScreen);
finally finally
Offscreen.Free; Offscreen.Free;
end; end;
@@ -471,10 +486,19 @@ end;
procedure THexaColorPicker.Paint; procedure THexaColorPicker.Paint;
begin begin
PaintParentBack; //(Canvas); PaintParentBack(Canvas);
if FColorCombs = nil then if FColorCombs = nil then
CalculateCombLayout; CalculateCombLayout;
DrawCombControls; DrawCombControls(Canvas);
{
if FBufferBmp = nil then
FBufferBmp := TBitmap.Create;
PaintParentBack(FBufferBmp); //(Canvas);
if FColorCombs = nil then
CalculateCombLayout;
DrawCombControls(FBufferBmp.Canvas);
Canvas.Draw(0, 0, FBufferBmp);
}
end; end;
// determines whether the mouse position is within the slider area and acts accordingly // determines whether the mouse position is within the slider area and acts accordingly
@@ -490,10 +514,14 @@ begin
Result := false; Result := false;
Exit; Exit;
end; end;
Result := PtInRect(FSliderRect, Point(Message.XPos, Message.YPos)) and
(FSelectionMode = smNone) or Result :=
(PtInRect(FSliderRect, Point(Message.XPos, Message.YPos))
and (FSelectionMode = smNone))
or
((Message.XPos >= FSliderRect.Left) and (Message.XPos <= FSliderRect.Right) ((Message.XPos >= FSliderRect.Left) and (Message.XPos <= FSliderRect.Right)
and (FSelectionMode = smRamp)); and (FSelectionMode = smRamp));
if Result then if Result then
begin begin
Shift := KeysToShiftState(Message.Keys); Shift := KeysToShiftState(Message.Keys);
@@ -723,6 +751,7 @@ begin
); );
if FSliderVisible then if FSliderVisible then
FSliderRect := Rect(FColorCombRect.Right, FCombSize, FColorCombRect.Right + 10 + FSliderWidth, FColorCombRect.Bottom - FCombSize) FSliderRect := Rect(FColorCombRect.Right, FCombSize, FColorCombRect.Right + 10 + FSliderWidth, FColorCombRect.Bottom - FCombSize)
// FSliderRect := Rect(FColorCombRect.Right, FColorCombRect.Top, FColorCombRect.Right + 10 + FSliderWidth, FColorCombRect.Bottom)
else else
FSliderRect := Rect(-1, -1, -1, -1); FSliderRect := Rect(-1, -1, -1, -1);
end; end;
@@ -759,7 +788,7 @@ var
Color1, Color2, dColor1, dColor2, dColor: TRGBrec; Color1, Color2, dColor1, dColor2, dColor: TRGBrec;
begin begin
// this ensures the radius and comb size is set correctly // this ensures the radius and comb size is set correctly
HandleNeeded; // HandleNeeded;
if FLevels < 1 then FLevels := 1; if FLevels < 1 then FLevels := 1;
// To draw perfectly aligned combs we split the final comb into six triangles (sextants) // To draw perfectly aligned combs we split the final comb into six triangles (sextants)
// and calculate each separately. The center comb is stored as first entry in the array // and calculate each separately. The center comb is stored as first entry in the array
@@ -1283,12 +1312,8 @@ end;
procedure THexaColorPicker.SetIntensity(v: integer); procedure THexaColorPicker.SetIntensity(v: integer);
var var
R: TRect; R: TRect;
s: single;
begin begin
s := v/100; FCenterIntensity := EnsureRange(v/100, 0, 1);
FCenterIntensity := s;
if FCenterIntensity < 0 then FCenterIntensity := 0;
if FCenterIntensity > 1 then FCenterIntensity := 1;
FCenterColor.Red := DefCenterColor.Red * FCenterIntensity; FCenterColor.Red := DefCenterColor.Red * FCenterIntensity;
FCenterColor.Green := DefCenterColor.Green * FCenterIntensity; FCenterColor.Green := DefCenterColor.Green * FCenterIntensity;
FCenterColor.Blue := DefCenterColor.Blue * FCenterIntensity; FCenterColor.Blue := DefCenterColor.Blue * FCenterIntensity;
@@ -1334,7 +1359,7 @@ begin
FRadius := r; FRadius := r;
DrawAll; DrawAll;
CalculateCombLayout; CalculateCombLayout;
DrawCombControls; // DrawCombControls;
Invalidate; Invalidate;
end; end;
@@ -1347,7 +1372,7 @@ begin
Width := FSliderRect.Right + 2; Width := FSliderRect.Right + 2;
// Height := FBWCombRect.Bottom + 2; // Height := FBWCombRect.Bottom + 2;
CalculateCombLayout; CalculateCombLayout;
DrawCombControls; // DrawCombControls;
Invalidate; Invalidate;
end; end;
end; end;
@@ -1467,7 +1492,8 @@ end;
procedure THexaColorPicker.SelectColor(Color: TColor); procedure THexaColorPicker.SelectColor(Color: TColor);
begin begin
SelectAvailableColor(Color); SelectAvailableColor(Color);
DrawCombControls; Invalidate;
// DrawCombControls;
if Assigned(FOnChange) then if Assigned(FOnChange) then
FOnChange(Self); FOnChange(Self);
end; end;
@@ -1479,7 +1505,7 @@ begin
FSliderVisible := Value; FSliderVisible := Value;
DrawAll; DrawAll;
CalculateCombLayout; CalculateCombLayout;
DrawCombControls; // DrawCombControls;
Invalidate; Invalidate;
end; end;
end; end;
@@ -1491,7 +1517,7 @@ begin
FMarker := Value; FMarker := Value;
DrawAll; DrawAll;
CalculateCombLayout; CalculateCombLayout;
DrawCombControls; //DrawCombControls;
Invalidate; Invalidate;
end; end;
end; end;
@@ -1503,7 +1529,7 @@ begin
FNewArrowStyle := Value; FNewArrowStyle := Value;
DrawAll; DrawAll;
CalculateCombLayout; CalculateCombLayout;
DrawCombControls; // DrawCombControls;
Invalidate; Invalidate;
end; end;
end; end;

23
components/mbColorLib/examples/fulldemo/main.lfm
View File

@@ -42,9 +42,9 @@ object Form1: TForm1
Height = 363 Height = 363
Top = 6 Top = 6
Width = 403 Width = 403
ActivePage = TabSheet3 ActivePage = TabSheet2
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
TabIndex = 2 TabIndex = 1
TabOrder = 0 TabOrder = 0
OnMouseMove = PageControl1MouseMove OnMouseMove = PageControl1MouseMove
object TabSheet1: TTabSheet object TabSheet1: TTabSheet
@@ -56,7 +56,7 @@ object Form1: TForm1
Height = 287 Height = 287
Top = 8 Top = 8
Width = 377 Width = 377
SelectedColor = 488454 SelectedColor = 553990
HSPickerHintFormat = 'H: %h S: %s'#13'Hex: %hex' HSPickerHintFormat = 'H: %h S: %s'#13'Hex: %hex'
LPickerHintFormat = 'Luminance: %l' LPickerHintFormat = 'Luminance: %l'
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
@@ -67,26 +67,27 @@ object Form1: TForm1
end end
object TabSheet2: TTabSheet object TabSheet2: TTabSheet
Caption = 'HexaColorPicker' Caption = 'HexaColorPicker'
ClientHeight = 303 ClientHeight = 335
ClientWidth = 391 ClientWidth = 395
ImageIndex = 1 ImageIndex = 1
object Label4: TLabel object Label4: TLabel
AnchorSideTop.Control = ComboBox1 AnchorSideTop.Control = ComboBox1
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 112 Left = 112
Height = 15 Height = 15
Top = 282 Top = 314
Width = 40 Width = 40
Caption = 'Marker:' Caption = 'Marker:'
ParentColor = False ParentColor = False
end end
object HexaColorPicker1: THexaColorPicker object HexaColorPicker1: THexaColorPicker
Left = 48 Left = 48
Height = 271 Height = 303
Top = 4 Top = 4
Width = 285 Width = 289
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %h' HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %h'
SliderMarker = smRect
IntensityText = 'Intensity' IntensityText = 'Intensity'
TabOrder = 0 TabOrder = 0
Constraints.MinHeight = 85 Constraints.MinHeight = 85
@@ -99,7 +100,7 @@ object Form1: TForm1
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 4 Left = 4
Height = 19 Height = 19
Top = 280 Top = 312
Width = 83 Width = 83
Caption = 'SliderVisible' Caption = 'SliderVisible'
Checked = True Checked = True
@@ -110,7 +111,7 @@ object Form1: TForm1
object ComboBox1: TComboBox object ComboBox1: TComboBox
Left = 160 Left = 160
Height = 23 Height = 23
Top = 278 Top = 310
Width = 71 Width = 71
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
ItemHeight = 15 ItemHeight = 15
@@ -129,7 +130,7 @@ object Form1: TForm1
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 256 Left = 256
Height = 20 Height = 20
Top = 279 Top = 311
Width = 101 Width = 101
Anchors = [akTop, akLeft, akBottom] Anchors = [akTop, akLeft, akBottom]
Caption = 'NewArrowStyle' Caption = 'NewArrowStyle'

4
components/mbColorLib/mbBasicPicker.pas
View File

@@ -67,7 +67,7 @@ const
constructor TmbBasicPicker.Create(AOwner: TComponent); constructor TmbBasicPicker.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
ControlStyle := ControlStyle - [csOpaque]; // ControlStyle := ControlStyle - [csOpaque];
ParentColor := true; ParentColor := true;
FHintTimer := TTimer.Create(self); FHintTimer := TTimer.Create(self);
FHintTimer.Interval := HINT_SHOW_DELAY; FHintTimer.Interval := HINT_SHOW_DELAY;
@@ -84,10 +84,12 @@ end;
procedure TmbBasicPicker.CMParentColorChanged(var Message: TLMessage); procedure TmbBasicPicker.CMParentColorChanged(var Message: TLMessage);
begin begin
{
if ParentColor then if ParentColor then
ControlStyle := ControlStyle - [csOpaque] ControlStyle := ControlStyle - [csOpaque]
else else
ControlStyle := ControlStyle + [csOpaque]; ControlStyle := ControlStyle + [csOpaque];
}
inherited; inherited;
end; end;