Секция 4 из 8 - Предыдущая - Следующая
Все секции
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
begin
if (Columns[nIndex].Width = 0) then
begin
if (nIndex + 1 <= FreezeCols) or (nIndex >= SelectedIndex + ADelta)
then Columns[nIndex].Width := ReadWidth;
end
else
begin
SaveWidth;
if (nIndex + 1 > FreezeCols) and
(nIndex < SelectedIndex + ADelta) and
(nIndex + 1 < Columns.Count) and
(FreezeCols > 0)
then Columns[nIndex].Width := 0;
end;
end;
end;
=== End DBGRIDEX.PAS ===
Author>:
Ramil Galiev
(2:5085/49.11)
.
Q>:
Как проводить локализацию своих приложений?
A>:
[D4] В Delphi 3 и 4 есть специальные механизмы, позволяющие приложение
"переделать" на любой язык после компиляции. Для D3 надо посмотреть в хелпе,
по-моему, internationalization или что-то в этом роде.
Для D4 вообще все делается ОЧЕНЬ просто:
1. берется проект, компилируется
2. тут-же не закрывая проект вызвается New|Resource DLL Wizard
в нем указывается какие формы и модули должны подвергнуться
переводу на другой язык.
3. в результате работы Wizard появляется проект (!) с RC и DFM.
Открываем формы, и переделываем все сообщения + размер (соотв. длине
сообщений). Компилируем. В результате получается файл xxxxxxx.rus,
где xxxxxxx - название исходного проекта.
4. Запускаем xxxxxxx.exe. Видим некий не наш язык. Подкладываем
в каталог с этим exe изготовленный файл xxxxxxx.rus, и запускаем
exe повторно. Видим абсолютно ВЕЗДЕ переведенные сообщения.
p.s. файл RUS можно подставлять и убирать по вкусу.
Author>:
Dmitry Kuzmenko, Epsylon Technologies.
dima@demo.ru
[D3] Вот, случайно набpели в хэлпе. Если нужно изменить pесуpсы какого-либо модуля,
то это можно делать с помощью нехитpой опеpации:
1) Вынимаете pесуpсы из этого модуля.
2) Пеpеводите их на дpугой язык. (напpимеp pусский)
3) Создаете в Delphi свой пpоект Dll-ки (с именем того модуля, из котоpого вы
вынули pесуpсы, напpимеp vcl30), в котоpый включаете _пеpеведенные_
pесуpсы:
{$R vcl30rus.res}
4) Собиpаете все это.
5) Пеpеименовываете полученную vcl30.Dll в vcl30.rus и кидаете ее в System.
Если вы хотите, пpиложение "говоpило" по pусски только тогда, когда в
pегиональных установках стоит Russia - то тогда это все.
Если же вы хотите, чтобы ваше пpиложение _всегда_ поднимало pусские pесуpсы,
то необходимо сделать следующее добавление в Registry:
HKEY_CURRENT_USER\SOFTWARE\Borland\Delphi\Locales
"X:\MyProject\MyApp.exe" = "rus"
Тепеpь, когда ваше пpиложение будет поднимать pakages, то всегда будут бpаться
pусские pесуpсы. Дpугие пpиложения, напpимеp Delphi - это не затpонет.
Таким обpазом можно заменять даже DFM-ки из пpоекта.
Более подpобно об этом - см Help - Index - Localizing...
Author>:
Alexander Simonenko
alex@protec.kiev.ua
(2:463/249)
.
Q>:
[API] Как получить список установленных модемов в Win95/98?
A>:
unit PortInfo;
interface
uses Windows, SysUtils, Classes, Registry;
function EnumModems : TStrings;
implementation
function EnumModems : TStrings;
var
R : TRegistry;
s : ShortString;
N : TStringList;
i : integer;
j : integer;
begin
Result:= TStringList.Create;
R:= TRegistry.Create;
try
with R do begin
RootKey:= HKEY_LOCAL_MACHINE;
if OpenKey('\System\CurrentControlSet\Services\Class\Modem', False) then
if HasSubKeys then begin
N:= TStringList.Create;
try
GetKeyNames(N);
for i:=0 to N.Count - 1 do begin
closekey; { + }
openkey('\System\CurrentControlSet\Services\Class\Modem',false); { + }
OpenKey(N[i], False);
s:= ReadString('AttachedTo');
for j:=1 to 4 do
if Pos(Chr(j+Ord('0')), s) > 0 then
Break;
Result.AddObject(ReadString('DriverDesc'),TObject(j));
CloseKey;
end;
finally
N.Free;
end;
end;
end;
finally
R.Free;
end;
end;
end.
Author>:
Stas Malinovski
(2:5042/6.6)
Editor>:
Кириллов Арсен Викторович
eg@ipm.lviv.ua
.
Q>:
[API] Как выполнить перезагрузку (reboot) в Windows NT?
A>:
Даже если ты работаешь под Администратором, твоя программка должна
запросить дополнительные привилегии. Вот как это делается (Си):
void Reboot (void)
{
HANDLE hToken;
TOKEN_PRIVILEGES* NewState;
OSVERSIONINFO OSVersionInfo;
OSVersionInfo.dwOSVersionInfoSize = sizeof (OSVERSIONINFO);
GetVersionEx (&OSVersionInfo);
if (OSVersionInfo.dwPlatformId == VER_PLATFORM_WIN32_NT)
{
OpenProcessToken (GetCurrentProcess (), TOKEN_ADJUST_PRIVILEGES,
&hToken);
NewState = (TOKEN_PRIVILEGES*) malloc (sizeof
(TOKEN_PRIVILEGES) + sizeof (LUID_AND_ATTRIBUTES));
NewState->PrivilegeCount = 1;
LookupPrivilegeValue (NULL, SE_SHUTDOWN_NAME,
&NewState->Privileges[0].Luid);
NewState->Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges (hToken, FALSE, NewState, NULL, NULL, NULL);
free (NewState);
CloseHandle (hToken);
}
ExitWindowsEx (EWX_REBOOT, 0);
}
Author>:
Andy Nikolayev
an@megatel.ru
(2:5020/56)
Здесь иная редакция этой процедуры (на Паскале, без проверки версии ОС) -
Procedure Shutdown(Name:String; // Имя машины (\\SERVER)
Message:String; // Сообщение
Delay:Integer; // Задержка перед рестартом
Restart,CloseAll:Boolean);
var ph:THandle;
tp,prevst:TTokenPrivileges;
rl:DWORD;
begin
OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,ph);
LookupPrivilegeValue(Nil,'SeShutdownPrivilege',tp.Privileges[0].Luid);
tp.PrivilegeCount:=1;
tp.Privileges[0].Attributes:=2;
AdjustTokenPrivileges(ph,FALSE,tp,SizeOf(prevst),prevst,rl);
InitiateSystemShutdown(PChar(name),PChar(Message),Delay,Restart,CloseAll);
ShowMessage(SysErrorMessage(GetLastError)); // Результат
end;
Editor>:
Sergey Dubovsky
4438645@pager.mirabilis.com
(2:450/103.15)
.
> --- added in v7.1
Q>:
[API] Как узнать язык Windows по умолчанию?
A>:
GetSystemDefaultLCID
GetLocaleInfo
Author>:
Denis G. Priyomov
(2:5030/386.97)
.
Q>:
[API] Как указать системе на необходимость сбросить буфера *.INI-файла на диск?
A>:
procedure FlushIni(FileName: string);
var
{$IFDEF WIN32}
CFileName: array[0..MAX_PATH] of WideChar;
{$ELSE}
CFileName: array[0..127] of Char;
{$ENDIF}
begin
{$IFDEF WIN32}
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
WritePrivateProfileStringW(nil, nil, nil, StringToWideChar(FileName,
CFileName, MAX_PATH))
else
WritePrivateProfileString(nil, nil, nil, PChar(FileName));
{$ELSE}
WritePrivateProfileString(nil, nil, nil, StrPLCopy(CFileName,
FileName, SizeOf(CFileName) - 1));
{$ENDIF}
end;
Author>:
Sergej Kosinskij
(2:5030/193)
.
Q>:
[OGL] Есть необходимость записать содержимое окна OpenGl, в 'bmp' файл.
Как можно решить эту задачку?
A>:
Вот что попробовал - вроде получилось:
bt := TBitmap.Create;
bt.Width := gr.Width;
bt.Height := gr.Height;
bt.Canvas.CopyRect(ClientRect, gr.Canvas, gr.ClientRect);
bt.SaveToFile('e:\bt.bmp');
bt.Free;
(gr - объект, в канве которого я рисую с помощью OpenGL)
Author>:
Michael L. Stepuchev
mike@prognoz.ru
.
Q>:
[VCL] Можно ли сделать так - одновременно иметь на экране всегда доступную
форму - например "Навигатор" и открывая модальные формы, иметь всегда
доступ к форме "Навигатор" ?
A>:
Обманом можно все.
procedure ShowAlmostModal(FormModal:TForm);
begin
NavigatorForm.Enabled:=false;
FormModal.ShowModal
end;
И вот это пpивесь на OnShow почти модальной фоpмы
procedure FormShow(Sender:Tobject);
begin
NavigatorForm.Enabled:=true;
end;
Author>:
Serge Buzadzhy
(2:467/44.37)
.
> --- added in v7.0
Q>:
[VCL] Хочу реализовать правильный выпадающий контрол (combo). Как это сделать?
A>:
Когда-то потратил немало времени на разбор, как же все таки работаю дропдаун
контролы. В итоге мной был написан маленький юнит, который я положил у себя
в каталоге Demo для ознакомления интерисующихся.
Он маленький (его основная задача -- показать принцип работы, а все остальное
-- как реализуешь), я думаю, что большинству он пригодиться, поэтому публикую
здесь. Касательно твоего вопроса -- реализуй вместо листбокса выпадающий
контрол, который даст тебе функциональность дерева.
=== Cut ===
unit edit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TPopupListbox = class(TCustomListbox)
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
override;
end;
TTestDropEdit = class(TEdit)
private
FPickList: TPopupListbox;
procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
protected
procedure CloseUp(Accept: Boolean);
procedure DropDown;
procedure WndProc(var Message: TMessage); override;
public
constructor Create(Owner: TComponent); override;
destructor Destroy; override;
end;
implementation
procedure TPopupListBox.CreateParams(var Params: TCreateParams);
begin
inherited;
with Params do begin
Style := Style or WS_BORDER;
ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
WindowClass.Style := CS_SAVEBITS;
end;
end;
procedure TPopupListbox.CreateWnd;
begin
inherited CreateWnd;
Windows.SetParent(Handle, 0);
CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0);
end;
procedure TPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
TTestDropEdit(Owner).CloseUp((X >= 0) and (Y >= 0) and (X < Width) and (Y <
Height));
end;
{ TTestDropEdit }
constructor TTestDropEdit.Create(Owner: TComponent);
begin
inherited Create(Owner);
Parent := Owner as TWinControl;
FPickList := TPopupListbox.Create(nil);
FPickList.Visible := False;
FPickList.Parent := Self;
FPickList.IntegralHeight := True;
FPickList.ItemHeight := 11;
FPickList.Items.CommaText :='1,2,3,4,5,6,7,8,9,0';
end;
destructor TTestDropEdit.Destroy;
begin
FPickList.Free;
inherited;
end;
procedure TTestDropEdit.CloseUp(Accept: Boolean);
begin
if FPickList.Visible then begin
if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
SetWindowPos(FPickList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
if FPickList.ItemIndex <> -1 then
Text := FPickList.Items.Strings[FPickList.ItemIndex];
FPickList.Visible := False;
Invalidate;
end;
end;
procedure TTestDropEdit.DropDown;
var
P: TPoint;
I,J,Y: Integer;
begin
if Assigned(FPickList) and (not FPickList.Visible) then begin
FPickList.Width := Width;
FPickList.Color := Color;
FPickList.Font := Font;
FPickList.Height := 6 * FPickList.ItemHeight + 4;
FPickList.ItemIndex := FPickList.Items.IndexOf(Text);
P := Parent.ClientToScreen(Point(Left, Top));
Y := P.Y + Height;
if Y + FPickList.Height > Screen.Height then Y := P.Y - FPickList.Height;
SetWindowPos(FPickList.Handle, HWND_TOP, P.X, Y, 0, 0,
SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
FPickList.Visible := True;
Invalidate;
Windows.SetFocus(Handle);
end;
end;
procedure TTestDropEdit.CMCancelMode(var Message: TCMCancelMode);
begin
if (Message.Sender <> Self) and (Message.Sender <> FPickList) then
CloseUp(False);
end;
procedure TTestDropEdit.WMKillFocus(var Message: TMessage);
begin
inherited;
CloseUp(False);
end;
procedure TTestDropEdit.WndProc(var Message: TMessage);
procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
begin
case Key of
VK_UP, VK_DOWN:
if ssAlt in Shift then begin
if FPickList.Visible then CloseUp(True) else DropDown;
Key := 0;
end;
VK_RETURN, VK_ESCAPE:
if FPickList.Visible and not (ssAlt in Shift) then begin
CloseUp(Key = VK_RETURN);
Key := 0;
end;
end;
end;
begin
case Message.Msg of
WM_KeyDown, WM_SysKeyDown, WM_Char:
with TWMKey(Message) do begin
DoDropDownKeys(CharCode, KeyDataToShiftState(KeyData));
if (CharCode <> 0) and FPickList.Visible then begin
with TMessage(Message) do
SendMessage(FPickList.Handle, Msg, WParam, LParam);
Exit;
end;
end
end;
inherited;
end;
end.
=== Cut ===
Author>:
Pasha Schurenko
(2:463/600.1)
.
> --- changed in v7.0
Q>:
Как мне отправить на принтер чистый поток данных?
A>:
Под Win16 Вы можете использовать функцию SpoolFile, или
Passthrough escape, если принтер поддерживает последнее.
Под Win32 Вы можете использовать WritePrinter.
Ниже пример открытия принтера и записи чистого потока данных в принтер.
Учтите, что Вы должны передать корректное имя принтера, такое, как "HP LaserJet 5MP",
чтобы функция сработала успешно.
Конечно, Вы можете включать в поток данных любые необходимые управляющие коды,
которые могут потребоваться.
uses WinSpool;
procedure WriteRawStringToPrinter(PrinterName:String; S:String);
var
Handle: THandle;
N: DWORD;
DocInfo1: TDocInfo1;
begin
if not OpenPrinter(PChar(PrinterName), Handle, nil) then
begin
ShowMessage('error ' + IntToStr(GetLastError));
Exit;
end;
with DocInfo1 do begin
pDocName := PChar('test doc');
pOutputFile := nil;
pDataType := 'RAW';
end;
StartDocPrinter(Handle, 1, @DocInfo1);
StartPagePrinter(Handle);
WritePrinter(Handle, PChar(S), Length(S), N);
EndPagePrinter(Handle);
EndDocPrinter(Handle);
ClosePrinter(Handle);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
WriteRawStringToPrinter('HP', 'Test This');
end;
Author>:
(Borland/Inprise FAQ N714, переведен Акжаном Абдулиным)
Посмотри и доделай как тебе надо.
=== Cut ===
unit TextPrinter;
interface
uses
Windows, Controls, Forms, Dialogs;
type
TTextPrinter = class(TObject)
FNumberOfBytesWritten: Integer;
FHandle: THandle;
FPrinterOpen: Boolean;
FErrorString: PChar;
procedure SetErrorString;
public
constructor Create;
procedure Write(const Str: string);
procedure WriteLn(const Str: string);
destructor Destroy; override;
published
property NumberOfBytesWritten: Integer read FNumberOfBytesWritten;
end;
implementation
{TTextPrinter}
constructor TTextPrinter.Create;
begin
FHandle := CreateFile('LPT1', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ
or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
if FHandle = INVALID_HANDLE_VALUE then
begin
SetErrorString;
raise Exception.Create(FErrorString);
end
else
FPrinterOpen := True;
end;
procedure TTextPrinter.SetErrorString;
begin
if FErrorString <> nil then
LocalFree(Integer(FErrorString));
FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM,
nil,
GetLastError(),
LANG_USER_DEFAULT,
@FErrorString,
0,
nil);
end;
procedure TTextPrinter.Write(const Str: string);
var
OEMStr: PChar;
NumberOfBytesToWrite: Integer;
begin
if not FPrinterOpen then
Exit;
NumberOfBytesToWrite := Length(Str);
OEMStr := PChar(LocalAlloc(LMEM_FIXED, NumberOfBytesToWrite + 1));
try
CharToOem(PChar(Str), OEMStr);
if not WriteFile(FHandle, OEMStr^, NumberOfBytesToWrite,
FNumberOfBytesWritten, nil) then
begin
SetErrorString;
raise Exception.Create(FErrorString);
end;
finally
LocalFree(Integer(OEMStr));
end;
end;
procedure TTextPrinter.WriteLn(const Str: string);
begin
Self.Write(Str);
Self.Write(#10);
end;
destructor TTextPrinter.Destroy;
begin
CloseHandle(FHandle);
if FErrorString <> nil then
LocalFree(Integer(FErrorString));
end;
end.
=== Cut ===
P.S. В принципе, вместо LPT1 может стоять что угодно, даже сетевой
сервер печати (\\server\prn) - все равно печатает. Можно и параметр
в конструктор вставить и т.д.
Author>:
Oleg Yunets
(2:451/300.24)
.
Q>:
Как создать окна непрямоугольной формы и работать с ними?
A>:
Win32 (Windows'95 or Windows NT 4.0 or above).
Достаточно создать регион нужной формы и вызвать SetWindowRgn -
HRGN rgn := CreateEllipticRgn( 10,10,100,100 );
SetWindowRgn( hMyWnd,rgn ); // Вот и будет круглое окно
При этом регион этот теперь используется Windows и будет уничтожен при
закрытии окна.
Author>:
Jouri Mamaev
(2:5080/80.66)
и другие.
Попpобуйте вот этот обpаботчик OnCreate :)
На меня это пpоизвело впечатление.
--------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
const W=36*pi/180;
var R,R1,R2: HRgn; X,Y,i:integer;
function S(a:integer;R:integer):integer;
begin
Result:=round(R*sin(W*a));
end;
function C(a:integer;R:integer):integer;
begin
Result:=round(R*cos(W*a));
end;
function GetStarReg(X,Y,R:integer):HRGN;
var P : array [0..4] of TPoint;
begin
P[0] := Point(X, Y-R);
P[1] := Point(X-S(4,R), Y-C(4,R));
P[2] := Point(X-S(8,R), Y-C(8,R));
P[3] := Point(X-S(2,R), Y-C(2,R));
P[4] := Point(X-S(6,R), Y-C(6,R));
Result := CreatePolygonRgn(P, 5, WINDING);
end;
begin
X:=Width div 2;
Y:=Height div 2;
R:=GetStarReg(X,Y,100);
i:=1;
repeat
R1:=GetStarReg(X-S(i,120),Y-C(i,110),40);
CombineRgn(R,R,R1,RGN_OR);
inc(i,2);
until i>9;
R1:=GetStarReg(X,Y,30);
CombineRgn(R,R,R1,RGN_DIFF);
R1:=CreateEllipticRgn(3,3,Width-6,Height-6);
R2:=CreateEllipticRgn(20,10,Width-20,Height-10);
CombineRgn(R1,R1,R2,RGN_DIFF);
CombineRgn(R,R,R1,RGN_OR);
SetWindowRgn(Handle, R, True);
end;
----------------------------------------------------
Author>:
Alexander Burnashov
alex@arta.spb.su
(2:5030/254.36)
.
> --- added in v6.1
Q>:
Как убрать публичное свойство компонента/формы из списка видимых/редактируемых
свойств в Инспекторе Обьектов?
A>:
Из TForm property не убиpал, но из TWinControl было дело.
А дело было так :
interface
type
TMyComp = class(TWinControl)
...
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('MyPage', [TMyComp]);
RegisterPropertyEditor(TypeInfo(String),TMyComp,'Hint',nil);
end;
[ и т.д.]
Тепеpь property 'Hint' в Object Inspector не видно.
Рад, если чем-то помог. Если будут глюки, умоляю сообшить. Такой подход
у меня сплошь и pядом.
Author>:
Andy Svirin
(2:5020/1377.5)
.
Q>:
Как узнать доступные сетевые pесуpсы?
A>:
Вот пример:
type
PNetResourceArray = ^TNetResourceArray;
TNetResourceArray =
array[0..MaxInt div SizeOf(TNetResource) - 1] of TNetResource;
Procedure EnumResources(LpNR:PNetResource);
Var
NetHandle: THandle;
BufSize: Integer;
Size: Integer;
NetResources: PNetResourceArray;
Count: Integer;
NetResult:Integer;
I: Integer;
NewItem:TListItem;
Begin
If WNetOpenEnum(
RESOURCE_GLOBALNET,
RESOURCETYPE_ANY,
// RESOURCETYPE_ANY - все ресурсы
// RESOURCETYPE_DISK - диски
// RESOURCETYPE_PRINT - принтеры
0,
LpNR,
NetHandle) <> NO_ERROR then Exit;
Try
BufSize := 50 * SizeOf(TNetResource);
GetMem(NetResources, BufSize);
Try
while True do
begin
Count := -1;
Size := BufSize;
NetResult := WNetEnumResource(NetHandle, Count, NetResources, Size);
If NetResult = ERROR_MORE_DATA then
begin
BufSize := Size;
ReallocMem(NetResources, BufSize);
Continue;
end;
if NetResult <> NO_ERROR then Exit;
For I := 0 to Count-1 do
Begin
With NetResources^[I] do
Begin
If RESOURCEUSAGE_CONTAINER =
(DwUsage and RESOURCEUSAGE_CONTAINER) then
EnumResources(@NetResources^[I]);
If dwDisplayType = RESOURCEDISPLAYTYPE_SHARE Then
// ^^^^^^^^^^^^^^^^^^^^^^^^^ - ресурс
// RESOURCEDISPLAYTYPE_SERVER - компьютер
// RESOURCEDISPLAYTYPE_DOMAIN - рабочая группа
// RESOURCEDISPLAYTYPE_GENERIC - сеть
Begin
NewItem:= Form1.ListView1.Items.Add;
NewItem.Caption:=LpRemoteName;
End;
End;
End
End;
finally
FreeMem(NetResources, BufSize);
end;
finally
WNetCloseEnum(NetHandle);
end;
End;
procedure TForm1.Button1Click(Sender: TObject);
Var
OldCursor: TCursor;
begin
OldCursor:= Screen.Cursor;
Screen.Cursor:= crHourGlass;
With ListView1.Items do
Begin
BeginUpdate;
Clear;
EnumResource(nil);
EndUpdate;
End;
Screen.Cursor:= OldCursor;
end;
Author>:
Alexey Lesovik
(2:5020/898.15)
.
> --- added in v6
Q>:
Как подключать сетевые диски?
A>:
Деpжи pабочий кусок кода из пpогpаммы "мэйлеpа" сетевой FIDO станции:
var nw:TNetResource;
...
nw.dwType:=RESOURCETYPE_DISK;
nw.lpLocalName:=nil;
nw.lpRemoteName:=PChar('\\'+MailServer.RemoteName+'\MAIL');
nw.lpProvider:=nil;
if MailServer.Password<>'' then
Err:=WNetAddConnection2(nw,PChar(MailServer.Password),nil,0)
else
Err:=WNetAddConnection2(nw,nil,nil,0);
If Err=NO_ERROR then
begin
...
end;
MailServer.RemoteName и Password -- имя удаленного компа в сети и
паpоль доступа к pесуpсу соответвенно.
ps.: так, как написано, ты будешь к pесуpсу обpащаться как к '\\Comp\Disc'.
если хочешь подключить сетевой pесуpс как локальный диск -- меняй
nw.lpLocalName.
pps.: когда(если) закончишь юзать сетевой диск, ставь WNetCancelConnection2.
Author>:
Vadim Saitov
(2:5011/76.13)
.
Q>:
[Win32] Как правильно работать с прозрачными окнами (стиль WS_EX_TRANSPARENT)?
A>:
Стиль окна-формы указывается в CreateParams (если не перепутал).
Только вот когда перемещаешь его, фон остается со старым куском экрана.
Чтобы этого не происходило, то когда pисуешь своё окно, запоминай,
что было под ним,а пpи пеpемещении восстанавливай.
HDC hDC = GetDC(GetDesktopWindow()) тебе поможет..
Author>:
Andrei Bogomolov
http://cardy.hypermart.net
ICQ UIN:7329451
mailto: admin@cardy.hypermart.net
e-pager:7329451@pager.mirabilis.com
(2:5013/11.3)
.
Q>:
[API,W95] Как спрятать окно приложения из списка задач и из таскбара?
A>:
Для NT - всё как обычно, для 95 так:
#define RSP_SIMPLE_SERVICE 0x00000001
#define RSP_UNREGISTER_SERVICE 0x00000000
void SimpleServiceRegister (void)
{
HINSTANCE hInstKernel;
DWORD (__stdcall *pRegisterServiceProcess) (DWORD, DWORD);
hInstKernel = LoadLibrary ("KERNEL32.DLL");
if (hInstKernel)
{
pRegisterServiceProcess = (DWORD (__stdcall *) (DWORD, DWORD))
GetProcAddress (hInstKernel, "RegisterServiceProcess");
if (pRegisterServiceProcess)
{
pRegisterServiceProcess (NULL, RSP_SIMPLE_SERVICE);
}
FreeLibrary (hInstKernel);
}
}
Author>:
Andy Nikolayev
an@megatel.ru
(2:5020/56)
.
Q>:
[LNG] Как корректно сравнивать и выполнять арифметические действия с
четырехбайтными беззнаковыми целыми числами (DWORD)?
A>:
Ничего лучшего, чем PChar(a) < PChar(b) пока не пpидумали.
Author>:
Alex Konshin
alexk@msmt.spb.su
(2:5030/217)
.
Q>:
[OGL] Каким обpазом выбиpать pазмеp шpифта, т.к. все мои стpадания по выбоpy
паpаметpов шpифта в CreateFont() никак не отpажались на его pазмеpе :(
Все что я пpидyмал, это юзать glScale(), но в этом слyчае полyчаем плохое
качество (по сpавнению с той-же Воpдой) пpи малом pазмеpе символов.
A>:
Вот часть работающего примера на Си (переведенного мною на Паскаль (АА)).
procedure GLSetupRC( pData: Pointer )
//void GLSetupRC(void *pData)
//{
var
// HDC hDC;
hDC: HDC;
// HFONT hFont;
hFont: HFONT;
// GLYPHMETRICSFLOAT agmf[128];
agmf: array [0..127] of GLYPHMETRICSFLOAT;
// LOGFONT logfont;
logfont: LOGFONT;
begin
logfont.lfHeight := -10;
logfont.lfWidth := 0;
logfont.lfEscapement := 0;
logfont.lfOrientation := 0;
logfont.lfWeight := FW_BOLD;
logfont.lfItalic := FALSE;
logfont.lfUnderline := FALSE;
logfont.lfStrikeOut := FALSE;
logfont.lfCharSet := ANSI_CHARSET;
logfont.lfOutPrecision := OUT_DEFAULT_PRECIS;
logfont.lfClipPrecision := CLIP_DEFAULT_PRECIS;
logfont.lfQuality := DEFAULT_QUALITY;
logfont.lfPitchAndFamily := DEFAULT_PITCH;
//strcpy(logfont.lfFaceName,"Arial");
// strcpy(logfont.lfFaceName,"Decor");
StrPCopy( logfont.lfFaceName, 'Decor' );
glDepthFunc(GL_LESS);
glEnable(GL_DEPTH_TEST); // Hidden surface removal
glFrontFace(GL_CCW); // Counter clock-wise polygons face out
glEnable(GL_CULL_FACE); // Do not calculate insides
glShadeModel(GL_SMOOTH); // Smooth shading
glEnable(GL_AUTO_NORMAL);
glEnable(GL_NORMALIZE);
glEnable(GL_COLOR_MATERIAL);
glClearColor(0.0, 0.0, 0.0, 1.0 );
glEnable(GL_LIGHTING);
glLightfv(GL_LIGHT0,GL_AMBIENT,ambientLight);
glLightfv(GL_LIGHT0,GL_DIFFUSE,diffuseLight);
glLightfv(GL_LIGHT0,GL_SPECULAR,specular);
glLightfv(GL_LIGHT0,GL_POSITION,lightPos);
glEnable(GL_LIGHT0);
glColorMaterial(GL_FRONT, GL_AMBIENT_AND_DIFFUSE);
glMaterialfv(GL_FRONT, GL_SPECULAR,specular);
glMateriali(GL_FRONT,GL_SHININESS,100);
// Blue 3D Text
glRGB(0, 0, 255);
// Select the font into the DC
hDC := (HDC)pData;
// hFont = CreateFontIndirect(&logfont);
hFont := CreateFontIndirect( Addr(logfont) );
SelectObject (hDC, hFont);
//create display lists for glyphs 0 through 255 with 0.3 extrusion
// and default deviation. The display list numbering starts at 1000
// (it could be any number).
// if(!wglUseFontOutlines(hDC, 0, 128, 1000, 0., 0.3,
// WGL_FONT_POLYGONS, agmf))
if not wglUseFontOutlines(hDC, 0, 128, 1000, 0., 0.3,
//> ``` - это тебе поможет
//> Выводить текст можно в любым масштабе
WGL_FONT_POLYGONS, agmf) then
Windows.MessageBox(nil,'Could not create Font Outlines',
'Error',MB_OK or MB_ICONSTOP);
// Delete the font now that we are done
DeleteObject(hFont);
//}
end;
// void GLRenderScene(void *pData)
procedure GLRenderScene(pData: Pointer);
begin
(* ... *)
// Draw 3D text
glListBase(1000);
glPushMatrix();
// Set up transformation to draw the string.
glTranslatef(-35.0, 0.0, -5.0) ;
glScalef(60.0, 60.0, 60.0);
glCallLists(3, GL_UNSIGNED_BYTE, 'Decor');
glPopMatrix(); // Clear the window with current clearing color
(* ... *)
end;
Author>:
Garik Pozdeev
(2:5021/15.9)
.
Q>:
[API] Как умертвить PC Speaker?
A>:
Это выключит спикеp:
SyStemParametersInfo(SPI_SETBEEP,0,nil,SPIF_UPDATEINIFILE);
Это включит:
SyStemParametersInfo(SPI_SETBEEP,1,nil,SPIF_UPDATEINIFILE);
Author>:
Alexey Lesovik
(2:5020/898.15)
.
Q>:
[API,COM] Как создавать ярлыки на рабочем столе?
A>:
function CreateShortcut(const CmdLine, Args, WorkDir, LinkFile: string):
IPersistFile;
var
MyObject : IUnknown;
MySLink : IShellLink;
MyPFile : IPersistFile;
WideFile : WideString;
begin
MyObject := CreateComObject(CLSID_ShellLink);
MySLink := MyObject as IShellLink;
MyPFile := MyObject as IPersistFile;
with MySLink do
begin
SetPath(PChar(CmdLine));
SetArguments(PChar(Args));
SetWorkingDirectory(PChar(WorkDir));
end;
WideFile := LinkFile;
MyPFile.Save(PWChar(WideFile), False);
Result := MyPFile;
end;
procedure CreateShortcuts;
var Directory, ExecDir: String;
MyReg: TRegIniFile;
begin
MyReg := TRegIniFile.Create(
'Software\MicroSoft\Windows\CurrentVersion\Explorer');
ExecDir := ExtractFilePath(ParamStr(0));
Directory := MyReg.ReadString('Shell Folders', 'Programs', '') + '\' +
ProgramMenu;
CreateDir(Directory);
MyReg.Free;
CreateShortcut(ExecDir + 'Autorun.exe', '', ExecDir,
Directory + '\Demonstration.lnk');
CreateShortcut(ExecDir + 'Readme.txt', '', ExecDir,
Directory + '\Installation notes.lnk');
CreateShortcut(ExecDir + 'WinSys\ivi_nt95.exe', '', ExecDir,
Directory + '\Install Intel Video Interactive.lnk');
end;
Разберешься?
Author>:
Roman Ryltsov
ryltsov@geocities.com
ryltsov@kharkov.com
http://surf.to/ryltsov
Гм. Вообще правильнее в процедуре CreateShortcuts пользовать
Win32API::GetSpecialFolderLocation с нужным параметром
(CSIDL_PROGRAMS в случае папки "Программы", или CSIDL_DESKTOP в случае
"Рабочего стола").
Editor>:
Akzhan Abdulin
(2:5040/55)
.
Q>:
[API] Как по IP адресу получить HostName (и обратно).
A>:
Хм... А ты увеpен, что пытался найти эту функцию?
Ты, навеpно, будешь очень удивлен (так уж повелось в этой эхе), но это
gethostbyaddr, а если в Winsock2, то можно еще WSAAddressToString
Скачиваешь с microsoft или с intel WinSock2 SDK и документацию (она отдельно),
там все есть.
Мне лень сейчас вспоминать и pазбиpаться, вот тебе кусочек, в котоpом этим
функции используются (не пpетендую на абсолютную истину, но с IP pаботает):
function TGenericNetTask.GetPeerOrigin( const ALogin : String ) : DWORD;
const AddressStrMaxLen = 256;
var len : DWORD;
ptr : PChar;
pHE : PHostEnt;
addr : TSockAddr;
buf : Array [0..AddressStrMaxLen-1] of Char;
begin
if FNet=nil then raise ESocketError.Error(-1,ClassName+'.GetPeerAds: Net is
not defined',WSAHOST_NOT_FOUND);
len := SizeOf(TSockAddr);
if getpeername(FSocket,addr,len)<>0 then
RaiseLastSocketError(-1,ClassName+'.GetPeerAds: getpeername()');
case addr.sin_family of
AF_INET: // TCP/IP
begin
pHE := gethostbyaddr( PChar(@addr.sin_addr), SizeOf(TInAddr),
AF_INET );
if pHE=nil then RaiseLastSocketError(-1,ClassName+'.GetPeerAds:
gethostbyaddr()');
FPeerNodeName := pHE^.h_name;
if FNet.NodeByName(FPeerNodeName)=nil then
begin
ptr := StrScan(pHE^.h_name,'.');
if ptr<>nil then FPeerNodeName :=
Copy(pHE^.h_name,1,ptr-pHE^.h_name);
end;
end;
else
len := AddressStrMaxLen;
if WSAAddressToStringA(sin,sinlen,nil,buf,len)<>0 then
RaiseLastSocketError(-1,ClassName+'.GetPeerAds: WSAAddressToStringA()');
ptr := StrRScan(buf,':');
if ptr<>nil then len := ptr-buf;
FPeerNodeName := Copy(buf,1,len);
end;
Result :=
FNet.EncodeAddress(ALogin,FPeerNodeName,'',[bLoginIdRequired,bNodeIdREquired,bR
aiseError]);
end; {TGenericNetTask.GetPeerOrigin}
Author>:
Alex Konshin
alexk@msmt.spb.su
(2:5030/217)
.
Q>:
[ALG] Есть ли у кого алгоритм переноса русского текста по слогам?
Секция 4 из 8 - Предыдущая - Следующая
© faqs.org.ru
