How to draw Unicode text on TCustomControl? Are there other options to make it without the Canvas?
Yes, you are right on spot. Still, I would recommend you to upgrade to Delphi 2009 or later in which the VCL has full Unicode support and everything is much easier.
Anyhow, you can do
procedure TMyControl.Paint;
var
S: WideString;
r: TRect;
begin
inherited;
r := ClientRect;
S := 'This is the integral sign: '#$222b;
DrawTextW(Canvas.Handle, PWideChar(S), length(S), r, DT_SINGLELINE or
DT_CENTER or DT_VCENTER or DT_END_ELLIPSIS);
end;
in old versions of Delphi (I think. The code compiles in Delphi 7 in my virtual Windows 95 machine, but I see no text. That is because Windows 95 is too old, I think.)
Update
If you want to support very old operating systems, like Windows 95 and Windows 98, you need to use TextOutW instead of DrawTextW, since the latter isn't implemented (source). TextOut is less powerful then DrawText, so you need to compute the position manually if you want to center the text inside a rectangle, for instance.
procedure TMyControl.Paint;
var
S: WideString;
begin
inherited;
S := 'This is the integral sign: '#$222b;
TextOutW(Canvas.Handle, 0, 0, PWideChar(S), length(S));
end;
Related
This code works on the PngImage component (from G.Daud). Now it doesn't compile after PngImage is replaced with PngComponents for D7 (http://code.google.com/p/cubicexplorer/downloads/list).
function Bmp32ToPng(bmp: TBitmap): TPngObject;
var
x, y: integer;
src, dst: PngImage.pByteArray;
begin
Result:= nil;
if bmp.PixelFormat<>pf32bit then
Exit;
Result:= TPngObject.CreateBlank(COLOR_RGBALPHA, 8, bmp.Width, bmp.Height);
Result.Canvas.Draw(0, 0, bmp);
for y:= 0 to bmp.Height-1 do begin
src:= bmp.ScanLine[y];
dst:= Result.AlphaScanLine[y];
for x:= 0 to bmp.Width-1 do
dst[x]:= src[x*4+3];
end;
end;
The Createblank method does not exist in PngComponents. It can't be replaced with a simple Create then setting Width/height. Width/height are R/O in PngComponents.
How to convert 32bpp BMP (e.g. got from shell32.dll) to PNG?
GraphicEx and PngComponents and pngimage are conflicting. To solve it:
1) always put them in uses clause in specific order - first - GraphicEx or PngComponents, last - pngimage.
2) build Project. It is not enough to run (or compile) project after uses clause was changed.
PS) pngimage installed with PNGcomponent package, BUT this version is outdated
I'm want to convert a string value to a global memory handle and vice versa, using the following functions I've just written.
But StrToGlobalHandle() causes my testing program hangs. So GlobalHandleToStr() is untest-able yet and I'm also wondering if my code is logical or not.
function StrToGlobalHandle(const aText: string): HGLOBAL;
var
ptr: PChar;
begin
Result := 0;
if aText <> '' then
begin
Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, length(aText) + 1);
if Result <> 0 then
begin
ptr := GlobalLock(Result);
if Assigned(ptr) then
begin
StrCopy(ptr, PChar(aText));
GlobalUnlock(Result);
end
end;
end;
end;
function GlobalHandleToStr(const aHandle: HGLOBAL): string;
var
ptrSrc: PChar;
begin
ptrSrc := GlobalLock(aHandle);
if Assigned(ptrSrc) then
begin
SetLength(Result, Length(ptrSrc));
StrCopy(PChar(Result), ptrSrc);
GlobalUnlock(aHandle);
end
end;
Testing code:
procedure TForm3.Button1Click(Sender: TObject);
var
h: HGLOBAL;
s: string;
s2: string;
begin
s := 'this is a test string';
h := StrToGlobalHandle(s);
s2 := GlobalHandleToStr(h);
ShowMessage(s2);
GlobalFree(h);
end;
BTW, I want to use these two functions as helpers to send string values between programs - send a global handle from process A to process B, and process B get the string using GlobalHandleToStr().
BTW 2, I know WM_COPY and other IPC methods, those are not suitable in my case.
The strings in Delphi 2010 are unicode, so you are not allocating the proper buffer size.
replace this line
Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, length(aText) + 1);
with this
Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, (length(aText) + 1)* SizeOf(Char));
If your program hangs when you call GlobalAlloc, then you probably have heap corruption from earlier in your program. That leads to undefined behavior; the function might detect the problem and return an error, it might crash your program, it might silently corrupt yet more of your memory, it might hang, or it might do any number of other things.
That heap corruption might come from a previous call to StrToGlobalHandle because your StrCopy call writes beyond the end of the allocated memory. You're allocating bytes, but the Length function returns the number of characters in the string. That's only valid when characters are one byte wide, which isn't the case as of Delphi 2009. Multiply by SizeOf(Char) to get a byte count:
Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, SizeOf(Char) * (Length(aText) + 1));
You can't send data between programs using GlobalAlloc - it worked only in 16-bit Windows. Use Memory Mapped File instead.
It's difficult to tell what is being asked here. This question is ambiguous, vague, incomplete, overly broad, or rhetorical and cannot be reasonably answered in its current form. For help clarifying this question so that it can be reopened, visit the help center.
Closed 11 years ago.
I have been using this code for my application on Windows XP 32bit. It works pretty well for me but now I migrated to Windows 7 64bit and it stops working. How can I make this work on Windows 7? I'm using Delphi 7.
program Project1;
{$APPTYPE CONSOLE}
uses
Windows, CommCtrl, dialogs , sysutils, classes;
var
myTimerHandle:WORD;
msg:TMSG;
Function Magchar(const S:string): string;
var
Ch: Char;
L: Integer;
Source, Dest: PChar;
begin
L := Length(S);
SetLength(Result, L);
Source := Pointer(S);
Dest := Pointer(Result);
while L <> 0 do
begin
Ch := Source^;
if (Ch >= 'A') and (Ch <= 'Z') then
Inc(Ch, 32); Dest^ := Ch; Inc(Source); Inc(Dest); Dec(L);
end;
end;
Function CacheCache(_Processus:string):string;
var
dwSize, dwNumberOfBytes, PID, hProcess:Cardinal;
PLocalShared, PSysShared:PlvItem;
wnd: THandle;
iCount, i: integer;
szTemp:string;
begin
wnd := FindWindow('#32770',nil);
wnd := FindWindowEx(wnd, 0, '#32770', nil);
wnd := FindWindowEx(wnd, 0, 'SysListView32',nil);
iCount := SendMessage(wnd, LVM_GETITEMCOUNT, 0, 0);
for
i := 0 to iCount -1 do
begin
dwSize := SizeOf(LV_ITEM) + SizeOf(CHAR) * MAX_PATH;
pLocalShared := VirtualAlloc(nil, dwSize, MEM_RESERVE + MEM_COMMIT, PAGE_READWRITE);
GetWindowThreadProcessID(WND, #PID);
hProcess := OpenProcess(PROCESS_VM_OPERATION OR PROCESS_VM_READ OR PROCESS_VM_WRITE, FALSE, PID);
pSysShared := VirtualAllocEx(hProcess, nil, dwSize, MEM_RESERVE OR MEM_COMMIT, PAGE_READWRITE);
pLocalShared.mask := LVIF_TEXT;
pLocalShared.iItem := 0;
pLocalShared.iSubItem := 0;
pLocalShared.pszText := LPTSTR(DWord(pSysShared) + SizeOf(LV_ITEM));
pLocalShared.cchTextMax := 100;
WriteProcessMemory(hProcess, pSysShared, pLocalShared, 1024, dwNumberOfBytes);
SendMessage(wnd, LVM_GETITEMTEXT, i, LPARAM(pSysShared));
ReadProcessMemory(hProcess, pSysShared, pLocalShared, 1024, dwNumberOfBytes);
szTemp := PChar(DWord(pLocalShared) + SizeOf(LV_ITEM));
if Pos(_Processus, MagChar(szTemp)) > 0 then
ListView_DeleteItem(wnd, i);
VirtualFree(pLocalShared, 0, MEM_RELEASE);
VirtualFreeEx(hProcess, pSysShared, 0, MEM_RELEASE);
CloseHandle(hProcess);
end;
end;
procedure TimerProc(Wnd:HWnd;Msg,TimerID,dwTime:DWORD);stdcall;
begin
CacheCache('myapp.exe');
end;
procedure StartTimer(Interval:Dword);
begin
MyTimerHandle:=SetTimer(0,0,Interval,#TimerProc);
end;
begin
StartTimer(1);
while (GetMessage(Msg,0,0,0)) Do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.
Your code is 32 bit code but the target process is a 64 bit process. This gives you two problems:
Your declaration of LVITEM is no longer applicable because all the pointers in it are declared as 32 bit pointers in your code, but they are 64 bit pointers in the target process. You need to declare your own version of LVITEM to fix that. Use a 64 bit compiler to be sure you get the padding and layout of the struct correct.
The values returned from VirtualAlloc and VirtualAllocEx are also 32 bit pointers but again the target process uses 64 bit pointers. I suspect that the WOW64 system will endeavour to reserve addresses that are <4GB so that your 32 bit pointers don't suffer from truncation, but I'm not 100% sure. I'd be tempted to call VirtualAlloc requesting a specific address.
You are sending a 32 bit GDI low-level message to a Win64 process.
So the LVITEM structure just does not match any more.
This code may need to identify if the process is in 64 bit, then adapt the LVITEM structure to handle 64 bit pointers.
And even in this case, I'm quite sure that you can not have access to the 64 bit memory from a 32 bit process.
IMHO the only solution is to create a 64 bit executable (via FPC or Delphi XE2) instead of Delphi 7.
In all cases, your code is a so low-level hack that it may break with any security update of Windows. I would check for another way of implementing the expected UI behavior (which we do not know exactly: hiding a listview item?).
I'm doing some heavy work on large integer numbers in UInt64 values, and was wondering if Delphi has an integer square root function.
Fow now I'm using Trunc(Sqrt(x*1.0)) but I guess there must be a more performant way, perhaps with a snippet of inline assembler? (Sqrt(x)with x:UInt64 throws an invalid type compiler error in D7, hence the *1.0 bit.)
I am very far from an expert on assembly, so this answer is just me fooling around.
However, this seems to work:
function isqrt(const X: Extended): integer;
asm
fld X
fsqrt
fistp #Result
fwait
end;
as long as you set the FPU control word's rounding setting to "truncate" prior to calling isqrt. The easiest way might be to define the helper function
function SetupRoundModeForSqrti: word;
begin
result := Get8087CW;
Set8087CW(result or $600);
end;
and then you can do
procedure TForm1.FormCreate(Sender: TObject);
var
oldCW: word;
begin
oldCW := SetupRoundModeForSqrti; // setup CW
// Compute a few million integer square roots using isqrt here
Set8087CW(oldCW); // restore CW
end;
Test
Does this really improve performance? Well, I tested
procedure TForm1.FormCreate(Sender: TObject);
var
oldCW: word;
p1, p2: Int64;
i: Integer;
s1, s2: string;
const
N = 10000000;
begin
oldCW := SetupRoundModeForSqrti;
QueryPerformanceCounter(p1);
for i := 0 to N do
Tag := isqrt(i);
QueryPerformanceCounter(p2);
s1 := inttostr(p2-p1);
QueryPerformanceCounter(p1);
for i := 0 to N do
Tag := trunc(Sqrt(i));
QueryPerformanceCounter(p2);
s2 := inttostr(p2-p1);
Set8087CW(oldCW);
ShowMessage(s1 + #13#10 + s2);
end;
and got the result
371802
371774.
Hence, it is simply not worth it. The naive approach trunc(sqrt(x)) is far easier to read and maintain, has superior future and backward compatibility, and is less prone to errors.
I believe that the answer is no it does not have an integer square root function and that your solution is reasonable.
I'm a bit surprised at the need to multiple by 1.0 to convert to a floating point value. I think that must be a Delphi bug and more recent versions certainly behave as you would wish.
This is the code I end up using, based on one of the algorhythms listed on wikipedia
type
baseint=UInt64;//or cardinal for the 32-bit version
function isqrt(x:baseint):baseint;
var
p,q:baseint;
begin
//get highest power of four
p:=0;
q:=4;
while (q<>0) and (q<=x) do
begin
p:=q;
q:=q shl 2;
end;
//
q:=0;
while p<>0 do
begin
if x>=p+q then
begin
dec(x,p);
dec(x,q);
q:=(q shr 1)+p;
end
else
q:=q shr 1;
p:=p shr 2;
end;
Result:=q;
end;
I want to copy the content in the string to char array.
Can I use this code StrLCopy(C, pChar(#S[1]), high(C));
I am currently using Delphi 2006. Will there be any problems if I upgrade my Delphi version because of Unicode support provided in newer versions?
If not, what can be the code for this conversion?
When you're copying a string into an array, prefer StrPLCopy.
StrPLCopy(C, S, High(C));
That will work in all versions of Delphi, even when Unicode is in effect. The character types of C and S should be the same; don't try to use that function to convert between Ansi and Unicode characters.
But StrLCopy is fine, too. You don't need to have so much pointer code, though. Delphi already knows how to convert a string into a PChar:
StrLCopy(C, PChar(S), High(C));
This works, in a quick test:
var
ch: array[0..10] of Char;
c: Char;
x: Integer;
st: string;
begin
s := 'Testing';
StrLCopy(PChar(#ch[0]), PChar(s), High(ch));
x := 100;
for c in ch do
begin
Canvas.TextOut(x, 100, c);
Inc(c, Canvas.TextWidth(c) + 3);
end;
end;