Как найти окно по неполному названию

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Mikel

WEB-сайт: http://forum.vingrad.ru

function TForm1.Find(s: string): hWnd;

var

Wnd: hWnd;

buff: array[0..127] of Char;

begin

Find := 0;

Wnd := GetWindow(Handle, gw_HWndFirst);

while Wnd 0 do

begin

if (Wnd Application.Handle) and

IsWindowVisible(Wnd) and

(GetWindow(Wnd, gw_Owner) = 0) and

(GetWindowText(Wnd, buff, sizeof(buff)) 0) then

begin

GetWindowText(Wnd, buff, sizeof(buff));

if pos(s, StrPas(buff)) > 0 then

begin

Find := Wnd;

Break;

end;

end;

Wnd := GetWindow(Wnd, gw_hWndNext);

end;

end;

{/codecitation}

Изменить параметры создания формы — добавить прозрачность

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

unit TranspaF;

interface

uses

SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs;

type

TForm1 = class(TForm)

private

{ Private declarations }

public

procedure CreateParams (var Params: TCreateParams); override;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.CreateParams (var Params: TCreateParams);

begin

inherited CreateParams (Params);

Params.ExStyle := Params.ExStyle or

WS_EX_TRANSPARENT;

end;

end.

{/codecitation}

Изменить оконную процедуру для TForm

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Переопределите в подклассе TForm оконную процедуру WinProc класса. В примере оконная процедура переопределяется для того чтобы реагировать на сообщение WM_CANCELMODE, показывающее, что выполняется messagebox или какой-либо еще диалог.

type

TForm1 = class(TForm)

Button1: TButton;

procedure WndProc (var message: TMessage); override;

procedure Button1Click(Sender: TObject);

private

{Private declarations}

public

{Public declarations}

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WndProc (var message: TMessage);

begin

if message.Msg = WM_CANCELMODE then

Form1.Caption := ‘A dialog or message box has popped up’

else

inherited // Oстальное сделает родительская процедура

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(‘Test Message’);

end;

{/codecitation}

Из региона формы вычитается регион надписи

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

{

When youu need a form like a tree or something else what do you do? Windows

provides the CreateRoundRectRegion() function that just cuts the edges of your

form. If you want to do something else, you need to completely draw your

region in a HDC (TCanvas) while Windows looks on your hand to learn it.

After this, you can set the new region to your form using the ‘SetWindowRgn()’ function.

And how to do this? Here you will find a simple example that just gives some text

and sets the region like it. Expand it by your mind!

}

var

Form1: TForm1;

HRgn: THandle;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

var

s: string;

begin

DeleteObject(HRgn);

s := InputBox(‘Region Text’, ‘Please enter some text to set to the region’, ‘CoolRgn’);

BeginPath(Canvas.Handle);

with Canvas do

begin

Font.Name := ‘Comic Sans MS’;

Font.Size := 64;

Font.Style := [fsBold];

TextOut(0, 0, s);

end;

EndPath(Canvas.Handle);

HRgn := PathToRegion(Canvas.Handle);

SetWindowRgn(Handle, HRgn, True);

button1.Visible := False;

Color := clRed;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

DeleteObject(HRgn);

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if Button = mbLeft then

begin

ReleaseCapture;

SendMessage(Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);

end;

end;

{/codecitation}

Заполнение фона формы рисунком 2

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

type

TForm1 = class(TForm)

Button1: TButton;

OpenDialog1: TOpenDialog;

procedure Button1Click(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

FWallpaper: TBitmap;

procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormDestroy(Sender: TObject);

begin

FWallpaper.Free;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

// Load the bitmap

// Bild laden

if OpenDialog1.Execute then

begin

if not Assigned(FWallpaper) then

FWallpaper := TBitmap.Create;

FWallpaper.LoadFromFile(OpenDialog1.FileName);

Invalidate;

end;

end;

procedure TForm1.WMEraseBkGnd(var Msg: TWMEraseBkGnd);

var

row, col: Integer;

begin

if not Assigned(FWallpaper) then

inherited

else

begin

// Draw the bitmap

// Das Bild zeichnen

for Row := 0 to ClientHeight div FWallpaper.Height do

for Col := 0 to ClientWidth div FWallpaper.Width do

BitBlt(Msg.Dc,

Col * FWallpaper.Width,

Row * FWallpaper.Height,

FWallpaper.Width,

FWallpaper.Height,

FWallpaper.Canvas.Handle,

0,

0,

SRCCOPY);

Msg.Result := 1;

end; { else }

end;

end.

{/codecitation}

Замена Form на FormIni

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Nick Hodges (Monterey, CA)

unit Formini;

{$IFDEF Production}

{$S-,R-,D-,L-,W-}

{$ENDIF}

{

TFormINI новая замена TForm, умеющая автоматически сохранять и восстанавливать

значения свойств Top, Left, Height, Width и WindowState

из программного INI-файла без какого-то либо программирования.

Код берет имя выполняемого файла из Application.EXEName и меняет

расширение на .INI.

В качестве имени секции при хранении величин в INI-файле,

TFormINI использует заголовок формы.

Просто замените все существующие объявления класса TForm на TFormINI,

и TFormINI позаботится обо всем остальном (в пределах функциональности).

Теперь ваши формы будут такие же, как и при их закрытии.

TMyForm = class(TForm) -> TMyForm = class(TFormINI)

}

interface

uses InIFiles, Forms, Controls, SysUtils, WinTypes, Classes;

type

TFormINI = class(TForm)

private

PrgINI: TIniFile;

FSection: string;

protected

procedure WriteInteger(Section, Ident: string; value: longint);

function ReadInteger(Section, Ident: string; Default: longint): longint;

public

constructor Create(AOwner: TComponent); override;

procedure CreateParams(var Params: TCreateParams); override;

procedure DoShow; override;

destructor Destroy; override;

end;

implementation

constructor TFormINI.Create(AOwner: TComponent);

var

INIFile: string;

begin

INIFile := ExtractFileName(Application.EXEName);

INIFile := ChangeFileExt(INIFile, ‘.INI’);

PrgINI := TIniFile.Create(INIFile);

inherited Create(AOwner);

end;

procedure TFormINI.CreateParams(var Params: TCreateParams);

begin

inherited CreateParams(Params);

with Params do

begin

FSection := StrPas(Caption);

Y := ReadInteger(», ‘Top’, 0);

X := ReadInteger(», ‘Left’, 0);

Width := ReadInteger(», ‘Width’, Width);

Height := ReadInteger(», ‘Height’, Height);

end;

end;

procedure TFormINI.DoShow;

var

aWindowState: integer;

begin

aWindowState := ReadInteger(», ‘WindowState’, 0);

case aWindowState of

0: WindowState := wsNormal;

1: WindowState := wsMinimized;

2: WindowState := wsMaximized;

end;

inherited DoShow;

end;

procedure TFormINI.WriteInteger(Section, Ident: string; value: longint);

begin

if Section = » then

PrgINI.WriteInteger(FSection, Ident, value)

else

begin

PrgINI.WriteInteger(Section, Ident, value);

FSection := Section;

end;

end;

destructor TFormINI.Destroy;

begin

if WindowState = wsNormal then

begin

WriteInteger(», ‘Top’, Top);

WriteInteger(», ‘Left’, Left);

end;

WriteInteger(», ‘Width’, Width);

WriteInteger(», ‘Height’, Height);

case WindowState of

wsNormal: WriteInteger(», ‘WindowState’, 0);

wsMinimized: WriteInteger(», ‘WindowState’, 1);

wsMaximized: WriteInteger(», ‘WindowState’, 2);

end;

PrgINI.Free;

inherited Destroy;

end;

function TFormINI.ReadInteger(Section, Ident: string; Default: longint):

longint;

begin

if Section = » then

Result := PrgINI.ReadInteger(FSection, Ident, Default)

else

begin

Result := PrgINI.ReadInteger(Section, Ident, Default);

FSection := Section;

end;

end;

end.

{/codecitation}

До динамического создания формы узнать, существует ли она

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

{

Q: How to know whether a form already exist before I dynamically create it ?

A: See the Forms and FormCount property of TScreen. You can iterate

through the forms, and test to see if your form is there.

}

function IsFormOpen(const FormName : string): Boolean;

var

i: Integer;

begin

Result := False;

for i := Screen.FormCount — 1 DownTo 0 do

if (Screen.Forms[i].Name = FormName) then

begin

Result := True;

Break;

end;

end;

// Example: Showing a TForm.

// First check, if the Form (here Form2) is open. If not, create it.

procedure TForm1.Button1Click(Sender: TObject);

begin

if not IsFormOpen(‘Form2’) then

Form2 := TForm2.Create(Self);

Form2.Show

end;

{ For MDI Children }

function IsMDIChildOpen(const AFormName: TForm; const AMDIChildName : string): Boolean;

var

i: Integer;

begin

Result := False;

for i := Pred(AFormName.MDIChildCount) DownTo 0 do

if (AFormName.MDIChildren[i].Name = AMDIChildName) then

begin

Result := True;

Break;

end;

end;

// Example: Showing a MDI Child.

// First check, if the MDI Child is open. If not, create it.

procedure TForm1.Button2Click(Sender: TObject);

begin

if not IsMDIChildOpen(Form1, ‘MyMDIChild’) then

MyMDIChild := TMyMDIChild.Create(Self);

MyMDIChild.Show;

MyMDIChild.BringToFront;

end;

{/codecitation}

Динамическое создание формы

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Steve Schafer

Я хочу следующее:

мой компонент должен «динамически» создавать форму.

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

Ок, но модуль, содержащий форму, должен включаться в ваш EXE-файл, после чего вы должны вызвать RegisterClass. Наилучшее место для размещения вызова — секция инициализации модуля, определяющего форму:

unit MyUnit;

interface

type

TMyForm = class(TForm)

implementation

initialization

RegisterClass(TMyForm);

end.

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

var

SomeForm: TForm;

FormClass: TFormClass;

FormClass := TFormClass(FindClass(‘TMyForm’));

SomeForm := FormClass.Create(Application);

{/codecitation}