StatusBar с другими контролами

Этот StatusBar позволит размещать на себе любые другие контролы.
Создаем новый компонент от StatusBar и првим код как внизу. Потом инсталлируем и все.

unit StatusBarExt;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls;

type
TStatusBarExt = class(TStatusBar)
public

  constructor Create(AOwner: TComponent); override; // добавить конструктор
end;

procedure Register;

implementation

uses Consts; // не забыть

constructor TStatusBarExt.Create( AOwner : TComponent );
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csAcceptsControls]; // собственно все!
end;

procedure Register;
begin
  RegisterComponents('Samples', [TStatusBarExt]);
end;

end.

Автор man2002ua
Взято с Vingrad.ru

Storing/Playing an .AVI file in a database

How can I store an AVI file in a database and then play AVI
files?

AVI files can be stored in BLOB (binary large object) fields.
The easiest way to play an AVI file stored in a BLOB is to write
the BLOB data to a temporary file, then let the mulimedia player
play the file. The following example demonstrates how to store
an AVI file to a BLOB field, and also play the AVI file from the
BLOB field.

var
  FileName : string;

{This function gets a temporary file name form the system}
function GetTemporaryFileName : string;
{$IFNDEF WIN32}
  const MAX_PATH = 144;
{$ENDIF}
var
{$IFDEF WIN32}
  lpPathBuffer : PChar;
{$ENDIF}
  lpbuffer : PChar;
begin
{Get the file name buffer}
  GetMem(lpBuffer, MAX_PATH);
{$IFDEF WIN32}
{Get the temp path buffer}
  GetMem(lpPathBuffer, MAX_PATH);
{Get the temp path}
  GetTempPath(MAX_PATH, lpPathBuffer);
{Get the temp file name}
  GetTempFileName(lpPathBuffer,
                  'tmp',
                  0,
                  lpBuffer);
{Free the temp path buffer}
  FreeMem(lpPathBuffer, MAX_PATH);
{$ELSE}
{Get the temp file name}
  GetTempFileName(GetTempDrive('C'),
                  'tmp',
                  0,
                  lpBuffer);
{$ENDIF}
{Create a pascal string containg}
{the  temp file name and return it}
  result := StrPas(lpBuffer);
{Free the file name buffer}
  FreeMem(lpBuffer, MAX_PATH);
end;

{Read a AVI file into a blob field}
procedure TForm1.Button1Click(Sender: TObject);
var
  FileStream: TFileStream; {to load the avi file}
  BlobStream: TBlobStream; {to save to the blob}
begin
{Allow the button to repaint}
  Application.ProcessMessages;
{Turn off the buttons}
  Button1.Enabled := false;
  Button2.Enabled := false;
{Assign the avi file name to read}
  FileStream := TFileStream.Create(
    'C:\PROGRA~1\BORLAND\DELPHI~1\DEMOS\COOLSTUF\COOL.AVI',
    fmOpenRead);
  Table1.Edit;
{Create a BlobStream for the TField Table1AVI}
  BlobStream := TBlobStream.Create(Table1AVI, bmReadWrite);
{Seek to the Beginning of the stream}
  BlobStream.Seek(0, soFromBeginning);
{Delete any data that may be there}
  BlobStream.Truncate;
{Copy from the FileStream to the BlobStream}
  BlobStream.CopyFrom(FileStream, FileStream.Size);
{Free the streams}
  FileStream.Free;
  BlobStream.Free;
{Post the record}
  Table1.Post;
{Enable the buttons}
  Button1.Enabled := true;
  Button2.Enabled := true;
end;

{Read an avi stored in a blob, and play it}
procedure TForm1.Button2Click(Sender: TObject);
var
  FileStream: TFileStream; {a temp file}
  BlobStream: TBlobStream; {the AVI Blob}
begin
{Create a blob stream for the AVI blob}
  BlobStream := TBlobStream.Create(Table1AVI, bmRead);
  if BlobStream.Size = 0 then begin
   BlobStream.Free;
   Exit;
  end;
{Close the media player}
  MediaPlayer1.Close;
{Reset the file name}
  MediaPlayer1.FileName := '';
{Refresh the play window}
  MediaPlayer1.Display := Panel1;
  Panel1.Refresh;
{if we have a temp file then erase it}
  if FileName  '' then
    DeleteFile(FileName);
{Get a temp file name}
  FileName := GetTemporaryFileName;
{Create a temp file stream}
  FileStream := TFileStream.Create(FileName,
                                   fmCreate or fmOpenWrite);
{Copy the blob to the temp file}
  FileStream.CopyFrom(BlobStream, BlobStream.Size);
{Free the streams}
  FileStream.Free;
  BlobStream.Free;
{Setup the Media player to play the AVI file}
  MediaPlayer1.FileName := filename;
  MediaPlayer1.DeviceType := dtAviVideo;
  MediaPlayer1.Open;
  MediaPlayer1.Play;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
{Unassign the temp file from the media player}
  MediaPlayer1.Close;
  MediaPlayer1.FileName := '';
{Erase the temp file}
  if FileName  '' then
    DeleteFile(FileName);
end;

Stream Read Error

В моем автономном приложении при чтении/записи из моей базы данных с помощью BDE проблем не возникает. Когда я выгружаю .EXE на наш сетевой том NetWare 3.11, я получаю случайные сообщения об ошибке "Stream Read Error" (ошибка чтения потока). В сети у меня имеется BDE, но пользователи имеют на своих жестких дисках собственные файлы IDAPI.CFG. Может мне кто-нибудь прояснит ситуацию?

В программе конфигурирования Database Engine Configuration, на закладке 'system', попробуйте изменить значение по умолчанию для MAXFILEHANDLES с 48 на 12. Не знаю почему, но это решило мои проблемы, у меня исчезли ошибки 'Stream read error' и различные GPF-ы.

Roger Huffman

Вопреки логики, как мне УМЕНЬШИТЬ количество дескрипторов файлов? Повышать мне их не удалось.

BDE берет дескриптор файла из доступного пула, поэтому, уменьшая его, вы эффективно теряете дескрипторы файла для его нормального открытия и закрытия. Также, уменьшая количество дескрипторов файла BDE, вы ничего этим не сделаете, поскольку BDE начинает их виртуализировать.

Roy Woll

Взято из

String --> PChar

VarS: String;
P: PChar;

....

P:=PChar(S);

Взято из

String --> TColor

В модуле graphics имеется недокументированная функция:

functionStringToColor(S: string): TColor;

Взято из

Советов по Delphi от

Сборник Kuliba

StringGrid

Cодержание раздела:

См. также статьи в других разделах:

См. также другие разделы:

Существующие решения

Автору известны две объектно-ориентированные библиотеки, которые можно рассматривать как альтернативу библиотеке VCL при написании компактных программ. Это библиотеки классов XCL и ACL. Обе библиотеки бесплатны и поставляются в исходных кодах.

Библиотека ACL   (API control library)
Автор:   Александр Боковиков, Екатеринбург, Россия
Страничка:   http://a-press.parad.ru/pc/bokovikov/delphi/acl/acl.zip
E-Mail:   abb@adx.ru
Классы:   TFont, TFonts, TControl, TWinControl, TStdControl, TLabel, TEdit, TListBox, TButton, TCheckBox, TComboBox, TGroupBox, TProgressBar, TKeyboard

Библиотека XCL   (Extreme class library)
Автор:   Vladimir Kladov (Mr.Bonanzas)
Страничка:   http://xcl.cjb.net
E-Mail:   bonanzas@xcl.cjb.net
Классы:   XForm, XApplet, XCanvas, XPen, XBrush, XFont, ZDDB, ZHiBmp, ZDIBitmap, ZBitmap, ZIcon, ZGifDecoder, ZGif, ZJpeg, XLabel, XButton, XBevel, XPanel, XSplitPanel, XStatus, XGrep, XGroup, XCheckBox, XRadioBox, XPaint, XScroller, XScrollBox, XScrollBoxEx, XEdit, XNumEdit, XCombo, XGrid, XListView, XMultiList, XNotebook, XTabs, XTabbedNotebook, XCalendar, XGauge, XGaugePercents, XHysto, XHystoEx, XImageList, XImgButton, XTooltip, XCustomForm, XDsgnForm, XDsgnNonvisual, CLabel, CPaint, CButton, CEdit, CMemo, CCheckBox, CRadioBox, CListBox, CComboBox, ZList, ZMenu, ZPopup, ZMainMenu, ZPopupMenu, ZTimer, ZStrings, ZStringList, ZIniFile, ZThread, ZQueue, ZFileChange, ZDirChange, ZOpenSaveDialog, ZOpenDirDialog, ZTree, ZDirList, ZDirListEx, ZRegistry, ZStream, ZFileStream, ZMemoryStream, XStrUtils.pas, XDateUtils.pas, XFileUtils.pas, XWindowUtils, XPrintUtils, XShellLinks.pas, XJustOne.pas, XJustOneNotify.pas, XPascalUnit.pas, XSysIcons.pas, XCanvasObjectsManager, XRotateFonts, XFocusPainter, XFormsStdMouseEvents, XFormsStdKeyEvents, XFormAutoSizer, XAligner, XControlAutoPlacer, XMfcAntiFlicker, XSplitSizer, XResizeAntiFlicker, XCaretShower, XEditMouseSelect, XEditClipboard, XEditUndo, XListMouseSel, XListKeySel, XListEdit, ZNamedTags, XBtnRepeats, XBufLabels, XBackgrounds, XWndDynHandlers
Как видно из списка приведенных для каждой библиотеки классов, эти библиотеки предендуют скорее не на помощь при написании программ с использованием Win32 API, а пытаются создать более высокий уровень абстракции чем API, по крайней мере в графической части (особенно это относится к XCL). Более того, иерархия и перечень объектов совпадают с соответствующими структурами в библиотеке VCL, что скорее всего связано с желанием авторов обеспечить логическую совместимость с VCL при построении программ на основе этих библиотек.
Данные библиотеки не обеспечивают минимального размера программы, за счет того что предоставляют более высокий уровень абстракции. Они являются компромисом между программированием с использованием VCL и программированием на чистом API.
Можно выделить несколько недостатков присущих даже не столько указанным библиотекам, а сколько решениям и принципам на которых они основаны.
·Несмотря на сравнительно малый размер получаемых программ, размер программ написанных с использованием только Win32 API был бы меньше.
·Помимо изучения Win32 необходимо изучение структуры классов, предлагаемых в этих библиотеках.
·Библиотека XCL не поддерживает механизм message-процедур.
·Архитектура этих библиотек, по мнению автора, является весьма громоздкой. Структуры и классы данных библиотек аналогичны структурам VCL, что приводит к неэффективности программ (ведь мы стараемся написать компактную программу, не так ли ?).
·Использование библиотеки ACL невозможно совместно с библиотекой VCL.
·Запутанность и большой размер классов наряду с "самодокументированным" кодом (то есть отсутствием файлов помощи) затрудняют изучение библиотек.
·Библиотеки разрабатываются и поставляются в частном порядке на некоммерческой основе, поэтому при разработке большого проекта на основе этих библиотек существует потенциальный риск отказа от поддержки. При этом вся тяжесть по устранению ошибок и развитию кода библиотеки ляжет на вас (если вы не вращаетесь в Delphi-сообществе).

Связь с personal Oracle

Связаться с Personal Oracle - мудреное дело, но оно оказывается очень простым, если знать как...

Personal Oracle должен иметь имя сервера (servername) "2:" (два и точка с запятой)
Сетевой протокол (Net Protocol) ДОЛЖЕН БЫТЬ пустым (т.е. пустым - ничего не содержать)
Если вы работаете с Personal Oracle версии 7.1, в файле конфигурации сервера должен быть определен ORA71WIN.DLL, в противном случае выберите ora7win.dll
Oracle в сети.... Если вы можете соединиться через sql*dba или sql*plus, то настройки вашего Oracle, вероятно, правильные. Кроме того, поставщик в файле конфигурации должен указывать версию базы данных.

The server name (имя сервера): SQL*Net V.1.x: Protocol (протокол) : Servername (имя сервера) : Database SID

---> например: T:222.122.22.32:DEMO

Помните: Protocol и SID чуствительны к регистру. Протокол T для TCP/IP. (Я не помню остальных, но я могу узнать, если они вам необходимы....). TCP/IP адрес может быть заменен псевдонимом, если правильно сконфигурирован host-файл....
SQL*Net V.2.x: Здесь все сводится к (Oracle) псевдониму. Используйте его как имя сервера (Server Name). Сетевой протокол (Network Protocol) должен отражать используемый протокол (TCP/IP, Named pipes, IPX/SPX и др.)

- Knud Andersen

Взято из

Советов по Delphi от

Сборник Kuliba

Связать поле BLOB таблицы Paradox с компонентом TRichEdit через потоки

Автор: Сергей Лагонский

Я сам занимался этой задачей и мое предыдущее письмо к Вам явилось результатом экспериментов над TRichEdit. Поэтому я хочу предложить Вам пример проэкта, в котором я связываю поле BLOB таблицы Paradox с компонентом TRichEdit через потоки. Кроме того я использую библиотеку ZLib из стандартного приложения к Delphi 3 CSS. Это позволяет по ходу перекачивания данных в таблицу сжимать текст, а при чтении - распаковывать его чем достигается уменьшение размера .MB-файла, что полезно при большом количестве записей с BLOB-полем.

В заключение хочу сказать несколько слов о библиотеке ZLib.dcu (размер 48496 байт, дата создания 24.03.97г.) которая включена в поставку Delphi 3. При использовании конструктора TDecompressStream почему-то генерировался Default Beep и это очень задерживало выполнение декомпрессии. По счастью в поставку входит и исходный текст ZLib.pas. Я перекомпилировал модуль с помощью тестового примера, также входящего в поставку, при этом указав в настройках проэкта не включать отладочную информацию. В результате размер ZLib.dcu стал равным 45681 байт, а сигнал генерироваться перестал.

Теперь о проэкте. Он имеет одну форму frmMain. Содержимое файлов проэкта привожу ниже. Для работы также необходима таблица Table.db, имеющая структуру:

Имя поля   Тип   Размер
   ID      +
   BLOBData   B   64

и Alias с именем CBDB указывающий на каталог с этой таблицей.
Для упрощения размещения компонентов в форме проделайте следующее:

Создайте новый проект;
Скопируйте выделенную красным цветом часть файла Main.dfm в буфер обмена;
Сделайте активной вновь созданную форму и вставте в нее содержимое буфера;
Измените свойства самой формы в соответствии с нижеприведенным описанием.

// Файл Main.dfm:

object frmMain: TfrmMain

  Left = 476
    Top = 347
    BorderStyle = bsSingle
    Caption = 'Compressed BLOB'
    ClientHeight = 235
    ClientWidth = 246
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    Position = poScreenCenter
    OnShow = FormShow
    PixelsPerInch = 96
    TextHeight = 13
    object SB1: TSpeedButton
    Left = 1
      Top = 209
      Width = 25
      Height = 25
      Hint = 'Добавить'
      Glyph.Data = {
    76010000424D7601000000000000760000002800000020000000100000000100
    04000000000000010000130B0000130B00001000000000000000000000000000
    800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
    FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
    33333333333FFFFFFFFF333333000000000033333377777777773333330FFFFF
    FFF03333337F333333373333330FFFFFFFF03333337F3FF3FFF73333330F00F0
    00F03333F37F773777373330330FFFFFFFF03337FF7F3F3FF3F73339030F0800
    F0F033377F7F737737373339900FFFFFFFF03FF7777F3FF3FFF70999990F00F0
    00007777777F7737777709999990FFF0FF0377777777FF37F3730999999908F0
    F033777777777337F73309999990FFF0033377777777FFF77333099999000000
    3333777777777777333333399033333333333337773333333333333903333333
    3333333773333333333333303333333333333337333333333333}
    NumGlyphs = 2
      ParentShowHint = False
      ShowHint = True
      OnClick = SB1Click
  end
  object SB2: TSpeedButton
    Left = 25
      Top = 209
      Width = 25
      Height = 25
      Hint = 'Удалить'
      Glyph.Data = {
    76010000424D7601000000000000760000002800000020000000100000000100
    0400000000000001000000000000000000001000000000000000000000000000
    8000008000000080800080000000800080008080000080808000C0C0C0000000
    FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
    33333333333FFFFFFFFF333333000000000033333377777777773333330FFFFF
    FFF03333337F333333373333330FFFFFFFF03333337F3FF3FFF73333330F00F0
    00F033333F7F773777373333300FFFFFFFF03333F73FFF3FF3F733330C0F0800
    F0F0333F773F337737373330CC0FFFFFFFF033F777FFFFF3FFF7330CCCCC00F0
    00003F777777F737777730CCCCCC0FF0FF03F7777777FF37F3730CCCCCCC08F0
    F03377777777F337F73330CCCCCC0FF0033337777777FFF77333330CCCCC0000
    333333777777777733333330CC3333333333333777333333333333330C333333
    3333333377333333333333333033333333333333373333333333}
    NumGlyphs = 2
      ParentShowHint = False
      ShowHint = True
      OnClick = SB2Click
  end
  object SB3: TSpeedButton
    Left = 49
      Top = 209
      Width = 25
      Height = 25
      Hint = 'Редактировать'
      Glyph.Data = {
    76010000424D7601000000000000760000002800000020000000100000000100
    04000000000000010000120B0000120B00001000000000000000000000000000
    800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
    FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333000000
    000033333377777777773333330FFFFFFFF03FF3FF7FF33F3FF700300000FF0F
    00F077F777773F737737E00BFBFB0FFFFFF07773333F7F3333F7E0BFBF000FFF
    F0F077F3337773F3F737E0FBFBFBF0F00FF077F3333FF7F77F37E0BFBF00000B
    0FF077F3337777737337E0FBFBFBFBF0FFF077F33FFFFFF73337E0BF0000000F
    FFF077FF777777733FF7000BFB00B0FF00F07773FF77373377373330000B0FFF
    FFF03337777373333FF7333330B0FFFF00003333373733FF777733330B0FF00F
    0FF03333737F37737F373330B00FFFFF0F033337F77F33337F733309030FFFFF
    00333377737FFFFF773333303300000003333337337777777333}
    NumGlyphs = 2
      ParentShowHint = False
      ShowHint = True
      OnClick = SB3Click
  end
  object SB4: TSpeedButton
    Left = 73
      Top = 209
      Width = 25
      Height = 25
      Hint = 'Отменить редактирование'
      Glyph.Data = {
    DE010000424DDE01000000000000760000002800000024000000120000000100
    0400000000006801000000000000000000001000000000000000000000000000
    80000080000000808000800000008000800080800000C0C0C000808080000000
    FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
    333333333333333333333333000033338833333333333333333F333333333333
    0000333911833333983333333388F333333F3333000033391118333911833333
    38F38F333F88F33300003339111183911118333338F338F3F8338F3300003333
    911118111118333338F3338F833338F3000033333911111111833333338F3338
    3333F8330000333333911111183333333338F333333F83330000333333311111
    8333333333338F3333383333000033333339111183333333333338F333833333
    00003333339111118333333333333833338F3333000033333911181118333333
    33338333338F333300003333911183911183333333383338F338F33300003333
    9118333911183333338F33838F338F33000033333913333391113333338FF833
    38F338F300003333333333333919333333388333338FFF830000333333333333
    3333333333333333333888330000333333333333333333333333333333333333
    0000}
    NumGlyphs = 2
      ParentShowHint = False
      ShowHint = True
      OnClick = SB4Click
  end
  object P1: TPanel
    Left = 0
      Top = 0
      Width = 246
      Height = 206
      BevelInner = bvRaised
      BevelOuter = bvLowered
      BevelWidth = 2
      TabOrder = 0
      object RE: TRichEdit
      Left = 5
        Top = 5
        Width = 236
        Height = 196
        ScrollBars = ssVertical
        TabOrder = 0
    end
  end
  object DBN: TDBNavigator
    Left = 149
      Top = 209
      Width = 96
      Height = 25
      DataSource = DS
      VisibleButtons = [nbFirst, nbPrior, nbNext, nbLast]
      TabOrder = 1
  end
  object T1: TTable
    Active = True
      DatabaseName = 'CBDB'
      TableName = 'table.db'
      Left = 5
      Top = 5
      object T1ID: TAutoIncField
      FieldName = 'ID'
        Visible = False
    end
    object T1BLOBData: TBlobField
      FieldName = 'BLOBData'
        Visible = False
        BlobType = ftBlob
        Size = 64
    end
  end
  object OD: TOpenDialog
    DefaultExt = 'rtf'
      Filter = 'RTF-файлы|*.rtf|Все файлы|*.*'
      Title = 'Выберите файл'
      Left = 5
      Top = 35
  end
  object DS: TDataSource
    DataSet = T1
      OnDataChange = DSDataChange
      Left = 35
      Top = 5
  end
end

// Файл Main.pas:

unit Main;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, StdCtrls, ComCtrls, ExtCtrls, DBCtrls, Buttons, swDBPanl,
  swRecPos;
type

  TfrmMain = class(TForm)
    T1: TTable;
    T1ID: TAutoIncField;
    T1BLOBData: TBlobField;
    OD: TOpenDialog;
    P1: TPanel;
    SB1: TSpeedButton;
    SB2: TSpeedButton;
    SB3: TSpeedButton;
    SB4: TSpeedButton;
    DS: TDataSource;
    DBN: TDBNavigator;
    procedure SB1Click(Sender: TObject);
    procedure SB2Click(Sender: TObject);
    procedure SB3Click(Sender: TObject);
    procedure SB4Click(Sender: TObject);
    procedure DSDataChange(Sender: TObject; Field: TField);
    procedure FormShow(Sender: TObject);
  private
    EF: boolean;
    procedure SetButtons;
    procedure UpdateEditor;
    procedure StoreFromFile;
    procedure StoreFromEditor;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation
uses ZLib;

{$R *.DFM}

const
  LID: longint = 0;

procedure TfrmMain.SetButtons;
var
  c1: boolean;
begin
  c1 := T1.RecordCount > 0;

  SB2.Enabled := not EF and c1;
  SB3.Enabled := not EF and c1;
  SB4.Enabled := EF;
end;

procedure TfrmMain.UpdateEditor;
var
  Buf: TStream;

  ZStream: TCustomZLibStream;
  id: longint;
begin

  id := T1ID.AsInteger;
  if (id = LID) and not EF then
    exit
  else
    LID := id;
  Buf := TMemoryStream.Create;
  T1BLOBData.SaveToStream(Buf);
  if Buf.Size > 0 then
  begin
    ZStream := TDecompressionStream.Create(Buf);
    RE.Lines.LoadFromStream(ZStream);
    ZStream.Free;
  end
  else
    RE.Lines.Clear;
  Buf.Free;
end;

procedure TfrmMain.StoreFromFile;
var
  InFile, Buf: TStream;

  ZStream: TCustomZLibStream;
begin

  if not OD.Execute then
    exit;
  T1.AppendRecord([NULL]);
  InFile := TFileStream.Create(OD.FileName, fmOpenRead);
  Buf := TMemoryStream.Create;
  ZStream := TCompressionStream.Create(clMax, Buf);
  ZStream.CopyFrom(InFile, 0);
  ZStream.Free;
  T1.Edit;
  T1BLOBData.LoadFromStream(Buf);
  T1.Post;
  Buf.Free;
  InFile.Free;
  LID := 0;
  UpdateEditor;
end;

procedure TfrmMain.StoreFromEditor;
var
  InStream, Buf: TStream;

  ZStream: TCustomZLibStream;
begin

  InStream := TMemoryStream.Create;
  Buf := TMemoryStream.Create;
  RE.Lines.SaveToStream(InStream);
  ZStream := TCompressionStream.Create(clMax, Buf);
  ZStream.CopyFrom(InStream, 0);
  ZStream.Free;
  T1.Edit;
  T1BLOBData.LoadFromStream(Buf);
  T1.Post;
  UpdateEditor;
end;

procedure TfrmMain.SB1Click(Sender: TObject);
begin

  if EF then
  begin
    StoreFromEditor;
    RE.ReadOnly := true;
    DBN.Enabled := true;
    EF := false;
    SB1.Hint := 'Добавить';
  end
  else
    StoreFromFile;
  SetButtons;
end;

procedure TfrmMain.SB2Click(Sender: TObject);
begin

  if MessageDlg('Удалять запись?', mtConfirmation, [mbYes, mbNo], 0) = mrYes
    then
  begin
    T1.Delete;
    SetButtons;
  end;
end;

procedure TfrmMain.SB3Click(Sender: TObject);
begin

  DBN.Enabled := false;
  EF := true;
  SB1.Hint := 'Внести изменения';
  RE.ReadOnly := false;
  SetButtons;
end;

procedure TfrmMain.SB4Click(Sender: TObject);
begin

  UpdateEditor;
  DBN.Enabled := true;
  EF := false;
  SB1.Hint := 'Добавить';
  RE.ReadOnly := true;
end;

procedure TfrmMain.DSDataChange(Sender: TObject; Field: TField);
begin
  if assigned(frmMain) and Visible and not EF then

  begin
    UpdateEditor;
    SetButtons;
  end;
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin

  EF := false;
  SetButtons;
  DSDataChange(nil, nil);
end;

end.

// Файл CompBLOB.dpr:

program CompBLOB;
uses

  Forms,
  Main in 'Main.pas' {frmMain};

{$R *.RES}

begin

  Application.Initialize;
  Application.CreateForm(TfrmMain, frmMain);
  Application.Run;
end.

Взято из

Связка ActiveX - Internet Explorer

А знаете ли вы, что на Delphi можно писать ActiveX компоненты? Конечно знаете. А что с их помощью можно взаимодействовать с Internet Explorer? Это может быть интересно для профессиональных вебмастеров, скажете вы, но я не согласен. "Простой" программист тоже может найти массу применений этому. Здесь будет описано одно из них. Все мы лазим (ходим и т.д.) по интернету. И вы тоже - раз читаете эти строки :). А не случалось ли вам, случайно где-то побывав, что-то прочитав и благополучно забыв адрес сайта через некоторое время вдруг понять, что там было именно то, что вам сейчас срочно понадобилось? Можно конечно посмотреть History браузера, можно залезть в кэш "руками" и попытаться найти там что-то. А можно написать компонент, который бы искал слова в файлах кэша (в общем случае в любых HTML-файлах) и выводил бы на просмотр требуемые файлы. Связать этот компонент с Эксплорером - и вперед. Что удобно - вся работа происходит в эксплорере: и поиск, и,естественно, просмотр. При этом для Delphi-программиста не нужны особые знания языка HTML, скриптовых языков и т.п. Достаточно знать несколько основных конструкций (а уж справочных руководств в интернете навалом - хотя бы на www.citforum.ru). Написанный ActiveX-компонент вставляется в HTML-страничку. Вот пример простейшей странички

<HTML>
<HEAD>
<TITLE>Поиск</TITLE>
</HEAD>
<BODY>
<P ALIGN=CENTER>
<OBJECT ID="findword1" - {при помощи этого тэга компонент вставляется в страничку}
CLASSID="CLSID:47E50425-E611-11D3-970A-4854E82B17E6"
CODEBASE="C:\PATH\FINDWORDS.OCX">
</OBJECT>
</P>
</BODY>
</HTML>

В этом примере ActiveX-компонент, находящийся в файле C:\PATH\FINDWORDS.OCX вставляется в HTML-страничку. Но важно отметить, что эта страничка откроется только в Microsoft Internet Explorer версии 4 и старше. Пишут, что третий эксплорер тоже поддерживает тэг <OBJECT>, но сам не пробовал, не знаю. Браузеры Netscape, Opera и какие еще там бывают, его не поддерживают.
Итак, тэг <OBJECT> вставляет в страничку ActiveX-компонент. Его атрибут CLASSID указывает идентификатор класса нашего компонента. При создании в Delphi компонента с нуля ему автоматически присваивается этот идентификатор класса. ID="findword1" - имя объекта. Здесь можно писать любое имя. По нему мы в дальнейшем будем ссылаться на наш компонент в теле странички из скриптов-процедур обработки событий. Далее, для того, чтобы наш компонент мог использоваться прикладными программами, он должен быть зарегистрирован в реестре. Зарегистрировать его можно программой regsvr32, которая по умолчанию находится в каталоге [System]. Например так: [regsvr32 C:\PATH\FINDWORDS.OCX]. Если при открытии странички Explorer не находит в реестре указанный компонент, то он ищет его в местоположении, указанном атрибутом CODEBASE. Здесь может быть полный путь к файлу, если он находится на вашем жестком диске или даже URL-адрес (со всеми сопутствующими атрибутами, как то http:// и т.д.).Т.е, если эксплорер встретил ссылку на компонент, а этого компонента нет на вашей машине, он может загрузить его из интернета с указанного адреса. Кстати, атрибут CLASSID - обязательный, именно по нему производится "идентификация" класса. А атрибут CODEBASE - необязательный. В случае, когда он опущен, если компонент уже зарегистрирован в системе, то он отобразится в вашей страничке, если не зарегистрирован - страничка будет пустой. И наконец если эксплорер сам регистрирует компонент, он переписывает файл OCX в папку [Windows\Downloaded program files].
Для того, чтобы вручную не писать скрипты подсоединения ActiveX компонентов, я советую скачать программу Microsoft ActiveX Control Pad отсюда. Эта программа предназначена для внедрения ActiveX-компонентов в HTML-странички. После ее работы определение компонента выглядит примерно так:

<OBJECT ID="findword1"
CLASSID="CLSID:47E50425-E611-11D3-970A-4854E82B17E6"
CODEBASE="C:\PATH\FINDWORDS.OCX">
<PARAM NAME="Visible" VALUE="-1">
<PARAM NAME="AutoScroll" VALUE="0">
<PARAM NAME="AutoSize" VALUE="0">
<PARAM NAME="AxBorderStyle" VALUE="1">
<PARAM NAME="Caption" VALUE="findword">
<PARAM NAME="Color" VALUE="2147483663">
<PARAM NAME="Font" VALUE="MS Sans Serif">
<PARAM NAME="KeyPreview" VALUE="0">
<PARAM NAME="PixelsPerInch" VALUE="96">
<PARAM NAME="PrintScale" VALUE="1">
<PARAM NAME="Scaled" VALUE="-1">
<PARAM NAME="DropTarget" VALUE="0">
<PARAM NAME="HelpFile" VALUE="">
<PARAM NAME="DoubleBuffered" VALUE="0">
<PARAM NAME="Enabled" VALUE="-1">
<PARAM NAME="BiDiMode" VALUE="0">
<PARAM NAME="Cursor" VALUE="0">
<PARAM NAME="filename" VALUE="nothing">
</OBJECT>

Т.е. эта программа сама подставляет полное определение компонента (его CLASSID, например). Правда, полученный код иногда приходится подправлять вручную. Например может потребоваться убрать явное указание высоты и ширины объекта.
Теперь подходим к самому главному: как сделать сам компонент (чтобы было что вставлять в нашу страничку :). Итак, в Delphi делаем New\ActiveX\Active form. В окошке Active Form Wizard выбираем Threading model=Apartment. Другие threading models не работают с IE 4. Выглядит это так: компонент в страничке открывается, но иногда вдруг выскакивает Access violation. (обычно на событие Create). Модель же Both работает с IE 5. Флажок "Include Design-Time licence" лучше не устанавливать. Дальше открывается новая форма, где вы можете размещать свои кнопки-текстбоксы, определять реакцию на события и т.д.
Далее будут описаны некоторые хитрости. Например, нужно хранить некоторые данные во внешнем файле. Я столкнулся со следующим: мой компонент на разных машинах размещал свои файлы в разных местах: на одной в каталоге Windows, на другой - на рабочем столе. Был найден такой выход: пусть страничка по требованию компонента возвращает ему каталог, в котором она находится. Для этого на форму я поместил PageControl, сделал закладки невидимыми и на OnShow (у формы ActiveX компонента нет события OnShow) одной из страниц поставил генерацию собственного события OnWantDir. А в теле HTML-странички соответственно реакцию на него:

<SCRIPT LANGUAGE="VBScript">

</SCRIPT>

Далее, это событие OnShow происходит сразу после создания экземпляра компонента. Так вот, если событие OnWantDir генерировать непосредственно в нем (в OnShow), то видимо что-то в недрах Windows не успевает провернуться и машина виснет. Поэтому пришлось повесить на форму таймер, на OnShow таймер запускать, и уже на OnTimer как раз и вызывать свое событие OnWantDir. Интервал у таймера я поставил в полсекунды. Конечно можно было бы хранить свои файлы например в каталоге [Windows], но почему-то функция GetWindowsDirectory при вызове из ActiveX-компонента возвращала ошибку, хотя тут же нормально отрабатывала из обыкновенного приложения (exe). То же и с GetSystemDirectory и GetTempDirectory. Кто не знает как делать собственные свойства и события - кликайте сюда.
Как сделать компонент тиражируемым? Чтобы пользователь смог работать с ним сразу же, не запуская никаких дополнительных программ, не указывая всяких-разных путей и т.д. Вот пример HTML-странички (а здесь его скриншот):

<html>
<HEAD>
<title>Поиск</title>
<SCRIPT LANGUAGE="VBScript">

</SCRIPT>
</HEAD>
<SCRIPT LANGUAGE="VBScript">

</SCRIPT>
<p align = "center">
<OBJECT ID="findword1"
CLASSID="CLSID:47E50425-E611-11D3-970A-4854E82B17E6"
CODEBASE="findwords.ocx">
{Здесь просто имя файла без пути. Explorer зарегистрирует компонент невидимо для пользователя, взяв его из текущеего каталога (страничка и файл OCX находятся в одном каталоге)}
<PARAM NAME="Visible" VALUE="-1">
<PARAM NAME="AutoScroll" VALUE="0">
<PARAM NAME="AutoSize" VALUE="0">
<PARAM NAME="AxBorderStyle" VALUE="1">
<PARAM NAME="Caption" VALUE="findword">
<PARAM NAME="Color" VALUE="2147483663">
<PARAM NAME="Font" VALUE="MS Sans Serif">
<PARAM NAME="KeyPreview" VALUE="0">
<PARAM NAME="PixelsPerInch" VALUE="96">
<PARAM NAME="PrintScale" VALUE="1">
<PARAM NAME="Scaled" VALUE="-1">
<PARAM NAME="DropTarget" VALUE="0">
<PARAM NAME="DoubleBuffered" VALUE="0">
<PARAM NAME="Enabled" VALUE="-1">
<PARAM NAME="BiDiMode" VALUE="0">
<PARAM NAME="Cursor" VALUE="0">
<PARAM NAME="filename" VALUE="nothing">
<PARAM NAME="page_location" VALUE="">
</OBJECT>
</p>
</BODY>
</html>
И еще раз: 1) открываем нашу страничку (в IE 4 и выше); 2) если компонент зарегистрирован, он сразу показывается, если не зарегистрирован, то регистрируется и показывается. При этом: 3) после создания выдерживается пауза в полсекунды и запрашивается текущий каталог (и страничка и сам OCX-файл находятся в одном каталоге, который и будет текущим). 4) если нужно открыть на просмотр какую либо страничку (выбранную пользователем в процессе работы из списка - см. скриншот), то свойству компонента (при внедрении его в страничку правильнее будет называть его уже объектом) присваивается значение (имя файла), генерируется событие. Процедура-скрипт обработчик этого события читает свойство и отрывает требуемый файл

Взято с Исходников.ru

Примечание Vit: Данный FAQ не поддерживает вложения, поэтому все линки данного топика не рабочие. Используйте оригинал с Web сайта для полной функциональности:

Свои апплеты в панели управления.

Компилятор: Delphi 3.x
Источник: www.borland.com.

Примечание Vit: Более поздние версии Дельфи имеют встроенные средства для создания апплетов - см. New Project->Other->Control Panel...

Апплеты в панели управления, это обычные DLL, имеющие расширение .cpl (Control Panel Library) и располагающиеся в системной директории Windows. В свою очередь, в каждом файле cpl может храниться несколько апплетов. Cpl имеет единственную функцию точки входа CPlApplet(), через которую поступают все сообщения от панели управления.
Давайте рассмотрим сообщения, с которыми панель управления вызывает функцию CPlApplet():
CPL_INIT - сообщение, которым CPlApplet() вызывается первый раз (инициализация). Возвращаем TRUE для продолжения процесса загрузки.
CPL_GETCOUNT - этим сообщением панель управления запрашивает количество поддерживаемых апплетов в файле cpl.
CPL_INQUIRE - панель управления запрашивает информацию о каждом апплете, хранящемся в файле cpl. При этом, параметр lParam1 будет содержать номер апплета, о котором панель управления хочет получить информацию, lParam2 будет указывать на структуру TCplInfo. Поле idIcon в структуре TClpInfo должно содержать идентификатор (id) ресурса иконки, которая будет отображаться в панели управления, а поля idName и idInfo должны содержать идентификаторы строковых ресурсов для имени и описания. lData может содержать данные, которые будут использоваться апплетом.
CPL_SELECT - это сообщение посылается апплету, если его иконка была выбрана пользователем. При этом lParam1 содержит номер выбранного апплета, а lParam2 содержит значение lData, определённое для данного апплета.
CPL_DBLCLK - это сообщение будет послано, если по иконке апплета сделать двойной щелчёк. lParam1 будет содержать номер апплета, а lParam2 будет содержать значение lData, определённое для данного апплета. При поступление это сообщения апплет должен как-то показать себя, в частности отобразить своё диалоговое окно.
CPL_STOP - Посылается каждому апплету, когда панель управления закрывается. lParam1 содержит номер апплета, а lParam2 содержит значение lData, определённое для данного апплета.
CPL_EXIT - Посылается перед тем, как панель управления вызовет FreeLibrary.
CPL_NEWINQUIRE - тоже, что и CPL_INQUIRE за исключением того, что lParam2 указывает на структуру NEWCPLINFO.
Итак, приступим. Для начала необходимо создать файл ресурсов, содержащий таблицу строк для имени и описания Вашего апплета(ов), а также иконки для каждого апплета (если у Вас их будет несколько).
Пример .rc файла содержит таблицу строк, состоящую из двух строк, и указатель на файл с иконкой:
STRINGTABLE
{
1, "TestApplet"
2, "My Test Applet"
}

2 ICON C:\SOMEPATH\CHIP.ICO
Чтобы преобразовать файл .rc в .res, (который можно будет спокойно прилинковать к Вашему приложению) достаточно просто указать в командной строке полный путь до компилятора ресурсов и полный путь до файла .rc:
c:\Delphi\Bin\brcc32.exe c:\Delphi\MyRes.rc
После того, как компиляция будет завершена, то Вы получите новый файл, с таким же именем, что и .rc, только с расширением ".res".
Следующий пример, это апплет панели управления, который в ответ на сообщение CPL_DBLCLK запускает блокнот. Код можно легко изменить, чтобы отображалась форма или диалоговое окошко. Этот код можно компилировать как под платформу Win32, так и под Win16.
Чтобы скомпилировать проект, необходимо из вышеприведённого файла .rc создать два: TCPL32.RES и TCPL16.RES.

library TestCpl;

{$IFDEF WIN32}
uses
  SysUtils,
  Windows,
  Messages;
{$ELSE}
uses
  SysUtils,
  WinTypes,
  WinProcs,
  Messages;
{$ENDIF}

{$IFDEF WIN32}
{$R TCPL32.RES}
{$ELSE}
{$R TCPL16.RES}
{$ENDIF}

const NUM_APPLETS = 1;

{$IFDEF WIN32}
const CPL_DYNAMIC_RES = 0;
{$ENDIF}
const CPL_INIT = 1;
const CPL_GETCOUNT = 2;
const CPL_INQUIRE = 3;
const CPL_SELECT = 4;
const CPL_DBLCLK = 5;
const CPL_STOP = 6;
const CPL_EXIT = 7;
const CPL_NEWINQUIRE = 8;
{$IFDEF WIN32}
const CPL_STARTWPARMS = 9;
{$ENDIF}
const CPL_SETUP = 200;

{$IFNDEF WIN32}
type DWORD = LongInt;
{$ENDIF}

type TCplInfo = record
       idIcon : integer;
       idName : integer;
       idInfo : integer;
       lData : LongInt;
     end;
     PCplInfo = ^TCplInfo;

type TNewCplInfoA = record
       dwSize : DWORD;
       dwFlags : DWORD;
       dwHelpContext : DWORD;
       lData : LongInt;
       IconH : HIcon;
       szName : array [0..31] of char;
       szInfo : array [0..63] of char;
       szHelpFile : array [0..127] of char;
     end;
     PNewCplInfoA = ^TNewCplInfoA;

{$IFDEF WIN32}
type TNewCplInfoW = record
       dwSize : DWORD;
       dwFlags : DWORD;
       dwHelpContext : DWORD;
       lData : LongInt;
       IconH : HIcon;
       szName : array [0..31] of WChar;
       szInfo : array [0..63] of WChar;
       szHelpFile : array [0..127] of WChar;
     end;
     PNewCplInfoW = ^TNewCplInfoW;
{$ENDIF}

type TNewCplInfo = TNewCplInfoA;
type PNewCplInfo = ^TNewCplInfoA;

function CPlApplet(hWndCPL : hWnd;
                   iMEssage : integer;
                   lParam1 : longint;
                   lParam2 : longint) : LongInt
{$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF}
begin
  case iMessage of
    CPL_INIT : begin
      Result := 1;
      exit;
    end;
    CPL_GetCount : begin
      Result := NUM_APPLETS;
      exit;
    end;
    CPL_Inquire : begin
      PCplInfo(lParam2)^.idIcon := 2;
      PCplInfo(lParam2)^.idName := 1;
      PCplInfo(lParam2)^.idInfo := 2;
      PCplInfo(lParam2)^.lData := 0;
      Result := 1;
      exit;
    end;
    CPL_NewInquire : begin
      PNewCplInfo(lParam2)^.dwSize := sizeof(TNewCplInfo);
      PNewCplInfo(lParam2)^.dwHelpContext := 0;
      PNewCplInfo(lParam2)^.lData := 0;
      PNewCplInfo(lParam2)^.IconH := LoadIcon(hInstance,
                                              MakeIntResource(2));
      lStrCpy(@PNewCplInfo(lParam2)^.szName, 'TestCPL');
      lStrCpy(PNewCplInfo(lParam2)^.szInfo, 'My Test CPL');
      PNewCplInfo(lParam2)^.szHelpFile[0] := #0;
      Result := 1;
      exit;
    end;
    CPL_SELECT : begin
      Result := 0;
      exit;
    end;
    CPL_DBLCLK : begin
        WinExec('Notepad.exe', SW_SHOWNORMAL);
      Result := 1;
      exit;
    end;
    CPL_STOP : begin
      Result := 0;
      exit;
    end;
    CPL_EXIT : begin
      Result := 0;
      exit;
    end else begin
      Result := 0;
      exit;
    end;
  end;
end;

exports CPlApplet name 'CPlApplet';

begin
end.

Взято с Исходников.ru

Свойства шрифта Style и Color в виде строки

Автор: Dennis Passmore

Как мне получить значение Font.Style и Font.Color в виде строки, я хотел бы присвоить его заголовку компонента Label, но style и color не являются строковыми величинами.

Есть масса способов это сделать, но я использую следующий способ:

const
fsTextName: array[TFontStyle] of string[11] = ('fsBold', 'fsItalic', 'fsUnderline', 'fsStrikeOut');
  fpTextName: array[TFontPitch] of string[10] = ('fpDefault','fpVariable','fpFixed');

Позже, в коде, я так использую эти имена:

var
  TFPitch: TFontPitch;
  TFStyle: TFontStyle;
  FString: String;
...

FString := '';
for TFStyle := fsBold to fsStrikeOut do
  if TFStyle in Canvas.Font.Style then
    Fstring := Fstring+fsTextName[TFStyle]+',';
if FString<>'' then
  dec(FString[0]); { убираем лишний разделитель ',' }
something := FString;

FString := fpTextName[Canvas.Font.Pitch];
something := FString;

Примерно также нужно поступить и с именованными цветами типа TColor.

Взято из

Примечание Vit: Описанный здесь способ относится скорее к тем которые указывают как не надо делать. Эта задача решается намного изящнее здесь:

System tray

Cодержание раздела:

См. также статьи в других разделах:

Таблицы строк

Таблицы строк

Ресурсы в виде таблиц строк (Stringtable) являются очень полезным подспорьем, когда ваше приложение должно хранить большое количество строк для их вывода во время выполнения приложения. Вы должны побороть искушение непосредственной вставки строк в вашу программу, поскольку использование таблиц строк имеет два неоспоримых преимущества:
1) Строки, хранимые в ресурсах, не занимают память до тех пор, пока они не будут загружены вашим приложением.
2) Stringtables легко редактировать, создавая таким образом локализованные (переведенные) версии вашего приложения.

Таблицы строк компилируются в ".res"-файл, который включается в exe-файл приложения во время сборки. Даже после того, как вы распространите ваше приложение, таблицы строк, содержащиеся в вашем приложении могут редактироваться редактором ресурсов. Моим любимым редактором ресурсов является Borland Resource Workshop, поставляемый в комплекте с Delphi. Он позволяет в режиме WYSIWYG редактировать как 16-, так и 32-битные ресурсы, как автономные, так и имплантированные в exe или dll-файлы. Тем более это удобно, если учесть что вместе со всеми версиями Delphi поставляется компилятор
ресурсов из командной строки (Borland Resource Command Line Compiler) (BRCC.EXE и BRCC32.EXE), расположенный в Delphi-директории Bin.

В нашем примере мы создадим интернациональное приложение, отображающее всего две кнопки. Кнопки будут иметь заголовки "Да" и "Нет", имеющие представления для английского, испанского и шведского языков.

Если вы вознамерились создавать мультиязыковые приложения с помощью Delphi, вам просто необходимо взглянуть на другие продукты фирмы Borland - Delphi Translation Suite и Language Pack software. Данные продукты позволяют изменять язык приложения одним щелчком!

Пример: Для начала в каталоге с исходным кодом приложения мы должны создать текстовый файл, содержащий строковые ресурсы. Пока вы можете создать файл с любым именем (главное, чтобы он имел расширение ".rc") и файл без разширения - главное, чтобы их имя не совпадало с именами файлов модулей и
файла проекта. Это очень важно, поскольку Delphi автоматически создает множество файлов с ресурсами для вашего приложения с теми же именами и переписывает их, не заботясь о наличии таких же файлов, но созданных вашими руками.

Вот содержание .rc-файла для нашего примера. Файл содержит слова "Yes" и "No" на английском, испанском и шведских языках:

STRINGTABLE
{
1, "&Yes"
2, "&No"
17, "&Si"
18, "&No"
33, "&Ja"
34, "&Nej"
}

Файл начинается с ключевого слова stringtable, обозначая, что следом располагается таблица строк. Сами строки находятся внутри скобок, таким образом таблица должна быть обрамлена двумя скобками -
открывающей и закрывающей. Каждая строка должна содержать идентификатор, сопровождаемый строкой,
заключенной в кавычки. Строка может содержать вплоть до 255 символов. Если вам нужно вставить
нестандартный символ, напишите его восьмиричный код и предварите его обратной косой чертой.
Единственное исключение - когда вам нужно вставить саму обратную черту - в этом случае понадобиться
использование двух таких символов. Вот два примера:

1, "A two\012line string"

2, "c:\\Borland\\Delphi"

Используемый номер индекса абсолютно не важен для компилятора. Вы должны иметь в виду, что таблицы
строк располагаются в памяти в 16 битных сегментах (Win 3.xx).
Для компиляции .rc-файла в .res-файл, который можно прилинковать к вашему приложению, вы должны
набрать в командной строке полный путь к компилятору ресурсов и полный путь к компилируемому
.rc-файлу. Вот пример:

c:\Delphi\Bin\brcc32.exe c:\Delphi\strtbl32.rc
После окончания процесса компиляции в указанном каталоге появляется файл с тем же именем, что и у
.rc-файла, но имеющий расширение ".res".
Для включения ресурсов в ваше приложение необходимо в коде программы добавить следующую директиву
компилятора, указывающую на файл с ресурсами:

{$R ResFileName.RES}

После того, как .res-файл прилинкуется к приложению, вы можете воспользоваться связанными
ресурсами из любого модуля вашего проекта, даже если вы определили директиву $R в секции реализации
(implementation) другого модуля.

Вот пример использования Windows API функции LoadString() для загрузки в массив символов третьей
строки из таблицы строк:

if LoadString(hInstance, 3, @a, sizeof(a)) <> 0 then ....

В этом примере функция LoadString() передает дескриптор (hInstance) модуля, содержащего ресурс,
индекс требуемой строки, адрес массива символов, куда будет передана строка и размер самого массива.
Функция LoadString возвращает количество реально переданных символов без учета терминатора. Будьте
внимательны: при использовании UNICODE количество загружаемых байт будет другим.

Ниже приведен исчерпывающий пример создания многоязыкового приложения с помощью Delphi. Приложение
совместимо как с 16, так и с 32-битными версиями Delphi.

Для этого вам придется создать два идентичных .rc-файла, один для 16-битной версии, второй для
32-битной, т.к. используемые ресурсы для каждой платформы свои. В данном примере мы создадим один
файл с именем STRTBL16.rc, а другой с именем STRTBL32.rc. Скомпилируйте файл STRTBL16.rc с помощью
16-битного компилятора BRCC.exe (расположен в каталоге BIN Delphi 1) и файл STRTBL32.rc с помощью
BRCC32.exe (расположен в той же директории 32-битной версии Delphi).

Во время работы приложения мы выясняем язык операционной системы, установленный по умолчанию.
Метод получения такой информации отличается для 16- и 32-битной версии Windows. Чтобы сделать код
более читабельным, мы позаимствовали "языковые" константы из файла Windows.pas, применяемого в
32-битной версии Delphi.

{$IFDEF WIN32}
  {$R STRTBL32.RES}
{$ELSE}
  {$R STRTBL16.RES}
  const LANG_ENGLISH = $09;
  const LANG_SPANISH = $0a;
  const LANG_SWEDISH = $1d;
{$ENDIF}

function GetLanguage : word;
{$IFDEF WIN32}
{$ELSE}

  var
    s : string;
    i : integer;
{$ENDIF}
begin
{$IFDEF WIN32}
  GetLanguage := GetUserDefaultLangID and $3ff;
{$ELSE}

  s[0] := Char(GetProfileString('intl', 'sLanguage', 'none', @s[1], sizeof(s)-2));
  for i := 1 to length(s) do
    s[i] := UpCase(s[i]);
  if s = 'ENU' then GetLanguage := LANG_ENGLISH else
  if s = 'ESN' then GetLanguage := LANG_SPANISH else
  if s = 'SVE' then GetLanguage := LANG_SWEDISH else
    GetLanguage := LANG_ENGLISH;
{$ENDIF}
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  a : array[0..255] of char;
  StrTblOfs : integer;
begin
  {Получаем текущий язык системы и начало соответствующих строк в таблице}
  case GetLanguage of
    LANG_ENGLISH : StrTblOfs := 0;
    LANG_SPANISH : StrTblOfs := 16;
    LANG_SWEDISH : StrTblOfs := 32;
  else
    StrTblOfs := 0;
  end;

  {Загружаем и устанавливаем заголовок кнопки "Yes" в соответствии с языком}
  if LoadString(hInstance, StrTblOfs + 1, @a, sizeof(a)) <> 0 then
    Button1.Caption := StrPas(a);

  {Загружаем и устанавливаем заголовок кнопки "No" в соответствии с языком}
  if LoadString(hInstance, StrTblOfs + 2, @a, sizeof(a)) <> 0 then
    Button2.Caption := StrPas(a);
end;

Статья взята из Kuliba1000

TApplication

Cодержание раздела:

См. также другие разделы:

Таскаем форму за её поверхность

unit DragMain;

interface

uses
  SysUtils, WinTypes, WinProcs,  Messages,
  Classes, Graphics, Controls, Forms, Dialogs, StdCrtls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure ButtonClick(Sender: TObject);
  private
    procedure WMNCHitTest(var M: TWMNCHitTest);
                 message wm_NCCHitTest;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1. WMNCHitTest(var M: TWMNCHitTest);

begin
  inherited;
  if M.Result = htClient then
    M.Result := htCaption;
end;

procedure TForm1.Button1Click(Sender: TObject);

begin
  Close;
end;

end.

Taskbar, кнопка Пуск, Системное меню

Cодержание раздела:

TCanvas и освобождение дескрипторов

TCanvas автоматически ReleaseDC не вызывает. При создании холста с WindowDC в качестве дескриптора, лучшей идеей будет создание потомка TCanvas (моделированного с TControlCanvas):

type
TWindowCanvas = class(TCanvas)
  private
    FWinControl: TWinControl;
    FDeviceContext: HDC;
    procedure SetWinControl(AControl: TWinControl);
  protected
    procedure CreateHandle; override;
  public
    destructor Destroy; override;
    procedure FreeHandle;
    property WinControl: TWinControl read FWinControl write SetWinControl;
  end;

implementation

destructor TWindowCanvas.Destroy;
begin
  FreeHandle;
  inherited Destroy;
end;

procedure TWindowCanvas.CreateHandle;
begin
  if FControl = nil then
    inherited CreateHandle
  else
  begin
    if FDeviceContext = 0 then
      FDeviceContext := GetWindowDC(WinControl.Handle);
    Handle := FDeviceContext;
  end;
end;

procedure TControlCanvas.FreeHandle;
begin
  if FDeviceContext <> 0 then
  begin
    Handle := 0;
    ReleaseDC(WinControl.Handle, FDeviceContext);
    FDeviceContext := 0;
  end;
end;

procedure TControlCanvas.SetWinControl(AControl: TWinControl);
begin
  if FWinControl <> AControl then
  begin
    FreeHandle;
    FWinControl := AControl;
  end;
end;

Очевидно, вы должны должны следить за ситуацией, и разрушать TWindowCanvas (или освобождать дескриптор) перед тем, как уничтожить элемент управления, связанный с ним. Также, имейте в виду, что дескриптор DeviceContext не освобождается автоматически после обработки каждого сообщения (как это происходит с дескрипторами TControlCanvas); для освобождения дескриптора вы должны явно вызвать FreeHandle (или разрушить Canvas). И, наконец, имейте в виду, что "WindowCanvas.Handle:= 0" не освобождает десктиптор, для его освобождения вы должны вызывать FreeHandle.

Взято из

TCheckListBox: использование методов LoadFromFile/SaveToFile

Автор: Bjarne Winkler

Пример показывает как можно сохранять в файл содержимое TCheckListBox и соответственно восстанавливать из файла ранее сохранённые состояния Чекбоксов.

На самом деле всё просто. Метод SaveToFile просто напросто сохраняет в обычном текстовом виде значения чекбоксов. Но предварительно нам нужно преобразовать состояния чекбоксов в текстовый вид, соответственно "1" или "0".
Далее задача метода LoadFromFile считать эти значения и преобразовать сначало в числовой вид, а затем в логический (true или false).

{====================================}
Procedure TFrameRuleEngine.SaveRules;
{====================================}
Var
  i: Integer;

begin
  i := 0;
  While i < CheckListBoxRule.Items.Count Do
  Begin
    If CheckListBoxRule.Items[i] = '' Then
    Begin
      // Если ячейка пустая, то удаляем её
      CheckListBoxRule.Items.Delete(i);
    End
    Else
    Begin
      // Добавляем 1 или 0 соответственно checked или not checked
      CheckListBoxRule.Items[i] := IntToStr(Integer(CheckListBoxRule.Checked[i])) + CheckListBoxRule.Items[i];
      Inc(i);
    End;
  End;
  // Сохраняем весь список
  CheckListBoxRule.Items.SaveToFile(ExtractFilePath(Application.ExeName) + 'Rule.Txt');
end;

{===================================}
Procedure TFrameRuleEngine.LoadRules;
{===================================}
Var
  sChecked: String;
  i: Integer;

begin
  If FileExists(ExtractFilePath(Application.ExeName) + 'Rule.Txt') Then
  Begin
    // Считываем файл
    CheckListBoxRule.Items.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Rule.Txt');
    i := 0;
    While i < CheckListBoxRule.Items.Count Do
    Begin
      If CheckListBoxRule.Items[i] = '' Then
      Begin
        // Удаляем пустую ячейку
        CheckListBoxRule.Items.Delete(i);
      End
      Else
      Begin
        // получаем состояние чекбокса
        sChecked := Copy(CheckListBoxRule.Items[i], 1, 1);
        CheckListBoxRule.Items[i] := Copy(CheckListBoxRule.Items[i], 2, Length(CheckListBoxRule.Items[i]));
        // Обновляем свойство Checked
        CheckListBoxRule.Checked[i] := Boolean(StrToInt(sChecked));
        Inc(i);
      End;
    End;
  End;
end;

Bjarne \v/
http://www.go2NTS.com

Взято с Исходников.ru

TClientDataSet. Некорректное формирование XML

Delphi5 build 5.62, midas.dll v5.0.5.63

При использовании SaveToFile('file.xml', dfXML) формируется некорректный текст XML, если набор данных содержит изменения, т.е. при непустом Delta.

Пример:

Набор данных состоит их двух полей

IntField:integer
StrField: string(20)

После ввода

  1    aaa
  2    bbb
  3    ccc
  4    ddd

и сохранения текст XML имеет вид:

<?xml version="1.0" standalone="yes"?>  <DATAPACKET Version="2.0">
<METADATA><FIELDS><FIELD attrname="IntField" fieldtype="i4"/>
<FIELD attrname="StrField" fieldtype="string" WIDTH="20"/></FIELDS>
<PARAMS CHANGE_LOG="1 0 4 2 0 4 3 0 4 4 0 4"/></PARAMS></METADATA>
<ROWDATA><ROW RowState="4" IntField="1" StrField="aaa"/>
<ROW RowState="4" IntField="2" StrField="bbb"/>
<ROW RowState="4" IntField="3" StrField="ccc"/>
<ROW RowState="4" IntField="4" StrField="ddd"/>
</ROWDATA></DATAPACKET>

Ошибочным явлается наличие тэга </PARAMS>, т.к. открывающий тэг <PARAMS.../> уже содержит ограничитель "/"

После вызова MergeChangeLog, CancelUpdates или ApplyUpdates сохраняется корректный XML.

КОММЕНТАРИЙ

Проблема заключена именно в midas.dll. При проверке в Delphi 5 update pack 1 (build 6.18) баг не проявляется - XML формируется корректно. Если же сменить midas.dll на старую - версии 5.0.5.63 - получаем вышеописанный результат.

Скачать тест StoneTest_22.zip (2.3K)

Мораль сей басни такова: ставьте свежие сервиспаки.

Взято из

TClientDataSet. Утечка памяти при загрузке XML

Hапpимеp, если делаем:

ClientDataSet.LoadFromFile('c:\tmp\1.xml');
ClientDataSet.Close;

то видим, что память выделилась, но не освободилась.

Если даже делать ClientDataSet.Create и ClientDataSet.Free то все pавно будут утечки.

Пpобовал также пеpед закpытием:

ClientDataSet.EmptyDataSet;
ClientDataSet.CancelUpdates;
ClientDataSet.LogChanges:= False;
ClientDataSet.MergeChangeLog;
ClientDataSet.FieldDefs.Clear;
ClientDataSet.IndexDefs.Clear;
ClientDataSet.Params.Clear;
ClientDataSet.Aggregates.Clear;
ClientDataSet.IndexName := '';
ClientDataSet.IndexFieldNames := '';

Все pавно не помогает.

Решения не нашел. Тестировал под D5 под W2000, W98. Также брал midas.dll от D6. Проблема осталась.

КОММЕНТАРИЙ

Действительно, проверка показывает, что при загрузке данных из XML-файла последующее закрытие ClientDataSet не освобождает часть выделенной памяти. Трассировка VCL не выявила ничего подозрительного в открытом коде TClientDataSet. Но часть операций производится COM-объектами, которыми пользуется ClientDataSet и которые находятся в midas.dll.

Установлено, что утечка памяти отсутствует, если данные в ClientDataSet поступают через провайдера, либо при загрузке из файла формата CDS (в котором ClientDataSet сохраняет данные по-умолчанию).

Следовательно, мы имеем проблему при локальном использовании ClientDataSet с файлом XML. Вероятно, в midas.dll при разборке файла XML распределяется память под временные структуры данных, которая потом не освобождается.

Взято из

TColor --> String

В модуле graphics имеется недокументированная функция:

functionColorToString(Color: TColor): string;

Взято из

Советов по Delphi от

Сборник Kuliba

TComboBox.ReadOnly

Иногда хочется сделать так, чтобы в комбобоксе, пользователь мог только выбирать из списка но не вводить текст с клавиатуры.
Так можно включить "ComboBox.ReadOnly"

SendMessage(GetWindow(ComboBox1.Handle,GW_CHILD), EM_SETREADONLY, 1, 0);

а так выключить.

SendMessage(GetWindow(ComboBox1.Handle,GW_CHILD), EM_SETREADONLY, 0, 0);

При csDropDownList нельзя набирать для выбора, то есть если нажал "К" а потом "О", то вначале выберется слово на "К" а потом на "О", а так выберется слово на "КО", и текст нельзя из него копировать.

Автор ответа: Fantasist
Взято с Vingrad.ru

TEdit

Cодержание раздела:

См. также статьи в других разделах:

См. также другие разделы:

Текстовые файлы

Текстовый файл отличается тем что он разбит на разные по длине строки, отделенные символами #13#10. Есть 2 основных метода работы с текстовыми файлами - старый паскалевский способ и через файловые потоки. У обоих есть преимущества и недостатки. Через потоки способ проще поэтому начнем с него.

Итак у всех потомков класса TStrings (TStringList, memo.Lines и т.п. ) есть методы записи и чтения в файл - SaveToFile, LoadFromFile. Преимущество - простота использования и довольно высокая скорость, недостаток - читать и писать файл можно только целиком.

Примеры.
1) Загрузка текста из файла в Memo:

Memo1.lines.loadfromfile('c:\MyFile.txt');

2) Сохранение в файл:

Memo1.lines.savetoFile('c:\MyFile.txt');

3) А вот так можно прочитать весь файл в строку:

Function ReadFromFile(FileName:string):string;
begin
With TStringList.create do
try
LoadFromFile(FileName);
result:=text;
finally
Free;
end;
end;

Текущий модуль и проект

Автор: Dr. Bob

Компонент во время проектирования может знать имена текущих модулей и имя проекта. Все это можно получить с помощью ToolServices (см. файл TOOLINTF.PAS)

Имя текущего проекта можно получить с помощью вызова GetProjectName, список модулей/форм - с помощью функции GetUnitCount, которая возвратит количество модулей и затем с помощью GetUnitName(i) мы можем получить имя каждого модуля (также и с формами).

Вот примерный образец кода (получение и запись имен всех модулей/форм в StringGrid и имени проекта в Label):

procedureTInformationFrm.FormActivate(Sender: TObject);
{ необходимо: StringGrid1 (2 колонки, масса строк), Label1, Label2 }
var
  i, j: Integer;
  Tmp: string;
begin
  StringGrid1.Cells[0, 0] := 'модулей:';
  StringGrid1.Cells[1, 0] := 'форм:';
  if ToolServices <> nil then
    with ToolServices do
    begin
      Label1.Caption := ExtractFileName(GetProjectName); { простое имя }
      Label2.Caption := GetProjectName;   { полное правильное имя пути }
      for i := 0 to GetUnitCount do
      begin
        Tmp := ExtractFileName(GetUnitName(i));
        StringGrid1.Cells[0, i + 1] := Tmp;
        Tmp := ChangeFileExt(Tmp, '.DFM');
        for j := 0 to GetFormCount do
          if ExtractFileName(GetFormName(j)) = Tmp then
            StringGrid1.Cells[1, i + 1] := Tmp
      end;
    end;
end;

Взято с

Теория и практика использования RTTI

Delphi ? это мощная среда визуальной разработки программ сочетающая в себе весьма простой и эффективный язык программирования, удивительный по быстроте компилятор и подкупающую открытость (в состав Delphi входят исходные тексты стандартных модулей и практически всех компонент библиотеки VCL). Однако, как и на солнце, так и в Delphi существуют пятна (на солнце черные, а в Delphi ? белые), пятна недокументированных (или почти не документированных) возможностей. Одно из таких пятен ? это информация о типах времени исполнения и методы работы с ней.

Информация о типах времени исполнения.(Runtime Type Information, RTTI) ?это данные, генерируемые компилятором Delphi о большинстве объектов вашей программы. RTTI представляет собой возможность языка, обеспечивающее приложение информацией об объектах (его имя, размер экземпляра, указатели на класс-предок, имя класса и т. д.) и о простых типах во время работы программы. Сама среда разработки использует RTTI для доступа к значениям свойств компонент, сохраняемых и считываемых из dfm-файлов и для отображения их в Object Inspector,

Компилятор Delphi генерирует runtime информацию для простых типов, используемых в программе, автоматически. Для объектов, RTTI информация генерируется компилятором для свойств и методов, описанных в секции published в следующих случаях:

Объект унаследован от объекта, дня которого генерируется такая информация. В качестве примера можно назвать объект TPersistent.

Декларация класса обрамлена директивами компилятора {$M+} и {$M-}.

Необходимо отметить, что published свойства ограничены по типу данных. Они могут быть перечисляемым типом, строковым типом, классом, интерфейсом или событием (указатель на метод класса). Также могут использоваться множества (set), если верхний и нижний пределы их базового типа имеют порядковые значения между 0 и 31 (иначе говоря, множество должно помещаться в байте, слове или двойном слове). Также можно иметь published свойство любого из вещественных типов (за исключением Real48). Свойство-массив не может быть published. Все методы могут быть published, но класс не может иметь два или более перегруженных метода с одинаковыми именами. Члены класса могут быть published, только если они являются классом или интерфейсом.

Корневой базовый класс для всех VCL объектов и компонент, TObject, содержит ряд методов для работы с runtime информацией. Наиболее часто используемые из них приведены в таблице 1.

Наиболее часто используемые методы класса TObject для работы с RTTI

Метод Описание
ClassType Возвращает тип класса объекта. Вызывается неявно компилятором при определении типа объекта при использовании операторов is и as
ClassName Возвращает строку, содержащую название класса объекта. Например, для объекта типа TForm вызов этой функции вернет строку "TForm"
ClassInfo Возвращает указатель на runtime информацию объекта
InstanceSize Возвращает размер конкретного экземпляра объекта в байтах.
Object Pascal предоставляет в распоряжение программиста два оператора, работа которых основана на неявном для программиста использовании RTTI информации. Это операторы is и as. Оператор is предназначен для проверки соответствия экземпляра объекта заданному объектному типу. Так, выражение вида:

AObjectis TSomeObjectType

является истинным в том случае, если объект AObject является экземпляром класса TSomeObjectType или одного из порожденных от него классов. Следует отметить, что определенная проверка происходит еще на этапе компиляции программы. если фактические объект и класс несовместимы, компилятор выдаст ошибку в этом операторе. Так, следующий программный код

if Edit1 is TForm then
  ShowMessage('Враки!');

даже не будет пропущен компилятором, и он выдаст сообщение о не совместимости типов (разумеется, что Edit1 ? это компонент типа TEdit):

Incompatible types: 'TForm' and 'TEdit'.

Перейдем теперь к оператору as. Он введен в язык специально для приведения объектных типов. Посредством него можно рассматривать экземпляр объекта как принадлежащий к другому совместимому типу:

AObject as TSomeObjectType

Использование оператора as отличается от обычного способа приведения типов

TSomeObjectType(AObject)

наличием проверки на совместимость типов. Так при попытке приведения этого оператора с несовместимым типом он сгенерирует исключение EInvalidCast. Определенным недостатком операторов is и as является то, что присваиваемый фактически тип должен быть известен на этапе компиляции программы и поэтому на месте TSomeObjectType не может стоять переменная указателя на класс.

Для иллюстрации только что написанного рассмотрим небольшой пример. Предположим у вас на форме имеется ряд компонент типа TEdit, и вы хотите реализовать их очистку их свойств перед созданием формы. С применением RTTI это можно сделать следующим программным кодом:

var
  I: Integer;
begin
  for I := 0 to ComponentCount - 1 do
    if Components[I] is TEdit then
      (Components[I] as TEdit).Text := '';
      { или так TEdit (Components[I]).Text := ''; }
end;

Хочу обратить ваше внимание, а то, что стандартное приведение типа в данном примере предпочтительнее, поскольку в операторе if мы уже установили что компонент является объектом нужного нам типа и дополнительная проверка соответствия типов, проводимая оператором as, нам уже не нужна.

Первые шаги в понимании RTTI мы уже сделали. Теперь переходим к подробностям. Все основополагающие определения типов, основные функции и процедуры для работы с runtime информацией находятся в модуле TypInfo. Этот модуль содержит две фундаментальные структуры для работы с RTTI ? TTypeInfo и TTypeData (типы указателей на них ? PTypeInfo и PTypeData соответственно). Суть работы с RTTI выглядит следующим образом. Получаем указатель на структуру типа TTypeInfo (для объектов указатель можно получить, вызвав метод, реализованный в TObject, ClassInfo, а для простых типов в модуле System существует функция TypeInfo). Затем, посредством имеющегося указателя и вызова функции GetTypeData получаем указатель на структуру типа TTypeData. Далее используя оба указателя и функции модуля TypInfo творим маленькие чудеса. Для пояснения написанного выше рассмотрим пример получения текстового вида значений перечисляемого типа. Пусть, например, это будет тип TBrushStyle. Этот тип описан в модуле Graphics следующим образом:

TBrushStyle = (bsSolid, bsClear, bsHorizontal, bsVertical,
  bsFDiagonal, bsBDiagonal, bsCross, bsDiagCross);

Вот мы и попробуем получить конкретные значения этого типа в виде текстовых строк. Для этого создайте пустую форму. Поместите на нее компонент типа TListBox с именем ListBox1 и кнопку. Реализацию события OnClick кнопки замените следующим кодом:

var
  ATypeInfo: PTypeInfo;
  ATypeData: PTypeData;
  I: Integer;
  S: string;
begin
  ATypeInfo := TypeInfo(TBrushStyle);
  ATypeData := GetTypeData(ATypeInfo);
  for I := ATypeData.MinValue to ATypeData.MaxValue do
  begin
    S := GetEnumName(ATypeInfo, I);
    ListBox1.Items.Add(S);
  end;
end;

Ну вот, теперь, когда на вооружении у нас есть базовые знания о противнике, чье имя, на первый взгляд выглядит непонятно и пугающее ? RTTI настало время большого примера. Мы приступаем к созданию объекта опций для хранения различных параметров, использующего в своей работе мощь RTTI на полную катушку. Чем же примечателен, будет наш будущий класс? А тем, что он реализует сохранение в ini-файл и считывание из него свои свойства секции published. Его потомки будут иметь способность сохранять свойства, объявленные в секции published, и считывать их, не имея для этого никакой собственной реализации. Надо лишь создать свойство, а все остальное сделает наш базовый класс. Сохранение свойств организуется при уничтожении объекта (т.е. при вызове деструктора класса), а считывание и инициализация происходит при вызове конструктора класса. Декларация нашего класса имеет следующий вид:

{$M+}
TOptions = class(TObject)
  protected
    FIniFile: TIniFile;
    function Section: string;
    procedure SaveProps;
    procedure ReadProps;
  public
    constructor Create(const FileName: string);
    destructor Destroy; override;
end;
{$M-}

Класс TOptions является производным от TObject и по этому, что бы компилятор генерировал runtime информацию его надо объявлять директивами {$M+/-}. Декларация класса весьма проста и вызвать затруднений в понимании не должна. Теперь переходим к реализации методов.

constructor TOptions.Create(const FileName: string);
begin
  FIniFile:=TIniFile.Create(FileName);
  ReadProps;
end;

destructor TOptions.Destroy;
begin
  SaveProps;
  FIniFile.Free;
  inherited Destroy;
end;

Как видно реализация конструктора и деструктора тривиальна. В конструкторе мы создаем объект для работы с ini-файлом и организуем считывание свойств. В деструкторе мы в сохраняем значения свойств в файл и уничтожаем файловый объект. Всю нагрузку по реализации сохранения и считывания published-свойств несут методы SaveProps и ReadProps соответственно.

procedure TOptions.SaveProps;
var
  I, N: Integer;
  TypeData: PTypeData;
  List: PPropList;
begin
  TypeData:= GetTypeData(ClassInfo);
  N:= TypeData.PropCount;
  if N <= 0 then
    Exit;
  GetMem(List, SizeOf(PPropInfo)*N);
  try
    GetPropInfos(ClassInfo,List);
    for I:= 0 to N - 1 do
      case List[I].PropType^.Kind of
        tkEnumeration, tkInteger:
          FIniFile.WriteInteger(Section, List[I]^.name,GetOrdProp(Self,List[I]));
        tkFloat:
          FIniFile.WriteFloat(Section, List[I]^.name, GetFloatProp(Self, List[I]));
        tkString, tkLString, tkWString:
          FIniFile.WriteString(Section, List[I]^.name, GetStrProp(Self, List[I]));
      end;
  finally
    FreeMem(List,SizeOf(PPropInfo)*N);
  end;
end;

procedure TOptions.ReadProps;
var
  I, N: Integer;
  TypeData: PTypeData;
  List: PPropList;
  AInt: Integer;
  AFloat: Double;
  AStr: string;
begin
  TypeData:= GetTypeData(ClassInfo);
  N:= TypeData.PropCount;
  if N <= 0 then
    Exit;
  GetMem(List, SizeOf(PPropInfo)*N);
  try
    GetPropInfos(ClassInfo, List);
    for I:= 0 to N - 1 do
      case List[I].PropType^.Kind of
        tkEnumeration, tkInteger:
        begin
          AInt:= GetOrdProp(Self, List[I]);
          AInt:= FIniFile.ReadInteger(Section, List[I]^.name, AInt);
          SetOrdProp(Self, List[i], AInt);
        end;
        tkFloat:
        begin
          AFloat:=GetFloatProp(Self,List[i]);
          AFloat:=FIniFile.ReadFloat(Section, List[I]^.name,AFloat);
          SetFloatProp(Self,List[i],AFloat);
        end;
        tkString, tkLString, tkWString:
        begin
          AStr:= GetStrProp(Self,List[i]);
          AStr:= FIniFile.ReadString(Section, List[I]^.name, AStr);
          SetStrProp(Self,List[i], AStr);
        end;
      end;
  finally
    FreeMem(List,SizeOf(PPropInfo)*N);
  end;
end;

function TOptions.Section: string;
begin
  Result := ClassName;
end;

Теперь, для проверки работоспособности, и отладки объекта опций создадим новое приложение и подключим к нему модуль, в котором описан и реализован объект TOptions. Ниже приведен программный код, иллюстрирующий создание наследника от класса TOptions и его использования в главной (и единственной) форме нашего тестового приложения интерфейсная часть выглядит так:

TMainOpt = class(TOptions)
  private
    FText: string;
    FHeight: Integer;
    FTop: Integer;
    FWidth: Integer;
    FLeft: Integer;
    procedure SetText(const Value: string);
    procedure SetHeight(Value: Integer);
    procedure SetLeft(Value: Integer);
    procedure SetTop(Value: Integer);
    procedure SetWidth(Value: Integer);
  published
    property Text: string read FText write SetText;
    property Left: Integer read FLeft write SetLeft;
    property Top: Integer read FTop write SetTop;
    property Width: Integer read FWidth write SetWidth;
    property Height: Integer read FHeight write SetHeight;
end;

TForm1 = class(TForm)
    Edit1: TEdit;
    procedure Edit1Change(Sender: TObject);
  private
    FMainOpt: TMainOpt;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
end;

А вот и реализация:

constructor TForm1.Create(AOwner: TComponent);
var
  S: string;
begin
  inherited Create(AOwner);
  S := ChangeFileExt(Application.ExeName, '.ini');
  FMainOpt := TMainOpt.Create(S);
  Edit1.Text := FMainOpt.Text;

  Left := FMainOpt.Left;
  Top := FMainOpt.Top;
  Width := FMainOpt.Width;
  Height := FMainOpt.Height;
end;

destructor TForm1.Destroy;
begin
  FMainOpt.Left := Left;
  FMainOpt.Top := Top;
  FMainOpt.Width := Width;
  FMainOpt.Height := Height;
  FMainOpt.Free;
  inherited Destroy;
end;

{ TMainOpt }

procedure TMainOpt.SetText(const Value: string);
begin
  FText := Value;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
  FMainOpt.Text := Edit1.Text;
end;

procedure TMainOpt.SetHeight(Value: Integer);
begin
  FHeight := Value;
end;

procedure TMainOpt.SetLeft(Value: Integer);
begin
  FLeft := Value;
end;

procedure TMainOpt.SetTop(Value: Integer);
begin
  FTop := Value;
end;

procedure TMainOpt.SetWidth(Value: Integer);
begin
  FWidth := Value;
end;

В заключение своей статьи хочу сказать, что RTTI является недокументированной возможностью Object Pascal и поэтому информации на эту тему в справочной системе и электронной документации весьма мало. Наиболее легкодоступный способ изучить более подробно эту фишку ? просмотр и изучение исходного текста модуля TypInfo.

Взято с

Тест на корректность GUID и интерфейсов

Автор: Nomadic

Как осуществить минимальный тест на корректность глобального идентификатора (GUID), и интерфейсов, унаследованных от IDispatch (и, следовательно, поддерживающих методы автоматизации)?

Вызовите CreateRemoteComObject, передав GUID интерфейса и имя компьютера, к которому Вы пытаетесь подключиться. Если функция вернет ошибку, то наличествует проблема сервера, иначе возможная проблема относится к клиенту.

const
MyGUID = '{444...111}'; //Whatever the guid is...

var
  Unk: IUnknown;
  Disp: IDispatch;

begin
  { Make sure this line works correctly }
  Unk := CreateRemoteComObject('server1',
    StringToGUID(MyGUID));

  { If it does, then cast it to a IDispatch }
  Disp := Unk as IDispatch;
end;

Если этот кусок кода работает, а проблема остается, то Вам требуется шаг за шагом пройти через код клиента и найти, где он дает трещину. Если не сможете этого обнаружить, Вам придется запустить сервер под отладчиком и установить связь с клиентом, чтобы Вы могли произвести отладку рядом со местом, дающем слабину.

Взято с

TForm

Cодержание раздела:

·
·
·
·
·
·
·
·
·
·

·
·
·
·
·
·
·
·
·

·
·

·
·
·
·
·
·
·
·

·
·
·
·
·

·
·
·
·
·
·
·
·
·
·
·

·
·
·
·
·

См. также статьи в других разделах:

Threads

Cодержание раздела:

TIF ---> PDF

Автор: Morten Ravn-Jonsen

Совместимость: Delphi 5.x (или выше)

Как-то раз получился TIF файл на несколько страниц и возникла необходимость конвертации его в PDF формат. Для использования такой возможности необходимо иметь полную версию Adobe Acrobat. Функция тестировалась на Adobe Acrobat 4.0.

Сперва Вам необходимо импортировать элементы управления Acrobat AxtiveX.

1) Выберите Component -> Import ActiveX Control
2) Выберите Acrobat Control for ActiveX и нажмите install
3) Выберите пакет ActiveX control для инсталяции
4) Добавьте PDFlib_tlb в Ваш проект. Этот файл находится в директории Borland\Delphi5\Imports.

Как использовать функцию

Вот пример её вызова:

if not TifToPDF('c:\test.tif', 'c:\test.pdf') then Showmessage('Could not convert');

Функция TifToPdf

function TifToPDF(TIFFilename, PDFFilename: string): boolean;
var
  AcroApp : variant;
  AVDoc : variant;
  PDDoc : variant;
  IsSuccess : Boolean;
begin
  result := false;
  if not fileexists(TIFFilename) then exit;

  try
    AcroApp := CreateOleObject('AcroExch.App');
    AVDoc := CreateOleObject('AcroExch.AVDoc');

    AVDoc.Open(TIFFilename, '');
    AVDoc := AcroApp.GetActiveDoc;

    if AVDoc.IsValid then
    begin
      PDDoc := AVDoc.GetPDDoc;

      PDDoc.SetInfo ('Title', '');
      PDDoc.SetInfo ('Author', '');
      PDDoc.SetInfo ('Subject', '');
      PDDoc.SetInfo ('Keywords', '');

      result := PDDoc.Save(1 or 4 or 32, PDFFilename);

      PDDoc.Close;
    end;

    AVDoc.Close(True);
    AcroApp.Exit;

  finally
    VarClear(PDDoc);
    VarClear(AVDoc);
    VarClear(AcroApp);
  end;
end;

Взято с Исходников.ru

Типизированные файлы

Теперь разберем типизированные файлы. Типизированный файл - это файл в котором записанны идентичные структуры. Например любой файл можно считать файлом байтов - т.е. можно его читать байт за байтом, можно перейти сразу к любому байту по его номеру, можно сразу узнать сколько байт в файле, можно заменить любой байт на другой не перезаписывая файл. Теперь все это в примерах:

Объявляем файл байтов:

var f:file of byte;
     b:Byte;

Ассоциируем файловую переменную с физическим файлом:

AssignFile(f,'c:\myfile.bin');

Теперь мы можем либо перезаписать/создать файл:

Rewrite(f);

Либо открыть существующий для чтения и записи:

Reset(f);

Обратите внимание, что функция Reset хотя и имеет такой же формат как и для текстовых файлов, но открытый ей файл можно и читать и писать, в отличие от текстовых.

Теперь функции работы с файлом:

read(f,b); - прочитать 1 байт
write(f,b); - записать 1 байт
seek(f,100); - поставить текущее положение считывания/записи на сотый байт
Size(f); - прочитать количество байт в файле.
Eof(f); - узнать не являетсмя ли байт последним

Все эти функции не работают с файлами большими 2 Gb.

После работы файл надо закрыть:

CloseFile(f);

Приведенные выше механизмы будут работать с любым файлом, так как любой файл можно считать файлом байтов. Теперь где это можно использовать? В принципе везде, но в подавляющем большинстве случаев это будет очень неудобно, ведь скорость считывания при чтении по байтам будет на порядки более низкой чем другими способами. Однако в некоторых случаях этот способ может быть очень полезен. Например в программе вам надо заменить 100й байт файла на другой, или прочитать 100й байт файла, например во всяких читерских программах, при взломе и т.п. Здесь такой доступ будет весьма удобен. Гораздо более интересным представляется дальнейшее развитие технологии типизированных файлов (их еще лет 15 назад называли "Файлы прямого доступа"). Представим себе, что файл состоит не из байт а из более сложных структур. Например мы имеем некоторую информацию в виде:

Type MyRec=Record
           Name:string[100];
           Age:byte;
           Membership:Boolean;
           Accounts:array[1..10] of integer;
        End;

Обратите внимание, что все элементы записи точно типизированны, нет ни длинных строк, ни открытых массивов, ни объектов, другими словами, заранее точно известно сколько именно байт будет занимать переменная этого типа. Объявим переменную этого типа:

Var MyVar:MyRec;

и файл этого типа:

Var f:File of MyRec;

Теперь мы можем читать и писать сразу целую структуру, абсолютно так же как и если бы это был один байт:

AssignFile(f,'c:\MyFile.rec');
Rewrite(f);
MyVar.Name:='Vitaly';
MyVar.Age:=33;
MyVar.Membership:=True;
MyVar.Accounts[1]:=12345;
MyVar.Accounts[2]:=34985;
Write(f,MyVar);
Closefile(f);

Все остальные функции приведенные в предыдущей статье будут работать так же, только одно отличие - Seek и Size оперируют не с количеством байт, а с количеством записей.

Типы файлов в среде Дельфи

DPR - Delphi Project File. This is actually a Pascal source file; it just happens to be the main program for the application.

PAS - In Delphi, PAS files are always the source code to either a unit or a form. The main program of an application is in the DPR file.

DFM - These files are always paired with PAS files. The DFM file is the binary data used to set up initial data for components (IE, the properties you set in design mode rather than in code). You can't edit a DFM file with a text editor, but if you open it in Delphi, you will see a textual version of the contents.

DCU - A compiled unit, similar in concept to an OBJ file.

OPT - Project Options; i.e. compiler and linker settings, which form is the main form, what icon to use for the application, etc. Generally, the stuff you edit under Options/Project.

RES - A Windows resource file; generated automatically by Delphi and required by the compilation process. You don't need to worry about this file, but don't delete it either.

EXE - All of the above linked together into runnable format.

~DP - A backup file of the DPR file before the last save operation.

~PA - A backup of a .PAS file.

~DF - A backup of a .DFM file.

Взято с сайта

Формат .CAB-файлов
Это формат файлов, который Delphi предлагает теперь своим пользователям для размещения в Интернете. Cabinet-формат является эффективным средством для упаковки нескольких файлов. Cabinet-формат имеет две ключевых характеристики: в отдельном кабинете (.cab-файл) могут храниться несколько файлов, и сжатие данных выполняется в зависимости от типа файлов, что значительно увеличивает коэффициент сжатия. Создание Cabinet-файла зависит также от количества упаковываемых файлов и ожидаемого к ним типа доступа (последовательный, произвольный, одновременный ко всем файлам или доступ к нескольким файлам в одно и тоже время). Delphi не пользуется преимуществами сжатия файлов в зависимости от их типа.

Формат .LIC-файлов
В действительности, как такового, формата .lic-файла не существует. Обычно это такие же текстовые файлы, содержащие одну или две ключевых строки.

Формат .INF-файлов
Все inf-файлы состоят из секций и пунктов. Каждая именованная секция содержит соответствующие пункты. Все inf-файлы начинаются с заголовочной секции. После заголовка включенные секции могут располагаться в любом порядке. Каждый заголовок представляет собой строку с [Именем Заголовка]. Далее следуют пункты: ItemA = ItemDetail. Для получения дополнительной информации обратитесь к документу "Device Information File Reference".

Формат .dpr-файлов
.dpr-файл является центральным файлом Delphi-проекта. Для программы он является первой точкой входа. dpr содержит ссылки на другие файлы проекта и связывает формы с соответствующими модулями. Данный файл нужно редактировать с предельной осторожностью, так как неумелые действия могут привести к тому, что вы не сможете загрузить ваш проект. Этот файл является критическим при загрузке и перемещении (копировании) проекта.

Формат .pas-файлов
Это стандартный текстовый файл, который можно редактировать в текстовом редакторе. Данный файл нужно редактировать с некоторой долей осторожности, поскольку это может закончиться потерей некоторых преимуществ двух других инструментов. К примеру, добавление кода для кнопки с декларацией типа никак не отразится на соответствующем .dfm-файле формы. Все pas-файлы являются критическими при пересборке проекта.

Формат .dfm-файлов
Данный файл содержит описание объектов, расположенных на форме. Содержимое файла можно увидеть в виде текста, вызвав правой кнопкой мыши контекстное меню и выбрав пункт "view as text", или же с помощью конвертера convert.exe (расположенного в каталоге bin), также позволяющего перевести файл в текстовый вид и обратно. Данный файл нужно редактировать очень осторожно, поскольку это может закончиться тем, что IDE не сможет загрузить форму. Этот файл является критическим при перемещении и пересборке проекта.

Формат .DOF-файлов
Данный текстовый файл содержит текущие установки для опций проекта, как например, настройки компилятора и компоновщика, каталоги, условные директивы и параметры командной строки. Данные установки могут быть изменены пользователем путем изменений настроек проекта.

Формат .DSK-файлов
Данный текстовый файл хранит информацию относительно состояния вашего проекта, как например, открытое окно и его координаты. Подобно .DOF-файлу, данный файл создается на основе текущей обстановки проекта.

Формат .DPK-файлов
Данный файл содержит исходный код пакета (аналогично .DPR-файлу стандартного проекта Delphi). Подобно файлу .DPR, .DPK-файл также является простым текстовым файлом, который можно редактировать (см. предупреждение выше) в стандартном редакторе. Одной из причин, по которой вы можете это сделать - использование компилятора командной строки.

Формат .DCP-файлов
Данный бинарный image-файл состоит фактически из реально скомпилированного пакета. Информация о символах и дополнительных заголовках, требуемых IDE, полностью содержится в .DCP-файле. Чтобы собрать (build) проект, IDE должен иметь доступ к этому файлу.

Формат .DPL-файла
В действительности это выполняемый runtime-пакет. Данный файл является Windows DLL с интегрированными Delphi-специфическими характеристиками. Данный файл необходим в случае развертывания приложения, использующего пакеты.

Формат .DCI-файла
Данный файл содержит как стандартные, так и определенные пользователем шаблоны кода, используемых в IDE. Файл может редактироваться стандартным текстовым редактором, или в самой IDE. Как и любой текстовый файл данных, используемый Delphi, редактировать его самостоятельно не рекомендуется.

Формат .DCT-файла
Это "частный" бинарный файл, содержащий информацию об определенных пользователями шаблонах компонентов. Данный файл не может быть отредактирован никакими способами через IDE. Поскольку данный файл является "личным" файлом IDE, то совместимость с последующими версиями Delphi не гарантируется.

Формат .TLB-файла
.TLB-файл является "частным" двоичным файлом библиотеки типов. Обеспечивает информацией для идентификации типов объектов и интерфейсов, доступных в ActiveX сервере. Подобно модулю или заголовочному файлу, .TLB служит в качестве хранилища для необходимой символьной информации приложения. Поскольку данный файл является "личным", то совместимость с последующими версиями Delphi не гарантируется.

Формат .DRO-файла
Данный текстовый файл содержит информацию об объектном хранилище. Каждый пункт данного файла содержит специфическую информацию о каждом доступном элементе в хранилище объектов. Хотя этот файл и является простым текстовым файлом, мы настоятельно не рекомендуем править его вручную. Хранилище может редактироваться только с помощью меню Tools|Repository в самом IDE.

Формат .RES-файла
Это стандартный двоичный windows-формата файл ресурсов, включающий в себя информацию о приложении. По умолчанию, Delphi создает новый .RES-файл при каждой компиляции проекта в исполняемое приложение.

Формат .DB-файла
Файлы с таким расширением - стандартные файлы Paradox.

Формат .DBF-файла
Файлы с таким расширением - стандартные dBASE-файлы.

Формат .GDB-файла
Файлы с таким расширением - стандартные Interbase-файлы.

Формат .DMT-файла
Этот "частный" бинарный файл содержит встроенные и определенные пользователем шаблоны меню. Данный файл не может быть отредактирован никакими способами через IDE. Поскольку данный файл является "личным", то совместимость с последующими версиями Delphi не гарантируется.

Формат .DBI-файла
Данный текстовый файл содержит информацию, необходимую для инициализации Database Explorer. Данный файл не может быть отредактирован никакими способами через Database Explorer.

Формат .DEM-файла
Данный текстовый файл содержит некоторые стандартные, привязанные к стране, форматы компонента TMaskEdit. Как и любой текстовый файл данных, используемый Delphi, редактировать его самостоятельно не рекомендуется.

Формат .OCX-файла
.OCX-файл является специализированной DLL, которая содержит все или несколько функций, связанных с элементом управления ActiveX. Файл OCX задумывался как "обертка", которая содержала бы сам объект, и средства для связи с другими объектами и серверами.

Взято с

TLabel

Cодержание раздела:

См. также статьи в других разделах:

TMemo

Cодержание раздела:

См. также статьи в других разделах:

См. также другие разделы:

TOpenDialog, TSaveDialog, TOpenPictureDialog и TSavePictureDialog

(Перевод одноимённой статьи с сайта delphi.about.com )

Стандарные диалоговые окошки
Практически любое приложение Windows использует стандартные диалоги, встроенные в операционную систему, для открытия и сохранения файлов, поиска текста, печати, выбора шрифта или установки цвета.
В этой статье мы рассмотрим основные свойства и методы этих диалогов и, особенно, сфокусируем внимание на диалогах Open и Save.

Стандартные диалоговые окошки можно найти на панели компонентов в закладке Dialogs. Для того, чтобы начать использовать определённое диалоговое окошко, его достаточно поместить на форму. Компоненты стандартных диалогов являются невидимыми, поэтому Вы не сможете изменить дизайн такого диалога во время разработки приложения.

TOpenDialog и TSaveDialog
Диалоговые окошки File Open и File Save имеют несколько общих свойств. File Open в основном используется для выбора и открытия файлов, в то время как диалог File Save (так же используется как диалоговое окошко Save As) используется для получения от пользователя имени файла, чтобы сохранить файл. Далее мы рассмотрим некоторые важные свойства TOpenDialog и TSaveDialog:

Свойство Options предназначено для задания конечного вида окна. Например, при помощи следующего кода:

with OpenDialog1 do
Options := Options +
   [ofAllowMultiSelect, ofFileMustExist];

мы позволим пользователю выбирать несколько файлов, а так же заставим генерироваться сообщение об ошибке, если пользователь выберет несуществующий файл.

Свойство InitialDir используется для указания директории, которая будет показана при создании диалога. Следующий код установит начальную директорию, из которой было запущено приложение:

SaveDialog1.InitialDir :=
    ExtractFilePath(Application.ExeName);

Свойство Filter содержит список типов файлов, которые сможет выбирать пользователь. Когда пользователь выберет тип файлов, то в диалоговом окне будут отображаться только файлы данного расширения. Фильтр можно легко установить на стадии создания приложения при помощи диалога редактора фильтра (Filter Editor):

Так же фильтр можно задать программно. Строка фильтра должна содержать описание и расширение для данного типа файлов, разделённые вертикальной чертой:

OpenDialog1.Filter :=
  'Text files (*.txt)|*.txt|All files (*.*)|*.*';

Свойство FileName. Когда пользователь нажмёт на диалоге кнопку OK, то это свойство будет содержать полный путь и имя выбранного файла.
Вызов диалогового окошка
Для создания и отображения стандартного диалога необходимо выполнить метод Execute для нужного диалога. За исключением диалогов TFindDialog и TReplaceDialog, все остальные диалоги отображаются модально.

Все стандартные диалоговые окошки позволяют определить нажал ли пользователь кнопку "Отмена" (Cancel) (или нажал ESC). Если метод Execute вернул True значит пользователь нажал OK или сделал двойной щелчёк по файлу либо нажал Enter на клавиатуре, иначе, если была нажата кнопка Cancel, клавиша Esc или Alt-F4, будет возвращено значение False.

if OpenDialog1.Execute then
  ShowMessage(OpenDialog1.FileName);

Этот код показывает диалог File Open и, если пользователь нажал "Открыть" (Open), то будет показано имя выбранного файла.

Использование только кода
Чтобы работать диалогом Open (или любым другим) не помещая при этом на форму компонент OpenDialog, можно воспользоваться следующим кодом:

procedure TForm1.btnFromCodeClick(Sender: TObject);
var OpenDlg : TOpenDialog;
begin OpenDlg := TOpenDialog.Create(Self);
{здесь устанавливаем опции...}
if OpenDlg.Execute then begin
  {здесь что-нибудь делаем}
end;
OpenDlg.Free;
end;

Обратите внимание, что перед вызовом Execute, можно установить различные свойства компонента OpenDialog.

TOpenPictureDialog и TSavePictureDialog
Эти два диалога есть ничто иное как обычные File Open и File Save с дополнительной возможностью предварительного просмотра выбранной картинки.

Мой Блокнот
А теперь предлагаю применить теорию на практике. Создадим простейший блокнот, и посмотрим как работают диалоговые окошки Open и Save:

Для создания блокнота проделаем следующее:
. Запустите Delphi и выберите в меню File-New Application.
. Поместите на форму Memo, OpenDialog, SaveDialog и две кнопки.
. Переименуйте Button1 в btnOpen, а Button2 в btnSave.

Код
1. Поместите в событие формы FormCreate следующий код:

procedure TForm1.FormCreate(Sender: TObject);
begin
with OpenDialog1 do begin
  Options:=Options+[ofPathMustExist,ofFileMustExist];
  InitialDir:=ExtractFilePath(Application.ExeName);
  Filter:='Text files (*.txt)|*.txt';
end;
with SaveDialog1 do begin
  InitialDir:=ExtractFilePath(Application.ExeName);
  Filter:='Text files (*.txt)|*.txt';
end;
Memo1.ScrollBars := ssBoth;
end;

Этот код устанавливает некоторые свойства диалога Open как было описано в начале статьи.

2. Добавьте следующий код в событие Onclick для кнопок btnOpen и btnSave:

procedure TForm1.btnOpenClick(Sender: TObject);
begin
if OpenDialog1.Execute then begin
  Form1.Caption := OpenDialog1.FileName;
  Memo1.Lines.LoadFromFile
    (OpenDialog1.FileName);
  Memo1.SelStart := 0;
end;
end;

procedure TForm1.btnSaveClick(Sender: TObject);
begin
SaveDialog1.FileName := Form1.Caption;
if SaveDialog1.Execute then begin
   Memo1.Lines.SaveToFile
     (SaveDialog1.FileName + '.txt');
   Form1.Caption:=SaveDialog1.FileName;
end;
end;

Теперь можно смело запускать проект

Взято с Исходников.ru

Тpансляция ошибок

Делаем ApplyUpdates. Если пpи insert(update) пpоизошла ошибка (поле null, сpаботал check, etc.), то BDE всегда говоpит "General SQL Error" вместо ноpмального сообщения об ошибке :-( Без CU все ноpмально, pазумеется. Как боpоть этот баг?

Использyй ноpмальнyю тpансляцию ошибок в Application.OnException. Вpоде это.

procedureDBExceptionTranslate(E: EDBEngineError);

function OriginalMessage: string;
var
  I: Integer;
  DBErr: TDBError;
  S: string;
begin
  Result := '';
  for I := 0 to E.ErrorCount - 1 do
  begin
    DBErr := E.Errors[I];
    case DBErr.NativeError of
      -836: { Intebase exception }
        begin
          S := DBErr.Message;
          Result := #13#10 + Copy(S, Pos(#10, S) + 1, Length(S));
          Exit;
        end;
    end;
    S := Trim(DBErr.Message);
    if S <> '' then
      Result := Result + #13#10 + S;
  end;
end;

begin
  case E.Errors[0].ErrorCode of
    $2204:
      E.Message := LoadStr(SKeyDeleted);
    $271E, $2734:
      E.Message := LoadStr(SInvalidUserName);
    $2815:
      E.Message := LoadStr(SDeadlock);
    $2601:
      E.Message := LoadStr(SKeyViol);
    $2604:
      E.Message := LoadStr(SFKViolation) + OriginalMessage;
  else
    begin
      E.Message := Format(LoadStr(SErrorCodeFmt), [E.Errors[0].ErrorCode]) +
        OriginalMessage;
    end;
  end;
end;

Взято из

TProgressBar

Cодержание раздела:

См. также статьи в других разделах:

TrackBar

Cодержание раздела:

Требуется нажать в другом приложении пару кнопок?

Требуется нажать в "другом" приложении пару кнопок (button). (кнопки не имеют hotkeys). Ищу окно так (Дельфи):

ifFindWindow(nil, 'Advanced Dialer')<> 0 then
  ShowMessage('OK');

А теперь в найденном приложении надо нажать кнопку HangUp, подождать 5 сек. и нажать кнопку Dial. Подскажите плз. как это реализовать. Я не знаю, что там за кнопки... Если класс Button, то один вариант, если это конпки на тулбаре, то другой. Вот посмотри, я писал когда-то, лишнее стирать лень... реализуется 1-й и 2-й способ:

function PressAbortAndReloadBtn: string;
var
  MenuHnd: THandle;
  //описатель меню
  ItemUint: UINT;
  //идентификатор пункта меню
  BtnHnd: THandle;
begin
  result := PRX_UNKNOWN_ERR;
  GetProcList;
  if Prx_MainWHnd <> 0 then
  begin
    BtnHnd := FindWindowEx(Prx_MainWHnd, 0, nil, PChar(PrxABtnName));
    SendMessage(BtnHnd, BM_CLICK, 0, 0);
    Sleep(100);
    MenuHnd := GetMenu(Prx_MainWHnd);
    if Menuhnd <> 0 then
    begin
      ItemUint := GetMenuItemID(Menuhnd, 4);
      if ItemUint <> 0 then
      begin
        SendMessage(Prx_MainWHnd, WM_COMMAND, ItemUint, 0);
        result := PRX_OK;
      end
      else
        result := PRX_ITEM_NOT_FOUND;
    end
    else
      result := PRX_MENU_NOT_FOUND;
  end
  else
    result := PRX_NOT_FOUND;
  if result <> PRX_OK then
    WriteLog(result);
end;

// У себя делал так

procedure ClickOnForm(wnd: HWND; caption: string);
var
  TheChildHandle: HWND;
begin
  TheChildHandle := FindWindowEx(wnd, 0, nil, PChar(caption));
  SendMessage(TheChildHandle, WM_LButtonDown, 1, 1);
  SendMessage(TheChildHandle, WM_LButtonUP, 1, 1);
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  wnd: HWND;
  caption: string;
begin
  wnd := GetTopWindow(0);
  repeat
    SetLength(caption, GetWindowtextLength(wnd));
    GetWindowText(wnd, @caption[1], length(caption) + 1);

    if (trim(caption) = 'Form caption') then
      ClickOnForm(wnd, 'Button name');
    wnd := GetNextWindow(wnd, GW_HWNDNEXT);
  until wnd = 0;
end;

Взято с

TreeView, ListView

Cодержание раздела:

TRichEdit

Cодержание раздела:

См. также статьи в других разделах:

См. также другие разделы:

TStatusBar

Cодержание раздела:

См. также статьи в других разделах:

TXT ---> GIF

procedureTxtToGif(txt, FileName: string);
var
  temp: TBitmap;
  GIF: TGIFImage;
begin

  temp := TBitmap.Create;
  try
    temp.Height := 400;
    temp.Width := 60;
    temp.Transparent := True;
    temp.Canvas.Brush.Color := colFondo.ColorValue;
    temp.Canvas.Font.Name := Fuente.FontName;
    temp.Canvas.Font.Color := colFuente.ColorValue;
    temp.Canvas.TextOut(10, 10, txt);
    Imagen.Picture.Assign(nil);

    GIF := TGIFImage.Create;
    try
      // Convert the bitmap to a GIF
      GIF.Assign(Temp);
      // Save the GIF
      GIF.SaveToFile(FileName);
      // Display the GIF
      Imagen.Picture.Assign(GIF);
    finally
      GIF.Free;
    end;

  finally

    temp.Destroy;
  end;
end;

Взято с

Delphi Knowledge Base

Убиваем активное приложение

Автор: Dale Berry

Данная функция позволяет завершить выполнение любой активной программы по её classname или заголовку окна.

procedure KillProgram(Classname : string; WindowTitle : string);
const
  PROCESS_TERMINATE = $0001;
var
  ProcessHandle : THandle;
  ProcessID: Integer;
  TheWindow : HWND;
begin
  TheWindow := FindWindow(Classname, WindowTitle);
  GetWindowThreadProcessID(TheWindow, @ProcessID);
  ProcessHandle := OpenProcess(PROCESS_TERMINATE, FALSE, ProcessId);
  TerminateProcess(ProcessHandle,4);
end;

Комментарии

Xianguang Li (22 Октября 2000)

В Delphi 5, при компиляции получается следующая ошибка :
Incompatible types: 'String' and 'PChar'.
После изменения выражения
TheWindow := FindWindow(ClassName, WindowTitle)
на
TheWindow := FindWindow(PChar(ClassName), PChar(WindowTitle)) ,
Нормально откомпилировалось.
И ещё: если мы не знаем ClassName или WindowTitle программы, которую мы хотим убить,
то мы не сможем её завершить. Причина в том, что нельзя вызвать функцию в виде:
KillProgram(nil, WindowTitle)
или
KillProgram(ClassName, nil).
Компилятор не позволяет передать nil в переменную типа String.
Итак, я изменил объявление
KillProgram(ClassName: string; WindowTitle: string)
на
KillProgram(ClassName: PChar; WindowTitle: PChar),
вот теперь функция действительно может завершить любое приложение, если вы не знаете
ClassName или WindowTitle этого приложения.

Взято с Исходников.ru

Убрать зазубринки при рисовании линий

При рисовании линии, особенно под маленьким углом, хорошо различимы отдельные точки. Для устранения этого недостатка я использую уменьшение изображения, как в предыдущем совете.

procedureTForm1.Button1Click(Sender: TObject);
var
  x, y: integer;
  i, j: integer;
  r, g, b: integer;
begin
  Form1.Canvas.Pen.Width := 10;
  Form1.Canvas.MoveTo(10, 10);
  Form1.Canvas.LineTo(90, 20);
  for y := 0 to 10 do
  begin
    for x := 0 to 25 do
    begin
      r := 0;
      for i := 0 to 3 do
        for j := 0 to 3 do
          r := r + GetRValue(Form1.Canvas.Pixels[4*x+i, 4*y+j]);
      r := round(r / 16);
      g := 0;
      for i := 0 to 3 do
        for j := 0 to 3 do
          g := g + GetGValue(Form1.Canvas.Pixels[4*x+i, 4*y+j]);
      g := round(g / 16);
      b := 0;
      for i := 0 to 3 do
        for j := 0 to 3 do
          b := b + GetBValue(Form1.Canvas.Pixels[4*x+i, 4*y+j]);
      b := round(b / 16);
      Form1.Canvas.Pixels[x,y+50] := RGB(r, g, b)
    end;
    Application.ProcessMessages;
  end;
end;

Взято из

Убывающий индекс

Table1.AddIndex('NewIndex','CustNo;CustName', [ixDescending]);

Взято из

Удаление большого количества записей

Судя по письмам в конференции fido7.su.dbms.interbase, существует определенный процент (около 15) задач, которые требуют периодического удаления большого количества записей. Это либо просто чистка устаревшей информации, либо перенос части данных в архив, но почти всегда - выполнение операции DELETE FROM... над количеством записей от десятков и сотен тысяч до нескольких миллионов.

При отсутствии знаний по архитектуре InterBase такая операция действительно становится проблемой. Если DELETE проходит относительно быстро, то последующие операции выборки могут "встать" на длительный период времени (возможно часы или даже десятки часов), во время которого InterBase будет интенсивно обращаться к базе данных.

Для начала нужно разобраться, что же происходит при операции DELETE. А происходит вот что - в силу архитектуры многоверсионности записей удаление записей не приводит к их действительному удалению. Просто рядом с версией записи пишется ее новая версия, но без значений полей, а с индикатором удаления. При этом, понятно, занимаемое таблицей дисковое пространство (количество страниц) может увеличиться, хотя на первый взгляд это кажется парадоксальным. (подробнее о сборке мусора и многоверсионности см. список статей внизу).

Далее, в силу уже правил сборки мусора, записи будут реально удалены (удалены предыдущие версии и delete-stub) только при попытке чтения этих записей. Пока никто к ним не обратился - устаревшие записи с диска вычищены не будут.
Итак, после массового удаления даем SELECT COUNT(*)..., возможно с тем же условием что и DELETE, для "вычистки" удаленных записей. Разумеется, результат этого запроса будет равен нулю, т.к. записей нет. Но "мусорные" записи будут собраны. Причем процесс сборки мусора будет никак не быстрее, чем время выполнения DELETE, а зачастую и много дольше (отчасти и потому, что старых версий записей была не одна, а несколько). Лучше всего select count выполнять в следующей после удаления транзакции.

Но самое большое влияние на скорость чистки удаленных записей оказывают неуникальные индексы. В качестве пояснения и примера лучше процитировать одно из писем Анны Харрисон (ныне директор IBPhoenix) на эту тему:
"Если возможно, посмотрите статистику сервера (gstat или Server Manager). Найдите индексы с наиболее длинными цепочками дубликатов у таблиц, которым предстоит пережить массовое удаление. Если цепочка больше 7000 строк (ключей) то стоимость сборки мусора будет меньше, если сделать индексы более селективными - например изменив одиночый индекс на композитный с оригинальным полем в качестве первого поля индекса и полем первичного ключа в качестве второго поля индекса.

Я попробовала удалить 20 тысяч записей из таблицы и собрать мусор - при записи небольшого размера и одном уникальном индексе (на очень медленном процессоре и антикварном винчестере) удаление заняло 47.54 секунды, а сборка мусора - 75.90 секунд (1 минута, 15.90 секунд). После этого я добавила индекс с 20000 дубликатов значений и после этого удаление заняло 38.04 секунды, но сборка мусора заняла 865.47 секунд (14 минут, 25.47 секунд).

Вот статистика запроса, который привел к сборке мусора в обоих случаях:
С уникальным индексом С дубликатами

·Elapsed time= 75.90 sec Elapsed time= 865.47 sec
·Reads = 1694 Reads = 1814
·Writes = 1499 Writes = 1732
·Fetches = 225,541 Fetches = 2,540,593

Обратите внимание на elapsed time и fetches - они отличаются более чем в 10 раз."
Харрисон дальше выводов не делает, кроме упомянутого в цитате изменения неуникального индекса. На самом деле зачастую (в зависимости от процентного соотношения записей которые удаляют, и которые остаются) бывает проще удалить или "выключить" этот неуникальный индекс.

Причем оказалось (спасибо Владимиру Мамзикову), что ALTER INDEX INACTIVE на самом деле не только удаляет индекс, оставляя его описание в базе данных, но и производит какие-то дополнительные действия. Эти действия тоже могут занять определенное время, причем чем больше дубликатов в индексе, тем больше времени это займет. DROP INDEX не производит этих "действий", и выполняется практически мгновенно.

Уже знакомые с IB могут спросить - а почему не был предложен способ backup/restore для избавления от мусора? Действительно, этим способом можно пользоваться (не забыв включить опцию Disable garbage collection), но при определенных размерах базы данных (несколько гигабайт) бывает выгоднее по скорости удалить индексы, чем делать backup restore.

Напоследок, немного данных по реальному проекту от Владимира Мамзикова:

·База данных - 1.5Гб, несколько таблиц с ~1 млн записей, одна таблица с 9 млн записей.
·Удаление ~4 млн записей (delete) - несколько минут
·Сборка мусора (4млн записей) select count - 20 и более часов
·Операция backup/restore (с disable garbage collection) - в сумме 15 минут
·Отключение неуникального индекса (alter index inactive) - 6 минут
·Сборка мусора (4млн записей) select count без индекса - 12 минут
·Удаление неуникального индекса (drop index) - несколько секунд (против 6 минут alter index inactive).

Разумеется, сюда не включено время активирования или повторного создания неуникального индекса. Но этот процесс в основном зависит от скорости винчестера, а кроме того, вероятно что количество оставшихся в таблице записей намного меньше, чем количество удаленных, поэтому индексирование пройдет быстро.

Взято из

Удаление HTML элементов из текста

Как-то раз пришлось решить задачу удаления из файла элементов HTML таких, как, например, ненужные ссылки, и в то эе время преобразования возврата каретки в HTML параграфы, знаков табуляции в пробелы и т.д. В результате соответственно должен был получиться новый HTML документ.
Следующие две процедуры показывают, как это можно сделать:

procedure TMainForm.LoadFileIntoList(TextFileName:String; AWebPage:TStringList; WithFilter:Boolean);
var CurrentFile : TStringList;
begin
   CurrentFile := TStringList.Create;
   CurrentFile.LoadFromFile(TextFileName);
   if WithFilter then
      FilterHTML(CurrentFile,AWebPage)
   else
      with AWebPage do AddStrings(CurrentFile);
   CurrentFile.Free;
end;

procedure TMainForm.FilterHTML(FilterInput, AWebPage:TStringList);
var
   i,j : LongInt;
   S   : String;
begin
   FilterMemo.Lines.Clear;
   FilterMemo.Lines := FilterInput;

   with AWebPage do
   begin
      FilterMemo.SelectAll;
      j := FilterMemo.SelLength;

      if j > 0 then
      begin
         i := 0;
         repeat
            if FilterMemo.Lines.GetText[i] = Char(VK_RETURN)      // ищем cr
            then S := S+'
'
            else if FilterMemo.Lines.GetText[i] = '<'
                 then repeat
                         inc(i);
                      until FilterMemo.Lines.GetText[i] = '>'
                 else if FilterMemo.Lines.GetText[i] = Char(VK_TAB)   // ищем tab
                      then S := S+'    '
                      else S := S+ FilterMemo.Lines.GetText[i];     // добавляем текст
            inc(i);
         until i = j+1;
         Add(S);     // добавляем строку в WebPage
      end else Add('No data entered into field.');   // no data in text file
   end;
end;

Применение функции:

Всё, что нужно сделать - это вызвать :
LoadFileIntoList("filename.txt",Webpage, True);

Где filename - это имя файла, который вы хотите обработать.
"WebPage" - это TStringList
последний параметр в функции указывает, применять или нет HTML-фильтр.

PS: В этом примере объект TMemo (который вызывается из "FilterMemo") лежит на форме и поэтому не видим.

WebPage := TStringList.Create;
   try
      Screen.Cursor := crHourGlass;
      AddHeader(WebPage);
      with WebPage do
      begin
         Add('Personal Details');
         LoadFileIntoList("filename.txt",Webpage, True);
      end;
      AddFooter(WebPage);
   finally
      WebPage.SaveToFile(HTMLFileName);
      WebPage.Free;
      Screen.Cursor := crDefault;
   end;

Взято с Исходников.ru

Удаление каталога с подкаталогами

Способ 1: проход по дереву каталогов

(Функция для удаления каталогов, взята из рассылки "Мастера DELPHI. Новости мира компонент, FAQ, статьи..." - собственно код аналогичен написанному мной коду по рекурсивному проходу каталогов )

Function MyRemoveDir(sDir : String) : Boolean;
var
iIndex : Integer;
SearchRec : TSearchRec;
sFileName : String;
begin
Result := False;
sDir := sDir + '\*.*';
iIndex := FindFirst(sDir, faAnyFile, SearchRec);
while iIndex = 0 do
begin
sFileName := ExtractFileDir(sDir)+'\'+SearchRec.Name;
if SearchRec.Attr = faDirectory then
begin
if (SearchRec.Name <> '' ) and (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then MyRemoveDir(sFileName);
end
else
begin
if SearchRec.Attr <> faArchive then FileSetAttr(sFileName, faArchive);
if NOT DeleteFile(sFileName) then ShowMessage('Could NOT delete ' + sFileName);
end;
iIndex := FindNext(SearchRec);
end;
FindClose(SearchRec);
RemoveDir(ExtractFileDir(sDir));
Result := True;
end;

Способ 2: Использование ShellApi

uses ShellApi;
...
var sh : SHFILEOPSTRUCT;
begin
...
sh.Wnd := Application.Handle;
sh.wFunc := FO_DELETE;
sh.pFrom := 'c:\\test\0';
sh.pTo := nil;
sh.fFlags := FOF_NOCONFIRMATION or FOF_SILENT;
sh.hNameMappings := nil;
sh.lpszProgressTitle := nil;

SHFileOperation (sh);
...

Надо путь писать : c:\\test\dfg
Чтобы вначале "\\" было...иначе не будет удалять диры из корня

Автор ответа: Baa
Взято с Vingrad.ru