TPW Graph unit - is anyone interested? 
Author Message
 TPW Graph unit - is anyone interested?

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

For the non-Windows-programmers, I have written a WinGraph unit some
time ago (you know, Graph is missing). It works, but some things that
cannot be done in GDI or are very slow in GDI (user-defined line
styles aka UserBitLn) are not defined. Is anyone interested in it? I
could post it in this newsgroup if you want to (<1600 lines).
Even the sound and delay functions from crt are implemented (the
delay is RTE-200 free, it uses GetTickCount).

-----BEGIN PGP SIGNATURE-----
Version: PGPfreeware 6.5.1 Int. for non-commercial use
< http://www.*-*-*.com/ >
Comment: Get a free virus at file://localhost/dev/aux/clock$

iQA/AwUBOWxS5pHoP2uzWQlaEQLZmQCdFrberNmfHf+EBYeMBvSqX2AUtacAn1A2
HKjj8EwpmbFYh0Lccb5HfRgv
=yspS
-----END PGP SIGNATURE-----



Wed, 18 Jun 1902 08:00:00 GMT  
 TPW Graph unit - is anyone interested?

Quote:
Seiberdragan wrote...
>For the non-Windows-programmers, I have written a WinGraph unit some
>time ago (you know, Graph is missing). It works, but some things that
>cannot be done in GDI or are very slow in GDI (user-defined line
>styles aka UserBitLn) are not defined. Is anyone interested in it? I
>could post it in this newsgroup if you want to (<1600 lines).
>Even the sound and delay functions from crt are implemented (the
>delay is RTE-200 free, it uses GetTickCount).

Sure, .... unless someone object such a useful 1600 lines posting.


Wed, 18 Jun 1902 08:00:00 GMT  
 TPW Graph unit - is anyone interested?

Quote:
Seiberdragan wrote...
>For the non-Windows-programmers, I have written a WinGraph unit some
>time ago (you know, Graph is missing). It works, but some things that
>cannot be done in GDI or are very slow in GDI (user-defined line
>styles aka UserBitLn) are not defined. Is anyone interested in it? I
>could post it in this newsgroup if you want to (<1600 lines).
>Even the sound and delay functions from crt are implemented (the
>delay is RTE-200 free, it uses GetTickCount).

A <1600 line posting would be a bit long.
But unless someone volunteer a web space, I second your suggestion
for posting it here.

Any volunteer? Any objection?



Wed, 18 Jun 1902 08:00:00 GMT  
 TPW Graph unit - is anyone interested?
Part 1: WINGRAPH.PAS
unit WinGraph;

{
if you want to see the comment: it is in the next message

Quote:
}

{$R-,I-}
{$D+,L+,G+,W-,A+}

{$DEFINE SOUND}

{ Entfernen des Leerzeichens schaltet die Sound- und NoSound-Prozeduren
ein }

interface

const framerate: integer = 25;
      WingraphVersion = '1.0';

type FillSettingsType = record
                              Pattern : Word;
                              Color, Color24: Longint;
                        end;
     LineSettingsType = record
                              LineStyle : Word;
                              Pattern   : Word;
                              Thickness : Word;
                        end;
     TextSettingsType = record
                              Font      : String;
                              Direction : Longint;
                              CharSize  : Word;
                              Horiz     : Longint;
                              Vert      : Longint;
                        end;
     ViewPortType = record
                          x1, y1, x2, y2 : integer;
                          Clip           : Boolean;
                    end;
     PointType = record
                       x, y: integer;
                 end;

function nospace (x: string): string;
{ entfernt Leerstellen am Anfang oder Ende eines Strings }

procedure Swap (var x, y: integer);
{ vertauscht die Integervariablen x und y }

const Detect = 0;
      deg = PI / 180;

      ClipOn = true;
      ClipOff = false;
      TopOn = true;
      TopOff = false;

      EmptyFill = 0;
      SolidFill = 1;
      LineFill = 2;
      LtSlashFill = 3;
      SlashFill = 4;
      BkSlashFill = 5;
      LtBkSlashFill = 6;
      HatchFill = 7;
      XHatchFill = 8;
      InterleaveFill = 9;
      WideDotFill = 10;
      CloseDotFill = 11;
      UserFill = 12;

      SolidLn = 0;
      DottedLn = 1;     { - - - - }
      CenterLn = 2;     { -- - -- }
      DashedLn = 3;     { -- -- --}
      UserBitLn = 4;
      NormWidth = 1;
      ThickWidth = 3;

      DefaultFont = 'face:=Courier New;base:=8';
      TriplexFont = 'face:=Times New Roman;base:=8;origin:=5';
      SansSerifFont = 'face:=Arial;base:=8;origin:=5';
      GothicFont = 'face:=Marriage;base:=8;origin:=5';
      SmallFont = 'face:=Small Fonts;base:=3;origin:=2';

      LeftText = -1;
      RightText = 1;
      TopText = -1;
      BottomText = 1;
      CenterText = 0;

      HorizDir = 0;
      VertDir = 900;

      Black = 0;
      Blue = 1;
      Green = 2;
      Cyan = 3;
      Red = 4;
      Magenta = 5;
      Brown = 6;
      LightGray = 7;
      DarkGray = 8;
      LightBlue = 9;
      LightGreen = 10;
      LightCyan = 11;
      LightRed = 12;
      LightMagenta = 13;
      Yellow = 14;
      White = 15;

      NormalPut     = 0;    { MOV }       { left for 1.0 compatibility }
      CopyPut       = 0;    { MOV }
      XORPut        = 1;    { XOR }
      OrPut         = 2;    { OR  }
      AndPut        = 3;    { AND }
      NotPut        = 4;    { NOT }

      grOk = 0;

{ *** todo *** bald read-only }

const GetMaxColor = 15;
      MaxColors = GetMaxColor;

procedure PutPixel24 (x, y: integer; c: longint);
function GetPixel24 (x, y: integer): longint;
procedure SetColor24 (c: longint);
function GetColor24: longint;
procedure SetFillStyle24 (fs: integer; col: longint);
procedure FloodFill24 (x, y: integer; border: longint);
function GetRedValue (c: longint): integer;
function GetGreenValue (c: longint): integer;
function GetBlueValue (c: longint): integer;
function GetCColor (c: longint): longint;
function RGBColor (r, g, b: byte): longint;
{ diese hier sind eigentlich klar :-) }

procedure UpdateWindow;
procedure NoViewPort;
{ entspricht SetViewPort (0, 0, GetMaxX, GetMaxY, ClipOff); }

procedure Arc (X, Y: integer; stangle, endangle, radius: word);
{ setzt noch keine ArcCoords!!! }

procedure Bar (x1, y1, x2, y2: integer);
procedure Bar3D (x1, y1, x2, y2, depth: integer; hasTop: boolean);
procedure Circle (x, y, r: integer);
procedure ClearDevice;
procedure ClearViewPort;
procedure CloseGraph;
procedure DestroyImage(var BitMap);
procedure DrawPoly (NumPoints: word; var PolyPoints);
procedure Ellipse (x, y, astart, aend, rx, ry: integer);
procedure FillEllipse (X, Y: integer; xr, yr: word);
procedure FillPoly (NumPoints: word; var PolyPoints);
procedure FloodFill (x, y: integer; border: longint);
function GetColor: longint;
procedure GetFillSettings (var s: FillSettingsType);
procedure GetImage(x1, y1, x2, y2 : integer; var BitMap);
procedure GetLineSettings (var s: LineSettingsType);
function GetMaxX: longint;
function GetMaxY: longint;
function GetPixel (x, y: integer): longint;
procedure GetTextSettings (var s: TextSettingsType);
procedure GetViewSettings (var v: viewporttype);
function GetX: longint;
function GetY: longint;
const GraphResult = grOk;
function ImageSize (x1, y1, x2, y2: word): word;
procedure InitGraph (x, y: integer; config: string);
{
 config-string: crt:=right|bottom;
                crt_x:=integer;
                crt_y:=integer;
                gr_x0:=integer;
                gr_y0:=integer;
                gr_numpages:=integer;
                appname:=string;
                zoom:=integer;
                fullscreen:=0/1;

Quote:
}

procedure Line (x1, y1, x2, y2: integer);
procedure LineRel (x, y: integer);
procedure LineTo (x, y: integer);
procedure MoveTo (x, y: integer);
procedure MoveRel (x, y: integer);
procedure OutText (s: string);
procedure OutTextXY (x, y: integer; s: string);
procedure PieSlice (X, Y: integer; stangle, endangle, radius: word);
procedure PutImage(x1, y1 : integer; var BitMap; R: word);
procedure PutPixel (x, y: integer; c: longint);
procedure Rectangle (x1, y1, x2, y2: integer);
procedure Sector (x, y, astart, aend, rx, ry: integer);
procedure SetActivePage (p: integer);
procedure SetColor (c: longint);
procedure SetFillStyle (fs: integer; col: longint);
procedure SetLineStyle (style, pattern, width: word);
procedure SetTextJustify (Horiz, Vert: integer);
procedure SetTextStyle (Fontname: string; orientation: integer;
fontsize: integer);
{
 config-string: face:=string;base:=integer

Quote:
}

procedure SetViewPort (x, y, x2, y2: integer; clip: boolean);
procedure SetVisualPage (p: integer);
function TextHeight (s: string): integer;
function TextWidth (s: string): integer;

procedure Delay (d: word);
{ gibt Zeit an andere Anwendungen frei }
procedure NoSound;
{ACHTUNG! NUR UNTER WIN31 ODER WIN9x, NICHT UNTER WIN2000 ODER NT }
procedure Sound (x: word);
{ACHTUNG! NUR UNTER WIN31 ODER WIN9x, NICHT UNTER WIN2000 ODER NT }
procedure CopyScreen;
{ Bildschirm in die Zwischenablage }
procedure CopyImage (var i);
{ Ein mit GetImage geladenes Bild in die Zwischenablage }
procedure SetCursor (var bmp1, bmp2; hsx, hsy: integer);
{ Setzt den GrafikCursor. bmp1 ist das AND-Bild, bmp2 ist das XOR-
Bild. }
procedure ShowMouse;
procedure HideMouse;

function fstr (v: integer): string;
function fval (s: string): integer;
function MakePChar (s: string): PChar;
procedure Play (s: string);

const GetMouseX: integer = 0;
      GetMouseY: integer = 0;
      GetMouseButtons: integer = 0;
      mbLeft = 1;
      mbRight = 2;
      mbBoth = 3;

implementation

{$R WINGRAPH.RES}

uses WinCrt, WinTypes, WinProcs, Strings;

const CRTWindowName: String = 'TPWingraph (c) 1999 Rudolf Polzer - CRT
Window #';

function GetParsedSubstring (s, name, default: string): string;
var p: integer;
begin
     s := ';' + s + ';';
     name := ';' + name + ':=';
     p := pos (name, s);
     if p = 0 then
     begin
          GetParsedSubstring := default;
          exit;
     end;
     s := copy (s, p + length(name), 255);
     GetParsedSubstring := copy (s, 1, pos(';', s)-1);
end;

function fval (s: string): integer;
var d1, d2: integer;
begin
     d1 := 0;
     val (s, d1, d2);
     fval := d1;
end;

function fstr (v: integer): string;
var s: string[6];
begin
     str (v:0, s);
     fstr := s;
end;

var dummy: integer;
    _GetMaxX, _GetMaxY: integer;
    _GetX, _GetY, _ShowMouse: Integer;

function nospace (x: string): string;
begin
     while (x[byte(x[0])] = ' ') do
           dec (x[0]);
     while (x[1] = ' ') do
           x := copy (x, 2, 255);
     nospace := x;
end;

procedure Swap (var x, y: integer);
var h: integer;
begin
     h := x; x := y; y := h;
end;

const nmaxstr = 9;
const currentstr: integer = 0;
      MaxNumPages = 64;
      NumPages: integer = MaxNumPages;

var Colors: array [0..15] of longint;
    hGraphWindow: HWnd;
    hGraphDC, hWindowDC: hDC;
    hGraphBitmaps: array [0..MaxNumPages-1] of hBitmap;
    hOldGraphBitmap: hBitmap;
    hGraphBrush, hOldGraphBrush: hBrush;
    hMouseAndBmp, hMouseXorBmp, hMouseSaveBmp: hBitmap;
    CursorX, CursorY, MouseHSX, MouseHSY: integer;
    VisualPage, ActivePage: integer;
    hGraphPen, hOldGraphPen: hPen;
    hGraphFont, hOldGraphFont: hFont;
    currentClipRgn: HRgn;
    tempstr: array [0..nmaxstr-1] of string;
    CrtPos: (CRT_RIGHT, CRT_BOTTOM);
    CrtX, CrtY, CrtX0, CrtY0: integer;
    MakeCrtActive: boolean;
    zoom: longint;

function GetCColor (c: longint): longint;
begin
     GetCColor := Colors[c and $0000000F]
end;

function GetRedValue (c: longint): integer;
begin
     GetRedValue := TRgbQuad(c).rgbRed;
end;
function GetGreenValue (c: longint): integer;
begin
     GetGreenValue := TRgbQuad(c).rgbGreen;
end;
function GetBlueValue (c: longint): integer;
begin
     GetBlueValue := TRgbQuad(c).rgbBlue;
end;

function FindColor (c: longint): longint;
var mdiff, diff, n, i: longint;
begin
     mdiff := MaxLongint;
     n := 0;
     for i := 0 to 15 do begin
         diff := sqr(longint(GetRedValue(c) - GetRedValue(colors[i])))
               + sqr(longint(GetGreenValue(c) - GetGreenValue(colors
[i])))
               + sqr(longint(GetBlueValue(c) - GetBlueValue(colors
[i])));
         if diff < mdiff then begin
            mdiff := diff;
            n := i;
         end;
     end;
     FindColor := n;
end;

procedure HideCrt;
var hCrtWnd: hWnd;
...

read more »



Wed, 18 Jun 1902 08:00:00 GMT  
 TPW Graph unit - is anyone interested?

************************************************************************
 * unit WinGraph;
*

*

************************************************************************
 * DIESE UNIT IST FREEWARE. ALLERDINGS MUESSEN ALLE COPYRIGHT-HINWEISE
*
 * ERHALTEN BLEIBEN (DAS ICON, DIE TITELLEISTE UND DIESES KOMMENTAR).
*
 * ANSONSTEN KANN DIESE UNIT FREI VERWENDET UND KOPIERT WERDEN.
*
 * ?NDERUNGEN SIND UNTER DER BEDINGUNG ERLAUBT, DASS SIE MIR PER MAIL
*
 * ZUGESCHICKT WERDEN. DIESE K?NNEN DANN IN WEITERE VERSIONEN
*
 * EINFLIESSEN.
*

************************************************************************
 * BESONDERHEITEN GEGENBER Graph
*
 * - es darf zur Zeit der Ausfhrung von InitGraph kein Crt-Fenster
*
 *   existieren!  Einfach InitGraph als ersten Befehl verwenden!
*
 * - kein SetWriteMode
*
 * - kein UserBitLn, kein UserFill
*
 * - kein GetArcCoords
*
 * - kein GothicFont (kann aber leicht selbst definiert werden;
*
 *   ein Freeware-Truetype-Font wrde mir gefallen. Auf (c)-Grnden
*
 *   hier kein Hinweis auf Microsoft's Font (bei Office dabei ;-).
*
 * - Bildschirmaufbau nur w?hrend GetMessage, Keypressed, Readkey,
*
 *   ReadLn, Read, Delay, WaitXXX, ...
*
 * - keine Palettenfunktionen
*
 * + TrueColor-Funktionalit?t
*
 * + keine BGI-Treiberdateien oder Fonts mehr n?tig
*
 * + kein DoubleBuffering mehr n?tig, keine Probleme mit dem Mauszeiger
*
 * + (schreibende) Untersttzung der Zwischenablage
*
 * + Bis zu 64 Bildschirmspeicherseiten
*
 * + TrueType-Untersttzung
*
 * + Mausuntersttzung ?hnlich der vielen verbreiteten unit Mouse;
*
 * + beliebig gro?e Mauszeiger
*
 * + beliebig gro?e Bildschirme
*
 * + keine 64k-Grenze bei Bitmaps
*
 * + Quellcode frei verfgbar :-)
*
 * + kein Runtime Error 200
*
 * * 98% kompatibel zu BGI, wenn Konstanten wie TriplexFont verwendet
*
 *   wurden (und nicht die entsprechenden Zahlenwerte). Bei fast allen
*
 *   Inkompatibilit?ten "meckert" der Compiler.
*

************************************************************************

Sent via Deja.com http://www.deja.com/
Before you buy.



Wed, 18 Jun 1902 08:00:00 GMT  
 TPW Graph unit - is anyone interested?
(ENGLISH version here)
Difference to BGI/Graph:

No CRT window before calling InitGraph! So WriteLns are not permitted
before initgraph

SetWriteMode is not supported
UserBitLn, UserFill are not supported
GetArcCoords is not supported
GothicFont is not supported (you could define it if you want (see the
pas file, fonts are strings pointing to a windows font), but because of
copyright restrictions I dont include one)
The screen is drawn only when the computer is idle (ReadKey,
KeyPressed, GetMessage, ReadLn, Read, Delay, WaitXXX)
No palette functions (since it is using the user's screen mode)

TrueColor functions
No BGI driver files needed
No double buffering needed, the screen is only drawn when looking at
the keyboard
No ShowMouse/HideMouse needed to draw at mouse cursor's pos (like a hw
cursor)
Writing in the clipboard is possible
Up to 64 pages (->SetVisualPage)
TrueType support
Mouse like the well-known unit mouse
Arbitrary size of mouse cursors
Arbitrary screen sizes (as much as the user has :-)
No 64k limit for bitmaps (PutImage)
Source code
No RTE 200
98% BGI-compatible
Most incompatibilities are compiler-detected

Sent via Deja.com http://www.deja.com/
Before you buy.



Wed, 18 Jun 1902 08:00:00 GMT  
 TPW Graph unit - is anyone interested?
Yes: Please post.

PP

Quote:

> -----BEGIN PGP SIGNED MESSAGE-----
> Hash: SHA1

> For the non-Windows-programmers, I have written a WinGraph unit some
> time ago (you know, Graph is missing). It works, but some things that
> cannot be done in GDI or are very slow in GDI (user-defined line
> styles aka UserBitLn) are not defined. Is anyone interested in it? I
> could post it in this newsgroup if you want to (<1600 lines).
> Even the sound and delay functions from crt are implemented (the
> delay is RTE-200 free, it uses GetTickCount).

> -----BEGIN PGP SIGNATURE-----
> Version: PGPfreeware 6.5.1 Int. for non-commercial use
> <http://www.pgpinternational.com>
> Comment: Get a free virus at file://localhost/dev/aux/clock$

> iQA/AwUBOWxS5pHoP2uzWQlaEQLZmQCdFrberNmfHf+EBYeMBvSqX2AUtacAn1A2
> HKjj8EwpmbFYh0Lccb5HfRgv
> =yspS
> -----END PGP SIGNATURE-----



Wed, 18 Jun 1902 08:00:00 GMT  
 TPW Graph unit - is anyone interested?
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

I already did, and it seemed to be lost. Only in Deja I find it.
(When In post, I have two different names: one in Deja and one in
MSUX. Seiberdragan and Rudolf Polzer are the same).

The file is now ZIPped and located at
http://members.xoom.com/hackdahacker/wingraph.zip including the RES,
the TPU and the PAS. Just extract them to your TPW directory and
write "uses Wingraph;" instead of "uses Graph;". Warning: download
does not work with GetRight!

The (translated) english description can be found at deja.com.



Quote:
> Yes: Please post.

> PP


> > -----BEGIN PGP SIGNED MESSAGE-----
> > Hash: SHA1

> > For the non-Windows-programmers, I have written a WinGraph unit
> > some time ago (you know, Graph is missing). It works, but some
> > things that cannot be done in GDI or are very slow in GDI
> > (user-defined line styles aka UserBitLn) are not defined. Is
> > anyone interested in it? I could post it in this newsgroup if you
> > want to (<1600 lines). Even the sound and delay functions from
> > crt are implemented (the delay is RTE-200 free, it uses
> > GetTickCount).

> > -----BEGIN PGP SIGNATURE-----
> > Version: PGPfreeware 6.5.1 Int. for non-commercial use
> > <http://www.pgpinternational.com>
> > Comment: Get a free virus at file://localhost/dev/aux/clock$

> > iQA/AwUBOWxS5pHoP2uzWQlaEQLZmQCdFrberNmfHf+EBYeMBvSqX2AUtacAn1A2
> > HKjj8EwpmbFYh0Lccb5HfRgv
> > =yspS
> > -----END PGP SIGNATURE-----

-----BEGIN PGP SIGNATURE-----
Version: PGPfreeware 6.5.1 Int. for non-commercial use
<http://www.pgpinternational.com>
Comment: Get a free virus at file://localhost/dev/aux/clock$

iQA/AwUBOICde5HoP2uzWQlaEQKavwCdGOAmHxPZwGwAqQSq7KeBwf4e1gcAnR4h
W75g+L0g4/5Mdw1zSUKHVbML
=tXic
-----END PGP SIGNATURE-----



Wed, 18 Jun 1902 08:00:00 GMT  
 
 [ 8 post ] 

 Relevant Pages 

1. TPW 1.5 and the missing Graph unit

2. problem with the graph unit-graph.tpu

3. I Am Interested in Pascal for Windows

4. Something Interesting in TPW 1.5!

5. Doing ODBC without BDE: Anyone Interested???

6. Anyone interested in boulderdash?

7. anyone interested in a freeware network game?

8. Anyone interested in a Record Based SQL API?

9. For all those interested in the qwktimer unit

10. Libliaries graph.tpw !!!

11. REQUEST FOR GRAPH.TPU FOR TPW 1.5

12. help for including units in main file (i am using BP7)

 

 
Powered by phpBB® Forum Software