added postscript canvas example from Olivier

git-svn-id: trunk@6110 -
2025-04-07 18:58:04 +02:00 · 2004-10-04 09:05:23 +00:00 · 2004-10-04 09:05:23 +00:00 · 2cca8f143f
commit 2cca8f143f
parent 68955cf841
7 changed files with 325 additions and 2 deletions
--- a/.gitattributes
+++ b/.gitattributes
@ -502,6 +502,11 @@ examples/objectinspector/mainunit.lrs svneol=native#text/pascal
 examples/objectinspector/mainunit.pas svneol=native#text/pascal
 examples/objectinspector/oiexample.lpi svneol=native#text/plain
 examples/objectinspector/oiexample.lpr svneol=native#text/pascal
+examples/postscript/samplepostscriptcanvas.lpi svneol=native#text/plain
+examples/postscript/samplepostscriptcanvas.lpr svneol=native#text/pascal
+examples/postscript/usamplepostscriptcanvas.lfm svneol=native#text/plain
+examples/postscript/usamplepostscriptcanvas.lrs svneol=native#text/pascal
+examples/postscript/usamplepostscriptcanvas.pas svneol=native#text/pascal
 examples/progressbar.pp svneol=native#text/pascal
 examples/scrollbar.pp svneol=native#text/pascal
 examples/selection.pp svneol=native#text/pascal
--- a/examples/postscript/samplepostscriptcanvas.lpi
+++ b/examples/postscript/samplepostscriptcanvas.lpi
@ -0,0 +1,66 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="5"/>
+    <General>
+      <Flags>
+        <SaveClosedFiles Value="False"/>
+        <SaveOnlyProjectUnits Value="True"/>
+      </Flags>
+      <MainUnit Value="0"/>
+      <ActiveEditorIndexAtStart Value="1"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+      <Title Value="samplepostscriptcanvas"/>
+    </General>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="samplepostscriptcanvas.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="samplepostscriptcanvas"/>
+        <UsageCount Value="20"/>
+      </Unit0>
+      <Unit1>
+        <CursorPos X="21" Y="9"/>
+        <EditorIndex Value="0"/>
+        <Filename Value="usamplepostscriptcanvas.pas"/>
+        <ComponentName Value="Form1"/>
+        <IsPartOfProject Value="True"/>
+        <Loaded Value="True"/>
+        <ResourceFilename Value="usamplepostscriptcanvas.lrs"/>
+        <TopLine Value="1"/>
+        <UnitName Value="uSamplePostScriptCanvas"/>
+        <UsageCount Value="20"/>
+      </Unit1>
+    </Units>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="2"/>
+    <SearchPaths>
+      <SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>
--- a/examples/postscript/samplepostscriptcanvas.lpr
+++ b/examples/postscript/samplepostscriptcanvas.lpr
@ -0,0 +1,15 @@
+program samplepostscriptcanvas;
+
+{$mode objfpc}{$H+}
+
+uses
+  Interfaces, // this includes the LCL widgetset
+  Forms
+  { add your units here }, uSamplePostScriptCanvas;
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+
--- a/examples/postscript/usamplepostscriptcanvas.lfm
+++ b/examples/postscript/usamplepostscriptcanvas.lfm
@ -0,0 +1,31 @@
+object Form1: TForm1
+  ActiveControl = Button1
+  Caption = 'Form1'
+  ClientHeight = 97
+  ClientWidth = 400
+  PixelsPerInch = 90
+  HorzScrollBar.Page = 401
+  VertScrollBar.Page = 98
+  Left = 310
+  Height = 97
+  Top = 163
+  Width = 400
+  object Button1: TButton
+    Caption = 'Generate a PostScript file'
+    OnClick = Button1Click
+    TabOrder = 0
+    Left = 24
+    Height = 25
+    Top = 23
+    Width = 352
+  end
+  object Button2: TButton
+    Caption = 'Show this file (kghostview)'
+    OnClick = Button2Click
+    TabOrder = 1
+    Left = 24
+    Height = 25
+    Top = 56
+    Width = 352
+  end
+end
--- a/examples/postscript/usamplepostscriptcanvas.lrs
+++ b/examples/postscript/usamplepostscriptcanvas.lrs
@ -0,0 +1,13 @@
+{ Ceci est un fichier ressource généré automatiquement par Lazarus }
+
+LazarusResources.Add('TForm1','FORMDATA',[
+  'TPF0'#6'TForm1'#5'Form1'#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'
+  +#12'ClientHeight'#2'a'#11'ClientWidth'#3#144#1#13'PixelsPerInch'#2'Z'#18'Hor'
+  +'zScrollBar.Page'#3#145#1#18'VertScrollBar.Page'#2'b'#4'Left'#3'6'#1#6'Heigh'
+  +'t'#2'a'#3'Top'#3#163#0#5'Width'#3#144#1#0#7'TButton'#7'Button1'#7'Caption'#6
+  +#26'Generate a PostScript file'#7'OnClick'#7#12'Button1Click'#8'TabOrder'#2#0
+  +#4'Left'#2#24#6'Height'#2#25#3'Top'#2#23#5'Width'#3'`'#1#0#0#7'TButton'#7'Bu'
+  +'tton2'#7'Caption'#6#27'Show this file (kghostview)'#7'OnClick'#7#12'Button2'
+  +'Click'#8'TabOrder'#2#1#4'Left'#2#24#6'Height'#2#25#3'Top'#2'8'#5'Width'#3'`'
+  +#1#0#0#0
+]);
--- a/examples/postscript/usamplepostscriptcanvas.pas
+++ b/examples/postscript/usamplepostscriptcanvas.pas
@ -0,0 +1,190 @@
+unit uSamplePostScriptCanvas;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
+  PostScriptCanvas, Unix;
+
+type
+  TForm1 = class(TForm)
+    Button1: TButton;
+    Button2: TButton;
+    procedure Button1Click(Sender: TObject);
+    procedure Button2Click(Sender: TObject);
+  private
+    { private declarations }
+  public
+    { public declarations }
+  end; 
+
+var
+  Form1: TForm1; 
+
+implementation
+
+{ TForm1 }
+
+procedure TForm1.Button1Click(Sender: TObject);
+var
+    Pt : Array[0..2] of TPoint;
+    Pt1: Array[0..3] of TPoint;
+    Bmp : TBitMap;
+    Xpm : TPixMap;
+begin
+  if Sender=nil then ;
+  With TPostscriptCanvas.Create do
+  try
+    PageHeight:=842;
+    PageWidth:=595;
+    TopMarging :=40;
+    LeftMarging:=20;
+
+    BeginDoc;
+    Font.Size:=24;
+    Font.Style:=[fsBold,fsItalic,fsUnderline];
+    TextOut(100,-10,'PostScript Canvas Lazarus sample');
+    Font.Size:=12;
+    Brush.Color:=clRed;
+    Pen.Width:=1;
+    RoundRect(10,10,100,100,8,8);
+    Brush.Color:=clMaroon;
+    Rectangle(130,10,220,100);
+    Font.Name:='Courier';
+    Font.Style:=[fsUnderline];
+    TextOut(240,20,'Underline text '+#13#10+'sample (éàçè)');
+    Font.Style:=[fsUnderline,fsBold];
+    TextOut(240,35,'Underline and bold text sample (éàçè)');
+    Font.Style:=[fsItalic];
+    TextOut(240,50,'Italic text sample (éàçè)');
+    Font.Style:=[];
+    TextOut(240,65,'Normal text sample (àçèéù)');
+
+    Pen.Style:=psSolid;
+    Brush.Color:=clGreen;
+    Ellipse(10,260,60,310);
+
+    Brush.Color:=clTeal;
+    Brush.Style:=bsSolid;
+    RadialPie(10,380,50,50,0,60*16);
+
+    Pen.Style:=psSolid;
+    Brush.Color:=clGray;
+    Pt[0]:=Point(10,140);
+    Pt[1]:=Point(10,240);
+    Pt[2]:=Point(140,140);
+    Polygon(@Pt,3,True);
+
+    Pen.Style:=psDot;
+    Pt1[0]:=Point(10,400);
+    Pt1[1]:=Point(50,390);
+    Pt1[2]:=Point(120,410);
+    Pt1[3]:=Point(180,425);
+    Polyline(@Pt1,4);
+    Brush.Color:=clAqua;
+    Pen.Style:=psSolid;
+    Pt1[0]:=Point(10,430);
+    PolyBezier(@Pt1,4,true,True);
+
+    TextOut(240,165,'Line style=psSolid');
+    Pen.Style:=psSolid;
+    Line(360,168,450,168);
+    TextOut(240,185,'Line style=psDash');
+    Pen.Style:=psDash;
+    Line(360,188,450,188);
+    TextOut(240,205,'Line style=psDot');
+    Pen.Style:=psDot;
+    Line(360,208,450,208);
+    TextOut(240,225,'Line style=psDashDot');
+    Pen.Style:=psDashDot;
+    Line(360,228,450,228);
+    TextOut(240,245,'Line style=psDashDotDot');
+    Pen.Style:=psDashDotDot;
+    Line(360,248,450,248);
+
+    Pen.Style:=psSolid;
+    Brush.Color:=clBlack;
+    Brush.Style:=bsCross;
+    Rectangle(240,260,290,300);
+    TextOut(300,285,'Brush.Style:=bsCross');
+    Brush.Style:=bsDiagCross;
+    Rectangle(240,310,290,350);
+    TextOut(300,335,'Brush.Style:=bsDiagCross');
+    Brush.Style:=bsBDiagonal;
+    Rectangle(240,360,290,400);
+    TextOut(300,385,'Brush.Style:=bsBDiagonal');
+    Brush.Style:=bsFDiagonal;
+    Rectangle(240,410,290,450);
+    TextOut(300,435,'Brush.Style:=bsFDiagonal');
+    Brush.Style:=bsVertical;
+    Rectangle(240,460,290,500);
+    TextOut(300,485,'Brush.Style:=bsVertical');
+    Brush.Style:=bsHorizontal;
+    Rectangle(240,510,290,550);
+    TextOut(300,535,'Brush.Style:=bsHorizontal');
+
+    Bmp:=TBitMap.Create;
+    try
+      Bmp.LoadFromFile(ExpandFileName('./10.bmp'));
+      DRaw(10,450,BMP);
+    finally
+      Bmp.Free;
+    end;
+
+    xpm:=TPixMap.Create;
+    try
+      xpm.LoadFromFile(ExpandFileName('./10.xpm'));
+      StretchDraw(Rect(10,500,110,600),xpm);
+    finally
+      xpm.Free;
+    end;
+
+    NewPage;
+
+    Pen.Color:=clBlack;
+    Brush.Color:=clTeal;
+    Brush.Style:=bsSolid;
+    Chord(10,380,50,50,0,60*16);
+
+    Pen.Style:=psSolid;
+    Brush.Color:=clBlack;
+    Brush.Style:=bsCross;
+    Rectangle(240,260,290,300);
+    TextOut(300,285,'Brush.Style:=bsCross');
+    Brush.Style:=bsDiagCross;
+    Rectangle(240,310,290,350);
+    TextOut(300,335,'Brush.Style:=bsDiagCross');
+    Brush.Style:=bsBDiagonal;
+    Rectangle(240,360,290,400);
+    TextOut(300,385,'Brush.Style:=bsBDiagonal');
+    Brush.Style:=bsFDiagonal;
+    Rectangle(240,410,290,450);
+    TextOut(300,435,'Brush.Style:=bsFDiagonal');
+    Brush.Style:=bsVertical;
+    Rectangle(240,460,290,500);
+    TextOut(300,485,'Brush.Style:=bsVertical');
+    Brush.Style:=bsHorizontal;
+    Rectangle(240,510,290,550);
+    TextOut(300,535,'Brush.Style:=bsHorizontal');
+
+    EndDoc;
+    SaveToFile('./test1.ps');
+  finally
+    Free;
+  end;
+end;
+
+procedure TForm1.Button2Click(Sender: TObject);
+begin
+  if Sender=nil then ;
+  if FileExists(ExpandFileName('./test1.ps')) then
+    Shell(format('kghostview %s',[ExpandFileName('./test1.ps')]));
+end;
+
+initialization
+  {$I usamplepostscriptcanvas.lrs}
+
+end.
+
--- a/lcl/alllclunits.pp
+++ b/lcl/alllclunits.pp
@ -44,8 +44,8 @@ uses
  StdActns, Buttons, Extctrls, Calendar, Clipbrd, Forms, LCLIntf, Spin,
  Comctrls, Graphics, StdCtrls, Arrow, Controls, ImgList, Menus, Toolwin,
  Dialogs, Messages, Clistbox, ActnList, Grids, MaskEdit,
-  Printers, PostScriptPrinter, CheckLst, PairSplitter, ExtDlgs,
-  DBCtrls, DBGrids, DBActns, EditBtn, ExtGraphics,
+  Printers, PostScriptPrinter, PostScriptCanvas, CheckLst, PairSplitter,
+  ExtDlgs, DBCtrls, DBGrids, DBActns, EditBtn, ExtGraphics,
  PropertyStorage, IniPropStorage, XMLPropStorage, Chart,
  // widgetset skeleton
  WSActnList, WSArrow, WSButtons, WSCalendar,
@ -64,6 +64,9 @@ end.
 { =============================================================================

  $Log$
+  Revision 1.23  2004/10/04 09:05:23  mattias
+  added postscript canvas example  from Olivier
+
  Revision 1.22  2004/09/27 21:45:44  vincents
  splitted off unit FileUtil, it doesn't depend on other LCL units