Delphi - база знаний

  35790931     

Как узнать номер BIOS для разных версий Windows?


Как узнать номер BIOS для разных версий Windows?



Windows 9X

with Memo1.Lines do
  begin
    Add('MainBoardBiosName:'+^I+string(Pchar(Ptr($FE061))));
    Add('MainBoardBiosCopyRight:'+^I+string(Pchar(Ptr($FE091))));
    Add('MainBoardBiosDate:'+^I+string(Pchar(Ptr($FFFF5))));
    Add('MainBoardBiosSerialNo:'+^I+string(Pchar(Ptr($FEC71))));
  end;

Windows NT

procedure TBIOSInfo.GetRegInfoWinNT;


var
  Registryv       : TRegistry;
  RegPath         : string;
  sl              : TStrings;
begin
  Params.Clear;

  RegPath := '\HARDWARE\DESCRIPTION\System';
  registryv:=tregistry.Create;
  registryv.rootkey:=HKEY_LOCAL_MACHINE;
  sl := nil;
  try
    registryv.Openkey(RegPath,false);
    ShowMessage('BIOS Date: '+RegistryV.ReadString('SystemBiosDate'));
    sl := ReadMultirowKey(RegistryV,'SystemBiosVersion');
    ShowMessage('BIOS Version: '+sl.Text);
  except
  end;
  Registryv.Free;
  if Assigned(sl) then sl.Free;
end;

function ReadMultirowKey(reg: TRegistry; Key: string): TStrings;
const bufsize = 100;
var
  i: integer;
  s1: string;
  sl: TStringList;
  bin: array[1..bufsize] of char;
begin
  try
    result := nil;
    sl := nil;
    sl := TStringList.Create;
    if not Assigned(reg) then
      raise Exception.Create('TRegistry object not assigned.');
    FillChar(bin,bufsize,#0);
    reg.ReadBinaryData(Key,bin,bufsize);
    i := 1;
    s1 := '';
    while i < bufsize do
    begin
      if ord(bin[i]) >= 32 then
        s1 := s1 + bin[i]
      else
      begin
        if Length(s1) > 0 then
        begin
          sl.Add(s1);
          s1 := '';
        end;
      end;
      inc(i);
    end;
    result := sl;
  except
    sl.Free;
    raise;
  end;
end;

нашел на
и

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




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


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



Вариант 1:


function WeekOfYear(ADate : TDateTime) : word;
var
  day : word;
  month : word;
  year : word;
  FirstOfYear : TDateTime;
begin
  DecodeDate(ADate, year, month, day);
  FirstOfYear := EncodeDate(year, 1, 1);
  Result := Trunc(ADate - FirstOfYear) div 7 + 1;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(WeekOfYear(Date)));
end;



Вариант 2:

function WeekNum(const ADate: TDateTime): word;
var
  Year: word;
  Month: word;
  Day: word;
begin
  DecodeDate(ADate + 4 - DayOfWeek(ADate + 6), Year, Month, Day);
  result := 1 + trunc((ADate - EncodeDate(Year, 1, 5) +
      DayOfWeek(EncodeDate(Year, 1, 3))) / 7);
end;



Вариант 3:

function WeekOfYear(Dat: TDateTime): Word;
// Интерпретация номеров дней:
// ISO: 1 = Понедельник, 7 = Воскресенье
// Delphi SysUtils: 1 = Воскресенье, 7 = Суббота
var
  Day,
  Month,
  Year: Word;
  FirstDate: TDateTime;
  DateDiff : Integer;
begin
  day := SysUtils.DayOfWeek(Dat)-1;
  Dat := Dat + 3 - ((6 + day) mod 7);
  DecodeDate(Dat, Year, Month, Day);
  FirstDate := EncodeDate(Year, 1, 1);
  DateDiff  := Trunc(Dat - FirstDate);
  Result    := 1 + (DateDiff div 7);
end;

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



Как узнать о нажатии non-menu клавиши в момент когда меню показано?


Как узнать о нажатии non-menu клавиши в момент когда меню показано?



Автор: Arx ( http://arxoft.tora.ru )

Создайте обработчик сообщения WM_MENUCHAR.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus;

type 
    TForm1 = class(TForm)
        MainMenu1: TMainMenu;
        One1: TMenuItem;
        Two1: TMenuItem;
        THree1: TMenuItem;
    private
        {Private declarations}
        procedure WmMenuChar(var m : TMessage); message WM_MENUCHAR;
    public
        {Public declarations}
end;

var
    Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WmMenuChar(var m : TMessage);
begin
    Form1.Caption := 'Non standard menu key pressed';
    m.Result := 1;
end;
end.

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





Как узнать откуда была установленна Windows?


Как узнать откуда была установленна Windows?





usesRegistry;

procedure TForm1.Button1Click(Sender: TObject);
var
   reg: TRegistry;
begin
   reg := TRegistry.Create;
   reg.RootKey := HKEY_LOCAL_MACHINE;
   reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\SETUP',false);
   ShowMessage(reg.ReadString('SourcePath'));
   reg.CloseKey;
   reg.free;
end;

Взято из
DELPHI VCL FAQ

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




Как узнать перечень таблиц базы и количество записей в них?


Как узнать перечень таблиц базы и количество записей в них?




procedureTForm1.Button1Click(Sender: TObject);
var
  SL: TStrings;
  index: Integer;
begin
  SL := TStringList.Create;
  try
    ADOConnection1.GetTableNames(SL, False);
    for index := 0 to (SL.Count - 1) do begin
      Table1.Insert;
      Table1.FieldByName('Name').AsString := SL[index];
      ADOTable1.TableName := SL[index];
      ADOTable1.Open;
      Table1.FieldByName('Records').AsInteger :=
        ADOTable1.RecordCount;
      Table1.Post;
    end;
  finally
    SL.Free;
    ADOTable1.Close;
  end;
end;

Взято с



Комментарий Vit: открытие больших таблиц, особенно на удалённых серверах баз данных может быть исключительно длительным процессом. ADO оптимизированно для работы через запросы, поэтому количество записей можно значительно быстрее узнать составляя query и выполняя её:

procedure TForm1.Button1Click(Sender: TObject);
var
  SL: TStrings;
  index: Integer;
begin
  SL := TStringList.Create;
  try
    ADOConnection1.GetTableNames(SL, False);
    for index := 0 to (SL.Count - 1) do begin
      Table1.Insert;
      Table1.FieldByName('Name').AsString := SL[index];
      ADOQuery1.sql.text := 'Select Count(*) From '+SL[index];
      ADOQuery1.Open;
      Table1.FieldByName('Records').AsInteger :=ADOQuery1.fields[0].AsInteger;
      Table1.Post;
      ADOQuery1.Close;
    end;
  finally
    SL.Free;
  end;
end;





Как узнать, по какой колонке был клик в TListView?


Как узнать, по какой колонке был клик в TListView?



Метод GetItemAt позволяет получить координаты ListItem, по которой был клик, но только для первой колонки TListView. Если нужно узнать по какому элементу из другой колонки кликнул пользователь, то прийдётся объявить новый метод в наследованном классе:

uses ComCtrls;

type
  TListViewX = class(TListView)
  public
    function GetItemAtX(X, Y: integer; var Col: integer): TListItem;
  end;

implementation

function TListViewX.GetItemAtX(X, Y: integer;
    var Col: integer): TListItem;
var
  i, n, RelativeX, ColStartX: Integer;
  ListItem: TlistItem;
begin
  Result := GetItemAt(X, Y);
  if Result <> nil then begin
    Col := 0; // Первая колонка
  end else if (ViewStyle = vsReport)
      and (TopItem <> nil) then begin
    // Первая, попробуем найти строку
    ListItem := GetItemAt(TopItem.Position.X, Y);
    if ListItem <> nil then begin
      // Теперь попробуем найти колонку
      RelativeX := X-ListItem.Position.X-BorderWidth;
      ColStartX := Columns[0].Width;
      n := Columns.Count - 1;
      for i := 1 to n do begin
        if RelativeX < ColStartX then break;
        if RelativeX <= ColStartX +
            StringWidth(ListItem.SubItems[i-1]) then
        begin
          Result := ListItem;
          Col := i;
          break;
        end;//if
        Inc(ColStartX, Columns[i].Width);
      end;//for
    end;//if
  end;//if
end;

А вот так выглядит событие MouseDown:

procedure TForm1.ListView1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  col: integer;
  li: TListItem;
begin
  li := TListViewX(ListView1).GetItemAtX(x, y, col);
  if li <> nil then
    ShowMessage('Column #' + IntToStr(col));
end;

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



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


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




procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if GetSystemMetrics(SM_NETWORK) and $01 = $01 then 
    ShowMessage('Computer is attached to a network!') 
  else 
    ShowMessage('Computer is not attached to a network!'); 
end; 

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



Как узнать, присутствует ли мышка?


Как узнать, присутствует ли мышка?




function MousePresent : Boolean; 
begin 
if GetSystemMetrics(SM_MOUSEPRESENT) <> 0 then   
  Result := true   
else   
  Result := false;   
end; 

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



Как узнать путь базы данных и её имя?


Как узнать путь базы данных и её имя?



Делается это при помощи dbiGetDatabaseDesc:

uses BDE;
.....

procedure ShowDatabaseDesc(DBName: string);
const
  DescStr = 'Driver Name: %s'#13#10'AliasName: %s'#13#10 +
    'Text: %s'#13#10'Physical Name/Path: %s';
var
  dbDes: DBDesc;
begin
  dbiGetDatabaseDesc(PChar(DBName), @dbDes);
  with dbDes do
    ShowMessage(Format(DescStr, [szDbType, szName, szText, szPhyName]));
end;



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



Как узнать путь к браузеру по умолчанию?


Как узнать путь к браузеру по умолчанию?





uses 
  Registry; 

{....} 

procedure TForm1.Button1Click(Sender: TObject); 
var 
  Reg: TRegistry; 
  KeyName: string; 
  ValueStr: string; 
begin 
  Reg := TRegistry.Create; 
  try 
    Reg.RootKey := HKEY_CLASSES_ROOT; 
    KeyName  := 'htmlfile\shell\open\command'; 
    if Reg.OpenKey(KeyName, False) then 
    begin 
      ValueStr := Reg.ReadString(''); 
      Reg.CloseKey; 
      Label1.Caption := ValueStr; 
    end 
    else 
      ShowMessage('No Default Webbrowser !'); 
  finally 
    Reg.Free; 
  end; 
end; 


Взято с сайта



Как узнать размер картинки для JPG, GIF и PNG файлов?


Как узнать размер картинки для JPG, GIF и PNG файлов?





unit ImgSize; 

interface 

uses Classes; 


procedure GetJPGSize(const sFile: string; var wWidth, wHeight: Word); 
procedure GetPNGSize(const sFile: string; var wWidth, wHeight: Word); 
procedure GetGIFSize(const sGIFFile: string; var wWidth, wHeight: Word); 


implementation 

uses SysUtils; 

function ReadMWord(f: TFileStream): Word; 
type 
  TMotorolaWord = record 
    case Byte of 
      0: (Value: Word); 
      1: (Byte1, Byte2: Byte); 
  end; 
var 
  MW: TMotorolaWord; 
begin 
  { It would probably be better to just read these two bytes in normally } 
  { and then do a small ASM routine to swap them.  But we aren't talking } 
  { about reading entire files, so I doubt the performance gain would be } 
  { worth the trouble. } 
  f.read(MW.Byte2, SizeOf(Byte)); 
  f.read(MW.Byte1, SizeOf(Byte)); 
  Result := MW.Value; 
end; 

procedure GetJPGSize(const sFile: string; var wWidth, wHeight: Word); 
const 
  ValidSig: array[0..1] of Byte = ($FF, $D8); 
  Parameterless = [$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7]; 
var 
  Sig: array[0..1] of byte; 
  f: TFileStream; 
  x: integer; 
  Seg: byte; 
  Dummy: array[0..15] of byte; 
  Len: word; 
  ReadLen: LongInt; 
begin 
  FillChar(Sig, SizeOf(Sig), #0); 
  f := TFileStream.Create(sFile, fmOpenRead); 
  try 
    ReadLen := f.read(Sig[0], SizeOf(Sig)); 

    for x := Low(Sig) to High(Sig) do 
      if Sig[x] <> ValidSig[x] then ReadLen := 0; 

    if ReadLen > 0 then 
    begin 
      ReadLen := f.read(Seg, 1); 
      while (Seg = $FF) and (ReadLen > 0) do 
      begin 
        ReadLen := f.read(Seg, 1); 
        if Seg <> $FF then 
        begin 
          if (Seg = $C0) or (Seg = $C1) then 
          begin 
            ReadLen := f.read(Dummy[0], 3); { don't need these bytes } 
            wHeight := ReadMWord(f); 
            wWidth  := ReadMWord(f); 
          end  
          else  
          begin 
            if not (Seg in Parameterless) then 
            begin 
              Len := ReadMWord(f); 
              f.Seek(Len - 2, 1); 
              f.read(Seg, 1); 
            end  
            else 
              Seg := $FF; { Fake it to keep looping. } 
          end; 
        end; 
      end; 
    end; 
  finally 
    f.Free; 
  end; 
end; 

procedure GetPNGSize(const sFile: string; var wWidth, wHeight: Word); 
type 
  TPNGSig = array[0..7] of Byte; 
const 
  ValidSig: TPNGSig = (137,80,78,71,13,10,26,10); 
var 
  Sig: TPNGSig; 
  f: tFileStream; 
  x: integer; 
begin 
  FillChar(Sig, SizeOf(Sig), #0); 
  f := TFileStream.Create(sFile, fmOpenRead); 
  try 
    f.read(Sig[0], SizeOf(Sig)); 
    for x := Low(Sig) to High(Sig) do 
      if Sig[x] <> ValidSig[x] then Exit; 
    f.Seek(18, 0); 
    wWidth := ReadMWord(f); 
    f.Seek(22, 0); 
    wHeight := ReadMWord(f); 
  finally 
    f.Free; 
  end; 
end; 


procedure GetGIFSize(const sGIFFile: string; var wWidth, wHeight: Word); 
type 
  TGIFHeader = record 
    Sig: array[0..5] of char; 
    ScreenWidth, ScreenHeight: Word; 
    Flags, Background, Aspect: Byte; 
  end; 

  TGIFImageBlock = record 
    Left, Top, Width, Height: Word; 
    Flags: Byte; 
  end; 
var 
  f: file; 
  Header: TGifHeader; 
  ImageBlock: TGifImageBlock; 
  nResult: integer; 
  x: integer; 
  c: char; 
  DimensionsFound: boolean; 
begin 
  wWidth  := 0; 
  wHeight := 0; 

  if sGifFile = '' then 
    Exit; 

  {$I-} 
  FileMode := 0;   { read-only } 
  AssignFile(f, sGifFile); 
  reset(f, 1); 
  if IOResult <> 0 then 
    { Could not open file } 
    Exit; 

  { Read header and ensure valid file. } 
  BlockRead(f, Header, SizeOf(TGifHeader), nResult); 
  if (nResult <> SizeOf(TGifHeader)) or (IOResult <> 0) or 
    (StrLComp('GIF', Header.Sig, 3) <> 0) then 
  begin 
    { Image file invalid } 
    Close(f); 
    Exit; 
  end; 

  { Skip color map, if there is one } 
  if (Header.Flags and $80) > 0 then 
  begin 
    x := 3 * (1 shl ((Header.Flags and 7) + 1)); 
    Seek(f, x); 
    if IOResult <> 0 then 
    begin 
      { Color map thrashed } 
      Close(f); 
      Exit; 
    end; 
  end; 

  DimensionsFound := False; 
  FillChar(ImageBlock, SizeOf(TGIFImageBlock), #0); 
  { Step through blocks. } 
  BlockRead(f, c, 1, nResult); 
  while (not EOF(f)) and (not DimensionsFound) do 
  begin 
    case c of 
      ',': { Found image } 
        begin 
          BlockRead(f, ImageBlock, SizeOf(TGIFImageBlock), nResult); 
          if nResult <> SizeOf(TGIFImageBlock) then  
          begin 
            { Invalid image block encountered } 
            Close(f); 
            Exit; 
          end; 
          wWidth := ImageBlock.Width; 
          wHeight := ImageBlock.Height; 
          DimensionsFound := True; 
        end; 
      'y': { Skip } 
        begin 
          { NOP } 
        end; 
      { nothing else.  just ignore } 
    end; 
    BlockRead(f, c, 1, nResult); 
  end; 
  Close(f); 
  {$I+} 
end; 

end. 

Взято с сайта




Как узнать размеры шрифтов в Windows?


Как узнать размеры шрифтов в Windows?



GetTextMetrics()

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



Как определить, какой шрифт установлен в системе, большой или маленький

Следующуя функция возвращает true, если маленькие шрифты установлены в системе. Так же можно заменить строку 'Result := (GetDeviceCaps(DC, logpixelsx) = 96);' на 'Result := (GetDeviceCaps(DC, logpixelsx) = 120);' чтобы определять - установлены ли в системе крупные шрифты.

Function UsesSmallFonts: boolean; 
var 
DC: HDC; 
begin 
DC := GetDC(0);   
Result := (GetDeviceCaps(DC, logpixelsx) = 96);   
ReleaseDC(0, DC);   
end; 

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



Как узнать разрешение экрана?


Как узнать разрешение экрана?



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


TScreen.WIdth/Height
Автор Song
Взято с Vingrad.ru





Как узнать серийный номер аудио CD?


Как узнать серийный номер аудио CD?





CD может иметь или не иметь серийный номер и/или универсальный код продукта (Universal Product Code). MCI-расширение Windows предоставляет эту информации с помощью комманды MCI_INFO_MEDIA_IDENTITY command. Эта команда возвращает уникальную ID-строку.
Пример:

usesMMSystem, MPlayer;

procedure TForm1.Button1Click(Sender: TObject);
var
   mp : TMediaPlayer;
   msp : TMCI_INFO_PARMS;
   MediaString : array[0..255] of char;
   ret : longint;
begin
   mp := TMediaPlayer.Create(nil);
   mp.Visible := false;
   mp.Parent := Application.MainForm;
   mp.Shareable := true;
   mp.DeviceType := dtCDAudio;
   mp.FileName := 'D:';
   mp.Open;
   Application.ProcessMessages;
   FillChar(MediaString, sizeof(MediaString), #0);
   FillChar(msp, sizeof(msp), #0);
   msp.lpstrReturn := @MediaString;
   msp.dwRetSize := 255;
   ret := mciSendCommand(Mp.DeviceId, MCI_INFO, MCI_INFO_MEDIA_IDENTITY,
         longint(@msp));
   if Ret <> 0 then
      begin
         MciGetErrorString(ret, @MediaString, sizeof(MediaString));
         Memo1.Lines.Add(StrPas(MediaString));
      end
   else
      Memo1.Lines.Add(StrPas(MediaString));
   mp.Close;
   Application.ProcessMessages;
   mp.free;
end;
end.


Взято из
DELPHI VCL FAQ

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




Как узнать состояние клавиши CAPS LOCK?


Как узнать состояние клавиши CAPS LOCK?



function IsCapsLockOn : Boolean; 
begin 
  Result := 0 <> (GetKeyState(VK_CAPITAL) and $01); 
end;

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



Как узнать состояние модема в Win32?


Как узнать состояние модема в Win32?



Следующий пример демонстрирует получение состояния управляющих регистров модема.

Пример:

procedure TForm1.Button1Click(Sender: TObject); 
var 
  CommPort : string; 
  hCommFile : THandle; 
  ModemStat : DWord; 
begin 
  CommPort := 'COM2'; 

{Открываем com-порт} 
  hCommFile := CreateFile(PChar(CommPort), 
                          GENERIC_READ, 
                          0, 
                          nil, 
                          OPEN_EXISTING, 
                          FILE_ATTRIBUTE_NORMAL, 
                          0); 
  if hCommFile = INVALID_HANDLE_VALUE then 
  begin 
    ShowMessage('Unable to open '+ CommPort); 
    exit; 
  end; 

{Получаем состояние модема} 
  if GetCommModemStatus(hCommFile, ModemStat) <> false then begin 
    if ModemStat and MS_CTS_ON <> 0 then 
      ShowMessage('The CTS (clear-to-send) is on.'); 
    if ModemStat and MS_DSR_ON <> 0 then 
      ShowMessage('The DSR (data-set-ready) is on.'); 
    if ModemStat and MS_RING_ON <> 0then 
      ShowMessage('The ring indicator is on.'); 
    if ModemStat and MS_RLSD_ON <> 0 then 
      ShowMessage('The RLSD (receive-line-signal-detect) is 
on.'); 
end; 

{Закрываем com-порт} 
  CloseHandle(hCommFile); 
end;

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





Как узнать состояние памяти?


Как узнать состояние памяти?

   


var 
  Status : TMemoryStatus; 
begin 
  Status.dwLength := sizeof( TMemoryStatus ); 
  GlobalMemoryStatus( Status ); 
... 

После этого TMemoryStatus будет содержать следующие паоля:

Status.dwMemoryLoad: Количество используемой памяти в процентах (%).
Status.dwTotalPhys: Общее количество физической памяти в байтах.
Status.dwAvailPhys: Количество оставшейся физической памяти в байтах.
Status.dwTotalPageFile: Объём страничного файла в байтах.
Status.dwAvailPageFile: Свободного места в страничном файле.
Status.dwTotalVirtual: Общий объём виртуальной памяти в байтах.
Status.dwAvailVirtual: Количество свободной виртуальной памяти в байтах.

Предваритель, желательно преобразовать эти значения в гига-, мега- или килобайты, например так:

label14.Caption := 'Total Ram: ' + IntToStr(Status.dwTotalPhys div 1024417) + 'meg';

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




Как узнать существует ли страница (worksheet)?


Как узнать существует ли страница (worksheet)?





{... }
WB := Excel.Workbooks[1];
for Idx := 1 to WB.Worksheets.Count do
  if WB.Worksheets[Idx].Name = 'first' then
    Showmessage('Found the worksheet');
{ ... }

Взято с

Delphi Knowledge Base






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


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





uses 
  WinInet; 

const 
  MODEM = 1; 
  LAN = 2; 
  PROXY = 4; 
  BUSY = 8; 

function GetConnectionKind(var strKind: string): Boolean; 
var 
  flags: DWORD; 
begin 
  strKind := ''; 
  Result := InternetGetConnectedState(@flags, 0); 
  if Result then 
  begin 
    if (flags and MODEM) = MODEM then strKind := 'Modem'; 
    if (flags and LAN) = LAN then strKind := 'LAN'; 
    if (flags and PROXY) = PROXY then strKind := 'Proxy'; 
    if (flags and BUSY) = BUSY then strKind := 'Modem Busy'; 
  end; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
var 
  strKind: string; 
begin 
  if GetConnectionKind(strKind) then 
    ShowMessage(strKind); 
end; 

Взято с сайта



Как узнать установлен ли activeX на машине?


Как узнать установлен ли activeX на машине?





{... }
var
  strOLE: string;
begin
  strOLE = "YourCOMServer.Application" {your ProgID}
  if (CLSIDFromProgID(PWideChar(WideString(strOLE), ClassID) = S_OK) then
    begin
      { ... }
    end;
end;


{ ... }
const
  cKEY = '\SOFTWARE\Classes\CLSID\%s\InprocServer32'
  var
  sKey: string;
  sComServer: string;
  exists: boolean;
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    sKey := format(cKEY, [GuidToString(ClassID)]);
    if Reg.OpenKey(sKey, False) then
    begin
      sComServer := Reg.ReadString('');
      if FileExists(sComServer) then
      begin
        { ... }
      end;
    end;
  finally
    Reg.free;
  end;
end;


Взято с

Delphi Knowledge Base






Как узнать версию ADO?


Как узнать версию ADO?





{
  With different versions of MDAC available it is sometimes 
  useful to know that your application won't fail because a user 
  hasn't got the latest version installed. 
  The following function returns the ADO version installed, 
  you need to place ComObj in the uses clause to use this function. 


function GetADOVersion: Double; 
var 
  ADO: OLEVariant; 
begin 
  try 
    ADO    := CreateOLEObject('adodb.connection'); 
    Result := StrToFloat(ADO.Version); 
    ADO    := Null; 
  except 
    Result := 0.0; 
  end; 
end; 

// To use this function try something like: 

procedure TForm1.Button1Click(Sender: TObject); 
const 
  ADOVersionNeeded = 2.5; 
begin 
  if GetADOVersion then 
    ShowMessage('Need to install MDAC version 2.7') 
  else 
    ShowMessage(Format('ADO Version %n, is OK', [GetADOVersion])); 
end; 


Взято с сайта



function TfrmMain.GetADOVersion: Double;
var
  ADO: OLEVariant;
begin
  try
    ADO := CreateOLEObject('adodb.connection');
    Result := StrToFloat(ADO.Version);
    ADO := Null;
  except
    Result := 0.0;
  end;
end;

Взято из







Как узнать версию BDE?


Как узнать версию BDE?





uses 
  BDE; 

{Without the Registry:} 

procedure TForm1.Button1Click(Sender: TObject); 
var 
  ThisVersion: SYSVersion; 
begin 
  DbiGetSysVersion(ThisVersion); 
  ShowMessage('BORLAND DATABASE ENGINE VERSION = ' + IntToStr(ThisVersion.iVersion)); 
end; 

{With the Registry:} 

function GetBDEVersion: string; 
var 
  h: hwnd; 
  ptr: Pointer; 
  proc: TSYSVerProc; 
  ver: SYSVersion; 
  idapi: string; 
  reg: TRegistry; 
begin 
  try 
    reg.RootKey := HKEY_CLASSES_ROOT; 
    reg.OpenKey('CLSID\{FB99D710-18B9-11D0-A4CF-00A024C91936}\InProcServer32', False); 
    idapi := reg.ReadString(''); 
    reg.CloseKey; 
  finally 
    reg.Free; 
  end; 
  Result := '<BDE Bulunamadi>'; 
  h      := LoadLibrary(PChar(idapi)); 
  if h <> 0 then  
    try 
      ptr := GetProcAddress(h, 'DbiGetSysVersion'); 
      if ptr <> nil then  
      begin 
        proc := ptr; 
        Proc(Ver); 
        Result := IntToStr(ver.iVersion); 
        Insert('.', Result, 2); 
      end; 
    finally 
      FreeLibrary(h); 
    end; 
end;

Взято с сайта



Как узнать версию Internet Explorer?


Как узнать версию Internet Explorer?





uses 
  Registry; 

function GetIEVersion(Key: string): string; 
var 
  Reg: TRegistry; 
begin 
  Reg := TRegistry.Create; 
  try 
    Reg.RootKey := HKEY_LOCAL_MACHINE; 
    Reg.OpenKey('Software\Microsoft\Internet Explorer', False); 
    try 
      Result := Reg.ReadString(Key); 
    except 
      Result := ''; 
    end; 
    Reg.CloseKey; 
  finally 
    Reg.Free; 
  end; 
end; 


procedure TForm1.Button1Click(Sender: TObject); 
begin 
  ShowMessage('IE-Version: ' + GetIEVersion('Version')[1] + '.' + GetIEVersion('Version')[3]); 
  ShowMessage('IE-Version: ' + GetIEVersion('Version')); 
  // <major version>.<minor version>.<build number>.<sub-build number> 
end; 


Взято с сайта



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


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



Иногда надо выполнить разный код в зависимости от версии Дельфи, особенно актуально это при разработки компонентов и модулей, которые используются в разных приложениях.

В Дельфи предопределены специальные константы компиляции для этого:

Ver80 - Дельфи 1
Ver90 - Дельфи 2
Ver93 - С Buider 1
Ver100 - Дельфи 3
Ver110 - С Buider 3
Ver120 - Дельфи 4
Ver125 - С Buider 4
Ver130 - Дельфи 5
Ver140 - Дельфи 6
Ver150 - Дельфи 7

Пример использования:

procedure TForm1.Button2Click(Sender: TObject);
const Version=
{$Ifdef Ver80}'Дельфи 1';{$EndIf}    
{$Ifdef Ver90}'Дельфи 2';{$EndIf}   
{$Ifdef Ver100}'Дельфи 3';{$EndIf}  
{$Ifdef Ver120}'Дельфи 4';{$EndIf}   
{$Ifdef Ver130}'Дельфи 5 ';{$EndIf}  
{$Ifdef Ver140}'Дельфи 6';{$EndIf}  
{$Ifdef Ver150}'Дельфи 7';{$EndIf}   
begin
  ShowMessage('Для компиляции этой программы был использован '+Version);
end;

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




Как узнать версию MS Word?


Как узнать версию MS Word?





{... }
MsWord := CreateOleObject('Word.Basic');
try
  {Return Application Info. This call is the same for English and 
   French Microsoft Word.}
  Lang := MsWord.AppInfo(Integer(16));
except
  try
    {For German Microsoft Word the procedure name is translated}
    Lang := MsWord.AnwInfo(Integer(16));
  except
    try
      {For Swedish Microsoft Word the procedure name is translated}
      Lang := MsWord.PrgmInfo(Integer(16));
    except
      try
        {For Dutch Microsoft Word the procedure name is translated}
        Lang := MsWord.ToepasInfo(Integer(16));
      except
        {If this procedure does not exist there is a different translation
           of Microsoft Word}
        ShowMessage('Microsoft Word version is not German, French, Dutch, Swedish
             or English.');
        Exit;
      end;
    end;
  end;
end;
ShowMessage(Lang);
{ ... }


Взято с

Delphi Knowledge Base






Как узнать версию программы?


Как узнать версию программы?




function FileVersion(AFileName:string): string;
var
  szName: array[0..255] of Char;
  P: Pointer;
  Value: Pointer;
  Len: UINT;
  GetTranslationString:string;
  FFileName: PChar;
  FValid:boolean;
  FSize: DWORD;
  FHandle: DWORD;
  FBuffer: PChar;
begin
  try
    FFileName := StrPCopy(StrAlloc(Length(AFileName) + 1), AFileName);
    FValid := False;
    FSize := GetFileVersionInfoSize(FFileName, FHandle);
    if FSize > 0 then
      try
        GetMem(FBuffer, FSize);
        FValid := GetFileVersionInfo(FFileName, FHandle, FSize, FBuffer);
      except
        FValid := False;
        raise;
      end;
    Result := '';
    if FValid then
      VerQueryValue(FBuffer, '\VarFileInfo\Translation', p, Len)
    else p := nil;
    if P <> nil then
      GetTranslationString := IntToHex(MakeLong(HiWord(Longint(P^)), LoWord(Longint(P^))), 8);
    if FValid then
      begin
        StrPCopy(szName, '\StringFileInfo\' + GetTranslationString + '\FileVersion');
        if VerQueryValue(FBuffer, szName, Value, Len) then
          Result := StrPas(PChar(Value));
      end;
  finally
    try
      if FBuffer <> nil then FreeMem(FBuffer, FSize);
    except
    end;
    try
      StrDispose(FFileName);
    except
    end;
  end;
end;


В качестве параметра задать имя программы, если своей программы:

FileVersion(Paramstr(0));

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




Как узнать версию сервера?


Как узнать версию сервера?





This function gets the connected MS SQL Server version. It returns the version info in 3 OUT parameters.

VerNum         : double    eg. 7.00623
   VerStrShort    : string       eg. '7.00.623'
   VerStrLong    : string       eg. 'Microsoft SQL Server 7.00 - 7.00.623 (Intel X86)    Nov 27 1998 22:20:07 Copyright (c) 1988-1998 Microsoft Corporation   Enterprise Edition on Windows NT 5.0 (Build 2195: Service Pack 1)'

I have tested it with MSSQL 7 and MSSQL 2000. I assume it should work for the others. Any feedback and fixes for different versions would be appreciated.

The TQuery parameter that it recieves is a TQuery component that is connected to an open database connection.

procedure GetSqlVersion(Query: TQuery;
  out VerNum: double;
  out VerStrShort: string;
  out VerStrLong: string);
var
  sTmp, sValue: string;
  i: integer;
begin
  // @@Version does not return a Cursor.
  // Read the value from the Record Buffer
  // Can be used to read all sys functions from MS Sql
  sValue := '';
  Query.SQL.Text := 'select @@Version';
  Query.Open;
  SetLength(sValue, Query.RecordSize + 1);
  Query.GetCurrentRecord(PChar(sValue));
  SetLength(sValue, StrLen(PChar(sValue)));
  Query.Close;

  if sValue <> '' then
    VerStrLong := sValue
  else
  begin
    // Don't know this version
    VerStrLong := '?';
    VerNum := 0.0;
    VerStrShort := '?.?.?.?';
  end;

  if VerStrLong <> '' then
  begin
    sTmp := trim(copy(VerStrLong, pos('-', VerStrLong) + 1, 1024));
    VerStrShort := copy(sTmp, 1, pos(' ', sTmp) - 1);
    sTmp := copy(VerStrShort, 1, pos('.', VerStrShort));

    for i := length(sTmp) + 1 to length(VerStrShort) do
    begin
      if VerStrShort[i] <> '.' then
        sTmp := sTmp + VerStrShort[i];
    end;

    VerNum := StrToFloat(sTmp);
  end;
end;

Взято с

Delphi Knowledge Base




Как узнать загрузку процессора? (NT/2000/XP)


Как узнать загрузку процессора? (NT/2000/XP)




const 
  SystemBasicInformation = 0; 
  SystemPerformanceInformation = 2; 
  SystemTimeInformation = 3; 

type 
  TPDWord = ^DWORD; 

  TSystem_Basic_Information = packed record 
    dwUnknown1: DWORD; 
    uKeMaximumIncrement: ULONG; 
    uPageSize: ULONG; 
    uMmNumberOfPhysicalPages: ULONG; 
    uMmLowestPhysicalPage: ULONG; 
    uMmHighestPhysicalPage: ULONG; 
    uAllocationGranularity: ULONG; 
    pLowestUserAddress: Pointer; 
    pMmHighestUserAddress: Pointer; 
    uKeActiveProcessors: ULONG; 
    bKeNumberProcessors: byte; 
    bUnknown2: byte; 
    wUnknown3: word; 
  end; 

type 
  TSystem_Performance_Information = packed record 
    liIdleTime: LARGE_INTEGER; {LARGE_INTEGER} 
    dwSpare: array[0..75] of DWORD; 
  end; 

type 
  TSystem_Time_Information = packed record 
    liKeBootTime: LARGE_INTEGER; 
    liKeSystemTime: LARGE_INTEGER; 
    liExpTimeZoneBias: LARGE_INTEGER; 
    uCurrentTimeZoneId: ULONG; 
    dwReserved: DWORD; 
  end; 

var 
  NtQuerySystemInformation: function(infoClass: DWORD; 
    buffer: Pointer; 
    bufSize: DWORD; 
    returnSize: TPDword): DWORD; stdcall = nil; 


  liOldIdleTime: LARGE_INTEGER = (); 
  liOldSystemTime: LARGE_INTEGER = (); 

function Li2Double(x: LARGE_INTEGER): Double; 
begin 
  Result := x.HighPart * 4.294967296E9 + x.LowPart 
end; 

procedure GetCPUUsage; 
var 
  SysBaseInfo: TSystem_Basic_Information; 
  SysPerfInfo: TSystem_Performance_Information; 
  SysTimeInfo: TSystem_Time_Information; 
  status: Longint; {long} 
  dbSystemTime: Double; 
  dbIdleTime: Double; 

  bLoopAborted : boolean; 

begin 
  if @NtQuerySystemInformation = nil then 
    NtQuerySystemInformation := GetProcAddress(GetModuleHandle('ntdll.dll'), 
      'NtQuerySystemInformation'); 

  // get number of processors in the system 

  status := NtQuerySystemInformation(SystemBasicInformation, @SysBaseInfo, SizeOf(SysBaseInfo), nil); 
  if status <> 0 then Exit; 

  // Show some information 
  with SysBaseInfo do 
  begin 
      ShowMessage( 
      Format('uKeMaximumIncrement: %d'#13'uPageSize: %d'#13+ 
      'uMmNumberOfPhysicalPages: %d'+#13+'uMmLowestPhysicalPage: %d'+#13+ 
      'uMmHighestPhysicalPage: %d'+#13+'uAllocationGranularity: %d'#13+ 
      'uKeActiveProcessors: %d'#13'bKeNumberProcessors: %d', 
      [uKeMaximumIncrement, uPageSize, uMmNumberOfPhysicalPages, 
      uMmLowestPhysicalPage, uMmHighestPhysicalPage, uAllocationGranularity, 
      uKeActiveProcessors, bKeNumberProcessors])); 
  end; 


  bLoopAborted := False; 

  while not bLoopAborted do 
  begin 

    // get new system time 
    status := NtQuerySystemInformation(SystemTimeInformation, @SysTimeInfo, SizeOf(SysTimeInfo), 0); 
    if status <> 0 then Exit; 

    // get new CPU's idle time 
    status := NtQuerySystemInformation(SystemPerformanceInformation, @SysPerfInfo, SizeOf(SysPerfInfo), nil); 
    if status <> 0 then Exit; 

    // if it's a first call - skip it 
    if (liOldIdleTime.QuadPart <> 0) then 
    begin 

      // CurrentValue = NewValue - OldValue 
      dbIdleTime := Li2Double(SysPerfInfo.liIdleTime) - Li2Double(liOldIdleTime); 
      dbSystemTime := Li2Double(SysTimeInfo.liKeSystemTime) - Li2Double(liOldSystemTime); 

      // CurrentCpuIdle = IdleTime / SystemTime 
      dbIdleTime := dbIdleTime / dbSystemTime; 

      // CurrentCpuUsage% = 100 - (CurrentCpuIdle * 100) / NumberOfProcessors 
      dbIdleTime := 100.0 - dbIdleTime * 100.0 / SysBaseInfo.bKeNumberProcessors + 0.5; 

      // Show Percentage 
      Form1.Label1.Caption := FormatFloat('CPU Usage: 0.0 %',dbIdleTime); 

      Application.ProcessMessages; 

      // Abort if user pressed ESC or Application is terminated 
      bLoopAborted := (GetKeyState(VK_ESCAPE) and 128 = 128) or Application.Terminated; 

    end; 

    // store new CPU's idle and system time 
    liOldIdleTime := SysPerfInfo.liIdleTime; 
    liOldSystemTime := SysTimeInfo.liKeSystemTime; 

    // wait one second 
    Sleep(1000); 
  end; 
end; 


procedure TForm1.Button1Click(Sender: TObject); 
begin 
  GetCPUUsage 
end; 

Взято с сайта




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


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



procedure TForm1.DBGrid1KeyUp(Sender: TObject; 
                              var Key: Word; Shift: TShiftState); 
var 
  B: byte; 

begin 
  for B := 0 to DBGrid1.ControlCount - 1 do 
  if DBGrid1.Controls[B] is TInPlaceEdit then 
  begin 
    with DBGrid1.Controls[B] as TInPlaceEdit do 
    begin 
      Label1.Caption := 'Text = ' + Text; 
    end; 
  end; 
end; 

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



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


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



Цвет Текста задается командой SetTextColor(Color), параметр Color - целое число от 0 до 15.
Вывод текста в указанном месте экрана задается командой GotoXY(X,Y,Text).
X,Y-координаты экрана.
Text - переменная типа String.
Ответ 3:
Вот текст модуля, напоминающего про наш любимый ДОС (CRT-like):

unit UffCRT;
// written by Michael Uskoff, Apr 2001, St.Petersburg, RUSSIA

interface

procedure ClrScr;
procedure SetAttr(attr: word);
function GetAttr: word;
procedure GotoXY(aX, aY: integer); // zero-based coords
function WhereX: integer;
function WhereY: integer;

implementation

uses Windows;

var
  UpperLeft: TCoord = (X: 0; Y: 0);
  hCon: integer;

procedure GotoXY(aX, aY: integer);
var aCoord: TCoord;
begin
  aCoord.x := aX;
  aCoord.y := aY;
  SetConsoleCursorPosition(hCon, aCoord);
end;

procedure SetAttr(attr: word);
begin
  SetConsoleTextAttribute(hCon, attr);
end;

function WhereX: integer;
var ScrBufInfo: TConsoleScreenBufferInfo;
begin
  GetConsoleScreenBufferInfo(hCon, ScrBufInfo);
  Result := ScrBufInfo.dwCursorPosition.x;
end;

function WhereY: integer;
var ScrBufInfo: TConsoleScreenBufferInfo;
begin
  GetConsoleScreenBufferInfo(hCon, ScrBufInfo);
  Result := ScrBufInfo.dwCursorPosition.y;
end;

function GetAttr: word;
var ScrBufInfo: TConsoleScreenBufferInfo;
begin
  GetConsoleScreenBufferInfo(hCon, ScrBufInfo);
  Result := ScrBufInfo.wAttributes;
end;

procedure ClrScr;
var fill: integer;
  ScrBufInfo: TConsoleScreenBufferInfo;
begin
  GetConsoleScreenBufferInfo(hCon, ScrBufInfo);
  fill := ScrBufInfo.dwSize.x * ScrBufInfo.dwSize.y;
  FillConsoleOutputCharacter(hCon, ' ', fill, UpperLeft, fill);
  FillConsoleOutputAttribute(hCon, ScrBufInfo.wAttributes, fill, UpperLeft, fill);
  GotoXY(0, 0);
end;

initialization
  hCon := GetStdHandle(STD_OUTPUT_HANDLE);
end.

Теперь можно творить такое:

uses UffCRT;
....
ClrScr;
SetAttr($1E);
GotoXY(32, 12);
Write('Hello, master !');
ReadLn;
...


Взято с сайта



Как в ListBox нарисовать Item своим цветом?


Как в ListBox нарисовать Item своим цветом?





procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; 
Rect: TRect; State: TOwnerDrawState); 
begin 
With ListBox1 do   
begin   
If odSelected in State then   
  Canvas.Brush.Color:=clTeal { твой цвет }   
else   
  Canvas.Brush.Color:=clWindow;   
Canvas.FillRect(Rect);   
Canvas.TextOut(Rect.Left+2,Rect.Top,Items[Index]);   
end;   
end; 

Hе забудьте установить свойство Style у своего ListBox в lbOwnerDrawFixed или в
lbOwnerDrawVariable.

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



Как в run-time Action добавить в ActionList?


Как в run-time Action добавить в ActionList?




var
  NewAction : TAction;
begin
  NewAction := TAction.Create(self);
  NewAction.ActionList := ActionList1;
end; 

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




Как в TBlobField запихать картинку из переменной типа TBitmap?


Как в TBlobField запихать картинку из переменной типа TBitmap?



1) LoadFromStream/SaveToStream

2) TBlobField.assign

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




Как включить/отключить хранитель экрана?


Как включить/отключить хранитель экрана?



procedure TForm1.Button1Click(Sender: TObject);
begin
{Turn it off}
  SystemParametersInfo(SPI_SETSCREENSAVEACTIVE,
                       0,
                       nil,
                       0);
{Turn it on}
  SystemParametersInfo(SPI_SETSCREENSAVEACTIVE,
                       1,
                       nil,
                       0);
end;



Как включить/выключить спикер?


Как включить/выключить спикер?





Это выключит спикеp:
SyStemParametersInfo(SPI_SETBEEP,0,nil,SPIF_UPDATEINIFILE);

Это включит:
  SyStemParametersInfo(SPI_SETBEEP,1,nil,SPIF_UPDATEINIFILE);


Alexey Lesovik
(2:5020/898.15)

Взято из

FAQ:
Delphi and Windows API Tips'n'Tricks
olmal@mail.ru
http://www.chat.ru/~olmal




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


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




Используте функцию Windows API - GetStockObject() чтобы получить дескриптор (handle) шрифта по умолчанию устройства (DEVICE_DEFAULT_FONT) и передайте его Printer.Font.Handle.

uses Printers;

procedure TForm1.Button1Click(Sender: TObject);
var
  tm: TTextMetric;
  i: integer;
begin
  if PrintDialog1.Execute then
    begin
      Printer.BeginDoc;
      Printer.Canvas.Font.Handle := GetStockObject(DEVICE_DEFAULT_FONT);
      GetTextMetrics(Printer.Canvas.Handle, tm);
      for i := 1 to 10 do
        begin
          Printer.Canvas.TextOut(100, i * tm.tmHeight +
            tm.tmExternalLeading, 'Test');
        end;
      Printer.EndDoc;
    end;
end;



Как внести изменения в код VCL?


Как внести изменения в код VCL?




Примечание: внесение изменений в VCL не поддерживается Borland или Borland Developer Support.
-Но если Вы решили сделать это...
Изменения в код VCL никогда не должны вносится в секцию "interface" модуля - только в секцию "implimentation". Наиболее безопасный способ внести изменения в VCL - создать новый каталог названный "исправленный VCL". Скопируйте файл VCL который Вы хотите изменить в этот каталог. Внесите изменения (лучше прокомментировать их) в этот файл. Затем добавьте путь к Вашему каталогу "исправленный VCL" в самое начало "library path". Перезапустите Delphi/C++ Builder и перекомпилируйте Ваш проект. "library path" можно изменить в меню:

Delphi 1 : Options | Environment | Library
Delphi 2 : Tools | Options | Library
Delphi 3 : Tools | Environment Options | Library
Delphi 4 : Tools | Environment Options | Library
C++ Builder : Options | Environment | Library





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


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





Problem/Question/Abstract:


Recently I got unique key violations during insert attempts on a piece of code that used to work (what can go bad, will go bad). I found that the offending field - was actually created by a generator. For some reason the generator returned values that where already in the database.

·how can I display the current value of the generator?
·how can I adjust the value of the generator?  

Answer:

See the example (table name is SD_LOAD, generator name is GEN_SD_LOAD).

Note:

You cannot modify the value of the generator inside of a trigger or stored procedure. You only can call the gen_id() function to increment the value in a generator. The SET GENERATOR command will only work outside of a stored procedure or trigger.

SELECT DISTINCT(GEN_ID(gen_sd_load, 0))FROM sd_load

set GENERATOR gen_sd_load to 2021819

Взято с

Delphi Knowledge Base




Как восстановить индекс Paradox?


Как восстановить индекс Paradox?





BDE включает функцию для этого - DbiRegenIndexes.



Copyright © 1996 Epsylon Technologies


Взято из

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




Как вращать текст


Как вращать текст



procedure TextOutAngle(x,y,aAngle,aSize: integer; txt: string); 
var hFont, Fontold: integer; 
    DC: hdc; 
    Fontname: string; 
begin 
  if length(txt)= 0 then 
    EXIT; 
  DC:= Screen.ActiveForm.Canvas.handle; 
  SetBkMode(DC, transparent); 
  Fontname:= Screen.ActiveForm.Canvas.Font.Name; 
  hFont:= CreateFont(-aSize,0, aAngle*10,0, fw_normal,0, 0, 
                     0,1,4,$10,2,4,PChar(Fontname)); 
  Fontold:= SelectObject(DC, hFont); 
  TextOut(DC,x,y,PChar(txt), length(txt)); 
  SelectObject(DC, Fontold); 
  DeleteObject(hFont); 
end; 

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



Как вставить картинку


Как вставить картинку





Answer:


If WS is your worksheet:

{... }
WS.Shapes.AddPicture('C:\Pictures\Small.Bmp', EmptyParam, EmptyParam, 10, 160,
  EmptyParam, EmptyParam);

or

{ ... }
var
  Pics: Excel2000.Pictures; {or whichever Excel}
  Pic: Excel2000.Picture;
  Pic: Excel2000.Shape;
  Left, Top: integer;
{ ... }
Pics := (WS.Pictures(EmptyParam, 0) as Pictures);
Pic := Pics.Insert('C:\Pictures\Small.Bmp', EmptyParam);
Pic.Top := WS.Range['D4', 'D4'].Top;
Pic.Left := WS.Range['D4', 'D4'].Left;
{ ... }

EmptyParam a special variant (declared in Variants.pas in D6+). However in later versions of Delphi some conversions cause problems. This should work:

uses

  OfficeXP;

{ ... }
WS.Shapes.AddPicture('H:\Pictures\Game\Hills.bmp', msoFalse, msoTrue, 10, 160, 100,
  100);

But you may have to use a TBitmap to find out how large the picture should be.

Взято с

Delphi Knowledge Base






Как вставить картинку в RichEdit?


Как вставить картинку в RichEdit?



В стандартном RichEdit нельзя, для RichEdit с картинками используйте RichEdit из RxLib или JVCL.


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


Ниже представлен пример, который можно применить к RxRichEdit, RichEditEx, RichEdit98, и Microsoft RichTextBox (поставляемый с VB5+) не прибегая к использованию буфера обмена или OLE:

function BitmapToRTF(pict: TBitmap): string;
var
  bi,bb,rtf: string;
  bis,bbs: Cardinal;
  achar: ShortString;
  hexpict: string;
  I: Integer;
begin
  GetDIBSizes(pict.Handle,bis,bbs);
  SetLength(bi,bis);
  SetLength(bb,bbs);
  GetDIB(pict.Handle,pict.Palette,PChar(bi)^,PChar(bb)^);
  rtf := '{\rtf1 {\pict\dibitmap ';
  SetLength(hexpict,(Length(bb) + Length(bi)) * 2);
  I := 2;
  for bis := 1 to Length(bi) do
  begin
    achar := Format('%x',[Integer(bi[bis])]);
    if Length(achar) = 1 then
      achar := '0' + achar;
    hexpict[I-1] := achar[1];
    hexpict[I] := achar[2];
    Inc(I,2);
  end;
  for bbs := 1 to Length(bb) do
  begin
    achar := Format('%x',[Integer(bb[bbs])]);
    if Length(achar) = 1 then
      achar := '0' + achar;
    hexpict[I-1] := achar[1];
    hexpict[I] := achar[2];
    Inc(I,2);
  end;
  rtf := rtf + hexpict + ' }}';
  Result := rtf;
end;

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

{SS это TStringStream, RE это TRxRichEdit, а BMP это TBitmap содержащий картинку.}
SS := TStringStream.Create(BitmapToRTF(BMP));
RE.PlainText := False;
RE.StreamMode := [smSelection];
RE.Lines.LoadFromStream(SS);
SS.Free;

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





Как вставить конец страницы?


Как вставить конец страницы?





{... }
Excel.ActiveWindow.View := xlPageBreakPreview;
WS.HPageBreaks.Add(WS.Cells.Item[78, 1]);
{ ... }

Взято с

Delphi Knowledge Base






Как вставить растровое изображение в компонент ListBox?


Как вставить растровое изображение в компонент ListBox?



Для этого необходимо установить в инспекторе объектов поле Style в lbOwnerDrawFixed, при фиксированной высоте строки, или в lbOwnerDrawVariable, при переменной, и установить собственный обработчик события для OnDrawItem. В этом обработчике и надо рисовать растровое изображение.
Пример:
Рисуются изображения размером 32*16 (размер стандартного глифа для Delphi). Очень полезно при поиске нужного изображения для кнопок!
Установить в инспекторе объектов для ListBox поле ItemHeight = 19, а поле Color = clBtnFace.


{ Загрузить список файлов в ListBox1 при нажатии на кнопку Load (например)}
procedure TForm1.bLoadClick(Sender: TObject);
VAR S : String; 
begin 
  ListBox1.Clear; {чистим список}
  S := '*.bmp'#0; {задаем шаблон}
  ListBox1.Perform(LB_DIR, DDL_ReadWrite, Longint(@S[1])); {заполняем список} 
end; 
          ............ 

{Отобразить изображения и имена файлов в ListBox}
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: DrawState);
var
  Bitmap: TBitmap;
  Offset: Integer;
  BMPRect: TRect;
begin
  with (Control as TListBox).Canvas do
    begin
      FillRect(Rect);
      Bitmap := TBitmap.Create;
      Bitmap.LoadFromFile(ListBox1.Items[Index]);
      Offset := 0;
      if Bitmap <> nil then
        begin
          BMPRect := Bounds(Rect.Left + 2, Rect.Top + 2,
            (Rect.Bottom - Rect.Top - 2) * 2, Rect.Bottom - Rect.Top - 2);
      {StretchDraw(BMPRect, Bitmap); Можно просто нарисовать, но лучше сначала убрать фон}
          BrushCopy(BMPRect, Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height),
            Bitmap.Canvas.Pixels[0, Bitmap.Height - 1]);
          Offset := (Rect.Bottom - Rect.Top + 1) * 2;
        end;
      TextOut(Rect.Left + Offset, Rect.Top, ListBox1.Items[Index]);
      Bitmap.Free;
    end;
end;

Данный пример работает медленно, но оптимизация, для ускорения, вызвала бы трудность в понимании общего принципа его работы.

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






Как вставить содержимое файла в текущую позицию TMemo?


Как вставить содержимое файла в текущую позицию TMemo?



Для чтения файла будем использовать TMemoryStream, а затем используем метод SetSelTextBuf() из TMemo, чтобы вставить в него текст:

var
  TheMStream : TMemoryStream;
  Zero : char;
begin
  TheMStream := TMemoryStream.Create;
  TheMStream.LoadFromFile('C:\AUTOEXEC.BAT');
  TheMStream.Seek(0, soFromEnd);
//Буфер завершается нулём!
  Zero := #0;
  TheMStream.Write(Zero, 1);
  TheMStream.Seek(0, soFromBeginning);
  Memo1.SetSelTextBuf(TheMStream.Memory);
  TheMStream.Free;
end;

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



Как вставить свой курсор из внешнего файла?


Как вставить свой курсор из внешнего файла?



Используя процедуру LoadCursorFromFile

var
  h: hcursor;
begin
  h := LoadCursorFromFile('D:\mc.cur');
  Screen.Cursors[1] := h;
  Form1.Cursor := 1;
end;



var h: THandle;
begin
  h := LoadImage(0, 'c:\Cursor.cur', IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE or
    LR_LOADFROMFILE);
  if h = 0 then
    ShowMessage('Cursor not loaded!!!')
  else
    begin
      Screen.Cursors[1] := h;
      Form1.Cursor := 1;
    end;
end;



Этот пример позволяет также использовать анимированные курсоры (*.ani)!

Вот кусок кода для загрузки анимированного курсора, который можно вставить в обработку события активизации формы :

var
  h: THandle;
  name: array[0..255] of char;
begin
  StrPCopy(name, 'Animcurs.ani');
  h := LoadImage(0, name, IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE or
    LR_LOADFROMFILE);
  if h <> 0 then
    begin
      Screen.Cursors[1] := h;
      Screen.Cursor := 1;
    end
  else
    Screen.Cursor := crDefault;
end;


Взято с сайта



Как вставить свой пункт меню?


Как вставить свой пункт меню?





{... }
var
  CBar: CommandBar;
  MenuItem: OleVariant;
  { ... }

{ Add an item to the File menu }
  CBar := Word.CommandBars['File'];
  MenuItem := CBar.Controls.Add(msoControlButton, EmptyParam, EmptyParam,
    EmptyParam, True) as CommandBarButton;
  MenuItem.Caption := 'NewMenuItem';
  MenuItem.DescriptionText := 'Does nothing';
{Note that a VB macro with the right name must exist before you assign it to the item!}
  MenuItem.OnAction := 'VBMacroName';
{ ... }


Взято с

Delphi Knowledge Base






Как выбрать цвет пользуя TTrackBar


Как выбрать цвет пользуя TTrackBar





Drop three TrackBars on a form. Set Min to 0, Max to 255. Drop a TImage on the form. Then try this code:

{... }
var
  Form1: TForm1;
  MyColor: LongWord;
  RedColor: LongWord = $00000000;
  GreenColor: LongWord = $00000000;
  BlueColor: LongWord = $00000000;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoImageFill;
end;

procedure TForm1.DoImageFill;
begin
  MyColor := RedColor or GreenColor or BlueColor;
  Image1.Canvas.Brush.Color := TColor(MyColor);
  Image1.Canvas.FillRect(Rect(0, 0, Image1.Width, Image1.Height));
end;

procedure TForm1.RedBarChange(Sender: TObject);
begin
  RedColor := RedBar.Position;
  DoImageFill;
end;

procedure TForm1.GreenBarChange(Sender: TObject);
begin
  GreenColor := GreenBar.Position shl 8;
  DoImageFill;
end;

procedure TForm1.BlueBarChange(Sender: TObject);
begin
  BlueColor := BlueBar.Position shl 16;
  DoImageFill;
end;

end.




Each color value ranges from 0 to 255. Set the three trackbars with this range. You can use the RGB function to create a color from these values.

{ ... }
type
  TForm1 = class(TForm)
    redTrackBar: TTrackBar;
    greenTrackBar: TTrackBar;
    blueTrackBar: TTrackBar;
    Panel1: TPanel;
    procedure blueTrackBarChange(Sender: TObject);
    procedure greenTrackBarChange(Sender: TObject);
    procedure redTrackBarChange(Sender: TObject);
  public
    { Public declarations }
    procedure ChangeColor;
  end;

procedure TForm1.ChangeColor;
begin
  Panel1.Color := RGB(redTrackBar.Position, greenTrackBar.Position, blueTrackBar.Position);
end;

procedure TForm1.blueTrackBarChange(Sender: TObject);
begin
  ChangeColor;
end;

procedure TForm1.greenTrackBarChange(Sender: TObject);
begin
  ChangeColor;
end;

procedure TForm1.redTrackBarChange(Sender: TObject);
begin
  ChangeColor;
end;

Взято с

Delphi Knowledge Base






Как выбрать случайную запись?


Как выбрать случайную запись?





procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Randomize; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Table1.First; 
  Table1.MoveBy(Random(Table1.RecordCount)); 
end; 


Взято с сайта



Как вычислить CRC-32 для файла?


Как вычислить CRC-32 для файла?





// The constants here are for the CRC-32 generator 
// polynomial, as defined in the Microsoft 
// Systems Journal, March 1995, pp. 107 - 108 
const 
  Table: array[0..255] of DWORD = 
    ($00000000, $77073096, $EE0E612C, $990951BA, 
    $076DC419, $706AF48F, $E963A535, $9E6495A3, 
    $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988, 
    $09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91, 
    $1DB71064, $6AB020F2, $F3B97148, $84BE41DE, 
    $1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7, 
    $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC, 
    $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5, 
    $3B6E20C8, $4C69105E, $D56041E4, $A2677172, 
    $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B, 
    $35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940, 
    $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59, 
    $26D930AC, $51DE003A, $C8D75180, $BFD06116, 
    $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F, 
    $2802B89E, $5F058808, $C60CD9B2, $B10BE924, 
    $2F6F7C87, $58684C11, $C1611DAB, $B6662D3D, 

    $76DC4190, $01DB7106, $98D220BC, $EFD5102A, 
    $71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433, 
    $7807C9A2, $0F00F934, $9609A88E, $E10E9818, 
    $7F6A0DBB, $086D3D2D, $91646C97, $E6635C01, 
    $6B6B51F4, $1C6C6162, $856530D8, $F262004E, 
    $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457, 
    $65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C, 
    $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65, 
    $4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2, 
    $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB, 
    $4369E96A, $346ED9FC, $AD678846, $DA60B8D0, 
    $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9, 
    $5005713C, $270241AA, $BE0B1010, $C90C2086, 
    $5768B525, $206F85B3, $B966D409, $CE61E49F, 
    $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, 
    $59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD, 

    $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A, 
    $EAD54739, $9DD277AF, $04DB2615, $73DC1683, 
    $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8, 
    $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1, 
    $F00F9344, $8708A3D2, $1E01F268, $6906C2FE, 
    $F762575D, $806567CB, $196C3671, $6E6B06E7, 
    $FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC, 
    $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5, 
    $D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252, 
    $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B, 
    $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60, 
    $DF60EFC3, $A867DF55, $316E8EEF, $4669BE79, 
    $CB61B38C, $BC66831A, $256FD2A0, $5268E236, 
    $CC0C7795, $BB0B4703, $220216B9, $5505262F, 
    $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04, 
    $C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D, 

    $9B64C2B0, $EC63F226, $756AA39C, $026D930A, 
    $9C0906A9, $EB0E363F, $72076785, $05005713, 
    $95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38, 
    $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21, 
    $86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E, 
    $81BE16CD, $F6B9265B, $6FB077E1, $18B74777, 
    $88085AE6, $FF0F6A70, $66063BCA, $11010B5C, 
    $8F659EFF, $F862AE69, $616BFFD3, $166CCF45, 
    $A00AE278, $D70DD2EE, $4E048354, $3903B3C2, 
    $A7672661, $D06016F7, $4969474D, $3E6E77DB, 
    $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0, 
    $A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9, 
    $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6, 
    $BAD03605, $CDD70693, $54DE5729, $23D967BF, 
    $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94, 
    $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D); 

type 
//----------------------------------crc32---------------------------------- 
  {$IFDEF VER130}           // This is a bit awkward 
    // 8-byte integer 
    TInteger8 = Int64;     // Delphi 5 
  {$ELSE} 
  {$IFDEF VER120} 
    TInteger8 = Int64;     // Delphi 4 
  {$ELSE} 
    TInteger8 = COMP;      // Delphi  2 or 3 
  {$ENDIF} 
  {$ENDIF} 
//----------------------------------crc32---------------------------------- 

   
  // Use CalcCRC32 as a procedure so CRCValue can be passed in but 
  // also returned. This allows multiple calls to CalcCRC32 for 
  // the "same" CRC-32 calculation. 
procedure CalcCRC32(p: Pointer; ByteCount: DWORD; var CRCValue: DWORD); 
  // The following is a little cryptic (but executes very quickly). 
  // The algorithm is as follows: 
  // 1. exclusive-or the input byte with the low-order byte of 
  // the CRC register to get an INDEX 
  // 2. shift the CRC register eight bits to the right 
  // 3. exclusive-or the CRC register with the contents of Table[INDEX] 
  // 4. repeat steps 1 through 3 for all bytes 
var 
  i: DWORD; 
  q: ^BYTE; 
begin 
  q := p; 
  for i := 0 to ByteCount - 1 do 
  begin 
    CRCvalue := (CRCvalue shr 8) xor 
      Table[q^ xor (CRCvalue and $000000FF)]; 
    Inc(q) 
  end 
end {CalcCRC32}; 

function CalcStringCRC32(s: string; out CRC32: DWORD): Boolean; 
var 
  CRC32Table: DWORD; 
begin 
  // Verify the table used to compute the CRCs has not been modified. 
  // Thanks to Gary Williams for this suggestion, Jan. 2003. 
  CRC32Table := $FFFFFFFF; 
  CalcCRC32(Addr(Table[0]), SizeOf(Table), CRC32Table); 
  CRC32Table := not CRC32Table; 

  if CRC32Table <> $6FCF9E13 then ShowMessage('CRC32 Table CRC32 is ' + 
      IntToHex(Crc32Table, 8) + 
      ', expecting $6FCF9E13') 
  else 
  begin 
    CRC32 := $FFFFFFFF; // To match PKZIP 
    if Length(s) > 0  // Avoid access violation in D4 
      then CalcCRC32(Addr(s[1]), Length(s), CRC32); 
    CRC32 := not CRC32; // To match PKZIP 
  end; 
end; 

procedure CalcFileCRC32(FromName: string; var CRCvalue: DWORD; 
  var TotalBytes: TInteger8; 
  var error: Word); 
var 
  Stream: TMemoryStream; 
begin 
  error := 0; 
  CRCValue := $FFFFFFFF; 
  Stream := TMemoryStream.Create; 
  try 
    try 
      Stream.LoadFromFile(FromName); 
      if Stream.Size > 0 then CalcCRC32(Stream.Memory, Stream.Size, CRCvalue) 
      except 
        on E: EReadError do 
          error := 1 
    end; 
    CRCvalue := not CRCvalue 
  finally 
    Stream.Free 
  end; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
var 
  s: string; 
  CRC32: DWORD; 
begin 
  s := 'Test String'; 
  if CalcStringCRC32(s, CRC32) then 
    ShowMessage(IntToStr(crc32)); 
end;
Взято с сайта



Как вычислить CRC (контрольную сумму) для файла?


Как вычислить CRC (контрольную сумму) для файла?





function GetCheckSum(FileName: string): DWORD; 
var 
  F: file of DWORD; 
  P: Pointer; 
  Fsize: DWORD; 
  Buffer: array [0..500] of DWORD; 
begin 
  FileMode := 0; 
  AssignFile(F, FileName); 
  Reset(F); 
  Seek(F, FileSize(F) div 2); 
  Fsize := FileSize(F) - 1 - FilePos(F); 
  if Fsize > 500 then Fsize := 500; 
  BlockRead(F, Buffer, Fsize); 
  Close(F); 
  P := @Buffer; 
  asm 
     xor eax, eax 
     xor ecx, ecx 
     mov edi , p 
     @again: 
       add eax, [edi + 4*ecx] 
       inc ecx 
       cmp ecx, fsize 
     jl @again 
     mov @result, eax 
   end; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  ShowMessage(IntToStr(GetCheckSum('c:\Autoexec.bat'))); 
end; 

Взято с сайта



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


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



Описывается функция, которая показывает, как вычислить IP адрес компьютера в интернете по его доменному имени.

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

Объявляем Winsock, для использования в функции

function HostToIP(Name: string; var Ip: string): Boolean; 
var 
wsdata : TWSAData;   
hostName : array [0..255] of char;   
hostEnt : PHostEnt;   
addr : PChar;   
begin 
WSAStartup ($0101, wsdata);   
try   
gethostname (hostName, sizeof (hostName));   
StrPCopy(hostName, Name);   
hostEnt := gethostbyname (hostName);   
if Assigned (hostEnt) then   
  if Assigned (hostEnt^.h_addr_list) then   
    begin   
      addr := hostEnt^.h_addr_list^;   
if Assigned (addr) then   
begin   
IP := Format ('%d.%d.%d.%d', [byte (addr [0]),   
byte (addr [1]), byte (addr [2]), byte (addr [3])]);   
Result := True;   
end   
else   
Result := False;   
end   
else   
Result := False   
else   
begin   
Result := False;   
end;   
finally   
  WSACleanup;   
end   
end; 

Вы можете разметстить на форме EditBox, Кнопку и Label и добавить к кнопке следующий обработчик события OnClick:



procedure TForm1.Button1Click(Sender: TObject); 
var 
  IP: string; 
begin 
  if HostToIp(Edit1.Text, IP) then Label1.Caption := IP; 
end; 

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



А вот какой способ предложен для нахождения собственного IP рассылкой мастеров дельфи ():

var
  WSAData: TWSAData;
  SockAddrIn: TSockAddrIn;
  Host: PHostEnt;
  // Эти переменные объявлены в Winsock.pas
begin
  if WSAStartup($101, WSAData) = 0 then begin
    Host := GetHostByName(@Localname[1]);
    if Host<>nil then begin
      SockAddrIn.sin_addr.S_addr:= longint(plongint(Host^.h_addr_list^)^);
      LocalIP := inet_ntoa(SockAddrIn.sin_addr);
    end;
    WSACleanUp;
  end;
end;

Взято с Vingrad.ru





Как вычислить IP-адрес по доменному имени


Как вычислить IP-адрес по доменному имени




uses winsock 
------- 
function IPAddrToName(IPAddr : String): String; 
var 
  SockAddrIn: TSockAddrIn; 
  HostEnt: PHostEnt; 
  WSAData: TWSAData; 
begin 
  WSAStartup($101, WSAData); 
  SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(IPAddr)); 
  HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET); 
  if HostEnt<>nil then 
  begin 
    result:=StrPas(Hostent^.h_name) 
  end 
  else 
  begin 
    result:=''; 
  end; 
end; 

Пример использования:

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

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



Как вычислить математическое выражение


Как вычислить математическое выражение



Зачастую пользователь должен ввести что-то типа "1+2/(3*4)" и программа должна разобрать выражение и произвести вычисления. Делается это с помощью рекурсивных функций, которые постеменно разбирают выражение. К счастью не обязательно изобретать велосипед: в бесплатной библиотеке RxLib есть модуль Parsing.pas включающий в себя класс для вычисления математических выражений, библиотеку можно взять на


или



Модуль Parsing.pas вполне может работать отдельно и без установки пакета компонент (но в таком случае вам прийдется взять еще несколько inc файлов помимо него).


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