Зайцев О.В. и Владимиров А.М.
Дата последней редакции 10.10.1999
Вопросы - ответы - советы
Глюки
Как отличить режим дизайна от режима
запущенного приложения:
if not (csDesigning in ComponentState) then {запущено приложениее}
От авторов ...
Данный файл содержит обобщенную и
апробированную авторами информацию по решению
некоторых задач, возникающих при
программировании на Delphi. Мы не претендуем на
авторство, вся эта информация собрана из
различных источников, но все примеры и советы,
приведенные здесь были предварительно проверены
под разными версиями Delphi, поэтому особое
внимание следует обратить на примечания
относительно версии, для которой это разработано
или проверено.
Зайцев О.В.
Владимиров А.М.
Как получить горизонтальную прокрутку
(scrollbar) в ListBox?
Так же как в случае с TMemo, здесь можно
использовать сообщения. Например, сообщение
может быть отослано в момент создания формы:
procedure TForm1.FormCreate(Sender: TObject); begin ListBox1.Perform(LB_SETHORIZONTALEXTENT, 1000, Longint(0)); end;
Второй параметр в вызове - ширина прокрутки в
точках.
Есть функция API Windows, что заставляет искать строку
в ListBox с указанной позиции.
Например, поиск строки, что начинается на '1.' От
текущей позиции курсора в ListBox. Т.о., нажимая на
кнопку Button1, будут перебраны все строки
начинающиеся на '1.'
procedure TForm1.Button1Click(Sender: TObject); var S : string; begin S:='1.'; with ListBox1 do ItemIndex := Perform(LB_SELECTSTRING, ItemIndex, LongInt(S)); end;
Более подробную информацию о работе
команды LB_SELECTSTRING можно узнать из Help-а Win32.
Пример получения позиции курсора из
компоненты TMemo.
procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin Memo1Click(Self); end; procedure TForm1.Memo1Click(Sender: TObject); VAR LineNum : LongInt; CharNum : LongInt; begin LineNum := Memo1.Perform(EM_LINEFROMCHAR, Memo1.SelStart, 0); CharNum := Memo1.Perform(EM_LINEINDEX, LineNum, 0); Label1.Caption := IntToStr(LineNum+1)+' : '+IntToStr((Memo1.SelStart-CharNum)+1); end; procedure TForm1.FormCreate(Sender: TObject); begin Memo1Click(Self); end;
В компоненте TMemo предусмотрена функция отмены
последней правки (Undo). Ее можно вызвать следующим
образом:
Memo1.Perform(EM_UNDO,0,0);
Узнать о том, возможна ли отмена (т.е. есть ли что
отменять) можно следующим образом:
UndoEnabled:=(Memo1.Perform(EM_CAUNDO,0,0)<>0);
Как прокрутить текст в Tmemo или в TRichEdit
Я добавляю програмно несколько строк в конец
поля Memo, а их не видно. Как прокрутить Memo, чтобы
было видно последние строки ?
Примерно так:
SendMessage(Memo1.Handle, EM_LINESCROLL, 0, Memo1.Lines.Count-1);
Как определить работает ли уже данное приложение или это первая его копия?
Для Delphi 1. Каждый экземпляр программы имеет
ссылку на свою предыдущую копию - hPrevInst: hWnd. Ее
можно проверить перед созданием приложения и при
необходимости отреагировать соответствующим
образом. Если запущена только одна копия, то эта
ссылка равна нулю.
Пример:
procedure TForm1.FormCreate(Sender: TObject); begin {Проверяем есть ли указатель на предыдущую копию приложения} IF hPrevInst <> 0 THEN BEGIN {Если есть, то выдаем сообщение и выходим} MessageDlg('Программа уже запущена!', mtError, [mbOk], 0); Halt; END; {Иначе - ничего не делаем (не мешаем созданию формы)} end;
P.S. Для выхода необходимо использовать Halt, а не
Close, как хотелось бы, так как форма еще не создана
и закрывать нечего.
Есть и другой способ - по списку загруженных
приложений
procedure TForm1.FormCreate(Sender: TObject); VAR Wnd : hWnd; buff : ARRAY[0.. 127] OF Char; Begin Wnd := GetWindow(Handle, gw_HWndFirst); WHILE Wnd <> 0 DO BEGIN IF (Wnd <> Application.Handle) AND (GetWindow(Wnd, gw_Owner) = 0) THEN BEGIN GetWindowText (Wnd, buff, sizeof (buff )); IF StrPas (buff) = Application.Title THEN BEGIN MessageDlg('Приложение уже загружено', mtWarning, [mbOk], 0); Halt; END; END; Wnd := GetWindow (Wnd, gw_hWndNext); END; End;
Еще один интересный способ для Win32. Дело в том,
что можно в памяти создавать временные файлы. При
перезагрузке они теряются, а так существуют.
Кстати, этот метод можно использовать и для
обмена информацией между вашими приложениями.
Пример:
program Project1; uses Windows, // Обязательно Forms, Unit1 in 'Unit1.pas' {Form1}; {$R *.RES} Const MemFileSize = 1024; MemFileName = 'one_inst_demo_memfile'; Var MemHnd : HWND; begin { Попытаемся создать файл в памяти } MemHnd := CreateFileMapping(HWND($FFFFFFFF), nil, PAGE_READWRITE, 0, MemFileSize, MemFileName); { Если файл не существовал запускаем приложение } if GetLastError<>ERROR_ALREADY_EXISTS then begin Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end; CloseHandle(MemHnd); end.
Часто при работе у пользователя может быть
открыто 5-20 окон и сообщение о том, что программа
уже запущено приводит к тому, что он вынужден
полчаса искать ранее запущенную копию. Выход из
положения - найдя копию программы активировать
ее, для чего в последнем примере перед HALT
необходимо добавить строку :
SetForegroundWindow(Wnd);
Например так:
program Project0; uses Windows, // !!! Forms, Unit0 in 'Unit0.pas' {Form1}; var Handle1 : LongInt; Handle2 : LongInt; {$R *.RES} begin Application.Initialize; Handle1 := FindWindow('TForm1',nil); if handle1 = 0 then begin Application.CreateForm(TForm1, Form1); Application.Run; end else begin Handle2 := GetWindow(Handle1,GW_OWNER); //Чтоб заметили :) ShowWindow(Handle2,SW_HIDE); ShowWindow(Handle2,SW_RESTORE); SetForegroundWindow(Handle1); // Активизируем end; end.
Пример вывода сообщения одной командой
и ввода строки тоже одной командой.
Вывод сообщения: ShowMessage('сообщение');
Ввод текста от пользователя: S:=InputBox('Заголовок',
'Сообщение', S{строка по умолчанию});
unit Unit1; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; Button3: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject); begin ShowMessage('Пример простого сообщения.'+#10+ 'Данное сообщение выводится всегда в центре экрана.'); end; procedure TForm1.Button2Click(Sender: TObject); begin ShowMessagePos('Пример сообщения с указанием его положения на экране.', Form1.Left+Button2.Left, Form1.Top+Button2.Top); end; procedure TForm1.Button3Click(Sender: TObject); begin Button3.Caption := InputBox('Delphi для всех', 'Введите строку:', Button3.Caption); end; end.
Перетаскивание формы за ее поле
procedure TForm1.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); const SC_DragMove = $F012; { a magic number } begin ReleaseCapture; perform(WM_SysCommand, SC_DragMove, 0); end;
Обработка событий от клавиатуры
I. Эмуляция нажатия клавиши.
Внутри приложения это выполняется достаточно
просто с помощью вызова функции Windows API SendMessage()
(можно воспользоваться и методом Perform того
объекта (или формы), кому посылается сообщение о
нажатой клавише).
Код
Memo1.Perform(WM_CHAR, Ord('A'), 0);
или
SendMessage(Memo1.Handle, WM_CHAR, Ord('A'), 0);
приведет к печати символа "A" в объекте Memo1.
II. Перехват нажатий клавиши внутри приложения.
Задача решается очень просто. Можно у формы
установить свойство KeyPreview в True и обрабатывать
событие OnKeyPress. Второй способ - перехватывать
событие OnMessage для объекта Application.
III. Перехват нажатия клавиши в Windows.
Существуют приложения, которым необходимо
перехватывать все нажатия клавиш в Windows, даже
если в данный момент активно другое приложение.
Это может быть, например, программа,
переключающая раскладку клавиатуры, резидентный
словарь или программа, выполняющая иные действия
по нажатию "горячей" комбинации клавиш.
Перехват всех событий в Windows (в том числе и
событий от клавиатуры) выполняется с помощью
вызова функции SetWindowsHook(). Данная функция
регистрирует в системе Windows ловушку (hook) для
определенного типа событий/сообщений. Ловушка -
это пользовательская процедура, которая будет
обрабатывать указанное событие. Основное здесь
то, что эта процедура должна всегда
присутствовать в памяти Windows. Поэтому ловушку
помещают в DLL и загружают эту DLL из программы. Пока
хоть одна программа использует DLL, та не может
быть выгружена из памяти. Приведем пример такой
DLL и программы, ее использующей. В примере ловушка
перехватывает нажатие клавиш на клавиатуре,
проверяет их и, если это клавиши "+" или
"-", посылает соответствующее сообщение в
конкретное приложение (окно). Окно ищется по
имени его класса ("TForm1") и заголовку (caption,
"XXX").
{текст библиотеки} library SendKey; uses WinTypes, WinProcs, Messages; const {пользовательские сообщения} wm_NextShow_Event = wm_User + 133; wm_PrevShow_Event = wm_User + 134; {handle для ловушки} HookHandle: hHook = 0; var SaveExitProc : Pointer; {собственно ловушка} function Key_Hook(Code: integer; wParam: word; lParam: Longint): Longint; export; var H: HWND; begin {если Code>=0, то ловушка может обработать событие} if Code >= 0 then begin {это те клавиши?} if ((wParam = VK_ADD)or(wParam = VK_SUBTRACT)) and (lParam and $40000000 = 0) then begin {ищем окно по имени класса и по заголовку} H := FindWindow('TForm1', 'XXX'); {посылаем сообщение} if wParam = VK_ADD then SendMessage(H, wm_NextShow_Event, 0, 0) else SendMessage(H, wm_PrevShow_Event, 0, 0); end; {если 0, то система должна дальше обработать это событие} {если 1 - нет} Result:=0; end else {если Code<0, то нужно вызвать следующую ловушку} Result := CallNextHookEx(HookHandle,Code, wParam, lParam); end; {при выгрузке DLL надо снять ловушку} procedure LocalExitProc; far; begin if HookHandle<>0 then begin UnhookWindowsHookEx(HookHandle); ExitProc := SaveExitProc; end; end; {инициализация DLL при загрузке ее в память} begin {устанавливаем ловушку} HookHandle := SetWindowsHookEx(wh_Keyboard, Key_Hook, hInstance, 0); if HookHandle = 0 then MessageBox(0, 'Unable to set hook!', 'Error', mb_Ok) else begin SaveExitProc := ExitProc; ExitProc := @LocalExitProc; end; end.
Размер такой DLL в скомпилированном виде будет
около 3Кб, поскольку в ней не используются
объекты из VCL.
Далее приведен код модуля в Delphi, который
загружает DLL и обрабатывает сообщения от ловушки,
просто отображая их в Label1.
unit Unit1; interface uses SysUtils,WinTypes,WinProcs,Messages,Classes,Graphics,Controls,Forms,Dialogs,StdCtrls; {пользовательские сообщения} const wm_NextShow_Event = wm_User + 133; wm_PrevShow_Event = wm_User + 134; type TForm1 = class(TForm) Label1: TLabel; procedure FormCreate(Sender: TObject); private {обработчики сообщений} procedure WM_NextMSG (Var M : TMessage); message wm_NextShow_Event; procedure WM_PrevMSG (Var M : TMessage); message wm_PrevShow_Event; end; var Form1: TForm1; P : Pointer; implementation {$R *.DFM} {загрузка DLL} function Key_Hook : Longint; far; external 'SendKey'; procedure TForm1.WM_NextMSG (Var M : TMessage); begin Label1.Caption:='Next message'; end; procedure TForm1.WM_PrevMSG (Var M : TMessage); begin Label1.Caption:='Previous message'; end; procedure TForm1.FormCreate(Sender: TObject); begin {если не использовать вызов процедуры из DLL в программе, то компилятор удалит загрузку DLL из программы} P:=@Key_Hook; end; end.
Конечно, свойство Caption в этой форме должно быть
установлено в "XXX".
Как сделать так, что при нажатии на Enter
происходил переход к следующему элементу формы
Ставите у формы KeyPreview = true и создаете событие KeyPress
следующего вида:
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char); begin if (Key = #13) then begin Key:=#0; Perform(WM_NEXTDLGCTL,0,0); end; end;
Вставка и удаление компонент в форму в design-time
Вопрос:
Каким образом можно отследить вставку и удаление
компонент в форму в design-time? Такая информация
могла бы пригодится, если моя компонента имеет
ссылки на другие компоненты (например, как в
связке TDateSource,TTable и др.)
Ответ:
Для получения такой информации предназначен
метод
procedure Notification (AComponent: TComponent; Operation: TOperation); virtual;
класса TComponent. Перекрыв его в своей компоненты Вы
можете произвести необходимые действия, в
зависимости от значения параметра Operation типа
TOperation = (opInsert, opRemove);
объявленного в модуле Classes. Параметр AComponent -
компонента, соответственно вставлемая или
удаляемая, в зависимости от Operation.
(Пример для Delphi 1.0 поскольку в Delphi 2-3 лучше
использовать:
var MsWord : variant;
MsWord := CreateOleObject('Word.Basic'); Для Delphi 3, пример ниже)
Создавать отчет в программе Word удобно если отчет
имеет сложную структуру (тогда его быстрее
создать в Word, чем в Qreport от Delphi, кроме того, этот
QReport имеет "глюки"), либо, если после создания
отчета его нужно будет изменять. Итак, первым
делом в Word создается шаблон будущего отчета, это
самый обыкновенный не заполненный отчет. А в
места куда будет записываться информация нужно
поставить метки. Например (для наглядности метки
показаны зеленым цветом, реально они конечно не
видны):
Накладная ? Num
? |
Поставщик |
Наименование товара |
Код товара |
Кол-во |
Цена |
Сумма |
Table |
Сдал_______________________ Принял________________________ М.П. М.П.
Далее в форму, откуда будут выводиться данные,
вставляете компоненту DdeClientConv из палитры System.
Назовем ее DDE1. Эта компонента позволяет
передавать информацию между программами методом
DDE. Свойства:
ConnectMode : ddeManual - связь устанавливаем вручную
DdeService : (winword) - с кем устанавливается связь
ServiceApplication : C:\MSOffice\Winword\WINWORD.EXE - полный путь
доступа к программе. (Вот здесь можно наступить
на грабли. Ведь Word может лежать в любой папке!
Поэтому путь доступа к нему лучше взять из
реестра, а еще лучше использовать OLE см.начало
раздела)
Теперь пишем процедуру передачи данных:
{ Печать накладной } procedure Form1.PrintN; Var S : string; i : integer; Sum : double; {итоговая сумма, кстати,совет: не пользуйтесь типом real!} Tv, Ss : PChar; begin S:=GetCurrentDir+'\Накладная.doc'; { имя открываемого документа } DDE1.OpenLink; { устанавливаем связь } Tv:=StrAlloc(20000); Ss:=StrAlloc(300); { выделяем память } { даем команду открыть документ и установить курсор в начало документа } StrPCopy(Tv, '[FileOpen "'+S+'"][StartOfDocument]'); S:=NNakl.Text; { номер накладной } { записываем в позицию Num номер накладной } StrCat(Tv, StrPCopy(SS, '[EditBookmark .Name = "Num", .Goto][Insert "'+S+'"]'+ '[EditBookmark .Name = "Table", .Goto]'); { и переходим к заполнению таблицы } { передаем данные в Word } if not DDE1.ExecuteMacro(Tv, false) then begin { сообщаем об ошибке и выход } MessageDlg('Ошибка связи с Microsoft Word.', mtError, [mbOk], 0); StrDispose(Tv); StrDispose(Ss); exit; end; { Заполняем таблицу } Sum:=0; Nn:=0; for i:=0 to TCount do begin inc(Nn); { предполагаем, что данные находятся в массиве T } StrPCopy(Tv, '[Insert "'+IntToStr(Nn)+'"][NextCell][Insert "'+T[i].Company+'"]'+ '[NextCell][Insert "'+T.TName+'"][NextCell][Insert "'+T.Cod+'"][NextCell]'+ '[Insert "'+IntToStr(T.Count)+'"][NextCell]'+ '[Insert "'+FloatToStr(T.Cena)+'"][NextCell]'+ '[Insert "'+FloatToStr(T.Count*T.Cena)*+'"][NextCell]')); inc(Nn); Sum:=Sum+(T.Count*T.Cena); { итоговая сумма } if not DDE1.ExecuteMacro(Tv, false) then begin MessageDlg('Ошибка связи с Microsoft Word.', mtError, [mbOk], 0); exit; end; end; { Записываем итоговую сумму } StrPCopy(Tv, '[NextCell][Insert "Итого"][NextCell][NextCell][NextCell]'+ '[Insert "'+FloatToStr(Sum)+'"]')); if not DDE1.ExecuteMacro(Tv, false) then MessageDlg('Ошибка связи с Microsoft Word.', mtError, [mbOk], 0) else MessageDlg('Акт удачно создан. Перейдите в Microsoft Word.', mtInformation, [mbOk], 0); StrDispose(Tv); StrDispose(Ss); end;
Для Delphi 2 и выше === Cut Пример by Sergey Arkhipov 2:5054/88.10 === Пример проверен только на русском Word 7.0! Может, поможет... unit InWord; interface uses ... ComCtrls; // Delphi3 ... OLEAuto; // Delphi2 [skip] procedure TPrintForm.MPrintClick(Sender: TObject); var W: Variant; S: String; begin S:=IntToStr(Num); try // А вдруг где ошибка :) W:=CreateOleObject('Word.Basic'); // Создаем документ по шаблону MyWordDot // с указанием пути если он не в папке шаблонов Word W.FileNew(Template:='C:\MyPath\DB\MyWordDot',NewTemplate:=0); // Отключение фоновой печати (на LJ5L без этого был пустой лист) W.ToolsOptionsPrint(Background:=0); // Переходим к закладке Word'a 'Num' W.EditGoto('Num'); W.Insert(S); //Сохранение W.FileSaveAs('C:\MayPath\Reports\MyReport') W.FilePrint(NumCopies:='2'); // Печать 2-х копий finally W.ToolsOptionsPrint(Background:=1); W:=UnAssigned; end; end; {.....} === Cut Конец примера ===
Спасибо Сергею :) И еще, как определить установлен ли на компьютере Word, запустить его и загрузить в него текст из программы?
Пример:
var MsWord: Variant; ... try // Если Word уже запущен MsWord := GetActiveOleObject('Word.Application'); // Взять ссылку на запущенный OLE объект except try // Word не запущен, запустить MsWord := CreateOleObject('Word.Application'); // Создать ссылку на зарегистрированный OLE объект MsWord.Visible := True; except ShowMessage('Не могу запустить Microsoft Word'); Exit; end; end; end; ... MSWord.Documents.Add; // Создать новый документ MsWord.Selection.Font.Bold := True; // Установить жирный шрифт MsWord.Selection.Font.Size := 12; // установить 12 кегль MsWord.Selection.TypeText('Текст');
По командам OLE Automation сервера см. help по
Microsoft Word Visual Basic.
Ну вот и все.
{ На эту форму можно бросить файл (например из проводника) и он будет открыт } unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, ShellAPI {обязательно!}; type TForm1 = class(TForm) Memo1: TMemo; FileNameLabel: TLabel; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); protected {Это и есть самая главная процедура} procedure WMDropFiles(var Msg: TMessage); message wm_DropFiles; end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.WMDropFiles(var Msg: TMessage); var Filename: array[0 .. 256] of Char; Count : integer; begin { Получаем количество файлов (просто пример) } nCount := DragQueryFile( msg.WParam, $FFFFFFFF, acFileName, cnMaxFileNameLen); { Получаем имя первого файла } DragQueryFile( THandle(Msg.WParam), 0, { это номер файла } Filename,SizeOf(Filename) ) ; { Открываем его } with FileNameLabel do begin Caption := LowerCase(StrPas(FileName)); Memo1.Lines.LoadfromFile(Caption); end; { Отдаем сообщение о завершении процесса } DragFinish(THandle(Msg.WParam)); end; procedure TForm1.FormCreate(Sender: TObject); begin { Говорим Windows, что на нас можно бросать файлы } DragAcceptFiles(Handle, True); end; procedure TForm1.FormDestroy(Sender: TObject); begin { Закрываем за собой дверь золотым ключиком} DragAcceptFiles(Handle, False); end; end.
Часто возникает проблема - в многооконном
приложении необходимо обратить внимание
пользователя на то, что какое-то из окон требует
внимания (например, к нему пришло сообщение по DDE,
в нем завершился какой-либо процесс, произошла
ошибка ...). Это легко сделать, используя команду API
FlashWindow:
procedure TForm1.Timer1Timer(Sender: TObject); begin FlashWindow(Handle,true); end;
В данном примере FlashWindow вызывается по
таймеру ежесекундно, что приводит к миганию
заголовка окна.
Сведения о программе, авторские права и т.д.,
лучше оформить в виде отдельной формы и
показывать ее при запуске программы (как это
сделано в Word).
Сделать это не сложно:
1. Создаете форму (например SplashForm).
2. Объявляете ее свободной (availableForms).
3. В Progect Source вставляете следующее (например):
program Splashin; uses Forms, Main in 'MAIN.PAS', Splash in 'SPLASH.PAS' {$R *.RES} begin try SplashForm := TSplashForm.Create(Application); SplashForm.Show; SplashForm.Update; Application.CreateForm(TMainForm, MainForm); SplashForm.Hide; finally SplashForm.Free; end; Application.Run; end.
И форма SplashForm держится на экране пока
выполняется Create в главной форме. Но иногда она
появляется и пропадает очень быстро, поэтому
нужно сделать задержку:
1. Добавляете на форму таймер с событием:
procedure TSplashForm.Timer1Timer(Sender: TObject); begin Timer1.Enabled := False; end;
2. Событие onCloseQuery для формы:
procedure TSplashForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin CanClose := Not Timer1.Enabled; end;
3. И перед SplashForm.Hide; ставите цикл:
repeat Application.ProcessMessages; until SplashForm.CloseQuery;
4. Все! Осталось установить на таймере
период задержки 3-4 секунды.
5. На последок, у такой формы желательно убрать
Caption:
SetWindowLong (Main.Handle,GWL_STYLE, GetWindowLong(Main.Handle, GWL_STYLE) AND NOT
WS_CAPTION OR WS_SIZEBOX);
Эта форма имет прозрачный фон !!! unit unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; // это просто кнопка на форме - для демонстрации protected procedure RebuildWindowRgn; procedure Resize; override; public constructor Create(AOwner: TComponent); override; end; var Form1 : TForm1; implementation // ресурс этой формы {$R *.DFM} { Прозрачная форма } constructor TForm1.Create(AOwner: TComponent); begin inherited; // убираем сколлбары, чтобы не мешались // при изменении размеров формы HorzScrollBar.Visible:= False; VertScrollBar.Visible:= False; // строим новый регион RebuildWindowRgn; end; procedure TForm1.Resize; begin inherited; // строим новый регион RebuildWindowRgn; end; procedure TForm1.RebuildWindowRgn; var FullRgn, Rgn: THandle; ClientX, ClientY, I: Integer; begin // определяем относительные координаты клиенской части ClientX:= (Width - ClientWidth) div 2; ClientY:= Height - ClientHeight - ClientX; // создаем регион для всей формы FullRgn:= CreateRectRgn(0, 0, Width, Height); // создаем регион для клиентской части формы // и вычитаем его из FullRgn Rgn:= CreateRectRgn(ClientX, ClientY, ClientX + ClientWidth, ClientY + ClientHeight); CombineRgn(FullRgn, FullRgn, Rgn, rgn_Diff); // теперь добавляем к FullRgn регионы каждого контрольного элемента for I:= 0 to ControlCount -1 do with Controls[I] do begin Rgn:= CreateRectRgn(ClientX + Left, ClientY + Top, ClientX + Left + Width, ClientY + Top + Height); CombineRgn(FullRgn, FullRgn, Rgn, rgn_Or); end; // устанавливаем новый регион окна SetWindowRgn(Handle, FullRgn, True); end; end. А как Вам понравится эта форма ? unit rgnu; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Buttons, Menus; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure FormPaint(Sender: TObject); private { Private declarations } rTitleBar : THandle; Center : TPoint; CapY : Integer; Circum : Double; SB1 : TSpeedButton; RL, RR : Double; procedure TitleBar(Act : Boolean); procedure WMNCHITTEST(var Msg: TWMNCHitTest); message WM_NCHITTEST; procedure WMNCACTIVATE(var Msg: TWMNCACTIVATE); message WM_NCACTIVATE; procedure WMSetText(var Msg: TWMSetText); message WM_SETTEXT; end; var Form1: TForm1; implementation {$R *.DFM} CONST TitlColors : ARRAY[Boolean] OF TColor = (clInactiveCaption, clActiveCaption); TxtColors : ARRAY[Boolean] OF TColor = (clInactiveCaptionText, clCaptionText); procedure TForm1.FormCreate(Sender: TObject); VAR rTemp, rTemp2 : THandle; Vertices : ARRAY[0..2] OF TPoint; X, Y : INteger; begin Caption := 'OOOH! Doughnuts!'; BorderStyle := bsNone; {required} IF Width > Height THEN Width := Height ELSE Height := Width; {harder to calc if width <> height} Center := Point(Width DIV 2, Height DIV 2); CapY := GetSystemMetrics(SM_CYCAPTION)+8; rTemp := CreateEllipticRgn(0, 0, Width, Height); rTemp2 := CreateEllipticRgn((Width DIV 4), (Height DIV 4), 3*(Width DIV 4), 3*(Height DIV 4)); CombineRgn(rTemp, rTemp, rTemp2, RGN_DIFF); SetWindowRgn(Handle, rTemp, True); DeleteObject(rTemp2); rTitleBar := CreateEllipticRgn(4, 4, Width-4, Height-4); rTemp := CreateEllipticRgn(CapY, CapY, Width-CapY, Height-CapY); CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_DIFF); Vertices[0] := Point(0,0); Vertices[1] := Point(Width, 0); Vertices[2] := Point(Width DIV 2, Height DIV 2); rTemp := CreatePolygonRgn(Vertices, 3, ALTERNATE); CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_AND); DeleteObject(rTemp); RL := ArcTan(Width / Height); RR := -RL + (22 / Center.X); X := Center.X-Round((Center.X-1-(CapY DIV 2))*Sin(RR)); Y := Center.Y-Round((Center.Y-1-(CapY DIV 2))*Cos(RR)); SB1 := TSpeedButton.Create(Self); WITH SB1 DO BEGIN Parent := Self; Left := X; Top := Y; Width := 14; Height := 14; OnClick := Button1Click; Caption := 'X'; Font.Style := [fsBold]; END; end; procedure TForm1.Button1Click(Sender: TObject); begin Close; End; procedure TForm1.WMNCHITTEST(var Msg: TWMNCHitTest); begin Inherited; WITH Msg DO WITH ScreenToClient(Point(XPos,YPos)) DO IF PtInRegion(rTitleBar, X, Y) AND (NOT PtInRect(SB1.BoundsRect, Point(X,Y))) THEN Result := htCaption; end; procedure TForm1.WMNCActivate(var Msg: TWMncActivate); begin Inherited; TitleBar(Msg.Active); end; procedure TForm1.WMSetText(var Msg: TWMSetText); begin Inherited; TitleBar(Active); end; procedure TForm1.TitleBar(Act: Boolean); VAR TF : TLogFont; R : Double; N, X, Y : Integer; begin IF Center.X = 0 THEN Exit; WITH Canvas DO begin Brush.Style := bsSolid; Brush.Color := TitlColors[Act]; PaintRgn(Handle, rTitleBar); R := RL; Brush.Color := TitlColors[Act]; Font.Name := 'Arial'; Font.Size := 12; Font.Color := TxtColors[Act]; Font.Style := [fsBold]; GetObject(Font.Handle, SizeOf(TLogFont), @TF); FOR N := 1 TO Length(Caption) DO BEGIN X := Center.X-Round((Center.X-6)*Sin(R)); Y := Center.Y-Round((Center.Y-6)*Cos(R)); TF.lfEscapement := Round(R * 1800 / pi); Font.Handle := CreateFontIndirect(TF); TextOut(X, Y, Caption[N]); R := R - (((TextWidth(Caption[N]))+2) / Center.X); IF R < RR THEN Break; END; Font.Name := 'MS Sans Serif'; Font.Size := 8; Font.Color := clWindowText; Font.Style := []; end; end; procedure TForm1.FormPaint(Sender: TObject); begin WITH Canvas DO BEGIN Pen.Color := clBlack; Brush.Style := bsClear; Pen.Width := 1; Pen.Color := clWhite; Arc(1, 1, Width-1, Height-1, Width, 0, 0, Height); Arc((Width DIV 4)-1, (Height DIV 4)-1, 3*(Width DIV 4)+1, 3*(Height DIV 4)+1, 0, Height, Width, 0); Pen.Color := clBlack; Arc(1, 1, Width-1, Height-1, 0, Height, Width, 0); Arc((Width DIV 4)-1, (Height DIV 4)-1, 3*(Width DIV 4)+1, 3*(Height DIV 4)+1, Width, 0, 0, Height); TitleBar(Active); END; end; end.
Как получить короткий путь файла если
имеется длинный ("c:\Program Files" ==>
"c:\progra~1")
GetShortPathName()
Как создать свою кнопку в заголовке формы (на Caption Bar)
Непосредственно такой функции вроде нет, но
можно изловчиться. Нарисовать там кнопку вручную
и обрабатывать команды нажатия мышки на Caption Bar.
Пример.
unit Main; interface uses Windows, Buttons, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) procedure FormResize(Sender: TObject); private CaptionBtn : TRect; procedure DrawCaptButton; procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPaint; procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE; procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT; procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST; procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN; public { Public declarations } end; var Form1: TForm1; implementation const htCaptionBtn = htSizeLast + 1; {$R *.DFM} procedure TForm1.DrawCaptButton; var xFrame, yFrame, xSize, ySize : Integer; R : TRect; begin //Dimensions of Sizeable Frame xFrame := GetSystemMetrics(SM_CXFRAME); yFrame := GetSystemMetrics(SM_CYFRAME); //Dimensions of Caption Buttons xSize := GetSystemMetrics(SM_CXSIZE); ySize := GetSystemMetrics(SM_CYSIZE); //Define the placement of the new caption button CaptionBtn := Bounds(Width - xFrame - 4*xSize + 2, yFrame + 2, xSize - 2, ySize - 4); //Get the handle to canvas using Form's device context Canvas.Handle := GetWindowDC(Self.Handle); Canvas.Font.Name := 'Symbol'; Canvas.Font.Color := clBlue; Canvas.Font.Style := [fsBold]; Canvas.Pen.Color := clYellow; Canvas.Brush.Color := clBtnFace; try DrawButtonFace(Canvas, CaptionBtn, 1, bsAutoDetect, False, False, False); //Define a smaller drawing rectangle within the button R := Bounds(Width - xFrame - 4 * xSize + 2, yFrame + 3, xSize - 6, ySize - 7); with CaptionBtn do Canvas.TextRect(R, R.Left + 2, R.Top - 1, 'W'); finally ReleaseDC(Self.Handle, Canvas.Handle); Canvas.Handle := 0; end; end; procedure TForm1.WMNCPaint(var Msg : TWMNCPaint); begin inherited; DrawCaptButton; end; procedure TForm1.WMNCActivate(var Msg : TWMNCActivate); begin inherited; DrawCaptButton; end; procedure TForm1.WMSetText(var Msg : TWMSetText); begin inherited; DrawCaptButton; end; procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest); begin inherited; with Msg do if PtInRect(CaptionBtn, Point(XPos - Left, YPos - Top)) then Result := htCaptionBtn; end; procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown); begin inherited; if (Msg.HitTest = htCaptionBtn) then ShowMessage('You hit the button on the caption bar'); end; procedure TForm1.FormResize(Sender: TObject); begin //Force a redraw of caption bar if form is resized Perform(WM_NCACTIVATE, Word(Active), 0); end; end.
Преобразование текста OEM у
Ansi
Эта версия работает под любым Delphi.
(Начиная с Delphi 2, это можно записать короче с
использованием AnsiToOem и OemToAnsi.)
Здесь все просто.
function ConvertAnsiToOem(const S : string) : string; { ConvertAnsiToOem translates a string into the OEM-defined character set } {$IFNDEF WIN32} var Source, Dest : array[0..255] of Char; {$ENDIF} begin {$IFDEF WIN32} SetLength(Result, Length(S)); if Length(Result) > 0 then AnsiToOem(PChar(S), PChar(Result)); {$ELSE} if Length(Result) > 0 then begin AnsiToOem(StrPCopy(Source, S), Dest); Result := StrPas(Dest); end; {$ENDIF} end; { ConvertAnsiToOem } function ConvertOemToAnsi(const S : string) : string; { ConvertOemToAnsi translates a string from the OEM-defined character set into either an ANSI or a wide-character string } {$IFNDEF WIN32} var Source, Dest : array[0..255] of Char; {$ENDIF} begin {$IFDEF WIN32} SetLength(Result, Length(S)); if Length(Result) > 0 then OemToAnsi(PChar(S), PChar(Result)); {$ELSE} if Length(Result) > 0 then begin OemToAnsi(StrPCopy(Source, S), Dest); Result := StrPas(Dest); end; {$ENDIF} end; { ConvertOemToAnsi }
Состояние кнопки insert (Insert/Overwrite)
{------------------------------------------} { Returns the status of the Insert key. } {------------------------------------------} function InsertOn: Boolean; begin if LowOrderBitSet(GetKeyState(VK_INSERT)) then InsertOn := true else InsertOn := false end;
Здесь я привожу полный список всех функций и
процедур модуля Math. При переходе от Delphi 2 к Delphi 3
модуль Math почти не изменился, фирма Borland ввела в
него только три новые функции: MaxIntVal ue, MInIntValue и
Sumint. Эти функции отличаются от своих прототипов
(MaxValue, MI nVal ue и Sum) лишь тем, что работают
исключительно с целыми числами, не принимая и не
возвращая величин с плавающей точкой. Что
касается остальных функций, то большинство из
них вполне очевидно. Если вам покажется иначе -
что ж, садитесь за исследования. И не надейтесь,
что все тайны Delphi достанутся вам на блюдечке в
виде help-файла!
Тригонометрические функции и процедуры
ArcCos - Арккосинус
ArcCosh - Пиперболический арккосинус
ArcSIn - Арксинус
ArcSInh - Гиперболический арксинус
ArcTahn - Гиперболический арктангенс
ArcTan2 - Арктангенс с учетом квадранта (функция ArcTan,
не учитывающая квадрант, находится в модуле System)
Cosh - Гиперболический косинус
Cotan - Котангенс
CycleToRad - Преобразование циклов в радианы
DegToRad - Преобразование градусов в радианы
GradToRad - Преобразование градов в радианы
Hypot - Вычисление гипотенузы прямоугольного
треугольника по длинам катетов
RadToCycle - Преобразование радианов в циклы
RadToDeg - Преобразование радианов в градусы
RacIToGrad - Преобразование радианов в грады
SinCos - Вычисление синуса и косинуса угла. Как и в
случае SumAndSquares и MeanAndStdDev, одновременная генерация
обеих величин происходит быстрее
Sinh - Гиперболический синус
Tan - Тангенс
Tanh - Гиперболический тангенс
Арифметические функции и процедуры
Cell - Округление вверх
Floor - Округление вниз
Frexp - Вычисление мантиссы и порядка заданной
величины
IntPower - Возведение числа в целую степень. Если вы
не собираетесь пользоваться экспонентами с
плавающей точкой, желательно использовать эту
функцию из-за ее скорости
Ldexp - Умножение Х на 2 в заданной степени
LnXPI - Вычисление натурального логарифма Х+1.
Рекомендуется для X, близких к нулю
LogN - Вычисление логарифма Х по основанию N
LogIO - Вычисление десятичного логарифмах
Log2 - Вычисление двоичного логарифмах
Power - Возведение числа в степень. Работает
медленнее IntPower, но для операций с плавающей
точкой вполне приемлемо
Финансовые функции и процедуры
DoubleDecliningBalance - Вычисление амортизации методом
двойного баланса
FutureValue - Будущее значение вложения
InterestPayment - Вычисление процентов по ссуде
InterestRate - Норма прибыли, необходимая для получения
заданной суммы
InternalRateOfReturn - Вычисление внутренней скорости
оборота вложения для ряда последовательных
выплат
NetPresentValue - Вычисление чистой текущей стоимости
вложения для ряда последовательных выплат с
учетом процентной ставки
NumberOf Periods - Количество периодов, за которое
вложение достигнет заданной величины
Payment - Размер периодической выплаты, необходимой
для погашения ссуды, при заданном числе периодов,
процентной ставке, а также текущем и будущем
значениях ссуды
PerlodPayment - Платежи по процентам за заданный период
PresentValue - Текущее значение вложения
SLNDepreclatlon - Вычисление амортизации методом
постоянной нормы
SYDepreclatlon - Вычисление амортизации методом весовых
коэффициентов
Статистические функции и процедуры
MaxIntValue - Максимальное значение в наборе целых
чисел. Функция появилась в Delphi 3. ее не существует
в Delphi 2
MaxValue - Максимальное значение в наборе чисел. В Delphi
2 функция возвращает минималъное значение
Mean - Среднее арифметическое для набора чисел
MeanAndStdDev - Одновременное вычисление среднего
арифметического и стандартного отклонения для
набора чисел. Вычисляется быстрее, чем обе
величины по отдельности
MinIntValLie - Минимальное значение в наборе целых
чисел. Функция появилась в Delphi 3, ее не существует
в Delphi 2
MInValue - Минимальное значение в наборе чисел. В Delphi 2
функция возвращает максимальное значение
MoiiientSkewKurtosIs - Статистические моменты порядков с
первого по четвертый, а также асимметрия (skew) и
эксцесс (kurtosis) для набора чисел
Norm - Норма для набора данных (квадратный корень из
суммы квадратов)
PopnStdDev - Выборочное стандартное отклонение.
Отличается от обычного стандартного отклонения
тем, что при вычислениях используется выборочное
значение дисперсии, PopnVarl апсе (см. ниже)
PopnVarlance - Выборочная дисперсия. Использует
"смещенную" формулу TotalVanance/n
RandG - Генерация нормально распределенных
случайных чисел с заданным средним значением и
среднеквадратическим отклонением
StdDev - Среднеквадратическое отклонение для набора
чисел
Sum - Сумма набора чисел
SLimsAndSquares - Одновременное вычисление суммы и суммы
квадратов для набора чисел. Как и в других
функциях модуля Math, обе величины вычисляются
быстрее, чем по отдельности
Sumint - Сумма набора целых чисел. Функция появилась
в Delphi 3, ее не существует в Delphi 2
SLimOfSquares - Сумма квадратов набора чисел
Total Variance - "Полная дисперсия" для набора
чисел. Это сумма квадратов расстояний всех
величин от их среднего арифметического
Variance - Выборочная дисперсия для набора чисел.
Функция использует "несмещенную" формулу
TotalVanапсе/ (п -1)
Глюки TImage
При увеличении размера компонента TImage в RunTime
пытаюсь рисоватьзаново на всем поле, но
отображается только часть компонента
(прежнегоразмера). В чем дело?
Ответ: Нужно при инициализации выполнить SetBounds(),
с максимальными размерами.
Глюки QReport
Обнаружил, что компонент QReport никак не реагирует
на установки принтера PrinterSetup диалога,
вызываемого нажатием кнопочкисобственного Preview!
В QuickReport есть собственный объект TQRPrinter, установки
которого он использует при печати, а стандартные
установки принтеров на него не влияют. В диалоге
PrinterSetup, вызываемом из Preview можно лишь выбрать
принтер на который нужно печатать (если, конечно,
установлено несколько принтеров).
Советую поставить обновление QReport на 2.0J с
www.qusoft.com.
Перед печатью (не только из QReport) программно
установите требуемый драйвер принтера текущим
для Windows
function SetDefPrn(const stDriver : string) : boolean; begin SetPrinter(nil).Free; Result := WriteProfileString('windows', device', PChar( stDriver)); end;
После печати восстановите установки.
По-видимому, надо добавить строк в конец, изменив
Grid.RowCount, а потом раздвинуть строки циклом снизу
вверх:
Grid.Rows.Strings[i] := Grid.Rows.Strings[i - 1];
Или я бы сделал метод рисования этой таблицы, а
данные хранил бы в отдельном stringList-е, там есть
методы вставки, а вообще-то для этих целей
предпочитаю DrawGrid: переопределяю метод onDrawCell, всё
же объектная модель лучше и данные проще
контролировать.
У меня такая проблема: я пишу компонент, который внутри себя создаёт другой компонент. Конструктор первого компонента выглядит примерно так:
constructor TFirstComp.Create(AOwner:TComponent); begin inherited Create(AOwner); SecondComp:=TSecondComp.Create(Owner) end;
Проблема заключается в том, что при
помещении первого компонента на форму в dfm-файл
записывается информация и о втором компоненте
тоже. А в pas-файл - только о первом. Это приводит к
конфликтам. Для меня принципиально, чтобы хозяин
у второго компонента был тот же, что и у первого.
Как не дать Delphi поместить запись о TSecondComp в
dfm-файл?
Попробуйте сделать так:
constructor TFirstComp.Create(AOwner:TComponent); begin inherited Create(AOwner); SecondComp:=TSecondComp.Create(SELF); end;
Т.е. дочернему компоненту в качастве
владельца передавайте его непосредственного
хозяина.
Посмотрите компонент RichEdit98 (полностью бесплатный). ftp://ftp.bcsmi.minsk.by/alex/
Я думаю, пример красноречивее пяти листов словоблудия ...
unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Buttons, ComCtrls, ExtCtrls, OleCtnrs; type TForm1 = class(TForm) OleContainer1: TOleContainer; Panel1: TPanel; StatusBar1: TStatusBar; mbLoad: TSpeedButton; mbPrint: TSpeedButton; OpenDialog1: TOpenDialog; procedure mbLoadClick(Sender: TObject); procedure mbPrintClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.mbLoadClick(Sender: TObject); begin // Покажем диалог, и если он отработал, то загрузим в контейнер if OpenDialog1.Execute and (OpenDialog1.FileName<>'') then OleContainer1.CreateObjectFromFile(OpenDialog1.FileName,false); // Если загрузилось что-нибудь, то покажем if OleContainer1.State <> osEmpty then OleContainer1.DoVerb(ovShow); end; procedure TForm1.mbPrintClick(Sender: TObject); var V : Variant; begin if OleContainer1.State = osEmpty then Begin MessageDlg('OLE не загружен !!', mtError, [mbOk],0); exit; end; // Получаем объект, который воплощает в себе WordBasic интерфейс V := OleContainer1.OleObject.Application.WordBasic; // Командуем до одурения .... V.FilePrint; end; end.