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

begin

FFormat := fmt;

OpenClipboard(0);

FHandle := GetClipboardData(FFormat);

FSize := GlobalSize(FHandle);

FMemory := AllocMem(FSize);

tmp := GlobalLock(FHandle);

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);

GetMem(lpszFile, SizeName+1);

DragQueryFile(hDrop, i, lpszFile, SizeName+1);

lb.Items.Add(lpszFile);

FreeMem(lpszFile, SizeName+1);

end;

DragFinish(hDrop);

end;

procedureTForm1.FormCreate(Sender: TObject);

begin

DragAcceptFiles(Handle,True);

end;

procedureTForm1.Button1Click(Sender: TObject);

begin

lb.Items.Clear;

end;

procedureTForm1.Button2Click(Sender: TObject);

begin

ShellAbout(Handle, 'Anton Saburov', 'APSystems', 0);

end;

end.

Рабочий стол перекрыт сверху компонентом ListView. Вам просто необходимо взять хэндл этого органа управления. Пример:

functionGetDesktopListViewHandle: THandle;

varS: String;

begin

Result := FindWindow('ProgMan', nil);

Result := GetWindow(Result, GW_CHILD);

Result := GetWindow(Result, GW_CHILD);

SetLength(S, 40);

GetClassName(Result, PChar(S), 39);

ifPChar(S) <> 'SysListView32' thenResult := 0;

end;

После того, как Вы взяли тот хэндл, Вы можете использовать API этого ListView, определенный в модуле CommCtrl, для того, чтобы манипулировать рабочим столом. Смотрите тему «LVM_xxxx messages» в оперативной справке по Win32.

К примеру, следующая строка кода:

ListView_SetItemPosition(GetDesktopListViewHandle, i, x, y); {Не забудьте в uses добавить CommCtrl}

ярлыку с индексом i, задаст координаты (x,y). К примеру Мой компьютер имеет индекс 0, т.е i:=0;

С наилучшими пожеланиями, Сергей.

E-mail: ssa_sss@mail.ru

Nomadicдополняет:

К примеру, следующая строка кода:

SendMessage(GetDesktopListViewHandle, LVM_ALIGN, LVA_ALIGNLEFT, 0);

разместит иконки рабочего стола по левой стороне рабочего стола Windows.

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

Сперва Вы должны взять хэндл курсора Windows и присвоить его одному из элементов массива Cursors обьекта Screen.

Предопределенные курсоры имеют отрицательный индекс, а определенные пользователем (Вами) курсоры получают положительные индексы.