SAJAD_MIRZA
مهمون يكي دو روزه
Joined: 20 Dec 2005
Posts: 21
|
 Posted: Tue Dec 27, 2005 1:25 pm Post subject: فونت فارسی برای پاسکال |
 |
|
سلام
این برنامه عمل فارسی سازی محیط گرافیکی پاسکال را انجام میده . توضیح اینکه اولا اون ثابتی هایی که میبینید مال فونته که هر سطرش مال یه بلوک 8 در 16 هست.
مثلا (0,0,66,62,2,2,4,4,4,4,2,2,0,0,0,0) ماله یک بلوکه و هر عدد ماله هر سطر که مجموعا 16 سطر داریم و اگه عدد را به باینری تبدیل کنیم میبینیم که حالت پیکسلها رو مشخص میکنه .
اگه به تابع say مراجعه کنید بهتر متوجه میشید .
نکته دوم به کار گیری تابع say در برنامه است :
توضیح (say (x1,y1,c1,c2,size,a1 : این تابع یک حرف از الفبا یا عدد فارسی را با مشخصات داده شده برایمان در صفحه گرافیکی رسم میکند .
x1 : مختصات گوشه چپ
y1 : مختصات گوشه بالا
c1 : رنگ زمینه
c2 : رنگ قلم
size : اندازه قلم
a1 : کد اسکی حرف یا عدد مورد نظر
یکم توضیح اضافی اینکه اگه بخواهید یه متن با این برنامه روی صفحه نمایش قرار بدید *** جر خواهد خورد  پس ***رو کنار بذارید و یه تابع به برنامه اضافه کنید که بشه باهاش تابع say رو کنترل کرد و عمل تبدیل کاراکتر به کد اسکی همچنین چیدن کارکترها رو انجام بدهد.
نکته آخر اینکه size اینجوری تعریف شده که اگه 1 باشه بلوک 8 در 16 اگه دو باشه بلوک 16 در 32 اگه سه باشه بلوک 24 در 48 میشه و الی آخر پس موقع به کار بردن say برای ساخت یک کلمه حواستون جمع باشه.
اینم کد فارسی ساز:
| PROGRAM FarsiFnt;
USES
GRAPH;
const
char1:array[127..175,1..16] of byte=(
(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,16,40,40,16,0,0,0,0,0,0),
(0,0,16,16,16,16,8,8,8,4,4,4,0,0,0,0),
(0,0,62,64,64,64,32,32,32,16,16,16,0,0,0,0),
(0,0,74,74,116,64,32,32,32,16,16,16,0,0,0,0),
(0,0,6,8,16,16,12,8,16,32,34,28,0,0,0,0),
(0,0,0,16,24,36,66,129,129,145,110,0,0,0,0,0),
(0,0,66,62,2,2,4,4,4,4,2,2,0,0,0,0),
(0,0,66,66,66,34,36,36,20,24,24,16,0,0,0,0),
(0,0,8,24,24,20,36,36,34,66,66,66,0,0,0,0),
(0,0,28,34,34,34,30,2,2,2,2,2,0,0,0,0),
(0,0,0,0,0,12,24,24,24,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0,255,0,0,0,0,0,0,0),
(0,0,60,66,64,96,16,12,12,0,12,12,0,0,0,0),
(0,1,62,64,8,8,8,8,8,0,0,0,0,0,0,0),
(0,0,6,8,30,0,1,1,254,0,0,0,0,0,0,0),
(0,0,0,0,12,18,16,12,16,4,8,0,0,0,0,0),
(0,8,12,12,8,8,8,8,8,0,0,0,0,0,0,0),
(0,4,4,4,4,4,4,4,3,0,0,0,0,0,0,0),
(0,0,0,0,0,64,129,129,126,0,0,16,0,0,0,0),
(0,0,0,0,0,0,1,1,254,0,0,32,0,0,0,0),
(0,0,0,0,0,64,129,129,126,0,0,40,16,0,0,0),
(0,0,0,0,0,0,1,1,254,0,0,40,16,0,0,0),
(0,0,0,20,0,64,129,129,126,0,0,0,0,0,0,0),
(0,0,0,20,0,0,1,1,254,0,0,0,0,0,0,0),
(0,0,8,20,0,64,129,129,126,0,0,0,0,0,0,0),
(0,0,8,20,0,0,1,1,254,0,0,0,0,0,0,0),
(0,0,0,0,24,36,2,63,64,128,136,128,65,62,0,0),
(0,0,0,0,0,12,18,1,254,0,0,8,0,0,0,0),
(0,0,0,0,24,36,2,63,64,128,148,136,65,62,0,0),
(0,0,0,0,0,12,18,1,254,0,0,40,16,0,0,0),
(0,0,0,0,24,36,2,63,64,128,128,128,65,62,0,0),
(0,0,0,0,0,12,18,1,254,0,0,0,0,0,0,0),
(0,0,16,0,24,36,2,63,64,128,128,128,65,62,0,0),
(0,0,8,0,0,12,18,1,254,0,0,0,0,0,0,0),
(0,0,0,0,4,2,1,33,62,0,0,0,0,0,0,0),
(0,0,16,0,4,2,1,33,62,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,1,1,1,2,36,24,0,0,0),
(0,0,0,2,0,0,0,1,1,1,2,36,24,0,0,0),
(0,0,2,5,0,0,0,1,1,1,2,36,24,0,0,0),
(0,0,0,0,0,0,21,21,143,136,132,132,120,0,0,0),
(0,0,0,0,0,0,37,45,210,0,0,0,0,0,0,0),
(0,2,5,0,0,0,21,21,143,136,132,132,120,0,0,0),
(0,4,10,0,0,0,37,45,210,0,0,0,0,0,0,0),
(0,0,0,0,0,2,5,41,158,136,132,132,120,0,0,0),
(0,0,0,0,0,6,41,49,254,0,0,0,0,0,0,0),
(0,0,2,0,0,2,5,41,158,136,132,132,120,0,0,0),
(0,4,0,0,0,6,41,49,254,0,0,0,0,0,0,0),
(0,32,32,32,32,38,41,49,254,0,0,0,0,0,0,0)
);
char2:array[224..254,1..16] of byte=(
(0,0,36,32,32,38,41,49,254,0,0,0,0,0,0,0),
(0,0,0,12,18,16,8,62,64,128,128,128,66,60,0,0),
(0,0,0,0,14,18,12,19,32,64,64,64,33,30,0,0),
(0,0,0,0,0,28,36,24,231,0,0,0,0,0,0,0),
(0,0,0,0,6,9,16,8,255,0,0,0,0,0,0,0),
(0,8,0,12,18,16,8,62,64,128,128,128,66,60,0,0),
(0,4,0,0,14,18,12,19,32,64,64,64,33,30,0,0),
(0,0,8,0,0,28,36,24,231,0,0,0,0,0,0,0),
(0,4,0,0,6,9,16,8,255,0,0,0,0,0,0,0),
(0,4,0,0,6,73,137,133,126,0,0,0,0,0,0,0),
(0,4,0,0,6,9,9,5,254,0,0,0,0,0,0,0),
(0,0,10,0,0,2,5,37,67,65,65,34,28,0,0,0),
(0,10,0,0,6,9,9,5,254,0,0,0,0,0,0,0),
(0,6,8,16,16,14,65,129,126,0,0,0,0,0,0,0),
(0,6,8,16,16,14,1,1,254,0,0,0,0,0,0,0),
(0,38,72,16,16,14,65,129,126,0,0,0,0,0,0,0),
(0,38,72,16,16,14,1,1,254,0,0,0,0,0,0,0),
(0,1,1,1,1,1,1,65,129,129,129,66,60,0,0,0),
(0,33,33,33,17,9,9,7,30,0,0,0,0,0,0,0),
(0,1,1,1,1,1,1,1,254,0,0,0,0,0,0,0),
(0,0,0,0,14,17,17,62,64,64,32,32,16,16,16,16),
(0,0,0,0,0,14,17,41,198,0,0,0,0,0,0,0),
(0,0,0,8,0,0,0,33,65,65,65,34,28,0,0,0),
(0,0,0,8,0,0,1,1,254,0,0,0,0,0,0,0),
(0,0,0,0,0,6,9,9,7,1,2,68,56,0,0,0),
(0,0,0,0,12,18,17,17,14,0,0,0,0,0,0,0),
(0,0,0,0,0,28,36,40,243,36,18,14,0,0,0,0),
(0,0,0,8,28,38,37,25,246,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0,7,72,140,130,130,124,0,0),
(0,0,0,0,0,6,72,140,130,130,124,0,0,0,0,0),
(0,0,0,0,0,0,1,1,254,0,0,40,0,0,0,0)
);
function say (x1,y1,c1,c2,size,a1:integer):integer;
var t,u,x,y,a,b,c,d,e,f,g:integer;
s:array [1..8] of boolean;
begin
for a:= 1 to 16 do
begin
if (a1>=127) and (a1<=175) then b:=char1[a1,a];
if (a1>=224) and (a1<=254) then b:=char2[a1,a];
y:=y1+(a-1)*size;
t:=size;
repeat
c:=b mod 2;
s[9-(t div size) ]:=false;
if c=1 then s[9-(t div size)]:=true;
b:=b div 2;
t:=t+size;
until t>8*size;
t:=size;
repeat
if s[t div size]=true then
begin
setcolor(c1);
RECTANGLE(x1+(t-size),y,x1+t,y+size);
SETFILLSTYLE(1,c1);
FLOODFILL(x1+(t-size)+1,y+1,c1);
end
else
begin
setcolor(c2);
RECTANGLE(x1+(t-size),y,x1+t,y+size);
SETFILLSTYLE(1,c2);
FLOODFILL(x1+(t-size)+1,y+1,c2);
end;
t:=t+size;
until t>8*size;
end;
end;
VAR
DM,GM,x,y,a:integer;
BEGIN
DM:=DETECT;
INITGRAPH(DM,GM,'');
x:=0;
y:=0;
for a:=127 to 175 do
begin
inc(x,25);
if x>575 then
begin
inc(y,30);
x:= 0;
end;
say(x,y,10,0,2,a);
end;
for a:=225 to 254 do
begin
inc(x,25);
if x>575 then
begin
inc(y,30);
x:= 0;
end;
say(x,y,10,0,2,a);
end;
readln;
END. |
______________________________________________________
اين پست توسط مدير سايت جهت رعايت موارد ادبي ويرايش شده است . |
|
Profile 
Log in to check your private messages | 
FAQ 
Search 
Memberlist 
Usergroups 
Log in
Register
