TImage에 색상바 그리기

TImage에 색상바 그리기

 

728x90

 

 

 

 

 

 

unit Unit1;

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, StdCtrls;

 

type

TMain = class(TForm)

HueImg: TImage;

ColImg: TImage;

Label1: TLabel;

FGColorPanel: TPanel;

BGColorPanel: TPanel;

procedure FormCreate(Sender: TObject);

procedure FormResize(Sender: TObject);

procedure HueImgMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure HueImgMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

procedure ColImgMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure ColImgMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

private

{ Private declarations }

procedure HueImageUpdate;

procedure ColImageUpdate(MainCol: TColor);

public

{ Public declarations }

end;

 

const

DefaultPxFormat = pf32Bit;

BPP = 4;

 

var

Main: TMain;

PrevHuePosY: Integer;

 

implementation

 

{$R *.dfm}

 

//////////////////////////////////////////////////////////////////////////////// 초기화

procedure TMain.FormCreate(Sender: TObject);

begin

DoubleBuffered:=True;

HueImg.Picture.Bitmap.PixelFormat:=DefaultPxFormat;

ColImg.Picture.Bitmap.PixelFormat:=DefaultPxFormat;

HueImageUpdate;

HueImgMouseMove(Self, [ssLeft], 0, 0);

end;

 

//////////////////////////////////////////////////////////////////////////////// 폼 크기가 변경되면 다시 그리고

procedure TMain.FormResize(Sender: TObject);

begin

HueImageUpdate;

HueImgMouseMove(Self, [ssLeft], 0, PrevHuePosY);

end;

//////////////////////////////////////////////////////////////////////////////// 마우스 입력 받기

procedure TMain.HueImgMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

if Button=mbLeft then

HueImgMouseMove(Sender, Shift, X, Y);

end;

 

procedure TMain.HueImgMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

if ssLeft in Shift then

begin

with HueImg do

begin

if (X>=0)and(Y>=0)and(X<Width)and(Y<Height) then

begin

ColImageUpdate(Canvas.Pixels[X, Y]);

PrevHuePosY:=Y;

end;

end;

end;

end;

 

procedure TMain.ColImgMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

case Button of

mbLeft : ColImgMouseMove(Sender, [ssLeft], X, Y);

mbRight: ColImgMouseMove(Sender, [ssRight], X, Y);

end;

end;

 

procedure TMain.ColImgMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

with ColImg do

begin

if (X>=0)and(Y>=0)and(X<Width)and(Y<Height) then

begin

if ssLeft in Shift then

FGColorPanel.Color:=Canvas.Pixels[X, Y]

else

if ssRight in Shift then

BGColorPanel.Color:=Canvas.Pixels[X, Y];

end;

end;

end;

 

//////////////////////////////////////////////////////////////////////////////// 그리기 함수는 요기...

procedure TMain.HueImageUpdate; // 색상바 그리기

const

ColArrCount = 6;

ColArr: array[0..ColArrCount]of TColor = ($0000FF, $FF00FF, $FF0000, $FFFF00, $00FF00, $00FFFF, $0000FF);

var

iY, XMax, YMax: Integer; ColIdx0, ColIdx1: Integer; BoganPos0, BoganPos1: Integer;

BoganValue: Single;

R, G, B: Byte;

begin

with HueImg do

begin

XMax:=Width;

YMax:=Height;

if Picture.Bitmap.Width

ColIdx0:=ColArrCount * iY div YMax;

ColIdx1:=ColIdx0+1;

BoganPos0:=ColIdx0*YMax div ColArrCount;

BoganPos1:=ColIdx1*YMax div ColArrCount;

BoganValue:=(iY-BoganPos0)/(BoganPos1-BoganPos0);

R:=Trunc(GetRValue(ColArr[ColIdx0])*(1-BoganValue)+GetRValue(ColArr[ColIdx1])*BoganValue); G:=Trunc(GetGValue(ColArr[ColIdx0])*(1-BoganValue)+GetGValue(ColArr[ColIdx1])*BoganValue); B:=Trunc(GetBValue(ColArr[ColIdx0])*(1-BoganValue)+GetBValue(ColArr[ColIdx1])*BoganValue);

with Canvas do

begin

Pen.Color:=RGB(R, G, B);

MoveTo(0 , iY);

LineTo(XMax-1, iY);

end;

end;

end;

end;

 

procedure TMain.ColImageUpdate(MainCol: TColor);

type

PDWORDArray = PIntegerArray;

var

iX, iY, XMax, YMax: Integer;

R, G, B, MainR, MainG, MainB: Byte;

XBoganValue, YBoganValue: Single;

P: PDWORDArray;

begin

with ColImg do

begin

XMax:=Width;

YMax:=Height;

if Picture.Bitmap.Width

P:=Picture.Bitmap.ScanLine[iY];

for iX:=0 to XMax-1 do

begin

XBoganValue:=iX/XMax;

YBoganValue:=iY/YMax;

R:=Trunc(((MainR*XBoganValue)+($FF*(1-XBoganValue)))*(1-YBoganValue));

G:=Trunc(((MainG*XBoganValue)+($FF*(1-XBoganValue)))*(1-YBoganValue));

B:=Trunc(((MainB*XBoganValue)+($FF*(1-XBoganValue)))*(1-YBoganValue));

//Canvas.Pixels[iX, iY]:=RGB(R, G, B);

// 이건 느려서 못써요 P[iX]:=(B shl 16) or (G shl 8) or R;

end;

end;

Repaint;

end;

end;

end.