Ru-Board.club
← Вернуться в раздел «Прикладное программирование»

» Вопросы по Delphi (все версии) - часть 4

Автор: ShIvADeSt
Дата сообщения: 06.02.2009 13:30
Maks150988

Цитата:
Стоп, я вроде про класс окна имел ввиду. Или тут уже подразумевается другое?

Под классом имелось в виду примерно такое
TOwnButton = class
с методами, свойствами и прочим. Тогда каждый экземпляр класса - кнопка, будет иметь свою собственную сабслассенную функцию и прочие свойства (иконка итд).
Вот пример из Warp класс меню на апи, почитай, попробуй на базе него сделать класс кнопок
[more]

Код:
unit WarpDesk;

interface

uses Windows,ActiveX,ShlObj,ShellApi,SysUtils,Messages,Classes,WarpMenu;

procedure InitWarpDesktop(hWnd : THandle);
procedure DoneWarpDesktop(hWnd : THandle);
procedure ExecMenu(hWnd : THandle; Menu : HMenu);
procedure ExecMenuEx(hWnd : THandle; Menu : HMenu; Pos : TPoint; Flags : integer);
procedure PopupDesktop(hWnd : THandle; Mouse : boolean);
procedure HandleDeskMenu(hWnd : THandle; wParam,lParam : integer);
procedure InitDeskMenu;
procedure DoneDeskMenu;
procedure DrawDeskMenuItem(p : PDrawItemStruct);
procedure MeasureDeskMenuItem(p : PMeasureItemStruct);
procedure RefreshMenu(IconMode : integer);

const
siNoIcons = 0;
siSmallIcons= 1;
siLargeIcons= 2;

ShowIcons : integer = siLargeIcons;

NotifyObj : THandle = 0;

sfTrashCan = 0;
sfNetwork = 1;
sfControls = 2;
SkipFoldSet : set of sfTrashCan..sfControls = [sfTrashCan..sfControls];

implementation

type
TMenu = class;

TMenuItem = class
Owner : TMenu;
PIdl,GPidl : PItemIDList;
Title : string;
hLargeIcon,hSmallIcon : HIcon;
constructor Create(Master : TMenu; Idl,GIdl : PItemIDList; const ItemName : string);
destructor Destroy; override;
procedure Execute(hWnd : THandle);
procedure Draw(Ctx : PDrawItemStruct); virtual;
end;

TMenu = class(TMenuItem)
Handle : HMENU;
Items : TList;
Folder : IShellFolder;
constructor Create(Master : TMenu; Idl,GIdl : PItemIDList; const ItemName : string; ShellLink : IShellFolder);
constructor CreateRoot(Idl : PItemIDList; ShellLink : IShellFolder);
destructor Destroy; override;
function MakeItem(pidl,GIdl : PItemIDList) : boolean;
function MakeSubMenu(pidl,GIdl : PItemIDList; ShellLink : IShellFolder) : boolean;
procedure AddMenu(Src : TMenuItem; Sub : boolean);
procedure BuildMenu;
end;

var
pMalloc : IMalloc;
DeskItems : TList;
DeskRoot : TMenu;
CtxMnu : IContextMenu;
SkipFolders : array[sfTrashCan..sfControls] of record
pidl : PItemIDList;
csidl : integer;
end = ( (csidl : CSIDL_BITBUCKET),
(csidl : CSIDL_NETWORK ),
(csidl : CSIDL_CONTROLS ) );
ItemHeight : array[siNoIcons..siLargeIcons] of integer = (19, 19, 35);
MenuHeight : integer;
ScreenWidth : integer;
Metrics : TNonClientMetrics = (cbSize : sizeof(Metrics));
LastCtxOrg : TPoint;

function GetDisplayName(Folder : IShellFolder; pidl : PItemIDList) : string;
var Value : TStrRet;
begin
Folder.GetDisplayNameOf( PIdl, SHGDN_INFOLDER, Value );
with Value do case uType of
STRRET_CSTR : Result := pchar(@cStr[0]);
STRRET_WSTR :
begin
Result := pOleStr;
pMalloc.Free( pOleStr );
end;
STRRET_OFFSET : Result := pchar( dword(pidl) + uOffset );
end;
end;

function GetIdlSize(Idl : PItemIdList) : integer;
begin
result := Idl.mkid.cb;
if result = 0 then exit;
inc(result, GetIdlSize(PItemIdList(integer(Idl)+result)));
end;

function IdlCopy(Idl : PItemIdList) : PItemIdList;
var L : integer;
begin
L := GetIdlSize(Idl)+2;
result := pMalloc.Alloc(L);
move(Idl.mkid, Result.mkid, L);
end;

function IdlCat(GIdl, LIdl : PItemIdList) : PItemIdList;
var L1,L2 : integer;
begin
L1 := GetIdlSize(GIdl);
L2 := GetIdlSize(LIdl)+2;
result := pMalloc.Alloc(L1+L2);
move(GIdl.mkid, Result.mkid, L1);
move(LIdl.mkid, PItemIdList(integer(Result)+L1).mkid, L2);
end;

function IsEqualIdl(p1,p2 : PItemIDList) : boolean;
var i,l : integer;
begin
result := false;
L := p1.mkid.cb;
if L <> p2.mkid.cb then exit;
if L <> 0 then
begin
for i := 0 to L-3 do
if p1.mkid.abID[i] <> p2.mkid.abID[i] then exit;
inc(integer(p1), l);
inc(integer(p2), l);
result := IsEqualIdl(p1, p2);
end
else result := true;
end;

function IsSkipFolder(p : PItemIDList) : boolean;
var i : integer;
begin
result := true;
for i := 0 to high(SkipFolders) do
if (i in SkipFoldSet) and IsEqualIdl(SkipFolders[i].pidl, p) then exit;
result := false;
end;

constructor TMenuItem.Create(Master : TMenu; Idl,GIdl : PItemIDList; const ItemName : string);
var FI : TSHFileInfo;
begin
Owner := Master;
PIdl := Idl;
GPidl := GIdl;
Title := ItemName;
fillchar(fi, sizeof(fi), 0);
SHGetFileInfo(pchar(GIdl), 0, fi, sizeof(fi), SHGFI_PIDL or SHGFI_ICON or SHGFI_LARGEICON);
HLargeIcon := FI.hIcon;
SHGetFileInfo(pchar(GIdl), 0, fi, sizeof(fi), SHGFI_PIDL or SHGFI_ICON or SHGFI_SMALLICON);
HSmallIcon := FI.hIcon;
end;

destructor TMenuItem.Destroy;
begin
pMalloc.Free(GPIdl);
pMalloc.Free(PIdl);
inherited;
end;

procedure TMenuItem.Execute(hWnd : THandle);
procedure RunContext;
var ItemPopup : HMENU;
begin
ItemPopup := CreatePopupMenu;
CtxMnu.QueryContextMenu(ItemPopup, 0, ID_CONTEXT_FIRST, ID_CONTEXT_LAST, CMF_DEFAULTONLY);
ExecMenuEx(hWnd, ItemPopup, LastCtxOrg, TPM_CENTERALIGN);
DestroyMenu(ItemPopup);
end;
procedure RunDefault(Invoke : boolean);
var EI : TShellExecuteInfo;
begin
fillchar(ei, sizeof(ei), 0);
ei.cbSize := sizeof(ei);
ei.wnd := hWnd;
ei.nShow := SW_SHOW;
if Invoke then ei.fMask := SEE_MASK_INVOKEIDLIST
else ei.fMask := SEE_MASK_IDLIST;
ei.lpIdList := Gpidl;
ShellExecuteEx(@ei);
end;
begin
CtxMnu := nil;
if Owner = nil then RunDefault(false)
else if ((GetAsyncKeyState(VK_RBUTTON) <> 0) or
(GetAsyncKeyState(VK_CONTROL) <> 0)) and Succeeded(
Owner.Folder.GetUIObjectOf(0, 1, pidl, IID_IContextMenu, nil,
pointer(CtxMnu))) then
RunContext
else RunDefault(true);
end;

procedure TMenuItem.Draw(Ctx : PDrawItemStruct);
var IconSize : integer; IconHandle : HICON;
begin
IconHandle := HLargeIcon;
case ShowIcons of
siSmallIcons :
begin
IconSize := 16;
if HSmallIcon <> 0 then IconHandle := HSmallIcon;
end;
siLargeIcons : IconSize := 32;
else IconSize := 0;
end;
with Ctx^, rcItem do
begin
if itemAction = ODA_SELECT then
begin
DeleteObject(SelectObject(hdc, CreatePen(PS_NULL, 0, 0)));
if (itemState and ODS_SELECTED) <> 0 then
begin
SetTextColor(HDC, GetSysColor(COLOR_HIGHLIGHTTEXT));
SetBkColor(HDC, GetSysColor(COLOR_HIGHLIGHT));
DeleteObject(SelectObject(hdc, GetSysColorBrush(COLOR_HIGHLIGHT)));
end
else DeleteObject(SelectObject(hdc, GetSysColorBrush(COLOR_MENU)));
Rectangle(HDC, Left, Top, Right, Bottom);
if itemState = ODS_SELECTED then
begin
LastCtxOrg := point((Left+Right) div 2, Top);
ClientToScreen(WindowFromDC(HDC), LastCtxOrg);
end;
end;
inc(Left, 4);
DrawIconEx(HDC, Left, Top+1, IconHandle, IconSize, IconSize, 0, 0, DI_COMPAT or DI_NORMAL);
inc(Left, 4+IconSize);
DrawText(HDC, pchar(Title), length(Title), rcItem, DT_SINGLELINE or DT_VCENTER or DT_LEFT);
end;
end;

constructor TMenu.CreateRoot(Idl : PItemIDList; ShellLink : IShellFolder);
var S : string;
begin
S := GetDisplayName(ShellLink, Idl);
if S = '' then S := 'Root';
Create(nil, Idl, IdlCopy(Idl), S, ShellLink);
end;

constructor TMenu.Create(Master : TMenu; Idl,GIdl : PItemIDList; const ItemName : string; ShellLink : IShellFolder);
var
pidlChild,gpidlChild : PItemIDList;
Iterator : IEnumIDList;
celtFetched,Attr : cardinal;
Child : IShellFolder;
HR : HResult;
begin
Folder := ShellLink;
Items := TList.Create;
inherited Create(Master, Idl,GIdl, ItemName);
hr := Folder.EnumObjects( 0, SHCONTF_FOLDERS or SHCONTF_NONFOLDERS, Iterator );
if Succeeded( hr ) then
while Iterator.Next( 1, pidlChild, celtFetched ) = NOERROR do
begin
gpidlChild := IdlCat(GIdl, pidlChild);
if IsSkipFolder(gpidlChild) then MakeItem(pidlChild,gpidlChild)
else begin
Attr := $ffffffff;
hr := folder.GetAttributesOf(1, pidlChild, Attr);
if Succeeded( hr ) then
if ((Attr and $70000000 = $70000000) or not Succeeded(
Folder.BindToObject( pidlChild, nil, IID_IShellFolder,
pointer(Child) ))) then
MakeItem(pidlChild,gpidlChild)
else MakeSubMenu(pidlChild,gpidlChild, Child);
end;
end;
Iterator := nil;
if Owner = nil then exit;
end;

procedure TMenu.BuildMenu;
var i : integer; Item : TMenuItem;
begin
if Owner = nil then
begin
DestroyMenu(Handle);
DeskItems.Count := 0;
end;
Handle := CreatePopupMenu;
AddMenu(Self, false);
if Items.Count <> 0 then
begin
for i := 0 to Items.Count-1 do begin
Item := TMenuItem(Items[i]);
if not (Item is TMenu) then continue;
(Item as TMenu).BuildMenu;
end;
AppendMenu(Handle, MF_SEPARATOR, 0, nil);
for i := 0 to Items.Count-1 do begin
Item := TMenuItem(Items[i]);
if Item is TMenu then continue;
AddMenu(Item, false);
end;
end;
if Owner <> nil then AddMenu(Self, true);
end;

destructor TMenu.Destroy;
var i : integer;
begin
Folder := nil;
for i := 0 to Items.Count-1 do TMenuItem(Items[i]).Free;
DestroyMenu(Handle);
Items.Free;
inherited;
end;

procedure TMenu.AddMenu(Src : TMenuItem; Sub : boolean);
var Flags : integer;
Param : pchar;
begin
if ShowIcons = siNoIcons then
begin
Flags := MF_STRING;
Param := pchar(Src.Title);
end
else
begin
Flags := MF_OWNERDRAW;
Param := pchar(Src);
end;
if Sub then AppendMenu(Owner.Handle, Flags or MF_POPUP, Handle, Param)
else
begin
if (GetMenuItemCount(Handle)+1) mod (MenuHeight div ItemHeight[ShowIcons]) = 0 then
Flags := Flags or MF_MENUBARBREAK;
AppendMenu(Handle, Flags, DeskItems.Count, Param);
end;
DeskItems.Add(Src);
end;

function TMenu.MakeItem(pidl,GIdl : PItemIDList) : boolean;
var ItemName : string;
begin
ItemName := GetDisplayName(Folder, pidl);
result := ItemName <> '';
if not result then exit;
Items.Add(TMenuItem.Create(Self, pidl, GIdl, ItemName));
end;

function TMenu.MakeSubMenu(pidl,GIdl : PItemIDList; ShellLink : IShellFolder) : boolean;
var ItemName : string;
begin
ItemName := GetDisplayName(Folder, pidl);
result := ItemName <> '';
if result then
Items.Add(TMenu.Create(Self, pidl, GIdl, ItemName, ShellLink))
else ShellLink := nil;
end;

procedure ExecMenu(hWnd : THandle; Menu : HMenu);
var MousePos : TPoint;
begin
GetCursorPos(MousePos);
ExecMenuEx(hWnd, Menu, MousePos, TPM_RIGHTALIGN);
end;

procedure ExecMenuEx(hWnd : THandle; Menu : HMenu; Pos : TPoint; Flags : integer);
begin
SetForegroundWindow(hWnd);
TrackPopupMenu(Menu, flags or TPM_LEFTBUTTON or TPM_RIGHTBUTTON,
Pos.X, Pos.Y, 0, hWnd, nil);
PostMessage(hWnd, WM_USER, 0, 0);
end;

procedure PopupDesktop(hWnd : THandle; Mouse : boolean);
begin
// GetAsyncKeyState(VK_RBUTTON);
GetAsyncKeyState(VK_CONTROL);
if Mouse then ExecMenu(hWnd, DeskRoot.Handle)
else ExecMenuEx(hWnd, DeskRoot.Handle,
point(ScreenWidth div 2, MenuHeight), TPM_CENTERALIGN);
end;

procedure HandleDeskMenu(hWnd : THandle; wParam,lParam : integer);
var ci : TCMInvokeCommandInfo;
begin
case wParam of
ID_CONTEXT_FIRST..ID_CONTEXT_LAST :
begin
fillchar(ci, sizeof(ci), 0);
ci.cbSize := sizeof(ci);
ci.hwnd := hWnd;
ci.lpVerb := pchar(wParam-ID_CONTEXT_FIRST);
ci.nShow := SW_SHOW;
CtxMnu.InvokeCommand(ci);
CtxMnu := nil;
end;
else if wParam < DeskItems.Count then
TMenuItem(DeskItems[wParam]).Execute(hWnd);
end;
end;

var DC: HDC;

procedure InitWarpDesktop(hWnd : THandle);
begin
DC := GetWindowDC(hWnd);
InitDeskMenu;
end;

procedure DoneWarpDesktop(hWnd : THandle);
begin
ReleaseDC(hWnd, DC);
DoneDeskMenu;
end;

procedure InitDeskMenu;
var Desktop : IShellFolder;
pidlItself : PItemIDList;
begin
DoneDeskMenu;
SHGetDesktopFolder( Desktop );
SHGetSpecialFolderLocation(0, CSIDL_DESKTOP, pidlItself);
DeskRoot := TMenu.CreateRoot(pidlItself, Desktop);
RefreshMenu(ShowIcons);
end;

procedure DoneDeskMenu;
begin
if DeskRoot = nil then exit;
DeskRoot.Free;
DeskRoot := nil;
DeskItems.Count := 0;
end;

procedure DrawDeskMenuItem(p : PDrawItemStruct);
begin
if p.CtlType <> ODT_MENU then exit;
TMenuItem(p.itemData).Draw(p);
end;

function TextWidth(const S : string) : integer;
var Size : TSize;
begin
if GetTextExtentPoint32(DC, pchar(s), length(s), Size) then
result := Size.cx
else result := length(s)*6;
end;

procedure MeasureDeskMenuItem(p : PMeasureItemStruct);
begin
if p.CtlType <> ODT_MENU then exit;
p.ItemHeight := ItemHeight[ShowIcons];
p.ItemWidth := ItemHeight[ShowIcons] +
TextWidth(TMenuItem(p.itemData).Title);
end;

procedure RefreshMenu(IconMode : integer);
begin
MenuHeight := GetSystemMetrics(SM_CYMAXIMIZED);
ScreenWidth := GetSystemMetrics(SM_CXSCREEN);
SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @Metrics, 0);
ItemHeight[siNoIcons] := Metrics.iMenuHeight;
if ItemHeight[siNoIcons] > 19 then
ItemHeight[siSmallIcons] := ItemHeight[siNoIcons]
else ItemHeight[siSmallIcons] := 19;
DeleteObject(SelectObject(DC, CreateFontIndirect(Metrics.lfMenuFont)));
ShowIcons := IconMode;
DeskRoot.BuildMenu;
end;

procedure InitialRoutine;
var i : integer;
Idl : PItemIdList;
DesktopLocation : array[0..MAX_PATH] of char;
begin
CoInitialize( nil );
SHGetMalloc( pMalloc );
SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, Idl);
SHGetPathFromIdList(Idl, DesktopLocation);
pMalloc.Free(Idl);
NotifyObj := FindFirstChangeNotification(DesktopLocation, longbool(1),
FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME);
DeskItems := TList.Create;
for i := 0 to high(SkipFolders) do with SkipFolders[i] do
SHGetSpecialFolderLocation(0, csidl, pidl);
end;

procedure FinalRoutine;
var i : integer;
begin
for i := 0 to high(SkipFolders) do pMalloc.Free(SkipFolders[i].pidl);
FindCloseChangeNotification(NotifyObj);
DeskItems.Free;
CtxMnu := nil;
pMalloc := nil;
CoUninitialize;
end;

initialization
InitialRoutine;
finalization
FinalRoutine;
end.
Автор: Maks150988
Дата сообщения: 06.02.2009 14:30
ShIvADeSt
Эээ, до этого пока не доросли. )) Если только с вашей помощью. Попробую конечно...
Автор: delover
Дата сообщения: 09.02.2009 08:38
Mandor Sawall
Хорошо, вот код

Код:
var
iInstXML: IXMLNode;
begin
iInstXML.NodeValue := 'F / '+
'&#1060;'; //Русская буква Ф
...
Автор: Mandor Sawall
Дата сообщения: 09.02.2009 09:33
delover
Да, спасибо - понял.
В общем, напрямо ето невозможно - MSXML принимает UTF-8 как дефолт, так что даже если сумели запихнуть &#1060 в node, он заменить на UTF8-коде. А если поставить например 'windows-1251', он поставить "Ф", а не его код.
Как workaround, можете установить енкодинг на 'US-ASCII' и добавлять текст напрямую (Ansi или Unicode - как удобно).
Пример:
Код: XMLDocument1.Encoding := 'US-ASCII';
...
oNode.NodeValue := 'F / Ф';
или:
oNode.NodeValue := 'F / '+ WideChar(1060); //Русская буква Ф
Автор: delover
Дата сообщения: 09.02.2009 17:34
Mandor Sawall
Ладно, я понял, спасибо. Это не то что хочется. Пришлось сделать так же как всегда - вместо значений я присваиваю уникальные строки которые потом заменяю на те значения которые хочу. Выигрышь только в одном - о структуре я не думаю. Естественно код, как бы совместимый, однако оборнутый в стринг-реплаце. Кстати та прога скорее всего XML сама генерит.
Автор: StalkerSoftware
Дата сообщения: 10.02.2009 12:57
Привет всезнающий All,

Есть обработчик KeyPress для TEdit, внутри него есть такой код
(это проверка на текущий язык):

var
buffer :array [0..KL_NAMELENGTH] of Char;

GetKeyboardLayoutName(buffer);

(*) if ((StrToInt('$'+ Buffer)) and $03FF) = LANG_UKRAINIAN then

В Delphi 7 строка (*) компилируется и работает нормально, а в Delphi 2009 получаю ошибку:
"E2008 Incompatible types".

Вопрос: Как правильно написать этот код, что бы он работал в Delphi 2009 ?
Автор: Dmiro
Дата сообщения: 10.02.2009 17:30
StalkerSoftware
Должно быть так
if ((StrToInt('$'+ string(Buffer))) and $03FF) = LANG_UKRAINIAN then
Автор: StalkerSoftware
Дата сообщения: 10.02.2009 19:13
Dmiro

Цитата:
Должно быть так
if ((StrToInt('$'+ string(Buffer))) and $03FF) = LANG_UKRAINIAN then

Спасибо, как доберусь до D2009 попробую.

Еще вопрос по D2009:

В том же обработчике OnKeyPress есть такой код:
if Key in ['а'..'я', 'А'..'Я'] then
который до D2009 работал прекрасно, а вот в D2009 почему то не работает.
Пробовал его заменить на
if CharInSet(Key, ['а'..'я', 'А'..'Я']) then
но все равно возвращается False.

Вопрос: Что я тут не правильно делаю ?
Автор: delover
Дата сообщения: 10.02.2009 19:52
StalkerSoftware
Char - это стандарт языка паскаль, но не системы vista. string состоит из char. В системах текст может быть AnsiChar и WideChar, это значит что система может работать как со строками анси так и виде. В паскале есть одноимённые функции, но работающие с разными параметрами. Так как у Выс написано of Char, значит логично писать String. В этом случае компилятор может сделать программу работающую с анси, так же легко, без изменения текста, как и программу работающую с wide. В Delphi 2009 по умолчанию принят стандарт виде. Все остальные Delphi, до 2009 будут делать анси, по умолчанию. Ваш пример который Вы где то нашли касался строк Анси. Но Delphi 2009 это сделает со стринг=видестринг.

Добавлено:
StalkerSoftware
А Вы знаете в какой кодировке сохранили свою программу?
Автор: ZalivkoDenis
Дата сообщения: 10.02.2009 20:20
Доброго времени суток!
Может я не сюда, но, вдруг кто-нить подскажет. Проблема -- вообщем-то не проблема, но мучает вопрос. CG2007. Как можно перенести цветовые настройки Object Inspector с одного компа на другой? Может, там какой файлик конфигурационный перекинуть нужно?
Спасибо.
Автор: StalkerSoftware
Дата сообщения: 11.02.2009 19:12
delover

Цитата:
В Delphi 2009 по умолчанию принят стандарт виде. Все остальные Delphi, до 2009 будут делать анси, по умолчанию. Ваш пример который Вы где то нашли касался строк Анси. Но Delphi 2009 это сделает со стринг=видестринг.

Что значит "где то нашли" ? Это маленький фрагмент реально работающей программы. В D7-D2007 этот кусок работает нормально, а в D2009 нет.


Цитата:
А Вы знаете в какой кодировке сохранили свою программу?

В вндовой конечно, т.е. в ANSI (1251). Собственно говоря в этот формат у меня D2009 сама и сохраняет файлы.

Так что делать, что бы этот кусок кода нормально работал в D2009 ? Вместо букв писать их CHR коды ?
Автор: delover
Дата сообщения: 12.02.2009 08:26
StalkerSoftware
Если по умолчанию, но писать CHR коды не обязательно. Вот
Код: // Стандарт (IT is. #6291.) для плагинов с паскаль скриптами.
function VNGetString(const Src: TPSVariantIFC): tbtString;
begin
{$IFDEF DELPHI2009UP}
Result := VNGetWideString(Src);
{$ELSE}
Result := VNGetAnsiString(Src);
{$ENDIF}
end;
Автор: bandyn
Дата сообщения: 12.02.2009 11:23
Подскажите плиз
Раньше использовал Delphi 7, решил попробовать CodeGear RAD Studio 2009 Update 2 (Delphi) и сразу столкнулся с проблемой: Как прикручивать компоненты от D7, а именно компонент для работы c DBF файлами Halcyon ?
Может есть какая инструкция? Опишите все по шагам плиз...
Автор: f3ka
Дата сообщения: 12.02.2009 11:34
bandyn скорее всего придется часть кода переписывать под 2009... все таки появилась полная зависимость от Unicode... либо как вариант искать версию с поддержкой 2009...
Автор: delover
Дата сообщения: 12.02.2009 14:56
Подскажите пожалуйста.
Может кто сталкивался? Мне нужно в программном коде CPU, процесса поменять некоторое количество байт (приблизительно на TNewClass+vmtSelfPtr). Байты найдены корректно и величина корректная и код мой тот который меняет и тот который меняю, но... Я сразу же попадаю в системный обработчик экзепшена и наслаждаюсь тем как система начинает выяснять права. Знаю что такое работало на ура ещё в XP, но что для этого нужно Висте? Возможно ли так делать не прибегая к дебагу продуктов делающих такое?
Автор: kserius
Дата сообщения: 12.02.2009 17:54
Есть ли какая нибудь библиотека или компонент для работы из Дельфи с файлами формата HDF5 ?
Автор: StalkerSoftware
Дата сообщения: 12.02.2009 19:15
delover

Цитата:
function VNGetString(const Src: TPSVariantIFC): tbtString;

Не совсем понял к чему вы привели эту ф-ий и как ее использовать ...
И причем тут TKeyboardLayout ?

Мой второй вопрос (по поводу проверки символьного множества) ни как не связан с первым (по поводу проверки текущего языка).

Я просто хочу понять почему код
if Key in ['а'..'я', 'А'..'Я'] then
который до D2009 работал прекрасно (он ограничивает ввод пользователем данных в TEdit) в D2009 почему то перестал работать ?
Автор: Frodo_Torbins
Дата сообщения: 12.02.2009 20:34
StalkerSoftware
Потому, что Key у вас WideChar, а ['а'..'я', 'А'..'Я'] - AnsiChar-ы в текущей кодировке. Соответственно и коды у них разные. Поэтому CharInSet написана так:

Код: function CharInSet(C: WideChar; const CharSet: TSysCharSet): Boolean;
begin
Result := (C < #$0100) and (AnsiChar(C) in CharSet);
end;
Автор: delover
Дата сообщения: 13.02.2009 06:54
StalkerSoftware

Цитата:
Не совсем понял к чему вы привели эту ф-ий и как ее использовать ...

Это не только для Вас. Тот пример, как Вы поняли - обёртка, и это уже стандарт. Дело в том, что мне, как и любому программеру не всегда очевидно, что какие либо новшества можно уже воспринимать как призыв к действию. Delphi2009=Wide, хотя я бы не стал спешить, только не примите за флуд... Два байта на букву - это мало. По этому для инопланетян, земля всё ещё отсталый район. Рас переходить я бы перешёл на SuperHugeString.

зы:
Кста, только в японском языке одиночных символов - иероглифов (обязательно общеупотребительных) около 60 тысячь, подумай куда остальные букавы девать?
Автор: Frodo_Torbins
Дата сообщения: 13.02.2009 08:51

Цитата:
Два байта на букву - это мало.

А кто вам сказал, что два - максимум? Согасно этой статье юникод позволяет закодировать 2^31 символов.
Автор: delover
Дата сообщения: 13.02.2009 10:22
Frodo_Torbins
Так этож юникод. А Делфи 2009 это ж виде.

Кстати нашол RtlVclOptimize. Он умеет код своего процесса фиксить, но для етого линкуется на прямую с VirtualProtect. А это не есть гуд.
Автор: StalkerSoftware
Дата сообщения: 13.02.2009 18:02
Frodo_Torbins

Цитата:
Как вариант можно пока обьявить Key как AnsiCha

Этого я сделать не могу, так как Key это var параметр обработчика нажатия клавиши OnKeyPress.

CharInSet я тоже пробовал
if CharInSet(Key, ['а'..'я', 'А'..'Я']) then
он так же не работает.
Автор: Frodo_Torbins
Дата сообщения: 13.02.2009 18:38
delover
Цитата:
Так этож юникод. А Делфи 2009 это ж виде.

Сурогатные пары в D2009 тоже поддерживаются, так что юникод там реализован на 100%.

StalkerSoftware
Цитата:
Этого я сделать не могу, так как Key это var параметр обработчика нажатия клавиши OnKeyPress.

Ну и? Обьявите новую переменную AnsiChar, присвойте ей значение key...
Автор: delover
Дата сообщения: 13.02.2009 18:52
Frodo_Torbins
И если уникоде я должен придерживаться Анси стринг или стринг?
Автор: DokPZ
Дата сообщения: 13.02.2009 19:42
Подскажите, как в процессе работы программы, зная имя глобальной переменной (string) обратиться к этой переменной?
Автор: delover
Дата сообщения: 13.02.2009 19:46
DokPZ
Сделайте
ShowMessageFmt('___', [переменнаЯ]);
Автор: DokPZ
Дата сообщения: 13.02.2009 20:07
delover
надо, чтобы процедура получив stringовый параметр с именем переменной, присвоила ей значение. В переменной этой массив чисел. Размер массива заранее неизвестен.
Автор: Frodo_Torbins
Дата сообщения: 13.02.2009 22:12
delover
Цитата:
И если уникоде я должен придерживаться Анси стринг или стринг?
Не совсем понял, о чем вы. String в D2009 юникодный (String = UnicodeString), а AnsiString соответственно ансишный.

DokPZ
Цитата:
надо, чтобы процедура получив stringовый параметр с именем переменной, присвоила ей значение.
В откомпилированной программе нет информации о названиях переменных.

Цитата:
В переменной этой массив чисел. Размер массива заранее неизвестен.
Все, что вы можете, это передать указатель на эту переменную.
Автор: z3r
Дата сообщения: 13.02.2009 23:59
Необходимо вводить функцию ее в программу и далее ее расчитывать разным способами расчитывать сделал а вот со вводом сложнее. Как обработать? там к примеру sin(exp^-x)

И еще вопрос можно ли через какой то компонент кроме OLE работать с таблицами Excel. В основном записывать туда результат!
Автор: Frodo_Torbins
Дата сообщения: 14.02.2009 09:04
z3r
Цитата:
Необходимо вводить функцию ее в программу и далее ее расчитывать разным способами расчитывать сделал а вот со вводом сложнее. Как обработать? там к примеру sin(exp^-x)
Для этого вашу функцию надо парсить, об этом есть статьи в делфикингдоме, да и на торри готовые компоненты должны быть.

Страницы: 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667

Предыдущая тема: Глобальные переменные в разных формах с++ builder 'a.


Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.