Re: Bullets?

Return to index

Author

Message

Frank de Groot

Posted: 06/24/2002 14:54:52

This works fine for fonts with and without bullets!

Frank de Groot

var

// not the exact font names, but strings that occur in non-bullet fontnames

NonBulletFonts: array[0..17] of string = ('Times New Roman', // only newest

version has bullet

'Vacation',

'Webdings', // 1, 2 & 3

'Wingdings',

'WST_', // everything that starts with WST_

'MS Serif',

'MS Sans Serif',

'MS Outlook',

'Simhei', // both with and without @ prepended

'Terminal',

'Symbol',

'Arial Narrow Special',

'Arial Special', // G1 & G2

'Raize',

'Default',

'System',

'FixedSys',

'Monotype'); // several versions

procedure TXHLPRichEdit.Bullet;

var

oldFontName: string;

oldFontSize: Integer;

begin

{ Quite a lot of high-tech stuff to make a bullet, but it's neccessary and

still not perfect.

The bullet will be in the style of the currently selected font when sending

the UNICODE bullet to it.

For fonts that do not have bullets, we use WingDings.

But... Inserting Wingdings does not work always, when inside pasted text

from other apps

(probably due to certain attributes that get pasted, this is another reason

why UNICODE is the preferred method.

It is still possible to get a 'failed' bullet, in pasted text that has

protected attributes and is in

a font that does not support bullets. }

if SupportsBullets(FontName) then

SendUnicode('0149') // this is a bullet in UNICODE, and the only way to

enter it universally is simulating ALTGR NUMPAD entry...

else

begin

oldFontName := FontName;

oldFontSize := FontSize;

FontName := 'WingDings';

ApplyStyleConversion(F_APPLYFONTNAME);

FontSize := Trunc(FontSize * 0.8); // make the bullet an appropriate size

if FontSize < 6 then

FontSize := 6; // minimum usable fontsize

ApplyStyleConversion(F_APPLYFONTSIZE);

// this may still fail in very rare occasion (protected pasted text with

font that doen not support bullets)

InsertText('l'); // bullet in WingDings

FontSize := oldFontSize;

ApplyStyleConversion(F_APPLYFONTSIZE);

FontName := oldFontName;

ApplyStyleConversion(F_APPLYFONTNAME);

FontName := oldFontName;

end;

end;

// some fonts do not contain a character for 'bullet', we need to know so we

can use Wingdings...

function TXHLPRichEdit.SupportsBullets(fontNameStr: string): Boolean;

var

i: Integer;

begin

Result := TRUE;

for i := 0 to Length(NonBulletFonts) - 1 do

if Pos(UpperCase(NonBulletFonts[i]), UpperCase(fontNameStr)) > 0 then

begin

Result := FALSE;

exit;

end;

end;

procedure TXHLPRichEdit.SendUnicode(aStr: string);

var

i: Integer;

key: Byte;

begin

SendingUnicode := TRUE; // block own keypress handler, otherwise it will

process the simulated keystrokes!

// when called via CTRL+B, the rest of the code will not work while CTRL is

down, so fool windows into thinking that it's released...

keybd_event(VK_CONTROL, MapvirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0);

// press ALT GR (do not use RMENU, does not work in keybd_event)

keybd_event(VK_MENU, MapVirtualKey(VK_MENU, 0), 0, 0);

// send key sequence to focused control by simulating keypresses (only thing

that really always works!)

for i := 1 to Length(aStr) do

begin

Key := VK_NUMPAD0 + Ord(aStr[i]) - Ord('0');

keybd_event(key, MapvirtualKey(key, 0), 0, 0);

keybd_event(key, MapvirtualKey(key, 0), KEYEVENTF_KEYUP, 0);

end;

// release ALT

keybd_event(VK_MENU, MapVirtualKey(VK_MENU, 0), KEYEVENTF_KEYUP, 0);

// when the CTRL key was down, and we fooled Windows into thinking it was

up, it stays down forever if we don't put it back...

if GetKeyState(VK_CONTROL) < 0 then

keybd_event(VK_CONTROL, MapvirtualKey(VK_CONTROL, 0), 0, 0);

SendingUnicode := FALSE;

end;