LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   RGB+Alpha color editor.
6
}
7
unit FRColorEditor;
8

9
interface
10

11
{$I GLScene.inc}
12

13
uses
14
  lresources, 
15
  SysUtils, 
16
  Classes, 
17
  Forms, 
18
  StdCtrls, 
19
  ExtCtrls, 
20
  FRTrackBarEdit, 
21
  Dialogs, 
22
  Controls,
23
  GLVectorGeometry, 
24
  Graphics, 
25
  GLTexture, 
26
  GLCrossPlatform,
27
  GLColor;
28

29
type
30

31
  TRColorEditor = class(TFrame)
32
    Label1: TLabel;
33
    Label2: TLabel;
34
    Label3: TLabel;
35
    Label4: TLabel;
36
    PAPreview: TPanel;
37
    ColorDialog: TColorDialog;
38
    Panel1: TPanel;
39
    ColorEditorPaintBox: TPaintBox;
40
    RedEdit: TEdit;
41
    GreenEdit: TEdit;
42
    BlueEdit: TEdit;
43
    AlphaEdit: TEdit;
44
    procedure TBEChange(Sender: TObject);
45
    procedure PAPreviewDblClick(Sender: TObject);
46
    procedure ColorEditorPaintBoxPaint(Sender: TObject);
47
    procedure FrameResize(Sender: TObject);
48
    procedure ColorEditorPaintBoxMouseDown(Sender: TObject;
49
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
50
    procedure ColorEditorPaintBoxMouseMove(Sender: TObject;
51
      Shift: TShiftState; X, Y: Integer);
52
    procedure ColorEditorPaintBoxMouseUp(Sender: TObject;
53
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
54
    procedure RedEditChange(Sender: TObject);
55
    procedure GreenEditChange(Sender: TObject);
56
    procedure BlueEditChange(Sender: TObject);
57
    procedure AlphaEditChange(Sender: TObject);
58
  private
59
    
60
    FOnChange : TNotifyEvent;
61
    updating : Boolean;
62
    WorkBitmap : tBitmap;
63
    RedValue : Integer;
64
    GreenValue : integer;
65
    BlueValue : integer;
66
    AlphaVAlue : integer;
67
    DraggingValue : (None,Red,Green,Blue,Alpha);
68
    procedure SetEditedColor(const val : THomogeneousFltVector);
69
    function GetEditedColor : THomogeneousFltVector;
70
    Procedure DrawContents;
71
    Procedure DragColorSliderToPosition(XPos : integer);
72
    Procedure ContentsChanged;
73
  public
74
    constructor Create(AOwner: TComponent); override;
75
    Destructor Destroy; override;
76
    property EditedColor : THomogeneousFltVector read GetEditedColor write SetEditedColor;
77
  published
78
    property OnChange : TNotifyEvent read FOnChange write FOnChange;
79
  end;
80

81
//=======================================================
82
implementation
83
//=======================================================
84

85
const
86
  MaxColorValue = 255;
87
  MaxAlphaValue = 1000;
88

89
  ColorSliderLeft = 40;
90
  ColorSliderWidth = 128;
91
  ColorSliderHeight = 16;
92
  ColorViewHeight = 7;
93
  ColorSliderMaxValue = ColorSliderWidth - 2;
94

95
  RTop = 8;
96
  GTop = 30;
97
  BTop = 52;
98
  ATop = 74;
99

100
  PreviewPanelLeft = 216;
101
  PreviewPanelTop = 10;
102
  PreviewPanelWidth = 65;
103
  PreviewPanelHeight = 74;
104

105
  AlphaCheckSize = 9;
106
  AlphaChecksHigh = 4;
107
  AlphaChecksWide = 7;
108

109
procedure TRColorEditor.TBEChange(Sender: TObject);
110
begin
111
   PAPreview.Color:=RGB(RedValue, GreenValue, BlueValue);
112
   if (not updating) and Assigned(FOnChange) then FOnChange(Self);
113
end;
114

115
// SetColor
116
//
117
procedure TRColorEditor.SetEditedColor(const val : THomogeneousFltVector);
118
begin
119
  RedValue:=Round(val.V[0]*255);
120
  GreenValue:=Round(val.V[1]*255);
121
  BlueValue:=Round(val.V[2]*255);
122
  AlphaValue:=Round(val.V[3]*1000);
123

124
  ContentsChanged;
125
end;
126

127
// GetColor
128
//
129
function TRColorEditor.GetEditedColor : THomogeneousFltVector;
130
begin
131
   Result:=VectorMake(RedValue/255, GreenValue/255, BlueValue/255,
132
                      AlphaValue/1000);
133
end;
134

135
procedure TRColorEditor.PAPreviewDblClick(Sender: TObject);
136
begin
137
   ColorDialog.Color:=PAPreview.Color;
138
   if ColorDialog.Execute then
139
      SetEditedColor(ConvertWinColor(ColorDialog.Color));
140
end;
141

142
procedure TRColorEditor.ColorEditorPaintBoxPaint(Sender: TObject);
143
begin
144
  With ColorEditorPaintBox,ColorEditorPaintBox.Canvas do
145
  begin
146
    Draw(0,0,WorkBitmap);
147
  end;
148
  RedEdit.Height := 16;
149
  GreenEdit.Height := 16;
150
  BlueEdit.Height := 16;
151
  AlphaEdit.Height := 16;
152

153
end;
154

155
constructor TRColorEditor.Create(AOwner: TComponent);
156
begin
157
  inherited;
158
  WorkBitmap := TBitmap.Create;
159
  WorkBitmap.PixelFormat := glpf24bit;
160
  WorkBitmap.HandleType := bmDib;
161

162
  RedValue := 200;
163
  GreenValue := 120;
164
  BlueValue := 60;
165
  AlphaValue := 450;
166
end;
167

168
destructor TRColorEditor.Destroy;
169
begin
170
  inherited;
171
  WorkBitmap.Free;
172
end;
173

174
procedure TRColorEditor.FrameResize(Sender: TObject);
175
begin
176
  WorkBitmap.Width := ColorEditorPaintBox.Width;
177
  WorkBitmap.Height := ColorEditorPaintBox.Height;
178
  With WorkBitmap.Canvas do
179
  begin
180
    Pen.Color := clLime;
181
    MoveTo(0,0);
182
    LineTo(Width-1,Height-1);
183
    MoveTo(Width-1,0);
184
    LineTo(0,Height-1);
185
  end;
186
  DrawCOntents;
187

188
  // Edits have an annoying habit of forgetting their height if they are small
189
  RedEdit.Height := 18;
190
  GreenEdit.Height := 18;
191
  BlueEdit.Height := 18;
192
  AlphaEdit.Height := 18;
193

194
end;
195

196
Function ColorValueToColorViewPosition(ColorValue : integer) : integer;
197
begin
198
  Result := Round( (ColorSliderMaxValue/(MaxColorValue+1)) * ColorValue);
199
end;
200

201
Function AlphaValueToColorViewPosition(AlphaValue : integer) : integer;
202
begin
203
  Result := Round( (ColorSliderMaxValue/(MaxAlphaValue+1)) * AlphaValue);
204
end;
205

206
Function ColorViewPositionToColorValue(ColorViewPosition : integer) : integer;
207
begin
208
  if ColorViewPosition < 0 then ColorViewPosition := 0;
209
  if ColorViewPosition > ColorSliderMaxValue then ColorViewPosition := ColorSliderMaxValue;
210

211
  Result := Round(ColorViewPosition / (ColorSliderMaxValue/(MaxColorValue)));
212
end;
213

214
Function ColorViewPositionToAlphaValue(ColorViewPosition : integer) : integer;
215
begin
216
  if ColorViewPosition < 0 then ColorViewPosition := 0;
217
  if ColorViewPosition > ColorSliderMaxValue then ColorViewPosition := ColorSliderMaxValue;
218
  Result := Round(ColorViewPosition / (ColorSliderMaxValue/(MaxAlphaValue)));
219
end;
220

221
procedure TRColorEditor.DrawContents;
222
var
223
  Position : integer;
224
  tx,ty : integer;
225
  RViewColor : tColor;
226
  GViewColor : tColor;
227
  BViewColor : tColor;
228
  AViewColor : tColor;
229
  ViewLevel : integer;
230
  WhiteCheckColor : tColor;
231
  BlackCheckColor : tColor;
232
  AValue : single;
233
begin
234
  With WorkBitmap.Canvas do
235
  begin
236
    Brush.Color := clBtnFace;
237
    FillRect(Rect(0,0,WorkBitmap.Width,WorkBitmap.Height));
238

239
    Font.Color := clBlack;
240
    Font.Name := 'Arial';
241
    Font.Height := 14;
242

243
    TextOut(6,5,'Red');
244
    TextOut(6,26,'Green');
245
    TextOut(6,48,'Blue');
246
    TextOut(6,70,'Alpha');
247

248
    Brush.Color := clBlack;
249
    FrameRect(Rect(ColorSliderLeft,RTop,ColorSliderLeft+ColorSliderWidth,RTop+ColorViewHeight));
250
    FrameRect(Rect(ColorSliderLeft,GTop,ColorSliderLeft+ColorSliderWidth,GTop+ColorViewHeight));
251
    FrameRect(Rect(ColorSliderLeft,BTop,ColorSliderLeft+ColorSliderWidth,BTop+ColorViewHeight));
252
    FrameRect(Rect(ColorSliderLeft,ATop,ColorSliderLeft+ColorSliderWidth,ATop+ColorViewHeight));
253

254
    // EditedColor View Frames
255
    Pen.Color := clBtnShadow;
256
    PolyLine([  Point(ColorSliderLeft-1,RTop+ColorViewHeight),
257
                Point(ColorSliderLeft-1,RTop-1),
258
                Point(ColorSliderLeft+ColorSliderWidth+1,RTop-1)  ]);
259

260
    PolyLine([  Point(ColorSliderLeft-1,GTop+ColorViewHeight),
261
                Point(ColorSliderLeft-1,GTop-1),
262
                Point(ColorSliderLeft+ColorSliderWidth+1,GTop-1)  ]);
263

264
    PolyLine([  Point(ColorSliderLeft-1,BTop+ColorViewHeight),
265
                Point(ColorSliderLeft-1,BTop-1),
266
                Point(ColorSliderLeft+ColorSliderWidth+1,BTop-1)  ]);
267

268
    PolyLine([  Point(ColorSliderLeft-1,ATop+ColorViewHeight),
269
                Point(ColorSliderLeft-1,ATop-1),
270
                Point(ColorSliderLeft+ColorSliderWidth+1,ATop-1)  ]);
271

272
    Pen.Color := clBtnHighlight;
273

274
    PolyLine([  Point(ColorSliderLeft,RTop+ColorViewHeight),
275
                Point(ColorSliderLeft+ColorSliderWidth,RTop+ColorViewHeight),
276
                Point(ColorSliderLeft+ColorSliderWidth,RTop) ]);
277

278
    PolyLine([  Point(ColorSliderLeft,GTop+ColorViewHeight),
279
                Point(ColorSliderLeft+ColorSliderWidth,GTop+ColorViewHeight),
280
                Point(ColorSliderLeft+ColorSliderWidth,GTop) ]);
281

282
    PolyLine([  Point(ColorSliderLeft,BTop+ColorViewHeight),
283
                Point(ColorSliderLeft+ColorSliderWidth,BTop+ColorViewHeight),
284
                Point(ColorSliderLeft+ColorSliderWidth,BTop) ]);
285

286
    PolyLine([  Point(ColorSliderLeft,ATop+ColorViewHeight),
287
                Point(ColorSliderLeft+ColorSliderWidth,ATop+ColorViewHeight),
288
                Point(ColorSliderLeft+ColorSliderWidth,ATop) ]);
289

290
  // EditedColor pointer triangles
291

292
    Pen.Color := clBlack;
293
    Position:=ColorValueToColorViewPosition(RedValue) + ColorSliderLeft;
294
    PolyLine([ Point(Position,RTop+ColorViewHeight+2),
295
               Point(Position+6,RTop+ColorViewHeight+8),
296
               Point(Position-6,RTop+ColorViewHeight+8),
297
               Point(Position,RTop+ColorViewHeight+2)]);
298

299
    Position:=ColorValueToColorViewPosition(GreenValue) + ColorSliderLeft;
300
    PolyLine([ Point(Position,GTop+ColorViewHeight+2),
301
               Point(Position+6,GTop+ColorViewHeight+8),
302
               Point(Position-6,GTop+ColorViewHeight+8),
303
               Point(Position,GTop+ColorViewHeight+2)]);
304

305
    Position:=ColorValueToColorViewPosition(BlueValue) + ColorSliderLeft;
306
    PolyLine([ Point(Position,BTop+ColorViewHeight+2),
307
               Point(Position+6,BTop+ColorViewHeight+8),
308
               Point(Position-6,BTop+ColorViewHeight+8),
309
               Point(Position,BTop+ColorViewHeight+2)]);
310

311
    Position:=AlphaValueToColorViewPosition(AlphaValue) + ColorSliderLeft;
312
    PolyLine([ Point(Position,ATop+ColorViewHeight+2),
313
               Point(Position+6,ATop+ColorViewHeight+8),
314
               Point(Position-6,ATop+ColorViewHeight+8),
315
               Point(Position,ATop+ColorViewHeight+2)]);
316

317
    // EditedColor view spectrums
318
    For tx := 1 to ColorSliderWidth - 2 do
319
    begin
320
      ViewLevel := (tx * 256) div ColorSliderWidth;
321
      AViewColor := (ViewLevel) + (ViewLevel shl 8) + (viewLevel shl 16);
322
      RViewColor := (ViewLevel) + (GreenValue Shl 8) + (BlueValue Shl 16);
323
      GViewColor := (RedValue) + (ViewLevel shl 8) + (BlueValue Shl 16);
324
      BViewColor := (RedValue) + (GreenValue Shl 8) + (ViewLevel Shl 16);
325
      For ty := 1 to ColorViewHeight -2 do
326
      begin
327
         Pixels[ColorSliderLeft+tx,Rtop+Ty]:=RViewCOlor;
328
         Pixels[ColorSliderLeft+tx,Gtop+Ty]:=GViewColor;
329
         Pixels[ColorSliderLeft+tx,Btop+Ty]:=BViewColor;
330
         Pixels[ColorSliderLeft+tx,Atop+Ty]:=AViewColor;
331
      end;
332
    end;
333

334
    // EditedColor preview panel
335
    Pen.Color := clBtnShadow;
336
    PolyLine([  Point(PreviewPanelLeft-1,PreviewPanelTop+PreviewPanelHeight),
337
                Point(PreviewPanelLeft-1,PreviewPanelTop-1),
338
                Point(PreviewPanelLeft+PreviewPanelWidth,PreviewPanelTop-1) ]);
339
    Pen.Color := clBtnHighlight;
340
    PolyLine([  Point(PreviewPanelLeft,PreviewPanelTop+PreviewPanelHeight),
341
                Point(PreviewPanelLeft+PreviewPanelWidth,PreviewPanelTop+PreviewPanelHeight),
342
                Point(PreviewPanelLeft+PreviewPanelWidth,PreviewPanelTop) ]);
343

344
    Brush.Color := (RedValue) + (GreenValue Shl 8) + (BlueValue Shl 16);
345
    Pen.Color := clBlack;
346
    Rectangle(Rect(PreviewPanelLeft,PreviewPanelTop,PreviewPanelLeft+PreviewPanelWidth,PreviewPanelTop+PreviewPanelHeight div 2 ) );
347
    PolyLine([  Point(PreviewPanelLeft,PreviewPanelTop+PreviewPanelHeight div 2 -1),
348
                Point(PreviewPanelLeft,PreviewPanelTop+PreviewPanelHeight -1),
349
                Point(PreviewPanelLeft+PreviewPanelWidth-1,PreviewPanelTop+PreviewPanelHeight-1),
350
                Point(PreviewPanelLeft+PreviewPanelWidth-1,PreviewPanelTop+PreviewPanelHeight div 2-1)
351
             ]);
352

353
    AValue := AlphaValue / MaxAlphaValue;
354
    BlackCheckColor := Round(RedValue * Avalue) + Round(GreenValue*AValue) shl 8 + Round(BlueValue*AValue) shl 16;
355
    WhiteCheckColor := Round(RedValue * Avalue + (255 * (1-AValue))) + Round(GreenValue*AValue + (255 * (1-AValue))) shl 8 +  Round(BlueValue*AValue + (255 * (1-AValue))) shl 16;
356
    For ty := 0 to AlphaChecksHigh - 1 do
357
    begin
358
      For tx := 0 to AlphaChecksWide - 1 do
359
      begin
360
        if (tx+ty) and 1 = 0 then Brush.Color := BlackCheckColor else Brush.Color := WhiteCheckColor;
361
        FillRect(Rect(  PreviewPanelLeft+1 + tx*AlphaCheckSize,
362
                        PreviewPanelTop+PreviewPanelHeight Div 2 + ty*AlphaCheckSize,
363
                        PreviewPanelLeft+1 + (tx+1)*AlphaCheckSize,
364
                        PreviewPanelTop+PreviewPanelHeight Div 2 + (ty+1)*AlphaCheckSize
365
                      ));
366
      end;
367
    end;
368

369

370
  end;
371

372
end;
373

374
procedure TRColorEditor.ColorEditorPaintBoxMouseDown(Sender: TObject;
375
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
376
begin
377
  DraggingValue := None;
378
  If Button = TMouseButton(mbLeft) then
379
  begin
380
    if (X > ColorSliderLeft-5) and ( X < (ColorSliderLeft+ColorSliderMaxValue+5)) then
381
    begin
382
      // In X range For EditedColor Sliders
383
      If (Y > RTop) and ( (RTop+ColorSliderHeight) > Y ) then DraggingValue := Red;
384
      If (Y > GTop) and ( (GTop+ColorSliderHeight) > Y ) then DraggingValue := Green;
385
      If (Y > BTop) and ( (BTop+ColorSliderHeight) > Y ) then DraggingValue := Blue;
386
      If (Y > ATop) and ( (ATop+ColorSliderHeight) > Y ) then DraggingValue := Alpha;
387

388
      If DraggingValue <> None then DragColorSliderToPosition(X-ColorSliderLeft-1);
389
    end
390
  end;
391
end;
392

393
procedure TRColorEditor.DragColorSliderToPosition(XPos: integer);
394
begin
395
  Case DraggingValue of
396
    Red: RedValue := ColorViewPositionToColorValue(XPos);
397
    Green: GreenValue := ColorViewPositionToColorValue(XPos);
398
    Blue: BlueValue := ColorViewPositionToColorValue(XPos);
399
    Alpha: AlphaValue := ColorViewPositionToAlphaValue(XPos);
400
  end;
401
  ContentsChanged;
402
end;
403

404
procedure TRColorEditor.ContentsChanged;
405
begin
406
  if Not Updating then
407
  begin
408
    UpDating := True;
409
    DrawContents;
410
    ColorEditorPaintBox.Canvas.Draw(0,0,WorkBitmap);
411
    RedEdit.Text := IntToStr(RedValue);
412
    GreenEdit.Text := IntToStr(GreenValue);
413
    BlueEdit.Text := IntToStr(BlueValue);
414
    AlphaEdit.Text := IntToStr(AlphaValue);
415

416
    PaPreview.Color := RedValue + (GreenValue Shl 8) + (BlueValue Shl 16);
417
    UpDating := False;
418

419
    TBEChange(Self);
420
  end;
421
end;
422

423
procedure TRColorEditor.ColorEditorPaintBoxMouseMove(Sender: TObject;
424
  Shift: TShiftState; X, Y: Integer);
425
begin
426
 if DraggingValue <> None then DragColorSliderToPosition(X-ColorSliderLeft-1);
427
end;
428

429
procedure TRColorEditor.ColorEditorPaintBoxMouseUp(Sender: TObject;
430
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
431
begin
432
  If Button = TMouseButton(mbLeft) then DraggingValue := None;
433
end;
434

435
procedure TRColorEditor.RedEditChange(Sender: TObject);
436
var
437
  IntValue : integer;
438
begin
439
  IntValue := StrToIntDef(RedEdit.Text,-1);
440

441
  If (IntValue < 0) or (IntValue > MaxColorValue) then
442
  begin
443
    RedEdit.Color:=clRed;
444
  end
445
  else
446
  begin
447
    RedEdit.Color:=clWindow;
448
    RedValue := IntValue;
449
    ContentsChanged;
450
  end;
451

452
end;
453

454
procedure TRColorEditor.GreenEditChange(Sender: TObject);
455
var
456
  IntValue : integer;
457
begin
458
  IntValue := StrToIntDef(GreenEdit.Text,-1);
459

460
  If (IntValue < 0) or (IntValue > MaxColorValue) then
461
  begin
462
    GreenEdit.Color:=clRed;
463
  end
464
  else
465
  begin
466
    GreenEdit.Color:=clWindow;
467
    GreenValue := IntValue;
468
    ContentsChanged;
469
  end;
470

471
end;
472

473
procedure TRColorEditor.BlueEditChange(Sender: TObject);
474
var
475
  IntValue : integer;
476
begin
477
  IntValue := StrToIntDef(BlueEdit.Text,-1);
478

479
  If (IntValue < 0) or (IntValue > MaxColorValue) then
480
  begin
481
    BlueEdit.Color:=clRed;
482
  end
483
  else
484
  begin
485
    BlueEdit.Color:=clWindow;
486
    BlueValue := IntValue;
487
    ContentsChanged;
488
  end;
489

490
end;
491

492
procedure TRColorEditor.AlphaEditChange(Sender: TObject);
493
var
494
  IntValue : integer;
495
begin
496
  IntValue := StrToIntDef(AlphaEdit.Text,-1);
497

498
  If (IntValue < 0) or (IntValue > MaxAlphaValue) then
499
  begin
500
    AlphaEdit.Color:=clRed;
501
  end
502
  else
503
  begin
504
    AlphaEdit.Color:=clWindow;
505
    AlphaValue := IntValue;
506
    ContentsChanged;
507
  end;
508

509
end;
510

511
// ------------------------------------------------------------------
512
// ------------------------------------------------------------------
513
// ------------------------------------------------------------------
514
initialization
515
// ------------------------------------------------------------------
516
// ------------------------------------------------------------------
517
// ------------------------------------------------------------------
518
  {$i FRColorEditor.lrs}
519

520
end.
521

522

523