{==============================================================================

  Utilites
  Copyright (C) 2000-2001 by Evgeny Kryukov
  All rights reserved

  All contents of this file and all other files included in this archive
  are Copyright (C) 2001 Evgeny Kryukov. Use and/or distribution of
  them requires acceptance of the License Agreement.

  See License.txt for licence information

===============================================================================}

unit KsUtils;

{$I KsCommonVer.Inc}

interface

uses Windows, Messages, Sysutils, Classes, Graphics, Forms, Controls, KsBitmap;

const

  BufferFlag    = $04; { For PaintBackground }
  NoChildPaint  = $08; { No paint children }

{ Strings functions }

function GetToken(var S: string): string;

function RectToString(R: TRect): string;
function StringToRect(S: string): TRect;

function FormatStr(DC: HDC; S: string; Width: integer): string; overload;
function FormatStr(Bitmap: TKsBitmap; S: string; Width: integer): string; overload;

{ Rect, Point and Polygon }

function RectWidth(R: TRect): integer;
function RectHeight(R: TRect): integer;
function RectHCenter(var R: TRect; Bounds: TRect): TRect;
function RectVCenter(var R: TRect; Bounds: TRect): TRect;
function RectCenter(var R: TRect; Bounds: TRect): TRect;
function RectOffset(ARect: TRect; Offset: integer): TRect;
function IsRectEmpty(Rect: TRect): boolean;
function CompareRect(Rect1, Rect2: TRect): boolean;

function PointInPolygon(const P: TPoint; const Points: array of TPoint): boolean;

{ Paint functions }

procedure PaintBackground(Control: TWinControl; DC: HDC; Blend: boolean);
procedure PaintGraphicBackground(Control: TGraphicControl; DC: HDC; Blend: boolean);
procedure PaintOwnerBackground(Control: TWinControl; DC: HDC);

{ Graphics routines }

function GetPlasma(const Color, PlasmaColor: TKColor): TKsBitmap;

{ Stream routines }

function ReadString(S: TStream): string;
procedure WriteString(S: TStream; Value: string);

{ Region }

function CreateRegionFromBitmap(Bitmap: TKsBitmap; Left, Top: integer): HRgn;

{ System }

function GetKeyBoardDelayInterval: integer;
function GetKeyBoardSpeedInterval: integer;

{ Mouse capture }

procedure CaptureMouse(const Wnd: HWND);
procedure EndCapture;

const
  CaptureHandle: Hwnd = 0;

implementation {===============================================================}

{ Capture =====================================================================}

const

  CaptureCount: integer = 0;

procedure CaptureMouse(const Wnd: HWND);
begin
  if CaptureCount = 0 then
  begin
    CaptureHandle := Wnd;
    SetCapture(CaptureHandle);
  end;
  Inc(CaptureCount);
end;

procedure EndCapture;
begin
  Dec(CaptureCount);
  if CaptureCount = 0 then
  begin
    if GetCapture = CaptureHandle then
      ReleaseCapture;
    CaptureHandle := 0;
  end;
end;

{ Strings functions ===========================================================}

function GetToken(var S: string): string;
{ Return first token and remove it from S }
var
  i: byte;
  CopyS: string;
begin
  Result := '';
  CopyS := S;
  for i := 1 to Length(CopyS) do
  begin
    Delete(S, 1, 1);
    if CopyS[i] in [',', ' ', '(', ')', ';'] then Break;
    Result := Result + CopyS[i];
  end;
  Trim(Result);
  Trim(S);
end;

function RectToString(R: TRect): string;
{ Convert TRect to string }
begin
  Result := '(' + IntToStr(R.Left) + ',' + IntToStr(R.Top) + ',' + IntToStr(R.Right) +
    IntToStr(R.Bottom) + ')';
end;

function StringToRect(S: string): TRect;
{ Convert string to TRect }
begin
  try
    Result.Left := StrToInt(GetToken(S));
    Result.Top := StrToInt(GetToken(S));
    Result.Right := StrToInt(GetToken(S));
    Result.Bottom := StrToInt(GetToken(S));
  except
    Result := Rect(0, 0, 0, 0);
  end;
end;

function FormatStr(DC: HDC; S: string; Width: integer): string;
var
  i: integer;
  Size: TSize;
  Ts: string;
begin
  Result := S;
  GetTextExtentPoint32(DC, PChar(S), Length(S), Size);

  if Size.cx <= Width then Exit;

  Result := '';
  for i := 1 to Length(S) do
  begin
    Ts := Result+S[i]+'...';
    GetTextExtentPoint32(DC, PChar(Ts), Length(Ts), Size);
    if Size.cx > Width then Break;
    Result := Result + S[i];
  end;
  Result := Result + '...'
end;

function FormatStr(Bitmap: TKsBitmap; S: string; Width: integer): string;
var
  SaveFont: HFONT;
begin
  SaveFont := SelectObject(Bitmap.DC, Bitmap.Font.Handle);
  try
    Result := FormatStr(Bitmap.DC, S, Width);
  finally
    SelectObject(Bitmap.DC, SaveFont);
  end;
end;

{ Rect and Point ==============================================================}

function RectWidth(R: TRect): integer;
begin
  Result := R.Right - R.Left;
end;

function RectHeight(R: TRect): integer;
begin
  Result := R.Bottom - R.Top;
end;

function RectVCenter(var R: TRect; Bounds: TRect): TRect;
begin
  OffsetRect(R, -R.Left, -R.Top);
  OffsetRect(R, 0, (RectHeight(Bounds) - RectHeight(R)) div 2);
  OffsetRect(R, Bounds.Left, Bounds.Top);

  Result := R;
end;

function RectHCenter(var R: TRect; Bounds: TRect): TRect;
begin
  OffsetRect(R, -R.Left, -R.Top);
  OffsetRect(R, (RectWidth(Bounds) - RectWidth(R)) div 2, 0);
  OffsetRect(R, Bounds.Left, Bounds.Top);

  Result := R;
end;

function RectCenter(var R: TRect; Bounds: TRect): TRect;
begin
  OffsetRect(R, -R.Left, -R.Top);
  OffsetRect(R, (RectWidth(Bounds) - RectWidth(R)) div 2, (RectHeight(Bounds) - RectHeight(R)) div 2);
  OffsetRect(R, Bounds.Left, Bounds.Top);

  Result := R;
end;

function RectOffset(ARect: TRect; Offset: integer): TRect;
begin
  Result.Top := ARect.Top - Offset;
  Result.Left := ARect.Left - Offset;
  Result.Bottom := ARect.Bottom + Offset;
  Result.Right := ARect.Right + Offset;
end;

function IsRectEmpty(Rect: TRect): boolean;
begin
  Result := (RectWidth(Rect) <= 0) or (RectHeight(Rect) <= 0); 
end;

function CompareRect(Rect1, Rect2: TRect): boolean;
begin
  Result := (Rect1.Left = Rect2.Left) and (Rect1.Top = Rect2.Top) and
    (Rect1.Right = Rect2.Right) and (Rect1.Bottom = Rect2.Bottom);
end;

function PointInPolygon(const P: TPoint; const Points: array of TPoint): boolean;
type
  PPoints = ^TPoints;
  TPoints = array[0..0] of TPoint;
var
  Rgn: HRgn;
begin
  Rgn := CreatePolygonRgn(PPoints(@Points)^, High(Points) + 1, WINDING);
  try
    Result := PtInRegion(Rgn, P.X, P.Y);
  finally
    DeleteObject(Rgn);
  end;
end;

{ Paint functions =============================================================}

type
  TParentControl = class(TWinControl);

procedure PaintBackground(Control: TWinControl; DC: HDC; Blend: boolean);
var
  P: TPoint;
  i, SaveIndex: Integer;
begin
  if Assigned(Control) and Assigned(Control.Parent) then
  begin
    SaveIndex := SaveDC(DC);
    try
      P := Control.ClientOrigin;
      ScreenToClient(Control.Parent.Handle, P);
      MoveWindowOrg(DC, -P.X, -P.Y);
      SendMessage(Control.Parent.Handle, WM_ERASEBKGND, DC, BufferFlag or NoChildPaint);
      TParentControl(Control.Parent).PaintControls(DC, nil);
    finally
      RestoreDC(DC, SaveIndex);
    end;
  end;
end;

procedure PaintGraphicBackground(Control: TGraphicControl; DC: HDC; Blend: boolean);
var
  P: TPoint;
  R: TRect;
  i, SaveIndex: Integer;
begin
  if Assigned(Control) and Assigned(Control.Parent) and (Control.Parent.HandleAllocated) then
  begin
    SaveIndex := SaveDC(DC);
    try
      P := Control.ClientOrigin;
      ScreenToClient(Control.Parent.Handle, P);
      MoveWindowOrg(DC, -P.X, -P.Y);
      SendMessage(Control.Parent.Handle, WM_ERASEBKGND, DC, BufferFlag or NoChildPaint);
    finally
      RestoreDC(DC, SaveIndex);
    end;
  end;
end;

procedure PaintOwnerBackground(Control: TWinControl; DC: HDC);
var
  P: TPoint;
  i, SaveIndex: Integer;
begin
  if Assigned(Control) and Assigned(Control.Parent) then
  begin
    SaveIndex := SaveDC(DC);
    try
      P := Control.ClientOrigin;
      ScreenToClient(Control.Parent.Handle, P);
      MoveWindowOrg(DC, -P.X, -P.Y);
      SendMessage(Control.Parent.Handle, WM_ERASEBKGND, DC, BufferFlag or NoChildPaint);
    finally
      RestoreDC(DC, SaveIndex);
    end;
  end;
end;

{ Stream routines ============================================================}

function ReadString(S: TStream): string;
var
  L: Integer;
begin
  L := 0;
  S.Read(L, SizeOf(L));
  SetLength(Result, L);
  S.Read(Pointer(Result)^, L);
end;

procedure WriteString(S: TStream; Value: string);
var
  L: Integer;
begin
  L := Length(Value);
  S.Write(L, SizeOf(L));
  S.Write(Pointer(Value)^, L);
end;

{ Region routines =============================================================}

const
  max    = 1500;
var
  Rts: array [0..max] of TRect;

function CreateRegionDataFromBitmap(Bitmap: TKsBitmap; var RgnData: PRgnData;
  Left, Top: integer): HRgn;
var
  j, i, i1: integer;
  C: TKColor;
  Count: integer;
  TrR, TrG, TrB: byte; 
begin
  Result := 0;
  TrR := TKColorRec(ckTransparent).R;
  TrG := TKColorRec(ckTransparent).G;
  TrB := TKColorRec(ckTransparent).B;

  if Bitmap.Empty then Exit;
  if Bitmap.Width * Bitmap.Height = 0 then Exit;

  Count := 0;
  for j := 0 to Bitmap.Height-1 do
  begin
    i := -1;
    while i < Bitmap.Width do
    begin
      repeat
        Inc(i);
        C := Bitmap.Pixels[i, j];
        if i >= Bitmap.Width then Break;
      until not ((TKColorRec(C).R = TrR) and (TKColorRec(C).G = TrG) and (TKColorRec(C).B = TrB));

      if i >= Bitmap.Width then Break;

      i1 := i;
      repeat
        Inc(i1);
        If (i1 >= Bitmap.Width) Then Break;
        C := Bitmap.Pixels[i1, j];
      until ((TKColorRec(C).R = TrR) and (TKColorRec(C).G = TrG) and (TKColorRec(C).B = TrB));

      if i <> i1 then
      begin
        Rts[Count] := Rect(Left+i, Top+j, Left+i1, Top+j+1);
        Inc(Count);
      end;
      i := i1;
    end;
  end;
  { Make Region data }
  Result := Count*SizeOf(TRect);
  GetMem(Rgndata, SizeOf(TRgnDataHeader)+Result);
  FillChar(Rgndata^, SizeOf(TRgnDataHeader)+Result, 0);
  RgnData^.rdh.dwSize := SizeOf(TRgnDataHeader);
  RgnData^.rdh.iType := RDH_RECTANGLES;
  RgnData^.rdh.nCount := Count;
  RgnData^.rdh.nRgnSize := 0;
  RgnData^.rdh.rcBound := Rect(0, 0, Bitmap.Width, Bitmap.Height);
  { Update New Region }
  Move(Rts, RgnData^.Buffer, Result);
  Result := SizeOf(TRgnDataHeader)+Count*SizeOf(TRect);
end;

function CreateRegionFromBitmap(Bitmap: TKsBitmap; Left, Top: integer): HRgn;
var
  RgnData: PRgnData;
  Size: integer;
begin
  RgnData := nil;
  Size := CreateRegionDataFromBitmap(Bitmap, RgnData, Left, Top);
  Result := ExtCreateRegion(nil, Size, RgnData^);
  if RgnData <> nil then FreeMem(RgnData, Size);
end;

{ Graphics }

function GetPlasma(const Color, PlasmaColor: TKColor): TKsBitmap;
var
  ImData: array [0..150, 0..150] of byte;
  x, y: integer;
  Colors: array [0..255] of TKColorRec;
  C: PKColor;

 procedure CalcColors;
 var
   x: integer;
   A, B, C: TKColorRec;
 begin
   A := TKColorRec(Color);
   B := TKColorRec(PlasmaColor);
   for x := 0 to 236 do
   begin
     if A.R < B.R then
       C.R := A.R + round(((B.R - A.R) / 236)*x)
     else
       C.R := A.R - round(((A.R - B.R) / 236)*x);

     if A.G < B.G then
       C.G := A.G + round(((B.G - A.G) / 236)*x)
     else
       C.G := A.G - round(((A.G - B.G) / 236)*x);

     if A.B < B.B then
       C.B := A.B + round(((B.B - A.B) / 236)*x)
     else
       C.B := A.B - round(((A.B - B.B) / 236)*x);

     Colors[x] := C;
   end;
 end;

 procedure SubDivide(x1, y1, x2, y2: integer);
  procedure Adjust(xa, ya, x, y, xb, yb: integer);
  var
    d: integer;
    v: double;
  begin
    if ImData[x,y] <> 0 then Exit;

    D := Abs(xa-xb) + Abs(ya-yb);
    v := (ImData[xa,ya] + ImData[xb,yb])/2 + (random-0.5)*d*8;
    if v < 1 then v := 1;
    if v >= 236 then v := 236;
    imdata[x,y] := Trunc(v);
  end;

 var
   x,y: integer;
   v: double;
 begin
   if (x2-x1<2) and (y2-y1<2) then Exit;

   x:=(x1+x2) div 2;
   y:=(y1+y2) div 2;
   adjust(x1,y1,x,y1,x2,y1);
   adjust(x2,y1,x2,y,x2,y2);
   adjust(x1,y2,x,y2,x2,y2);
   adjust(x1,y1,x1,y,x1,y2);
   if imdata[x,y] = 0 then
   begin
     v := (imdata[x1,y1] + imdata[x2,y1] + imdata[x2,y2] + imdata[x1,y2])/4;
     imdata[x,y] := Trunc(v);
   end;
   subDivide(x1,y1,x,y);
   subDivide(x,y1,x2,y);
   subDivide(x,y,x2,y2);
   subDivide(x1,y,x,y2);
 end;

begin
  CalcColors;

  FillChar(ImData, SizeOf(ImData), 0);

  ImData[0, 150] := random(236);
  ImData[150, 150] := random(236);
  ImData[150, 150] := random(236);
  ImData[0, 0] := random(236);

  SubDivide(0, 0, 150, 150);

  { Copy to Buffer }
  Result := TKsBitmap.Create;
  try
    Result.SetSize(150, 150);

    for x := 0 to Result.Width - 1 do
      for y := 0 to Result.Height - 1 do
      begin
        C := @Result.Bits[x + y * Result.Width];
        C^ := TKColor(Colors[ImData[x, y]]);
      end;
  except
    Result.Free;
    raise;
  end;
end;

{ System Routines }

function GetKeyBoardDelayInterval: integer;
var
  A: DWORD;
begin
  SystemParametersInfo(SPI_GETKEYBOARDDELAY, 0, @A, 0);
  Result := (A + 1) * 200;
end;

function GetKeyBoardSpeedInterval: integer;
var
  A: DWORD;
begin
  SystemParametersInfo(SPI_GETKEYBOARDSPEED, 0, @A, 0);
  Result := Round(1000 / ((A + 1) * 2.3));
end;

end.




