paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

mbColorLib: Fix painting of transparent background

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5467 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2016-12-13 09:59:28 +00:00
parent 060a6d39bd
commit 5795461441
6 changed files with 66 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
components/mbColorLib/HSLColorPicker.pas
View File

@ -52,7 +52,7 @@ type
procedure CreateWnd; override; procedure CreateWnd; override;
procedure Resize; override; procedure Resize; override;
procedure Paint; override; procedure Paint; override;
procedure PaintParentBack; override; // procedure PaintParentBack; override;
procedure WMSetFocus(var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF}); procedure WMSetFocus(var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF});
message {$IFDEF FPC}LM_SETFOCUS{$ELSE}WM_SETFOCUS{$ENDIF}; message {$IFDEF FPC}LM_SETFOCUS{$ELSE}WM_SETFOCUS{$ENDIF};
procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
@ -109,8 +109,8 @@ uses
constructor THSLColorPicker.Create(AOwner: TComponent); constructor THSLColorPicker.Create(AOwner: TComponent);
begin begin
inherited; inherited;
ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque]; // ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque];
DoubleBuffered := true; //DoubleBuffered := true;
PBack := TBitmap.Create; PBack := TBitmap.Create;
PBack.PixelFormat := pf32bit; PBack.PixelFormat := pf32bit;
{$IFDEF DELPHI_7_UP} {$IFDEF DELPHI} {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI}
@ -323,7 +323,7 @@ function THSLColorPicker.GetManual:boolean;
begin begin
Result := FHSPicker.Manual or FLPicker.Manual; Result := FHSPicker.Manual or FLPicker.Manual;
end; end;
(*
procedure THSLColorPicker.PaintParentBack; procedure THSLColorPicker.PaintParentBack;
begin begin
if PBack = nil then if PBack = nil then
@ -333,13 +333,20 @@ begin
end; end;
PBack.Width := Width; PBack.Width := Width;
PBack.Height := Height; PBack.Height := Height;
PaintParentBack(PBack); if Color = clDefault then begin
PBack.Transparent := true;
PBack.TransparentColor := clForm;
PBack.Canvas.Brush.Color := clForm;
end else
PBack.Canvas.Brush.Color := Color;
PBack.Canvas.FillRect(0, 0, Width, Height);
// PaintParentBack(PBack);
end; end;
*)
procedure THSLColorPicker.Resize; procedure THSLColorPicker.Resize;
begin begin
inherited; inherited;
PaintParentBack; // PaintParentBack(Canvas);
if (FHSPicker = nil) or (FLPicker = nil) then if (FHSPicker = nil) or (FLPicker = nil) then
exit; exit;
@ -354,12 +361,12 @@ end;
procedure THSLColorPicker.CreateWnd; procedure THSLColorPicker.CreateWnd;
begin begin
inherited; inherited;
PaintParentBack; // PaintParentBack;
end; end;
procedure THSLColorPicker.Paint; procedure THSLColorPicker.Paint;
begin begin
PaintParentBack; PaintParentBack(Canvas);
Canvas.Draw(0, 0, PBack); Canvas.Draw(0, 0, PBack);
end; end;

15
components/mbColorLib/HexaColorPicker.pas
View File

@ -295,24 +295,28 @@ var
XOffs, YOffs, Count: Integer; XOffs, YOffs, Count: Integer;
dColor: Single; dColor: Single;
OffScreen: TBitmap; OffScreen: TBitmap;
{$IFDEF DELPHI_7_UP} {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI}
MemDC: HDC; MemDC: HDC;
OldBMP: HBITMAP; OldBMP: HBITMAP;
{$ENDIF} {$ENDIF} {$ENDIF}
begin begin
OffScreen := TBitmap.Create; OffScreen := TBitmap.Create;
try try
OffScreen.PixelFormat := pf32bit; // OffScreen.PixelFormat := pf32bit;
OffScreen.Width := Width; OffScreen.Width := Width;
OffScreen.Height := FColorCombRect.Bottom - FColorCombRect.Top + FBWCombRect.Bottom - FBWCombRect.Top; OffScreen.Height := FColorCombRect.Bottom - FColorCombRect.Top + FBWCombRect.Bottom - FBWCombRect.Top;
//Parent background //Parent background
{$IFDEF FPC} {$IFDEF FPC}
if Color = clDefault then if Color = clDefault then
begin
Offscreen.Transparent := true;
Offscreen.TransparentColor := clForm;
Offscreen.Canvas.Brush.Color := clForm Offscreen.Canvas.Brush.Color := clForm
else end else
{$ENDIF} {$ENDIF}
OffScreen.Canvas.Brush.Color := Color; OffScreen.Canvas.Brush.Color := Color;
OffScreen.Canvas.FillRect(OffScreen.Canvas.ClipRect); OffScreen.Canvas.FillRect(OffScreen.Canvas.ClipRect);
{$IFDEF DELPHI_7_UP}{$IFDEF DELPHI} {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI}
if ParentBackground then if ParentBackground then
with ThemeServices do with ThemeServices do
@ -325,6 +329,7 @@ begin
if MemDC <> 0 then DeleteDC(MemDC); if MemDC <> 0 then DeleteDC(MemDC);
end; end;
{$ENDIF}{$ENDIF} {$ENDIF}{$ENDIF}
with OffScreen.Canvas do with OffScreen.Canvas do
begin begin
Pen.Style := psClear; Pen.Style := psClear;
@ -454,7 +459,7 @@ end;
procedure THexaColorPicker.Paint; procedure THexaColorPicker.Paint;
begin begin
PaintParentBack; PaintParentBack; //(Canvas);
if FColorCombs = nil then if FColorCombs = nil then
CalculateCombLayout; CalculateCombLayout;
DrawCombControls; DrawCombControls;

12
components/mbColorLib/SLHColorPicker.pas
View File

@ -52,7 +52,7 @@ type
procedure DoChange; procedure DoChange;
procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure Paint; override; procedure Paint; override;
procedure PaintParentBack; override; // procedure PaintParentBack; override;
procedure Resize; override; procedure Resize; override;
procedure WMSetFocus(var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF}); procedure WMSetFocus(var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF});
message {$IFDEF FPC}LM_SETFOCUS{$ELSE}WM_SETFOCUS{$ENDIF}; message {$IFDEF FPC}LM_SETFOCUS{$ELSE}WM_SETFOCUS{$ENDIF};
@ -329,7 +329,7 @@ end;
procedure TSLHColorPicker.Resize; procedure TSLHColorPicker.Resize;
begin begin
inherited; inherited;
PaintParentBack; // PaintParentBack;
if (FSLPicker = nil) or (FHPicker = nil) then if (FSLPicker = nil) or (FHPicker = nil) then
exit; exit;
@ -340,7 +340,7 @@ begin
FHPicker.Left := Width - FHPicker.Width; FHPicker.Left := Width - FHPicker.Width;
FHPicker.Height := Height; FHPicker.Height := Height;
end; end;
{
procedure TSLHColorPicker.PaintParentBack; procedure TSLHColorPicker.PaintParentBack;
begin begin
if PBack = nil then if PBack = nil then
@ -351,12 +351,12 @@ begin
PBack.Width := Width; PBack.Width := Width;
PBack.Height := Height; PBack.Height := Height;
PaintParentBack(PBack); PaintParentBack(PBack);
end; end; }
procedure TSLHColorPicker.Paint; procedure TSLHColorPicker.Paint;
begin begin
PaintParentBack; PaintParentBack(Canvas);
Canvas.Draw(0, 0, PBack); // Canvas.Draw(0, 0, PBack);
end; end;
procedure TSLHColorPicker.CreateWnd; procedure TSLHColorPicker.CreateWnd;

30
components/mbColorLib/mbBasicPicker.pas
View File

@ -45,12 +45,12 @@ type
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
{$ELSE} {$ELSE}
procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED; procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED;
procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND; // procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
{$ENDIF} {$ENDIF}
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
function GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor; override; // function GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor; override;
published published
property ParentColor default true; property ParentColor default true;
end; end;
@ -95,11 +95,11 @@ procedure TmbBasicPicker.CreateGradient;
begin begin
// to be implemented by descendants // to be implemented by descendants
end; end;
{
function TmbBasicPicker.GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor; function TmbBasicPicker.GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor;
begin begin
result := inherited GetDefaultColor(DefaultColorType); result := inherited GetDefaultColor(DefaultColorType);
end; end; }
function TmbBasicPicker.GetGradientColor(AValue: Integer): TColor; function TmbBasicPicker.GetGradientColor(AValue: Integer): TColor;
begin begin
@ -170,13 +170,19 @@ end;
procedure TmbBasicPicker.PaintParentBack(ABitmap: TBitmap); procedure TmbBasicPicker.PaintParentBack(ABitmap: TBitmap);
begin begin
ABitmap.Width := Width;
ABitmap.Height := Height;
{$IFNDEF DELPHI} {$IFNDEF DELPHI}
if Color = clDefault then if Color = clDefault then begin
ABitmap.Canvas.Brush.Color := GetDefaultColor(dctBrush) ABitmap.Transparent := true;
else ABitmap.TransparentColor := clForm;
ABitmap.Canvas.Brush.Color := clForm; //GetDefaultColor(dctBrush)
end else
{$ENDIF} {$ENDIF}
ABitmap.Canvas.Brush.Color := Color; ABitmap.Canvas.Brush.Color := Color;
ABitmap.Canvas.FillRect(ABitmap.Canvas.ClipRect); ABitmap.Canvas.FillRect(ABitmap.Canvas.ClipRect);
Canvas.Draw(0, 0, ABitmap);
{$IFDEF DELPHI_7_UP}{$IFDEF DELPHI} {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI}
if ParentBackground then if ParentBackground then
with ThemeServices do with ThemeServices do
@ -197,7 +203,11 @@ var
begin begin
Offscreen := TBitmap.Create; Offscreen := TBitmap.Create;
try try
Offscreen.PixelFormat := pf32bit; // Offscreen.PixelFormat := pf32bit;
if Color = clDefault then begin
Offscreen.Transparent := true;
Offscreen.TransparentColor := GetDefaultColor(dctBrush);
end;
Offscreen.Width := Width; Offscreen.Width := Width;
Offscreen.Height := Height; Offscreen.Height := Height;
PaintParentBack(Offscreen); PaintParentBack(Offscreen);
@ -244,13 +254,13 @@ begin
Result := true; Result := true;
end; end;
(* !!!!!!!!!!!!!!!!!
procedure TmbBasicPicker.WMEraseBkgnd( procedure TmbBasicPicker.WMEraseBkgnd(
var Message: {$IFDEF DELPHI}TWMEraseBkgnd{$ELSE}TLMEraseBkgnd{$ENDIF} ); var Message: {$IFDEF DELPHI}TWMEraseBkgnd{$ELSE}TLMEraseBkgnd{$ENDIF} );
begin begin
inherited; inherited;
// Message.Result := 1; // Message.Result := 1;
end; end; *)
end. end.

8
components/mbColorLib/mbColorTree.pas
View File

@ -348,7 +348,7 @@ begin
if Selected then if Selected then
Brush.Color := clHighlight Brush.Color := clHighlight
else else
Brush.Color := Color; //clBtnFace; Brush.Color := Color;
FillRect(R); FillRect(R);
MoveTo(R.Left, R.Bottom - 1); MoveTo(R.Left, R.Bottom - 1);
LineTo(R.Right, R.Bottom - 1); LineTo(R.Right, R.Bottom - 1);
@ -427,13 +427,15 @@ begin
Font.Style := [fsBold]; Font.Style := [fsBold];
if Selected then if Selected then
begin begin
Brush.Color := clHighlightText; //Brush.Color := clHighlightText;
Pen.Color := clHighlightText; Pen.Color := clHighlightText;
Font.Color := clHighlightText;
end end
else else
begin begin
Brush.Color := clWindowText; //Brush.Color := clWindowText;
Pen.Color := clWindowText; Pen.Color := clWindowText;
Font.Color := clWindowText;
end; end;
TR := Rect(R.Left + 48, R.Top + (48 - TextHeight(itemText)) div 2, R.Right - 15, R.Bottom); TR := Rect(R.Left + 48, R.Top + (48 - TextHeight(itemText)) div 2, R.Right - 15, R.Bottom);
if Assigned(FDraw) then FDraw(Self, Index, Canvas.Font, itemText, Selected); if Assigned(FDraw) then FDraw(Self, Index, Canvas.Font, itemText, Selected);

12
components/mbColorLib/mbTrackBarPicker.pas
View File

@ -56,7 +56,6 @@ type
FBevelOuter: TBevelCut; FBevelOuter: TBevelCut;
FBevelWidth: TBevelWidth; FBevelWidth: TBevelWidth;
FBorderStyle: TBorderStyle; FBorderStyle: TBorderStyle;
procedure SetBevelInner(Value: TBevelCut); procedure SetBevelInner(Value: TBevelCut);
procedure SetBevelOuter(Value: TBevelCut); procedure SetBevelOuter(Value: TBevelCut);
procedure SetBevelWidth(Value: TBevelWidth); procedure SetBevelWidth(Value: TBevelWidth);
@ -77,8 +76,10 @@ type
FPickRect: TRect; FPickRect: TRect;
FLayout: TTrackBarLayout; FLayout: TTrackBarLayout;
FLimit: integer; FLimit: integer;
FBack: TBitmap;
procedure CreateGradient; override; procedure CreateGradient; override;
procedure Paint; override; procedure Paint; override;
// procedure PaintParentBack;
procedure DrawFrames; dynamic; procedure DrawFrames; dynamic;
procedure Resize; override; procedure Resize; override;
procedure CreateWnd; override; procedure CreateWnd; override;
@ -191,7 +192,7 @@ const
constructor TmbTrackBarPicker.Create(AOwner: TComponent); constructor TmbTrackBarPicker.Create(AOwner: TComponent);
begin begin
inherited; inherited;
ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque]; //ControlStyle := ControlStyle - [csAcceptsControls]; // + [csOpaque]; // !!!!!!!!
DoubleBuffered := true; DoubleBuffered := true;
{$IFDEF DELPHI_7_UP} {$IFDEF DELPHI} {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI}
ParentBackground := true; ParentBackground := true;
@ -200,10 +201,14 @@ begin
Height := 22; Height := 22;
TabStop := true; TabStop := true;
ParentShowHint := true; ParentShowHint := true;
FBack := TBitmap.Create;
FGradientWidth := 256; FGradientWidth := 256;
FGradientHeight := 12; FGradientHeight := 12;
FGradientBmp := TBitmap.Create; FGradientBmp := TBitmap.Create;
FGradientBmp.PixelFormat := pf32bit; FGradientBmp.PixelFormat := pf32bit;
mx := 0; mx := 0;
my := 0; my := 0;
FIncrement := 1; FIncrement := 1;
@ -232,6 +237,7 @@ end;
destructor TmbTrackbarPicker.Destroy; destructor TmbTrackbarPicker.Destroy;
begin begin
FGradientBmp.Free; FGradientBmp.Free;
FBack.Free;
inherited; inherited;
end; end;
@ -385,7 +391,7 @@ end;
procedure TmbTrackBarPicker.Paint; procedure TmbTrackBarPicker.Paint;
begin begin
CalcPickRect; CalcPickRect;
PaintParentBack; PaintParentBack(Canvas);
FArrowPos := GetArrowPos; FArrowPos := GetArrowPos;
Execute(TBA_Paint); Execute(TBA_Paint);
if FBorderStyle <> bsNone then if FBorderStyle <> bsNone then