diff --git a/components/colorpalette/colorpalette.pas b/components/colorpalette/colorpalette.pas index e5c832eae..c8476ab52 100644 --- a/components/colorpalette/colorpalette.pas +++ b/components/colorpalette/colorpalette.pas @@ -22,6 +22,7 @@ Color palette grid with custom palette support. The OnColorPick event is fired when user picks a color. The LoadPalette procedure loads custom palette. + Custom palette example: $COLS 8 @@ -51,7 +52,6 @@ uses LCLType; type - TPickMode = ( pmDefault, // Select color at mouse-down, ColorPick event at mouse-up if at same pos pmImmediate, // Select color and ColorPick event at mouse-down @@ -64,12 +64,27 @@ type TPaletteSelectionKind = (pskNone, pskThin, pskThinInverted, pskThick, pskThickInverted); - TColorMouseEvent = procedure (Sender: TObject; AColor: TColor; Shift: TShiftState) of object; - TColorPaletteHintEvent = procedure (Sender: TObject; AColor: TColor; var AText: String) of object; + TPaletteItem = ( + piColors, piColumnCount, piFlipped, + piButtonBorder, piButtonSize, piButtonDistance, + piSelKind, piSelColor + ); + TPaletteItems = set of TPaletteItem; +const + piAll = [piColors, piColumnCount, piFlipped, + piButtonBorder, piButtonSize, piButtonDistance, + piSelKind, piSelColor + ]; + + +type { TCustomColorPalette } + TColorMouseEvent = procedure (Sender: TObject; AColor: TColor; Shift: TShiftState) of object; + TColorPaletteHintEvent = procedure (Sender: TObject; AColor: TColor; var AText: String) of object; + TCustomColorPalette = class(TGraphicControl) private FSizeToLastCol: Integer; @@ -110,13 +125,13 @@ type procedure SetColorNames(AIndex: Integer; const AValue: String); procedure SetColors(AIndex: Integer; const AValue: TColor); procedure SetCols(AValue: Integer); + procedure SetFlipped(AValue: Boolean); procedure SetGradientSteps(AValue: Byte); procedure SetPaletteKind(AValue: TPaletteKind); procedure SetPickedIndex(AValue: Integer); procedure SetSelectionColor(AValue: TColor); procedure SetSelectionKind(AValue: TPaletteSelectionKind); procedure SetUseSpacers(AValue: Boolean); - procedure SetFlipped(AValue: Boolean); protected procedure BlendWBColor(AColor: TColor; Steps: Integer); @@ -165,7 +180,8 @@ type procedure ClearColors; procedure DeleteColor(AIndex: Integer); procedure InsertColor(AIndex: Integer; AColor: TColor; AColorName: String = ''); - procedure LoadPalette(const FileName: String); + procedure LoadPalette(const FileName: String; + AItems: TPaletteItems = [piColors, piColumnCount]); procedure SavePalette(const FileName: String); property Colors[Index: Integer]: TColor read GetColors write SetColors; @@ -237,6 +253,11 @@ implementation uses LCLIntf, StrUtils; +const + SELKIND_NAMES: Array[TPaletteSelectionKind] of String = ( + 'NONE', 'THIN', 'THIN-INV', 'THICK', 'THICK-INV' + ); + procedure Register; begin RegisterComponents('Misc', [TColorPalette]); @@ -486,13 +507,15 @@ begin DoInsertColor(AIndex, AColor, AColorName); end; -procedure TCustomColorPalette.LoadPalette(const FileName: String); +procedure TCustomColorPalette.LoadPalette(const FileName: String; + AItems: TPaletteItems = [piColors, piColumnCount]); var F: TextFile; Line: String; C: TColor; clrName: String; p, steps: Integer; + sk: TPaletteSelectionKind; procedure ParseColor(S: String; out AColor: TColor; out Steps: Integer; out ColorName: String); @@ -578,10 +601,51 @@ begin if Line[1] = '$' then begin if Copy(Line, 2, 4) = 'NONE' then - DoAddColor(clNone); - if Copy(Line, 2, 4) = 'COLS' then - FCols := StrToIntDef(Copy(Line, 6, MaxInt), 8); - if Copy(Line, 2, 7) = 'BLENDWB' then + DoAddColor(clNone) + else + if (Copy(Line, 2, 4) = 'COLS') and (piColumnCount in AItems) then + FCols := StrToIntDef(Copy(Line, 6, MaxInt), FCols) + else + if (Copy(Line, 2, 7) = 'BTNDIST') and (piButtonDistance in AItems) then + FButtonDistance := StrToIntDef(Copy(Line, 9, MaxInt), FButtonDistance) + else + if (Copy(Line, 2, 8) = 'BTNWIDTH') and (piButtonSize in AItems) then + FButtonWidth := StrToIntDef(Copy(Line, 10, MaxInt), FButtonWidth) + else + if (Copy(Line, 2, 9) = 'BTNHEIGHT') and (piButtonSize in AItems) then + FButtonHeight := StrToIntDef(Copy(Line, 11, MaxInt), FButtonHeight) + else + if (Copy(Line, 2, 9) = 'BTNBORDER') and (piButtonBorder in AItems) then + begin + Delete(Line, 1, 11); + ParseColor(Line, C, steps, clrName); + FButtonBorderColor := C; + end else + if (Copy(Line, 2, 7) = 'FLIPPED') and (piFlipped in AItems) then + begin + Delete(Line, 1, 9); + case Line of + 'TRUE' : FFlipped := true; + 'FALSE': FFlipped := false; + end; + end else + if (Copy(Line, 2, 7) = 'SELKIND') and (piSelKind in AItems) then + begin + Delete(Line, 1, 9); + for sk in TPaletteSelectionKind do + if Line = SELKIND_NAMES[sk] then + begin + FSelectionKind := sk; + break; + end; + end else + if (Copy(Line, 2, 8) = 'SELCOLOR') and (piSelColor in AItems) then + begin + Delete(Line, 1, 10); + ParseColor(Line, C, steps, clrName); + FSelectionColor := C; + end else + if (Copy(Line, 2, 7) = 'BLENDWB') and (piColors in AItems) then begin Delete(Line, 1, 8); ParseColor(Line, C, steps, clrName); @@ -589,7 +653,7 @@ begin end; end else - if Pos(',', Line) > 0 then + if (Pos(',', Line) > 0) and (piColors in AItems) then begin ParseColor(Line, C, steps, clrName); DoAddColor(C, clrName); @@ -807,7 +871,17 @@ var begin L := TStringList.Create; try + L.Add('# PROPERTIES'); + L.Add(Format('$BTNBORDER %d, %d, %d', [Red(FButtonBorderColor), Green(FButtonBorderColor), Blue(FButtonBorderColor)])); + L.ADd(Format('$BTNWIDTH %d', [FButtonWidth])); + L.Add(Format('$BTNHEIGHT %d', [FButtonHeight])); + L.Add(Format('$BTNDIST %d', [FButtonDistance])); + L.Add(Format('$SELKIND %s', [SELKIND_NAMES[FSelectionKind]])); + L.Add(Format('$SELCOLOR %d, %d, %d', [Red(FSelectionColor), Green(FSelectionColor), Blue(FSelectionColor)])); + L.Add(Format('$FLIPPED %s', [BoolToStr(FFlipped, 'TRUE', 'FALSE')])); L.Add(Format('$COLS %d', [FCols])); + L.Add(''); + L.Add('# COLORS'); for i:=0 to FColors.Count-1 do begin clr := Colors[i]; if clr = clNone then diff --git a/components/colorpalette/demo/GeneralDemo/unit1.lfm b/components/colorpalette/demo/GeneralDemo/unit1.lfm index 6d7468c3a..99ceb11c8 100644 --- a/components/colorpalette/demo/GeneralDemo/unit1.lfm +++ b/components/colorpalette/demo/GeneralDemo/unit1.lfm @@ -1,22 +1,22 @@ object MainForm: TMainForm Left = 394 - Height = 555 + Height = 586 Top = 287 Width = 625 Caption = 'MainForm' - ClientHeight = 555 + ClientHeight = 586 ClientWidth = 625 OnCreate = FormCreate ShowHint = True LCLVersion = '1.5' object LeftPanel: TPanel Left = 0 - Height = 555 + Height = 586 Top = 0 Width = 160 Align = alLeft BevelOuter = bvNone - ClientHeight = 555 + ClientHeight = 586 ClientWidth = 160 TabOrder = 0 object ColorSample: TShape @@ -50,7 +50,7 @@ object MainForm: TMainForm object BtnLoadRndPalette: TButton Left = 10 Height = 25 - Top = 408 + Top = 437 Width = 137 Caption = 'Load random palette' Enabled = False @@ -60,7 +60,7 @@ object MainForm: TMainForm object BtnCreateRndPalette: TButton Left = 10 Height = 25 - Top = 379 + Top = 408 Width = 137 Caption = 'Create random palette' OnClick = BtnCreateRndPaletteClick @@ -69,7 +69,7 @@ object MainForm: TMainForm object BtnAddColor: TButton Left = 10 Height = 25 - Top = 485 + Top = 514 Width = 137 Caption = 'Add color...' OnClick = BtnAddColorClick @@ -87,7 +87,7 @@ object MainForm: TMainForm object BtnDeleteColor: TButton Left = 10 Height = 25 - Top = 514 + Top = 543 Width = 137 Caption = 'Delete color #0' OnClick = BtnDeleteColorClick @@ -96,9 +96,10 @@ object MainForm: TMainForm object BtnSavePalette: TButton Left = 10 Height = 25 - Top = 446 + Top = 475 Width = 137 Caption = 'Save palette...' + OnClick = BtnSavePaletteClick TabOrder = 6 end object LblGradientSteps: TLabel @@ -175,10 +176,19 @@ object MainForm: TMainForm Visible = False WordWrap = True end + object BtnLoadPaletteAndProps: TButton + Left = 10 + Height = 25 + Top = 367 + Width = 137 + Caption = 'Load palette && props...' + OnClick = BtnLoadPaletteClick + TabOrder = 9 + end end object Bevel1: TBevel Left = 160 - Height = 539 + Height = 570 Top = 8 Width = 3 Align = alLeft @@ -188,12 +198,12 @@ object MainForm: TMainForm end object RightPanel: TPanel Left = 465 - Height = 555 + Height = 586 Top = 0 Width = 160 Align = alRight BevelOuter = bvNone - ClientHeight = 555 + ClientHeight = 586 ClientWidth = 160 TabOrder = 1 object LblButtonDistance: TLabel @@ -415,7 +425,7 @@ object MainForm: TMainForm end object Bevel2: TBevel Left = 462 - Height = 539 + Height = 570 Top = 8 Width = 3 Align = alRight @@ -425,7 +435,7 @@ object MainForm: TMainForm end object ScrollBox: TScrollBox Left = 168 - Height = 539 + Height = 570 Top = 8 Width = 287 HorzScrollBar.Increment = 15 @@ -438,7 +448,7 @@ object MainForm: TMainForm VertScrollBar.Tracking = True Anchors = [akTop, akLeft, akRight, akBottom] BorderStyle = bsNone - ClientHeight = 539 + ClientHeight = 570 ClientWidth = 287 TabOrder = 2 object ColorPalette: TColorPalette diff --git a/components/colorpalette/demo/GeneralDemo/unit1.pas b/components/colorpalette/demo/GeneralDemo/unit1.pas index 91bdc4b2d..86890df1c 100644 --- a/components/colorpalette/demo/GeneralDemo/unit1.pas +++ b/components/colorpalette/demo/GeneralDemo/unit1.pas @@ -16,6 +16,7 @@ type Bevel1: TBevel; Bevel2: TBevel; BtnDeleteColor: TButton; + BtnLoadPaletteAndProps: TButton; BtnSavePalette: TButton; BtnLoadRndPalette: TButton; BtnCreateRndPalette: TButton; @@ -66,6 +67,7 @@ type procedure BtnEditColorClick(Sender: TObject); procedure BtnLoadPaletteClick(Sender: TObject); procedure BtnLoadRndPaletteClick(Sender: TObject); + procedure BtnSavePaletteClick(Sender: TObject); procedure CbBuiltinPalettesSelect(Sender: TObject); procedure CbBkColorSelect(Sender: TObject); procedure CbCustomHintTextChange(Sender: TObject); @@ -163,20 +165,18 @@ begin with OpenDialog do if Execute then begin - ColorPalette.LoadPalette(FileName); - UpdateCaption; + if Sender = BtnLoadPaletteAndProps then + ColorPalette.LoadPalette(FileName, piAll) else + ColorPalette.LoadPalette(FileName); EdColCount.Value := ColorPalette.ColumnCount; + CbSelKind.ItemIndex := ord(Colorpalette.SelectionKind); + CbSelColor.Selected := ColorPalette.SelectionColor; + CbButtonBorderColor.Selected := ColorPalette.ButtonBorderColor; + EdButtonSize.Value := ColorPalette.ButtonWidth; + EdButtonDistance.Value := ColorPalette.ButtonDistance; + CbFlipped.Checked := ColorPalette.Flipped; + UpdateCaption; end; - { - if not FileExists('..\default.pal') then - begin - ShowMessage('File "default.pal" not found. Copy it from the TColorPalette folder to the current exe folder.'); - exit; - end; - ColorPalette.LoadPalette('..\default.pal'); - UpdateCaption; - EdColCount.Value := ColorPalette.ColumnCount; - } end; procedure TMainForm.BtnLoadRndPaletteClick(Sender: TObject); @@ -186,6 +186,12 @@ begin EdColCount.Value := ColorPalette.ColumnCount; end; +procedure TMainForm.BtnSavePaletteClick(Sender: TObject); +begin + if SaveDialog.Execute then + ColorPalette.SavePalette(SaveDialog.FileName); +end; + procedure TMainForm.BtnEditColorClick(Sender: TObject); begin if BtnEditColor.caption = 'Edit' then