// Wer gern NonVCL
programmiert, findet im ersten Beispiel den Code für // 1. Beispiel: TrueColor-Dialog uses commdlg;
function FarbDlg(h: THandle; cust: array of TColor; Auswahl: TColor;
geoeffnet: boolean; var Farbe: TColor): boolean;
var
cc: tagCHOOSECOLOR;
ca: array[0..15] of TColor;
x: integer;
begin
for x := 0 to high(cust) do ca[x] := colortorgb(cust[x]);
for x := high(cust) + 1 to 15 do ca[x] := colortorgb(clBtnFace);
cc.lStructSize := sizeof(cc);
cc.hwndOwner := h;
cc.hInstance := hinstance;
cc.rgbResult := colortorgb(Auswahl);
cc.lpCustColors := @ca;
cc.Flags := CC_RGBINIT or ord(geoeffnet) * CC_FULLOPEN;
result := choosecolor(cc);
Farbe := cc.rgbResult;
end;
// ---------- Beispielaufrufe ---------------
// Klickt der Anwender auf ABBRECHEN, passiert nichts.
// Klickt er auf OK, wird Form1 mit der ausgewählten Farbe eingefärbt.
procedure TForm1.Button2Click(Sender: TObject);
var
f: TColor;
begin
if FarbDlg(handle, [$0FBC50, $FF05BC, $FFA757], $FF05BC, true, f) then
Form1.color := f;
end;
// Bei klicken auf OK, wird Panel1 mit der ausgewählten Farbe eingefärbt.
// Bei ABBRECHEN erhält Panel1 die Farbe der Vorgabe.
procedure TForm1.Button3Click(Sender: TObject);
var
vorgabe: TColor;
begin
vorgabe := clLime;
FarbDlg(handle, [], vorgabe, false, vorgabe);
panel1.color := vorgabe;
end;
// -------------------------------------------------------------------- // 2. Beispiel: von Hand programmierter Dialog mit 256 Farben type
TForm1 = class(TForm)
// ...
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
procedure MDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
procedure okClick(Sender: TObject);
procedure iDblClick(Sender: TObject);
procedure cancelClick(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// uses Vcl.graphics, Vcl.ExtCtrls, Vcl.Buttons;
type
farray = array [0 .. 255] of TColor;
const
breit = 18;
abstand = 3;
buttonheight = 25;
buttonwidth = 80;
var
ok, da: boolean;
Farbe: TColor;
cdlg: TForm;
ti: TImage;
tl: TLabel;
tp: TPanel;
bu: array [0 .. 1] of TSpeedButton;
mx, my, xx, yy: Integer;
fOrigin: farray;
f256: farray = ($000000, $808080, $C0C0C0, $FFFFFF, $000080, $0000FF, $008000,
$00FF00, $800000, $FF0000, $800080, $FF00FF, $008080, $00FFFF, $808000,
$FFFF00, $F0CAA6, $A4A0A0, $C0DCC0, $F0FBFF, $405C40, $58745D, $708C7A,
$88A497, $A0BCB4, $B8D4D1, $704A26, $8C6844, $A88662, $C4A480, $E0C29E,
$FCE0BC, $0F0F0F, $1E1E1E, $2D2D2D, $3C3C3C, $4B4B4B, $5A5A5A, $696969,
$787878, $878787, $969696, $A5A5A5, $B4B4B4, $C3C3C3, $D2D2D2, $E1E1E1,
$F0F0F0, $0D3F6C, $183A67, $244673, $2F517E, $3B5D8A, $466895, $5274A1,
$5D7FAC, $6A8CB5, $7799BE, $84A6C7, $91B3D0, $9EC0D9, $ABCDE2, $B8DAEB,
$C5E7F4, $000F8F, $001F9F, $002FAF, $003FBF, $004FCF, $005FDF, $006FEF,
$007FFF, $0F7FFF, $268FFF, $3D9FFF, $54AFFF, $6BBFFF, $82CFFF, $99CFFF,
$B0DFFF, $00005F, $00006F, $00007F, $00009F, $0000AF, $0000CF, $0000DF,
$0000FE, $1C1CFF, $3838FF, $5454FF, $7070FF, $8C8CFF, $A8A8FF, $C4C4FF,
$E0E0FF, $10005F, $20008F, $30009F, $4000AF, $5000BF, $6000CF, $7000DF,
$8000EF, $8F0FEF, $8F27F1, $9F3FF3, $AF57F5, $BF6FF7, $CF87FA, $CF9FFC,
$DFB7FE, $4F004F, $6F006F, $7F007F, $9F009F, $AF00AF, $CF00CF, $DF00DF,
$FB00FB, $FF1CFF, $FF38FF, $FF54FF, $FF70FF, $FF8CFF, $FFA8FF, $FFC4FF,
$FFE0FF, $4F0020, $680030, $810040, $9A0050, $B30050, $CD0060, $E60070,
$FF0080, $FF0F8F, $FF1F9C, $FF3FA9, $FF5FB6, $FF7FC3, $FF9FD0, $FFBFDD,
$FFCFEA, $4F0000, $6F0000, $7F0000, $9F0000, $AF0000, $CF0000, $DF0000,
$FF0303, $FF1C1C, $FF3838, $FF5454, $FF7070, $FF8C8C, $FFA8A8, $FFC4C4,
$FFE0E0, $7F1700, $8F2700, $9F3700, $AF4700, $BF6700, $CF7700, $DF8700,
$EFA700, $EFB700, $F1BF19, $F3C732, $F5CF4B, $F8D764, $FADF7D, $FCE796,
$FFEFAF, $4F4F00, $6F6F00, $7F7F00, $9F9F00, $AFAF00, $CFCF00, $DFDF00,
$FBFB00, $FFFF1C, $FFFF38, $FFFF54, $FFFF70, $FFFF8C, $FFFFA8, $FFFFC4,
$FFFFE0, $204000, $356000, $4A7000, $5F9000, $74B000, $89C000, $9EE000,
$B3F000, $B5F000, $B8F210, $BBF430, $BEF650, $C1F870, $C4FB90, $C7FDA0,
$CAFFC0, $004F00, $006F00, $007F00, $009F00, $00AF00, $00CF00, $00DF00,
$00FF06, $1CFF1C, $38FF38, $54FF54, $70FF70, $8CFF8C, $A8FFA8, $C4FFC4,
$E0FFE0, $002E10, $003E20, $005E40, $007E50, $009E70, $00BE80, $00DEA0,
$00FEB0, $0FFFC0, $1FFFC0, $3FFFC0, $5FFFD0, $7FFFD0, $8FFFE0, $AFFFE0,
$CFFFF0, $004F4F, $006F6F, $007F7F, $009F9F, $00AFAF, $00CFCF, $00DFDF,
$00FBFB, $1CFFFF, $38FFFF, $54FFFF, $70FFFF, $8CFFFF, $A8FFFF,
$C4FFFF, $E0FFFF);
procedure Gitter;
var
X, Y: Integer;
begin
with ti.canvas do
begin
brush.color := clbtnface;
fillrect(cliprect);
for Y := 0 to 15 do
for X := 0 to 15 do
begin
pen.color := clbtnshadow;
moveto(X * breit, Y * breit + breit - abstand);
lineto(X * breit, Y * breit);
lineto(X * breit + breit - abstand, Y * breit);
pen.color := clbtnhighlight;
lineto(X * breit + breit - abstand, Y * breit + breit - abstand);
lineto(X * breit, Y * breit + breit - abstand);
brush.color := f256[Y * 16 + X];
fillrect(rect(X * breit + 1, Y * breit + 1, X * breit + breit - abstand,
Y * breit + breit - abstand));
end;
end;
end;
procedure rahmen;
begin
ti.canvas.rectangle(mx, my, mx + breit - abstand, my + breit - abstand);
end;
procedure kennzeichnen;
var
sr, sg, sb: string;
begin
sr := inttostr(getrvalue(Farbe));
sg := inttostr(getgvalue(Farbe));
sb := inttostr(getbvalue(Farbe));
tl.caption := 'Rot:'#9 + sr + #13'Grün:'#9 + sg + #13'Blau:'#9 + sb;
bu[0].enabled := true;
tp.color := Farbe;
da := true;
end;
procedure testen;
var
X, Y: Integer;
begin
for X := 0 to 15 do
for Y := 0 to 15 do
begin
if Farbe = f256[X + Y * 16] then
begin
kennzeichnen;
mx := X * breit + 1;
my := Y * breit + 1;
rahmen;
exit;
end;
end;
end;
function drin(X, Y: Integer): boolean;
begin
result := ((X mod breit) in [1 .. breit - abstand - 1]) and
((Y mod breit) in [1 .. breit - abstand - 1]);
end;
procedure Dlg256(Startfarbe: TColor; bmp: TBitmap = nil);
var
X: Integer;
begin
cdlg := TForm.create(application);
cdlg.DoubleBuffered := true;
cdlg.borderstyle := bsDialog;
cdlg.caption := '256 Farben';
cdlg.position := poScreenCenter;
cdlg.clientwidth := breit * 16 + abstand;
cdlg.clientheight := breit * 16 + buttonheight * 2 + 20;
ti := TImage.create(cdlg);
ti.parent := cdlg;
ti.setbounds(abstand, abstand, breit * 16 + abstand, breit * 16 + abstand);
ti.onmousedown := Form1.MDown;
ti.onDblclick := Form1.iDblClick;
if (bmp <> nil) then
begin
if bmp.pixelformat <> pf8bit then
bmp.pixelformat := pf8bit;
getpaletteentries(bmp.palette, 0, 256, f256);
end
else
copymemory(@f256, @fOrigin, sizeof(f256));
Gitter;
ti.canvas.pen.mode := pmnotxor;
ti.canvas.pen.width := 4;
ti.canvas.brush.style := bsclear;
ti.canvas.pen.color := clblack;
tl := TLabel.create(cdlg);
tl.left := abstand + 15 + buttonwidth;
tl.parent := cdlg;
for X := 0 to 1 do
begin
bu[X] := TSpeedButton.create(cdlg);
bu[X].top := breit * 16 + abstand * 2 + (buttonheight + abstand) * X;
bu[X].height := buttonheight;
bu[X].width := buttonwidth;
bu[X].left := abstand;
bu[X].parent := cdlg;
end;
bu[0].caption := 'OK';
bu[0].onClick := Form1.okClick;
bu[0].enabled := false;
bu[1].caption := 'Abbrechen';
bu[1].onClick := Form1.cancelClick;
tl.top := bu[0].top;
tp := TPanel.create(cdlg);
tp.ParentBackground := false;
tp.parent := cdlg;
tp.height := 33;
tp.width := tp.height;
tp.top := bu[0].top + buttonheight div 2;
tp.left := cdlg.clientwidth - abstand * 2 - tp.width;
tp.bevelouter := bvlowered;
da := false;
ok := false;
Farbe := Startfarbe;
testen;
cdlg.showmodal;
ti.free;
tl.free;
for X := 0 to 1 do
bu[X].free;
tp.free;
cdlg.free;
end;
procedure TForm1.okClick(Sender: TObject);
begin
ok := true;
cdlg.close;
end;
procedure TForm1.iDblClick(Sender: TObject);
begin
if drin(xx, yy) then
okClick(Sender);
end;
procedure TForm1.cancelClick(Sender: TObject);
begin
cdlg.close;
end;
procedure TForm1.MDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
xx := X;
yy := Y;
if drin(X, Y) then
begin
if da then
rahmen;
Farbe := ti.canvas.pixels[X, Y];
kennzeichnen;
mx := (X div breit) * breit + 1;
my := (Y div breit) * breit + 1;
rahmen;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
copymemory(@fOrigin, @f256, sizeof(f256));
end;
// ------- Beispielaufrufe ----------
// Farbdialog öffnen und bei Klick auf OK
// oder Doppelklick auf eine Farbe die Form einfärben
procedure TForm1.Button1Click(Sender: TObject);
begin
Dlg256(clfuchsia, nil);
if ok then
color := Farbe;
end;
// Palette eines Bitmaps mit 256 Farben anzeigen
procedure TForm1.Button2Click(Sender: TObject);
var
b: TBitmap;
begin
b := TBitmap.create;
b.loadfromfile('d:\bilder\2.bmp');
Dlg256(clblack, b);
b.free;
end;
|
