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

mbColorLib: Fix painting issues of mbColorPalette

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5516 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-12-16 14:22:33 +00:00
parent 88b3257b59
commit 8baa12ec3b
6 changed files with 129 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
components/mbColorLib/mbBasicPicker.pas
View File

@@ -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