nyuuzyou/wikis huggingface dataset:
Как вставить свой пункт меню?

{ ... }
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';
{ ... }
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 04415
Category:COM
Category:MS Office
Как вставить содержимое файла в текущую позицию 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;
Source: Взято из http://forum.sources.ru
ID: 00550
----
Как мне импортировать файл в элемент управления TMemo начиная с позиции курсора? LoadFromFile заменяет содержимое TMemo содержимым текстового файла. Я хочу включить текстовый файл или в поцизию курсора или, если выбран текст, заменить этот текст содержимым текстового файла. Все это должно быть похоже на работу функции PasteFromClipboard. 
Самый простой путь вставки текста в компонент Memo заключается в посылке ему сообщения EM_REPLACESEL.
{ InsertFileInMemo--
ПРИМЕЧАНИЕ: если вы хотите заменить к настоящему времени
выбранный в Memo текст, передайте в параметре ReplaceSel
TRUE. FALSE необходим для простой вставки текста... }
procedure InsertFileInMemo(Memo: TMemo; FileName: string;
 ReplaceSel: Boolean);
var
 Stream: TMemoryStream;
 NullTerminator: Char;
begin
 Stream := TMemoryStream.Create;
 try
 { Загружаем текст... }
 Stream.LoadFromFile(FileName);
 { Добавляем в конец текста терминирующий ноль... }
 Stream.Seek(0, 2);
 NullTerminator := #0;
 Stream.Write(NullTerminator, 1);
 { Вставляем текст в Memo... }
 if not ReplaceSel then
 Memo.SelLength := 0;
 SendMessage(Memo.Handle, EM_ReplaceSel, 0,
 LongInt(Stream.Memory));
 finally
 Stream.Free;
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 00992
----
procedure TForm1.Button1Click(Sender: TObject);
var
 sl: TStringList;
begin
 sl := TStringList.Create;
 try
 sl.LoadFromFile('c:\afile.txt');
 Memo1.SetSelTextBuf(PChar(sl.Text));
 finally
 sl.Free;
 end;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 00994
Как вшить иконку в мою прогу?, с нуля

=== Как вшить иконку в мою прогу?, с нуля ===
в .RC - файле подключаемом к проекту пишешь
 100 ICON "100.ico"
для загрузки икоки:
 with MainWindow do
 begin
 cbSize := SizeOf(MainWindow);
 style := CS_HREDRAW or CS_VREDRAW;
 lpfnWndProc := @WindowProc;
 cbClsExtra := 0;
 cbWndExtra := 0;
 hIcon := LoadIcon(0, IDI_APPLICATION);
 hCursor := LoadCursor(0, IDC_ARROW);
 hbrBackground := COLOR_BTNFACE + 1;
 lpszMenuName := nil;
 lpszClassName := 'TDeliveryInstaller';
 end;
 MainWindow.hInstance := HInstance;
 if RegisterClassEx(MainWindow) = 0 then Exit;
 Width := 360;
 Height := 200;
 InitCommonControls;
 Handle := CreateWindowEx(0, 'TDeliveryInstaller',
 PChar(TXT_CAPTION), WS_OVERLAPPED or WS_SYSMENU,
 Left, Top, Width, Height, 0, 0, HInstance, nil);
 SendMessage(Handle, WM_SETICON, 1, LoadIcon(HInstance, MAKEINTRESOURCE(100)));
Author: Rouse_
Source: Взято из http://forum.sources.ru
ID: 02347
Как выбрать и установить уровень прозрачности формы

=== Как выбрать и установить уровень прозрачности формы ===
Form1.AlphaBlendValue := 200 { Уровень прозрачности };
Form1.AlphaBlend := True;
 Delphi 6+
Author: Radmin
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00451
Как выбрать случайную запись?

=== Как выбрать случайную запись? ===
procedure TForm1.FormCreate(Sender: TObject);
begin
 Randomize;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 Table1.First;
 Table1.MoveBy(Random(Table1.RecordCount));
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 02553
Как выбрать цвет пользуя TTrackBar

Разместите три TrackBar для каждого цвета (red, green, blue) на форме. Установите свойства Min на 0, Max на 255.
С помощью функции RGB() создаем цвет из значений каждого TrackBar.
interface
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;
implementation
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;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 03697
ID: 03696
Category:Графика
Category:Цвета и палитры
Как вывести Hint для ячейки DBGrid

=== Как вывести Hint для ячейки DBGrid ===
Создайте на форме DataSource1, Table1, DataSource2, Table2, DBGrid1. Table1 и Table2 свяжите со своей базой данных. DataSource1 и DataSource2 свяжите соответственно с Table1 и Table2. DBGrid1 свяжите с DataSource1 Table2 и DataSource2 нужны для доступа к какой-нибудь ячейке. Другой способ без их использования: при отрисовке значений ячеек (соответствующее событие), необходимо запомнить значения всех ячеек, находящихся на экране и производить выбор среди них. 
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls,
 Forms, Dialogs, Grids, DBGrids, Db, DBTables;
type
 TForm1 = class(TForm)
 DataSource1: TDataSource;
 Table1: TTable;
 DBGrid1: TDBGrid;
 Table2: TTable;
 DataSource2: TDataSource;
 procedure FormCreate(Sender: TObject);
 private
 { Private declarations }
 procedure AppMess(var Msg: TMsg; var Handled: Boolean);
 public
 { Public declarations }
end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.AppMess(var Msg: TMsg; var Handled: Boolean);
var
 X, Y: integer;
 gpt: TGridCoord;
 s: string;
 w, len: integer;
begin
 if Msg.message = WM_MOUSEMOVE then
 begin
 if Msg.hwnd = DBGrid1.Handle then
 begin
 x := LoWord(Msg.lParam);
 y := HiWord(Msg.lParam);
 gpt := DBGrid1.MouseCoord(x, y);
 { получить строку и солбец, в которых находится курсор }
 if (gpt.x > 0) and (gpt.y > 0) then
 begin
 DataSource2.DataSet.First;
 DataSource2.DataSet.MoveBy(gpt.y-1);
 s := Table2.Fields[gpt.x-1].AsString;
 w := DBGrid1.Columns[gpt.x-1].Width;
 { получить ширину столбца }
 len := DBGrid1.Canvas.TextWidth(s);
 { получить длину строки в пикселах }
 if len > w then
 DBGrid1.Hint := s;
 else
 DBGrid1.Hint := ;
 end;
 end;
 end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin 
 DBGrid1.ShowHint := True;
 Application.OnMessage := AppMess;
end;
end.
Source: http://delphiworld.narod.ru/
ID: 01291
ID: 03077
Как вывести главное окно справочной системы?

В 16-битных версиях справочной системы необходимо было вызывать начальное (главное) окно помощи с параметром HELP_CONTENTS в команде HelpCommand. В 32-битном варианте это осуществляется следующим образом:
Application.HelpCommand(HELP_FINDER, 0);
;Примечание: Для того, чтобы показывались "книжки" (или главные темы) - необходимо создать .CNT-файл.
ID: 04549
Category:Разработка приложений
Category:Справочная система
Как вывести данные в Excel?

Можно выводить данные последовательно в каждую ячейку, но это очень сильно замедляет работу. Лучше сформировать вариантный массив, и выполнить присвоение области (Range) этого массива.
var
 ExcelApp, Workbook, Range, Cell1, Cell2, ArrayData: Variant;
 TemplateFile: String;
 BeginCol, BeginRow, i, j: Integer;
 RowCount, ColCount: Integer;
begin
 // Координаты левого верхнего угла области, в которую будем выводить данные
 BeginCol := 1;
 BeginRow := 5;
 // Размеры выводимого массива данных
 RowCount := 100;
 ColCount := 50;
 // Создание Excel
 ExcelApp := CreateOleObject('Excel.Application');
 // Отключаем реакцию Excel на события, чтобы ускорить вывод информации
 ExcelApp.Application.EnableEvents := False;
 // Создаем Книгу (Workbook)
 // Если заполняем шаблон, то Workbook := ExcelApp.WorkBooks.Add('C:\MyTemplate.xls');
 Workbook := ExcelApp.WorkBooks.Add;
 // Создаем Вариантный Массив, который заполним выходными данными
 ArrayData := VarArrayCreate([1, RowCount, 1, ColCount], varVariant);
 // Заполняем массив
 for i := 1 to RowCount do
 for j := 1 to ColCount do
 ArrayData[i, j] := j * 10 + i;
 // Левая верхняя ячейка области, в которую будем выводить данные
 Cell1 := WorkBook.WorkSheets[1].Cells[BeginRow, BeginCol];
 // Правая нижняя ячейка области, в которую будем выводить данные
 Cell2 := WorkBook.WorkSheets[1].Cells[BeginRow + RowCount - 1, BeginCol + ColCount - 1];
 // Область, в которую будем выводить данные
 Range := WorkBook.WorkSheets[1].Range[Cell1, Cell2];
 // А вот и сам вывод данных
 // Намного быстрее поячеечного присвоения
 Range.Value := ArrayData;
 // Делаем Excel видимым
 ExcelApp.Visible := True;
end;
Author: Кулюкин Олег
Source: http://www.delphikingdom.ru/
ID: 04381
Category:COM
Category:MS Office
Как вывести звук через звуковую карту?

uses
 MMSystem;
type
 TVolumeLevel = 0..127;
{ writes tone to memory and plays it }
procedure MakeSound(Frequency{Hz}, Duration{mSec}: Integer; Volume: TVolumeLevel);
var
 WaveFormatEx: TWaveFormatEx;
 MS: TMemoryStream;
 i, TempInt, DataCount, RiffCount: Integer;
 SoundValue: Byte;
 w: Double; // omega ( 2 * pi * frequency)
const
 Mono: Word = $0001;
 SampleRate: Integer = 11025; // 8000, 11025, 22050, or 44100
 RiffId: string = 'RIFF';
 WaveId: string = 'WAVE';
 FmtId: string = 'fmt ';
 DataId: string = 'data';
begin
 if Frequency > (0.6 * SampleRate) then
 begin
 ShowMessage(Format('Sample rate of %d is too Low to play a tone of %dHz',
 [SampleRate, Frequency]));
 Exit;
 end;
 with WaveFormatEx do
 begin
 wFormatTag := WAVE_FORMAT_PCM;
 nChannels := Mono;
 nSamplesPerSec := SampleRate;
 wBitsPerSample := $0008;
 nBlockAlign := (nChannels * wBitsPerSample) div 8;
 nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
 cbSize := 0;
 end;
 MS := TMemoryStream.Create;
 with MS do
 begin
 { Calculate length of sound data and of file data }
 DataCount := (Duration * SampleRate) div 1000; // sound data
 RiffCount := Length(WaveId) + Length(FmtId) + SizeOf(DWORD) +
 SizeOf(TWaveFormatEx) + Length(DataId) + SizeOf(DWORD) + DataCount; // file data
 { write out the wave header }
 Write(RiffId[1], 4); // 'RIFF'
 Write(RiffCount, SizeOf(DWORD)); // file data size
 Write(WaveId[1], Length(WaveId)); // 'WAVE'
 Write(FmtId[1], Length(FmtId)); // 'fmt '
 TempInt := SizeOf(TWaveFormatEx);
 Write(TempInt, SizeOf(DWORD)); // TWaveFormat data size
 Write(WaveFormatEx, SizeOf(TWaveFormatEx)); // WaveFormatEx record
 Write(DataId[1], Length(DataId)); // 'data'
 Write(DataCount, SizeOf(DWORD)); // sound data size
 { calculate and write out the tone signal } // now the data values
 w := 2 * Pi * Frequency; // omega
 for i := 0 to DataCount - 1 do
 begin
 SoundValue := 127 + trunc(Volume * sin(i * w / SampleRate)); // wt = w * i / SampleRate
 Write(SoundValue, SizeOf(Byte));
 end;
 { now play the sound }
 sndPlaySound(MS.Memory, SND_MEMORY or SND_SYNC);
 MS.Free;
 end;
end;
// How to call the function:
procedure TForm1.Button1Click(Sender: TObject);
begin
 MakeSound(1200, 1000, 60);
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03603
Category:Звук
Как вывести полупрозрачный текст

Пример вывода полупрозрачного текста.
Эффект достигается за счет режима Canvas.CopyMode := cmSrcPaint и функции Canvas.CopyRect(), при котором происходит логическое сложение (операция OR) значений цветов картинки-источника и картинки-приемника. Проще говоря, яркости цветов каждого пикселя складываются.
procedure TForm1.FormPaint(Sender: TObject);
var
 x, y: integer;
 bm: TBitMap;
begin
 Form1.ClientWidth := 200;
 Form1.ClientHeight := 100;
 Randomize;
 for x := 0 to 199 do
 for y := 0 to 99 do
 if Random(3) = 1 then
 Form1.Canvas.Pixels[x, y] := clGreen
 else
 Form1.Canvas.Pixels[x, y] := clLime;
 bm := TBitMap.Create;
 bm.Width := 200;
 bm.Height := 100;
 with bm.Canvas do
 begin
 Brush.Color := clGreen;
 FillRect(ClipRect);
 Font.Name := 'Arial';
 Font.Size := 50;
 Font.Color := clGray;
 Font.Style := [fsBold];
 TextOut((bm.Width - TextWidth('Text')) div 2,
 (bm.Height - TextHeight('Text')) div 2, 'Text');
 end;
 Form1.Canvas.CopyMode := cmSrcPaint;
 Form1.Canvas.CopyRect(bm.Canvas.ClipRect, bm.Canvas, bm.Canvas.ClipRect);
 bm.Destroy;
end;
Author: Даниил Карапетян (delphi4all@narod.ru)
Author: Алексей Денисов (aleksey@sch103.krasnoyarsk.su)
ID: 03653
Category:Графика
Category:Работа с текстом
Как вывести список привилегий?

=== Как вывести список привилегий? ===
procedure TForm1.Button1Click(Sender: TObject);
const
 TokenSize = 800; // (SizeOf(Pointer) = 4 * 200)
var
 hToken: THandle;
 pTokenInfo: PTOKENPRIVILEGES;
 ReturnLen: Cardinal;
 i: Integer;
 PrivName: PChar;
 DisplayName: PChar;
 NameSize: Cardinal;
 DisplSize: Cardinal;
 LangId: Cardinal;
begin
 GetMem(pTokenInfo, TokenSize);
 if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
 ShowMessage('OpenProcessToken error');
 if not GetTokenInformation(hToken, TokenPrivileges, pTokenInfo, TokenSize, ReturnLen) then
 ShowMessage('GetTokenInformation error');
 GetMem(PrivName, 255);
 GetMem(DisplayName, 255);
 for i := 0 to pTokenInfo.PrivilegeCount - 1 do
 begin
 DisplSize := 255;
 NameSize := 255;
 LookupPrivilegeName(nil, pTokenInfo.Privileges[i].Luid, PrivName, Namesize);
 LookupPrivilegeDisplayName(nil, PrivName, DisplayName, DisplSize, LangId);
 ListBox1.Items.Add(PrivName +^I + DisplayName);
 end;
 FreeMem(PrivName);
 FreeMem(DisplayName);
 FreeMem(pTokenInfo);
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 01722
Как вывести текст с красивым обрезанием если не помещается?

=== Как вывести текст с красивым обрезанием если не помещается? ===
Используй вызов DrawTextEx, установив в параметре dwDTFormat значение DT_PATH_ELLIPSIS. 
procedure TForm1.FormPaint(Sender: TObject);
var
 r: TRect;
begin
 r := Rect(20, 20, 110, 70);
 // DT_PATH_ELLIPSIS or DT_WORD_ELLIPSIS or DT_END_ELLIPSIS
 DrawTextEx(Form1.Canvas.Handle, 'Delphi World - это круто!!!', 25, r, DT_WORD_ELLIPSIS, nil);
end;
Source: Взято с http://delphiworld.narod.ru
ID: 01944
Как вывести цветной текст в TStatusBar?

=== Как вывести цветной текст в TStatusBar? ===
Статусбар, это стандартный элемент управления Windows и как все отображает шрифт, заданный в параметре clBtnText, который устанавливается через Панель управления. Поумолчанию этот цвет чёрный, но он может менятся в зависимоти пользовательской темы. StatusBar и связанные с ним панели имеют возможность самостоятельной перерисовки (owner-draw), позволяющей рисовать текст различными цветами. Для этого необходимо в TStatusBar.Panels установить свойство Style в OwnerDraw.
procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; 
 Panel: TStatusPanel; const Rect: TRect); 
begin 
 if Panel = StatusBar.Panels[0] then
 begin 
 StatusBar.Canvas.Font.Color := clRed; 
 StatusBar.Canvas.TextOut(Rect.Left, Rect.Top, 'Panel - 0') 
 end 
 else
 begin 
 StatusBar.Canvas.Font.Color := clGreen; 
 StatusBar.Canvas.TextOut(Rect.Left, Rect.Top, 'Panel - 1'); 
 end; 
end;
Source: Взято из http://forum.sources.ru
ID: 00515
Как выводить hint при движении мыши над списком

=== Как выводить hint при движении мыши над списком ===
В Windows, в частности в Delphi, используются Hint для полного отображения не умещающихся строк. Достаточно к такой строке поднести мышь, и всплывает подсказка с полным текстом на том же месте. Как это реализовать показано ниже. 
...
public
 HintRow: Integer;
 HintString: String;
 procedure OnShowHint(var HintStr: string;
 var CanShow: Boolean; var HintInfo: THintInfo);
implementation
procedure TForm1.FormCreate(Sender: TObject);
begin
 Application.HintPause := 100;
 Application.HintHidePause := 30000;
 ListBox1.Items.Add('It is a long row');
 ListBox1.Items.Add('It is a very long row');
 ListBox1.Items.Add('And it is a very very long row');
 ListBox1.Items.Add('But this row if longer then other rows');
 ListBox1.Items.Add('It was not truth, because this row is so long, that I do not know, what' + #13#10 +
 'will do the program with this row. Do You know it? I think that it will be' + #13#10 +
 'very interesting to look at this row. But if it will be longer and longer,' + #13#10 +
 'what will be? Look!!!');
 ListBox1.Items.Add('Short row');
 ListBox1.Items.Add('123');
 HintRow := -1;
 Application.OnShowHint := OnShowHint;
 ListBox1.ShowHint := true;
end;
procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
 ItemNum: Integer;
begin
 ItemNum := ListBox1.ItemAtPos(Point(X, Y), True);
 if (ItemNum <> HintRow) then
 begin
 HintRow := ItemNum;
 Application.CancelHint;
 if HintRow > -1 then
 begin
 HintString := ListBox1.Items[ItemNum];
 if (ListBox1.Canvas.TextWidth(HintString) <= ListBox1.ClientWidth) then
 HintString := ;
 end
 else
 HintString := ;
 end;
end;
procedure TForm1.OnShowHint(var HintStr: string;
 var CanShow: Boolean; var HintInfo: THintInfo);
begin
 if not (HintInfo.HintControl is TListBox) then Exit;
 with HintInfo.HintControl as TListBox do begin
 HintInfo.HintPos := ListBox1.ClientToScreen(Point(-1, ListBox1.ItemRect(HintRow).Top - 3));
 HintStr := HintString;
 end;
end;
 e-mail: delphi4all@narod.ru
 e-mail: aleksey@sch103.krasnoyarsk.su
Author: Алексей Денисов
ID: 01283
Как выводить элементы списка разными шрифтами

=== Как выводить элементы списка разными шрифтами ===
Очень удобно выбирать шрифты, когда в списке каждый шрифт написан собой. Например, "Arial" будет написано шрифтом Arial, а "Times" - Times. Список шрифтов лежит в свойстве Fonts объекта Screen. 
procedure TForm1.FormCreate(Sender: TObject);
begin
 ListBox1.Items := Screen.Fonts;
 ListBox1.Style := lbOwnerDrawVariable;
end;
// Определение высоты элемента списка
procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
 var Height: Integer);
begin
 with ListBox1.Canvas do
 begin
 Font.Name := ListBox1.Items.Strings[index];
 Font.Size := 0; // Размер шрифта – по умолчанию
 Height := TextHeight(ListBox1.Items.Strings[index]) + 2;
 end;
end;
// Вывод названия шрифта
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
 Rect: TRect; State: TOwnerDrawState);
begin
 with ListBox1.Canvas do
 begin
 Font.Name := ListBox1.Items.Strings[index];
 Font.Size := 0; // Размер шрифта – по умолчанию
 TextOut(Rect.Left + 1, Rect.Top + 1,
 ListBox1.Items.Strings[index]);
 end;
end;
 e-mail: delphi4all@narod.ru
 e-mail: aleksey@sch103.krasnoyarsk.su
Author: Алексей Денисов
ID: 00659
Как выгрузить Dll из памяти?

=== Как выгрузить Dll из памяти? ===
function KillDll(aDllName: string): Boolean;
var
 hDLL: THandle;
 aName: array[0..10] of char;
 FoundDLL: Boolean;
begin
 StrPCopy(aName, aDllName);
 FoundDLL := False;
 repeat
 hDLL := GetModuleHandle(aName);
 if hDLL = 0 then
 Break;
 FoundDLL := True;
 FreeLibrary(hDLL);
 until False;
 if FoundDLL then
 MessageDlg('Success!', mtInformation, [mbOK], 0)
 else
 MessageDlg('DLL not found!', mtInformation, [mbOK], 0);
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 01995
Как выдавить текст

== Выпуклый текст ==
Чтобы сделать текст выпуклым, нужно за светло-серой надписью разместить точно такие же надписи, только белую чуть левее и выше и светло-серую чуть правее и ниже.
Приведенная ниже программа выводит выпуклый текст, который вдавливается при нажатии.
const
 s = 'It is a text string';
 ColDark = clGray;
 ColNorm = clSilver;
 ColLight = clWhite;
 XPos = 10;
 YPos = 10;
 dx = 1;
 dy = 1;
procedure TForm1.FormCreate(Sender: TObject);
begin
 Form1.Canvas.Brush.Style := bsClear;
 with Form1.Canvas.Font do
 begin
 Name := 'Arial';
 Size := 20;
 Style := [fsBold];
 end;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 with Form1.Canvas do
 begin
 Font.Color := ColDark;
 TextOut(XPos - dx, YPos - dy, s);
 Font.Color := ColLight;
 TextOut(XPos + dx, YPos + dy, s);
 Font.Color := ColNorm;
 TextOut(XPos, YPos, s);
 end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 with Form1.Canvas do
 begin
 Font.Color := ColLight;
 TextOut(XPos - dx, YPos - dy, s);
 Font.Color := ColDark;
 TextOut(XPos + dx, YPos + dy, s);
 Font.Color := ColNorm;
 TextOut(XPos, YPos, s);
 end;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
 Form1.MouseUp(mbLeft, [], 0, 0);
end;
Author: Даниил Карапетян (delphi4all@narod.ru)
Author: Алексей Денисов (aleksey@sch103.krasnoyarsk.su)
ID: 03652
Category:Графика
Category:Работа с текстом
Как выделить URL в TRichEdit?

=== Как выделить URL в TRichEdit? ===
{....}
 protected
 procedure WndProc(var Message: TMessage); override;
{....}
uses Richedit, ShellApi;
{ Today I want to show how to implement URL highlighting and URL navigation
without any third-party components. This functionality is implemented in
RichEdit from Microsoft (and MS Outlook use this feature, for example) and
only Borland's developers didn't publish it for us. }
procedure TForm1.FormCreate(Sender: TObject);
var
 mask: Word;
begin
 mask := SendMessage(RichEdit1.Handle, EM_GETEVENTMASK, 0, 0);
 SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
 SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, Integer(True), 0);
 // Some text in RichEdit
 RichEdit1.Text := 'Scalabium Software'#13#10 +
 ' Site is located at www.scalabium.com. Welcome to our site.';
end;
procedure TForm1.WndProc(var Message: TMessage);
var
 p: TENLink;
 strURL: string;
begin
 if (Message.Msg = WM_NOTIFY) then
 begin
 if (PNMHDR(Message.lParam).code = EN_LINK) then
 begin
 p := TENLink(Pointer(TWMNotify(Message).NMHdr)^);
 if (p.Msg = WM_LBUTTONDOWN) then
 begin
 SendMessage(RichEdit1.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
 strURL := RichEdit1.SelText;
 ShellExecute(Handle, 'open', PChar(strURL), 0, 0, SW_SHOWNORMAL);
 end
 end
 end;
 inherited;
end;
Language: en
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 00575
Как выделить кнопку в DBNavigator программно?

=== Как выделить кнопку в DBNavigator программно? ===
type TFake = class(TDBNavigator);
procedure TForm1.Button1Click(Sender: TObject);
begin
 TFake(DBNavigator1).Buttons[nbNext].Perform(WM_RBUTTONDOWN, 0, 0);
 TFake(DBNavigator1).Buttons[nbNext].Perform(WM_RBUTTONUP, 0, 0);
end;
Author: Vit
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 03080
Category:Базы данных
Category:DBNavigator