Ir al contenido



Generador de Colores


  • Por favor identifícate para responder
2 respuestas en este tema

#1 Guest_Jose Fco_*

Guest_Jose Fco_*
  • Visitante

Escrito 29 noviembre 2008 - 03:21

Hola amigos aqui les dejo este generador de colores:

Imagen Enviada

Imagen Enviada

Aqui el codigo:


delphi
  1. uses
  2.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  3.   Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons;
  4.  
  5. type
  6.   TFGeneraColor = class(TForm)
  7.     Panel1: TPanel;
  8.     tbRojo: TTrackBar;
  9.     tbVerde: TTrackBar;
  10.     tbAzul: TTrackBar;
  11.     ldtRojo: TLabeledEdit;
  12.     ldtVerde: TLabeledEdit;
  13.     ldtAzul: TLabeledEdit;
  14.     rgColores: TRadioGroup;
  15.     BClose: TBitBtn;
  16.     procedure tbRojoChange(Sender: TObject);
  17.     procedure FormShow(Sender: TObject);
  18.     procedure ldtRojoKeyPress(Sender: TObject; var Key: Char);
  19.     procedure ldtRojoExit(Sender: TObject);
  20.     procedure ldtVerdeExit(Sender: TObject);
  21.     procedure ldtAzulExit(Sender: TObject);
  22.     procedure rgColoresClick(Sender: TObject);
  23.     procedure BCloseClick(Sender: TObject);
  24.   private
  25.     { Private declarations }
  26.     procedure ActualizaPanel;
  27.     procedure ActualizaEdits;
  28.   public
  29.     { Public declarations }
  30.   end;
  31.  
  32. var
  33.   FGeneraColor: TFGeneraColor;
  34. implementation
  35.  
  36. {$R *.dfm}
  37. procedure TFGeneraColor.ActualizaPanel;
  38. begin
  39.   panel1.Color := RGB(tbRojo.Position,tbVerde.Position,tbAzul.Position);
  40. end;
  41. procedure TFGeneraColor.ActualizaEdits;
  42. begin
  43.   ldtRojo.Text := IntToStr(tbRojo.Position );
  44.   ldtVerde.Text := IntToStr(tbVerde.Position );
  45.   ldtAzul.Text := IntToStr(tbAzul.Position );
  46. end;
  47. procedure TFGeneraColor.FormShow(Sender: TObject);
  48. begin
  49.   tbRojo.Position := 0;
  50.   tbVerde.Position := 0;
  51.   tbAzul.Position := 0;
  52.   ActualizaEdits;
  53.   ActualizaPanel;
  54. end;
  55. procedure TFGeneraColor.tbRojoChange(Sender: TObject);
  56. begin
  57.   ActualizaEdits;
  58.   ActualizaPanel;
  59. end;
  60. procedure TFGeneraColor.ldtRojoKeyPress(Sender: TObject; var Key: Char);
  61. begin
  62.   if not (Key in ['0'..'9',#8,#13]) then
  63.     key := #0;
  64. end;
  65. procedure TFGeneraColor.ldtRojoExit(Sender: TObject);
  66. begin
  67.   if StrToInt(ldtRojo.Text) > 255 then
  68.     ldtRojo.Text := '255';
  69.   tbRojo.Position := StrToInt(ldtRojo.Text );
  70.   ActualizaEdits;
  71.   ActualizaPanel;
  72. end;
  73. procedure TFGeneraColor.ldtVerdeExit(Sender: TObject);
  74. begin
  75.   if StrToInt(ldtverde.Text) > 255 then
  76.     ldtVerde.Text := '255';
  77.   tbVerde.Position := StrToInt(ldtVerde.Text );
  78.   ActualizaEdits;
  79.   ActualizaPanel;
  80. end;
  81. procedure TFGeneraColor.ldtAzulExit(Sender: TObject);
  82. begin
  83.   if StrToInt(ldtAzul.Text) > 255 then
  84.     ldtAzul.Text := '255';
  85.   tbAzul.Position := StrToInt(ldtAzul.Text );
  86.   ActualizaEdits;
  87.   ActualizaPanel;
  88. end;
  89. procedure TFGeneraColor.rgColoresClick(Sender: TObject);
  90. begin
  91.   case rgColores.ItemIndex of
  92.     0: begin
  93.       tbRojo.Position := 255;tbverde.Position := 255;tbazul.Position := 0;
  94.       end;
  95.     1: begin
  96.       tbRojo.Position := 0;tbverde.Position := 0;tbazul.Position := 255;
  97.       end;
  98.     2: begin
  99.       tbRojo.Position := 255;tbverde.Position := 255;tbazul.Position := 255;
  100.       end ;
  101.     3: begin
  102.       tbRojo.Position := 127;tbverde.Position := 127;tbazul.Position := 127;
  103.       end;
  104.     4: begin
  105.       tbRojo.Position := 0;tbverde.Position := 0;tbazul.Position := 0;
  106.       end ;
  107.     5: begin
  108.       tbRojo.Position := 255;tbverde.Position := 0;tbazul.Position := 0;
  109.       end;
  110.     6: begin
  111.       tbRojo.Position := 0;tbverde.Position := 255;tbazul.Position := 0;
  112.       end;
  113.   end;
  114. end;
  115. procedure TFGeneraColor.BCloseClick(Sender: TObject);
  116. begin
  117. Close;
  118. end;
  119. end.



Alguien me paso este codigo y pues le hice algunas modificasiones.

Un Saludo.

#2 felipe

felipe

    Advanced Member

  • Administrador
  • 3.283 mensajes
  • LocationColombia

Escrito 29 noviembre 2008 - 03:24

Gracias por el aporte Jose  :)
  • 0

#3 Caral

Caral

    Advanced Member

  • Administrador
  • 4.241 mensajes
  • LocationCosta Rica

Escrito 29 noviembre 2008 - 03:26

Hola
Muy bueno amigo.
Saludos
  • 0