paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-05 19:20:38 +02:00
Code Issues Packages Projects Releases Wiki Activity

customdrawn: Postpones the palette creation time to avoid a circle between the LCL-CustomDrawn and the Drawer, each reading the palette from one another

Browse Source 
git-svn-id: trunk@33902 -
This commit is contained in:
sekelsenmat 2011-12-02 08:17:54 +00:00
parent 11ccee44cd
commit 7c2dbbb1e0
3 changed files with 29 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
lcl/customdrawn_common.pas
View File

@ -22,6 +22,7 @@ type
TCDDrawerCommon = class(TCDDrawer)
public
function PalDefaultUsesNativePalette: Boolean; override;
procedure LoadFallbackPaletteColors; override;
// General
function GetMeasures(AMeasureID: Integer): Integer; override;
@ -129,6 +130,15 @@ const
{ TCDDrawerCommon }
function TCDDrawerCommon.PalDefaultUsesNativePalette: Boolean;
begin
{$ifdef MSWindows}
Result := True;
{$else}
Result := False;
{$endif}
end;
procedure TCDDrawerCommon.LoadFallbackPaletteColors;
begin
Palette.BtnFace := WIN2000_BTNFACE;

4
lcl/customdrawncontrols.pas
View File

@ -723,10 +723,14 @@ begin
end;
procedure TCDControl.PrepareCurrentDrawer;
var
OldDrawer: TCDDrawer;
begin
OldDrawer := FDrawer;
FDrawer := GetDrawer(FDrawStyle);
if FDrawer = nil then FDrawer := GetDrawer(dsCommon); // avoid exceptions in the object inspector if an invalid drawer is selected
if FDrawer = nil then raise Exception.Create('No registered drawers were found');
if OldDrawer <> FDrawer then FDrawer.LoadPalette();
end;
procedure TCDControl.SetDrawStyle(const AValue: TCDDrawStyle);

33
lcl/customdrawndrawers.pas
View File

@ -251,15 +251,17 @@ type
public
Palette: TCDColorPalette;
FallbackPalette: TCDColorPalette;
PaletteKind: TCDPaletteKind;
constructor Create; virtual;
destructor Destroy; override;
procedure CreateResources; virtual;
procedure LoadResources; virtual;
procedure FreeResources; virtual;
procedure ScaleRasterImage(ARasterImage: TRasterImage; ASourceDPI, ADestDPI: Word);
procedure SetPaletteKind(APaletteKind: TCDPaletteKind);
procedure LoadPalette;
procedure LoadNativePaletteColors;
procedure LoadFallbackPaletteColors; virtual;
function PalDefaultUsesNativePalette: Boolean; virtual;
function GetDrawStyle: TCDDrawStyle; virtual;
// GetControlDefaultColor is used by customdrawncontrols to resolve clDefault
function GetControlDefaultColor(AControlId: TCDControlID): TColor;
@ -471,11 +473,13 @@ constructor TCDDrawer.Create;
begin
inherited Create;
// We never load the system palette at creation because we might get created
// before the Widgetset is constructed
Palette := TCDColorPalette.Create;
SetPaletteKind(palFallback);
LoadFallbackPaletteColors();
FallbackPalette := TCDColorPalette.Create;
FallbackPalette.Assign(Palette);
SetPaletteKind(palDefault);
PaletteKind := palDefault;
CreateResources;
LoadResources;
@ -515,24 +519,12 @@ begin
ARasterImage.Height := lNewHeight;
end;
procedure TCDDrawer.SetPaletteKind(APaletteKind: TCDPaletteKind);
var
lIsOnNativeSystem: Boolean = False;
lStyle: TCDDrawStyle;
procedure TCDDrawer.LoadPalette;
begin
case APaletteKind of
case PaletteKind of
palDefault:
begin
lStyle := GetDrawStyle();
case lStyle of
dsWinCE: lIsOnNativeSystem := {$ifdef WinCE}True{$else}False{$endif};
dsCommon, dsWin2000, dsWinXP:
lIsOnNativeSystem := {$ifdef MSWindows}True{$else}False{$endif};
else
lIsOnNativeSystem := False;
end;
if lIsOnNativeSystem then LoadNativePaletteColors()
if PalDefaultUsesNativePalette() then LoadNativePaletteColors()
else LoadFallbackPaletteColors();
end;
palNative: LoadNativePaletteColors();
@ -582,6 +574,11 @@ begin
end;
function TCDDrawer.PalDefaultUsesNativePalette: Boolean;
begin
Result := False;
end;
function TCDDrawer.GetDrawStyle: TCDDrawStyle;
begin
Result := dsCommon;