Difference between revisions of "Examplecode"

From Freepascal Amiga wiki
Jump to navigation Jump to search
(Initial creation of page)
 
(Added first load (Introduction + Graphics) of sources from aros.org examples that need a rewrite to use distributed units)
Line 1: Line 1:
 
Some example-code that need preperation before they can go into the wikibook.
 
Some example-code that need preperation before they can go into the wikibook.
 +
 +
Original c-code [http://aros.sourceforge.net/documentation/developers/samplecode/helloworld.c]
 +
<source lang="pascal">
 +
Program HelloWorld;
 +
Begin
 +
  Writeln('Hello World');
 +
  Exit(0);
 +
End.
 +
</source>
 +
 +
 +
Original c-code [http://aros.sourceforge.net/documentation/developers/samplecode/graphics_simple.c]
 +
<source lang="pascal">
 +
Program graphics_simple;
 +
 +
{$MODE OBJFPC} {$H+}
 +
 +
(*
 +
  Example for simple drawing routines
 +
*)
 +
 +
 +
Uses
 +
  chelpers,
 +
  amigalib,
 +
  aros_exec,
 +
  aros_graphics,
 +
  aros_intuition,
 +
  aros_utility;
 +
 +
 +
var
 +
  window : pWindow;
 +
  cm    : pColorMap;
 +
  rp    : pRastPort;
 +
 
 +
const
 +
  (*
 +
    ObtainBestPen() returns -1 when it fails, therefore we
 +
    initialize the pen numbers with -1 to simplify cleanup.
 +
  *)
 +
  pen1  : A_LONG = -1;
 +
  pen2  : A_LONG = -1;
 +
 
 +
 
 +
  { forward declarations }
 +
  procedure draw_simple;  forward;
 +
  procedure clean_exit(const s: A_CONST_STRPTR); forward;
 +
  procedure handle_events; forward;
 +
 +
 +
 +
Function Main: Integer;
 +
begin
 +
  window := OpenWindowTags(nil,
 +
  [
 +
    WA_Left        ,  50,
 +
    WA_Top          ,  70,
 +
    WA_Width        , 400,
 +
    WA_Height      , 350,
 +
   
 +
    WA_Title        , 'Simple Graphics',
 +
    WA_Activate    , True,
 +
    WA_SmartRefresh , true,
 +
    WA_NoCareRefresh, true,
 +
    WA_GimmeZeroZero, true,
 +
    WA_CloseGadget  , true,
 +
    WA_DragBar      , true,
 +
    WA_DepthGadget  , true,
 +
    WA_IDCMP        , IDCMP_CLOSEWINDOW,
 +
    TAG_END
 +
  ]);
 +
 +
  if not valid(window) then clean_exit('Can''t open window');
 +
 
 +
  rp := window^.RPort;
 +
  cm := pScreen(window^.WScreen)^.ViewPort.Colormap;
 +
 
 +
  (* Let's obtain two pens *)
 +
  {
 +
  pen1 := ObtainBestPen(cm, $FFFF0000, 0, 0, TAG_END);
 +
  pen2 := ObtainBestPen(cm, 0 ,0, $FFFF0000, TAG_END);
 +
  }
 +
  pen1 := ObtainBestPenA(cm, $FFFF0000, 0, 0, nil);
 +
  pen2 := ObtainBestPenA(cm, 0 ,0, $FFFF0000, nil);
 +
  If (not valid(pen1) or not valid(pen2)) then clean_exit('Can''t allocate pen');
 +
 +
  draw_simple;
 +
  handle_events;
 +
 
 +
  clean_exit(nil);
 +
 
 +
  result := 0;
 +
end;
 +
 +
 +
 +
procedure draw_simple;
 +
var
 +
  array_ : array[0..8-1] of A_WORD;
 +
begin
 +
  array_[0] := 50;  array_[1] := 200;  { Polygon for PolyDraw }
 +
  array_[2] := 80;  array_[3] := 180;
 +
  array_[4] := 90;  array_[5] := 220;
 +
  array_[6] := 50;  array_[7] := 200;
 +
 +
  SetAPen(rp, pen1);                    { Set foreground color }
 +
  SetBPen(rp, pen2);                    { Set background color }
 +
 +
  WritePixel(rp, 30, 70);              { Plot a point }
 +
 
 +
  SetDrPt(rp, $FF00);                  { Change line pattern. Set pixels are drawn }
 +
                                        { with APen, unset with BPen }
 +
  Move(rp, 20, 50);                    { Move cursor to given point }
 +
  Draw(rp, 100, 80);                    { Draw a line from current to given point }
 +
 
 +
  DrawEllipse(rp, 70, 30, 15, 10);      { Draw an ellipse }
 +
 +
  (*
 +
    Draw a polygon. Note that the first line is draw from the
 +
    end of the last Move() or Draw() command 
 +
  *) 
 +
 +
  PolyDraw(rp, sizeof(array_) div sizeof(A_WORD) div 2, @array_);
 +
 
 +
  SetDrMd(rp, JAM1);                    { We want to use only the foreground pen }
 +
  Move(rp, 200, 80);
 +
  GText(rp, 'Text in default font', 20);
 +
 
 +
  SetDrPt(rp, $FFFF);                  { Reset line pattern }
 +
end;
 +
 +
 +
 +
procedure write_text(const s: A_CONST_STRPTR; x: A_WORD; y: A_WORD; mode: A_ULONG);
 +
begin
 +
  SetDrMd(rp, mode);
 +
  Move(rp, x, y);
 +
  GText(rp, s, strlen(s));
 +
end;
 +
 +
 +
 +
procedure handle_events;
 +
var
 +
  imsg : pIntuiMessage;
 +
  port : pMsgPort;
 +
  terminated : boolean;
 +
begin
 +
  (*
 +
    A simple event handler. This will be exaplained ore detailed
 +
    in the Intuition examples.
 +
  *)
 +
  port := window^.userPort;
 +
  terminated := false;
 +
 
 +
  while not terminated do
 +
  begin
 +
    Wait(1 shl port^.mp_SigBit);
 +
    if (Assign(imsg, GetMsg(port)) <> nil) then
 +
    begin
 +
      Case imsg^.IClass of
 +
        IDCMP_CLOSEWINDOW : terminated := true;
 +
      end; { case }
 +
      ReplyMsg(pMessage(imsg));
 +
    end;
 +
 +
  end;
 +
end;
 +
 +
 +
 +
procedure clean_exit(const s: A_CONST_STRPTR);
 +
begin
 +
  If valid(s)      then WriteLn(s);
 +
 
 +
  (* Give back allocated resources *)
 +
  if (pen1 <> -1)  then ReleasePen(cm, pen1);
 +
  if (pen2 <> -1)  then ReleasePen(cm, pen2);
 +
  if valid(window) then CloseWindow(window);
 +
end;
 +
 +
 +
 +
Begin
 +
  Main();
 +
end.
 +
</source>
 +
 +
 +
 +
Original c-code [http://aros.sourceforge.net/documentation/developers/samplecode/graphics_bitmap.c]
 +
<source lang="pascal">
 +
Program graphics_bitmap;
 +
 +
{$MODE OBJFPC} {$H+}
 +
 +
(*
 +
  Example for bitmaps
 +
*)
 +
 +
Uses
 +
  chelpers,
 +
  amigalib,
 +
  aros_exec,
 +
  aros_graphics,
 +
  aros_intuition,
 +
  aros_utility;
 +
 +
 +
var
 +
  window : pWindow;
 +
  cm    : pColorMap;
 +
  win_rp : pRastPort;
 +
 
 +
Const
 +
  BMWIDTH  = (50); 
 +
  BMHEIGHT = (50);
 +
 +
var
 +
  bm    : pBitmap;
 +
  bm_rp : pRastPort;
 +
 
 +
const
 +
  (*
 +
    ObtainBestPen() returns -1 when it fails, therefore we
 +
    initialize the pen numbers with -1 to simplify cleanup.
 +
  *)
 +
  pen1  : A_LONG = -1;
 +
  pen2  : A_LONG = -1;
 +
 
 +
 
 +
  { forward declarations }
 +
  procedure draw_bitmap;  forward;
 +
  procedure clean_exit(const s: A_CONST_STRPTR); forward;
 +
  procedure handle_events; forward;
 +
 +
 +
{
 +
function RASSIZE(w: integer; h: Integer): Integer; inline;
 +
begin
 +
  result := ( (h) * ( ((w)+15) shr 3 and $FFFE ));
 +
end;
 +
}
 +
Procedure DrawCircle(rp: pRastPort; cx: A_LONG; cy: A_LONG; r:A_LONG); inline;
 +
begin
 +
  DrawEllipse(rp, cx, cy, r, r);
 +
end;
 +
 +
 +
 +
 +
Function Main: Integer;
 +
begin
 +
  window := OpenWindowTags(nil,
 +
  [
 +
    WA_Left        ,  50,
 +
    WA_Top          ,  70,
 +
    WA_Width        , 400,
 +
    WA_Height      , 350,
 +
   
 +
    WA_Title        , 'Bitmap Graphics',
 +
    WA_Activate    , True,
 +
    WA_SmartRefresh , true,
 +
    WA_NoCareRefresh, true,
 +
    WA_GimmeZeroZero, true,
 +
    WA_CloseGadget  , true,
 +
    WA_DragBar      , true,
 +
    WA_DepthGadget  , true,
 +
    WA_IDCMP        , IDCMP_CLOSEWINDOW,
 +
    TAG_END
 +
  ]);
 +
 +
  if not valid(window) then clean_exit('Can''t open window');
 +
 
 +
  win_rp := window^.RPort;
 +
  cm    := pScreen(window^.WScreen)^.ViewPort.Colormap;
 +
 
 +
  (* Let's obtain two pens *)
 +
  {
 +
  pen1 := ObtainBestPen(cm, $FFFF0000, 0, 0, TAG_END);
 +
  pen2 := ObtainBestPen(cm, 0 ,0, $FFFF0000, TAG_END);
 +
  }
 +
  pen1 := ObtainBestPenA(cm, $FFFF0000, 0, 0, nil);
 +
  pen2 := ObtainBestPenA(cm, 0 ,0, $FFFF0000, nil);
 +
 +
  If (not valid(pen1) or not valid(pen2)) then clean_exit('Can''t allocate pen');
 +
 +
  draw_bitmap;
 +
  handle_events;
 +
 
 +
  clean_exit(nil);
 +
 
 +
  result := 0;
 +
end;
 +
 +
 +
 +
procedure draw_bitmap;
 +
var
 +
  Depth : A_UWORD; x: integer;
 +
begin
 +
  (*
 +
    Get the depth of the screen. Don't peek in the structures, always use
 +
    GetBitMapAttr().
 +
  *)
 +
 
 +
  depth := GetBitMapAttr(win_rp^.BitMap, BMA_DEPTH);
 +
 
 +
  (*
 +
    Create new bitmap. With BMF_MINPLANES and the bitmap pointer we are saying
 +
    that we want a bitmap which is smaller than the target bitmap.
 +
  *)
 +
  bm := AllocBitMap(BMWIDTH, BMHEIGHT, depth, BMF_MINPLANES, win_rp^.BitMap);
 +
  if not valid(bm) then clean_exit('Can''t allocate bitmap');
 +
 +
  bm_rp := CreateRastPort;    { create rastport for our bitmap }
 +
  if not valid(bm_rp) then clean_exit('Can''t allocate rastport!');
 +
  bm_rp^.Bitmap := bm;
 +
 +
  (*
 +
    Now we can draw into our bitmap. Take care that the bitmap has no
 +
    clipping rectangle. This means we must not draw over the limits.
 +
  *)
 +
 +
  SetRast(bm_rp, 0);  { fill whole bitmap with color 0 }
 +
  SetAPen(bm_rp, pen1);
 +
  DrawCircle(bm_rp, 24, 24, 24);
 +
  SetAPen(bm_rp, pen2);
 +
  move(bm_rp,  0,  0);
 +
  Draw(bm_rp, 49, 49);
 +
  Move(bm_rp, 49,  0);
 +
  Draw(bm_rp,  0, 49);
 +
  Draw(bm_rp, 49, 49);
 +
  Draw(bm_rp, 49,  0);
 +
  Draw(bm_rp,  0,  0); 
 +
  Draw(bm_rp,  0, 49);
 +
   
 +
 +
  { for x := 20 to pred(400) step 30 do }
 +
  x := 20;
 +
  while x < 400 do
 +
  begin
 +
    (* Blit the bitmap into the window *)
 +
    ClipBlit(bm_rp, 0, 0, win_rp, x, x div 2, BMWIDTH, BMHEIGHT, $C0); 
 +
    inc(x, 30);
 +
  end;
 +
end;
 +
 +
 +
 +
procedure handle_events;
 +
var
 +
  imsg : pIntuiMessage;
 +
  port : pMsgPort;
 +
  terminated : boolean;
 +
begin
 +
  (*
 +
    A simple event handler. This will be exaplained ore detailed
 +
    in the Intuition examples.
 +
  *)
 +
  port := window^.userPort;
 +
  terminated := false;
 +
 
 +
  while not terminated do
 +
  begin
 +
    Wait(1 shl port^.mp_SigBit);
 +
    if (Assign(imsg, GetMsg(port)) <> nil) then
 +
    begin
 +
      Case imsg^.IClass of
 +
        IDCMP_CLOSEWINDOW : terminated := true;
 +
      end; { case }
 +
      ReplyMsg(pMessage(imsg));
 +
    end;
 +
 +
  end;
 +
end;
 +
 +
 +
 +
procedure clean_exit(const s: A_CONST_STRPTR);
 +
begin
 +
  If valid(s)      then WriteLn(s);
 +
 
 +
  (* Give back allocated resources *)
 +
  if valid(bm)    then FreeBitMap(bm);
 +
  if valid(bm_rp)  then FreeRastPort(bm_rp);
 +
  if (pen1 <> -1)  then ReleasePen(cm, pen1);
 +
  if (pen2 <> -1)  then ReleasePen(cm, pen2);
 +
  if valid(window) then CloseWindow(window);
 +
end;
 +
 +
 +
 +
Begin
 +
  Main();
 +
end.
 +
</source>
 +
 +
 +
 +
Original c-code [http://aros.sourceforge.net/documentation/developers/samplecode/graphics_area.c]
 +
<source lang="pascal">
 +
Program graphics_area;
 +
 +
{$MODE OBJFPC} {$H+}
 +
 +
(*
 +
  Example for area drawing routines
 +
*)
 +
 +
Uses
 +
  chelpers,
 +
  amigalib,
 +
  aros_exec,
 +
  aros_graphics,
 +
  aros_intuition,
 +
  aros_utility;
 +
 +
 +
var
 +
  window : pWindow;
 +
  cm    : pColorMap;
 +
  rp    : pRastPort;
 +
 
 +
const
 +
  (*
 +
    ObtainBestPen() returns -1 when it fails, therefore we
 +
    initialize the pen numbers with -1 to simplify cleanup.
 +
  *)
 +
  pen1  : A_LONG = -1;
 +
  pen2  : A_LONG = -1;
 +
 
 +
  MAX_POINTS = 50;
 +
 
 +
var 
 +
  ai : TAreaInfo;
 +
  tr : TTmpRas;
 +
  trbuf : Pointer;
 +
  aibuf : array[0..(MAX_POINTS+1)*5] of A_UBYTE;
 +
 +
 +
  { forward declarations }
 +
  procedure draw_area; forward;
 +
  procedure clean_exit(const s: A_CONST_STRPTR); forward;
 +
  procedure handle_events; forward;
 +
 +
 +
 +
function RASSIZE(w: integer; h: Integer): Integer; inline;
 +
begin
 +
  result := ( (h) * ( ((w)+15) shr 3 and $FFFE ));
 +
end;
 +
 +
 +
 +
 +
Function Main: Integer;
 +
begin
 +
  window := OpenWindowTags(nil,
 +
  [
 +
    WA_Left, 50,
 +
    WA_Top, 70,
 +
    WA_Width, 400,
 +
    WA_Height, 350,
 +
   
 +
    WA_Title, 'Area Graphics',
 +
    WA_Activate, True,
 +
    WA_SmartRefresh, true,
 +
    WA_NoCareRefresh, true,
 +
    WA_GimmeZeroZero, true,
 +
    WA_CloseGadget, true,
 +
    WA_DragBar, true,
 +
    WA_DepthGadget, true,
 +
    WA_IDCMP, IDCMP_CLOSEWINDOW,
 +
    TAG_END
 +
  ]);
 +
 +
  if not valid(window) then clean_exit('Can''t open window');
 +
 
 +
  rp := window^.RPort;
 +
  cm := pScreen(window^.WScreen)^.ViewPort.Colormap;
 +
 
 +
  (* Let's obtain two pens *)
 +
  {
 +
  pen1 := ObtainBestPen(cm, $FFFF0000, 0, 0, TAG_END);
 +
  pen2 := ObtainBestPen(cm, 0 ,0, $FFFF0000, TAG_END);
 +
  }
 +
  pen1 := ObtainBestPenA(cm, $FFFF0000, 0, 0, nil);
 +
  pen2 := ObtainBestPenA(cm, 0 ,0, $FFFF0000, nil);
 +
 +
  If (not valid(pen1) or not valid(pen2)) then clean_exit('Can''t allocate pen');
 +
 +
  draw_area;
 +
  handle_events;
 +
 
 +
  clean_exit(nil);
 +
 
 +
  result := 0;
 +
end;
 +
 +
 +
 +
procedure draw_area;
 +
begin
 +
  (*
 +
    The area drawing functions need two additional
 +
    structures, which have to be linked with the rastport.
 +
   
 +
    First we set the AreaInfo.
 +
    The size of 'aibuf' must be at least 5 times the number
 +
    of vertexes.
 +
    Take care: when you define the variable 'aibuf' locally, you
 +
    have to set all fields to 0.   
 +
  *)
 +
 
 +
  InitArea(@ai, @aibuf, sizeOf(aibuf) div 5);
 +
 
 +
  (*
 +
    Then we allocate a raster. It must have the size of
 +
    the drawing area. We have a GimmeZeroZero window with
 +
    no size gadget, therefore we can use the GZZ sizes. 
 +
  *)
 +
 +
  trbuf := AllocRaster(window^.GZZWidth, window^.GZZHeight);
 +
  if not valid(trbuf) then clean_exit('TmpRas buffer allocation failed!');
 +
 
 +
  (*
 +
    The raster must be initialized. The reason for RASSIZE() is
 +
    that we must round up the width to a 16 bit value
 +
  *)
 +
  InitTmpRas(@tr, trbuf, RASSIZE(window^.GZZWidth, Window^.GZZHeight));
 +
 
 +
  rp^.AreaInfo := @ai;              { Link areainfo to rastport }
 +
  rp^.TmpRas := @tr;                { Link tempras to rastport }
 +
 
 +
  SetAPen(rp, pen1);                { Set foreground color }
 +
  SetBPen(rp, pen2);                { Set background color }
 +
 
 +
  AreaMove(rp,  50, 200);          { set start point of 1st triangle }
 +
  AreaDraw(rp, 300, 100);
 +
  AreaDraw(rp, 280, 300); 
 +
 
 +
  AreaMove(rp, 200,  50);          { Set start point of 2nd triangle }
 +
  AreaDraw(rp, 210, 100);
 +
  AreaDraw(rp, 300,  75);
 +
 
 +
  AreaEllipse(rp, 70, 70, 40, 30);  { Add an ellipse }
 +
 
 +
  AreaEnd(rp);                      { Do the rendering }
 +
end;
 +
 +
 +
 +
procedure handle_events;
 +
var
 +
  imsg : pIntuiMessage;
 +
  port : pMsgPort;
 +
  terminated : boolean;
 +
begin
 +
  (*
 +
    A siple event handler. This will be exaplained ore detailed
 +
    in the Intuition examples.
 +
  *)
 +
  port := window^.userPort;
 +
  terminated := false;
 +
 
 +
  while not terminated do
 +
  begin
 +
    Wait(1 shl port^.mp_SigBit);
 +
    if (Assign(imsg, GetMsg(port)) <> nil) then
 +
    begin
 +
      Case imsg^.IClass of
 +
        IDCMP_CLOSEWINDOW : terminated := true;
 +
      end; { case }
 +
      ReplyMsg(pMessage(imsg));
 +
    end;
 +
 +
  end;
 +
end;
 +
 +
 +
 +
procedure clean_exit(const s: A_CONST_STRPTR);
 +
begin
 +
  If valid(s)      then WriteLn(s);
 +
 
 +
  (* Give back allocated resources *)
 +
  if valid(trbuf)  then FreeRaster(trbuf, window^.GZZWidth, window^.GZZHeight);
 +
  if (pen1 <> -1)  then ReleasePen(cm, pen1);
 +
  if (pen2 <> -1)  then ReleasePen(cm, pen2);
 +
  if valid(window) then CloseWindow(window);
 +
 
 +
end;
 +
 +
 +
 +
Begin
 +
  Main();
 +
end.
 +
</source>
 +
 +
 +
 +
Original c-code [http://aros.sourceforge.net/documentation/developers/samplecode/graphics_font.c]
 +
<source lang="pascal">
 +
Program graphics_font;
 +
 +
{$MODE OBJFPC} {$H+}
 +
 +
(*
 +
  Example for fonts
 +
*)
 +
 +
 +
Uses
 +
  chelpers,
 +
  amigalib,
 +
  aros_exec,
 +
  aros_graphics,
 +
  aros_intuition,
 +
  aros_diskfont,
 +
  aros_utility;
 +
 +
 +
var
 +
  window : pWindow;
 +
  cm    : pColorMap;
 +
  rp    : pRastPort;
 +
  font  : pTextFont;
 +
 
 +
const
 +
  (*
 +
    ObtainBestPen() returns -1 when it fails, therefore we
 +
    initialize the pen numbers with -1 to simplify cleanup.
 +
  *)
 +
  pen1  : A_LONG = -1;
 +
  pen2  : A_LONG = -1;
 +
 
 +
 
 +
  { forward declarations }
 +
  procedure draw_font;  forward;
 +
  procedure write_text(const s: A_CONST_STRPTR; x: A_WORD; y: A_WORD; mode: A_ULONG); forward;
 +
  procedure clean_exit(const s: A_CONST_STRPTR); forward;
 +
  procedure handle_events; forward;
 +
 +
 +
 +
Function Main: Integer;
 +
begin
 +
  window := OpenWindowTags(nil,
 +
  [
 +
    WA_Left        ,  50,
 +
    WA_Top          ,  70,
 +
    WA_Width        , 400,
 +
    WA_Height      , 350,
 +
   
 +
    WA_Title        , 'Fonts',
 +
    WA_Activate    , True,
 +
    WA_SmartRefresh , true,
 +
    WA_NoCareRefresh, true,
 +
    WA_GimmeZeroZero, true,
 +
    WA_CloseGadget  , true,
 +
    WA_DragBar      , true,
 +
    WA_DepthGadget  , true,
 +
    WA_IDCMP        , IDCMP_CLOSEWINDOW,
 +
    TAG_END
 +
  ]);
 +
 +
  if not valid(window) then clean_exit('Can''t open window');
 +
 
 +
  rp := window^.RPort;
 +
  cm := pScreen(window^.WScreen)^.ViewPort.Colormap;
 +
 
 +
  (* Let's obtain two pens *)
 +
  {
 +
  pen1 := ObtainBestPen(cm, $FFFF0000, 0, 0, TAG_END);
 +
  pen2 := ObtainBestPen(cm, 0 ,0, $FFFF0000, TAG_END);
 +
  }
 +
  pen1 := ObtainBestPenA(cm, $FFFF0000, 0, 0, nil);
 +
  pen2 := ObtainBestPenA(cm, 0 ,0, $FFFF0000, nil);
 +
 +
  If (not valid(pen1) or not valid(pen2)) then clean_exit('Can''t allocate pen');
 +
 +
  draw_font;
 +
  handle_events;
 +
 
 +
  clean_exit(nil);
 +
 
 +
  result := 0;
 +
end;
 +
 +
 +
 +
procedure draw_font;
 +
var
 +
  style : A_ULONG;
 +
  ta    : TTextAttr;
 +
begin
 +
  ta.ta_name  := 'arial.font';              { Font name }
 +
  ta.ta_YSize := 15;                        { Font size }
 +
  ta.ta_Style := FSF_ITALIC or FSF_BOLD;    { Font style }
 +
  ta.ta_Flags := 0;
 +
 +
  if not valid(assign(font, OpenDiskFont(@ta))) then
 +
  begin
 +
    clean_exit('Can''t open font');
 +
  end;
 +
 +
 +
  SetAPen(rp, pen1);
 +
  SetBPen(rp, pen2);
 +
 +
  SetFont(rp, font);        { Linking the font to the rastport }
 +
 +
  (*
 +
    In the TextAttr above we've queried a font with the styles italic and bold.
 +
    OpenDiskFont() tries to open a font with this styles. If this fails
 +
    the styles have to be generated algorithmically. To avoid that a
 +
    style will be added to a font which has already the style intrinsically,
 +
    we've first to ask. AskSoftStyle() returns a mask where all bits for styles
 +
    which have to be added algorithmically are set.
 +
  *)
 +
  style := AskSoftStyle(rp);
 +
 +
  (*
 +
    We finally set the style. SetSoftStyle() compares with the mask from
 +
    AskSoftStyle() to avoid that an intrinsic style is applied again.
 +
  *)
 +
  SetSoftStyle(rp, style, FSF_ITALIC or FSF_BOLD);
 +
 
 +
  (*
 +
    Now we write some text. Additionally the effects of the
 +
    rastport modes are demonstrated
 +
  *)
 +
  write_text('JAM1'                , 100,  60, JAM1);
 +
  write_text('JAM2'                , 100,  80, JAM2);
 +
  write_text('COMPLEMENT'          , 100, 100, COMPLEMENT);
 +
  write_text('INVERSVID'            , 100, 120, INVERSVID);
 +
  write_text('JAM1|INVERSVID'      , 100, 140, JAM1 or INVERSVID);
 +
  write_text('JAM2|INVERSVID'      , 100, 160, JAM2 or INVERSVID);
 +
  write_text('COMPLEMENT|INVERSVID' , 100, 180, COMPLEMENT or INVERSVID);
 +
end;
 +
 +
 +
 +
procedure write_text(const s: A_CONST_STRPTR; x: A_WORD; y: A_WORD; mode: A_ULONG);
 +
begin
 +
  SetDrMd(rp, mode);
 +
  Move(rp, x, y);
 +
  GText(rp, s, strlen(s));
 +
end;
 +
 +
 +
 +
procedure handle_events;
 +
var
 +
  imsg : pIntuiMessage;
 +
  port : pMsgPort;
 +
  terminated : boolean;
 +
begin
 +
  (*
 +
    A simple event handler. This will be exaplained ore detailed
 +
    in the Intuition examples.
 +
  *)
 +
  port := window^.userPort;
 +
  terminated := false;
 +
 
 +
  while not terminated do
 +
  begin
 +
    Wait(1 shl port^.mp_SigBit);
 +
    if (Assign(imsg, GetMsg(port)) <> nil) then
 +
    begin
 +
      Case imsg^.IClass of
 +
        IDCMP_CLOSEWINDOW : terminated := true;
 +
      end; { case }
 +
      ReplyMsg(pMessage(imsg));
 +
    end;
 +
 +
  end;
 +
end;
 +
 +
 +
 +
procedure clean_exit(const s: A_CONST_STRPTR);
 +
begin
 +
  If valid(s)      then WriteLn(s);
 +
 
 +
  (* Give back allocated resources *)
 +
  if (pen1 <> -1)  then ReleasePen(cm, pen1);
 +
  if (pen2 <> -1)  then ReleasePen(cm, pen2);
 +
  if valid(font)  then CloseFont(font);
 +
  if valid(window) then CloseWindow(window);
 +
end;
 +
 +
 +
 +
Begin
 +
  Main();
 +
end.
 +
</source>
 +
 +
 +
 +
Original c-code []
 +
<source lang="pascal">
 +
 +
</source>
 +
 +
 +
 +
Original c-code []
 +
<source lang="pascal">
 +
 +
</source>
 +
 +
 +
 +
Original c-code []
 +
<source lang="pascal">
 +
 +
</source>
 +
 +
 +
 +
Original c-code []
 +
<source lang="pascal">
 +
 +
</source>
 +
 +
 +
 +
Original c-code []
 +
<source lang="pascal">
 +
 +
</source>
 +
 +
 +
 +
Original c-code []
 +
<source lang="pascal">
 +
 +
</source>
 +
 +
 +
 +
Original c-code []
 +
<source lang="pascal">
 +
 +
</source>

Revision as of 08:28, 26 August 2013

Some example-code that need preperation before they can go into the wikibook.

Original c-code [1] 

Program HelloWorld;
Begin
  Writeln('Hello World');
  Exit(0);
End.


Original c-code [2] 

Program graphics_simple;

{$MODE OBJFPC} {$H+}

(*
  Example for simple drawing routines
*)


Uses
  chelpers,
  amigalib,
  aros_exec,
  aros_graphics,
  aros_intuition,
  aros_utility;


var
  window : pWindow;
  cm     : pColorMap;
  rp     : pRastPort;
  
const
  (*
    ObtainBestPen() returns -1 when it fails, therefore we
    initialize the pen numbers with -1 to simplify cleanup.
  *)
  pen1   : A_LONG = -1;
  pen2   : A_LONG = -1;
  
  
  { forward declarations }
  procedure draw_simple;  forward;
  procedure clean_exit(const s: A_CONST_STRPTR); forward;
  procedure handle_events; forward;



Function Main: Integer;
begin
  window := OpenWindowTags(nil,
  [
    WA_Left         ,  50,
    WA_Top          ,  70,
    WA_Width        , 400,
    WA_Height       , 350,
    
    WA_Title        , 'Simple Graphics',
    WA_Activate     , True,
    WA_SmartRefresh , true,
    WA_NoCareRefresh, true,
    WA_GimmeZeroZero, true,
    WA_CloseGadget  , true,
    WA_DragBar      , true,
    WA_DepthGadget  , true,
    WA_IDCMP        , IDCMP_CLOSEWINDOW,
    TAG_END
  ]);

  if not valid(window) then clean_exit('Can''t open window');
  
  rp := window^.RPort;
  cm := pScreen(window^.WScreen)^.ViewPort.Colormap;
  
  (* Let's obtain two pens *)
  {
  pen1 := ObtainBestPen(cm, $FFFF0000, 0, 0, TAG_END);
  pen2 := ObtainBestPen(cm, 0 ,0, $FFFF0000, TAG_END);
  }
  pen1 := ObtainBestPenA(cm, $FFFF0000, 0, 0, nil);
  pen2 := ObtainBestPenA(cm, 0 ,0, $FFFF0000, nil);
  If (not valid(pen1) or not valid(pen2)) then clean_exit('Can''t allocate pen');

  draw_simple;
  handle_events;
  
  clean_exit(nil);
  
  result := 0;
end;



procedure draw_simple;
var
  array_ : array[0..8-1] of A_WORD; 
begin
  array_[0] := 50;  array_[1] := 200;  { Polygon for PolyDraw }
  array_[2] := 80;  array_[3] := 180;
  array_[4] := 90;  array_[5] := 220;
  array_[6] := 50;  array_[7] := 200;

  SetAPen(rp, pen1);                    { Set foreground color }
  SetBPen(rp, pen2);                    { Set background color }

  WritePixel(rp, 30, 70);               { Plot a point }
  
  SetDrPt(rp, $FF00);                   { Change line pattern. Set pixels are drawn }
                                        { with APen, unset with BPen }
  Move(rp, 20, 50);                     { Move cursor to given point }
  Draw(rp, 100, 80);                    { Draw a line from current to given point }
  
  DrawEllipse(rp, 70, 30, 15, 10);      { Draw an ellipse }

  (*
    Draw a polygon. Note that the first line is draw from the
    end of the last Move() or Draw() command  
  *)  

  PolyDraw(rp, sizeof(array_) div sizeof(A_WORD) div 2, @array_);
  
  SetDrMd(rp, JAM1);                    { We want to use only the foreground pen }
  Move(rp, 200, 80);
  GText(rp, 'Text in default font', 20);
  
  SetDrPt(rp, $FFFF);                   { Reset line pattern }
end;



procedure write_text(const s: A_CONST_STRPTR; x: A_WORD; y: A_WORD; mode: A_ULONG);
begin
  SetDrMd(rp, mode);
  Move(rp, x, y);
  GText(rp, s, strlen(s));
end; 
 
 

procedure handle_events;
var
  imsg : pIntuiMessage;
  port : pMsgPort;
  terminated : boolean;
begin
  (*
    A simple event handler. This will be exaplained ore detailed
    in the Intuition examples.
  *)
  port := window^.userPort;
  terminated := false;
  
  while not terminated do
  begin
    Wait(1 shl port^.mp_SigBit);
    if (Assign(imsg, GetMsg(port)) <> nil) then
    begin
      Case imsg^.IClass of
        IDCMP_CLOSEWINDOW : terminated := true;
      end; { case }
      ReplyMsg(pMessage(imsg));
    end;

  end;
end;



procedure clean_exit(const s: A_CONST_STRPTR);
begin
  If valid(s)      then WriteLn(s);
  
  (* Give back allocated resources *)
  if (pen1 <> -1)  then ReleasePen(cm, pen1);
  if (pen2 <> -1)  then ReleasePen(cm, pen2);
  if valid(window) then CloseWindow(window);
end;



Begin
  Main();
end.


Original c-code [3] 

Program graphics_bitmap;

{$MODE OBJFPC} {$H+}

(*
  Example for bitmaps
*)

Uses
  chelpers,
  amigalib,
  aros_exec,
  aros_graphics,
  aros_intuition,
  aros_utility;


var
  window : pWindow;
  cm     : pColorMap;
  win_rp : pRastPort;
  
Const
  BMWIDTH  = (50);  
  BMHEIGHT = (50);

var
  bm    : pBitmap;
  bm_rp : pRastPort;
  
const
  (*
    ObtainBestPen() returns -1 when it fails, therefore we
    initialize the pen numbers with -1 to simplify cleanup.
  *)
  pen1   : A_LONG = -1;
  pen2   : A_LONG = -1;
  
  
  { forward declarations }
  procedure draw_bitmap;  forward;
  procedure clean_exit(const s: A_CONST_STRPTR); forward;
  procedure handle_events; forward;


{
function RASSIZE(w: integer; h: Integer): Integer; inline;
begin
  result := ( (h) * ( ((w)+15) shr 3 and $FFFE ));
end;
}
Procedure DrawCircle(rp: pRastPort; cx: A_LONG; cy: A_LONG; r:A_LONG); inline;
begin
  DrawEllipse(rp, cx, cy, r, r);
end;




Function Main: Integer;
begin
  window := OpenWindowTags(nil,
  [
    WA_Left         ,  50,
    WA_Top          ,  70,
    WA_Width        , 400,
    WA_Height       , 350,
    
    WA_Title        , 'Bitmap Graphics',
    WA_Activate     , True,
    WA_SmartRefresh , true,
    WA_NoCareRefresh, true,
    WA_GimmeZeroZero, true,
    WA_CloseGadget  , true,
    WA_DragBar      , true,
    WA_DepthGadget  , true,
    WA_IDCMP        , IDCMP_CLOSEWINDOW,
    TAG_END
  ]);

  if not valid(window) then clean_exit('Can''t open window');
  
  win_rp := window^.RPort;
  cm     := pScreen(window^.WScreen)^.ViewPort.Colormap;
  
  (* Let's obtain two pens *)
  {
  pen1 := ObtainBestPen(cm, $FFFF0000, 0, 0, TAG_END);
  pen2 := ObtainBestPen(cm, 0 ,0, $FFFF0000, TAG_END);
  }
  pen1 := ObtainBestPenA(cm, $FFFF0000, 0, 0, nil);
  pen2 := ObtainBestPenA(cm, 0 ,0, $FFFF0000, nil);

  If (not valid(pen1) or not valid(pen2)) then clean_exit('Can''t allocate pen');

  draw_bitmap;
  handle_events;
  
  clean_exit(nil);
  
  result := 0;
end;



procedure draw_bitmap;
var
  Depth : A_UWORD; x: integer;
begin
  (*
    Get the depth of the screen. Don't peek in the structures, always use
    GetBitMapAttr().
  *)
  
  depth := GetBitMapAttr(win_rp^.BitMap, BMA_DEPTH);
  
  (*
    Create new bitmap. With BMF_MINPLANES and the bitmap pointer we are saying
    that we want a bitmap which is smaller than the target bitmap.
  *)
  bm := AllocBitMap(BMWIDTH, BMHEIGHT, depth, BMF_MINPLANES, win_rp^.BitMap);
  if not valid(bm) then clean_exit('Can''t allocate bitmap');

  bm_rp := CreateRastPort;     { create rastport for our bitmap }
  if not valid(bm_rp) then clean_exit('Can''t allocate rastport!');
  bm_rp^.Bitmap := bm;

  (*
    Now we can draw into our bitmap. Take care that the bitmap has no
    clipping rectangle. This means we must not draw over the limits.
  *)

  SetRast(bm_rp, 0);   { fill whole bitmap with color 0 }
  SetAPen(bm_rp, pen1);
  DrawCircle(bm_rp, 24, 24, 24);
  SetAPen(bm_rp, pen2);
  move(bm_rp,  0,  0);
  Draw(bm_rp, 49, 49);
  Move(bm_rp, 49,  0);
  Draw(bm_rp,  0, 49);
  Draw(bm_rp, 49, 49);
  Draw(bm_rp, 49,  0);
  Draw(bm_rp,  0,  0);  
  Draw(bm_rp,  0, 49);
    

  { for x := 20 to pred(400) step 30 do }
  x := 20;
  while x < 400 do
  begin
    (* Blit the bitmap into the window *)
    ClipBlit(bm_rp, 0, 0, win_rp, x, x div 2, BMWIDTH, BMHEIGHT, $C0);  
    inc(x, 30);
  end;
end;



procedure handle_events;
var
  imsg : pIntuiMessage;
  port : pMsgPort;
  terminated : boolean;
begin
  (*
    A simple event handler. This will be exaplained ore detailed
    in the Intuition examples.
  *)
  port := window^.userPort;
  terminated := false;
  
  while not terminated do
  begin
    Wait(1 shl port^.mp_SigBit);
    if (Assign(imsg, GetMsg(port)) <> nil) then
    begin
      Case imsg^.IClass of
        IDCMP_CLOSEWINDOW : terminated := true;
      end; { case }
      ReplyMsg(pMessage(imsg));
    end;

  end;
end;



procedure clean_exit(const s: A_CONST_STRPTR);
begin
  If valid(s)      then WriteLn(s);
  
  (* Give back allocated resources *)
  if valid(bm)     then FreeBitMap(bm);
  if valid(bm_rp)  then FreeRastPort(bm_rp);
  if (pen1 <> -1)  then ReleasePen(cm, pen1);
  if (pen2 <> -1)  then ReleasePen(cm, pen2);
  if valid(window) then CloseWindow(window);
end;



Begin
  Main();
end.


Original c-code [4] 

Program graphics_area;

{$MODE OBJFPC} {$H+}

(*
  Example for area drawing routines
*)

Uses
  chelpers,
  amigalib,
  aros_exec,
  aros_graphics,
  aros_intuition,
  aros_utility;


var
  window : pWindow;
  cm     : pColorMap;
  rp     : pRastPort;
  
const
  (*
    ObtainBestPen() returns -1 when it fails, therefore we
    initialize the pen numbers with -1 to simplify cleanup.
  *)
  pen1   : A_LONG = -1;
  pen2   : A_LONG = -1;
  
  MAX_POINTS = 50;
  
var  
  ai : TAreaInfo;
  tr : TTmpRas;
  trbuf : Pointer;
  aibuf : array[0..(MAX_POINTS+1)*5] of A_UBYTE;


  { forward declarations }
  procedure draw_area; forward;
  procedure clean_exit(const s: A_CONST_STRPTR); forward;
  procedure handle_events; forward;



function RASSIZE(w: integer; h: Integer): Integer; inline;
begin
  result := ( (h) * ( ((w)+15) shr 3 and $FFFE ));
end;




Function Main: Integer;
begin
  window := OpenWindowTags(nil,
  [
    WA_Left, 50,
    WA_Top, 70,
    WA_Width, 400,
    WA_Height, 350,
    
    WA_Title, 'Area Graphics',
    WA_Activate, True,
    WA_SmartRefresh, true,
    WA_NoCareRefresh, true,
    WA_GimmeZeroZero, true,
    WA_CloseGadget, true,
    WA_DragBar, true,
    WA_DepthGadget, true,
    WA_IDCMP, IDCMP_CLOSEWINDOW,
    TAG_END
  ]);

  if not valid(window) then clean_exit('Can''t open window');
  
  rp := window^.RPort;
  cm := pScreen(window^.WScreen)^.ViewPort.Colormap;
  
  (* Let's obtain two pens *)
  {
  pen1 := ObtainBestPen(cm, $FFFF0000, 0, 0, TAG_END);
  pen2 := ObtainBestPen(cm, 0 ,0, $FFFF0000, TAG_END);
  }
  pen1 := ObtainBestPenA(cm, $FFFF0000, 0, 0, nil);
  pen2 := ObtainBestPenA(cm, 0 ,0, $FFFF0000, nil);

  If (not valid(pen1) or not valid(pen2)) then clean_exit('Can''t allocate pen');

  draw_area;
  handle_events;
  
  clean_exit(nil);
  
  result := 0;
end;



procedure draw_area;
begin
  (*
    The area drawing functions need two additional
    structures, which have to be linked with the rastport.
    
    First we set the AreaInfo.
    The size of 'aibuf' must be at least 5 times the number
    of vertexes.
    Take care: when you define the variable 'aibuf' locally, you
    have to set all fields to 0.    
  *)
  
  InitArea(@ai, @aibuf, sizeOf(aibuf) div 5);
  
  (*
    Then we allocate a raster. It must have the size of
    the drawing area. We have a GimmeZeroZero window with
    no size gadget, therefore we can use the GZZ sizes.  
  *)

  trbuf := AllocRaster(window^.GZZWidth, window^.GZZHeight);
  if not valid(trbuf) then clean_exit('TmpRas buffer allocation failed!');
  
  (*
    The raster must be initialized. The reason for RASSIZE() is
    that we must round up the width to a 16 bit value
  *)
  InitTmpRas(@tr, trbuf, RASSIZE(window^.GZZWidth, Window^.GZZHeight));
  
  rp^.AreaInfo := @ai;              { Link areainfo to rastport }
  rp^.TmpRas := @tr;                { Link tempras to rastport }
  
  SetAPen(rp, pen1);                { Set foreground color }
  SetBPen(rp, pen2);                { Set background color }
  
  AreaMove(rp,  50, 200);           { set start point of 1st triangle }
  AreaDraw(rp, 300, 100);
  AreaDraw(rp, 280, 300);  
  
  AreaMove(rp, 200,  50);           { Set start point of 2nd triangle }
  AreaDraw(rp, 210, 100);
  AreaDraw(rp, 300,  75);
  
  AreaEllipse(rp, 70, 70, 40, 30);  { Add an ellipse }
  
  AreaEnd(rp);                      { Do the rendering }
end;



procedure handle_events;
var
  imsg : pIntuiMessage;
  port : pMsgPort;
  terminated : boolean;
begin
  (*
    A siple event handler. This will be exaplained ore detailed
    in the Intuition examples.
  *)
  port := window^.userPort;
  terminated := false;
  
  while not terminated do
  begin
    Wait(1 shl port^.mp_SigBit);
    if (Assign(imsg, GetMsg(port)) <> nil) then
    begin
      Case imsg^.IClass of
        IDCMP_CLOSEWINDOW : terminated := true;
      end; { case }
      ReplyMsg(pMessage(imsg));
    end;

  end;
end;



procedure clean_exit(const s: A_CONST_STRPTR);
begin
  If valid(s)      then WriteLn(s);
  
  (* Give back allocated resources *)
  if valid(trbuf)  then FreeRaster(trbuf, window^.GZZWidth, window^.GZZHeight);
  if (pen1 <> -1)  then ReleasePen(cm, pen1);
  if (pen2 <> -1)  then ReleasePen(cm, pen2);
  if valid(window) then CloseWindow(window);
  
end;



Begin
  Main();
end.


Original c-code [5] 

Program graphics_font;

{$MODE OBJFPC} {$H+}

(*
  Example for fonts
*)


Uses
  chelpers,
  amigalib,
  aros_exec,
  aros_graphics,
  aros_intuition,
  aros_diskfont,
  aros_utility;


var
  window : pWindow;
  cm     : pColorMap;
  rp     : pRastPort;
  font   : pTextFont;
  
const
  (*
    ObtainBestPen() returns -1 when it fails, therefore we
    initialize the pen numbers with -1 to simplify cleanup.
  *)
  pen1   : A_LONG = -1;
  pen2   : A_LONG = -1;
  
  
  { forward declarations }
  procedure draw_font;  forward;
  procedure write_text(const s: A_CONST_STRPTR; x: A_WORD; y: A_WORD; mode: A_ULONG); forward;
  procedure clean_exit(const s: A_CONST_STRPTR); forward;
  procedure handle_events; forward;



Function Main: Integer;
begin
  window := OpenWindowTags(nil,
  [
    WA_Left         ,  50,
    WA_Top          ,  70,
    WA_Width        , 400,
    WA_Height       , 350,
    
    WA_Title        , 'Fonts',
    WA_Activate     , True,
    WA_SmartRefresh , true,
    WA_NoCareRefresh, true,
    WA_GimmeZeroZero, true,
    WA_CloseGadget  , true,
    WA_DragBar      , true,
    WA_DepthGadget  , true,
    WA_IDCMP        , IDCMP_CLOSEWINDOW,
    TAG_END
  ]);

  if not valid(window) then clean_exit('Can''t open window');
  
  rp := window^.RPort;
  cm := pScreen(window^.WScreen)^.ViewPort.Colormap;
  
  (* Let's obtain two pens *)
  {
  pen1 := ObtainBestPen(cm, $FFFF0000, 0, 0, TAG_END);
  pen2 := ObtainBestPen(cm, 0 ,0, $FFFF0000, TAG_END);
  }
  pen1 := ObtainBestPenA(cm, $FFFF0000, 0, 0, nil);
  pen2 := ObtainBestPenA(cm, 0 ,0, $FFFF0000, nil);

  If (not valid(pen1) or not valid(pen2)) then clean_exit('Can''t allocate pen');

  draw_font;
  handle_events;
  
  clean_exit(nil);
  
  result := 0;
end;



procedure draw_font;
var
  style : A_ULONG;
  ta    : TTextAttr;
begin
  ta.ta_name  := 'arial.font';              { Font name }
  ta.ta_YSize := 15;                        { Font size }
  ta.ta_Style := FSF_ITALIC or FSF_BOLD;    { Font style }
  ta.ta_Flags := 0;

  if not valid(assign(font, OpenDiskFont(@ta))) then
  begin
    clean_exit('Can''t open font');
  end;


  SetAPen(rp, pen1);
  SetBPen(rp, pen2);

  SetFont(rp, font);        { Linking the font to the rastport }

  (*
    In the TextAttr above we've queried a font with the styles italic and bold.
    OpenDiskFont() tries to open a font with this styles. If this fails
    the styles have to be generated algorithmically. To avoid that a
    style will be added to a font which has already the style intrinsically,
    we've first to ask. AskSoftStyle() returns a mask where all bits for styles
    which have to be added algorithmically are set.
  *)
  style := AskSoftStyle(rp);

  (*
    We finally set the style. SetSoftStyle() compares with the mask from
    AskSoftStyle() to avoid that an intrinsic style is applied again.
  *)
  SetSoftStyle(rp, style, FSF_ITALIC or FSF_BOLD);
  
  (*
    Now we write some text. Additionally the effects of the
    rastport modes are demonstrated
  *)
  write_text('JAM1'                 , 100,  60, JAM1);
  write_text('JAM2'                 , 100,  80, JAM2);
  write_text('COMPLEMENT'           , 100, 100, COMPLEMENT);
  write_text('INVERSVID'            , 100, 120, INVERSVID);
  write_text('JAM1|INVERSVID'       , 100, 140, JAM1 or INVERSVID);
  write_text('JAM2|INVERSVID'       , 100, 160, JAM2 or INVERSVID);
  write_text('COMPLEMENT|INVERSVID' , 100, 180, COMPLEMENT or INVERSVID);
end;



procedure write_text(const s: A_CONST_STRPTR; x: A_WORD; y: A_WORD; mode: A_ULONG);
begin
  SetDrMd(rp, mode);
  Move(rp, x, y);
  GText(rp, s, strlen(s));
end; 
 
 

procedure handle_events;
var
  imsg : pIntuiMessage;
  port : pMsgPort;
  terminated : boolean;
begin
  (*
    A simple event handler. This will be exaplained ore detailed
    in the Intuition examples.
  *)
  port := window^.userPort;
  terminated := false;
  
  while not terminated do
  begin
    Wait(1 shl port^.mp_SigBit);
    if (Assign(imsg, GetMsg(port)) <> nil) then
    begin
      Case imsg^.IClass of
        IDCMP_CLOSEWINDOW : terminated := true;
      end; { case }
      ReplyMsg(pMessage(imsg));
    end;

  end;
end;



procedure clean_exit(const s: A_CONST_STRPTR);
begin
  If valid(s)      then WriteLn(s);
  
  (* Give back allocated resources *)
  if (pen1 <> -1)  then ReleasePen(cm, pen1);
  if (pen2 <> -1)  then ReleasePen(cm, pen2);
  if valid(font)   then CloseFont(font);
  if valid(window) then CloseWindow(window);
end;



Begin
  Main();
end.


Original c-code []


Original c-code []


Original c-code []


Original c-code []


Original c-code []


Original c-code []


Original c-code []

Retrieved from "http://fpcamigawiki.alb42.de/index.php?title=Examplecode&oldid=36"