nyuuzyou/wikis huggingface dataset:
Как изменить фоновый цвет текста в различных строчках TListBox?

=== Как изменить фоновый цвет текста в различных строчках TListBox? ===
После того, как поместите TListBox на форму, необходимо изменить свойство Style в TListBox на lbOwnerDrawFixed. Если не изменить свойство Style, то событие OnDrawItem никогда не вызовется. Теперь поместите следующий код в обработчик события OnDrawItem Вашего TListBox:
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
 Rect: TRect; State: TOwnerDrawState);
var
 myColor: TColor;
 myBrush: TBrush; 
begin
 myBrush := TBrush.Create; 
 with (Control as TListBox).Canvas do
 begin
 if not Odd(Index) then
 myColor := clSilver
 else
 myColor := clYellow;
 myBrush.Style := bsSolid; 
 myBrush.Color := myColor; 
 Windows.FillRect(handle, Rect, myBrush.Handle); 
 Brush.Style := bsClear; 
 TextOut(Rect.Left, Rect.Top, (Control as TListBox).Items[Index]); 
 MyBrush.Free;
 end;
end;
Source: Взято из http://forum.sources.ru
ID: 00643
Category:VCL
Category:Графика
Category:ListBox
Как изменить цвет всех компонентов на форме в Run-time?

=== Как изменить цвет всех компонентов на форме в Run-time? ===
I would like to change the font color on all components on a form at runtime (and the components owned by the components etc). I devised a recursive algorithm using RTTI that accepts a TComponent as a parameter. It works to some extent, but I still have to use 'if' statements to cast the object to a particular descendant, resulting in about 30 lines of code to test for all of the components I use. Also, some objects (TColumnTitle), are not descended from TComponent, even though they have a font property.
This may do the trick (with D6 and maybe D5):
uses
 TypInfo;
{ ... }
var
 i: integer;
 aFont: TFont;
begin
 for i := 0 to aComponent.ComponentCount - 1 do
 begin
 aFont := TFont(GetOrdProp(aComponent.Components[i], 'Font'));
 if assigned(aFont) then
 aFont.Color := clWhite;
 end;
end;
With D4:
{ ... }
var
 i: integer;
 aFont: TFont;
 pi: PPropInfo;
begin
 for i := 0 to aComponent.ComponentCount - 1 do
 begin
 pi := GetPropInfo(aComponent.Components[i].ClassInfo, 'Font');
 if assigned(pi) then
 TFont(GetOrdProp(aComponent.Components[i],pi)).Color := clWhite;
 end;
end;
Language: en
Author: Charles McNicoll
Source: Взято из http://www.lmc-mediaagentur.de/dpool
ID: 00283
Как изменить цвет отмеченных записей в DBGrid

=== Как изменить цвет отмеченных записей в DBGrid ===
DefaultDrawing := False;
procedure TfrmCard.GridDrawColumnCell(Sender: TObject; const Rect: TRect;
 DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
 index: Integer;
 Marked, Selected: Boolean;
begin
 Marked := False;
 if (dgMultiSelect in Grid.Options) and (THackDBGrid(Grid).Datalink.Active) then
 Marked := Grid.SelectedRows.Find(THackDBGrid(Grid).Datalink.Datasource.Dataset.Bookmark, index);
 Selected := (THackDBGrid(Grid).Datalink.Active) and (Grid.Row-1 = THackDBGrid(Grid).Datalink.ActiveRecord);
 if Marked then
 begin
 Grid.Canvas.Brush.Color:=$DFEFDF;;
 Grid.Canvas.Font.Color :=clBlack;
 end;
 if Selected then
 begin
 Grid.Canvas.Brush.Color:=$FFFBF0;
 Grid.Canvas.Font.Color :=clBlack;
 if Marked then
 Grid.Canvas.Brush.Color:=$EFE3DF; { $8F8A30 }
 end;
 Grid.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
// где:
THackDBGrid = class(TDBGrid)
 property DataLink;
 property UpdateLock;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 03043
Category:Базы данных
Category:DBGrid
Как изменить число фиксированных колонок в TDbGrid?

=== Как изменить число фиксированных колонок в TDbGrid? ===
procedure TForm1.Button1Click(Sender: TObject);
begin
 TStringGrid(DbGrid1).FixedCols := 2;
end;
Source: Взято из http://forum.sources.ru
ID: 03013
----
Это маленькая вставка в Ваш наследник от TCustomDBGrid, которая решает данную задачу.
// DBGRIDEX.PAS
// ----------------------------------------------------------------------------
destructor TDbGridEx.Destroy;
begin
 _HideColumnsValues.Free;
 _HideColumns.Free;
 inherited Destroy;
end;
// ----------------------------------------------------------------------------
constructor TDbGridEx.Create(Component: TComponent);
begin
 inherited Create(Component);
 FFreezeCols := ?;
 _HideColumnsValues := TList.Create;
 _HideColumns := TList.Create;
end;
// ----------------------------------------------------------------------------
procedure TDbGridEx.KeyDown(var Key: Word; Shift: TShiftState);
begin
 if (Key = VK_LEFT) then
 ColBeforeEnter(-1);
 if (Key = VK_RIGHT) then
 ColBeforeEnter(1);
 inherited;
end;
// ----------------------------------------------------------------------------
procedure TDbGridEx.SetFreezeColor(AColor: TColor);
begin
 InvalidateRow(0);
end;
// ----------------------------------------------------------------------------
procedure TDbGridEx.SetFreezeCols(AFreezeCols: Integer);
begin
 FFreezeCols := AFreezeCols;
 InvalidateRow(0);
end;
// ----------------------------------------------------------------------------
procedure TDbGridEx.ColEnter;
begin
 ColBeforeEnter(0);
 if Assigned(OnColEnter) then
 OnColEnter(Self);
end;
// ----------------------------------------------------------------------------
procedure TDbGridEx.ColBeforeEnter(ADelta: Integer);
var
 nIndex: Integer;
 function ReadWidth: Integer;
 var
 i: Integer;
 begin
 i := _HideColumns.IndexOf(Columns[nIndex]);
 if i = -1 then
 result := 120
 else
 result := Integer(_HideColumnsValues[i]);
 end;
 procedure SaveWidth;
 var
 i: Integer;
 begin
 i := _HideColumns.IndexOf(Columns[nIndex]);
 if i <> -1 then
 begin
 _HideColumnsValues[i] := Pointer(Columns[nIndex].Width);
 end
 else
 begin
 _HideColumns.Add(Columns[nIndex]);
 _HideColumnsValues.Add(Pointer(Columns[nIndex].Width));
 end;
 end;
begin
 for nIndex := 0 to Columns.Count - 1 do
 begin
 if (Columns[nIndex].Width = 0) then
 begin
 if (nIndex + 1 <= FreezeCols) or (nIndex >= SelectedIndex + ADelta) then
 Columns[nIndex].Width := ReadWidth;
 end
 else
 begin
 SaveWidth;
 if (nIndex + 1 > FreezeCols) and
 (nIndex < SelectedIndex + ADelta) and
 (nIndex + 1 < Columns.Count) and
 (FreezeCols > 0) then
 Columns[nIndex].Width := 0;
 end;
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 03014
Category:Базы данных
Category:DBGrid
Как изменить шрифт hint?

=== Как изменить шрифт hint? ===
{ 
 When the application displays a Help Hint, 
 it creates an instance of HintWindowClass to represent 
 the window used for displaying the hint. 
 Applications can customize this window by creating a 
 descendant of THintWindow and assigning it to the 
 HintWindowClass variable at application startup. 
} 
type 
 TMyHintWindow = class(THintWindow) 
 constructor Create(AOwner: TComponent); override; 
 end; 
implementation 
constructor TMyHintWindow.Create(AOwner: TComponent); 
begin 
 inherited Create(AOwner); 
 with Canvas.Font do 
 begin 
 Name := 'Arial'; 
 Size := Size + 5; 
 Style := [fsBold]; 
 end; 
end; 
procedure TForm2.FormCreate(Sender: TObject); 
begin 
 HintWindowClass := TMyHintWindow; 
 Application.ShowHint := False; 
 Application.ShowHint := True; 
end; 
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 01269
----
В примере перехватывается событие Application.OnShowHint и изменяется шрифт Hint'а. 
type
 TForm1 = class(TForm)
 procedure FormCreate(Sender: TObject);
 public
 procedure MyShowHint(var HintStr: string; var CanShow: Boolean;var HintInfo: THintInfo);
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.MyShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
var
 i: integer;
begin
 for i := 0 to Application.ComponentCount - 1 do
 if Application.Components[i] is THintWindow then
 with THintWindow(Application.Components[i]).Canvas do
 begin
 Font.name := 'Arial';
 Font.Size := 18;
 Font.Style := [fsBold];
 HintInfo.HintColor := clWhite;
 end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 Application.OnShowHint := MyShowHint;
end;
Source: http://delphiworld.narod.ru/
ID: 01270
Как изменить шрифт определённой строки в DBGrid?

=== Как изменить шрифт определённой строки в DBGrid? ===
Для этого надо воспользоваться событием OnDrawDataCell в dbgrid.
procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
 Field: TField; State: TGridDrawState);
begin
 // If the record's CustNo is 4711 draw the entire row with a
 // line through it. (set the font style to strike out)
 if (Sender as TDBGrid).DataSource.DataSet.FieldByName('CustNo').AsString = '4711' then
 with (Sender as TDBGrid).Canvas do
 begin
 FillRect(Rect);
 // Set the font style to StrikeOut
 Font.Style := Font.Style + [fsStrikeOut];
 // Draw the cell right aligned for floats + offset
 if (Field.DataType = ftFloat) then
 TextOut(Rect.Right - TextWidth(Field.AsString) - 3,
 Rect.Top + 3, Field.AsString)
 // Otherwise draw the cell left aligned + offset
 else
 TextOut(Rect.Left + 2, Rect.Top + 3, Field.AsString);
 end;
end;
; Замечание: Вышеприведённый код использует таблицу "CUSTOMER.DB", TDBGrid, TDataSource и TTable
Source: Взято из http://forum.sources.ru
ID: 03022
Category:Базы данных
Category:DBGrid
Как изменить языковый драйвер в runtime?

=== Как изменить языковый драйвер в runtime? ===
procedure SetLanguage(Tbl: TTable; Lang: DbiName);
var
 pOptDesc: pFLDDesc;
 pOptData: pBYTE;
 hDb: hDbiDb;
 TblDesc: CRTblDesc;
 Dir: string;
begin
 pOptDesc := AllocMem(sizeof(FLDDesc));
 pOptData := AllocMem(20);
 SetLength(Dir, dbiMaxNameLen + 1);
 Tbl.Active := True;
 Check(DbiGetDirectory(Tbl.DBHandle, False, PChar(Dir)));
 SetLength(Dir, StrLen(PChar(Dir)));
 try
 FillChar(TblDesc, sizeof(CRTblDesc), #0);
 Tbl.DisableControls;
 Tbl.Close;
 Check(DbiOpenDatabase(nil, nil, dbiReadWrite, dbiOpenExcl, nil, 0, nil, nil, hDb));
 Check(DbiSetDirectory(hDb, PChar(Dir)));
 pOptDesc.iOffset := 0;
 pOptDesc.iLen := Length(Lang) + 1;
 StrPCopy(pOptDesc.szName, 'LANGDRIVER');
 StrPCopy(PChar(pOptData), Lang);
 TblDesc.iOptParams := 1;
 TblDesc.pfldOptParams := pOptDesc;
 TblDesc.pOptData := pOptData;
 StrPCopy(TblDesc.szTblName, Tbl.TableName);
 StrCopy(TblDesc.szTblType, szParadox);
 Check(DbiDoRestructure(hDb, 1, @TblDesc, nil, nil, nil, False));
 finally
 Check(DbiCloseDatabase(hDb));
 FreeMem(pOptDesc, SizeOf(FLDDesc));
 FreeMem(pOptData, 20);
 Tbl.EnableControls;
 end;
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02941
Category:Базы данных
Category:Paradox
Как имитировать нажатие левой кнопки мыши?

=== Как имитировать нажатие левой кнопки мыши? ===
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
Application.ProcessMessages;
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0); 
Author: Song, Spawn
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01581
Как имитировать появление формы как нового приложения?

=== Как иммитировать появление формы как нового приложения? ===
How i can create a form and this form stay in another icon in task bar ? (Looks like a new aplication).
In private clause: 
type
 TForm1 = class(TForm)
 private
 { Private declarations }
 procedure CreateParams(var Params: TCreateParams); override;
And, in the implementation: 
procedure TForm1.CreateParams(var Params: TCreateParams);
begin
 inherited CreateParams(Params);
 with params do
 ExStyle := ExStyle or WS_EX_APPWINDOW;
end;
Language: en
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 00417
Как импортировать данные из Excel в Stringgrid?

uses
 ComObj;
function Xls_To_StringGrid(AGrid: TStringGrid; AXLSFile: string): Boolean;
const
 xlCellTypeLastCell = $0000000B;
var
 XLApp, Sheet: OLEVariant;
 RangeMatrix: Variant;
 x, y, k, r: Integer;
begin
 Result := False;
 // Create Excel-OLE Object
 XLApp := CreateOleObject('Excel.Application');
 try
 // Hide Excel
 XLApp.Visible := False;
 // Open the Workbook
 XLApp.Workbooks.Open(AXLSFile);
 // Sheet := XLApp.Workbooks[1].WorkSheets[1];
 Sheet := XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];
 // In order to know the dimension of the WorkSheet, i.e the number of rows
 // and the number of columns, we activate the last non-empty cell of it
 Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
 // Get the value of the last row
 x := XLApp.ActiveCell.Row;
 // Get the value of the last column
 y := XLApp.ActiveCell.Column;
 // Set Stringgrid's row &col dimensions.
 AGrid.RowCount := x;
 AGrid.ColCount := y;
 // Assign the Variant associated with the WorkSheet to the Delphi Variant
 RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
 // Define the loop for filling in the TStringGrid
 k := 1;
 repeat
 for r := 1 to y do
 AGrid.Cells[(r - 1), (k - 1)] := RangeMatrix[K, R];
 Inc(k, 1);
 AGrid.RowCount := k + 1;
 until k > x;
 // Unassign the Delphi Variant Matrix
 RangeMatrix := Unassigned;
 finally
 // Quit Excel
 if not VarIsEmpty(XLApp) then
 begin
 // XLApp.DisplayAlerts := False;
 XLApp.Quit;
 XLAPP := Unassigned;
 Sheet := Unassigned;
 Result := True;
 end;
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 if Xls_To_StringGrid(StringGrid1, 'C:\Table1.xls') then
 ShowMessage('Table has been exported!');
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04373
Category:COM
Category:MS Office
Как инвертировать матрицу?

type
 RCOMat = array of array of Extended;
var
 DimMat: integer;
procedure InvertMatrix(var aa: RCOMat);
var
 numb, nula1, ipiv, indxr, indxc: array of Integer;
 i, j, l, kod, jmax, k, ll, icol, irow: Integer;
 amax, d, c, pomos, big, dum, pivinv: Double;
 ind: Boolean;
begin
 for j := 0 to Pred(DimMat) do ipiv[j] := 0;
 irow := 1;
 icol := 1;
 for i := 0 to Pred(DimMat) do
 begin
 big := 0;
 for j := 0 to Pred(DimMat) do
 begin
 if (ipiv[j] <> 1) then
 begin
 for k := 0 to Pred(DimMat) do
 begin
 if (ipiv[k] = 0) then
 if (Abs(aa[j, k]) >= big) then
 begin
 big := Abs(aa[j, k]);
 irow := j;
 icol := k;
 end;
 end;
 end;
 end;
 ipiv[icol] := ipiv[icol] + 1;
 if (irow <> icol) then
 begin
 for l := 0 to Pred(DimMat) do
 begin
 dum := aa[irow, l];
 aa[irow, l] := aa[icol, l];
 aa[icol, l] := dum;
 end;
 for l := 0 to Pred(DimMat) do
 begin
 dum := aa[irow + DimMat + 1, l];
 aa[irow + DimMat + 1, l] := aa[icol + DimMat + 1, l];
 aa[icol + DimMat + 1, l] := dum;
 end;
 end;
 indxr[i] := irow;
 indxc[i] := icol;
 if (aa[icol, icol] = 0) then;
 pivinv := 1.0 / aa[icol, icol];
 aa[icol, icol] := 1.0;
 for l := 0 to Pred(DimMat) do aa[icol, l] := aa[icol, l] * pivinv;
 for l := 0 to Pred(DimMat) do aa[icol + DimMat + 1, l] :=
 aa[icol + DimMat + 1, l] * pivinv;
 for ll := 0 to Pred(DimMat) do
 begin
 if (ll <> icol) then
 begin
 dum := aa[ll, icol];
 aa[ll, icol] := 0.0;
 for l := 0 to Pred(DimMat) do aa[ll, l] := aa[ll, l] - aa[icol, l] * dum;
 for l := 0 to Pred(DimMat) do aa[ll + DimMat + 1, l] :=
 aa[ll + DimMat + 1, l] - aa[icol + DimMat + 1, l] * dum;
 end;
 end;
 end;
 for l := Pred(DimMat) downto 0 do
 begin
 if (indxr[l] <> indxc[l]) then
 begin
 for k := 0 to Pred(DimMat) do
 begin
 dum := aa[k, indxr[l]];
 aa[k, indxr[l]] := aa[k, indxc[l]];
 aa[k, indxc[l]] := dum;
 end;
 end;
 end;
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03957
Category:Алгоритмы
Category:Матрицы
Как инициализировать BDE, если она установлена в нестандартном месте?

=== Как инициализировать BDE, если она установлена в нестандартном месте? ===
I need to use a BDE that is placed in another directory than default. How can I do it? DbiInit(pDbiEnv) doesn't work when pDbiEnv < > nil (not default).
Answer:
pDbiEnv := nil;
check(DbiInit(pDbiEnv));
or if you don't need the pointer simply
 check(DbiInit(nil));
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02492
Как инсталлировать INF файл?

uses
 ShellAPI;
function InstallINF(const PathName: string; hParent: HWND): Boolean;
var
 instance: HINST;
begin
 instance := ShellExecute(hParent,
 PChar('open'),
 PChar('rundll32.exe'),
 PChar('setupapi,InstallHinfSection DefaultInstall 132 ' + PathName),
 nil,
 SW_HIDE);
 Result := instance > 32;
end; { InstallINF }
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
 InstallINF('C:\XYZ.inf', 0);
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04288
Category:Разработка приложений‏
Category:Windows
Как использовать ChartFX?

=== Как использовать ChartFX? ===
begin
 with ChartFX do
 begin 
 Visible := false; 
 { Устанавливаем режим ввода значений } 
 { 1 - количество серий (в нашем случае 1), 3 - количество значений } 
 OpenData [COD_VALUES] := MakeLong (1, 3); 
 { Номер текущей серии } 
 ThisSerie := 0; 
 { Value [i] - значение с индексом i } 
 { Legend [i] - комментарий к этому значению } 
 Value [0] := a; 
 Legend [0] := 'Значение переменной A'; 
 Value [1] := b; 
 Legend [1] := 'Значение переменной B'; 
 Value [2] := c; 
 Legend [2] := 'Значение переменной C'; 
 { Закрываем режим } 
 CloseData [COD_VALUES] := 0; 
 { Ширина поля с комментариями на экране (в пикселах) } 
 LegendWidth := 150; 
 Visible := true; 
 end; 
end;
ID: 01321
Как использовать CreateWindow(Ex)

=== Как использовать CreateWindow(Ex) ===
program winmin;
uses
 windows,
 messages;
var
 wc: TWndClassEx;
 MainWnd: HW;
 Mesg: TMsg;
function WindowProc(wnd: HWND; Msg: Integer; Wparam: Wparam; Lparam: Lparam): Lresult; stdcall;
begin
 case msg of
 wm_destroy:
 begin
 PostQuitMessage(0);
 Result := 0;
 exit;
 end;
 else
 Result := DefWindowProc(wnd, msg, wparam, lparam);
 end;
end;
var
 xPos, yPos, nWidth, nHeight: Integer;
begin
 wc.cbSize := SizeOf(wc);
 wc.style := cs_hredraw or cs_vredraw;
 wc.lpfnWndProc := @WindowProc;
 wc.cbClsExtra := 0;
 wc.cbWndExtra := 0;
 wc.hInstance := HInstance;
 wc.hIcon := LoadIcon(0, idi_application);
 wc.hCursor := LoadCursor(0, idc_arrow);
 wc.hbrBackground := COLOR_BTNFACE+1;
 wc.lpszMenuName := nil;
 wc.lpszClassName := 'WinMin : Main';
 RegisterClassEx(wc);
 xPos := 100;
 yPos := 150;
 nWidth := 400;
 nHeight := 250;
 MainWnd := CreateWindowEx(
 0,
 'WinMin : Main',
 'Win Min',
 ws_overlappedwindow,
 xPos,
 yPos,
 nWidth,
 nHeight,
 0,
 0,
 Hinstance,
 nil
 );
 ShowWindow(MainWnd, CmdShow);
 while GetMessage(Mesg, 0, 0, 0) do
 begin
 TranslateMessage(Mesg);
 DispatchMessage(Mesg);
 end;
end.
Source: http://delphiworld.narod.ru/
ID: 02152
Как использовать IP Address Control у себя?

=== Как использовать IP Address Control у себя? ===
{
 Microsoft® Internet Explorer Version 4.0 introduces the IP address control,
 a new control similar to an edit control that allows the user to enter a
 numeric address in Internet protocol (IP) format.
 This format consists of four three-digit fields.
 Each field is treated individually; the field numbers are zero-based and
 proceed from left to right as shown in this figure.
 Further informations
 http://msdn.microsoft.com/library/en-us/shellcc/platform/commctls/ipaddress/ipaddress.asp
}
unit Unit1;
interface
uses
 Windows, Messages, Classes, Forms, Controls, StdCtrls, ExtCtrls;
type
 TForm1 = class(TForm)
 IPAddress: TBevel;
 SetIP: TButton;
 ClearIP: TButton;
 procedure FormCreate(Sender: TObject);
 procedure SetIPClick(Sender: TObject);
 procedure ClearIPClick(Sender: TObject);
 private
 FIPAddress: Longint;
 HIPAddress: HWND;
 PrevWndProc: TWndMethod;
 procedure NewWindowProc(var Message: TMessage);
 public
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
uses
 CommCtrl;
const
 IP_ADDRESS_ID: Longword = $0100;
procedure TForm1.FormCreate(Sender: TObject);
var
 lpInitCtrls: TInitCommonControlsEx;
begin
 lpInitCtrls.dwSize := SizeOf(TInitCommonControlsEx);
 lpInitCtrls.dwICC := ICC_INTERNET_CLASSES;
 if InitCommonControlsEx(lpInitCtrls) then 
 begin
 PrevWndProc := WindowProc;
 WindowProc := NewWindowProc;
 HIPAddress := CreateWindowEx(WS_EX_LEFT, WC_IPADDRESS, nil,
 WS_CHILD + WS_VISIBLE + WS_BORDER + WS_TABSTOP,
 IPAddress.Left, IPAddress.Top, IPAddress.Width, IPAddress.Height,
 Handle, IP_ADDRESS_ID, HInstance, nil);
 SendMessage(HIPAddress, IPM_SETFOCUS, 0, 0);
 end;
end;
procedure TForm1.NewWindowProc(var Message: TMessage);
var
 nField: longint;
begin
 case Message.Msg of
 WM_NOTIFY: 
 begin
 if PNMHDR(Ptr(Message.lParam)).idFrom = IP_ADDRESS_ID then 
 begin
 case PNMIPAddress(ptr(Message.lParam)).hdr.code of
 IPN_FIELDCHANGED: 
 begin
 if SendMessage(HIPAddress, IPM_ISBLANK, 0, 0) = 0 then
 SendMessage(HIPAddress, IPM_GETADDRESS, 0, lParam(LPDWORD(@FIPAddress)));
 end;
 end;
 end;
 end;
 WM_COMMAND: 
 begin
 if Message.WParamLo = IP_ADDRESS_ID then
 case Message.WParamHi of
 EN_SETFOCUS: 
 begin
 nField := SendMessage(HIPAddress, IPM_GETADDRESS, 0,
 lParam(LPDWORD(@FIPAddress)));
 if nField = 4 then nField := 0;
 SendMessage(HIPAddress, IPM_SETFOCUS, wParam(nField), 0);
 end;
 EN_KILLFOCUS: 
 begin
 if SendMessage(HIPAddress, IPM_ISBLANK, 0, 0) = 0 then
 SendMessage(HIPAddress, IPM_GETADDRESS, 0, lParam(LPDWORD(@FIPAddress)));
 end;
 EN_CHANGE: 
 begin
 end;
 end;
 end;
 end;
 if Assigned(PrevWndProc) then PrevWndproc(Message);
end;
procedure TForm1.SetIPClick(Sender: TObject);
begin
 FIPAddress := MAKEIPADDRESS(127, 0, 0, 1);
 SendMessage(HIPAddress, IPM_SETADDRESS, 0, lParam(DWORD(FIPAddress)));
end;
procedure TForm1.ClearIPClick(Sender: TObject);
begin
 SendMessage(HIPAddress, IPM_CLEARADDRESS, 0, 0);
end;
end.
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 01324
Как использовать Microsoft Speech API?

=== Как использовать Microsoft Speech API? ===
// Works on NT, 2k, XP, Win9x with SAPI SDK
// reference & Further examples: See links below!
uses Comobj;
procedure TForm1.Button1Click(Sender: TObject);
var
 voice: OLEVariant;
begin
 voice := CreateOLEObject('SAPI.SpVoice');
 voice.Speak('Hello World!', 0);
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 02264
Как использовать Shell API SHBrowseForFolder?

Статья из рассылки "Мастера DELPHI. Новости мира компонент, FAQ, статьи...".
Как использовать функцию Shell API SHBrowseForFolder чтобы позволить пользователю выбрать каталог?
uses ShellAPI, ShlObj;
procedure TForm1.Button1Click(Sender: TObject);
var
 TitleName: string;
 lpItemID: PItemIDList;
 BrowseInfo: TBrowseInfo;
 DisplayName: array[0..MAX_PATH] of Char;
 TempPath: array[0..MAX_PATH] of Char;
begin
 FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
 BrowseInfo.hwndOwner := Form1.Handle;
 BrowseInfo.pszDisplayName := @DisplayName;
 TitleName := 'Please specify a directory';
 BrowseInfo.lpszTitle := PChar(TitleName);
 BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
 lpItemID := SHBrowseForFolder(BrowseInfo);
 if lpItemId <> nil then
 begin
 SHGetPathFromIDList(lpItemID, TempPath);
 ShowMessage(TempPath);
 GlobalFreePtr(lpItemID);
 end;
end;
Source: Дельфи. Вокруг да около.
ID: 03187
----
Вариант от Анатолия (SAVwa@eleks.lviv.ua)
threadvar myDir: string;
function BrowseCallbackProc(hwnd: HWND; uMsg: UINT;
 lParam: LPARAM; lpData: LPARAM): integer; stdcall;
begin
 Result := 0;
 if uMsg = BFFM_INITIALIZED then
 begin
 SendMessage(hwnd, BFFM_SETSELECTION, 1, LongInt(PChar(myDir)))
 end;
end;
function SelectDirectory(const Caption: string; const Root: WideString;
 var Directory: string): Boolean;
var
 WindowList: Pointer;
 BrowseInf!
 o: TBrowseInfo;
 Buffer: PChar;
 RootItemIDList, ItemIDList: PItemIDList;
 ShellMalloc: IMalloc;
 IDesktopFolder: IShellFolder;
 Eaten, Flags: LongWord;
begin
 myDir := Directory;
 Result := False;
 FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
 if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
 begin
 Buffer := ShellMalloc.Alloc(MAX_PATH);
 try
 RootItemIDList := nil;
 if Root <> then
 begin
 SHGetDesktopFolder(IDesktopFolder);
 IDesktopFolder.ParseDisplayName(Application.Handle, nil,
 POleStr(Root), Eaten, RootItemIDList, Flags);
 end;
 with BrowseInfo do
 begin
 hwndOwner := Application.Handle;
 pidlRoot := RootItemIDList;
 pszDisplayName := Buffer;
 lpfn := @BrowseCallbackProc;
 lParam := Integer(PChar(Directory));
 lpszTitle := PChar(Caption);
 ulFlags := BIF_RETURNONLYFSDIRS or $0040 or BIF_EDITBOX or BIF_STATUSTEXT;
 end;
 WindowList := DisableTaskWindows(0);
 try
 ItemIDList := ShBrowseForFolder(BrowseInfo);
 finally
 EnableTaskWindows(WindowList);
 end;
 Result := ItemIDList <> nil;
 if Result then
 begin
 ShGetPathFromIDList(ItemIDList, Buffer);
 ShellMalloc.Free(ItemIDList);
 Directory := Buffer;
 end;
 finally
 ShellMalloc.Free(Buffer);
 end;
 end;
end;
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 03188
Category:Файловая система