nyuuzyou/wikis huggingface dataset:
Компонент TEdit с возможностью задать выравнивание текста

=== Компонент TEdit с возможностью задать выравнивание текста ===
{ 
 All you have to do is to verride the CreateParams of the class TEdit. 
 Install the following unit as a component. 
}
unit AlignEdit;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls;
type
 TAlign = (eaLeft, eaCenter, eaRight);
 TAlignEdit = class(TEdit)
 private
 { Private-Deklarationen }
 FAlign: TAlign;
 procedure SetAlign(const Value: TAlign);
 protected
 { Protected-Deklarationen }
 procedure CreateParams(var Params: TCreateParams); override;
 public
 { Public-Deklarationen }
 constructor Create(AOwner: TComponent); override;
 published
 { Published-Deklarationen }
 property Alignment: TAlign read FAlign write SetAlign default eaLeft;
 end;
procedure Register;
implementation
constructor TAlignEdit.Create(Aowner: TComponent);
begin
 inherited Create(AOwner);
 FAlign := eaLeft;
end;
procedure TAlignEdit.SetAlign(const Value: TAlign);
begin
 if FAlign <> Value then
 begin
 FAlign := Value;
 RecreateWnd;
 end;
end;
procedure TAlignEdit.CreateParams(var Params: TCreateParams);
begin
 inherited;
 case FAlign of
 eaLeft: Params.Style := Params.Style or ES_LEFT;
 eaCenter: Params.Style := Params.Style or ES_CENTER;
 eaRight: Params.Style := Params.Style or ES_RIGHT;
 end;
end;
procedure Register;
begin
 RegisterComponents('SwissDelphiCenter', [TAlignEdit]);
end;
end.
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 00969
Компонент TNMDayTime

Этот компонент предназначен для получения даты и времени от серверов даты и времени в интернет и интранет в соответствии со стандартом rfc 867, называемым "Протокол времени суток". 
Если у вас в "подчинении" один домашний компьютер, то время на нём можно периодически подводить по своим часам - здесь точность не требуется, но если вы администратор малой или большой сети, если у вас есть многопользовательская программа, то для синхронизации времени на машинах нужно использовать некий механизм. Например, эту возможность, предоставляемую интернет. 
В интернете используются 4 временных протокола. Протокол, используемый в tnmdaytime, достаточно простой и даёт время с погрешностью в 1секунду. Этому протоколу требуется наличие 32-битного стека протоколов tcp/ip (библиотеки wsock32.dll), поставляемой с операционными системами windows 95/98/nt. За протоколом даты/времени закреплён порт 13. 
Перед тем как использовать этот компонент, вы должны знать имя или ip-адрес соответствующего сервера Интернет и присвоить это значение свойству host, в которое помещается имя сервера или разделённый точками ip-адрес. После того как вы сделали это и установили соединение, вам остаётся считать полученное значение из свойства daytimestr 
Пример:
procedure TForm1.Button1Click(Sender: TObject);
begin
 NMDayTime1.ReportLevel := STATUS_BASIC;
 NMDayTime1.Timeout := 30000;
 NMDayTime1.Host := Edit1.Text;
 NMDayTime1.Port := StrToInt(Edit2.Text);
 Label3.Caption := NMDayTime1.DayTimeStr;
end;
Source: http://www.goldfaq.ru
ID: 03392
Category:Связь
Компонент TNMEcho

Компонент применяется для отсылки текстовых сообщений на эхо-сервер и получения этого сообщения обратно в соответствии со стандартом rfc 862. 
Этот компонент обычно применяется для тестирования и настройки сети., поскольку мы можем оценить время ответа сервера, которое помещается в свойство elapsedtime. Это единственное собственное свойство компонента, остальные наследуются. 
Перед отправкой сообщения должно быть установлено соединение с сервером. Для этого нужно задать имя сервера или его адрес в свойстве host, а в свойстве port определить соответствующий порт [обычно серверы эхо слушают 7-ой порт]. После этого нужно вызвать метод connect. Для отправки сообщения нужно использовать метод echo. В случае успеха вы должны получить от сервера ту строку, которую вы передали в качестве параметра методу echo. После этого для завершения связи вы должны вызвать метод disconnect. Все методы, кроме echo, компонент наследует. 
Пример: 
// Подключиться
NMEcho1.Host := Edit1.Text;
NMEcho1.Connect;
// Отключиться
NMEcho1.Disconnect;
// Отправить
Memo1.Lines.Add(NMEcho1.Echo(Edit2.Text) + 'время [' +
 FloatToStr(NMEcho1.ElapsedTime) + ']');
// Прекратить
NMEcho1.Abort;
Source: http://www.goldfaq.ru
ID: 03391
Category:Связь
Компонент TStoredProc

=== компонент TStoredProc ===
Недавно я перешел на использование Oracle, но все мои попытки использовать компонент TStoredProc оказываются неудачными. Почему?
Причины неработоспособности компонента TStoredProc могут быть следующими.
Во-первых, при использовании ODBC-доступа может оказаться, что применяемый вами ODBC-драйвер не поддерживает хранимые процедуры (как известно, не все ODBC-драйверы их поддерживают).
Во-вторых, имеется известная проблема, описание которой содержится в разделе Developers Support корпоративного сайта Inprise (http://www.inprise.com). Дело в том, что число параметров хранимой процедуры, с которой взаимодействует компонент TStoredProc, не должно превышать 10. В случае, если реальное число параметров превышает 10, многие разработчики переписывают хранимые процедуры так, чтобы они использовали строковые параметры, содержащие по несколько реальных параметров.
Source: Взято с http://delphiworld.narod.ru
ID: 02732
Компонент со вложенной панелью

=== Компонент со вложенной панелью ===
Следующий небольшой компонент представляет собой панель, содержащую другую, вложенную панель. Во вложенной панели могут быть размещены другие компоненты, читаться они будут правильно. Ключевым моментом здесь является перекрытие методов WriteComponents и ReadState.
unit RzPnlPnl;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, Dialogs, ExtCtrls;
type
 TSubPanel = class(TPanel)
 protected
 procedure ReadState(Reader: TReader); override;
 end;
 TPanelPanel = class(TPanel)
 private
 FSubPanel: TSubPanel;
 protected
 procedure WriteComponents(Writer: TWriter); override;
 procedure ReadState(Reader: TReader); override;
 public
 constructor Create(AOwner: TComponent); override;
 end;
procedure Register;
implementation
procedure TSubPanel.ReadState(Reader: TReader);
var
 OldOwner: TComponent;
begin
 { Сохраняем старого владельца, что необходимо для PanelPanel }
 OldOwner := Reader.Owner;
 Reader.Owner := Reader.Root; { Задаем в качестве владельца форму }
 try
 inherited ReadState(Reader);
 finally
 Reader.Owner := OldOwner;
 end;
end;
constructor TPanelPanel.Create(AOwner: TComponent);
const
 Registered: Boolean = False;
begin
 inherited Create(AOwner);
 FSubPanel := TSubPanel.Create(Self);
 FSubPanel.Parent := Self;
 FSubPanel.SetBounds(20, 20, 200, 100);
 FSubPanel.Name := 'SomeName';
 if not Registered then
 begin
 Classes.RegisterClasses([TSubPanel]);
 { так TSubPanel может храниться в файле формы }
 Registered := True;
 end;
end;
procedure TPanelPanel.ReadState(Reader: TReader);
var
 OldOwner: TComponent;
 I: Integer;
begin
 for I := 0 to ControlCount - 1 do
 Controls[0].Free;
 OldOwner := Reader.Owner;
 Reader.Owner := Self;
 { Для чтения субкомпонентов, установите данный экземпляр в качестве родителя }
 try
 inherited ReadState(Reader);
 finally
 Reader.Owner := OldOwner;
 end;
end;
procedure TPanelPanel.WriteComponents(Writer: TWriter);
var
 I: Integer;
begin
 for I := 0 to ControlCount - 1 do
 Writer.WriteComponent(Controls[I]);
end;
procedure Register;
begin
 RegisterComponents('Samples', [TPanelPanel]);
end;
end.
Комментарии:
 Выдает ошибки
 procedure WriteComponents(Writer: TWriter); override; Метод не найден в базовом классе
 
 Registered := True;на присвоение значения константе
Author: Ray Konopka
Source: http://delphiworld.narod.ru/
ID: 00949
Компонента HTML - редактора

Если у тебя стоит MS Internet Explorer 5, то считай, редактор у тебя в кармане ;-) Дело в том, что вместе с эксплорером идет DHTML -- ActiveX контрол, представляющий собой редактор HTML-ок, покруче, чем FrontPage Express даже, т.к. держит даже стили (.css). Лежит в C:\Program Files\Common Files\Microsoft Shared\Triedit. В Дельфи устанавливается через меню Components|Import ActiveX Control. При распространении своей программы с этим компонентом не забудь, что помимо копирования на машину клиента всех файлов из приведенного выше каталога нужно, чтоб они зарегистрированы были (regsvr32 имяфайла)
Source: http://delphiworld.narod.ru
ID: 03539
Category:Связь
Category:Web
Конвертация bitmap to sepia or greyscale

// This function adds a sepia effect to a bitmap.
// the 'depth' sets the colour intensity of the red-brown colour
// greater numbers set a higher intensity.
// To create a greyscale effect instead, set 'depth' to 0
function BmpToSepia(const bmp: TBitmap; depth: Integer): Boolean;
var
 color, color2: LongInt;
 r, g, b, rr, gg: Byte;
 h, w: Integer;
begin
 for h := 0 to bmp.Height do
 begin
 for w := 0 to bmp.Width do
 begin
 // first convert the bitmap to greyscale
 color := ColorToRGB(bmp.Canvas.Pixels[w, h]);
 r := GetRValue(color);
 g := GetGValue(color);
 b := GetBValue(color);
 color2 := (r+g+b) div 3;
 bmp.Canvas.Pixels[w, h] := RGB(color2, color2, color2);
 // then convert it to sepia
 color := ColorToRGB(bmp.Canvas.Pixels[w, h]);
 r := GetRValue(color);
 g := GetGValue(color);
 b := GetBValue(color);
 rr := r + (depth * 2);
 gg := g + depth;
 if rr <= ((depth * 2) - 1) then
 rr := 255;
 if gg <= (depth - 1) then
 gg:=255;
 bmp.Canvas.Pixels[w, h] := RGB(rr, gg, b);
 end;
 end;
end;
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
 BmpToSepia(Image1.Picture.Bitmap, 20);
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03893
Category:Графика
Category:Bitmap
Category:Цвета и палитры
Конвертация арабских цифр в римские

{ returns num in capital roman digits }
function IntToRoman(num: Cardinal): String;
const
 Nvals = 13;
 vals: array [1..Nvals] of Word = (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);
 roms: array [1..Nvals] of string[2] = ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');
var
 b: 1..Nvals;
begin
 Result := ;
 b := Nvals;
 while num > 0 do
 begin
 while vals[b] > num do
 Dec(b);
 Dec(num, vals[b]);
 Result := Result + roms[b]
 end;
end;
Source: Взято из http://www.lmc-mediaagentur.de/dpool
ID: 04059
Category:Алгоритмы
Category:Математика
Конвертация римских цифр в арабские

function RomanToDec(const Value: string): Integer;
var
 i, lastValue, curValue: Integer;
begin
 Result := 0;
 lastValue := 0;
 for i := Length(Value) downto 1 do
 begin
 case UpCase(Value[i]) of
 'C': curValue := 100;
 'D': curValue := 500;
 'I': curValue := 1;
 'L': curValue := 50;
 'M': curValue := 1000;
 'V': curValue := 5;
 'X': curValue := 10;
 else
 raise Exception.CreateFmt('Invalid character: %s', [Value[i]]);
 end;
 if curValue < lastValue then
 Dec(Result, curValue)
 else
 Inc(Result, curValue);
 lastValue := curValue;
 end;
end;
Source: http://www.baltsoft.com/
ID: 04058
Category:Алгоритмы
Category:Математика
Конвертировать INI файл в XML

=== Конвертировать INI файл в XML ===
uses XMLIntf, XMLDoc, INIFiles;
procedure INI2XML(const pINIFileName: string; const pXML: IXMLNode;
 const AsAttributes: Boolean = true);
var
 lINIFile: TIniFile;
 lSections, lItems: TStringList;
 iSections, iItems: integer;
 lNode: IXMLNode;
begin
 lINIFile := TIniFile.Create(pINIFileName);
 try
 lSections := TStringList.Create;
 try
 lItems := TStringList.Create;
 try
 lINIFile.ReadSections(lSections);
 for iSections := 0 to pred(lSections.Count) do
 begin
 lItems.Clear;
 lINIFile.ReadSection(lSections[iSections], lItems);
 lNode := pXML.AddChild(StringReplace(lSections[iSections], ' ', , [rfReplaceAll]));
 for iItems := 0 to pred(lItems.Count) do
 begin
 if AsAttributes then
 lNode.Attributes[lItems[iItems]] :=
 lINIFile.ReadString(lSections[iSections], lItems[iItems], )
 else
 lNode.AddChild(lItems[iItems]).Text :=
 lINIFile.ReadString(lSections[iSections], lItems[iItems], );
 end;
 lNode := nil;
 end;
 finally
 lItems.Free;
 end;
 finally
 lSections.Free;
 end;
 finally
 lINIFile.Free;
 end;
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 03102
Category:XML
Конвертировать результат запроса в XML и обратно

=== Конвертировать результат запроса в XML и обратно ===
unit ADOXMLUnit;
interface
uses
 Classes, ADOInt;
function RecordsetToXML(const Recordset: _Recordset): string;
function RecordsetFromXML(const XML: string): _Recordset;
implementation
uses
 ComObj;
function RecordsetToXML(const Recordset: _Recordset): string;
var
 RS: Variant;
 Stream: TStringStream;
begin
 Result := ;
 if Recordset = nil then
 Exit;
 Stream := TStringStream.Create();
 try
 RS := CreateOleObject('ADODB.Recordset');
 RS := Recordset;
 RS.Save(TStreamAdapter.Create(stream) as IUnknown, adPersistXML);
 Stream.Position := 0;
 Result := Stream.DataString;
 finally
 Stream.Free;
 end;
end;
function RecordsetFromXML(const XML: string): _Recordset;
var
 RS: Variant;
 Stream: TStringStream;
begin
 Result := nil;
 if XML = then
 Exit;
 try
 Stream := TStringStream.Create(XML);
 Stream.Position := 0;
 RS := CreateOleObject('ADODB.Recordset');
 RS.Open(TStreamAdapter.Create(Stream) as IUnknown);
 Result := IUnknown(RS) as _Recordset;
 finally
 Stream.Free;
 end;
end;
end.
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 03103
Category:Базы данных
Category:ADO
Category:XML
Конвертируем TDateTime to Unix Timestamp

=== Конвертируем TDateTime to Unix Timestamp ===
{
 Sometimes you want to communicate with mySQL or other databases using
 the unix timestamp. To solve this difference you may want to convert your
 TDateTime to the unix timestamp format and vice versa.
}
unit unix_utils;
interface
implementation
const
 // Sets UnixStartDate to TDateTime of 01/01/1970
 UnixStartDate: TDateTime = 25569.0;
function DateTimeToUnix(ConvDate: TDateTime): Longint;
begin
 // example: DateTimeToUnix(now);
 Result := Round((ConvDate - UnixStartDate) * 86400);
end;
function UnixToDateTime(USec: Longint): TDateTime;
begin
 // Example: UnixToDateTime(1003187418);
 Result := (Usec / 86400) + UnixStartDate;
end;
end.
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 00200
Конвертируем Unix дату

=== Конвертируем Unix дату ===
The value is a Unix Time, defined as seconds since 1970-01-01T00:00:00,0Z. Important is the Letter Z, you live in Sweden, in consequence you must add 1 hour for StandardDate and 2 hours for DaylightDate to the date. The infos you can get with GetTimeZoneInformation. But you must determine, which Bias (Standard or Daylight) is valid for the date (in this case -60). You can convert the date value with the function below.
The Date for 977347109 is 2000-12-20T22:18:29+01:00.
const
 UnixDateDelta = 25569; { 1970-01-01T00:00:00,0 }
 SecPerMin = 60;
 SecPerHour = SecPerMin * 60;
 SecPerDay = SecPerHour * 24;
 MinDayFraction = 1 / (24 * 60);
 {Convert Unix time to TDatetime}
function UnixTimeToDateTime(AUnixTime: DWord; ABias: Integer): TDateTime;
begin
 Result := UnixDateDelta + (AUnixTime div SecPerDay) { Days }
 + ((AUnixTime mod SecPerDay) / SecPerDay) { Seconds }
 - ABias * MinDayFraction { Bias to UTC in minutes };
end;
{Convert Unix time to String with locale settings}
function UnixTimeToStr(AUnixTime: DWord; ABias: Integer): string;
begin
 Result := FormatDateTime('ddddd hh:nn:ss', UnixTimeToDateTime(AUnixTime, ABias));
end;
{Convert TDateTime to Unix time}
function DateTimeToUnixTime(ADateTime: TDateTime; ABias: Integer): DWord;
begin
 Result := Trunc((ADateTime - UnixDateDelta) * SecPerDay) + ABias * SecPerMin;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
 Label1.Caption := UnixTimeToStr(977347109, -60);
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 00196
Конфигурирование ODBC

=== Конфигурирование ODBC ===
Представляю вашему вниманию инструкцию по конфигурированию ODBC и источника данных.
Для того, чтобы Borland Database Engine мог пользоваться драйверами ODBC, они должны быть сконфигурированы следующим образом:
* Инсталлируйте драйвер и установите его в Панель Управления/ODBC administrator.
* Если это файл базового драйвера типа dBase, Paradox, Excel, FoxPro и др., то вы должны указать каталог, содержащий ваши файлы.
* Access и Local Btrieve файлы должны указывать на конкретный файл базы данных (Btreive на File.ddf, Access должен указывать на файл с расширением .MDB).
* Если это линк (connection) к базе данных, например Oracle, Sybase, Interbase, и др., вы должны указать на этот линк. Обычно транспорт посредством TCPIP, SPX/IPX, NetBEUI и т.п. предусматривается поставщиком программного обеспечения. Каждый драйвер работает с транспортным протоколом по-своему.
* Запустите Database Engine Configuration Utility. (BDECFG.EXE)
* Выберите New ODBC Driver.
* Задайте имя вашему драйверу (к имени автоматически добавится "ODBC_".)
* Выберите ваш ODBC Driver из списка Default ODBC Driver List.
* Выберите имя источника данных по умолчанию.
* Создайте псевдоним (alias), указывающий на установленный вами драйвер.
* Установите ссылку с именем псевдонима на ваш драйвер.
; Примечание относительно баз данных Access 2.0: вам необходимо иметь самые последние драйверы от Microsoft. Имеющиеся драйверы позволяют работать только с базами данных Access 1.0, не выше.
Стоимость нового набора драйверов у самой Microsoft составляет $10, что эквивалентно цене носителя и пересылки.
Для работы с Access 2.0 вам необходимо использовать источник данных с именем "Microsoft Access Driver" или "Microsoft Access 2.0 Databases".
Имейте в виду, что "Access Data" и "Access Files" по умолчанию являются источниками данных только для Access 1.0. Поэтому для получения доступа к MDB-файлам Access 1.0 пользуйтесь "Access Data".
Btrieve также создает источник данных по умолчанию "Btrieve Data" и "Btrieve Files". Используйте "Btrieve Data" как ваш источник данных по умолчанию. Драйверы Btrieve позволяют использовать данные btrieve вплоть до версии 5.0. Для работы с Btrive данными более новой версии, необходим новый набор драйверов Microsoft или Intersolve Q+E.
Author: Mark Nelson (Delphi Tech Support) 
Source: Взято с http://delphiworld.narod.ru
ID: 02679
Конфликт IDAPI German и English

=== Конфликт IDAPI German и English ===
Я просто установил DtopicsP v1.20 и DtopicsD (03-29-96). При запуске dtopics.exe возникает ошибка DB-Error $3E05 ('cannot load driver') (не могу загрузить драйвер).
Я нашел ответ в German Borland Forum. Ошибка происходит, если установлен German BDE. В этом случае в систему устанавливается вместо IDR10009.DLL (который присутствует в английской версии) файл IDR10007.DLL. После установки данного файла в каталог IDAPI все заработало как часы.
Это означает, что приложения, разработанные под English Delphi не будут работать под German или French Delphi.
Author: Walter Schell
Source: Взято с http://delphiworld.narod.ru
ID: 02518
Координатная сетка

unit grid_;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls;
type
 TForm1 = class(TForm)
 procedure FormPaint(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormPaint(Sender: TObject);
var
 x0, y0: Integer; // координаты начала координатных осей
 dx, dy: Integer; // шаг координатной сетки (в пикселях)
 h, w: Integer; // высота и ширина области вывода координатной сетки
 x, y: Integer;
 lx, ly: Real; // метки (оцифровка) линий сетки по X Y
 dlx, dly: Real; // шаг меток (оцифровки) линий сетки по X и Y
 cross: Integer; // счетчик не оцифрованных линий сетки
 dcross: Integer; // количество не оцифрованных линий между оцифрованными
begin
 x0 := 30;
 y0 := 220; // оси начинаются в точке (40,250)
 dx := 40;
 dy := 40; // шаг координатной сетки 40 пикселей
 dcross := 1; // помечать линии сетки X: 1 - каждую;
 // 2 - через одну;
 // 3 - через две;
 dlx := 0.5; // шаг меток оси X
 dly := 1.0; // шаг меток оси Y, метками будут: 1, 2, 3 и т.д.
 h := 200;
 w := 300;
 with form1.Canvas do
 begin
 cross := dcross;
 MoveTo(x0, y0);
 LineTo(x0, y0 - h); // ось X
 MoveTo(x0, y0);
 LineTo(x0 + w, y0); // ось Y
 // засечки, сетка и оцифровка по оси X
 x := x0 + dx;
 lx := dlx;
 repeat
 MoveTo(x, y0 - 3);
 LineTo(x, y0 + 3); // засечка
 cross := cross - 1;
 if cross = 0 then //оцифровка
 begin
 TextOut(x - 8, y0 + 5, FloatToStr(lx));
 cross := dcross;
 end;
 Pen.Style := psDot;
 MoveTo(x, y0 - 3);
 LineTo(x, y0 - h); // линия сетки
 Pen.Style := psSolid;
 lx := lx + dlx;
 x := x + dx;
 until (x > x0 + w);
 // засечки, сетка и оцифровка по оси Y
 y := y0 - dy;
 ly := dly;
 repeat
 MoveTo(x0 - 3, y);
 LineTo(x0 + 3, y); // засечка
 TextOut(x0 - 20, y, FloatToStr(ly)); // оцифровка
 Pen.Style := psDot;
 MoveTo(x0 + 3, y);
 LineTo(x0 + w, y); // линия сетки
 Pen.Style := psSolid;
 y := y - dy;
 ly := ly + dly;
 until (y < y0 - h);
 end;
end;
end.
Source: http://delphiworld.narod.ru/
ID: 03751
Category:Графика
Category:Рисование
Копирование большого файла в буфер обмена

=== Копирование большого файла в буфер обмена ===
Вот общее решение, которое будет работать, даже если у вас размер файла превышает 64Кб:
function _hread(FileHandle: word; BufPtr: pointer;
 ByteCount: longint): longint; far;
 external 'KERNEL' index 349;
procedure CopyFileToClipboard(const fname: string);
var
 hmem, hFile: THandle;
 size: LongInt;
 p: Pointer;
begin
 hFile := FileOpen(fname, fmOpenRead);
 try
 size := FileSeek(hFile, 0, 2);
 FileSeek(hfile, 0, 0);
 if size > 0 then
 begin
 hmem := GlobalAlloc(GHND, size);
 if hMem <> 0 then
 begin
 p := GlobalLock(hMem);
 if p <> nil then
 begin
 _hread(hFile, p, size);
 GlobalUnlock(hMem);
 Clipboard.SetAsHandle(CF_TEXT, hMem);
 end
 else
 GlobalFree(hMem);
 end;
 end;
 finally
 FileClose(hFile);
 end;
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
var
 fname: string[128];
begin
 if OpenDialog1.Execute then
 begin
 fname := OpenDialog1.Filename;
 CopyFileToClipboard(fname);
 end;
end;
Примечание Vit: похоже это актуально только для Windows 3x
Source: http://delphiworld.narod.ru/
ID: 01894
Копирование в буфер обмена

=== Копирование в буфер обмена ===
procedure CopyButtonClick(Sender: TObject);
begin
 if ActiveControl is TMemo then
 TMemo(ActiveControl).CopyToClipboard;
 if ActiveControl is TDBMemo then
 TDBMemo(ActiveControl).CopyToClipboard;
 if ActiveControl is TEdit then
 TEdit(ActiveControl).CopyToClipboard;
 if ActiveControl is TDBedit then
 TDBedit(ActiveControl).CopyToClipboard;
end;
procedure PasteButtonClick(Sender: TObject);
begin
 if ActiveControl is TMemo then
 TMemo(ActiveControl).PasteFromClipboard;
 if ActiveControl is TDBMemo then
 TDBMemo(ActiveControl).PasteFromClipboard;
 if ActiveControl is TEdit then
 TEdit(ActiveControl).PasteFromClipboard;
 if ActiveControl is TDBedit then
 TDBedit(ActiveControl).PasteFromClipboard;
end;
Source: http://delphiworld.narod.ru/
ID: 01872