Test fontu – Delphi – Fórum – Programujte.com
 x   TIP: Přetáhni ikonu na hlavní panel pro připnutí webu
Reklama
Reklama

Test fontu – Delphi – Fórum – Programujte.comTest fontu – Delphi – Fórum – Programujte.com

 

Spuštěný nový filmový web Filmožrouti.cz — vše o Avengers, Pacific Rim, Thor, Star Wars…
oxidián0
Grafoman
19. 10. 2018   #1
-
0
-

Používám Delphi 7  

unit Testfnt;

//  Uc_heb - Hebrak 2.31

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls;
type
 tbarva = array[1..7,1..2] of integer;
  TFtestfont = class(TForm)
    Panel1: TPanel;
    Pfonttest: TPaintBox;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Timer1: TTimer; // obsluhován Timer1Timer
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    bila : tbarva;
    cerna : tbarva;
    testovanyfont: string;
    testch: char;
    function testujfont: boolean;

  public
    { Public declarations }
    function testujhebrew : boolean;
    function testujgreek : boolean;
  end;

var
  Ftestfont: TFtestfont;

implementation

{$R *.DFM}
function TFtestfont.testujfont: boolean;
var i : integer;
begin
 with pfonttest.canvas do
  begin
   with font do
    begin
     color  := clblack;
     name   := testovanyfont;
     pitch  := fpDefault;
     height := -80;
     style  := [];
    end;
  brush.color := clwhite;
  textout(0,0,testch);
  result := true;
  for i:=1 to 7 do
   begin
    if pixels[bila[i,1],bila[i,2]]<>16777215
          then result := false;
    if pixels[cerna[i,1],cerna[i,2]]<>0
          then result := false;
   end;
  end;
 end;

function TFtestfont.testujhebrew : boolean;
const bil:tbarva=((8,36),(20,36),(16,48),(9,47),(31,51),
        (10,26),(22,26));
      cer:tbarva=((3,26),(15,26),(30,29),(30,16),(6,50),
        (9,58),(26,53));
begin
  testovanyfont := 'Hebrew';
  testch        := 'v';
  bila          := bil;
  cerna         := cer;
  result        := testujfont;
end;

function TFtestfont.testujgreek : boolean;
const bil:tbarva=((2,34),(12,66),(18,65),(19,59),(12,60),
        (39,34),(40,27));
      cer:tbarva=((5,31),(25,15),(41,30),(16,63),(3,57),
        (27,59),(11,77));
begin
  testovanyfont := 'BwGrki';
  testch        :='y';
  bila          := bil;
  cerna         := cer;
  result        :=testujfont;
end;


procedure TFtestfont.Button1Click(Sender: TObject);
begin
  close;
end;

procedure TFtestfont.FormActivate(Sender: TObject);
var hbr,grk: boolean;
    kyd:string;
begin
kyd:=' Fonty '+
   'přibalené k programu je nutno nainstalovat '+
   'standardním postupem Windows. (Přečtěte si nápovědu uc_heb.htm, část instalace!)';
if testujhebrew then hbr:=true else hbr:=false;
if testujgreek then grk:=true else grk:=false;

if hbr and grk then
   begin
    label4.visible:=true;
    label2.visible:=false;
    timer1.enabled:=true;
    exit;
   end;
label1.visible := false;
label3.visible := false;
if (not hbr) and grk then
   begin
    label2.caption:=
        'Font Hebrew není v pořádku. Buď není nainstalován vůbec '
         +'nebo je nainstalována jeho jiná verze. Testy se nemusí '
         +'zobrazovat správně.'{+kyd+'Hebrew-OK).'};
    button1.visible:=true;
    label5.visible:=true;
    LABEL5.caption:=kyd{+'Hebrew - OK).'};
   end;
if  hbr and (not grk) then
   begin
    label2.caption:=
        'Font BwGrki není v pořádku. Buď není nainstalován vůbec '
         +'nebo je nainstalována jeho jiná verze. Testy se nemusí '
         +'zobrazovat správně.'{+kyd+ 'Bwgrki-OK).'};
    button1.visible:=true;
    label5.visible:=true;
    LABEL5.caption:=kyd+ 'Bwgrki - OK).';
   end;
if (not hbr) and  (not grk) then
   begin
    label2.caption:=
        'Fonty Hebrew a BwGrki nejsou v pořádku. Buď nejsou nainstalovány vůbec '
         +'nebo je nainstalována jejich jiná verze. Testy se nemusí '
         +'zobrazovat správně.'{+kyd+'Hebrew a Bwgrki-OK).'};
    button1.visible:=true;
    label5.visible:=true;
    LABEL5.caption:=kyd+ 'Hebrew a Bwgrki - OK).';
   end;
end;

procedure TFtestfont.Timer1Timer(Sender: TObject);
begin
  timer1.enabled:=false;
  close;
end;

end.

Tento kod má za úkol zjistit jestli jsou nainstalovány fonty BWGRKI.TTF a HEBREW.TTF.

Chci se zeptat, jak by se dal tento modul upravit

1) abych si mohl prohlédnout ve formuláři jak vypadá to co bylo nakteslené do TPaintBox?

2) Jak to upravit, aby se to co se vykreslilo uložilo do souboru? Přesněji: rád bych vytiskl jedno písmeno o velikosti např. 12px do obrázku např. greek.png

3) Provést načtení z tohoto obrázku (místo toho abych psal data ručně bych je chtěl načíst a porovnat automaticky.

Jde mi o to, že mám více fontů, asi tak 10 a jejich testování se mi nechce dělat takto ručně jak je to v kódu nastavováním nějakých pixelů:

const bil:tbarva=((2,34),(12,66),(18,65),(19,59),(12,60),
        (39,34),(40,27));
      cer:tbarva=((5,31),(25,15),(41,30),(16,63),(3,57),
        (27,59),(11,77));
Nahlásit jako SPAM
IP: 78.45.193.–
oxidián0
Grafoman
19. 10. 2018   #2
-
0
-

#1 oxidián
Já teď zjistil že seznam fontů je v Screen.Fonts takže ten kód nepotřebuju.

Nahlásit jako SPAM
IP: 78.45.193.–
Zjistit počet nových příspěvků

Přidej příspěvek

×Vložení zdrojáku

×Vložení obrázku

Vložit URL obrázku Vybrat obrázek na disku
Vlož URL adresu obrázku:
Klikni a vyber obrázek z počítače:

×Vložení videa

Aktuálně jsou podporována videa ze serverů YouTube, Vimeo a Dailymotion.
×
 
Podporujeme Gravatara.
Zadej URL adresu Avatara (40 x 40 px) nebo emailovou adresu pro použití Gravatara.
Email nikam neukládáme, po získání Gravatara je zahozen.
-
Pravidla pro psaní příspěvků, používej diakritiku. ENTER pro nový odstavec, SHIFT + ENTER pro nový řádek.
Sledovat nové příspěvky (pouze pro přihlášené)
Sleduj vlákno a v případě přidání nového příspěvku o tom budeš vědět mezi prvními.
Reaguješ na příspěvek:

Uživatelé prohlížející si toto vlákno

Uživatelé on-line: 0 registrovaných, 8 hostů

Podobná vlákna

Nastavení fontu — založil Filip Drahoš

Změna fontu v cmd okně — založil sachy

 

Hostujeme u Českého hostingu       ISSN 1801-1586       ⇡ Nahoru Webtea.cz logo © 20032018 Programujte.com
Zasadilo a pěstuje Webtea.cz, šéfredaktor Lukáš Churý