All pastes #68959 Raw Edit

Stuff

public text v1 · immutable
#68959 ·published 2006-06-22 09:30 UTC
rendered paste body
function TApu.HexToInt(const HexStr: String): Integer;
begin
result := StrToInt('$' + HexStr); //$!!!
end;

//periaate: esim. alpha25=alpha50(alpha0,alpha50), alpha12.5=(alpha0,alpha25)
//"puhelinluetteloalgoritmi"
function TApu.alphaBlend(const col1, col2 : TColor; const goal : extended) : TColor;

  function alphaBlend50(const col1, col2 : TColor): TColor;
  var col1R, col1G, col1B, col2R, col2G, col2B, colR, colG, colB : Byte;
  col1Hex, col2Hex : string;
  begin
  //parsitaan
  col1Hex := IntToHex(col1, 6);
  col1R   := HexToInt(Copy(col1Hex,1,2));
  col1G   := HexToInt(Copy(col1Hex,3,2));
  col1B   := HexToInt(Copy(col1Hex,5,2));

  col2Hex := IntToHex(col2, 6);
  col2R   := HexToInt(Copy(col2Hex,1,2));
  col2G   := HexToInt(Copy(col2Hex,3,2));
  col2B   := HexToInt(Copy(col2Hex,5,2));

  //lasketaan
  colR    := Round((col1R + col2R) / 2);
  colG    := Round((col1G + col2G) / 2);
  colB    := Round((col1B + col2B) / 2);

  //kootaan ja palautetaan
  result  := HexToInt(IntToHex(colR,2) + IntToHex(colG,2) + IntToHex(colB,2));
  end;

  function alphaRecursion(const col1, col2 : TColor; const percentL, percentH,
    goal, precision : extended): TColor;
  var percentAvg : extended; colAvg : TColor;
  begin
  percentAvg := (percentL + percentH) / 2;
  colAvg := alphaBlend50(col1,col2);
  if (goal > percentAvg - precision) and (goal < percentAvg + precision) then
    begin
    result := colAvg;
    exit;
    end
  else
    if (goal <= percentAvg) then
      begin
      result := alphaRecursion(col1,colAvg,percentL,percentAvg,goal,precision);
      end
    else
      begin
      result := alphaRecursion(colAvg,col2,percentAvg,percentH,goal,precision);
      end
  end;

begin
//huomioidaan poikkeustapaus
if (goal < 0) or (goal > 100) then
  begin
    result := alphaBlend50(col1,col2);
    exit;
  end;

//rekursio, precision voisi säätyä laskentatehon mukaan
result := alphaRecursion(col1,col2,0,100,goal,0.01); //!!!
end;

//kehno algoritmi ... järkevämpää tutkia lävistyksiä
function TApu.onko_sisalla(const p: TPoint; const r : TRect) : boolean;
var xpit, ypit : integer;
begin
result := true;

xpit := abs(r.Left - r.Right);
ypit := abs(r.Top - r.Bottom);

if (abs(p.X - r.Left) > xpit)
or (abs(p.X - r.Right) > xpit)
or (abs(p.Y - r.Top) > ypit)
or (abs(p.Y - r.Bottom) > ypit)
  then result := false;
end;

// huom! ruudukko on myöh. yleisempää tyyppiä TRuudukko
function TApu.etsiNPituinenSuoraMatriisista(const merk : TMerkki;
  const n, xCoord, yCoord : integer; const taul : array of AlkioRivi) : boolean;

  // rekursiivinen funktio, joka tutkii "syvyyden" määriteltyyn suuntaan ja palauttaa sen
  function tutkiPituus(const x, y, dx, dy : integer; const merk : TMerkki;
  const taul : array of AlkioRivi) : integer;
  var seurX,seurY: integer;
  begin
  result := 0;

  seurX := x+dx;
  seurY := y+dy;

  //tarkistetaan ollaanko ylitetty taulukon rajoja
  if (seurX >= Length(taul))    or
     (seurY >= Length(taul[0])) or
     (seurX < 0)                or
     (seurY < 0)                then exit;

  //mahd. poikkeuksien varalta
  try
    // tutkitaan täsmääkö
    if (merk = taul[seurX][seurY].merkki) then
      result := tutkiPituus(seurX, seurY, dx, dy, merk, taul) + 1;
  except
  end;
  end;

var i, posSyv, negSyv : integer;
begin
result := false;

for i := Low(muunnosmatriisi) to High(muunnosmatriisi) do 
  begin
  posSyv := tutkiPituus(xCoord, yCoord, muunnosmatriisi[i][0],
            muunnosmatriisi[i][1], merk, taul);
  negSyv := tutkiPituus(xCoord, yCoord, -muunnosmatriisi[i][0],
            -muunnosmatriisi[i][1], merk, taul);
  if (posSyv + negSyv + 1 >= n) then
    begin
    result := true;
    exit;
    end;
  end;
end;

function TApu.makeRect(const height, width: integer): TRect;
var rect : TRect;
begin
rect.Left := 0;
rect.Top := 0;
rect.Right := width;
rect.Bottom := height;

result := rect;
end;

//gradientit voisi yleistää myös vinoiksi

procedure TApu.horizontalGradient(const c: TCanvas; const height, width : integer;
const upColor, downColor: TColor);
begin
horizontalGradient(c, makeRect(height,width), upColor, downColor);
end;

procedure TApu.horizontalGradient(const c: TCanvas; const rect: TRect;
  const upColor, downColor: TColor);
var percent, percentPerPixel : extended; i : integer; xPoints, yPoints : TPoint;
begin
xPoints         := maxAndMin(rect.Right,rect.Left);
Ypoints         := maxAndMin(rect.Bottom,rect.Top);

percent         := 0;
percentPerPixel := 100 / (yPoints.X-yPoints.Y);

for i := yPoints.Y to yPoints.X do
  begin
  c.Pen.Color := alphaBlend(upColor, downColor,percent);
  c.MoveTo(xPoints.Y,i);
  c.LineTo(xPoints.X,i);
  percent := percent + percentPerPixel;;
  end;
end;

procedure TApu.verticalGradient(const c: TCanvas; const height,
  width: integer; const leftColor, rightColor: TColor);
begin
verticalGradient(c, makeRect(height,width), leftColor, rightColor);
end;

procedure TApu.verticalGradient(const c: TCanvas; const rect: TRect;
  const leftColor, rightColor: TColor);
var percent, percentPerPixel : extended; i : integer; xPoints, yPoints : TPoint;
begin
xPoints         := maxAndMin(rect.Right,rect.Left);
Ypoints         := maxAndMin(rect.Bottom,rect.Top);

percent         := 0;
percentPerPixel := 100 / (Rect.Right-Rect.Left);

for i := xPoints.Y to xPoints.X do
  begin
  c.Pen.Color := alphaBlend(leftColor, rightColor,percent);
  c.MoveTo(i,yPoints.Y);
  c.LineTo(i,yPoints.X);
  percent := percent + percentPerPixel;;
  end;
end;

function TApu.hypotenuseLenght(const a, b: extended): extended;
begin
result := Sqrt(exp(2,a) + exp(2,b));
end;

procedure TApu.roundGradient(const c : TCanvas; const height, width : integer;
  const centerColor, cornerColor : TColor);
begin
roundGradient(c, makeRect(height,width), centerColor, cornerColor);
end;

procedure TApu.roundGradient(const c: TCanvas; const rect: TRect;
  const centerColor, cornerColor: TColor);
var percent, percentPerPixel : extended;
i, centerx, centery, centerToCorner, rectWidth, rectHeight : integer;
xPoints, yPoints : TPoint;
begin
xPoints := maxAndMin(rect.Right,rect.Left);
Ypoints := maxAndMin(rect.Bottom,rect.Top);

percent         := 0;
rectWidth       := xPoints.X-xPoints.Y;
rectHeight      := yPoints.X-yPoints.Y;
centerToCorner  :=  Round(hypotenuseLenght(rectWidth,rectHeight)/2);
percentPerPixel := 100 / centerToCorner;
centerx         := Round(rectWidth/2)  + xPoints.Y;
centery         := Round(rectHeight/2) + yPoints.Y;

for i := centerToCorner downto 0 do
  begin
  c.Pen.Color := alphaBlend(cornerColor, centerColor,percent);
  c.Brush.Color := alphaBlend(cornerColor, centerColor,percent);
  c.Ellipse(centerx+i,centery+i,centerx-i,centery-i);
  percent := percent + percentPerPixel;;
  end;
end;

function TApu.maxAndMin(const i, j: integer): TPoint;
var p : TPoint;
begin
if (i >= j) then
  begin
  p.X := i;
  p.Y := j;
  end
else
  begin
  p.X := j;
  p.Y := i;
  end;

result := p;
end;