![Graphische Funktionen [VCL]](https://www.elitepvpers.com/forum/iconimages/coding-releases/graphische-funktionen-vcl_ltr.gif){kind=small}
Im Zuge eines projektes habe ich ein paar funktionen geschrieben, und ich denke die können noch andere leute gebrauchen.
Geschrieben ist es in delphi, die funktionen lassen sich aber auch mit dem Rad Studio in C++ verwenden
Sollte schon ab D5 gehen, da es allerdings die PNGImage Komponente verwendet geht es nur wenn die installiert ist (standartmäßig ab 09 glaub ich)
die Funktionen sind:
DrawOnCanvas: Zeichnet ein Bild (TPicture) auf ein Canvas Objekt, mit verschiedenen anzeige möchlichkeiten (Zentriert, gestreckt, gezoomt, gefüllt, wiederholend X, wiederholendy, wiederohlendXY)
FileMD5: Gibt dem Hash einer Datei zurück, super zum überprüfen ob sich eine datei in der zwischenzeit geändert hat
GreyAndDarkenPicture: Diese funktion ändert die Helligkeit und die Sättigung eines TPictures (Nach HSV-Farbraum)
RGBToHSV und HSVToRGB: Konvertierung zwischen den Farbschemen, funktionen nicht von mir, nur von mir angepasst
DrawTextOnWindow, DrawTextOnDesktop: Schreibt einen Text auf den Bildschirm oder auf ein Fenster (Fenstertitel muss angegeben werden)
DrawOnWindow, DrawOnDesktop: Zeichnet ein TPicture auf bildschirm oder auf ein anderes Fenster
SetOpacity: Reduziert die Opacity von einem TPicture
Hinweise:
Verwendet man GreyAndDarkenPicture sowie die HSV Convertierung so wird der Alpha kanal von Png bildern auf 1bit gesetzt-> Nur noch tranzparent, oder farbig, nix mehr dazwischen
Selbiges gilt bei DrawOnCanvas, wenn Smooth aktiviert ist.
Ohne smooth bleibt der Alpha kanal zwar erhalten, aber beim skalieren verschlächtert sich die Qualität
Bei den DrawTextOn und DrawOn methoden bleibt das gezeichnete nur solange erhalten bis sich der hintergrund hinter dem gezeichneten ändert, danach verschwindet das gezeichnete
SetOpacity: funktioniert erst beim 2ten aufruf im testprogramm
Hier die Unit mit den Funktionen:
PHP Code:
unit GraphicalFunctions;
interface
uses Windows, SysUtils, Classes, Graphics, Controls, Jpeg, PngImage,
idHashMessageDigest, Dialogs, Math;
type
PRow=^TRow;
TRow=array[0..(High(Integer)-10) div Sizeof(TRGBTriple)] of TRGBTriple;
TImageMode = (imStrech, imZoom, imCenter, imRepeatX, imRepeatY, imRepeatXY, imFill);
THSVColor = record
Hue: Integer;
Value: Byte;
Saturation: Byte;
end;
function GetCanvasHandle(var p: TPicture): Integer;
procedure DrawOnCanvas(Canvas: TCanvas; Smooth: Boolean; PicToDraw: TPicture;
DrawMode: TImageMode; Width, Height: Integer; Offset: TPoint);
function FileMD5(const fileName : string) : string;
procedure GreyAndDarkenPicture(P: TPicture; GreyVal, DarkVal: Real);
function RGBtoHSV(Red, Green, Blue: Byte): THSVColor;
function HSVtoRGB(HSV: THSVColor):TColor;
function ColToRGBTriple(const Color: TColor): TRGBTriple;
procedure DrawTextOnDesktop(Text: string; X, Y: Integer; F: TFont);
procedure DrawOnDesktop(P: TPicture; Pos: TRect; Smooth: Boolean);
procedure DrawTextOnWindow(Text, Window: string; X, Y: Integer; F: TFont);
procedure DrawOnWindow(P: TPicture; Window: string; Pos: TRect; Smooth: Boolean);
procedure SetOpacity(P: TPicture; Opacity: Byte);
implementation
function GetCanvasHandle(var p: TPicture): Integer;
var tmpbmp: TBitmap;
g:TGraphic;
begin
Result:=-1;
g:=p.Graphic;
if g is TBitmap then
Result:=TBitmap(g).Canvas.Handle
else if g is TPngImage then
Result:=TPngImage(g).Canvas.Handle
else if g is TJPEGImage then
begin
tmpbmp:=TBitmap.Create;
try
tmpbmp.Assign(TJPEGImage(g));
p.Graphic:=tmpbmp;
Result:=tmpbmp.Canvas.Handle;
finally
tmpbmp.Free;
end;
end;
end;
procedure DrawOnCanvas(Canvas: TCanvas; Smooth: Boolean; PicToDraw: TPicture;
DrawMode: TImageMode; Width, Height: Integer; Offset: TPoint);
var newW, newH: Integer;
i, x: Integer;
begin
SetStretchBltMode(Canvas.Handle, HALFTONE);
if Assigned(PicToDraw) then
begin
case DrawMode of
imStrech:
begin
if (GetCanvasHandle(PicToDraw)<>-1) And Smooth then
StretchBlt(Canvas.Handle, Offset.X, Offset.Y, Width, Height, GetCanvasHandle(PicToDraw), 0, 0,
PicToDraw.Width, PicToDraw.Height, SRCCOPY)
else
Canvas.StretchDraw(Rect(Offset.X, Offset.Y, Width+ Offset.X, Height + Offset.Y), PicToDraw.Graphic);
end;
imZoom:
begin
if PicToDraw.Width / Width>PicToDraw.Height / Height then
begin
newW:=Width;
newH:=round(PicToDraw.Height/(PicToDraw.Width / Width));
end
else
begin
newH:=Height;
newW:=round(PicToDraw.Width/(PicToDraw.Height / Height));
end;
if (GetCanvasHandle(PicToDraw)<>-1) And Smooth then
StretchBlt(Canvas.Handle, Width div 2 - newW div 2 + Offset.X, Height div 2 - newH div 2 + Offset.Y, newW, newH, GetCanvasHandle(PicToDraw), 0, 0,
PicToDraw.Width, PicToDraw.Height, SRCCOPY)
else
Canvas.StretchDraw(Rect(Width div 2 -newW div 2 + Offset.X, Height div 2 -newH div 2 + Offset.Y, newW+Width div 2 -newW div 2 + Offset.X, newH + Height div 2 -newH div 2 + Offset.Y), PicToDraw.Graphic);
end;
imCenter:
begin
Canvas.Draw(Width div 2 - PicToDraw.Width div 2 + Offset.X,Height div 2 - PicToDraw.Height div 2 + Offset.Y, PicToDraw.Graphic);
end;
imFill:
begin
if PicToDraw.Width / Width<PicToDraw.Height / Height then
begin
newW:=Width;
newH:=round(PicToDraw.Height/(PicToDraw.Width / Width));
end
else
begin
newH:=Height;
newW:=round(PicToDraw.Width/(PicToDraw.Height / Height));
end;
if (GetCanvasHandle(PicToDraw)<>-1) And Smooth then
StretchBlt(Canvas.Handle, Width div 2 - newW div 2 + Offset.X, Height div 2 - newH div 2 + Offset.Y, newW, newH, GetCanvasHandle(PicToDraw), 0, 0,
PicToDraw.Width, PicToDraw.Height, SRCCOPY)
else
Canvas.StretchDraw(Rect(Width div 2 -newW div 2 + Offset.X, Height div 2 -newH div 2 + Offset.Y, newW+Width div 2 -newW div 2 + Offset.X, newH + Height div 2 -newH div 2 + Offset.Y), PicToDraw.Graphic);
end;
imRepeatX..imRepeatXY:
begin
for i := Offset.X to Width div PicToDraw.Width+Offset.X do
begin
if DrawMode<>imRepeatY then
Canvas.Draw(i*PicToDraw.Width, 0, PicToDraw.Graphic);
if DrawMode<>imRepeatX then
for x := Offset.Y to Height div PicToDraw.Height+Offset.Y do
if DrawMode=imRepeatXY then
Canvas.Draw(i*PicToDraw.Width, x*PicToDraw.Height, PicToDraw.Graphic)
else
Canvas.Draw(0, x*PicToDraw.Height, PicToDraw.Graphic);
end;
end;
end;
end;
end;
function FileMD5(const fileName : string) : string;
var
MD5 : TIdHashMessageDigest5;
FileStream: TFileStream;
begin
MD5 := TIdHashMessageDigest5.Create;
FileStream := TFileStream.Create(fileName, fmOpenRead OR fmShareDenyWrite) ;
try
result := MD5.HashStreamAsHex(FileStream);
finally
FileStream.Free;
MD5.Free;
end;
end;
procedure GreyAndDarkenPicture(P: TPicture; GreyVal, DarkVal: Real);
var
y, x: Integer;
Row: ^TRGBTriple;
hsv: THSVColor;
bmp: TBitmap;
begin
if Assigned(P.Graphic) then
begin
bmp:=TBitmap.Create;
try
bmp.PixelFormat := pf24bit;
bmp.Assign(TJPEGImage(P.Graphic));
for y := 0 to bmp.Height - 1 do
begin
Row:=bmp.ScanLine[y];
for x := 0 to bmp.Width - 1 do
begin
hsv:=RGBtoHSV(row^.rgbtRed, row^.rgbtGreen, row^.rgbtBlue);
hsv.Saturation:=Max(round(hsv.Saturation-hsv.Saturation/100*GreyVal), 0);
hsv.Value:=Max(round(hsv.Value-hsv.Value/100*DarkVal), 0);
row^:=ColToRGBTriple(HSVtoRGB(hsv));
inc(Row);
end;
end;
P.Bitmap.Assign(bmp);
finally
bmp.Free;
end;
end;
end;
function ColToRGBTriple(const Color: TColor): TRGBTriple;
begin
result.rgbtRed := Color and $FF;
result.rgbtGreen := (Color shr 8) and $FF;
Result.rgbtBlue := (Color shr 16) and $FF;
end;
//abgeändert von http://www.delphipraxis.net/42054-rgb-hsv-und-hsv-rgb.html
function RGBtoHSV(Red, Green, Blue: Byte): THSVColor;
var Hue: Integer;
var Saturation, Value: Byte;
var
Maximum, Minimum: Byte;
Rc, Gc, Bc: Single;
H: Single;
begin
Maximum := Max(Red, Max(Green, Blue));
Minimum := Min(Red, Min(Green, Blue));
Value := Maximum;
if Maximum <> 0 then
Saturation := MulDiv(Maximum - Minimum, 255, Maximum)
else
Saturation := 0;
if Saturation = 0 then
Hue := 0 // arbitrary value
else
begin
Assert(Maximum <> Minimum);
Rc := (Maximum - Red) / (Maximum - Minimum);
Gc := (Maximum - Green) / (Maximum - Minimum);
Bc := (Maximum - Blue) / (Maximum - Minimum);
if Red = Maximum then
H := Bc - Gc
else if Green = Maximum then
H := 2 + Rc - Bc
else
begin
Assert(Blue = Maximum);
H := 4 + Gc - Rc;
end;
H := H * 60;
if H < 0 then
H := H + 360;
Hue := Round(H);
end;
result.Hue:=Hue;
Result.Value:=Value;
Result.Saturation:=Saturation;
end;
//abgeändert von http://www.delphipraxis.net/42054-rgb-hsv-und-hsv-rgb.html
function HSVtoRGB(HSV: THSVColor):TColor;
var
H:Integer;
S, V: Byte;
ht, d, t1, t2, t3:Integer;
R,G,B:Word;
begin
h:=HSV.Hue;
S:=HSV.Saturation;
V:=HSV.Value;
if S = 0 then
begin
R := V; G := V; B := V;
end
else
begin
ht := H * 6;
d := ht mod 360;
t1 := round(V * (255 - S) / 255);
t2 := round(V * (255 - S * d / 360) / 255);
t3 := round(V * (255 - S * (360 - d) / 360) / 255);
case ht div 360 of
0:
begin
R := V; G := t3; B := t1;
end;
1:
begin
R := t2; G := V; B := t1;
end;
2:
begin
R := t1; G := V; B := t3;
end;
3:
begin
R := t1; G := t2; B := V;
end;
4:
begin
R := t3; G := t1; B := V;
end;
else
begin
R := V; G := t1; B := t2;
end;
end;
end;
Result:=RGB(R,G,B);
end;
procedure DrawOnWindow(P: TPicture; Window: string; Pos: TRect; Smooth: Boolean);
var c: TCanvas;
begin
c:=TCanvas.Create;
try
c.Handle:=GetWindowDC(FindWindow(nil, PChar(Window)));
DrawOnCanvas(c, Smooth, P, imZoom, Pos.Right-Pos.Left, Pos.Bottom-Pos.Top,
Point(Pos.Left, Pos.Top));
finally
c.Free;
end;
end;
procedure DrawTextOnWindow(Text, Window: string; X, Y: Integer; F: TFont);
var c: TCanvas;
begin
c:=TCanvas.Create;
try
c.Handle:=GetWindowDC(FindWindow(nil, PChar(Window)));
if Assigned(F) then
c.Font:=F;
c.TextOut(X, Y, Text);
finally
c.Free;
end;
end;
procedure DrawOnDesktop(P: TPicture; Pos: TRect; Smooth: Boolean);
var c: TCanvas;
begin
c:=TCanvas.Create;
try
c.Handle:=GetWindowDC(GetDesktopWindow);
DrawOnCanvas(c, Smooth, P, imZoom, Pos.Right-Pos.Left, Pos.Bottom-Pos.Top,
Point(Pos.Left, Pos.Top));
finally
c.Free;
end;
end;
procedure DrawTextOnDesktop(Text: string; X, Y: Integer; F: TFont);
var c: TCanvas;
begin
c:=TCanvas.Create;
try
c.Handle:=GetWindowDC(GetDesktopWindow);
if Assigned(F) then
c.Font:=F;
c.TextOut(X, Y, Text);
finally
c.Free;
end;
end;
procedure SetOpacity(P: TPicture; Opacity: Byte);
var tmpbmp: TBitmap;
begin
tmpbmp:=TBitmap.Create;
try
tmpbmp.SetSize(P.Graphic.Width, P.Graphic.Height);
tmpbmp.PixelFormat:=pf24bit;
tmpbmp.Canvas.Draw(0,0, P.Graphic, Opacity);
P.Graphic:=(tmpbmp);
finally
tmpbmp.Free;
end;
end;
end.
