Login | ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/colormanager/trunk/Unit1.pas
Revision: 2
Committed: Thu Nov 8 11:54:22 2018 UTC (22 months, 3 weeks ago) by daniel-marschall
Content type: text/x-pascal
File size: 53003 byte(s)
Log Message:
Released source code of 22 October 2006 in SVN

File Contents

# Content
1 unit Unit1;
2
3 interface
4
5 uses
6 Windows, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, ExtCtrls,
7 Buttons, Spin, math, ComCtrls, Messages, Menus, Registry, IniFiles,
8 ShellApi, Dialogs;
9
10 // Graphutils
11 // ColorRGBToHLS
12
13 type
14 TLanguageEntry = record
15 name: string;
16 text: string;
17 end;
18
19 TMainForm = class(TForm)
20 ColorPanel: TPanel;
21 KomplementaerColor: TPanel;
22 PickTimer: TTimer;
23 PopupMenu: TPopupMenu;
24 mGetColor: TMenuItem;
25 mPutColor: TMenuItem;
26 mAktuell: TMenuItem;
27 mKomplementaer: TMenuItem;
28 mMixColor: TMenuItem;
29 mUmkehren: TMenuItem;
30 mAktuell2: TMenuItem;
31 mKomplementaer2: TMenuItem;
32 WebSafe1: TPanel;
33 WebSafe2: TPanel;
34 CurrentLbl: TLabel;
35 mWebsafe: TMenuItem;
36 mWebsafeInv: TMenuItem;
37 TabControl: TTabControl;
38 Panel1: TPanel;
39 RGBBox: TGroupBox;
40 RLbl: TLabel;
41 GLbl: TLabel;
42 BLbl: TLabel;
43 RDecLbl: TLabel;
44 GDecLbl: TLabel;
45 BDecLbl: TLabel;
46 RHexLbl: TLabel;
47 GHexLbl: TLabel;
48 BHexLbl: TLabel;
49 BDecC: TUpDown;
50 GDecC: TUpDown;
51 RDecC: TUpDown;
52 RHexC: TUpDown;
53 GHexC: TUpDown;
54 BHexC: TUpDown;
55 RDec: TEdit;
56 RHex: TEdit;
57 GDec: TEdit;
58 GHex: TEdit;
59 BDec: TEdit;
60 BHex: TEdit;
61 R: TTrackBar;
62 G: TTrackBar;
63 B: TTrackBar;
64 HSVBox: TGroupBox;
65 HLbl: TLabel;
66 SLbl: TLabel;
67 VLbl: TLabel;
68 HDecLbl: TLabel;
69 SDecLbl: TLabel;
70 VDecLbl: TLabel;
71 HHexLbl: TLabel;
72 SHexLbl: TLabel;
73 VHexLbl: TLabel;
74 HDec: TEdit;
75 HDecC: TUpDown;
76 SDec: TEdit;
77 SDecC: TUpDown;
78 VDec: TEdit;
79 VDecC: TUpDown;
80 H: TTrackBar;
81 S: TTrackBar;
82 V: TTrackBar;
83 HHex: TEdit;
84 HHexC: TUpDown;
85 SHex: TEdit;
86 SHexC: TUpDown;
87 VHex: TEdit;
88 VHexC: TUpDown;
89 ColorcodeBox: TGroupBox;
90 HTMLLbl: TLabel;
91 DelphiLbl: TLabel;
92 VisualCLbl: TLabel;
93 VisualBasicLbl: TLabel;
94 JavaLbl: TLabel;
95 PhotoshopLbl: TLabel;
96 LongLbl: TLabel;
97 HTML: TEdit;
98 Delphi: TEdit;
99 VisualC: TEdit;
100 VisualBasic: TEdit;
101 Java: TEdit;
102 Photoshop: TEdit;
103 Long: TEdit;
104 Panel2: TPanel;
105 ColorMixerBox: TGroupBox;
106 Color1Per: TLabel;
107 Color2Per: TLabel;
108 Color2: TPanel;
109 Color1: TPanel;
110 MixedColor: TPanel;
111 Color1Edt: TEdit;
112 Color1Upd: TUpDown;
113 Color2Edt: TEdit;
114 Color2Upd: TUpDown;
115 ColorBox: TGroupBox;
116 DelphiBoxLbl: TLabel;
117 DelphiBox: TColorListBox;
118 Panel3: TPanel;
119 ColorPicker: TGroupBox;
120 AverageLbl: TLabel;
121 PickBtn: TButton;
122 EqualLbl: TLabel;
123 GreyscaleBtn: TPanel;
124 InvertBtn: TPanel;
125 RandomBtn: TPanel;
126 WebsafeLbl: TLabel;
127 WebSafeBtn: TPanel;
128 PanelR: TPanel;
129 RedBox: TPaintBox;
130 PanelG: TPanel;
131 GreenBox: TPaintBox;
132 PanelB: TPanel;
133 BlueBox: TPaintBox;
134 PanelH: TPanel;
135 HueBox: TPaintBox;
136 PanelS: TPanel;
137 SatBox: TPaintBox;
138 PanelV: TPanel;
139 ValBox: TPaintBox;
140 HGra: TEdit;
141 HGraC: TUpDown;
142 HGraLbl: TLabel;
143 WebcolorBox: TListBox;
144 WebcolorLbl: TLabel;
145 PalLbl: TLabel;
146 WinColorDialog: TColorDialog;
147 DelphiZutreffend: TListBox;
148 DelphiZutreffendLbl: TLabel;
149 FavoPnl: TPanel;
150 favo14: TPanel;
151 favo13: TPanel;
152 favo12: TPanel;
153 favo11: TPanel;
154 favo10: TPanel;
155 favo9: TPanel;
156 favo8: TPanel;
157 favo7: TPanel;
158 favo6: TPanel;
159 favo5: TPanel;
160 favo4: TPanel;
161 favo3: TPanel;
162 favo2: TPanel;
163 favo1: TPanel;
164 FavoritenLbl: TLabel;
165 BasicPanel: TPanel;
166 QBLbl: TLabel;
167 cpa1: TPanel;
168 cpa16: TPanel;
169 cpa15: TPanel;
170 cpa14: TPanel;
171 cpa13: TPanel;
172 cpa12: TPanel;
173 cpa11: TPanel;
174 cpa10: TPanel;
175 cpa9: TPanel;
176 cpa8: TPanel;
177 cpa7: TPanel;
178 cpa6: TPanel;
179 cpa5: TPanel;
180 cpa4: TPanel;
181 cpa3: TPanel;
182 cpa2: TPanel;
183 PalPanel: TPanel;
184 WinPanel: TPanel;
185 WindowsLbl: TLabel;
186 WinDialog: TLabel;
187 cpb48: TPanel;
188 cpb47: TPanel;
189 cpb46: TPanel;
190 cpb45: TPanel;
191 cpb44: TPanel;
192 cpb43: TPanel;
193 cpb42: TPanel;
194 cpb41: TPanel;
195 cpb40: TPanel;
196 cpb39: TPanel;
197 cpb38: TPanel;
198 cpb37: TPanel;
199 cpb36: TPanel;
200 cpb35: TPanel;
201 cpb34: TPanel;
202 cpb33: TPanel;
203 cpb32: TPanel;
204 cpb31: TPanel;
205 cpb24: TPanel;
206 cpb23: TPanel;
207 cpb30: TPanel;
208 cpb22: TPanel;
209 cpb29: TPanel;
210 cpb21: TPanel;
211 cpb28: TPanel;
212 cpb20: TPanel;
213 cpb27: TPanel;
214 cpb19: TPanel;
215 cpb25: TPanel;
216 cpb26: TPanel;
217 cpb18: TPanel;
218 cpb17: TPanel;
219 cpb16: TPanel;
220 cpb15: TPanel;
221 cpb14: TPanel;
222 cpb13: TPanel;
223 cpb12: TPanel;
224 cpb11: TPanel;
225 cpb10: TPanel;
226 cpb9: TPanel;
227 cpb8: TPanel;
228 cpb7: TPanel;
229 cpb6: TPanel;
230 cpb5: TPanel;
231 cpb4: TPanel;
232 cpb3: TPanel;
233 cpb2: TPanel;
234 cpb1: TPanel;
235 JskPanel: TPanel;
236 PaintshopProLbl: TLabel;
237 cpc47: TPanel;
238 cpc46: TPanel;
239 cpc45: TPanel;
240 cpc44: TPanel;
241 cpc43: TPanel;
242 cpc42: TPanel;
243 cpc39: TPanel;
244 cpc38: TPanel;
245 cpc37: TPanel;
246 cpc36: TPanel;
247 cpc35: TPanel;
248 cpc34: TPanel;
249 cpc31: TPanel;
250 cpc30: TPanel;
251 cpc29: TPanel;
252 cpc28: TPanel;
253 cpc27: TPanel;
254 cpc26: TPanel;
255 cpc23: TPanel;
256 cpc22: TPanel;
257 cpc21: TPanel;
258 cpc20: TPanel;
259 cpc19: TPanel;
260 cpc18: TPanel;
261 cpc40: TPanel;
262 cpc32: TPanel;
263 cpc24: TPanel;
264 cpc16: TPanel;
265 cpc15: TPanel;
266 cpc14: TPanel;
267 cpc13: TPanel;
268 cpc12: TPanel;
269 cpc11: TPanel;
270 cpc10: TPanel;
271 cpc7: TPanel;
272 cpc6: TPanel;
273 cpc5: TPanel;
274 cpc4: TPanel;
275 cpc3: TPanel;
276 cpc2: TPanel;
277 cpc8: TPanel;
278 cpc48: TPanel;
279 cpc41: TPanel;
280 cpc33: TPanel;
281 cpc25: TPanel;
282 cpc17: TPanel;
283 cpc9: TPanel;
284 cpc1: TPanel;
285 favo15: TPanel;
286 favo16: TPanel;
287 Pal: TListBox;
288 WebZutreffendLbl: TLabel;
289 WebZutreffend: TListBox;
290 Panel4: TPanel;
291 Info1: TLabel;
292 Info2: TLabel;
293 Info4: TLabel;
294 Info6: TLabel;
295 Info7: TLabel;
296 Info8: TLabel;
297 Info9: TLabel;
298 Info12: TLabel;
299 Info5: TLabel;
300 Info10: TLabel;
301 Info11: TLabel;
302 Info14: TLabel;
303 Info15: TLabel;
304 Info13: TLabel;
305 ColorTmr: TTimer;
306 Info3: TLabel;
307 AverageX: TEdit;
308 AverageMidLbl: TLabel;
309 AverageY: TEdit;
310 MagPnl: TPanel;
311 MagBox: TPaintBox;
312 favo17: TPanel;
313 favo18: TPanel;
314 favo19: TPanel;
315 favo20: TPanel;
316 CoordsLbl: TLabel;
317 CoordsLbl2: TLabel;
318 SPro: TEdit;
319 SProLbl: TLabel;
320 VProLbl: TLabel;
321 VPro: TEdit;
322 SProC: TUpDown;
323 VProC: TUpDown;
324 BPro: TEdit;
325 GPro: TEdit;
326 RPro: TEdit;
327 RProC: TUpDown;
328 GProC: TUpDown;
329 BProC: TUpDown;
330 RProLbl: TLabel;
331 GProLbl: TLabel;
332 BProLbl: TLabel;
333 procedure ColorClick(Sender: TObject; Button: TMouseButton;
334 Shift: TShiftState; X, Y: Integer);
335 procedure SaveEditChange(Sender: TObject);
336 procedure ColorTmrTimer(Sender: TObject);
337 procedure LinkClick(Sender: TObject);
338 procedure WebZutreffendClick(Sender: TObject);
339 procedure DelphiZutreffendClick(Sender: TObject);
340 procedure WebcolorBoxClick(Sender: TObject);
341 procedure WinDialogClick(Sender: TObject);
342 procedure PalClick(Sender: TObject);
343 procedure OutboxPaint(Sender: TObject);
344 procedure FormClose(Sender: TObject; var Action: TCloseAction);
345 procedure WebsafeLblClick(Sender: TObject);
346 procedure TabControlChange(Sender: TObject);
347 procedure InvertBtnClick(Sender: TObject);
348 procedure TakeClick(Sender: TObject);
349 procedure DelphiBoxClick(Sender: TObject);
350 procedure DefColorClick(Sender: TObject);
351 procedure GreyscaleBtnClick(Sender: TObject);
352 procedure Menu2Click(Sender: TObject);
353 procedure MenuClick(Sender: TObject);
354 procedure RandomBtnClick(Sender: TObject);
355 procedure PickTimerTimer(Sender: TObject);
356 procedure PickBtnClick(Sender: TObject);
357 procedure FormCreate(Sender: TObject);
358 procedure EditKeyPress(Sender: TObject; var Key: Char);
359 procedure UpDownClick(Sender: TObject; Button: TUDBtnType);
360 procedure Change(Sender: TObject);
361 private
362 LangArray: Array of TLanguageEntry;
363 function GetLangEntry(name: string): string;
364 public
365 SampleMethod, NewMethod: byte;
366 MemPix: TBitmap;
367 BoxBuf, Box2Buf: TBitmap;
368 ScreenDC: HDC;
369 PopupmenuSender: tobject;
370 procedure WMLButtonDown(var Msg: TMessage); message WM_LBUTTONDOWN;
371 procedure WMRButtonDown(var Msg: TMessage); message WM_RBUTTONDOWN;
372 procedure AppDeactivate(Sender: TObject);
373 procedure DrawGrad(BoxNum: integer);
374 procedure AktualisiereFarben(RGBAlsQuelle: boolean; ignore: integer = 0);
375 procedure AktualisiereWert(Sender: TObject);
376 procedure Ladefarbe(col: tcolor);
377 procedure BerechneMixColor;
378 procedure CheckWebfarben;
379 procedure CheckDelphiFarben;
380 procedure ZeigeRichtigePalette;
381 procedure SchreibeInt(name: string; wert: integer);
382 function LeseInt(name: string): integer;
383 end;
384
385 var
386 MainForm: TMainForm;
387
388 implementation
389
390 {$R *.DFM}
391
392 {$R WindowsXP.res}
393
394 const
395 webfarben: array[0..140] of string = ('#F0F8FF', '#FAEBD7', '#00FFFF', '#7FFFD4',
396 '#F0FFFF', '#F5F5DC', '#FFE4C4', '#000000', '#FFEBCD', '#0000FF', '#8A2BE2',
397 '#A52A2A', '#DEB887', '#5F9EA0', '#7FFF00', '#D2691E', '#FF7F50', '#6495ED',
398 '#FFF8DC', '#DC143C', '#00FFFF', '#00008B', '#008B8B', '#B8860B', '#A9A9A9',
399 '#006400', '#BDB76B', '#8B008B', '#556B2F', '#FF8C00', '#9932CC', '#8B0000',
400 '#E9967A', '#8FBC8F', '#483D8B', '#2F4F4F', '#00CED1', '#9400D3', '#FF1493',
401 '#00BFFF', '#696969', '#1E90FF', '#B22222', '#FFFAF0', '#228B22', '#FF00FF',
402 '#DCDCDC', '#F8F8FF', '#FFD700', '#DAA520', '#808080', '#008000', '#ADFF2F',
403 '#808080', '#F0FFF0', '#FF69B4', '#CD5C5C', '#4B0082', '#FFFFF0', '#F0E68C',
404 '#E6E6FA', '#FFF0F5', '#7CFC00', '#FFFACD', '#ADD8E6', '#F08080', '#E0FFFF',
405 '#FAFAD2', '#90EE90', '#D3D3D3', '#FFB6C1', '#FFA07A', '#20B2AA', '#87CEFA',
406 '#778899', '#B0C4DE', '#FFFFE0', '#00FF00', '#32CD32', '#FAF0E6', '#FF00FF',
407 '#800000', '#66CDAA', '#0000CD', '#BA55D3', '#9370DB', '#3CB371', '#7B68EE',
408 '#00FA9A', '#48D1CC', '#C71585', '#191970', '#F5FFFA', '#FFE4E1', '#FFE4B5',
409 '#FFDEAD', '#000080', '#FDF5E6', '#808000', '#6B8E23', '#FFA500', '#FF4500',
410 '#DA70D6', '#EEE8AA', '#98FB98', '#AFEEEE', '#DB7093', '#FFEFD5', '#FFDAB9',
411 '#CD853F', '#FFC0CB', '#DDA0DD', '#B0E0E6', '#800080', '#FF0000', '#BC8F8F',
412 '#4169E1', '#8B4513', '#FA8072', '#F4A460', '#2E8B57', '#FFF5EE', '#A0522D',
413 '#C0C0C0', '#87CEEB', '#6A5ACD', '#708090', '#FFFAFA', '#00FF7F', '#4682B4',
414 '#D2B48C', '#008080', '#D8BFD8', '#FF6347', '#40E0D0', '#EE82EE', '#F5DEB3',
415 '#FFFFFF', '#F5F5F5', '#FFFF00', '#9ACD32');
416
417 function TMainForm.GetLangEntry(name: string): string;
418 var
419 i: integer;
420 begin
421 for i := 0 to high(LangArray) do
422 begin
423 if LangArray[i].name = name then
424 begin
425 result := LangArray[i].text;
426 break;
427 end;
428 end;
429 end;
430
431 // http://www.delphipraxis.net/topic49179_rgb+hsv+und+hsv+rgb.html
432 // mit 360°
433 function HSVtoRGB(H:Integer; S, V: Byte): TColor;
434 var
435 ht, d, t1, t2, t3:Integer;
436 R,G,B:Word;
437 begin
438 if S = 0 then
439 begin
440 R := V; G := V; B := V;
441 end
442 else
443 begin
444 ht := H * 6;
445 d := ht mod 360;
446
447 t1 := round(V * (255 - S) / 255);
448 t2 := round(V * (255 - S * d / 360) / 255);
449 t3 := round(V * (255 - S * (360 - d) / 360) / 255);
450
451 case ht div 360 of
452 0:
453 begin
454 R := V; G := t3; B := t1;
455 end;
456 1:
457 begin
458 R := t2; G := V; B := t1;
459 end;
460 2:
461 begin
462 R := t1; G := V; B := t3;
463 end;
464 3:
465 begin
466 R := t1; G := t2; B := V;
467 end;
468 4:
469 begin
470 R := t3; G := t1; B := V;
471 end;
472 else
473 begin
474 R := V; G := t1; B := t2;
475 end;
476 end;
477 end;
478 Result:=RGB(R,G,B);
479 end;
480
481 // http://www.delphipraxis.net/topic49179_rgb+hsv+und+hsv+rgb.html
482 // mit 360°
483 procedure RGBtoHSV(Red, Green, Blue: Byte; var Hue: Integer; var Saturation, Value: Byte);
484 var
485 Maximum, Minimum: Byte;
486 Rc, Gc, Bc: Single;
487 H: Single;
488 begin
489 Maximum := Max(Red, Max(Green, Blue));
490 Minimum := Min(Red, Min(Green, Blue));
491 Value := Maximum;
492 if Maximum <> 0 then
493 Saturation := MulDiv(Maximum - Minimum, 255, Maximum)
494 else
495 Saturation := 0;
496 if Saturation = 0 then
497 Hue := 0 // arbitrary value
498 else
499 begin
500 Assert(Maximum <> Minimum);
501 Rc := (Maximum - Red) / (Maximum - Minimum);
502 Gc := (Maximum - Green) / (Maximum - Minimum);
503 Bc := (Maximum - Blue) / (Maximum - Minimum);
504 if Red = Maximum then
505 H := Bc - Gc
506 else if Green = Maximum then
507 H := 2 + Rc - Bc
508 else
509 begin
510 Assert(Blue = Maximum);
511 H := 4 + Gc - Rc;
512 end;
513 H := H * 60;
514 if H < 0 then
515 H := H + 360;
516 Hue := Round(H);
517 end;
518 end;
519
520 // http://www.delphipraxis.net/topic35695_kontrastfarbe+ermitteln.html
521 function BlackWhiteContrastColor(value: TColor): TColor;
522 var
523 intensity : Integer;
524 begin
525 value := ColorToRGB(value);
526
527 intensity := GetBValue(value) * 21 // Blue
528 + GetGValue(value) * 174 // Green
529 + GetRValue(value) * 61; // Red
530
531 // intensity = 0 -> dark
532 // intensity = 255*256 -> bright
533
534 if intensity >= (128*256) then
535 Result := clBlack
536 else
537 Result := clWhite;
538 end;
539
540 procedure TMainForm.WMLButtonDown(var Msg: TMessage);
541 begin
542 inherited;
543 if not PickBtn.Enabled then begin
544 ReleaseCapture;
545 PickBtn.Enabled := true;
546 Caption := Application.Title;
547 PostMessage(MainForm.Handle, WM_ACTIVATE, word(true), 0);
548 end;
549 end;
550
551 procedure TMainForm.WMRButtonDown(var Msg: TMessage);
552 begin
553 inherited;
554 WMLButtonDown(Msg);
555 end;
556
557 procedure TMainForm.AppDeactivate(Sender: TObject);
558 begin
559 if not PickBtn.Enabled then
560 SetCapture(MainForm.Handle);
561 end;
562
563 procedure TMainForm.DrawGrad(BoxNum: integer);
564 var
565 R, G, B, S, V: byte;
566 H: integer;
567 begin
568 case BoxNum of
569 1:
570 begin
571 G := Mainform.G.Position;
572 B := Mainform.B.Position;
573
574 with BoxBuf.Canvas do
575 begin
576 for R := 0 to 255 do
577 Pixels[R, 0] := rgb(R, G, B);
578 StretchBlt(RedBox.Canvas.Handle,
579 0, 0, RedBox.Width, RedBox.Height,
580 Handle,
581 0, 0,
582 256, 1,
583 SRCCOPY);
584 end;
585 end;
586
587 2:
588 begin
589 R := Mainform.R.Position;
590 B := Mainform.B.Position;
591
592 with BoxBuf.Canvas do
593 begin
594 for G := 0 to 255 do
595 Pixels[G, 0] := rgb(R, G, B);
596 StretchBlt(GreenBox.Canvas.Handle,
597 0, 0, GreenBox.Width, GreenBox.Height,
598 Handle,
599 0, 0,
600 256, 1,
601 SRCCOPY);
602 end;
603 end;
604
605 3:
606 begin
607 R := Mainform.R.Position;
608 G := Mainform.G.Position;
609
610 with BoxBuf.Canvas do
611 begin
612 for B := 0 to 255 do
613 Pixels[B, 0] := rgb(R, G, B);
614 StretchBlt(BlueBox.Canvas.Handle,
615 0, 0, BlueBox.Width, BlueBox.Height,
616 Handle,
617 0, 0,
618 256, 1,
619 SRCCOPY);
620 end;
621 end;
622
623 4:
624 begin
625 S := Mainform.S.Position;
626 V := MainForm.V.Position;
627
628 with Box2Buf.Canvas do
629 begin
630 for H := 0 to 359 do
631 Pixels[H, 0] := HSVtoRGB(H, S, V);
632 StretchBlt(HueBox.Canvas.Handle,
633 0, 0, HueBox.Width, HueBox.Height,
634 Handle,
635 0, 0,
636 360, 1,
637 SRCCOPY);
638 end;
639 end;
640
641 5:
642 begin
643 H := Mainform.H.Position;
644 V := MainForm.V.Position;
645
646 with BoxBuf.Canvas do
647 begin
648 for S := 0 to 255 do
649 Pixels[S, 0] := HSVtoRGB(H, S, V);
650 StretchBlt(SatBox.Canvas.Handle,
651 0, 0, SatBox.Width, SatBox.Height,
652 Handle,
653 0, 0,
654 256, 1,
655 SRCCOPY);
656 end;
657 end;
658
659 6:
660 begin
661 H := Mainform.H.Position;
662 S := MainForm.S.Position;
663
664 with BoxBuf.Canvas do
665 begin
666 for V := 0 to 255 do
667 Pixels[V, 0] := HSVtoRGB(H, S, V);
668 StretchBlt(ValBox.Canvas.Handle,
669 0, 0, ValBox.Width, ValBox.Height,
670 Handle,
671 0, 0,
672 256, 1,
673 SRCCOPY);
674 end;
675 end;
676 end;
677 end;
678
679 procedure TMainForm.FormCreate(Sender: TObject);
680 var
681 i: integer;
682 ini: tinifile;
683 str: TStringList;
684 begin
685 Application.OnDeactivate := AppDeactivate;
686 Randomize;
687
688 ScreenDC := GetDC(0);
689
690 MemPix := TBitmap.Create;
691
692 MemPix.Width := MagBox.Width;
693 MemPix.Height := MagBox.Height;
694 MemPix.Canvas.Pixels[0, 0] := clBlack;
695
696 SampleMethod := NewMethod;
697
698 BoxBuf := TBitmap.Create;
699 BoxBuf.Width := 256;
700 BoxBuf.Height := 1;
701
702 Box2Buf := TBitmap.Create;
703 Box2Buf.Width := 360;
704 Box2Buf.Height := 1;
705
706 Caption := Application.title;
707 Change(r);
708 Change(g);
709 Change(b);
710
711 delphibox.ItemIndex := -1;
712 color1upd.position := 50;
713 UpDownClick(color1upd, btPrev);
714 color1.Color := clBlack;
715 PopupmenuSender := color1;
716 MenuClick(popupmenu);
717 color2.Color := clBlack;
718 PopupmenuSender := color2;
719 MenuClick(popupmenu);
720
721 cpa1.font.color := BlackWhiteContrastColor(cpa1.Color);
722 cpa2.font.color := BlackWhiteContrastColor(cpa2.Color);
723 cpa3.font.color := BlackWhiteContrastColor(cpa3.Color);
724 cpa4.font.color := BlackWhiteContrastColor(cpa4.Color);
725 cpa5.font.color := BlackWhiteContrastColor(cpa5.Color);
726 cpa6.font.color := BlackWhiteContrastColor(cpa6.Color);
727 cpa7.font.color := BlackWhiteContrastColor(cpa7.Color);
728 cpa8.font.color := BlackWhiteContrastColor(cpa8.Color);
729 cpa9.font.color := BlackWhiteContrastColor(cpa9.Color);
730 cpa10.font.color := BlackWhiteContrastColor(cpa10.Color);
731 cpa11.font.color := BlackWhiteContrastColor(cpa11.Color);
732 cpa12.font.color := BlackWhiteContrastColor(cpa12.Color);
733 cpa13.font.color := BlackWhiteContrastColor(cpa13.Color);
734 cpa14.font.color := BlackWhiteContrastColor(cpa14.Color);
735 cpa15.font.color := BlackWhiteContrastColor(cpa15.Color);
736 cpa16.font.color := BlackWhiteContrastColor(cpa16.Color);
737
738 // Sprachdatei auslesen
739 if fileexists(ExtractFilePath(Application.ExeName)+'Language.ini') then
740 begin
741 ini := TIniFile.Create(ExtractFilePath(Application.ExeName)+'Language.ini');
742 str := TStringList.Create();
743 try
744 ini.ReadSection(Name, str);
745 for i := 0 to str.count-1 do
746 begin
747 setlength(LangArray, length(LangArray)+1);
748 LangArray[length(LangArray)-1].name := str.strings[i];
749 LangArray[length(LangArray)-1].text := ini.ReadString(name, str.strings[i], '');
750 LangArray[length(LangArray)-1].text := StringReplace(LangArray[length(LangArray)-1].text, '###', #13#10, [rfReplaceAll]);
751 end;
752 finally
753 ini.free;
754 str.Free;
755 end;
756 end;
757
758 // Elemente mit Sprache versehen
759 rgbbox.Caption := GetLangEntry('rgb');
760 hsvbox.Caption := GetLangEntry('hsv');
761 rdeclbl.Caption := GetLangEntry('dec');
762 gdeclbl.Caption := GetLangEntry('dec');
763 bdeclbl.Caption := GetLangEntry('dec');
764 hdeclbl.Caption := GetLangEntry('dec');
765 sdeclbl.Caption := GetLangEntry('dec');
766 vdeclbl.Caption := GetLangEntry('dec');
767 rhexlbl.Caption := GetLangEntry('hex');
768 ghexlbl.Caption := GetLangEntry('hex');
769 bhexlbl.Caption := GetLangEntry('hex');
770 hhexlbl.Caption := GetLangEntry('hex');
771 shexlbl.Caption := GetLangEntry('hex');
772 vhexlbl.Caption := GetLangEntry('hex');
773 hgralbl.Caption := GetLangEntry('gra');
774 rlbl.Caption := GetLangEntry('red');
775 glbl.Caption := GetLangEntry('green');
776 blbl.Caption := GetLangEntry('blue');
777 GreyscaleBtn.caption := GetLangEntry('greyscale');
778 InvertBtn.caption := GetLangEntry('invert');
779 WebSafeBtn.caption := GetLangEntry('websafe');
780 RandomBtn.caption := GetLangEntry('random');
781 HLbl.caption := GetLangEntry('hue');
782 SLbl.caption := GetLangEntry('sat');
783 VLbl.caption := GetLangEntry('val');
784 ColorcodeBox.caption := GetLangEntry('codes');
785 htmllbl.caption := GetLangEntry('html');
786 delphilbl.caption := GetLangEntry('delphi');
787 VisualClbl.caption := GetLangEntry('cpp');
788 visualbasiclbl.caption := GetLangEntry('visualbasic');
789 javalbl.caption := GetLangEntry('java');
790 photoshoplbl.caption := GetLangEntry('photoshop');
791 longlbl.caption := GetLangEntry('long');
792 currentlbl.caption := GetLangEntry('current');
793 websafelbl.caption := GetLangEntry('websafelbl');
794 komplementaercolor.Caption := GetLangEntry('invcolor');
795 websafe2.Caption := GetLangEntry('invwebsafe');
796 tabcontrol.tabs.clear;
797 tabcontrol.Tabs.add(GetLangEntry('tab1'));
798 tabcontrol.Tabs.add(GetLangEntry('tab2'));
799 tabcontrol.Tabs.add(GetLangEntry('tab3'));
800 tabcontrol.Tabs.add(GetLangEntry('tab4'));
801 colormixerbox.Caption := getlangentry('colormixer');
802 color1.Caption := getlangentry('color') + ' 1';
803 color2.Caption := getlangentry('color') + ' 2';
804 mixedcolor.caption := getlangentry('mixedcolor');
805 colorbox.caption := getlangentry('colors');
806 pallbl.Caption := getlangentry('availablepals');
807 delphiboxlbl.Caption := getlangentry('delphipal');
808 webcolorlbl.Caption := getlangentry('css3');
809 delphizutreffendlbl.Caption := getlangentry('zutr');
810 webzutreffendlbl.Caption := getlangentry('zutr');
811 qblbl.Caption := getlangentry('vgapal');
812 windialog.Caption := getlangentry('windialog');
813 favoritenlbl.Caption := getlangentry('favorites');
814 pal.Items.add(getlangentry('windows'));
815 pal.Items.add(getlangentry('jasc'));
816 windowslbl.Caption := getlangentry('windows');
817 PaintshopProlbl.Caption := getlangentry('jasc');
818 colorpicker.Caption := getlangentry('colorpicker');
819 averagelbl.Caption := getlangentry('averagepix');
820 CoordsLbl2.Caption := getlangentry('coords');
821 pickbtn.Caption := getlangentry('capture');
822 info3.Caption := getlangentry('createdwith');
823 info4.Caption := getlangentry('leader');
824 info6.Caption := getlangentry('email');
825 info8.Caption := getlangentry('website');
826 info10.Caption := getlangentry('icq');
827 info13.Caption := getlangentry('webportal');
828 info14.Caption := getlangentry('viathinksoft');
829 info15.Caption := getlangentry('projektseite');
830 info5.Caption := getlangentry('contact');
831 info12.Caption := getlangentry('links');
832 komplementaercolor.Hint := getlangentry('thiscolor');
833 websafe2.Hint := getlangentry('thiscolor');
834 websafe1.Hint := getlangentry('thiscolor');
835 websafelbl.Hint := getlangentry('thiscolor');
836 sprolbl.Caption := getlangentry('per');
837 vprolbl.Caption := getlangentry('per');
838 rprolbl.Caption := getlangentry('per');
839 gprolbl.Caption := getlangentry('per');
840 bprolbl.Caption := getlangentry('per');
841 popupmenu.Items.Items[0].Caption := getlangentry('PopupA');
842 popupmenu.Items.Items[0].Items[0].Caption := getlangentry('PopupA1');
843 popupmenu.Items.Items[0].Items[1].Caption := getlangentry('PopupA2');
844 popupmenu.Items.Items[0].Items[2].Caption := getlangentry('PopupA3');
845 popupmenu.Items.Items[0].Items[3].Caption := getlangentry('PopupA4');
846 popupmenu.Items.Items[0].Items[4].Caption := getlangentry('PopupA5');
847 popupmenu.Items.Items[1].Caption := getlangentry('PopupB');
848 popupmenu.Items.Items[1].Items[0].Caption := getlangentry('PopupB1');
849 popupmenu.Items.Items[1].Items[1].Caption := getlangentry('PopupB2');
850 popupmenu.Items.Items[2].Caption := getlangentry('PopupC');
851
852 // Favoriten-Farben und Einstellungen aus Registry holen
853 pal.ItemIndex := 0;
854 for i := 1 to 20 do
855 tpanel(mainform.FindComponent('favo'+inttostr(i))).Color := LeseInt('favo'+inttostr(i));
856 pal.ItemIndex := LeseInt('Palette');
857 AverageX.Text := inttostr(LeseInt('AverageX'));
858 AverageY.Text := inttostr(LeseInt('AverageY'));
859
860 ZeigeRichtigePalette;
861 end;
862
863 function WebSafeColor(inp: TColor): TColor;
864
865 function WebSafeVal(int: Byte): Byte;
866 begin
867 case int of
868 0..26: Result := 0;
869 27..76: Result := 51;
870 77..127: Result := 102;
871 128..178: Result := 153;
872 179..229: Result := 209;
873 else Result := 255;
874 end;
875 end;
876
877 begin
878 result := rgb(WebSafeVal(GetRValue(inp)), WebSafeVal(GetGValue(inp)), WebSafeVal(GetBValue(inp)));
879 end;
880
881 function InvertString(inp: string): string;
882 var
883 i: integer;
884 begin
885 result := '';
886 for i := length(inp) downto 1 do
887 result := result + inp[i];
888 end;
889
890 procedure TMainForm.AktualisiereFarben(RGBAlsQuelle: boolean; Ignore: integer = 0);
891 var
892 hc: integer;
893 sc, lc: byte;
894 begin
895 if RGBAlsQuelle then
896 begin
897 RGBtoHSV(R.position, G.position, B.Position, hc, sc, lc);
898 ColorPanel.color := rgb(R.position, G.position, B.Position);
899
900 h.OnChange := nil;
901 h.position := hc;
902 AktualisiereWert(h);
903 h.OnChange := Change;
904
905 s.OnChange := nil;
906 s.position := sc;
907 AktualisiereWert(s);
908 s.OnChange := Change;
909
910 v.OnChange := nil;
911 v.position := lc;
912 AktualisiereWert(v);
913 v.OnChange := Change;
914 end
915 else
916 begin
917 ColorPanel.color := HSVtoRGB(h.Position, s.Position, v.Position);
918
919 // Die OnChange-Ereignisse werden kurzzeitig entfernt,
920 // um eine unendliche Rückkopplung durch AktualisiereFarben() zu verhindern
921 r.OnChange := nil;
922 g.OnChange := nil;
923 b.OnChange := nil;
924
925 Ladefarbe(colorpanel.Color);
926
927 AktualisiereWert(r);
928 AktualisiereWert(g);
929 AktualisiereWert(b);
930
931 r.OnChange := Change;
932 g.OnChange := Change;
933 b.OnChange := Change;
934 end;
935
936 VisualC.text := '0x00' + inttohex(GetRValue(ColorPanel.color), 2) + inttohex(GetGValue(ColorPanel.color), 2) +
937 inttohex(GetBValue(ColorPanel.color), 2);
938 HTML.text := '#' + inttohex(GetRValue(ColorPanel.color), 2) + inttohex(GetGValue(ColorPanel.color), 2) +
939 inttohex(GetBValue(ColorPanel.color), 2);
940 Delphi.text := '$00' + inttohex(GetBValue(ColorPanel.color), 2) + inttohex(GetGValue(ColorPanel.color), 2) +
941 inttohex(GetRValue(ColorPanel.color), 2);
942 VisualBasic.text := '&00' + inttohex(GetBValue(ColorPanel.color), 2) + inttohex(GetGValue(ColorPanel.color), 2) +
943 inttohex(GetRValue(ColorPanel.color), 2) + '&';
944 Java.text := '0x' + InvertString(inttohex(GetBValue(ColorPanel.color), 2)) + InvertString(inttohex(GetGValue(ColorPanel.color), 2)) +
945 InvertString(inttohex(GetRValue(ColorPanel.color), 2));
946 Photoshop.text := InvertString(inttohex(GetBValue(ColorPanel.color), 2)) + InvertString(inttohex(GetGValue(ColorPanel.color), 2)) +
947 InvertString(inttohex(GetRValue(ColorPanel.color), 2));
948 Long.Text := inttostr(ColorToRGB(ColorPanel.color));
949
950 if Ignore <> 1 then
951 CheckDelphiFarben; // Akzeptiert keine Systemfarben: DelphiBox.Selected := ColorPanel.color;
952
953 if Ignore <> 2 then
954 CheckWebfarben;
955
956 KomplementaerColor.Color := ColorPanel.Color xor $FFFFFF;
957 KomplementaerColor.Font.Color := BlackWhiteContrastColor(KomplementaerColor.Color);
958
959 websafe1.Color := WebSafeColor(colorpanel.color);
960 websafe1.Font.Color := BlackWhiteContrastColor(websafe1.Color);
961 websafe2.Color := websafe1.color xor $FFFFFF;
962 websafe2.Font.Color := BlackWhiteContrastColor(websafe2.Color);
963
964 CurrentLbl.Font.Color := BlackWhiteContrastColor(ColorPanel.Color);
965 WebsafeLbl.Font.Color := BlackWhiteContrastColor(websafe1.Color);
966 end;
967
968 function DeleteFirstSeros(str: string): string;
969 var
970 ende: boolean;
971 begin
972 ende := false;
973 while not ende do
974 if (copy(str, 0, 1) = '0') and (length(str) > 1) then
975 str := copy(str, 2, length(str)-1)
976 else
977 ende := true;
978 result := str;
979 end;
980
981 function HexToInt(hex: string; sender: tobject): integer;
982 var
983 i: integer;
984 begin
985 hex := DeleteFirstSeros(hex);
986 result := -1;
987 for i := $00 to $FF do
988 if uppercase(hex) = inttohex(i, 0) then
989 begin
990 result := i;
991 end;
992 end;
993
994 procedure TMainForm.EditKeyPress(Sender: TObject; var Key: Char);
995 begin
996 if (sender = HTML) then
997 begin
998 if not (Key in [#13, #08, '0'..'9', '#', 'a'..'f', 'A'..'F']) then Key := #0;
999 end
1000 else if (sender = Delphi) then
1001 begin
1002 if not (Key in [#13, #08, '0'..'9', '$', 'a'..'f', 'A'..'F']) then Key := #0;
1003 end
1004 else if (sender = VisualC) or (sender = Java) then
1005 begin
1006 if not (Key in [#13, #08, '0'..'9', 'x', 'a'..'f', 'A'..'F']) then Key := #0;
1007 end
1008 else if (sender = VisualBasic) then
1009 begin
1010 if not (Key in [#13, #08, '0'..'9', '&', 'a'..'f', 'A'..'F']) then Key := #0;
1011 end
1012 else if (sender = Photoshop) then
1013 begin
1014 if not (Key in [#13, #08, '0'..'9', 'a'..'f', 'A'..'F']) then Key := #0;
1015 end
1016 else if (sender = Long) or (sender = AverageX) or (sender = AverageY) or
1017 (sender = SPro) or (sender = VPro) or (sender = RPro) or (sender = GPro) or
1018 (sender = BPro) then
1019 begin
1020 if not (Key in [#13, #08, '0'..'9']) then Key := #0;
1021 end
1022 else if (sender = RHex) or (sender = GHex) or (sender = BHex) or
1023 (sender = HHex) or (sender = SHex) or (sender = VHex) then
1024 begin
1025 if not (Key in [#13, #08, '0'..'9', 'a'..'f', 'A'..'F']) then Key := #0;
1026 end
1027 else
1028 begin
1029 if not (Key in [#13, #08, '0'..'9']) then Key := #0;
1030 end;
1031
1032 if key = #13 then
1033 begin
1034 Key := #0;
1035 if sender = RHex then
1036 begin
1037 R.Position := hextoint(RHex.text, r);
1038 Change(r);
1039 end;
1040 if sender = RPro then
1041 begin
1042 if strtoint(tedit(sender).text) > 100 then
1043 tedit(sender).Text := inttostr(100);
1044 R.Position := round(strtoint(RPro.text) / rproc.max * 255);
1045 Change(r);
1046 end;
1047 if sender = GHex then
1048 begin
1049 G.Position := hextoint(GHex.text, g);
1050 Change(g);
1051 end;
1052 if sender = GPro then
1053 begin
1054 if strtoint(tedit(sender).text) > 100 then
1055 tedit(sender).Text := inttostr(100);
1056 G.Position := round(strtoint(GPro.text) / gproc.max * 255);
1057 Change(g);
1058 end;
1059 if sender = BHex then
1060 begin
1061 B.Position := hextoint(BHex.text, b);
1062 Change(b);
1063 end;
1064 if sender = BPro then
1065 begin
1066 if strtoint(tedit(sender).text) > 100 then
1067 tedit(sender).Text := inttostr(100);
1068 B.Position := round(strtoint(BPro.text) / bproc.max * 255);
1069 Change(b);
1070 end;
1071 if sender = HHex then
1072 begin
1073 H.Position := ceil(hextoint(HHex.text, h) / 255 * 359);
1074 Change(h);
1075 end;
1076 if sender = HGra then
1077 begin
1078 H.Position := strtoint(HGra.text);
1079 Change(h);
1080 end;
1081 if sender = SHex then
1082 begin
1083 S.Position := hextoint(SHex.text, s);
1084 Change(s);
1085 end;
1086 if sender = SPro then
1087 begin
1088 if strtoint(tedit(sender).text) > 100 then
1089 tedit(sender).Text := inttostr(100);
1090 S.Position := round(strtoint(SPro.text) / sproc.max * 255);
1091 Change(h);
1092 end;
1093 if sender = VHex then
1094 begin
1095 v.Position := hextoint(VHex.text, v);
1096 Change(v);
1097 end;
1098 if sender = VPro then
1099 begin
1100 if strtoint(tedit(sender).text) > 100 then
1101 tedit(sender).Text := inttostr(100);
1102 V.Position := round(strtoint(VPro.text) / vproc.max * 255);
1103 Change(h);
1104 end;
1105 if sender = RDec then
1106 begin
1107 if strtoint(RDec.Text) > RDecC.Max then RDec.Text := inttostr(RDecC.Max);
1108 if strtoint(RDec.Text) < RDecC.Min then RDec.Text := inttostr(RDecC.Min);
1109 R.Position := strtoint(RDec.text);
1110 Change(r);
1111 end;
1112 if sender = GDec then
1113 begin
1114 if strtoint(GDec.Text) > GDecC.Max then GDec.Text := inttostr(GDecC.Max);
1115 if strtoint(GDec.Text) < GDecC.Min then GDec.Text := inttostr(GDecC.Min);
1116 G.Position := strtoint(GDec.text);
1117 Change(g);
1118 end;
1119 if sender = BDec then
1120 begin
1121 if strtoint(BDec.Text) > BDecC.Max then BDec.Text := inttostr(BDecC.Max);
1122 if strtoint(BDec.Text) < BDecC.Min then BDec.Text := inttostr(BDecC.Min);
1123 B.Position := strtoint(BDec.text);
1124 Change(b);
1125 end;
1126 if sender = HDec then
1127 begin
1128 if strtoint(HDec.Text) > HDecC.Max then HDec.Text := inttostr(HDecC.Max);
1129 if strtoint(HDec.Text) < HDecC.Min then HDec.Text := inttostr(HDecC.Min);
1130 H.Position := ceil(strtoint(HDec.text) / 255 * 359);
1131 Change(H);
1132 end;
1133 if sender = SDec then
1134 begin
1135 if strtoint(SDec.Text) > SDecC.Max then SDec.Text := inttostr(SDecC.Max);
1136 if strtoint(SDec.Text) < SDecC.Min then SDec.Text := inttostr(SDecC.Min);
1137 S.Position := strtoint(SDec.text);
1138 Change(S);
1139 end;
1140 if sender = VDec then
1141 begin
1142 if strtoint(VDec.Text) > VDecC.Max then VDec.Text := inttostr(VDecC.Max);
1143 if strtoint(VDec.Text) < VDecC.Min then VDec.Text := inttostr(VDecC.Min);
1144 V.Position := strtoint(VDec.text);
1145 Change(V);
1146 end;
1147 if sender = Long then
1148 begin
1149 if strtoint(tedit(sender).text) > 16777215 then
1150 tedit(sender).Text := inttostr(16777215);
1151
1152 R.OnChange := nil;
1153 G.OnChange := nil;
1154 B.OnChange := nil;
1155
1156 R.Position := getrvalue(strtoint(long.text));
1157 G.Position := getgvalue(strtoint(long.text));
1158 B.Position := getbvalue(strtoint(long.text));
1159
1160 R.OnChange := Change;
1161 G.OnChange := Change;
1162 B.OnChange := Change;
1163
1164 Change(r);
1165 Change(g);
1166 Change(b);
1167 end;
1168 if sender = Photoshop then
1169 begin
1170 R.OnChange := nil;
1171 G.OnChange := nil;
1172 B.OnChange := nil;
1173
1174 R.Position := hextoint(invertstring(copy(Photoshop.text, 5, 2)), r);
1175 G.Position := hextoint(invertstring(copy(Photoshop.text, 3, 2)), g);
1176 B.Position := hextoint(invertstring(copy(Photoshop.text, 1, 2)), b);
1177
1178 R.OnChange := Change;
1179 G.OnChange := Change;
1180 B.OnChange := Change;
1181
1182 Change(r);
1183 Change(g);
1184 Change(b);
1185 end;
1186 if sender = Java then
1187 begin
1188 R.OnChange := nil;
1189 G.OnChange := nil;
1190 B.OnChange := nil;
1191
1192 R.Position := hextoint(invertstring(copy(Java.text, 7, 2)), r);
1193 G.Position := hextoint(invertstring(copy(Java.text, 5, 2)), g);
1194 B.Position := hextoint(invertstring(copy(Java.text, 3, 2)), b);
1195
1196 R.OnChange := Change;
1197 G.OnChange := Change;
1198 B.OnChange := Change;
1199
1200 Change(r);
1201 Change(g);
1202 Change(b);
1203 end;
1204 if sender = VisualBasic then
1205 begin
1206 R.OnChange := nil;
1207 G.OnChange := nil;
1208 B.OnChange := nil;
1209
1210 R.Position := hextoint(copy(VisualBasic.text, 8, 2), r);
1211 G.Position := hextoint(copy(VisualBasic.text, 6, 2), g);
1212 B.Position := hextoint(copy(VisualBasic.text, 4, 2), b);
1213
1214 R.OnChange := Change;
1215 G.OnChange := Change;
1216 B.OnChange := Change;
1217
1218 Change(r);
1219 Change(g);
1220 Change(b);
1221 end;
1222 if sender = VisualC then
1223 begin
1224 R.OnChange := nil;
1225 G.OnChange := nil;
1226 B.OnChange := nil;
1227
1228 R.Position := hextoint(copy(VisualC.text, 9, 2), r);
1229 G.Position := hextoint(copy(VisualC.text, 7, 2), g);
1230 B.Position := hextoint(copy(VisualC.text, 5, 2), b);
1231
1232 R.OnChange := Change;
1233 G.OnChange := Change;
1234 B.OnChange := Change;
1235
1236 Change(r);
1237 Change(g);
1238 Change(b);
1239 end;
1240 if sender = Delphi then
1241 begin
1242 R.OnChange := nil;
1243 G.OnChange := nil;
1244 B.OnChange := nil;
1245
1246 R.Position := hextoint(copy(Delphi.text, 8, 2), r);
1247 G.Position := hextoint(copy(Delphi.text, 6, 2), g);
1248 B.Position := hextoint(copy(Delphi.text, 4, 2), b);
1249
1250 R.OnChange := Change;
1251 G.OnChange := Change;
1252 B.OnChange := Change;
1253
1254 Change(r);
1255 Change(g);
1256 Change(b);
1257 end;
1258 if sender = HTML then
1259 begin
1260 R.OnChange := nil;
1261 G.OnChange := nil;
1262 B.OnChange := nil;
1263
1264 R.Position := hextoint(copy(html.text, 2, 2), r);
1265 G.Position := hextoint(copy(html.text, 4, 2), g);
1266 B.Position := hextoint(copy(html.text, 6, 2), b);
1267
1268 R.OnChange := Change;
1269 G.OnChange := Change;
1270 B.OnChange := Change;
1271
1272 Change(r);
1273 Change(g);
1274 Change(b);
1275 end;
1276 end;
1277 end;
1278
1279 procedure TMainForm.UpDownClick(Sender: TObject; Button: TUDBtnType);
1280 begin
1281 if hgrac.Position = hgrac.Min then
1282 hgrac.Position := hgrac.Max-1;
1283 if hgrac.Position = hgrac.Max then
1284 hgrac.Position := hgrac.Min+1;
1285 if (sender = RHexC) or (sender = RDecC) then
1286 R.Position := TUpDown(sender).Position;
1287 if (sender = RProC) then
1288 R.Position := round(RProC.Position / 100 * 255);
1289 if (sender = GHexC) or (sender = GDecC) then
1290 G.Position := TUpDown(sender).Position;
1291 if (sender = GProC) then
1292 G.Position := round(GProC.Position / 100 * 255);
1293 if (sender = BHexC) or (sender = BDecC) then
1294 B.Position := TUpDown(sender).Position;
1295 if (sender = BProC) then
1296 B.Position := round(BProC.Position / 100 * 255);
1297 if (sender = HHexC) or (sender = HDecC) then
1298 H.Position := ceil(TUpDown(sender).Position / 255 * 359);
1299 if (sender = HGraC) then
1300 H.Position := TUpDown(sender).Position;
1301 if (sender = SHexC) or (sender = SDecC) then
1302 S.Position := TUpDown(sender).Position;
1303 if (sender = SProC) then
1304 S.Position := round(SProC.Position / 100 * 255);
1305 if (sender = VHexC) or (sender = VDecC) then
1306 V.Position := TUpDown(sender).Position;
1307 if sender = VProC then
1308 V.Position := round(VProC.Position / 100 * 255);
1309 if (sender = Color1Upd) then
1310 begin
1311 Color1Edt.Text := inttostr(Color1Upd.Position);
1312 Color2Upd.Position := Color1Upd.Max - Color1Upd.Position;
1313 Color2Edt.Text := inttostr(Color2Upd.Position);
1314 BerechneMixColor;
1315 end;
1316 if (sender = Color2Upd) then
1317 begin
1318 Color2Edt.Text := inttostr(Color2Upd.Position);
1319 Color1Upd.Position := Color2Upd.Max - Color2Upd.Position;
1320 Color1Edt.Text := inttostr(Color1Upd.Position);
1321 BerechneMixColor;
1322 end;
1323 end;
1324
1325 procedure TMainForm.AktualisiereWert(Sender: TObject);
1326 begin
1327 if sender = R then
1328 begin
1329 RHex.text := inttohex(R.position, 0);
1330 RHexC.Position := R.Position;
1331 RDec.text := inttostr(R.position);
1332 RDecC.Position := R.Position;
1333 RPro.Text := inttostr(round(R.position / 255 * 100));
1334 RProC.Position := round(R.position / 255 * 100);
1335 end;
1336 if sender = G then
1337 begin
1338 GHex.text := inttohex(G.position, 0);
1339 GHexC.Position := G.Position;
1340 GDec.text := inttostr(G.position);
1341 GDecC.Position := G.Position;
1342 GPro.Text := inttostr(round(G.position / 255 * 100));
1343 GProC.Position := round(G.position / 255 * 100);
1344 end;
1345 if sender = B then
1346 begin
1347 BHex.text := inttohex(B.position, 0);
1348 BHexC.Position := B.position;
1349 BDec.text := inttostr(B.position);
1350 BDecC.Position := B.position;
1351 BPro.Text := inttostr(round(B.position / 255 * 100));
1352 BProC.Position := round(B.position / 255 * 100);
1353 end;
1354 if sender = H then
1355 begin
1356 HHex.text := inttohex(ceil(H.position / 359 * 255), 0);
1357 HHexC.Position := ceil(H.position / 359 * 255);
1358 HDec.text := inttostr(ceil(H.position / 359 * 255));
1359 HDecC.Position := ceil(H.position / 359 * 255);
1360 HGra.text := inttostr(H.position);
1361 HGraC.Position := H.position;
1362 end;
1363 if sender = S then
1364 begin
1365 SHex.text := inttohex(S.position, 0);
1366 SHexC.Position := S.position;
1367 SDec.text := inttostr(S.position);
1368 SDecC.Position := S.position;
1369 SPro.Text := inttostr(round(S.position / 255 * 100));
1370 SProC.Position := round(S.position / 255 * 100);
1371 end;
1372 if sender = V then
1373 begin
1374 VHex.text := inttohex(V.position, 0);
1375 VHexC.Position := V.position;
1376 VDec.text := inttostr(V.position);
1377 VDecC.Position := V.position;
1378 VPro.Text := inttostr(round(V.position / 255 * 100));
1379 VProC.Position := round(V.position / 255 * 100);
1380 end;
1381 end;
1382
1383 procedure TMainForm.Ladefarbe(col: tcolor);
1384 begin
1385 r.Position := GetRValue(col);
1386 g.Position := GetGValue(col);
1387 b.Position := GetBValue(col);
1388 end;
1389
1390 procedure TMainForm.Change(Sender: TObject);
1391 begin
1392 if (sender = r) then
1393 begin
1394 DrawGrad(2);
1395 DrawGrad(3);
1396 DrawGrad(4);
1397 DrawGrad(5);
1398 DrawGrad(6);
1399 end;
1400 if (sender = g) then
1401 begin
1402 DrawGrad(1);
1403 DrawGrad(3);
1404 DrawGrad(4);
1405 DrawGrad(5);
1406 DrawGrad(6);
1407 end;
1408 if (sender = b) then
1409 begin
1410 DrawGrad(1);
1411 DrawGrad(2);
1412 DrawGrad(4);
1413 DrawGrad(5);
1414 DrawGrad(6);
1415 end;
1416 if (sender = h) then
1417 begin
1418 DrawGrad(1);
1419 DrawGrad(2);
1420 DrawGrad(3);
1421 DrawGrad(5);
1422 DrawGrad(6);
1423 end;
1424 if (sender = s) then
1425 begin
1426 DrawGrad(1);
1427 DrawGrad(2);
1428 DrawGrad(3);
1429 DrawGrad(4);
1430 DrawGrad(6);
1431 end;
1432 if (sender = v) then
1433 begin
1434 DrawGrad(1);
1435 DrawGrad(2);
1436 DrawGrad(3);
1437 DrawGrad(4);
1438 DrawGrad(5);
1439 end;
1440
1441 AktualisiereWert(sender);
1442 AktualisiereFarben((sender = R) or (sender = G) or (sender = B));
1443 end;
1444
1445 procedure TMainForm.PickBtnClick(Sender: TObject);
1446 begin
1447 SetCapture(MainForm.Handle);
1448 PickBtn.Enabled := false;
1449 //PickTimer.Enabled := true;
1450 Caption := Application.Title + ' ['+getlangentry('capture')+']';
1451 end;
1452
1453 procedure TMainForm.PickTimerTimer(Sender: TObject);
1454 var
1455 CursorPos: TPoint;
1456 PixelCol: TColor;
1457 AverageR, AverageG, AverageB: integer;
1458 x, y: shortint;
1459 begin
1460 GetCursorPos(CursorPos);
1461 CoordsLbl.Caption := Format('%d,' + #13 + '%d', [CursorPos.x, CursorPos.y]);
1462
1463 AverageR := 0;
1464 AverageG := 0;
1465 Averageb := 0;
1466 for y := -floor((strtoint(AverageY.text)-1)/2) to ceil((strtoint(AverageY.text)-1)/2) do
1467 for x := -floor((strtoint(AverageX.text)-1)/2) to ceil((strtoint(AverageX.text)-1)/2) do
1468 begin
1469 PixelCol := GetPixel(ScreenDC, CursorPos.x + x, CursorPos.y + y);
1470 AverageR := AverageR + GetRValue(PixelCol);
1471 AverageG := AverageG + GetGValue(PixelCol);
1472 AverageB := AverageB + GetBValue(PixelCol);
1473 end;
1474 if strtoint(AverageX.text)*strtoint(AverageY.text) > 0 then
1475 AverageR := AverageR div (strtoint(AverageX.text)*strtoint(AverageY.text));
1476 if strtoint(AverageX.text)*strtoint(AverageY.text) > 0 then
1477 AverageG := AverageG div (strtoint(AverageX.text)*strtoint(AverageY.text));
1478 if strtoint(AverageX.text)*strtoint(AverageY.text) > 0 then
1479 AverageB := AverageB div (strtoint(AverageX.text)*strtoint(AverageY.text));
1480
1481 PixelCol := RGB(Lo(AverageR), Lo(AverageG), Lo(AverageB));
1482
1483 BitBlt(MemPix.Canvas.Handle,
1484 0, 0,
1485 strtoint(AverageX.text), strtoint(AverageY.text),
1486 ScreenDC,
1487 CursorPos.x - floor(strtoint(AverageX.text)/2), CursorPos.y - floor(strtoint(AverageY.text)/2),
1488 SRCCOPY);
1489 StretchBlt(MagBox.Canvas.Handle,
1490 0, 0,
1491 MagBox.Width, MagBox.Height,
1492 MemPix.Canvas.Handle,
1493 0, 0,
1494 strtoint(AverageX.text), strtoint(AverageY.text),
1495 SRCCOPY);
1496
1497 if not PickBtn.Enabled then
1498 Ladefarbe(PixelCol);
1499 end;
1500
1501 procedure TMainForm.RandomBtnClick(Sender: TObject);
1502 begin
1503 R.Position := Random(255);
1504 G.Position := Random(255);
1505 B.Position := Random(255);
1506 end;
1507
1508 procedure TMainForm.BerechneMixColor();
1509 var
1510 r, g, b: integer;
1511 begin
1512 r := round(Color1Upd.Position / 100 * getrvalue(color1.Color) + Color2Upd.Position / 100 * getrvalue(color2.Color));
1513 g := round(Color1Upd.Position / 100 * getgvalue(color1.Color) + Color2Upd.Position / 100 * getgvalue(color2.Color));
1514 b := round(Color1Upd.Position / 100 * getbvalue(color1.Color) + Color2Upd.Position / 100 * getbvalue(color2.Color));
1515
1516 mixedcolor.Color := rgb(r, g, b);
1517 mixedcolor.font.color := BlackWhiteContrastColor(mixedcolor.color);
1518 end;
1519
1520 procedure TMainForm.MenuClick(Sender: TObject);
1521 begin
1522 if sender = mAktuell then
1523 tpanel(PopupmenuSender).Color := colorpanel.Color;
1524 if sender = mKomplementaer then
1525 tpanel(PopupmenuSender).Color := komplementaercolor.Color;
1526 if sender = mWebsafe then
1527 tpanel(PopupmenuSender).Color := websafe1.Color;
1528 if sender = mWebsafeInv then
1529 tpanel(PopupmenuSender).Color := websafe2.Color;
1530 if sender = mMixColor then
1531 tpanel(PopupmenuSender).Color := mixedcolor.Color;
1532 if sender = mUmkehren then
1533 tpanel(PopupmenuSender).Color := tpanel(PopupmenuSender).Color xor $FFFFFF;
1534 tpanel(PopupmenuSender).Font.Color := BlackWhiteContrastColor(tpanel(PopupmenuSender).Color);
1535 BerechneMixColor;
1536
1537 if (PopupmenuSender = favo1) or (PopupmenuSender = favo2) or (PopupmenuSender = favo3) or
1538 (PopupmenuSender = favo4) or (PopupmenuSender = favo5) or (PopupmenuSender = favo6) or
1539 (PopupmenuSender = favo7) or (PopupmenuSender = favo8) or (PopupmenuSender = favo9) or
1540 (PopupmenuSender = favo10) or (PopupmenuSender = favo11) or (PopupmenuSender = favo12) or
1541 (PopupmenuSender = favo13) or (PopupmenuSender = favo14) or (PopupmenuSender = favo15) or
1542 (PopupmenuSender = favo16) or (PopupmenuSender = favo17) or (PopupmenuSender = favo18) or
1543 (PopupmenuSender = favo19) or (PopupmenuSender = favo20) then
1544 SchreibeInt(tpanel(PopupmenuSender).GetNamePath, colortorgb(tpanel(PopupmenuSender).color));
1545 end;
1546
1547 procedure TMainForm.Menu2Click(Sender: TObject);
1548 begin
1549 if sender = mAktuell2 then
1550 Ladefarbe(tpanel(PopupmenuSender).Color);
1551 if sender = mKomplementaer2 then
1552 Ladefarbe(tpanel(PopupmenuSender).Color xor $FFFFFF);
1553 end;
1554
1555 procedure TMainForm.GreyscaleBtnClick(Sender: TObject);
1556 begin
1557 S.Position := 0;
1558 end;
1559
1560 procedure TMainForm.DefColorClick(Sender: TObject);
1561 begin
1562 LadeFarbe(tpanel(sender).Color);
1563 end;
1564
1565 procedure TMainForm.DelphiBoxClick(Sender: TObject);
1566 var
1567 tmp: string;
1568 begin
1569 tmp := inttohex(colortorgb(delphibox.Selected), 6); // Systemfarben umwandeln
1570
1571 R.OnChange := nil;
1572 G.OnChange := nil;
1573 B.OnChange := nil;
1574
1575 R.Position := hextoint(copy(tmp, 5, 2), r);
1576 G.Position := hextoint(copy(tmp, 3, 2), g);
1577 B.Position := hextoint(copy(tmp, 1, 2), b);
1578
1579 AktualisiereWert(r);
1580 AktualisiereWert(g);
1581 AktualisiereWert(b);
1582
1583 R.OnChange := Change;
1584 G.OnChange := Change;
1585 B.OnChange := Change;
1586
1587 // DelphiBox muss nicht mehr ignoriert werden, da wir nun "DelphiZustimmend"
1588 // verwenden und nichts mehr in der DelphiBox markieren
1589 // AktualisiereFarben(true, 1);
1590 AktualisiereFarben(true);
1591 end;
1592
1593 procedure TMainForm.TakeClick(Sender: TObject);
1594 begin
1595 Ladefarbe(tpanel(sender).color);
1596 end;
1597
1598 procedure TMainForm.InvertBtnClick(Sender: TObject);
1599 begin
1600 TakeClick(KomplementaerColor);
1601 end;
1602
1603 procedure TMainForm.TabControlChange(Sender: TObject);
1604 begin
1605 panel1.Visible := tabcontrol.TabIndex = 0;
1606 panel2.Visible := tabcontrol.TabIndex = 1;
1607 panel3.Visible := tabcontrol.TabIndex = 2;
1608 panel4.Visible := tabcontrol.TabIndex = 3;
1609 end;
1610
1611 procedure TMainForm.WebsafeLblClick(Sender: TObject);
1612 begin
1613 TakeClick(websafe1);
1614 end;
1615
1616 procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
1617 begin
1618 ReleaseDC(0, ScreenDC);
1619 MemPix.Free;
1620 BoxBuf.Free;
1621 Box2Buf.Free;
1622 end;
1623
1624 procedure TMainForm.OutboxPaint(Sender: TObject);
1625 begin
1626 DrawGrad(TPaintbox(Sender).Tag);
1627 end;
1628
1629 procedure TMainForm.ZeigeRichtigePalette;
1630 begin
1631 WinPanel.Visible := Pal.ItemIndex = 0;
1632 JskPanel.Visible := Pal.ItemIndex = 1;
1633 end;
1634
1635 procedure TMainForm.PalClick(Sender: TObject);
1636 begin
1637 ZeigeRichtigePalette;
1638 SchreibeInt('Palette', Pal.ItemIndex);
1639 end;
1640
1641 procedure TMainForm.WinDialogClick(Sender: TObject);
1642 begin
1643 WinColorDialog.Color := ColorPanel.Color;
1644 if WinColorDialog.Execute then
1645 LadeFarbe(WinColorDialog.Color);
1646 end;
1647
1648 procedure TMainForm.WebcolorBoxClick(Sender: TObject);
1649 begin
1650 html.Text := webfarben[webcolorbox.ItemIndex];
1651
1652 R.OnChange := nil;
1653 G.OnChange := nil;
1654 B.OnChange := nil;
1655
1656 R.Position := hextoint(copy(html.text, 2, 2), r);
1657 G.Position := hextoint(copy(html.text, 4, 2), g);
1658 B.Position := hextoint(copy(html.text, 6, 2), b);
1659
1660 R.OnChange := Change;
1661 G.OnChange := Change;
1662 B.OnChange := Change;
1663
1664 DrawGrad(1);
1665 DrawGrad(2);
1666 DrawGrad(3);
1667 DrawGrad(4);
1668 DrawGrad(5);
1669 DrawGrad(6);
1670
1671 AktualisiereWert(r);
1672 AktualisiereWert(g);
1673 AktualisiereWert(b);
1674
1675 // WebcolorBox muss nicht mehr ignoriert werden, da wir nun "WebZustimmend"
1676 // verwenden und nichts mehr in der WebcolorBox markieren
1677 // AktualisiereFarben(true, 2);
1678 AktualisiereFarben(true);
1679 end;
1680
1681 procedure TMainForm.CheckWebfarben;
1682 var
1683 i: integer;
1684 begin
1685 WebZutreffend.Clear;
1686 if webcolorbox.itemindex <> -1 then
1687 if html.text <> webfarben[webcolorbox.itemindex] then
1688 webcolorbox.itemindex := -1;
1689 for i := 0 to high(webfarben) do
1690 begin
1691 if html.text = webfarben[i] then
1692 WebZutreffend.Items.add(webcolorbox.Items.Strings[i]); // Geht nicht mit mehreren Übereinstimmungen: webcolorbox.ItemIndex := i;
1693 end;
1694 end;
1695
1696 procedure TMainForm.CheckDelphiFarben;
1697 var
1698 i: integer;
1699 begin
1700 DelphiZutreffend.Clear;
1701 if colortorgb(delphibox.selected) <> colortorgb(colorpanel.Color) then
1702 delphibox.ItemIndex := -1;
1703 for i := 0 to delphibox.Items.Count - 1 do
1704 begin
1705 if colortorgb(delphibox.Colors[i]) = colortorgb(colorpanel.Color) then
1706 DelphiZutreffend.Items.add(delphibox.ColorNames[i]); // Geht nicht mit mehreren Übereinstimmungen: delphibox.ItemIndex := i;
1707 end;
1708 end;
1709
1710 procedure TMainForm.DelphiZutreffendClick(Sender: TObject);
1711 begin
1712 if delphizutreffend.ItemIndex <> -1 then
1713 delphibox.ItemIndex := delphibox.Items.IndexOf(delphizutreffend.Items.Strings[delphizutreffend.ItemIndex]);
1714 end;
1715
1716 procedure TMainForm.WebZutreffendClick(Sender: TObject);
1717 begin
1718 if webzutreffend.ItemIndex <> -1 then
1719 webcolorbox.ItemIndex := webcolorbox.Items.IndexOf(webzutreffend.Items.Strings[webzutreffend.ItemIndex]);
1720 end;
1721
1722 procedure TMainForm.LinkClick(Sender: TObject);
1723 begin
1724 if sender = info7 then
1725 ShellExecute(Application.Handle, 'open', pchar('mailto:'+tlabel(sender).caption+'?subject=ColorManager 2.0'), nil, nil, SW_SHOW);
1726 if (sender = Info9) or (sender = Info13) then
1727 ShellExecute(Application.Handle, 'open', pchar(Info9.caption), nil, nil, SW_SHOW);
1728 if (sender = Info11) then
1729 ShellExecute(Application.Handle, 'open', 'http://www.icq.com/people/about_me.php?uin=160106169', nil, nil, SW_SHOW);
1730 if (sender = Info14) then
1731 ShellExecute(Application.Handle, 'open', 'http://www.viathinksoft.de/', nil, nil, SW_SHOW);
1732 if (sender = Info15) then
1733 ShellExecute(Application.Handle, 'open', 'http://www.viathinksoft.de/index.php?page=projektanzeige&seite=projekt-20', nil, nil, SW_SHOW);
1734 end;
1735
1736 var
1737 ColorTmrDurchlauf: integer;
1738
1739 procedure TMainForm.ColorTmrTimer(Sender: TObject);
1740 begin
1741 ColorTmrDurchlauf :=ColorTmrDurchlauf + 10;
1742 if ColorTmrDurchlauf >= 360 then
1743 ColorTmrDurchlauf := ColorTmrDurchlauf - 360;
1744 if panel4.Visible then
1745 Info1.Font.Color := hsvtorgb(ColorTmrDurchlauf, 255, 200);
1746 end;
1747
1748 procedure TMainForm.SchreibeInt(name: string; wert: integer);
1749 var
1750 reg: TRegistry;
1751 begin
1752 reg := tregistry.Create;
1753 try
1754 Reg.RootKey := HKEY_CURRENT_USER;
1755 Reg.OpenKey('SOFTWARE\ViaThinkSoft\ColorManager\', true);
1756 Reg.WriteInteger(name, wert);
1757 Reg.CloseKey;
1758 finally
1759 Reg.Free;
1760 end;
1761 end;
1762
1763 function TMainForm.LeseInt(name: string): integer;
1764 var
1765 reg: TRegistry;
1766 begin
1767 result := 0;
1768 reg := tregistry.Create;
1769 try
1770 Reg.RootKey := HKEY_CURRENT_USER;
1771 Reg.OpenKey('SOFTWARE\ViaThinkSoft\ColorManager\', true);
1772 if Reg.ValueExists(name) then
1773 result := Reg.ReadInteger(name);
1774 Reg.CloseKey;
1775 finally
1776 Reg.Free;
1777 end;
1778 end;
1779
1780 procedure TMainForm.SaveEditChange(Sender: TObject);
1781 begin
1782 SchreibeInt(tedit(sender).GetNamePath, strtoint(tedit(sender).text));
1783 end;
1784
1785 procedure TMainForm.ColorClick(Sender: TObject; Button: TMouseButton;
1786 Shift: TShiftState; X, Y: Integer);
1787 var
1788 MausPos: TPoint;
1789 begin
1790 PopupMenuSender := sender;
1791 GetCursorPos(MausPos);
1792 Popupmenu.Items.Items[0].Enabled := sender <> MixedColor;
1793 Popupmenu.Items.Items[2].Enabled := sender <> MixedColor;
1794 popupmenu.Popup(MausPos.x, MausPos.y);
1795 end;
1796
1797 end.
1798