ColorsUnit.pas 3.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
  1. {
  2. TIGCC IDE
  3. Copyright (C) 2000-2004 Sebastian Reichelt
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2, or (at your option)
  7. any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software Foundation,
  14. Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  15. }
  16. unit ColorsUnit;
  17. interface
  18. uses
  19. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  20. ExtCtrls, StdCtrls;
  21. type
  22. TMultipleColorsForm = class(TForm)
  23. ColorBox: TListBox;
  24. Button1: TButton;
  25. Button2: TButton;
  26. Button3: TButton;
  27. Bevel1: TBevel;
  28. Button4: TButton;
  29. Button5: TButton;
  30. ColorDlg: TColorDialog;
  31. procedure ColorBoxDrawItem(Control: TWinControl; Index: Integer;
  32. Rect: TRect; State: TOwnerDrawState);
  33. procedure EditColor(Sender: TObject);
  34. procedure Button1Click(Sender: TObject);
  35. procedure Button2Click(Sender: TObject);
  36. procedure ColorBoxKeyDown(Sender: TObject; var Key: Word;
  37. Shift: TShiftState);
  38. procedure UpdateButtons(Sender: TObject);
  39. private
  40. public
  41. end;
  42. implementation
  43. {$R *.DFM}
  44. procedure TMultipleColorsForm.ColorBoxDrawItem(Control: TWinControl; Index: Integer;
  45. Rect: TRect; State: TOwnerDrawState);
  46. begin
  47. with Control as TListBox do begin
  48. if odSelected in State then
  49. Canvas.Pen.Color := clHighlight
  50. else
  51. Canvas.Pen.Color := Color;
  52. Canvas.MoveTo (Rect.Left, Rect.Top);
  53. Canvas.LineTo (Rect.Right, Rect.Top);
  54. Canvas.MoveTo (Rect.Left, Rect.Top + 1);
  55. Canvas.LineTo (Rect.Right, Rect.Top + 1);
  56. Canvas.MoveTo (Rect.Left, Rect.Bottom - 1);
  57. Canvas.LineTo (Rect.Right, Rect.Bottom - 1);
  58. Canvas.MoveTo (Rect.Left, Rect.Bottom - 2);
  59. Canvas.LineTo (Rect.Right, Rect.Bottom - 2);
  60. Canvas.MoveTo (Rect.Left, Rect.Top);
  61. Canvas.LineTo (Rect.Left, Rect.Bottom);
  62. Canvas.MoveTo (Rect.Left + 1, Rect.Top);
  63. Canvas.LineTo (Rect.Left + 1, Rect.Bottom);
  64. Canvas.MoveTo (Rect.Right - 1, Rect.Top);
  65. Canvas.LineTo (Rect.Right - 1, Rect.Bottom);
  66. Canvas.MoveTo (Rect.Right - 2, Rect.Top);
  67. Canvas.LineTo (Rect.Right - 2, Rect.Bottom);
  68. Inc (Rect.Left, 2);
  69. Inc (Rect.Top, 2);
  70. Dec (Rect.Right, 2);
  71. Dec (Rect.Bottom, 2);
  72. try
  73. Canvas.Brush.Color := StrToInt (Items [Index]);
  74. except
  75. Canvas.Brush.Color := clBlack;
  76. end;
  77. Canvas.Brush.Style := bsSolid;
  78. Canvas.FillRect (Rect);
  79. end;
  80. end;
  81. procedure TMultipleColorsForm.EditColor(Sender: TObject);
  82. begin
  83. if Button3.Enabled then begin
  84. try
  85. ColorDlg.Color := StrToInt (ColorBox.Items [ColorBox.ItemIndex]);
  86. except
  87. ColorDlg.Color := clBlack;
  88. end;
  89. if ColorDlg.Execute then
  90. ColorBox.Items [ColorBox.ItemIndex] := '$' + UpperCase (IntToHex (ColorDlg.Color, 6));
  91. end;
  92. end;
  93. procedure TMultipleColorsForm.Button1Click(Sender: TObject);
  94. var
  95. I: Integer;
  96. begin
  97. if ColorDlg.Execute then begin
  98. I := ColorBox.Items.Add (UpperCase (IntToHex (ColorDlg.Color, 6)));
  99. if ColorBox.Items [I] [1] <> '$' then
  100. ColorBox.Items [I] := '$' + ColorBox.Items [I];
  101. end;
  102. UpdateButtons (Sender);
  103. end;
  104. procedure TMultipleColorsForm.Button2Click(Sender: TObject);
  105. begin
  106. if Button2.Enabled then
  107. ColorBox.Items.Delete (ColorBox.ItemIndex);
  108. UpdateButtons (Sender);
  109. if Button2.Enabled then
  110. ColorBox.ItemIndex := ColorBox.Items.Count - 1;
  111. end;
  112. procedure TMultipleColorsForm.ColorBoxKeyDown(Sender: TObject;
  113. var Key: Word; Shift: TShiftState);
  114. begin
  115. if Key = vk_Delete then
  116. Button2.Click;
  117. end;
  118. procedure TMultipleColorsForm.UpdateButtons(Sender: TObject);
  119. begin
  120. Button2.Enabled := ColorBox.Items.Count > 0;
  121. Button3.Enabled := Button2.Enabled;
  122. end;
  123. end.