ANTICHAT — форум по информационной безопасности, OSINT и технологиям
ANTICHAT — русскоязычное сообщество по безопасности, OSINT и программированию.
Форум ранее работал на доменах antichat.ru, antichat.com и antichat.club,
и теперь снова доступен на новом адресе —
forum.antichat.xyz.
Форум восстановлен и продолжает развитие: доступны архивные темы, добавляются новые обсуждения и материалы.
⚠️ Старые аккаунты восстановить невозможно — необходимо зарегистрироваться заново.
03.05.2009, 19:37
|
|
Постоянный
Регистрация: 31.01.2008
Сообщений: 643
Провел на форуме:
6128108
Репутация:
445
|
|
НTL вроде так
procedure TForm1.Button1Click(Sender: TObject);
var
s: string;
begin
if OpenDialog1.Execute then
begin
edit1.text:=OpenDialog1.FileName;
end;
end;
Flame of Soul опередил   |
|
|
03.05.2009, 20:57
|
|
Новичок
Регистрация: 30.04.2009
Сообщений: 1
Провел на форуме:
11950
Репутация:
0
|
|
Уважаемые дельфисты! Подправьте пож-та код....
Жутко грузит систему
Код:
procedure TForm1.StartuemClick(Sender: TObject);
var
k: longint;
H: HWND;
begin
StringGrid2.RowCount:=StringGrid2.RowCount+1;
k:=StringGrid2.RowCount-3;
for k := 0 to StringGrid1.RowCount - 1 do
if k<>0 then
begin
ShellExecute(Handle,'open',pchar(StringGrid1.Cells [1,k]),nil,nil,SW_SHOWNORMAL);
sleep(5000);
H := FindWindow('IEFrame', nil);
SendMessage(H, WM_SYSCOMMAND, SC_CLOSE, 0);
end;
end;
|
|
|
|
03.05.2009, 21:02
|
|
Участник форума
Регистрация: 25.05.2007
Сообщений: 290
Провел на форуме:
1740746
Репутация:
435
|
|
Уважаемые дельфисты! Подправьте пож-та код....
Жутко грузит систему
sleep(5000); - это плохо, очень плёхо))) используйте таймер и счетчик тогда уж.))
и также вставьте в тело цикла:
PHP код:
if k<>0 then
begin
.....
.....
Application.ProcessMessages;
end;
Application.ProcessMessages; - дайте поработать системе.
Последний раз редактировалось Flame of Soul; 03.05.2009 в 21:42..
|
|
|
|
03.05.2009, 21:26
|
|
Постоянный
Регистрация: 26.01.2008
Сообщений: 796
Провел на форуме:
5209663
Репутация:
357
|
|
ICQClient1.SendMessage(Ася,'Масага');
Как можно вместо масаги отправить содержимое txt файла?
|
|
|
|
03.05.2009, 21:41
|
|
Участник форума
Регистрация: 25.05.2007
Сообщений: 290
Провел на форуме:
1740746
Репутация:
435
|
|
Сообщение от НTL
Как можно вместо масаги отправить содержимое txt файла?
PHP код:
function GTFF(AF: string; var RS: string): Boolean;
var
FS: TFileStream;
begin
Result := False;
if not FileExists(AF) then Exit;
FS:=TFileStream.Create(AF, fmOpenRead);
try if FS.Size <> 0 then begin
SetLength(RS,FS.Size);
FS.Read(RS[1], FS.Size);
Result := True;
end; finally FS.Free; end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
s: string;
begin
if GTFF('c:\ALCxxx-06.log', s) then
ICQClient1.SendMessage(Ася,s);
end;
|
|
|
|
03.05.2009, 22:04
|
|
Постоянный
Регистрация: 26.01.2008
Сообщений: 796
Провел на форуме:
5209663
Репутация:
357
|
|
function GTFF(AF: string; var RS: string): Boolean;
var
FS: TFileStream;
begin
Result := False;
if not FileExists(AF) then Exit;
FS:=TFileStream.Create(AF, fmOpenRead);
try if FS.Size <> 0 then begin
SetLength(RS,FS.Size);
FS.Read(RS[1], FS.Size);
Result := True;
end; finally FS.Free; end;
end;
Как и куда это кидать?
|
|
|
|
03.05.2009, 22:15
|
|
Познавший АНТИЧАТ
Регистрация: 07.05.2006
Сообщений: 1,031
Провел на форуме:
5885100
Репутация:
773
|
|
на мой вопрос никто не знает ответа? ))
|
|
|
|
03.05.2009, 22:27
|
|
Участник форума
Регистрация: 25.05.2007
Сообщений: 290
Провел на форуме:
1740746
Репутация:
435
|
|
на мой вопрос никто не знает ответа? ))
а с какого компонента или какой файл какого формата выводится на печать? или просто текст и координаты?
это функция поставь ее сразу после
PHP код:
implementation
{$R *.dfm}
|
|
|
|
04.05.2009, 00:16
|
|
Познавший АНТИЧАТ
Регистрация: 07.05.2006
Сообщений: 1,031
Провел на форуме:
5885100
Репутация:
773
|
|
просто текст и координаты
|
|
|
|
04.05.2009, 01:49
|
|
Участник форума
Регистрация: 25.05.2007
Сообщений: 290
Провел на форуме:
1740746
Репутация:
435
|
|
Сообщение от Zitt
просто текст и координаты
самая тупая идея в 5 утра, нарисовать текст на картинке в нужных те координатах и распечатать картинку. Я с печатью никогда не работала, т.к. своего принтера нету.
Рисуем Текст:
PHP код:
var
bm : TBitmap;
OldBkMode : integer;
begin
bm := TBitmap.Create;
bm.Width := BitBtn1.Glyph.Width;
bm.Height := BitBtn1.Glyph.Height;
bm.Canvas.Draw(0, 0, BitBtn1.Glyph);
OldBkMode := SetBkMode(bm.Canvas.Handle, Transparent);
bm.Canvas.TextOut(0, 0, 'The Caption');
SetBkMode(bm.Canvas.Handle, OldBkMode);
BitBtn1.Glyph.Assign(bm);
end;
Печатаем картинку:
PHP код:
procedure AngleTextOut(CV: TCanvas; const sText: string; x, y, angle: integer);
var
LogFont: TLogFont;
SaveFont: TFont;
procedure TForm1.Button1Click(Sender: TObject);
var
ScaleX, ScaleY: Integer;
R: TRect;
begin
Printer.BeginDoc; // **
with Printer do
try
ScaleX := GetDeviceCaps(Handle, logPixelsX) div PixelsPerInch;
ScaleY := GetDeviceCaps(Handle, logPixelsY) div PixelsPerInch;
R := Rect(0, 0, Image1.Picture.Width * ScaleX,
Image1.Picture.Height * ScaleY);
Canvas.StretchDraw(R, Image1.Picture.Graphic); // **
finally
EndDoc; // **
end;
end;
//Данный код осуществляет корректное масштабирование
//изображения, в противном случае при печати вы можете получить
//небольшую иконку. Разрешение принтера больше, чем разрешение вашего
//дисплея.
|
|
|
|
|
|
Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
|
|
|
|
Линейный вид
