unit RyuGraphics;

interface

Uses
  SysUtils, WinTypes, Types, Graphics, Classes, Controls, JPeg, Math, StdCtrls,
  Forms;

type
  TRyuJpegImage = class(TJPEGImage)
  private
  protected
  public
    procedure SaveToBitmap(Bitmap:TBitmap);
  published
  end;

Procedure GradationDown(Canvas:TCanvas; Width,Height:Integer; Color:TColor);
Procedure GradationUp(Canvas:TCanvas; Width,Height:Integer; Color:TColor);
Function  BrightColor(Color:TColor; Weight:Integer):TColor;
Function  DarkColor(Color:TColor; Weight:Integer):TColor;

Procedure SaveImageToJPG(Graphic:TPersistent; FileName:String; Quality:Integer);
procedure GetDarkBitmap(Bitmap:TBitmap; Weight:integer);

function PixelToColor(Pixel:DWord):TColor;
function RGBToGray(RGBColor:TColor):TColor;
procedure ColorToHSB(RGBColor:TColor; var H,S,B:integer);

Procedure TransparentTextOut(Canvas:TCanvas; X,Y:Integer; stText:String);
Procedure RotateText(Canvas:TCanvas; stText:String; X,Y,Angle:Integer);

Procedure ScrollCanvasX(Canvas:TCanvas; SRect:TRect; Pixel:Integer);
Procedure ScrollCanvasY(Canvas:TCanvas; SRect:TRect; Pixel:Integer);
Function  RatioSize(Source,Target:TPoint):TPoint; overload;
Procedure RatioSize(Source,Target:TControl); overload;
Procedure SetClipRect(Canvas:TCanvas; R:TRect);

function GetStringOfWidth(Canvas:TCanvas; Width:integer; var Line: string):WideString;

function Brightness(Color: TColor): integer;
function BrightnessOfBitmap(ABitmap:TBitmap):integer;

procedure SmoothResize(Src, Dst: TBitmap);

procedure MakeOpaque(AControl:TControl);

function FindMonitorRect(AX,AY:integer):TRect;

procedure FalshWindow(AHandle:HWND; ACount,ATimeOut:integer);

function SetBright(AColor:TColor; APercent:integer):TColor;

implementation

{ TRyuJpegImage }

procedure TRyuJpegImage.SaveToBitmap(Bitmap: TBitmap);
begin
  Bitmap.Width:=  Width;
  Bitmap.Height:= Height;
  Bitmap.Canvas.Draw(0, 0, Self);
end;

Procedure GradationDown(Canvas:TCanvas; Width,Height:Integer; Color:TColor);
Var
   bTemp : TBrushStyle;
   pTemp : TPenStyle;
   Loop, iR, iG, iB, R, G, B : Integer;
Begin
  bTemp:= Canvas.Brush.Style;
  pTemp:= Canvas.Pen.Style;
  Canvas.Brush.Style:= bsSolid;
  Canvas.Pen.Style:=   psSolid;
  iB:= (Color and $FF0000) shr 16;
  iG:= (Color and $00FF00) shr  8;
  iR:= (Color and $0000FF);
  For Loop:= 0 to Height do
      Begin
        R:= iR*Loop div Height;
        G:= iG*Loop div Height;
        B:= iB*Loop div Height;
        Canvas.Pen.Color:= RGB(R, G, B);
        Canvas.MoveTo(0, Loop);
        Canvas.LineTo(Width, Loop);
      End;
  Canvas.Pen.Style:=   pTemp;
  Canvas.Brush.Style:= bTemp;
End;

Procedure GradationUp(Canvas:TCanvas; Width,Height:Integer; Color:TColor);
Var
   bTemp : TBrushStyle;
   pTemp : TPenStyle;
   Loop, iR, iG, iB, R, G, B : Integer;
Begin
  bTemp:= Canvas.Brush.Style;
  pTemp:= Canvas.Pen.Style;
  Canvas.Brush.Style:= bsSolid;
  Canvas.Pen.Style:=   psSolid;
  iB:= (Color and $FF0000) shr 16;
  iG:= (Color and $00FF00) shr  8;
  iR:= (Color and $0000FF);
  For Loop:= 0 to Height do
      Begin
        R:= iR*(Height-Loop) div Height;
        G:= iG*(Height-Loop) div Height;
        B:= iB*(Height-Loop) div Height;
        Canvas.Pen.Color:= RGB(R, G, B);
        Canvas.MoveTo(0, Loop);
        Canvas.LineTo(Width, Loop);
      End;
  Canvas.Pen.Style:=   pTemp;
  Canvas.Brush.Style:= bTemp;
End;

Function  BrightColor(Color:TColor; Weight:Integer):TColor;
Var
   iR, iG, iB : Integer;
Begin
  iR:= (GetRValue(Color)*(100+Weight)) div 100;
  iG:= (GetGValue(Color)*(100+Weight)) div 100;
  iB:= (GetBValue(Color)*(100+Weight)) div 100;
  Result:= RGB(iR, iG, iB);
End;

Function  DarkColor(Color:TColor; Weight:Integer):TColor;
Var
   iR, iG, iB : Integer;
Begin
  iR:= (GetRValue(Color)*(100-Weight)) div 100;
  iG:= (GetGValue(Color)*(100-Weight)) div 100;
  iB:= (GetBValue(Color)*(100-Weight)) div 100;
  Result:= RGB(iR, iG, iB);
End;

procedure SaveImageToJPG(Graphic:TPersistent; FileName:string; Quality:integer);
var
   JP : TJPEGImage;
begin
  JP := TJPEGImage.Create;
  try
    JP.CompressionQuality := Quality;
    JP.Performance := jpBestQuality;
    JP.Assign(Graphic);
    JP.PixelFormat := jf24Bit;
    JP.Compress;
    JP.SaveToFile(FileName);
  finally
    JP.Free;
  end;
end;

procedure GetDarkBitmap(Bitmap:TBitmap; Weight:Integer);
var
  LoopX, LoopY : integer;
begin
  for LoopY := 0 to Bitmap.Height - 1 do
  for LoopX := 0 to Bitmap.Width - 1 do
    Bitmap.Canvas.Pixels[LoopX, LoopY]:= DarkColor(Bitmap.Canvas.Pixels[LoopX, LoopY], Weight);
end;

function PixelToColor(Pixel:DWord):TColor;
var
  R, G, B : integer;
begin
  B := (Pixel and $FF);
  G := ((Pixel and $FF00) shr 8);
  R := ((Pixel and $FF0000) shr 16);

  Result := RGB(R, G, B);
end;

function  RGBToGray(RGBColor:TColor):TColor;
var
   Gray : Byte;
begin
  Gray := Round((0.30*GetRValue(RGBColor)) +
                (0.59*GetGValue(RGBColor)) +
                (0.11*GetBValue(RGBColor )));
  Result := RGB(Gray, Gray, Gray);
end;

procedure ColorToHSB(RGBColor:TColor; var H,S,B:integer);
var
  Red, Green, Blue : byte;
  dH, dS, dB,
  minRGB, maxRGB, Delta : Double;
begin
  Red := GetRValue(RGBColor);
  Green := GetGValue(RGBColor);
  Blue := GetBValue(RGBColor);

  dH := 0.0;

  minRGB := Min(Min(Red, Green), Blue);
  maxRGB := Max(Max(Red, Green), Blue);
  dB := maxRGB;

  Delta := ( maxRGB - minRGB ) ;
  if (maxRGB <> 0.0) then dS := 255.0 * Delta / maxRGB
  else dS := 0.0;

  if (dS <> 0.0) then begin
    if Red = maxRGB then dH := (Green - Blue) / Delta
    else if Green = maxRGB then dH := 2.0 + (Blue - Red) / Delta
    else if Blue = maxRGB then dH := 4.0 + (Red - Green) / Delta
  end else dH := -1.0;

  dH := dH * 60;
  if dH < 0.0 then dH := dH + 360.0
  else if dH > 360.0 then dH := 360.0;           

  H := Round(dH);
  S := Round(dS * 100 / 255);
  B := Round(dB * 100 / 255);
end;

Procedure TransparentTextOut(Canvas:TCanvas; X,Y:Integer; stText:String);
Var
   OldBkMode : Integer;
Begin
  OldBkMode:= SetBkMode(Canvas.Handle, TRANSPARENT);
  Canvas.TextOut(X, Y, stText);
  SetBkMode(Canvas.Handle, OldBkMode);
End;

Procedure RotateText(Canvas:TCanvas; stText:String; X,Y,Angle:Integer);
Var
   LogFont : TLogFont;
Begin
  GetObject(Canvas.Handle, SizeOf(TLogFont), @LogFont);
  LogFont.lfEscapement:= Angle*10;
  Canvas.Font.Handle := CreateFontIndirect(LogFont);
  Canvas.TextOut(X, Y, stText);
End;

Procedure ScrollCanvasX(Canvas:TCanvas; SRect:TRect; Pixel:Integer);
Var
   DRect : TRect;
Begin
  DRect:= Rect(SRect.Left+Pixel, SRect.Top, SRect.Right+Pixel, SRect.Bottom);
  Canvas.CopyRect(DRect, Canvas, SRect);
End;

Procedure ScrollCanvasY(Canvas:TCanvas; SRect:TRect; Pixel:Integer);
Var
   DRect : TRect;
Begin
  DRect:= Rect(SRect.Left, SRect.Top+Pixel, SRect.Right, SRect.Bottom+Pixel);
  Canvas.CopyRect(DRect, Canvas, SRect);
End;

function RGBChange(A: TColor; Rx, Gx, Bx: SmallInt): TColor;
var
  RValue, GValue, BValue : byte;
begin
  RValue := GetRValue(A);
  GValue := GetGValue(A);
  BValue := GetBValue(A);
  // Change Red Part
  If Rx > 0 Then
    If RValue + Rx < $FF Then Inc(RValue, Rx) else RValue := $FF;
  If Rx < 0 Then
    If RValue > Abs(Rx) Then Dec(RValue, Abs(Rx)) else RValue := 0;
  // Change Green Part
  If Gx > 0 Then
    If GValue + Gx < $FF Then Inc(GValue, Gx) else GValue := $FF;
  If Gx < 0 Then
    If GValue > Abs(Gx) Then Dec(GValue, Abs(Gx)) else GValue := 0;
  // Change Blue Part
  If Bx > 0 Then
    If BValue + Bx < $FF Then Inc(BValue, Bx) else BValue := $FF;
  If Bx < 0 Then
    If BValue > Abs(Bx) Then Dec(BValue, Abs(Bx)) else BValue := 0;
  Result := RGB(RValue, GValue, BValue);
end;

Function  RatioSize(Source,Target:TPoint):TPoint;
var
  rSRatio, rTRatio, rRatio : double;
Begin
  if (Source.X = 0) or (Target.X = 0) or (Source.Y = 0) or (Target.Y = 0) then begin
    Result := Source;
    Exit;
  end;

  rSRatio:= Source.Y / Source.X;
  rTRatio:= Target.Y / Target.X;

  If rSRatio > rTRatio then
    // 원본의 세로축의 비율이 크다.  길쭉한 모양으로
    rRatio:= Source.Y / Target.Y

  Else
    //원본의 가로축의 비율이 크다.  넓적한 모양으로
    rRatio:= Source.X / Target.X;

  Result.X:= Trunc(Source.X / rRatio);
  Result.Y:= Trunc(Source.Y / rRatio);
End;

Procedure RatioSize(Source,Target:TControl);
Var
  rSRatio, rTRatio, rRatio : Real;
Begin
  if (Source.Width = 0) or (Target.Width = 0) or (Source.Width = 0) or (Target.Width = 0) then begin
    Target.Width:=  Source.Width;
    Target.Height:= Source.Height;
    Exit;
  end;

  rSRatio:= Source.Height / Source.Width;
  rTRatio:= Target.Height / Target.Width;

  If rSRatio > rTRatio then
    // 원본의 세로축의 비율이 크다.  길쭉한 모양으로
    rRatio:= Source.Height / Target.Height

  Else
    //원본의 가로축의 비율이 크다.  넓적한 모양으로
    rRatio:= Source.Width / Target.Width;

  Target.Width:=  Trunc(Source.Width / rRatio);
  Target.Height:= Trunc(Source.Height / rRatio);
End;

Procedure SetClipRect(Canvas:TCanvas; R:TRect);
var
  Rgn : HRGN;
Begin
  Rgn:= CreateRectRgn(R.Left, R.Top, R.Right, R.Bottom);
  ExtSelectClipRgn(Canvas.Handle, Rgn, RGN_AND);
  DeleteObject(Rgn);
End;

function GetStringOfWidth(Canvas:TCanvas; Width:integer; var Line: string):WideString;
var
  Loop : Integer;
  sTemp : string;
  sCopy : WideString;
begin
  if Canvas.TextWidth(Line) <= Width then begin
    Result := Line;
    Line := '';
    Exit;
  end;

  Result := '';
  sCopy := Line;
  for Loop := 1 to Length(sCopy) do begin
    Result := Result + sCopy[Loop];
    if Canvas.TextWidth(Result) > Width then begin
      Delete(Result, Length(Result), 1);

      // 짤라낸 만큼 원본도 짤라낸다.
      sTemp := Result;
      Delete(Line, 1, Length(sTemp));

      Exit;
    end;
  end;
end;

function Brightness(Color: TColor): integer;
var
  R, G, B : integer;
begin
  B := Color and $FF;
  G := (Color and $FF00) shr 8;
  R := (Color and $FF0000) shr 16;

  Result := ((30*R) + (59*G) + (11*B)) div 100;
end;

function BrightnessOfBitmap(ABitmap:TBitmap):integer;
var
  Count : integer;
  Bright : double;
  StartPos, EndPos : ^TColor;
begin
  if ABitmap.PixelFormat <> pf32bit then
    raise Exception.Create('RyuGraphics.BrightnessOfBitmap: 32bit 포멧만 지원합니다.');

  StartPos := ABitmap.ScanLine[ABitmap.Height-1];

  EndPos := StartPos;
  Inc(EndPos, ABitmap.Width * ABitmap.Height);

  Count := 0;
  Bright := 0;
  while StartPos <> EndPos do begin
    Inc(Count);
    Bright := (Bright*(Count-1)) / Count;
    Bright := Bright + (Brightness(StartPos^) / Count);

    Inc(StartPos);
  end;

  Result := Round(Bright);
end;

procedure SmoothResize(Src, Dst: TBitmap);
type
  TRGBArray = array[Word] of TRGBQuad;
  pRGBArray = ^TRGBArray;
var
  x, y: Integer;
  xP, yP: Integer;
  xP2, yP2: Integer;
  t3: Integer;
  z, z2, iz2: Integer;
  DstGap: Integer;
  w1, w2, w3, w4: Integer;
  SrcLine1, SrcLine2, DstLine: pRGBArray;
begin
  Assert(Src.PixelFormat = pf32Bit, 'Invalid PixelFormat');
  Assert(Dst.PixelFormat = pf32Bit, 'Invalid PixelFormat');

  if (Src.Width = Dst.Width) and (Src.Height = Dst.Height) then begin
    Dst.Assign(Src);
    Exit;
  end;

  DstLine := Dst.ScanLine[0];
  DstGap  := Integer(Dst.ScanLine[1]) - Integer(DstLine);

  xP2 := MulDiv(pred(Src.Width), $10000, Dst.Width);
  yP2 := MulDiv(pred(Src.Height), $10000, Dst.Height);
  yP  := 0;

  for y := 0 to pred(Dst.Height) do begin
    xP := 0;
    SrcLine1 := Src.ScanLine[yP shr 16];

    if (yP shr 16 < pred(Src.Height)) then SrcLine2 := Src.ScanLine[succ(yP shr 16)]
    else SrcLine2 := Src.ScanLine[yP shr 16];

    z2  := succ(yP and $FFFF);
    iz2 := succ((not yp) and $FFFF);
    for x := 0 to pred(Dst.Width) do begin
      t3 := xP shr 16;
      z  := xP and $FFFF;
      w2 := MulDiv(z, iz2, $10000);
      w1 := iz2 - w2;
      w4 := MulDiv(z, z2, $10000);
      w3 := z2 - w4;
      DstLine[x].rgbRed := (SrcLine1[t3].rgbRed * w1 +
        SrcLine1[t3 + 1].rgbRed * w2 +
        SrcLine2[t3].rgbRed * w3 + SrcLine2[t3 + 1].rgbRed * w4) shr 16;
      DstLine[x].rgbGreen :=
        (SrcLine1[t3].rgbGreen * w1 + SrcLine1[t3 + 1].rgbGreen * w2 +

        SrcLine2[t3].rgbGreen * w3 + SrcLine2[t3 + 1].rgbGreen * w4) shr 16;
      DstLine[x].rgbBlue := (SrcLine1[t3].rgbBlue * w1 +
        SrcLine1[t3 + 1].rgbBlue * w2 +
        SrcLine2[t3].rgbBlue * w3 +
        SrcLine2[t3 + 1].rgbBlue * w4) shr 16;
      Inc(xP, xP2);
    end;
    Inc(yP, yP2);
    DstLine := pRGBArray(Integer(DstLine) + DstGap);
  end;
end;

procedure MakeOpaque(AControl:TControl);
var
  Loop : integer;
  WinControl : TWinControl;
begin
  if AControl is TLabel then Exit;

  AControl.ControlStyle := AControl.ControlStyle + [csOpaque];

  if AControl is TWinControl then begin
    WinControl := Pointer(AControl);
    WinControl.DoubleBuffered := true;

    for Loop := 0 to WinControl.ControlCount-1 do MakeOpaque(WinControl.Controls[Loop]);
  end;
end;

function FindMonitorRect(AX,AY:integer):TRect;
var
  Monitor : TMonitor;
begin
  Monitor := Screen.MonitorFromPoint(Point(AX, AY));
  if Monitor = nil then Monitor := Screen.Monitors[0];

  Result :=
    Rect(
      Monitor.Left,
      Monitor.Top,
      Monitor.Left + Monitor.Width,
      Monitor.Top  + Monitor.Height
    );
end;

procedure FalshWindow(AHandle:HWND; ACount,ATimeOut:integer);
var
  pfwi : FLASHWINFO;
begin
  pfwi.cbSize    := SizeOf(pfwi);
  pfwi.hWnd      := AHandle;
  pfwi.dwFlags   := FLASHW_ALL;
  pfwi.uCount    := ACount;
  pfwi.dwTimeOut := ATimeOut;
  FlashWindowEx(pfwi);
end;

function SetBright(AColor:TColor; APercent:integer):TColor;
var
  iR, iG, iB : integer;
begin
  iB:= (AColor and $FF0000) shr 16;
  iG:= (AColor and $00FF00) shr  8;
  iR:= (AColor and $0000FF);

  Result := RGB(
    iR * APercent div 100,
    iG * APercent div 100,
    iB * APercent div 100
  );
end;

end.

