File: penshare.pas

package info (click to toggle)
fpc 2.0.0-4
  • links: PTS
  • area: main
  • in suites: etch-m68k
  • size: 89,476 kB
  • ctags: 133,433
  • sloc: pascal: 1,075,377; makefile: 310,704; xml: 64,343; perl: 7,703; yacc: 3,297; ansic: 2,265; lex: 839; php: 447; sh: 412; sed: 132; asm: 71; csh: 34; cpp: 26; tcl: 7
file content (115 lines) | stat: -rw-r--r-- 3,025 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
Program PenShare;


{ Dieses Programm demonstriert die ObtainPen Funktion der graphics.lib V39+

  Ab OS3.0 gibt es sogenanntes Pen Sharing. Das bedeutet, da sich
  verschiedene Programme die Farben der Workbench teilen. Zum Beispiel
  knnen Sie mit Multiview 2 Bilder mit 256 auf der Workbench anzeigen,
  wobei beide noch relativ gut aussehen.

  Mit der Funktion ObtainPen knnen Sie sich ein Farbregister mit einem
  ganz bestimmten Farbwert reservieren lassen.

  Es gibt noch eine zweite Funktion namens ObtainBestPen (Multiview
  benutzt diese Fkt.). Mit ihr werden die Farbwerte nicht 100%ig exakt
  behandelt. So wird z.B. zwei leicht unterschiedlichen Rottnen dasselbe
  Farbregister zugeordnet.


  Autor: Andreas Tetzl
  Datum: 22.12.1994
}

{
  Translated to fpc pascal
  20 Mar 2001.

  Reworked to use systemvartags.
  Text to GText.
  28 Nov 2002.

  nils.sjoholm@mailbox.swipnet.se
}

uses exec, graphics, intuition, utility,systemvartags;

VAR RP : pRastPort;
    Win : pWindow;
    Colors : Array[0..2] of longint;
    Msg : pMessage;
    VP : pViewPort;
    i : Integer;


PROCEDURE CleanExit(Why : String; RC : longint);
Begin
 For i:=0 to 2 do
  If Colors[i]<>-1 then ReleasePen(VP^.ColorMap,Colors[i]);

 If Win<>NIL then CloseWindow(Win);
 If Why<>'' then Writeln(Why);
 halt(RC);
end;

Begin
 For i:=0 to 2 do Colors[i]:=-1; { Farbwerte vorbelegen (wegen CleanExit()) }


  Win:=OpenWindowTags(nil,[WA_Width,150,
                        WA_Height,100,
                        WA_Title,'PenShare',
                        WA_Flags,WFLG_CLOSEGADGET+WFLG_DRAGBAR,
                        WA_IDCMP,IDCMP_CLOSEWINDOW,
                        TAG_END]);



 If Win=NIL then CleanExit('Can''t open window',10);
 VP:=ViewPortAddress(Win);
 RP:=Win^.RPort;

 { Fr n geben Sie die gewnschte Farbregisternummer }
 { an (-1, wenn es Ihnen egal ist).                  }
 { Die folgenden drei RGB-Werte mssen die ganzen    }
 { 32 Bit ausnutzen. Wenn Sie z.B. fr Rot den Wert  }
 { $F0 setzen wollen, mssen Sie in r den Wert       }
 { $F0F0F0F0 einsetzen !                             }
 { Wenn Sie die Farbe spter verndern               }
 { (z.B. ColorCycling), mssen Sie im Flags          }
 { Parameter PENF_EXCLUSIVE setzen !                 }
 { (siehe Include:graphics/View.i                    }

 Colors[0]:=ObtainPen(VP^.ColorMap,-1,$FFFFFFFF,0,0,0); { Rot  }
 Colors[1]:=ObtainPen(VP^.ColorMap,-1,0,$FFFFFFFF,0,0); { Grn }
 Colors[2]:=ObtainPen(VP^.ColorMap,-1,0,0,$FFFFFFFF,0); { Blau }
 If (Colors[0]=-1) or (Colors[1]=-1) or (Colors[1]=-1) then
  CleanExit('Please set more colors for Workbench.',10);

 SetAPen(RP,Colors[0]);
 Move(RP,40,40);
 GText(RP,'Red',3);

 SetAPen(RP,Colors[1]);
 Move(RP,40,60);
 GText(RP,'Green',5);

 SetAPen(RP,Colors[2]);
 Move(RP,40,80);
 GText(RP,'Blue',4);

 Msg:=WaitPort(Win^.UserPort);
 Msg:=GetMsg(Win^.UserPort);
 ReplyMsg(Msg);

 CleanExit('',0);
end.

{
  $Log: penshare.pas,v $
  Revision 1.3  2005/02/14 17:13:19  peter
    * truncate log

}