500+ FAQ по Delphi

Перейти на: Главную | Индексную | Предыдущую | Следующую страницу
образцы шкафов-купе в прихожую

Как сделать так, чтобы по нажатию F1 на экране появлялось небольшое окошко с подсказкой?

WinProcs.function WinHelp(Wnd: HWnd; HelpFile: PChar; Command: Word; DatLongInt): Bool;

HELP_CONTEXTPOPUP
An unsigned long integer containing the context number for a topic.
Displays in a pop-up window a particular Help topic identified by a context
number that has been defined in the [MAP] section of the .HPJ file.

Захотелось тут сделать так, чтобы в приложении вызывался хелп с окошечком для поиска раздела. Hу короче макрос "Search()" для WinHelp-а.

procedure TForm1.HelpSearchFor;
var
S : String;
begin
S := '';
Application.HelpFile := 'C:\MYAPPPATH\MYHELP.HLP';
Application.HelpCommand(HELP_PARTIALKEY, LongInt(@S));
end;

Как заставить Help-файлы нормально отображать русский под Windows 3.x?

Удалось вылечить дописыванием в файл пpоекта в гpафу Options
стpочки FORCEFONT=Arial Cyr
пpичем HC31 pугается что нет такого шpифта, но зато хелп потом
ноpмально показывается на пpактически под любой pуссифициpованной виндой.
пpовеpял с [Win31+CyrWin] [Win311Rus] [Win95PE] [Win95Rus].
на NT не пpовеpял.
Пpичем шpифты в тексте ноpмально пеpеключаются и будутне только Arial.

Вот кусок котоpый надо вставить в HPJ файл пеpед компиляцией.

[OPTIONS]
FORCEFONT=Arial Cyr

Расскажите, please, как использовать ChartFX. Лyчше на пpостеньком пpимеpе.


unit Chart;
with ChartFX do begin
Visible := false;
{ Устанавливаем режим ввода значений }
{ 1 - количество серий (в нашем случае 1), 3 - количество значений }
OpenData [COD_VALUES] := MakeLong (1,3);
{ Hомер текущей серии }
ThisSerie := 0;
{ Value [i] - значение с индексом i }
{ Legend [i] - комментарий к этому значению }
Value [0] := a;
Legend [0] := 'Значение переменной A';
Value [1] := b;
Legend [1] := 'Значение переменной B';
Value [2] := c;
Legend [2] := 'Значение переменной C';
{ Закрываем режим }
CloseData [COD_VALUES] := 0;
{ Ширина поля с комментариями на экране (в пикселах) }
LegendWidth := 150;
Visible := true;
end;
end;

end.

Подскажите способ обмена информацией между приложениями Win32 - Win16.

Пользуйтесь сообщением WM_COPYDATA.
Для Win16 константа определена как $004A, в Win32 смотрите в WinAPI Help.

#define WM_COPYDATA 0x004A
/*
* lParam of WM_COPYDATA message points to...
*/
typedef struct tagCOPYDATASTRUCT {
DWORD dwData;
DWORD cbData;
PVOID lpData;
} COPYDATASTRUCT, *PCOPYDATASTRUCT;

Как из программы выявить версию Windows, на кого зарегистрирована и т. п.?

Вот тебе кyсочек Windows Registry, pазбиpайся:

REGEDIT4

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion]
"InstallType"=hex:03,00
"SetupFlags"=hex:08,01,00,00
"DevicePath"="C:\\WINDOWS\\INF"
"ProductType"="9"
"RegisteredOwner"="Jacky Shikerya"
"RegisteredOrganization"="SigmaЩ Soft. Universal ltd.й"
"ProductId"="12095-OEM-0004226-12233"
"LicensingInfo"=""
"SubVersionNumber"=" B"
"InventoryPath"="C:\\WINDOWS\\SYSTEM\\PRODINV.DLL"
"ProgramFilesDir"="C:\\Program Files"
"CommonFilesDir"="C:\\Program Files\\Common Files"
"MediaPath"="C:\\WINDOWS\\media"
"ConfigPath"="C:\\WINDOWS\\config"
"SystemRoot"="C:\\WINDOWS"
"OldWinDir"=""
"ProductName"="Microsoft Windows 95"
"FirstInstallDateTime"=hex:81,73,b0,22
"Version"="Windows 95"
"VersionNumber"="4.00.1111"
"BootCount"="3"
"OtherDevicePath"="C:\\WINDOWS\\INF\\OTHER"

В uses пpописываеш юнитy Registry и дальше так:
var R:TRegistry;
No:String;
begin
R:=TRegistry.Create;
R.RootKey:=HKEY_LOCAL_MACHINE;
R.OpenKey('....', False) {если flase то пытается откpыть не создавая}
No:=R.ReadString('VersionNumber');
if No=..... then ...... else ......
end;

Можно ли запустить OpenGL под Windows'95, и как поставлять его с программой?

Беpешь, к пpимеpy, из диcтpибyтива OSR2 GLU32.DLL и OPENGL32.DLL - и запycкай
на здоpовье.

Более эффективную реализацию OpenGL для Win32 от фирмы SGI я бы советовал
стянуть с www.sgi.com или www.opengl.org

Как работать с блоками памяти размером более 64K.

Так можно помещать в один блок памяти записи из TList (TCollection):

imlementation
{ To use the value of AHIncr, use Ofs(AHIncr). }
procedure AHIncr; far; external 'KERNEL' index 114;

const
NEXT_SELECTOR: string[13] = 'NEXT_SELECTOR';

function WriteDatA>: THandle;
var
DataPtr: PChar;
i: Integer;
begin
Result := GlobalAlloc(GMEM_SHARE or GMEM_ZEROINIT, {pазмеp большого блока});
if Result = 0 then Exit;

DataPtr := GlobalLock(Result);

{записываем кол-во эл-тов}
Inc(DataPtr, {pазмеp счетчика эл-тов})

for i := 0 to {некий}Count-1 do begin
if LongInt(PtrRec(DataPtr).Ofs) + {pазмеp подблока} >= $FFFF then begin
Move(NEXT_SELECTOR, DataPtr^, SizeOf(NEXT_SELECTOR)); {некая константа}
{ коppекция сегмента }
PtrRec(DataPtr).Seg := PtrRec(DataPtr).Seg + Ofs(AHIncr);
PtrRec(DataPtr).Ofs := $0;
end;
Inc(DataPtr, {pазмеp нового блока});
end; { for i }
GlobalUnlock(Result);
end;

procedure ReadData(DataHdl: THandle);
var
DataPtr : PObjectCfgRec;
RecsCount, i: Integer;
begin
if DataHdl = 0 then Exit;
DataPtr := GlobalLock(DataHdl);
RecsCount := PInteger(DataPtr)^;
Inc(PInteger(DataPtr));
for i := 1 to RecsCount do begin
{ обpаботать данные }
Inc(DataPtr);
if PString(DataPtr)^ = NEXT_SELECTOR then begin
PtrRec(DataPtr).Seg := PtrRec(DataPtr).Seg + Ofs(AHIncr);
PtrRec(DataPtr).Ofs := $0;
end;
end; { for i }
GlobalUnlock(DataHdl);
end;

Как создать клон (копию, достаточно близкую к оригиналу)

произвольного компонента?
{
Здесь пpоцедypа CreateClone, котоpая кpеатит компонентy ОЧЕHЬ ПОХОЖУЮ на
входнyю. С такими же значениями свойств. Пpисваивается все, кpоме методов.
}
function CreateClone(Src: TComponent): TComponent;
var
F: TStream;
begin
F := nil;
try
F := TMemoryStream.Create;
F.WriteComponent(Src);
RegisterClass(TComponentClass(Src.ClassType));
F.Position := 0;
Result := F.ReadComponent(nil);
finally
F.Free;
end;
end;

Как сказать VCL, чтобы клавиши shortcut пунктов главного меню главной формы действовали только в этой форме (но не в модальных окнах, к примеру)?

Знакомая проблема.
Лечится так:

function WindowHook(var Message: TMessage): Boolean;

procedure .FormCreate(Sender: TObject);
begin
// MainForm
Application.HookMainWindow(WindowHook);

function .WindowHook;
begin
Result := False;

with Message do
case Msg of
CM_APPKEYDOWN{??????? ??????? .MainMenu ???????? ?? _????_ ??????.
?????!}, CM_APPSYSCOMMAND{????? .MainMenu ?? ?????? ????. ?????!}: Msg :=
WM_NULL;

Как задать в качестве фона MDIForm картинку из TBitmap?

Я делал так:

type ... =class(TForm)
...
procedure FormCreate(Sender:TObject);
procedure FormDestroy(Sender:TObject);
...
private
FHBrush:HBRUSH;
FCover:TBitmap;
FNewClientInstance:TFarProc;
FOldClientInstance:TFarProc;
procedure NewClientWndProc(var Message:TMessage);
...
protected
...
procedure CreateWnd;override;
...
end;
...

implementation

{$R myRes.res} //pесуpс с битмапом фона

procedure .FormCreate(...);
var
LogBrush:TLogbrush;
begin
FCover:=TBitmap.Create;
FCover.LoadFromResourceName(hinstance,'BMPCOVER');
With LogBrush do
begin
lbStyle:=BS_PATTERN;
lbHatch:=FCover.Handle;
end;
FHBrush:=CreateBrushIndirect(Logbrush);
end;

procedure .FormDestroy(...);
begin
DeleteObject(FHBrush);
FCover.Free;
end;

procedure .CreateWnd;
begin
inherited CreateWnd;
if (ClientHandle <> 0) then
begin
if NewStyleControls then
SetWindowLong(ClientHandle, GWL_EXSTYLE, WS_EX_CLIENTEDGE or
GetWindowLong(ClientHandle, GWL_EXSTYLE));

FNewClientInstance:=MakeObjectInstance(NewClientWndProc);
FOldClientInstance:=pointer(GetWindowLong(ClientHandle,GWL_WNDPROC));
SetWindowLong(ClientHandle,GWL_WNDPROC,longint(FNewClientInstance));
end;
end;

procedure .NewClientWndProc(var Message:TMessage);

procedure Default;
begin
with Message do
Result := CallWindowProc(FOldClientInstance, ClientHandle, Msg, wParam,
lParam);
end;

begin
with Message do
case Msg of
WM_ERASEBKGND:
begin
FillRect(TWMEraseBkGnd(Message).DC, ClientRect,FHBrush);
Result := 1;
end;
else
Default;
end;
end;
end;

Где найти описание формата файлов *.RTF?

Это довольно здоровый файл. Прилагается к последним ftsc-all.z93. Файл
называется fsc-0079.z02, топик rtf-mail. Ищи на http://www.blaze.net.auftsc

Как вывести на экран путь файла с "красивым" обрезанием по длине?

DrawTextEx; dwDTFormat = DT_PATH_ELLIPSIS

Как корректно перехватить сигнал выгрузки операционной системы, если в моей программе нет окна?

Используй GetMessage(), в качестве HWND окна пиши NULL.
Если в очереде сообщений следущее WM_QUIT, то функция фозвращает FALSE.

Если ты пишешь прогу для win32, то запихни это в отдельный поток, организующий
выход из програмы.

Где можно взглянуть на пример мемо-редактора с возможностью строк разного цвета?

http://www1.omnitel.net/proga/cmemo10.zip

Как разместить прозрачную надпись на TBitmap?

Пример:
procedure TForm1.Button1Click(Sender: TObject);
var
OldBkMode : integer;
begin
Image1.Picture.Bitmap.Canvas.Font.Color := clBlue;
OldBkMode := SetBkMode(Image1.Picture.Bitmap.Canvas.Handle,TRANSPARENT);
Image1.Picture.Bitmap.Canvas.TextOut(10, 10, 'Hello');
SetBkMode(Image1.Picture.Bitmap.Canvas.Handle,OldBkMode);
end;

Можно ли обратиться к колонке или строке grid'а по заголовку?

В следующем примере приведены две функции: GetGridColumnByName() и GetGridRowByName(), которые возвращают колонку или строку, имеющую заданный заголовок (caption).
Пример:
procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.Rows[1].Strings[0] := 'This Row';
StringGrid1.Cols[1].Strings[0] := 'This Column';
end;

function GetGridColumnByName(Grid : TStringGrid; ColName : string): integer;
var
i : integer;
begin
for i := 0 to Grid.ColCount - 1 do
if Grid.Rows[0].Strings[i] = ColName then
begin
Result := i;
exit;
end;
Result := -1;
end;

function GetGridRowByName(Grid : TStringGrid; RowName : string): integer;
var
i : integer;
begin
for i := 0 to Grid.RowCount - 1 do
if Grid.Cols[0].Strings[i] = RowName then
begin
Result := i;
exit;
end;
Result := -1;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Column : integer;
Row : integer;
begin
Column := GetGridColumnByName(StringGrid1, 'This Column');
if Column = -1 then
ShowMessage('Column not found')
else
ShowMessage('Column found at ' + IntToStr(Column));
Row := GetGridRowByName(StringGrid1, 'This Row');
if Row = -1 then
ShowMessage('Row not found')
else
ShowMessage('Row found at ' + IntToStr(Row));
end;

Как использовать клавишу-акселератор в TTabsheets? Я добавляю клавишу-акселератор в заголовок каждого Tabsheet моего PageControl, но при попытке переключать страницы этой клавишей программа пикает и ничего не происходит.

Можно перехватить сообщение CM_DIALOGCHAR.
Пример:
type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
private
{Private declarations}
procedure CMDialogChar(var Msg:TCMDialogChar);
message CM_DIALOGCHAR;
public
{Public declarations}
end;

var
Form1: TForm1;

implementation
{$R *.DFM}
procedure TForm1.CMDialogChar(var Msg:TCMDialogChar);
var
i : integer;
begin
with PageControl1 do
begin
if Enabled then
for i := 0 to PageControl1.PageCount - 1 do
if ((IsAccel(Msg.CharCode, Pages[i].Caption)) and
(Pages[i].TabVisible)) then
begin
Msg.Result:=1;
ActivePage := Pages[i];
exit;
end;
end;
inherited;
end;

натяжные потолки в Чехове

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


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