Color > RGB, HEX, Delphi, C++, Visual Basic

private
    { Private-Deklarationen }
    PROCEDURE ColorToWindows(Clr : TColor; Sender: TObject);
    PROCEDURE AktualisiereFarbwerte(Sender: TObject);
    PROCEDURE AktualisiereCodeArt(Sender: TObject);
    
VAR CodeArt : Integer;                    // ComboBox ItemIndex 0 / 1 / 2 ...
    col_r, col_g, col_b : Byte;           // RGB - Farbwerte...
    col_rs, col_gs, col_bs : STRING[2];   // RGB - Hexstrings...
    
//

procedure TForm1.FormCreate(Sender: TObject);
begin
 Application.HintPause := 1;
 Application.HintHidePause := 220000;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
 // START-EINSTELLUNGEN SETZEN...
 ComboBox1.ItemIndex := 0;
 StaticText1.Color := StringToColor('$00FFFFFF');
 AktualisiereFarbwerte(Sender);
 ActiveControl := BitBtn1;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Action := caFree;
end;

PROCEDURE TForm1.ColorToWindows(Clr : TColor; Sender: TObject);
VAR ColStrA : STRING;
begin
 ColStrA := IntToHex(clr, 6);
 col_rs := Copy(ColStrA, 1, 2);
 col_gs := Copy(ColStrA, 3, 2);
 col_bs := Copy(ColStrA, 5, 2);
end;

PROCEDURE TForm1.AktualisiereFarbwerte(Sender: TObject);
VAR Farbe : LongInt;
BEGIN
  Farbe := ColorToRGB(StaticText1.Color);
  col_r     := Farbe;
  col_g     := Farbe shr 8;
  col_b     := Farbe shr 16;
  Edit1.Text := IntToStr(col_r);
  Edit2.Text := IntToStr(col_g);
  Edit3.Text := IntToStr(col_b);
  ColorToWindows(StaticText1.Color, Sender);
  Ed_TColor.Text := '#'+col_rs+col_gs+col_bs;
  AktualisiereCodeArt(Sender);
END;

PROCEDURE TForm1.AktualisiereCodeArt(Sender: TObject);
VAR ColStrRes : STRING;
BEGIN
 IF CodeArt = 0 THEN BEGIN
  Label1.Caption := 'Delphi® Farbcode';
  IF ColorToIdent(StaticText1.Color, ColStrRes) THEN
   Edit4.Text := ColStrRes
  ELSE Edit4.Text := ColorToString(StaticText1.Color);
 END;
 IF CodeArt = 1 THEN BEGIN
  Label1.Caption := 'C++ Farbcode';
  Edit4.Text := '0x'+col_rs+col_gs+col_bs;
 END;
 IF CodeArt = 2 THEN BEGIN
  Label1.Caption := 'Visual Basic® Farbcode';
  Edit4.Text := '&H00'+col_rs+col_gs+col_bs;
 END;
END;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
 CodeArt := ComboBox1.ItemIndex;
 AktualisiereCodeArt(Sender);
 ActiveControl := BitBtn1;
end;

{

// FÜR DEN BUTTON PIPETTE DIE EREIGNISSE ( OnMouseDown / OnMouseMove / OnMouseUp ) BENUTZEN....

procedure TColorForm.ButtPipetteMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 IF Button <> mbLeft THEN Exit;
 PipetteAktiv := True;
end;

procedure TColorForm.ButtPipetteMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
VAR Point1 : TPoint;
    DC : HDC;
    NewCol : TColorRef;
begin
 IF (PipetteAktiv = TRUE) THEN BEGIN
  GetCursorPos(Point1);  //Die Cursor-Position wird in Point1 geschrieben...
  DC := CreateDC('DISPLAY', nil, nil, nil);
  TRY
   NewCol := GetPixel(DC, Point1.X, Point1.Y);  // Pixelfarbe am Mauspfeil holen...
   PipetteCol := NewCol;  // Farbe zuweisen...
   StatikColFenster.Color := NewCol;
  FINALLY
   DeleteDC(DC);
  END;
 END;
end;

procedure TColorForm.ButtPipetteMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 IF Button <> mbLeft THEN Exit;
 PipetteAktiv := FALSE;
 ReleaseCapture; // Senden der Mausereignisse stoppen...
 StatikColFenster.Color := PipetteCol;
  Application.ProcessMessages;
 AktualisiereFarbwerte(Sender);
end;
}

Beispiel :

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
 ColorDialog1.Color := StaticText1.Color;
 IF ColorDialog1.Execute THEN BEGIN
  StaticText1.Color := ColorDialog1.Color;
  AktualisiereFarbwerte(Sender);
 end;
end;