 |
Een eenvoudige kleurenmixer |  |
 |
Soms is een eenvoudige kleurenselectie nodig op een dialog form.
Het componentje dat hier wordt beschreven is klein, maar kan toch een kleur kiezen uit 256000,
omdat het is opgebouwd uit drie schuifjes voor rood, groen en blauw, elk met keuze uit 64 intensiteiten.
Hieronder staat een afbeelding van het mixertje in aktie:
Form1 en Unit1 vormen een exerciser om het componentje te testen.
Het mixertje bestaat slechts uit drie vertikale gekleurde schuifbalkjes.
De andere componenten maken deel uit van de exerciser.
De enige property is color.
Een waarde geven aan color zet de schuifjes in de nieuwe stand.
Lees de color property voor de geselecteerde kleur.
Deze kleur heeft het Windows bb-gg-rr formaat.
Als de positie van een kleurenschuifje wordt veranderd, dan treedt een event op.
Elk schuifje heeft positie 0 t/m 63.
Voordat de schuif posities worden verpakt in een 32 integer, worden 1 bits gezet op posties 0 en 1 van elke kleur.
De minimale (Windows) kleur is dus $00030303 en de maximale is $00ffffff
De kleurenmixer heeft vaste afmetingen van 120 * 140 pixels.
Verander deze afmetingen niet.
klik [ hier ] om het testprogramma met mixer te laden.
klik [ hier ] voor het hele Delphi-7 project.
Hieronder staan 4 kleurenmixers in aktie (beeld op halve grootte)op een dialogform voor de instelling van frame properties.
unit dav7ColorMixer;
{simple color mixer component for use on custom dialog form
DavData Software, 14 - 12 - 2011
mix r,g,b selection
property : - color
methods : - create
events : - OnSelect : mouse-move or mouse-down
over a color slide supplies selected color
}
interface
uses windows,controls,classes,graphics,forms;
type TColorSelect = procedure(sender : TObject; color : LongInt) of object;
Tdav7Colormixer = class(TGraphicControl)
private
Fred : byte; //0..63 color code cc
Fgreen : byte;
Fblue : byte;
FColor : longInt;
FOnSelect : TColorSelect;
protected
procedure paint; override;
procedure mousemove(Shift : Tshiftstate; x,y : integer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure selColor(color : LongInt);
procedure clearSlide(nr : byte);
procedure setslide(nr : byte);
procedure packRGB;
procedure change(x,y : integer);
public
constructor create(AOwner:TComponent); override;
property color : longInt read FColor write selcolor;
published
property OnSelect : TcolorSelect read FOnSelect write FOnSelect;
property visible;
property enabled;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('system',[Tdav7ColorMixer]);
end;
function y2color(y,nr : byte) : longInt;
//convert y slide top position to color
begin
result := (((y and $fe) shl 1) + 3) shl ((nr-1) shl 3);
end;
procedure Tdav7ColorMixer.packRGB;
//make Fcolor from Fred,Fgreen,Fblue
begin
Fcolor := (Fred shl 2) + 3;
Fcolor := Fcolor or ((Fgreen shl 2) + 3) shl 8;
Fcolor := Fcolor or ((Fblue shl 2) + 3) shl 16;
end;
constructor Tdav7Colormixer.create(AOwner: TComponent);
begin
inherited create(Aowner);
Fred := 0;
Fgreen := 0;
Fblue := 0;
Fcolor := $0;
width := 120;
height := 140;
end;
procedure TDav7ColorMixer.selcolor(color : LongInt);
//external call sets color of mixer
var i : byte;
begin
if (enabled = false) then exit;
Fcolor := color;
for i := 1 to 3 do
begin
if visible then clearslide(i);
case i of
1 : Fred := (color and $ff) shr 2;
2 : Fgreen := ((color shr 8) and $ff) shr 2;
3 : Fblue := ((color shr 16) and $ff) shr 2;
end;
if visible then setslide(i);
end;
end;
procedure TDav7ColorMixer.clearSlide(nr : byte);
//erase slide nr
var x,y1,y2 : byte;
i,cc : byte;
begin
with self do with canvas do
begin
brush.color := getparentform(self).color;
x := (nr - 1)*40;
cc := 0;
case nr of
1 : cc := Fred;
2 : cc := Fgreen;
3 : cc := Fblue;
end;
y1 := cc shl 1;
y2 := y1 + 11;
pen.Width := 1;
pen.Color := 0;
brush.style := bsSolid;
fillrect(rect(x,y1,x+40,y2));
if y1 < 5 then y1 := 5;
if y2 > 133 then y2 := 134;
moveto(x+10,y1);
lineto(x+10,y2);
moveto(x+30,y1);
lineto(x+30,y2);
for i := 0 to 11 do
if (y1+i >= 5) and (y1+i <= 133) then
begin
if y1 + i = 133 then pen.Color := 0
else pen.Color := y2color(y1+i-5,nr);
moveto(x+11,y1+i);
lineto(x+30,y1+i);
end;//for i
end;//with
end;
procedure Tdav7ColorMixer.setslide(nr : byte);
//set slide nr acc. to bc
var x,y : byte;
i,cc : byte;
begin
cc := 0;
case nr of
1 : cc := Fred;
2 : cc := Fgreen;
3 : cc := Fblue;
end;
x := (nr-1)*40;
y := cc shl 1;
with self do with canvas do
begin
brush.style := bsClear;
pen.width := 1;
pen.color := 0;
rectangle(x+4,y,x+37,y+11);
for i := 0 to 5 do
begin
moveto(x+4+i,y+i);
lineto(x+4+i,y+11-i);
end;
x := x+36;
for i := 0 to 5 do
begin
moveto(x-i,y+i);
lineto(x-i,y+11-i);
end;
end;
end;
procedure Tdav7Colormixer.Paint;
var i,j,x1,x2,y,k : byte;
begin
with self do
with canvas do
begin
brush.color := getparentform(self).color;
pen.color := $000000;
pen.Width := 1;
brush.style := bsSolid;
fillrect(rect(0,0,width,height));
brush.Style := bsClear;
for i := 0 to 2 do
begin
x1 := 10+40*i;
x2 := x1+21;
for j := 0 to 63 do
begin
y := 5 + 2*j;
pen.color := y2color(y-5,i+1);
for k := 0 to 1 do
begin
moveto(x1,y+k);
lineto(x2,y+k);
end;//for k
end;
pen.color := $0;
rectangle(x1,5,x2,133);
setslide(i+1);
end;//for i
end;//with canvas
end;
procedure Tdav7ColorMixer.change(x,y: integer);
//process change
var modx,slide : byte;
proc : boolean;
begin
if (x > 0) and (x < 120) and (y > 0) and (y < 133) then
begin
modx := x mod 40;
if (modx > 5) and (modx < 35) then
begin
slide := x div 40 + 1;
y := (y - 5);
if y < 0 then y := 0
else y := y shr 1;
proc := false;
case slide of
1 : proc := Fred <> y;
2 : proc := Fgreen <> y;
3 : proc := Fblue <> y;
end;
if proc then
begin
clearslide(slide);
case slide of
1 : Fred := y;
2 : Fgreen := y;
3 : Fblue := y;
end;
setslide(slide);
packRGB;
if componentstate * [csDesigning] = [] then
if assigned(FOnSelect) then FonSelect(self,Fcolor);
end;//if proc
end;//if modx
end;//if x > 0
end;
procedure Tdav7colormixer.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
change(x,y);
end;
procedure Tdav7ColorMixer.mousemove(Shift : Tshiftstate; x,y : integer);
begin
if shift = [] then exit;
change(x,y);
end;
end.
