Registriert seit: 1. Feb 2018
3.691 Beiträge
Delphi 11 Alexandria
|
AW: Screenshot like Snipping Tool
17. Okt 2022, 23:21
Nun habe ich mal das Github ausprobiert, es sind 2 total unterschiedliche Projekte gegenüber der Webseite.
Das von CodeProject, damit komme ich irgendwie so gar nicht klar.
Das vom Github war sehr einfach zu implementieren so das es erstmal überhaupt was macht
Der aktuelle Ist-Zustand:
Delphi-Quellcode:
procedure TkzSnapShot.ScreenShotDWM(const ALeft, ATop, ARight, ABottom: Integer);
var
Index: Integer;
BMP: TBitmap;
lpPal: PLogPalette;
begin
// MessageBox(0, 'DWM', 'DWM', MB_OK);
FSuccess := False;
FRect.Left := ALeft;
FRect.Top := ATop;
FRect.Right := ARight;
FRect.Bottom := ABottom;
FImageWidth := FRect.Right - FRect.Left;
FImageHeight := FRect.Bottom - FRect.Top;
BMP := TBitmap.Create;
try
if FDuplication.GetFrame then
begin
FDuplication.DrawFrame(BMP);
with BMP.Canvas do
begin
Pen.Color := clRed;
Brush.Style := bsClear;
for Index := 0 to FDuplication.DirtyCount - 1 do
begin
{$POINTERMATH ON}
with FDuplication.DirtyRects[Index] do
Rectangle(Left, Top, Right, Bottom);
end;
end;
FBMP := TBitmap.Create;
try
FBMP.PixelFormat := TPixelFormat.pf24bit;
FBMP.Width := FImageWidth;
FBMP.Height := FImageHeight;
FCanvas.Handle := BMP.Canvas.Handle;
if FInverted then
begin
FInverted := False;
FBMP.Canvas.CopyMode := cmSrcInvert or CAPTUREBLT;
end
else
FBMP.Canvas.CopyMode := cmSrcCopy or CAPTUREBLT;
FBMP.Canvas.CopyRect(
Rect(0, 0, FImageWidth, FImageHeight),
FCanvas,
Rect(FRect.Left, FRect.Top, FRect.Right, FRect.Bottom));
if (GetDeviceCaps(FCanvas.Handle, RASTERCAPS) and RC_PALETTE = RC_PALETTE) then
begin
GetMem(lpPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)));
FillChar(lpPal^, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)), #0);
lpPal^.palVersion := $300;
lpPal^.palNumEntries := GetSystemPaletteEntries(FCanvas.Handle, 0, 256, lpPal^.palPalEntry);
if (lpPal^.palNumEntries <> 0) then
FBMP.Palette := CreatePalette(lpPal^);
FreeMem(lpPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)));
end;
FBitmap.ReleaseHandle;
FBitmap.Assign(FBMP);
finally
FBMP.Free;
FBitmap.Dormant;
FBitmap.FreeImage;
FSuccess := True;
end;
end;
finally
BMP.Free;
end;
if (FSuccess and FAutoClipboard) then
CopyToClipboard;
end;
|
|
Zitat
|