PDA

View Full Version : How to make color picker that works in form?



Secet
03-08-2007, 07:33 PM
How to make color picker that works in form?



Hello again, this is my second tutorial.
I will teach you how to make a color picker into form, so user can get colors easily instead of typing/copying. Useless? Maybe, but I'm bored.

"Wow, this script is cool! It has forms and all, it seems to be really easy to use. *Clicks run* Okay, now it asks for 3 monster colors. *Tries to click color picker* Huh? Color picker doesn't work when form is running? How am I going to get colors now?"
Sounds familiar? Well, here is a solution for scripters how to avoid that.

I assume that you already know basics on forms so I won't explain obvious things.

Let's make a simple form, add following things to it:

6 labels. Name them laFirst, laSecond, laThird, laPick1, laPick2, laPick3. Change laFirst, laSecond, laThird captions to '1st color', '2nd color' and '3rd color'. Change laPick 1,2 and 3 captions to 'Pick Color!
3 Edit boxes, name them edColor1, edColor2 and edColor3. Set their color to black.(Not font color, edit box color!)


If it looks somewhat like this, then you are doing good!
http://www.secetweb.com/images/colorpicker1.png

Next thing we do is make color picker. We will use laPick1, laPick2, laPick3 labels as buttons.
Add this to your InitForm procedure:
laPick1.OnClick := @GetColor1;
laPick2.OnClick := @GetColor2;
laPick3.OnClick := @GetColor3;

Now we have defined what happens when user clicks labels; script runs a procedure.

Next thing to do is make those procedures called GetColor1, GetColor2, GetColor3. Here are procedures that does nothing:
procedure GetColor1(Sender: TObject);
begin
end;

procedure GetColor2(Sender: TObject);
begin
end;

procedure GetColor3(Sender: TObject);
begin
end;


Now let's add colorpicker into those procedures, colorpicking function is PickColor(var Color:TColor; var x, y :integer);
So we need to add those variables. Add these to variables list:

Color1, Color2, Color3, x, y: integer;

Next, add PickColor functions to procedures like this:

procedure GetColor1(Sender: TObject);
begin
PickColor(Color1, x, y);
end;

procedure GetColor2(Sender: TObject);
begin
PickColor(Color2, x, y);
end;

procedure GetColor3(Sender: TObject);
begin
PickColor(Color3, x, y);
end;

Try running the script, when you click text 'Pick Color!' colorpicker should pop up. But when you click somewhere, it just picks colorvalue and doesn't tell you it. How rude. We need to change that.
We are going to do that by changing edColor1, edColor2, edColor3 texts to color that you just picked.
We have to use IntToStr function, because Color1 is integer, and editboxes require strings. Here is the code you need to add:

edColor1.Text := IntToStr(Color1);

If you try edColor1.Text := Color1; it won't work, because of the reasons I said above.
Your code should look like this:


procedure GetColor1(Sender: TObject);
begin
PickColor(Color1, x, y);
edColor1.Text := IntToStr(Color1);
end;

procedure GetColor2(Sender: TObject);
begin
PickColor(Color2, x, y);
edColor2.Text := IntToStr(Color2);
end;

procedure GetColor3(Sender: TObject);
begin
PickColor(Color3, x, y);
edColor3.Text := IntToStr(Color3);
end;

Gratz, you now got working color picker. But... Are you satisfied with it? Because I'm not. Let's continue.
I wan't to make it look good. I wan't it to change edit box font color to same color user just picked!
It should be easy.. Let's see.
Add this to your procedures:

edColor1.Font.Color := Color1;

That's it, so simple and gives a nice little extra touch on it! Looks very nice on black background! Try picking some very dark color, almost black. Oh.. I can't see it because it's same color as the background. "Let's just change background to white?" you think. But then it would have same effect when picking very white colors.
Here is what we are going to do:
We want script to change edit box color to white when picked color is very dark, and vice versa.
Here is the code you need to add in your procedures:
if Color1 < 3500000 then
begin
edColor1.Color := clWhite;
end else
edColor1.Color := clBlack;

Here is the FULL code how it should look like:
program ColorPicker;

var
ColorPickerF1 : TForm;
laFirst : TLabel;
laSecond : TLabel;
laThird : TLabel;
laPick1 : TLabel;
laPick2 : TLabel;
laPick3 : TLabel;
edColor1 : TEdit;
edColor2 : TEdit;
edColor3 : TEdit;
Color1, Color2, Color3, x, y: integer;

procedure GetColor1(Sender: TObject);
begin
PickColor(Color1, x, y);
edColor1.Text := IntToStr(Color1);
edColor1.Font.Color := Color1;
if Color1 < 3500000 then
begin
edColor1.Color := clWhite;
end else
edColor1.Color := clBlack;
end;

procedure GetColor2(Sender: TObject);
begin
PickColor(Color2, x, y);
edColor2.Text := IntToStr(Color2);
edColor2.Font.Color := Color2;
if Color2 < 3500000 then
begin
edColor2.Color := clWhite;
end else
edColor2.Color := clBlack;
end;

procedure GetColor3(Sender: TObject);
begin
PickColor(Color3, x, y);
edColor3.Text := IntToStr(Color3);
edColor3.Font.Color := Color3;
if Color3 < 3500000 then
begin
edColor3.Color := clWhite;
end else
edColor3.Color := clBlack;
end;

////////////////FORM//////////////////
procedure InitForm;
begin
ColorPickerF1 := CreateForm;
ColorPickerF1.Left := 250;
ColorPickerF1.Top := 114;
ColorPickerF1.Width := 222;
ColorPickerF1.Height := 166;
ColorPickerF1.Caption := 'Color picker';
ColorPickerF1.Color := clWhite;
ColorPickerF1.Font.Color := clWindowText;
ColorPickerF1.Font.Height := -11;
ColorPickerF1.Font.Name := 'MS Sans Serif';
ColorPickerF1.Font.Style := [];
ColorPickerF1.Visible := False;
ColorPickerF1.PixelsPerInch := 96;
laFirst := TLabel.Create(ColorPickerF1);
laFirst.Parent := ColorPickerF1;
laFirst.Left := 10;
laFirst.Top := 30;
laFirst.Width := 40;
laFirst.Height := 13;
laFirst.Caption := '1st color';
laSecond := TLabel.Create(ColorPickerF1);
laSecond.Parent := ColorPickerF1;
laSecond.Left := 10;
laSecond.Top := 60;
laSecond.Width := 44;
laSecond.Height := 13;
laSecond.Caption := '2nd color';
laThird := TLabel.Create(ColorPickerF1);
laThird.Parent := ColorPickerF1;
laThird.Left := 10;
laThird.Top := 90;
laThird.Width := 41;
laThird.Height := 13;
laThird.Caption := '3rd color';
laPick1 := TLabel.Create(ColorPickerF1);
laPick1.Parent := ColorPickerF1;
laPick1.OnClick := @GetColor1;
laPick1.Left := 155;
laPick1.Top := 30;
laPick1.Width := 43;
laPick1.Height := 13;
laPick1.Caption := 'Pick Color!';
laPick2 := TLabel.Create(ColorPickerF1);
laPick2.Parent := ColorPickerF1;
LaPick2.OnClick := @GetColor2;
laPick2.Left := 155;
laPick2.Top := 60;
laPick2.Width := 43;
laPick2.Height := 13;
laPick2.Caption := 'Pick color!';
laPick3 := TLabel.Create(ColorPickerF1);
laPick3.Parent := ColorPickerF1;
laPick3.OnClick := @GetColor3;
laPick3.Left := 155;
laPick3.Top := 90;
laPick3.Width := 43;
laPick3.Height := 13;
laPick3.Caption := 'Pick color!';
edColor1 := TEdit.Create(ColorPickerF1);
edColor1.Parent := ColorPickerF1;
edColor1.Left := 60;
edColor1.Top := 25;
edColor1.Width := 90;
edColor1.Height := 21;
edColor1.TabOrder := 8;
edColor1.Color :=clBlack;
edColor2 := TEdit.Create(ColorPickerF1);
edColor2.Parent := ColorPickerF1;
edColor2.Color := clBlack;
edColor2.Left := 60;
edColor2.Top := 55;
edColor2.Width := 90;
edColor2.Height := 21;
edColor2.TabOrder := 9;
edColor3 := TEdit.Create(ColorPickerF1);
edColor3.Parent := ColorPickerF1;
edColor3.Color := clBlack;
edColor3.Left := 60;
edColor3.Top := 85;
edColor3.Width := 91;
edColor3.Height := 21;
edColor3.TabOrder := 10;
end;

procedure SafeInitForm;
var
v: TVariantArray;
begin
setarraylength(V, 0);
ThreadSafeCall('InitForm', v);
end;

procedure ShowFormModal;
begin
ColorPickerF1.ShowModal;
end;

procedure SafeShowFormModal;
var
v: TVariantArray;
begin
setarraylength(V, 0);
ThreadSafeCall('ShowFormModal', v);
end;

begin
SafeInitForm;
SafeShowFormModal;
end.

Now I'm happy with it! Here is image about it, yours should be close to it:
http://www.secetweb.com/images/colorpicker2.png

If it is, good job. :)

If it isn't, then start flaming, or read it again. :)

pwnaz0r
03-08-2007, 08:39 PM
Yeah i have seen this before on mopar :D looks. Conincidence? I think not... :D nyways you wrote it and i still like it the second time :D Gj bro

Secet
03-08-2007, 09:06 PM
Hehe thanks.

Yea, I also posted it there! :)

r4ndom
03-18-2007, 06:53 PM
cool :) I did the same in my script except with the debug box

Santa_Clause
04-05-2007, 01:24 PM
Lmao...I Already Saw This Secet...Didn't Really Understand It ;)

n3ss3s
04-05-2007, 07:00 PM
Tyvm m8!
Something to except from clarion v0.7 :)

gsquare567
04-13-2007, 06:23 PM
great tut. where did you find the function PickColor?

also, cant you also say "Sender.Text := IntToStr(Color1);"?