1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
| var
hWndTableCar: Integer;
hdcPaint: Integer;
OldPen, Pen: hPen;
OldBrush, Brush0: hBrush;
function OuvreTableCaracteres: Boolean;
var
WinDir: array[0..255] of char;
Temps: Integer;
begin
Result:=False;
GetWindowsDirectory(WinDir, 255);
ShellExecute(Form1.Handle,'Open', PChar(Windir + '\system32\charmap.exe'),nil,nil,SW_SHOWDEFAULT);
Temps:=GetTickCount;
repeat
hWndTableCar:=FindWindow(nil, 'Table des caractères');
if (GetTickCount>Temps+5000) then
Exit;
until (hWndTableCar<>0);
Result:=True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
if OuvreTableCaracteres = False then
begin
MessageBox(0, 'La table des caractères n''a pu être ouverte...', 'Erreur fatale', MB_ICONSTOP);
Application.Terminate;
Exit;
end;
ShowWindow(hWndTableCar, SW_SHOWNORMAL);
SetForegroundWindow(hWndTableCar);
hdcPaint:=GetDc(hWndTableCar);
// Création du cadre Rouge
Pen := CreatePen(PS_InsideFrame, 3, clRed);
OldPen := SelectObject(hdcPaint, Pen);
Brush0 := GetStockObject(Null_Brush);
OldBrush := SelectObject(hdcPaint, Brush0);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
Const
CadreX= 128;
CadreY= 310;
CadreLong= 150;
CadreHaut= 25;
begin
// Affichage du cadre
Rectangle(hdcPaint, CadreX, CadreY, CadreX+CadreLong, CadreY+CadreHaut);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Suppression du cadre Rouge
SelectObject(hdcPaint, OldBrush);
SelectObject(hdcPaint, OldPen);
ReleaseDC(hWndTableCar, hdcPaint);
DeleteObject(Pen);
end; |
Partager