diff --git a/components/colorpalette/colorpalette.pas b/components/colorpalette/colorpalette.pas index dec833708..8a6f87089 100644 --- a/components/colorpalette/colorpalette.pas +++ b/components/colorpalette/colorpalette.pas @@ -66,6 +66,7 @@ type FRows: Integer; FColors: TList; MX, MY: integer; + function GetColorCount: Integer; function GetColors(Index: Integer): TColor; procedure SetButtonHeight(const AValue: Integer); procedure SetButtonWidth(const AValue: Integer); @@ -77,6 +78,7 @@ type procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override; procedure ColorPick(AColor: TColor; Shift: TShiftState); dynamic; procedure ColorMouseMove(AColor: TColor; Shift: TShiftState); dynamic; + procedure DoAddColor(AColor: TColor); public PickedColor: TColor; PickShift: TShiftState; @@ -84,11 +86,14 @@ type destructor Destroy; override; procedure Paint; override; public + procedure AddColor(AColor: TColor); + procedure DeleteColor(AIndex: Integer); procedure LoadPalette(const FileName: String); property ButtonWidth: Integer read FButtonWidth write SetButtonWidth; property ButtonHeight: Integer read FButtonHeight write SetButtonHeight; property Colors[Index: Integer]: TColor read GetColors write SetColors; + property ColorCount: Integer read GetColorCount; property OnColorPick: TColorMouseEvent read FOnColorPick write FOnColorPick; property OnColorMouseMove: TColorMouseEvent read FOnColorMouseMove write FOnColorMouseMove; @@ -149,9 +154,14 @@ begin UpdateSize; end; +function TCustomColorPalette.GetColorCount: Integer; +begin + Result := FColors.Count; +end; + function TCustomColorPalette.GetColors(Index: Integer): TColor; begin - Result := TColor(FColors.Items[Index]); + Result := TColor(PtrUInt(FColors.Items[Index])); end; procedure TCustomColorPalette.SetButtonWidth(const AValue: Integer); @@ -173,7 +183,7 @@ begin else FRows := Ceil(FColors.Count / FCols); - SetBounds(Left, Top, FCols * FButtonWidth + 1, FRows * FButtonHeight + 1) + SetBounds(Left, Top, FCols * FButtonWidth + 1, FRows * FButtonHeight + 1); end; procedure TCustomColorPalette.MouseDown(Button: TMouseButton; @@ -192,7 +202,7 @@ begin if X + Y * FCols < FColors.Count then begin - PickedColor := TColor(FColors.Items[X + Y * FCols]); + PickedColor := GetColors(X + Y * FCols); PickShift := Shift; end; end; @@ -218,7 +228,7 @@ begin Exit; if X + Y * FCols < FColors.Count then begin - C := TColor(FColors.Items[X + Y * FCols]); + C := GetColors(X + Y * FCols); if C <> clNone then ColorMouseMove(C, Shift); end; end; @@ -243,25 +253,25 @@ begin ControlStyle := ControlStyle + [csFixedWidth, csFixedHeight]; FCols := 8; - - FColors.Add(Pointer(clBlack)); - FColors.Add(Pointer(clGray)); - FColors.Add(Pointer(clMaroon)); - FColors.Add(Pointer(clOlive)); - FColors.Add(Pointer(clGreen)); - FColors.Add(Pointer(clTeal)); - FColors.Add(Pointer(clNavy)); - FColors.Add(Pointer(clPurple)); - - FColors.Add(Pointer(clWhite)); - FColors.Add(Pointer(clSilver)); - FColors.Add(Pointer(clRed)); - FColors.Add(Pointer(clYellow)); - FColors.Add(Pointer(clLime)); - FColors.Add(Pointer(clAqua)); - FColors.Add(Pointer(clBlue)); - FColors.Add(Pointer(clFuchsia)); - + + DoAddColor(clBlack); + DoAddColor(clGray); + DoAddColor(clMaroon); + DoAddColor(clOlive); + DoAddColor(clGreen); + DoAddColor(clTeal); + DoAddColor(clNavy); + DoAddColor(clPurple); + + DoAddColor(clWhite); + DoAddColor(clSilver); + DoAddColor(clRed); + DoAddColor(clYellow); + DoAddColor(clLime); + DoAddColor(clAqua); + DoAddColor(clBlue); + DoAddColor(clFuchsia); + UpdateSize; end; @@ -272,18 +282,39 @@ begin inherited; end; +procedure TCustomColorPalette.AddColor(AColor: TColor); +begin + DoAddColor(AColor); + UpdateSize; + Invalidate; +end; + +procedure TCustomColorPalette.DoAddColor(AColor: TColor); +begin + FColors.Add(Pointer(AColor)); +end; + +procedure TCustomColorPalette.DeleteColor(AIndex: Integer); +begin + FColors.Delete(AIndex); + UpdateSize; + Invalidate; +end; + procedure TCustomColorPalette.Paint; var I, X, Y: Integer; + c: TColor; begin Canvas.Pen.Color := clBlack; for I := 0 to Pred(FColors.Count) do begin Y := I div FCols; X := I mod FCols; - if TColor(FColors.Items[I]) <> clNone then + c := GetColors(I); + if c <> clNone then begin - Canvas.Brush.Color := TColor(FColors.Items[I]); + Canvas.Brush.Color := c; Canvas.Rectangle(Bounds(X * FButtonWidth, Y * FButtonHeight, FButtonWidth, FButtonHeight)); end; @@ -327,17 +358,17 @@ var NR := Round((R * I + 255 * (Steps + 1 - I)) / (Steps + 1)); NG := Round((G * I + 255 * (Steps + 1 - I)) / (Steps + 1)); NB := Round((B * I + 255 * (Steps + 1 - I)) / (Steps + 1)); - FColors.Add(Pointer(RGBToColor(NR, NG, NB))); + DoAddColor(RGBToColor(NR, NG, NB)); end; - FColors.Add(Pointer(Color)); + DoAddColor(Color); for I := Steps downto 1 do begin NR := Round(R * I / (Steps + 1)); NG := Round(G * I / (Steps + 1)); NB := Round(B * I / (Steps + 1)); - FColors.Add(Pointer(RGBToColor(NR, NG, NB))); + DoAddColor(RGBToColor(NR, NG, NB)); end; end; @@ -359,7 +390,7 @@ begin if Line[1] = '#' then Continue; if Line[1] = '$' then begin - if Copy(Line, 2, 4) = 'NONE' then FColors.Add(Pointer(clNone)); + 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 begin @@ -369,13 +400,14 @@ begin end; end else - if Pos(',', Line) > 0 then FColors.Add(Pointer(ParseColor(Line))); + if Pos(',', Line) > 0 then DoAddColor(ParseColor(Line)); end; finally Close(F); end; UpdateSize; + Invalidate; end; initialization diff --git a/components/colorpalette/demo/project1.ico b/components/colorpalette/demo/project1.ico new file mode 100644 index 000000000..0341321b5 Binary files /dev/null and b/components/colorpalette/demo/project1.ico differ diff --git a/components/colorpalette/demo/project1.lpi b/components/colorpalette/demo/project1.lpi new file mode 100644 index 000000000..d784f2c48 --- /dev/null +++ b/components/colorpalette/demo/project1.lpi @@ -0,0 +1,84 @@ + + + + + + + + + + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <Icon Value="0"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="LazColorPalette"/> + </Item1> + <Item2> + <PackageName Value="LCL"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="project1.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="unit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="Unit1"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="project1"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/colorpalette/demo/project1.lpr b/components/colorpalette/demo/project1.lpr new file mode 100644 index 000000000..11c56ab39 --- /dev/null +++ b/components/colorpalette/demo/project1.lpr @@ -0,0 +1,21 @@ +program project1; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, Unit1, lazcolorpalette + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource:=True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/components/colorpalette/demo/unit1.lfm b/components/colorpalette/demo/unit1.lfm new file mode 100644 index 000000000..d2329582f --- /dev/null +++ b/components/colorpalette/demo/unit1.lfm @@ -0,0 +1,100 @@ +object Form1: TForm1 + Left = 290 + Height = 502 + Top = 157 + Width = 331 + Caption = 'Form1' + ClientHeight = 502 + ClientWidth = 331 + LCLVersion = '1.5' + object ColorPalette1: TColorPalette + Left = 22 + Height = 33 + Top = 19 + Width = 129 + ButtonWidth = 16 + ButtonHeight = 16 + OnColorPick = ColorPalette1ColorPick + end + object BtnLoadRndPalette: TButton + Left = 176 + Height = 25 + Top = 344 + Width = 139 + Caption = 'Load random palette' + Enabled = False + OnClick = BtnLoadRndPaletteClick + TabOrder = 0 + end + object BtnCreateRndPalette: TButton + Left = 176 + Height = 25 + Top = 312 + Width = 139 + Caption = 'Create random palette' + OnClick = BtnCreateRndPaletteClick + TabOrder = 1 + end + object BtnAddColor: TButton + Left = 176 + Height = 25 + Top = 400 + Width = 139 + Caption = 'Add color' + OnClick = BtnAddColorClick + TabOrder = 2 + end + object BtnLoadDefaultPal: TButton + Left = 176 + Height = 25 + Top = 264 + Width = 139 + Caption = 'Load Default.pal' + OnClick = BtnLoadDefaultPalClick + TabOrder = 3 + end + object Label1: TLabel + Left = 176 + Height = 15 + Top = 464 + Width = 34 + Caption = 'Label1' + ParentColor = False + end + object BtnDeleteColor0: TButton + Left = 176 + Height = 25 + Top = 432 + Width = 139 + Caption = 'Delete color #0' + OnClick = BtnDeleteColor0Click + TabOrder = 4 + end + object ColorDialog1: TColorDialog + Color = clBlack + CustomColors.Strings = ( + 'ColorA=000000' + 'ColorB=000080' + 'ColorC=008000' + 'ColorD=008080' + 'ColorE=800000' + 'ColorF=800080' + 'ColorG=808000' + 'ColorH=808080' + 'ColorI=C0C0C0' + 'ColorJ=0000FF' + 'ColorK=00FF00' + 'ColorL=00FFFF' + 'ColorM=FF0000' + 'ColorN=FF00FF' + 'ColorO=FFFF00' + 'ColorP=FFFFFF' + 'ColorQ=C0DCC0' + 'ColorR=F0CAA6' + 'ColorS=F0FBFF' + 'ColorT=A4A0A0' + ) + left = 163 + top = 51 + end +end diff --git a/components/colorpalette/demo/unit1.pas b/components/colorpalette/demo/unit1.pas new file mode 100644 index 000000000..fba9c4b07 --- /dev/null +++ b/components/colorpalette/demo/unit1.pas @@ -0,0 +1,121 @@ +unit Unit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, + ColorPalette; + +type + + { TForm1 } + + TForm1 = class(TForm) + BtnDeleteColor0: TButton; + BtnLoadRndPalette: TButton; + BtnCreateRndPalette: TButton; + BtnAddColor: TButton; + BtnLoadDefaultPal: TButton; + ColorDialog1: TColorDialog; + ColorPalette1: TColorPalette; + Label1: TLabel; + procedure BtnDeleteColor0Click(Sender: TObject); + procedure Button1Click(Sender: TObject); + procedure BtnLoadRndPaletteClick(Sender: TObject); + procedure BtnCreateRndPaletteClick(Sender: TObject); + procedure BtnAddColorClick(Sender: TObject); + procedure BtnLoadDefaultPalClick(Sender: TObject); + procedure ColorPalette1ColorPick(Sender: TObject; AColor: TColor; + Shift: TShiftState); + private + { private declarations } + public + { public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +{ TForm1 } + +procedure TForm1.ColorPalette1ColorPick(Sender: TObject; AColor: TColor; + Shift: TShiftState); +begin + ShowMessage(Format( + 'Color %s picked.'+#13+ + ' red = %d'#13+ + ' green = %d'#13+ + ' blue = %d', [ColorToString(AColor), Red(AColor), Green(AColor), Blue(AColor)])); +end; + +procedure TForm1.Button1Click(Sender: TObject); +begin + ColorPalette1.LoadPalette('palette1.txt'); + Label1.caption := IntToStr(ColorPalette1.ColorCount) + ' colors available'; +end; + +procedure TForm1.BtnDeleteColor0Click(Sender: TObject); +begin + if ColorPalette1.ColorCount > 0 then + begin + ColorPalette1.DeleteColor(0); + Label1.Caption := IntToStr(ColorPalette1.ColorCount) + ' colors available'; + end; +end; + +procedure TForm1.BtnLoadRndPaletteClick(Sender: TObject); +begin + ColorPalette1.LoadPalette('random_palette.pal'); + Label1.Caption := IntToStr(ColorPalette1.ColorCount) + ' colors available'; +end; + +procedure TForm1.BtnCreateRndPaletteClick(Sender: TObject); +const + N = 64; +var + i: Integer; + R,G,B: Byte; + L: TStringList; +begin + L := TStringList.Create; + try + L.Add('$COLS 16'); + for i:=1 to N do begin + R := Random(256); + G := Random(256); + B := Random(256); + L.Add(Format('%d, %d, %d', [R, G, B])); + end; + L.SaveToFile('random_palette.pal'); + finally + L.Free; + end; + BtnLoadRndPalette.Enabled := true; +end; + +procedure TForm1.BtnAddColorClick(Sender: TObject); +begin + if ColorDialog1.Execute then + ColorPalette1.AddColor(ColorDialog1.Color); + Label1.caption := IntToStr(ColorPalette1.ColorCount) + ' colors available'; +end; + +procedure TForm1.BtnLoadDefaultPalClick(Sender: TObject); +begin + 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; + ColorPalette1.LoadPalette('..\default.pal'); + Label1.caption := IntToStr(ColorPalette1.ColorCount) + ' colors available'; +end; + +end. +