home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Best of German Only 1
/
romside_best_of_german_only_1.iso
/
wissen
/
dos
/
wgraph
/
entpack.exe
/
WGBSP!.EXE
/
BSP15.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-12-17
|
8KB
|
321 lines
program Beispiel15;
uses GDecl,
GApp,
GEvent,
GViews,
GDrivers,
GText,
GDlg,
graph;
const cmList = 101;
cmSetFont = 20;
msgDraw = 10;
type TApplication=object(TApp)
procedure InitMenuBar; virtual;
procedure SetDialogData; virtual;
procedure HandleEvent; virtual;
procedure NewWindow;
procedure SetFont;
end;
PNewScroller=^TNewScroller;
PScrollWindow=^TScrollWindow;
TScrollWindow=object(TDlgWindow)
Scroller:PNewScroller;
procedure InitWindowScroller; virtual;
procedure InitBackground; virtual;
destructor Done; virtual;
procedure HandleEvent; virtual;
end;
TNewScroller=object(TScroller)
procedure CreateData;
procedure ScrollDraw; virtual;
procedure Draw; virtual;
end;
PScrollBgrd=^TScrollBgrd;
TScrollBgrd=object(TBackground)
procedure Draw; virtual;
end;
PSetFontWindow=^TSetFontWindow;
TSetFontWindow=object(TDlgWindow)
DFont:GraficFont;
procedure WriteTextBlock;
procedure Draw; virtual;
procedure HandleEvent; virtual;
end;
{--------------------------------------}
tFontDataRec=record
Schalter:string[9];
end;
var MyApp:TApplication;
FontDataRec:tFontDataRec;
procedure TApplication.InitMenuBar;
var R:TRect;
begin
MainMenu('~F~enster',0);
SubMenu('~Q~elltext-Lister',cmList,0,0,false,false);
SubMenu('E~x~it Alt-X',cmCloseApplication,0,altX,false,false);
end;
procedure TApplication.SetDialogData;
begin
with FontDataRec do Schalter:='TGrrrrRrG';
end;
procedure TApplication.HandleEvent;
begin
Heap^.ShowHeapStatus(523,8,White);
TProgram.HandleEvent;
case Event.Command of
cmList : NewWindow;
cmSetFont : SetFont;
end; {case}
end;
procedure TApplication.NewWindow;
var R:TRect;
Window:PScrollWindow;
x,y:integer;
begin
R.Assign(60,80,540,380);
Window:=new(PScrollWindow, Init(R,'ScrollWindow / Quelltext-Lister',winDouble+winPanel+winMenu));
with Window^ do
begin
Frame^.DragMode:=dmNoMove;
SetPushButton(386,40,80,22,'~F~ont',cmSetFont);
DlgInput:=false;
end;
InsertDesktop(Window);
end;
procedure TApplication.SetFont;
var K:TRect;
Window:PSetFontWindow;
begin
K.Assign(110,125,565,390);
Window:=new(PSetFontWindow, Init(K,'Zeichensätze',winDouble+winPanel+winMenu));
with Window^ do
begin
SetPushButton(55,210,80,22,'OK',cmCloseWindow);
SetGroupFrame(25,55,150,125,'Zeichensätze',NormWidth);
SetRadioButton(45,80, '~T~hin8 8x12',1);
SetRadioButton(45,95, 'T~h~in14 8x14',1);
SetRadioButton(45,110,'Th~i~n16 8x16',1);
SetRadioButton(45,125,'~B~rdwy19 8x19',1);
SetRadioButton(45,140,'~W~ndW19 8x19',1);
SetRadioButton(45,155,'~S~ans19 8x19',1);
SetData(FontDataRec);
SetGroupFrame(200,55,230,140,'',ThickWidth);
end;
InsertDesktop(Window);
end;
{Implementation TScrollWindow}
procedure TScrollWindow.InitWindowScroller;
var RR:TRect;
i:byte;
SBH1,SBV1:PScrollBar;
begin
RR:=Frame^.Area;
RR.Grow(-130,-30);
RR.Move(30,15);
SBH1:=new(PScrollBar, Init(RR,HorizDir));
SBV1:=new(PScrollBar, Init(RR,VertDir));
with SBH1^ do
begin
Palette[1]:=#0; {Hintergrund Scrollbereich}
Palette[3]:=#2; {Tastenfarbe}
Palette[4]:=#14; {BalkenFarbe}
Palette[5]:=#14; {Randfarbe Taste}
Palette[7]:=#4; {Pfeile}
end;
with SBV1^ do
begin
Palette[1]:=#0;
Palette[3]:=#2; {Tastenfarbe}
Palette[4]:=#14; {BalkenFarbe}
Palette[5]:=#14; {Randfarbe Taste}
Palette[7]:=#4; {Pfeile}
end;
Scroller:=new(PNewScroller, Init(RR,SBH1,SBV1));
Scroller^.CreateData;
Scroller^.Palette[1]:=#0;
Scroller^.Palette[2]:=#11;
List^.InsertItem(Scroller);
end;
procedure TScrollWindow.InitBackground;
var RR:TRect;
begin
RR:=Frame^.Area;
Bgrd:=new(PScrollBgrd, Init(RR));
List^.InsertItem(Bgrd);
end;
destructor TScrollWindow.Done;
begin
TWindow.Done;
dispose(Scroller, Done);
end;
procedure TScrollWindow.HandleEvent;
begin
TDlgWindow.HandleEvent;
if Event.Message=msgDraw then
begin
Scroller^.ScrollDraw;
Event.Message:=msgNothing;
end;
end;
{Implementation TNewScroller}
procedure TNewScroller.CreateData;
var f:text;
LfdPtr:PLine;
begin
SetFont(Wndw19);
assign(f,'BSP5.PAS');
reset(f);
while not EOF(f) do
begin
LfdPtr:=new(PLine, Init);
readln(f,LfdPtr^.Eintrag);
Liste^.InsertItem(LfdPtr);
end;
SetLimit(35,Liste^.AnzElem-1,CharLength,CharHeight);
end;
procedure TNewScroller.ScrollDraw;
var i:integer;
LfdPtr:PGroup;
function clip(p,n:byte;z:string):string;
begin
clip:=copy(z,p,n);
end;
begin
SetFontColor(GetPalColor(1),GetPalColor(2));
Mouse.HideMouse;
with Border do
begin
SetFillStyle(SolidFill,GetPalColor(1));
SetColor(GetPalColor(2));
for i:=Delta.y to WDelta.y do
begin
LfdPtr:=Liste^.GetItems(i);
Bar(A.x,A.y+(i-Delta.y)*Py+10,B.x,A.y+(i-Delta.y)*Py+10+Py);
WriteText(A.x+20,A.y+(i-Delta.y)*Py+10,clip(Delta.x,Spalten*8 div 8-5,PLine(LfdPtr)^.Eintrag));
end;
if VertiScrollBar<>nil then
for i:=(WDelta.y-Delta.y)+1 to Zeilen do
Bar(A.x,A.y+i*Py+10,B.x,A.y+i*Py+10+Py);
end;
Mouse.ShowMouse;
end;
procedure TNewScroller.Draw;
begin
TScroller.Draw;
SetColor(GetPalColor(6));
with Border do
RectAngle(A.x-1,A.y-1,B.x+16,B.y+16);
end;
{Implementation TScrollBgrd}
procedure TScrollBgrd.Draw;
begin
with Border do
begin
SetFillStyle(HatchFill,LightRed);
Bar(A.x,A.y,B.x,B.y);
end;
end;
{Implementation TSetFontWindow}
procedure TSetFontWindow.WriteTextBlock;
var z:string;
begin
Mouse.HideMouse;
SetFillStyle(SolidFill,White);
Bar(Origin.x+205,Origin.y+60,Origin.x+425,Origin.y+190);
z:='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
WriteText(Origin.x+210,Origin.y+67,z);
z:='abcdefghijklmnopqrstuvwxyz';
WriteText(Origin.x+210,Origin.y+87,z);
z:='ÄÖÜäöü?!"$%&/()=?+#*,.:;_-';
WriteText(Origin.x+210,Origin.y+107,z);
z:='01234567890123456789012345';
WriteText(Origin.x+210,Origin.y+127,z);
z:='{}[]\~ÇüéâàåçêëèïîìÅÉæÆôöò';
WriteText(Origin.x+210,Origin.y+147,z);
z:='ûùÿÖÜ¢£¥₧ƒáíóúñѪº¿⌐¬½¼¡«»';
WriteText(Origin.x+210,Origin.y+167,z);
Mouse.ShowMouse;
end;
procedure TSetFontWindow.Draw;
begin
TDlgWindow.Draw;
DFont:=Font;
SetFont(DFont); SetFontColor(White,Green);
WriteTextBlock;
SetFontColor(Black,LightCyan);
end;
procedure TSetFontWindow.HandleEvent;
var z:string;
i:byte;
begin
with FontDataRec do
for i:=1 to length(Schalter) do
if Schalter[i]='R' then
begin
case i of
3 : DFont:=Thin8;
4 : DFont:=Thin14;
5 : DFont:=Thin16;
6 : DFont:=Brdwy19;
7 : DFont:=Wndw19;
8 : DFont:=Sans19;
end; {case}
end;
if DFont<>Font then
begin
SetFont(DFont); SetFontColor(White,Green);
WriteTextBlock;
SetFontColor(Black,LightCyan);
Event.Message:=msgDraw;
end;
TDlgWindow.HandleEvent;
end;
{Hauptprogramm}
begin
MyApp.Init('Beispiel 15');
MyApp.Run;
MyApp.Done;
end.