Рассылка компании "X-program"
Delphi7
Выпуск 36

Новости

1)В нашем форуме есть вопросы на которые ещё НЕ ОТВЕТИЛИ. Заходите в форум, читайте, отвечайте и задавайте свои вопросы.
2)Теперь в каждом выпуске мы будем выкладывать часть функций API.
3)В MagDate TheEnd уже готова системма настройки дизайна. Настроить можно буквально всё! Примерная дата выхода программы 31.01.2005 Напишите нам что бы Вы хотели увидеть в MagDate TheEnd. Написать

Вопросы

Здравствуйте, x-program.
Как обработать ошибку подключения компонента idTelnet???? Ответить

I) Как программно (видимо, используя API) щелкнуть по TGauge [Gauges]
а) левой кнопкой мыши для выполнения OnClick;
б) правой кнопкой мыши для раскрытия PopupMenu с выбором возможных пунктов.
II) Раскажите про кнопку "Пуск" в ХР. В плане - в каком файле находится, из каких составных
частей состоит (вероятно надпись и картинка - это части), можно ли изменить фон цвета
самой кнопки. Ответить

Здравствуйте, X-Program.
1-Предположим, что у меня в проекте две формы (Form1 и Form2).Как сделать, чтобы они открывались в одном и том же окне?
2-Как сделать кнопку ссылкой на какой-то файл или папку?
3-Как запретить изменение размера окна? Ответить

Здравствуйте! Где в интернете можно скачать стандартный набор Delphi7 и сколько он весит (в MB, конечно)?! Ответить

Ответы

X-Program

HELLO!
Я думаю, что можно сделать вот так.

Коннект:
try
IdTelnet1.Connect;
except
showmessaeg('Подключились!')
else
showmessage('Ошибочка вышла.');
end;

Дисконнект:
IdTelnet1.Disconnect;

Приём данных:
procedure TForm1.IdTelnet1DataAvailable(Buffer: String);
begin
Form1.Caption:=buffer;
end;

DENIS

2. Чтобы сделать ссылку на директорию надо во-первых в uses добавить ShellAPI и написать следующее:
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(Application.Handle,'open','c:\\',nil,nil,SW_SHOWDEFAULT);
end;

чтобы сделать ссылку на файл, то же самое, но в этом случае файл откроется в приложении, с которым стоит ассоциация расширения:
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(Application.Handle,'open','c:\\1.txt',nil,nil,SW_SHOWDEFAULT);
end;

3. Чтобы у окна нельзя было изменить размеры, достаточно вытавить параметр у формы
BorderStyle - bsSingle или программно BorderStyle:=bsSingle

3. Form.BorderStyle:=bsSingle;

X-Program

Привет!
Отвечаю на первую часть вопроса.
Значит есть две формы Form1 и Form2. Создаём ещё одну форму, допустим Form3. Где-нибудь пишем
Form1.Parent:=Form3;
Form2.Parent:=Form3;
Всё. Form1 и Form2 окажутся внутри Form3.

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
ClientSocket1: TClientSocket;
ServerSocket1: TServerSocket;
Button1: TButton;
procedure Image1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
private
{ Private declarations }
Reciving: boolean;
DataSize: integer;
Data: TMemoryStream;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Image1Click(Sender: TObject);
begin
// Это процедура для открытия сокета на ПРИЁМ (RECEIVING).
ClientSocket1.Active:= true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
// Открытие ОТПРАВЛЯЮЩЕГО (SENDING) сокета.
ServerSocket1.Active:= true;
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
// Посылаем команду для начала передачи файла.
Socket.SendText('send');
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
s, sl: string;
begin
s:= Socket.ReceiveText;
// Если мы не в режиме приёма:
if not Reciving then
begin
// Теперь нам необходимо получить длину потока данных.
SetLength(sl, StrLen(PChar(s))+1); // +1 for the null terminator
StrLCopy(@sl[1], PChar(s), Length(sl)-1);
DataSize:= StrToInt(sl);
Data:= TMemoryStream.Create;
// Удаляем информацию о размере из данных.
Delete(s, 1, Length(sl));
Reciving:= true;
end;
// Сохраняем данные в файл, до тех пор, пока не получим все данные.
try
Data.Write(s[1], length(s));
if Data.Size = DataSize then
begin
Data.Position:= 0;
Image2.Picture.Bitmap.LoadFromStream(Data);
Data.Free;
Reciving:= false;
Socket.Close;
end;
except
Data.Free;
end;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
ms: TMemoryStream;
begin
// Клиент получает команду на передачу файла.
if Socket.ReceiveText = 'send' then
begin
ms:= TMemoryStream.Create;
try
// Получаем данные на передачу.
Image1.Picture.Bitmap.SaveToStream(ms);
ms.Position:= 0;
// Добавляем длину данных, чтобы клиент знал, сколько данных будет передано
// Добавляем #0 , чтобы можно было определить, где заканчивается информация о размере.
Socket.SendText(IntToStr(ms.Size) + #0);
// Посылаем его.
Socket.SendStream(ms);
except
// Итак, осталось освободить поток, если что-то не так.
ms.Free;
end;
end;
end;

end.

var
Computer: Array[1..500] of String[25];
ComputerCount: Integer;

procedure FindAllComputers(Workgroup: String);
Var
EnumHandle: THandle;
WorkgroupRS: TNetResource;
Buf: Array[1..500] of TNetResource;
BufSize: Integer;
Entries: Integer;
Result: Integer;

begin
ComputerCount := 0;
Workgroup := Workgroup + #0;
FillChar(WorkgroupRS, SizeOf(WorkgroupRS), 0);
With WorkgroupRS do begin
dwScope := 2;
dwType := 3;
dwDisplayType := 1;
dwUsage := 2;
lpRemoteName := @Workgroup[1];
end;

WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @WorkgroupRS, EnumHandle);

Repeat
Entries := 1;
BufSize := SizeOf(Buf);

Result :=
WNetEnumResource(EnumHandle, Entries, @Buf, BufSize);
If (Result = NO_ERROR) and (Entries = 1) then begin
Inc( ComputerCount );
Computer[ ComputerCount ] := StrPas(Buf[1].lpRemoteName);
end;
Until (Entries <> 1) or (Result <> NO_ERROR);

WNetCloseEnum(EnumHandle);
end;

uses
ComObj, Outlook_TLB;

procedure TForm1.Button1Click(Sender: TObject);
var
MSOutlook, MyNameSpace, MyFolder, MyItem: Variant;
s: string;
i: Integer;
begin
try
MSOutlook := CreateOleObject('Outlook.Application');
MyNameSpace := MSOutlook.GetNameSpace('MAPI');
MyFolder := MyNamespace.GetDefaultFolder(olFolderContacts);
for i := 1 to MyFolder.Items.Count do
begin
s := s + #13#13'Contact No: ' + IntToStr(i) + #13#13;
MyItem := MyFolder.Items[i];
s := s + 'BillingInformation: ' + MyItem.BillingInformation + #13;
s := s + 'Body: ' + MyItem.Body + #13;
s := s + 'Categories: ' + MyItem.Categories + #13;
s := s + 'Companies: ' + MyItem.Companies + #13;
s := s + 'CreationTime: ' + DateTimeToStr(MyItem.CreationTime) + #13;
s := s + 'EntryID: ' + MyItem.EntryID + #13;
s := s + 'Importance: ' + IntToStr(MyItem.Importance) + #13;
s := s + 'LastModificationTime: ' + DateTimeToStr(MyItem.LastModificationTime) + #13;
s := s + 'MessageClass: ' + MyItem.MessageClass + #13;
s := s + 'Mileage: ' + MyItem.Mileage + #13;
s := s + 'NoAging: ' + IntToStr(MyItem.NoAging) + #13;
s := s + 'OutlookVersion: ' + MyItem.OutlookVersion + #13;
s := s + 'Saved: ' + IntToStr(MyItem.Saved) + #13;
s := s + 'Sensitivity: ' + IntToStr(MyItem.Sensitivity) + #13;
s := s + 'Size: ' + IntToStr(MyItem.Size) + #13;
s := s + 'Subject: ' + MyItem.Subject + #13;
s := s + 'UnRead: ' + IntToStr(MyItem.UnRead) + #13;
s := s + 'Account: ' + MyItem.Account + #13;
s := s + 'Anniversary: ' + DateTimeToStr(MyItem.Anniversary) + #13;
s := s + 'AssistantName: ' + MyItem.AssistantName + #13;
s := s + 'AssistantTelephoneNumber: ' + MyItem.AssistantTelephoneNumber + #13;
s := s + 'Birthday: ' + DateTimeToStr(MyItem.Birthday) + #13;
s := s + 'Business2TelephoneNumber: ' + MyItem.Business2TelephoneNumber + #13;
s := s + 'BusinessAddress: ' + MyItem.BusinessAddress + #13;
s := s + 'BusinessAddressCity: ' + MyItem.BusinessAddressCity + #13;
s := s + 'BusinessAddressCountry: ' + MyItem.BusinessAddressCountry + #13;
s := s + 'BusinessAddressPostalCode: ' + MyItem.BusinessAddressPostalCode + #13;
s := s + 'BusinessAddressPostOfficeBox: ' + MyItem.BusinessAddressPostOfficeBox + #13;
s := s + 'BusinessAddressState: ' + MyItem.BusinessAddressState + #13;
s := s + 'BusinessAddressStreet: ' + MyItem.BusinessAddressStreet + #13;
s := s + 'BusinessFaxNumber: ' + MyItem.BusinessFaxNumber + #13;
s := s + 'BusinessHomePage: ' + MyItem.BusinessHomePage + #13;
s := s + 'BusinessTelephoneNumber: ' + MyItem.BusinessTelephoneNumber + #13;
s := s + 'CallbackTelephoneNumber: ' + MyItem.CallbackTelephoneNumber + #13;
s := s + 'CarTelephoneNumber: ' + MyItem.CarTelephoneNumber + #13;
s := s + 'Children: ' + MyItem.Children + #13;
s := s + 'CompanyAndFullName: ' + MyItem.CompanyAndFullName + #13;
s := s + 'CompanyMainTelephoneNumber: ' + MyItem.CompanyMainTelephoneNumber + #13;
s := s + 'CompanyName: ' + MyItem.CompanyName + #13;
s := s + 'ComputerNetworkName: ' + MyItem.ComputerNetworkName + #13;
s := s + 'CustomerID: ' + MyItem.CustomerID + #13;
s := s + 'Department: ' + MyItem.Department + #13;
s := s + 'Email1Address: ' + MyItem.Email1Address + #13;
s := s + 'Email1AddressType: ' + MyItem.Email1AddressType + #13;
s := s + 'Email1DisplayName: ' + MyItem.Email1DisplayName + #13;
s := s + 'Email1EntryID: ' + MyItem.Email1EntryID + #13;
s := s + 'Email2Address: ' + MyItem.Email2Address + #13;
s := s + 'Email2AddressType: ' + MyItem.Email2AddressType + #13;
s := s + 'Email2DisplayName: ' + MyItem.Email2DisplayName + #13;
s := s + 'Email2EntryID: ' + MyItem.Email2EntryID + #13;
s := s + 'Email3Address: ' + MyItem.Email3Address + #13;
s := s + 'Email3AddressType: ' + MyItem.Email3AddressType + #13;
s := s + 'Email3DisplayName: ' + MyItem.Email3DisplayName + #13;
s := s + 'Email3EntryID: ' + MyItem.Email3EntryID + #13;
s := s + 'FileAs: ' + MyItem.FileAs + #13;
s := s + 'FirstName: ' + MyItem.FirstName + #13;
s := s + 'FTPSite: ' + MyItem.FTPSite + #13;
s := s + 'FullName: ' + MyItem.FullName + #13;
s := s + 'FullNameAndCompany: ' + MyItem.FullNameAndCompany + #13;
s := s + 'Gender: ' + IntToStr(MyItem.Gender) + #13;
s := s + 'GovernmentIDNumber: ' + MyItem.GovernmentIDNumber + #13;
s := s + 'Hobby: ' + MyItem.Hobby + #13;
s := s + 'Home2TelephoneNumber: ' + MyItem.Home2TelephoneNumber + #13;
s := s + 'HomeAddress: ' + MyItem.HomeAddress + #13;
s := s + 'HomeAddressCity: ' + MyItem.HomeAddressCity + #13;
s := s + 'HomeAddressCountry: ' + MyItem.HomeAddressCountry + #13;
s := s + 'HomeAddressPostalCode: ' + MyItem.HomeAddressPostalCode + #13;
s := s + 'HomeAddressPostOfficeBox: ' + MyItem.HomeAddressPostOfficeBox + #13;
s := s + 'HomeAddressState: ' + MyItem.HomeAddressState + #13;
s := s + 'HomeAddressStreet: ' + MyItem.HomeAddressStreet + #13;
s := s + 'HomeFaxNumber: ' + MyItem.HomeFaxNumber + #13;
s := s + 'HomeTelephoneNumber: ' + MyItem.HomeTelephoneNumber + #13;
s := s + 'Initials: ' + MyItem.Initials + #13;
s := s + 'ISDNNumber: ' + MyItem.ISDNNumber + #13;
s := s + 'JobTitle: ' + MyItem.JobTitle + #13;
s := s + 'Journal: ' + IntToStr(MyItem.Journal) + #13;
s := s + 'Language: ' + MyItem.Language + #13;
s := s + 'LastName: ' + MyItem.LastName + #13;
s := s + 'LastNameAndFirstName: ' + MyItem.LastNameAndFirstName + #13;
s := s + 'MailingAddress: ' + MyItem.MailingAddress + #13;
s := s + 'MailingAddressCity: ' + MyItem.MailingAddressCity + #13;
s := s + 'MailingAddressCountry: ' + MyItem.MailingAddressCountry + #13;
s := s + 'MailingAddressPostalCode: ' + MyItem.MailingAddressPostalCode + #13;
s := s + 'MailingAddressPostOfficeBox: ' + MyItem.MailingAddressPostOfficeBox + #13;
s := s + 'MailingAddressState: ' + MyItem.MailingAddressState + #13;
s := s + 'MailingAddressStreet: ' + MyItem.MailingAddressStreet + #13;
s := s + 'ManagerName: ' + MyItem.ManagerName + #13;
s := s + 'MiddleName: ' + MyItem.MiddleName + #13;
s := s + 'MobileTelephoneNumber: ' + MyItem.MobileTelephoneNumber + #13;
s := s + 'NickName: ' + MyItem.NickName + #13;
s := s + 'OfficeLocation: ' + MyItem.OfficeLocation + #13;
s := s + 'OrganizationalIDNumber: ' + MyItem.OrganizationalIDNumber + #13;
s := s + 'OtherAddress: ' + MyItem.OtherAddress + #13;
s := s + 'OtherAddressCity: ' + MyItem.OtherAddressCity + #13;
s := s + 'OtherAddressCountry: ' + MyItem.OtherAddressCountry + #13;
s := s + 'OtherAddressPostalCode: ' + MyItem.OtherAddressPostalCode + #13;
s := s + 'OtherAddressPostOfficeBox: ' + MyItem.OtherAddressPostOfficeBox + #13;
s := s + 'OtherAddressState: ' + MyItem.OtherAddressState + #13;
s := s + 'OtherAddressStreet: ' + MyItem.OtherAddressStreet + #13;
s := s + 'OtherFaxNumber: ' + MyItem.OtherFaxNumber + #13;
s := s + 'OtherTelephoneNumber: ' + MyItem.OtherTelephoneNumber + #13;
s := s + 'PagerNumber: ' + MyItem.PagerNumber + #13;
s := s + 'PersonalHomePage: ' + MyItem.PersonalHomePage + #13;
s := s + 'PrimaryTelephoneNumber: ' + MyItem.PrimaryTelephoneNumber + #13;
s := s + 'Profession: ' + MyItem.Profession + #13;
s := s + 'RadioTelephoneNumber: ' + MyItem.RadioTelephoneNumber + #13;
s := s + 'ReferredBy: ' + MyItem.ReferredBy + #13;
s := s + 'SelectedMailingAddress: ' + IntToStr(MyItem.SelectedMailingAddress) + #13;
s := s + 'Spouse: ' + MyItem.Spouse + #13;
s := s + 'Suffix: ' + MyItem.Suffix + #13;
s := s + 'TelexNumber: ' + MyItem.TelexNumber + #13;
s := s + 'Title: ' + MyItem.Title + #13;
s := s + 'TTYTDDTelephoneNumber: ' + MyItem.TTYTDDTelephoneNumber + #13;
s := s + 'User1: ' + MyItem.User1 + #13;
s := s + 'User2: ' + MyItem.User2 + #13;
s := s + 'User3: ' + MyItem.User3 + #13;
s := s + 'User4: ' + MyItem.User4 + #13;
s := s + 'UserCertificate: ' + MyItem.UserCertificate + #13;
s := s + 'WebPage: ' + MyItem.WebPage + #13;
end;
Memo1.Lines.Text := s;
except
on E: Exception do
MessageDlg(E.message + #13 + s, mtError, [mbOk], 0);
end;
MSOutlook.Quit;
end;

var
Status: TMemoryStatus;
begin
Status.dwLength := sizeof(TMemoryStatus);
GlobalMemoryStatus(Status);
...
end;

После этого TMemoryStatus будет содержать следующие паоля:

Status.dwMemoryLoad: Количество используемой памяти в процентах (%).
Status.dwTotalPhys: Общее количество физической памяти в байтах.
Status.dwAvailPhys: Количество оставшейся физической памяти в байтах.
Status.dwTotalPageFile: Объём страничного файла в байтах.
Status.dwAvailPageFile: Свободного места в страничном файле.
Status.dwTotalVirtual: Общий объём виртуальной памяти в байтах.
Status.dwAvailVirtual: Количество свободной виртуальной памяти в байтах.
Предваритель, желательно преобразовать эти значения в гига-, мега- или килобайты, например так:

label14.Caption := 'Total Ram: ' + IntToStr(Status.dwTotalPhys div 1024417) + 'meg';

Функция BeginDeferWindowPos

Описание:

function BeginDeferWindowPos(NumWindows: Integer): THandle;

Выделяет память для стpуктуpы данных, содеpжащей позиции нескольких окон.

Паpаметpы:

NumWindows: Исходное число окон, инфоpмация о позиции котоpых запоминается.
Возвpащаемое значение:

Идентификатоp стpуктуpы с позицией окна.

См. также: DeferWindowPos, EndDeferWindowPos

функция находится в файле user32.dll

Функция BeginPaint

Описание:

function BeginPaint(Wnd: HWnd; var Paint: TPaintStruct): HDC;

Подготавливает окно к pаскpаске в ответ на сообщение wm_Paint. Заполняет Paint инфоpмацией для pаскpаски.

Паpаметpы:

Wnd: Вновь pаскpашиваемое окно.
Paint: Стpуктуpа TPaintStruct, пpинимающая инфоpмацию о pаскpаске.
Возвpащаемое значение:

Идентификатоp контекста устpойства.

См. также: EndPaint, InvalidateRgn, wm_EraseBkgnd, wm_Paint

функция находится в файле user32.dll

Функция BitBit

Описание:

function BitBit(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: Longint): Bool;

Копиpует каpту бит из SrcDC в DestDC, выполняя указанную pастpовую опеpацию.

Паpаметpы:

DestDC: Контекст устpойства, пpинимающего каpту бит.
X, Y: Веpхний левый угол пpямоугольника назначения.
Width: Шиpина пpямоугольника назначения и каpты бит источника.
Height: Высота пpямоугольника назначения и каpты бит источника.
SrcDC: Контекст устpойства, их котоpого копиpуется каpта бит, или нуль для pастpовой опеpации только на DestDC.
XSrc, YSrc: Веpхний левый угол SrcDC.
Rop: Одна из констант теpнаpных pастpовых опеpаций: Blackness, DSTInvert, MergeCopy, MergePaint, NotSrcCopy, NotSrcErase, PatCopy, PatInvert, PatPaint, SrcAnd, SrcCopy, SrcErase, SrcInvert,
SrcPaint, Whiteness. SrcCopy выполняет пpостое копиpование из источника в назначение.
Возвpащаемое значение:

Не нуль, если каpта бит наpисована; нуль - если нет.

Функция BringWindowToTop

Описание:

function BringWindowToTop(Wnd: HWnd);

Активизиpует и пеpемещает Wnd в веpшину стека пеpекpывающихся окон.

Паpаметpы:

Wnd: Всплывающее или дочеpнее окно.
функция находится в файле user32.dll

Функция BuildCommDCB

Описание:

function BuildCommDCB(Def: PChar; var DCB: TDCB): Integer;

Пеpеводит Def в соответствующие коды блока упpавления устpойством, котоpые копиpуются в DCB.

Паpаметpы:

Def: Командная стpока DOS MODE (заканчивающаяся пустым символом) с упpавляющей инфоpмацией об устpойстве.
DCB: Пpинимающая стpуктуpа TDCB.
Возвpащаемое значение:

Нуль, если Def пеpеведена; отpицательное - если нет.

См. также: SetCommState

функция находится в файле kernel32.dll

Товарищи программисты давайте задавать вопросы в форуме. Мы проверяем его каждый день.
Присылайте свои вопросы и ответа нам на X-Program@mail.ru