{ GUTENBERG-DRUCKER ist Teil des Programmpakets } { zum Drucken von NLQ und anderen Schriften auf } { EPSON-kompatiblen Druckern. } { Hierzu geh”rt auch FONT.PRG zum editieren der } { Zeichens„tze } { GUTENBERG (c) Juli 1986 by MKB-Soft M.Baldauf } { } { letzte Žnderung am : 16.04.1987 } { } { ** VERSION 1.1 4/87 ** } { Jetzt noch 70 kByte des Speichers fr eventuelle Malloc-Aufrufe freigeben } {$U70} { und schon kann das Programm beginnen } program GUTENBERG_DRUCKER; { Zuerst sind die Konstanten dran, nur wenige } CONST mu_mesag = 16; mu_button = 2; {$I GUTENBERG.I} { Nach den Konstanten kommen bekannterweise die Typen dran } TYPE in_type = ARRAY[0..10] OF integer; out_type = ARRAY[0..99] OF integer; stringtyp = PACKED ARRAY[1..21] OF char; nulldrei = ARRAY[0..3] OF integer; mgbuftyp = ARRAY[0..7] OF integer; text_type = PACKED ARRAY [0..39] OF char; pxy_type = ARRAY[0..7] OF integer; grect = RECORD { Dieser RECORD wird zur Fenster-Restaurierung - } g_x:integer; { gebraucht } g_y:integer; g_w:integer; g_h:integer; END; ted1 = PACKED RECORD { Wichtig zur Object-Behandlung } te_ptext:long_integer; te_ptmplt:long_integer; te_pvalid:long_integer; te_font:integer; te_junk1:integer; te_just:integer; te_color:integer; te_junk2:integer; te_thickness:integer; te_txtlen:integer; te_tmplen:integer END; tedinfo = RECORD { Wichtig zur Object-Behandlung } CASE boolean OF FALSE: (ted_tree:long_integer); TRUE : (p_ted:^ted1) END; ob1 = PACKED RECORD { Wichtig zur Object-Behandlung } ob_next:integer; ob_head:integer; ob_tail:integer; ob_type:integer; ob_flags:integer; ob_state:integer; ob_spec:long_integer; ob_x:integer; ob_y:integer; ob_width:integer; ob_height:integer END; object_typ = RECORD { Wichtig zur Object-Behandlung } CASE boolean OF FALSE: (object_tree:long_integer); TRUE : (p_obj:^ob1) END; copy_type = RECORD { Dies brauchen wir fr das Block-Copy } address:long_integer; wort:array[2..9] of integer; END; fs_type = PACKED ARRAY [1..39] OF char; ch_type = PACKED ARRAY [1..150] OF char; str_type = packed array [1..14] of char; { Nun folgt die Deklaratione der vielen n”tigen Variablen } VAR handle,w_handle,dummy:integer; druck_zeile : ARRAY [1..10] OF string; xdesk,ydesk,wdesk,hdesk:integer; mausx,mausy,ready:integer; modus:integer; l_intin:in_type; l_out :out_type; mgbuf:mgbuftyp; menu_tree:long_integer; fs_iexbutton:boolean; fs_iinpath,fs_iinsel:fs_type; f_iinpath,f_iinsel:fs_type; obj_tree:long_integer; laenge:integer; a:char; fil:text; i:integer; str:string; dateiname:string; pxy:pxy_type; sourc,dest:copy_type; screen_sourc,screen_dest:long_integer; select : integer; select_x,select_y:integer; esc:char; font: ARRAY[1..250,1..13] OF long_integer; font_pr : ARRAY[1..2,1..250,1..13] OF integer; prop:integer; pr_init,pr_vor_halb,pr_vor_acht,pr_vor_norm, pr_hrg_norm,pr_hrg_dopp,pr_vor_wahl:string[10]; pr_vor_halb_nl, pr_zur_halb_nl:string[10]; nl_10:integer; druck:integer; stand:integer; small:integer; rand:integer; zsz:integer; st:integer; seit:integer; potenz : array[0..15] of long_integer; potenz_w : array[0..7] of integer; pap_len,pap_tof,pap_head,pap_foot,pap_bof,pap_breit:integer; kopf_left,kopf_mid,kopf_right:string; fuss_left,fuss_mid,fuss_right:string; { Eine Menge Prozedur-Deklarationen fr GEM- und Systemaufrufe } procedure vro_cpyfm(handle,mode:integer;var xy:pxy_type; var sourc,dest:copy_type); C; procedure appl_init; C; procedure appl_exit; C; procedure rsrc_free; C; function graf_handle(var gl_wchar,gl_hchar,gl_wbox,gl_hbox:integer):integer; C; function wind_create(wtype,w1,w2,w3,w4:integer):integer; C; function evnt_multi(t,i0,i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12:integer; var mgbuf:mgbuftyp; j1,j2:integer; var k1,k2,k3,k4,k5,k6:integer):integer; C; procedure v_opnvwk(var wi:in_type; var handle:integer; var wo:out_type); C; procedure graf_mouse(i:integer); C; procedure wind_get(i,j:integer; var x,y,w,h:integer); C; procedure wind_calc(i,wtype,w1,w2,w3,w4:integer; var j,k,l,m: integer); C; procedure v_gtext(handle,k,l:integer;var t:string); C; procedure wind_open(handle,w1,w2,w3,w4:integer); C; procedure v_clsvwk(handle:integer); C; procedure wind_close(handle:integer); C; procedure wind_delete(handle:integer); C; procedure vsf_interior(handle,i:integer); C; procedure vsf_color(handle,i:integer); C; procedure vswr_mode(handle,i:integer); C; procedure evnt_button(i,j,k:integer; var mausx,mausy,l,m:integer); C; procedure vs_clip(handle,i:integer; var t:nulldrei); C; procedure v_bar(handle:integer; var t:nulldrei); C; procedure graf_growbox(i,j,k,l,m1,m2,m3,m4:integer); C; procedure graf_shrinkbox(i,j,k,l,m1,m2,m3,m4:integer); C; procedure vsf_style(handle,i:integer); C; function rsrc_load(var title:stringtyp):integer; C; function rsrc_gaddr(i,j:integer; var menu_tree:long_integer):integer; C; procedure menu_bar(m:long_integer; k:integer); C; procedure menu_tnormal(m:long_integer; k,l:integer); C; function form_alert(i:integer; var l:ch_type):integer; C; procedure form_dial(i,j,k,l,m,m1,m2,m3,m4:integer); C; procedure form_center(i:long_integer; var m1,m2,m3,m4:integer); C; procedure objc_change(i:long_integer; j,l,m1,m2,m3,m4,m,k:integer); C; function form_do(i:long_integer; m:integer):integer; C; procedure objc_draw(i:long_integer; k,j,m1,m2,m3,m4:integer); C; function rc_intersect(var i,j:grect):integer; C; procedure wind_update(i:integer); C; function fsel_input(var pfad1:fs_type; var filename1:fs_type; var button1:boolean):boolean; C; procedure menu_ienable(m_tree:long_integer; m_item,m_enable:integer); C; procedure menu_icheck(m_tree:long_integer; m_item,m_check:integer); C; function getrez:integer; xbios(4); function logbase:long_integer; xbios(3); function malloc(size:long_integer):long_integer; gemdos($48); function fopen(var name:str_type; i:integer):integer; gemdos($3d); procedure fclose(handle:integer); gemdos($3e); function fread(hande:integer; count,buf:long_integer):integer; gemdos($3f); {********************* ** Peek und Poke ** *********************} function peek(adr:long_integer):byte; type word = packed record w:byte end; var ptr:record case boolean of false:(i:long_integer); true :(p:^word) end; begin ptr.i := adr; peek := ptr.p^.w end; procedure poke(adr:long_integer;val:byte); type word = packed record w:byte end; var ptr:record case boolean of false:(i:long_integer); true :(p:^word) end; begin ptr.i := adr; ptr.p^.w := val end; {*************************************************** ** Wandlung einer INTEGER-Zahl in einen String ** ***************************************************} procedure itoa(n:integer); {liefert Ergebnis in 'str' zurueck} var i,j,sign,n1:integer; st:string; begin sign := n; if sign < 0 then n := -n; i := 0; st := ''; str := ''; repeat i := i + 1; n1 := n-(trunc(n/10)*10); st := concat(st,chr(48+n1)); n := trunc(n/10); until n <= 0; if sign < 0 then st := concat(st,'-'); j := length(st); for i := 1 to j do begin str := concat(str,st[j]); j := j - 1; end; end; {**************************************** ** Objecttext holen ** ****************************************} PROCEDURE get_text(baum,index:integer;VAR text:string); VAR adress,text_tree:long_integer; object:object_typ; ted_info:tedinfo; text_len,i:integer; i1:integer; BEGIN dummy:=rsrc_gaddr(0,baum,adress); object.object_tree:=adress+index*24; ted_info.ted_tree:=object.p_obj^.ob_spec; text_tree:=ted_info.p_ted^.te_ptext; text_len:=ted_info.p_ted^.te_tmplen-2; text:=''; for i:=0 TO text_len DO text:=concat(text,chr(peek(text_tree+i))); if text[1]='@' then text:='' else begin i1:=1;text:=''; loop exit if (text[i1]=chr(0)) or ((i1>=text_len-2) and (text[i1]=' ')); text:=concat(text,text[i1]); i1:=i1+1; end; end; END; {**************************************** ** Objecttext setzen ** ****************************************} PROCEDURE set_text(baum,index:integer;text:string); VAR adress,text_tree:long_integer; object:object_typ; ted_info:tedinfo; text_len,i:integer; BEGIN dummy:=rsrc_gaddr(0,baum,adress); object.object_tree:=adress+index*24; ted_info.ted_tree:=object.p_obj^.ob_spec; text_tree:=ted_info.p_ted^.te_ptext; text_len:=ted_info.p_ted^.te_txtlen-2; text:=''; FOR i:=0 TO text_len DO poke(text_tree+i,ord(text[i+1])); END; {**************************************** ** Objectstatus holen ** ****************************************} FUNCTION get_state(baum,index:integer):integer; var object:object_typ; error:integer; address:long_integer; begin error := rsrc_gaddr(0,baum,address); object.object_tree := address + index*24; get_state := object.p_obj^.ob_state; end; {************************************************** ** Wandlung eines Strings in eine INTEGER-Zahl ** **************************************************} function atoi(s:string):integer; var i,n:integer; begin n := 0; i := 1; while ((s[i] >= '0') and (s[i] <= '9')) do begin n := 10*n + (ord(s[i])-48); i := i+1; end; atoi := n; end; {******************************************************* ** Titelbild wird in den Bildschirm-Puffer geladen ** *******************************************************} procedure load_pic; var i:integer; f_handle:integer; pstr:str_type; begin pstr := 'GUTENBER.PIC '; pstr[13] := chr(0); f_handle := fopen(pstr,0); if f_handle > 0 then begin i := fread(f_handle,32000,screen_dest); fclose(f_handle); end; end; {********************************************************** ** Wandlung eines Strings in ein PACKED ARRAY OF CHAR ** **********************************************************} procedure str_to_char(str:string; var pa:ch_type); var i,len:integer; begin len := length(str); for i := 1 to len do pa[i] := str[i]; pa[len+1] := chr(0); end; {**************************************** ** und das Ganze auch mal umgekehrt ** ****************************************} procedure char_to_str(pa:fs_type; var str:string); var i:integer; begin str := ''; i := 1; while pa[i] <> chr(0) do begin str := concat(str,pa[i]); i := i + 1; end; end; {******************************************************************* ** Kopieren eines Blocks vom SOURC- nach dem DESTINATION-SCREEN ** *******************************************************************} procedure sourc_dest(x,y,w,h:integer); var i : integer; begin hide_mouse; pxy[0] := x; pxy[1] := y; pxy[2] := x+w; pxy[3] := y+h; for i := 4 to 7 do pxy[i] := pxy[i-4]; vro_cpyfm(handle,3,pxy,sourc,dest); show_mouse; end; {**************************************** ** und das Ganze auch mal umgekehrt ** ****************************************} procedure dest_sourc(x,y,w,h:integer); var i : integer; begin hide_mouse; pxy[0] := x; pxy[1] := y; pxy[2] := x+w; pxy[3] := y+h; for i := 4 to 7 do pxy[i] := pxy[i-4]; vro_cpyfm(handle,3,pxy,dest,sourc); show_mouse; end; {********************************************* ** Zwei Prozeduren zur Object-Behandlung ** *********************************************} procedure desel_obj(tree:long_integer; which:integer); BEGIN objc_change(tree,which,0,xdesk,ydesk,wdesk,hdesk,0,1); END; procedure sel_obj(tree:long_integer; which:integer); BEGIN objc_change(tree,which,0,xdesk,ydesk,wdesk,hdesk,1,1); END; {*********************************************************************** ** vor dem Programmstart gibt es auch eine Menge zu initialisieren ** ***********************************************************************} procedure init; var i,n,l,x,y,error:integer; tree:long_integer; fil:text; function getdrv:integer;gemdos($19); begin menu_ienable(menu_tree, PRINTFIL,0); hide_mouse; fs_iinpath := 'A:\*.ZSZ '; { 39 char } fs_iinpath[9] := chr(0); fs_iinsel := ' '; { 39 char } fs_iinsel[1] := chr(0); f_iinpath := 'A:\*.DOC '; { 39 char } f_iinpath[9] := chr(0); f_iinsel := ' '; { 39 char } f_iinsel[1] := chr(0); f_iinpath[1] := chr(getdrv+1+64); fs_iinpath[1] := chr(getdrv+1+64); sourc.address := screen_sourc; dest.address := screen_dest; sourc.wort[2] := 640; sourc.wort[3] := 400; sourc.wort[4] := 40; sourc.wort[5] := 0; sourc.wort[6] := 1; sourc.wort[7] := 0; sourc.wort[8] := 0; sourc.wort[9] := 0; for i := 2 to 9 do dest.wort[i] := sourc.wort[i]; {##############################################################################} {Druckertreiber} pr_init := concat(chr(27),chr(64)); { Drucker-Initialisierung } pr_vor_halb := concat(chr(27),chr(51),chr(1)); { Vorschub auf 1/144 Inch } pr_vor_wahl := concat(chr(27),chr(65),chr(11)); { Vorschub auf 11/72 Inch } pr_vor_acht := concat(chr(27),chr(65),chr(8)); { Vorschub auf 8/72 Inch } pr_hrg_dopp := concat(chr(27),chr(76)); { Graphik doppelte Dichte } pr_hrg_norm := concat(chr(27),chr(75)); { Graphik einfache Dichte } pr_vor_norm := concat(chr(27),chr(50)); { Vorschub 1/6 Inch } { Folgendes nur fr ** NL-10 ** } pr_vor_halb_nl := concat(chr(27),chr(51),chr(2));{ Vorschub auf 2/216 Inch } pr_zur_halb_nl := concat(chr(27),chr(106),chr(4));{ 4/216 Inch zurck } {Druckertreiber bis hierher} {##############################################################################} druck := 1 ; { Voreinstellung Druck-Art auf NLQ } prop := 0 ; { Voreinstellung keine Proportionalschrift } stand := 1 ; small := 1 ; rand := 8 ; { Voreinstellung Rand auf 8 } zsz := 0 ; { kein Zeichensatz compiliert } st := 1; { 1st Word } nl_10 := 1; { NL-10 Drucker ausgew„hlt } { Nachschauen ob Standard-Einstellung auf Diskette } reset(fil,'GUTENBER.INF'); if not eof(fil) then begin readln(fil,st); { Textart } readln(fil,prop); { Proportional } readln(fil,nl_10); { Druckertyp } readln(fil,druck); { Druck-Art } readln(fil,small); { NLQ-Art } readln(fil,stand); { Standard-Art } close(fil); end; { Alle Einstellungen vornehmen } if small = 1 then begin menu_icheck(menu_tree,NLQNORM,1); menu_icheck(menu_tree,NLQBREIT,0); end else begin menu_icheck(menu_tree,NLQNORM,0); menu_icheck(menu_tree,NLQBREIT,1); end; if stand = 3 then begin menu_icheck(menu_tree,STANDHER,1); menu_icheck(menu_tree,STANDSCH,0); menu_icheck(menu_tree,STANDNOR,0); end; if stand = 2 then begin menu_icheck(menu_tree,STANDHER,0); menu_icheck(menu_tree,STANDSCH,1); menu_icheck(menu_tree,STANDNOR,0); end; if stand = 1 then begin menu_icheck(menu_tree,STANDHER,0); menu_icheck(menu_tree,STANDSCH,0); menu_icheck(menu_tree,STANDNOR,1); end; if druck = 1 then begin menu_icheck(menu_tree,NORMAL,0); menu_icheck(menu_tree,NLQ,1); menu_ienable(menu_tree, NLQBREIT,1); menu_ienable(menu_tree, NLQNORM,1); menu_ienable(menu_tree, STANDHER,0); menu_ienable(menu_tree, STANDSCH,0); menu_ienable(menu_tree, STANDNOR,0); end else begin menu_icheck(menu_tree,NORMAL,1); menu_icheck(menu_tree,NLQ,0); menu_ienable(menu_tree, NLQBREIT,0); menu_ienable(menu_tree, NLQNORM,0); menu_ienable(menu_tree, STANDHER,1); menu_ienable(menu_tree, STANDSCH,1); menu_ienable(menu_tree, STANDNOR,1); end; if prop = 1 then menu_icheck(menu_tree,PROPORT,1) else menu_icheck(menu_tree,PROPORT,0); error := rsrc_gaddr(0, PRINTER, tree); if nl_10 = 1 then sel_obj(tree,NL10) else sel_obj(tree,GEMINI); if st = 1 then { 1st-Word } begin menu_icheck(menu_tree,STWORD,1); menu_icheck(menu_tree,ASCII,0); menu_icheck(menu_tree,TEXTOMAT,0); end; if st = -1 then { ASCII-Texte } begin menu_icheck(menu_tree,STWORD,0); menu_icheck(menu_tree,ASCII,1); menu_icheck(menu_tree,TEXTOMAT,0); end; if st = 0 then { Textomat } begin menu_icheck(menu_tree,STWORD,0); menu_icheck(menu_tree,ASCII,0); menu_icheck(menu_tree,TEXTOMAT,1); end; seit := 1; { Voreinstellung Seitenz„hler } itoa(seit); if length(str)<2 then str := concat(str,chr(0)); set_text(DRUCKE, SEITE,str); itoa(rand); if length(str)<2 then str := concat(str,chr(0)); set_text(DRUCKE, DRUCKRND,str); potenz[0] := 1; potenz[1] := 2; potenz[2] := 4; potenz[3] := 8; potenz[4] := 16; potenz[5] := 32; potenz[6] := 64; potenz[7] := 128; potenz[8] := 256; potenz[9] := 512; potenz[10] := 1024; potenz[11] := 2048; potenz[12] := 4096; potenz[13] := 8192; potenz[14] := 16384; potenz[15] := 32768; potenz_w[0] := 1; potenz_w[1] := 2; potenz_w[2] := 4; potenz_w[3] := 8; potenz_w[4] := 16; potenz_w[5] := 32; potenz_w[6] := 64; potenz_w[7] := 128; end; {************************************************* ** Diverse Prozeduren zur Window-Darstellung ** *************************************************} procedure set_clip(x,y,w,h:integer); var clip:nulldrei; begin clip[0] := x; clip[1] := y; clip[2] := x+w; clip[3] := y+h; vs_clip(handle,1,clip); end; procedure clear_window; var clip:nulldrei; begin hide_mouse; clip[0] := xdesk; clip[1] := ydesk; clip[2] := xdesk+wdesk; clip[3] := ydesk+hdesk; vsf_color(handle,0); vsf_interior(handle,1); v_bar(handle,clip); show_mouse; end; procedure open_work; var i,gr_1,gr_2,gr_3,gr_4:integer; begin appl_init; handle := graf_handle(gr_1,gr_2,gr_3,gr_4); for i:=0 to 9 do l_intin[i] := 1; l_intin[10] := 2; v_opnvwk(l_intin, handle, l_out); end; procedure close_window; begin menu_bar(menu_tree,0); rsrc_free; wind_close(w_handle); graf_shrinkbox(xdesk+wdesk DIV 2,ydesk+hdesk DIV 2, 0,0,xdesk,ydesk,wdesk,hdesk); wind_delete(w_handle); v_clsvwk(handle); appl_exit; end; procedure open_window; type titletyp = packed array[1..22] of char; var wi_title:titletyp; wi_kind:integer; procedure wind_set(x,i:integer;var title:titletyp;j,k:integer); C; begin wi_kind := 1; (* Namenszeile *) hide_mouse; wind_get(0,4,xdesk,ydesk,wdesk,hdesk); w_handle := wind_create(wi_kind,xdesk,ydesk,wdesk,hdesk); wi_title := ' GUTENBERG - DRUCKER '; wi_title[22] := chr(0); wind_set(w_handle,2,wi_title,0,0); graf_growbox(xdesk+wdesk DIV 2,ydesk+hdesk DIV 2, 0,0,xdesk,ydesk,wdesk,hdesk); clear_window; wind_open(w_handle,xdesk,ydesk,wdesk,hdesk); init; wind_get(w_handle,4,xdesk,ydesk,wdesk,hdesk); dest_sourc(xdesk,ydesk,wdesk,hdesk); show_mouse; end; {************************************************** ** auch ALERT-BOXEN werden manchmal gebraucht ** **************************************************} function alert(art:integer; text:string):integer; var al_txt:ch_type; begin str_to_char(text,al_txt); alert := form_alert(art,al_txt); end; {******************************************************** ** eine Resource-Datei will auch mal geladen werden ** ********************************************************} function load_rsc:integer; var error:integer; title:stringtyp; begin load_rsc := 0; title := 'GUTENBER.RSC '; title[13] := chr(0); error := rsrc_load(title); if error = 0 then begin graf_mouse(0); str:='[1][Raubkopierer, was?|Ohne .RSC l„uft das|Programm nicht.][ PECH ]'; ready:=alert(1,str); load_rsc := 1; end; error := rsrc_gaddr(0,0,menu_tree); if error = 0 then begin graf_mouse(0); str:='[1][Es ist ein Fehler|mit dem .RSC-File|aufgetreten !!][ SCHADE ]'; ready:=alert(1,str); load_rsc := 1; end; end; {********************************************** ** Diese Function stellt Dialog-Boxen dar ** **********************************************} function hndl_dial(tree:long_integer; def, x,y,w,h:integer):integer; VAR obj,xdial,ydial,wdial,hdial:integer; BEGIN form_center(tree, xdial,ydial,wdial,hdial); sourc_dest(xdial,ydial,wdial,hdial); form_dial(0,x,y,w,h,xdial,ydial,wdial,hdial); objc_draw(tree,0,30,xdial,ydial,wdial,hdial); obj := form_do(tree,def); hndl_dial := obj; form_dial(3,x,y,w,h,xdial,ydial,wdial,hdial); desel_obj(tree,obj); dest_sourc(xdial,ydial,wdial,hdial); END; {****************************************** ** auch der Autor will genannt werden ** ******************************************} procedure about_prg; var tree:long_integer; error,obj:integer; begin error := rsrc_gaddr(0, UEBER, tree); obj := hndl_dial(tree,0,320,200,1,1); end; {********************************************* ** Welchen Drucker haben Sie doch gleich ? ** *********************************************} procedure sel_printer_type; var tree:long_integer; error,obj,stat:integer; begin error := rsrc_gaddr(0, PRINTER, tree); obj := hndl_dial(tree,0,320,200,1,1); stat := get_state(PRINTER,NL10); if stat = 0 then nl_10 := 0 else nl_10 := 1; end; {***************************************************************** ** Eine Steuerung einer File-Select-Box ist auch interessant ** *****************************************************************} procedure show_file(mode:integer; iinsel,iinpath:fs_type); var ende:boolean; tree:long_integer; xdial,ydial,wdial,hdial:integer; error,i:integer; fn:fs_type; function setdrv(drv:integer):integer;gemdos($0e); function chdir(var fn:fs_type):integer; gemdos($3b); begin xdial := 100; ydial := 50; wdial := 400; hdial := 330; sourc_dest(xdial,ydial,wdial,hdial); ende := fsel_input(iinpath, iinsel, fs_iexbutton); if fs_iexbutton = TRUE then begin char_to_str(iinsel,str); dateiname := str; if mode = 1 then begin fs_iinpath := iinpath; fs_iinsel := iinsel; error := setdrv(ord(fs_iinpath[1])-64-1); end else begin f_iinpath := iinpath; f_iinsel := iinsel; error := setdrv(ord(f_iinpath[1])-64-1); end; fn:=('\\ '); fn[3]:=chr(0); error:=chdir(fn); i:=3; if mode = 1 then begin while fs_iinpath[i]<>'*' do begin fn[i-2]:=fs_iinpath[i]; i:=i+1; end; end else begin while f_iinpath[i]<>'*' do begin fn[i-2]:=f_iinpath[i]; i:=i+1; end; end; fn[i-2]:=chr(0); error:=chdir(fn); end; dest_sourc(xdial,ydial,wdial,hdial); end; {********************************************* ** Ein Pixel will erstmal gesetzt werden ** *********************************************} procedure set_pixel(mode,x,y,art:integer); var i,n:integer; begin for n := 0 to mode do for i := 0 to mode do begin put_pixel(x+n,y+i,art); end; end; {********************************************************** ** wird gebraucht um Font auf dem Screen darzustellen ** **********************************************************} procedure recompile(mode,x,y:integer; str:string); var i,n,z:integer; zaehler,status:integer; flag,flag1 : long_integer; begin hide_mouse; for z := 1 to length(str) do begin zaehler := ord(str[z]); for n := 1 to 12 do begin flag1 := font[zaehler,n]; for i := 1 to 16 do begin flag := flag1 - potenz[16-i]; if flag >= 0 then begin flag1 := flag; set_pixel(mode,x+n-1+mode*n,y+i-1+mode*i,1); end else set_pixel(mode,x+n-1+mode*n,y+i-1+mode*i,0); end; end; x := x + 12+mode*12; end; show_mouse; end; {**************************************** ** Einlesen einer Zeichensatz-Datei ** ****************************************} procedure load_font(mode:integer); var i,n,mem,flag:integer; datei:file of long_integer; begin if mode = 1 then show_file(1,fs_iinsel,fs_iinpath) else fs_iexbutton := TRUE; if fs_iexbutton then begin graf_mouse(2); reset(datei,dateiname); if not eof(datei) then begin for i := 1 to 250 do for n := 1 to 12 do begin font[i,n] := datei^; get(datei); end; zsz := 0; menu_ienable(menu_tree, PRINTFIL,1); str := 'ABCDEFGHIJ'; recompile(0,474,138,str); str := 'KLMNOPQRST'; recompile(0,474,160,str); str := 'UVWXYZŽ™š'; recompile(0,474,182,str); str := 'abcdefghij'; recompile(0,474,204,str); str := 'klmnopqrst'; recompile(0,474,226,str); str := 'uvwxyz„”ž'; recompile(0,474,248,str); str := '0123456789'; recompile(0,474,270,str); graf_mouse(0); end else if mode = 1 then begin str:='[1][Diesen Zeichensatz|habe ich nicht|gefunden !][ABBRUCH]'; ready:=alert(1,str); end; close(datei); graf_mouse(0); end; end; {********************************************************** ** Der Zeichensatz wird fr den NLQ-Druck vorbereitet ** **********************************************************} procedure convert_nlq; var i,n,g,z,za:integer; flag,flag1:long_integer; begin zsz := 1; for i := 1 to 250 do for n := 1 to 12 do begin flag1 := font[i,n]; font_pr[1,i,n] := 0; font_pr[2,i,n] := 0; za := 0; for z := 1 to 8 do begin za := za + 1; flag := flag1 - potenz[16-za]; if flag >= 0 then begin flag1 := flag; g := 8-z; font_pr[1,i,n] := font_pr[1,i,n] + potenz_w[g]; end; za := za + 1; flag := flag1 - potenz[16-za]; if flag >= 0 then begin flag1 := flag; g := 8-z; font_pr[2,i,n] := font_pr[2,i,n] + potenz_w[g]; end; end; end; end; {************************************************************** ** Der Zeichensatz wird fr den Einfach-Druck vorbereitet ** **************************************************************} procedure convert_norm; var i,n,g,z:integer; flag,flag1:long_integer; begin zsz := 2; for i := 1 to 250 do for n := 1 to 12 do begin flag1 := font[i,n]; font_pr[1,i,n] := 0; font_pr[2,i,n] := 0; for z := 1 to 8 do begin flag := flag1 - potenz[16-z]; if flag >= 0 then begin flag1 := flag; g := 8-z; font_pr[1,i,n] := font_pr[1,i,n] + potenz_w[g]; end; end; for z := 9 to 16 do begin flag := flag1 - potenz[16-z]; if flag >= 0 then begin flag1 := flag; g := 16-z; font_pr[2,i,n] := font_pr[2,i,n] + potenz_w[g]; end; end; end; end; {*************************************************************************** ** Wenn eine Zeile nur aus Leerzeichen besteht wird sie nicht gedruckt ** ***************************************************************************} procedure cut_line(line:string); var i:integer; begin i := 0; repeat if line[length(line)] = chr(32) then line := copy(line,1,length(line)-1) else i := 1; until (( i = 1 ) or (length(line) < 1)); str := line; end; {************************************************** ** Druck-Routine fr Proportionalen NLQ-Druck ** **************************************************} procedure prop_nlq(line:string); var i,z,z1,zei,lang,ra:integer; g,count:integer; zeile,zeile1:packed array [1..1920] of char; begin ra := rand; if line <> '' then begin cut_line(line); line := str; if small = 2 then ra := ra * 2; lang := ra*12; z1 := 0; if ra <> 0 then for i := 1 to ra do for z := 1 to 12 do begin if z1 < 1920 then begin z1 := z1 + 1; zeile[z1] := chr(0); zeile1[z1] := chr(0); end; end; for i := 1 to length(line) do begin zei := ord(line[i]); if zei = 32 then begin for count := 1 to 12 do begin if lang < 1920 then begin lang := lang + 1; zeile[lang] := chr(0); zeile1[lang] := chr(0); end; if small = 2 then begin if lang < 1920 then begin lang := lang + 1; zeile[lang] := chr(0); zeile1[lang] := chr(0); end; end end; end else begin if lang < 1920 then begin lang := lang + 1; zeile[lang] := chr(0); zeile1[lang] := chr(0); end; for count := 1 to 12 do begin if ((font_pr[1,zei,count]) | (font_pr[2,zei,count])) <> 0 then begin if lang < 1920 then begin lang := lang + 1; zeile[lang] := chr(font_pr[1,zei,count]); zeile1[lang] := chr(font_pr[2,zei,count]); end; if small = 2 then begin if lang < 1920 then begin lang := lang + 1; zeile[lang] := chr(font_pr[1,zei,count]); zeile1[lang] := chr(font_pr[2,zei,count]); end; end; end; end; end; end; z := lang div 256; z1 := lang mod 256; if nl_10 = 0 then write(pr_vor_halb) { STAR Gemini 10 x etc. } else write(pr_vor_halb_nl); { STAR NL-10, Epson-FX etc. } write(concat(pr_hrg_dopp,chr(z1),chr(z))); for i := 1 to lang do write(zeile[i]); writeln; write(concat(pr_hrg_dopp,chr(z1),chr(z))); for i := 1 to lang do write(zeile1[i]); writeln; if nl_10 = 0 then writeln(pr_vor_wahl) { STAR Geminie 10 x etc. } else begin write(pr_zur_halb_nl);{ STAR NL-10, Epson-FX etc. } writeln(pr_vor_norm); end; end else begin if nl_10 = 0 then begin write(pr_vor_halb); { STAR Gemini 10 x etc. } writeln; writeln; writeln(pr_vor_wahl); end else writeln(pr_vor_norm); { STAR NL-10, Epson-FX etc. } end; end; {****************************************************** ** Druck-Routine fr Proportionalen Einfach-Druck ** ******************************************************} procedure prop_norm(line:string); var i,z,z1,zei,lang,ra:integer; g,count:integer; zeile,zeile1:packed array [1..1920] of char; begin ra := rand; if line <> '' then begin cut_line(line); line := str; if stand = 3 then ra := ra * 2; lang := ra*12; z1 := 0; if ra <> 0 then for i := 1 to ra do for z := 1 to 12 do begin if z1<1920 then begin z1 := z1 + 1; zeile[z1] := chr(0); zeile1[z1] := chr(0); end; end; for i := 1 to length(line) do begin zei := ord(line[i]); if zei = 32 then begin for count := 1 to 12 do begin if lang < 1920 then begin lang := lang + 1; zeile[lang] := chr(0); zeile1[lang] := chr(0); end; if stand = 3 then if lang < 1920 then begin lang := lang + 1; zeile[lang] := chr(0); zeile1[lang] := chr(0); end; end; end else begin if lang < 1920 then begin lang := lang + 1; zeile[lang] := chr(0); zeile1[lang] := chr(0); end; if stand = 3 then if lang < 1920 then begin lang := lang + 1; zeile[lang] := chr(0); zeile1[lang] := chr(0); end; for count := 1 to 12 do begin if ((font_pr[1,zei,count]) | (font_pr[2,zei,count])) <> 0 then begin if lang < 1920 then begin lang := lang + 1; zeile[lang] := chr(font_pr[1,zei,count]); zeile1[lang] := chr(font_pr[2,zei,count]); end; if stand = 3 then if lang < 1920 then begin lang := lang + 1; zeile[lang] := chr(font_pr[1,zei,count]); zeile1[lang] := chr(font_pr[2,zei,count]); end; end; end; end; end; z := lang div 256; z1 := lang mod 256; write(pr_vor_acht); if ((stand = 2) or (stand = 3)) then write(concat(pr_hrg_dopp,chr(z1),chr(z))) else write(concat(pr_hrg_norm,chr(z1),chr(z))); for i := 1 to lang do write(zeile[i]); writeln; if ((stand = 2) or (stand = 3)) then write(concat(pr_hrg_dopp,chr(z1),chr(z))) else write(concat(pr_hrg_norm,chr(z1),chr(z))); for i := 1 to lang do write(zeile1[i]); writeln(pr_vor_wahl); end else begin write(pr_vor_acht); writeln; writeln(pr_vor_wahl); end; end; {*********************************** ** Druck-Routine fr NLQ-Druck ** ***********************************} procedure print_nlq(line:string); var i,z,z1,zei,lang,ra:integer; g,count:integer; begin ra := rand; if line <> '' then begin cut_line(line); line := str; lang := length(line)*12; lang := lang+ra*12; if small = 2 then begin lang := lang * 2; ra := ra * 2; end; if nl_10 = 0 then write(pr_vor_halb) { STAR Gemini 10 x etc. } else write(pr_vor_halb_nl); { STAR NL-10, Epson-FX etc. } z := lang div 256; z1 := lang mod 256; for g := 1 to 2 do begin write(concat(pr_hrg_dopp,chr(z1),chr(z))); if ra > 0 then for i := 1 to ra*12 do write(chr(0)); for i := 1 to length(line) do begin zei := ord(line[i]); for count := 1 to 12 do begin write(chr(font_pr[g,zei,count])); if small = 2 then write(chr(font_pr[g,zei,count])); end; end; writeln; end; if nl_10 = 0 then writeln(pr_vor_wahl) { STAR Geminie 10 x etc. } else begin write(pr_zur_halb_nl);{ STAR NL-10, Epson-FX etc. } writeln(pr_vor_norm); end; end else begin if nl_10 = 0 then begin write(pr_vor_halb); { STAR Gemini 10 x etc. } writeln; writeln; writeln(pr_vor_wahl); end else writeln(pr_vor_norm); { STAR NL-10, Epson-FX etc. } end; end; {*************************************** ** Druck-Routine fr Einfach-Druck ** ***************************************} procedure print_norm(line:string); var i,z,z1,zei,lang,ra:integer; g,count:integer; begin ra := rand; if line <> '' then begin cut_line(line); line := str; lang := length(line)*12; lang := lang+ra*12; if stand = 3 then begin ra := ra * 2; lang := lang * 2; end; write(pr_vor_acht); z := lang div 256; z1 := lang mod 256; for g := 1 to 2 do begin if ((stand = 2) or (stand = 3)) then write(concat(pr_hrg_dopp,chr(z1),chr(z))) else write(concat(pr_hrg_norm,chr(z1),chr(z))); if ra > 0 then for i := 1 to ra*12 do write(chr(0)); for i := 1 to length(line) do begin zei := ord(line[i]); for count := 1 to 12 do begin write(chr(font_pr[g,zei,count])); if stand = 3 then write(chr(font_pr[g,zei,count])); end; end; if g = 1 then writeln; end; writeln(pr_vor_wahl); end else begin write(pr_vor_acht); writeln; writeln(pr_vor_wahl); end; end; {*************************************************** ** 1st-Word Konvertier Routine (c) by MKB-Soft ** ** ** ** Diese Routine kann abge„ndert auch fr ** ** eigene Entwicklungen benutzt werden. ** ** ** **************************************************} procedure st_word_print; var i,ii,lang,zeile,zeich,flag:integer; fil:text; line,zei,ganz_zeil:string; esc:char; pap_zeil:integer; xdial,ydial,wdial,hdial:integer; x,y,w,h,z,error,obj:integer; tree:long_integer; quit:boolean; poit:integer; seite:integer; anzahl,zaehler:integer; procedure print_line(line:string); { Ausdrucken einer Zeile je nach } begin { eingestellten Schriftwnschen } if prop = 0 then if druck = 1 then print_nlq(line) else print_norm(line); if prop = 1 then if druck = 1 then prop_nlq(line) else prop_norm(line); end; procedure kopf; { Erzeugen der Kopfzeile } var line,left,mid,right,zahl_str,zw:string; i,poit,zahl:integer; begin line := ''; if pap_tof > 0 then for i := 1 to pap_tof do print_line(line); { Zusammenstellen der Kopf-Zeile } poit := pos('#',kopf_left); { Suche nach dem Seitenz„hler } if poit <> 0 then begin itoa(seite); zahl_str := str; left := copy(kopf_left,1,poit - 1); left := concat(left,zahl_str); if length(kopf_left) > poit+1 then begin zw := copy(kopf_left,poit+1,length(kopf_left)-poit-1); left := concat(left,zw); end; end else left := kopf_left; line := left; poit := pos('#',kopf_mid); { Suche nach dem Seitenz„hler } if poit <> 0 then begin itoa(seite); zahl_str := str; mid := copy(kopf_mid,1,poit - 1); mid := concat(mid,zahl_str); if length(kopf_mid) > poit+1 then begin zw := copy(kopf_mid,poit+1,length(kopf_mid)-poit-1); mid := concat(mid,zw); end; end else mid := kopf_mid; zahl := (pap_breit div 2) - (length(left)) - (length(mid) div 2); if zahl <> 0 then for i := 1 to zahl do line := concat(line,' '); line := concat(line,mid); poit := pos('#',kopf_right); { Suche nach dem Seitenz„hler } if poit <> 0 then begin itoa(seite); zahl_str := str; right := copy(kopf_right,1,poit - 1); right := concat(right,zahl_str); if length(kopf_right) > poit+1 then begin zw := copy(kopf_right,poit+1,length(kopf_right)-poit-1); right := concat(right,zw); end; end else right := kopf_right; zahl := (pap_breit) - (length(line)) - (length(right)); if zahl <> 0 then for i := 1 to zahl do line := concat(line,' '); line := concat(line,right); if pap_head > 0 then begin print_line(line); end; line := ''; if pap_head > 1 then for i := 1 to pap_head-1 do print_line(line); end; procedure fuss; { Zusammenstellen der Fužzeile } var line,left,mid,right,zahl_str,zw:string; i,poit,zahl:integer; begin line := ''; if pap_foot > 1 then for i := 1 to pap_foot-1 do print_line(line); { Zusammenstellen der Fuž-Zeile } poit := pos('#',fuss_left); { Suche nach dem Seitenz„hler } if poit <> 0 then begin itoa(seite); zahl_str := str; left := copy(fuss_left,1,poit - 1); left := concat(left,zahl_str); if length(fuss_left) > poit+1 then begin zw := copy(fuss_left,poit+1,length(fuss_left)-poit-1); left := concat(left,zw); end; end else left := fuss_left; line := left; poit := pos('#',fuss_mid); { Suche nach dem Seitenz„hler } if poit <> 0 then begin itoa(seite); zahl_str := str; mid := copy(fuss_mid,1,poit - 1); mid := concat(mid,zahl_str); if length(fuss_mid) > poit+1 then begin zw := copy(fuss_mid,poit+1,length(fuss_mid)-poit-1); mid := concat(mid,zw); end; end else mid := fuss_mid; zahl := (pap_breit div 2) - (length(left)) - (length(mid) div 2); if zahl <> 0 then for i := 1 to zahl do line := concat(line,' '); line := concat(line,mid); poit := pos('#',fuss_right); { Suche nach dem Seitenz„hler } if poit <> 0 then begin itoa(seite); zahl_str := str; right := copy(fuss_right,1,poit - 1); right := concat(right,zahl_str); if length(fuss_right) > poit+1 then begin zw := copy(fuss_right,poit+1,length(fuss_right)-poit-1); right := concat(right,zw); end; end else right := fuss_right; zahl := (pap_breit) - (length(line)) - (length(right)); if zahl <> 0 then for i := 1 to zahl do line := concat(line,' '); line := concat(line,right); if pap_foot > 0 then print_line(line); line := ''; if pap_bof > 0 then for i := 1 to pap_bof do print_line(line); end; procedure read_zeile; { 10 Zeilen von Diskette einlesen } var i:integer; begin i := 0; repeat i := i + 1; line := ''; readln(fil,druck_zeile[i]); until ((eof(fil)) or (i = 10)); anzahl := i; end; begin { Begin von st_word_print } fuss_left := ''; fuss_mid := ''; fuss_right := ''; kopf_left := ''; kopf_mid := ''; kopf_right := ''; esc := chr(27); seite := seit; pap_zeil := 0; ganz_zeil := ''; reset(fil,dateiname); { oeffne Datei } rewrite(output,'PRN:'); { Leite Ausgaben auf Drucker } write(pr_init); x := 320; y := 200; w := 1; h := 1; error := rsrc_gaddr(0, WAIT, tree); form_center(tree, xdial,ydial,wdial,hdial); sourc_dest(xdial,ydial,wdial,hdial); form_dial(0,x,y,w,h,xdial,ydial,wdial,hdial); objc_draw(tree,0,30,xdial,ydial,wdial,hdial); quit := false; repeat read_zeile; zaehler := 0; while ((zaehler < anzahl) and (keypress = false)) do begin line := ''; zaehler := zaehler + 1; line := druck_zeile[zaehler]; if ((length(line) > 1) and (ord(line[1]) = 31)) then begin case line[2] of '0' : begin { Layout Daten } str := copy(line,3,2); pap_len := atoi(str); str := copy(line,5,2); pap_tof := atoi(str); str := copy(line,7,2); pap_head := atoi(str); str := copy(line,9,2); pap_foot := atoi(str); str := copy(line,11,2); pap_bof := atoi(str); str := copy(line,13,2); pap_breit := atoi(str); { Beschreibbare Seitenl„nge berechnen } end; '1' : begin { Kopfzeile, eventuell mit # als Seitenz„hler } line := copy(line,3,length(line)-2); poit := pos(chr(31),line); if poit <> 1 then kopf_left := copy(line,1,poit); line := copy(line,poit+1,length(line)-poit); poit := pos(chr(31),line); if poit <> 1 then kopf_mid := copy(line,1,poit); kopf_right := copy(line,poit+1,length(line)-poit); end; '2' : begin { Fusszeile, eventuell mit # als Seitenzaehler } line := copy(line,3,length(line)-2); poit := pos(chr(31),line); if poit <> 1 then fuss_left := copy(line,1,poit); line := copy(line,poit+1,length(line)-poit); poit := pos(chr(31),line); if poit <> 1 then fuss_mid := copy(line,1,poit); fuss_right := copy(line,poit+1,length(line)-poit); end; '9' : begin { Formatzeile mit Tabulator-Zeichen } pap_breit := pos(']',line) - 2; end; end; end else begin if ((length(line) > 0) and (ord(line[1]) = 12)) then begin { Formfeed -> Vorschub } for ii := pap_zeil to pap_len-pap_foot-pap_bof-1 do print_line(''); pap_zeil := 0; fuss; seite := seite + 1; end; if pap_zeil = pap_len-pap_foot-pap_bof then begin { Seite voll -> Vorschub } pap_zeil := 0; fuss; seite := seite + 1; end; if pap_zeil < 1 then { Es ist wohl Zeit einen - } begin { Kopf auszudrucken } kopf; pap_zeil := pap_tof+pap_head; { Kopf gedruckt } end; ganz_zeil := ''; lang:=length(line); { Wie lang ist denn die Zeile ? } for i := 1 to lang do begin zei:=copy(line,i,1); { Aktuelles zeichen holen } zeich := ord(zei[1]); if flag = 1 then { Aha, jetzt kommt ein Style change } flag := 0 else if zeich > 31 then { Alles in Ordnung, also hinzufgen } ganz_zeil := concat(ganz_zeil,chr(zeich)) else { Ansonsten mal testen was anliegt } case zeich of 25 : { Variable Trennung } ganz_zeil := concat(ganz_zeil,'-'); 27 : flag := 1; { Style change } 28 : { Stretch space } ganz_zeil := concat(ganz_zeil,chr(32)); 29 : { Indent space } ganz_zeil := concat(ganz_zeil,chr(32)); 30 : { Variable space } ganz_zeil := concat(ganz_zeil,chr(32)); end; end; { jetzt die Zeile ausgeben } print_line(ganz_zeil); pap_zeil := pap_zeil + 1; { Wieder eine Zeile gedruckt } end; end; if eof(fil) then { Was, Text schon zu Ende ? } begin { Noch schnell Vorschub bis Fuž - } for ii := pap_zeil to pap_len-pap_foot-pap_bof-1 do print_line(''); fuss; { Fužzeile ausdrucken - } quit := true; { und jetzt Feierabend } end; if keypress then { Was soll der Quatsch - } begin { Abbrechen wo es gerade Spaž macht? } str := '[1][Sind Sie sicher,|daž Sie abbrechen|wollen?][JA|NEIN]'; ready:=alert(2,str); if ready = 1 then quit := true; { Okay, berzeugt } end; until quit = true; { solange weiter bis Abbruch oder Ende } close(fil); { Datei schliesen } form_dial(3,x,y,w,h,xdial,ydial,wdial,hdial); dest_sourc(xdial,ydial,wdial,hdial); { Hintergrund restaurieren } write(pr_init); rewrite(output,'CON:'); { Standart-Ausgabe auf Konsole lenken } graf_mouse(0); { Maus-Cursor = Pfeil } end; { end von st_word_print } {*************************************** ** Jetzt soll wohl gedruckt werden ** ***************************************} procedure print_text; VAR xdial,ydial,wdial,hdial:integer; x,y,w,h,i,z,error,obj:integer; line:string; tree:long_integer; quit : boolean; function bcostat(dev:integer):integer;bios(8); begin show_file(2,f_iinsel,f_iinpath); if fs_iexbutton = TRUE then begin error := rsrc_gaddr(0, DRUCKE, tree); obj := hndl_dial(tree,0,320,200,1,1); get_text(DRUCKE, DRUCKRND,str); rand := atoi(str); get_text(DRUCKE, SEITE,str); seit := atoi(str); if obj = DRUCKDRU then begin i := bcostat(0); if i = -1 then begin graf_mouse(2); if zsz <> druck then begin x := 320; y := 200; w := 1; h := 1; error := rsrc_gaddr(0, WARTE, tree); form_center(tree, xdial,ydial,wdial,hdial); sourc_dest(xdial,ydial,wdial,hdial); form_dial(0,x,y,w,h,xdial,ydial,wdial,hdial); objc_draw(tree,0,30,xdial,ydial,wdial,hdial); if druck = 1 then convert_nlq else convert_norm; form_dial(3,x,y,w,h,xdial,ydial,wdial,hdial); dest_sourc(xdial,ydial,wdial,hdial); end; if st <> 1 then begin { normale ASCII-Dateien drucken } reset(fil,dateiname); { oeffne Datei } rewrite(output,'PRN:'); { Leite Ausgaben auf Drucker } write(pr_init); x := 320; y := 200; w := 1; h := 1; error := rsrc_gaddr(0, WAIT, tree); form_center(tree, xdial,ydial,wdial,hdial); sourc_dest(xdial,ydial,wdial,hdial); form_dial(0,x,y,w,h,xdial,ydial,wdial,hdial); objc_draw(tree,0,30,xdial,ydial,wdial,hdial); quit := false; repeat while ((not eof(fil)) and (keypress <> true)) do begin readln(fil,line); if prop = 0 then if druck = 1 then print_nlq(line) else print_norm(line); if prop = 1 then if druck = 1 then prop_nlq(line) else prop_norm(line); end; if eof(fil) then quit := true; if keypress = true then begin str:= '[1][Sind Sie sicher,|dass Sie abbrechen|wollen?][JA|NEIN]'; ready:=alert(2,str); if ready = 1 then quit := true; end; until quit = true; close(fil); form_dial(3,x,y,w,h,xdial,ydial,wdial,hdial); dest_sourc(xdial,ydial,wdial,hdial); write(pr_init); rewrite(output,'CON:'); graf_mouse(0); end else st_word_print; end else begin str := '[1][Bitte Drucker und|Kabel berprfen !!][ Abbruch ]'; i := alert(1,str); end; end; end; end; {*********************************************** ** Was wurde im DROP-DOWN-MEN angeclickt? ** ***********************************************} procedure select_menu(menu,item:integer); var tree:long_integer; error:integer; x:char; begin CASE menu OF DESK : case item of INFO : about_prg; end; AUSGABE : case item of LADEFONT : load_font(1); PRINTFIL : print_text; ASCII : begin x := f_iinpath[1]; f_iinpath := 'A:\*.* '; f_iinpath[7] := chr(0); f_iinpath[1] := x; str := concat('0',chr(0)); set_text(DRUCKE, DRUCKRND,str); menu_icheck(menu_tree,item,1); menu_icheck(menu_tree,TEXTOMAT,0); menu_icheck(menu_tree,STWORD,0); st := -1; end; TEXTOMAT : begin x := f_iinpath[1]; f_iinpath := 'A:\*.OUT '; f_iinpath[9] := chr(0); f_iinpath[1] := x; str := concat('0',chr(0)); set_text(DRUCKE, DRUCKRND,str); menu_icheck(menu_tree,item,1); menu_icheck(menu_tree,ASCII,0); menu_icheck(menu_tree,STWORD,0); st := 0; end; STWORD : begin x := f_iinpath[1]; f_iinpath := 'A:\*.DOC '; f_iinpath[9] := chr(0); f_iinpath[1] := x; str := concat('8',chr(0)); set_text(DRUCKE, DRUCKRND,str); menu_icheck(menu_tree,item,1); menu_icheck(menu_tree,ASCII,0); menu_icheck(menu_tree,TEXTOMAT,0); st := 1; end; end; FONTI : case item of NLQ : begin menu_icheck(menu_tree,NORMAL,0); menu_icheck(menu_tree,NLQ,1); menu_ienable(menu_tree, NLQBREIT,1); menu_ienable(menu_tree, NLQNORM,1); menu_ienable(menu_tree, STANDHER,0); menu_ienable(menu_tree, STANDSCH,0); menu_ienable(menu_tree, STANDNOR,0); druck := 1; end; NLQNORM : begin small := 1; { normal } menu_icheck(menu_tree,item,1); menu_icheck(menu_tree,NLQBREIT,0); end; NLQBREIT : begin small := 2; { breit } menu_icheck(menu_tree,item,1); menu_icheck(menu_tree,NLQNORM,0); end; NORMAL : begin menu_icheck(menu_tree,NORMAL,1); menu_icheck(menu_tree,NLQ,0); menu_ienable(menu_tree, STANDHER,1); menu_ienable(menu_tree, STANDSCH,1); menu_ienable(menu_tree, STANDNOR,1); menu_ienable(menu_tree, NLQBREIT,0); menu_ienable(menu_tree, NLQNORM,0); druck := 2; end; STANDHER : begin stand := 3; { Hervorgehoben } menu_icheck(menu_tree,item,1); menu_icheck(menu_tree,STANDSCH,0); menu_icheck(menu_tree,STANDNOR,0); end; STANDSCH : begin stand := 2; { Schmal } menu_icheck(menu_tree,item,1); menu_icheck(menu_tree,STANDHER,0); menu_icheck(menu_tree,STANDNOR,0); end; STANDNOR : begin stand := 1; { Normal } menu_icheck(menu_tree,item,1); menu_icheck(menu_tree,STANDSCH,0); menu_icheck(menu_tree,STANDHER,0); end; end; SPECIAL : case item of PROPORT : begin if prop = 0 then { Proportional einstellen } begin prop := 1; menu_icheck(menu_tree,PROPORT,1); end else { Proportional loeschen } begin prop := 0; menu_icheck(menu_tree,PROPORT,0); end; end; SAVEPREV : begin { Preverences abspeichern } str:= '[1][Bitte Start-Diskette|ins aktuelle|Laufwerk legen !][ OK | ABBRUCH ]'; error := alert(1,str); if error = 1 then begin rewrite(fil,'GUTENBER.INF'); writeln(fil,st); { Textart } writeln(fil,prop); { Proportional } writeln(fil,nl_10); { Druckertyp } writeln(fil,druck); { Druck-Art } writeln(fil,small); { NLQ-Art } writeln(fil,stand); { Standard-Art } close(fil); end; end; PRINTTYP : begin { Druckertyp w„hlen } sel_printer_type; end; end; END; { CASE OF } menu_tnormal(menu_tree,menu,1); end; {**************************************** ** Event-Handling muž auch mal sein ** ****************************************} procedure do_menu; var evnt:integer; begin REPEAT evnt := evnt_multi(mu_mesag | mu_button, 1,1,dummy,0,0,0,0,0,0,0,0,0,0, mgbuf,0,0,mausx,mausy,dummy, dummy,dummy,dummy); if (evnt & mu_mesag)= mu_mesag then begin if mgbuf[0] = 10 then select_menu(mgbuf[3],mgbuf[4]); { MN_SELECTED } end; UNTIL ((((evnt & mu_mesag)=mu_mesag) and (mgbuf[3] = AUSGABE) and (mgbuf[4] = QUIT))); end; {*************************************************************** ** Und dies, meine Damen?? und Herrn, ist das Hauptrogramm ** ***************************************************************} BEGIN open_work; screen_sourc := logbase; { Wo isser denn, der Bildschirm } screen_dest := malloc(32768); { Mal eben 32 kByte reservieren } i := load_rsc; { Wie lief denn das Laden der Resource-Datei? } if i = 0 then { wenn alles O.K. dann mal los } begin i := getrez; { Welche Aufl”sung haben wir denn eingestellt } if i = 2 then { L„uft nur in der hohen Aufl”sung (bei der Grafik, haha)} begin load_pic; { Einen sch”nen Hintergrund brauchen wir auch noch } menu_bar(menu_tree,1); { Menzeile einschalten } open_window; graf_mouse(0); dateiname := 'GUTENBER.ZSZ'; load_font(2); { Ist denn der Lieblingszeichensatz da? } do_menu; { Auf zur Mensteuerung } end else begin graf_mouse(0); str:= { So spielt das Leben! } '[1][Dieses Programm l„uft|nur auf dem Mono-Screen|SM124!][SCHADE]'; ready:=alert(1,str); end; end; close_window; END. { Ende Main } { Das wars, Tscheerio }