/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Delphi

Выпуск № 861
от 07.07.2007, 22:35

Вопрос № 93.577

Ув. эксперты, я написал программу, которая проверяет количество знаков в тексте, но не могу сделать так, чтобы пробелы и Enter за знак не считались. Код программы, которую я написал в Borland Turbo Delphi Explorer находится ниже, пожалуйста скажите что нужно для того, чтобы пробелы и Enter не считались за знак. Если можете напишите полный код программы. Заранее огромное спасибо. Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Memo1: TMemo; Button1: TButton; Label1: TLabel; procedure FormCreate(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin Label1.Caption := 'Знаков: ' + FloatToStr(Length(Memo1.Text)); end; procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); var r: integer; begin if Memo1.Modified then begin r := MessageDlg('Текст изменён.Сохранить изменения?', mtWarning, [mbYes,mbNo,mbCancel],0); case r of mrYes: Memo1.Lines.SaveToFile('C:Documents and SettingsCkUlerМои документы' + 'ПрограммированиеTurbo DelphiMemomemo.txt'); mrCancel: CanClose := False; end; end; end; procedure TForm1.FormCreate(Sender: TObject); begin Memo1.Lines.LoadFromFile('C:Documents and SettingsCkUlerМои документы' + 'ПрограммированиеTurbo DelphiMemomemo.txt'); end; end.

Отправлен: 01.07.2007, 22:31 Вопрос задал: Патрикеев Сергей (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Градов Юрий Михайлович Здравствуйте, Патрикеев Сергей! Привожу пример фрагмент листинга программы для решения Вашей проблемы: Приложение: function TForm1.LenMemoText(meMemo: TMemo): integer; var i,j,count: integer; begin count:=0; for i:=0 to meMemo.Lines.Count do begin for j:=1 to Length(meMemo.Lines.Strings[i]) do if meMemo.Lines.Strings[i]<>' ' then Inc(count); end; Result:=count; end; procedure TForm1.Button1Click(Sender: TObject); begin Label1.Caption := 'Знаков: ' + FloatToStr(LenMemoText(Memo1)); end; --------- Глаза боятся - руки делают!

Ответ отправил: Градов Юрий Михайлович (статус: Студент) Ответ отправлен: 02.07.2007, 00:32 Оценка за ответ: 5

Вопрос № 93.630

Здравствуйте уважаемые... Как программно убрать выделение в строке Combobox, а то использую его в качестве TEdit и вот столкнулся с таким неудобством

Отправлен: 02.07.2007, 11:28 Вопрос задал: source (статус: 1-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Василенко Алексей Васильевич Здравствуйте, source! я извиняюсь за возможно покажущуюся глупость ответа, но.. 1 - Используйте компоненты по назначению снять "выделении строки" находящегося в свойстве текст - только :=''; --------- Человек развивается только преодолевая трудности

Ответ отправил: Василенко Алексей Васильевич (статус: 2-ой класс) Ответ отправлен: 02.07.2007, 19:28 Оценка за ответ: 1

Вопрос № 93.632

Здравствуйте, эксперты!!! Пытаюсь преобразовать BMP в WMF. В строке Canvas.Draw(0, 0, Bitmap) компилятор выдаёт ошибку. Приложение: procedure ConvertBMP2WMF (const BMPFileName, WMFFileName: TFileName); var MetaFile: TMetafile; Bitmap: TBitmap; begin Metafile := TMetaFile.Create; Bitmap := TBitmap.Create; try Bitmap.LoadFromFile(BMPFileName); with MetaFile do begin Height := Bitmap.Height; Width := Bitmap.Width; Canvas.Draw(0, 0, Bitmap); SaveToFile(WMFFileName); end; finally Bitmap.Free; MetaFile.Free; end; end; // Использование: ConvertBMP2WMF(′c:mypic.bmp′, ′c:mypic.wmf′)

Отправлен: 02.07.2007, 11:41 Вопрос задал: Саттаров Рамиль Зайтунович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Denisss Здравствуйте, Саттаров Рамиль Зайтунович! Правильно выдает компилятор - у класса TMetafile нет такого свойства, как Canvas. Для него существует отдельный класс - TMetaFileCanvas. Вот его-то и нужно создавать (см. пример в приложении). Удачи! Приложение: procedure ConvertBMP2WMF(const BMPFileName, WMFFileName: TFileName); var MetaFile: TMetafile; Bitmap: TBitmap; MetaCanvas: TMetafileCanvas; begin Metafile:= TMetaFile.Create; try Bitmap:= TBitmap.Create; try Bitmap.LoadFromFile(BMPFileName); Metafile.Height:= Bitmap.Height; Metafile.Width:= Bitmap.Width; MetaCanvas:= TMetafileCanvas.Create(Metafile, 0); try MetaCanvas.Draw(0, 0, Bitmap); finally MetaCanvas.Free; end; finally Bitmap.Free; end; Metafile.SaveToFile(WMFFileName); finally Metafile.Free; end; end;

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва WWW: Хлама много, по сути ничего... ---- Ответ отправлен: 02.07.2007, 12:10

Вопрос № 93.659

Здравствуйте! Как делфийскими средствами сделать безопасное отключение устройства (флэшки или плеера) по USB порту?

Отправлен: 02.07.2007, 15:16 Вопрос задал: Red Spirit (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Denisss Здравствуйте, Red Spirit! См. пример в приложении. Пример взят с форума "Мастера Delphi" (LINK). Удачи! Приложение: program USBEject; uses Windows; const setupapi = 'SetupApi.dll'; type HDEVINFO = THandle; PSP_DEVINFO_DATA = ^SP_DEVINFO_DATA; SP_DEVINFO_DATA = packed record cbSize: DWORD; ClassGuid: TGUID; DevInst: DWORD; Reserved: DWORD; end; function SetupDiGetClassDevsA(ClassGuid: PGUID; Enumerator: PChar; hwndParent: HWND; Flags: DWORD): HDEVINFO; stdcall; external setupapi; function SetupDiEnumDeviceInfo(DeviceInfoSet: HDEVINFO; MemberIndex: DWORD; DeviceInfoData: PSP_DEVINFO_DATA): boolean; stdcall; external setupapi; function SetupDiDestroyDeviceInfoList(DeviceInfoSet: HDEVINFO): boolean; stdcall; external setupapi; function CM_Get_Parent(pdnDevInst: PDWORD; dnDevInst: DWORD; ulFlags: DWORD): DWORD; stdcall; external setupapi; function CM_Get_Device_ID_Size(pulLen: PDWORD; dnDevInst: DWORD; ulFlags: DWORD): DWORD; stdcall; external setupapi; function CM_Get_Device_IDA(dnDevInst: DWORD; Buffer: PChar; BufferLen: DWORD; ulFlags: DWORD): DWORD; stdcall; external setupapi; function CM_Locate_DevNodeA(pdnDevInst: PDWORD; pDeviceID: PChar; ulFlags: DWORD): DWORD; stdcall; external setupapi; function CM_Request_Device_EjectA(dnDevInst: DWORD; pVetoType: Pointer; pszVetoName: PChar; ulNameLength: DWORD; ulFlags: DWORD): DWORD; stdcall; external setupapi; function IsUSBDevice(DevInst: DWORD): boolean; function CompareMem(p1, p2: Pointer; len: DWORD): boolean; var i: DWORD; begin result := false; if len = 0 then exit; for i := 0 to len-1 do if PByte(DWORD(p1) + i)^ <> PByte(DWORD(p2) + i)^ then exit; result := true; end; var IDLen: DWORD; ID: PChar; begin result := false; if (CM_Get_Device_ID_Size(@IDLen, DevInst, 0) <> 0) or (IDLen = 0) then exit; inc(IDLen); ID := GetMemory(IDLen); if ID = nil then exit; if (CM_Get_Device_IDA(DevInst, ID, IDLen, 0) <> 0) or (not CompareMem(ID, PChar('USBSTOR'), 7)) then begin FreeMemory(ID); exit; end; FreeMemory(ID); result := true; end; procedure EjectUSB(); const GUID_DEVCLASS_DISKDRIVE: TGUID = (D1: $4D36E967; D2: $E325; D3: $11CE; D4: ($BF, $C1, $08, $00, $2B, $E1, $03, $18)); var hDevInfoSet: HDEVINFO; DevInfo: SP_DEVINFO_DATA; i: Integer; Parent: DWORD; VetoName: PChar; begin DevInfo.cbSize := sizeof(SP_DEVINFO_DATA); hDevInfoSet := SetupDiGetClassDevsA(@GUID_DEVCLASS_DISKDRIVE, nil, 0, 2); if hDevInfoSet = INVALID_HANDLE_VALUE then exit; i := 0; while (SetupDiEnumDeviceInfo(hDevInfoSet, i, @DevInfo)) do begin if (IsUSBDevice(DevInfo.DevInst)) and (CM_Get_Parent(@Parent, DevInfo.DevInst, 0) = 0) then begin VetoName := GetMemory(260); if (CM_Request_Device_EjectA(Parent, nil, VetoName, 260, 0) <> 0) then begin if (CM_Locate_DevNodeA(@Parent, VetoName, 0) <> 0) then begin FreeMemory(VetoName); continue; end; FreeMemory(VetoName); if (CM_Request_Device_EjectA(Parent, nil, nil, 0, 0) <> 0) then continue; end; FreeMemory(VetoName); break; end; inc(i); end; SetupDiDestroyDeviceInfoList(hDevInfoSet); end; begin if MessageBoxA(0, 'Вы действительно хотите извлечь USB-диск?', 'Подтверждение', MB_YESNO) = ID_YES then EjectUSB(); end.

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва WWW: Хлама много, по сути ничего... ---- Ответ отправлен: 03.07.2007, 00:21 Оценка за ответ: 5 Комментарий оценки: отлично!

Вопрос № 93.673

Добрый день уважаемые эксперты. Как создать программу на delphi чтобы можно было выключить компьютор. Спасибо

Отправлен: 02.07.2007, 17:29 Вопрос задал: Ботвана Василий (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Coupler Здравствуйте, Ботвана Василий! Посмотрите ответы на вопрос №37006. Один из ответов - в приложении. Исправлена ссылка. = Устинов С.Е. = (Профессионал) Приложение: function GetWinVersion: string; var VersionInfo: TOSVersionInfo; OSName: string; begin VersionInfo.dwOSVersionInfoSize := SizeOf( TOSVersionInfo ); if Windows.GetVersionEx( VersionInfo ) then begin with VersionInfo do begin case dwPlatformId of VER_PLATFORM_WIN32s: OSName := 'Win32s'; VER_PLATFORM_WIN32_WINDOWS: OSName := 'Windows 95'; VER_PLATFORM_WIN32_NT: OSName := 'Windows NT'; end; // case dwPlatformId Result := OSName + ' Version ' + IntToStr( dwMajorVersion ) + '.' + IntToStr( dwMinorVersion ) + #13#10' (Build ' + IntToStr( dwBuildNumber ) + ': ' + szCSDVersion + ')'; end; // with VersionInfo end // if GetVersionEx else Result := ''; end; procedure ShutDown; const SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; var hToken: THandle; tkp: TTokenPrivileges; tkpo: TTokenPrivileges; zero: DWORD; begin if Pos('Windows NT', GetWinVersion) = 1 then begin zero := 0; if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then begin MessageBox(0, 'Exit Error', 'OpenProcessToken() Failed', MB_OK); Exit; end; if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then begin MessageBox(0, 'Exit Error', 'OpenProcessToken() Failed', MB_OK); Exit; end; if not LookupPrivilegeValue( nil, 'SeShutdownPrivilege' , tkp.Privileges[0].Luid ) then begin MessageBox(0, 'Exit Error', 'LookupPrivilegeValue() Failed', MB_OK); Exit; end; tkp.PrivilegeCount := 1; tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; AdjustTokenPrivileges(hToken, False, tkp, SizeOf( TTokenPrivileges ), tkpo, zero); if Boolean(GetLastError()) then begin MessageBox(0, 'Exit Error', 'AdjustTokenPrivileges() Failed', MB_OK); Exit; end // if Boolean( GetLastError() ) else ExitWindowsEx( EWX_FORCE or EWX_SHUTDOWN, 0 ); end else begin ExitWindowsEx( EWX_FORCE or EWX_SHUTDOWN, 0 ); end; end;

Ответ отправил: Coupler (статус: Практикант) Ответ отправлен: 02.07.2007, 17:33

Отвечает: Dovhanyk Roman Igorovych Здравствуйте, Ботвана Василий! Ответ на Ваш вопрос в приложении. Приложение: Для выключения ПК можно использовать например такую процедуру: procedure TForm1.Button1Click(Sender: TObject); const SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; var hToken: THandle; tkp: TTokenPrivileges; tkpo: TTokenPrivileges; zero: DWORD; begin if Pos('Windows NT', GetWinVersion) = 1 then begin zero := 0; if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then begin MessageBox(0, 'Exit Error', 'OpenProcessToken() Failed', MB_OK); Exit; end; if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then begin MessageBox(0, 'Exit Error', 'OpenProcessToken() Failed', MB_OK); Exit; end; if not LookupPrivilegeValue( nil, 'SeShutdownPrivilege' , tkp.Privileges[0].Luid ) then begin MessageBox(0, 'Exit Error', 'LookupPrivilegeValue() Failed', MB_OK); Exit; end; tkp.PrivilegeCount := 1; tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; AdjustTokenPrivileges(hToken, False, tkp, SizeOf( TTokenPrivileges ), tkpo, zero); if Boolean(GetLastError()) then begin MessageBox(0, 'Exit Error', 'AdjustTokenPrivileges() Failed', MB_OK); Exit; end else ExitWindowsEx( EWX_FORCE or EWX_SHUTDOWN, 0 ); end else begin ExitWindowsEx( EWX_FORCE or EWX_SHUTDOWN, 0 ); end; end; Для ее работы нужно еще функцию для определения версии Windows: function GetWinVersion: string; var VersionInfo: TOSVersionInfo; OSName: string; begin VersionInfo.dwOSVersionInfoSize := SizeOf( TOSVersionInfo ); if Windows.GetVersionEx( VersionInfo ) then begin with VersionInfo do begin case dwPlatformId of VER_PLATFORM_WIN32s: OSName := 'Win32s'; VER_PLATFORM_WIN32_WINDOWS: OSName := 'Windows 95'; VER_PLATFORM_WIN32_NT: OSName := 'Windows NT'; end; Result := OSName + ' Version ' + IntToStr( dwMajorVersion ) + '.' + IntToStr( dwMinorVersion ) + #13#10' (Build ' + IntToStr( dwBuildNumber ) + ': ' + szCSDVersion + ')'; end; end else Result := ''; end;

Ответ отправил: Dovhanyk Roman Igorovych (статус: 1-ый класс) Ответ отправлен: 03.07.2007, 09:08

© 2001-2007, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Email: support@rusfaq.ru, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале Версия системы: 4.52 от 02.05.2007
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru