Часто задаваемые вопросы по Delphi

Как копировать и вставлять Bitmap через буфер обмена?

Некоторые функции для копирования и вставки Bitmap-объектов через буфер обмена.

function CopyClipToBuf(DC: HDC; Left, Top,
Width, Height: Integer; Rop: LongInt;
var CopyDC: HDC;
var CopyBitmap: HBitmap): Boolean;
var
TempBitmap: HBitmap;
begin
Result := False;
CopyDC := 0;
CopyBitmap := 0;
if DC <> 0 then
begin
CopyDC := CreateCompatibleDC(DC);
if CopyDC <> 0 then
begin
CopyBitmap := CreateCompatibleBitmap(DC,
Width, Height);
if CopyBitmap <> 0 then
begin
TempBitmap := CopyBitmap;
CopyBitmap := SelectObject(CopyDC,
CopyBitmap);
Result := BitBlt(CopyDC, 0, 0,
Width, Height, DC,
Left, Top, Rop);
CopyBitmap := TempBitmap;
end;
end;
end;
end;
function CopyBufToClip(DC: HDC; var CopyDC: HDC;
var CopyBitmap: HBitmap;
Left, Top, Width, Height: Integer;
Rop: LongInt; DeleteObjects: Boolean): Boolean;
var
TempBitmap: HBitmap;
begin
Result := False;
if (DC <> 0) and
(CopyDC <> 0) and
(CopyBitmap <> 0) then
begin
TempBitmap := CopyBitmap;
CopyBitmap := SelectObject(DC, CopyBitmap);
Result := BitBlt(DC, Left, Top,
Width, Height, CopyDC,
0, 0, Rop);
CopyBitmap := TempBitmap;
if DeleteObjects then
begin
DeleteDC(CopyDC);
DeleteObject(CopyBitmap);
end;
end;
end;

Как выяснить положение курсора в МЕМО?

Необходимо вызвать дважды API-функцию "SendMessage":

var
xChr,
xRow,
xCol: LongInt;
...
xRow := SendMessage(Memo1.Handle, EM_LINEFROMCHAR, Memo1.SelStart, 0);
xChr := SendMessage(Memo1.Handle, EM_LINEINDEX, Zeile, 0);
xCol := Memo1.SelStart - xChr + 1;

Как узнать содержание активной записи в БД?

Следующая функция возвращает в виде указателя на строку содержание активной записи в БД.

function TBDEDirect.GetCurRecord(Lock: DBILockType): PChar;
var
Res: DBIResult;
RecSize: Word;
RecBuf: PChar;
Bookmark: TBookmark;
begin
Result := StrNew('');
if CheckDatabase then
begin
RecSize := GetPhysicalRecSize;
RecBuf := StrAlloc(RecSize+1);
FillChar(RecBuf^, RecSize+1, #0);
Bookmark := FDataLink.DataSource.DataSet.GetBookmark;
DbiSetToBookmark(FDataLink.DataSource.DataSet.Handle,
Bookmark);
FDataLink.DataSource.DataSet.FreeBookmark(Bookmark);
Res := DbiGetRecord(FDataLink.DataSource.DataSet.Handle,
Lock, RecBuf, nil);
if Res = 0 then
Result := RecBuf
else
Check(Res);
end;
end;

Как создать и использовать новую форму курсора?

   Для этого необходимо создать новый курсор(ы) в подходящем для этого редакторе ресурсов (например борландовский Resource Workshop). При этом надо обратить внимание на то что имена в редакторе ресурсов (особенно в том, который поставляется с Delphi) надо писать заглавными буквами. После этого "перед внутренним употреблением" (лучше всего в процедуре обработки события OnCreate главной формы) необходимо загрузить курсор(ы) из res-файла как указано ниже:

{$I CURSOR.RES}
Screen.Cursors[1] := LoadCursor(hInstance, 'CURSOR_1');
Button1.Cursor := 1;

   Обратите внимание на то, что системные курсоры в Screen.Cursors начинаются с нуля и идут в минусовом направлении. Поэтому при создании новых курсоров лучше выбирать положительные числа (лучше не слишком большие :-)).

Более удобный вариант - это объявить постоянную (равную например 12):

const
CUR_HAND = 12;
...
Screen.Cursors[CUR_HAND] := LoadCursor(hInstance, 'CURSOR_HAND');
Button1.Cursor := CUR_HAND;

Как выяснить дату последнего изменения файла?

Для выяснения даты последнего изменения файла можно воспользоваться следующей функцией:

function GetFileDate(FileName: string): string;
var
FHandle: Integer;
begin
FHandle := FileOpen(FileName, 0);
try
Result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle)));
finally
FileClose(FHandle);
end;
end;

Как проверять корректность доступа к базе данных?

   Следующая функция проверяет доступ к базе данных и выдает возможные причины, если доступ не удается осуществить. Функция возвращает значение True в случае успешной операции и False в противном случае.

function TBDEDirect.CheckDatabase: Boolean;
var
DS: TDataSource;
begin
Result := False;
DS := GetDataSource;
if DS = nil then
begin
MessageDlg('Не установлена связь с элементом-источником данных.'+
'Проверьте установку свойства DataSource.',
mtError, [mbOK], 0);
Exit;
end;
if DS.DataSet = nil then
begin
MessageDlg('Доступ к базе данных невозможен.', mtError,
[mbOK], 0);
Exit;
end;
if TDBDataSet(DS.DataSet).Database = nil then
begin
MessageDlg('Доступ к базе данных невозможен.', mtError,
[mbOK], 0);
Exit;
end;
if TDBDataSet(DS.DataSet).Database.Handle = nil then
begin
MessageDlg('Дескриптор (Handle) БД недоступен.', mtError,
[mbOK], 0);
Exit;
end;
if DS.DataSet.Handle = nil then
begin
MessageDlg('Дескриптор курсора (Cursor-Handle) недоступен.', mtError,
[mbOK], 0);
Exit;
end;
Result := True;
end;