nyuuzyou/wikis huggingface dataset:
Копирование информации из DBGrid-а в Clipboard

=== Копирование информации из DBGrid-а в Clipboard ===
Простая процедура копирования информации из DBGrid-а в Clipboard может существенно облегчить жизнь при реализации требований экспорта выборок данных во внешние приемники. Удобнее вызов "прицепить" к контекстному меню грида.
unit UnGridToClb;
interface
uses
 Windows, SysUtils, Classes, Dialogs,
 Grids, DBGrids, Db, DBTables, ClipBrd;
procedure CopyGRDToClb(dbg: TDBGrid);
// Копирует DBGrid в буфер обмена,
// после чего данные отлично переносятся
// как в простой текстовый редактор, так и в Excell
implementation
procedure CopyGRDToClb(dbg: TDBGrid);
var
 bm: TBookMark;
 pch, pch1: PChar;
 s, s2: string;
 i, j: integer;
begin
 s := ;
 for j := 0 to dbg.Columns.Count - 1 do
 s := s + dbg.Columns.Items[j].Title.Caption + #9;
 s := s + #13 + #10;
 if not dbg.DataSource.DataSet.active then
 begin
 ShowMessage('Нет выборки!!!');
 Exit;
 end;
 try
 dbg.Visible := False; // Делаем грид невидимым, чтобы не тратилось время
 // на его перерисовку при прокрутке DataSet - просто и
 // эффективно
 bm := dbg.DataSource.DataSet.GetBookmark; // для того чтобы не
 // потерять текущую запись
 dbg.DataSource.DataSet.First;
 while not dbg.DataSource.DataSet.EOF do
 begin
 s2 := ;
 for j := 0 to dbg.Columns.Count - 1 do
 begin
 s2 := s2 + dbg.Columns.Items[j].Field.AsString + #9;
 end;
 s := s + s2 + #13 + #10;
 dbg.DataSource.DataSet.Next;
 end;
 // Переключаем клавиатуру "в русский режим",
 // иначе - проблемы с кодировкой
 GetMem(pch, 100);
 GetMem(pch1, 100);
 GetKeyboardLayoutName(pch);
 StrCopy(pch1, pch);
 while pch <> '00000419' do
 begin
 ActivateKeyboardLayout(HKL_NEXT, 0);
 GetKeyboardLayoutName(pch);
 if strComp(pch, pch1) = 0 then
 // Круг замкнулся - нет такого языка '00000419'
 StrCopy(pch, '00000419');
 end;
 clipboard.AsText := s; // Данные - в буфер!!!
 // Возвращаем режим клавиатуры
 while strComp(pch, pch1) <> 0 do
 begin
 ActivateKeyboardLayout(HKL_NEXT, 0);
 GetKeyboardLayoutName(pch);
 end;
 FreeMem(pch);
 FreeMem(pch1);
 dbg.DataSource.DataSet.GotoBookmark(bm);
 //ShowMessage('Данные успешно скопированы в буфер обмена.');
 finally
 dbg.Visible := True;
 end;
end;
end.
Source: Взято с http://delphiworld.narod.ru
ID: 03066
Category:Базы данных
Category:DBGrid
Category:Clipboard
Копирование содержимого TStringGrid в буфер обмена

=== Копирование содержимого TStringGrid в буфер обмена ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Копирование содержимого StringGrid в буфер обмена
Копирует содержимое ячеек StringGrid в ClipBoard в формате, позволяющем
вставку, например, в Word или Excel. При CopySel=True копирует выделение,
иначе всю таблицу или указанный диапазон (CL- левый столбец и т.д.).
Зависимости: Grids
Copyright: MBo
Дата: 30 апреля 2002 г.
***************************************************** }
procedure SGCopyToCLP(SG: TStringGrid; CopySel: Boolean; CL: integer = -1;
 RT: integer = -1; CR: integer = -1; RB: integer = -1);
var
 i, j: Integer;
 s: string;
begin
 s := ;
 with SG do
 begin
 if CopySel then
 begin
 CL := Selection.Left;
 CR := Selection.Right;
 RT := Selection.Top;
 RB := Selection.Bottom;
 end;
 // при необходимости FixedRows и FixedCols можно заменить на 0
 if (CL < FixedCols) or (CL > CR) or (CL >= ColCount) then
 CL := FixedCols;
 if (CR < FixedCols) or (CL > CR) or (CR >= ColCount) then
 CR := ColCount - 1;
 if (RT < FixedRows) or (RT > RB) or (RT >= RowCount) then
 RT := FixedRows;
 if (RB < FixedCols) or (RT > RB) or (RB >= RowCount) then
 RB := RowCount - 1;
 for i := RT to RB do
 begin
 for j := CL to CR do
 begin
 s := s + Cells[j, i];
 if j < CR then
 s := s + #9;
 end;
 s := s + #13#10;
 end;
 end;
 ClipBoard.AsText := s;
end;
// Пример использования:
SGCopyToCLP(StringGrid1, True); // выделение
SGCopyToCLP(StringGrid1, False); // все ячейки
SGCopyToCLP(StringGrid1, False, 1, 1, 3, 2); // диапазон, 6 ячеек
Source: http://delphibase.endimus.com
ID: 01096
Копирование таблицы с помощью DBE

=== Копирование таблицы с помощью DBE ===
function CopyTable(tbl: TTable; dest: string): boolean;
var
 psrc, pdest: array[0..DBIMAXTBLNAMELEN] of char;
 rslt: DBIResult;
begin
 Result := False;
 StrPCopy(pdest, dest);
 with tbl do
 begin
 try
 DisableControls;
 StrPCopy(psrc, TableName);
 rslt := DbiCopyTable(DBHandle, True, psrc, nil, pdest);
 Result := (rslt = 0);
 finally
 Refresh;
 EnableControls;
 end;
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02597
Копирование файлов

== Копирование методом Pascal ==
type
 TCallBack = procedure(Position, Size: Longint); { Для индикации процесса копирования }
procedure FastFileCopy(const InfileName, OutFileName: string; CallBack: TCallBack);
const
 BufSize = 3 * 4 * 4096; { 48Kbytes дает прекрасный результат }
type
 PBuffer = ^TBuffer;
 TBuffer = array [1..BufSize] of Byte;
var
 Size : Integer;
 Buffer : PBuffer;
 infile, outfile : File;
 SizeDone,SizeFile: Longint;
begin
 if (InFileName <> OutFileName) then
 begin
 Buffer := Nil;
 AssignFile(infile, InFileName);
 System.Reset(infile, 1);
 try
 SizeFile := FileSize(infile);
 AssignFile(outfile, OutFileName);
 System.Rewrite(outfile, 1);
 try
 SizeDone := 0; New(Buffer);
 repeat
 BlockRead(infile, Buffer^, BufSize, Size);
 Inc(SizeDone, Size);
 CallBack(SizeDone, SizeFile);
 BlockWrite(outfile,Buffer^, Size)
 until Size < BufSize;
 FileSetDate(TFileRec(outfile).Handle,
 FileGetDate(TFileRec(infile).Handle));
 finally
 if Buffer <> Nil then Dispose(Buffer);
 System.Close(outfile)
 end;
 finally
 System.Close(infile);
 end;
 end
 else
 Raise EInOutError.Create('File cannot be copied into itself');
end;
== Копирование методом потока ==
procedure FileCopy(const SourceFileName, TargetFileName: string);
var
 S, T: TFileStream;
begin
 S := TFileStream.Create(SourceFileName, fmOpenRead );
 try
 T := TFileStream.Create(TargetFileName, fmOpenWrite or fmCreate);
 try
 T.CopyFrom(S, S.Size);
 FileSetDate(T.Handle, FileGetDate(S.Handle));
 finally
 T.Free;
 end;
 finally
 S.Free;
 end;
end;
== Копирование методом LZExpand ==
uses LZExpand;
procedure CopyFile(FromFileName, ToFileName: string);
var
 FromFile, ToFile: File;
begin
 AssignFile(FromFile, FromFileName);
 AssignFile(ToFile, ToFileName);
 Reset(FromFile);
 try
 Rewrite(ToFile);
 try
 if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle) < 0 then
 raise Exception.Create('Error using LZCopy')
 finally
 CloseFile(ToFile);
 end;
 finally
 CloseFile(FromFile);
 end;
end;
== Копирование методами Windows ==
uses ShellApi; // !!! важно
function WindowsCopyFile(FromFile, ToDir: string): Boolean;
var
 F: TShFileOpStruct;
begin
 F.Wnd := 0;
 F.wFunc := FO_COPY;
 FromFile := FromFile + #0;
 F.pFrom := PChar(FromFile);
 ToDir := ToDir + #0;
 F.pTo := PChar(ToDir);
 F.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;
 Result := (ShFileOperation(F) = 0);
end;
// пример копирования
procedure TForm1.Button1Click(Sender: TObject);
begin
 if not WindowsCopyFile('C:\UTIL\ARJ.EXE', GetCurrentDir) then
 ShowMessage('Copy Failed');
end;
Source: http://dmitry9.nm.ru/info/
ID: 03176
Category:Файловая система
Копирование экрана

unit ScrnCap;
interface
uses WinTypes, WinProcs, Forms, Classes, Graphics, Controls;
{ Копирует прямоугольную область экрана }
function CaptureScreenRect(ARect: TRect): TBitmap;
{ Копирование всего экрана }
function CaptureScreen: TBitmap;
{ Копирование клиентской области формы или элемента }
function CaptureClientImage(Control: TControl): TBitmap;
{ Копирование всей формы элемента }
function CaptureControlImage(Control: TControl): TBitmap;
{===============================================================}
implementation
function GetSystemPalette: HPalette;
var
 PaletteSize: Integer;
 LogSize: Integer;
 LogPalette: PLogPalette;
 DC: HDC;
 Focus: HWND;
begin
 Result := 0;
 Focus := GetFocus;
 DC := GetDC(Focus);
 try
 PaletteSize := GetDeviceCaps(DC, SIZEPALETTE);
 LogSize := SizeOf(TLogPalette) + (PaletteSize-1) * SizeOf(TPaletteEntry);
 GetMem(LogPalette, LogSize);
 try
 with LogPalette^ do
 begin
 palVersion := $0300;
 palNumEntries := PaletteSize;
 GetSystemPaletteEntries(DC, 0, PaletteSize, palPalEntry);
 end;
 Result := CreatePalette(LogPalette^);
 finally
 FreeMem(LogPalette, LogSize);
 end;
 finally
 ReleaseDC(Focus, DC);
 end;
end;
function CaptureScreenRect(ARect: TRect): TBitmap;
var
 ScreenDC: HDC;
begin
 Result := TBitmap.Create;
 with result, ARect do
 begin
 Width := Right-Left;
 Height := Bottom-Top;
 ScreenDC := GetDC(0);
 try
 BitBlt(Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, SRCCOPY);
 finally
 ReleaseDC(0, ScreenDC);
 end;
 Palette:=GetSystemPalette;
 end;
end;
function CaptureScreen: TBitmap;
begin
 with Screen do
 Result := CaptureScreenRect(Rect(0, 0, Width, Height));
end;
function CaptureClientImage(Control: TControl): TBitmap;
begin
 with Control, Control.ClientOrigin do
 Result := CaptureScreenRect(Bounds(X, Y, ClientWidth, ClientHeight));
end;
function CaptureControlImage(Control: TControl): TBitmap;
begin
 with Control do
 if Parent = Nil then
 Result := CaptureScreenRect(Bounds(Left, Top, Width, Height))
 else
 with Parent.ClientToScreen(Point(Left, Top)) do
 Result := CaptureScreenRect(Bounds(X, Y, Width, Height));
end;
end.
Author: Зайцев О.В.
Author: Владимиров А.М.
Source: http://forum.sources.ru
ID: 03823
Category:Графика
Копировать векторное изображение

procedure TForm1.Button1Click(Sender: TObject);
var
 mf: TMetaFile;
 mfc: TMetaFileCanvas;
 i: Integer;
 ClipBrdFormat: Word;
 data: Cardinal;
 palette: hPalette;
 p: array [0..90] of TPoint;
begin
 mf := TMetaFile.Create;
 mf.Width := 100;
 mf.Height := 100;
 mfc := TMetafileCanvas.Create(mf, 0);
 with mfc do
 begin
 Pen.Color := clBlack;
 FrameRect(ClipRect);
 MoveTo(0, 50);
 LineTo(100, 50);
 LineTo(95, 48);
 MoveTo(100, 50);
 LineTo(95, 52);
 MoveTo(50, 100);
 LineTo(50, 0);
 LineTo(48, 5);
 MoveTo(50, 0);
 LineTo(52, 5);
 Brush.Style := bsClear;
 Font.Name := 'Arial';
 Font.Size := 6;
 TextOut(55, 0, 'Y');
 TextOut(95, 38, 'X');
 Pen.Color := clRed;
 for i := Low(p) to High(p) do
 p[i] := Point(i, Round(50 - 30 * Sin((i - 50) / 5)));
 Polyline(p);
 end;
 mfc.Free;
 mf.SaveToClipboardFormat(ClipBrdFormat, data, palette);
 OpenClipboard(Application.Handle);
 EmptyClipboard;
 SetClipboardData(ClipBrdFormat, data);
 CloseClipboard;
 mf.Inch := 200;
 Form1.Canvas.Draw(0, 0, mf);
 mf.Free;
end;
Source: http://delphiworld.narod.ru/
ID: 03817
Category:Графика
Копировать и вставлять TreeNode

=== Копировать и вставлять TreeNode ===
var
 SL : TStringList;
procedure TForm1.CutBtnClick(Sender: TObject);
var
 i, j, StartLevel: integer;
 TNSel: TTreeNode;
begin
 TNSel := TreeView1.Selected;
 if TNSel <> nil then
 begin
 StartLevel := TNSel.Level;
 i := TNSel.AbsoluteIndex;
 j := i; // note for later deletion
 if SL = nil then
 SL := TStringList.Create
 else
 SL.Clear;
 SL.AddObject(TNSel.Text, Pointer(0));
 Inc(i);
 with TreeView1 do
 begin
 while Items[i].Level > StartLevel do
 begin
 { stop before next sibling to top node }
 SL.AddObject(Items[i].Text, Pointer(Items[i].Level - StartLevel));
 Inc(i);
 end;
 Items[j].Delete;
 end;
 end;
end;
procedure TForm1.PasteBtnClick(Sender: TObject);
var
 i, Level : integer;
 TNSel, TN : TTreeNode;
begin
 with TreeView1 do
 begin
 TNSel := Selected;
 if TNSel <> nil then
 begin
 TN := Items.Insert(TNSel, SL.Strings[0]);
 Level := integer(SL.Objects[0]); // should be 0
 for i := 1 to SL.Count - 1 do
 begin
 if integer(SL.Objects[i]) < Level then
 begin
 { go up one level }
 TN := TN.Parent;
 Level := Integer(SL.Objects[i]);
 end;
 if Level = Integer(SL.Objects[i]) then
 { same level }
 TN := Items.Add(TN, SL.Strings[i])
 else
 begin
 { go down one level }
 TN := Items.AddChild(TN, SL.Strings[i]);
 Level := Integer(SL.Objects[i]);
 end;
 end;
 end;
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 01115
Копировать и вставлять ячейки TStringGrid в буфер обмена

=== Копировать и вставлять ячейки TStringGrid в буфер обмена ===
uses
 Clipbrd;
// Copy
procedure TForm1.Button1Click(Sender: TObject);
var
 S: string;
 GRect: TGridRect;
 C, R: Integer;
begin
 GRect := StringGrid1.Selection;
 S := ;
 for R := GRect.Top to GRect.Bottom do
 begin
 for C := GRect.Left to GRect.Right do
 begin
 if C = GRect.Right then S := S + (StringGrid1.Cells[C, R])
 else
 S := S + StringGrid1.Cells[C, R] + #9;
 end;
 S := S + #13#10;
end;
 ClipBoard.AsText := S;
end;
// Paste
procedure TForm1.Button2Click(Sender: TObject);
var
 Grect: TGridRect;
 S, CS, F: string;
 L, R, C: Byte;
begin
 GRect := StringGrid1.Selection;
 L := GRect.Left;
 R := GRect.Top;
 S := ClipBoard.AsText;
 R := R - 1;
 while Pos(#13, S) > 0 do
 begin
 R := R + 1;
 C := L - 1;
 CS := Copy(S, 1,Pos(#13, S));
 while Pos(#9, CS) > 0 do
 begin
 C := C + 1;
 if (C <= StringGrid1.ColCount - 1) and (R <= StringGrid1.RowCount - 1) then
 StringGrid1.Cells[C, R] := Copy(CS, 1,Pos(#9, CS) - 1);
 F := Copy(CS, 1,Pos(#9, CS) - 1);
 Delete(CS, 1,Pos(#9, CS));
 end;
 if (C <= StringGrid1.ColCount - 1) and (R <= StringGrid1.RowCount - 1) then
 StringGrid1.Cells[C + 1,R] := Copy(CS, 1,Pos(#13, CS) - 1);
 Delete(S, 1,Pos(#13, S));
 if Copy(S, 1,1) = #10 then
 Delete(S, 1,1);
 end;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01886
----
=== Как скопировать выбранные в DBGrid записи в буфер обмена ===
const
 FIELD_DELIMITER = #9;
 RECORD_DELIMITER = #10;
procedure CopyDBGridToClipboard(Grid: TDBGrid);
var
 BM: string;
 S: string;
 S1: string;
 I: Integer;
begin
 with Grid do
 begin
 if Assigned(DataSource) and Assigned(DataSource.DataSet) and DataSource.DataSet.Active then
 with DataSource.DataSet do
 begin
 S := ;
 DisableControls;
 BM := BookMark;
 for I := 0 to Pred(Columns.Count) do
 begin
 if Assigned(Columns.Items[I].Field) then
 S := S + Columns.Items[I].Title.Caption + FIELD_DELIMITER;
 end;
 S[Length(S)] := RECORD_DELIMITER;
 First;
 while not Eof do
 begin
 S1 := ;
 for I := 0 to Pred(Columns.Count) do
 begin
 if Assigned(Columns.Items[I].Field) then
 S1 := S1 + FieldByName(Columns[I].FieldName).AsString + FIELD_DELIMITER;
 end;
 S1[Length(S1)] := RECORD_DELIMITER;
 S := S + S1;
 Next;
 end;
 BookMark := BM;
 EnableControls;
 //Clipboard.SetTextBuf(PChar(S));
 SendToClipboard(S);
 end;
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 01887
Копировать узлы с поддеревом TTreeView во второй TTreeView

=== Копировать узлы с поддеревом TTreeView во второй TTreeView ===
type
 {: Callback to use to copy the data of a treenode when the
 node itself is copied by CopySubtree.
 @param oldnode is the old node
 @param newnode is the new node
 @Desc Use a callback of this type to implement your own algorithm
 for a node copy. The default just uses the Assign method, which
 produces a shallow copy of the nodes Data property. }
 TCopyDataProc = procedure(oldnode, newnode: TTreenode);
{: The default operation is to do a shallow copy of the node, via Assign. }
procedure DefaultCopyDataProc(oldnode, newnode: TTreenode);
begin
 newnode.Assign(oldnode);
end;
{-- CopySubtree -------------------------------------------------------}
{: Copies the source node with all child nodes to the Target TTreeView.
@Param SourceNode is the node to copy
@Param Target is the treeview to insert the copied nodes into
@Param TargetNode is the node to insert the copy under, can be nil to
 make the copy a top-level node.
@Param CopyProc is the (optional) callback to use to copy a node.
 If Nil is passed for this parameter theDefaultCopyDataProc will be
used.
@Precondition SourceNode <> nil, Target <> nil, TargetNode is either
 nil or a node of Target
@Raises Exception if TargetNode happens to be in the subtree rooted in
 SourceNode. Handling that special case is rather complicated, so we
 simply refuse to do it at the moment. }
{ Created 2003-04-09 by P. Below
-----------------------------------------------------------------------}
procedure CopySubtree(SourceNode: TTreenode; Target: TTreeView;
 TargetNode: TTreeNode; CopyProc: TCopyDataProc = nil);
var
 Anchor: TTreenode;
 Child: TTreenode;
begin { CopySubtree }
 Assert(Assigned(SourceNode), 'CopySubtree:sourcenode cannot be nil');
 Assert(Assigned(Target), 'CopySubtree: target treeview cannot be nil');
 Assert((TargetNode = nil) or (TargetNode.TreeView = Target),
 'CopySubtree: targetnode has to be a node in the target treeview.');
 if (SourceNode.TreeView = Target)
 and (TargetNode.HasAsParent(SourceNode)
 or (SourceNode = TargetNode)) then
 raise Exception.Create('CopySubtree cannot copy a subtree to one of the ' +
 'subtrees nodes.');
 if not Assigned(CopyProc) then
 CopyProc := DefaultCopyDataProc;
 Anchor := Target.Items.AddChild(TargetNode, SourceNode.Text);
 CopyProc(SourceNode, Anchor);
 Child := SourceNode.GetFirstChild;
 while Assigned(Child) do
 begin
 CopySubtree(Child, Target, Anchor, CopyProc);
 Child := Child.GetNextSibling;
 end;
end;
procedure TForm1.Button1Click(Sender : TObject);
begin
 if Assigned(TreeView1.Selected) then
 CopySubtree(TreeView1.Selected, TreeView2, nil);
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01116
Копируем русский текст в буфер обмена в Windows2000

=== Копируем русский текст в буфер обмена в Windows2000 ===
У меня Windows NT/2000. Когда копирую текст на русском языке, скажем, из TMemo в Ворд 97/2000, то получаю в результате каракули. Эти каракули исправляются, если перед копированием насильно переключить клавиатуру пользователя на русский язык. Но если у него нет этой клавиатуры, или если лучше не переключать ее, то как можно сообщить системе, что мы будем копировать РУССКИЙ текст. На форме создается невидимый TRichEdit (я обозвал его TRE в коде). Далее текст копируется в клипборд как обычно, после чего вызывается следующая процедура 
procedure TMainForm.ConvertClipboard;
begin
 TRE.SelectAll;
 TRE.ClearSelection;
 TRE.Lines.Add(Clipboard.AsText);
 TRE.SelectAll;
 TRE.Font.Name := 'Times New Roman'; // тут нужный шрифт
 TRE.Font.Size := 12; // тут нужный размер
 // или просто берите TRE.Font := MainMemo.Font;
 TRE.SelAttributes.Charset := RUSSIAN_CHARSET;
 TRE.CopyToClipboard;
end
Source: Взято с http://delphiworld.narod.ru
ID: 01898
Кораблик

unit ship_;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, ExtCtrls;
type
 TForm1 = class(TForm)
 Timer1: TTimer;
 procedure Timer1Timer(Sender: TObject);
 procedure FormActivate(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
 x, y: Integer; // координаты корабля (базовой точки)
implementation
{$R *.DFM}
procedure Titanik(x, y: Integer; // координаты базовой точки
 color: TColor); // цвет корабля
const
 dx = 5;
 dy = 5;
var
 buf: TColor;
begin
 with form1.canvas do
 begin
 buf := pen.Color; // сохраним текущий цвет
 pen.Color := color; // установим нужный цвет
 // рисуем ...
 // корпус
 MoveTo(x, y);
 LineTo(x, y - 2 * dy);
 LineTo(x + 10 * dx, y - 2 * dy);
 LineTo(x + 11 * dx, y - 3 * dy);
 LineTo(x + 17 * dx, y - 3 * dy);
 LineTo(x + 14 * dx, y);
 LineTo(x, y);
 // надстройка
 MoveTo(x + 3 * dx, y - 2 * dy);
 LineTo(x + 4 * dx, y - 3 * dy);
 LineTo(x + 4 * dx, y - 4 * dy);
 LineTo(x + 13 * dx, y - 4 * dy);
 LineTo(x + 13 * dx, y - 3 * dy);
 MoveTo(x + 5 * dx, y - 3 * dy);
 LineTo(x + 9 * dx, y - 3 * dy);
 // капитанский мостик
 Rectangle(x + 8 * dx, y - 4 * dy, x + 11 * dx, y - 5 * dy);
 // труба
 Rectangle(x + 7 * dx, y - 4 * dy, x + 8 * dx, y - 7 * dy);
 // иллюминаторы
 Ellipse(x + 11 * dx, y - 2 * dy, x + 12 * dx, y - 1 * dy);
 Ellipse(x + 13 * dx, y - 2 * dy, x + 14 * dx, y - 1 * dy);
 // мачта
 MoveTo(x + 10 * dx, y - 5 * dy);
 LineTo(x + 10 * dx, y - 10 * dy);
 // оснастка
 MoveTo(x + 17 * dx, y - 3 * dy);
 LineTo(x + 10 * dx, y - 10 * dy);
 LineTo(x, y - 2 * dy);
 pen.Color := buf; // восстановим старый цвет карандаша
 end;
end;
// обработка сигнала таймера
procedure TForm1.Timer1Timer(Sender: TObject);
begin
 Titanik(x, y, form1.color); // стереть рисунок
 if x < Form1.ClientWidth then
 x := x + 5
 else
 begin // новый рейс
 x := 0;
 y := Random(50) + 100;
 end;
 Titanik(x, y, clWhite); // нарисовать в новой точке
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
 x := 0;
 y := 100;
 Form1.Color := clNavy;
 Timer1.Interval := 50; // сигнал таймера каждые 50 мСек
end;
end.
Source: http://delphiworld.narod.ru/
ID: 03752
Category:Графика
Category:Рисование
Корректировка поведения маски TDateTimeField

=== Корректировка поведения маски TDateTimeField ===
При работе с полями в формате "дата-время" объектов типа TDataSet мои коллеги неоднократно сталкивались с проблемой поведения маски. Недавно у меня тоже возникла задача работы с такими полями. Возможно, ни один из нас просто не разобрался, как нужно делать правильно, но нужно было действовать. 
Проблема заключается в том, что при вводе с клавиатуры требуется обязательно указывать все знаки, включая ненужные в конкретном случае (временную часть). В противном случае генерируется ошибка: 
 'Invalid input value. Use escape key to abandon changes'
После часа, потраченного на разбирательство с маской, возникло желание написать собственный компонент. Спросив у коллег, которые уже ходили этим путем, я решил посмотреть в исходниках - вдруг получится быстро обойти этот вопрос. 
Не буду брать на себя смелость комментировать, что и как делается в модуле Mask.pas. Кто хочет, может разобраться самостоятельно - ничего особо сложного там нет. 
Для начала в свойстве EditMask замените символ BlankChar с '_' на '0'. В результате получится маска вроде 
 !99/99/99 99:99:99;1;0
Чтобы при редактировании и просмотре значение выглядело одинаково, укажите свойство DisplayFormat 
 dd.mm.yy hh:nn:ss
Далее нужно добавить в проект файлы Consts.pas, Sysconsts.pas и Mask.pas. После внесения изменений закройте Дельфи, и открыв снова, перекомпилируйте проект. Затем указанные файлы можно исключить из проекта. Пример приведен для Дельфи 5. 
Изменения следующие:
Consts.pas 
// SMaskEditErr = 'Invalid input value. Use escape key to abandon changes';
SMaskEditErr = 'Введено некорректное значение. Нажмите Esc для отмены';
SysConsts.pas 
// SInvalidDateTime = '%s is not a valid date and time';
SInvalidDateTime = '%s - некорректное значение даты и времени';
Mask.pas 
function TCustomMaskEdit.RemoveEditFormat(const Value: string): string;
{ шестая строка снизу }
{ так было }
// if Result[I] = FMaskBlank then
// Result[I] := ' ';
{ так стало }
if Result[I] = FMaskBlank then
 if FMaskBlank = '0' then
 Result[I] := FMaskBlank
 else
 Result[I] := ' ';
 function TCustomMaskEdit.Validate(const Value: string; var Pos: Integer):
 Boolean;
 { одинадцатая строка снизу }
 { так было }
 // if (Value [Offset] = FMaskBlank) or
 // ((Value [Offset] = ' ') and (EditMask[MaskOffset] <> mMskAscii)) then
 if (FMaskBlank <> '0') and
 ((Value[Offset] = FMaskBlank) or
 ((Value[Offset] = ' ') and (EditMask[MaskOffset] <> mMskAscii))) then
В завершении хочу поделиться полезной и простой функцией. Как правило, при создании документа, мы вставляем текущие дату и время. При этом секунды как правило не нужны. 
function GetDateTimeWOSec(DateTime: TDateTime): TDateTime;
begin
 Result := StrToDateTime(FormatDateTime('dd.mm.yy hh:nn', DateTime));
end;
После проведения описанных манипуляций с полем в формате дата-время становиться так же приятно работать, как с компонентом TRXDateEdit. 
Source: http://delphiworld.narod.ru
ID: 00757
Краткая история Delphi

=== Краткая история Delphi ===
Delphi - это потомок Турбо Паскаля, который был выпущен для операционной системы CP/M в 1983 году. В феврале 1994 года Турбо Паскаль был перенесен на операционную систему MS-DOS. 
На раннем этапе развития компьютеров IBM PC, Турбо Паскаль являлся одним из наиболее популярных языков разработки программного обеспечения - главным образом потому, что это было вполне серьезный компилятор, который, включая компилятор, редактор и все остальное, стоил всего $19.95 и работал на машине с 64 Kb оперативной памяти. 
Под Windows - Турбо Паскаль был перенесен фирмой Borland в 1990 году. А самая последняя версия Borland Pascal 7.0 (имеющая теперь такое название), не считая Delphi, вышла в свет в 1992 году. 
Разработка Delphi началась в 1993 году. После проведения beta-тестирования Delphi показали на "Software Development '95". И 14 февраля 1995 года официально объявили о ее продаже в США. В торговлю Delphi попала спустя 14 дней, 28 февраля 1995 года. 
Source: http://dmitry9.nm.ru/info/
ID: 00060