Skip to content

Commit

Permalink
ref
Browse files Browse the repository at this point in the history
  • Loading branch information
[email protected] authored and [email protected] committed Jan 9, 2021
1 parent d93868a commit 0a94aa2
Show file tree
Hide file tree
Showing 7 changed files with 4,866 additions and 5,018 deletions.
9,671 changes: 4,835 additions & 4,836 deletions CTS.Main.dfm
View file

Large diffs are not rendered by default.

182 changes: 6 additions & 176 deletions CTS.Main.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,8 +7,7 @@ interface
Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.Buttons, System.Types, Vcl.Imaging.pngimage,
System.ImageList, Vcl.ImgList, System.UITypes, HGM.Controls.Labels, HGM.Controls.SpinEdit, HGM.Button,
HGM.Controls.PanelCollapsed, HGM.Controls.PanelExt, HexaColorPicker, HSColorPicker, HSLRingPicker, HSLColorPicker,
SLHColorPicker, HSVColorPicker, mbDeskPickerButton, mbOfficeColorDialog, mbColorPickerControl, acPNG, Vcl.Themes,
Vcl.Styles;
SLHColorPicker, HSVColorPicker, mbDeskPickerButton, mbOfficeColorDialog, mbColorPickerControl, Vcl.Themes, Vcl.Styles;

type
TFormMain = class(TForm)
Expand Down Expand Up @@ -212,7 +211,7 @@ TFormMain = class(TForm)
implementation

uses
Math, System.IniFiles, CTS.Test, HGM.Common.Utils;
Math, System.IniFiles, CTS.Test, HGM.Common.Utils, HGM.Utils.Color;

{$R *.dfm}

Expand All @@ -226,176 +225,6 @@ function ShiftDown: Boolean;
Result := GetKeyState(VK_SHIFT) < 0;
end;

function GrayColor(AColor: TColor): TColor;
var
Gr: Byte;
begin
AColor := ColorToRGB(AColor);
Gr := Trunc((GetBValue(AColor) + GetGValue(AColor) + GetRValue(AColor)) / 3);
Result := RGB(Gr, Gr, Gr);
end;

function RGBToHSV(R, G, B: Byte; var H, S, V: Double): Boolean;
var
minRGB, maxRGB, delta: Double;
begin
H := 0.0;
minRGB := Min(Min(R, G), B);
maxRGB := Max(Max(R, G), B);
delta := (maxRGB - minRGB);
V := maxRGB;
if (maxRGB <> 0.0) then
S := 255.0 * delta / maxRGB
else
S := 0.0;

if (S <> 0.0) then
begin
if R = maxRGB then
H := (G - B) / delta
else if G = maxRGB then
H := 2.0 + (B - R) / delta
else if B = maxRGB then
H := 4.0 + (R - G) / delta
end
else
H := -1.0;
H := H * 60;
if H < 0.0 then
H := H + 360.0;

S := S / 255 * 100;
V := V / 255 * 100;

Result := True;
end;

function HSVToRGB(H, S, V: Double; var R, G, B: Byte): Boolean;
var
i: Integer;
f, p, q, t: Double;

procedure CopyOutput(const RV, GV, BV: Double);
const
RGBmax = 255;
begin
R := Round(RGBmax * RV);
G := Round(RGBmax * GV);
B := Round(RGBmax * BV);
end;

begin
S := S / 100;
V := V / 100;
H := H / 60;
//Assert(InRange(H, 0.0, 1.0));
//Assert(InRange(S, 0.0, 1.0));
//Assert(InRange(V, 0.0, 1.0));
if S = 0.0 then
begin
CopyOutput(B, B, B);
Result := True;
Exit;
end;
//H:=H*6.0;
i := floor(H);
f := H - i;
p := V * (1.0 - S);
q := V * (1.0 - S * f);
t := V * (1.0 - S * (1.0 - f));
case i of
0:
CopyOutput(V, t, p);
1:
CopyOutput(q, V, p);
2:
CopyOutput(p, V, t);
3:
CopyOutput(p, q, V);
4:
CopyOutput(t, p, V);
else
CopyOutput(V, p, q);
end;
Result := True;
end;

procedure RGBToCMYK(const R, G, B: Byte; var C: Byte; var M: Byte; var Y: Byte; var K: Byte);
begin
C := 255 - R;
M := 255 - G;
Y := 255 - B;
if C < M then
K := C
else
K := M;
if Y < K then
K := Y;
if K > 0 then
begin
C := C - K;
M := M - K;
Y := Y - K;
end;
end;

procedure CMYKToRGB(C, M, Y, K: Byte; var R: Byte; var G: Byte; var B: Byte);
begin
if (Integer(C) + Integer(K)) < 255 then
R := 255 - (C + K)
else
R := 0;
if (Integer(M) + Integer(K)) < 255 then
G := 255 - (M + K)
else
G := 0;
if (Integer(Y) + Integer(K)) < 255 then
B := 255 - (Y + K)
else
B := 0;
end;

procedure ColorCorrectCMYK(var C: Byte; var M: Byte; var Y: Byte; var K: Byte);
var
MinColor: Byte;
begin
if C < M then
MinColor := C
else
MinColor := M;
if Y < MinColor then
MinColor := Y;
if MinColor + K > 255 then
MinColor := 255 - K;
C := C - MinColor;
M := M - MinColor;
Y := Y - MinColor;
K := K + MinColor;
end;

function HexToTColor(sColor: string): TColor;
begin
Result := RGB(StrToInt('$' + Copy(sColor, 1, 2)), StrToInt('$' + Copy(sColor, 3, 2)), StrToInt('$' + Copy(sColor, 5, 2)));
end;

function ColorToHex(Color: TColor): string;
begin
Result := IntToHex(GetRValue(Color), 2) + IntToHex(GetGValue(Color), 2) + IntToHex(GetBValue(Color), 2);
end;

function ColorToHtml(Color: TColor): string;
var
COL: Integer;
begin
COL := ColorToRGB(Color);
Result := '#' + IntToHex(COL and $FF, 2) + IntToHex(COL shr 8 and $FF, 2) + IntToHex(COL shr 16 and $FF, 2);
end;

function HtmlToColor(Color: string): TColor;
begin
Result := StringToColor('$' + Copy(Color, 6, 2) + Copy(Color, 4, 2) + Copy(Color, 2, 2));
end;

procedure TFormMain.AddColorToMix(aColor: TColor);
begin
ListBoxMix.Items.Add(ColorToString(aColor));
Expand Down Expand Up @@ -514,8 +343,8 @@ procedure TFormMain.DrawPanelMagnifyPaint(Sender: TObject);
S := 'Ctrl+Shift';
DrawPanelMagnify.Canvas.TextRect(R, S, [tfCenter, tfVerticalCenter, tfSingleLine]);
end;
PixW := DrawPanelMagnify.ClientRect.Width / FMagnify.Width;
DrawPanelMagnify.Brush.Style := bsClear;
PixW := DrawPanelMagnify.ClientRect.Width / FMagnify.Width;
R.Width := Ceil(PixW);
R.Height := Ceil(PixW);
R.Location := Point(Round((PixW * FMagnify.Width / 2) - (PixW / 2)), Round((PixW * FMagnify.Width / 2) - (PixW / 2)));
Expand Down Expand Up @@ -673,7 +502,8 @@ procedure TFormMain.Navigate(Tab: TTabSheet);

procedure TFormMain.SetColor(IsDark: Boolean);
var
CaptionColor, AC: TColor;
//CaptionColor,
AC: TColor;

procedure SetPanelColor(Panel: TPanelCollapsed);
begin
Expand Down Expand Up @@ -744,7 +574,7 @@ procedure TFormMain.SetColor(IsDark: Boolean);

Font.Color := clBlack;
Color := $00F7F7F7;
CaptionColor := $005B3825;
//CaptionColor := $005B3825;

SpinEditR.Color := $00D7D7FF;
SpinEditG.Color := $00D7FFD7;
Expand Down
6 changes: 6 additions & 0 deletions CTS.Test.dfm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -83,8 +83,10 @@ object FormTest: TFormTest
FontDown.Height = -13
FontDown.Name = 'Tahoma'
FontDown.Style = []
IgnorBounds = True
OnClick = ColorSelectBGClick
RoundRectParam = 0
ShowFocusRect = False
TabOrder = 0
TabStop = True
TextFormat = [tfCenter, tfSingleLine, tfVerticalCenter]
Expand Down Expand Up @@ -120,8 +122,10 @@ object FormTest: TFormTest
FontDown.Height = -13
FontDown.Name = 'Tahoma'
FontDown.Style = []
IgnorBounds = True
OnClick = ColorSelectPanelClick
RoundRectParam = 0
ShowFocusRect = False
TabOrder = 1
TabStop = True
TextFormat = [tfCenter, tfSingleLine, tfVerticalCenter]
Expand Down Expand Up @@ -157,8 +161,10 @@ object FormTest: TFormTest
FontDown.Height = -13
FontDown.Name = 'Tahoma'
FontDown.Style = []
IgnorBounds = True
OnClick = ColorSelectFontClick
RoundRectParam = 0
ShowFocusRect = False
TabOrder = 2
TabStop = True
TextFormat = [tfCenter, tfSingleLine, tfVerticalCenter]
Expand Down
3 changes: 1 addition & 2 deletions CTS.Test.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,8 +4,7 @@ interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls,
Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, mbDeskPickerButton, Vcl.ExtCtrls, Vcl.Buttons, sSpeedButton, sColorSelect,
HGM.Button;
Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, mbDeskPickerButton, Vcl.ExtCtrls, Vcl.Buttons, HGM.Button;

type
TFormTest = class(TForm)
Expand Down
3 changes: 2 additions & 1 deletion CTS.dpr
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,8 @@ program CTS;
uses
Vcl.Forms,
CTS.Main in 'CTS.Main.pas' {FormMain},
CTS.Test in 'CTS.Test.pas' {FormTest};
CTS.Test in 'CTS.Test.pas' {FormTest},
HGM.Utils.Color in '..\Components\HGM.Utils.Color.pas';

{$R *.res}

Expand Down
1 change: 1 addition & 0 deletions CTS.dproj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -111,6 +111,7 @@
<Form>FormTest</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\Components\HGM.Utils.Color.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
Expand Down
18 changes: 15 additions & 3 deletions ColorToStr.groupproj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,9 @@
<Projects Include="..\Components\HGMComponents.dproj">
<Dependencies/>
</Projects>
<Projects Include="..\FMXColors\FMXColors.dproj">
<Dependencies/>
</Projects>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Default.Personality.12</Borland.Personality>
Expand All @@ -35,14 +38,23 @@
<Target Name="HGMComponents:Make">
<MSBuild Projects="..\Components\HGMComponents.dproj" Targets="Make"/>
</Target>
<Target Name="FMXColors">
<MSBuild Projects="..\FMXColors\FMXColors.dproj"/>
</Target>
<Target Name="FMXColors:Clean">
<MSBuild Projects="..\FMXColors\FMXColors.dproj" Targets="Clean"/>
</Target>
<Target Name="FMXColors:Make">
<MSBuild Projects="..\FMXColors\FMXColors.dproj" Targets="Make"/>
</Target>
<Target Name="Build">
<CallTarget Targets="CTS;HGMComponents"/>
<CallTarget Targets="CTS;HGMComponents;FMXColors"/>
</Target>
<Target Name="Clean">
<CallTarget Targets="CTS:Clean;HGMComponents:Clean"/>
<CallTarget Targets="CTS:Clean;HGMComponents:Clean;FMXColors:Clean"/>
</Target>
<Target Name="Make">
<CallTarget Targets="CTS:Make;HGMComponents:Make"/>
<CallTarget Targets="CTS:Make;HGMComponents:Make;FMXColors:Make"/>
</Target>
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
</Project>

0 comments on commit 0a94aa2

Please sign in to comment.