Отправляет email-рассылки с помощью сервиса Sendsay

KLSoft company - программирование в Delphi и PHP

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Веб-разработка: пособие начинающим" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Январь 2005   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
12.01.2005
10:14:22
10:16:41
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Автор
ADMIN

Статистика

989 подписчиков
0 за неделю
←   Все выпуски   →

X-Program ПО, новости сайта и программирование в Delphi7


Информационный Канал Subscribe.Ru
Выпуск 32

Как с нами связаться:
E-Mail
X-Program@mail.ru
SMS
+79046560786
ICQ
322284039
Форум по Delphi
http://narod.yandex.ru/userforum/?owner=x-program
Наш сайт
http://www.x-program.narod.ru


НОВОСТИ
***
12.01.05
Сегодня у нас несколько новостей:
>Обновился сайт. Советую всем зайти и посмотреть. Отправить коментарии
>Мы хотим создать базу по всем выпускам рассылки. Напишите нам, что Вы об этом думаете. Отправить коментарии
>Почему нет вопросов по Delphi? Вопросы мы принимали и будем принимать, так что отправляйте. Отправить вопрос


Сегодня в выпуске:
1. Просмотр буфера обмена
2. Показ иконки зарегистрированного расширения
3. Как мне подсчитать занимаемое директорией место?
4. Быстрое копирование файла


Просмотр буфера обмена
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.


Показ иконки зарегистрированного расширения
{процедура показывает иконку в заголовке окна, используемую для, интерисующего вас, зарегистрированного расширения файла}
{Не забудьте - ShellAPI поместить в uses}

procedure ShowIcon;
var
W : Word;
begin
W := 0;
Form1.Icon.Handle := {изображение иконки вы увидите в заголовке окна}
{можно, конечно, посмотреть его и в TImage: для этого вместо "Form1.Icon.Handle" напишите "Image1.Picture.Icon.Handle"}
ExtractAssociatedIcon(HInstance,
Pchar('c:\windows\*.txt'{узнаем, например, какая иконка
используется для текстового файла.
вы можете указать конкретный файл с любым расширением}), W);
end;


Как мне подсчитать занимаемое директорией место?
Попробуйте следующий код (он просматривает скрытые, системные, архивные и нормальные файлы, использует рекурсивный алгоритм для просмотра всех вложенных поддиректорий: достаточно указать
стартовый каталог и функция возвратит результат в переменной DirBytes, имейте в виду, что для определения типа (файл или директория) код использует функции FileExists и DirectoryExists вместо просмотра атрибутов файла.
Причина этого проста - при просмотре CD-ROM функции FindFirst и FindNext иногда заявляют, что файл является каталогом.
В коде я обошел эту ошибку. Возвращаемая размерность - байты.):
 var
DirBytes : integer;

function TFileBrowser.DirSize(Dir:string):integer;
var
SearchRec : TSearchRec;
Separator : string;
begin
if Copy(Dir,Length(Dir),1)='\' then
Separator := ''
else
Separator := '\';
if FindFirst(Dir+Separator+'*.*',faAnyFile,SearchRec) = 0 then begin
if FileExists(Dir+Separator+SearchRec.Name) then begin
DirBytes := DirBytes + SearchRec.Size;
{Memo1.Lines.Add(Dir+Separator+SearchRec.Name);}
end else if DirectoryExists(Dir+Separator+SearchRec.Name) then begin
if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then begin
DirSize(Dir+Separator+SearchRec.Name);
end;
end;
while FindNext(SearchRec) = 0 do begin
if FileExists(Dir+Separator+SearchRec.Name) then begin
DirBytes := DirBytes + SearchRec.Size;
{Memo1.Lines.Add(Dir+Separator+SearchRec.Name);}
end else if DirectoryExists(Dir+Separator+SearchRec.Name) then
begin
if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then begin
DirSize(Dir+Separator+SearchRec.Name);
end;
end;
end;
end;
FindClose(SearchRec);
end;


Быстрое копирование файла
procedure CopyFile( Source, Dest : string );
var
SrcFile : Integer;
DestFile : Integer;
S : string;
RetCode : Longint;
OpenFileBuf : TOFStruct;
FName : array[ 0..255 ] of Char;
begin
StrPCopy( FName, Source );
SrcFile := LZOpenFile( FName, OpenFileBuf, of_Read );
StrPCopy( FName, Dest );
DestFile := LZOpenFile( FName, OpenFileBuf, of_Create );
RetCode := LZCopy( SrcFile, DestFile );
if RetCode >= 0 then
begin
LZClose( SrcFile );
LZClose( DestFile );
end
else
begin
Str( RetCode, S );
MessageDlg( 'Не могу скопировать ' + Source + ' в ' +
Dest + #13 + 'Код ошибки = ' + S, mtError, [mbOk], 0 );
end;
end;


Теперь Вы тоже можете присылать свои статьи! Прислать статью
http://subscribe.ru/
http://subscribe.ru/feedback/		 Подписан адрес:
Код этой рассылки: comp.soft.prog.program		 Отписаться
В избранное