nyuuzyou/wikis huggingface dataset:
Возможные проблемы при работе с TCanvas больших размеров

Проблема.
Так получилось, что передо мной встала задачи работы с канвой (TCanvas) больших размеров (от 2000 и более точек в одном измерении). Через достаточно короткое время работы я обнаружил, что методы TCanvas иногда ведут себя некорректно. Некорректность поведения заключалась в том, что при определенных условиях графические примитивы, например, прямые линии, либо отображались неправильно, либо просто исчезали. Проверка и перепроверка текста программы ничего не дала. Попытка найти какую-либо информацию о возможных особенностях работы с канвой таких размеров также ни дала положительного результата (может быть, просто плохо искал). Пришлось разбираться самому, а затем и обратиться за советом к некоторым жителям Королевства.
Результат.
В ходе работы удалось некоторым образом локализовать условия возникновения изложенной выше ситуации.
:1. Проблемы возникают только под Win9x. Под Windows NT или 2000 подобные ошибки обнаружить не удалось.
:2. Графические примитивы могут отображаться неправильно, если их размер в одном измерении более 1000 точек. Например, при отрисовки линии:
MoveTo(0, 0);
LineTo(0, 2000);
:3. Самый надежный метод TCanvas - Rectangle, рисуется корректно всегда. Менее надежные - методы рисования прямых линий, например, PolyLine или MoveTo, LineTo.
Поскольку большое значение имеет платформа, а именно Windows 9x, возникло предположение, что возникающие проблемы являются не глюком или не ошибкой TCanvas. Просто именно под этой платформой возможности графики ограничены.
Напрашивающиеся выводы по использованию TCanvas больших размеров.
:1. Не пытайтесь рисовать все сразу, а отображайте только то что, действительно необходимо. Если по каким-либо причинам это невозможно, и вам просто необходимо перерисовывать сразу весь TCanvas, используйте графические примитивы, принудительно ограничивая их размер, допустим 1500 точек.
:2. Может быть, воспользоваться советом Рустама Кафарова:
"Итак, решение одно (во всяком случае, одно я нашел, может решений больше) - используйте платформу NT. Под Windows 2000 все работает НАМНОГО ЛУЧШЕ! Советую просто поменять систему. Если в вашей программе будет ремарка "разработана специально под NT", то это не будет минусом для программы"
P.S.
В качестве примера я предлагаю вашему вниманию небольшой проект TCanvas.zip, в котором возникают изложенные выше проблемы. Суть проекта - отрисовка разными методами сетки с шагом 40 точек.
К сожалению, мне не удалось подобрать такой режим, чтобы проблема возникало на любой машине, на которой стоит Windows 9x. Поэтому я хотел бы попросить сразу не забрасывать меня помидорами тех, у кого под Windows 9x все будет работать корректно. Возможно, что все вышеописанное является неким частным случаем, и автор хотел бы получить отклик от тех, кому интересна эта тема.
Особая благодарность Кафарову Рустаму за оказанную помощь.
Author: Тимофей Загуренко
Source: http://delphiworld.narod.ru/
ID: 03731
Category:Графика
Возникает сложность копирования MS Access

=== Возникает сложность копирования MS Access ===
Говорит мол невозможно открыть файл. И на самом деле еще виден файл блокировки Access. Как закрыть базу так чтоб этот файл исчез и я мог сохранить.
Ответ:
 session.close
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02749
Восстановление записи dBase

=== Восстановление записи dBase ===
function GetTableCursor(oTable: TTable): hDBICur;
var
 szTable: array[0..78] of Char;
begin
 StrPCopy(szTable, oTable.TableName);
 DbiGetCursorForTable(oTable.DBHandle, szTable, nil, Result);
end;
function dbRecall(oTable: TTable): DBIResult;
begin
 Result := DbiUndeleteRecord(GetTableCursor(oTable)));
end;
Предположим, у вас на форме имеется кнопка (с именем 'butRecall'), восстанавливающая текущую отображаемую (или позиционируемую курсором) запись, данный код, будучи расположенный в обработчике события кнопки OnClick (вместе с опубликованным выше кодом), это демонстрирует (продвигаясь в наших предположениях дальше, имя вашего объекта TTable - Table1 и имя текущей формы - Form1):
procedure TForm1.butRecallClick(Sender: TObject);
begin
 if dbRecall(Table1) <> DBIERR_NONE then
 ShowMessage('Не могу восстановить запись!');
end;
Author: Loren Scott
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 02702
----
procedure RecordUndelete(ATable: TTable);
begin
 ATable.UpdateCursorPos;
 try
 Check(DbiUndeleteRecord(ATable.Handle));
 except
 ShowMessage('No undelete performed.');
 end;
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 02703
Восстановление минимизированного приложения

=== Восстановление минимизированного приложения ===
При минимизации формы я использую RxTrayIcon, чтобы при этом исчезла кнопка из Панели задач вызываю ShowWindow(Application.Handle, SW_HIDE).
Но вот незадача - не получается при восстановлении приложения (после клика на TrayIcon) добиться, чтобы оно становилось поверх других окон и обязательно было активным.
Дело оказалось в следующем: гасить Tray-иконку надо в последнюю очередь, именно так все работает(ранее сначала гасил Tray-иконку, а уже потом восстанавливал свое приложение).
Таким образом правильно работает следующий код:
procedure TForm1.ApplicationMinimize(Sender : TObject);
begin
 RxTrayIcon1.Show;
 ShowWindow(Application.Handle, SW_HIDE);
end;
procedure TForm1.RxTrayIcon1Click(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 Application.Restore;
 SetForeGroundWindow(Application.MainForm.Handle);
 RxTrayIcon1.Hide;
end;
Author: Song, Den
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00406
Восстановление файла из корзины

=== Восстановление файла из корзины ===
// Функция восстанавливает выбранный в ListView элемент из корзины...
function RestoreElement(const AHandle: THandle; LV: TListView): Boolean;
 function GetLVItemText(const Index: Integer): String;
 begin
 if Index = 0 then
 Result := LV.Selected.Caption
 else
 Result := LV.Selected.SubItems.Strings[Index - 1];
 end;
var
 ppidl, Item: PItemIDList;
 Desktop: IShellFolder;
 RecycleBin: IShellFolder2;
 RecycleBinEnum: IEnumIDList;
 Fetched, I: Cardinal;
 Details: TShellDetails;
 Mallok: IMalloc;
 Valid: Boolean;
 Context: IContextMenu;
 AInvokeCommand: TCMInvokeCommandInfo;
begin
 Result := False;
 if LV = nil then Exit;
 if SHGetMalloc(Mallok) = S_OK then
 if SHGetSpecialFolderLocation(AHandle, CSIDL_BITBUCKET, ppidl) = S_OK then
 if SHGetDesktopFolder(Desktop) = S_OK then
 if Desktop.BindToObject(ppidl, nil, IID_IShellFolder2, RecycleBin) = S_OK then
 if RecycleBin.EnumObjects(AHandle,
 SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, RecycleBinEnum) = S_OK then
 begin
 // Перечисляем содержимое корзины
 while True do
 begin
 RecycleBinEnum.Next(1, Item, Fetched);
 if Fetched = 0 then Break;
 Valid := False;
 for I := 0 to DETAIL_COUNT - 1 do
 if RecycleBin.GetDetailsOf(Item, I, Details) = S_OK then
 try
 // Ищем нужный нам элемент
 Valid := GetLVItemText(I) = StrRetToString(Item, Details.str);
 if not Valid then Break;
 finally
 Mallok.Free(Details.str.pOleStr);
 end;
 // Если выделенный элемент найден
 if Valid then
 begin
 // Восстанавливаем его при помощи интерфейса IContextMenu
 if RecycleBin.GetUIObjectOf(AHandle, 1, Item,
 IID_IContextMenu, nil, Pointer(Context)) = S_OK then
 begin
 FillMemory(@AInvokeCommand, SizeOf(AInvokeCommand), 0);
 with AInvokeCommand do
 begin
 cbSize := SizeOf(AInvokeCommand);
 hwnd := AHandle;
 // - локализация не нужна...
 lpVerb := 'undelete'; // - восстановление фийла из корзины...
 //lpVerb := 'properties'; // - показ диалога свойства...
 //lpVerb := 'delete'; // - удаление файла из корзины...
 fMask := 0;
 lpDirectory := PChar(LV.Selected.SubItems.Strings[0]);
 nShow := SW_SHOWNORMAL;
 end;
 Result := Context.InvokeCommand(AInvokeCommand) = S_OK;
 Break;
 end;
 end;
 end;
 end;
end; 
procedure TForm1.mnuRestoreClick(Sender: TObject);
begin
 if ListView1.Selected <> nil then
 if RestoreElement(Handle, ListView1) then ShowMessage('Элемент успешно восстановлен.');
end;
Author: Rouse_
Source: Взято из http://forum.sources.ru
ID: 01713
Время простаивания системы

=== Время простаивания системы ===
function LastInput: DWord;
var
 LInput: TLastInputInfo;
begin
 LInput.cbSize := SizeOf(TLastInputInfo);
 GetLastInputInfo(LInput);
 Result := GetTickCount - LInput.dwTime;
end;
// Example: 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
 Label1.Caption := Format('System Idle since %d ms', [LastInput]);
end;
// The GetLastInputInfo function retrieves the time 
// of the last input event. 
// Minimum operating systems: Windows 2000 
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01656
Время старта и завершения работы системы

=== Время старта и завершения работы системы ===
Вот так можно узнать дату/время загрузки или завершения работы системы (т.е. когда компьютер был выключен или перезагружен последний раз):
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 Label1: TLabel;
 Label2: TLabel;
 procedure FormCreate(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
uses Registry;
{$R *.dfm}
type
 SYSTEM_TIME_OF_DAY_INFORMATION = record
 BootTime: LARGE_INTEGER;
 CurrentTime: LARGE_INTEGER;
 TimeZoneBias: LARGE_INTEGER;
 CurrentTimeZoneId: ULONG;
 end;
 PSYSTEM_TIME_OF_DAY_INFORMATION = ^SYSTEM_TIME_OF_DAY_INFORMATION;
 NTSTATUS = DWORD;
const
 SystemTimeOfDayInformation = 3;
function NtQuerySystemInformation(SystemInformationClass: byte;
 SystemInformation: Pointer; SystemInformationLength: ULONG;
 ReturnLength: PULONG): NTSTATUS; stdcall; external 'NTDLL.DLL';
function SysDateToStr(ST: TSystemTime): string;
const
 sDateFmt = 'dddd, d MMMM, yyyy';
begin
 SetLength(Result, 255);
 GetDateFormat(LOCALE_USER_DEFAULT, 0, @ST, sDateFmt, @Result[1], 255);
 SetLength(Result, LStrLen(@Result[1]));
end;
function SysTimeToStr(ST: TSystemTime): string;
const
 sTimeFmt = 'HH:mm:ss';
begin
 SetLength(Result, 15);
 GetTimeFormat(LOCALE_USER_DEFAULT, 0, @st, sTimeFmt, @Result[1], 15);
 SetLength(Result, StrLen(@Result[1]));
end;
function GetFileTimeToSystemTime(ft: TFileTime): string;
var
 st, lt: TSystemTime;
 tz: TTimezoneInformation;
begin
 Result := ;
 if not FileTimeToSystemTime(ft, st) then
 exit;
 GetTimeZoneInformation(tz);
 SystemTimeToTzSpecificLocalTime(@tz, st, lt);
 Result := SysDateToStr(lt) + ' at ' + SysTimeToStr(lt);
end;
// дата/время последнего выключения (или перезагрузки) системы
function GetLastSystemShutdown: string;
var
 ft: TFileTime;
 reg: TRegistry;
begin
 Result := ;
 reg := TRegistry.Create;
 try
 reg.RootKey := HKEY_LOCAL_MACHINE;
 if (not reg.OpenKeyReadOnly('System\CurrentControlSet\Control\Windows')) then
 exit;
 if (reg.ReadBinaryData('ShutdownTime', ft, sizeof(ft)) = 0) then
 exit
 finally
 reg.Free
 end;
 Result := GetFileTimeToSystemTime(ft);
end;
// дата/время старта системы
function NtGetBootDateTime: string;
var
 sti: SYSTEM_TIME_OF_DAY_INFORMATION;
 status: NTSTATUS;
 ftSystemBoot: FILETIME;
 ST: TSystemTime;
begin
 Result := ;
 status := NtQuerySystemInformation(SystemTimeOfDayInformation, @sti,
 sizeof(SYSTEM_TIME_OF_DAY_INFORMATION), nil);
 if (status <> NO_ERROR) then
 exit;
 ftSystemBoot := PFILETIME(@(sti.BootTime))^;
 if FileTimeToLocalFileTime(ftSystemBoot, ftSystemBoot) then
 if FileTimeToSystemTime(ftSystemBoot, ST) then
 Result := SysDateToStr(ST) + ' at ' + SysTimeToStr(ST);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 Label1.Caption := 'System start: ' + NtGetBootDateTime;
 Label2.Caption := 'Last system shutdown: ' + GetLastSystemShutdown;
end;
end.
PS: работает только в NT и выше. 
Author: Krid
Source: Взято из http://forum.sources.ru
ID: 01655
Вскрытие запароленной таблицы Paradox

=== Вскрытие запароленной таблицы Paradox ===
Предупрежден - значит, вооружен. Берем Парадоксовскую табличку, паролим ее самым секретным паролем, бумажку с паролем сжигаем, а сам пароль забываем. Что теперь делать? Да ничего, просто открываем нашу табличку с одним из паролей: jIGGAe, nx66ppx, cupcdvum. Один, да подойдет.
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 02948
----
If you forget your paradox table password, try out
on of these passwords, it works well.
for PARADOX 7.0 use this password: "jIGGAe" or "cupcdvum"
for PARADOX 5.0 use this password: same thing
for PARADOX 4.x (DOS) use this password: "nx66ppx"
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 02949
Category:Базы данных
Category:Paradox
Всплывающие подсказки у выключенных кнопок

=== Всплывающие подсказки у выключенных кнопок ===
Проблема заключается в том, что свойство Parent у выключенной (disabled) кнопки равно NIL. Я не уверен что это так, но это становится проблемой в ActivateHint. Если кнопка выключена, то даже при наличии над ней курсора мыши и включенной подсказки, появится.... правильно, подсказка ФОРМЫ.... 
OK, давайте лечить. Метод FindDragTarget вызывается в коде-обработчике подсказки, и позволяет увидеть компонент, находящийся в данный момент под курсорм мыши. FindDragTarget вызывает функцию Windows API WindowFromPoint. И WindowFromPoint *НЕ* возвращает "выключенные" окна. В электронной справке по API говорится, что если вам необходимы также выключенные окна, используйте ChildWindowFromPoint. ОГО! Это идея. Если элемент управления выключен, то будет найдена или сама форма, или же контейнер выключенного компонента. Если компонент, найденый с помощью ChildWindowFromPoint отличается от найденного с помощью WindowFromPoint, мы должны высветить подсказку. Это работает! Но хочу предостеречь: вы не сможете таким образом получить подсказку для самой формы или контейнеров типа TPanel или TGroupBox. Попытайтесь сами!
procedure TForm1.AppShowHint(var HintStr: string;
 var CanShow: Boolean; var HintInfo: THintInfo);
var
 PT: TPoint;
 H: HWnd;
 TWC: TWinControl;
begin
 if not (HintInfo.HintControl is TWinControl) then
 Exit;
 GetCursorPos(PT);
 PT := HintInfo.HintControl.ScreenToClient(PT);
 H := ChildWindowFromPoint(TWinControl(HintInfo.HintControl).Handle, PT);
 TWC := FindControl(H);
 if TWC = nil then
 Exit;
 if TWC = Self then
 CanShow := False
 else if TWC = HintInfo.HintControl then
 exit { эту строку добавил Tim Frost }
 else if TWC.ControlCount > 0 then
 CanShow := False
 else
 with TWC do
 if ShowHint and (Hint <> ) then
 begin
 HintStr := '(выключен) ' + Hint;
 HintInfo.HintPos := ClientOrigin;
 Inc(HintInfo.HintPos.Y, Height + 6);
 end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 Application.OnShowHint := AppShowHint;
end; 
Source: http://delphiworld.narod.ru/
ID: 01292
Вставить Bitmap

function InvertBmp1(SourceBmp: TBitmap): TBitMap;
var
 i, j: Longint;
 tmp: TBitMap;
 red, green, blue: Byte;
 PixelColor: Longint;
begin
 tmp := TBitmap.Create;
 tmp.Width := SourceBmp.Width;
 tmp.Height := SourceBmp.Height;
 for i := 0 to SourceBmp.Width - 1 do
 begin
 for j := 0 to SourceBmp.Height - 1 do
 begin
 PixelColor := ColorToRGB(SourceBmp.Canvas.Pixels[i, j]);
 red := PixelColor;
 green := PixelColor shr 8;
 blue := PixelColor shr 16;
 red := 255 - red;
 green := 255 - green;
 blue := 255 - blue;
 tmp.Canvas.pixels[i, j] := (red shl 8 + green) shl 8 + blue;
 end;
 end;
 Result := tmp;
end;
function InvertBmp2(ABitmap: TBitmap): TBitmap;
var
 l_bmp: TBitmap;
begin
 l_bmp := TBitmap.Create;
 l_bmp.Width := ABitmap.Width;
 l_bmp.Height := ABitmap.Height;
 l_bmp.PixelFormat := ABitmap.PixelFormat;
 BitBlt( l_bmp.Canvas.Handle, 0, 0, l_bmp.Width, l_bmp.Height,
 ABitmap.Canvas.Handle, 0, 0, SRCINVERT );
 Result := l_bmp;
end;
Source: http://www.swissdelphicenter.ch
ID: 03778
Category:Графика
Category:Bitmap
Вставить ProgressBar в StatusBar

=== Вставить ProgressBar в StatusBar ===
procedure TForm1.FormCreate(Sender: TObject);
begin
 with ProgressBar1 do
 begin
 Parent := StatusBar1;
 Position := 100;
 Top := 2;
 Left := 0;
 Height := StatusBar1.Height - Top;
 Width := StatusBar1.Panels[0].Width - Left;
 end;
end;
pgProgress положить на форму как Visible := false; 
StatusPanel надо OwnerDraw сделать и рефрешить, если Position меняется. 
procedure TMainForm.stStatusBarDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect);
begin
 if Panel.index = pnProgress then
 begin
 pgProgress.BoundsRect := Rect;
 pgProgress.PaintTo(stStatusBar.Canvas.Handle, Rect.Left, Rect.Top);
 end;
end; 
Source: http://delphiworld.narod.ru/
ID: 00963
Вставка новой записи через буфер

=== Вставка новой записи через буфер ===
Table2.Insert;
Move(Table1.ActiveBuffer^, Table2.ActiveBuffer^, Table1.RecordSize);
{ При необходимости назначаем новый первичный ключ }
Table2.FieldByName('Primary Key').AsWhatever := whatever;
Table2.Post;
...если вы уверены в том, что нарушение ключа произойти не может, то можно вырезать это для дальнейшего использования:
DbiInsertRecord(Table2.Handle, dbiNOLOCK, Table1.ActiveBuffer);
...конечно, это "обходит" VCL, т.к., чтобы увидеть потом новую запись, необходимо сделать TTable.Refresh.
Source: Взято с http://delphiworld.narod.ru
ID: 02570
Вставка содержимого буфера как картинку в RTF

=== Вставка содержимого буфера как картинку в RTF ===
procedure TForm1.Button1Click(Sender: TObject);
var
 b: TBitmap;
 fr: TFormatRange;
 r: TRect;
begin
 b := TBitmap.create;
 b.Width := RXRichEdit1.Width;
 b.Height := RXRichEdit1.Height;
 r := Rect(0, 0, RXRichEdit1.Width * Screen.PixelsPerInch,
 RXRichEdit1.Height * Screen.PixelsPerInch);
 fr.HDC := b.Canvas.Handle;
 fr.HDCTarget := b.Canvas.Handle;
 fr.rc := r;
 fr.rcpage := r;
 fr.chrg.cpMin := 0;
 fr.chrg.cpMax := -1;
 SendMessage(RXRichEdit1.Handle, EM_FORMATRANGE, 1, LongInt(@fr));
 Image1.Picture.Assign(b);
 b.Free;
end;
Source: http://delphiworld.narod.ru/
ID: 01915
Вставка строки в TStringGrid

=== Вставка строки в TStringGrid ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Вставка строки в StringGrid
Вставляет новую строку в указанную позицию StringGrid
Зависимости: Grids
Copyright: MBo
Дата: 27 апреля 2002 г.
***************************************************** }
procedure SGInsertRow(SG: TStringGrid; NewRow: Integer);
var
 i: Integer;
begin
 if NewRow < 0 then
 NewRow := 0; // либо 1, задайте нужное вам поведение
 with SG do
 begin
 RowCount := RowCount + 1;
 if NewRow < RowCount - 1 then
 begin
 for i := RowCount - 1 downto NewRow + 1 do
 Rows[i].Assign(Rows[i - 1]);
 end;
 Rows[NewRow].Clear;
 end;
end;
Source: http://delphibase.endimus.com
ID: 01046
Вставка текста в TMemo в текущую позицию

=== Вставка текста в TMemo в текущую позицию ===
SendMessage(Memo.Handle, EM_REPLACESEL, 0, PCHAR('Delphi World - это КРУТО!'));
var TempBuf: Array [0..255] of Char;
SendMessage(Memo.Handle, EM_REPLACESEL, 0, StrPCopy(TempBuf, 'Delphi World - это КРУТО!'));
Memo1.SelText := 'Delphi World!';
Source: http://delphiworld.narod.ru/
ID: 00988
Встроенные форматы буфера обмена

=== Встроенные форматы буфера обмена ===
procedure TForm1.BtnShowFormatsClick(Sender: TObject);
var
 buf: array[0..60] of Char;
 n: Integer;
 fmt: Word;
 name: string[30];
begin
 MemFormats.Clear;
 for n := 0 to Clipboard.FormatCount - 1 do
 begin
 fmt := Clipboard.Formats[n];
 if GetclipboardFormatName(fmt, buf, Pred(Sizeof(buf))) <> 0 then
 MemFormats.Lines.Add(StrPas(buf))
 else
 begin
 case fmt of
 1: name := 'CF_TEXT';
 2: name := 'CF_BITMAP';
 3: name := 'CF_METAFILEPICT';
 4: name := 'CF_SYLK';
 5: name := 'CF_DIF';
 6: name := 'CF_TIFF';
 7: name := 'CF_OEMTEXT';
 8: name := 'CF_DIB';
 9: name := 'CF_PALETTE';
 10: name := 'CF_PENDATA';
 11: name := 'CF_RIFF';
 12: name := 'CF_WAVE';
 13: name := 'CF_UNICODETEXT';
 14: name := 'CF_ENHMETAFILE';
 15: name := 'CF_HDROP (Win 95)';
 16: name := 'CF_LOCALE (Win 95)';
 17: name := 'CF_MAX (Win 95)';
 $0080: name := 'CF_OWNERDISPLAY';
 $0081: name := 'CF_DSPTEXT';
 $0082: name := 'CF_DSPBITMAP';
 $0083: name := 'CF_DSPMETAFILEPICT';
 $008E: name := 'CF_DSPENHMETAFILE';
 $0200..$02FF: name := 'частный формат';
 $0300..$03FF: name := 'Объект GDI';
 else
 name := 'неизвестный формат';
 end;
 MemFormats.Lines.Add(name);
 end;
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 01916
Встроенный редактор ComboBox в ячейке StringGrid

=== Встроенный редактор ComboBox в ячейке StringGrid ===
procedure TForm1.FormCreate(Sender: TObject);
begin
 { Высоту combobox'а не изменишь, так что вместо combobox'а
 будем изменять высоту строки grid'а ! }
 StringGrid1.DefaultRowHeight := ComboBox1.Height;
 { Спрятать combobox }
 ComboBox1.Visible := False;
 ComboBox1.Items.Add('Delphi Kingdom');
 ComboBox1.Items.Add('Королевство Дельфи');
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
 { Перебросим выбранное в значение из ComboBox в grid }
 StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row] := ComboBox1.Items[ComboBox1.ItemIndex];
 ComboBox1.Visible := False;
 StringGrid1.SetFocus;
end;
procedure TForm1.ComboBox1Exit(Sender: TObject);
begin
 { Перебросим выбранное в значение из ComboBox в grid }
 StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row] := ComboBox1.Items[ComboBox1.ItemIndex];
 ComboBox1.Visible := False;
 StringGrid1.SetFocus;
end;
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
 ARow: Integer; var CanSelect: Boolean);
var
 R: TRect;
begin
 if ((ACol = 3) and (ARow <> 0)) then
 begin
 { Ширина и положение ComboBox должно соответствовать ячейке StringGrid }
 R := StringGrid1.CellRect(ACol, ARow);
 R.Left := R.Left + StringGrid1.Left;
 R.Right := R.Right + StringGrid1.Left;
 R.Top := R.Top + StringGrid1.Top;
 R.Bottom := R.Bottom + StringGrid1.Top;
 ComboBox1.Left := R.Left + 1;
 ComboBox1.Top := R.Top + 1;
 ComboBox1.Width := (R.Right + 1) - R.Left;
 ComboBox1.Height := (R.Bottom + 1) - R.Top;
 { Покажем combobox }
 ComboBox1.Visible := True;
 ComboBox1.SetFocus;
 end;
 CanSelect := True;
end;
Author: JINX
Source: http://delphiworld.narod.ru/
ID: 01042
Выбор строки или колонки компонента TStringGrid

=== Выбор строки или колонки компонента TStringGrid ===
Вот функция, выбирающая при нажатии на кнопку первую строку сетки. Это работает независимо от размера сетки и количества фиксированных строк/колонок.
procedure TForm1.Button1Click(Sender: TObject);
var
 NewSel: TGridRect;
begin
 with StringGrid1 do
 begin
 NewSel.Left := FixedCols;
 NewSel.Top := FixedRows;
 NewSel.Right := ColCount - 1;
 NewSel.Bottom := FixedRows;
 Selection := NewSel;
 end;
end;
 StringGrid1.Row := { номер строки от нуля };
 StringGrid1.Col := { номер столбца от нуля };
Source: http://delphiworld.narod.ru/
ID: 01052
Вывести Bitmap на рабочем столе

=== Вывести Bitmap на рабочем столе ===
procedure TForm1.Button1Click(Sender: TObject);
var
 Picture: TPicture;
 Desktop: TCanvas;
 X, Y: Integer;
begin
 // Objekte erstellen
 // create objects
 Picture := TPicture.Create;
 Desktop := TCanvas.Create;
 // Bild laden
 // load bitmap
 Picture.LoadFromFile('bitmap1.bmp');
 // Geratekontex vom Desktop ermitteln
 // get DC of desktop
 Desktop.Handle := GetWindowDC(0);
 // Position des Bildes
 // position of bitmap
 X := 100;
 Y := 100;
 // Bild zeichnen
 // draw bitmap
 Desktop.Draw(X, Y, Picture.Graphic);
 // Geratekontex freigeben
 ReleaseDC(0, Desktop.Handle);
 // Objekte freigeben
 // release objects
 Picture.Free;
 Desktop.Free;
end;
Source: http://delphiworld.narod.ru/
ID: 01822