500+ FAQ по Delphi

Перейти на: Главную | Индексную | Предыдущую | Следующую страницу
baldinini woman by baldinini

Как зафиксировать один или несколько столбцов в TDBGrid с возможностью навигации по этим столбцам?

Это маленькая вставка в Ваш наследник от TCustomDBGrid, которая решает данную
задачу.

=== Begin DBGRIDEX.PAS ===
destructor TDbGridEx.Destroy;
begin

_HideColumnsValues.Free;
_HideColumns.Free;

inherited Destroy;
end;

constructor TDbGridEx.Create(Component : TComponent);
begin
inherited Create(Component);

FFreezeCols := ?;

_HideColumnsValues := TList.Create;
_HideColumns := TList.Create;
end;

procedure TDbGridEx.KeyDown(var Key: Word; Shift: TShiftState);
begin
if (Key = VK_LEFT) then ColBeforeEnter(-1);
if (Key = VK_RIGHT) then ColBeforeEnter(1);

inherited;
end;

procedure TDbGridEx.SetFreezeColor(AColor : TColor);
begin
InvalidateRow(0);
end;

procedure TDbGridEx.SetFreezeCols(AFreezeCols : Integer);
begin
FFreezeCols := AFreezeCols;
InvalidateRow(0);
end;

procedure TDbGridEx.ColEnter;
begin
ColBeforeEnter(0);

if Assigned(OnColEnter) then OnColEnter(Self);
end;

procedure TDbGridEx.ColBeforeEnter(ADelta : Integer);
var
nIndex : Integer;

function ReadWidth : Integer;
var
i : Integer;

begin
i := _HideColumns.IndexOf(Columns[nIndex]);

if i = -1
then result := 120
else result := Integer(_HideColumnsValues[i]);
end;

procedure SaveWidth;
var
i : Integer;

begin
i := _HideColumns.IndexOf(Columns[nIndex]);
if i <> - 1 then
begin
_HideColumnsValues[i] := Pointer(Columns[nIndex].Width);
end else
begin
_HideColumns.Add(Columns[nIndex]);
_HideColumnsValues.Add(Pointer(Columns[nIndex].Width));
end;
end;

begin
for nIndex := 0 to Columns.Count - 1 do
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 ===

Как проводить локализацию своих приложений?

[D4] В Delphi 3 и 4 есть специальные механизмы, позволяющие приложение
"переделать" на любой язык после компиляции. Для D3 надо посмотреть в хелпе,
по-моему, internationalization или что-то в этом роде.
Для D4 вообще все делается ОЧЕHЬ просто:

1. берется проект, компилируется
2. тут-же не закрывая проект вызвается New|Resource DLL Wizard
в нем указывается какие формы и модули должны подвергнуться
переводу на другой язык.
3. в результате работы Wizard появляется проект (!) с RC и DFM.
Открываем формы, и переделываем все сообщения + размер (соотв. длине
сообщений). Компилируем. В результате получается файл xxxxxxx.rus,
где xxxxxxx - название исходного проекта.
4. Запускаем xxxxxxx.exe. Видим некий не наш язык. Подкладываем
в каталог с этим exe изготовленный файл xxxxxxx.rus, и запускаем
exe повторно. Видим абсолютно ВЕЗДЕ переведенные сообщения.

p.s. файл RUS можно подставлять и убирать по вкусу.

Вот, случайно наб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...

Как получить список установленных модемов в Win95/98?

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.

Как выполнить перезагрузку (reboot) в Windows NT?

Даже если ты работаешь под Администратором, твоя программка должна
запросить дополнительные привилегии. Вот как это делается (Си):

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);
}

Здесь иная редакция этой процедуры (на Паскале, без проверки версии ОС) -

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;

Как узнать язык Windows по умолчанию?

GetSystemDefaultLCID
GetLocaleInfo

Как указать системе на необходимость сбросить буфера *.INI-файла на диск?

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;

Есть необходимость записать содержимое окна OpenGl, в 'bmp' файл. Как можно решить эту задачку?

Вот что попробовал - вроде получилось:

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)

Можно ли сделать так - одновременно иметь на экране всегда доступную форму - например "Hавигатор" и открывая модальные формы, иметь всегда доступ к форме "Hавигатор" ?

Обманом можно все.

procedure ShowAlmostModal(FormModal:TForm);
begin
NavigatorForm.Enabled:=false;
FormModal.ShowModal
end;

И вот это пpивесь на OnShow почти модальной фоpмы

procedure FormShow(Sender:Tobject);
begin
NavigatorForm.Enabled:=true;
end;

Хочу реализовать правильный выпадающий контрол (combo). Как это сделать?

Когда-то потратил немало времени на разбор, как же все таки работаю дропдаун
контролы. В итоге мной был написан маленький юнит, который я положил у себя
в каталоге Demo для ознакомления интерисующихся.
Он маленький (его основная задача -- показать принцип работы, а все остальное
-- как реализуешь), я думаю, что большинству он пригодиться, поэтому публикую
здесь. Касательно твоего вопроса -- реализуй вместо листбокса выпадающий
контрол, который даст тебе функциональность дерева.


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.


Материалы находятся на сайте http://cracklab.narod.ru/faq/


Создатель этого HTML файла не претендует на авторство вопросов/ответов представленных в нём, не отвечает за их содержание и достоверность, а также за последствия использования программных кодов , полученных из этого HTML файла. Также не принимаются претензии относительно не размещённой информации об авторе каждого конкретного FAQ'а. Любые другие вопросы присылайте на bad_guy@cracklab.ru (обращаться к Bad_guy'ю).
Hosted by uCoz