Валентин Озеров - Советы по Delphi. Версия 1.0.6 Страница 16

Операционная система

Буфер обмена

Просмотр буфера обмена

Пример на основе простого модуля-класса, осуществляющего просмотр буфера обмена.

unit ClipboardViewer;

interface

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

type TForm1 = class(tform)

 procedure FormCreate(Sender: TObject);

 procedure FormDestroy(Sender: TObject);

private

 FNextViewerHandle : THandle;

 procedure WMDrawClipboard(var message: TMessage); message WM_DRAWCLIPBOARD;

 procedure WMChangeCBCHain(var message: TMessage); message WM_CHANGECBCHAIN;

public

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

 // Проверяем работоспособность функции.

 // При невозможности просмотра буфера обмена

 // функция возвратит значение Nil.

 FNextViewerHandle:= SetClipboardViewer(Handle);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

 // Восстанавливаем цепочки.

 ChangeClipboardChain(Handle, FNextViewerHandle);

end;

procedure TForm1.WMDrawClipboard(var message: TMessage);

begin

 // Вызывается при любом изменении содержимого буфера обмена

 message.Result := SendMessage(WM_DRAWCLIPBOARD, FNextViewerHandle, 0, 0);

end;

procedure TForm1.WMChangeCBCHain(var message: TMessage);

begin

 // Вызывается при любом изменении цепочек буфера обмена.

 if message.wParam = FNextViewerHandle then begin

  // Удаляем следующую цепочку просмотра. Корректируем внутреннюю переменную.

  FNextViewerHandle:= message.lParam;

  // Возвращаем 0 чтобы указать, что сообщение было обработано

  message.Result:= 0;

 end else begin

  // Передаем сообщение следующему окну в цепочке.

  message.Result:= SendMessage(FNextViewerHandle, WM_CHANGECBCHAIN, message.wParam, message.lParam);

 end;

end;

end.

Копирование в буфер обмена

Две вспомогательных процедуры:

procedure CopyButtonClick(Sender: TObject);

begin

 If ActiveControl is TMemo then TMemo(ActiveControl).CopyToClipboard;

 If ActiveControl is TDBMemo then TDBMemo(ActiveControl).CopyToClipboard;

 If ActiveControl is TEdit then TEdit(ActiveControl).CopyToClipboard;

 If ActiveControl is TDBedit then TDBedit(ActiveControl).CopyToClipboard;

end;

procedure PasteButtonClick(Sender: TObject);

begin

 If ActiveControl is TMemo then TMemo(ActiveControl).PasteFromClipboard;

 If ActiveControl is TDBMemo then TDBMemo(ActiveControl).PasteFromClipboard;

 If ActiveControl is TEdit then TEdit(ActiveControl).PasteFromClipboard;

 If ActiveControl is TDBedit then TDBedit(ActiveControl).PasteFromClipboard;

end;

Форма как графический объект

Каким образом можно скопировать форму в буфер обмена в виде графического изображения?

uses clipbrd;

procedure TShowVRML.Kopieren1Click(Sender: TObject);

var bitmap:tbitmap;

begin

 bitmap:=tbitmap.create;

 bitmap.width:=clientwidth;

 bitmap.height:=clientheight;

 try

  with bitmap.Canvas do CopyRect (clientrect,canvas,clientrect);

  clipboard.assign(bitmap);

 finally

  bitmap.free;

 end;

end;

Компоненты

BitBtn

Смена иконки BitBtn во время работы приложения

Иконка компонента является инкапсулированным объектом, требующим для хранения изображения некоторый участок памяти. Следовательно, при замене иконки, память, связанная с первоначальной иконкой, должна возвратиться в кучу, а для новой иконки требуется новое распределение памяти. По правилам Delphi, этим должен заниматься метод "Assign". Ниже приведен код всей процедуры замены иконки.

implementation

{$R *.DFM}

var n: integer;  // При инициализации программы данное значение будет равным нулю

procedure TForm1.Button1Click(Sender: TObject);

var Image: TBitmap;

begin // Изменение иконки в bitbtn1

 Image:= TBitmap.Create;

 if n < ImageList1.Count then ImageList1.GetBitmap(n, Image); {end if}

 BitBtn1.Glyph.Assign(Image)   // Примечание: Для изменения свойств объекта используется метод Assign

 inc(n,2); // В данный момент кнопка содержит две иконки!

 if n > ImageList1.Count then n:= 0; {end if}

 Image.Free;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin // добавляем новую иконку кнопки в список imagelist1

 if OpenDialog1.Execute then ImageList1.FileLoad(rtBitMap,OpenDialog1.FileName,clBtnFace);

 label1.Caption:=  'Количество иконок = ' + IntToStr(ImageList1.Count);

end;

DBGrid

Использование опции MultiSelect в DBGRID

Есть пример в Delphi Technical Information… Его можно посмотреть по адресу http://loki.borland.com/winbin/bds.exe?getdoc+2976+Delphi

{*

 Данный пример позволяет производить множественный выбор записей

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

 набора данных.

 Метод DisableControls применяется для того, чтобы

 DBGrid не обновлялся во время изменения набора данных.

 Последняя позиция набора данных сохраняется как

 TBookmark.

 Метод IndexOf вызывается для проверки

 существования закладки.

 Решение использовать метод IndexOf, а не метод

 Refresh должно определяться

 спецификой приложения.

*}

procedure TForm1.SelectClick(Sender: TObject);

var

 x: word;

 TempBookmark: TBookMark;

begin

 DBGrid1.Datasource.Dataset.DisableControls;

 with DBgrid1.SelectedRows do if Count  <> 0 then begin

  TempBookmark:= DBGrid1.Datasource.Dataset.GetBookmark;

  for x:= 0 to Count - 1 do begin

   if  IndexOf(Items[x]) > –1 then begin

    DBGrid1.Datasource.Dataset.Bookmark:= Items[x];

    showmessage(DBGrid1.Datasource.Dataset.Fields[1].AsString);

   end;

  end;

 end;

 DBGrid1.Datasource.Dataset.GotoBookmark(TempBookmark);

 DBGrid1.Datasource.Dataset.FreeBookmark(TempBookmark);

 DBGrid1.Datasource.Dataset.EnableControls;

end;

Edit

Массив Edit-компонентов

Procedure DoSomethingWithEditControls;

Var K: Integer;

 EditArray: Array[0..99] of Tedit;

begin

 Try

  For  K:= 0 to 99 do begin

   EditArray[K]:= TEdit.Create(Self);

   EditArray[K].Parent:= Self;

   SetSomeOtherPropertiesOfTEdit; {Устанавливаем необходимые свойства TEdit}

   Left:= 100; Top:= K*10;

   OnMouseMove:= WhatToDoWhenMouseIsMoved; {Что-то делаем при перемещении мыши}

  end;

  DoWhateverYouWantToDoWithTheseEdits; {Делаем все что хотим с полученным массивом Edit-компонентов}

 Finally

 For K:= 0to 99do EditArray[K].Free;

end;

Примечание: узнать доступные свойства компонента можно непосредственно в инспекторе объектов и (или) в текстовом режиме вашей формы (щелкните на форме правой кнопкой мыши и выберите пункт View as Text)

Label

3D-рамка для текстовых компонентов

Один из примеров создания текстового компонента с трехмерной декоративной контурной рамкой (для создания компонента потребовалось около получаса. Он демонстрирует только принцип получения рамки. Я не стал колдовать над свойствами типа ParentFont…, т.к. это заняло бы еще немало времени и места).

unit IDSLabel;

interface

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

type TIDSLabel = class(TBevel)

private

 { Private declarations }

 FAlignment: TAlignment;

 FCaption: String;

 FFont: TFont;

 FOffset: Byte;

 FOnChange: TNotifyEvent;

 procedure SetAlignment(taIn : TAlignment);

 procedure SetCaption(const strIn: String);

 procedure SetFont(fntNew: TFont);

 procedure SetOffset(bOffNew: Byte);

protected

{ Protected declarations }

 constructor Create(compOwn: TComponent); override;

 destructor Destroy; override;

 procedure Paint; override;

public

{ Public declarations }

published

{ Published declarations }

 property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;

 property Caption: String read FCaption write SetCaption;

 property Font: TFont read FFont write SetFont;

 property Offset: Byte read FOffset write SetOffset;

 property OnChange: TNotifyEvent read FOnChange write FOnChange;

end;

implementation

constructor TIDSLabel.Create;

begin

 inherited Create(compOwn);

 FFont:= TFont.Create;

 with compOwn as TForm do FFont.Assign(Font);

 Offset:= 4;

 Height:= 15;

end;

destructor TIDSLabel.Destroy;

begin

 FFont.Free;

 inherited Destroy;