ColorsUnit.pas 3.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120
  1. unit ColorsUnit;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5. ExtCtrls, StdCtrls;
  6. type
  7. TMultipleColorsForm = class(TForm)
  8. ColorBox: TListBox;
  9. Button1: TButton;
  10. Button2: TButton;
  11. Button3: TButton;
  12. Bevel1: TBevel;
  13. Button4: TButton;
  14. Button5: TButton;
  15. ColorDlg: TColorDialog;
  16. procedure ColorBoxDrawItem(Control: TWinControl; Index: Integer;
  17. Rect: TRect; State: TOwnerDrawState);
  18. procedure EditColor(Sender: TObject);
  19. procedure Button1Click(Sender: TObject);
  20. procedure Button2Click(Sender: TObject);
  21. procedure ColorBoxKeyDown(Sender: TObject; var Key: Word;
  22. Shift: TShiftState);
  23. procedure UpdateButtons(Sender: TObject);
  24. private
  25. public
  26. end;
  27. implementation
  28. {$R *.DFM}
  29. procedure TMultipleColorsForm.ColorBoxDrawItem(Control: TWinControl; Index: Integer;
  30. Rect: TRect; State: TOwnerDrawState);
  31. begin
  32. with Control as TListBox do begin
  33. if odSelected in State then
  34. Canvas.Pen.Color := clHighlight
  35. else
  36. Canvas.Pen.Color := Color;
  37. Canvas.MoveTo (Rect.Left, Rect.Top);
  38. Canvas.LineTo (Rect.Right, Rect.Top);
  39. Canvas.MoveTo (Rect.Left, Rect.Top + 1);
  40. Canvas.LineTo (Rect.Right, Rect.Top + 1);
  41. Canvas.MoveTo (Rect.Left, Rect.Bottom - 1);
  42. Canvas.LineTo (Rect.Right, Rect.Bottom - 1);
  43. Canvas.MoveTo (Rect.Left, Rect.Bottom - 2);
  44. Canvas.LineTo (Rect.Right, Rect.Bottom - 2);
  45. Canvas.MoveTo (Rect.Left, Rect.Top);
  46. Canvas.LineTo (Rect.Left, Rect.Bottom);
  47. Canvas.MoveTo (Rect.Left + 1, Rect.Top);
  48. Canvas.LineTo (Rect.Left + 1, Rect.Bottom);
  49. Canvas.MoveTo (Rect.Right - 1, Rect.Top);
  50. Canvas.LineTo (Rect.Right - 1, Rect.Bottom);
  51. Canvas.MoveTo (Rect.Right - 2, Rect.Top);
  52. Canvas.LineTo (Rect.Right - 2, Rect.Bottom);
  53. Inc (Rect.Left, 2);
  54. Inc (Rect.Top, 2);
  55. Dec (Rect.Right, 2);
  56. Dec (Rect.Bottom, 2);
  57. try
  58. Canvas.Brush.Color := StrToInt (Items [Index]);
  59. except
  60. Canvas.Brush.Color := clBlack;
  61. end;
  62. Canvas.Brush.Style := bsSolid;
  63. Canvas.FillRect (Rect);
  64. end;
  65. end;
  66. procedure TMultipleColorsForm.EditColor(Sender: TObject);
  67. begin
  68. if Button3.Enabled then begin
  69. try
  70. ColorDlg.Color := StrToInt (ColorBox.Items [ColorBox.ItemIndex]);
  71. except
  72. ColorDlg.Color := clBlack;
  73. end;
  74. if ColorDlg.Execute then
  75. ColorBox.Items [ColorBox.ItemIndex] := '$' + UpperCase (IntToHex (ColorDlg.Color, 6));
  76. end;
  77. end;
  78. procedure TMultipleColorsForm.Button1Click(Sender: TObject);
  79. var
  80. I: Integer;
  81. begin
  82. if ColorDlg.Execute then begin
  83. I := ColorBox.Items.Add (UpperCase (IntToHex (ColorDlg.Color, 6)));
  84. if ColorBox.Items [I] [1] <> '$' then
  85. ColorBox.Items [I] := '$' + ColorBox.Items [I];
  86. end;
  87. UpdateButtons (Sender);
  88. end;
  89. procedure TMultipleColorsForm.Button2Click(Sender: TObject);
  90. begin
  91. if Button2.Enabled then
  92. ColorBox.Items.Delete (ColorBox.ItemIndex);
  93. UpdateButtons (Sender);
  94. if Button2.Enabled then
  95. ColorBox.ItemIndex := ColorBox.Items.Count - 1;
  96. end;
  97. procedure TMultipleColorsForm.ColorBoxKeyDown(Sender: TObject;
  98. var Key: Word; Shift: TShiftState);
  99. begin
  100. if Key = vk_Delete then
  101. Button2.Click;
  102. end;
  103. procedure TMultipleColorsForm.UpdateButtons(Sender: TObject);
  104. begin
  105. Button2.Enabled := ColorBox.Items.Count > 0;
  106. Button3.Enabled := Button2.Enabled;
  107. end;
  108. end.