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;