Как очистить canvas

procedureTForm1.Button1Click(Sender: TObject);
begin
PatBlt(Form1.Canvas.Handle,0,0,Form1.ClientWidth,Form1.ClientHeight,WHITENESS);
end;

Взято с Исходников.ru

Canvas.Brush.Color := ClWhite;
Canvas.FillRect(Canvas.ClipRect);

InValidateRect(Canvas.handle,NIL,True);
(или взамен передать дескриптор компонента)

Взято из

Как очистить кэш в IE?

В примере описывается как программно в Internet Explorer нажать кнопку "Clear cache".

Вам нужно будет использовать WinINet в Вашей TfrmMain:

Uses WinINet;

и добавить к TButton следующий обработчик btnEmptyCache:

Procedure TfrmMain.btnEmptyCacheClick( Sender : TObject );
Var
    lpEntryInfo : PInternetCacheEntryInfo;
    hCacheDir   : LongWord;
    dwEntrySize : LongWord;
    dwLastError : LongWord;
Begin
    dwEntrySize := 0;
    FindFirstUrlCacheEntry( NIL, TInternetCacheEntryInfo( NIL^ ), dwEntrySize );
    GetMem( lpEntryInfo, dwEntrySize );
    hCacheDir := FindFirstUrlCacheEntry( NIL, lpEntryInfo^, dwEntrySize );
    If ( hCacheDir <> 0 ) Then
        DeleteUrlCacheEntry( lpEntryInfo^.lpszSourceUrlName );
    FreeMem( lpEntryInfo );
    Repeat
        dwEntrySize := 0;
        FindNextUrlCacheEntry( hCacheDir, TInternetCacheEntryInfo( NIL^ ), dwEntrySize );
        dwLastError := GetLastError();
        If ( GetLastError = ERROR_INSUFFICIENT_BUFFER ) Then Begin
            GetMem( lpEntryInfo, dwEntrySize );
            If ( FindNextUrlCacheEntry( hCacheDir, lpEntryInfo^, dwEntrySize ) ) Then
                DeleteUrlCacheEntry( lpEntryInfo^.lpszSourceUrlName );
            FreeMem(lpEntryInfo);
        End;
    Until ( dwLastError = ERROR_NO_MORE_ITEMS );
End;

Взято с Исходников.ru

Как очистить пункт меню Документы кнопки Пуск?

Вызовите Windows API функцию SHAddToRecentDocs() передав nil вместо имени файла в качестве параметра.

uses ShlOBJ;

procedure TForm1.Button1Click(Sender: TObject);
begin
SHAddToRecentDocs(SHARD_PATH, nil);
end;

Взято с Исходников.ru

Как очистить все окошки редактирования на форме?

procedure ClearEdits;
var i : Integer;
begin
for i := 0 to ComponentCount-1 do
if (Components[i] is TEdit) then
(Components[i] as TEdit).Text := '';
end;

Взято с Исходников.ru

Как ограничить длинну вводимого текста шириной TEdit'а?

Как ограничить длинну текста, вводимого в TEdit, так чтобы ширина текста не превышала
ширину TEdit'а?

В примере приведено два способа ограничить длинну текста в TEdit так чтобы она не превышала ширину клиентской области окна TEdit'а и не появлялась прокрутка текста. Первый способ устанавливает свойство TEdit'а MaxLength равным числу букв "W", которые поместятся в TEdit. "W" выбрана потому, что является, наверное, самой широкой буквой в любом шрифте. Этот метод сносно работает для шрифтов с фиксированной шириной букв, но для шрифтов с переменной шириной букв вряд ли сгодится. Второй способ перхватывает событие KeyPress TEdit'а и измеряет ширину уже введенного текста и ширину нового символа. Если ширина больше чем клиентская область TEdit'а новый символ отбрасывается и вызывается MessageBeep.

procedure TForm1.FormCreate(Sender: TObject);
var
  cRect: TRect;
  bm: TBitmap;
  s: string;
begin
  Windows.GetClientRect(Edit1.Handle, cRect);
  bm := TBitmap.Create;
  bm.Width := cRect.Right;
  bm.Height := cRect.Bottom;
  bm.Canvas.Font := Edit1.Font;
  s := 'W';
  while bm.Canvas.TextWidth(s) < CRect.Right do
    s := s + 'W';
  if length(s) > 1 then
    begin
      Delete(s, 1, 1);
      Edit1.MaxLength := Length(s);
    end;
end;

{Другой вариант}

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
  cRect: TRect;
  bm: TBitmap;
begin
  if ((Ord(Key) <> VK_TAB) and (Ord(Key) <> VK_RETURN) and
    (Ord(Key) <> VK_LEFT) and (Ord(Key) <> VK_BACK)) then
    begin
      Windows.GetClientRect(Edit1.Handle, cRect);
      bm := TBitmap.Create;
      bm.Width := cRect.Right;
      bm.Height := cRect.Bottom;
      bm.Canvas.Font := Edit1.Font;
      if bm.Canvas.TextWidth(Edit1.Text + Key) > CRect.Right then
        begin
          Key := #0;
          MessageBeep(-1);
        end;
      bm.Free;
    end;
end;

Как ограничить движения мышки определённой областью?

Для этого можно воспользоваться API функцией ClipCursor(). Например, можно вставить следующий код в обработчик события формы OnMouseDown:
ClipCursor(&BoundsRect);

а следующий код в обработчик события формы OnMouseUp:
ClipCursor(NULL);

Если нажать кнопку мыши на форме и удерживать её, то курсор мышки не сможет покинуть пределы формы.

Взято с Исходников.ru

Как округлять до сотых в большую сторону?

Прибавляешь 0.5 затем отбрасываешь дробную часть:

Uses Math;

Function RoundMax(Num:real; prec:integer):real;
begin
  result:=roundto(num+Power(10, prec-1)*5, prec);
end;

До сотых соответственно будет:

Function RoundMax100(Num:real):real;
begin
  result:=round(num*100+0.5)/100;
end;

Автор ответа: Vit
Взято с Vingrad.ru

Как опеделить состояние списка ComboBox, выпал/скрыт?

Пошлите ComboBox сообщение CB_GETDROPPEDSTATE.

if SendMessage(ComboBox1.Handle, CB_GETDROPPEDSTATE, 0, 0) = 1 then
begin {список ComboBox выпал}

end;

Как оперделить все IP и порты на моем компьютере?

Функции GetTcpTable, GetUdpTable.

Импорт GetTcpTable:

unit TcpTable;
interface
type
  PDWord = ^Longword;
  PMIB_TCPROW = ^TMIB_TCPROW;
  TMIB_TCPROW = record
    dwState: LongWord;
    dwLocalAddr: LongWord;
    dwLocalPort: LongWord;
    dwRemoteAddr: LongWord;
    dwRemotePort: LongWord;
  end;
  PMIB_TCPTABLE = ^TMIB_TCPTABLE;
  TMIB_TCPTABLE = record
    dwNumEntries: LongWord;
    table: array[0..0] of TMIB_TCPROW;
  end;
function GetTcpTable(var TcpTable: PMIB_TCPTABLE; var Size: PDWord; bOrder: Boolean): LongWord; stdcall
implementation
function GetTcpTable; external 'Iphlpapi.dll' name 'GetTcpTable';
end.

Вызов GetTcpTable:

{$R-}
    Entries:=16;
    Sz:=SizeOf(TMIB_TCPTABLE)+SizeOf(TMIB_TCPROW)*(Entries-1);
    pMibTable:=nil;
    try
     repeat
       ReallocMem(pMibTable,Sz);
       Res:=GetTcpTable(pMibTable^,Sz,False);
     until Res <> ERROR_INSUFFICIENT_BUFFER;
     if Res <> NO_ERROR then
      begin
       ShowMessage(SysErrorMessage(Res));
       exit;
      end;
     for Entries:=0 to pMibTable.dwNumEntries-1 do
      begin
         <Делать что-то>
      end;
    finally
     FreeMem(pMibTable);
    end;
{$R+}

Автор Spawn

Взято с Vingrad.ru

Как определить bitrate WAV файла?

{....}

  private
    procedure OpenMedia(WaveFile : string);
    function GetStatus(StatusRequested : DWord) : longint;
    procedure CloseMedia;

{....}

var
  MyError, dwFlags: Longint;
  FDeviceID : Word;

{....}

uses
  MMSystem;

{....}

procedure TForm1.OpenMedia(WaveFile: string);
var
  MyOpenParms: TMCI_Open_Parms;
begin
  with MyOpenParms do
  begin
    dwCallback       := Handle; // TForm1.Handle
    lpstrDeviceType  := PChar('WaveAudio');
    lpstrElementName := PChar(WaveFile);
  end; {with MyOpenParms}
  dwFlags := MCI_WAIT or MCI_OPEN_ELEMENT or MCI_OPEN_TYPE;
  MyError := mciSendCommand(0, MCI_OPEN, dwFlags, Longint(@MyOpenParms));
  // one could use mciSendCommand(DevId, here to specify a particular device
  if MyError = 0 then
    FDeviceID := MyOpenParms.wDeviceID
  else
    raise Exception.Create('Open Failed');
end;

function TForm1.GetStatus(StatusRequested: DWORD): Longint;
var
  MyStatusParms: TMCI_Status_Parms;
begin
  dwFlags := MCI_WAIT or MCI_STATUS_ITEM;
  with MyStatusParms do
  begin
    dwCallback := Handle;
    dwItem     := StatusRequested;
  end;
  MyError := mciSendCommand(FDeviceID,
    MCI_STATUS,
    MCI_WAIT or MCI_STATUS_ITEM,
    Longint(@MyStatusParms));
  if MyError = 0 then
    Result := MyStatusParms.dwReturn
  else
    raise Exception.Create('Status call to get status of ' +
      IntToStr(StatusRequested) + ' Failed');
end;

procedure TForm1.CloseMedia;
var
  MyGenParms: TMCI_Generic_Parms;
begin
  if FDeviceID > 0 then
  begin
    dwFlags := 0;
    MyGenParms.dwCallback := Handle; // TForm1.Handle
    MyError := mciSendCommand(FDeviceID, MCI_CLOSE, dwFlags, Longint(@MyGenParms));
    if MyError = 0 then
      FDeviceID := 0
    else
    begin
      raise Exception.Create('Close Failed');
    end;
  end;
end;

//Example:
//Beispiel:

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    OpenMedia(OpenDialog1.FileName);
    with ListBox1.Items do
    begin
      Add('Average Bytes / Sec : ' + IntToStr(GetStatus(MCI_WAVE_STATUS_AVGBYTESPERSEC)));
      Add('Bits / Sample : ' + IntToStr(GetStatus(MCI_WAVE_STATUS_BITSPERSAMPLE)));
      Add('Samples / Sec : ' + IntToStr(GetStatus(MCI_WAVE_STATUS_SAMPLESPERSEC)));
      Add('Channels : ' + IntToStr(GetStatus(MCI_WAVE_STATUS_CHANNELS)));
    end;
    CloseMedia;
  end;
end;
Взято с сайта

Как определить цвет код произвольной точки экрана?

var
DC: HDC;
Color: Cardinal;
begin
DC := CreateDC ('MONITOR', nil, nil, nil);
Color := GetPixel(DC, 300, 300);
DeleteDC(DC);
end;

Автор Baa.
Взято с Vingrad.ru

var
DC: HDC;
Color: Cardinal;
begin
DC :=GetDC(0);
Color := GetPixel(DC, 300, 300);
ReleaseDC(0,DC);
end;

Автор Mikel.
Взято с Vingrad.ru

Как определить графический формат файла (не используя расширение)?

You can determine it without extention. Below is a function that reads the file header and determines the type.

functionPhysicalResolveFileType(AStream: TStream): Integer;
var
  p: PChar;
begin
  Result := 0;
  if not Assigned(AStream) then
    Exit;
  GetMem(p, 10);
  try
    AStream.Position := 0;
    AStream.Read(p[0], 10);
    {bitmap format}
    if (p[0] = #66) and (p[1] = #77) then
      Result := 1;
    {tiff format}
    if ((p[0] = #73) and (p[1] = #73) and (p[2] = #42) and (p[3] = #0)) or
      ((p[0] = #77) and (p[1] = #77) and (p[2] = #42) and (p[3] = #0)) then
      Result := 2;
    {jpg format}
    if (p[6] = #74) and (p[7] = #70) and (p[8] = #73) and (p[9] = #70) then
      Result := 3;
    {png format}
    if (p[0] = #137) and (p[1] = #80) and (p[2] = #78) and (p[3] = #71) and
      (p[4] = #13) and (p[5] = #10) and (p[6] = #26) and (p[7] = #10) then
      Result := 4;
    {dcx format}
    if (p[0] = #177) and (p[1] = #104) and (p[2] = #222) and (p[3] = #58) then
      Result := 5;
    {pcx format}
    if p[0] = #10 then
      Result := 6;
    {emf format}
    if (p[0] = #215) and (p[1] = #205) and (p[2] = #198) and (p[3] = #154) then
      Result := 7;
    {emf format}
    if (p[0] = #1) and (p[1] = #0) and (p[2] = #0) and (p[3] = #0) then
      Result := 7;
  finally
    Freemem(p);
  end;
end;

Взято с

Delphi Knowledge Base

Как определить, изменилось ли системное время?

Следующий пример демонстрирует обработку сообщения WM_TIMECHANGE. Приложение, которое изменяет системное время, посылает сообщение WM_TIMECHANGE всем окнам верхнего уровня.

type
TForm1 = class(TForm)
private
{ Private declarations }
procedure WMTIMECHANGE(var Message: TWMTIMECHANGE); message WM_TIMECHANGE;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMTIMECHANGE(var Message: TWMTIMECHANGE);
begin
Form1.Caption := 'Time Changed';
end;

Взято с Исходников.ru

Как определить, является ли диск NTFS?

uses
  ComObj;

function IsNTFS(AFileName: string): Boolean;
var
  fso, drv: OleVariant;
begin
  IsNTFS := False;
  fso := CreateOleObject('Scripting.FileSystemObject');
  drv := fso.GetDrive(fso.GetDriveName(AFileName));
  IsNTFS := drv.FileSystem = 'NTFS'
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if IsNTFS('X:\Temp\File.doc') then
    ShowMessage('File is on NTFS File System')
  else
    ShowMessage('File is not on NTFS File System')
end;

Взято с сайта

Как определить, является ли метод потомком TNotifyEvent?

If I am given a TPersistent object, and a method name, is there a way to determine if the name is an event of TNotifyEvent type? For example, given a TPersistent lMyObj and an event name, "OnDataChanged", how can I determine if OnDataChanged is a TNotifyEvent?

functionIsNotifyEvent(Sender: TObject; const Event: string): Boolean;
var
  PropInfo: PPropInfo;
  Method: TNotifyEvent;
begin
  Result := False;
  PropInfo := GetPropInfo(Sender.ClassInfo, Event);
  if not Assigned(PropInfo) then
    Exit;
  if PropInfo.PropType^.Kind <> tkMethod then
    Exit;
  Method := TNotifyEvent(GetMethodProp(Sender, PropInfo));
  Result := Assigned(Method);
end;

Tip by Jack Sudarev

Взято из

Как определить какие приложения уже запущены?

procedure TForm1.Button1Click(Sender: TObject);
VAR
Wnd : hWnd;
buff: ARRAY [0..127] OF Char;
begin
ListBox1.Clear;
Wnd := GetWindow(Handle, gw_HWndFirst);
WHILE Wnd <> 0 DO
BEGIN {Не показываем:}
IF (Wnd <> Application.Handle) AND {-Собственное окно}
IsWindowVisible(Wnd) AND {-Невидимые окна}
(GetWindow(Wnd, gw_Owner) = 0) AND {-Дочернии окна}
(GetWindowText(Wnd, buff, sizeof(buff)) <> 0) {-Окна без заголовков}
THEN BEGIN
GetWindowText(Wnd, buff, sizeof(buff));
ListBox1.Items.Add(StrPas(buff));
END;
Wnd := GetWindow(Wnd, gw_hWndNext);
END;
ListBox1.ItemIndex := 0;
end;

Взято с Исходников.ru

Как определить координаты курсора мыши?

GetCursorPos()

Автор Spawn
Взято с Vingrad.ru

Обрабатывай событие OnMouseMove. Координаты курсора можно получить следующим путем:

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
   if (X >= 40 or X <= 234) and (Y >= 60 or Y <=258) then {здесь запуск твоей функции};
end;

Автор Pegas
Взято с Vingrad.ru

  mouse.CursorPos.x
  mouse.CursorPos.y

Автор Vit
Взято с Vingrad.ru

Для этого можно воспользоваться API функцией GetCursorPos. Передав в эту функцию TPoint, мы получим текущие координаты курсора. Следующий код показывает, как получить значения координат курсора по нажатию кнопки.

procedure Form1.Button1Click(Sender: TObject);
var
  foo: TPoint;
begin
  GetCursorPos(foo)
  ShowMessage( '(' + IntToStr(foo.X) + ' ,' + IntToStr( foo.Y ) + ')' );
end;

Взято с Исходников.ru

Как определить лежит ли точка внутри полигона?

The main procedure is called ExploreLine. In this procedure Fst and Lst may be two consecutively points in the polyline. Srch is the point searched.

{... }
const {global}
  BigM = 1000000;

function Pend(Pi, Pf: TPoint): Real;
begin
  if (Pf.X = Pi.X) then
    Result := BigM {for a vertical line}
  else
    Result := (Pf.Y - Pi.Y) / (Pf.X - Pi.X);
end;

function Dist(Pi, Pf: TPoint): Real;
begin
  Result := sqrt(sqr(Pi.Y - Pf.Y) + sqr(Pi.X - Pf.X))
end;

function CalcPoint(Pi, Pf: TPoint; d: Word): TPoint;
var
  k, m: Real; { k=d / (1 + m2)Ѕ }
begin
  m := Pend(Pi, Pf);
  k := d / (Sqrt(1 + Sqr(m)));
  if ((Pf.X - Pi.X) < 0) then
  begin
    Result.X := Pi.X - Round(k);
    Result.Y := Pi.Y - Round(m * k);
  end
  else
  begin
    Result.X := Pi.X + Round(k);
    Result.Y := Pi.Y + Round(m * k);
  end;
end;

function ExploreLine(Srch, Fst, Lst: TPoint): Boolean;
var
  p: Word;
  Any: TPoint;
  lim, dis: Real;
begin
  lim := Dist(Lst, Fst);
  p := 1;
  Any := Fst;
  repeat
    Result := TestPoint(Srch, Any);
    dis := Dist(Any, Fst);
    Any := CalcPoint(Fst, Lst, Rad * p);
    Inc(p);
  until
    (Result)rr(dis >= lim);
end;

Взято с

Delphi Knowledge Base

Как определить локализацию ОС: английская или русская?

GetSystemDefaultLangID

Взято с сайта

Как определить MAC адрес NIC?

Вот на что наткнулся в одном из ФАКов:

Вариант1:
From : Sergey Gazimagomedov 2:453/11.13
Мне нужен был МАС адpес, так я его получал, пользуясь NetBIOS.
Добавляешь имя NetBIOS и посылаешь на имя станции, нужной для опpеделения(можно
и своей) датагpамный пакет с заполненным NCB.
Вот исходник моей функции для опpеделения МАС адpеса.

UCHARMYLIBAPI GetAdapterID(char *Name, // NetBIOS ??? ???????
UINT lana_num,
CARDID *ID) // 6 ???????? ??????
{
UCHAR rc = 0;
UCHAR Status[256];
while( lstrlen(Name) - 15)
lstrcat(Name, " ");
memset(&SNcb, 0, sizeof(NCB));
SNcb.ncb_command = NCBASTAT;
SNcb.ncb_buffer = (LPSTR)Status;
SNcb.ncb_length = 256;
lstrcpy(SNcb.ncb_callname, Name);
SNcb.ncb_lana_num = lana_num;
rc = Netbios( &SNcb );
if(rc ==0){
memcpy(ID, Status, 6);
}
return(SNcb.ncb_cmd_cplt);
}

Это под Win32. Конечно должен быть пpотокол NetBIOS, но он в фоpточках и так
необходим.

Взято с Vingrad.ru

Вариант2:
From : Alexey Grachyov

#include
#include
#include
#include
#include
void main()
{
int iAdapters,iOpt=sizeof(iAdapters),iSize=sizeof(SOCKADDR_IPX);
SOCKET skNum;
SOCKADDR_IPX Addr;
WSADATA Wsa;
if(WSAStartup(0x0101,&Wsa)) return;
if((skNum=socket(AF_IPX,SOCK_DGRAM,NSPROTO_IPX))!=INVALID_SOCKET)
{
memset(&Addr,0,sizeof(Addr));
Addr.sa_family=AF_IPX;
if(bind(skNum,(SOCKADDR *)&Addr,iSize)!=SOCKET_ERROR)
{
if(getsockopt(skNum,NSPROTO_IPX,IPX_MAX_ADAPTER_NUM,
(char *)&iAdapters,&iOpt)!=SOCKET_ERROR)
{
while(iAdapters)
{
IPX_ADDRESS_DATA Data;
memset(&Data,0,sizeof(Data));
Data.adapternum=iAdapters-1;
iOpt=sizeof(Data);
if(getsockopt(skNum,NSPROTO_IPX,IPX_ADDRESS,(char
*)&Data,&iOpt)!=SOCKET_ERROR)
{
printf("Addr: %02X%02X%02X%02X:%02X%02X%02X%02X%02X%02X\n",
(int)Data.netnum[0],(int)Data.netnum[1],(int)Data.netnum[2],
(int)Data.netnum[3],(int)Data.netnum[4],(int)Data.netnum[5],
(int)Data.netnum[6],(int)Data.netnum[7],(int)Data.netnum[8],
(int)Data.netnum[9]);
}
iAdapters--;
}
}
}
closesocket(skNum);
}
WSACleanup();
}

Взято с Vingrad.ru

Вариант3:

From: MSDN

#include
#include
#include
#include
#include
typedef struct _ASTAT_
{
ADAPTER_STATUS adapt;
NAME_BUFFER NameBuff [30];
}ASTAT, * PASTAT;
ASTAT Adapter;
void main (void)
{
NCB Ncb;
UCHAR uRetCode;
char NetName[50];
memset( &Ncb, 0, sizeof(Ncb) );
Ncb.ncb_command = NCBRESET;
Ncb.ncb_lana_num = 0;
uRetCode = Netbios( &Ncb );
printf( "The NCBRESET return code is: 0x%x \n", uRetCode );
memset( &Ncb, 0, sizeof (Ncb) );
Ncb.ncb_command = NCBASTAT;
Ncb.ncb_lana_num = 0;
strcpy( Ncb.ncb_callname, "* " );
Ncb.ncb_buffer = (char *) &Adapter;
Ncb.ncb_length = sizeof(Adapter);
uRetCode = Netbios( &Ncb );
printf( "The NCBASTAT return code is: 0x%x \n", uRetCode );
if ( uRetCode == 0 )
{
printf( "The Ethernet Number is: %02x%02x%02x%02x%02x%02x\n",
Adapter.adapt.adapter_address[0],
Adapter.adapt.adapter_address[1],
Adapter.adapt.adapter_address[2],
Adapter.adapt.adapter_address[3],
Adapter.adapt.adapter_address[4],
Adapter.adapt.adapter_address[5] );
}
}

Автор ответа: Garik

Взято с Vingrad.ru

Автор: Daniel Wischnewski

Для того, чтобы этот код работал, необходимо включить в проект юнит NB30. Простой вызов функции GetMACAddress возвращает адрес первого установленного сетевого адаптера.

Совместимость: Delphi 3.x (или выше)

Данный пример был составлен на основе статьи на сайте Borland:

uses
  NB30;

function GetAdapterInfo(Lana: Char): String;
var
  Adapter: TAdapterStatus;
  NCB: TNCB;
begin
  FillChar(NCB, SizeOf(NCB), 0);
  NCB.ncb_command := Char(NCBRESET);
  NCB.ncb_lana_num := Lana;
  if Netbios(@NCB) <> Char(NRC_GOODRET) then
  begin
    Result := 'mac not found';
    Exit;
  end;

  FillChar(NCB, SizeOf(NCB), 0);
  NCB.ncb_command := Char(NCBASTAT);
  NCB.ncb_lana_num := Lana;
  NCB.ncb_callname := '*';

  FillChar(Adapter, SizeOf(Adapter), 0);
  NCB.ncb_buffer := @Adapter;
  NCB.ncb_length := SizeOf(Adapter);
  if Netbios(@NCB) <> Char(NRC_GOODRET) then
  begin
    Result := 'mac not found';
    Exit;
  end;
  Result :=
    IntToHex(Byte(Adapter.adapter_address[0]), 2) + '-' +
    IntToHex(Byte(Adapter.adapter_address[1]), 2) + '-' +
    IntToHex(Byte(Adapter.adapter_address[2]), 2) + '-' +
    IntToHex(Byte(Adapter.adapter_address[3]), 2) + '-' +
    IntToHex(Byte(Adapter.adapter_address[4]), 2) + '-' +
    IntToHex(Byte(Adapter.adapter_address[5]), 2);
end;

function GetMACAddress: string;
var
  AdapterList: TLanaEnum;
  NCB: TNCB;
begin
  FillChar(NCB, SizeOf(NCB), 0);
  NCB.ncb_command := Char(NCBENUM);
  NCB.ncb_buffer := @AdapterList;
  NCB.ncb_length := SizeOf(AdapterList);
  Netbios(@NCB);
  if Byte(AdapterList.length) > 0 then
    Result := GetAdapterInfo(AdapterList.lana[0])
  else
    Result := 'mac not found';
end;

Взято с Исходников.ru

Как определить - находится ли Ваше приложение в режиме отладки ?

Автор: Simon Carter
Обычно господа взломщики, для того, чтобы взломать защиту приложения, запускают его в режиме отладки и анализируют машинный код для определения точки перехвата ввода пароля с клавиатуры.
Обычно таким способом ломаются игрушки :)
Конечно данный способ не сможет полностью защитить Ваш программный продукт от взлома, но прекратить выполнение секретного кода - запросто. Для этого мы будем использовать API функцию IsDebuggerPresent. Единственный недостаток этой функции, заключается в том, что она не работет под Windows 95.
Теперь посмотрим как эту функцию реализовать в Delphi:

function DebuggerPresent: boolean;
type
  TDebugProc = function: boolean; stdcall;
var
  Kernel32: HMODULE;
  DebugProc: TDebugProc;
begin
  Result := False;
  Kernel32 := GetModuleHandle('kernel32.dll');
  if Kernel32 <> 0 then
  begin
    @DebugProc := GetProcAddress(Kernel32, 'IsDebuggerPresent');
    if Assigned(DebugProc) then
      Result := DebugProc;
  end;
end;

А это окончательный пример вызова нашей функции:

if DebuggerPresent then
  ShowMessage('debugging')
else
  ShowMessage('NOT debugging');

Взято с Исходников.ru

Как определить наличие сопроцессора?

В отличие от общепринятого мнения не всее клоны 486/586/686/ и Pentium имеют сопроцессор для вычислений с плавающей запятой. В примере определяется наличие сопроцессора и под Win16 и под Win32.
Пример:

{$IFDEFWIN32}

uses Registry;

{$ENDIF}

function HasCoProcesser : bool;
{$IFDEF WIN32}
var
   TheKey : hKey;
{$ENDIF}
begin
   Result := true;
   {$IFNDEF WIN32}
   if GetWinFlags and Wf_80x87 = 0 then
   Result := false;
   {$ELSE}
   if RegOpenKeyEx(HKEY_LOCAL_MACHINE,
   'HARDWARE\DESCRIPTION\System\FloatingPointProcessor',0,
   KEY_EXECUTE, TheKey) <> ERROR_SUCCESS then result := false;
   RegCloseKey(TheKey);
{$ENDIF}
   end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if HasCoProcesser then
      ShowMessage('Has CoProcessor')
   else
      ShowMessage('No CoProcessor - Windows Emulation Mode');
end;

Взято из
DELPHI VCL FAQ

Перевод с английского
Подборку, перевод и адаптацию материала подготовил Aziz(JINX)
специально для

Как определить, насдледовано ли свойство от определённого класса?

functionGetFontProp(anObj: TObject): TFont;
var
  PInfo: PPropInfo;
begin
  {Try to get a pointer to the property information for a property with the name 'Font'.
  TObject.ClassInfo returns a pointer to the RTTI table, which we need to pass to GetPropInfo}
  PInfo := GetPropInfo(anObj.ClassInfo, 'font');
  Result := nil;
  if PInfo <> nil then
    {found a property with this name, check if it has the correct type}
    if (PInfo^.Proptype^.Kind = tkClass) and
      GetTypeData(PInfo^.Proptype^)^.ClassType.InheritsFrom(TFont)
      then
      Result := TFont(GetOrdProp(anObj, PInfo));
end;

Tip by Peter Below

Взято из

Как определить, нажал ли пользователь клавишу PrintScreen?

В событиях, обрабатывающих нажатия клавишь в TForm, клавиша PrintScreen не обрабатывается. Однако проблему можно решить при помощи 'GetAsyncKeyState'. Функция GetAsyncKeyState определяет, когда клавиша была нажата или отпущена каждый раз, когда функция вызвана, а так же, когда клавиша была нажата после предыдущего вызова GetAsyncKeyState.

Событие OnIdle в TApplication как раз подходит для вызова этой API функции:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnIdle := AppIdle;
end;

procedure TForm1.AppIdle(Sender: TObject; var Done: Boolean);
begin
if GetAsyncKeyState(VK_SNAPSHOT) <> 0 then
Form1.Caption := 'PrintScreen нажата !';
Done := True;
end;

Взято с Исходников.ru

The PrintScreen system key is not processed during the TForm
keydown event. The following example tests if the PrintScreen key has
been pressed by calling the Windows API function GetAsyncKeyState()
during the Application.OnIdle event.

Example:

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure AppIdle(Sender: TObject; var Done: Boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnIdle := AppIdle;
end;

procedure TForm1.AppIdle(Sender: TObject; var Done: Boolean);
begin
  if GetAsyncKeyState(VK_SNAPSHOT)  0 then
    Form1.Caption := 'SnapShot';
  Done := True;
end;

Как определить, нажата ли в данный момент клавиша Shift, Ctrl или Alt?

Следующий пример демонстрирует проверку состояния клавиши Shift (нажата она или нет), в то время когда выделен пункт меню. А так же в примере содержатся функции, позволяющие определить состояние клавишь Alt, Ctrl, и shift:

function CtrlDown : Boolean;
var
  State : TKeyboardState;
begin
  GetKeyboardState(State);
  Result := ((State[vk_Control] And 128) <> 0);
end;

function ShiftDown : Boolean;
var
  State : TKeyboardState;
begin
  GetKeyboardState(State);
  Result := ((State[vk_Shift] and 128) <> 0);
end;

function AltDown : Boolean;
var
  State : TKeyboardState;
begin
  GetKeyboardState(State);
  Result := ((State[vk_Menu] and 128) <> 0);
end;

procedure TForm1.MenuItem12Click(Sender: TObject);
begin
  if ShiftDown then
    Form1.Caption := 'Shift' else
    Form1.Caption := '';
end;

Взято с Исходников.ru

Как определить откуда был запущен процесс?

Есть handle запущенного PE файла. Как определить откуда он был запущен?

Я так предполагаю что getmodulefilename как и GetModuleHandle
работает в рамках только своего процесса.

А решить твою задачу .. можно так:
Тут парочка моих любимых функций

uses
tlhelp32;

type
TModuleArray = array of TModuleEntry32;

// Возвращает список описаний (TModuleEntry32) модулей по идентификатору процесса
function GetModulesListByProcessId(ProcessId : Cardinal) : TModuleArray;

implementation

function GetModulesListByProcessId(ProcessId : Cardinal) : TModuleArray;
var
hSnapshot : THandle;
lpme : TModuleEntry32;

procedure AddModuleToList;
begin
SetLength(Result,High(Result)+2);
Result[high(Result)]:=lpme;
end;

begin
SetLength(Result,0);
hSnapshot:=CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,ProcessId);
if hSnapshot=-1 then RaiseLastWin32Error;
lpme.dwSize:=SizeOf(lpme);
if Module32First(hSnapshot,lpme) then
begin
AddModuleToList;
while Module32Next(hSnapshot,lpme) do AddModuleToList;
end;
end;

Исходный код

VAR Wnd : hWnd;
buff: ARRAY [0..127] OF Char;
//------------------------------------
Pid : Cardinal;
modarr : TModuleArray;
Name : String;
//------------------------------------
begin
StringGrid1.RowCount:=1;
Wnd := GetWindow(Handle, gw_HWndFirst);
WHILE Wnd <> 0 DO
BEGIN
IF (GetWindowText(Wnd, buff, sizeof(buff)) <> 0) THEN
BEGIN
fillchar(name,sizeof(name),#0);
GetWindowText(wnd,buff,sizeof(buff));
// if getmodulefilename(GetWindowLong(wnd,GWL_HINSTANCE),name,sizeof(name))=0
// then name:='Null';
//-----------------------------------------
GetWindowThreadProcessId(Wnd,@Pid);
modarr:=GetModulesListByProcessId(Pid);
name:='Null';
for i:=0 to High(modarr) do
begin
if Integer(modarr[i].modBaseAddr)=$400000 then
begin
name:=modarr[i].szExePath;
break;
end;
end;
//-----------------------------------------
StringGrid1.Cells[0,StringGrid1.RowCount-1]:=StrPas(buff);
StringGrid1.Cells[1,StringGrid1.RowCount-1]:=StrPas(name);
StringGrid1.RowCount:=StringGrid1.RowCount+1;
END;
Wnd := GetWindow(Wnd, gw_hWndNext);
END;
StringGrid1.RowCount:=StringGrid1.RowCount-1;
end;

Автор ответа: TAPAKAH
Взято с Vingrad.ru

Как определить продолжительность в секундах wav файла?

uses
  MPlayer, MMsystem;

type
  EMyMCIException = class(Exception);
  TWavHeader = record
    Marker1: array[0..3] of Char;
    BytesFollowing: Longint;
    Marker2: array[0..3] of Char;
    Marker3: array[0..3] of Char;
    Fixed1: Longint;
    FormatTag: Word;
    Channels: Word;
    SampleRate: Longint;
    BytesPerSecond: Longint;
    BytesPerSample: Word;
    BitsPerSample: Word;
    Marker4: array[0..3] of Char;
    DataBytes: Longint;
  end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Header: TWavHeader;
begin
  with TFileStream.Create('C:\SomeFile.wav', fmOpenRead) do
    try
      ReadBuffer(Header, SizeOf(Header));
    finally
      Free;
    end;
  ShowMessage(FloatToStr((Int64(1000) * header.DataBytes div header.BytesPerSecond) / 1000));
end;

Взято с сайта

function GetWaveLength(WaveFile: string): Double;
var
    groupID: array[0..3] of char;
    riffType: array[0..3] of char;
    BytesPerSec: Integer;
    Stream: TFileStream;
    dataSize: Integer;
  // chunk seeking function,
  // -1 means: chunk not found

  function GotoChunk(ID: string): Integer;
  var
      chunkID: array[0..3] of char;
      chunkSize: Integer;
  begin
      Result := -1;

    with Stream do
        begin
             // index of first chunk
          Position := 12;
        repeat
             // read next chunk
          Read(chunkID, 4);
          Read(chunkSize, 4);
           if chunkID <> ID then
             // skip chunk
         Position := Position + chunkSize;
          until(chunkID = ID) or (Position >= Size);
          if chunkID = ID then
               // chunk found,
             // return chunk size
            Result := chunkSize;
        end;
  end;

begin
    Result := -1;
    Stream := TFileStream.Create(WaveFile, fmOpenRead or fmShareDenyNone);
    with Stream do
        try
          Read(groupID, 4);
        Position := Position + 4; // skip four bytes (file size)
        Read(riffType, 4);

        if(groupID = 'RIFF') and (riffType = 'WAVE') then
           begin
              // search for format chunk
           if GotoChunk('fmt') <> -1 then
              begin
                // found it
              Position := Position + 8;
              Read(BytesPerSec, 4);
                 //search for data chunk
                dataSize := GotoChunk('data');

                if dataSize <> -1 then
                     // found it
                  Result := dataSize / BytesPerSec
                end
            end
        finally
          Free;
      end;
end;

This returns the number of seconds as a floating point number, which is not necessarily the most helpful format. Far better to return it as a string representing the time in hours, minutes and seconds. The following function achieves this based on the number of seconds as an integer:

function SecondsToTimeStr(RemainingSeconds: Integer): string;
var
    Hours, Minutes, Seconds: Integer;
    HourString, MinuteString, SecondString: string;
begin
     // Calculate Minutes
    Seconds := RemainingSeconds mod 60;
    Minutes := RemainingSeconds div 60;
    Hours := Minutes div 60;
    Minutes := Minutes - (Hours * 60);

    if Hours < 10 then
       HourString := '0' + IntToStr(Hours) + ':'
     else
       HourString := IntToStr(Hours) + ':';

    if Minutes < 10 then
        MinuteString := '0' + IntToStr(Minutes) + ':'
      else
        MinuteString := IntToStr(Minutes) + ':';

    if Seconds < 10 then
        SecondString := '0' + IntToStr(Seconds)
      else
        SecondString := IntToStr(Seconds);
    Result := HourString + MinuteString + SecondString;
end;

Having created these functions you can call them from any relevant event - for example a button click:

procedure TForm1.Button1Click(Sender: TObject);
var
   Seconds: Integer;
begin
    Seconds := Trunc(GetWaveLength(Edit1.Text));
    //gets only the Integer part of the length
    Label1.Caption := SecondsToTimeStr(Seconds);
end;

You can even reduce this to a single line of code if you prefer:

procedure TForm1.Button1Click(Sender: TObject);
begin
    Label1.Caption := SecondsToTimeStr(Trunc(GetWaveLength(Edit1.Text)));
end;

Взято с

Delphi Knowledge Base

Как определить реальный размер поля типа BLOB, которое сохранено в таблице?

Ниже приведена функция GetBlobSize, которая возвращает размер данного BLOB или MEMO поля.

Пример вызова:

functionGetBlobSize(Field: TBlobField): Longint;
begin
  with TBlobStream.Create(Field, bmRead) do
  try
    Result := Seek(0, 2);
  finally
    Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
{ This sets the Edit1 edit box to display the size of }
{ a memo field named Notes.                           }

  Edit1.Text := IntToStr(GetBlobSize(Notes));
end;

Copyright © 1996 Epsylon Technologies

Взято из

FAQ Epsylon Technologies (095)-913-5608; (095)-913-2934; (095)-535-5349

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

Для этого можно воспользоваться функцией

GetHeapStatus

:

lwMem.Items.Clear;
s := LastStatsList[cbCompare.ItemIndex];
LastStatsList[0] := GetHeapStatus;
LastStats := LastStatsList[PointId];

ListItem := lwMem.Items.Add;
ListItem.Caption := 'TotalAddrSpace';
ListItem.SubItems.Add(Numb2USA(Format(strFormat,[s.TotalAddrSpace])));
tmp := s.TotalAddrSpace - LastStats.TotalAddrSpace;
ListItem.SubItems.Add(DeltaToStr(tmp));

ListItem := lwMem.Items.Add;
ListItem.Caption := 'TotalUncommitted';
ListItem.SubItems.Add(Numb2USA(Format(strFormat,[s.TotalUncommitted])));
tmp := s.TotalUncommitted - LastStats.TotalUncommitted;
ListItem.SubItems.Add(DeltaToStr(tmp));

ListItem := lwMem.Items.Add;
ListItem.Caption := 'TotalCommitted';
ListItem.SubItems.Add(Numb2USA(Format(strFormat,[s.TotalCommitted])));
tmp := s.TotalCommitted - LastStats.TotalCommitted;
ListItem.SubItems.Add(DeltaToStr(tmp));

ListItem := lwMem.Items.Add;
ListItem.Caption := 'TotalAllocated';
ListItem.SubItems.Add(Numb2USA(Format(strFormat,[s.TotalAllocated])));
tmp := s.TotalAllocated - LastStats.TotalAllocated;
ListItem.SubItems.Add(DeltaToStr(tmp));

ListItem := lwMem.Items.Add;
ListItem.Caption := 'TotalFree';
ListItem.SubItems.Add(Numb2USA(Format(strFormat,[s.TotalFree])));
tmp := s.TotalFree - LastStats.TotalFree;
ListItem.SubItems.Add(DeltaToStr(tmp));

ListItem := lwMem.Items.Add;
ListItem.Caption := 'FreeSmall';
ListItem.SubItems.Add(Numb2USA(Format(strFormat,[s.FreeSmall])));
tmp := s.FreeSmall - LastStats.FreeSmall;
ListItem.SubItems.Add(DeltaToStr(tmp));

ListItem := lwMem.Items.Add;
ListItem.Caption := 'FreeBig';
ListItem.SubItems.Add(Numb2USA(Format(strFormat,[s.FreeBig])));
tmp := s.FreeBig - LastStats.FreeBig;
ListItem.SubItems.Add(DeltaToStr(tmp));

ListItem := lwMem.Items.Add;
ListItem.Caption := 'Unused';
ListItem.SubItems.Add(Numb2USA(Format(strFormat,[s.Unused])));
tmp := s.Unused - LastStats.Unused;
ListItem.SubItems.Add(DeltaToStr(tmp));

ListItem := lwMem.Items.Add;
ListItem.Caption := 'Overhead';
ListItem.SubItems.Add(Numb2USA(Format(strFormat,[s.Overhead])));
tmp := s.Overhead - LastStats.Overhead;
ListItem.SubItems.Add(DeltaToStr(tmp));

ListItem := lwMem.Items.Add;
ListItem.Caption := 'HeapErrorCode';
ListItem.SubItems.Add(Numb2USA(Format(strFormat,[s.HeapErrorCode])));

Взято с Исходников.ru

Как определить уровень звука в данный момент?

Единственное, что удалось найти это компонент на Дельфи (с исходным кодом) на компонент называется Vumeter v.1.0. Я его не разбирал, но похоже что он опрашивает Audio Mixer Driver (или что-то подобное).

Автор ответа: Vit
Взято с Vingrad.ru

Я построил диограмму так:
Назначил F:= TFileStream.Create(OpenDialog1.FileName, fmOpenRead );
Затем считал заголовок Wav- SampleCount, SamplesPerSec, BitsPerSample, Channeles.
Затем считал данные- GetMem(buf, SampleCount * Channeles * BitsPerSample);
Описал массив Volume- SetLength(Volume, SampleCount);
Затем - F.Read(buf^, SampleCount*2); F.Free;
Затем заполнил массив -

buf16 := buf;
for h := 0 to SampleCount - 1 do
  begin
    Volume[h] := abs(buf16^);
    inc(buf16);
  end;
FreeMem(buf);

Затем строил график(в экранных координатах) - по горизонтальной оси откладывал значения SampleCount, по вертикальной значения Volume[h].
График получается точно такой же как в SoundForge.
Единственно, я писал программу для конкретного случая - у меня файлы по 10 минут, моно, 11025 Гц., 16 бит. Так что программа у меня не универсальная. Но работает нормально. По времени: обработка файла и построение графика около 4 -5 секунд.

Автор ответа: TPavel
Взято с Vingrad.ru

Как определить установлен ли Excel?

Функция возвращает True если найден OLE-объект

Пример использования
  if not IsOLEObjectInstalled('Excel.Application') then
    ShowMessage('Класс не зарегистрирован')
  else
    ShowMessage('Класс найден');

function IsOLEObjectInstalled(Name: String): boolean;
var
  ClassID: TCLSID;
  Rez : HRESULT;
begin
  // Ищем CLSID OLE-объекта
  Rez := CLSIDFromProgID(PWideChar(WideString(Name)), ClassID);

  if Rez = S_OK then  // Объект найден
    Result := true
  else
    Result := false;
end;

Если нужна более подробная информация об объекте, можно почитать хелп по функции API CLSIDFromProgID.

Автор Кулюкин Олег
Взято с сайта

Как определить установлен ли Internet Explorer?

uses
  registry;

function IE_installed(var Version: string): Boolean;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  with Reg do
  begin
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey('Software\Microsoft\Internet Explorer', False);
    if ValueExists('Version') then
      Version := ReadString('Version')
    else
      Version := '';
    CloseKey;
    Free;
  end;
  Result := Version <> '';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  IE_Version: string;
begin
  if IE_Installed(IE_Version) then
    ShowMessage(Format('Internet Explorer %s installed.', [IE_Version]));
end;

Взято с сайта

Как определить установлена ли звуковая карта?

{... }
if WaveOutGetNumDevs > 0 then
  ShowMessage('Wave-Device present')
else
  ShowMessage('No Wave-Device present');
{ ... }

function IsSoundCardInstalled: Boolean;
type
  SCFunc = function: UInt; stdcall;
var
  LibInst: LongInt;
  EntryPoint: SCFunc;
begin
  Result := False;
  LibInst := LoadLibrary(PChar('winmm.dll'));
  try
    if LibInst <> 0 then
    begin
      EntryPoint := GetProcAddress(LibInst, 'waveOutGetNumDevs');
      if (EntryPoint <> 0) then
        Result := True;
    end;
  finally
    if (LibInst <> 0) then
      FreeLibrary(LibInst);
  end;
end;

Взято с

Delphi Knowledge Base

Как определить видеокарту?

procedure TForm1.button1click(Sender: TObject);
var
  lpDisplayDevice: TDisplayDevice;
  dwFlags: DWORD;
  cc: DWORD;
begin
form2.memo1.Clear;
lpDisplayDevice.cb := sizeof(lpDisplayDevice);
dwFlags := 0;
cc:= 0;
while EnumDisplayDevices(nil, cc, lpDisplayDevice , dwFlags) do
  begin
    Inc(cc);
    form2.memo1.lines.add(lpDisplayDevice.DeviceString);
        {Так же мы увидим дополнительную информацию в lpDisplayDevice}
    form2.show;
  end;
end;

Взято с Исходников.ru

Как определить, включено ли автоскрытие у панели задач?

uses ShellAPI;

...

function IsTaskbarAutoHideOn : boolean;
var ABData : TAppBarData;
begin
ABData.cbSize := sizeof(ABData);
Result :=(SHAppBarMessage(ABM_GETSTATE, ABData) and ABS_AUTOHIDE) > 0;
end;

Взято с Исходников.ru

Как определить запущен ли Excel?

Данный пример ищет активный экземпляр Excel и делает его видимым

var
    ExcelApp : Variant;
begin
  try
    // Ищем запущеный экземплят Excel, если он не найден, вызывается исключение
    ExcelApp := GetActiveOleObject('Excel.Application');

    // Делаем его видимым
    ExcelApp.Visible := true;
  except
  end;

Автор Кулюкин Олег
Взято с сайта

Как определить, запущена ли Delphi

Иногда, особенно при создании компонент, бывает необходимо получить доступ к компоненту только когда запущена Delphi IDE.

If FindWindow('TAppBuilder',nil) <= 0 then
ShowMessage('Delphi is not running !')
else
ShowWindow('Delphi is running !');

Взято с Исходников.ru

Как определить, запущено ли приложение в Windows NT?

Следующий кодкомпилируется как на 16-ти, так и на 32-битных платформах.

{$IFNDEF WIN32}
  const WF_WINNT = $4000;
{$ENDIF}

function IsNT : bool;
{$IFDEF WIN32}
var
   osv : TOSVERSIONINFO;
{$ENDIF}
begin
  result := true;
{$IFDEF WIN32}
  GetVersionEx(osv);
  if osv.dwPlatformId = VER_PLATFORM_WIN32_NT then exit;
{$ELSE}
   if ((GetWinFlags and WF_WINNT) = WF_WINNT ) then exit;
{$ENDIF}
  result := false;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if IsNt then
    ShowMessage('Running on NT')
  else
    ShowMessage('Not Running on NT');
end;

Взято с Исходников.ru

function IsNT: bool;
var osv: TOSVERSIONINFO;
begin result := true;
  GetVersionEx(osv);
  if osv.dwPlatformId = VER_PLATFORM_WIN32_NT then exit;
  result := false;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if IsNt then
    ShowMessage('Running on NT')
  else
    ShowMessage('Not Running on NT');

Взято с сайта

Как остановить автодобавление из DBGrid?

Добавьте в событие "BeforeInsert" Вашего TTables следующие строки:

procedure TForm1.Tbable1BeforeInsert(DataSet: TDataset);
begin
  Abort;
end;

ИЛИ

procedure TForm8.DBGrid1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_DOWN) then
  begin
    TTable1.DisableControls ;
    TTable1Next ;
    if TTable1.EOF then
      Key := 0 else TTable1.Prior ;
    TTable1.EnableControls ;
  end ;
end;

Взято с Исходников.ru

Как остановить или запустить IB сервис?

Do you need to shutdown the Interbase db service e.g. for an installation program and afterwards restart it?

You could do this with a lot of Delphi code involving unit WinSvc and function calls to

OpenSCManager()
EnumServicesStatus()
OpenService()
StartService()or ControlService().

But luckily there is a much easier solution that uses the NET.EXE program which has been part of Windows since Windows for Workgroups (Wfw 3.11). Just create the two batch files

IBSTOP.BAT
IBSTART.BAT

and call them from your code. You may want to call them and wait for their termination.

IBSTOP.BAT
=============
@echo off
net stop "InterBase Guardian" >NULL
net stop "InterBase Server" >NULL

IBSTART.BAT
=============
@echo off
net start "Interbase Guardian" >NULL

Взято с

Delphi Knowledge Base

Как осуществить быстрый поиск в Listbox?

Очень просто, смотри пример....
считаем, сто есть поле Edit1, в котором набираем текст, и ListBox, в котором ищем нужную строку, (как в Нelp).

procedure TForm1.Edit1Change(Sender: TObject);
begin
ListBox1.Perform(LB_SELECTSTRING,-1,longint(Pchar(Edit1.text)));
end;

Взято с Исходников.ru

Как осуществить поиск ячейки по её значению?

{... }
var
  Rnge: OleVariant;
  { ... }

Rnge := WS.Cells;
Rnge := Rnge.Find('Is this text on the sheet?');
if Pointer(IDispatch(Rnge)) <> nil then
  {The text was found somewhere, so colour it pink}
  Rnge.Interior.Color := clFuchsia;

Взято с

Delphi Knowledge Base

Как осуществить поиск слов по маске?

Может у кого-нибудь есть готовая функция поиска(выборки) слов по маске (с использованием символов '*' и '?').

Такая функция в Дельфи есть: MatchesMask из модуля masks.

Автор ответа: MBo
Взято с Vingrad.ru

Как осуществить ввод текста в компоненте Label?

Многие программисты задавая такой вопрос получают на него стандартный ответ "используй edit box." На самом же деле этот вопрос вполне решаем, хотя лейблы и не основаны на окне и, соответственно не могут получать фокус ввода и, соответственно не могут получать символы, вводимые с клавиатуры. Давайте рассмотрим шаги, которые были предприняты мной для разработки данного компонента.

Первый шаг, это кнопка, которая может отображать вводимый текст:

type
  TInputButton = class(TButton)
  private
    procedure WmChar (var Msg: TWMChar);
      message wm_Char;
  end;

procedure TInputButton.WmChar (var Msg: TWMChar);
var
  Temp: String;
begin
  if Char (Msg.CharCode) = #8 then
  begin
    Temp := Caption;
    Delete (Temp, Length (Temp), 1);
    Caption := Temp;
  end
  else
    Caption := Caption + Char (Msg.CharCode);
end;

С меткой (label) дела обстоят немного сложнее, так как прийдётся создать некоторые ухищрения, чтобы обойти её внутреннюю структуру. Впринципе, проблему можно решить созданием других скрытых компонент (кстати, тот же edit box). Итак, посмотрим на объявление класса:

type
  TInputLabel = class (TLabel)
  private
    MyEdit: TEdit;
    procedure WMLButtonDown (var Msg: TMessage);
      message wm_LButtonDown;
  protected
    procedure EditChange (Sender: TObject);
    procedure EditExit (Sender: TObject);
  public
    constructor Create (AOwner: TComponent); override;
  end;

Когда метка (label) создана, то она в свою очередь создаёт edit box и устанавливает несколько обработчиков событий для него. Фактически, если пользователь кликает по метке, то фокус перемещается на (невидимый) edit box, и мы используем его события для обновления метки. Обратите внимание на ту часть кода, которая подражает фокусу для метки (рисует прямоугольничек), основанная на API функции DrawFocusRect:

constructor TInputLabel.Create (AOwner: TComponent);
begin
  inherited Create (AOwner);

  MyEdit := TEdit.Create (AOwner);
  MyEdit.Parent := AOwner as TForm;
  MyEdit.Width := 0;
  MyEdit.Height := 0;
  MyEdit.TabStop := False;
  MyEdit.OnChange := EditChange;
  MyEdit.OnExit := EditExit;
end;

procedure TInputLabel.WMLButtonDown (var Msg: TMessage);
begin
  MyEdit.SetFocus;
  MyEdit.Text := Caption;
  (Owner as TForm).Canvas.DrawFocusRect (BoundsRect);
end;

procedure TInputLabel.EditChange (Sender: TObject);
begin
  Caption := MyEdit.Text;
  Invalidate;
  Update;
  (Owner as TForm).Canvas.DrawFocusRect (BoundsRect);
end;

procedure TInputLabel.EditExit (Sender: TObject);
begin
  (Owner as TForm).Invalidate;
end;

Взято с Исходников.ru

Как отчитывать промежутки времени с точностью, большей чем 60 мсек?

Для начала описываешь процедуру, которая будет вызываться по сообщению от таймера :
procedureFNTimeCallBack(uTimerID, uMessage: UINT;dwUser, dw1, dw2: DWORD)
stdcall;
begin
//
// Тело процедуры.
end;

а дальше в программе (например по нажатию кнопки) создаешь Таймер и вешаешь на него созданную процедуру
uTimerID:=timeSetEvent(10,500,@FNTimeCallBack,100,TIME_PERIODIC);

Подробности смотри в Help.
Hу и в конце убиваешь таймер
timeKillEvent(uTimerID);

И все. Точность этого способа до 1 мсек. минимальный интервал времени можно задавать 1 мсек.

Автор: Leonid Tserling
tlv@f3334.dd.vaz.tlt.ru

Автор:

StayAtHome

Взято из

Как открыть базу данных Microsoft Access .MDB в Delphi?

ADO

Если у Вас Delphi 5 Enterprise или Delphi 5 Professional с ADO Express, то Вы можете использовать компонент ADOTable и в его свойстве ConnectionString настроить (build) подключение как базе данных MS Access. Например:

Provider=Microsoft.Jet.OLEDB.4.0;
User ID=Admin;
Password=Password;
Data Source=D:\Path\dbname.mdb;
Mode=ReadWrite;
Extended Properties="";
Persist Security Info=False;
Jet OLEDB:System database="";
Jet OLEDB:Registry Path="";
Jet OLEDB:Database Password="";
Jet OLEDB:Engine Type=5;
Jet OLEDB:Database Locking Mode=1;
Jet OLEDB:Global Partial Bulk Ops=2;
Jet OLEDB:Global Bulk Transactions=1;
Jet OLEDB:New Database Password="";
Jet OLEDB:Create System Database=False;
Jet OLEDB:Encrypt Database=False;
Jet OLEDB:Don't Copy Locale on Compact=False;
Jet OLEDB:Compact Without Replica Repair=True;
Jet OLEDB:SFP=False

При этом будет открыта база данных D:\Path\dbname.mdb, будет использован драйвер ADO для базы данных Access (Microsoft.Jet.OLEDB.4.0). Имя пользователя будет Admin без пароля (эти значения присваиваются поумолчанию при создании базы Access). Если Вы всё-таки захотите использовать пароль, то его надо будет задать в ствойстве Jet OLEDB:Database Password. Если у Вас установлен режим безопасности, то необходимо указать файл .MDW или .MDA в свойстве Jet OLEDB:System database.

BDE
Так же для открытия базы данных Access можно воспользоваться BDE которая содержит родной драйвер (MSACCESS). В компоненте Database установите следующие свойства:

DatabaseName = Any_name (или Alias_name)
DriverName   = MSACCESS
LoginPrompt  = False
Params       = PATH=d:\path
               DATABASE NAME=d:\path\filename.mdb
               TRACE MODE=0
               LANGDRIVER=Access General
               USER NAME=Admin
               PASSWORD=your_password
               Open/MODE=Read/Write
               SQLPASSTHRU MODE=Not SHARED

Значения свойства DatabaseName объекта Database, это то, которое Вы будете использовать в свойстве DatabaseName компонентов Table и Query, которые представляют таблицы и запросы для этой базы данных (тем самым связывая их с объектом Database).

BDE+ODBC
В случае с базой данных Access, BDE предоставляет драйвер, однако существует множество других баз, для которых в BDE драйвера нет, но для которых есть драйвер ODBC. ODBC обычно используется для небольших баз данных или в приложениях, в которых присутствуют только операции импорта/экспорта...

Ниже приведён пример использования драйвера ODBC с BDE для открытия базы данных Access:

Создайте DSN (Data Source Name) для Вашей базы данных (используя апплет ODBC Data Sources в панели управления).
Кликните на закладку "System DSN" или "User DSN"
Кликните по кнопке "Add..."
Выберите "Microsoft Access Driver (*.mdb)" и нажмите ENTER. Появится диалоговое окошко "ODBC Microsoft Access Setup".
Задайте имя в текстовом окошке Data Source Name (без пробелов и без специальных символов).
Кликните по кнопке "Select..." чтобы выбрать нужный файл .MDB.
Если у Вас установлена схема безопасноти, то выберите радио кнопку "Database" в "System Database", а затем кликните кнопку "System database...", чтобы указать файл рабочей группы .MDW или .MDA.
Если Вы хотите указать имя пользователя и пароль, то нажмите кнопку "Advanced...". Данный способ защиты является низкоуровневым, так как любой, кто имеет доступ к Вашей машине может спокойно посмотреть свойства DSN. Если Вам необходим более высокий уровень защиты, то задавать имя пользователя и пароль необходимо на стадии открытия базы данных (см. ниже).
В заключении нажмите "OK", после чего Ваш DSN будет сохранён.
В Delphi установите свойства компонента TDatabase:
В DatabaseName задайте имя, которое указали в DSN.
Если Вы хотите, чтобы пользователя спрашивали имя и пароль, то установите LoginPrompt в True.
Если Вы не хотите использовать стандартный диалог имени и пароля (или если имя и пароль будут задаваться программно), то установите LoginPrompt в False и задайте свойство Params (или задайте эти свойства по ходу выполнения программы):
USER NAME=your_username
PASSWORD=your_password
Свяжите компоненты TTable или TQuery с компонентом TDatabase, как рассказывалось Выше, просто указав тоже имя (которое было задано в DSN) в их соответствующих свойствах DatabaseName.

Взято с Исходников.ru

Как открыть диалог Add printer?

// добавьте ShellAPI в USES

ShellExecute(handle, nil,
'rundll32.exe',
'shell32.dll,SHHelpShortcuts_RunDLL AddPrinter', '', SW_SHOWNORMAL);

Взято с Исходников.ru

Как открыть диалог смены системного времени?

uses
Shellapi;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(Handle, 'open', 'control', 'date/time', nil, SW_SHOW);
end;

Взято с сайта

Как открыть диалог создания ярлыка?

uses
  registry, shellapi;

function Launch_CreateShortCut_Dialog(Directory: string): Boolean;
var
  reg: TRegistry;
  cmd: string;
begin
  Result := False;
  reg    := TRegistry.Create;
  try
    reg.Rootkey := HKEY_CLASSES_ROOT;
    if reg.OpenKeyReadOnly('.LNK\ShellNew') then
    begin
      cmd    := reg.ReadString('Command');
      cmd    := StringReplace(cmd, '%1', Directory, []);
      Result := True;
      WinExec(PChar(cmd), SW_SHOWNORMAL);
    end
  finally
    reg.Free;
  end;
end;

{Example}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Launch_CreateShortCut_Dialog('c:\temp');
end;

Взято с сайта

Как открыть диалог свойств аудио?

WinExec('rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,2',SW_SHOWNORMAL);

Взято с сайта

Как очистить canvas

Взято из

Как очистить кэш в IE?

Как очистить кэш в IE?

Как очистить пункт меню Документы кнопки Пуск?

Как очистить пункт меню Документы кнопки Пуск?

Как очистить все окошки редактирования на форме?

Как очистить все окошки редактирования на форме?

Как ограничить длинну вводимого текста шириной TEdit'а?

Как ограничить длинну вводимого текста шириной TEdit'а?

Как ограничить движения мышки определённой областью?

Как ограничить движения мышки определённой областью?

Как округлять до сотых в большую сторону?

Как округлять до сотых в большую сторону?

Как опеделить состояние списка ComboBox, выпал/скрыт?

Как опеделить состояние списка ComboBox, выпал/скрыт?

Как оперделить все IP и порты на моем компьютере?

Как оперделить все IP и порты на моем компьютере?

Как определить bitrate WAV файла?

Как определить bitrate WAV файла?

Как определить цвет код произвольной точки экрана?

Как определить цвет код произвольной точки экрана?

Как определить графический формат файла (не используя расширение)?

Как определить графический формат файла (не используя расширение)?

Взято с

Как определить, изменилось ли системное время?

Как определить, изменилось ли системное время?

Как определить, является ли диск NTFS?

Как определить, является ли диск NTFS?

Как определить, является ли метод потомком TNotifyEvent?

Как определить, является ли метод потомком TNotifyEvent?

Взято из

Как определить какие приложения уже запущены?

Как определить какие приложения уже запущены?

Как определить координаты курсора мыши?

Как определить координаты курсора мыши?

Как определить лежит ли точка внутри полигона?

Как определить лежит ли точка внутри полигона?

Взято с

Как определить локализацию ОС: английская или русская?

Как определить локализацию ОС: английская или русская?

Как определить MAC адрес NIC?

Как определить MAC адрес NIC?

Вариант3:

Как определить - находится ли Ваше приложение в режиме отладки ?

Как определить - находится ли Ваше приложение в режиме отладки ?

Как определить наличие сопроцессора?

Как определить наличие сопроцессора?

Взято из DELPHI VCL FAQ

Как определить, насдледовано ли свойство от определённого класса?

Как определить, насдледовано ли свойство от определённого класса?

Взято из

Как определить, нажал ли пользователь клавишу PrintScreen?

Как определить, нажал ли пользователь клавишу PrintScreen?

Как определить, нажата ли в данный момент клавиша Shift, Ctrl или Alt?

Как определить, нажата ли в данный момент клавиша Shift, Ctrl или Alt?

Как определить откуда был запущен процесс?

Как определить откуда был запущен процесс?

Как определить продолжительность в секундах wav файла?

Как определить продолжительность в секундах wav файла?

Взято с

Как определить реальный размер поля типа BLOB, которое сохранено в таблице?

Как определить реальный размер поля типа BLOB, которое сохранено в таблице?

Copyright © 1996 Epsylon Technologies

Взято из

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

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

GetHeapStatus

Как определить уровень звука в данный момент?

Как определить уровень звука в данный момент?

Как определить установлен ли Excel?

Как определить установлен ли Excel?

Как определить установлен ли Internet Explorer?

Как определить установлен ли Internet Explorer?

Как определить установлена ли звуковая карта?

Как определить установлена ли звуковая карта?

Взято с

Как определить видеокарту?

Как определить видеокарту?

Как определить, включено ли автоскрытие у панели задач?

Взято из
DELPHI VCL FAQ