Как сделать калькулятор в Delphi?
Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Как Delphi реализует многоплатформенную разработку?
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...
Скопировать и вставить Bitmap из буфера
{
In order to run this example you will need the GR32 Unit from the package
http://www.g32.org/files/graphics32/graphics32-1_5_1.zip
to run this example.
}
unit EG_ClipboardBitmap32;
{
Author William Egge. egge@eggcentric.com
January 17, 2002
Compiles with ver 1.2 patch #1 of Graphics32
This unit will copy and paste Bitmap32 pixels to the clipboard and retain the
alpha channel.
The clipboard data will still work with regular paint programs because this
unit adds a new format only for the alpha channel and is kept seperate from
the regular bitmap storage.
}
interface
uses
ClipBrd, Windows, SysUtils, GR32;
procedure
CopyBitmap32ToClipboard(const
Source: TBitmap32);
procedure
PasteBitmap32FromClipboard(const
Dest: TBitmap32);
function
CanPasteBitmap32: Boolean;
implementation
const
RegisterName = 'G32 Bitmap32 Alpha Channel';
GlobalUnlockBugErrorCode = ERROR_INVALID_PARAMETER;
var
FAlphaFormatHandle: Word = 0;
procedure
RaiseSysError;
var
ErrCode: LongWord;
begin
ErrCode := GetLastError();
if
ErrCode <> NO_ERROR then
raise
Exception.Create(SysErrorMessage(ErrCode));
end
;
function
GetAlphaFormatHandle: Word;
begin
if
FAlphaFormatHandle = 0 then
begin
FAlphaFormatHandle := RegisterClipboardFormat(RegisterName);
if
FAlphaFormatHandle = 0 then
RaiseSysError;
end
;
Result := FAlphaFormatHandle;
end
;
function
CanPasteBitmap32: Boolean;
begin
Result := Clipboard.HasFormat(CF_BITMAP);
end
;
procedure
CopyBitmap32ToClipboard(const
Source: TBitmap32);
var
H: HGLOBAL;
Bytes: LongWord;
P, Alpha: PByte;
I: Integer;
begin
Clipboard.Assign(Source);
if
not
OpenClipboard(0) then
RaiseSysError
else
try
Bytes := 4 + (Source.Width * Source.Height);
H := GlobalAlloc(GMEM_MOVEABLE and
GMEM_DDESHARE, Bytes);
if
H = 0 then
RaiseSysError;
P := GlobalLock(H);
if
P = nil
then
RaiseSysError
else
try
PLongWord(P)^ := Bytes - 4;
Inc(P, 4);
// Copy Alpha into Array
Alpha := Pointer(Source.Bits);
Inc(Alpha, 3); // Align with Alpha
for
I := 1 to
(Source.Width * Source.Height) do
begin
P^ := Alpha^;
Inc(Alpha, 4);
Inc(P);
end
;
finally
if
(not
GlobalUnlock(H)) then
if
(GetLastError() <> GlobalUnlockBugErrorCode) then
RaiseSysError;
end
;
SetClipboardData(GetAlphaFormatHandle, H);
finally
if
not
CloseClipboard then
RaiseSysError;
end
;
end
;
procedure
PasteBitmap32FromClipboard(const
Dest: TBitmap32);
var
H: HGLOBAL;
ClipAlpha, Alpha: PByte;
I, Count, PixelCount: LongWord;
begin
if
Clipboard.HasFormat(CF_BITMAP) then
begin
Dest.BeginUpdate;
try
Dest.Assign(Clipboard);
if
not
OpenClipboard(0) then
RaiseSysError
else
try
H := GetClipboardData(GetAlphaFormatHandle);
if
H <> 0 then
begin
ClipAlpha := GlobalLock(H);
if
ClipAlpha = nil
then
RaiseSysError
else
try
Alpha := Pointer(Dest.Bits);
Inc(Alpha, 3); // Align with Alpha
Count := PLongWord(ClipAlpha)^;
Inc(ClipAlpha, 4);
PixelCount := Dest.Width * Dest.Height;
Assert(Count = PixelCount,
'Alpha Count does not match Bitmap pixel Count, PasteBitmap32FromClipboard(const Dest: TBitmap32);');
// Should not happen, but if it does then this is a safety catch.
if
Count > PixelCount then
Count := PixelCount;
for
I := 1 to
Count do
begin
Alpha^ := ClipAlpha^;
Inc(Alpha, 4);
Inc(ClipAlpha);
end
;
finally
if
(not
GlobalUnlock(H)) then
if
(GetLastError() <> GlobalUnlockBugErrorCode) then
RaiseSysError;
end
;
end
;
finally
if
not
CloseClipboard then
RaiseSysError;
end
;
finally
Dest.EndUpdate;
Dest.Changed;
end
;
end
;
end
;
end
.
// Example Call:
{uses
JPEG;}
procedure
TForm1.Button1Click(Sender: TObject);
var
bmp: TBitmap32;
begin
bmp := TBitmap32.Create;
try
bmp.LoadFromFile('C: est.jpg');
CopyBitmap32ToClipboard(bmp);
finally
bmp.Free;
end
;
end
;