From 8baa12ec3b9573f726d607741a72cbd1f3350203 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 16 Dec 2016 14:22:33 +0000 Subject: [PATCH] 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 | 3 +- .../mbColorLib/examples/fulldemo/main.lfm | 19 ++-- .../mbColorLib/examples/fulldemo/main.pas | 17 ++- components/mbColorLib/mbBasicPicker.pas | 31 +++++- components/mbColorLib/mbColorPalette.pas | 101 +++++++++++------- components/mbColorLib/mbutils.pas | 17 ++- 6 files changed, 129 insertions(+), 59 deletions(-) diff --git a/components/mbColorLib/HexaColorPicker.pas b/components/mbColorLib/HexaColorPicker.pas index badbb97b0..8b78e6389 100644 --- a/components/mbColorLib/HexaColorPicker.pas +++ b/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 diff --git a/components/mbColorLib/examples/fulldemo/main.lfm b/components/mbColorLib/examples/fulldemo/main.lfm index 880b5a8e3..4ce87495a 100644 --- a/components/mbColorLib/examples/fulldemo/main.lfm +++ b/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 - VertScrollBar.Page = 234 + HorzScrollBar.Page = 385 + 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 diff --git a/components/mbColorLib/examples/fulldemo/main.pas b/components/mbColorLib/examples/fulldemo/main.pas index 04a7ae002..ef5241c26 100644 --- a/components/mbColorLib/examples/fulldemo/main.pas +++ b/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; - var AllowChange: Boolean); +procedure TForm1.UpDown1ChangingEx(Sender: TObject; var AllowChange: Boolean; + NewValue: SmallInt; Direction: TUpDownDirection); begin -allowchange := true; -mbcolorpalette1.CellSize := abs(updown1.Position); + allowchange := true; + mbcolorpalette1.CellSize := abs(NewValue); end; procedure TForm1.CbWebSsafeClick(Sender: TObject); diff --git a/components/mbColorLib/mbBasicPicker.pas b/components/mbColorLib/mbBasicPicker.pas index 2e7695816..3dc453bc0 100644 --- a/components/mbColorLib/mbBasicPicker.pas +++ b/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 diff --git a/components/mbColorLib/mbColorPalette.pas b/components/mbColorLib/mbColorPalette.pas index 7b9e652db..c2fe7518b 100644 --- a/components/mbColorLib/mbColorPalette.pas +++ b/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,25 +172,25 @@ type implementation +uses + mbUtils; + { TmbColorPalette } constructor TmbColorPalette.Create(AOwner: TComponent); begin inherited Create(AOwner); -// ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque]; +// ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque]; // 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; - Height := 126; + SetInitialBounds(0, 0, 180, 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; - FTempBmp.Height := Height; - PaintParentBack(FTempBmp); + if FBufferBmp = nil then + FBufferBmp := TBitmap.Create; + 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(clr, 'clCustom') and not SameText(clr, 'clTransparent') then + if not SameText(AColor, 'clCustom') and not SameText(AColor, 'clTransparent') then case FCellStyle of csDefault: begin InflateRect(R, -3, -3); if Enabled then begin - FTempBmp.Canvas.Brush.Color := c; - FTempBmp.Canvas.Pen.Color := clBtnShadow; + ACanvas.Brush.Color := c; + ACanvas.Pen.Color := clBtnShadow; end else begin - FTempBmp.Canvas.Brush.Color := clGray; - FTempBmp.Canvas.Pen.Color := clGray; + ACanvas.Brush.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; - FTempBmp.Canvas.FillRect(R); + ACanvas.Brush.Color := clGray; + ACanvas.FillRect(R); Exit; end; end; //if transparent draw the glyph - if SameText(clr, 'clTransparent') then - PaintTransparentGlyph(FTempBmp.Canvas, R); + if SameText(AColor, 'clTransparent') then + PaintTransparentGlyph(ACanvas, R); end; end; @@ -454,8 +482,8 @@ begin with ThemeServices do if Enabled then case FState of - ccsNone: ; - //ccsNone: ACanvas.CopyRect(R, PBack.Canvas, R); + 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); ccsChecked: DrawElement(ACanvas.Handle, GetElementDetails(ttbButtonChecked), 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; diff --git a/components/mbColorLib/mbutils.pas b/components/mbColorLib/mbutils.pas index 1da1abbb0..a3bca921b 100644 --- a/components/mbColorLib/mbutils.pas +++ b/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 WidthOf(R: TRect): Integer; +function HeightOfRect(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