Форум: "Потрепаться";
Текущий архив: 2004.04.11;
Скачать: [xml.tar.bz2];
ВнизДвадцатка самых популярных вопросов. Найти похожие ветки
← →
panov © (2004-03-26 15:09) [120]http://delphimaster.net/view/1-1080300909/
← →
panov © (2004-03-26 15:09) [120]http://delphimaster.net/view/1-1080300909/
← →
Romkin © (2004-03-26 15:35) [121]Посылать на http://sources.ru/delphi/delphi_system.shtml#17
← →
Romkin © (2004-03-26 15:35) [121]Посылать на http://sources.ru/delphi/delphi_system.shtml#17
← →
panov © (2004-03-26 21:45) [122]2 вопрос.
Как спрятать (свернуть) приложение при нажатии на кнопку «закрыть» в области заголовка формы или при нажатии Alt-F4?
---------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
procedure OnWM_SYSCOMMAND(var Message: TMessage); message WM_SYSCOMMAND;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.OnWM_SYSCOMMAND(var Message: TMessage);
begin
if Message.WParam=SC_CLOSE then
begin
Application.Minimize;
Message.Result := 0;
end
else inherited;
end;
end.
← →
panov © (2004-03-26 21:45) [122]2 вопрос.
Как спрятать (свернуть) приложение при нажатии на кнопку «закрыть» в области заголовка формы или при нажатии Alt-F4?
---------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
procedure OnWM_SYSCOMMAND(var Message: TMessage); message WM_SYSCOMMAND;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.OnWM_SYSCOMMAND(var Message: TMessage);
begin
if Message.WParam=SC_CLOSE then
begin
Application.Minimize;
Message.Result := 0;
end
else inherited;
end;
end.
← →
DrPass © (2004-03-26 23:51) [123]А вот еще популярный вопрос по этой теме:
"Как заставить юзеров сначала читать FAQ, а потом спрашивать на форуме, а не наоборот"
← →
DrPass © (2004-03-26 23:51) [123]А вот еще популярный вопрос по этой теме:
"Как заставить юзеров сначала читать FAQ, а потом спрашивать на форуме, а не наоборот"
← →
_none_ © (2004-03-27 01:21) [124]надо посылать всех на www.soobcha.ru
← →
_none_ © (2004-03-27 01:21) [124]надо посылать всех на www.soobcha.ru
← →
Piter © (2004-03-27 19:14) [125]Предлагаю оформлять FAQ не как сейчас, а разбивать их по темам, как форумы!
Так будет логичнее...
типа Базы данных, Основные вопросы, WinApi и т.д.
Панов, как идет работа над FAQ"ом? Я хочу принять участие...
← →
Piter © (2004-03-27 19:14) [125]Предлагаю оформлять FAQ не как сейчас, а разбивать их по темам, как форумы!
Так будет логичнее...
типа Базы данных, Основные вопросы, WinApi и т.д.
Панов, как идет работа над FAQ"ом? Я хочу принять участие...
← →
Rouse_ © (2004-03-27 19:27) [126]> [125] Piter © (27.03.04 19:14)
Работа идет :)
По поводу участия - адрес у Саши знаешь :)
← →
Rouse_ © (2004-03-27 19:27) [126]> [125] Piter © (27.03.04 19:14)
Работа идет :)
По поводу участия - адрес у Саши знаешь :)
← →
PVOzerski © (2004-03-27 20:12) [127]IMHO, "хит сезона" - попытки назначить обработчиками событий неинкапсулированные процедуры и возникающие из-за этого вопросы "как назначить?".
← →
PVOzerski © (2004-03-27 20:12) [127]IMHO, "хит сезона" - попытки назначить обработчиками событий неинкапсулированные процедуры и возникающие из-за этого вопросы "как назначить?".
← →
Игорь Шевченко © (2004-03-27 20:30) [128]Как избавиться от ScrollBars на главной MDI-форме:
{ (С) Peter Below (TeamB) }
unit MainForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus;
type
TfMain = class(TForm)
procedure FormCreate(Sender: TObject);
....
end;
var
fMain: TfMain;
implementation
{$R *.DFM}
function ClientWindowProc( wnd: HWND; msg: Cardinal; wparam, lparam: Integer ): Integer; stdcall;
var
f: Pointer;
begin
f := Pointer(GetWindowLong (wnd, GWL_USERDATA));
case msg of
WM_NCCALCSIZE:
if (GetWindowLong (wnd, GWL_STYLE) and
(WS_HSCROLL or WS_VSCROLL)) <> 0 then
SetWindowLong (wnd, GWL_STYLE,
GetWindowLong (wnd, GWL_STYLE) and
not (WS_HSCROLL or WS_VSCROLL));
end;
Result := CallWindowProc(f, wnd, msg, wparam, lparam);
end;
procedure TfMain.FormCreate(Sender: TObject);
begin
if ClientHandle <> 0 then begin
if GetWindowLong (ClientHandle, GWL_USERDATA) <> 0 then
Exit; {cannot subclass client window, userdata already in use}
SetWindowLong (ClientHandle, GWL_USERDATA,
SetWindowLong (ClientHandle, GWL_WNDPROC,
integer(@ClientWindowProc)));
end;
end;
end.
← →
Игорь Шевченко © (2004-03-27 20:30) [128]Как избавиться от ScrollBars на главной MDI-форме:
{ (С) Peter Below (TeamB) }
unit MainForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus;
type
TfMain = class(TForm)
procedure FormCreate(Sender: TObject);
....
end;
var
fMain: TfMain;
implementation
{$R *.DFM}
function ClientWindowProc( wnd: HWND; msg: Cardinal; wparam, lparam: Integer ): Integer; stdcall;
var
f: Pointer;
begin
f := Pointer(GetWindowLong (wnd, GWL_USERDATA));
case msg of
WM_NCCALCSIZE:
if (GetWindowLong (wnd, GWL_STYLE) and
(WS_HSCROLL or WS_VSCROLL)) <> 0 then
SetWindowLong (wnd, GWL_STYLE,
GetWindowLong (wnd, GWL_STYLE) and
not (WS_HSCROLL or WS_VSCROLL));
end;
Result := CallWindowProc(f, wnd, msg, wparam, lparam);
end;
procedure TfMain.FormCreate(Sender: TObject);
begin
if ClientHandle <> 0 then begin
if GetWindowLong (ClientHandle, GWL_USERDATA) <> 0 then
Exit; {cannot subclass client window, userdata already in use}
SetWindowLong (ClientHandle, GWL_USERDATA,
SetWindowLong (ClientHandle, GWL_WNDPROC,
integer(@ClientWindowProc)));
end;
end;
end.
← →
Piter © (2004-03-27 21:12) [129]Игорь Шевченко (27.03.04 20:30) [128]
Как избавиться от ScrollBars на главной MDI-форме
а можно поинтересоваться - а в чем проблема? Я никак не пойму... какой еще скролл бар у MDI формы?
← →
Piter © (2004-03-27 21:12) [129]Игорь Шевченко (27.03.04 20:30) [128]
Как избавиться от ScrollBars на главной MDI-форме
а можно поинтересоваться - а в чем проблема? Я никак не пойму... какой еще скролл бар у MDI формы?
← →
Игорь Шевченко © (2004-03-27 21:25) [130]Piter © (27.03.04 21:12)
Можно поинтересоваться. У главной формы MDI-приложения есть клиентская область, в которой размещаются дочерние MDI-окна. Если какая-то из дочерних форм не помещается полностью в клиентской области главной формы, то в этой области появляются скроллбары. В форуме периодически задается вопрос, как от них избавиться.
← →
Игорь Шевченко © (2004-03-27 21:25) [130]Piter © (27.03.04 21:12)
Можно поинтересоваться. У главной формы MDI-приложения есть клиентская область, в которой размещаются дочерние MDI-окна. Если какая-то из дочерних форм не помещается полностью в клиентской области главной формы, то в этой области появляются скроллбары. В форуме периодически задается вопрос, как от них избавиться.
← →
Piter © (2004-03-27 22:21) [131]Игорь Шевченко (27.03.04 21:25) [130]
Если какая-то из дочерних форм не помещается полностью в клиентской области главной формы, то в этой области появляются скроллбары
хм, ну так ведь так и должно быть! Какой смысл убирать этот скролл бар? Каким образом тогда дотянуться до невидимого участка дочерней формы?
← →
Piter © (2004-03-27 22:21) [131]Игорь Шевченко (27.03.04 21:25) [130]
Если какая-то из дочерних форм не помещается полностью в клиентской области главной формы, то в этой области появляются скроллбары
хм, ну так ведь так и должно быть! Какой смысл убирать этот скролл бар? Каким образом тогда дотянуться до невидимого участка дочерней формы?
← →
Игорь Шевченко © (2004-03-27 22:26) [132]
> Какой смысл убирать этот скролл бар?
Просят...
← →
Игорь Шевченко © (2004-03-27 22:26) [132]
> Какой смысл убирать этот скролл бар?
Просят...
← →
Sergey Masloff (2004-03-27 22:31) [133]еще вопрос про значек мастера. Ну сейчас вроде пореже а то в неделю по нескольку раз же было ;-)
← →
Sergey Masloff (2004-03-27 22:31) [133]еще вопрос про значек мастера. Ну сейчас вроде пореже а то в неделю по нескольку раз же было ;-)
← →
Rouse_ © (2004-03-27 22:35) [134]> [133] Sergey Masloff (27.03.04 22:31)
А это уже к программированию не относится :)
← →
Rouse_ © (2004-03-27 22:35) [134]> [133] Sergey Masloff (27.03.04 22:31)
А это уже к программированию не относится :)
← →
Sergey Masloff (2004-03-27 22:37) [135]Rouse_ © (27.03.04 22:35) [134]
> это уже к программированию не относится :)
а что делать? Я вспоминал-вспоминал но другого частого в голову не пришло...
← →
Sergey Masloff (2004-03-27 22:37) [135]Rouse_ © (27.03.04 22:35) [134]
> это уже к программированию не относится :)
а что делать? Я вспоминал-вспоминал но другого частого в голову не пришло...
← →
Rouse_ © (2004-03-27 22:44) [136]> [135] Sergey Masloff (27.03.04 22:37)
Иногда лучше жевать, чем говорить © :)))
← →
Rouse_ © (2004-03-27 22:44) [136]> [135] Sergey Masloff (27.03.04 22:37)
Иногда лучше жевать, чем говорить © :)))
← →
Sergey Masloff (2004-03-27 22:56) [137]Rouse_ © (27.03.04 22:44) [136]
>> [135] Sergey Masloff (27.03.04 22:37)
>Иногда лучше жевать, чем говорить © :)))
Я и так за 90 вот-вот перевалю :( Жевать, нет уж спасибо... Поговорю лучше ;-)
← →
Sergey Masloff (2004-03-27 22:56) [137]Rouse_ © (27.03.04 22:44) [136]
>> [135] Sergey Masloff (27.03.04 22:37)
>Иногда лучше жевать, чем говорить © :)))
Я и так за 90 вот-вот перевалю :( Жевать, нет уж спасибо... Поговорю лучше ;-)
← →
Fenik © (2004-03-27 23:26) [138]Как объединить два изображения в одно.
← →
Fenik © (2004-03-27 23:26) [138]Как объединить два изображения в одно.
← →
TButton © (2004-03-27 23:33) [139]>Как избавиться от ScrollBars на главной MDI-форме
а я всегда думал, что надо AutoScroll поставить в false...
← →
TButton © (2004-03-27 23:33) [139]>Как избавиться от ScrollBars на главной MDI-форме
а я всегда думал, что надо AutoScroll поставить в false...
← →
TButton © (2004-03-27 23:35) [140]>а я всегда думал, что надо AutoScroll поставить в false...
плохо думал...
← →
TButton © (2004-03-27 23:35) [140]>а я всегда думал, что надо AutoScroll поставить в false...
плохо думал...
← →
Юрий Зотов © (2004-03-28 07:33) [141]> panov © (26.03.04 21:45) [122]
> if Message.WParam=SC_CLOSE then
Не совсем так.
In WM_SYSCOMMAND messages, the four low-order bits of the uCmdType parameter are used internally by Windows. To obtain the correct result when testing the value of uCmdType, an application must combine the value 0xFFF0 with the uCmdType value by using the bitwise AND operator.
Поэтому надо так:
if Message.WParam and $FFF0 = SC_CLOSE then...
← →
Юрий Зотов © (2004-03-28 07:33) [141]> panov © (26.03.04 21:45) [122]
> if Message.WParam=SC_CLOSE then
Не совсем так.
In WM_SYSCOMMAND messages, the four low-order bits of the uCmdType parameter are used internally by Windows. To obtain the correct result when testing the value of uCmdType, an application must combine the value 0xFFF0 with the uCmdType value by using the bitwise AND operator.
Поэтому надо так:
if Message.WParam and $FFF0 = SC_CLOSE then...
← →
panov © (2004-03-29 11:52) [142]>Юрий Зотов © (28.03.04 07:33) [141]
Спасибо за замечание, испроавлю в ответе.
← →
panov © (2004-03-29 11:52) [142]>Юрий Зотов © (28.03.04 07:33) [141]
Спасибо за замечание, испроавлю в ответе.
← →
panov © (2004-03-29 15:53) [143]Третий вопрос.
Как получить список/размер всех файлов в каталоге и его подкаталогах?
Функции или процедуры, позволяющей это сделать нет, поэтому для получения списка файлов нужно воспользоваться рекурсивно функциями FindFirst/FindNext/FindClose.
Пример:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms,
StdCtrls, Masks;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//Простой поиск всех файлов в каталоге и его покаталогах
procedure GetFilesSimple(const aPath: String;var aListFile: TStringList);
var
SR: TSearchRec;
tPath: String;
begin
tPath := IncludeTrailingBackSlash(aPath);
if FindFirst(tPath+"\*.*",faAnyFile,SR)=0 then
begin
try
repeat
if (SR.Name=".") or (SR.Name="..") then Continue;
if (SR.Attr and faDirectory)<>0 then GetFilesSimple(tPath+SR.Name,aListFile);
aListFile.Add(tPath+SR.Name);
until FindNext(SR)<>0;
finally
Sysutils.FindClose(SR);
end;
end;
end;
//Поиск файлов в каталоге и его покаталогах с фильтром по маске и исключением
//из поиска всех файлов, атрибуты которых попадают в aExcludeAttr
function GetFiles(const aPath,aMask: String;var aListFile: TStringList;const aExcludeAttr: Integer=0): Integer;
var
SR: TSearchRec;
tPath: String;
begin
tPath := IncludeTrailingBackSlash(aPath);
if FindFirst(tPath+"*.*",faDirectory,SR)=0 then
begin
try
repeat
if (SR.Name=".") or (SR.Name="..") then Continue;
if (SR.Attr and faDirectory)<>0 then GetFiles(tPath+SR.Name,aMask,aListFile,aExcludeAttr);
if (aExcludeAttr<>0) and (SR.Attr and aExcludeAttr <> 0) then Continue;
if MatchesMask(SR.Name,aMask) then aListFile.Add(tPath+SR.Name);
until FindNext(SR)<>0;
finally
Sysutils.FindClose(SR);
end;
end;
end;
//Процедура вычисления размера каталога
procedure GetDirSize(const aPath: String;var SizeDir: Int64);
var
SR: TSearchRec;
tPath: String;
begin
tPath := IncludeTrailingBackSlash(aPath);
if FindFirst(tPath+"*.*",faAnyFile,SR)=0 then
begin
try
repeat
if (SR.Name=".") or (SR.Name="..") then Continue;
if (SR.Attr and faDirectory)<>0 then
begin
GetDirSize(tPath+SR.Name,SizeDir);
Continue;
end;
SizeDir := SizeDir +
(SR.FindData.nFileSizeHigh shl 32)+
SR.FindData.nFileSizeLow;
until FindNext(SR)<>0;
finally
Sysutils.FindClose(SR);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
SizeDir: Int64;
ListFiles: TStringList;
begin
ListFiles := TStringList.Create;
GetFilesSimple("c:\winnt",ListFiles); //Поиск всех файлов
ListFiles.Add("---------");
GetFiles("c:\winnt","*.exe",ListFiles,faArchive);
ListFiles.Add("---------");
SizeDir := 0;
GetDirSize("c:\winnt",SizeDir);
ListFiles.Add("Размер каталога "+IntToStr(SizeDir));
ListBox1.Items.Assign(ListFiles);
ListFiles.Free;
end;
end.
← →
panov © (2004-03-29 15:53) [143]Третий вопрос.
Как получить список/размер всех файлов в каталоге и его подкаталогах?
Функции или процедуры, позволяющей это сделать нет, поэтому для получения списка файлов нужно воспользоваться рекурсивно функциями FindFirst/FindNext/FindClose.
Пример:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms,
StdCtrls, Masks;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//Простой поиск всех файлов в каталоге и его покаталогах
procedure GetFilesSimple(const aPath: String;var aListFile: TStringList);
var
SR: TSearchRec;
tPath: String;
begin
tPath := IncludeTrailingBackSlash(aPath);
if FindFirst(tPath+"\*.*",faAnyFile,SR)=0 then
begin
try
repeat
if (SR.Name=".") or (SR.Name="..") then Continue;
if (SR.Attr and faDirectory)<>0 then GetFilesSimple(tPath+SR.Name,aListFile);
aListFile.Add(tPath+SR.Name);
until FindNext(SR)<>0;
finally
Sysutils.FindClose(SR);
end;
end;
end;
//Поиск файлов в каталоге и его покаталогах с фильтром по маске и исключением
//из поиска всех файлов, атрибуты которых попадают в aExcludeAttr
function GetFiles(const aPath,aMask: String;var aListFile: TStringList;const aExcludeAttr: Integer=0): Integer;
var
SR: TSearchRec;
tPath: String;
begin
tPath := IncludeTrailingBackSlash(aPath);
if FindFirst(tPath+"*.*",faDirectory,SR)=0 then
begin
try
repeat
if (SR.Name=".") or (SR.Name="..") then Continue;
if (SR.Attr and faDirectory)<>0 then GetFiles(tPath+SR.Name,aMask,aListFile,aExcludeAttr);
if (aExcludeAttr<>0) and (SR.Attr and aExcludeAttr <> 0) then Continue;
if MatchesMask(SR.Name,aMask) then aListFile.Add(tPath+SR.Name);
until FindNext(SR)<>0;
finally
Sysutils.FindClose(SR);
end;
end;
end;
//Процедура вычисления размера каталога
procedure GetDirSize(const aPath: String;var SizeDir: Int64);
var
SR: TSearchRec;
tPath: String;
begin
tPath := IncludeTrailingBackSlash(aPath);
if FindFirst(tPath+"*.*",faAnyFile,SR)=0 then
begin
try
repeat
if (SR.Name=".") or (SR.Name="..") then Continue;
if (SR.Attr and faDirectory)<>0 then
begin
GetDirSize(tPath+SR.Name,SizeDir);
Continue;
end;
SizeDir := SizeDir +
(SR.FindData.nFileSizeHigh shl 32)+
SR.FindData.nFileSizeLow;
until FindNext(SR)<>0;
finally
Sysutils.FindClose(SR);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
SizeDir: Int64;
ListFiles: TStringList;
begin
ListFiles := TStringList.Create;
GetFilesSimple("c:\winnt",ListFiles); //Поиск всех файлов
ListFiles.Add("---------");
GetFiles("c:\winnt","*.exe",ListFiles,faArchive);
ListFiles.Add("---------");
SizeDir := 0;
GetDirSize("c:\winnt",SizeDir);
ListFiles.Add("Размер каталога "+IntToStr(SizeDir));
ListBox1.Items.Assign(ListFiles);
ListFiles.Free;
end;
end.
← →
panov © (2004-03-29 16:03) [144]4 вопрос.
Как перекодировать строку из кодировки OEM в кодировку ANSI и обратно?
function Win2Dos(const aStr: String): String;
begin
Result := aStr;
CharToOem(PChar(Result),PChar(Result));
end;
function Dos2Win(const aStr: String): String;
begin
Result := aStr;
OemToChar(PChar(Result),PChar(Result));
end;
← →
panov © (2004-03-29 16:03) [144]4 вопрос.
Как перекодировать строку из кодировки OEM в кодировку ANSI и обратно?
function Win2Dos(const aStr: String): String;
begin
Result := aStr;
CharToOem(PChar(Result),PChar(Result));
end;
function Dos2Win(const aStr: String): String;
begin
Result := aStr;
OemToChar(PChar(Result),PChar(Result));
end;
← →
Dmitriy O. © (2004-03-29 16:06) [145]А на мой вопрос по печати больших изображений уже был ответ ?
Например нужно распечатать Имаже 700*5600 как это сделать ?
← →
Dmitriy O. © (2004-03-29 16:06) [145]А на мой вопрос по печати больших изображений уже был ответ ?
Например нужно распечатать Имаже 700*5600 как это сделать ?
← →
panov © (2004-03-29 16:22) [146]>Dmitriy O. © (29.03.04 16:06) [145]
Я иду по списку, который был выше, и до графики еще далеко. А так как с графикой я не работал вообще, то сразу будет сложно ответить. Может быть Вы ответите на этот вопрос и опубликуете здесь?
← →
panov © (2004-03-29 16:22) [146]>Dmitriy O. © (29.03.04 16:06) [145]
Я иду по списку, который был выше, и до графики еще далеко. А так как с графикой я не работал вообще, то сразу будет сложно ответить. Может быть Вы ответите на этот вопрос и опубликуете здесь?
← →
Тимохов © (2004-03-29 16:29) [147]
> panov © (29.03.04 16:03) [144]
проверку на astr <> "" забыли
← →
Тимохов © (2004-03-29 16:29) [147]
> panov © (29.03.04 16:03) [144]
проверку на astr <> "" забыли
← →
panov © (2004-03-29 16:31) [148]5 вопрос.
Как выполнить длительную(по времени) процедуру в дополнительном потоке и одновременно обновлять TProgressBar в основном потоке.
unit ufMyLongProcedure;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ProgressBar1: TProgressBar;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
//Класс потока для выполнения длительных расчетов
TMyLongProcedure = class(TThread)
FProgressBar: TProgressBar;
FCounter: Integer;
protected
procedure Execute; override;
public
//Параметром передаем TProgressBar, который необходимо обновлять
constructor Create(aProgressBar: TProgressBar);
//Процедура для работы с объектами в основном потоке
procedure ShowProgress;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
constructor TMyLongProcedure.Create(aProgressBar: TProgressBar);
begin
inherited Create(True); //Создается в приостановленном состоянии
FreeOnTerminate := True; //После окончания выполнения потока все
// ресурсы освобождаются автоматически
FProgressBar := aProgressBar;
FProgressBar.Min := 0;
FProgressBar.Max := 100;
FProgressBar.Position := 0;
FCounter := 0;
Resume;
end;
procedure TMyLongProcedure.ShowProgress;
begin
//Обновление TProgressBar в основном потоке
FProgressBar.Position := FCOunter;
end;
procedure TMyLongProcedure.Execute;
var
i: Integer;
begin
i := 0;
while (not Terminated) and (i<10000) do
begin
if (i mod 10) = 0 then //Не обновляем на каждой итерации,
// так как тогда не сможем работать
// в основном потоке с формой
begin
inc(FCounter);
Synchronize(ShowProgress); //Обновляем TProgressBar
if FCounter=100 then FCOunter := 0; //TProgressBar будет обновляться
// циклически
end;
Sleep(1); //Для эмуляции длительной работы
Inc(i);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TMyLongProcedure.Create(ProgressBar1);
end;
end.
← →
panov © (2004-03-29 16:31) [148]5 вопрос.
Как выполнить длительную(по времени) процедуру в дополнительном потоке и одновременно обновлять TProgressBar в основном потоке.
unit ufMyLongProcedure;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ProgressBar1: TProgressBar;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
//Класс потока для выполнения длительных расчетов
TMyLongProcedure = class(TThread)
FProgressBar: TProgressBar;
FCounter: Integer;
protected
procedure Execute; override;
public
//Параметром передаем TProgressBar, который необходимо обновлять
constructor Create(aProgressBar: TProgressBar);
//Процедура для работы с объектами в основном потоке
procedure ShowProgress;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
constructor TMyLongProcedure.Create(aProgressBar: TProgressBar);
begin
inherited Create(True); //Создается в приостановленном состоянии
FreeOnTerminate := True; //После окончания выполнения потока все
// ресурсы освобождаются автоматически
FProgressBar := aProgressBar;
FProgressBar.Min := 0;
FProgressBar.Max := 100;
FProgressBar.Position := 0;
FCounter := 0;
Resume;
end;
procedure TMyLongProcedure.ShowProgress;
begin
//Обновление TProgressBar в основном потоке
FProgressBar.Position := FCOunter;
end;
procedure TMyLongProcedure.Execute;
var
i: Integer;
begin
i := 0;
while (not Terminated) and (i<10000) do
begin
if (i mod 10) = 0 then //Не обновляем на каждой итерации,
// так как тогда не сможем работать
// в основном потоке с формой
begin
inc(FCounter);
Synchronize(ShowProgress); //Обновляем TProgressBar
if FCounter=100 then FCOunter := 0; //TProgressBar будет обновляться
// циклически
end;
Sleep(1); //Для эмуляции длительной работы
Inc(i);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TMyLongProcedure.Create(ProgressBar1);
end;
end.
← →
blackman © (2004-03-29 16:32) [149]>panov © (29.03.04 16:03) [144]
Если пустая aStr, то будет ОЙ :)
← →
blackman © (2004-03-29 16:32) [149]>panov © (29.03.04 16:03) [144]
Если пустая aStr, то будет ОЙ :)
← →
panov © (2004-03-29 16:32) [150]>Тимохов © (29.03.04 16:29) [147]
Спасибо, исправлено.
← →
panov © (2004-03-29 16:32) [150]>Тимохов © (29.03.04 16:29) [147]
Спасибо, исправлено.
← →
Игорь Шевченко © (2004-03-29 16:35) [151]Еще часто задаваемые вопросы:
Как добавить свой пункт меню в контекстное меню Explorer.
Как создать ярлык на рабочем столе.
Как зарегистрировать свое расширение файлов (или изменить регистрацию существующего)
← →
Игорь Шевченко © (2004-03-29 16:35) [151]Еще часто задаваемые вопросы:
Как добавить свой пункт меню в контекстное меню Explorer.
Как создать ярлык на рабочем столе.
Как зарегистрировать свое расширение файлов (или изменить регистрацию существующего)
← →
panov © (2004-03-29 16:36) [152]>blackman © (29.03.04 16:32) [149]
>Тимохов © (29.03.04 16:29) [147]
function Win2Dos(const aStr: String): String;
begin
Result := aStr;
if Result = "" then Exit;
CharToOem(PChar(Result),PChar(Result));
end;
function Dos2Win(const aStr: String): String;
begin
Result := aStr;
if Result = "" then Exit;
OemToChar(PChar(Result),PChar(Result));
end;
← →
panov © (2004-03-29 16:36) [152]>blackman © (29.03.04 16:32) [149]
>Тимохов © (29.03.04 16:29) [147]
function Win2Dos(const aStr: String): String;
begin
Result := aStr;
if Result = "" then Exit;
CharToOem(PChar(Result),PChar(Result));
end;
function Dos2Win(const aStr: String): String;
begin
Result := aStr;
if Result = "" then Exit;
OemToChar(PChar(Result),PChar(Result));
end;
← →
Игорь Шевченко © (2004-03-29 16:37) [153]
> function Dos2Win(const aStr: String): String;
> begin
> Result := aStr;
> if Result = "" then Exit;
> OemToChar(PChar(Result),PChar(Result));
> end;
Предлагаю
function Dos2Win(const aStr: String): String;
begin
Result := aStr;
if Result <> "" then
OemToChar(PChar(Result),PChar(Result));
end;
← →
Игорь Шевченко © (2004-03-29 16:37) [153]
> function Dos2Win(const aStr: String): String;
> begin
> Result := aStr;
> if Result = "" then Exit;
> OemToChar(PChar(Result),PChar(Result));
> end;
Предлагаю
function Dos2Win(const aStr: String): String;
begin
Result := aStr;
if Result <> "" then
OemToChar(PChar(Result),PChar(Result));
end;
← →
panov © (2004-03-29 16:39) [154]>Игорь Шевченко © (29.03.04 16:37) [153]
Согласен, так и запишем-)
← →
panov © (2004-03-29 16:39) [154]>Игорь Шевченко © (29.03.04 16:37) [153]
Согласен, так и запишем-)
← →
Dmitriy O. © (2004-03-29 16:50) [155]
> panov © (29.03.04 16:22) [146]
Хорошо вот рабочий код из моей Avtoshema. Печатает очень
большие изображения практическибесконечные. С помощью Qreport.Вся фишка в использовании двух Qrimage. При одном изображение есть на превьев а на печать выводится пустая страница. Итак зацените !
procedure TMyform.ApechExecute(Sender: TObject);
var
i,str:integer;
stras:string;
strap:pchar;
begin
idiag1.Stretch:=false;
if radiogroup1.ItemIndex=0 then begin
//idiag1.Stretch:=true;
//idiag1.Height:=1040;
qrimage1.AutoSize:=false;
qrimage2.AutoSize:=false;
qrimage1.Height:=idiag1.Height;
qrimage2.Height:=idiag1.Height;
qrimage1.Canvas.CopyMode:=cmSrcCopy;
qrimage1.Canvas.CopyRect(rect(0,0,350,idiag1.Height),idiag1.Canvas,rect(0,0,350,idiag1.Height));
qrimage2.Canvas.CopyMode:=cmSrcCopy;
qrimage2.Canvas.CopyRect(rect(0,0,350,idiag1.Height),idiag1.Canvas,rect(350,0,700,idiag1.Height));
qrimage2.Canvas.TextOut(320,1020,"1");
qrimage1.Stretch:=true;
qrimage2.Stretch:=true;
qrimage1.Height:=1040;
qrimage2.Height:=1040;
quickrep1.Preview;
qrimage1.Stretch:=false;
qrimage2.Stretch:=false;;
exit;
end;
str:=ceil(idiag1.Height/1040);
stras:="Всего "+inttostr(str)+" страниц";
strap:=PChar(stras);
if (application.messagebox(strap,"Печать",mb_yesno+mb_iconquestion)=idno) then exit;
if cbprint.Checked=true then begin
quickrep1.PrinterSetup;
//quickrep1.Prepare;
end;
qrimage1.Canvas.CopyMode:=cmSrcCopy;
qrimage2.Canvas.CopyMode:=cmSrcCopy;
for i:=1 to str do begin
case i of
1:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,0,350,1040));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,0,700,1040));
qrimage2.Canvas.TextOut(320,1020,"1");
quickrep1.Print;
end;
2:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,1040,350,2080));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,1040,700,2080));
qrimage2.Canvas.TextOut(320,1020,"2");
quickrep1.Print;
end;
3:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,2080,350,3120));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,2080,700,3120));
qrimage2.Canvas.TextOut(320,1020,"3");
quickrep1.Print;
end;
4:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,3120,350,4160));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,3120,700,4160));
qrimage2.Canvas.TextOut(320,1020,"4");
quickrep1.Print;
end;
5: begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,4160,350,5200));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,4160,700,5200));
qrimage2.Canvas.TextOut(320,1020,"5");
quickrep1.Print;
end;
6:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,5200,350,6240));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,5200,700,6240));
qrimage2.Canvas.TextOut(320,1020,"6");
quickrep1.Print;
end;
7:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,6240,350,7280));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,6240,700,7280));
qrimage2.Canvas.TextOut(320,1020,"7");
quickrep1.Print;
end;
8:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,7280,700,8320));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,7280,350,8320));
qrimage2.Canvas.TextOut(320,1020,"8");
quickrep1.Print;
end;
9:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,8320,350,9360));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,8320,700,9360));
qrimage2.Canvas.TextOut(320,1020,"9");
quickrep1.Print;
end;
10:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,9360,350,10400));
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,9360,700,10400));
qrimage2.Canvas.TextOut(320,1020,"10");
quickrep1.Print;
end;
11: begin
if i=str then begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
end;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,10400,350,11440));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,10400,700,11440));
qrimage2.Canvas.TextOut(320,1020,"11");
quickrep1.Print;
end;
12:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,11440,350,12480));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,11440,700,12480));
qrimage2.Canvas.TextOut(320,1020,"12");
quickrep1.Print;
end;
else begin
showmessage("Нет печати более 12 страниц");
break;
end;
end;//case
end;//for
end;
← →
Dmitriy O. © (2004-03-29 16:50) [155]
> panov © (29.03.04 16:22) [146]
Хорошо вот рабочий код из моей Avtoshema. Печатает очень
большие изображения практическибесконечные. С помощью Qreport.Вся фишка в использовании двух Qrimage. При одном изображение есть на превьев а на печать выводится пустая страница. Итак зацените !
procedure TMyform.ApechExecute(Sender: TObject);
var
i,str:integer;
stras:string;
strap:pchar;
begin
idiag1.Stretch:=false;
if radiogroup1.ItemIndex=0 then begin
//idiag1.Stretch:=true;
//idiag1.Height:=1040;
qrimage1.AutoSize:=false;
qrimage2.AutoSize:=false;
qrimage1.Height:=idiag1.Height;
qrimage2.Height:=idiag1.Height;
qrimage1.Canvas.CopyMode:=cmSrcCopy;
qrimage1.Canvas.CopyRect(rect(0,0,350,idiag1.Height),idiag1.Canvas,rect(0,0,350,idiag1.Height));
qrimage2.Canvas.CopyMode:=cmSrcCopy;
qrimage2.Canvas.CopyRect(rect(0,0,350,idiag1.Height),idiag1.Canvas,rect(350,0,700,idiag1.Height));
qrimage2.Canvas.TextOut(320,1020,"1");
qrimage1.Stretch:=true;
qrimage2.Stretch:=true;
qrimage1.Height:=1040;
qrimage2.Height:=1040;
quickrep1.Preview;
qrimage1.Stretch:=false;
qrimage2.Stretch:=false;;
exit;
end;
str:=ceil(idiag1.Height/1040);
stras:="Всего "+inttostr(str)+" страниц";
strap:=PChar(stras);
if (application.messagebox(strap,"Печать",mb_yesno+mb_iconquestion)=idno) then exit;
if cbprint.Checked=true then begin
quickrep1.PrinterSetup;
//quickrep1.Prepare;
end;
qrimage1.Canvas.CopyMode:=cmSrcCopy;
qrimage2.Canvas.CopyMode:=cmSrcCopy;
for i:=1 to str do begin
case i of
1:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,0,350,1040));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,0,700,1040));
qrimage2.Canvas.TextOut(320,1020,"1");
quickrep1.Print;
end;
2:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,1040,350,2080));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,1040,700,2080));
qrimage2.Canvas.TextOut(320,1020,"2");
quickrep1.Print;
end;
3:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,2080,350,3120));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,2080,700,3120));
qrimage2.Canvas.TextOut(320,1020,"3");
quickrep1.Print;
end;
4:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,3120,350,4160));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,3120,700,4160));
qrimage2.Canvas.TextOut(320,1020,"4");
quickrep1.Print;
end;
5: begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,4160,350,5200));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,4160,700,5200));
qrimage2.Canvas.TextOut(320,1020,"5");
quickrep1.Print;
end;
6:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,5200,350,6240));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,5200,700,6240));
qrimage2.Canvas.TextOut(320,1020,"6");
quickrep1.Print;
end;
7:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,6240,350,7280));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,6240,700,7280));
qrimage2.Canvas.TextOut(320,1020,"7");
quickrep1.Print;
end;
8:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,7280,700,8320));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,7280,350,8320));
qrimage2.Canvas.TextOut(320,1020,"8");
quickrep1.Print;
end;
9:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,8320,350,9360));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,8320,700,9360));
qrimage2.Canvas.TextOut(320,1020,"9");
quickrep1.Print;
end;
10:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,9360,350,10400));
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,9360,700,10400));
qrimage2.Canvas.TextOut(320,1020,"10");
quickrep1.Print;
end;
11: begin
if i=str then begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
end;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,10400,350,11440));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,10400,700,11440));
qrimage2.Canvas.TextOut(320,1020,"11");
quickrep1.Print;
end;
12:begin
qrimage1.Picture.Graphic:=nil;
qrimage2.Picture.Graphic:=nil;
qrimage1.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(0,11440,350,12480));
qrimage2.Canvas.CopyRect(rect(0,0,350,1040),idiag1.Canvas,rect(350,11440,700,12480));
qrimage2.Canvas.TextOut(320,1020,"12");
quickrep1.Print;
end;
else begin
showmessage("Нет печати более 12 страниц");
break;
end;
end;//case
end;//for
end;
← →
Тимохов © (2004-03-29 16:53) [156]да...
← →
Тимохов © (2004-03-29 16:53) [156]да...
← →
blackman © (2004-03-29 17:01) [157]Как открыть URL браузером, установленным по умолчанию?
Используйте функцию ShellExecute.
Пример:
uses ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(Form1.Handle,
nil,
"http://blackman.wp-club.net",
nil,
nil,
SW_SHOWNORMAL);
end;
:)
← →
blackman © (2004-03-29 17:01) [157]Как открыть URL браузером, установленным по умолчанию?
Используйте функцию ShellExecute.
Пример:
uses ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(Form1.Handle,
nil,
"http://blackman.wp-club.net",
nil,
nil,
SW_SHOWNORMAL);
end;
:)
← →
Игорь Шевченко © (2004-03-29 17:01) [158]Dmitriy O. © (29.03.04 16:50)
> Итак зацените !
LMD
← →
Игорь Шевченко © (2004-03-29 17:01) [158]Dmitriy O. © (29.03.04 16:50)
> Итак зацените !
LMD
← →
Dmitriy O. © (2004-03-29 17:04) [159]
> Игорь Шевченко © (29.03.04 17:01)
Что только обзываться умеете. Если знаете как по другому. То скажите как. А этот метод хорош тем что если его немножко модифицировать то можно печатать с разными маштабами устанавливать свою разметку страниц.
← →
Dmitriy O. © (2004-03-29 17:04) [159]
> Игорь Шевченко © (29.03.04 17:01)
Что только обзываться умеете. Если знаете как по другому. То скажите как. А этот метод хорош тем что если его немножко модифицировать то можно печатать с разными маштабами устанавливать свою разметку страниц.
← →
Тимохов © (2004-03-29 17:09) [160]
> Игорь Шевченко © (29.03.04 17:01) [158]
как точно человек все определил...
← →
Тимохов © (2004-03-29 17:09) [160]
> Игорь Шевченко © (29.03.04 17:01) [158]
как точно человек все определил...
Страницы: 1 2 3 4 5 6 7 вся ветка
Форум: "Потрепаться";
Текущий архив: 2004.04.11;
Скачать: [xml.tar.bz2];
Память: 1.22 MB
Время: 0.113 c