vortextracker/ColorPickerDlgUnit.pas at main · ivanpirog/vortextracker · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
//========================================================================
//  Ultimate Color Picker Dialogs - Delphi Edition
//
//  Copyright 2003-2005, SimpleWebsiteNavigation.com, All Rights Reserved.
//
//  Datecode: 050929
//
//  This software is shareware.  You may evaluate it for free, but it you
//  use it you must purchase a license from:
//     www.components.SimpleWebsiteNavigation.com
//========================================================================

unit ColorPickerDlgUnit;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  Buttons, ExtCtrls;

type
  TColorPickerDlg = class;
  TColorPickerColorChangeEvent = procedure (Sender: TColorPickerDlg) of object;
  TColorPickerDlg = class(TForm)
    OKBtn: TButton;
    CancelBtn: TButton;
    SelectedColorGroupBox: TGroupBox;
    RedValueLabel: TLabel;
    GreenValueLabel: TLabel;
    BlueValueLabel: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    SelectedColorPanel: TPanel;
    ColorPickerPanel: TPanel;
    procedure FormDeactivate(Sender: TObject);
  private
    revert_color: TColor;  // used by SaveColor/RevertColor
    fOnColorChange: TColorPickerColorChangeEvent;
    function rColorPick: TColor;
    procedure wColorPick (c: TColor);
  protected
    old_color: TColor;  // used if this dialog's Cancel button is hit
    procedure fire_color_change_event;
    procedure UpdateDialogPreview;
      virtual;
  public
    property ColorPick: TColor read rColorPick write wColorPick;
    property OnColorChange: TColorPickerColorChangeEvent read fOnColorChange write fOnColorChange;
    procedure SaveColor;
    procedure RevertColor;
  end;

var
   ColorPickerDlg: TColorPickerDlg;

implementation

{$R *.DFM}

procedure TColorPickerDlg.fire_color_change_event;
   begin
      if Assigned (fOnColorChange)
      then
         OnColorChange (self)
   end;

function TColorPickerDlg.rColorPick: TColor;
begin
   result := SelectedColorPanel.Color
end;

procedure TColorPickerDlg.wColorPick (c: TColor);
begin
   SelectedColorPanel.Color := c;
   RedValueLabel.Caption := format ('%d', [c and $ff]);
   GreenValueLabel.Caption := format ('%d', [(c shr 8) and $ff]);
   BlueValueLabel.Caption := format ('%d', [(c shr 16) and $ff])
end;

procedure TColorPickerDlg.SaveColor;
begin
   revert_color := ColorPick
end;

procedure TColorPickerDlg.RevertColor;
begin
   ColorPick := revert_color
end;

procedure TColorPickerDlg.UpdateDialogPreview;
   begin
      { base dialogs have no preview other than SelectedColorPanel (handled in       }
      {    wColorPick above), but descendant classes might implement something more. }
   end;

procedure TColorPickerDlg.FormDeactivate(Sender: TObject);
begin
   if (ModalResult <> mrOK)
      and
      (ColorPick <> old_color)
   then
      begin
         ColorPick := old_color;
         fire_color_change_event
      end
end;

end.