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

MoveMemory(FMemory, tmp, FSize);

GlobalUnlock(FHandle);

FPosition := 0;

CloseClipboard;

end;

destructorTClipboardStream.Destroy;

begin

FreeMem(FMemory);

end;

functionTClipboardStream.Read( varBuffer; Count : longint) : longint;

begin

ifFPosition + Count > FSize thenResult := FSize - FPosition

elseResult := Count;

MoveMemory(@Buffer, PChar(FMemory) + FPosition, Result);

Inc(FPosition, Result);

end;

functionTClipboardStream.Write( constBuffer; Count : longint) : longint;

var

FHandle : HGlobal;

tmp : pointer;

begin

ReallocMem(FMemory, FPosition + Count);

MoveMemory(PChar(FMemory) + FPosition, @Buffer, Count);

FPosition := FPosition + Count;

FSize := FPosition;

FHandle := GlobalAlloc(GMEM_MOVEABLE orGMEM_SHARE orGMEM_ZEROINIT, FSize);

try

tmp := GlobalLock(FHandle);

try

MoveMemory(tmp, FMemory, FSize);

OpenClipboard(0);

SetClipboardData(FFormat, FHandle);

finally

GlobalUnlock(FHandle);

end;

CloseClipboard;

except

GlobalFree(FHandle);

end;

Result := Count;

end;

functionTClipboardStream.Seek(Offset : Longint; Origin : Word) : Longint;

begin

caseOrigin of

0 : FPosition := Offset;

1 : Inc(FPosition, Offset);

2 : FPosition := FSize + Offset;

end;

Result := FPosition;

end;

end.

Как мне сохранить свойство шрифта Style, ведь он же набор?

Вы можете получать и устанавливать FontStyle через его преобразование к типу byte.

Для примера,

VarStyle: TFontStyles;

begin

{ Сохраняем стиль шрифта в байте }

Style := Canvas.Font.Style; {необходимо, поскольку Font.Style – свойство}

ByteValue := Byte(Style);

{ Преобразуем значение byte в TFontStyles }

Canvas.Font.Style := TFontStyles(ByteValue);

end;

Для восстановления шрифта, вам необходимо сохранить параметры Color, Name, Pitch, Style и Size в базе данных и назначить их соответствующим свойствам при загрузке.

– Robert Wittig

{

Данный код изменяет стиль шрифта поля редактирования,

если оно выбрано. Может быть адаприрован для управления

шрифтами в других объектах.

Расположите на форме Edit(Edit1) и ListBox(ListBox1).

Добавьте следующие элементы (Items) к ListBox:

fsBold

fsItalic

fsUnderLine

fsStrikeOut

}

procedureTForm1.ListBox1Click(Sender: TObject);

varX: Integer;

typeTLookUpRec = record

Name: String;

Data: TFontStyle;

end;

constLookUpTable: array[1..4] ofTLookUpRec = (

(Name: 'fsBold'; Data: fsBold),

(Name: 'fsItalic'; Data: fsItalic),

(Name: 'fsUnderline'; Data: fsUnderline),

(Name: 'fsStrikeOut'; Data: fsStrikeOut));

begin

X := ListBox1.ItemIndex;

Edit1.Text := ListBox1.Items[X];

Edit1.Font.Style := [LookUpTable[ListBox1.ItemIndex+1].Data];

end;

Из советов Nomadic'a:

Развлекался когда-то — вот, осталось:

unitUnit1;

interface

usesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ShellAPI, Grids, StdCtrls;

typeTForm1 = class(TForm)

lb: TListBox;

Memo1: TMemo;

Button1: TButton;

Button2: TButton;

procedureFormCreate(Sender: TObject);

procedureButton1Click(Sender: TObject);

procedureButton2Click(Sender: TObject);

private

procedureWMDropFiles( varM: TMessage); messageWM_DROPFILES;

{ Private declarations }

public

{ Public declarations }

end;

varForm1: TForm1;

implementation

Var

CountFiles: integer;

SizeName : integer;

cch : integer;

Var

hDrop: integer;

Point: TPoint;

lpszFile: PChar;

{$R *.DFM}

procedureTForm1.WMDropFiles( varM: TMessage);

Vari: integer;

begin

hDrop:= M.WParam;

DragQueryPoint(hDrop, Point);

CountFiles:= DragQueryFile(hDrop, $FFFFFFFF, nil, cch);

fori:=0 toCountFiles-1 do begin

SizeName:= DragQueryFile(hDrop, i, nil, cch);