unit Pal;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls;

type
    ThreeBytePalette = array[0..255,0..2] of Byte;

  TPalForm = class(TForm)
    Blend: TButton;
    Rndm: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Refrsh: TButton;
    ColDemo: TPaintBox;
    Label2: TLabel;
    Red: TLabel;
    Green: TLabel;
    Blue: TLabel;
    Blur: TButton;
    Move: TButton;
    REdit: TEdit;
    GEdit: TEdit;
    BEdit: TEdit;
    PalSample: TImage;
    ColSample: TImage;
    AppPal: TButton;
    procedure FormShow(Sender: TObject);
    procedure PalSampleMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PalSampleMouseWait(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Blur2(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Blend2(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RefrshClick(Sender: TObject);
    procedure RndmClick(Sender: TObject);
    procedure PalSampleMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure BlendClick(Sender: TObject);
    procedure REditKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure GEditKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure BEditKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure BlurClick(Sender: TObject);
    procedure AppPalClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  PalForm: TPalForm;
  CPal   : Array[0..255] of Cardinal;
  CurC   : Byte;
  Cur2   : Byte;
  NewPal : Boolean;
  Pal3   : ThreeBytePalette;

implementation

{$R *.DFM}

Uses   MainForm, Img;

//Refreshing

procedure TPalForm.RefrshClick(Sender: TObject);
Var I, J : Word; X : Cardinal;
begin
        For I := 0 To 511 Do For J := 0 to PalSample.Height do
                PalSample.Canvas.Pixels[I,J] := CPal[I div 2];
        For I := 0 to ColSample.Width Do For J := 0 to ColSample.Height Do
                ColSample.Canvas.Pixels[I,J] := CPal[CurC];
        X := CPal[CurC];
        REdit.Text := IntToStr(X Mod 256);
        X := X Div 256;
        GEdit.Text := IntToStr(X Mod 256);
        X := X Div 256;
        BEdit.Text := IntToStr(X Mod 256);
        Repaint;
end;

//FORM SHOW

procedure TPalForm.FormShow(Sender: TObject);
Var I : Byte;
    J : Word;
begin
        Randomize;
        Left := 0;
        Top := 60;

        Label1.Caption := 'Colour Selected: 0';
        Edit1.Text := '0';
        CurC := 0;
        RefrshClick(Sender);
end;

//Alternate Colour Select

procedure TPalForm.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
Var I, J : Word;
begin
        If Key <> VK_Return Then Exit;
        Label1.Caption := 'Colour Selected: ' + Edit1.Text;
        CurC := StrToInt(Edit1.Text);
        RefrshClick(Sender);
end;

//Normal Colour Select

procedure TPalForm.PalSampleMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  Var I, J : Word;
begin
        CurC := X div 2;
        Edit1.Text := IntToStr(X div 2);
        Label1.Caption := 'Colour Selected: '+ Edit1.Text;
        RefrshClick(Sender);
end;

//Colour Modifier

procedure TPalForm.REditKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
	If Key <> VK_Return Then Exit;
   CPal[CurC] := CPal[CurC] AND $FFFFFF00;
   CPal[CurC] := CPal[CurC] + StrToInt(REdit.Text);
	ReFrshClick(Sender);
end;

procedure TPalForm.GEditKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
	If Key <> VK_Return Then Exit;
   CPal[CurC] := CPal[CurC] AND $FFFF00FF;
   CPal[CurC] := CPal[CurC] + StrToInt(GEdit.Text)*256;
	ReFrshClick(Sender);
end;

procedure TPalForm.BEditKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
	If Key <> VK_Return Then Exit;
   CPal[CurC] := CPal[CurC] AND $FF00FFFF;
   CPal[CurC] := CPal[CurC] + StrToInt(BEdit.Text)*65536;
	ReFrshClick(Sender);
end;


//END Colour Modifier

//RANDOM GENERATOR

procedure TPalForm.PalSampleMouseWait(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  Var I, J : Word;
   R,G,B : Extended;
Begin
        Cur2 := X div 2;
        Edit1.Text := IntToStr(X div 2);
        Label1.Caption := Label1.Caption + ' to ' + Edit1.Text;
        RefrshClick(Sender);
        If CurC > Cur2 Then
         Begin J := Cur2; Cur2 := CurC; CurC := J; End;
        J := StrToInt( InputBox('Similarity','Similarity to previous colour 0..100','100') );
        If CurC <> Cur2 Then
        For I := CurC+1 to Cur2 Do
         Begin
              R := (CPal[I-1] Mod 256)*(J/100) + Random(256)*(100-J)/100;
              G := ((CPal[I-1] div 256) Mod 256)*(J/100) + Random(256)*(100-J)/100;
              B := ((CPal[I-1] Div 65536) Mod 256)*(J/100) + Random(256)*(100-J)/100;
              CPal[I] := Trunc(R) + 256*Trunc(G) + 65536*Trunc(B);
         End;
        PalSample.OnMouseDown := PalSampleMouseDown;
        RefrshClick(Sender);
End;
procedure TPalForm.RndmClick(Sender: TObject);
begin
     //generate random from a starting point
     Label1.Caption := 'Random colour starting at ' + IntToStr(CurC);
     PalSample.OnMouseDown := PalSampleMouseWait;
end;


//COLDEMO

procedure TPalForm.PalSampleMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
Var I, J : word;
begin
     For I := 0 to ColDemo.Width Do For J := 0 to ColDemo.Height Do
       ColDemo.Canvas.Pixels[I,J] := CPal[X div 2];
     Label2.Caption := IntToStr(X div 2);
end;

//BLENDING

procedure TPalForm.Blend2(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  Var I, J : Word; R1,R2,G1,G2,B1,B2,dR,dG,dB : Extended;
begin
	Cur2 := X div 2;
   PalForm.Edit1.Text := IntToStr(X div 2);
   PalForm.Label1.Caption := PalForm.Label1.Caption + PalForm.Edit1.Text;
   PalForm.RefrshClick(Sender);
   If CurC > Cur2 Then
   	Begin J := CurC; CurC := Cur2; Cur2 := J; End;
   R1 := CPal[CurC] mod 256;
   R2 := CPal[Cur2] mod 256;
   G1 := (CPal[CurC] Div 256) Mod 256;
   G2 := (CPal[Cur2] Div 256) Mod 256;
   B1 := (CPal[CurC] Div 65536) Mod 256;
   B2 := (CPal[Cur2] Div 65536) Mod 256;

   dR := (R2-R1)/(Cur2-CurC);
   dG := (G2-G1)/(Cur2-CurC);
   dB := (B2-B1)/(Cur2-CurC);

   For I := CurC To Cur2 Do
   	Begin
           CPal[I] := CPal[CurC] + Trunc((I-CurC)*dR) + Trunc((I-CurC)*dG)*256 + Trunc((I-CurC)*dB)*65536;
      End;

	PalForm.PalSample.OnMouseDown := PalForm.PalSampleMouseDown;
	PalForm.RefrshClick(Sender);
end;


procedure TPalForm.BlendClick(Sender: TObject);
begin
	Label1.Caption := 'Blend colour ' + IntToStr(CurC) + ' with ';
	PalSample.OnMouseDown := Blend2;
end;

//END Blending

//Blurring

procedure TPalForm.Blur2(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Var I, J : Word; Z : Cardinal;
	 R,G,B : Extended;
	 BPal : Array[0..255] of Cardinal;
begin
	Cur2 := X div 2;
   PalForm.Edit1.Text := IntToStr(X div 2);
   PalForm.Label1.Caption := PalForm.Label1.Caption +' to '+ PalForm.Edit1.Text;
   PalForm.RefrshClick(Sender);

   If CurC > Cur2 Then Begin J := Cur2; Cur2 := CurC; CurC := J; End;
   J := StrToInt ( InputBox('Intensity','Blurring intensity 0..100','0') );
   For I := 0 to 255 Do BPal[I] := CPal[I];
   For I := CurC To Cur2 Do
   	If I In [2..253] Then
      	Begin

         	R := (100-J)*(BPal[I] mod 256);
            R := R + (J/3)*(BPal[I-1] mod 256);
            R := R + (J/3)*(BPal[I+1] mod 256);
            R := R + (J/6)*(BPal[I+2] mod 256);
            R := R + (J/6)*(BPal[I-2] mod 256);
            R := R / 100;
         	G := (100-J)*((BPal[I] div 256) mod 256);
            G := G + (J/3)*((BPal[I-1] div 256) mod 256);
            G := G + (J/3)*((BPal[I+1] div 256) mod 256);
            G := G + (J/6)*((BPal[I-2] div 256) mod 256);
            G := G + (J/6)*((BPal[I+2] div 256) mod 256);
            G := G / 100;
         	B := (100-J)*((BPal[I] div 65536) mod 256);
            B := B + (J/3)*((BPal[I-1] div 65536) mod 256);
            B := B + (J/3)*((BPal[I+1] div 65536) mod 256);
            B := B + (J/6)*((BPal[I-2] div 65536) mod 256);
            B := B + (J/6)*((BPal[I+2] div 65536) mod 256);
            B := B / 100;
				CPal[I] := Round(R) + 256*Round(G) + 65536*Round(B);
         End;

	PalForm.PalSample.OnMouseDown := PalForm.PalSampleMouseDown;
	PalForm.RefrshClick(Sender);
end;

procedure TPalForm.BlurClick(Sender: TObject);
begin
	PalSample.OnMouseDown := Blur2;
   Label1.Caption := 'Blur from ' + IntToStr(CurC);
end;


//End Blurring
procedure TPalForm.AppPalClick(Sender: TObject);
var I,J,K : Integer;
begin
     K := MainF.List.Items.Add( 'Converting ...');
     FrcForm.FrcImg.Stretch := False;
     For I := 0 to FrcForm.FrcImg.Height-1 Do
         Begin
         For J := 0 to FrcForm.FrcImg.Width-1 Do
             Begin

                  With FrcForm.FrcImg.Canvas Do
                       Pixels[J,I] := CPal[Pixels[J,I] mod 256];
             End;

         End;
     FrcForm.FrcImg.Stretch := True;
     MainF.List.Items[K] := 'Conversion complete';
end;

procedure TPalForm.FormCreate(Sender: TObject);
Var I,J : Integer;
begin
             For I := 0 to 255 do
                Begin
                        CPal[I] := I*65536+I*256+I;
                        Pal3[I,0] := i;
                        Pal3[I,1] := i;
                        Pal3[I,2] := i;

                        For J := 0 to PalForm.PalSample.Height Do PalForm.PalSample.Canvas.Pixels[I,J] := CPal[I];
                End;

end;

end.