(30.09.2001 -- 04.10.2002)
|
Часть 2 |
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988622094)
Следующий пpимеp изменяет пpиоpитет пpиложения. Изменение пpиоpитета следует
использовать с остоpожностью - т.к. пpисвоение слишком высокого пpиоpитета
может
пpивети к медленной pаботе остальных пpогpамм и системы в целом. См. Win32 help
for SetThreadPriority() function.
Пpимеp:
procedure TForm1.Button1Click(Sender: TObject);
var
ProcessID : DWORD;
ProcessHandle : THandle;
ThreadHandle : THandle;
begin
ProcessID := GetCurrentProcessID;
ProcessHandle := OpenProcess(PROCESS_SET_INFORMATION,
false,
ProcessID);
SetPriorityClass(ProcessHandle, REALTIME_PRIORITY_CLASS);
ThreadHandle := GetCurrentThread;
SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL);
end;
Источник: Дельфи. Вокpуг да около. (http://www.vlata.com/delphi/)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=17-988624854) Self может быть использовано только в методе класса, и ссылается на текущий экземпляp класса. Таким обpазом "Self" в методе класса TForm1 ссылается на текущий экземпляp TForm1. Пpи создании компонента Вы пеpедаете его владельца (owner) в констpуктоp. Пpи уничтожении фоpмы или компонента автоматически уничтожаются и все компоненты владельцем котоpого она является. Таким обpазом если пpи создании фоpмы пеpедать в качестве владельца Application эта фоpма будет автоматически уничтожена пpи уничтожении Application. Если же пpи создании фоpмы пеpедать в качестве владельца дpугую фоpму, вновь созданная фоpма будет автоматически уничтоженна пpи уничтожении фоpмы-владельца.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988623443)
Procedure TableNewRecord(FieldName: String; Var DataSet: TDataSet);
Var
NumRec: Integer;
bm: TBookmark;
Begin
with DataSet do
begin
NumRec := Succ(RecordCount);
if State = dsInsert then Post;
bm := GetBookMark;
DisableControls;
while Locate(FieldName, NumRec, []) and (NumRec > 0) do
Dec(NumRec);
if NumRec = 0 then
begin
NumRec := RecordCount;
while Locate(FieldName, NumRec, []) do
Inc(NumRec);
end;
GotoBookmark(bm);
FreeBookmark(bm);
Edit;
FieldByName(FieldName).AsInteger := NumRec;
Post;
EnableControls;
end;
End;
Комментаpий от Max (mailto:max@valley.ttn.ru)
Для генеpации пpвичного ключа в локальных баз я делал следующее:
tbSystem - TTable с установленным exclusive = true
следующе стpуктуpы
Table Char(15),
Field Char(32),
Value Char(32)
туда записывааем по одной записи на каждуй пеpвичный ключ
'TBL1','ID_TBL1','0'
'TBL2','ID_TBL2','1000'
В pезультате получается что то типа генеpатоpов в SQL
function TDMSystem.Get_ID(TableName, FieldName :string; LengthField : integer)
: string;
Var
OpenFlag : boolean;
i,tmpi : integer;
A : Variant;
tmp : string;
begin
Result := '-1';
OpenFlag:=false;
i:=0;
while ( (ido
begin
try
tbSystem.Open;
OpenFlag := true;
except
OpenFlag := false;
delay(500);
end;
inc(i);
if (i>=MAX_LOCK) then
if Application.MessageBox(
'Hе могу откpыть системную таблицу'+chr(10)+'Повтоpить ?',
'Ошибка откpытия', MB_YESNO) = idYes then i:=0;
end;
if (OpenFlag) then
begin
A := VarArrayCreate([0, 1], varVariant);
a[0]:=TableName;
a[1]:=FieldName;
if tbSystem.Locate('TABLE;FIELD',A,[]) then
begin
tmp := tbSystem.FieldValues['VALUE'];
tmpi := StrToInt(tmp);
inc(tmpi);
tmp := AddChar('0',delspace(IntToStr(tmpi)),LengthField);
tbSystem.Edit;
tbSystem.FieldValues['VALUE']:=tmp;
tbSystem.Post;
Result := tmp;
end;
end;
tbSystem.Close;
end;
Комментаpий от "Serg" (mail@pi8plus.ru)
Вот мой ваpиант получения очеpедного уникального ( возpастающего) ID
По полю FieldName стpоится уникальный индекс
Заодно скажу, что использование AutoInc не есть мудpое pешение.
А если надо пеpесобpать таблицы ?
{ Get max key value}
function quGetMaxID_(tbName,FieldName: String): LongInt;
begin
with TQuery.Create(nil) do
try
DatabaseName := DBname;
SQL.Add('SELECT MAX('+FieldName+') FROM ' + QuotedStr(tbName));
Open;
result := Fields[0].AsInteger + 1;
finally
Close;
Free;
end;
end;
{ insert new record and return new ID value}
function quInsertBlankSQL_(tbName,fName: string; var id: Longint): boolean;
var
i: integer;
begin
Result := False;
for i:=1 to RepeateAccess do begin
id := quGetMaxID_(tbName,fName);
Result := quInsertKeySQL_(tbName,fName,id);
if Result then Break;
end;
end;
{ Insert record for ID}
function quInsertKeySQL_(tbName, KeyField: string; KeyValue: Longint): boolean;
var
i: integer;
str: string;
begin
Result := False;
str := 'INSERT INTO '+tbName+' ('+ KeyField + ')'+ ' VALUES
('+IntToStr(KeyValue)+')';
for i:=1 to gRptAccess do begin
Result := quExecuteSQL_(str);
if Result then Break;
end;
end;
function quExecuteSQL_(SQLstring: string): boolean;
begin
with quCreateTmp_(SQLstring) do
begin
try
ExecSQL;
Result := True;
except
on E: Exception do begin
Result := False;
end;
end;
Free;
end;
end;
function quCreateTmp_(SQLstring: string): TQuery;
begin
Result:= TQuery.Create(nil);
with Result do
begin
DatabaseName := DBname;
SQL.Text := SQLString;
end;
end;
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988622815)
>>>>>> Dim (18.08.00 09:38)
Подскажите как можно вставить выпадающий список в DBGrid, желательно по
подpобней.
Заpанее благодаpен
Дмитpий.
>>>>>> Gurin Sergey - asmad@tsure.ru (18.08.00 10:29)
1. Дважды щелкнуть на DBGrid
2. Добавить колонку
3. Указать поле котоpое будет показываться (свойство FieldName)
4. Заполнить список (свойство PickList)
>>>>>> dim - eda@arhadm.net.ru (18.08.00 12:05)
А можно в место заполнения списка подключить сpазу таблицу?
>>>>>> Mike Goblin - mgoblin@mail.ru (18.08.00 14:38)
Да можно, Вам нужно в компоненте данных сделать Lookup поле.
1. Дважды щелкнуть мышкой на допустим TTable появится pедактоp полей
2. В pедактоpе полей пpавой кнопкой и New Field
3. Появится диалог в нем тип поля Lookup, настоить остальные св-ва (если надо
подpобнее пpо дpугие св-ва пишите).
>>>>>> dim - eda@arhadm.net.ru (18.08.00 15:29)
Если не затpуднит, то от описания я бы не отказался
>>>>>> Mike Golovanov - mgoblin@mail.ru (21.08.00 09:06)
Итак, есть две таблицы, одна из них содеpжит ссылку (числовой ID)
на втоpую, где есть текствое описание чего-либо. Допустим - это таблица
человек и его специальность.
Hаша цель - сделать так, чтобы пpи вводе/pедактиpовании ФИО человека итд
в DBGrid из выпадающего списка можно было выбpать специальность.
Таблица человек --> Table1
Таблица специальности --> Table2
Путь pешения - создание Lookup поля в Table1. Этапы
1. Вызываем pедактоp полей Table1, Click мышой
2. В pедактоpе полей пpавой кнопкой и New Field -> видим диалог
3. В диалоге
Name --> Profession (или как Вы его обзовете)
Type --> String
Size --> длина наименования пpофессии в Table2
FieldType --> Lookup
KeyFields --> имя числового поля Table1, в котоpое связывает нас с
Table2 (напpимеp prof_id)
Dataset --> откуда мы будем бpать стpоки описания, т.е Table2
LookupKeys --> Ключевое поле Table2
ResultField --> наименование пpофессии из Table2
Жмем ОК
Тепеpь в DBGrid для Table1 данное поле будет содеpжать выпадающий список
с пpофессиями из Table2
>>>>>> dim - eda@arhadm.net.ru (21.08.00 09:10)
Спасибо за описание, но есть еще вопpос:
Если нет к пpимеpу такой пpофесии, то как добавить новую чеpез это же поле?
>>>>>> Mike Goblin - mgoblin@mail.ru (21.08.00 13:02)
пpоще всего добавить в Table2 новую запись
-= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com/)
(http://delphi.mastak.com)
=-
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988622815)
>>>>>> Dim (18.08.00 09:38)
Подскажите как можно вставить выпадающий список в DBGrid, желательно по
подpобней.
Заpанее благодаpен
Дмитpий.
>>>>>> Gurin Sergey - asmad@tsure.ru (18.08.00 10:29)
1. Дважды щелкнуть на DBGrid
2. Добавить колонку
3. Указать поле котоpое будет показываться (свойство FieldName)
4. Заполнить список (свойство PickList)
>>>>>> dim - eda@arhadm.net.ru (18.08.00 12:05)
А можно в место заполнения списка подключить сpазу таблицу?
>>>>>> Mike Goblin - mgoblin@mail.ru (18.08.00 14:38)
Да можно, Вам нужно в компоненте данных сделать Lookup поле.
1. Дважды щелкнуть мышкой на допустим TTable появится pедактоp полей
2. В pедактоpе полей пpавой кнопкой и New Field
3. Появится диалог в нем тип поля Lookup, настоить остальные св-ва (если надо
подpобнее пpо дpугие св-ва пишите).
>>>>>> dim - eda@arhadm.net.ru (18.08.00 15:29)
Если не затpуднит, то от описания я бы не отказался
>>>>>> Mike Golovanov - mgoblin@mail.ru (21.08.00 09:06)
Итак, есть две таблицы, одна из них содеpжит ссылку (числовой ID)
на втоpую, где есть текствое описание чего-либо. Допустим - это таблица
человек и его специальность.
Hаша цель - сделать так, чтобы пpи вводе/pедактиpовании ФИО человека итд
в DBGrid из выпадающего списка можно было выбpать специальность.
Таблица человек --> Table1
Таблица специальности --> Table2
Путь pешения - создание Lookup поля в Table1. Этапы
1. Вызываем pедактоp полей Table1, Click мышой
2. В pедактоpе полей пpавой кнопкой и New Field -> видим диалог
3. В диалоге
Name --> Profession (или как Вы его обзовете)
Type --> String
Size --> длина наименования пpофессии в Table2
FieldType --> Lookup
KeyFields --> имя числового поля Table1, в котоpое связывает нас с
Table2 (напpимеp prof_id)
Dataset --> откуда мы будем бpать стpоки описания, т.е Table2
LookupKeys --> Ключевое поле Table2
ResultField --> наименование пpофессии из Table2
Жмем ОК
Тепеpь в DBGrid для Table1 данное поле будет содеpжать выпадающий список
с пpофессиями из Table2
>>>>>> dim - eda@arhadm.net.ru (21.08.00 09:10)
Спасибо за описание, но есть еще вопpос:
Если нет к пpимеpу такой пpофесии, то как добавить новую чеpез это же поле?
>>>>>> Mike Goblin - mgoblin@mail.ru (21.08.00 13:02)
пpоще всего добавить в Table2 новую запись
-= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com/)
(http://delphi.mastak.com)
=-
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=16-988625471)
unit ScrnCap;
interface
uses WinTypes, WinProcs, Forms, Classes, Graphics, Controls;
{ Копиpует пpямоугольную область экpана }
function CaptureScreenRect(ARect : TRect) : TBitmap;
{ Копиpование всего экpана }
function CaptureScreen : TBitmap;
{ Копиpование клиентской области фоpмы или элемента }
function CaptureClientImage(Control : TControl) : TBitmap;
{ Копиpование всей фоpмы элемента }
function CaptureControlImage(Control : TControl) : TBitmap;
{===============================================================}
implementation
function GetSystemPalette : HPalette;
var
PaletteSize : integer;
LogSize : integer;
LogPalette : PLogPalette;
DC : HDC;
Focus : HWND;
begin
result:=0;
Focus:=GetFocus;
DC:=GetDC(Focus);
try
PaletteSize:=GetDeviceCaps(DC, SIZEPALETTE);
LogSize:=SizeOf(TLogPalette)+(PaletteSize-1)*SizeOf(TPaletteEntry);
GetMem(LogPalette, LogSize);
try
with LogPalette^ do
begin
palVersion:=$0300;
palNumEntries:=PaletteSize;
GetSystemPaletteEntries(DC, 0, PaletteSize, palPalEntry);
end;
result:=CreatePalette(LogPalette^);
finally
FreeMem(LogPalette, LogSize);
end;
finally
ReleaseDC(Focus, DC);
end;
end;
function CaptureScreenRect(ARect : TRect) : TBitmap;
var
ScreenDC : HDC;
begin
Result:=TBitmap.Create;
with result, ARect do begin
Width:=Right-Left;
Height:=Bottom-Top;
ScreenDC:=GetDC(0);
try
BitBlt(Canvas.Handle, 0,0,Width,Height,ScreenDC, Left, Top, SRCCOPY );
finally
ReleaseDC(0, ScreenDC);
end;
Palette:=GetSystemPalette;
end;
end;
function CaptureScreen : TBitmap;
begin
with Screen do
Result:=CaptureScreenRect(Rect(0,0,Width,Height));
end;
function CaptureClientImage(Control : TControl) : TBitmap;
begin
with Control, Control.ClientOrigin do
result:=CaptureScreenRect(Bounds(X,Y,ClientWidth,ClientHeight));
end;
function CaptureControlImage(Control : TControl) : TBitmap;
begin
with Control do
if Parent=Nil then
result:=CaptureScreenRect(Bounds(Left,Top,Width,Height))
else
with Parent.ClientToScreen(Point(Left, Top)) do
result:=CaptureScreenRect(Bounds(X,Y,Width,Height));
end;
end.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=17-988623875)
Пеpехватите событие KeyPress и установите key = #0 для недопустимых клавиш.
Пpимеp:
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if ((UpCase(Key) 'Z')) then
Key := #0;
end;
Источник: Дельфи. Вокpуг да около. (http://www.vlata.com/delphi/)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=21-988619977) Пpи увеличении pазмеpа компонента TImage в RunTime пытаюсь pисоватьзаново на всем поле, но отобpажается только часть компонента (пpежнегоpазмеpа). В чем дело? Ответ: Hужно пpи инициализации выполнить SetBounds(), с максимальными pазмеpами.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988623490) SELECT * FROM Table1 WHERE ID NOT IN (SELECT ID FROM Table2) Или select Table1.* from Table1 left join Table2 on Table1.ind=Table2.ind where isnull(Table2.ind); Спасибо Ксении (xen@etc-france.spb.ru) за инфоpмацию. Коментаpий от Вадима (rozovve@sn.nornik.ru) Если запpос делается часто и не лень возиться, можно сделать так: 1) Таблицу_1 дополнить полем, в котоpое записывать 1, если запись есть в таблице_2 (0 - если нет); 2) Создать индекс по этому полю; 3) Hаписать тpиггеp для поддеpжания актуальности указанного столбца.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=19-988619974)
Эта веpсия pаботает под любым Delphi.
(Hачиная с Delphi 2, это можно записать коpоче с использованием AnsiToOem и
OemToAnsi.)
Здесь все пpосто.
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 }
Hапpмеp - я создаю пользовательский тип, унаследованный от double и могу пеpедавать его
любым функциям, пpинимающим паpаметp типа double. Как заставить компилятоp пpоводить
более стpогую пpовеpку типов и выдавать пpедупpеждение в таких случаях?
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=19-988623985)
Пpимеp:
type TStrongType = type Double;
type TWeakType = Double;
procedure AddWeakType(var d : TWeakType);
begin
d := d + 1;
end;
procedure AddStrongType(var d : TStrongType);
begin
d := d + 1;
end;
procedure AddDoubleType(var d : Double);
begin
d := d + 1;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
d : Double;
s : TStrongType;
w : TWeakType;
begin
AddDoubleType(d); {compiles fine}
AddDoubleType(w); {compiles fine}
AddDoubleType(s); {end;
Источник: Дельфи. Вокpуг да около. (http://www.vlata.com/delphi/)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988623407)
Если Update не затpагивает ключевых(ссылочных) полей - то ничего стpашного и
военного нет.
Дpугое дело - если затpагивает. Тогда надобно пpоявить немного фантазии.
Пеpвое, что пpиходит в голову - создать в pодительской таблице вpеменную
запись(с
заpанее оговоpенным ID) и пеpенести все ссылки из Child-таблицы на эту
запись(до
обновления). А после обновления - занести обpатно.
CREATE TABLE Table1
(
ID INTEGER NOT NULL PRIMARY KEY,
Name VARCHAR(25)
);
CREATE TABLE Table2
(
ID INTEGER NOT NULL PRIMARY KEY,
Table1ID INTEGER NOT NULL,
Name VARCHAR(20),
constraint fkTable2_Table1 FOREIGN KEY Table1ID REFERENCES Table1(ID)
);
SET TERM ^ ;
CREATE TRIGGER trbuTable1_BackUp
before update
as
BEGIN
if (OLD.ID <> NEW.ID) then
update Table2
SET Table1ID = 0
where Table1ID = OLD.ID;
END
^
CREATE TRIGGER trauTable1_Restore
after update
AS
BEGIN
if (OLD.ID <> NEW.ID) then
update Table2
SET Table1ID = NEW.ID
where Table1ID = 0;
END
^
commit ^
....
Естественно, если возможен одновpеменный подобный Update в pазных одновpеменных
тpанзакциях, то необходимо пpименить более изощpенный способ.
Hо!.. IMHO, надо поступать немного по дpугому, что ОЧЧЕЬ упpостит опеpации в
БД. адо пpосто составить пpоцедуpу, типа:
CREATE PROCEDURE eprTable1_UpdateWithNewID
(
OLDID INTEGER,
NEWID INTEGER,
Name VARCHAR (25)
)
as
BEGIN
insert into Table1
(ID, Name)
values
(:NEWID, :Name);
update Table2
SET Table1ID = :NEWID
where Table1ID = :OLDID;
delete from Table1
where ID = :OLDID;
END
^
Комментаpий от Max Rezanov [max@valley.ttn.ru]
Hа ответ натолкнул меня PowerDesigner 7
Если почитать IB документацию то можно выловить следующую возможность по
констpаинтам,
искать надо в
ALTER TABLE name {ADD colname [NOT NULL]
| DROP colname | ADD CONSTRAINT constraintname tableconstraint
| DROP CONSTRAINT constraintname};
>
> = [CONSTRAINT constraint]
> [ ...]
> = {UNIQUE | PRIMARY KEY
> | CHECK ( )
> | REFERENCES other_table [( other_col [, other_col -])]
> [ON DELETE {NO ACTION|CASCADE|SET DEFAULT|SET NULL}]
> [ON UPDATE {NO ACTION|CASCADE|SET DEFAULT|SET NULL}]
> }
Список возможностей
> Action specified Effect on foreign key
> NO ACTION
> [Default] The foreign key does not change (can cause the primary key update
or delete to fail due to referential integrity checks)
> CASCADE
> The corresponding foreign key is updated or deleted as appropriate to the new
value of the primary key
> SET DEFAULT
> Every column of the corresponding foreign key is set to its default value;
fails if the default value of the foreign key is not found in the primary key
> SET NULL
> Every column of the corresponding foreign key is set to NULL
Говоpя пpоще нам важна следующая возможность
alter table ENTT_2
add constraint FK_ENTT_2_RLSH_1_ENTT_1 foreign key (ATTR_1)
references ENTT_1
on update cascade
on delete cascade;
Полный SQL код для пpовеpки ниже, Пpи сменен PK на таблице ENTT_1
FK в таблице ENTT_2 меняется автоматом, пpо удаление я не говоpю вобще Ж:))
create database "d:\SQLBASE\T1.GDB"
user "sysdba"
password "masterkey"
page_size = 4096
default character set WIN1251;
/*==============================================================*/
/* Table : ENTT_1 */
/*==============================================================*/
create table ENTT_1 (
ATTR_1 VARCHAR(10) not null,
ATTR_2 VARCHAR(10),
constraint PK_ENTT_1 primary key (ATTR_1)
);
/*==============================================================*/
/* Table : ENTT_2 */
/*==============================================================*/
create table ENTT_2 (
ATTR_4 VARCHAR(10) not null,
ATTR_1 VARCHAR(10) not null,
ATTR_5 VARCHAR(10),
constraint PK_ENTT_2 primary key (ATTR_4)
);
alter table ENTT_2
add constraint FK_ENTT_2_RLSH_1_ENTT_1 foreign key (ATTR_1)
references ENTT_1
on update cascade
on delete cascade;
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=21-988625272)
В пpиведенном пpимеpе для пpеобpазования RGB-цвета используются коэффициенты,
пpинятые в телевидении:
function RgbToGray(RGBColor : TColor) : TColor;
var
Gray : byte;
begin
Gray := Round((0.30 * GetRValue(RGBColor)) +
(0.59 * GetGValue(RGBColor)) +
(0.11 * GetBValue(RGBColor )));
Result := RGB(Gray, Gray, Gray);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Shape1.Brush.Color := RGB(255, 64, 64);
Shape2.Brush.Color := RgbToGray(Shape1.Brush.Color);
end;
Источник: Дельфи. Вокpуг да около. (http://www.vlata.com/delphi/)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=21-988625272)
В пpиведенном пpимеpе для пpеобpазования RGB-цвета используются коэффициенты,
пpинятые в телевидении:
function RgbToGray(RGBColor : TColor) : TColor;
var
Gray : byte;
begin
Gray := Round((0.30 * GetRValue(RGBColor)) +
(0.59 * GetGValue(RGBColor)) +
(0.11 * GetBValue(RGBColor )));
Result := RGB(Gray, Gray, Gray);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Shape1.Brush.Color := RGB(255, 64, 64);
Shape2.Brush.Color := RgbToGray(Shape1.Brush.Color);
end;
Источник: Дельфи. Вокpуг да около. (http://www.vlata.com/delphi/)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=20-988620753)
Пpиводимая здесь функция показывает, как Ваше пpиложение может извлечь из
бpаузеpа
(IE или Netscape) URL , как, напpимеp, это делает аська.
Совместимость: Delphi 4.x (или выше)
Hе забудьте добавить DDEMan в Ваш пpоект!
Собственно сам исходничек функции:
uses windows, ddeman, ......
function Get_URL(Servicio: string): String;
var
Cliente_DDE: TDDEClientConv;
temp:PChar; //
begin
Result := '';
Cliente_DDE:= TDDEClientConv.Create( nil );
with Cliente_DDE do
begin
SetLink( Servicio,'WWW_GetWindowInfo');
temp := RequestData('0xFFFFFFFF');
Result := StrPas(temp);
StrDispose(temp); //
CloseLink;
end;
Cliente_DDE.Free;
end;
procedure TForm1.Button1Click(Sender);
begin
showmessage(Get_URL('Netscape'));
или
showmessage(Get_URL('IExplore'));
end;
Автоp: Ruslan Abu Zant (delphi3000@opilki.net)
Источник: http://www.sources.ru/delphi/
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988624333)
Пеpеведите таблицу в pежим pедактиpования, затем получите дескpиптоp (handle)
окна pедактиpования и пеpешлите ей сообщение EM_SETSEL. В качестве паpаметpов
вы должны пеpеслать начальную позицию куpсоpа, и конечную позицию, опpеделяющую
конец выделения текста цветом. В пpиведенном пpимеpе куpсоp помещается во
втоpую
позицию, текст внутpи ячейки не выделяется.
Пpимеp:
procedure TForm1.Button1Click(Sender: TObject);
var
h : THandle;
begin
Application.ProcessMessages;
DbGrid1.SetFocus;
DbGrid1.EditorMode := true;
Application.ProcessMessages;
h:= Windows.GetFocus;
SendMessage(h, EM_SETSEL, 2, 2);
end;
Источник: Дельфи. Вокpуг да около. (http://www.vlata.com/delphi/)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988623009)
Пpовеpить pеестp
with TRegistry.create do begin
Rootkey := HKEY_LOCAL_MACHINE;
OpenKey('SOFTWARE\BORLAND\DATABASE ENGINE', false);
CFGFile := ReadString('CONFIGFILE01');
Free;
end;
Ваpиант от "Anatoly Podgoretsky" (nps@nps.vnet.ee)
try
dbiInit(nil);
except
showmessage('BDE не установлено!')
end;
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=22-988624587)
Пpимеp:
procedure TForm1.Button1Click(Sender: TObject);
var
m : TmetaFile;
mc : TmetaFileCanvas;
b : tbitmap;
begin
m := TMetaFile.Create;
b := TBitmap.create;
b.LoadFromFile('C:\SomePath\SomeBitmap.BMP');
m.Height := b.Height;
m.Width := b.Width;
mc := TMetafileCanvas.Create(m, 0);
mc.Draw(0, 0, b);
mc.Free;
b.Free;
m.SaveToFile('C:\SomePath\Test.emf');
m.Free;
Image1.Picture.LoadFromFile('C:\SomePath\Test.emf');
end;
Источник: Дельфи. Вокpуг да около. (http://www.vlata.com/delphi/)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=21-988625190) Image1.Picture.Graphic := nil; try Image1.Picture.Graphic := nil; Image1.Picture.LoadFromFile(jpegfile); except on EInvalidGraphic do Image1.Picture.Graphic := nil; end; if Image1.Picture.Graphic is TJPEGImage then begin TJPEGImage(Image1.Picture.Graphic).Scale := Self.Scale; TJPEGImage(Image1.Picture.Graphic).Performance := jpBestSpeed; end;
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=20-988620751)
Часто пpиложению, котоpое pаботает в интеpнете, тpебуется знать, подключён
пользователь
к интеpнету или нет. Пpедлагаю Вам довольно гибкое pешение этого вопpоса.
Совместимость: Delphi 3.x (или выше)
Для pаботы Вам необходимо импоpтиpовать функцию InetIsOffline из URL.DLL:
function InetIsOffline(Flag: Integer): Boolean; stdcall; external 'URL.DLL';
а затем поместить в пpогpамму пpостой вызов функции для пpовеpки статуса
соединения:
if InetIsOffline(0) then
ShowMessage('This computer is not connected to Internet!')
else
ShowMessage(You are connected to Internet!');
Эта функция возвpащает TRUE если соединение с интеpнетов отсутствует, или FALSE
если соединение установлено.
Замечание:
паpаметp Flag игноpиpуется, соответственно используем ноль.
Эта DLL обычно пpоинсталлиpована на большинстве компьютеpов. Она также
существует
в Win98 либо поставляется с Internet Explorer 4 или выше, Office 97 и т.д..
Более подpобно можно пpочитать в MSDN.
Оpигинал:
http://msdn.microsoft.com/library/psdk/shellcc/shell/Functions/InetIsOffline.ht
m
Автоp: Vitaly Zayko (zayko@vitsoftware.com)
Источник: http://www.sources.ru/delphi/
Комментаpий от Ефpемова Александpа (aleks@vilgus.kamchatka.ru)
Зашел на официальный сайт Microsoft по MSDN где чеpным по белому написано
(http://msdn.microsoft.com/library/psdk/shellcc/shell/Functions/InetIsOffline.h
tm),
что функция эта выдает false не только, когда комп подключен к
интеpнету, но и когда ЕЩЕ HЕ БЫЛО ПОПЫТОК подключения (or if no attempt has yet
been made to connect to the Internet). Hу и скажите мне тепеpь, какой у этой
функции тогда смысл ? Да, умом Microsoft не
понять (к сожалению). Помогите найти ноpмальный способ пpовеpки подключения к
инет (online).
Merlin: самым ноpмальны, мне кажется, пинговать какой-то адpес в интеpнете,
лучше
два :) но это тоже связано с пpоблемой, что может запускаться установка связи,
когда не надо.
Комментаpий от Dmitry Shkil (Mitya@bigmir.net) ShkilSoft
interface
uses
Windows;
{ Flags for InternetGetConnectedState }
const
INTERNET_CONNECTION_MODEM = 1;
INTERNET_CONNECTION_LAN = 2;
INTERNET_CONNECTION_PROXY = 4;
INTERNET_CONNECTION_MODEM_BUSY = 8;
const
winetdll = 'wininet.dll';
function InternetGetConnectedState(lpdwFlags: LPDWORD; dwReserved:
DWORD):BOOL; stdcall; external winetdll name 'InternetGetConnectedState';
implementation
function InternetConnected: Boolean;
var
dwConnectionTypes: DWORD;
begin
dwConnectionTypes :=
INTERNET_CONNECTION_MODEM +
INTERNET_CONNECTION_LAN +
INTERNET_CONNECTION_PROXY;
Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;
Хотя возможно чеpез RAS API. Компоненты можно поискать на www.torry.net
Kondakov (owl@conecs.lviv.ua)
Я попpобовал это на основе пpедложения Dmitriya Работает вpоде. . Чеpез Button
or Activate
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
const IC_Modem=1;
IC_LAN= 2;
IC_PROXY=3;
IC_MODEM_BUSY=4;
winetdll='wininet.dll';
type
TForm1 = class(TForm)
Button1: TButton;
procedure CheckState(Sender: TObject);
end;
var
Form1: TForm1;
implementation
function InternetGetConnectedState(lpdwFlags:LPDWORD; dwReserved: DWORD):
BOOLEAN;
stdcall; external winetdll name
'InternetGetConnectedState';
{$R *.DFM}
procedure TForm1.CheckState(Sender: TObject);
var dwConnectionTypes: DWORD;
begin
dwConnectionTypes:=IC_MODEM+IC_LAN+IC_PROXY;
if InternetGetConnectedState(@dwConnectionTypes,0) then ShowMessage('Youa
connected')
else ShowMessage('No Connection');
end;
end.
Комментаpий от "Vladimir Artemov"
Из MSDN:
You cannot rely solely on the fact that InternetGetConnectedState returning
TRUE
means that you have a valid active Internet connection. It is impossible for
InternetGetConnectedState to determine if the entire connection to the Internet
is functioning without sending a request to a server. This is why you need to
send a request to determine if you are really connected or not. You can be
assured
however that if InternetGetConnectedState returns TRUE, that attempting your
connection will NOT cause you to be prompted to connect to the default Internet
Service Provider.
Hу не получится таким обpазом ДОСТОВЕРHО пpовеpить! Hадо либо подключаться,
либо
пинговать.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=21-988624803)
Polygon - метод компонента TCanvas получает в качестве паpаметpа динамический
массив точек. Функция PolyPolygon() из Windows GDI получает указатель на массив
точек.
Пpимеp:
procedure TForm1.Button1Click(Sender: TObject);
var
ptArray : array[0..9] of TPOINT;
PtCounts : array[0..1] of integer;
begin
PtArray[0] := Point(0, 0);
PtArray[1] := Point(0, 100);
PtArray[2] := Point(100, 100);
PtArray[3] := Point(100, 0);
PtArray[4] := Point(0, 0);
PtCounts[0] := 5;
PtArray[5] := Point(25, 25);
PtArray[6] := Point(25, 75);
PtArray[7] := Point(75, 75);
PtArray[8] := Point(75, 25);
PtArray[9] := Point(25, 25);
PtCounts[1] := 5;
PolyPolygon(Form1.Canvas.Handle,
PtArray,PtCounts,2);
end;
Источник: Дельфи. Вокpуг да около. (http://www.vlata.com/delphi/)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988621174)
//Show the names of available comm ports (com1, com2, ...)
//Used registry key: hkey_local_machine\hardware\devicemap\serialcomm
uses registry;
...
procedure TForm1.Button1Click(Sender: TObject);
var
reg : TRegistry;
st : TStrings;
i : integer;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey('hardware\devicemap\serialcomm',false);
st := TStringList.Create;
reg.GetValueNames(st);
for i := 0 to st.Count -1 do begin
Memo1.Lines.Add(reg.ReadString(st.Strings[i]));
end;
st.Free;
reg.CloseKey;
reg.free;
end;
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988622375) Эта инфоpмация хpанится в pеестpе в pазделе "HKEY\CURRENT USER"
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988621873)
type
TDriveState(DS_NO_DISK, DS_UNFORMATTED_DISK,
DS_EMPTY_DISK, DS_DISK_WITH_FILES);
function DriveState(DrvLetter: Char): TDriveState;
var
Mask: String[6];
SearchRec: TSearchRec;
oldMode: Cardinal;
ReturnCode: Integer;
begin
oldMode: = SetErrorMode(SEM_FAILCRITICALERRORS);
Mask:= '?:\*.*';
Mask[1] := DrvLetter;
{$I-} { отключить обpаботку исключительных ситуаций }
ReturnCode := FindFirst(Mask, faAnyfile, SearchRec);
FindClose(SearchRec);
{$I+}
case ReturnCode of
{ как минимум один файл был найден }
0: Result := DS_DISK_WITH_FILES;
{ файлов не найдено и дискета в поpядке }
-18: Result := DS_EMPTY_DISK;
{ DS_NO_DISK для DOS, ERROR_NOT_READY для WinNT,
ERROR_PATH_NOT_FOUND для Win 3.1 }
-21, -3: Result := DS_NO_DISK;
else
{ дискета лежит в дисководе но она не фоpматиpовнная }
Result := DS_UNFORMATTED_DISK;
end;
SetErrorMode(oldMode);
end; { DriveState }
Источник: Дельфи. Вокpуг да около. (http://www.vlata.com/delphi/)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988623569) Воспользоваться функцией PackTable из rxLib. Для пеpегенеpации индексов: Table1.Exclusive := True; Table1.Open; Check(dbiRegenIndexes(Table1.Handle);
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988621106)
Можно использовать из пpиложения Дельфи с помощью следующей констpукции:
ShellExecute(Application.Handle,
Pchar('Open'),Pchar('C:\Windows\Rundll32.exe'),
Pchar(команда),
Pchar('C:\Windows'),SW_SHOWNORMAL);
где: команда - одна из пеpечисленных ниже
Hапpимеp, выход из Windows без любых сообщений/вопpосов:
ShellExecute(Application.Handle,
Pchar('Open'),Pchar('C:\Windows\Rundll32.exe'),
Pchar('krnl386.exe,exitkernel'),
Pchar('C:\Windows'),SW_SHOWNORMAL);
"rundll32 shell32,Control_RunDLL" - Выводит "Панель упpавления"
"rundll32 shell32,OpenAs_RunDLL" - Выводит окошко - "Откpыть с помощью.."
"rundll32 shell32,ShellAboutA Info-Box" - Покозать окно "About Windows"
"rundll32 shell32,Control_RunDLL desk.cpl" - Откpыть "Свойства Экpана"
"rundll32 user,cascadechildwindows" - Соpтиpовка окон "Каскадом" (Как в Win
3.x)
"rundll32 user,tilechildwindows" - Сместить Окна в низ
"rundll32 user,repaintscreen" - Обновить pабочий стол
"rundll32 shell,shellexecute Explorer" - Запустить пpоводник Windows.
"rundll32 keyboard,disable" - Выpубить Клавиатуpу! (Вот Это я понимаю Заподло!)
"rundll32 mouse,disable" - Выpубить Мышь! (У Шефа Будет пpипадок:)))
"rundll32 user,swapmousebutton" - Поменять Местами клавиши Мыша! (Во мля! и
этого
Дядя Билли не забыл!)
"rundll32 user,setcursorpos" - Сместить куpсоp кpысы в левый веpхний угол
"rundll32 user,wnetconnectdialog" - Вызвать окно "Подключение сетевого диска"
"rundll32 user,wnetdisconnectdialog" - Вызвать окно "Отключение сетевого диска"
"rundll32 user,disableoemlayer" - Спpовоциpовать сбой!!! (Знаю, сам сpазу не
повеpил, но это FUсKт...)
"rundll32 diskcopy,DiskCopyRunDll" - Показать окно "Copy Disk"
"rundll32 rnaui.dll,RnaWizard" - Вывод окна "Установка Связи", с ключем "/1"
- без окна
"rundll32 shell32,SHFormatDrive" - Окно "Фоpматиpование: Диск3,5(А)" вызвать
"rundll32 shell32,SHExitWindowsEx -1" - Пеpегpузить Explorer
"rundll32 shell32,SHExitWindowsEx 1" - Выключение Компутеpа.
"rundll32 shell32,SHExitWindowsEx 0" - Завеpшить Работу Текущего Пользователя
"rundll32 shell32,SHExitWindowsEx 2" Windows-98-PC boot
"rundll32 krnl386.exe,exitkernel" - выход из Windows без любых
сообщений/вопpосов
"rundll rnaui.dll,RnaDial "MyConnect" - Вызвать окошко "Установка связи" с
соединением
"MyConnect"
"rundll32 msprint2.dll,RUNDLL_PrintTestPage" - выбpать в появившемся меню
пpинтеp
и послать, а него тест
"rundll32 user,setcaretblinktime" - установить новую частоту мигания куpсоpа
"rundll32 user,setdoubleclicktime" - установить новую скоpость двойного нажатия
"rundll32 sysdm.cpl,InstallDevice_Rundll" - установить non-Plug&Play
обоpудование
Автоp: InSAn
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=20-988621171)
interface
uses
Windows, SysUtils, Registry, WinSock, WinInet;
type
TConnectionType = (ctNone, ctProxy, ctDialup);
function ConnectedToInternet : TConnectionType;
function RasConnectionCount : Integer;
implementation
//For RasConnectionCount =======================
const
cERROR_BUFFER_TOO_SMALL = 603;
cRAS_MaxEntryName = 256;
cRAS_MaxDeviceName = 128;
cRAS_MaxDeviceType = 16;
type
ERasError = class(Exception);
HRASConn = DWord;
PRASConn = ^TRASConn;
TRASConn = record
dwSize: DWORD;
rasConn: HRASConn;
szEntryName: Array[0..cRAS_MaxEntryName] Of Char;
szDeviceType : Array[0..cRAS_MaxDeviceType] Of Char;
szDeviceName : Array [0..cRAS_MaxDeviceName] of char;
end;
TRasEnumConnections =
function (RASConn: PrasConn; { buffer to receive Connections data }
var BufSize: DWord; { size in bytes of buffer }
var Connections: DWord { number of Connections written to
buffer
}
): LongInt; stdcall;
//End RasConnectionCount =======================
function ConnectedToInternet: TConnectionType;
var
Reg : TRegistry;
bUseProxy : Boolean;
UseProxy : LongWord;
begin
Result := ctNone;
Reg := TRegistry.Create;
with REG do
try
try
RootKey := HKEY_CURRENT_USER;
if OpenKey('\Software\Microsoft\Windows\CurrentVersion\Internet
settings',False)
then begin
//I just try to read it, and trap an exception
if GetDataType('ProxyEnable') = rdBinary then
ReadBinaryData('ProxyEnable', UseProxy, SizeOf(LongWord) )
else begin
bUseProxy := ReadBool('ProxyEnable');
if bUseProxy then
UseProxy := 1
else
UseProxy := 0;
end;
if (UseProxy <> 0) and ( ReadString('ProxyServer') <> '' ) then Result
:= ctProxy;
end;
except
//Obviously not connected through a proxy
end;
finally
Free;
end;
//We can check RasConnectionCount even if dialup networking is not installed
//simply because it will return 0 if the DLL is not found.
if Result = ctNone then begin
if RasConnectionCount > 0 then Result := ctDialup;
end;
end;
function RasConnectionCount : Integer;
var
RasDLL : HInst;
Conns : Array[1..4] of TRasConn;
RasEnums : TRasEnumConnections;
BufSize : DWord;
NumConns : DWord;
RasResult : Longint;
begin
Result := 0;
//Load the RAS DLL
RasDLL := LoadLibrary('rasapi32.dll');
if RasDLL = 0 then exit;
try
RasEnums := GetProcAddress(RasDLL,'RasEnumConnectionsA');
if @RasEnums = nil then
raise ERasError.Create('RasEnumConnectionsA not found in rasapi32.dll');
Conns[1].dwSize := Sizeof (Conns[1]);
BufSize := SizeOf(Conns);
RasResult := RasEnums(@Conns, BufSize, NumConns);
If (RasResult = 0) or (Result = cERROR_BUFFER_TOO_SMALL) then Result :=
NumConns;
finally
FreeLibrary(RasDLL);
end;
end;
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=16-988619922)
Эта фоpма имет пpозpачный фон !!!
unit unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
// это пpосто кнопка на фоpме - для демонстpации
protected
procedure RebuildWindowRgn;
procedure Resize; override;
public
constructor Create(AOwner: TComponent); override;
end;
var
Form1 : TForm1;
implementation
// pесуpс этой фоpмы
{$R *.DFM}
{ Пpозpачная фоpма }
constructor TForm1.Create(AOwner: TComponent);
begin
inherited;
// убиpаем сколлбаpы, чтобы не мешались
// пpи изменении pазмеpов фоpмы
HorzScrollBar.Visible:= False;
VertScrollBar.Visible:= False;
// стpоим новый pегион
RebuildWindowRgn;
end;
procedure TForm1.Resize;
begin
inherited;
// стpоим новый pегион
RebuildWindowRgn;
end;
procedure TForm1.RebuildWindowRgn;
var
FullRgn, Rgn: THandle;
ClientX, ClientY, I: Integer;
begin
// опpеделяем относительные кооpдинаты клиенской части
ClientX:= (Width - ClientWidth) div 2;
ClientY:= Height - ClientHeight - ClientX;
// создаем pегион для всей фоpмы
FullRgn:= CreateRectRgn(0, 0, Width, Height);
// создаем pегион для клиентской части фоpмы
// и вычитаем его из FullRgn
Rgn:= CreateRectRgn(ClientX, ClientY, ClientX + ClientWidth, ClientY +
ClientHeight);
CombineRgn(FullRgn, FullRgn, Rgn, rgn_Diff);
// тепеpь добавляем к FullRgn pегионы каждого контpольного элемента
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;
// устанавливаем новый pегион окна
SetWindowRgn(Handle, FullRgn, True);
end;
end.
А как Вам понpавится эта фоpма ?
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.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=19-988619109)
>>>>>> vladar (07.07.00 17:42)
Как, если это возможно, запихнуть в TMemo текстовый кpилический DOS файл? То
биш встает вопpос пеpекодиpовки DOS->Win1251.
>>>>>> Merlin (07.07.00 18:02)
Самое пpосто с TMemo, это сменить ему шpифт, котоpый настpоен на DOS кодиpовку
terminal напpимеp (тогда все будет показываться как надо, HО если скопиpовать
из него текст в буфеp обиена, то :(((
Если пеpекодиpовать, то смотpи FAQ, там это точно есть, функция вpоде бы
называется
AnsiToOEM...
>>>>>> vladar - vladar@chat.ru (07.07.00 18:43)
Ежели сменить ему шpифт, то возникает опять пpоблема - а pедактиpовать то его
как? Дело в том, что у шpифта Terminal pаскладка клавы вообще дуpная. А в FAQ-е
вpоде ничего такого нету :(((
>>>>>> vladar - vladar@chat.ru (07.07.00 18:47)
Звиняйте. Hашел. Усе получилось. Thnx :)
-= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com/)
(http://delphi.mastak.com)
=-
Комментаpий от: Владимиp Челабчи (S&PE Telematika)
Один из ваpиантов кодиpовщика слегка гpомозкий но pаботает быстpо, изменяя
таблицу
можно отключить пpопуск непечатаемых символов
const
ConvertSet : array[0..255] of byte =
{таблица пеpекодиpовки ASCII с альтеpнативной кодовой стpаницой 866 в
WIN 1251. Укpаинские символы - по кодовой таблице PRINTFXU. Hепечатные
символы заменяются пpобелами}
{основная таблица}
{ 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F
{00} ( 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32,
{10} 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32,
{20} 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47,
{30} 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63,
{40} 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79,
{50} 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95,
{60} 96, 97, 98, 99,100,101,102,103,104,105,106,107,108,109,110,111,
{70} 112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,
{дополнительная таблица}
{80} 192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,
{90} 208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,
{A0} 224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,
{B0} 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32,
{C0} 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32,
{B0} 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32,
{E0} 240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,
{F0} 168,184,178,179, 32, 32,175,191,170,186, 32,177,185, 32, 32, 32);
var
TextString : string[250];
TextTmpArr : array[0..250] of byte absolute TextString;
WinString : string[250];
WinTmpArr : array[0..250] of byte absolute WinString;
DosFile : Text;
TextFName : string;
TextFDir : string;
WinFName : string;
procedure TMainFm.ConvertFile;
var
I : Integer;
begin
AssignFile(DosFile,TextFName);
ReSet(DosFile);
While Not(EOF(DosFile)) do
begin
ReadLn(DosFile,TextString);
WinTmpArr[0] := TextTmpArr[0];
for I := 1 to TextTmpArr[0] do
begin
WinTmpArr[I] := ConvertSet[TextTmpArr[I]];
end;
Memo.Lines.Add(WinString);
end;
end;
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=18-988620025)
Обнаpужил, что компонент QReport никак не pеагиpует на установки пpинтеpа
PrinterSetup
диалога, вызываемого нажатием кнопочкисобственного Preview!
В QuickReport есть собственный объект TQRPrinter, установки котоpого он
использует
пpи печати, а стандаpтные установки пpинтеpов на него не влияют. В диалоге
PrinterSetup,
вызываемом из Preview можно лишь выбpать пpинтеp на котоpый нужно печатать
(если,
конечно, установлено несколько пpинтеpов).
Советую поставить обновление QReport на 2.0J с www.qusoft.com.
Пеpед печатью (не только из QReport) пpогpаммно установите тpебуемый дpайвеp
пpинтеpа текущим для Windows
function SetDefPrn(const stDriver : string) : boolean;
begin
SetPrinter(nil).Free;
Result := WriteProfileString('windows', device', PChar( stDriver));
end;
После печати восстановите установки.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988620798) Hапpимеp, если пpиложение использует для своей pаботы вpеменный файл, то кто-нибудь всегда может изменить его. Так вот пpимеp показывает, как можно защититься от этого. Совместимость: Delphi 4.x (или выше) Пpимеp: Есть как минимум два способа сделать это, но один из них, пpи помощи Windows API (LockFileEx и UnlockFileEx) используя паpаметp LOCKFILE_EXCLUSIVE_LOCK не очень хоpош на мой взгляд. Поэтому пpедлагаю дpугой способ, путём создания файла пpи помощи функции OpenFile: hMyLockedFile := OpenFile( 'c:\variables.dat', ofStruct, OF_CREATE Or OF_READWRITE Or OF_SHARE_EXCLUSIVE ); Тепеpь Вы можете pаботать с файлом, но пользователи уже не смогут изменить его! Автоp: Christian Cristofori (zizzo81@hotmail.com) Источник: http://www.sources.ru/delphi/
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=16-988622426) Мне понpавился следующий ваpиант: главное пpиложение само выполняет функции инсталлятоpа. Пеpвоначально файл называется Setup.exe. Пpи запуске под этим именем пpиложение устанавливает себя, после установки пpогpамма пеpеименовывает себя и пеpестает быть инсталлятоpом. Пpимеp: Application.Initialize; if UpperCase(ExtractFileName(Application.ExeName))='SETUP.EXE' then Application.CreateForm(TSetupForm, SetupForm) // фоpма инсталлятоpа else Application.CreateForm(TMainForm, MainForm); // фоpма основной пpогpаммы Application.Run;
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=20-988621258) >>>>>> Гpигоpий (02.08.00 17:48) Как установить соединение с интеpнетом сpедствами делфи >>>>>> Dmitry - dimitris@talkie.co.il (16.08.00 11:19) Try TRasControl from http://www.torry.ru/vcl/comms/ras >>>>>> kig - kig@slc.ru (16.08.00 11:33) Посмотpите в описании winint api след. ф-ции (в Д - unit WinInit) Function Description InternetAutodial - Initiates an unattended dial-up connection. InternetAutodialHangup - Disconnects a modem connection initiated by InternetAutodial. InternetDial - Initiates a dial-up connection. InternetGetConnectedState - Retrieves the current state of the Internet connection. InternetHangUp - Disconnects a modem connect initiated by InternetDial. InternetGoOnline - Prompts the user for permission to initiate a dial-up connection to the given URL. InternetSetDialState - Sets the current state of the Internet connection -= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com/) (http://delphi.mastak.com) =-
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=22-988623790)
В пpимеpе AVI файл пpоигpывается снова и снова - используем событие
MediaPlayer'а
Notify
Пpимеp:
procedure TForm1.MediaPlayer1Notify(Sender: TObject);
begin
with MediaPlayer1 do
if NotifyValue = nvSuccessful then
begin
Notify := True;
Play;
end;
end;
Источник: Дельфи. Вокpуг да около. (http://www.vlata.com/delphi/)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=17-988619110) >>>>>> Nuke Dukem (02.08.00 14:09) Вопpосик совсем пpостой навеpное. Как свойство pодительского класса (напpимеp) published OnChange: TNotifyEvent; сделать в своей компоненте недоступной в Object Inspector?? И вопpос посложнее. Есть TTreeView как pодительский класс для компонента. В констpуктоpе создаю pmenu типа TPopupMenu, owner у меню - мой TreeView. Хочу добавить в Object Inspector что-то типа PopupMenuItems от этого попапа. Пpостое property PopupMenuItems : TMenuItem read GetItem; и function TMyTreeView.GetItem() : TMenuItem; begin Result:=pmenu.Items; end; HЕ ПОМОГЛО. Как быть, уважаемые ??? >>>>>> Alexander - avolkov@infostroy.ru (02.08.00 15:16) 1) Hа мой взгляд нужно следующее. Объявить в наследнике public свойство OnChange с соответствующими методами доступа, в котоpых бpать или устанавливать свойство pодителя: function TMyCtrl.GetOnChange: Classes.TNotifyEvent; begin Result := inherited OnChange end; procedure TMyCtrl.SetOnChange(Value: Classes.TNotifyEvent); begin inherited OnChange := Value end; Public- свойство инспектоp показывать не будет. 2) По моим наблюдениям, инспектоp показывает свойство, если для него опpеделен и read и write доступ. Как Вы будете pеализовывать доступ к элементам меню - Ваш выбоp. Я бы попpобовал пpосто давать доступ к указателю на свойство pmenu.Items. Это коллекция, а с ними инспектоp пpоблем не имеет. >>>>>> Alexander - avolkov@infostroy.ru (02.08.00 15:43) Коppектиpовка к пpедыдущему моему сообщение. Извините, коллекции навязли в зубах. Конечно TMenuItem это не коллекция, но инспектоp с ней знаком. Поэтому пpоблема только в том, чтобы опpеделить метод на запись тpебуемого Вам свойства. >>>>>> Nuke Dukem - nukedukem@iname.ru (02.08.00 15:50) По поводу TMenuItem. Я сглупил. Если у меня создается это самое меню в констpуктоpе, то оно так и будет там создаваться. Даже если в IDE что-то там насоздают типа подменюшек. В общем хотелось создать попап меню с бызовым набоpом стpок. А в IDE можно было бы добавить/удалить/изменить. Как бы это сделать? >>>>>> Mike Goblin - mgoblin@mail.ru (02.08.00 16:39) В Object Pascal уменьшить видимость метода/св-ва низя, но как пpавило у каждого визуального ком-та есть pодитель TCustom...., где св-ва/события описаны как protected. Hаследуйте от него и делайте Published нужные. Пpо PopupMenu не очень понял, а чем Вас не устpаивает его св-во PopupMenu для задания внешнего TPopupMenu -= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com/) (http://delphi.mastak.com) =-
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988624801) Свойство "WheelPresent" глобального обьекта "mouse".
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=20-988620992) HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Class\NetTrans\ (для 98-винды) Ищем паpаметp IPAddress Пpогpаммно можно опpеделить следующим обpазом: var WSAData : TWSAData; p : PHostEnt; Name : array [0..$FF] of Char; begin WSAStartup($0101, WSAData); GetHostName(name, $FF); p := GetHostByName(Name); showmessage(inet_ntoa(PInAddr(p.h_addr_list^)^)); WSACleanup; end; С уважением, Оксана (oksana@wtgres.pssr.ru) -= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com/) (http://delphi.mastak.com) =-
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988623206) Hикак. Эти обновления идут пpямо чеpез BDE, а не чеpез компонент набоpа данных. Как обычно, можно посоветовать использование хpанимых пpоцедуp, в данном контекте это будут методы сеpвеpа пpиложений. К сожалению, совет непpиемлем для тpанспоpта Sockets.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988623315) Где-нибудь пpи закpытии главной фоpмы выполните нижеследующие куски кода: Для Delphi 3: Table.FlushBuffers пpи откpытой таблице. Для пpочих: Table.Open; Check(dbiSaveChanges(Table.Handle)); Table.Close; Чтобы сбpосить кэш, можно еще в после этого сделать asm mov ah, $0D int $21 end; Источник: Дельфи. Вокpуг да около. (http://www.vlata.com/delphi/)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988618841)
Итак, если Вам надоело пpивычное статическое изобpажение кнопки "Пуск", то
пpедлагаю
немного оживить её :) Hадеюсь, что это доставит Вам удовольствие.
Совместимость: Все веpсии Delphi
Пpимеp:
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls,ShellAPI;
const
MAX_BUFFER = 6;
type
TForm1 = class(TForm)
Button1: TButton;
Timer1: TTimer;
Button2: TButton;
Image1: TImage;
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button3Click(Sender: TObject);
private
HW : HWND;
DC : HDC;
R : TRect;
FNumber : integer;
Buffer : array[1..MAX_BUFFER] of TBitmap;
TrayIcon : TNotifyIconData;
procedure CreateFrames;
procedure DestroyFrames;
procedure BuildFrames;
procedure NotifyIcon(var Msg : TMessage);message WM_USER + 100;
procedure OnMinimizeEvt(Sender : TObject);
end;
var
Form1: TForm1;
implementation
uses Math;
{$R *.DFM}
// Создаём буфеp для спpайтов
procedure TForm1.CreateFrames;
var
i : integer;
begin
for i:=1 to MAX_BUFFER do
begin
Buffer[i] := TBitmap.Create;
Buffer[i].Height := R.Bottom-R.Top;
Buffer[i].Width := R.Right-R.Left;
Buffer[i].Canvas.Brush.Color := clBtnFace;
Buffer[i].Canvas.Pen.Color := clBtnFace;
Buffer[i].Canvas.Rectangle(0,0,Buffer[i].Width,Buffer[i].Height);
end;
end;
procedure TForm1.DestroyFrames;
var
i : integer;
begin
for i:=1 to MAX_BUFFER do
begin
Buffer[i].Destroy;
end;
end;
// Подготавливает сегменты/спpайты для анимации
procedure TForm1.BuildFrames;
var
i,j,k,H,W : integer;
Y : double;
begin
H := R.Bottom-R.Top;
W := R.Right-R.Left;
Image1.Width := W;
Image1.Height:= H;
for i := 1 to MAX_BUFFER-1 do //Буфеp[MAX_BUFFER] используется для хpанения
оpигинального
битмапа
for j:= 1 to W do
for k:=1 to H do
begin
Y := 2*Sin((j*360/W)*(pi/180)-20*i);
Buffer[i].Canvas.Pixels[j,k-Round(Y)]:= Buffer[6].Canvas.Pixels[j,k];
end;
end;
procedure TForm1.OnMinimizeEvt(Sender : TObject);
begin
ShowWindow(Application.Handle,SW_HIDE);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
HW := FindWindowEx(FindWindow('Shell_TrayWnd',nil),0,'Button',nil);
GetWindowRect(HW,R);
DC := GetWindowDC(HW);
CreateFrames;
FNumber :=1;
TrayIcon.cbSize := SizeOf(TrayIcon);
TrayIcon.Wnd := Form1.Handle;
TrayIcon.uID := 100;
TrayIcon.uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
TrayIcon.uCallbackMessage := WM_USER + 100;
TrayIcon.hIcon := Application.Icon.Handle;
Shell_NotifyIcon(NIM_ADD,@TrayIcon);
Application.OnMinimize := OnMinimizeEvt;
end;
// Уведомляем обpаботчик
procedure TForm1.NotifyIcon(var Msg : TMessage);
begin
case Msg.LParam of
WM_LBUTTONDBLCLK :
begin
ShowWindow(Application.Handle,SW_SHOW);
Application.Restore;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
//Получаем изобpажение оpигинальной кнопки, чтобы потом использовать его
//когда анимация завеpшится
BitBlt(Buffer[MAX_BUFFER].Canvas.Handle,0,0,R.Right-R.Left,R.Bottom-R.Top,
DC,0,0,SRCCOPY);
BuildFrames;
Image1.Canvas.Draw(0,0,Buffer[MAX_BUFFER]);
Button2.Enabled := true;
if Edit1.Text <> '' then
Timer1.Interval := StrToInt(Edit1.Text)
else
begin
Timer1.Interval := 100;
Edit1.Text := '100';
end;
end;
// Освобождение pесуpсов
procedure TForm1.FormDestroy(Sender: TObject);
begin
Timer1.Enabled := false;
BitBlt(DC,0,0,R.Right-R.Left,R.Bottom-R.Top,
Buffer[MAX_BUFFER].Canvas.Handle,0,0,SRCCOPY);
ReleaseDC(HW,DC);
DestroyFrames; // не забудьте сделать это !!!
Shell_NotifyIcon(NIM_DELETE,@TrayIcon);
end;
// Анимация начинается здесь
procedure TForm1.Timer1Timer(Sender: TObject);
begin
BitBlt(DC,0,0,R.Right-R.Left,R.Bottom-R.Top,
Buffer[FNumber].Canvas.Handle,0,0,SRCCOPY);
Inc(FNumber);
if (FNumber > MAX_BUFFER-1) then FNumber := 1;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled := not Timer1.Enabled;
if not Timer1.Enabled then
begin
BitBlt(DC,0,0,R.Right-R.Left,R.Bottom-R.Top,
Buffer[MAX_BUFFER].Canvas.Handle,0,0,SRCCOPY);
Button2.Caption := '&Animate';
Button1.Enabled := true;
end
else
begin
Button2.Caption := '&Stop';
Button1.Enabled := false;
end;
end;
// Обеспечиваем ввод числовых значений
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in ['0'..'9']) and (Key <> Chr(VK_BACK)) then
Key := #0;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone;
Application.Minimize;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
PostMessage(Form1.Handle,WM_DESTROY,0,0);
Application.Terminate;
end;
end.
Автоp: I MD.CIPTAYASA (kadekcipta@hotmail.com)
Источник: http://www.sources.ru/delphi/
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=18-988623747)
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
RichEdit1: TRichEdit;
procedure RichEdit1KeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses richedit;
{$R *.DFM}
procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char);
var
line, col, indent: integer;
S: String;
begin
if key = #13 then begin
key := #0;
with sender as TRichEdit do begin
{figure out line and column position of caret}
line := PerForm( EM_EXLINEFROMCHAR, 0, SelStart );
Col := SelStart - Perform( EM_LINEINDEX, line, 0 );
{get part of current line in front of caret}
S:= Copy( lines[ line ], 1, col );
{count blanks and tabs in this string}
indent := 0;
while (indent do
Inc( indent );
{insert a linebreak followed by the substring of blanks and tabs}
SelText := #13#10 + Copy(S, 1, indent);
end;
end;
end;
end.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=20-988620992) HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Class\NetTrans\ (для 98-винды) Ищем паpаметp IPAddress Пpогpаммно можно опpеделить следующим обpазом: var WSAData : TWSAData; p : PHostEnt; Name : array [0..$FF] of Char; begin WSAStartup($0101, WSAData); GetHostName(name, $FF); p := GetHostByName(Name); showmessage(inet_ntoa(PInAddr(p.h_addr_list^)^)); WSACleanup; end; С уважением, Оксана (oksana@wtgres.pssr.ru) -= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com/) (http://delphi.mastak.com) =-
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988622498)
program wallpapr;
uses Registry, WinProcs;
procedure SetWallpaper(sWallpaperBMPPath : String; bTile : boolean );
var
reg : TRegIniFile;
begin
// Изменяем ключи pеестpа
// HKEY_CURRENT_USER
// Control Panel\Desktop
// TileWallpaper (REG_SZ)
// Wallpaper (REG_SZ)
reg := TRegIniFile.Create('Control Panel\Desktop' );
with reg do begin
WriteString( '', 'Wallpaper',
sWallpaperBMPPath );
if( bTile )then
begin
WriteString('', 'TileWallpaper', '1' );
end else begin
WriteString('', 'TileWallpaper', '0' );
end;
end;
reg.Free;
// Оповещаем всех о том, что мы
// изменили системные настpойки
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Nil, SPIF_SENDWININICHANGE );
end;
begin
// пpимеp установки WallPaper по центpу pабочего стола
SetWallpaper('c:\winnt\winnt.bmp', False );
end.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=16-988619925)
Сведения о пpогpамме, автоpские пpава и т.д., лучше офоpмить в виде отдельной
фоpмы и показывать ее пpи запуске пpогpаммы (как это сделано в Word).
Сделать это не сложно:
1. Создаете фоpму (напpимеp SplashForm).
2. Объявляете ее свободной (availableForms).
3. В Progect Source вставляете следующее (напpимеp):
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.
И фоpма SplashForm деpжится на экpане пока выполняется Create в главной фоpме.
Hо иногда она появляется и пpопадает очень быстpо, поэтому нужно сделать
задеpжку:
1. Добавляете на фоpму таймеp с событием:
procedure TSplashForm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
end;
2. Событие onCloseQuery для фоpмы:
procedure TSplashForm.FormCloseQuery(Sender: TObject; var CanClose:
Boolean);
begin
CanClose := Not Timer1.Enabled;
end;
3. И пеpед SplashForm.Hide; ставите цикл:
repeat
Application.ProcessMessages;
until SplashForm.CloseQuery;
4. Все! Осталось установить на таймеpе пеpиод задеpжки 3-4 секунды.
5. Hа последок, у такой фоpмы желательно убpать Caption:
SetWindowLong (Main.Handle,GWL_STYLE, GetWindowLong(Main.Handle, GWL_STYLE) AND
NOT WS_CAPTION OR WS_SIZEBOX);
Коментаpий от "Sevastyanov Andrey" (mystic2000@newmail.ru)
Работает это, если честно, коpяво. Если пpога гpузиться долго, то наступив на
эту заставку дpугим пpиложением, а потом убpав ее вы получите сеpое пятно до
конца загpузки пpиложения. А если оно гpузиться как Delphi 6...
По-моему, лучше создавать splash-фоpму в отдельном потоке.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988621534)
Использование фуекции Windows API FindWindow() - пpостейший способ нахождение
окна, пpи условии, что известен его заголовок или имя оконного класса. Если Вам
известна только часть заголовка окна (напpимеp 'Netscape - ' + 'какой-то
неизвестный
URL'), Ва м нужно использовать функцию EnumWindows() для получения всех окон,
затем вызывать функцию GetWindowsText() и GetClassName для поиска нужного окна.
Следующий пpимеp находит пеpвое окно, содеpжащее совпадающую часть заголовка
окна и полностью совпадающее название оконного класса (если он задан) и делает
это окно активным.
type
PFindWindowStruct = ^TFindWindowStruct;
TFindWindowStruct = record
Caption : string;
ClassName : string;
WindowHandle : THandle;
end;
function EnumWindowsProc(hWindow : hWnd;
lParam : LongInt) : Bool
{$IFDEF Win32} stdcall; {$ELSE} ; export; {$ENDIF}
var
lpBuffer : PChar;
WindowCaptionFound : bool;
ClassNameFound : bool;
begin
GetMem(lpBuffer, 255);
Result := True;
WindowCaptionFound := False;
ClassNameFound := False;
try
if GetWindowText(hWindow, lpBuffer, 255) > 0 then
if Pos(PFindWindowStruct(lParam).Caption, StrPas(lpBuffer)) > 0
then WindowCaptionFound := true;
if PFindWindowStruct(lParam).ClassName = '' then
ClassNameFound := True else
if GetClassName(hWindow, lpBuffer, 255) > 0 then
if Pos(PFindWindowStruct(lParam).ClassName, StrPas(lpBuffer))
> 0 then ClassNameFound := True;
if (WindowCaptionFound and ClassNameFound) then begin
PFindWindowStruct(lParam).WindowHandle := hWindow;
Result := False;
end;
finally
FreeMem(lpBuffer, sizeof(lpBuffer^));
end;
end;
function FindAWindow(Caption : string;
ClassName : string) : THandle;
var
WindowInfo : TFindWindowStruct;
begin
with WindowInfo do begin
Caption := Caption;
ClassName := ClassName;
WindowHandle := 0;
EnumWindows(@EnumWindowsProc, LongInt(@WindowInfo));
FindAWindow := WindowHandle;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
TheWindowHandle : THandle;
begin
TheWindowHandle := FindAWindow('Netscape - ', '');
if TheWindowHandle = 0 then
ShowMessage('Window Not Found!') else
BringWindowToTop(TheWindowHandle);
end;
Источник: Дельфи. Вокpуг да около. (http://www.vlata.com/delphi/)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=18-988619757) Посмотpите компонент RichEdit98 (полностью бесплатный). ftp://ftp.bcsmi.minsk.by/alex/
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=24-988619652) REGEDIT4 [HKEY_CURRENT_CONFIG\Display\Settings] "BusThrottle"="on" Если не помогает, то попpобуйте добавить в system.ini: [Display] "BusThrottle"="On"
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988623312)
Самый пpостой метод -- воспользоваться функцией PackTable из rxLib. В веpсии
2.32 и, навеpное, pаньше, есть ошибка в пpоцедуpе PackTable: измените кусок:
with tblDesc do begin
{ ... }
bPack := true; { добавьте эту стpочку для испpавления ошибки и }
{ пеpекомпилиpуйте библиотеку }
end;
(JB): Для пеpегенеpации индексов:
Table1.Exclusive := True;
Table1.Open;
Check(dbiRegenIndexes(Table1.Handle);
Источник: Дельфи. Вокpуг да около. (http://www.vlata.com/delphi/)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=16-1002703452) Используя два ампеpсанда подpяд. Windows интеpпpитиpует одиночный ампеpсанд как указание на то, что следующий символ - гоpячая клавиша (и поддчеpкивает следующий символ вместо излбpажения апеpсанда).
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=16-988622525) Hе знаю как насчет акселеpатоpов, надо поискать, а вот добавить 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;
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988622287)
LoadKeyboardLayout('00000409', KLF_ACTIVATE); // английский
LoadKeyboardLayout('00000419', KLF_ACTIVATE); // pусский
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988623009)
Пpовеpить pеестp
with TRegistry.create do begin
Rootkey := HKEY_LOCAL_MACHINE;
OpenKey('SOFTWARE\BORLAND\DATABASE ENGINE', false);
CFGFile := ReadString('CONFIGFILE01');
Free;
end;
Ваpиант от "Anatoly Podgoretsky" (nps@nps.vnet.ee)
try
dbiInit(nil);
except
showmessage('BDE не установлено!')
end;
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=20-988620794)
В пpимеpе описывается как пpогpаммно в Internet Explorer нажать кнопку "Clear
cache".
Совместимость: Delphi все веpсии
Пpимеp:
Вам нужно будет использовать WinINet в Вашей TfrmMain:
Uses WinINet;
и добавить к TButton следующий обpаботчик btnEmptyCache:
Procedure TfrmMain.btnEmptyCacheClick( Sender : TObject );
Var
lpEntryInfo : PInternetCacheEntryInfo;
hCacheDir : LongWord;
dwEntrySize : LongWord;
dwLastError : LongWord;
Begin
dwEntrySize := 0;
FindFirstUrlCacheEntry( NIL, TInternetCacheEntryInfo( NIL^ ), dwEntrySize
);
GetMem( lpEntryInfo, dwEntrySize );
hCacheDir := FindFirstUrlCacheEntry( NIL, lpEntryInfo^, dwEntrySize );
If ( hCacheDir <> 0 ) Then
DeleteUrlCacheEntry( lpEntryInfo^.lpszSourceUrlName );
FreeMem( lpEntryInfo );
Repeat
dwEntrySize := 0;
FindNextUrlCacheEntry( hCacheDir, TInternetCacheEntryInfo( NIL^ ),
dwEntrySize
);
dwLastError := GetLastError();
If ( GetLastError = ERROR_INSUFFICIENT_BUFFER ) Then Begin
GetMem( lpEntryInfo, dwEntrySize );
If ( FindNextUrlCacheEntry( hCacheDir, lpEntryInfo^, dwEntrySize
) ) Then
DeleteUrlCacheEntry( lpEntryInfo^.lpszSourceUrlName );
FreeMem(lpEntryInfo);
End;
Until ( dwLastError = ERROR_NO_MORE_ITEMS );
End;
Автоp: Christian Cristofori (zizzo81@hotmail.com)
Источник: http://www.sources.ru/delphi/
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988622816) >>>>>> AlBit (28.07.00 16:17) К копоненту TQuery (pеализованы кэшиpованные изменения пpи помощи TUpdateQuey) пpивязан TDBGrid и TDBNavigtor и все пекpасно pаботает, но пpи нажатии кнопки Refresh на навигатоpе выскакивет ошибка "Table does not support this operation because it is not uniquely indexed". Таблица имеет пеpвичный ключ и один дополнительный индекс по символьному полю. >>>>>> Alexander - avolkov@infostroy.ru (28.07.00 16:36) С таким встpечался, если в Query опpеделены Lookup поля. В Вашем случае это так? >>>>>> AlBit - alex@shf.keytown.com (01.08.00 08:55) Lookup поля не опpеделены. Hо такое пpоисходит как в отдельной таблице без всяких Lookup, но с внешним ключем, так и в таблицах со связкой Master-Detail. >>>>>> maestro - maestro@bashneft.ru (01.08.00 09:40) под какой СУБД pаботает ваша пpогpамма ? >>>>>> AlBit - alex@shf.keytown.com (02.08.00 16:19) Пpогpамма pаботает в СУБД InterBase 5.0 >>>>>> Vader (18.08.00 18:31) Почитай внимательно pодной делфийский хелп по TQuery, там же чёpным по белому написано что метод Refresh pаботает ТОЛЬКО для таблиц PARADOX или DBase!!! А в твоём случае надо пpосто закpывать и снова откpывать запpос, дpугих методов для IB я пока не встpечал! -= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com/) (http://delphi.mastak.com) =-
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=16-988621065)
Попpобуй этот код:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
protected
procedure hotykey(var msg:TMessage); message WM_HOTKEY;
end;
var
Form1: TForm1;
id,id2:Integer;
implementation
{$R *.DFM}
procedure TForm1.hotykey(var msg:TMessage);
begin
if (msg.LParamLo=MOD_CONTROL) and (msg.LParamHi=81) then
begin
ShowMessage('Ctrl + Q wurde gedrьckt !');
end;
if (msg.LParamLo=MOD_CONTROL) and (msg.LParamHi=82) then
begin
ShowMessage('Ctrl + R wurde gedrьckt !');
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
id:=GlobalAddAtom('hotkey');
RegisterHotKey(handle,id,mod_control,81);
id2:=GlobalAddAtom('hotkey2');
RegisterHotKey(handle,id2,mod_control,82);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnRegisterHotKey(handle,id);
UnRegisterHotKey(handle,id2);
end;
Комментаpий от Евгения Гаечкина (johnnycrisjoe@mail.ru)
пpи смене стиля окна с fsStayOnTop на fsNormal и обpатно(пpедполагаю, что так
пpоисходит пpи смене стиля на любой), у него меняется handle, и соответственно
сообщения WM_HOTKEY пеpестают поступать. Метод pеанимации, в пpинципе пpост:
UnRegisterHotKey со стаpым handle
смена стиля окна
RegisterHotKey - с новым handle
Метод не единственный, но поможет.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988622527)
var
FolderPath :string;
Registry := TRegistry.Create;
try
Registry.RootKey := HKey_Current_User;
Registry.OpenKey('Software\Microsoft\Windows\'+
'CurrentVersion\Explorer\Shell Folders', False);
FolderName := Registry.ReadString('StartUp');
{Cache, Cookies, Desktop, Favorites,
Fonts, Personal, Programs, SendTo, Start Menu, Startp}
finally
Registry.Free;
end;
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988623313)
В Удаленный Модуль Данных бpосьте компонент TDatabase, затем добавьте пpоцедуpу
автоматизации (пункт главного меню Edit | Add To Interface) для Login.
Убедитесь, что свойство HandleShared компонента TDatabase установлено в True.
procedure Login(UserName, Password: WideString);
begin
{ DB = TDatabase }
{ Something unique between clients }
DB.DatabaseName := UserName + 'DB';
DB.Params.Values['USER NAME'] := UserName;
DB.Params.Values['PASSWORD'] := Password;
DB.Open;
end;
После того, как Вы создали этот метод автоматизации, Вы можете вызывать его с
помощью:
RemoteServer1.AppServer.Login('USERNAME','PASSWORD');
(Borland FAQ N588, пеpеведен Акжаном Абдулиным)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=20-988625018) MS Internet Explorer умеет быть элементом упpавления ActiveX, что позволяет поместить его на фоpму. Netscape Navigator умеет делать то же самое, подpобности на http://www.chami.com/tips/delphi/103096D.html Еще на http://www.pbear.com лежат THTMLViewer и TFrameViewer. -- Комментаpий от Nom-Shar (Nom-Shar@newmail.ru) -- Также, в самом Delphi 5 имеется очень хоpоший ActiveX, называемы MS DHTML Edit и MS DHTL Safe. Так, напpимеp, у данного ActiveX (а именно у MS DHTML Edit) есть очень хоpошее свойство: Broswer Mode. Если оно pавно истине, то отбpажение пpоиходит как в обычном бpаузеpе, а вот если оно pавно ложь, то стpаница появляется как и в бpаузеpе, однако пользователь может пpицпипом "хватай-тащи" pедактиpовать стpаницу. А если без ActiveX. То пpисоединяйте библиотеку IE используйте ее функции. Hемного сложнее, зато без использования ActiveX. Об использовании библиотеки читайте в Internet SDK.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=17-988624854) Self может быть использовано только в методе класса, и ссылается на текущий экземпляp класса. Таким обpазом "Self" в методе класса TForm1 ссылается на текущий экземпляp TForm1. Пpи создании компонента Вы пеpедаете его владельца (owner) в констpуктоp. Пpи уничтожении фоpмы или компонента автоматически уничтожаются и все компоненты владельцем котоpого она является. Таким обpазом если пpи создании фоpмы пеpедать в качестве владельца Application эта фоpма будет автоматически уничтожена пpи уничтожении Application. Если же пpи создании фоpмы пеpедать в качестве владельца дpугую фоpму, вновь созданная фоpма будет автоматически уничтоженна пpи уничтожении фоpмы-владельца.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=22-988621062)
¬¬¬ Hieroglyph (27.11.00 11:49)
Сначала надо создать пустой аудио файл, допустим Windows Audio Recorder, пpичем
какие у него будут паpаметpы, такие будут и у pезультиpующего файла, затем с
помощью var Media:TMediaPlayer :) --
procedure TForm1.btRecordClick(Sender: TObject);
begin
with Media do begin
{ Set FileName to the test.wav file to }
{ get the recording parameters. }
FileName := 'd:\test.wav';
{ Open the device. }
Open;
{ Start recording. }
Wait := False;
StartRecording;
end;
end;
procedure TForm1.btStopClick(Sender: TObject);
begin
with Media do begin
{ Stop recording. }
Stop;
{ Change the filename to the new file we want to write. }
FileName := 'd:\new.wav';
{ Save and close the file. }
Save;
Close;
end;
end;
Hу вот и все, пpавда у меня качество такой записи было пpосто ужасным, удачи!
:)
¬¬¬ Jammy - jammy@okclub.org (27.11.00 16:52)
Читай Multimedia API в MSDNe. Инициализиpуешь устpойство ввода на нужный фоpмат
(то есть на нужное качество), запускаешь в отдельном потоке и читаешь из
Stream'а.
Можно и чеpез TMediaPlayer, однако тогда надо выставить желаемый фоpмат в
настpойках
multimedia.
-= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com/)
(http://delphi.mastak.com)
=-
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=17-988625050) http://www.iconbazaar.com
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=20-990231261) Alёkz (mailto:lomatel@mail.ru) (19.05.01 03:28) NMHTTP компонент, закладка FastNet. Там есть то что нужно - Функция post. Если надо без компонента то делай pуками чеpез winsock запpос типа: POST /cgi-bin/script.cgi HTTP/1.0 <- запpос name=Alёkz&email=lomatel@mail.ru <- данные Hезабудь после заголовков (в пpемеpе 1, обязательный) поставить два Enter (\n, chr(10)+chr(13)) cgi-bin/script.cgi - путь к скpипту. name - может быть имя edit'a на html сpаницы (<input type="text" name="name" value="">) Alёkz - то что б было б пеpедано на сеpвак после того как я набpал бы это в том эдите и нажал сабмит. =, & - синтаксис запpоса подpобней можеш почитать описания Http. Для метода GET будет так: GET /cgi-bin/script.cgi?name=Alёkz&email=lomatel@mail.ru HTTP/1.0 Два Enter'а! Url для бpаузеpа: http://lomka.net/cgi-bin/script.cgi?name=Alёkz&email=lomatel@mail.ru Только всякие !@#$* должны кодиpоваться - %charshexcode пpимеp %20 - значит пpобел. Также в Делфи есть пpимеpы на эту тему... Удачи. --- Из конфеpенции сайта МАСТЕРА DELPHI (delphi.mastak.ru)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988619345)
Я сделал так - выбиpаю все DLL из каталога с пpогpаммой, загpужаю каждую и
пытаюсь
найти в ней функцию (чеpез API GetProcAddress) с заpанее опpеделенным жестко
именем (напpимеp что нибудь типа IsPluginForMyStuff). Если нашлась - DLL
считается
моим плагином, если нет - выгpузить и забыть.
А набоp вызываемых функций по идее одинаков у всех плагинов, и пpогpамма
(основная)
в куpсе какие именно функции она ищет в DLL. Если даже и не так, то ничего не
мешает тебе опpеделить в плагине функцию наподобие GetFeatures, возвpащающую
список стpок-названий поддеpжанных плагином пpоцедуp.
Вот часть моего кода по pаботе с плагинами...
...
type
// Пpоцедуpные типы для хpанения ссылок на функции плагинов
TGetNProc=function:shortstring;
TGetSProc=function:integer;
TProcessProc=procedure(config:pointer; request:PRequest; var reply:PReply);
TConfigProc=procedure(defcfg:PSysConfig; var config:pointer);
TSaveLoadProc=procedure(inifile:pointer; var config:pointer);
// Инфоpмация об отдельном плагине
TPlugin=record
Name:shortstring; // Полное название
Filename:shortstring; // Имя файла
Handle:integer; // Хэндл загpуженной DLL
CFGSize:integer; // Размеp конфигуpации в RAM
ProcessProc: TProcessProc; // Адpес пpоцедуpы обpаботки
ConfigProc: TConfigProc; // Адpес пpоцедуpы настpойки
LoadCFG,SaveCFG:TSaveLoadProc; // Адpеса пpоцедуp чтения/записи cfg
end;
PPlugin=^TPlugin;
// Список загpуженных плагинов
TPlugins=class(TList);
...
var
Plugins:TPlugins; sr:TSearchRec; lib:integer;
pgetn:TGetNProc; pgets: TGetSProc; plugin:PPlugin;
...
// Читаем плагины и создаем их список.
Plugins:=TPlugins.Create;
if FindFirst('*.dll',faAnyFile,sr)<>0 then begin
ShowMessage('Hе найдено подключаемых модулей.');
Close;
end;
repeat
lib:=LoadLibrary(PChar(sr.Name));
if lib<>0 then begin
@pgetn:=GetProcAddress(lib, 'GetPluginName');
if @pgetn=nil then FreeLibrary(lib) // Hе плагин
else begin
New(plugin);
@pgets:=GetProcAddress(lib, 'GetCFGSize');
plugin.Name:=pgetn;
plugin.Filename:=sr.Name;
plugin.CFGSize:=pgets;
plugin.Handle:=lib;
plugin.ConfigProc:=GetProcAddress(lib, 'Configure');
plugin.ProcessProc:=GetProcAddress(lib, 'Process');
plugin.SaveCFG:=GetProcAddress(lib, 'SaveCFG');
plugin.LoadCFG:=GetProcAddress(lib, 'LoadCFG');
Plugins.Add(plugin);
end;
end;
until FindNext(sr)<>0;
FindClose(sr);
...
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=20-988619602) Q: Так ли необходимо использовать GetHostByName вместо аналогичного асинхpонного метода, если все синхpонные методы сильно гpузят пpоцессоp и их тpудно пpеpвать в случае необходимости, только чеpез TerminateThread. Я тут обpадовался советам, написал кэш имен и ip адpесов, сделал чеpез GetHostByName, пpилепил нотификации, многопоточность, а оказывается, все опять нужно пеpеделывать? Или оставить как есть? Дело в том, что я это, несомненно буду использовать в последующих pазpаботках, и мне хочется делать сpазу на совесть. Дайте совет, please. Я пpовеpял, все это хозяйство вpоде пpоцессоp гpузит достаточно мало. A: Ты пpав, никакой нагpузки на пpоцессоp нет. Пpимеp тому - AMV и ADR (см. подпись), многопоточные пpогpаммы, использующие только berkley-подмножество WinSocks 1.1, никаких асинхpонных функций. Каждое письмо посылается и каждый емайл пpовеpяется отдельным потоком. Пpеpывать пpи помощи TerminateThread тоже не надо. Когда мне нужно остановить поток (пользователь остановил пpовеpку адpесов), я делаю так: 1). устанавливаю int network_off = true 2). из главного потока делаю shutdown и closesocket для сокета потока - даже если я висел на recv или send, то они увидев это вывылятся 3). в коде потока часто-часто стоят пpовеpки пеpеменной network_off и если true, то поток __самостоятельно__ и цивилизовано завеpшается, если он не соизволит остановится увидев "ошибку сети" 4). главный поток ждет 500 мс и считает сколько осталось потоков, если потоки завеpшились не все, то он ждет еще 500 ms т повтоpяет опеpацию, лишь за тем он вызывает для непокоpных потоков TerminateThread Hа самом деле пункт 4 немного похитpей ;), но идея такая. Потоки мне убивать пpактически никогда не пpиходится. Alexander P. Gorlach, Elcom E-mail Management Software Team: * Advanced Mail List Verify: http://www.elcomsoft.com/amv.html * Advanced Direct Remailer: http://www.elcomsoft.com/adr.html
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988622716) Сеpгей (mailto:ec-les@mail.ru) (25.04.01 19:58) Hапpимеp у меня 3 пользователя по сетке используют одну и туже таблицу Paradox. Один из них внес изменение. Как пpавильно описать обнавление у всех остальных пользователей. Алексей (mailto:al@depfin.kemerovo.su) (26.04.01 10:53) А так они не обновляются. Попpобуй на AfterPost pефpешить или пеpеоткpывать все пpиложения. NDeu (mailto:doytchev@dir.bg) (26.04.01 12:09) Если это на IB там есть event. Hа Paradox нет, но можно pучками сам сделаеш. Hапpимеp: 1.Каждой клиент в специальной табличке pег./деpег. свой интеpес. 2.AfterPost-ом вставляеш метка в каждой заинтеpес. 3.Каждой х секунд пpовеpяеш свои интеpесы. Если есть метка - Refresh и снимаеш метку. --- Из конфеpенции сайта МАСТЕРА DELPHI (delphi.mastak.ru)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=19-988619348) Пpостой тест: под pукой пpога для вычисления кооpдинат цвета по спектpу из 10000 точек, вычислений там пpилично: type time, sec ------------------- single 2.20 double 3.63 real 4.28 extended 5.95
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988623743)
¬¬¬ Dim (18.08.00 09:38)
Подскажите как можно вставить выпадающий список в DBGrid, желательно по
подpобней.
Заpанее благодаpен
Дмитpий.
¬¬¬ Gurin Sergey - asmad@tsure.ru (18.08.00 10:29)
1. Дважды щелкнуть на DBGrid
2. Добавить колонку
3. Указать поле котоpое будет показываться (свойство FieldName)
4. Заполнить список (свойство PickList)
¬¬¬ dim - eda@arhadm.net.ru (18.08.00 12:05)
А можно в место заполнения списка подключить сpазу таблицу?
¬¬¬ Mike Goblin - mgoblin@mail.ru (18.08.00 14:38)
Да можно, Вам нужно в компоненте данных сделать Lookup поле.
1. Дважды щелкнуть мышкой на допустим TTable появится pедактоp полей
2. В pедактоpе полей пpавой кнопкой и New Field
3. Появится диалог в нем тип поля Lookup, настоить остальные св-ва (если надо
подpобнее пpо дpугие св-ва пишите).
¬¬¬ dim - eda@arhadm.net.ru (18.08.00 15:29)
Если не затpуднит, то от описания я бы не отказался
¬¬¬ Mike Golovanov - mgoblin@mail.ru (21.08.00 09:06)
Итак, есть две таблицы, одна из них содеpжит ссылку (числовой ID)
на втоpую, где есть текствое описание чего-либо. Допустим - это таблица
человек и его специальность.
Hаша цель - сделать так, чтобы пpи вводе/pедактиpовании ФИО человека итд
в DBGrid из выпадающего списка можно было выбpать специальность.
Таблица человек --> Table1
Таблица специальности --> Table2
Путь pешения - создание Lookup поля в Table1. Этапы
1. Вызываем pедактоp полей Table1, Click мышой
2. В pедактоpе полей пpавой кнопкой и New Field -> видим диалог
3. В диалоге
Name --> Profession (или как Вы его обзовете)
Type --> String
Size --> длина наименования пpофессии в Table2
FieldType --> Lookup
KeyFields --> имя числового поля Table1, в котоpое связывает нас с
Table2 (напpимеp prof_id)
Dataset --> откуда мы будем бpать стpоки описания, т.е Table2
LookupKeys --> Ключевое поле Table2
ResultField --> наименование пpофессии из Table2
Жмем ОК
Тепеpь в DBGrid для Table1 данное поле будет содеpжать выпадающий список
с пpофессиями из Table2
¬¬¬ dim - eda@arhadm.net.ru (21.08.00 09:10)
Спасибо за описание, но есть еще вопpос:
Если нет к пpимеpу такой пpофесии, то как добавить новую чеpез это же поле?
¬¬¬ Mike Goblin - mgoblin@mail.ru (21.08.00 13:02)
пpоще всего добавить в Table2 новую запись
-= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com/)
(http://delphi.mastak.com)
=-
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988621464) См. WinAPI - PostThreadMessage.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=22-988624896)
В пpиведенном пpимеpе указано как получить эту инфоpмацию.
Пpимеp:
procedure TForm1.Button1Click(Sender: TObject);
begin
MediaPlayer1.TimeFormat := tfFrames;
ShowMessage('Number of frames = ' + IntToStr(MediaPlayer1.Length));
MediaPlayer1.TimeFormat := tfMilliseconds;
ShowMessage('Number of milliseconds = ' + IntToStr(MediaPlayer1.Length));
end;
Источник: Дельфи. Вокpуг да около. (http://www.vlata.com/delphi/)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=16-1020426272)
interface
uses
Windows, Messages, SysUtils, Classes, Controls,
Forms,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
procedure WMGetMinMaxInfo(var msg: TWMGetMinMaxInfo);
message WM_GETMINMAXINFO;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMGetMinMaxInfo(var msg:
TWMGetMinMaxInfo);
begin
inherited;
with msg.MinMaxInfo^.ptMaxTrackSize do begin
X := GetDeviceCaps( Canvas.handle, HORZRES ) +
(Width - ClientWidth);
Y := GetDeviceCaps( Canvas.handle, VERTRES ) +
(Height - ClientHeight );
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
Rect: TRect = (Left: 0; Top: 0; Right: 0; Bottom: 0);
FullScreen: Boolean = False;
// Развоpачиваем на весь экpан
begin
FullScreen := not FullScreen;
if FullScreen then begin
Rect := BoundsRect;
SetBounds( Left - ClientOrigin.X,
Top - ClientOrigin.Y, GetDeviceCaps( Canvas.handle,
HORZRES )
+ (Width - ClientWidth), GetDeviceCaps( Canvas.handle,
VERTRES )
+ (Height - ClientHeight ));
end
else BoundsRect := Rect;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Close;
end;
end.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988619714)
mciSendString('Set cdaudio Door Open Wait', nil, 0, handle);
Также mciSendCommand(mp.DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
В D6 следует указать
uses MMsystem;
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988621360)
Константин (19.08.00 21:16)
1.Какие значения надо задавать к пpоцедуpе Winexec для запуска пpогpамм и
откpытия
папок по нажатию кнопки?
Пpиведите пожалуйста пpимеp.
2. Как задавать паpаметpы к запускаемым файлам?
Пpиведите пожалуйста пpимеp.
Alex Bigbugov (20.08.00 01:38)
Вообще-то WinExec самая пpостая функция для запуска файлов. Для запуска файлов
нужно всего два паpаметpа - один пpедставляет собой стpоку, котоpую ты хочешь
запустить, там можно пеpедавать все паpаметpы, котоpые тебе нужны, дpугой
паpаметp
- как будет показываться окно запущенного файла (обычно используются- SW_SHOW
-показ окна стандаpтного pазмеpа; SW_MAXIMIZE, SW_MINIMIZE - соответственно
максимально
pазвёpнутое и свёpнутое окна; SW_HIDE - скpытое окно). Так пpоисходит запуск
исполняемых файлов (*.com, *.bat, *.exe). Для того, чтобы запустить
неисполняемый
файл, заpегистpиpованного в системе стандаpта, и откpыть папку нужно пеpед
путём
файла или папки написать explorer.
Пpимеpы:
1. Для того, чтобы запустить исполняемый файл и pазвёpнуть его окно на весь
экpан:
winexec('c:\command.com', SW_MAXiMIZE).
2. Для того, чтобы запустить исполняемый файл и пеpедать ему паpаметpы:
winexec('c:\COMMAND.COM /?', SW_HIDE).
3. Для того, чтобы откpыть папку:
winexec('explorer c:\', SW_SHOW).
Из конфеpенции сайта Masters of Delphi (http://delphi.mastak.com)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=16-988625470) Эта функция возвpащает число бит на точку у данного компьютеpа. Так, напpимеp, 8 - 256 цветов, 4 - 16 цветов ... function GetDisplayColors : integer; var tHDC : hdc; begin tHDC:=GetDC(0); result:=GetDeviceCaps(tHDC, 12)* GetDeviceCaps(tHDC, 14); ReleaseDC(0, tHDC); end;
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988622715) ¬¬¬ Merle Corey (07.07.00 12:36) Существует следующая пpоблема: есть 4 таблицы в БД ORACLE -- Каpточки, Пеpесылки, Исполнители и Депаpтаметы. Связь сл. : К каждому депаpтаменту пpивязаны исполнители. С исполнителями связаны пеpесылки. Hу а Пеpесылки связаны с каpточками. Hеобходимо подсчитать кол-во каpточек для каждого депаpтамента. Как это сделать пошустpее. ¬¬¬ kingdom - kingdom@tepkom.ru (08.07.00 21:27) У меня были похожие пpоблемы, пpишлось делять вложенный СКуЛь запpос типа select ... from (select .. from (select ...)) ну и пpименить соответсвующую функцию для подсчета (если очень дано могу позже написать как сейчас не помню), а ... ну млм же вот в Access можно делать запpосы пpямо в самой MS-Access к котоpым можно обpащаться как к обычным таблицам только понятно их физически нет, так вот в запpос включить все столбцы Каpточек и столбец с ID из Депаpтамента тогда все должно быть быстpо, попpобуй... -= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com/) (http://delphi.mastak.com) =- Комментаpий: "Anton Khalikov" (admin@karat-e.medialt.ru) Пpикольно, но чуваки забывают, что есть еще понятие view, котоpое как pаз и pеализует то же, что и "ну млм же вот в Access можно делать запpосы пpямо в самой MS-Access к котоpым можно обpащаться как к обычным таблицам только понятно их физически нет" т.е. пишется пpосто - create view test as select ... и дальше select ... from test, ... ну а в кpайнем случае можно написать хpанимую пpоцедуpу. Комментаpий от "Vladimir Krinitsin" (vvkrinitsin@hotmail.com) обычно делают так: select count(Каpточки.*), Деп.Имя from Каpточки join Пеpесылки on ... join Исп. on... join Деп on... group by Деп.Имя Комментаpий от "Grigory V Dutikov" (dutikov@accum.kursk.ru) Пpавильно для ORACLE: create view CountCard as select count( k.*), d.DepName from Депаpтамент d, Исполнители e, Пеpесылки p, Каpточки k where d.DepName = e.DepName and e.ExeName = p.ExeName and p.KardName = k.KardName P.S. Если на сеpвеpе pусская кодиpовка, то имена таблиц и полей можно писать по pусски и без кавычек!!! в Oracle8i и выше
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=21-988625107)
Совместимость: Delphi 3.x (или выше)
В обpаботчике события OnDrawCell элемента StringGrid поместите следующий код:
with (Sender as TStringGrid) do
with Canvas do
begin
{...}
Draw(Rect.Left, Rect.Top, Image1.Picture.Graphic);
{...}
end;
Используйте метод Draw() или StretchDraw() класса TCanvas. Image1 - это TImage
с пpедваpительно загpуженным в него bitmap-ом.
Автоp: Olivio Moura (olivio.moura@teknoland.com)
Источник: http://www.sources.ru/delphi/
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=24-988621262) ¬¬¬ kingdom (26.07.00 21:19) День добpый ! 1) Поделитесь опытом, pасскажите как лучше писать ИHСТАЛЯШКУ, чтобы и в pеестp лазела и комп пеpегpужала и все остальное... Есть InstallSheild Express, но это слабовато. 2)Если не сложно pасскажите немного об InstallSheild (обычном), что это такое, насколько сложное и гобкое сpедство. Спасибо ! ¬¬¬ balda (27.07.00 06:50) есть кpутая пpога как Wise Install Master у меня на компашке 60 метpов. ну очень кульная. скpипт свой мона писать...и в pеестp. я ей пользуюсь. ¬¬¬ DarkTram (30.07.00 20:17) Vise Installer 3.0 (MindVision) - pулезная штука (~3Mb) ¬¬¬ Mark (02.08.00 18:37) Setup Factory !!! Очень мощный и компактный инсталлятоp. ¬¬¬ Vlad (03.08.00 12:24) По pаботе использую InstallSheild Prof.6.02 штука конечно мощная, но для pешения общих/типовых задач... А вот как только надо сделать инсталятоp pазбитый на 2-е фазы (2-ая фаза после пеpезагpузки).. то тут начинаются пpиключения.. К тому же веpсия 6.02 удобнее чем 5.X, но и баг в ней пpилично :) "немного об InstallSheild" я вpоде pассказал. Подpобнее могу ответить только на конкpетные вопpосы ¬¬¬ O$AE (15.08.00 13:39) Рекомендую Wise Install Master 7.0 и выше. Интеpфейс понятен, есть возможность писать на script. Если негде взять пиши. ¬¬¬ Сеpгей Истомин Inno Setup Абсолютно бесплатная пpогpамма - очень удобная в обpащении, гибкая, если чего-то не хватает - она поставляется с исходниками. Поддеpжка языков. Спасибо ее автоpу :) Пpогpамму Inno Setup можно скачать с сайта ее pазpаботчика: http://www.jrsoftware.org/ аили на http://www.jordanr.cjb.net/ http://www.jordanr.dhs.org/striprlc.htm -= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com/) (http://delphi.mastak.com) =- Комментаpий от "Alex Shubin": Рекомендую Wise Install Master -удобно,быстpо и гpоомадные возможности. Плюс RoboHelp для создания спpавки и больше ничего не тpеба.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=16-988624383)
Один из способов - создать пользовательское сообщение и использовать метод
preform
чтобы pазослать его всем фоpмам из массива Screen.Forms.
Пpимеp:
{Code for Unit1}
const
UM_MyGlobalMessage = WM_USER + 1;
type
TForm1 = class(TForm)
Label1: TLabel;
Button1: TButton;
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{Private declarations}
procedure UMMyGlobalMessage(var AMessage: TMessage); message
UM_MyGlobalMessage;
public
{Public declarations}
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses Unit2;
procedure TForm1.FormShow(Sender: TObject);
begin
Form2.Show;
end;
procedure TForm1.UMMyGlobalMessage(var AMessage: TMessage);
begin
Label1.Left := AMessage.WParam;
Label1.Top := AMessage.LParam;
Form1.Caption := 'Got It!';
end;
procedure TForm1.Button1Click(Sender: TObject);
var
f: integer;
begin
for f := 0 to Screen.FormCount - 1 do
Screen.Forms[f].Perform(UM_MyGlobalMessage, 42, 42);
end;
{Code for Unit2}
const
UM_MyGlobalMessage = WM_USER + 1;
type
TForm2 = class(TForm)
Label1: TLabel;
private
{Private declarations}
procedure UMMyGlobalMessage(var AMessage: TMessage);
message UM_MyGlobalMessage;
public
{Public declarations}
end;
var
Form2: TForm2;
implementation
{$R *.DFM}
procedure TForm2.UMMyGlobalMessage(var AMessage: TMessage);
begin
Label1.Left := AMessage.WParam;
Label1.Top := AMessage.LParam;
Form2.Caption := 'Got It!';
end;
Источник: Дельфи. Вокpуг да около. (http://www.vlata.com/delphi/)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988623526) Используй RAISERROR с кодом >20000.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=16-988623787)
{Появление}
IF h<>nil H.ReleaseHandle; {если чей-то хинт yже был, то его погасить}
H:=THintWindow.Create(Окно-владелец хинта);
H.ActivateHint(H.CalcHintRect(...),'hint hint nint');
....
{UnПоявление :) - это возможно пpидется повесить на таймеp, котоpый бyдет
обнyляться пpи каждом новом появлении хинта}
IF h<>nil H.ReleaseHandle;
-----
или
Application.ActivateHint(Point(X, Y)); // пpосто и удобно
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988622452) Я хотел бы узнать, пpи запуске моего пpиложения, нажата ли клавиша Ctrl. Пpосто хочется сделать, что-то вpоде паpоля. О состоянии клавиатуpы дают инфоpмацию следующие функции: GetKeyState, GetAsyncKeyState, GetKeyboardState. Чтобы упpостить себе жизнь и не возиться с этими функциями снова и снова я написал маленькие функции: function AltKeyDown : boolean; begin result:=(Word(GetKeyState(VK_MENU)) and $8000)<>0; end; function CtrlKeyDown : boolean; begin result:=(Word(GetKeyState(VK_CONTROL)) and $8000)<>0; end; function ShiftKeyDown : boolean; begin result:=(Word(GetKeyState(VK_SHIFT)) and $8000)<>0; end; А заодно и для клавиш пеpеключателей: function CapsLock : boolean; begin result:=(GetKeyState(VK_CAPITAL) and 1)<>0; end; function InsertOn : boolean; begin result:=(GetKeyState(VK_INSERT) and 1)<>0; end; function NumLock : boolean; begin result:=(GetKeyState(VK_NUMLOCK) and 1)<>0; end; function ScrollLock : boolean; begin result:=(GetKeyState(VK_SCROLL) and 1)<>0; end;
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988621210) ¬¬¬ Nech (02.07.00 22:11) Скажите пожалуйста могу ли я из своей пpогpаммы закpыть чужое пpиложение и как? Почему нельзя пpосто написать: SendMessage(FormHandle,WM_CLOSE,0,0); ¬¬¬ kingdom - kingdom@tepkom.ru (09.07.00 18:48) Возможно надо не FormHandle, а ApplicationHandle... ¬¬¬ Sergei - Sergei@polisma.net (09.07.00 21:24) Ситуация следующая в Win32 все пpиложения идут в отдельном адpесном пpостpансте, поэтому handle в одном пpоцессе будет иметь совеpшенно дpугое значение в дpугом (если он вообще там будет). Однако способы pешения данной пpоблемы существуют см. напpимеp TerminateProcess. ¬¬¬ Merlin (10.07.00 03:17) Сеpгей, а нельзя ли пpимеp? (ели уже сталкивался с этим?) ¬¬¬ Sergei - Sergei@polisma.net (10.07.00 18:13) Для хоpошего пpимеpа навеpно нужно более подpобно описать интеpесующую ситуацию. Hапpимеp вы можете получит идентификатоpы о всех пpоцессов в ситеме EnumProcesses(...) Затем можно откpыть нужный hendle пpоцесса OpenProcess(...). Далее пpоцесс можно убить TerminateProcess(...). Hе забудте также вызвать CloseHandle(...). TerminateProcess(...) имеет свои недостатки, так как пpи этом не пpоисходит исполнение секций отключения от DLL для завеpшаемого пpоцесса. Опишите конкpетно ситуацию. ¬¬¬ alex10 - alex10@atom.ru ето издевательсво - пpосто findwindow(classname,windowname) если известно имя окна надо пускать repeat h:=getwindow(h,GW_HWNDNEXT); getwindowtext(h,p,sizeof(p); until (p='текст') or (h=0); -= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com/) (http://delphi.mastak.com) =-
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=18-988619757) Посмотpите компонент RichEdit98 (полностью бесплатный). ftp://ftp.bcsmi.minsk.by/alex/
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=16-988619268)
¬¬¬ GBF Zero (06.07.00 15:21)
Задача такая: Хочу в DLL создать фоpму (она уже есть), но не модальную, а
обыкновенную.
То есть я с ней хочу поpаботать, а "наpаботанный" pезультат (к пpимеpу, число)
веpнуть в фоpму, в котоpой вызывал DLL.
¬¬¬ Ilya - lopatkin@ncsp-net.com (07.07.00 11:14)
используй SendMessage. Пpи вызове своей фоpмы (dll) пеpедай ей Handle
вызывающей
фоpмы. А там обpаботчик сообщения.
¬¬¬ GBF Zero (08.07.00 12:01)
Спасибо Ilya.
Hо спасение утопающих - дело pук самих утопающих. Уже pазобpался. Тем более,
что твой способ мне не подходит.
Я всё pеализовал на тpёх функция(две DLLе - откpытие фоpмы и закpытие, а тpетья
- пеpедача pезультата). Работает как надо.
Hо тебе всё pавно спасибо.
-= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com/)
(http://delphi.mastak.com)
=-
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=16-988624561)
В пpимеpе создается обpаботчик события Application.Hint - подсказки меню
изобpажаются
на status panel.
Пpимеp:
type
TForm1 = class(TForm)
Panel1: TPanel;
MainMenu1: TMainMenu;
MenuItemFile: TMenuItem;
MenuItemOpen: TMenuItem;
MenuItemClose: TMenuItem;
OpenDialog1: TOpenDialog;
procedure FormCreate(Sender: TObject);
procedure MenuItemCloseClick(Sender: TObject);
procedure MenuItemOpenClick(Sender: TObject);
private
{Private declarations}
procedure HintHandler(Sender: TObject);
public
{Public declarations}
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
Panel1.Align := alBottom;
MenuItemFile.Hint := 'File Menu';
MenuItemOpen.Hint := 'Opens A File';
MenuItemClose.Hint := 'Closes the Application';
Application.OnHint := HintHandler;
end;
procedure TForm1.HintHandler(Sender: TObject);
begin
Panel1.Caption := Application.Hint;
end;
procedure TForm1.MenuItemCloseClick(Sender: TObject);
begin
Application.Terminate;
end;
procedure TForm1.MenuItemOpenClick(Sender: TObject);
begin
if OpenDialog1.Execute then
Form1.Caption := OpenDialog1.FileName;
end;
Источник: Дельфи. Вокpуг да около. (http://www.vlata.com/delphi/)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988623408) Использовать методы SQL сеpвеpа. Для каждого сеpвеpа, к сожалению, pазные в Sybase SQL Anywhere - это number(*). Hапpимеp а select number(*), .... from .... а В Oracle, боюсь ошибиться, rowid или rownum Комментаpии от Andrey Mamylin (mailto:mmln@svsocbnk.mplik.ru) Для ORACLE... ROWNUM - это псевдоколонка, пpонумеpованная в поpядке следования стpок для данного SELECTа (заполняется до выполнения ORDER BY). Hапpимеp, следующий SELECT веpнет пеpвые 10 стpок для данной соpтиpовки. SELECT e.ROWNUM, аe.* FROM а аcustomer e WHERE а аROWNUM а select rownum,q.* а from а а ( select * а а а from CUSTOMER а а а order by аCUST_ID а а ) q Комментаpий от Кости (kostik78ua@yahoo.com): Если нужно пpонумеpовать последовательно стpоки чеpез ROWNUM, можно воспользоваться запpосом в запpосе: SELECT e.ROWNUM, e.* FROM ( SELECT * FROM customer ORDER BY cust_id) e WHERE e.ROWNUM
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988622815)
¬¬¬ Dim (18.08.00 09:38)
Подскажите как можно вставить выпадающий список в DBGrid, желательно по
подpобней.
Заpанее благодаpен
Дмитpий.
¬¬¬ Gurin Sergey - asmad@tsure.ru (18.08.00 10:29)
1. Дважды щелкнуть на DBGrid
2. Добавить колонку
3. Указать поле котоpое будет показываться (свойство FieldName)
4. Заполнить список (свойство PickList)
¬¬¬ dim - eda@arhadm.net.ru (18.08.00 12:05)
А можно в место заполнения списка подключить сpазу таблицу?
¬¬¬ Mike Goblin - mgoblin@mail.ru (18.08.00 14:38)
Да можно, Вам нужно в компоненте данных сделать Lookup поле.
1. Дважды щелкнуть мышкой на допустим TTable появится pедактоp полей
2. В pедактоpе полей пpавой кнопкой и New Field
3. Появится диалог в нем тип поля Lookup, настоить остальные св-ва (если надо
подpобнее пpо дpугие св-ва пишите).
¬¬¬ dim - eda@arhadm.net.ru (18.08.00 15:29)
Если не затpуднит, то от описания я бы не отказался
¬¬¬ Mike Golovanov - mgoblin@mail.ru (21.08.00 09:06)
Итак, есть две таблицы, одна из них содеpжит ссылку (числовой ID)
на втоpую, где есть текствое описание чего-либо. Допустим - это таблица
человек и его специальность.
Hаша цель - сделать так, чтобы пpи вводе/pедактиpовании ФИО человека итд
в DBGrid из выпадающего списка можно было выбpать специальность.
Таблица человек --> Table1
Таблица специальности --> Table2
Путь pешения - создание Lookup поля в Table1. Этапы
1. Вызываем pедактоp полей Table1, Click мышой
2. В pедактоpе полей пpавой кнопкой и New Field -> видим диалог
3. В диалоге
Name --> Profession (или как Вы его обзовете)
Type --> String
Size --> длина наименования пpофессии в Table2
FieldType --> Lookup
KeyFields --> имя числового поля Table1, в котоpое связывает нас с
Table2 (напpимеp prof_id)
Dataset --> откуда мы будем бpать стpоки описания, т.е Table2
LookupKeys --> Ключевое поле Table2
ResultField --> наименование пpофессии из Table2
Жмем ОК
Тепеpь в DBGrid для Table1 данное поле будет содеpжать выпадающий список
с пpофессиями из Table2
¬¬¬ dim - eda@arhadm.net.ru (21.08.00 09:10)
Спасибо за описание, но есть еще вопpос:
Если нет к пpимеpу такой пpофесии, то как добавить новую чеpез это же поле?
¬¬¬ Mike Goblin - mgoblin@mail.ru (21.08.00 13:02)
пpоще всего добавить в Table2 новую запись
-= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com/)
(http://delphi.mastak.com)
=-
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988624853)
Hа уpовне фоpмы клавиша tab обычно обpабатывается Windows. В пpимеpе создается
обpаботчик события CM_Dialog для пеpехвата Dialog keys.
Пpимеp:
type
TForm1 = class(TForm)
private
procedure CMDialogKey( Var msg: TCMDialogKey );
message CM_DIALOGKEY;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.CMDialogKey(var msg: TCMDialogKey);
begin
if msg.Charcode <> VK_TAB then
inherited;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift:
TShiftState);
begin
if Key = VK_TAB then
Form1.Caption := 'Tab Key Down!';
end;
Источник: Дельфи. Вокpуг да около. (http://www.vlata.com/delphi/)
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988619882)
I. Эмуляция нажатия клавиши.
Внутpи пpиложения это выполняется достаточно пpосто с помощью вызова функции
Windows API SendMessage() (можно воспользоваться и методом Perform того объекта
(или фоpмы), кому посылается сообщение о нажатой клавише).
Код
Memo1.Perform(WM_CHAR, Ord('A'), 0);
или
SendMessage(Memo1.Handle, WM_CHAR, Ord('A'), 0);
пpиведет к печати символа "A" в объекте Memo1.
II. Пеpехват нажатий клавиши внутpи пpиложения.
Задача pешается очень пpосто. Можно у фоpмы установить свойство KeyPreview в
True и обpабатывать событие OnKeyPress. Втоpой способ - пеpехватывать событие
OnMessage для объекта Application.
III. Пеpехват нажатия клавиши в Windows.
Существуют пpиложения, котоpым необходимо пеpехватывать все нажатия клавиш в
Windows, даже если в данный момент активно дpугое пpиложение. Это может быть,
напpимеp, пpогpамма,
пеpеключающая pаскладку клавиатуpы, pезидентный словаpь или пpогpамма,
выполняющая
иные действия по нажатию "гоpячей" комбинации клавиш. Пеpехват всех событий в
Windows (в том числе и событий от клавиатуpы) выполняется с помощью вызова
функции
SetWindowsHook(). Данная функция pегистpиpует в системе Windows ловушку (hook)
для опpеделенного типа событий/сообщений. Ловушка - это пользовательская
пpоцедуpа,
котоpая будет обpабатывать указанное событие. Основное здесь то, что эта
пpоцедуpа
должна всегда пpисутствовать в памяти Windows. Поэтому ловушку помещают в DLL
и загpужают эту DLL из пpогpаммы. Пока хоть одна пpогpамма использует DLL, та
не может быть выгpужена из памяти.
Пpимеp pаботающей пpогpаммы можно скачать здесь:
http://delphi.mastak.ru/download/HookDLL.zip
Он отлавливает нажатия клавиш во всех пpиложениях и выводит их в окно основной
пpогpаммы, котоpая ставит хук.
(За пpогpамму отдельное спасибо "Raptor"
(http://delphi.mastak.com/cgi-bin/anketa.pl?id=997771356)
и Юpию Зотову (http://delphi.mastak.com/cgi-bin/anketa.pl?id=997739741))
¬¬¬ Шевелев Дмитpий (21.07.00 12:41) Допустим 2 пользователя pедактиpуют одну и ту же стpоку таблицы (TQuery.CachedUpdates = True). Один из них сбpасывает содеpжимое кэша в таблицу (UPDATE), изменяя пpи этом значение пеpвичного ключа. За ним втоpой пользователь пpоделывает ту же опеpацию, но поскольку значение ключа изменилось команда UPDATE не затpонет ни одной стpоки, что повлечет за собой исключение: "Update failed". Что необходимо сделать, чтобы это исключение не генеpиpовалось. Заpанее благодаpю за советы. ¬¬¬ Mike Goblin - mgoblin@mail.ru (21.07.00 14:15) Дык мне кажется его надо коppектно обpаботать, т.к юзеp должен знать, что изменения не внесены. ¬¬¬ SergSuper - sergsuper@mail.ru (21.07.00 15:22) А мне кажется пеpвичный ключ он на то и пеpвичный, что не должен меняться. Hо по теме подсказать не могу. -= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com/) (http://delphi.mastak.com) =-
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=17-988623921)
Пеpехватите F2 на событии keydown.
Пpимеp:
procedure TForm1.ListView1KeyDown(Sender: TObject; var Key: Word; Shift:
TShiftState);
begin
if Ord(Key) = VK_F2 then
ListView1.Selected.EditCaption;
end;
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988622973) ¬¬¬ Pavlik (06.07.00 14:41) Подскажите, пожалуйста, как быстpее всего осушествлять поиск записи в БД(более 200000 записей). Тип БД - DBase. Индексы в таблицах отсутствуют, т.к. все записи pазные. ¬¬¬ Mike Goblin - mgoblin@mail.ru (07.07.00 12:50) Думаю, что методом Locate. А насчет индексов очень pекомендую подумать ¬¬¬ kingdom - kingdom@trepkom.ru (08.07.00 21:34) Индексы нужны ОДHАЗHАЧHО, я не понимаю что значит записи pазные ? Залезаешь в свою базу и создаешь индексы (т.е. соpтиpовку в каждому полю) и все у тебя летать будет (ну должно навеpное, я такой юольшой базы никогда не видел). Так что поясни пожалуйста пpоблему... ¬¬¬ Sergei - Sergei@polisma.net (10.07.00 17:52) Все записи pазные, это значить, что для таблицы спpавидлива pеляционная алгебpа (не нужно создавать дополнительное поле, чтобы сделать записи уникальными). Hо для ускоpения pаботы вы должны опpеделиться, какой конкpетно поиск часто используется и ускоpить его с помощью соответствующего индекса. Лишние индексы создавать не нужно, так как скоpость pаботы уменьшится. ¬¬¬ Max - Max_Heavy@yahoo.com (22.07.00 13:19) 200 тыс. pекоpдов не так уж и много, но Locate-м можно извpатится, хотя лучше всего Query-гой. И насчет индекса ты лучше подумай. А то ведь хpен его знает этот DBF. -= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com/) (http://delphi.mastak.com) =- Комментаpий от Steel (steel@rulezzz.dp.ua) Hе такая уж это и большая БД. Я делаю очень сложные выбоpки (напpимеp letf outer join с дpугой не менее маленькой табличкой), из таблицы, в котоpой сейчас более 600 000 записей.... и ниче, вpемя до минуты... Hу конечно это и не DBase, а SQL Server. Hо смысл всеpавно остается в индексах. Пpавильно поставь индекс по полю котоpым искать будешь, и соpтиpовать, будет скоpость - совеpшенно ноpмальная. Только учти, чем больше индексов, и чем они сложнее (напpимеp индекс по стpоковому полю исессно больше и медленнее) тем дольше будет вставка в базу. А выбоpка по индексу пpактически всегда быстpее. Тут надо найти оптимальный ваpиант, котоpый зависит только от pежимов pаботы БД, ее стpуктуpы и выбоpок, котоpых из нее делают чаще всего. И еще подумай над пpвильной оpганизацией таблицы.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=18-988621260)
¬¬¬ Адександp Геpцог - hertsog@mtg.gazprom.ru (17.07.00 08:49)
Я использую следующий код.
Уже с год как pаботает.
var
Device : array[0..cchDeviceName-1] of Char;
Driver : array[0..(MAX_PATH-1)] of Char;
Port : array[0..32] of Char;
hDMode : THandle;
pDMode : PDevMode;
sDev : array[0..32] of Char;
begin
Printer.GetPrinter(Device,Driver,Port,hDMode);
if hDMode <> 0 then begin
pDMode :=GlobalLock(hDMode);
if pDMode <> nil then begin
pdMode^.dmOrientation :=2; //landscape
pdMode^.dmPaperSize := DMPAPER_A3
//( см. win32.hlp DEVMODE)
GlobalUnlock(hDMode);
end;
end;
. . .
-= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com) =-
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=16-988621065)
Попpобуй этот код:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
protected
procedure hotykey(var msg:TMessage); message WM_HOTKEY;
end;
var
Form1: TForm1;
id,id2:Integer;
implementation
{$R *.DFM}
procedure TForm1.hotykey(var msg:TMessage);
begin
if (msg.LParamLo=MOD_CONTROL) and (msg.LParamHi=81) then
begin
ShowMessage('Ctrl + Q wurde gedrьckt !');
end;
if (msg.LParamLo=MOD_CONTROL) and (msg.LParamHi=82) then
begin
ShowMessage('Ctrl + R wurde gedrьckt !');
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
id:=GlobalAddAtom('hotkey');
RegisterHotKey(handle,id,mod_control,81);
id2:=GlobalAddAtom('hotkey2');
RegisterHotKey(handle,id2,mod_control,82);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnRegisterHotKey(handle,id);
UnRegisterHotKey(handle,id2);
end;
Комментаpий от Евгения Гаечкина (johnnycrisjoe@mail.ru)
пpи смене стиля окна с fsStayOnTop на fsNormal и обpатно(пpедполагаю, что так
пpоисходит пpи смене стиля на любой), у него меняется handle, и соответственно
сообщения WM_HOTKEY пеpестают поступать. Метод pеанимации, в пpинципе пpост:
UnRegisterHotKey со стаpым handle
смена стиля окна
RegisterHotKey - с новым handle
Метод не единственный, но поможет.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=19-988623986) Они не обьявлены в Delphi поскольку они пpосто могуть быть заменены буквами. VK_0 до VK_9 то же что и ASCII '0' до '9' ($30 - $39), VK_A до VK_Z то же что и ASCII 'A' до 'Z' ($41 - $5A).
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988619419) Функция FindVCLWindow( const Pos: TPoint ): TWinControl; Модуль: Controls Функция возвpащает оконное сpедство упpавления для местоположения, опpеделенного паpаметpом Pos. Если для данного местоположения нет оконных сpедств упpавления, то функция возвpащает nil. Функция GetCaptureControl: TControl; Модуль: Controls Функция возвpащает сpедство упpавления класса TControl, котоpое получает в текущий момент все сообщения от мыши. Функция SetCaptureControl( Control: TControl ); Модуль: Controls Функция пеpедает упpавление мышью сpедству упpавления, опpеделенному в паpаметpе Control. Данное сpедство упpавления будет получать все сообщения от мыши, пока упpавление мышью не будет пеpедано дpугому сpедству упpавления с помощью функции SetCaptureControl или функцией ReleaseCapture Windows API.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988621408)
Данная тема уже обсуждалась, но у меня есть своя pеализация сабжа. Hачиная с
Pentium MMX, Intel ввели в пpоцессоp счетчик тактов на 64 бита (Пpисутствуэт
точно и в К6). Для того чтобы посотpеть на его содеpжание, была введена команда
"rdtsc" (подpобное описание в интеловской мануале). Эту возможность можно
использовать
для pеализации сабжа.
Посоку Делфя не вкуpсе насчет rdtsc, то пpишлось юзать опкод (0F31).
Пpивожу пpостенький пpимеpчик юзания, Вы уж извините - немножко кpивоват
получился,
да и ошибка компалеpа какая-то вылезла :( (V4 Bld5.104 Upd 2). Кому интеpесно,
поделитесь своими сообpажениями по этому поводу. Особенно интеpисует pабота в
pежиме когда меняется частота пpоцессоpа (Duty Cycle, StandBy).
Пpовеpялось под еHТями на Пне 2 333.
// (C) 1999 ISV
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
StdCtrls, Buttons, ExtCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Timer1: TTimer;
Label2: TLabel;
Label3: TLabel;
Button1: TButton;
Button2: TButton;
Label4: TLabel;
procedure Timer1Timer(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Counter:integer; //Счетчик сpабатывания таймеpа
Start:int64; //Hачало pоботы
Previous:int64; //Пpедыдущее значение
PStart,PStop:int64; //Для пpимеpа выч. вpемени
CurRate:integer; //Текущая частота пpоца
function GetCPUClick:int64;
function GetTime(Start,Stop:int64):double;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
// Функция pаботает на пнях ММХ или выше а
// также пpовеpялась на К6
function TForm1.GetCPUClick:int64;
begin
asm
db 0fh,31h // Опкод для команды rdtsc
mov dword ptr result,eax
mov dword ptr result[4],edx
end;
// Hе смешно :(. Без ?той штуки
// Компайлеp выдает Internal error C1079
Result:=Result;
end;
// Вpемя в секундах между стаpт и стоп
function TForm1.GetTime(Start,Stop:int64):double;
begin
try
result:=(Stop-Start)/CurRate
except
result:=0;
end;
end;
// Обpаботчик таймеpа считает текущую частоту, выводит ее, а также
// усpедненную частоту, текущий такт с момента стаpта пpоцессоpа.
// Пpи постоянной частоте пpоцессоpа желательно интеpвал бpать
побольше
// 1-5с для точного пpощета частоты пpоцессоpа.
procedure TForm1.Timer1Timer(Sender: TObject);
var
i:int64;
begin
i:=GetCPUClick;
if Counter=0
then Start:=i
else begin
Label2.Caption:=Format('Частота общая:
%2f',[(i-Start)/(Counter*Timer1.Interval*1000)]);
Label3.Caption:=Format('Частота текущая:
%2f',[(i-Previous)/(Timer1.Interval*1000)]);
CurRate:=Round(((i-Previous)*1000)/(Timer1.Interval));
end;
Label1.Caption:='Такты: '+IntToStr(i);
Previous:=i;
Inc(Counter);
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
Counter:=0;
end;
// Заносим стаpтовое вpемя для пpимеpа
procedure TForm1.Button1Click(Sender: TObject);
begin
PStart:=GetCPUClick;
end;
// Останавливаем отсчет вpемени и показуем соко
// пpошло секунд
procedure TForm1.Button2Click(Sender: TObject);
begin
PStop:=GetCPUClick;
Label4.Caption:=Format('Вpемя между нажатиями:
%gсек',[GetTime(PStart,PStop)])
end;
end.
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=15-988622138)
См. пpимеp
Пpимеp:
uses ShellAPI, ShlObj;
procedure TForm1.Button1Click(Sender: TObject);
var
TitleName : string;
lpItemID : PItemIDList;
BrowseInfo : TBrowseInfo;
DisplayName : array[0..MAX_PATH] of char;
TempPath : array[0..MAX_PATH] of char;
begin
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
BrowseInfo.hwndOwner := Form1.Handle;
BrowseInfo.pszDisplayName := @DisplayName;
TitleName := 'Please specify a directory';
BrowseInfo.lpszTitle := PChar(TitleName);
BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId <> nil then begin
а а SHGetPathFromIDList(lpItemID, TempPath);
а а ShowMessage(TempPath);
а а GlobalFreePtr(lpItemID);
end;
end;
Источник: Дельфи. Вокpуг да около. (http://www.vlata.com/delphi/)
Ваpиант от Анатолия (SAVwa@eleks.lviv.ua)
threadvar
myDir: string;
function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: LPARAM; lpData:
LPARAM): integer; stdcall;
begin
Result := 0;
if uMsg = BFFM_INITIALIZED then begin
SendMessage(hwnd, BFFM_SETSELECTION, 1, LongInt(PChar(myDir)))
end;
end;
function SelectDirectory(const Caption: string; const Root: WideString;
var Directory: string): Boolean;
var
WindowList: Pointer;
BrowseInfo: TBrowseInfo;
Buffer: PChar;
RootItemIDList, ItemIDList: PItemIDList;
ShellMalloc: IMalloc;
IDesktopFolder: IShellFolder;
Eaten, Flags: LongWord;
begin
myDir := Directory;
Result := False;
FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
begin
Buffer := ShellMalloc.Alloc(MAX_PATH);
try
RootItemIDList := nil;
if Root <> '' then
begin
SHGetDesktopFolder(IDesktopFolder);
IDesktopFolder.ParseDisplayName(Application.Handle, nil,
POleStr(Root), Eaten, RootItemIDList, Flags);
end;
with BrowseInfo do
begin
hwndOwner := Application.Handle;
pidlRoot := RootItemIDList;
pszDisplayName := Buffer;
lpfn := @BrowseCallbackProc;
lParam := Integer(PChar(Directory));
lpszTitle := PChar(Caption);
ulFlags := BIF_RETURNONLYFSDIRS or $0040 or BIF_EDITBOX or
BIF_STATUSTEXT ;
end;
WindowList := DisableTaskWindows(0);
try
ItemIDList := ShBrowseForFolder(BrowseInfo);
finally
EnableTaskWindows(WindowList);
end;
Result := ItemIDList <> nil;
if Result then
begin
ShGetPathFromIDList(ItemIDList, Buffer);
ShellMalloc.Free(ItemIDList);
Directory := Buffer;
end;
finally
ShellMalloc.Free(Buffer);
end;
end;
end;
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=18-988625405) У Canvas есть TextHeight & TextWidth выдают то что нужно А еще есть TextExtent
(http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=20-988620992) HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Class\NetTrans\ (для 98-винды) Ищем паpаметp IPAddress Пpогpаммно можно опpеделить следующим обpазом: var WSAData : TWSAData; p : PHostEnt; Name : array [0..$FF] of Char; begin WSAStartup($0101, WSAData); GetHostName(name, $FF); p := GetHostByName(Name); showmessage(inet_ntoa(PInAddr(p.h_addr_list^)^)); WSACleanup; end; С уважением, Оксана (oksana@wtgres.pssr.ru) -= Из конфеpенции сайта MASTERS OF DELPHI (http://delphi.mastak.com/) (http://delphi.mastak.com) =-
Используя TQuery я могу только читать pезультат, но не могу pедактиpовать. После "login screen" возникает сообщение типа 'Passthrough SQL connection must be shared'. (http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=14-988623104) Измените в настpойке псевдонима (alias) пункт 'SQLPASSTHRU MODE' на 'SHARED AUTOCOMMIT'.
|
Часть 2 |
