• TForm 
  • fsStayOnTop ~не наверху~
  • Без иконки в панели задач?
  • Передача переменных форме
  • Освобождение экземпляров формы
  • Условие создания главной формы?
  • Динамическое создание и циклическое связывание форм
  • Как заставить формы минимизироваться на панель задач с анимацией?
  • Перемещение формы не за заголовок III
  • Перемещение формы не за заголовок IV
  • Как работать с формой, куда динамически передаются страницы (PageControl) из форм-хранителей (с использованием наследования)?
  • IMHO файл *.dfm – это компилированный ресурс с определением установок формы. А можно ли как-то увидеть этот ресуpс в исходном виде?
  • Определение перемещения формы
  • Можно ли сделать так – одновременно иметь на экране всегда доступную форму – например, "Навигатор", и, открывая модальные формы, иметь всегда доступ к форме "Навигатор"?
  • Как создать окна непрямоугольной формы и работать с ними?
  • Как запретить кнопку Close [×] в заголовке окна?
  • Мерцание формы
  • Минимизация модального окна
  • Прозрачная форма
  • Каким образом можно изменить системное меню формы?
  • Как сделать MDI-приложение, в котором способны сливаться не только меню дочернего и главного окна, но и полосы инструментов?
  • Заполнение изображением MDI-формы IV
  • Предотвращение закрытия формы
  • Немедленный TrayIcon после старта приложения
  • Заполнение формы изображением
  • Создание консольных приложений
  • События приложения
  • Нужны ли мне формы в сервере приложений?
  • Создание формы на основе строки
  • Показ логотипа при запуске приложения III
  • Показ логотипа при запуске приложения IV
  • Как правильно закрыть и удалить форму? Почему моя MDI Child форма при закрывании просто минимизируется?
  • Как установить максимальный и минимальный размер формы
  • TIniFile 
  • Проблемы ini-файла
  • Как создать Ini-файл в директории программы?
  • TRegistry 
  • Дополненный TRegistry, умеет работать с значениями типа REG_MULTI_SZ (Windows NT, Windows 2000)
  • Как я могу определить доступные сервера приложений на этой машине через Registry?
  • Классы 

    TForm 

    fsStayOnTop ~не наверху~

    Delphi 1 

    Тема: fsStayOnTop ~не наверху~

    От: Philip Kapusta  74170,3550

    Почему, если присвоить свойству FormStyle значение fsStayOnTop, форма так и не остается на самом верху?

    Просто добавьте application.RestoreTopMosts в обработчик события формы OnPaint. Это ошибка.

    Могли бы вы рассказать об этом чуть-чуть поподробнее? Delphi где-то в неправильном месте осуществляет вызов NormalizeTopMosts?

    Borland говорит что это Windows, но это случается когда StayonTop-форма НЕ является главной формой. (Некоторые английские программисты чтобы получить эту отговорку потратили несколько сотен долларов, звоня в американскую службу помощи по телефону 1-800).

    – Fred S. 

    Без иконки в панели задач?

    Если вы не хотите, чтобы ваше приложение имело иконку в панели задач, добавьте следующие строки в исходный код проекта:

    Application.CreateHandle;

    ShowWindow(Application.Handle, SW_HIDE);

    Application.ShowMainForm := FALSE;

    Да, чуть не забыл, есть еще одна вещь. При нормальном поведении TApplication создает дескриптор и показывает окно прежде, чем далее начнет что-то «происходить». Чтобы избежать этого, вам необходимо создать модуль, содержащий единственную строчку в секции initialization:

    IsLibrary := True;

    … и поместить этот модуль ПЕРВЫМ в .DPR-файле в списке используемых модулей. Этим мы «одурачиваем» TApplication, и оно думает что оно запущено из DLL, тем самым изменяя свое обычное поведение.

    – Neil J. Rubenking

    Передача переменных форме

    Delphi 1


    …поможете мне создать функцию, с помощью которой я передам переменные в TFormClass? Проблема в том, что MyDlg.Execute() не захотела компилироваться, поскольку, как сообщил мне компилятор, я не могу использовать MyDlg (определенный как: TForm).

    Эта функция может выглядеть примерно так:

    function ExecuteDialog(FormClass: TFormClass; var Data): Boolean;

    Я могу вам дать еще один совет: сделать все ваши формы наследниками одного класса, в котором объявлены виртуальные методы SetData и GetData.

    { ----------------------- }

    unit ExecFrms;

    interface

    uses Forms, Controls;

    type TExecForm = class(TForm)

    public

     procedure GetData(var Data); virtual; abstract;

     procedure SetData(var Data); virtual; abstract;

    end;

    TExecFormClass = class of TExecForm;


    function ExecuteDialog(FormClass: TExecFormClass; var Data): Boolean;


    implementation


    function ExecuteDialog(FormClass: TExecFormClass; var Data): Boolean;

    begin

     with FormClass.Create(Application) do try

      SetData(Data);

      Result := ShowModal = mrOK;

      if Result then GetData(Data);

     finally

      Release;

     end;

    end;

    end.

    { ----------------------- }

    Как вы можете видеть, я поместил функцию ExecuteDialog в тот же самый модуль.

    После того как Delphi создаст форму, вы должны в модуле формы сделать четыре вещи:

    1. вручную измените предка формы, с TForm на TExecForm;

    2. добавьте ExecFrms в список используемых модулей;

    3. добавьте тип записи для хранения данных, необходимых диалогу; и

    4. перекрыть методы SetData и GetData.

    { ----------------------- }

    unit MyDlgs;

    interface

    uses WinTypes, WinProcs, Classes, Graphics, Forms,Controls, Buttons, StdCtrls, Spin, ExtCtrls, ExecFrms;


    type

     { Запись для данных, необходимых модальной форме... }

     TMyDlgData = record

      FormCaption: string;

      FormWidth: Integer;

     end;


     TMyDlg = class(TExecForm)

      OKBtn: TBitBtn;

      CancelBtn: TBitBtn;

      HelpBtn: TBitBtn;

      Bevel1: TBevel;

      Edit1: TEdit;

      SpinEdit1: TSpinEdit;

     public

      procedure SetData(var Data); override;

      procedure GetData(var Data); override;

     end;


    var MyDlg: TMyDlg;


    implementation


    {$R *.DFM}


    procedure TMyDlg.SetData(var Data);

    begin

     with TMyDlgData(Data) do begin

      Edit1.Text := FormCaption;

      SpinEdit1.Value := FormWidth;

     end;

    end;


    procedure TMyDlg.GetData(var Data);

    begin

     with TMyDlgData(Data) do begin

      FormCaption := Edit1.Text;

      FormWidth := SpinEdit1.Value;

     end;

    end;


    end.

    { ----------------------- }

    Затем создаем и выполняем диалог, который должен выглядеть приблизительно так:

    { Добавьте ExecFrms и MyDlgs в список USES вызывающего модуля. }

    procedure TForm1.GetNewCaptionAndWidthBtnClick(Sender: TObject);

    var Data: TMyDlgData;

    begin

    Data.FormCaption := Caption;

     Data.FormWidth := Width;

     if ExecuteDialog(TMyDlg, Data) then begin

      Caption := Data.FormCaption;

      Width := Data.FormWidth;

     end;

    end;

    Не поверите: данный код работает еще со времён Turbo Vision!

    – Ed Jordan

    Освобождение экземпляров формы

    Delphi 1

    В нашем примере для решения задачи мы передаем конструктору переменную формы. Затем, при закрытии формы, мы сбрасываем эту переменную.

    Естественно, эта технология подразумевает написание некоторого кода, поэтому, если вы не расположены к этому действию, пропустите мое дальнейшее повествование.

    TMyForm = class(TForm)

    private

     FormVar: ^TMyForm;

    public

     constructor Create(AOwner: TComponent; var AFormVar: TMyForm);

     destructor Destroy; override;

    end;


    constructor TMyForm.Create(AOwner: TComponent; var AFormVar: TMyForm);

    begin

     FormVar := @AFormVar;

     inherited Create;

     .....

    end;


    destructor TMyForm.Destroy;

    begin

     FormVar^ := nil;

     inherited Destroy;

    end;


    MyForm := TMyForm.Create(Self, MyForm);

    MyOtherForm := TMyForm.Create(Self, MyOtherForm);

    Этот код при разрушении окна автоматически сбрасывает все, что вы передаете в AFormVar, в nil.

    Как вы, наверное, заметили, частный член FormVar реально является указателем на указатель. Так, читая содержимое памяти, адрес которой содержится в FormVar, мы реально получаем переменную формы. Таким образом мы можем просто установить ее в nil.

    – Jeff Fisher 

    Условие создания главной формы?

    Delphi 2 

    Существует ли в Delphi возможность создавать главную форму по условию? Я хочу использовать условие IF (в зависимости от передаваемого параметра) для того, чтобы определить какая форма будет главной при старте приложения. Фактически «другую» форму НЕ нужно будет загружать.

    Хитрость здесь заключается в том, что мы предоставляем компилятору весь необходимый для создания форм код, но не допускаем его выполнения (IF FALSE THEN), при этом компилятор не ругается, а мы тем временем (во время выполнения приложения) выбираем и создаем главную форму. Вот пример кода, измененный .DPR-файл, который при старте случайным образом выбирает из друх форм главную:

    begin

     IF FALSE THEN BEGIN

      Application.CreateForm(TForm1, Form1);

      Application.CreateForm(TForm2, Form2);

     END;

     Randomize;

     IF Random < 0.5 THEN Application.CreateForm(TForm1, Form1)

     ELSE Application.CreateForm(TForm2, Form2);

     Application.Run;

    end.

    Пара «подходящих» для CreateForm форм заключено в никогда не выполнимый блок, тем самым приводя компилятор в состояние свинячего восторга.

    – Neil Rubenking

    Динамическое создание и циклическое связывание форм

    Тема: Динамическое создание и циклическое связывание форм

    Как сделать простой метод, переключающий между формами?

    Как мне добавить возвращаемые результаты к моей ShowModal-форме?

    Как мне создавать экземпляры форм во время выполнения приложения?

    Необходимый для осуществления этого метод очень прост. В моем примере я использую 3 формы с именами Mainform, Form1 и Form2. На Mainform я установил кнопку, которая выводит Form1, из нее вы можете вызвать любое количество форм (перемещаться между ними) через соответствующие кнопки, расположенные на этих формах. В моем примере "переключение" происходит между формами Form1 и Form2.

    Шаг 1. Разместите следующие две строчки в секции interface той формы, которая у вас будет главной:

    const

     mrNext = 100;

     mrPrevious = 101;

    Шаг 2. Разместите на главной форме кнопку и добавьте следующий код в обработчик события ее нажатия:

    var

     MyForm: TForm;

     R, CurForm: Integer;

    begin

     R := 0;

     CurForm := 1;

     while R <> mrCancel do begin

      Case CurForm of

      1: MyForm := TForm1.Create(Application);

      2: MyForm := TForm2.Create(Application);

      end;

      try

      R := MyForm.ShowModal;

      finally

      MyForm.Free;

      end;

      case R of

      MrNext : Inc(CurForm);

      MrPrevious : Dec(CurForm);

      end;

      // эти 2 строчки позволят нам не выходить за границы

      if CurForm < 1 then CurForm := 2

      else if CurForm > 2 then CurForm  := 1;

     end; // while

    end;

    Шаг 3. Добавьте формы 1 и 2 (и любые другие, какие вы хотите иметь) в список используемых модулей формы mainform.

    Шаг 4. В форме Form1 и Form2 добавьте MainForm в список используемых модулей (чтобы они видели константы.)

    Шаг 5. На форму Form1, Form2, и все последующие, добавьте 2 TBitBtn'а, с заголовками «Next» и «Previous». In the Onclick Events for these buttons add the following line of code.

    Если это кнопка Next, добавьте: ModalResult := mrNext;

    Если это кнопка Previous, добавьте: ModalResult := mrPrevious;

    Как заставить формы минимизироваться на панель задач с анимацией?


    Nomadic советует:

    Дело-то вот в чем: Главным окном программы дельфийской является не главная форма, а окно TApplication, которое имеет нулевые размеры, поэтому его не видно. Именно для него показывается иконка на панели задач. Когда пользователь нажимает кнопку минимизации на главной форме, команда минимизации передается этому окну, и сворачивается именно оно, а для остальных просто делается hide. А так как окно TApplication имеет нулевые размеры, то и анимации никакой не видно.

    А чтобы этого избежать, необходимо:

    В исходном тесте модуля проекта после вызова Application.Initialize выполнить вызов

    // В исходном тесте модуля проекта после вызова Application.Initialize

    SetWindowLong(Application.Handle, GWL_EXSTYLE, GetWindowLong(Application.Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW);

    В исходном тексте модуля главной формы перекрыть следующие методы –

    // // В классе формы

    // Интерфейс

    protected

     procedure CreateParams(var p: TCreateParams); override;

     procedure WMSysCommand(var m: TMessage); message WM_SYSCOMMAND;


    // Реализация

    procedure TMainForm.CreateParams(var p: TCreateParams);

    begin

     inherited;

     p.WndParent := 0;

    end;


    procedure TMainForm.WMSysCommand(var m: TMessage);

    begin

     m.Result := DefWindowProc(Handle, m.Msg, m.wParam, m.lParam);

    end;

    Вместо SetWindowLong в MDI-приложениях лучше использовать

    ShowWindow(Application.Handle, SW_HIDE);

    Перемещение формы не за заголовок III


    Ситников Митрий советует:

    В следующем примере показано как можно передвигать форму если пользователь "захватил" Client-пространство:

    unit Main;


    interface


    uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;


    type TForm1 = class(TForm)

     Button1: TButton;

     procedure Button1Click(Sender: TObject);

     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);

    private

     { Private declarations }

    public

     { Public declarations }

    end;


    var

     Form1: TForm1;

     MX: integer;

     MY: integer;


    implementation


    {$R *.DFM}


    procedure TForm1.Button1Click(Sender: TObject);

    begin

     Close;

    end;


    procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

    begin

     if Shift<>[ssLeft] then begin

      MX:=X;

      MY:=Y;

     end else begin

      Left:=Left+X-MX;

      Top:=Top+Y-MY;

     end;

    end;

    end.

    Перемещение формы не за заголовок IV

    Как мне переместить форму, не имеющую заголовка?

    Выберите элемент управления (или саму форму) и напишите это в его (ее) обработчике события OnMouseDown (данный пример дан только для формы):

    procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

    begin

     ReleaseCapture;

     Perform(WM_SYSCOMMAND, SC_MOVE+2, 0);

    end;

    Классно! Намного проще метода NCHitTest, который я предлагал. Хотя многое из того, чтобы вы мне написали, я не понял. Для чего нужно прибавлять 2 к параметру SC_MOVE? В справке по API об этом ничего не сказано.

    Ну хорошо, есть недокументированный способ сообщить Windows о необходимости перемещения окна таким же способом, что и с помощью заголовка (это может вызвать неадекватную реакцию системы, не делайте этого!). Другим способом перемещения окна является перекрытие WMNCHITTEST и возвращения им значения HTCAPTION. Тем не менее, обычно я предпочитаю пользоваться методом SC_MOVE+2, поскольку он не требует создания потомков, а только создание обработчика OnMouseDown. Отчасти аналогично, вы можете добавлять константы SC_SIZE к WM_SYSCOMMAND для получения размера окна подобно тому, как если бы вы потянули его за бордюрчик. В основном мы добавляем код hittest – 9. В следующем классе определена панель, которая сама изменяет свои размеры при щелчке в ее нижнем правом углу, и сама перемещается, если вы щелкнули по ней где-то еще.

    Type TMovablePanel = Class(TPanel)

    Private

     Procedure wmNCHitTest(Var Message : TWMNCHitTest); message WM_NCHITTEST;

    Protected

     Procedure MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer); override;

    End;


    Procedure TMovablePanel.wmNCHitTest(Var Message : TWMNCHitTest);

    Begin

     With Message, ScreenToClient(Pos) Do

      If (X < Width - 10) And (Y < Height - 10) Then

       Message.Result := HTCAPTION

      Else Message.Result := HTCLIENT;

    End;


    Procedure TMovablePanel.MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);

    Begin

     If Button = mbLeft Then Begin

      ReleaseCapture;

      Perform(WM_SYSCOMMAND, SC_SIZE + HTBOTTOMRIGHT - 9, 0);

     End Else Inherited MouseDown(Button, SHift, X, Y);

    End;

    – Robert Wittig

    Как работать с формой, куда динамически передаются страницы (PageControl) из форм-хранителей (с использованием наследования)?

    Nomadic советует:

    Кидаю проект-болванку, сделанную перед началом работы над основным -

    unit Unit1; //базовая форма хранителя страницы

    interface

    uses ...

    type TBPgFrm = class(TForm)

     Panel1: TPanel;

     PageControl1: TPageControl;

     TabSheet1: TTabSheet;

     Label1: TLabel;

    public

     function PgInit: boolean; virtual;

     function PgValid: boolean; virtual;

    end;


    implementation


    {$R *.DFM}


    function TBPgFrm.PgInit: boolean;

    begin

     result:= MessageDlg(Label1.Caption+': PgInit', mtConfirmation, mbOkCancel, 0)=mrOK;

    end;


    function TBPgFrm.PgValid: boolean;

    begin

     result:= MessageDlg(Label1.Caption+': PgValid', mtConfirmation, mbOkCancel, 0)=mrOK;

    end;

    end.


    unit Unit2; //главная форма проекта; содержит первую страницу

    interface //и кнопки Cancel, Prev & Next/Finish.

    uses ...

    type TPagesDlg = class(TForm)

     Panel1: TPanel;

     Panel2: TPanel;

     PageControl1: TPageControl;

     TabSheet1: TTabSheet;

     Prev: TButton;

     CancelBtn: TButton;

     Next: TButton;

     Label1: TLabel;

     procedure CancelBtnClick(Sender: TObject);

     procedure FormDestroy(Sender: TObject);

     procedure NextClick(Sender: TObject);

     procedure PrevClick(Sender: TObject);

     privateFrms: TList;

     procedure AddForms;

    end;


    var PagesDlg: TPagesDlg;


    implementation


    uses Unit1, Unit3, Unit4, Unit5;


    {$R *.DFM}


    procedure TPagesDlg.AddForms; //размещение динамических страниц

    var i: word;

    begin

     Frms:= TList.Create;

     Frms.Add(TBPgFrm1.Create(Self));

     Frms.Add(TBPgFrm2.Create(Self));

     for i:= 0 to 1 do TBPgFrm(Frms[i]).TabSheet1.PageControl := PageControl1

    end;


    procedure TPagesDlg.CancelBtnClick(Sender: TObject);

    begin

     Close;

    end;


    procedure TPagesDlg.FormDestroy(Sender: TObject);

    var i: word;

    begin

     for i:= Frms.Count-1 downto 0 do TBPgFrm(Frms[i]).Free;

     Frms.Free;

    end;


    procedure TPagesDlg.NextClick(Sender: TObject);

    var

     i: word;

     vi: Boolean;

    begin

     Next.Enabled:= false;

     if PageControl1.PageCount=1 then AddForms;

     i:= PageControl1.ActivePage.PageIndex;

     if i=0 then vi:= true

     else vi:= TBPgFrm(Frms[i-1]).PgValid;

     if vi then

      with PageControl1 do

      if i=PageCount-1 then begin

       CancelBtnClick(Sender);

       exit;

      end else begin

       ActivePage:= FindNextPage(ActivePage, True, false);

       if ActivePage.PageIndex=PageCount-1 then Next.Caption:= 'Finish';

       Prev.Enabled:= true;

       if TBPgFrm(Frms[i]).PgInit then Next.Enabled:= true

       else PrevClick(Sender);

      end else Next.Enabled:= true;

    end;


    procedure TPagesDlg.PrevClick(Sender: TObject);

    begin

     Prev.Enabled:= false;

     with PageControl1 do begin

      ActivePage:= FindNextPage(ActivePage, false, false);

      Prev.Enabled:= ActivePage.PageIndex>0;

     end;

     Next.Caption:= 'Next';

     Next.Enabled:= true;

    end;


    end.


    unit Unit3; //наследник с RadioGroup.

    interface

    uses ...

    type TBPgFrm3 = class(TBPgFrm)

     RadioValid: TRadioGroup;

    public

     function PgValid: boolean; override;

    end;

    implementation


    {$R *.DFM}


    function TBPgFrm3.PgValid: boolean;

    begin

     result:= RadioValid.ItemIndex=0;

    end;


    end.


    unit Unit4; // наследник с CheckBox.

    interface

    uses ...

    type TBPgFrm2 = class(TBPgFrm)

     CheckValid: TCheckBox;

    public

     function PgValid: boolean; override;

    end;

    implementation


    {$R *.DFM}


    function TBPgFrm2.PgValid: boolean;

    begin

     result:= CheckValid.Checked;

    end;

    end.

    В Delphi 4 появились новые возможности, в частности, возможность докинга визуальных компонент, в частности, форм, на различные DockSite, в том числе и на TPageControl. Это более удобно. Кроме того, Вы имеете возможность использования TFormLoader из библиотеки VG Library. 

    IMHO файл *.dfm – это компилированный ресурс с определением установок формы. А можно ли как-то увидеть этот ресуpс в исходном виде?

    Nomadic советует: 

    1. File|Open… ТвояФорма.DFM – увидишь текст;

    2. «Delphi\bin\convert ТвояФорма.DFM» — получится ТвояФорма.TXT (можно и наоборот).

    Идею в массы: в DN/VC/NC можно настроить viewer'ом .DFM .BAT'ник, который скажет convert;wpview;del – и заглядывать в .DFM не открывая Delphi.

    Кстати, функции, которые реализуют это преобразование, доступны для использования в личных целях :)

    CLASSES.PAS:

    […]

    { Object conversion routines }

    procedure ObjectBinaryToText(Input, Output: TStream);

    procedure ObjectTextToBinary(Input, Output: TStream);


    procedure ObjectResourceToText(Input, Output: TStream);

    procedure ObjectTextToResource(Input, Output: TStream);
     

    Определение перемещения формы

    Кто-нибудь знает как мне определить перемещение пользователем главной формы приложения (не изменение ее размеров), кроме как использования таймера и проверки значений свойств Form.Top и Form.Left?

    Вам можно воспользоваться обработчиками следующих системных сообщений:

    1. WM_WINDOWPOSCHANGING (возникает перед перемещением),

    2. WM_WINDOWPOSCHANGED (возникает после перемещения), или

    3. WM_MOVE (возникает после перемещения)

     – Robert Wittig 

    Можно ли сделать так – одновременно иметь на экране всегда доступную форму – например, "Навигатор", и, открывая модальные формы, иметь всегда доступ к форме "Навигатор"?

    Nomadic советует:

    Обманом можно все.

    procedure ShowAlmostModal(FormModal:TForm);

    begin

     NavigatorForm.Enabled:=false;

     FormModal.ShowModal

    end;

    И вот это привесь на OnShow почти модальной формы

    procedure FormShow(Sender:Tobject);

    begin

     NavigatorForm.Enabled:=true;

    end;

    Как создать окна непрямоугольной формы и работать с ними?

    Nomadic советует:

    Достаточно создать регион нужной формы и вызвать SetWindowRgn —

    HRGN rgn := CreateEllipticRgn(10,10,100,100);

    SetWindowRgn(hMyWnd,rgn); // Вот и будет круглое окно

    При этом регион этот теперь используется Windows и будет уничтожен при закрытии окна.

    Попробуйте вот этот обpаботчик OnCreate : На меня это произвело впечатление.

    procedure TForm1.FormCreate(Sender: TObject);

    const W=36*pi/180;

    var

     R,R1,R2: HRgn;

     X,Y,i:integer;


     function S(a:integer;R:integer):integer;

     begin

      Result:=round(R*sin(W*a));

     end;


     function C(a:integer;R:integer):integer;

     begin

      Result:=round(R*cos(W*a));

     end;


     function GetStarReg(X,Y,R:integer):HRGN;

     var P : array [0..4] of TPoint;

     begin

      P[0] := Point(X, Y-R);

      P[1] := Point(X-S(4,R), Y-C(4,R));

      P[2] := Point(X-S(8,R), Y-C(8,R));

      P[3] := Point(X-S(2,R), Y-C(2,R));

      P[4] := Point(X-S(6,R), Y-C(6,R));

      Result := CreatePolygonRgn(P, 5, WINDING);

     end;


    begin

     X:=Width div 2;

     Y:=Height div 2;

     R:=GetStarReg(X,Y,100);

     i:=1;

     repeat

      R1:=GetStarReg(X-S(i,120),Y-C(i,110),40);

      CombineRgn(R,R,R1,RGN_OR);

      inc(i,2);

     until i>9;

     R1:=GetStarReg(X,Y,30);

     CombineRgn(R,R,R1,RGN_DIFF);

     R1:=CreateEllipticRgn(3,3,Width-6,Height-6);

     R2:=CreateEllipticRgn(20,10,Width-20,Height-10);

     CombineRgn(R1,R1,R2,RGN_DIFF);

     CombineRgn(R,R,R1,RGN_OR);

     SetWindowRgn(Handle, R, True);

    end;

    Как запретить кнопку Close [×] в заголовке окна?

    Nomadic советует:

    Вот кусок, который делает все, что тебе нужно:

    procedure TForm1.FormCreate(Sender: TObject);

    var Style: Longint;

    begin

     Style := GetWindowLong(Handle, GWL_STYLE);

     SetWindowLong(Handle, GWL_STYLE, Style And Not WS_SYSMENU);

    end;


    procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

    begin

     if (Key = VK_F4) and (ssAlt in Shift) then begin

      MessageBeep(0);

      Key := 0;

     end;

    end;


    { Disable close button }

    procedure TForm1.Button1Click(Sender: TObject);

    var SysMenu: HMenu;

    begin

     SysMenu := GetSystemMenu(Handle, False);

     Windows.EnableMenuItem(SysMenu, SC_CLOSE, MF_DISABLED or MF_GRAYED);

    end;


    { Enable close button }

    procedure TForm1.Button2Click(Sender: TObject);

    begin

     GetSystemMenu(Handle, True);

     Perform(WM_NCPAINT, Handle, 0);

    end;

    Но это окно можно закрыть из TaskBar'а. 

    Мерцание формы

    Как бы это осуществить рисование в окне без его дурацкого мерцания и без помощи создания виртуального изображения в памяти? WM_SETREDRAW здесь поможет?

    Попробуйте этот код. Даже если некоторые компоненты имеют пару BeginUpdate / EndUpdate, то для таких компонентов, как TTreeView, интенсивное рисование может послужить причиной перемещения полосы прокрутки и появления других «барабашек». В таких ситуаций вместо дескриптора элемента управления используйте родительский дескриптор.

    procedure BeginScreenUpdate(hwnd : THandle);

    begin

     if (hwnd = 0) then hwnd := Application.MainForm.Handle;

     SendMessage(hwnd, WM_SETREDRAW, 0, 0);

    end;


    procedure EndScreenUpdate(hwnd : THandle; erase : Boolean);

    begin

     if (hwnd = 0) then hwnd := Application.MainForm.Handle;

     SendMessage(hwnd, WM_SETREDRAW, 1, 0);

     RedrawWindow(hwnd, nil, 0, DW_FRAME + RDW_INVALIDATE + RDW_ALLCHILDREN + RDW_NOINTERNALPAINT);

     if (erase) then Windows.InvalidateRect(hwnd, nil, True);

    end;

    – Jeff Johnson 

    Минимизация модального окна

    Мне нужно открыть из моей формы модальное окно, т.е. приостановить работу в моей форме до обработки этого модального окна. Но при этом я теряю возможность убрать (минимизировать) мою форму

    Nomadic советует:

    function TMyForm.Execute: TModalResult;

    begin

     Show;

     try

      SendMessage(Handle, CM_ACTIVATE, 0, 0);

      ModalResult := 0;

      repeat

       Application.HandleMessage;

       if Application.Terminated then ModalResult := mrCancel;

       if ModalResult = mrCancel then CloseModal;

      until ModalResult  <> 0;

      Hide;

      Result := ModalResult;

      SendMessage(Handle, CM_DEACTIVATE, 0, 0);

     finally

      Hide;

     end;

    end;

    Конечно, в TMyForm должно быть FormStyle := fsStayOnTop;

    Прозрачная форма

    Dmitry V. Koreyba советует:

    Высылаю прогу которая делает прозрачной форму. Может кому-нибудь поможет в его дизайнерских изысканиях.

    var FullRgn, ClientRgn, CtlRgn : THandle;


    procedure TForm1.DoInvisible;

    var

     AControl : TControl;

     A, Margin, X, Y, CtlX, CtlY : Integer;

    begin

     Margin := (Width - ClientWidth) div 2;

     FullRgn := CreateRectRgn(0, 0, Width, Height);

     X := Margin;

     Y := Height - ClientHeight - Margin;

     ClientRgn := CreateRectRgn(X, Y, X + ClientWidth, Y + ClientHeight);

     CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);

     for A := 0 to ControlCount - 1 do begin

      AControl := Controls[A];

      if (AControl is TWinControl) or (AControl is TGraphicControl) then

       with AControl do begin

        if Visible then begin

         CtlX := X + Left;

         CtlY := Y + Top;

         CtlRgn := CreateRectRgn(CtlX, CtlY, CtlX + Width, CtlY + Height);

         CombineRgn(FullRgn, FullRgn, CtlRgn, RGN_OR);

        end;

       end;

     end;

     SetWindowRgn(Handle, FullRgn, TRUE);

    end;


    procedure TForm1.FormDestroy(Sender: TObject);

    begin

     DeleteObject(ClientRgn);DeleteObject(FullRgn);

     DeleteObject(CtlRgn);

    end;


    procedure TForm1.DoVisible;

    begin

     FullRgn := CreateRectRgn(0, 0, Width, Height);

     CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);

     SetWindowRgn(Handle, FullRgn, TRUE);

    end;


    procedure TForm1.FormCreate(Sender: TObject);

    begin

     DoInvisible;

    end;

    Каким образом можно изменить системное меню формы?

    Nomadic советует:

    Hе знаю как насчет акселераторов,надо поискать, а вот добавить пункт меню(Item) — пожалуйста

    type TMyForm=class(TForm)

     procedure wmSysCommand(var Message:TMessage); message WM_SYSCOMMAND;

    end;


    const

     ID_ABOUT = WM_USER+1;

     ID_CALENDAR=WM_USER+2;

     ID_EDIT = WM_USER+3;

     ID_ANALIS = WM_USER+4;


    implementation


    procedure TMyForm.wmSysCommand;

    begin

     case Message.wParam of

     ID_CALENDAR:DatBitBtnClick(Self);

     ID_EDIT :EditBitBtnClick(Self);

     ID_ANALIS:AnalisButtonClick(Self);

     end;

     inherited;

    end;


    procedure TMyForm.FormCreate(Sender: TObject);

    var SysMenu:THandle;

    begin

     SysMenu:=GetSystemMenu(Handle,False);

     InsertMenu(SysMenu, Word(-1), MF_SEPARATOR, ID_ABOUT, '');

     InsertMenu(SysMenu, Word(-1), MF_BYPOSITION, ID_Calendar, 'Calendar');

     InsertMenu(SysMenu, Word(-1), MF_BYPOSITION, ID_Analis, 'Analis');

     InsertMenu(SysMenu, Word(-1), MF_BYPOSITION, ID_Edit, 'Edit');

    end;

    Как сделать MDI-приложение, в котором способны сливаться не только меню дочернего и главного окна, но и полосы инструментов?

    Nomadic советует:

    Вариант 1. CoolBar.

    procedure TMainForm.SetBands(AControls: array of TWinControl;ABreaks: array of boolean);

    var i: integer;

    begin

     with CoolBar do begin

      for i:=0 to High(AControls) do begin

       if Bands.Count=succ(i) then TCoolBand.Create(Bands);

       with Bands[succ(i)] do begin

        if Assigned(Control) then Control.Hide;

        MinHeight:=AControls[i].Height;

        Break:=ABreaks[i];

        Control:=AControls[i];

        Control.Show;

        Visible:=true;

       end

      end;

      for i:=High(AControls)+2 to pred(Bands.Count) do Bands[i].Free

     end

    end;

    и

    procedure TMsgForm.FormActivate(Sender: TObject);

    begin

     MainForm.SetBands([ToolBar],[false])

    end;

    Примечание:

    Оба массива равны по длине. CoolBar.Bands[0] должен существовать всегда,.. на нём я размешаю «глобальные» кнопки. СoolBar[1] тоже можно сделать в DesignTime с Break:=false и придвинуть поближе с началу. При CoolBar.AutoSize:=true возможно «мигании» (при добавлении на новую строку) так что можно добавить:

    AutoSize:=false; try … finally AutoSize:=true;

    Вариант 2.

    TMainForm

    object SpeedBar: TPanel

     ...

     Align = alTop

     BevelOuter = bvNone

     object ToolBar: TPanel

      ...

      Align = alLeft

      BevelOuter = bvNone

     end

     object RxSplitter1: TRxSplitter

      ...

      ControlFirst = ToolBar

      ControlSecond = ChildBar

      Align = alLeft

      BevelOuter = bvLowered

     end

     object ChildBar: TPanel

      ...

      Align = alClient

      BevelOuter = bvNone

     end

    end

    TMdiChild {прародитель всех остальных}

    ..

    object pnToolBar: TPanel

     …

     Align = alTop

     BevelOuter = bvNone

     Visible = False

    end

    end;


    procedure TMDIForm.FormActivate(Sender: TObject);

    begin

     pnToolBar.Parent:=MainForm.ChildBar;

     pnToolBar.Visible:=True;

    end;


    procedure TMDIForm.FormDeactivate(Sender: TObject);

    begin

     pnToolBar.Visible:=false;

     pnToolBar.Parent:=self

     {pnToolBar.Visible:=false}

    end;

    Заполнение изображением MDI-формы IV

    Nomadic советует:

    Я делал так:

    type

    …. = class(TForm)

     ....

     procedure FormCreate(Sender:TObject);

     procedure FormDestroy(Sender:TObject);

     ....

    private

     FHBrush: HBRUSH;

     FCover: TBitmap;

     FNewClientInstance: TFarProc;

     FOldClientInstance: TFarProc;

     procedure NewClientWndProc(var Message:TMessage);

     ....

    protected

     ....

     procedure CreateWnd; override;

     ....

    end;


    .....


    implementation


    {$R myRes.res} //ресурс с битмапом фона


    procedure .FormCreate(...);

    var LogBrush:TLogbrush;

    begin

     FCover:=TBitmap.Create;

     FCover.LoadFromResourceName(hinstance,'BMPCOVER');

     With LogBrush do begin

      lbStyle:=BS_PATTERN;

      lbHatch:=FCover.Handle;

     end;

     FHBrush:=CreateBrushIndirect(Logbrush);

    end;


    procedure .FormDestroy(...);

    begin

     DeleteObject(FHBrush);

     FCover.Free;

    end;


    procedure .CreateWnd;

    begin

     inherited CreateWnd;

     if (ClientHandle <> 0) then begin

      if NewStyleControls then

       SetWindowLong(ClientHandle, GWL_EXSTYLE, WS_EX_CLIENTEDGE or GetWindowLong(ClientHandle, GWL_EXSTYLE));

      FNewClientInstance:=MakeObjectInstance(NewClientWndProc);

      FOldClientInstance:=pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));

      SetWindowLong(ClientHandle, GWL_WNDPROC, longint(FNewClientInstance));

     end;

    end;


    procedure .NewClientWndProc(var Message:TMessage);


     procedure Default;

     begin

      with Message do

       Result := CallWindowProc(FOldClientInstance, ClientHandle, Msg, wParam, lParam);

     end;


    begin

     with Message do begin

      case Msg of

      WM_ERASEBKGND:

       begin

        FillRect(TWMEraseBkGnd(Message).DC, ClientRect,FHBrush);

        Result := 1;

       end;

      else

       Default;

      end;

     end;

    end;
     

    Предотвращение закрытия формы

    Igor Nikolaev aKa The Sprite советует:

    Следующий текст убирает команду закрыть из системного меню и одновременно делает серой кнопку закрыть в заголовке формы:

    procedure TForm1.FormCreate(Sender: TObject);

    var hMenuHandle:HMENU;

    begin

     hMenuHandle := GetSystemMenu(Handle, FALSE);

     IF (hMenuHandle <> 0) THEN DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);

    end;
     

    Немедленный TrayIcon после старта приложения

    Нужно чтобы при запуске приложения сразу исчезала с экрана главная форма и появлялась TrayIcon. В Ваших «Советы по Дельфи» на данный вопрос я нашел два решения (раздел Классы/TForm) к сожалению ни одно решения на моем компьютере не работало :-(. В связи с этим было решено продолжить поиск, и решение было найдено:

    На Главную форму приложения помещаем компонент (TEdit или другой любой, который может иметь фокус), затем устанавливаем свойства:

    Visible:=True;

    TabOrder:=0;

    В обработчик события OnEnter записываем (этот код взял из «Советов по Дельфи»):

    Application.Minimize;

    ShowWindow(Application.Handle, SW_HIDE);

    Button1.SetFocus; //Устанавливаем фокус на другой компонент формы (у меня был Button1 )

    Edit1.Visible:=False; //Делаем добавочный компонент невидимым – т.к. он больше нам не нужен

    Механизм работы:

    При запуске приложения создается форма и фокус получает компонент со свойством TabOrder:=0, при получении фокуса вызывается процедура OnEnter для нашего компонента и происходит скрытие формы.

    Для восстановления формы необходим код:

    ShowWindow(Application.Handle, SW_RESTORE);

    Application.Restore;

    Для реализации TrayIcon был использован компонент TRxTrayIcon из библиотеки RxLib ver.2.75 Данное решение имеет один недостаток – незначительное мерцание формы при ее сворачивании.

    -----------------------------------------------------------------

    С уважением Пащенко Андрей Владимирович (Bibigon)

    г.Архангельск, 2000. 

    Заполнение формы изображением

    Почитал я тут ваши 'Советы ……' и решил дополнить ответ по теме создание фона на форме раздела классы\tform

    Чтобы заполнить вашу форму повторяющимся изображением нужно

    1. Разместить на форме image

    2. Присвоить его свойству visible значение false

    3. В обработчике события формы OnCreate разместить следующий код : 

    form1.brush.bitmap:=image1.picture.bitmap;

    Хочу заметить , что при использовании этого св-ва св-ва color & style не действительны! А самое главное при изменении размеров формы ваше повторяюшееся изображение будет автоматически перересовываться и вам не понадобится обрабатывать событие paint & resize.

    С уважением, Dmitry Morsin

    Создание консольных приложений

    Создание консольных приложений. (Об этом в советах немножко есть, но очень не конкретно)

    Как уже отмечалось в совете [000092] (да и в Хелпе) в консольных приложениях в Delphi можно использовать в принципе весь дельфийский арсенал. Правда и работать они будут лишь под Windows. (Кстати этот способ можно применить для модернизации программ на Паскале под Windows).

    Этот код был использован для вывода результатов работы программы проверки (неважно чего) чтобы не приходилось смотреть файл с результатами. Главная проблема была в том, что консоль (если запуск был из Windows) оставалась висеть позади формы до её закрытия. Вреда конечно никакого, но не приятно. Если же запуск из Нортона или т.п., то всё идёт нормально

    Program MyProgram;

    {$APPTYPE CONSOLE}

    uses

     Windows, Forms, Dialogs, SysUtils, StdCtrls, Controls; // и (или) т.п.

     …

    var

     …

     SH,SW: integer;

     MainForm: TForm; // если нужна форма

     Memo: TMemo;

     // могут быть также любые другие визуальные компоненты

     …

     // здесь могут быть процедуры и функции, т.е всё как в обычном Паскале


    Begin

     … // здесь какой-то код

     { а здесь, перед выводом формы, есть два пути:}

     { так}

     FreeConsole; // Отцепиться от консоли, т.е она просто исчезнет (в случае запуска из Windows) и останется только форма

     { или так}

     //  Handle:= GetForegroundWindow; // Получить Handle консоли

     //  ShowWindow(Handle, SW_HIDE);  // Спрятать консоль

     // а в конце, перед завершением

     //  ShowWindow(Handle, SW_SHOW); // Показать консоль


     { для помещения формы в центр экрана}

     SH:= Screen.Height;

     SW:= Screen.Width;

     MainForm:= TForm.Create(nil);

     with MainForm do try

      BorderStyle:= bsSizeable;

      Height:= 390;

      Width:= 390;

      Left:= (SW - Width) div 2;

      Top:= (SH - Height) div 2;

      Caption:= 'Моя программа';

      // здесь могут быть и другие компоненты

      Memo:= TMemo.Create(MainForm);

      with Memo do begin

       Parent:= MainForm;

       Align:= alClient;

       BorderStyle:= bsNone;

       Font.Name:= 'Courier New Cyr';

       Font.Size:= 9;

       ScrollBars:= ssVertical;

       Lines.LoadFromFile('MyProgram.txt');

      end;

      ShowModal;

     finally

      Free;

     end;

     { или можно вывести сообщение, например в случае неудачи (или наоборот)}

     with CreateMessageDialog('Текст сообщения', mtInformation, [mbOk]) do try

      Caption := 'Заголовок';

      ShowModal;

     finally

      Free;

     end;


     // это для второго пути, иначе она так и останется висеть свёрнутой

     // ShowWindow(Handle, SW_SHOW); // Показать консоль

    End.

    С уважением, Михаил Чумак

    События приложения

    Delphi 1 

    …проблема в том, что когда приложение Delphi минимизировано, десктиптор окна в этом случае совершенно другой. Объект Application в действительности дескриптор собственного окна! Application.Handle является окном, которое активно при минимизированном приложении. Когда вы минимизируете ваше приложение, все формы просто прячутся (hidden). Обратите внимание на методы Application Minimize и Restore. Также обратите внимание, что у TApplication есть два недокументированных события, OnMinimize и OnRestore. Они принадлежат приложению, поскольку в TForm нет обработчиков событий, возникающих при минимизации главного окна. Немного странно. Я думаю так сделано для поддержки SDI-приложений. 

    Нужны ли мне формы в сервере приложений?

    Nomadic отвечает:

    Да.

    Необязательно, чтобы они были видимы, но должна присутствовать хотя бы одна. Чтобы сделать главную форму невидимой, установите

    Application.ShowMainForm := False

    в файле проекта.

    Пример:

    begin

     Application.ShowMainForm := False;

     Application.Initialize;

     Application.CreateForm(TForm1, Form1);

     Application.Run;

    end.

    Создание формы на основе строки

    Обзор

    В данном документе рассказывается о том, как в Delрhi можно создать экземпляр формы на основе строки, содержащей имя типа. Код примера прилагается.

    На кого расчитан данный документ?

    На любого программиста, имеющего начальные знания для работы с Delphi. Имеет отношение к любой версии Delphi.

    Создание формы на основе строки

    Чтобы можно было создать экземпляр формы на основе строки, содержащей имя типа, вы должны в первую очередь зарегистрировать данный тип в Delphi. Это выполняется функцией "RegisterClass". RegisterClass описан следующим образом:

    procedure RegisterClass(AClass: TPersistentClass);

    AClass – класс TPersistent. Другими словами, класс, который вы хотите регистрировать, в какой-то точке должен наследоваться от TPersistent. Поскольку все элементы управления Delphi, включая формы, соблюдают это требование, то проблем быть не должно. Но такой способ не пройдет, если регистрируемые классы наследуются непосредственно от TObject.

    После регистрации класса, вы можете найти указатель на тип, передавая строку в FindClass. Функция возвратит ссылку на класс, которую можно использовать для создания формы. Небольшой поясняющий пример:

    procedure TForm1.Button2Click(Sender: TObject);

    var

     b : TForm;

     f : TFormClass;

    begin

     f := TFormClass(findClass('Tform2'));

     b := f.create(self);

     b.show;

    end;

    Данный код создаст тип TForm2, который мы зарегистрировали с помощью RegisterClass.

    Демонстрационный проект

    Создайте новый проект, затем добавьте 4 формы так, чтобы в общей сложности получилось 5. В реальном проекте вы можете заполнить их необходимыми элементами управления, для данного же примера это не важно.

    В первой форме разместите поле редактирования и кнопку. Удалите все формы, кроме главной, из списка AutoCreate. Наконец, скопируйте приведенный ниже код в unit1, он позволит вам создавать форму по имени типа класса, введенному в поле редактирования.

    unit Unit1;


    interface


    uses Unit2, Unit3, Unit4, Unit5, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;


    type TForm1 = class(TForm)

     Edit1: TEdit;

     Button1: TButton;

     procedure FormCreate(Sender: TObject);

     procedure Button1Click(Sender: TObject);

    private

     { Private declarations }

    public

     { Public declarations }

    end;


    var Form1: TForm1;


    implementation


    {$R *.DFM}


    procedure TForm1.FormCreate(Sender: TObject);

    begin

     RegisterClass(Tform2);

     RegisterClass(Tform3);

     RegisterClass(Tform4);

     RegisterClass(Tform5);

    end;


    procedure TForm1.Button1Click(Sender: TObject);

    var f : Tformclass;

    begin

     f := tformclass(findClass(edit1.text));

     with f.create(self) do show;

    end;
     

    Показ логотипа при запуске приложения III

    Своим опытом делится Nomadic :

    A: Смотрите пример в X:\DELPHI\DEMOS\DB\MASTAPP\mastapp.dpr.

    Удобно использовать функцию ShowSplashWindow из rxLib. 

    Показ логотипа при запуске приложения IV

    Как добавить логотип к вашему приложению

    Логотип (заставка) является важной составляющей вашего приложения. Он позволяет занять время во время загрузки и сообщить пользователю дополнительные сведения о программе. Логотип сделает ваше приложение более профессиональным.

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

    Имеется множество типов заставок (Splash Screen). Самый распространный тип - показ логотипа во время загрузки приложения. Обычно такие экраны отображают имя приложения, автора, версию, авторские права и изображение или иконку, идентифицирующую приложение.

    Также, некоторые приложения используют этот экран для показа линейки прогресса при выполнении длительного процесса. Примером такого типа экрана может быть диалог с выводом числа процентов выполненного запроса к базе данных, файловая задача, или задача обработки чисел. При длительных процессах наличие такого диалога означает вежливость программы по отношению к пользователю.

    Надеюсь, вы оценили преимущества заставок. Давайте теперь попробуем создать простую заставку своими руками.

    1. Добавьте форму в ваш проект --> File | New Form.. Комментарий: Заставка (Splash Screen) похожа на любую другую форму.

    2. Измените свойство формы Name на SplashScreen

    3. Измените свойство формы BorderStyle на bsNone

    4. Измените свойство формы Position на poScreenCenter

    5. Сделайте заставку привлекательной и функциональной путем добавления на нее необходимых компонентов и изображений. (компоненты Label, Panel, Image, Shape и Bevel)

    6. Отредактируйте свойства добавленных компонентов

    7. Выберите в меню Delphi IDE Options | Project

    8. Уберите SplashScreen-форму из списка Auto-create-списка (списка автоматически создаваемых форм)

    Комментарий: Вы динамически создаете экземпляр заставки

    9. Добавьте модуль, содержащий TSplashScreen, в список используемых модулей главной формы вашего приложения. Пример:

    unit Unit1;

    interface

    uses SysUtils, WinTypes, WinProcs, Messages, Classes,Graphics, Controls, Forms, Dialogs, StdCtrls, unit2;  <– поместите сюда

    Комментарий: В нашем примере TSplashScreen объявлен в Unit2

    10. Выберите в меню Delphi IDE View | Project Source

    11. Вставьте между ключевым словом begin и перед любым Application.Create() следующий код:

    SplashScreen := TSplashScreen.Create(Application);

    SplashScreen.Show;

    SplashScreen.Refresh;

    12. Измените поведение главной формы приложения при наступлении события OnShow. Добавьте следующий код:

    SplashScreen.Free;

    Комментарий: Реализация заставки с линейкой прогресса ничуть не сложнее, чем приведенный выше пример. Необходимо всего лишь вовремя выводить ее на экран: перед тем, как процесс начнется, и убирать только после того, как он закончится. Различие заключается в осуществлении связи (реализации механизма) между процессом и заставкой для правильного обновления линейки прогресса.

    13. Запустите приложение. В приведенном выше примере, если скорость вашего компьютера значительна, то заставки вы можете и не увидеть. Следующий код демонстрирует технику создания заставки для вашего приложения — только будьте осмотрительней при его использовании.

    Добавьте следующий код на этапе #11:

    for x:= 1 to 10000000 do begin

     x:=x;

    end;


    {PROJECT1.DPR}

    program Project1;

    uses Forms, Unit1 in 'UNIT1.PAS' {Form1}, Unit2 in 'UNIT2.PAS' {SplashScreen};


    {$R *.RES}

    var x: longint;

    begin

     SplashScreen:= TSplashScreen.Create(Application);

     SplashScreen.Show;SplashScreen.Refresh;

     for x:= 1 to 10000000 do begin

      x:=x;

      x:=x;

     end;

     Application.CreateForm(TForm1, Form1);

     Application.Run;

    end.


    {UNIT1.PAS}

    unit Unit1;

    interface

    uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, unit2;

    type TForm1 = class(TForm)

     procedure FormShow(Sender: TObject);

    private

     { Private declarations }

    public

     { Public declarations }

    end;


    var Form1: TForm1;

    implementation

    {$R *.DFM}

    procedure TForm1.FormShow(Sender: TObject);

    begin

      splashscreen.free;

    end;

    end.


    {UNIT2.PAS}

    unit Unit2;

    interface

    uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

    type TSplashScreen = class(TForm)

     Panel1: TPanel;

     Label1: TLabel;

     Label2: TLabel;

     Label3: TLabel;

     Shape1: TShape;

     Shape2: TShape;

     Shape3: TShape;

    private

     { Private declarations }

    public

     { Public declarations }

    end;


    var SplashScreen: TSplashScreen;

    implementation

     {$R *.DFM}

    end.
     

    Как правильно закрыть и удалить форму? Почему моя MDI Child форма при закрывании просто минимизируется?

    Своим опытом делится Nomadic:

    A: Обрабатывайте событие OnClose для формы и выставляйте в нем параметр Action в caFree. Дело в том, что его значение по умолчанию для MDI Child форм caMinimize. Кстати, если сделать Action := caNone, то форму нельзя будет закрыть.

    Как установить максимальный и минимальный размер формы

    Если вы хотите контролировать изменение пользователем размера вашей формы, воспользуйтесь установкой значения MinMax. (Если для этих целей вы используете метод resize, это работает, но выглядит не так хорошо.)

    Примечание: Чтобы совсем запретить пользователю изменять размеры формы, задайте одинаковые значения для ее минимального и максимального значения. Вот пример того, как можно объявить и использовать в вашем приложении обработку системного сообщения wm_GetMinMaxInfo:

    unit MinMax;


    interface


    uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs;


    type TForm1 = class(TForm)

    private

     { Private declarations }

     procedure WMGetMinMaxInfo(var MSG: Tmessage); message WM_GetMinMaxInfo;

    public

     { Public declarations }

    end;


    var Form1: TForm1;


    implementation


    {$R *.DFM}


    procedure TForm1.WMGetMinMaxInfo(var MSG: Tmessage);

    Begin

     inherited;

     with PMinMaxInfo(MSG.lparam)^ do begin

      with ptMinTrackSize do begin

       X := 300;

       Y := 150;

      end;

      with ptMaxTrackSize  do begin

       X := 350;

       Y := 250;

      end;

     end;

    end;

    end.
     

    TIniFile 

    Проблемы ini-файла

    Кто-нибудь имел какие-нибудь проблемы при использовании модуля TIniFile? Я думаю здесь какая-то детская проблема с кэшированием!!!

    Вот что я делал:

    (* c:\test.ini уже существует *)

    myIni := TIniFile.Create('c:\test.ini');

    With myIni do begin

     …. (добавляем новую секцию в test.ini

    end;

    myIni.Free;

    RenameFile('c:\test.ini', 'c:\test1.ini');

    Что я получил:

    1. test1.ini НЕ ИМЕЕТ добавленной мною секции;

    2. всякий раз при создании или открытии нового файла в том же самом каталоге с помощью File Manager, 'c:\test.ini' появляется вновь, и у него СУЩЕСТВУЕТ секция, которую я добавлял.

    Я решил эту проблему добавлением следующей строки перед IniFile.Free:

    WritePrivateProfileString(nil, nil, nil, PChar(IniFileName));

    Для получения дополнительной информации обратитесь к электронной справке к разделу 'WritePrivateProfileString'.

    – Tony Chang 

    Как создать Ini-файл в директории программы?

    По умолчанию ini-файл создается в Windows-директории (например: TIniFile.Create('MFile.ini')), что приводит к «захламлению» оной. Более (эко-)логично (за исключением случаев, когда программа делается для CD-ROM) если ini-файл создается в той же директории что и главная программа. Вот пример чтения и записи ini файла из директории программы:

    function ReadIni(ASection, AString : String) : String;

    var

     sIniFile: TIniFile;

     sPath : String[60];

    begin

     GetDir(0,sPath);

     sIniFile := TIniFile.Create(sPath + '\Name.INI');

     Result := sIniFile.ReadString(ASection, AString, S);

     sIniFile.Free;

    end;


    procedure WriteIni(ASection, AString, AValue: String);

    var

     sIniFile: TIniFile;

     sPath : String[60];

    begin

     GetDir(0,sPath);

     sIniFile := TIniFile.Create(sPath + '\Name.INI');

     sIniFile.WriteString(ASection, AString, AValue);

     sIniFile.Free;

    end;

    TRegistry 

    Дополненный TRegistry, умеет работать с значениями типа REG_MULTI_SZ (Windows NT, Windows 2000)

    Кондратюк Виталий советует:

    unit Reg;

    {$R-,T-,H+,X+}


    interface


    uses Registry, Classes, Windows, Consts, SysUtils;


    type TReg = class(TRegistry)

    public

     procedure ReadStringList(const name : string; list : TStringList);

     procedure WriteStringList(const name : string; list : TStringList);

    end;


    implementation


    //*** TReg *********************************************************************

    //------------------------------------------------------------------------------

    // Запись TStringList ввиде значения типа REG_MULTI_SZ в реестр

    //------------------------------------------------------------------------------

    procedure TReg.WriteStringList(const name : string; list : TStringList);

    var

     Buffer  : Pointer;

     BufSize : DWORD;

     i, j, k : Integer;

     s       : string;

     p       : PChar;

    begin

     {подготовим буфер к записи}

     BufSize := 0;

     for i:=0 to list.Count-1 do inc(BufSize, Length(list[i])+1);

     inc(BufSize);

     GetMem(Buffer, BufSize);

     k := 0;

     p := Buffer;

     for i:=0 to list.Count-1 do begin

      s := list[i];

      for j:=0 to Length(s)-1 do begin

       p[k] := s[j+1];

       inc(k);

      end;

      p[k] := chr(0);

      inc(k);

     end;

     p[k] := chr(0);

     {запись в реестр}

     if RegSetValueEx(CurrentKey, PChar(name), 0, REG_MULTI_SZ, Buffer, BufSize) <> ERROR_SUCCESS then raise ERegistryException.CreateResFmt(@SRegSetDataFailed, [name]);

    end;


    //------------------------------------------------------------------------------

    // Чтение TStringList ввиде значения типа REG_MULTI_SZ из реестра

    //------------------------------------------------------------------------------

    procedure TReg.ReadStringList(const name : string; list : TStringList);

    var

     BufSize,DataType: DWORD;

     Len, i: Integer;

     Buffer: PChar;

     s: string;

    begin

     if list = nil then Exit;

     {чтение из реестра}

     Len := GetDataSize(Name);

     if Len < 1 then Exit;

     Buffer := AllocMem(Len);

     if Buffer = nil then Exit;

     try

      DataType := REG_NONE;

      BufSize := Len;

      if RegQueryValueEx(CurrentKey, PChar(name), nil, @DataType, PByte(Buffer), @BufSize) <> ERROR_SUCCESS then raise ERegistryException.CreateResFmt(@SRegGetDataFailed, [name]);

      if DataType <> REG_MULTI_SZ then raise ERegistryException.CreateResFmt(@SInvalidRegType, [name]);

      {запись в TStringList}

      list.Clear;s := '';

      for i:=0 to BufSize-2 do begin

      // BufSize-2 т.к. последние два нулевых символа

       if Buffer[i] = chr(0) then begin

        list.Add(s);

        s := '';

       end else s := s + Buffer[i];

      end;

     finally

      FreeMem(Buffer);

     end;

    end;

    end.

    Как я могу определить доступные сервера приложений на этой машине через Registry?

    Nomadic советует:

    Прочитайте ключ под HKEY_CLASSES_ROOT\CLSID\*, просматривая его насчёт ключей, которые имеют подключ "Borland DataBroker". Эти вхождения и являются серверами приложений.

    Ниже пример, который загружает имена доступных серверов приложений в Listbox:

    uses Registry;

    procedure TForm1.FormCreate(Sender: TObject);

    var

     I: integer;

     TempList: TStringList;

    begin

     TempList := TStringList.Create;

     try

      with TRegistry.Create do try

       RootKey := HKEY_CLASSES_ROOT;

       if OpenKey('CLSID', False) then GetKeyNames(TempList);

       CloseKey;

       for I := 1 to TempList.Count - 1 do

        if KeyExists('CLSID\' + TempList[I] + '\Borland DataBroker') then begin

         if OpenKey('CLSID\' + TempList[I] + '\ProgID', False) then begin

          Listbox1.Items.Add(ReadString(''));

          CloseKey;

         end;

        end;

      finally

       Free;

      end;

     finally

      TempList.Free;

     end;

    end;








    Главная | В избранное | Наш E-MAIL | Прислать материал | Нашёл ошибку | Наверх