WinPrinterContext.st
author Michael Beyl <mb@exept.de>
Thu, 04 Jul 2013 12:57:17 +0200
changeset 3190 437b1425507e
parent 3041 e0211b174c0e
child 3457 dcc643202507
child 3526 8dea8945255b
permissions -rw-r--r--
class: WinPrinterContext added: #supportsVariableHeightFonts
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
 COPYRIGHT (c) 2006 by eXept Software AG
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
     3
	      All Rights Reserved
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
 This software is furnished under a license and may be used
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
 hereby transferred.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
"{ Package: 'stx:libview2' }"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
2301
135f21a3d127 refactorred OS-independent stuff
Claus Gittinger <cg@exept.de>
parents: 2299
diff changeset
    14
PrinterContext subclass:#WinPrinterContext
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
    15
	instanceVariableNames:'deviceFonts hatch supportsColor'
2348
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
    16
	classVariableNames:'PostScriptBlackWhite'
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
    17
	poolDictionaries:''
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
    18
	category:'Interface-Printing'
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
    21
WinPrinterContext subclass:#WinPrinterGraphicContext
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
    22
	instanceVariableNames:'fontScale printPageNumbers pageNumberFormat pageCounter
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
    23
		needsEndOfPage titleFont'
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
    24
	classVariableNames:''
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
    25
	poolDictionaries:''
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
    26
	privateIn:WinPrinterContext
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
    27
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
    28
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    29
!WinPrinterContext primitiveDefinitions!
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    30
%{
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    31
#undef INT
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    32
#define INT WIN_INT
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    33
#undef Array
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    34
#define Array WIN_Array
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    35
#undef Number
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    36
#define Number WIN_Number
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    37
#undef Method
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    38
#define Method WIN_Method
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    39
#undef Point
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    40
#define Point WIN_Point
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    41
#undef Rectangle
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    42
/* #define Rectangle WIN_Rectangle */
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    43
#undef True
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    44
#define True WIN_True
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    45
#undef False
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    46
#define False WIN_False
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    47
#undef Block
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    48
#define Block WIN_Block
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    49
#undef Context
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    50
#define Context WIN_Context
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    51
#undef Date
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    52
#define Date WIN_Date
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    53
#undef Time
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    54
#define Time WIN_Time
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    55
#undef Delay
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    56
#define Delay WIN_Delay
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    57
#undef Signal
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    58
#define Signal WIN_Signal
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    59
#undef Set
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    60
#define Set WIN_Set
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    61
#undef Process
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    62
#define Process WIN_Process
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    63
#undef Processor
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    64
#define Processor WIN_Processor
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    65
#undef Message
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    66
#define Message WIN_Message
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
    67
#undef String
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
    68
#define String WIN_String
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
    69
#undef Character
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
    70
#define Character WIN_Character
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    71
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    72
#include <stdio.h>
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    73
#include <errno.h>
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    74
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    75
#ifdef __BORLANDC__
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    76
# define NOATOM
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    77
# define NOGDICAPMASKS
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    78
# define NOMETAFILE
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    79
# define NOMINMAX
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    80
# define NOOPENFILE
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    81
# define NOSOUND
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    82
# define NOWH
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    83
# define NOCOMM
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    84
# define NOKANJI
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    85
# define NOCRYPT
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    86
# define NOMCX
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    87
# define WIN32_LEAN_AND_MEAN
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    88
# include <windows.h>
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    89
# include <shellapi.h>
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    90
# include <sys\timeb.h>
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    91
# include <dir.h>
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    92
#else
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    93
# define _USERENTRY /**/
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    94
# define NOATOM
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    95
# define NOGDICAPMASKS
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    96
# define NOMETAFILE
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    97
# define NOMINMAX
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    98
# define NOOPENFILE
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    99
# define NOSOUND
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   100
# define NOWH
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   101
# define NOCOMM
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   102
# define NOKANJI
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   103
# define NOCRYPT
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   104
# define NOMCX
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   105
# define WIN32_LEAN_AND_MEAN
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   106
# include <windows.h>
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   107
# include <sys\timeb.h>
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   108
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   109
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   110
#include <process.h>
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   111
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   112
#ifdef __DEF_Array
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   113
# undef Array
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   114
# define Array __DEF_Array
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   115
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   116
#ifdef __DEF_Number
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   117
# undef Number
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   118
# define Number __DEF_Number
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   119
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   120
#ifdef __DEF_Method
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   121
# undef Method
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   122
# define Method __DEF_Method
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   123
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   124
#ifdef __DEF_Point
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   125
# undef Point
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   126
# define Point __DEF_Point
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   127
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   128
#ifdef __DEF_Rectangle
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   129
# undef Rectangle
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   130
# define Rectangle __DEF_Rectangle
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   131
#else
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   132
# undef Rectangle
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   133
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   134
#ifdef __DEF_Block
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   135
# undef Block
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   136
# define Block __DEF_Block
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   137
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   138
#ifdef __DEF_Context
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   139
# undef Context
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   140
# define Context __DEF_Context
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   141
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   142
#ifdef __DEF_Date
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   143
# undef Date
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   144
# define Date __DEF_Date
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   145
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   146
#ifdef __DEF_Time
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   147
# undef Time
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   148
# define Time __DEF_Time
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   149
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   150
# ifdef __DEF_Set
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   151
#  undef Set
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   152
#  define Set __DEF_Set
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   153
# endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   154
# ifdef __DEF_Signal
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   155
#  undef Signal
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   156
#  define Signal __DEF_Signal
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   157
# endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   158
# ifdef __DEF_Delay
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   159
#  undef Delay
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   160
#  define Delay __DEF_Delay
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   161
# endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   162
# ifdef __DEF_Process
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   163
#  undef Process
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   164
#  define Process __DEF_Process
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   165
# endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   166
# ifdef __DEF_Processor
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   167
#  undef Processor
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   168
#  define Processor __DEF_Processor
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   169
# endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   170
# ifdef __DEF_Message
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   171
#  undef Message
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   172
#  define Message __DEF_Message
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   173
# endif
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   174
# ifdef __DEF_String
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   175
#  undef String
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   176
#  define String __DEF_String
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   177
# endif
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   178
# ifdef __DEF_Character
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   179
#  undef Character
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   180
#  define Character __DEF_Character
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   181
# endif
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   182
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   183
#undef INT
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   184
#define INT STX_INT
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   185
#undef UINT
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   186
#define UINT STX_UINT
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   187
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   188
/*
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   189
 * some defines - tired of typing ...
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   190
 */
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   191
#define _HANDLEVal(o)        (HANDLE)(__MKCP(o))
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   192
#define _HBITMAPVAL(o)       (HBITMAP)(__MKCP(o))
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   193
#define _HWNDVal(o)          (HWND)(__MKCP(o))
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   194
#define _HPALETTEVal(o)      (HPALETTE)(__MKCP(o))
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   195
#define _HCURSORVal(o)       (HCURSOR)(__MKCP(o))
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   196
#define _HGDIOBJVal(o)       (HGDIOBJ)(__MKCP(o))
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   197
#define _LOGPALETTEVal(o)    (LOGPALETTE *)(__MKCP(o))
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   198
#define _COLORREFVal(o)      (COLORREF)(__MKCP(o))
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   199
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   200
#define WIDECHAR unsigned short
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   201
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   202
#define WIN32PADDING 32
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   203
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   204
#ifdef DEBUG
2325
634b74929d2d *** empty log message ***
fm
parents: 2324
diff changeset
   205
# define DPRINTF(x)              /* printf  x */
634b74929d2d *** empty log message ***
fm
parents: 2324
diff changeset
   206
# define DFPRINTF(x)             /* fprintf x */
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   207
#else
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   208
# define DPRINTF(x)              /* */
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   209
# define DFPRINTF(x)             /* */
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   210
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   211
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   212
typedef int (*intf)(int);
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   213
typedef INT (*INTF)(INT);
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   214
%}
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   215
! !
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   216
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   217
!WinPrinterContext class methodsFor:'documentation'!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   218
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   219
copyright
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   220
"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   221
 COPYRIGHT (c) 2006 by eXept Software AG
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   222
	      All Rights Reserved
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   223
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   224
 This software is furnished under a license and may be used
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   225
 only in accordance with the terms of that license and with the
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   226
 inclusion of the above copyright notice.   This software may not
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   227
 be provided or otherwise made available to, or used by, any
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   228
 other person.  No title to or ownership of the software is
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   229
 hereby transferred.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   230
"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   231
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   232
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   233
documentation
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   234
"
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   235
    I am the mediator between the smalltalk printing protocol
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   236
    (which is the same as the graphics drawing protocol) and the
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   237
    windows printer.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   238
    When you open a printer, you will typically talk to me.
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   239
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   240
    [author:]
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   241
	Felix Madrid (fm@exept.de)
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   242
"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   243
! !
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   244
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   245
!WinPrinterContext class methodsFor:'instance creation'!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   246
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   247
fromPrinterInfo: aPrinterInfo
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   248
    | printerContext printerDevice hDC|
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   249
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   250
    hDC := aPrinterInfo createDC.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   251
    hDC = 0 ifTrue: [ ^self error: 'Error while opening printer.' ].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   252
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   253
    printerContext := self new.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   254
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   255
    printerDevice := printerContext.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   256
"/    printerDevice := WinPrinter on: aPrinterInfo.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   257
"/    printerDevice printerDC:hDC.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   258
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   259
    printerContext printerInfo: aPrinterInfo.
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   260
    printerContext setDevice:printerDevice id:nil gcId:hDC.
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   261
    printerContext initExtent.
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   262
    ^printerContext
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   263
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   264
    "Created: / 03-08-2006 / 12:53:52 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   265
    "Modified: / 04-08-2006 / 12:55:01 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   266
    "Modified: / 16-04-2007 / 12:36:26 / cg"
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   267
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   268
2446
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   269
newPrinter
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   270
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   271
    | printer printerInfo|
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   272
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   273
    printerInfo := PrintingDialog getPrinterInfo.
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   274
    printerInfo isNil ifTrue:[^self].
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   275
    printer := WinPrinterContext fromPrinterInfo: printerInfo.
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   276
    ^ printer
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   277
!
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   278
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   279
openGraphicContext
2621
8eac3ee0603d *** empty log message ***
sr
parents: 2603
diff changeset
   280
    ^ self openGraphicContextWithoutDialog:false
8eac3ee0603d *** empty log message ***
sr
parents: 2603
diff changeset
   281
!
8eac3ee0603d *** empty log message ***
sr
parents: 2603
diff changeset
   282
8eac3ee0603d *** empty log message ***
sr
parents: 2603
diff changeset
   283
openGraphicContextWithoutDialog:withoutDialog
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   284
    |printerInfo gc|
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   285
2621
8eac3ee0603d *** empty log message ***
sr
parents: 2603
diff changeset
   286
    printerInfo := PrintingDialog getPrinterInfoWithoutDialog:withoutDialog.
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   287
    printerInfo isNil ifTrue:[^ nil].
2352
b9196fb35b8a bugfix - name of class
ca
parents: 2351
diff changeset
   288
    gc := WinPrinterGraphicContext fromPrinterInfo:printerInfo.
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   289
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   290
    gc notNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   291
	gc startPrintJob
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   292
    ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   293
    ^ gc
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   294
! !
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   295
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   296
!WinPrinterContext class methodsFor:'accessing'!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   297
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   298
getPrinterInformation:printerNameString
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   299
    " Answer the printer information for the printer named printerNameString.  If no name is specified,
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   300
      answer the information for the default printer."
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   301
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   302
    |h|
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   303
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   304
    h := OperatingSystem openPrinter:printerNameString.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   305
    ^ OperatingSystem
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   306
	getDocumentProperties:nil
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   307
	hPrinter:h
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   308
	pDeviceName:printerNameString.
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   309
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   310
    "Created: / 27-07-2006 / 10:22:32 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   311
    "Modified: / 01-08-2006 / 16:01:44 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   312
    "Modified: / 10-10-2006 / 18:57:45 / cg"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   313
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   314
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   315
getPrinterInformationString: printerNameString
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   316
	" Answer the printer information string from the WIN.INI file
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   317
	for the printer named printerNameString.  If no name is specified,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   318
	answer the information for the default printer. "
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   319
    | printerInfo result |
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   320
    printerInfo := ( String new: 80 ).
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   321
    result := OperatingSystem primGetProfileString: 'windows'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   322
	keyName:  'device'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   323
	default: ( printerNameString isNil ifTrue: [ '' ] ifFalse: [ printerNameString ] )
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   324
	returnedString: printerInfo
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   325
	size: printerInfo size.
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   326
    ^result > 0
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   327
	ifTrue: [printerInfo copyFrom: 1 to: result]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   328
	ifFalse: ['']
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   329
!
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   330
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   331
named: aName
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   332
    "Answer a new instance of Printer which represents
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   333
     the printer named aName as specified in the host
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   334
     Control Panel."
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   335
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   336
    aName isNil ifTrue: [ ^self default ].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   337
    ^self new printerInfoWithName: aName
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   338
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   339
    "Created: / 27-07-2006 / 17:51:27 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   340
    "Modified: / 02-08-2006 / 17:26:29 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   341
    "Modified: / 10-10-2006 / 17:33:29 / cg"
2348
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   342
!
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   343
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   344
postScriptBlackWhite
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   345
    "Returns true if the postscript is b&w or returns false if the postscript is color"
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   346
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   347
    ^ PostScriptBlackWhite ? false
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   348
!
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   349
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   350
postScriptBlackWhite: aBoolean
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   351
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   352
    PostScriptBlackWhite := aBoolean
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   353
! !
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   354
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   355
!WinPrinterContext class methodsFor:'not supported yet'!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   356
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   357
printAdvancedLines: pairOfPointsArray
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   358
    "Opens a print dialog and prints the given lines"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   359
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   360
    | printerInfo printer |
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   361
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   362
    printerInfo := PrintingDialog getPrinterInfo.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   363
    printerInfo isNil ifTrue:[^self].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   364
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   365
    printer := self fromPrinterInfo: printerInfo.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   366
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   367
	printer startPrintJob: 'Advanced Lines'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   368
	printer foreground:Color red background:Color white.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   369
	pairOfPointsArray
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   370
	    do:[:pairOfPointsAndContext |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   371
		 |pairOfPoints|
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   372
		 pairOfPoints := pairOfPointsAndContext at:1.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   373
		 printer
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   374
		    lineWidth: (pairOfPointsAndContext at:2);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   375
		    lineStyle: (pairOfPointsAndContext at:3);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   376
		    capStyle: (pairOfPointsAndContext at:4);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   377
		    joinStyle: (pairOfPointsAndContext at:5);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   378
		    foreground: (pairOfPointsAndContext at:6);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   379
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   380
		    displayAdvanceLineFrom: (pairOfPoints at:1)  to: (pairOfPoints at:2).
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   381
	    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   382
	printer endPrintJob.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   383
    ] forkAt: 3
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   384
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   385
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   386
     WinPrinterContext printAdvancedLines:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   387
	(Array with: (Array with: (Array with:10@10 with:1000@5000) with: 3 with:#dashed with: #butt with: #miter with: Color green)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   388
	       with: (Array with: (Array with:10@10 with:3500@2000) with: 2 with:#solid  with: #butt with: #miter with: Color yellow)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   389
	       with: (Array with: (Array with:1000@800 with:6000@5000) with: 8 with:#dashed  with: #butt with: #miter with: Color black)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   390
	       with: (Array with: (Array with:2000@2800 with:2000@5000) with: 1 with:#dashed  with: #butt with: #miter with: Color red)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   391
	)
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   392
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   393
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   394
    "Created: / 07-08-2006 / 12:09:48 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   395
    "Modified: / 07-08-2006 / 14:11:17 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   396
    "Modified: / 16-04-2007 / 15:37:41 / cg"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   397
! !
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   398
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   399
!WinPrinterContext class methodsFor:'testing'!
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   400
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   401
computeScaleForPrinter:aPrinter
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   402
    ^ Point x:(aPrinter pixelsPerInchOfScreenWidth / Screen current horizontalPixelPerInch)
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   403
	    y:(aPrinter pixelsPerInchOfScreenHeight / Screen current verticalPixelPerInch)
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   404
!
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   405
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   406
testPrintingDo:anOneArgBlock
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   407
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   408
    "Opens a print dialog and invokes the action with the printer"
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   409
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   410
    | printerInfo printer |
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   411
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   412
    printerInfo := PrintingDialog getPrinterInfo.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   413
    printerInfo isNil ifTrue:[^self].
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   414
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   415
    printer := self fromPrinterInfo: printerInfo.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   416
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   417
    printer startPrintJob: 'Testing'.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   418
    anOneArgBlock value:printer.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   419
    printer endPrintJob.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   420
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   421
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   422
"
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   423
self testPrintingDo:[:aPrinter| |icon|
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   424
    aPrinter scale:(self computeScaleForPrinter:aPrinter).
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   425
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   426
    aPrinter displayLineFrom:10@10   to:100@10.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   427
    aPrinter displayLineFrom:100@10  to:100@100.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   428
    aPrinter displayLineFrom:100@100 to:10@100.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   429
    aPrinter displayLineFrom:10@100  to:10@10.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   430
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   431
    icon := XPToolbarIconLibrary eraseXP28x28Icon.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   432
    icon displayOn:aPrinter x:10 y:10.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   433
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   434
].
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   435
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   436
self testPrintingDo:[:aPrinter| |scale|
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   437
    scale := self computeScaleForPrinter:aPrinter.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   438
    aPrinter scale:(1 * scale).
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   439
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   440
    aPrinter  font:(Font family:'Arial' face:'medium' size:8).
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   441
    aPrinter displayLineFrom:8@16 to:100@16.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   442
    aPrinter displayLineFrom:8@16 to:8@128.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   443
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   444
    'hallo' displayOn:aPrinter x:8 y:16.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   445
    aPrinter scale:(2 * scale).
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   446
    'hallo' displayOn:aPrinter x:4 y:32.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   447
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   448
    aPrinter scale:(4 * scale).
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   449
    'hallo' displayOn:aPrinter x:2 y:32.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   450
].
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   451
"
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   452
! !
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   453
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   454
!WinPrinterContext class methodsFor:'testing & examples'!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   455
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   456
fillCircles: arrayOfPointsAndRadiusWithContextArray
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   457
    "Opens a print dialog and prints the given circles"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   458
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   459
    | printerInfo printer |
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   460
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   461
    printerInfo := PrintingDialog getPrinterInfo.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   462
    printerInfo isNil ifTrue:[^self].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   463
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   464
    printer := self fromPrinterInfo: printerInfo.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   465
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   466
	printer startPrintJob: 'Fill Circles'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   467
	arrayOfPointsAndRadiusWithContextArray
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   468
	    do:[:pointsAndRadiusWithContextArray |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   469
		printer foreground:(pointsAndRadiusWithContextArray at:3).
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   470
		printer fillCircle:(pointsAndRadiusWithContextArray at:1)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   471
			radius:(pointsAndRadiusWithContextArray at:2).
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   472
	    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   473
	printer endPrintJob.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   474
    ] forkAt: 3
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   475
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   476
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   477
     WinPrinterContext fillCircles:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   478
	(Array with: (Array with: 800@800 with: 600 with:Color red)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   479
	       with: (Array with: 1500@1500 with: 1000 with:Color blue)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   480
	       with: (Array with: 4000@2500 with: 2000 with:Color gray))
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   481
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   482
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   483
    "Created: / 07-08-2006 / 11:46:52 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   484
    "Modified: / 16-04-2007 / 15:37:34 / cg"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   485
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   486
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   487
fillHatchCircles: arrayOfPointsAndRadiusWithContextArray
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   488
    "Opens a print dialog and prints the given circles"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   489
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   490
    | printerInfo printer |
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   491
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   492
    printerInfo := PrintingDialog getPrinterInfo.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   493
    printerInfo isNil ifTrue:[^self].
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   494
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   495
    printer := self fromPrinterInfo: printerInfo.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   496
    [
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   497
	printer startPrintJob: 'Fill Hatch Circles'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   498
	arrayOfPointsAndRadiusWithContextArray
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   499
	    do:[:pointsAndRadiusWithContextArray |
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   500
		| point radius color hatch|
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   501
		point := (pointsAndRadiusWithContextArray at:1).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   502
		radius := (pointsAndRadiusWithContextArray at:2).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   503
		color := (pointsAndRadiusWithContextArray at:3).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   504
		hatch := (pointsAndRadiusWithContextArray at:4).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   505
		printer foreground: color;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   506
			hatch: hatch.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   507
		printer fillCircle:point
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   508
			radius:radius.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   509
	    ].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   510
	printer endPrintJob.
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   511
    ] forkAt: 3
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   512
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   513
    "
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   514
     WinPrinterContext fillHatchCircles:
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   515
	(Array with: (Array with: 800@800 with: 600 with:Color red with: #diagonalCross)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   516
	       with: (Array with: 1500@1500 with: 1000 with:Color blue with: #vertical)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   517
	       with: (Array with: 4000@2500 with: 2000 with:Color gray with: #bDiagonal))
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   518
    "
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   519
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   520
    "Created: / 07-08-2006 / 11:46:52 / fm"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   521
    "Modified: / 16-04-2007 / 15:37:34 / cg"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   522
!
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   523
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   524
fillHatchPolygons: polygonsWithContextArray
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   525
    "Opens a print dialog and prints the given polygons"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   526
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   527
    | printerInfo printer |
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   528
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   529
    printerInfo := PrintingDialog getPrinterInfo.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   530
    printerInfo isNil ifTrue:[^self].
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   531
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   532
    printer := self fromPrinterInfo: printerInfo.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   533
    [
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   534
	printer startPrintJob: 'Fill Hatch Polygons'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   535
	polygonsWithContextArray
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   536
	    do:[:polygonWithContextArray |
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   537
		 |aPolygon color hatch|
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   538
		 aPolygon := polygonWithContextArray at: 1.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   539
		 color := (polygonWithContextArray at: 2).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   540
		 hatch := (polygonWithContextArray at: 3).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   541
		 printer foreground: color;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   542
			 hatch: hatch.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   543
		 aPolygon displayFilledOn: printer.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   544
	    ].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   545
	printer endPrintJob.
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   546
    ] forkAt: 3
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   547
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   548
    "
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   549
     WinPrinterContext fillHatchPolygons:
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   550
	(Array with: (Array with: (Polygon vertices:(
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   551
				Array
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   552
				    with:100@100
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   553
				    with:600@1000
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   554
				    with:3500@4000
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   555
				    with:100@4000
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   556
				    with:100@100))
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   557
			    with: Color red
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   558
			    with: #cross)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   559
		with: (Array with: (Polygon vertices:(
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   560
				Array
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   561
				    with:1000@1000
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   562
				    with:1000@2000
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   563
				    with:2000@1000))
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   564
			     with: Color blue
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   565
			     with: #none)
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   566
    )
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   567
    "
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   568
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   569
    "Created: / 07-08-2006 / 12:09:48 / fm"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   570
    "Modified: / 07-08-2006 / 14:11:17 / fm"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   571
    "Modified: / 16-04-2007 / 15:37:43 / cg"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   572
!
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   573
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   574
fillHatchRectangles: rectanglesWithHatch
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   575
    "Opens a print dialog and prints the given rectangles"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   576
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   577
    | printerInfo printer |
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   578
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   579
    printerInfo := PrintingDialog getPrinterInfo.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   580
    printerInfo isNil ifTrue:[^self].
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   581
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   582
    printer := self fromPrinterInfo: printerInfo.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   583
    [
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   584
	printer startPrintJob: 'Fill Hatch Rectangles'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   585
	printer foreground:Color blue background:Color white.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   586
	rectanglesWithHatch
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   587
	    do:[:rectangleWithHatch |
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   588
		|rectangle hatch|
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   589
		rectangle := rectangleWithHatch at: 1.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   590
		hatch := rectangleWithHatch at: 2.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   591
		printer hatch: hatch.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   592
		printer fillRectangleX: rectangle origin x
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   593
			y: rectangle origin y
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   594
			width: rectangle width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   595
			height: rectangle height.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   596
	    ].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   597
	printer endPrintJob.
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   598
    ] forkAt: 3
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   599
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   600
    "
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   601
     WinPrinterContext fillHatchRectangles:
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   602
	(Array with: (Array with: (Rectangle left:20 top:20 width:400 height:600) with: #horizontal)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   603
	       with: (Array with: (Rectangle left:500 top:700 width:600 height:400) with: #vertical)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   604
	       with: (Array with: (Rectangle left:800 top:1000 width:1600 height:2000) with: #cross)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   605
	       with: (Array with: (Rectangle left:1040 top:1240 width:3000 height:3000) with: #bDiagonal)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   606
	)
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   607
    "
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   608
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   609
    "Created: / 07-08-2006 / 11:40:48 / fm"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   610
    "Modified: / 16-04-2007 / 15:37:46 / cg"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   611
!
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   612
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   613
fillPolygons: polygonsWithContextArray
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   614
    "Opens a print dialog and prints the given polygons"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   615
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   616
    | printerInfo printer |
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   617
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   618
    printerInfo := PrintingDialog getPrinterInfo.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   619
    printerInfo isNil ifTrue:[^self].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   620
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   621
    printer := self fromPrinterInfo: printerInfo.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   622
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   623
	printer startPrintJob: 'Fill Polygons'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   624
	polygonsWithContextArray
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   625
	    do:[:polygonWithContextArray |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   626
		 |aPolygon|
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   627
		 aPolygon := polygonWithContextArray at: 1.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   628
		 printer foreground:(polygonWithContextArray at: 2).
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   629
		 aPolygon displayFilledOn: printer.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   630
	    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   631
	printer endPrintJob.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   632
    ] forkAt: 3
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   633
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   634
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   635
     WinPrinterContext fillPolygons:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   636
	(Array with: (Array with: (Polygon vertices:(
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   637
				Array
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   638
				    with:100@100
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   639
				    with:600@1000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   640
				    with:3500@4000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   641
				    with:100@4000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   642
				    with:100@100))
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   643
			    with: Color red)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   644
		with: (Array with: (Polygon vertices:(
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   645
				Array
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   646
				    with:1000@1000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   647
				    with:1000@2000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   648
				    with:2000@1000))
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   649
			     with: Color blue)
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   650
    )
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   651
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   652
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   653
    "Created: / 07-08-2006 / 12:09:48 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   654
    "Modified: / 07-08-2006 / 14:11:17 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   655
    "Modified: / 16-04-2007 / 15:37:43 / cg"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   656
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   657
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   658
fillRectangles: rectangles
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   659
    "Opens a print dialog and prints the given rectangles"
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   660
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   661
    | printerInfo printer |
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   662
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   663
    printerInfo := PrintingDialog getPrinterInfo.
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   664
    printerInfo isNil ifTrue:[^self].
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   665
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   666
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   667
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   668
	printer startPrintJob: 'Fill Rectangles'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   669
	printer foreground:Color blue background:Color white.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   670
	rectangles
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   671
	    do:[:rectangle |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   672
		printer fillRectangleX: rectangle origin x
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   673
			y: rectangle origin y
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   674
			width: rectangle width
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   675
			height: rectangle height.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   676
	    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   677
	printer endPrintJob.
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   678
    ] forkAt: 3
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   679
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   680
    "
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   681
     WinPrinterContext fillRectangles:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   682
	(Array with: (Rectangle left:20 top:20 width:400 height:600)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   683
	       with: (Rectangle left:500 top:700 width:600 height:400)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   684
	       with: (Rectangle left:800 top:1000 width:1600 height:2000)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   685
	       with: (Rectangle left:1040 top:1240 width:3000 height:3000)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   686
	)
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   687
    "
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   688
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   689
    "Created: / 07-08-2006 / 11:40:48 / fm"
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   690
    "Modified: / 16-04-2007 / 15:37:46 / cg"
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   691
!
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   692
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   693
print: aString font: aFont title: aTitle
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   694
    "Open a print dialog to allow printing of the given string
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   695
     using the given title & font."
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   696
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   697
    self print: aString font: aFont title: aTitle wordWrap: false
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   698
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   699
   "
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
   700
    WinPrinterContext print: 'Holaaaa!! (from:  WinPrinterContext>>print:aString font:aFont title:aTitle)' font: nil title: 'Printing Test'
2315
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
   701
    WinPrinterContext print: (WinPrinterContext class sourceCodeAt:#'print:font:title:wordWrap:') font: nil title: 'Printing Test String'
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
   702
    WinPrinterContext print: (WinPrinterContext class sourceCodeAt:#'print:font:title:wordWrap:') font: (Font family:'Arial' face:'medium' size:8) title: 'Printing Test String'
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   703
   "
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   704
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   705
    "Created: / 27-07-2006 / 17:52:33 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   706
    "Modified: / 03-08-2006 / 18:52:31 / fm"
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
   707
    "Modified: / 16-04-2007 / 13:54:40 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   708
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   709
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   710
print: aString font: aFont title: aTitle wordWrap: wordWrap
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   711
    "Open a print dialog to allow printing of the given string
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   712
     using the given title & font."
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   713
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   714
    | printerInfo printer |
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   715
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   716
    printerInfo := PrintingDialog getPrinterInfo.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   717
    printerInfo isNil ifTrue:[^self].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   718
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   719
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   720
    [
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   721
	printer
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   722
	    print: aString
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   723
	    font: aFont
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   724
	    title: aTitle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   725
	    wordWrap: wordWrap
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   726
	    marginsRect: nil
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   727
    ] forkAt: 3
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   728
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   729
    "
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
   730
     WinPrinterContext print: 'Holaaaa!! (from:  PrinterContext>>print:aString font:aFont title:aTitle)' font: nil title: 'Printing Test' wordWrap: true
2315
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
   731
     WinPrinterContext print: (WinPrinterContext class sourceCodeAt:#'print:font:title:wordWrap:') font:nil title:'Printing Test String' wordWrap:true
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
   732
     WinPrinterContext print: (WinPrinterContext class sourceCodeAt:#'print:font:title:wordWrap:') font: (Font family:'Arial' face:'medium' size:8) title: 'Printing Test String' wordWrap: true
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   733
    "
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   734
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   735
    "Created: / 03-08-2006 / 18:51:53 / fm"
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
   736
    "Modified: / 16-04-2007 / 15:37:31 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   737
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   738
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   739
printCircles: arrayOfPointsAndRadius
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   740
    "Opens a print dialog and prints the given circles"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   741
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   742
    | printerInfo printer |
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   743
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   744
    printerInfo := PrintingDialog getPrinterInfo.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   745
    printerInfo isNil ifTrue:[^self].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   746
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   747
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   748
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   749
	printer startPrintJob: 'Circles'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   750
	printer foreground:Color green background:Color white.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   751
	arrayOfPointsAndRadius
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   752
	    do:[:pointAndRadius |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   753
		printer displayCircle:(pointAndRadius at:1)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   754
			radius:(pointAndRadius at:2).
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   755
	    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   756
	printer endPrintJob.
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   757
    ] forkAt: 3
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   758
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   759
    "
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   760
     WinPrinterContext printCircles:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   761
	(Array with: (Array with: 800@800 with: 600)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   762
	       with: (Array with: 1500@1500 with: 1000)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   763
	       with: (Array with: 4000@2500 with: 2000))
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   764
    "
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   765
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   766
    "Created: / 07-08-2006 / 11:46:52 / fm"
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
   767
    "Modified: / 16-04-2007 / 15:37:34 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   768
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   769
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   770
printCirclesIn: rectangles
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   771
    "Opens a print dialog and prints the given circles"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   772
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   773
    | printerInfo printer |
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   774
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   775
    printerInfo := PrintingDialog getPrinterInfo.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   776
    printerInfo isNil ifTrue:[^self].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   777
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   778
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   779
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   780
	printer startPrintJob: 'Circles In Rectangles'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   781
	rectangles
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   782
	   do:[:rectangle |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   783
	       printer displayCircleIn: rectangle.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   784
	   ].
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   785
       printer endPrintJob.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   786
    ] forkAt: 3
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   787
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   788
    "
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   789
     WinPrinterContext printCirclesIn:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   790
	(Array with: (Rectangle left:20 top:20 width:400 height:600)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   791
	       with: (Rectangle left:40 top:40 width:600 height:400)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   792
	)
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   793
    "
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   794
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   795
    "Created: / 07-08-2006 / 11:48:46 / fm"
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
   796
    "Modified: / 16-04-2007 / 15:37:38 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   797
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   798
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   799
printImage: anImage
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   800
    "Opens a print dialog and prints the given image"
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   801
2384
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   802
    self printImage: anImage magnification:1.
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   803
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   804
    "
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   805
     WinPrinterContext printImage: (Image fromFile:'C:\vsw311\pavheadr.gif').
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   806
     WinPrinterContext printImage: XPToolbarIconLibrary help32x32Icon.
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   807
     WinPrinterContext printImage: XPToolbarIconLibrary eraseXP28x28Icon.
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   808
     WinPrinterContext printImage: XPToolbarIconLibrary saveImageBlack22x22Icon.
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   809
     WinPrinterContext printImage: XPToolbarIconLibrary changesBrowser18x22Icon.
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   810
    "
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   811
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   812
    "Created: / 07-08-2006 / 11:46:52 / fm"
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   813
    "Modified: / 16-04-2007 / 15:37:34 / cg"
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   814
!
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   815
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   816
printImage:anImage magnification:factor
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   817
    "Opens a print dialog and prints the given image"
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   818
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   819
    | printerInfo printer |
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   820
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   821
    printerInfo := PrintingDialog getPrinterInfo.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   822
    printerInfo isNil ifTrue:[^self].
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   823
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   824
    printer := self fromPrinterInfo: printerInfo.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   825
    [
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   826
	printer startPrintJob: 'Image'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   827
	printer background:Color white.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   828
	(anImage magnifiedBy:factor) displayOn:printer x:0 y:0.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   829
	printer endPrintJob.
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   830
    ] forkAt: 3
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   831
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   832
    "
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   833
     WinPrinterContext printImage: (Image fromFile:'C:\vsw311\pavheadr.gif').
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   834
     WinPrinterContext printImage: XPToolbarIconLibrary help32x32Icon.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   835
     WinPrinterContext printImage: XPToolbarIconLibrary eraseXP28x28Icon.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   836
     WinPrinterContext printImage: XPToolbarIconLibrary saveImageBlack22x22Icon.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   837
     WinPrinterContext printImage: XPToolbarIconLibrary changesBrowser18x22Icon.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   838
    "
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   839
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   840
    "Created: / 07-08-2006 / 11:46:52 / fm"
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   841
    "Modified: / 16-04-2007 / 15:37:34 / cg"
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   842
!
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   843
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   844
printLines: pairOfPointsWithContextArray
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   845
    "Opens a print dialog and prints the given lines"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   846
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   847
    | printerInfo printer |
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   848
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   849
    printerInfo := PrintingDialog getPrinterInfo.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   850
    printerInfo isNil ifTrue:[^self].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   851
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   852
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   853
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   854
	printer startPrintJob: 'Lines'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   855
	pairOfPointsWithContextArray
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   856
	    do:[:pairOfPointsAndContext |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   857
		 |pairOfPoints|
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   858
		 pairOfPoints := pairOfPointsAndContext at: 1.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   859
		 printer
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   860
		    foreground:(pairOfPointsAndContext at:2);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   861
		    lineWidth: (pairOfPointsAndContext at:3);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   862
		    lineStyle: (pairOfPointsAndContext at:4);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   863
		    displayLineFrom: (pairOfPoints at:1)  to: (pairOfPoints at:2).
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   864
	    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   865
	printer endPrintJob.
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   866
    ] forkAt: 3
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   867
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   868
    "
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   869
     WinPrinterContext printLines:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   870
	(Array with: (Array with:(Array with:10@10 with:1000@5000) with: Color red with:4 with: #solid)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   871
	       with: (Array with:(Array with:10@10 with:3500@2000) with: Color blue with:1 with: #dashed)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   872
	       with: (Array with:(Array with:1000@800 with:6000@5000) with: Color black with: 1 with:#dotted)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   873
	       with: (Array with: (Array with:2000@2800 with:2000@5000) with: Color green with:8 with: nil))
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   874
    "
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   875
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   876
    "Created: / 07-08-2006 / 12:09:48 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   877
    "Modified: / 07-08-2006 / 14:11:17 / fm"
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
   878
    "Modified: / 16-04-2007 / 15:37:41 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   879
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   880
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   881
printPoints: aCollectionOfPoints
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   882
    "Opens a print dialog and prints the given points"
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   883
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   884
    | printerInfo printer |
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   885
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   886
    printerInfo := PrintingDialog getPrinterInfo.
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   887
    printerInfo isNil ifTrue:[^self].
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   888
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   889
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   890
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   891
	printer startPrintJob: 'Points'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   892
	aCollectionOfPoints do:[:each |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   893
	    printer displayPointX: each x y: each y.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   894
	].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   895
	printer endPrintJob.
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   896
    ] forkAt: 3
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   897
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   898
    "
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   899
     WinPrinterContext printPoints:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   900
	(Array with: (10 @ 10)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   901
	       with: (500 @ 700)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   902
	       with: (900 @ 1000)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   903
	       with: (1500 @ 1700)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   904
	       with: (2100 @ 2000)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   905
	       with: (2500 @ 2700)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   906
	)
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   907
    "
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   908
!
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   909
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   910
printPolygons: polygons
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   911
    "Opens a print dialog and prints the given polygons"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   912
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   913
    | printerInfo printer |
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   914
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   915
    printerInfo := PrintingDialog getPrinterInfo.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   916
    printerInfo isNil ifTrue:[^self].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   917
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   918
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   919
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   920
	printer startPrintJob: 'Polygons'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   921
	printer foreground:Color black background:Color white.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   922
	polygons
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   923
	    do:[:aPolygon |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   924
		 aPolygon displayStrokedOn: printer.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   925
	    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   926
	printer endPrintJob.
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   927
    ] forkAt: 3
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   928
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   929
    "
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   930
     WinPrinterContext printPolygons:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   931
	(Array with: (Polygon vertices:(
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   932
				Array
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   933
				    with:100@100
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   934
				    with:600@1000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   935
				    with:3500@4000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   936
				    with:100@4000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   937
				    with:100@100))
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   938
		with: (Polygon vertices:(
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   939
				Array
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   940
				    with:1000@1000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   941
				    with:1000@2000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   942
				    with:2000@1000)))
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   943
    "
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   944
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   945
    "Created: / 07-08-2006 / 12:09:48 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   946
    "Modified: / 07-08-2006 / 14:11:17 / fm"
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
   947
    "Modified: / 16-04-2007 / 15:37:43 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   948
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   949
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   950
printPolylines: evenCollectionOfPoints
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   951
    "Opens a print dialog and prints the given rectangles"
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   952
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   953
    | printerInfo printer |
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   954
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   955
    printerInfo := PrintingDialog getPrinterInfo.
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   956
    printerInfo isNil ifTrue:[^self].
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   957
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   958
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   959
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   960
	printer startPrintJob: 'Polylines'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   961
	printer displayPolylines:evenCollectionOfPoints.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   962
	printer endPrintJob.
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   963
    ] forkAt: 3
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   964
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   965
    "
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   966
     WinPrinterContext printPolylines:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   967
	(Array with: (10 @ 10)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   968
	       with: (500 @ 700)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   969
	       with: (900 @ 1000)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   970
	       with: (1500 @ 1700)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   971
	       with: (2100 @ 2000)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   972
	       with: (2500 @ 2700)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   973
	)
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   974
    "
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   975
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   976
    "Created: / 07-08-2006 / 11:40:48 / fm"
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   977
    "Modified: / 16-04-2007 / 15:37:46 / cg"
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   978
!
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   979
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   980
printRectangles: rectanglesWithContextArray
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   981
    "Opens a print dialog and prints the given rectangles"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   982
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   983
    | printerInfo printer |
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   984
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   985
    printerInfo := PrintingDialog getPrinterInfo.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   986
    printerInfo isNil ifTrue:[^self].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   987
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   988
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   989
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   990
	printer startPrintJob: 'Rectangles'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   991
	printer foreground:Color red background:Color white.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   992
	rectanglesWithContextArray do:[:rectangleWithContextArray |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   993
	    |rectangle|
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   994
	    rectangle := rectangleWithContextArray at: 1.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   995
	    printer
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   996
		foreground:(rectangleWithContextArray at:2);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   997
		lineWidth: (rectangleWithContextArray at:3);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   998
		lineStyle: (rectangleWithContextArray at:4);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   999
		displayRectangleX: rectangle origin x
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1000
			y: rectangle origin y
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1001
			width: rectangle width
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1002
			height: rectangle height.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1003
	    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1004
	printer endPrintJob.
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1005
    ] forkAt: 3
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1006
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1007
    "
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  1008
     WinPrinterContext printRectangles:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1009
	(Array with: (Array with: (Rectangle left:30 top:10 width:400 height:600) with: Color red with:4 with: #solid)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1010
	       with: (Array with: (Rectangle left:100 top:140 width:700 height:800) with: Color blue with:1 with: #dashed)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1011
	       with: (Array with: (Rectangle left:800 top:1500 width:2600 height:3400) with: Color green with:1 with: #dotted)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1012
	       with: (Array with: (Rectangle left:1000 top:1200 width:1400 height:1600) with: Color gray with:8 with: #dashed)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1013
	       with: (Array with: (Rectangle left:2600 top:1200 width:1400 height:1600) with: Color darkGray with:1 with: #dashDotDot)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1014
	)
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1015
    "
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1016
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1017
    "Created: / 07-08-2006 / 11:40:48 / fm"
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
  1018
    "Modified: / 16-04-2007 / 15:37:46 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1019
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1020
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1021
printStrings: stringAndPositionsArray
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1022
    "Opens a print dialog and prints the given strings"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1023
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1024
    | printerInfo printer |
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1025
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1026
    printerInfo := PrintingDialog getPrinterInfo.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1027
    printerInfo isNil ifTrue:[^self].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1028
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1029
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  1030
    [
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1031
	printer startPrintJob: 'Strings with Position'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1032
	printer foreground:Color black background:Color white.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1033
	stringAndPositionsArray
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1034
	    do:[:pairOfPointsAndPosition |
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1035
		 printer displayString:(pairOfPointsAndPosition at: 1)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1036
			    x:(pairOfPointsAndPosition at: 2) x
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1037
			    y:(pairOfPointsAndPosition at: 2) y
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1038
	    ].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1039
	printer endPrintJob.
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1040
    ] forkAt: 3
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1041
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1042
    "
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  1043
     WinPrinterContext printStrings:
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1044
	(Array with: (Array with:'Testing printing with standard method' with:10@10)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1045
	       with: (Array with:'Another test string to print' with:80@200))
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1046
    "
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1047
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1048
    "Created: / 07-08-2006 / 12:09:48 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1049
    "Modified: / 07-08-2006 / 14:11:17 / fm"
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
  1050
    "Modified: / 16-04-2007 / 15:37:49 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1051
! !
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1052
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1053
!WinPrinterContext methodsFor:'accessing'!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1054
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1055
depth
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1056
    ^ 24
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1057
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1058
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1059
deviceColors
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1060
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1061
    ^#()
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1062
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1063
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1064
deviceFonts
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1065
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1066
    deviceFonts isNil ifTrue:[deviceFonts := CachingRegistry new cacheSize:10.].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1067
    ^deviceFonts
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1068
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1069
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1070
getCharHeight
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1071
    "Private - answer the height of the font selected in the receiver's
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1072
     device context."
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  1073
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1074
    |textMetrics answer|
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1075
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  1076
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1077
    textMetrics := Win32OperatingSystem::TextMetricsStructure new.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1078
"/    (OperatingSystem getTextMetrics:gcId lpMetrics:textMetrics) ifFalse:[ ^ self error ].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1079
"/    Transcript showCR: 'CHAR HEIGHT PRIM ******* ', '   ',  (textMetrics tmHeight + textMetrics tmExternalLeading) printString.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1080
"/    Transcript showCR: 'CHAR HEIGHT DEVICE ***** ', '   ', (self font heightOf:'PQWEXCZ' on:self device) printString.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1081
    answer := (self font heightOf:'PQWEXCZ' on:self device).
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1082
"/    answer := textMetrics tmHeight + textMetrics tmExternalLeading.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  1083
    ^answer
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1084
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1085
    "Created: / 02-08-2006 / 17:47:20 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1086
    "Modified: / 03-08-2006 / 10:09:01 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1087
    "Modified: / 10-10-2006 / 18:15:17 / cg"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1088
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1089
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1090
getLogicalPixelSizeX
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1091
    ^ printerInfo printQuality ? 600
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1092
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1093
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1094
getLogicalPixelSizeY
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1095
    ^ printerInfo printQuality ? 600
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1096
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1097
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1098
numberOfColorBitsPerPixel
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1099
    ^ OperatingSystem getDeviceCaps:gcId index:12 "Bitspixel"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1100
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1101
    "Created: / 03-08-2006 / 09:58:18 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1102
    "Modified: / 10-10-2006 / 18:15:40 / cg"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1103
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1104
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1105
physicalOffsetX
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1106
    ^ OperatingSystem getDeviceCaps:gcId index:112 "PhysicalOffsetX"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1107
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1108
    "Created: / 01-08-2006 / 16:28:34 / fm"
2301
135f21a3d127 refactorred OS-independent stuff
Claus Gittinger <cg@exept.de>
parents: 2299
diff changeset
  1109
    "Modified: / 16-04-2007 / 12:52:06 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1110
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1111
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1112
physicalOffsetY
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1113
    ^ OperatingSystem getDeviceCaps:gcId index:113 "PhysicalOffsetY"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1114
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1115
    "Created: / 01-08-2006 / 16:28:34 / fm"
2301
135f21a3d127 refactorred OS-independent stuff
Claus Gittinger <cg@exept.de>
parents: 2299
diff changeset
  1116
    "Modified: / 16-04-2007 / 12:52:01 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1117
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1118
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1119
pixelsPerInchOfScreenHeight
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1120
    ^ OperatingSystem getDeviceCaps:gcId index:90 "Logpixelsy"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1121
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1122
    "Created: / 01-08-2006 / 16:29:16 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1123
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1124
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1125
pixelsPerInchOfScreenWidth
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1126
    ^ OperatingSystem getDeviceCaps:gcId index:88 "Logpixelsx"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1127
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1128
    "Created: / 01-08-2006 / 16:28:34 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1129
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1130
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1131
printerHeightArea
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1132
    ^ (OperatingSystem getDeviceCaps:gcId index:10)
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1133
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1134
    "Modified: / 10-10-2006 / 18:18:31 / cg"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1135
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1136
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1137
printerPhysicalHeight
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1138
    ^ OperatingSystem getDeviceCaps:gcId "deviceContext" index:111 "PhysicalHeight"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1139
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1140
    "Created: / 01-08-2006 / 16:14:08 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1141
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1142
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1143
printerPhysicalWidth
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1144
    ^ OperatingSystem getDeviceCaps:gcId "deviceContext" index:110 "PhysicalWidth"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1145
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1146
    "Created: / 01-08-2006 / 16:14:08 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1147
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1148
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1149
printerWidthArea
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1150
    ^ OperatingSystem getDeviceCaps:gcId "deviceContext" index:8 "Horzres"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1151
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1152
    "Created: / 01-08-2006 / 16:14:08 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1153
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1154
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1155
supportedImageFormats
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1156
    "return an array with supported image formats; each array entry
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1157
     is another array, consisting of depth and bitsPerPixel values."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1158
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1159
    |info|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1160
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1161
    info := IdentityDictionary new.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1162
    info at:#depth put:self depth.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1163
    info at:#bitsPerPixel put:self depth.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1164
    info at:#padding put:32.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1165
    ^ Array with:info
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1166
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1167
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1168
     Disply supportedImageFormats
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1169
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1170
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1171
    "Modified: / 10.9.1998 / 23:14:05 / cg"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1172
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1173
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1174
visualType
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1175
    ^ #TrueColor
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1176
! !
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1177
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1178
!WinPrinterContext methodsFor:'color stuff'!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1179
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1180
colorScaledRed:r scaledGreen:g scaledBlue:b
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1181
    "allocate a color with rgb values (0..16rFFFF) - return the color index
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1182
     (i.e. colorID)"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1183
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1184
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1185
    int id, ir, ig, ib;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1186
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1187
    if (__bothSmallInteger(r, g) && __isSmallInteger(b)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1188
	ir = (__intVal(r) >> 8) & 0xff;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1189
	ig = (__intVal(g) >> 8) & 0xff;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1190
	ib = (__intVal(b) >> 8) & 0xff;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1191
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1192
	id = RGB( ir, ig, ib);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1193
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1194
	RETURN ( __MKSMALLINT(id) );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1195
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1196
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1197
    self primitiveFailed.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1198
    ^ nil
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1199
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1200
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1201
setBackground:bgColorIndex in:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1202
    "set background color to be drawn with"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1203
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1204
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1205
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1206
    HDC hDC;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1207
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1208
    if (__isExternalAddressLike(aDC)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1209
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1210
	COLORREF bg, oldBg;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1211
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1212
	oldBg = GetBkColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1213
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1214
	bg = __intVal(bgColorIndex) & 0xffffff;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1215
/*        bg = (COLORREF)st2RGB(__intVal(bgColorIndex),gcData);         */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1216
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1217
	if (bg != oldBg) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1218
	    SetBkColor(hDC, bg);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1219
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1220
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1221
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1222
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1223
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1224
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1225
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1226
setBackgroundColor:color in:aGCId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1227
    "set background color to be drawn with"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1228
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1229
    |colorId deviceColor|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1230
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1231
    (color isOnDevice:self) ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1232
	colorId := color colorId.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1233
    ] ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1234
	deviceColor := color onDevice:self.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1235
	deviceColor notNil ifTrue:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1236
	    colorId := deviceColor colorId.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1237
	]
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1238
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1239
    colorId isNil ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1240
	'DeviceWorkstation [warning]: could not set bg color' infoPrintCR.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1241
    ] ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1242
	self setBackground:colorId in:aGCId.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1243
    ]
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1244
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1245
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1246
setForeground:fgColorIndex background:bgColorIndex in:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1247
    "set foreground and background colors to be drawn with"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1248
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1249
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1250
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1251
    if (__isExternalAddressLike(aDC)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1252
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1253
	COLORREF fg, bg, oldFg, oldBg;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1254
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1255
/*        fg = (COLORREF)st2RGB(__intVal(fgColorIndex),gcData);    */
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1256
	fg = __intVal(fgColorIndex) & 0xffffff;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1257
/*        bg = (COLORREF)st2RGB(__intVal(bgColorIndex),gcData);    */
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1258
	bg = __intVal(bgColorIndex) & 0xffffff;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1259
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1260
	oldFg = GetTextColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1261
	oldBg = GetBkColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1262
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1263
	if ((fg != oldFg) || (bg != oldBg)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1264
	    /* Pen only depends upon fg-color */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1265
	    if (fg != oldFg) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1266
		SetTextColor(hDC, fg);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1267
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1268
	    if (bg != oldBg) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1269
		SetBkColor(hDC, bg);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1270
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1271
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1272
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1273
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1274
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1275
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1276
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1277
setForeground:fgColorIndex in:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1278
    "set foreground color to be drawn with"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1279
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1280
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1281
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1282
    HDC hDC;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1283
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1284
    if (__isExternalAddressLike(aDC)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1285
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1286
	COLORREF fg, oldFg;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1287
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1288
	oldFg = GetTextColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1289
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1290
	fg = __intVal(fgColorIndex) & 0xffffff;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1291
/*        fg = (COLORREF)st2RGB(__intVal(fgColorIndex),gcData);         */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1292
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1293
	if (fg != oldFg) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1294
	    SetTextColor(hDC, fg);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1295
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1296
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1297
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1298
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1299
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1300
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1301
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1302
setForegroundColor:color in:aGCId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1303
    "set the foreground color to be drawn with"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1304
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1305
    |colorId deviceColor|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1306
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1307
    (color isOnDevice:self) ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1308
	colorId := color colorId.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1309
    ] ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1310
	deviceColor := color onDevice:self.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1311
	deviceColor notNil ifTrue:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1312
	    colorId := deviceColor colorId.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1313
	]
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1314
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1315
    colorId isNil ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1316
	'DeviceWorkstation [warning]: could not set fg color' infoPrintCR.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1317
    ] ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1318
	self setForeground:colorId in:aGCId.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1319
    ]
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1320
! !
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1321
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1322
!WinPrinterContext methodsFor:'context stuff'!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1324
getPenFor:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1325
    "set line attributes"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1326
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1327
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1328
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1329
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1330
     && __isSmallInteger(__INST(lineWidth))) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1331
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1332
	COLORREF fgColor;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1333
	HANDLE hPen, prevPen;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1334
	int lineStyleInt, capStyleInt, joinStyleInt, lineWidth;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1335
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1336
	lineWidth= __intVal(__INST(lineWidth));
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1337
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1338
	if (__INST(lineStyle) == @symbol(solid)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1339
	    lineStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1340
	} else if (__INST(lineStyle) == @symbol(dashed)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1341
	    lineStyleInt= PS_DASH;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1342
	} else if (__INST(lineStyle) == @symbol(dotted)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1343
	    lineStyleInt= PS_DOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1344
	} else if (__INST(lineStyle) == @symbol(dashDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1345
	    lineStyleInt= PS_DASHDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1346
	} else if (__INST(lineStyle) == @symbol(dashDotDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1347
	    lineStyleInt= PS_DASHDOTDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1348
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1349
	    lineStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1350
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1351
	if (__INST(capStyle) == @symbol(round)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1352
	    capStyleInt= PS_ENDCAP_ROUND;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1353
	} else if (__INST(capStyle) == @symbol(square)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1354
	    capStyleInt= PS_ENDCAP_SQUARE;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1355
	} else if (__INST(capStyle) == @symbol(flat)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1356
	    capStyleInt= PS_ENDCAP_FLAT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1357
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1358
	    capStyleInt= PS_ENDCAP_FLAT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1359
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1360
	if (__INST(joinStyle) == @symbol(bevel)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1361
	    joinStyleInt= PS_JOIN_BEVEL;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1362
	} else if (__INST(joinStyle) == @symbol(miter)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1363
	    joinStyleInt= PS_JOIN_MITER;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1364
	} else if (__INST(joinStyle) == @symbol(round)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1365
	    joinStyleInt= PS_JOIN_ROUND;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1366
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1367
	    joinStyleInt= PS_JOIN_MITER;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1368
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1369
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1370
	fgColor = GetTextColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1371
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1372
	hPen = CreatePen(lineStyleInt | capStyleInt | joinStyleInt, lineWidth, fgColor);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1373
	prevPen = SelectObject(hDC, hPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1374
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1375
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1376
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1377
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1378
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1379
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1380
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1381
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1382
getPenForContext
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1383
    "set line attributes"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1384
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1385
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1386
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1387
    if (__isExternalAddressLike(__INST(gcId))
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1388
     && __isSmallInteger(__INST(lineWidth))) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1389
	HANDLE hDC = (HANDLE)(__externalAddressVal(__INST(gcId)));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1390
	COLORREF fgColor;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1391
	HANDLE hPen;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1392
	int lineStyleInt, capStyleInt, joinStyleInt, lineWidth;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1393
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1394
	lineWidth= __INST(lineWidth);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1395
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1396
	if (__INST(lineStyle) == @symbol(solid)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1397
	    lineStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1398
	} else if (__INST(lineStyle) == @symbol(dashed)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1399
	    lineStyleInt= PS_DASH;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1400
	} else if (__INST(lineStyle) == @symbol(dotted)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1401
	    lineStyleInt= PS_DOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1402
	} else if (__INST(lineStyle) == @symbol(dashDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1403
	    lineStyleInt= PS_DASHDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1404
	} else if (__INST(lineStyle) == @symbol(dashDotDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1405
	    lineStyleInt= PS_DASHDOTDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1406
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1407
	    lineStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1408
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1409
	if (__INST(capStyle) == @symbol(round)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1410
	    capStyleInt= PS_ENDCAP_ROUND;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1411
	} else if (__INST(capStyle) == @symbol(square)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1412
	    capStyleInt= PS_ENDCAP_SQUARE;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1413
	} else if (__INST(capStyle) == @symbol(flat)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1414
	    capStyleInt= PS_ENDCAP_FLAT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1415
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1416
	    capStyleInt= PS_ENDCAP_FLAT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1417
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1418
	if (__INST(joinStyle) == @symbol(bevel)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1419
	    joinStyleInt= PS_JOIN_BEVEL;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1420
	} else if (__INST(joinStyle) == @symbol(miter)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1421
	    joinStyleInt= PS_JOIN_MITER;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1422
	} else if (__INST(joinStyle) == @symbol(round)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1423
	    joinStyleInt= PS_JOIN_ROUND;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1424
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1425
	    joinStyleInt= PS_JOIN_MITER;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1426
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1427
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1428
	fgColor = GetTextColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1429
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1430
	hPen = CreatePen(lineStyleInt | capStyleInt | joinStyleInt, lineWidth, fgColor);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1431
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1432
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1433
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1434
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1435
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1436
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1437
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1438
hatch
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1439
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1440
    "The hatch style will define a hatched brush between these patterns:
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1441
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1442
       #none
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1443
       #horizontal              -----       HS_HORIZONTAL = 0
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1444
       #vertical                |||||       HS_VERTICAL = 1
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1445
       #fDiagonal               \\\\\       HS_FDIAGONAL = 2
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1446
       #bDiagonal               /////       HS_BDIAGONAL = 3
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1447
       #cross                   +++++       HS_CROSS = 4
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1448
       #diagonalCross           xxxxx       HS_DIAGCROSS = 5
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1449
    "
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1450
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1451
    hatch isNil ifTrue:[^#none].
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1452
    ^ hatch
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1453
!
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1454
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1455
hatch: aSymbol
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1456
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1457
    "The hatch style will define a hatched brush between these patterns:
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1458
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1459
       #none
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1460
       #horizontal              -----       HS_HORIZONTAL = 0
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1461
       #vertical                |||||       HS_VERTICAL = 1
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1462
       #fDiagonal               \\\\\       HS_FDIAGONAL = 2
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1463
       #bDiagonal               /////       HS_BDIAGONAL = 3
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1464
       #cross                   +++++       HS_CROSS = 4
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1465
       #diagonalCross           xxxxx       HS_DIAGCROSS = 5
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1466
    "
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1467
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1468
    hatch := aSymbol
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1469
!
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1470
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1471
noClipIn:aWindowId gc:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1472
    "disable clipping rectangle"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1473
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1474
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1475
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1476
    if (__isExternalAddressLike(aDC)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1477
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1478
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1479
	SelectClipRgn(hDC, NULL);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1480
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1481
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1482
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1483
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1484
2399
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  1485
platformName
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  1486
    "used by #fillRoundRectangleX ...."
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1487
    ^ Smalltalk platformName asUppercase
2399
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  1488
!
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  1489
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1490
setBitmapMask:aBitmapId in:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1491
    "set or clear the drawing mask - a bitmap mask using current fg/bg"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1492
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1493
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1494
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1495
    if (__isExternalAddressLike(aDC)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1496
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1497
	HBITMAP oldM;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1498
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1499
/*        oldM = gcData->hMask;
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1500
	if (__isExternalAddress(aBitmapId))
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1501
	    gcData->hMask = _HBITMAPVAL(aBitmapId);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1502
	else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1503
	    gcData->hMask = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1504
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1505
	if (oldM != gcData->hMask) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1506
	  FLUSH_CACHED_DC(gcData);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1507
	    CPRINTF(("masks set to %x\n",gcData->hMask));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1508
	}                                                     */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1509
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1510
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1511
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1512
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1513
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1514
setClipX:clipX y:clipY width:clipWidth height:clipHeight in:ignoredDrawableId gc:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1515
    "clip to a rectangle"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1516
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1517
"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1518
      p--w---
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1519
      |     |
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1520
      h     |  the clipping rectangle
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1521
      |     |
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1522
      -------
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1523
	  where p = ( clipX, clipY ), w = clipWidth, h = clipHeight
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1524
"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1525
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1526
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1527
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1528
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1529
     && __bothSmallInteger(clipX, clipY)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1530
     && __bothSmallInteger(clipWidth, clipHeight) ) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1531
	HANDLE hDC;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1532
	int cX, cY, cW, cH;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1533
	POINT ptOrg;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1534
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1535
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1536
	hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1537
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1538
	GetViewportOrgEx(hDC,&ptOrg);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1539
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1540
	// set the clip rectangle
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1541
	// and offset the rectangle by the viewport origin
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1542
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1543
	cX = __intVal(clipX) + ptOrg.x;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1544
	cY = __intVal(clipY) + ptOrg.y;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1545
	cW = __intVal(clipWidth)+ ptOrg.x;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1546
	cH = __intVal(clipHeight)+ ptOrg.y;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1547
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1548
	{
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1549
	    HRGN region = CreateRectRgn(cX, cY, cX + cW, cY + cH);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1550
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1551
	    if (region == NULL ) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1552
		console_fprintf(stderr, "WinWorkstat [warning]: clipping region creation failed\n");
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1553
	    } else {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1554
		if (SelectClipRgn(hDC, region) == ERROR ) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1555
		    console_fprintf(stderr, "WinWorkstat [warning]: select clipping region failed\n");
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1556
		}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1557
		DeleteObject(region);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1558
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1559
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1560
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1561
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1562
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1563
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1564
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1565
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1566
setDashes:dashList dashOffset:offset in:aGCId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1567
    "set line attributes"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1568
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1569
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1570
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1571
    if (__isExternalAddressLike(aGCId)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1572
	DPRINTF(("WinWorkstat [warning]: dashes not (yet) implemented\n"));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1573
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1574
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1575
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1576
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1577
setLineWidth:aNumber style:lineStyle cap:capStyle join:joinStyle in:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1578
    "set line attributes"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1579
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1580
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1581
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1582
    HDC hDC;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1583
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1584
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1585
     && __isSmallInteger(aNumber)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1586
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1587
	int style;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1588
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1589
	if (lineStyle == @symbol(solid)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1590
	    style = PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1591
	} else if (lineStyle == @symbol(dashed)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1592
	    style= PS_DASH;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1593
	} else if (lineStyle == @symbol(dotted)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1594
	    style= PS_DOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1595
	} else if (lineStyle == @symbol(dashDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1596
	    style= PS_DASHDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1597
	} else if (lineStyle == @symbol(dashDotDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1598
	    style= PS_DASHDOTDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1599
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1600
	    style= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1601
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1602
	if (capStyle == @symbol(round)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1603
	    style = PS_ENDCAP_ROUND;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1604
	} else if (capStyle == @symbol(square)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1605
	    style = PS_ENDCAP_SQUARE;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1606
	} else if (capStyle == @symbol(flat)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1607
	    style = PS_ENDCAP_FLAT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1608
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1609
	    style = PS_ENDCAP_FLAT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1610
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1611
	if (joinStyle == @symbol(bevel)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1612
	    style = PS_JOIN_BEVEL;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1613
	} else if (joinStyle == @symbol(miter)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1614
	    style = PS_JOIN_MITER;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1615
	} else if (joinStyle == @symbol(round)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1616
	    style = PS_JOIN_ROUND;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1617
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1618
	    style = PS_JOIN_MITER;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1619
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1620
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1621
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1622
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1623
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1624
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1625
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1626
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1627
setMaskOriginX:orgX y:orgY in:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1628
    "set the mask origin"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1629
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1630
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1631
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1632
    if (__isExternalAddress(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1633
     && __bothSmallInteger(orgX,orgY)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1634
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1635
	int oX, oY, maskOrgX, maskOrgY;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1636
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1637
	oX = __intVal(orgX);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1638
	oY = __intVal(orgY);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1639
	if ((oX != maskOrgX)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1640
	 || (oY != maskOrgY)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1641
	    maskOrgX = __intVal(orgX);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1642
	    maskOrgY = __intVal(orgY);;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1643
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1644
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1645
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1646
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1647
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1648
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1649
setViewportOrg: aPoint
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1650
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1651
    "Sets the viewport origin (LOGICAL point (0,0)) of the device context"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1652
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  1653
    ^ OperatingSystem
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1654
	    setViewportOrg: gcId "deviceContext"
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1655
	    x: aPoint x
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1656
	    y: aPoint y
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1657
	    oldOrigin: nil
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1658
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1659
    "Created: / 01-08-2006 / 16:14:08 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1660
! !
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1661
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
  1662
!WinPrinterContext methodsFor:'drawing'!
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
  1663
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1664
displayArcX:x y:y width:width height:height from:startAngle angle:angle in:ignoredDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1665
    "draw an arc. If any of x,y, w or h is not an integer, an error is triggered.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1666
     The angles may be floats or integer - they are given in degrees."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1667
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1668
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1669
    int __x, __y, w, h;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1670
    float angle1, angle2;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1671
    double f;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1672
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1673
    if (__isSmallInteger(startAngle))
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1674
	angle1 = (float)(__intVal(startAngle));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1675
    else if (__isFloat(startAngle)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1676
	angle1 = (float) __floatVal(startAngle);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1677
    } else if (__isShortFloat(startAngle)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1678
	angle1 = __shortFloatVal(startAngle);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1679
    } else goto bad;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1680
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1681
    if (__isSmallInteger(angle))
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1682
	angle2 = (float)(__intVal(angle));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1683
    else if (__isFloat(angle)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1684
	angle2 = (float) __floatVal(angle);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1685
    } else if (__isShortFloat(angle)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1686
	angle2 = __shortFloatVal(angle);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1687
    } else goto bad;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1688
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1689
    if (angle2 <= 0) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1690
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1691
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1692
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1693
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1694
     && __bothSmallInteger(x, y)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1695
     && __bothSmallInteger(width, height))
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1696
     {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1697
	POINT p;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1698
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1699
	DWORD clr = 0 /* 0xFFFFFFFF */;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1700
	HANDLE prevPen, hPen;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1701
	double xB, yB, xE, yE, xR, yR;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1702
	COLORREF fgColor;
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1703
	OBJ lStyleSymbol;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1704
	int lStyleInt;
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1705
	int lw;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1706
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1707
	lw= __intVal(__INST(lineWidth));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1708
	lStyleSymbol= __INST(lineStyle);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1709
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1710
	/*  PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1711
	    only works with lineWidth = 1  */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1712
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1713
	if (lStyleSymbol == @symbol(solid)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1714
	    lStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1715
	} else if (lStyleSymbol == @symbol(dashed)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1716
	    lStyleInt= PS_DASH;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1717
	} else if (lStyleSymbol == @symbol(dotted)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1718
	    lStyleInt= PS_DOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1719
	} else if (lStyleSymbol == @symbol(dashDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1720
	    lStyleInt= PS_DASHDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1721
	} else if (lStyleSymbol == @symbol(dashDotDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1722
	    lStyleInt= PS_DASHDOTDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1723
	} else if (lStyleSymbol == @symbol(insideFrame)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1724
	    lStyleInt= PS_INSIDEFRAME;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1725
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1726
	    lStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1727
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1728
	fgColor = GetTextColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1729
	hPen = CreatePen(lStyleInt, lw, fgColor);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1730
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1731
	w = __intVal(width);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1732
	h = __intVal(height);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1733
	__x = __intVal(x);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1734
	__y = __intVal(y);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1735
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1736
	    xR = w / 2;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1737
	    yR = h / 2;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1738
	    if (angle2 - angle1 >= 360) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1739
		xB = xE = __x + xR + 0.5;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1740
		yB = yE = __y /*+ yR + 0.5*/;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1741
	    } else {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1742
		double sin(), cos();
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1743
		float rad1, rad2;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1744
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1745
		if (angle1 <= 180)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1746
		  angle1 = 180 - angle1;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1747
		else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1748
		  angle1 = 360 + 180 - angle1;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1749
		angle2 = angle1 - angle2;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1750
		/* sigh - compute the intersections ... */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1751
		rad1 = (angle1 * 3.14159265359) / 180.0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1752
		rad2 = (angle2 * 3.14159265359) / 180.0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1753
		xB = cos(rad1) * xR;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1754
		yB = sin(rad1) * yR;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1755
		xE = cos(rad2) * xR;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1756
		yE = sin(rad2) * yR;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1757
		xB = __x + xR - xB + 0.5;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1758
		yB = __y + yR - yB + 0.5;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1759
		xE = __x + xR - xE + 0.5;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1760
		yE = __y + yR - yE + 0.5;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1761
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1762
	    prevPen = SelectObject(hDC, hPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1763
	    DPRINTF(("Arc x=%d y=%d w=%d h=%d xB=%d xE=%d yB=%d yE=%d a1=%f a2=%f\n",__x,__y,w,h,(int)xB,(int)xE,(int)yB,(int)yE,angle1,angle2));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1764
	    Arc(hDC,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1765
		__x, __y,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1766
		__x + w, __y + h,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1767
		(int)xB, (int)yB,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1768
		(int)xE, (int)yE);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1769
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1770
	    SelectObject(hDC, prevPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1771
	    DeleteObject(hPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1772
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1773
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1774
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1775
    bad: ;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1776
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1777
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1778
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1779
    "Created: / 07-08-2006 / 10:40:27 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1780
    "Modified: / 07-08-2006 / 14:44:21 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1781
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1782
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1783
displayLineFromX:x0 y:y0 toX:x1 y:y1 in:ignoredDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1784
    "draw a line. If the coordinates are not integers, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1785
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1786
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1787
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1788
     && __bothSmallInteger(x0, y0)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1789
     && __bothSmallInteger(x1, y1)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1790
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1791
	COLORREF fgColor;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1792
	HANDLE prevPen, hPen;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1793
	int __x1 = __intVal(x1), __y1 = __intVal(y1);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1794
	OBJ lStyleSymbol;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1795
	int lStyleInt;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1796
	int lw;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1797
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1798
/*      DPRINTF(("displayLine: %d/%d -> %d/%d\n",
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1799
		    __intVal(x0), __intVal(y0),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1800
		    __x1, __y1));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1801
*/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1802
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1803
	lw= __intVal(__INST(lineWidth));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1804
	lStyleSymbol= __INST(lineStyle);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1805
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1806
	/*  PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1807
	    only works with lineWidth = 1  */
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1808
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1809
	if (lStyleSymbol == @symbol(solid)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1810
	    lStyleInt= PS_SOLID;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1811
	} else if (lStyleSymbol == @symbol(dashed)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1812
	    lStyleInt= PS_DASH;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1813
	} else if (lStyleSymbol == @symbol(dotted)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1814
	    lStyleInt= PS_DOT;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1815
	} else if (lStyleSymbol == @symbol(dashDot)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1816
	    lStyleInt= PS_DASHDOT;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1817
	} else if (lStyleSymbol == @symbol(dashDotDot)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1818
	    lStyleInt= PS_DASHDOTDOT;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1819
	} else if (lStyleSymbol == @symbol(insideFrame)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1820
	    lStyleInt= PS_INSIDEFRAME;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1821
	} else
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1822
	    lStyleInt= PS_SOLID;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1823
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1824
	fgColor = GetTextColor(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1825
	hPen = CreatePen(lStyleInt, lw, fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1826
	prevPen = SelectObject(hDC, hPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1827
	MoveToEx(hDC, __intVal(x0), __intVal(y0), NULL);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1828
	LineTo(hDC, __x1, __y1);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1829
	/*
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1830
	 * end-point ...
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1831
	 */
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1832
	// LineTo(hDC, __x1+1, __y1);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1833
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1834
	SelectObject(hDC, prevPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1835
	DeleteObject(hPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1836
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1837
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1838
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1839
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1840
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1841
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1842
displayPointX:px y:py in:ignoredDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1843
    "draw a point. If x/y are not integers, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1844
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1845
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1846
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1847
     && __bothSmallInteger(px, py)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1848
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1849
	POINT p;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1850
	COLORREF fgColor;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1851
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1852
	int __x = __intVal(px), __y = __intVal(py);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1853
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1854
	fgColor = GetTextColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1855
	SetPixelV(hDC, __x, __y, fgColor);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1856
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1857
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1858
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1859
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1860
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1861
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1862
displayPolygon:aPolygon in:aDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1863
    "draw a polygon, the argument aPolygon is a Collection of individual points,
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1864
     which define the polygon.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1865
     If any coordinate is not integer, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1866
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1867
    |numberOfPoints|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1868
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1869
    numberOfPoints := aPolygon size.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1870
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1871
    OBJ point, px, py;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1872
    int i, num;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1873
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1874
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1875
     /* && __isExternalAddress(aDrawableId) */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1876
     && __isSmallInteger(numberOfPoints)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1877
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1878
	POINT p;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1879
	DWORD clr = 0 /* 0xFFFFFFFF */;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1880
	HANDLE prevPen, hPen;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1881
	int lw;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1882
	COLORREF fgColor;
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1883
	OBJ lStyleSymbol;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1884
	int lStyleInt;
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1885
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1886
	lw= __intVal(__INST(lineWidth));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1887
	lStyleSymbol= __INST(lineStyle);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1888
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1889
	/*  PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1890
	    only works with lineWidth = 1  */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1891
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1892
	if (lStyleSymbol == @symbol(solid)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1893
	    lStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1894
	} else if (lStyleSymbol == @symbol(dashed)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1895
	    lStyleInt= PS_DASH;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1896
	} else if (lStyleSymbol == @symbol(dotted)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1897
	    lStyleInt= PS_DOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1898
	} else if (lStyleSymbol == @symbol(dashDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1899
	    lStyleInt= PS_DASHDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1900
	} else if (lStyleSymbol == @symbol(dashDotDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1901
	    lStyleInt= PS_DASHDOTDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1902
	} else if (lStyleSymbol == @symbol(insideFrame)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1903
	    lStyleInt= PS_INSIDEFRAME;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1904
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1905
	    lStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1906
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1907
	num = __intVal(numberOfPoints);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1908
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1909
	for (i=0; i<num; i++) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1910
	    point = __AT_(aPolygon, __MKSMALLINT(i+1));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1911
	    if (! __isPoint(point)) goto fail;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1912
	    px = _point_X(point);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1913
	    py = _point_Y(point);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1914
	    if (! __bothSmallInteger(px, py)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1915
		goto fail;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1916
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1917
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1918
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1919
	fgColor = GetTextColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1920
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1921
	hPen = CreatePen(lStyleInt, lw, fgColor);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1922
	prevPen = SelectObject(hDC, hPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1923
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1924
	for (i=0; i<num; i++) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1925
	    point = __AT_(aPolygon, __MKSMALLINT(i+1));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1926
	    px = _point_X(point);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1927
	    py = _point_Y(point);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1928
	    p.x = __intVal(px);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1929
	    p.y = __intVal(py);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1930
	    if (i == 0) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1931
		MoveToEx(hDC, p.x, p.y, NULL);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1932
	    } else {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1933
		if (i == (num-1)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1934
		    PolylineTo(hDC, &p, 1);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1935
		} else {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1936
		    LineTo(hDC, p.x, p.y);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1937
#ifdef PRE_04_JUN_04
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1938
		    /*
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1939
		     * end-point ...
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1940
		     */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1941
		    LineTo(hDC, p.x+1, p.y);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1942
#endif
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1943
		}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1944
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1945
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1946
	SelectObject(hDC, prevPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1947
	DeleteObject(hPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1948
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1949
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1950
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1951
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1952
fail: ;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1953
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1954
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1955
    "Created: / 07-08-2006 / 14:46:55 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1956
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1957
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  1958
displayPolylines:arrayOfPoints
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
  1959
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
  1960
    device displayPolylines:arrayOfPoints in:nil with:gcId
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1961
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1962
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1963
displayPolylines:aPolyline in:ignoredDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1964
    "draw a polyline, the argument aPolyline is a collection of individual points,
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1965
     which define the lines (p1/p2 pairs); must be even in size.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1966
     If any coordinate is not integer, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1967
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1968
    |numberOfPoints|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1969
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1970
    numberOfPoints := aPolyline size.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1971
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1972
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1973
    OBJ point, px, py;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1974
    int i, num;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1975
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1976
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1977
     && __isSmallInteger(numberOfPoints)) {
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1978
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1979
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1980
	POINT p;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1981
	HANDLE prevPen, hPen;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1982
	COLORREF fgColor;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1983
	int lw;
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1984
	OBJ lStyleSymbol;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1985
	int lStyleInt;
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1986
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1987
	lw= __intVal(__INST(lineWidth));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1988
	lStyleSymbol= __INST(lineStyle);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1989
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1990
	/*  PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1991
	    only works with lineWidth = 1  */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1992
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1993
	if (lStyleSymbol == @symbol(solid)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1994
	    lStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1995
	} else if (lStyleSymbol == @symbol(dashed)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1996
	    lStyleInt= PS_DASH;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1997
	} else if (lStyleSymbol == @symbol(dotted)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1998
	    lStyleInt= PS_DOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1999
	} else if (lStyleSymbol == @symbol(dashDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2000
	    lStyleInt= PS_DASHDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2001
	} else if (lStyleSymbol == @symbol(dashDotDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2002
	    lStyleInt= PS_DASHDOTDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2003
	} else if (lStyleSymbol == @symbol(insideFrame)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2004
	    lStyleInt= PS_INSIDEFRAME;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2005
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2006
	    lStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2007
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2008
	fgColor = GetTextColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2009
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2010
	num = __intVal(numberOfPoints);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2011
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2012
	for (i=0; i<num; i++) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2013
	    point = __AT_(aPolyline, __MKSMALLINT(i+1));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2014
	    if (! __isPoint(point)) goto fail;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2015
	    px = _point_X(point);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2016
	    py = _point_Y(point);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2017
	    if (! __bothSmallInteger(px, py)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2018
		goto fail;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2019
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2020
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2021
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2022
	hPen = CreatePen(lStyleInt, lw, fgColor);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2023
	prevPen = SelectObject(hDC, hPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2024
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2025
	for (i=0; i<num; i++) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2026
	    point = __AT_(aPolyline, __MKSMALLINT(i+1));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2027
	    px = _point_X(point);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2028
	    py = _point_Y(point);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2029
	    p.x = __intVal(px);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2030
	    p.y = __intVal(py);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2031
	    DPRINTF(("printing point"));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2032
	    DPRINTF(("displayPolygon: no pen\n"));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2033
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2034
	    if ((i & 1) == 0) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2035
		MoveToEx(hDC, p.x, p.y, NULL);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2036
	    } else {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2037
		LineTo(hDC, p.x, p.y);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2038
		/*
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2039
		 * end-point ...
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2040
		 */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2041
		LineTo(hDC, p.x+1, p.y);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2042
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2043
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2044
	SelectObject(hDC, prevPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2045
	DeleteObject(hPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2046
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2047
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2048
fail: ;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2049
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2050
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2051
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2052
displayRectangleX:x y:y width:width height:height in:ignoredDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2053
    "draw a rectangle. If the coordinates are not integers, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2054
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2055
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2056
    int w, h;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2057
    int xL, yT;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2058
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2059
     && __bothSmallInteger(x, y)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2060
     && __bothSmallInteger(width, height)) {
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2061
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2062
	xL = __intVal(x);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2063
	yT = __intVal(y);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2064
	w = __intVal(width);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2065
	h = __intVal(height);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2066
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2067
	DPRINTF(("displayRectangle: %d/%d -> %d/%d\n", xL, yT, w, h));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2068
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2069
	if ((w >= 0) && (h >= 0)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2070
	    HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2071
	    COLORREF fgColor;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2072
	    HANDLE prevPen, hPen;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2073
	    OBJ lStyleSymbol;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2074
	    int lStyleInt;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2075
	    int lw;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2076
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2077
	    lw= __intVal(__INST(lineWidth));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2078
	    lStyleSymbol= __INST(lineStyle);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2079
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2080
	    /*  PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2081
		only works with lineWidth = 1  */
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2082
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2083
	    if (lStyleSymbol == @symbol(solid)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2084
		lStyleInt= PS_SOLID;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2085
	    } else if (lStyleSymbol == @symbol(dashed)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2086
		lStyleInt= PS_DASH;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2087
	    } else if (lStyleSymbol == @symbol(dotted)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2088
		lStyleInt= PS_DOT;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2089
	    } else if (lStyleSymbol == @symbol(dashDot)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2090
		lStyleInt= PS_DASHDOT;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2091
	    } else if (lStyleSymbol == @symbol(dashDotDot)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2092
		lStyleInt= PS_DASHDOTDOT;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2093
	    } else if (lStyleSymbol == @symbol(insideFrame)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2094
		lStyleInt= PS_INSIDEFRAME;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2095
	    } else
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2096
		lStyleInt= PS_SOLID;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2097
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2098
	    fgColor = GetTextColor(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2099
	    hPen = CreatePen(lStyleInt, lw, fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2100
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2101
	    prevPen = SelectObject(hDC, hPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2102
	    MoveToEx(hDC, xL, yT, NULL);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2103
	    LineTo(hDC, xL+w, yT);       // to top-right
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2104
	    LineTo(hDC, xL+w, yT+h);     // to bot-right
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2105
	    MoveToEx(hDC, xL, yT, NULL); // back to top-left
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2106
	    LineTo(hDC, xL, yT+h);       // to bot-left
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2107
	    // LineTo(hDC, xL+w+1, yT+h);   // move pen one pixel more
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2108
	    LineTo(hDC, xL+w,   yT+h);   // move pen one pixel more
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2109
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2110
	    SelectObject(hDC, prevPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2111
	    DeleteObject(hPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2112
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2113
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2114
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2115
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2116
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2117
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2118
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2119
    "Created: / 28-07-2006 / 20:18:25 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2120
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2121
2399
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2122
displayRoundRectangleX:left y:top width:width height:height wCorner:wCorn hCorner:hCorn
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2123
    |right bottom wC hC wHalf hHalf|
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2124
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2125
    right := left + width-1.
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2126
    bottom := top + height-1.
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2127
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2128
    wC := wCorn.
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2129
    hC := hCorn.
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2130
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2131
    self scale = 1 ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2132
	wHalf := wC // 2.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2133
	hHalf := hC // 2.
2399
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2134
    ] ifFalse:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2135
	wHalf := wC / 2.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2136
	hHalf := hC / 2.
2399
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2137
    ].
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2138
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2139
    "top left arc"
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2140
    self displayArcX:left y:top width:wC height:hC from:90 angle:90.
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2141
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2142
    "top right arc"
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2143
    self displayArcX:(right - wC) y:top width:wC height:hC from:0 angle:90.
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2144
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2145
    "bottom right arc"
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2146
    self displayArcX:(right - wC) y:(bottom - hC) width:wC height:hC from:270 angle:90.
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2147
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2148
    "bottom left arc"
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2149
    self displayArcX:left y:(bottom - hC) width:wC height:hC from:180 angle:90.
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2150
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2151
    "top line"
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2152
    self displayLineFromX:(left + wHalf) y:top toX:(right - wHalf+1) y:top.
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2153
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2154
    "left line"
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2155
    self displayLineFromX:left y:(top + hHalf - 1) toX:left y:(bottom - hHalf).
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2156
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2157
    "bottom line"
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2158
    self displayLineFromX:(left + wHalf-1) y:bottom
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2159
		      toX:(right - wHalf ) y:bottom.
2399
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2160
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2161
    "right line"
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2162
    self displayLineFromX:right y:(top + hHalf) toX:right y:(bottom - hHalf).
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2163
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2164
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2165
    "
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2166
     |v|
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2167
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2168
     (v := View new) extent:200@200; openAndWait.
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2169
     v displayRoundRectangleX:10 y:10 width:100 height:100 wCorner:20 hCorner:20
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2170
    "
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2171
!
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2172
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2173
displayString:aString from:index1 to:index2 x:x y:y in:aDrawableId with:aGCId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2174
    "draw a sub-string - draw foreground only.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2175
     If the coordinates are not integers, retry with rounded."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2176
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2177
    self
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2178
	displayString:aString
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2179
	from:index1
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2180
	to:index2
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2181
	x:x
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2182
	y:y
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2183
	in:aDrawableId
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2184
	with:aGCId
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2185
	opaque:false
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2186
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2187
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2188
displayString:aString from:index1 to:index2 x:x y:y in:ignoredDrawableId with:aDC opaque:opaque
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2189
    "draw a sub-string - if opaque is false, draw foreground only; otherwise, draw both
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2190
     foreground and background characters.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2191
     If the coordinates are not integers, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2192
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2193
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2194
    unsigned char *cp;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2195
    OBJ cls;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2196
    int  i1, i2, l, n;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2197
    int nInstBytes;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2198
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2199
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2200
     && __isNonNilObject(aString)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2201
     && __bothSmallInteger(index1, index2)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2202
     && __bothSmallInteger(x, y))
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2203
    {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2204
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2205
	int pX, pY;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2206
	COLORREF fgColor;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2207
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2208
	pX = __intVal(x);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2209
	pY = __intVal(y);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2210
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2211
	if (opaque == true) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2212
	    SetBkMode(hDC, OPAQUE);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2213
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2214
	    SetBkMode(hDC, TRANSPARENT);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2215
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2216
	fgColor = GetTextColor(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2217
	SetTextColor(hDC, fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2218
	SetBkColor(hDC, 0xFFFFFFFF);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2219
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2220
	cls = __qClass(aString);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2221
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2222
	i1 = __intVal(index1) - 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2223
	if (i1 >= 0) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2224
	    i2 = __intVal(index2) - 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2225
	    if (i2 < i1) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2226
		goto ret;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2227
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2228
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2229
	    cp = _stringVal(aString);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2230
	    l = i2 - i1 + 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2231
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2232
	    if ((cls == @global(String)) || (cls == @global(Symbol))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2233
		n = _stringSize(aString);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2234
		if (i2 < n) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2235
		    cp += i1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2236
		    DPRINTF(("string1: %s pos=%d/%d l=%d hDC=%x\n", cp, pX, pY,l,hDC));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2237
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2238
		    if (l > 32767) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2239
			l = 32767;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2240
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2241
		    if (! TextOut(hDC, pX, pY, (char *)cp, l)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2242
			DFPRINTF((stderr, "WinPrinter [warning]: Textout failed. %d\n", GetLastError()));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2243
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2244
		    goto ret;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2245
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2246
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2247
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2248
	    nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2249
	    cp += nInstBytes;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2250
	    n = __byteArraySize(aString) - nInstBytes;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2251
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2252
	    if (__isBytes(aString)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2253
		if (i2 < n) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2254
		    cp += i1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2255
		    DPRINTF(("string: %s pos=%d/%d\n", cp, pX, pY));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2256
		    if (l > 32767) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2257
			l = 32767;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2258
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2259
		    if (! TextOut(hDC, pX, pY, (char *)cp, l)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2260
			DFPRINTF((stderr, "WinPrinter [warning]: Textout failed. %d\n", GetLastError()));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2261
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2262
		    goto ret;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2263
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2264
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2265
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2266
	    /* Unicode */
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2267
	    if (__isWords(aString)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2268
		n = n / 2;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2269
		if (i2 < n) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2270
		    WIDECHAR *w_cp = (WIDECHAR *)cp;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2271
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2272
		    w_cp += i1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2273
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2274
		    if (! TextOutW(hDC, pX, pY, w_cp, l)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2275
			DFPRINTF((stderr, "WinPrinter [warning]: TextoutW failed. %d\n", GetLastError()));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2276
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2277
		    goto ret;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2278
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2279
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2280
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2281
ret:
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2282
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2283
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2284
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2285
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2286
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2287
    "Created: / 28-07-2006 / 20:35:19 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2288
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2289
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2290
displayString:aString from:index1 to:index2 x:x y:y in:ignoredDrawableId with:aDC opaque:opaque fontAscent:fontAscent
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2291
    "draw a sub-string - if opaque is false, draw foreground only; otherwise, draw both
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2292
     foreground and background characters.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2293
     If the coordinates are not integers, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2294
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2295
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2296
    unsigned char *cp;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2297
    OBJ cls;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2298
    int  i1, i2, l, n;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2299
    int nInstBytes;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2300
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2301
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2302
     && __isNonNilObject(aString)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2303
     && __bothSmallInteger(index1, index2)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2304
     && __bothSmallInteger(x, y))
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2305
    {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2306
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2307
	int pX, pY;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2308
	COLORREF fgColor;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2309
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2310
	pX = __intVal(x);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2311
	pY = __intVal(y);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2312
	pY -= __intVal(fontAscent);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2313
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2314
	if (opaque == true) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2315
	    SetBkMode(hDC, OPAQUE);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2316
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2317
	    SetBkMode(hDC, TRANSPARENT);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2318
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2319
	fgColor = GetTextColor(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2320
	SetTextColor(hDC, fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2321
	SetBkColor(hDC, 0xFFFFFFFF);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2322
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2323
	cls = __qClass(aString);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2324
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2325
	i1 = __intVal(index1) - 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2326
	if (i1 >= 0) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2327
	    i2 = __intVal(index2) - 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2328
	    if (i2 < i1) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2329
		goto ret;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2330
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2331
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2332
	    cp = _stringVal(aString);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2333
	    l = i2 - i1 + 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2334
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2335
	    if ((cls == @global(String)) || (cls == @global(Symbol))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2336
		n = _stringSize(aString);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2337
		if (i2 < n) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2338
		    cp += i1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2339
		    DPRINTF(("string1: %s pos=%d/%d l=%d hDC=%x\n", cp, pX, pY,l,hDC));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2340
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2341
		    if (l > 32767) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2342
			l = 32767;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2343
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2344
		    if (! TextOut(hDC, pX, pY, (char *)cp, l)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2345
			DFPRINTF((stderr, "WinPrinter [warning]: Textout failed. %d\n", GetLastError()));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2346
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2347
		    goto ret;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2348
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2349
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2350
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2351
	    nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2352
	    cp += nInstBytes;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2353
	    n = __byteArraySize(aString) - nInstBytes;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2354
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2355
	    if (__isBytes(aString)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2356
		if (i2 < n) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2357
		    cp += i1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2358
		    DPRINTF(("string: %s pos=%d/%d\n", cp, pX, pY));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2359
		    if (l > 32767) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2360
			l = 32767;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2361
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2362
		    if (! TextOut(hDC, pX, pY, (char *)cp, l)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2363
			DFPRINTF((stderr, "WinPrinter [warning]: Textout failed. %d\n", GetLastError()));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2364
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2365
		    goto ret;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2366
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2367
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2368
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2369
	    /* Unicode */
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2370
	    if (__isWords(aString)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2371
		n = n / 2;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2372
		if (i2 < n) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2373
		    WIDECHAR *w_cp = (WIDECHAR *)cp;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2374
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2375
		    w_cp += i1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2376
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2377
		    if (! TextOutW(hDC, pX, pY, w_cp, l)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2378
			DFPRINTF((stderr, "WinPrinter [warning]: TextoutW failed. %d\n", GetLastError()));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2379
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2380
		    goto ret;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2381
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2382
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2383
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2384
ret:
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2385
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2386
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2387
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2388
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2389
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2390
    "Created: / 28-07-2006 / 20:35:19 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2391
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2392
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2393
displayString:aString x:x y:y in:aDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2394
    "draw a string - draw foreground only.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2395
     If the coordinates are not integers, retry with rounded."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2396
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2397
    self
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2398
	displayString:aString
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2399
	x:x
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2400
	y:y
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2401
	in:aDrawableId
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2402
	with:aDC
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2403
	opaque:false
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2404
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2405
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2406
displayString:aString x:x y:y in:aDrawableId with:aDC opaque:opaque
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2407
    "draw a string"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2408
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2409
    self displayString:aString
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2410
		  from:1
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2411
		    to:aString size
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2412
		     x:x
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2413
		     y:y
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2414
		     in:aDrawableId
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2415
		     with:aDC
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2416
		     opaque:opaque
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2417
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2418
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2419
fillArcX:x y:y width:width height:height from:startAngle angle:angle
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2420
	       in:ignoredDrawableId with:aDC
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2421
    "fill an arc. If any coordinate is not integer, an error is triggered.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2422
     The angles may be floats or integer - they are given in degrees."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2423
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2424
    | hatchSymbol |
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2425
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2426
    hatchSymbol := self hatch.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2427
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2428
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2429
    int __x, __y, w, h;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2430
    float angle1, angle2;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2431
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2432
    if (__isSmallInteger(startAngle))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2433
	angle1 = (float)(__intVal(startAngle));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2434
    else if (__isFloat(startAngle)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2435
	angle1 = __floatVal(startAngle);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2436
    } else if (__isShortFloat(startAngle)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2437
	angle1 = __shortFloatVal(startAngle);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2438
    } else goto bad;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2439
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2440
    if (__isSmallInteger(angle))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2441
	angle2 = (float)(__intVal(angle));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2442
    else if (__isFloat(angle)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2443
	angle2 = __floatVal(angle);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2444
    } else if (__isShortFloat(angle)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2445
	angle2 = __shortFloatVal(angle);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2446
    } else goto bad;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2447
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2448
    if (angle2 <= 0) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2449
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2450
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2451
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2452
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2453
     && __bothSmallInteger(x, y)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2454
     && __bothSmallInteger(width, height))
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2455
     {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2456
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2457
	HBRUSH hBrush, prevBrush;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2458
	HPEN prevPen = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2459
	COLORREF fgColor;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2460
	int hatch, hasHatch;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2461
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2462
	w = __intVal(width);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2463
	h = __intVal(height);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2464
	__x = __intVal(x);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2465
	__y = __intVal(y);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2466
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2467
	fgColor = GetTextColor(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2468
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2469
	hasHatch= 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2470
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2471
	if (hatchSymbol == @symbol(none)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2472
	    hasHatch= 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2473
	} else if (hatchSymbol == @symbol(horizontal)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2474
	    hatch= HS_HORIZONTAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2475
	} else if (hatchSymbol == @symbol(vertical)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2476
	    hatch= HS_VERTICAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2477
	} else if (hatchSymbol == @symbol(cross)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2478
	    hatch= HS_CROSS;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2479
	} else if (hatchSymbol == @symbol(bDiagonal)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2480
	    hatch= HS_BDIAGONAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2481
	} else if (hatchSymbol == @symbol(fDiagonal)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2482
	    hatch= HS_FDIAGONAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2483
	} else if (hatchSymbol == @symbol(diagonalCross)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2484
	    hatch= HS_DIAGCROSS;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2485
	} else
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2486
	    hasHatch= 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2487
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2488
	if (hasHatch) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2489
	    hBrush = CreateHatchBrush(hatch, fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2490
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2491
	    hBrush = CreateSolidBrush(fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2492
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2493
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2494
	prevBrush = SelectObject(hDC, hBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2495
	if (hBrush == 0) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2496
	    DPRINTF(("fillArc: no brush\n"));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2497
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2498
	    HPEN hPen = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2499
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2500
	    if (0 /* __isWinNT */) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2501
		fgColor = GetTextColor(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2502
		hPen = CreatePen(PS_SOLID, 1, fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2503
		prevPen = SelectObject(hDC, hPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2504
		if (hPen == 0) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2505
		    DPRINTF(("fillArc: no pen\n"));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2506
		    goto failpen;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2507
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2508
	    } else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2509
		prevPen = SelectObject(hDC, GetStockObject(NULL_PEN));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2510
		w++;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2511
		h++;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2512
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2513
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2514
	    {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2515
		double xB, yB, xE, yE, xR, yR;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2516
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2517
		xR = w / 2;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2518
		yR = h / 2;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2519
		if (angle2 - angle1 >= 360) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2520
		    xB = xE = __x + xR + 0.5;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2521
		    yB = yE = __y /*+ yR + 0.5*/;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2522
		} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2523
		    double sin(), cos();
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2524
		    float rad1, rad2;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2525
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2526
		    if (angle1 <= 180)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2527
			angle1 = 180 - angle1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2528
		    else
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2529
			angle1 = 360 + 180 - angle1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2530
		    angle2 = angle1 - angle2;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2531
		    /* sigh - compute the intersections ... */
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2532
		    rad1 = (angle1 * 3.14159265359) / 180.0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2533
		    rad2 = (angle2 * 3.14159265359) / 180.0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2534
		    xB = cos(rad1) * xR;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2535
		    yB = sin(rad1) * yR;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2536
		    xE = cos(rad2) * xR;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2537
		    yE = sin(rad2) * yR;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2538
		    xB = __x + xR - xB + 0.5;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2539
		    yB = __y + yR - yB + 0.5;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2540
		    xE = __x + xR - xE + 0.5;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2541
		    yE = __y + yR - yE + 0.5;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2542
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2543
		DPRINTF(("fillArc x=%d y=%d w=%d h=%d xB=%d xE=%d yB=%d yE=%d a1=%f a2=%f\n",__x,__y,w,h,(int)xB,(int)xE,(int)yB,(int)yE,angle1,angle2));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2544
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2545
		Pie(hDC,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2546
		    __x, __y,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2547
		    __x + w + 1, __y + h + 1,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2548
		    (int)xB, (int)yB,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2549
		    (int)xE, (int)yE);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2550
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2551
		if (hPen) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2552
		    DeleteObject(hPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2553
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2554
	    }
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2555
failpen:
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2556
	    if (prevPen) SelectObject(hDC, prevPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2557
	    DeleteObject(hPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2558
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2559
	    SelectObject(hDC, prevBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2560
	    DeleteObject(hBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2561
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2562
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2563
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2564
    bad: ;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2565
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2566
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2567
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2568
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2569
fillPolygon:aPolygon in:ignoredDrawableId with:aGCId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2570
    "fill a polygon given by its points.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2571
     If any coordinate is not integer, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2572
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2573
    |numberOfPoints|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2574
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2575
    numberOfPoints := aPolygon size.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2576
    self
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2577
	primFillPolygon:aPolygon n:numberOfPoints
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2578
	in:ignoredDrawableId with:aGCId
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2579
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2580
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2581
fillRectangleX:x y:y width:width height:height in:ignoredDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2582
    "fill a rectangle. If any coordinate is not integer, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2583
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2584
    |hatchSymbol|
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2585
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2586
    hatchSymbol := self hatch.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2587
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2588
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2589
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2590
    int w, h;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2591
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2592
     && __bothSmallInteger(x, y)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2593
     && __bothSmallInteger(width, height)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2594
	w = __intVal(width);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2595
	h = __intVal(height);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2596
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2597
	if ((w >= 0) && (h >= 0)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2598
	    HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2599
	    HBRUSH hBrush, prevBrush;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2600
	    RECT rct;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2601
	    COLORREF fgColor;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2602
	    int hatch, hasHatch;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2603
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2604
	    fgColor = GetTextColor(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2605
	    hasHatch= 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2606
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2607
	    if (hatchSymbol == @symbol(none)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2608
		hasHatch= 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2609
	    } else if (hatchSymbol == @symbol(horizontal)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2610
		hatch= HS_HORIZONTAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2611
	    } else if (hatchSymbol == @symbol(vertical)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2612
		hatch= HS_VERTICAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2613
	    } else if (hatchSymbol == @symbol(cross)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2614
		hatch= HS_CROSS;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2615
	    } else if (hatchSymbol == @symbol(bDiagonal)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2616
		hatch= HS_BDIAGONAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2617
	    } else if (hatchSymbol == @symbol(fDiagonal)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2618
		hatch= HS_FDIAGONAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2619
	    } else if (hatchSymbol == @symbol(diagonalCross)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2620
		hatch= HS_DIAGCROSS;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2621
	    } else
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2622
		hasHatch= 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2623
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2624
	    if (hasHatch) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2625
		hBrush = CreateHatchBrush(hatch, fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2626
	    } else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2627
		hBrush = CreateSolidBrush(fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2628
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2629
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2630
	    rct.left = __intVal(x);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2631
	    rct.top  = __intVal(y);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2632
	    rct.right  = rct.left + w; // + 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2633
	    rct.bottom = rct.top  + h; // + 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2634
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2635
	   prevBrush = SelectObject(hDC, hBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2636
	   FillRect(hDC, &rct, hBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2637
	   SelectObject(hDC, prevBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2638
	   DeleteObject(hBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2639
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2640
	}
2326
82077cd59898 *** empty log message ***
fm
parents: 2325
diff changeset
  2641
    }
82077cd59898 *** empty log message ***
fm
parents: 2325
diff changeset
  2642
    RETURN ( self );
2327
32f68e607e13 + displayString supports color
fm
parents: 2326
diff changeset
  2643
32f68e607e13 + displayString supports color
fm
parents: 2326
diff changeset
  2644
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2645
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2646
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2647
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2648
primFillPolygon:aPolygon n:numberOfPoints in:ignoredDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2649
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2650
    |hatchSymbol|
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2651
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2652
    hatchSymbol := self hatch.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2653
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2654
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2655
    OBJ point, px, py;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2656
    int i, num;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2657
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2658
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2659
     && __isSmallInteger(numberOfPoints)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2660
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2661
	POINT p;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2662
	HBRUSH hBrush, prevBrush;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2663
	COLORREF fgColor;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2664
	int hatch, hasHatch;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2665
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2666
	num = __intVal(numberOfPoints);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2667
	if (num < 3) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2668
	    RETURN ( self );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2669
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2670
	for (i=0; i<num; i++) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2671
	    point = __AT_(aPolygon, __MKSMALLINT(i+1));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2672
	    if (! __isPoint(point)) goto fail;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2673
	    px = _point_X(point);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2674
	    py = _point_Y(point);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2675
	    if (! __bothSmallInteger(px, py))
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2676
		goto fail;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2677
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2678
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2679
	fgColor = GetTextColor(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2680
	hasHatch= 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2681
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2682
	if (hatchSymbol == @symbol(none)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2683
	    hasHatch= 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2684
	} else if (hatchSymbol == @symbol(horizontal)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2685
	    hatch= HS_HORIZONTAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2686
	} else if (hatchSymbol == @symbol(vertical)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2687
	    hatch= HS_VERTICAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2688
	} else if (hatchSymbol == @symbol(cross)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2689
	    hatch= HS_CROSS;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2690
	} else if (hatchSymbol == @symbol(bDiagonal)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2691
	    hatch= HS_BDIAGONAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2692
	} else if (hatchSymbol == @symbol(fDiagonal)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2693
	    hatch= HS_FDIAGONAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2694
	} else if (hatchSymbol == @symbol(diagonalCross)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2695
	    hatch= HS_DIAGCROSS;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2696
	} else
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2697
	    hasHatch= 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2698
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2699
	if (hasHatch) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2700
	    hBrush = CreateHatchBrush(hatch, fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2701
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2702
	    hBrush = CreateSolidBrush(fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2703
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2704
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2705
	if (hBrush == 0) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2706
	    DPRINTF(("fillPolygon: no brush\n"));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2707
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2708
	    HPEN prevPen;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2709
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2710
	    prevBrush = SelectObject(hDC, hBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2711
	    prevPen = SelectObject(hDC, GetStockObject(NULL_PEN));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2712
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2713
	    BeginPath(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2714
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2715
	    for (i=0; i<num; i++) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2716
		point = __AT_(aPolygon, __MKSMALLINT(i+1));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2717
		px = _point_X(point);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2718
		py = _point_Y(point);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2719
		if (i == 0) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2720
		    MoveToEx(hDC, __intVal(px), __intVal(py), NULL);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2721
		} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2722
		    if (i == (num-1)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2723
			p.x = __intVal(px);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2724
			p.y = __intVal(py);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2725
			PolylineTo(hDC, &p, 1);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2726
		    } else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2727
			LineTo(hDC, __intVal(px), __intVal(py));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2728
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2729
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2730
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2731
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2732
	    EndPath(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2733
	    FillPath(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2734
	    SelectObject(hDC, prevPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2735
	    SelectObject(hDC, prevBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2736
	    DeleteObject(hBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2737
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2738
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2739
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2740
fail: ;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2741
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2742
%}
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2743
!
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2744
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2745
scaleTest_displayString:aString x:x y:y
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2746
    "draw a string at the coordinate x/y -
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2747
     draw foreground-pixels only (in current paint-color),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2748
     leaving background as-is. If the transformation involves scaling,
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2749
     the fonts point-size is scaled as appropriate."
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2750
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2751
    |id pX pY fontUsed sz s fontsEncoding|
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2752
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2753
    "hook for non-strings (i.e. attributed text)"
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2754
    (aString isString not
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2755
    or:[aString isText]) ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2756
	^ aString displayOn:self x:x y:y
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2757
    ].
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2758
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2759
    gcId isNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2760
	self initGC
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2761
    ].
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2762
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2763
    fontUsed := font.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2764
    transformation notNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2765
	pX := transformation applyToX:x.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2766
	pY := transformation applyToY:y.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2767
	transformation noScale ifFalse:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2768
	    sz := font size.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2769
	    sz isNil ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2770
		"/ oops - not a real font; use original font
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2771
		fontUsed := font
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2772
	    ] ifFalse:[ |yS|
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2773
		yS := self pixelsPerInchOfScreenHeight / Screen current verticalPixelPerInch.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2774
		yS := self scale y / yS.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2775
		fontUsed := font size:(sz * yS) rounded.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2776
	    ]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2777
	]
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2778
    ] ifFalse:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2779
	pX := x.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2780
	pY := y.
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2781
    ].
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2782
    pX := pX rounded.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2783
    pY := pY rounded.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2784
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2785
    s := aString.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2786
    fontUsed := fontUsed onDevice:device.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2787
    fontsEncoding := fontUsed encoding.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2788
    (characterEncoding ~~ fontsEncoding) ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2789
	[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2790
	    s := CharacterEncoder encodeString:s from:characterEncoding into:fontsEncoding.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2791
	] on:CharacterEncoderError do:[:ex|
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2792
	    "substitute a default value for codes that cannot be represented
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2793
	     in the new character set"
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2794
	    ex proceedWith:ex defaultValue.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2795
	].
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2796
    ].
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2797
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2798
    id := fontUsed fontId.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2799
    id isNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2800
	"hook for alien fonts"
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2801
	fontUsed displayString:s x:x y:y in:self
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2802
    ] ifFalse:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2803
	deviceFont ~~ fontUsed ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2804
	    device setFont:id in:gcId.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2805
	    deviceFont := fontUsed
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2806
	].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2807
	device displayString:s x:pX y:pY in:drawableId with:gcId
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2808
    ]
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2809
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2810
    "Modified: 1.7.1997 / 17:08:35 / cg"
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2811
! !
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2812
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2813
!WinPrinterContext methodsFor:'drawing bitmaps'!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2814
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2815
bitsBlue
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2816
    "return the number of valid bits in the red component."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2817
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2818
"/    bitsRed isNil ifTrue:[
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2819
"/        "/ not a truecolor display
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2820
"/        ^ bitsPerRGB
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2821
"/    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2822
"/    ^ bitsRed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2823
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2824
     ^Display bitsBlue
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2825
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2826
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2827
bitsGreen
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2828
    "return the number of valid bits in the red component."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2829
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2830
"/    bitsRed isNil ifTrue:[
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2831
"/        "/ not a truecolor display
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2832
"/        ^ bitsPerRGB
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2833
"/    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2834
"/    ^ bitsRed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2835
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2836
     ^Display bitsGreen
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2837
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2838
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2839
bitsRed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2840
    "return the number of valid bits in the red component."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2841
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2842
"/    bitsRed isNil ifTrue:[
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2843
"/        "/ not a truecolor display
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2844
"/        ^ bitsPerRGB
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2845
"/    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2846
"/    ^ bitsRed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2847
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2848
     ^Display bitsRed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2849
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2850
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2851
compressColorMapImage: image
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2852
    "calculates a new color map for the image, using only used colors"
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2853
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2854
    |depth newColorMap newImage oldImage usedColors oldToNew oldBits newBits tmpBits|
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2855
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2856
    oldImage := image.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2857
    depth := oldImage depth.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2858
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2859
    oldImage photometric ~~ #palette ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2860
	Transcript showCR:'Compress colorMap: Only palette images have colormaps.'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2861
	^ image
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2862
    ].
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2863
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2864
    usedColors := oldImage realUsedColors.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2865
    usedColors size == (1 bitShift:depth) ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2866
	Transcript showCR:'Compress colorMap: All colors are used - no compression.'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2867
	^ image
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2868
    ].
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2869
    usedColors size == oldImage colorMap size ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2870
	Transcript showCR:'Compress colorMap: Colormap already compressed - no compression.'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2871
	^ image
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2872
    ].
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2873
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2874
	"/ translation table
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2875
	oldToNew := ByteArray new:(1 bitShift:depth).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2876
	newColorMap := usedColors asArray.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2877
	newColorMap sort:self sortBlockForColors.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2878
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2879
	oldImage colorMap asArray keysAndValuesDo:[:oldIdx :clr |
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2880
	    |newPixel|
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2881
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2882
	    (usedColors includes:clr) ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2883
		newPixel := newColorMap indexOf:clr.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2884
		oldToNew at:oldIdx put:newPixel-1.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2885
	    ]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2886
	].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2887
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2888
	oldBits := oldImage bits.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2889
	newBits := ByteArray new:(oldBits size).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2890
	depth ~~ 8 ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2891
	    "/ expand/compress can only handle 8bits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2892
	    tmpBits := ByteArray uninitializedNew:(oldImage width*oldImage height).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2893
	    oldBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2894
		expandPixels:depth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2895
		width:oldImage width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2896
		height:oldImage height
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2897
		into:tmpBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2898
		mapping:oldToNew.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2899
	    tmpBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2900
		compressPixels:depth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2901
		width:oldImage width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2902
		height:oldImage height
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2903
		into:newBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2904
		mapping:nil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2905
	] ifFalse:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2906
	    oldBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2907
		expandPixels:depth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2908
		width:oldImage width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2909
		height:oldImage height
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2910
		into:newBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2911
		mapping:oldToNew.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2912
	].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2913
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2914
	newImage := oldImage species new
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2915
			width:oldImage width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2916
			height:oldImage height
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2917
			depth:depth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2918
			fromArray:newBits.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2919
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2920
	newImage colorMap:newColorMap.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2921
	newImage fileName:oldImage fileName.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2922
	newImage mask:(oldImage mask copy).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2923
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2924
	^ newImage
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2925
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2926
    "Created: / 28.7.1998 / 20:03:11 / cg"
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2927
    "Modified: / 15.9.1998 / 17:53:32 / cg"
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2928
!
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2929
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2930
copyFromId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2931
		width:w height:h
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2932
    "do a bit-blt; copy bits from the rectangle defined by
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2933
     srcX/srcY and w/h from the sourceId drawable to the rectangle
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2934
     below dstX/dstY in the destId drawable. Trigger an error if any
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2935
     argument is not integer."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2936
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2937
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2938
    int     dstGcOwnerThreadID;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2939
    HWND    dstGcHWIN;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2940
    HBITMAP dstGcHBITMAP;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2941
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2942
    if (! __isExternalAddressLike(srcGCId)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2943
     || ! __isExternalAddressLike(dstGCId)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2944
	goto fail;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2945
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2946
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2947
    if (__bothSmallInteger(w, h)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2948
     && __bothSmallInteger(srcX, srcY)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2949
     && __bothSmallInteger(dstX, dstY)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2950
	HANDLE srcDC = (HANDLE)(__externalAddressVal(srcGCId));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2951
	HANDLE dstDC = (HANDLE)(__externalAddressVal(dstGCId));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2952
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2953
	int fun;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2954
	OBJ aFunctionSymbol;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2955
	int src_fg, src_bg, dst_fg, dst_bg;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2956
	char buf[5];
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2957
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2958
//          fun = dstGcData->bitbltrop2;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2959
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2960
	aFunctionSymbol= __INST(function);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2961
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2962
	if (aFunctionSymbol == @symbol(copy)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2963
	    fun = SRCCOPY /* R2_COPYPEN */ ;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2964
/*            bfun = BITBLT_COPY;                                          */
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2965
	} else if (aFunctionSymbol == @symbol(copyInverted)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2966
	    fun = NOTSRCCOPY /* R2_NOTCOPYPEN */;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2967
/*            bfun = BITBLT_COPYINVERTED;                                  */
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2968
	} else if (aFunctionSymbol == @symbol(xor)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2969
	    fun = SRCINVERT /* R2_XORPEN */;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2970
/*            bfun = BITBLT_XOR;                                           */
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2971
	} else if (aFunctionSymbol == @symbol(and)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2972
	    fun = SRCAND /* R2_MASKPEN */ ;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2973
/*            bfun = BITBLT_AND;                                           */
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2974
	} else if (aFunctionSymbol == @symbol(or)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2975
	    fun = MERGECOPY /* R2_MERGEPEN */ ;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2976
/*            bfun = BITBLT_OR;                                            */
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2977
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2978
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2979
    // convert 123 to string [buf]
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  2980
    // itoa(fun, buf, 10);
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  2981
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  2982
    //        console_printf(" ", buf);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2983
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2984
/*
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2985
#if 0
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2986
	switch (fun) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2987
	  case BITBLT_COPY:
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2988
	    console_printf("BITBLT_COPY\n");
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2989
	    break;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2990
	  case BITBLT_COPYINVERTED:
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2991
	    console_printf("BITBLT_COPYINVERTED\n");
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2992
	    break;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2993
	  case BITBLT_XOR:
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2994
	    console_printf("BITBLT_XOR\n");
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2995
	    break;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2996
	  case BITBLT_AND:
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2997
	    console_printf("BITBLT_AND\n");
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2998
	    break;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2999
	  case BITBLT_OR:
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3000
	    console_printf("BITBLT_OR\n");
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3001
	    break;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3002
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3003
#endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3004
*/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3005
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3006
//          fun = dstGcData->bitbltrop2;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3007
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3008
	if (0 /* fun == BITBLT_COPY */) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3009
	    src_fg = dst_fg = 0xFFFFFF;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3010
	    src_bg = dst_bg = 0x000000;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3011
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3012
	    src_fg = GetTextColor(srcDC) /* srcGcData->fgColor */;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3013
	    src_bg = GetBkColor(dstDC) /* srcGcData->bgColor */;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3014
	    dst_fg = GetTextColor(srcDC) /* dstGcData->fgColor */;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3015
	    dst_bg = GetBkColor(dstDC) /* dstGcData->bgColor */;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3016
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3017
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3018
	SetBkColor(dstDC, dst_fg);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3019
	SetTextColor(dstDC, dst_bg);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3020
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3021
	SetBkColor(srcDC, src_fg);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3022
	SetTextColor(srcDC, src_bg);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3023
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3024
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3025
	CPRINTF(("bitblt src f:%x b:%x",GetTextColor(srcDC),GetBkColor(srcDC)));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3026
	CPRINTF(("dst f:%x b:%x\n",GetTextColor(dstDC),GetBkColor(dstDC)));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3027
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3028
	if (BitBlt(dstDC,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3029
	     __intVal(dstX), __intVal(dstY),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3030
	     __intVal(w), __intVal(h),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3031
	     srcDC,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3032
	     __intVal(srcX), __intVal(srcY),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3033
	     fun)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3034
	   == 0
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3035
	  ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3036
	    console_fprintf(stderr, "WinWorkstation [info]: ERROR in BitBlt\n");
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3037
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3038
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3039
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3040
	if (dstGcData != srcGcData) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3041
	    SetBkColor(dstDC, dstGcData->bgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3042
	    SetTextColor(dstDC, dstGcData->fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3043
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3044
	SetBkColor(srcDC, srcGcData->bgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3045
	SetTextColor(srcDC, srcGcData->fgColor);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3046
*/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3047
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3048
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3049
	if (srcGcData != dstGcData) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3050
	    _releaseDC(srcGcData);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3051
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3052
	_releaseDC(dstGcData);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3053
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3054
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3055
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3056
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3057
 fail: ;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3058
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3059
    self primitiveFailed.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3060
    ^ nil
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3061
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3062
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3063
copyFromPixmapId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId width:w height:h
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3064
    "do a bit-blt from a pix- or bitmap.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3065
     Here, fall back into copyFromId:, which should also work.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3066
     Subclasses may redefine this for more performance or if required"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3067
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3068
    ^ self copyFromId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId width:w height:h
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3069
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3070
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3071
copyPlaneFromId:sourceId x:srcX y:srcY gc:srcDCId to:destId x:dstX y:dstY gc:dstDCId
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3072
		width:w height:h
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3073
    "do a bit-blt, but only copy the low-bit plane;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3074
     copy bits from the rectangle defined by
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3075
     srcX/srcY and w/h from the sourceId drawable to the rectangle
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3076
     below dstX/dstY in the destId drawable. Trigger an error if any
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3077
     argument is not integer."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3078
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3079
    ^ self
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3080
	copyFromId:sourceId
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3081
		 x:srcX y:srcY gc:srcDCId
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3082
		to:destId x:dstX y:dstY gc:dstDCId
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3083
	     width:w height:h
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3084
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3085
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3086
copyPlaneFromPixmapId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId width:w height:h
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3087
    "do a bit-blt from a pix- or bitmap, using the low-bit plane of the source only.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3088
     Here, fall back into copyPlaneFromId:, which should also work.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3089
     Subclasses may redefine this for more performance or if required"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3090
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3091
    ^ self copyPlaneFromId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId width:w height:h
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3092
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3093
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3094
createBitmapFromArray:anArray width:w height:h
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3095
    |bitmapId|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3096
2325
634b74929d2d *** empty log message ***
fm
parents: 2324
diff changeset
  3097
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3098
    bitmapId := self primCreateBitmapFromArray:anArray width:w height:h.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3099
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3100
    bitmapId isNil ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3101
	'WINWORKSTATION: cannot create bitmap' errorPrintCR.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3102
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3103
    ^ bitmapId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3104
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3105
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3106
createPixmapWidth:w height:h depth:d
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3107
    "allocate a pixmap on the Xserver, the contents is undefined
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3108
     (i.e. random). Return a bitmap id or nil"
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3109
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3110
%{
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3111
    HANDLE newBitmapHandle;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3112
    HANDLE rootDC = CreateDC("DISPLAY", NULL, NULL, NULL);
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3113
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3114
    /*console_printf("CreateBitmap Color\n");*/
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3115
    if (__bothSmallInteger(w, h) && __isSmallInteger(d) /*&& ISCONNECTED */) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3116
	if (__intVal(d) == 1) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3117
	    newBitmapHandle = CreateBitmap(__intVal(w), __intVal(h) , 1, 1, NULL);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3118
	} else {
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3119
#if 0
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3120
	    if (__intVal(d) != __depth) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3121
		console_printf("invalid depth\n");
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3122
		RETURN (nil);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3123
	    }
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3124
#endif
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3125
	    newBitmapHandle = CreateCompatibleBitmap(rootDC, __intVal(w), __intVal(h) );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3126
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3127
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3128
	if (newBitmapHandle) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3129
	    RETURN ( __MKEXTERNALADDRESS(newBitmapHandle));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3130
	}
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3131
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3132
	DPRINTF(("empty bitmap handle = %x\n", newBitmapHandle));
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3133
*/
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3134
    }
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3135
    RETURN (nil);
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3136
%}
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3137
!
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3138
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3139
destroyPixmap:aDrawableId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3140
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3141
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3142
    if (__isExternalAddress(aDrawableId) /* && ISCONNECTED */ ) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3143
	HANDLE bitmapHandle = _HANDLEVal(aDrawableId);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3144
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3145
	if (bitmapHandle) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3146
	    DeleteObject(bitmapHandle);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3147
	/*    _DeleteObject(bitmapHandle, __LINE__);    */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3148
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3149
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3150
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3151
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3152
2329
f5a1833995a1 to do #displayDeviceForm:aForm x:x y:y
fm
parents: 2328
diff changeset
  3153
displayDeviceForm:aForm x:x y:y
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3154
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3155
    |sortedImage formMask bitsWithTransparency redVector greenVector blueVector|
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3156
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3157
    sortedImage := aForm.
2341
cf7b3de4f3ef *** empty log message ***
fm
parents: 2340
diff changeset
  3158
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3159
    "Image 16 bits"
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3160
    aForm depth = 16 ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3161
	bitsWithTransparency := aForm bits.
2341
cf7b3de4f3ef *** empty log message ***
fm
parents: 2340
diff changeset
  3162
    ].
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3163
    "Image 24 and 32 bits"
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3164
    aForm depth >= 24 ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3165
	|bestFormat|
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3166
	bestFormat := aForm bestSupportedImageFormatFor: Display.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3167
	bitsWithTransparency := aForm rgbImageBitsOn: Display bestFormat: bestFormat.
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3168
    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3169
    "Image up to 8 bits"
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3170
    aForm depth <= 8 ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3171
	aForm depth < 8 ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3172
	    sortedImage := aForm asImageWithDepth: 8.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3173
	].
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3174
"/        sortedImage := self sortColorMapImage: aForm.
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3175
	sortedImage := self compressColorMapImage: sortedImage.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3176
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3177
	formMask := sortedImage mask.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3178
	formMask isNil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3179
	    ifTrue:[bitsWithTransparency := sortedImage bits ]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3180
	    ifFalse:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3181
		|bitsWithTransparencySize|
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3182
		formMask := formMask asImageWithDepth: sortedImage depth.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3183
		bitsWithTransparency := sortedImage bits copy.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3184
		bitsWithTransparencySize := bitsWithTransparency size.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3185
		formMask bits doWithIndex:[:maskBit :index |
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3186
		    bitsWithTransparencySize >= index ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3187
			maskBit == 0 ifTrue:[bitsWithTransparency at: index put: 255 "60" "bitClearAt: index"].
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3188
"/                    maskBit == 1 ifTrue:[bitsWithTransparency at: index put: (bitsWithTransparency at: index)].
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3189
		    ].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3190
		].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3191
	].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3192
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3193
	redVector := sortedImage colorMap redVector.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3194
	greenVector := sortedImage colorMap greenVector.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3195
	blueVector := sortedImage colorMap blueVector.
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3196
    ].
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3197
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3198
    self
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3199
	 drawBits: bitsWithTransparency
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3200
	redVector: redVector
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3201
      greenVector: greenVector
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3202
       blueVector: blueVector
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3203
     bitsPerPixel: sortedImage bitsPerPixel
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3204
	    depth: sortedImage depth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3205
	    width: sortedImage width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3206
	   height: sortedImage height
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3207
	     into: self id
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3208
		x: x
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3209
		y: y
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3210
	    width: sortedImage width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3211
	   height: sortedImage height
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3212
	     with: gcId.
2329
f5a1833995a1 to do #displayDeviceForm:aForm x:x y:y
fm
parents: 2328
diff changeset
  3213
!
f5a1833995a1 to do #displayDeviceForm:aForm x:x y:y
fm
parents: 2328
diff changeset
  3214
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3215
drawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth padding:padd
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3216
			  width:imageWidth height:imageHeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3217
			      x:srcx y:srcy
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3218
			   into:ignoredDrawableId
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3219
			      x:dstx y:dsty
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3220
			  width:w height:h
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3221
			   with:aGCId
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3222
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3223
    "draw a bitImage which has depth id, width iw and height ih into
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3224
     the drawable. draw a region of w/h pixels from srcx/srcy to dstx/dsty.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3225
     Individual source pixels have bitsPerPixel bits, allowing to draw
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3226
     depth and pixel-units to be different.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3227
     It has to be checked elsewhere, that the server can do it with the given
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3228
     depth - otherwise, primitive failure will be signalled.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3229
     Also it is assumed, that the colormap is setup correctly and the
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3230
     colors are allocated - otherwise the colors may be wrong."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3231
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3232
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3233
     sorry; I had to separate it into 2 methods, since XPutImage needs
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3234
     an unlimited stack, and thus cannot send primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3235
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3236
    (self primDrawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth padding:padd
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3237
					width:imageWidth height:imageHeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3238
					     x:srcx y:srcy
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3239
					  into:ignoredDrawableId
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3240
					     x:(dstx rounded) y:(dsty rounded)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3241
					 width:w height:h
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3242
					  with:aGCId)
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3243
    ifFalse:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3244
	"
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3245
	 also happens, if a segmentation violation occurs in the
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3246
	 XPutImage ...
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3247
	"
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3248
	self primitiveFailed
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3249
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3250
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3251
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3252
drawBits:imageBits redVector:redVector greenVector:greenVector blueVector:blueVector bitsPerPixel:bitsPerPixel depth:imageDepth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3253
			      width:imageWidth height:imageHeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3254
			       into:ignoredDrawableId
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3255
				  x:dstx y:dsty
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3256
			      width:w height:h
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3257
			       with:aGCId
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3258
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3259
    "draw a bitImage which has depth id, width iw and height ih into
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3260
     the drawable. draw a region of w/h pixels from srcx/srcy to dstx/dsty.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3261
     Individual source pixels have bitsPerPixel bits, allowing to draw
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3262
     depth and pixel-units to be different.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3263
     It has to be checked elsewhere, that the server can do it with the given
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3264
     depth - otherwise, primitive failure will be signalled.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3265
     Also it is assumed, that the colormap is setup correctly and the
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3266
     colors are allocated - otherwise the colors may be wrong."
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3267
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3268
    "
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3269
     sorry; I had to separate it into 2 methods, since XPutImage needs
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3270
     an unlimited stack, and thus cannot send primitiveFailed
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3271
    "
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3272
    (self primDrawBits:imageBits redVector:redVector greenVector:greenVector blueVector:blueVector bitsPerPixel:bitsPerPixel depth:imageDepth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3273
			      width:imageWidth height:imageHeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3274
			       into:ignoredDrawableId
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3275
				  x:(dstx rounded) y:(dsty rounded)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3276
			      width:w height:h
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3277
			       with:aGCId)
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3278
    ifFalse:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3279
	self primitiveFailed
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3280
    ].
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3281
!
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3282
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3283
primCreateBitmapFromArray:anArray width:w height:h
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3284
%{
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3285
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3286
    HBITMAP newBitmapHandle;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3287
    int b_width, b_height, bytesPerRowST, bytesPerRowWN, padding;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3288
    int row, col;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3289
    unsigned char *cp, *bPits;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3290
    unsigned char *b_bits = 0;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3291
    int index;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3292
    OBJ num;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3293
    unsigned char *allocatedBits = 0;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3294
    unsigned char fastBits[10000];
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3295
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3296
    if (__bothSmallInteger(w, h)
2818
37b97e4ebb01 Use __isArrayLike() and __isByteArrayLike()
Stefan Vogel <sv@exept.de>
parents: 2621
diff changeset
  3297
     && __isNonNilObject(anArray)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3298
	OBJ cls = __qClass(anArray);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3299
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3300
	b_width = __intVal(w);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3301
	b_height = __intVal(h);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3302
	bytesPerRowST = (b_width + 7) / 8;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3303
	bytesPerRowWN = ((b_width + 15) / 16) * 2;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3304
	padding = bytesPerRowWN - bytesPerRowST;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3305
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3306
	if ((padding == 0) && (cls == @global(ByteArray))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3307
	    b_bits = __ByteArrayInstPtr(anArray)->ba_element;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3308
	    cp = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3309
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3310
	    int nBytes = b_height * bytesPerRowWN;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3311
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3312
	    if (nBytes < sizeof(fastBits)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3313
		cp = b_bits = fastBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3314
	    } else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3315
		cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3316
		if (! cp) goto fail;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3317
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3318
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3319
	if (cp) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3320
	    if (__qIsArrayLike(anArray)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3321
		OBJ *op;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3322
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3323
		index = 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3324
		op = &(__ArrayInstPtr(anArray)->a_element[index - 1]);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3325
		for (row = b_height; row; row--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3326
		    for (col = bytesPerRowST; col; col--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3327
			num = *op++;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3328
			if (! __isSmallInteger(num))
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3329
			    goto fail;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3330
			*cp++ = __intVal(num);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3331
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3332
		    cp += padding;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3333
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3334
	    } else if (__qIsByteArrayLike(anArray)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3335
		unsigned char *pBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3336
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3337
		pBits = __ByteArrayInstPtr(anArray)->ba_element;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3338
		for (row = b_height; row; row--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3339
		    for (col = bytesPerRowST; col; col--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3340
			*cp++ = ( *pBits++ /*^ 0xFF*/ );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3341
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3342
		    cp += padding;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3343
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3344
	    } else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3345
		goto fail;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3346
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3347
	}
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3348
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3349
	CPRINTF(("create bitmap ...\n"));
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3350
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3351
	newBitmapHandle = CreateBitmap(b_width, b_height, 1, 1, b_bits );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3352
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3353
	if (newBitmapHandle ) {
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3354
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3355
	    DDPRINTF(("returning bitmap %x ...\n", newBitmapHandle));
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3356
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3357
	    if (allocatedBits) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3358
		free(allocatedBits);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3359
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3360
	    RETURN ( __MKEXTERNALADDRESS(newBitmapHandle));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3361
	}
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3362
    }
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3363
fail: ;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3364
/*
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3365
    DDPRINTF(("create bitmap FAILED!!!\n"));
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3366
*/
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3367
    if (allocatedBits) {
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3368
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3369
	CPRINTF(("freeing up bitmap bits ...\n"));
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3370
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3371
	free(allocatedBits);
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3372
    }
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3373
/*
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3374
    CPRINTF(("returning nil ...\n"));
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3375
*/
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3376
    RETURN ( nil );
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3377
%}
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3378
!
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3379
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3380
primDrawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth padding:padd
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3381
			      width:imageWidth height:imageHeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3382
				  x:srcx y:srcy
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3383
			       into:ignoredDrawableId
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3384
				  x:dstx y:dsty
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3385
			      width:w height:h
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3386
			       with:aGCId
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3387
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3388
    "since XPutImage may allocate huge amount of stack space
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3389
     (some implementations use alloca), this must run with unlimited stack."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3390
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3391
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3392
    unsigned char fastBits[10000];
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3393
    unsigned char *b_bits = 0;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3394
    unsigned char *allocatedBits = 0;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3395
    unsigned char *__imageBits = 0;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3396
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3397
    if (__isByteArray(imageBits)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3398
	__imageBits = __ByteArrayInstPtr(imageBits)->ba_element;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3399
    } else if (__isExternalBytesLike(imageBits)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3400
	__imageBits = (unsigned char *)(__externalBytesAddress(imageBits));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3401
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3402
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3403
    if (/* ISCONNECTED
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3404
     && */ __isExternalAddressLike(aGCId)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3405
     && __bothSmallInteger(srcx, srcy)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3406
     && __bothSmallInteger(dstx, dsty)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3407
     && __bothSmallInteger(w, h)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3408
     && __bothSmallInteger(imageWidth, imageHeight)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3409
     && __bothSmallInteger(imageDepth, bitsPerPixel)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3410
     && __isSmallInteger(padd)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3411
     && __imageBits)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3412
     {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3413
	struct
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3414
	{
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3415
	  BITMAPINFOHEADER bmiHeader;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3416
	  DWORD r;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3417
	  DWORD g;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3418
	  DWORD b;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3419
	} bitmap;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3420
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3421
	HANDLE hDC = (HANDLE)(__externalAddressVal(aGCId));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3422
	HBITMAP hBitmap = _HBITMAPVAL(__INST(drawableId));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3423
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3424
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3425
	DDPRINTF(("hDC = %x\n", hDC));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3426
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3427
	if (__intVal(padd) != WIN32PADDING) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3428
	    int row, col;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3429
	    unsigned char *cp;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3430
	    unsigned char *pBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3431
	    int b_width, b_height, bytesPerRowST, bytesPerRowWN, padding, nBytes;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3432
	    int bi = __intVal(bitsPerPixel);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3433
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3434
	    b_width = __intVal(w);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3435
	    b_height = __intVal(h);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3436
	    bytesPerRowST = (b_width * bi + (__intVal(padd)-1)) / __intVal(padd);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3437
	    bytesPerRowWN = (b_width * bi + (WIN32PADDING-1)) / WIN32PADDING * (WIN32PADDING/8);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3438
	    padding = bytesPerRowWN - bytesPerRowST;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3439
	    nBytes = b_height * bytesPerRowWN;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3440
	    /*console_printf("padd %d bs %d bw %d p %d\n",__intVal(padd),bytesPerRowST,bytesPerRowWN,padding);*/
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3441
	    if (padding) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3442
		if (nBytes < sizeof(fastBits)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3443
		    cp = b_bits = fastBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3444
		} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3445
		    cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3446
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3447
		if (cp) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3448
		    pBits = __imageBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3449
		    for (row = b_height; row; row--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3450
			for (col = bytesPerRowST; col; col--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3451
			    *cp++ = *pBits++;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3452
			}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3453
			cp += padding;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3454
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3455
		} else
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3456
		    goto fail;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3457
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3458
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3459
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3460
	if (b_bits == 0) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3461
	    b_bits = __imageBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3462
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3463
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3464
	bitmap.bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3465
	bitmap.bmiHeader.biPlanes = 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3466
	if (__intVal(imageDepth) == 24) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3467
	    /*bitmap.bmiHeader.biCompression = BI_BITFIELDS;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3468
	    bitmap.r = 0xff0000;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3469
	    bitmap.g = 0x00ff00;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3470
	    bitmap.b = 0x0000ff;*/
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3471
	    bitmap.bmiHeader.biCompression = BI_RGB;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3472
	} else if (__intVal(imageDepth) == 16) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3473
	    /*bitmap.bmiHeader.biCompression = BI_RGB;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3474
	    bitmap.bmiHeader.biCompression = BI_BITFIELDS;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3475
	    bitmap.b = 0x001f;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3476
	    bitmap.g = 0x07e0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3477
	    bitmap.r = 0xf800;*/
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3478
	    bitmap.b = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3479
	    bitmap.g = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3480
	    bitmap.r = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3481
	    bitmap.bmiHeader.biCompression = BI_RGB;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3482
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3483
	bitmap.bmiHeader.biSizeImage = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3484
	bitmap.bmiHeader.biXPelsPerMeter = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3485
	bitmap.bmiHeader.biYPelsPerMeter = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3486
	bitmap.bmiHeader.biClrUsed = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3487
	bitmap.bmiHeader.biClrImportant = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3488
	bitmap.bmiHeader.biWidth = __intVal(imageWidth);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3489
	bitmap.bmiHeader.biHeight = -(__intVal(imageHeight));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3490
	bitmap.bmiHeader.biBitCount = __intVal(bitsPerPixel);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3491
	/*console_printf("drawBits depth:%d bitsPerPixel:%d IW%d W:%d H:%d\n",__intVal(imageDepth),bitmap.bmiHeader.biBitCount,bitmap.bmiHeader.biWidth,__intVal(w),bitmap.bmiHeader.biHeight);*/
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3492
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3493
	SetDIBitsToDevice(hDC,__intVal(dstx),__intVal(dsty),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3494
			      __intVal(w), __intVal(h),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3495
			      __intVal(srcx), __intVal(srcy),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3496
			      0,__intVal(h),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3497
			      (void *)b_bits,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3498
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3499
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3500
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3501
	SetDIBits(hDC,hBitmap,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3502
			      0,__intVal(h),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3503
			      (void *)b_bits,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3504
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3505
*/
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3506
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3507
	StretchDIBits(hDC,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3508
		      __intVal(dstx),(__intVal(dsty)),            //  x & y coord of destination upper-left corner
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3509
		      __intVal(w), __intVal(h),                 // width & height of destination rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3510
		      __intVal(srcx), __intVal(srcy),           // x & y coord of source upper-left corner
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3511
		      __intVal(w), __intVal(h),                 // width & height of source rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3512
		      (void *)b_bits,                           // bitmap bits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3513
		      (BITMAPINFO*)&bitmap,                     // bitmap data
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3514
		      DIB_RGB_COLORS,                           // usage options
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3515
		      SRCCOPY                                   // raster operation code
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3516
	);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3517
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3518
	if (allocatedBits) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3519
	    free(allocatedBits);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3520
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3521
/*
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3522
#ifndef CACHE_LAST_DC
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3523
	_releaseDC(gcData);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3524
#endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3525
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3526
	RETURN ( true );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3527
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3528
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3529
fail: ;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3530
/*
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3531
    PRINTF(("create temp bitmap FAILED!!!\n"));
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3532
*/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3533
    if (allocatedBits) {
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3534
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3535
	PRINTF(("freeing up temp bitmap bits ...\n"));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3536
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3537
	free(allocatedBits);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3538
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3539
/*
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3540
#ifndef CACHE_LAST_DC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3541
    if (hDC) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3542
	_releaseDC(gcData);
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3543
    }
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3544
#endif
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3545
*/
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3546
%}
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3547
.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3548
    ^ false
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3549
!
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3550
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3551
primDrawBits:imageBits redVector:redVector greenVector:greenVector blueVector:blueVector bitsPerPixel:bitsPerPixel depth:imageDepth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3552
			      width:imageWidth height:imageHeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3553
			       into:ignoredDrawableId
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3554
				  x:dstx y:dsty
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3555
			      width:w height:h
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3556
			       with:aGCId
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3557
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3558
    "since XPutImage may allocate huge amount of stack space
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3559
     (some implementations use alloca), this must run with unlimited stack."
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3560
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3561
%{
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3562
    unsigned char fastBits[10000];
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3563
    unsigned char *b_bits = 0;
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3564
    unsigned char *allocatedBits = 0;
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3565
    unsigned char *__imageBits = 0;
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3566
    unsigned char *__redVector = 0;
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3567
    unsigned char *__greenVector = 0;
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3568
    unsigned char *__blueVector = 0;
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3569
    int padd = 8;
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3570
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3571
    if (__isByteArray(imageBits)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3572
	__imageBits = __ByteArrayInstPtr(imageBits)->ba_element;
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3573
    } else if (__isExternalBytesLike(imageBits)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3574
	__imageBits = (unsigned char *)(__externalBytesAddress(imageBits));
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3575
    }
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3576
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3577
    if (__isByteArray(redVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3578
	__redVector = __ByteArrayInstPtr(redVector)->ba_element;
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3579
    } else if (__isExternalBytesLike(redVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3580
	__redVector = (unsigned char *)(__externalBytesAddress(redVector));
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3581
    }
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3582
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3583
    if (__isByteArray(greenVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3584
	__greenVector = __ByteArrayInstPtr(greenVector)->ba_element;
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3585
    } else if (__isExternalBytesLike(greenVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3586
	__greenVector = (unsigned char *)(__externalBytesAddress(greenVector));
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3587
    }
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3588
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3589
    if (__isByteArray(blueVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3590
	__blueVector = __ByteArrayInstPtr(blueVector)->ba_element;
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3591
    } else if (__isExternalBytesLike(blueVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3592
	__blueVector = (unsigned char *)(__externalBytesAddress(blueVector));
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3593
    }
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3594
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3595
    if (/* ISCONNECTED
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3596
     && */ __isExternalAddressLike(aGCId)
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3597
//     && __bothSmallInteger(srcx, srcy)
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3598
     && __bothSmallInteger(dstx, dsty)
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3599
     && __bothSmallInteger(w, h)
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3600
     && __bothSmallInteger(imageWidth, imageHeight)
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3601
     && __bothSmallInteger(imageDepth, bitsPerPixel)
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3602
     && __imageBits)
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3603
     {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3604
	struct
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3605
	{
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3606
	  BITMAPINFOHEADER bmiHeader;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3607
	  RGBQUAD bmiColors[256];
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3608
	} bitmap;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3609
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3610
	HANDLE hDC = (HANDLE)(__externalAddressVal(aGCId));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3611
	HBITMAP hBitmap = _HBITMAPVAL(__INST(drawableId));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3612
	int col;
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3613
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3614
	DDPRINTF(("hDC = %x\n", hDC));
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3615
*/
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3616
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3617
	if (padd != WIN32PADDING) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3618
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3619
	    int row, col;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3620
	    unsigned char *cp;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3621
	    unsigned char *pBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3622
	    int b_width, b_height, bytesPerRowST, bytesPerRowWN, padding, nBytes;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3623
	    int bi = __intVal(bitsPerPixel);
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3624
2340
7aada47a2ec0 changed #primDrawBits:redVector:greenVector:blueVector:bitsPerPixel:depth:width:height:into:x:y:width:height:with:
fm
parents: 2339
diff changeset
  3625
//            console_fprintf(stderr, "Non WIN32PADDING");
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3626
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3627
	    b_width = __intVal(w);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3628
	    b_height = __intVal(h);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3629
	    bytesPerRowST = (b_width * bi + (padd - 1 )) / padd;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3630
	    bytesPerRowWN = (b_width * bi + (WIN32PADDING-1)) / WIN32PADDING * (WIN32PADDING/8);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3631
	    padding = bytesPerRowWN - bytesPerRowST;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3632
	    nBytes = b_height * bytesPerRowWN;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3633
	    /*console_printf("padd %d bs %d bw %d p %d\n",__intVal(padd),bytesPerRowST,bytesPerRowWN,padding);*/
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3634
	    if (padding) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3635
		if (nBytes < sizeof(fastBits)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3636
		    cp = b_bits = fastBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3637
		} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3638
		    cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3639
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3640
		if (cp) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3641
		    pBits = __imageBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3642
		    for (row = b_height; row; row--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3643
			for (col = bytesPerRowST; col; col--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3644
			    *cp++ = *pBits++;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3645
			}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3646
			cp += padding;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3647
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3648
		} else
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3649
		    goto fail;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3650
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3651
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3652
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3653
	if (b_bits == 0) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3654
	    b_bits = __imageBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3655
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3656
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3657
	bitmap.bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3658
	bitmap.bmiHeader.biPlanes = 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3659
	bitmap.bmiHeader.biCompression = BI_RGB;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3660
	bitmap.bmiHeader.biSizeImage = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3661
	bitmap.bmiHeader.biXPelsPerMeter = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3662
	bitmap.bmiHeader.biYPelsPerMeter = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3663
	bitmap.bmiHeader.biClrUsed = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3664
	bitmap.bmiHeader.biClrImportant = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3665
	bitmap.bmiHeader.biWidth = __intVal(imageWidth);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3666
	bitmap.bmiHeader.biHeight = -(__intVal(imageHeight));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3667
	bitmap.bmiHeader.biBitCount = __intVal(bitsPerPixel);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3668
	/*console_printf("drawBits depth:%d bitsPerPixel:%d IW%d W:%d H:%d\n",__intVal(imageDepth),bitmap.bmiHeader.biBitCount,bitmap.bmiHeader.biWidth,__intVal(w),bitmap.bmiHeader.biHeight);*/
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3669
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3670
	if (__intVal(imageDepth) <= 8) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3671
	    for(col=0;col<256;col++)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3672
	     {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3673
	      bitmap.bmiColors[col].rgbBlue = __blueVector[col];    // Microsoft idea: change rgbBlue to rgbRed
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3674
	      bitmap.bmiColors[col].rgbGreen = __greenVector[col];
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3675
	      bitmap.bmiColors[col].rgbRed = __redVector[col];         // Microsoft idea: change rgbRed to rgbBlue
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3676
	      bitmap.bmiColors[col].rgbReserved = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3677
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3678
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3679
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3680
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3681
	bitmap.bmiColors[255].rgbBlue=255;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3682
	bitmap.bmiColors[255].rgbGreen=255;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3683
	bitmap.bmiColors[255].rgbRed =255;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3684
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3685
	SetDIBitsToDevice(hDC,__intVal(dstx),__intVal(dsty),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3686
			      __intVal(w), __intVal(h),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3687
			      0, 0, /* __intVal(srcx), __intVal(srcy),    */
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3688
			      0,__intVal(h),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3689
			      (void *)b_bits,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3690
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3691
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3692
	SetDIBits(hDC,hBitmap,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3693
			      0,__intVal(h),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3694
			      (void *)b_bits,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3695
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3696
*/
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3697
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3698
	StretchDIBits(hDC,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3699
		      __intVal(dstx),(__intVal(dsty)),            //  x & y coord of destination upper-left corner
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3700
		      __intVal(w), __intVal(h),                 // width & height of destination rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3701
		      __intVal(srcx), __intVal(srcy),           // x & y coord of source upper-left corner
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3702
		      __intVal(w), __intVal(h),                 // width & height of source rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3703
		      (void *)b_bits,                           // bitmap bits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3704
		      (BITMAPINFO*)&bitmap,                     // bitmap data
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3705
		      DIB_RGB_COLORS,                           // usage options
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3706
		      SRCCOPY                                   // raster operation code
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3707
	);
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3708
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3709
	if (allocatedBits) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3710
	    free(allocatedBits);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3711
	}
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3712
/*
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3713
#ifndef CACHE_LAST_DC
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3714
	_releaseDC(gcData);
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3715
#endif
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3716
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3717
	RETURN ( true );
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3718
    }
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3719
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3720
fail: ;
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3721
/*
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3722
    PRINTF(("create temp bitmap FAILED!!!\n"));
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3723
*/
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3724
    if (allocatedBits) {
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3725
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3726
	PRINTF(("freeing up temp bitmap bits ...\n"));
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3727
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3728
	free(allocatedBits);
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3729
    }
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3730
/*
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3731
#ifndef CACHE_LAST_DC
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3732
    if (hDC) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3733
	_releaseDC(gcData);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3734
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3735
#endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3736
*/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3737
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3738
.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3739
    ^ false
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3740
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3741
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3742
setFunction:aFunctionSymbol in:aGCId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3743
    "set alu function to be drawn with"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3744
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3745
    Transcript showCR: aFunctionSymbol printString.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3746
    function := aFunctionSymbol.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3747
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3748
"/%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3749
"/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3750
"/    if (__isExternalAddress(aGCId)) {
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3751
"/        struct gcData *gcData = _GCDATA(aGCId);
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3752
"/        int fun = -1;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3753
"/        int bfun = -1;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3754
"/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3755
"/        if (aFunctionSymbol == @symbol(copy)) {
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3756
"/            fun = R2_COPYPEN;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3757
"/            bfun = BITBLT_COPY;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3758
"/        } else if (aFunctionSymbol == @symbol(copyInverted)) {
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3759
"/            fun = R2_NOTCOPYPEN;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3760
"/            bfun = BITBLT_COPYINVERTED;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3761
"/        } else if (aFunctionSymbol == @symbol(xor)) {
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3762
"/            fun = R2_XORPEN;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3763
"/            bfun = BITBLT_XOR;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3764
"/        } else if (aFunctionSymbol == @symbol(and)) {
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3765
"/            fun = R2_MASKPEN;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3766
"/            bfun = BITBLT_AND;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3767
"/        } else if (aFunctionSymbol == @symbol(or)) {
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3768
"/            fun = R2_MERGEPEN;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3769
"/            bfun = BITBLT_OR;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3770
"/        }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3771
"/
2325
634b74929d2d *** empty log message ***
fm
parents: 2324
diff changeset
  3772
"/        if (fun
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3773
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3774
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3775
setGraphicsExposures:aBoolean in:aGCId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3776
    "set or clear the graphics exposures flag"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3777
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3778
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3779
shiftBlue
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3780
    "return the number of valid bits in the red component."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3781
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3782
"/    bitsRed isNil ifTrue:[
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3783
"/        "/ not a truecolor display
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3784
"/        ^ bitsPerRGB
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3785
"/    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3786
"/    ^ bitsRed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3787
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3788
     ^Display shiftBlue
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3789
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3790
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3791
shiftGreen
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3792
    "return the number of valid bits in the red component."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3793
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3794
"/    bitsRed isNil ifTrue:[
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3795
"/        "/ not a truecolor display
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3796
"/        ^ bitsPerRGB
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3797
"/    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3798
"/    ^ bitsRed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3799
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3800
     ^Display shiftGreen
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3801
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3802
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3803
shiftRed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3804
    "return the number of valid bits in the red component."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3805
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3806
"/    bitsRed isNil ifTrue:[
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3807
"/        "/ not a truecolor display
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3808
"/        ^ bitsPerRGB
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3809
"/    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3810
"/    ^ bitsRed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3811
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3812
     ^Display shiftRed
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3813
!
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3814
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3815
sortBlockForColors
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3816
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3817
    ^ [:a :b |
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3818
	    a redByte == b redByte ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3819
		a greenByte == b greenByte ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3820
		    a blueByte < b blueByte
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3821
		] ifFalse:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3822
		    a greenByte < b greenByte
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3823
		]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3824
	    ] ifFalse:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3825
		a redByte < b redByte
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3826
	    ]
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3827
      ].
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3828
!
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3829
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3830
sortColorMapImage: image
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3831
    "calculates a new color map for the image, sorting colors"
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3832
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3833
    |sortBlock depth newColorMap newImage oldImage usedColors oldToNew oldBits newBits tmpBits|
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3834
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3835
    sortBlock := self sortBlockForColors.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3836
    oldImage := image.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3837
    depth := oldImage depth.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3838
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3839
    oldImage photometric ~~ #palette ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3840
	Transcript showCR:'Compress colorMap: Only palette images have colormaps.'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3841
	^ image
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3842
    ].
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3843
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3844
    usedColors := oldImage realColorMap.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3845
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3846
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3847
	"/ translation table
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3848
	oldToNew := ByteArray new:(1 bitShift:depth).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3849
	newColorMap := usedColors asArray.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3850
	newColorMap sort:sortBlock.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3851
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3852
	oldImage colorMap asArray keysAndValuesDo:[:oldIdx :clr |
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3853
	    |newPixel|
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3854
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3855
	    (usedColors includes:clr) ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3856
		newPixel := newColorMap indexOf:clr.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3857
		oldToNew at:oldIdx put:newPixel-1.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3858
	    ]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3859
	].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3860
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3861
	oldBits := oldImage bits.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3862
	newBits := ByteArray new:(oldBits size).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3863
	depth ~~ 8 ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3864
	    "/ expand/compress can only handle 8bits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3865
	    tmpBits := ByteArray uninitializedNew:(oldImage width*oldImage height).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3866
	    oldBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3867
		expandPixels:depth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3868
		width:oldImage width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3869
		height:oldImage height
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3870
		into:tmpBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3871
		mapping:oldToNew.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3872
	    tmpBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3873
		compressPixels:depth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3874
		width:oldImage width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3875
		height:oldImage height
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3876
		into:newBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3877
		mapping:nil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3878
	] ifFalse:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3879
	    oldBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3880
		expandPixels:depth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3881
		width:oldImage width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3882
		height:oldImage height
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3883
		into:newBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3884
		mapping:oldToNew.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3885
	].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3886
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3887
	newImage := oldImage species new
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3888
			width:oldImage width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3889
			height:oldImage height
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3890
			depth:depth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3891
			fromArray:newBits.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3892
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3893
	newImage colorMap:newColorMap.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3894
	newImage fileName:oldImage fileName.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3895
	newImage mask:(oldImage mask copy).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3896
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3897
	^newImage
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3898
!
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3899
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3900
transparencyTest_primDrawBits:imageBits redVector:redVector greenVector:greenVector blueVector:blueVector bitsPerPixel:bitsPerPixel depth:imageDepth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3901
			      width:imageWidth height:imageHeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3902
			       into:ignoredDrawableId
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3903
				  x:dstx y:dsty
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3904
			      width:w height:h
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3905
			       with:aGCId
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3906
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3907
    "since XPutImage may allocate huge amount of stack space
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3908
     (some implementations use alloca), this must run with unlimited stack."
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3909
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3910
%{
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3911
    unsigned char fastBits[10000];
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3912
    unsigned char *b_bits = 0;
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3913
    unsigned char *allocatedBits = 0;
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3914
    unsigned char *__imageBits = 0;
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3915
    unsigned char *__redVector = 0;
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3916
    unsigned char *__greenVector = 0;
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3917
    unsigned char *__blueVector = 0;
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3918
    int padd = 8;
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3919
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3920
    if (__isByteArray(imageBits)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3921
	__imageBits = __ByteArrayInstPtr(imageBits)->ba_element;
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3922
    } else if (__isExternalBytesLike(imageBits)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3923
	__imageBits = (unsigned char *)(__externalBytesAddress(imageBits));
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3924
    }
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3925
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3926
    if (__isByteArray(redVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3927
	__redVector = __ByteArrayInstPtr(redVector)->ba_element;
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3928
    } else if (__isExternalBytesLike(redVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3929
	__redVector = (unsigned char *)(__externalBytesAddress(redVector));
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3930
    }
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3931
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3932
    if (__isByteArray(greenVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3933
	__greenVector = __ByteArrayInstPtr(greenVector)->ba_element;
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3934
    } else if (__isExternalBytesLike(greenVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3935
	__greenVector = (unsigned char *)(__externalBytesAddress(greenVector));
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3936
    }
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3937
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3938
    if (__isByteArray(blueVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3939
	__blueVector = __ByteArrayInstPtr(blueVector)->ba_element;
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3940
    } else if (__isExternalBytesLike(blueVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3941
	__blueVector = (unsigned char *)(__externalBytesAddress(blueVector));
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3942
    }
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3943
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3944
    if (/* ISCONNECTED
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3945
     && */ __isExternalAddressLike(aGCId)
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3946
//     && __bothSmallInteger(srcx, srcy)
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3947
     && __bothSmallInteger(dstx, dsty)
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3948
     && __bothSmallInteger(w, h)
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3949
     && __bothSmallInteger(imageWidth, imageHeight)
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3950
     && __bothSmallInteger(imageDepth, bitsPerPixel)
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3951
     && __imageBits)
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3952
     {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3953
	struct
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3954
	{
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3955
	  BITMAPINFOHEADER bmiHeader;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3956
	  RGBQUAD bmiColors[256];
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3957
	} bitmap;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3958
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3959
	HANDLE hDC = (HANDLE)(__externalAddressVal(aGCId));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3960
	HBITMAP hBitmap = _HBITMAPVAL(__INST(drawableId));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3961
	int col;
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3962
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3963
	DDPRINTF(("hDC = %x\n", hDC));
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3964
*/
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3965
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3966
	if (padd != WIN32PADDING) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3967
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3968
	    int row, col;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3969
	    unsigned char *cp;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3970
	    unsigned char *pBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3971
	    int b_width, b_height, bytesPerRowST, bytesPerRowWN, padding, nBytes;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3972
	    int bi = __intVal(bitsPerPixel);
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3973
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3974
//            console_fprintf(stderr, "Non WIN32PADDING");
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3975
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3976
	    b_width = __intVal(w);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3977
	    b_height = __intVal(h);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3978
	    bytesPerRowST = (b_width * bi + (padd - 1 )) / padd;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3979
	    bytesPerRowWN = (b_width * bi + (WIN32PADDING-1)) / WIN32PADDING * (WIN32PADDING/8);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3980
	    padding = bytesPerRowWN - bytesPerRowST;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3981
	    nBytes = b_height * bytesPerRowWN;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3982
	    /*console_printf("padd %d bs %d bw %d p %d\n",__intVal(padd),bytesPerRowST,bytesPerRowWN,padding);*/
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3983
	    if (padding) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3984
		if (nBytes < sizeof(fastBits)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3985
		    cp = b_bits = fastBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3986
		} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3987
		    cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3988
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3989
		if (cp) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3990
		    pBits = __imageBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3991
		    for (row = b_height; row; row--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3992
			for (col = bytesPerRowST; col; col--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3993
			    *cp++ = *pBits++;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3994
			}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3995
			cp += padding;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3996
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3997
		} else
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3998
		    goto fail;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3999
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4000
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4001
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4002
	if (b_bits == 0) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4003
	    b_bits = __imageBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4004
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4005
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4006
	bitmap.bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4007
	bitmap.bmiHeader.biPlanes = 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4008
	bitmap.bmiHeader.biCompression = BI_RGB;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4009
	bitmap.bmiHeader.biSizeImage = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4010
	bitmap.bmiHeader.biXPelsPerMeter = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4011
	bitmap.bmiHeader.biYPelsPerMeter = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4012
	bitmap.bmiHeader.biClrUsed = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4013
	bitmap.bmiHeader.biClrImportant = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4014
	bitmap.bmiHeader.biWidth = __intVal(imageWidth);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4015
	bitmap.bmiHeader.biHeight = -(__intVal(imageHeight));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4016
	bitmap.bmiHeader.biBitCount = __intVal(bitsPerPixel);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4017
	/*console_printf("drawBits depth:%d bitsPerPixel:%d IW%d W:%d H:%d\n",__intVal(imageDepth),bitmap.bmiHeader.biBitCount,bitmap.bmiHeader.biWidth,__intVal(w),bitmap.bmiHeader.biHeight);*/
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4018
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4019
	if (__intVal(imageDepth) <= 8) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4020
	    for(col=0;col<256;col++)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4021
	     {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4022
	      bitmap.bmiColors[col].rgbBlue = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4023
	      bitmap.bmiColors[col].rgbGreen = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4024
	      bitmap.bmiColors[col].rgbRed = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4025
	      bitmap.bmiColors[col].rgbReserved = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4026
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4027
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4028
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4029
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4030
	bitmap.bmiColors[255].rgbBlue=255;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4031
	bitmap.bmiColors[255].rgbGreen=255;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4032
	bitmap.bmiColors[255].rgbRed =255;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4033
	bitmap.bmiColors[255].rgbReserved = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4034
	StretchDIBits(hDC,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4035
		      __intVal(dstx),(__intVal(dsty)),            //  x & y coord of destination upper-left corner
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4036
		      __intVal(w), __intVal(h),                 // width & height of destination rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4037
		      0, 0,  /* __intVal(srcx), __intVal(srcy),    */   // x & y coord of source upper-left corner
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4038
		      __intVal(w), __intVal(h),                 // width & height of source rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4039
		      (void *)b_bits,                           // bitmap bits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4040
		      (BITMAPINFO*)&bitmap,                     // bitmap data
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4041
		      DIB_RGB_COLORS,                           // usage options
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4042
		      SRCAND                                   // raster operation code
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4043
	);
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4044
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4045
	if (__intVal(imageDepth) <= 8) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4046
	    for(col=0;col<256;col++)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4047
	     {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4048
	      bitmap.bmiColors[col].rgbBlue = __blueVector[col];    // Microsoft idea: change rgbBlue to rgbRed
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4049
	      bitmap.bmiColors[col].rgbGreen = __greenVector[col];
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4050
	      bitmap.bmiColors[col].rgbRed = __redVector[col];         // Microsoft idea: change rgbRed to rgbBlue
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4051
	      bitmap.bmiColors[col].rgbReserved = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4052
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4053
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4054
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4055
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4056
	bitmap.bmiColors[255].rgbBlue=0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4057
	bitmap.bmiColors[255].rgbGreen=0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4058
	bitmap.bmiColors[255].rgbRed =0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4059
	bitmap.bmiColors[255].rgbReserved = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4060
	StretchDIBits(hDC,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4061
		      __intVal(dstx),(__intVal(dsty)),            //  x & y coord of destination upper-left corner
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4062
		      __intVal(w), __intVal(h),                 // width & height of destination rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4063
		      0, 0,                                     // x & y coord of source upper-left corner
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4064
		      __intVal(w), __intVal(h),                 // width & height of source rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4065
		      (void *)b_bits,                           // bitmap bits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4066
		      (BITMAPINFO*)&bitmap,                     // bitmap data
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4067
		      DIB_RGB_COLORS,                           // usage options
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4068
		      SRCPAINT                                  // raster operation code
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4069
	);
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4070
 */
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4071
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4072
	SetDIBitsToDevice(hDC,__intVal(dstx),__intVal(dsty),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4073
			      __intVal(w), __intVal(h),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4074
			      0, 0,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4075
			      0,__intVal(h),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4076
			      (void *)b_bits,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4077
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4078
*/
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4079
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4080
	SetDIBits(hDC,hBitmap,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4081
			      0,__intVal(h),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4082
			      (void *)b_bits,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4083
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4084
*/
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4085
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4086
	StretchDIBits(hDC,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4087
		      __intVal(dstx),(__intVal(dsty)),            //  x & y coord of destination upper-left corner
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4088
		      __intVal(w), __intVal(h),                 // width & height of destination rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4089
		      __intVal(srcx), __intVal(srcy),           // x & y coord of source upper-left corner
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4090
		      __intVal(w), __intVal(h),                 // width & height of source rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4091
		      (void *)b_bits,                           // bitmap bits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4092
		      (BITMAPINFO*)&bitmap,                     // bitmap data
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4093
		      DIB_RGB_COLORS,                           // usage options
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4094
		      SRCCOPY                                   // raster operation code
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4095
	);
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4096
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4097
	if (allocatedBits) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4098
	    free(allocatedBits);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4099
	}
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4100
/*
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4101
#ifndef CACHE_LAST_DC
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4102
	_releaseDC(gcData);
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4103
#endif
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4104
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4105
	RETURN ( true );
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4106
    }
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4107
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4108
fail: ;
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4109
/*
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4110
    PRINTF(("create temp bitmap FAILED!!!\n"));
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4111
*/
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4112
    if (allocatedBits) {
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4113
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4114
	PRINTF(("freeing up temp bitmap bits ...\n"));
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4115
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4116
	free(allocatedBits);
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4117
    }
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4118
/*
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4119
#ifndef CACHE_LAST_DC
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4120
    if (hDC) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4121
	_releaseDC(gcData);
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4122
    }
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4123
#endif
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4124
*/
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4125
%}
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4126
.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4127
    ^ false
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4128
! !
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4129
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4130
!WinPrinterContext methodsFor:'font stuff'!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4131
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4132
createFontFor:aFontName
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4133
    "a basic method for font allocation; this method allows
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4134
     any font to be aquired (even those not conforming to
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4135
     standard naming conventions, such as cursor, fixed or k14)"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4136
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4137
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4138
    HGDIOBJ hFont;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4139
    char *fn;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4140
2818
37b97e4ebb01 Use __isArrayLike() and __isByteArrayLike()
Stefan Vogel <sv@exept.de>
parents: 2621
diff changeset
  4141
    if (__isStringLike(aFontName)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4142
	fn = __stringVal(aFontName);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4143
	if ((strcmp(fn, "fixed") == 0) || (strcmp(fn, "ANSI_FIXED_FONT") == 0)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4144
	    hFont = GetStockObject(ANSI_FIXED_FONT);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4145
	} else if ((strcmp(fn, "variable") == 0) || (strcmp(fn, "ANSI_VAR_FONT") == 0)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4146
	    hFont = GetStockObject(ANSI_VAR_FONT);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4147
	} else if ((strcmp(fn, "system") == 0) || (strcmp(fn, "SYSTEM_FONT") == 0)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4148
	    hFont = GetStockObject(SYSTEM_FONT);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4149
	} else if ((strcmp(fn, "systemFixed") == 0) || (strcmp(fn, "SYSTEM_FIXED_FONT") == 0)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4150
	    hFont = GetStockObject(SYSTEM_FIXED_FONT);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4151
	} else if ((strcmp(fn, "deviceDefault") == 0) || (strcmp(fn, "DEVICE_DEFAULT_FONT") == 0)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4152
	    hFont = GetStockObject(DEVICE_DEFAULT_FONT);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4153
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4154
	    hFont = GetStockObject(ANSI_FIXED_FONT);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4155
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4156
	if (hFont) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4157
	    DPRINTF(("createFontFor:%s -> %x\n", fn, hFont));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4158
	    RETURN ( __MKEXTERNALADDRESS(hFont) );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4159
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4160
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4161
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4162
    ^ nil
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4163
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4164
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4165
fontMetricsOf:fontId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4166
    "return a fonts metrics info object"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4167
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4168
    |rawData info|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4169
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4170
    rawData := Array new:15.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4171
    (self primFontMetricsOf:fontId hdc:gcId intoArray:rawData) isNil ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4172
	self primitiveFailed.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4173
	^ self
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4174
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4175
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4176
    rawData at:11 put:#'ms-ansi'.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4177
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4178
    info := DeviceWorkstation::DeviceFontMetrics new.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4179
    info
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4180
      ascent:(rawData at:1)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4181
      descent:(rawData at:2)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4182
      maxAscent:(rawData at:3)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4183
      maxDescent:(rawData at:4)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4184
      minWidth:(rawData at:5)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4185
      maxWidth:(rawData at:6)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4186
      avgWidth:(rawData at:7)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4187
      minCode:(rawData at:8)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4188
      maxCode:16rFFFF "(rawData at:9)"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4189
      direction:nil
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4190
      encoding:(rawData at:11).
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4191
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4192
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4193
    ^ info
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4194
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4195
3002
a6acab3dbdea added: #getDefaultFontWithEncoding:
Stefan Vogel <sv@exept.de>
parents: 2905
diff changeset
  4196
getDefaultFontWithEncoding:encoding
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4197
    "return a default font id - used when class Font cannot
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4198
     find anything usable"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4199
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4200
     ^ self createFontFor:'fixed'
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4201
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4202
2603
875d9c41c67d pixelSize stuff
Claus Gittinger <cg@exept.de>
parents: 2602
diff changeset
  4203
getFontWithFamily:familyString face:faceString style:styleString size:sizeArg encoding:encodingSym
2602
87adcdcddc17 preps for pixelSize fonts
Claus Gittinger <cg@exept.de>
parents: 2482
diff changeset
  4204
    "try to get the specified font, return id.
87adcdcddc17 preps for pixelSize fonts
Claus Gittinger <cg@exept.de>
parents: 2482
diff changeset
  4205
     If not available, try next smaller font.
87adcdcddc17 preps for pixelSize fonts
Claus Gittinger <cg@exept.de>
parents: 2482
diff changeset
  4206
     If no font fits, return nil"
87adcdcddc17 preps for pixelSize fonts
Claus Gittinger <cg@exept.de>
parents: 2482
diff changeset
  4207
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4208
    ^ self
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4209
	getFontWithFamily:familyString
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4210
	face:faceString
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4211
	style:styleString
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4212
	size:sizeArg
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4213
	sizeUnit:#pt
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4214
	encoding:encodingSym
2602
87adcdcddc17 preps for pixelSize fonts
Claus Gittinger <cg@exept.de>
parents: 2482
diff changeset
  4215
!
87adcdcddc17 preps for pixelSize fonts
Claus Gittinger <cg@exept.de>
parents: 2482
diff changeset
  4216
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4217
getFontWithFamily:familyString face:faceString
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4218
	    style:styleArgString size:sizeArgOrNil sizeUnit:sizeUnit encoding:encodingSym
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4219
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4220
    "try to get the specified font, if not available, try the next smaller
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4221
     font."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4222
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4223
    |styleString theName theId xlatedStyle id spacing|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4224
2603
875d9c41c67d pixelSize stuff
Claus Gittinger <cg@exept.de>
parents: 2602
diff changeset
  4225
    self assert:(sizeUnit == #pt).
875d9c41c67d pixelSize stuff
Claus Gittinger <cg@exept.de>
parents: 2602
diff changeset
  4226
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4227
    styleString := styleArgString.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4228
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4229
    "special: if face is nil, allow access to X-fonts"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4230
    faceString isNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4231
	sizeArgOrNil notNil ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4232
	    theName := familyString , '-' , sizeArgOrNil printString
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4233
	] ifFalse:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4234
	    theName := familyString
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4235
	].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4236
	theName notNil ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4237
	    theId := self createFontFor:theName.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4238
	].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4239
	theId isNil ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4240
	    theId := self getDefaultFontWithEncoding:encodingSym
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4241
	].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4242
	^ theId
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4243
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4244
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4245
    "/ spacing other than 'normal' is contained as last component
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4246
    "/ in style
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4247
    styleString notNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4248
	((styleString endsWith:'-narrow')
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4249
	 or:[styleString endsWith:'-semicondensed']) ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4250
	    |i|
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4251
	    i := styleString lastIndexOf:$-.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4252
	    spacing := styleString copyFrom:(i+1).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4253
	    styleString := styleString copyTo:(i-1).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4254
	] ifFalse:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4255
	    spacing := 'normal'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4256
	].
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4257
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4258
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4259
    xlatedStyle := styleString.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4260
    xlatedStyle notNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4261
	xlatedStyle := xlatedStyle first asString
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4262
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4263
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4264
    id := self
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4265
	    getFontWithFoundry:'*'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4266
	    family:familyString asLowercase
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4267
	    weight:faceString
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4268
	    slant:styleString "/ xlatedStyle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4269
	    spacing:spacing
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4270
	    pixelSize:nil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4271
	    size:sizeArgOrNil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4272
	    registry:'*'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4273
	    encoding:encodingSym.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4274
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4275
    id isNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4276
	(encodingSym notNil and:[encodingSym ~= '*']) ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4277
	    "/ too stupid: encodings come in both cases
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4278
	    "/
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4279
	    id := self
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4280
		    getFontWithFoundry:'*'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4281
		    family:familyString asLowercase
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4282
		    weight:faceString
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4283
		    slant:styleString "/ xlatedStyle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4284
		    spacing:spacing
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4285
		    pixelSize:nil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4286
		    size:sizeArgOrNil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4287
		    registry:'*'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4288
		    encoding:encodingSym asUppercase.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4289
	    id isNil ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4290
		id := self
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4291
			getFontWithFoundry:'*'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4292
			family:familyString asLowercase
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4293
			weight:faceString
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4294
			slant:styleString "/ xlatedStyle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4295
			spacing:spacing
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4296
			pixelSize:nil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4297
			size:sizeArgOrNil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4298
			registry:'*'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4299
			encoding:encodingSym asLowercase.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4300
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4301
		id isNil ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4302
		    id := self
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4303
			    getFontWithFoundry:'*'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4304
			    family:familyString asLowercase
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4305
			    weight:faceString asLowercase
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4306
			    slant:styleString asLowercase
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4307
			    spacing:spacing
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4308
			    pixelSize:nil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4309
			    size:sizeArgOrNil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4310
			    registry:'*'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4311
			    encoding:encodingSym asLowercase.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4312
		]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4313
	    ]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4314
	]
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4315
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4316
    ^ id
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4317
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4318
    "Modified: 24.2.1996 / 22:37:24 / cg"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4319
    "Modified: 4.7.1996 / 11:38:47 / stefan"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4320
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4321
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4322
getFontWithFoundry:foundry family:family weight:weight
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4323
	      slant:slant spacing:spc pixelSize:pixelSize size:pointSize
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4324
	      registry:registry encoding:encodingArg
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4325
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4326
    "get the specified font, if not available, return nil.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4327
     For now, this is a poor (incomplete) emulation of the X code ...
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4328
     Individual attributes can be left empty (i.e. '') or nil to match any.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4329
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4330
     foundry:   'adobe', 'misc', 'dec', 'schumacher' ... usually '*'
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4331
     family:    'helvetica' 'courier' 'times' ...
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4332
     weight:    'bold' 'medium' 'demi' ...
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4333
     slant:     'r(oman)' 'i(talic)' 'o(blique)'
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4334
     spacing:   'narrow' 'normal' semicondensed' ... usually '*'
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4335
     pixelSize: 16,18 ... usually left empty
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4336
     size:      size in point (1/72th of an inch)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4337
     registry:  iso8859, sgi ... '*'
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4338
     encoding:  vendor specific encoding (usually '*')
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4339
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4340
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4341
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4342
     Windows-NT/95 allows the creation of a font with the following parameters
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4343
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4344
	nHeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4345
	nWidth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4346
	nEscapement
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4347
	nOrientation
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4348
	fnWeight        FW_DONTCARE, FW_NORMAL, FW_MEDIUM, FW_BOLD, ...
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4349
	fdwItalic       TRUE or FALSE
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4350
	fdwUnderline    TRUE or FALSE
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4351
	fdwStrikeOut    TRUE or FALSE
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4352
	fdwCharSet      ANSI_CHARSET, UNICODE_, SYMBOL_, SHIFTJIS_,...
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4353
	fdwOutputPrecision      DEFAULT, STRING, CHAR, ...
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4354
	fdwClipPrecision        DEFAULT, CHAR, STROKE, MASK, ...
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4355
	fdwQuality      DEFAULT, DRAFT, or PROOF.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4356
	fdwPitchAndFamily
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4357
		DEFAULT, FIXED or VARIABLE pitch
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4358
		DECORATIVE, DONTCASE, MODERN, ROMAN, SCRIPT, or SWISS.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4359
	lpszFace
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4360
		Typeface Name
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4361
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4362
      These two above descriptions will be matched as follows:
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4363
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4364
	foundry   - ignored
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4365
	family    - mapped to type face name.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4366
	weight    - mapped to fnWeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4367
	slant     - used for style
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4368
	spacing   - NOT USED INITIALLY
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4369
	pixelSize - NOT USED INITIALLY
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4370
	size      - mapped to nHeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4371
	registry  - NOT USED INITIALLY
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4372
	encoding  - mapped to fdwCharSet
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4373
     "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4374
2851
fad5f9ba8014 primitives expect a symbol as encoding
Stefan Vogel <sv@exept.de>
parents: 2818
diff changeset
  4375
    |logSize encoding|
fad5f9ba8014 primitives expect a symbol as encoding
Stefan Vogel <sv@exept.de>
parents: 2818
diff changeset
  4376
fad5f9ba8014 primitives expect a symbol as encoding
Stefan Vogel <sv@exept.de>
parents: 2818
diff changeset
  4377
    encoding := encodingArg asSymbol.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4378
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4379
    pixelSize notNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4380
	logSize := pixelSize
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4381
    ] ifFalse:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4382
	logSize := (pointSize * (self getLogicalPixelSizeY) / 72.0) rounded.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4383
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4384
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4385
    HGDIOBJ hFont;
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4386
    int  nHeight, nWidth, nEscapement, nOrientation;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4387
    char* work;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4388
    char* work2;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4389
    DWORD fnWeight;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4390
    DWORD fdwItalic;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4391
    DWORD fdwUnderline;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4392
    DWORD fdwStrikeOut;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4393
    DWORD fdwCharSet;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4394
    DWORD fdwOutputPrecision;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4395
    DWORD fdwClipPrecision;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4396
    DWORD fdwQuality;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4397
    DWORD fdwPitchAndFamily;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4398
    static char faceName[256];
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4399
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4400
/* INITIALIZE */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4401
    strcpy( faceName, "NULL" );
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4402
    nHeight   = 0;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4403
    nWidth   = 0;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4404
    nEscapement = 0;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4405
    nOrientation = 0;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4406
    fnWeight = FW_NORMAL;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4407
    fdwItalic = FALSE;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4408
    fdwUnderline = FALSE;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4409
    fdwStrikeOut = FALSE;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4410
    fdwOutputPrecision = OUT_DEFAULT_PRECIS;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4411
    fdwClipPrecision   = CLIP_DEFAULT_PRECIS;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4412
    fdwQuality         = DEFAULT_QUALITY;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4413
    fdwPitchAndFamily  = FF_DONTCARE;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4414
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4415
    fdwCharSet   = ANSI_CHARSET;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4416
    if ((encoding == @symbol('ms-ansi'))) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4417
	fdwCharSet   = ANSI_CHARSET;
2852
9d0ad50e4335 changed: #getFontWithFoundry:family:weight:slant:spacing:pixelSize:size:registry:encoding:
Stefan Vogel <sv@exept.de>
parents: 2851
diff changeset
  4418
    } else if (encoding == @symbol('ms-default')
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4419
	       || encoding == @symbol(*)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4420
	fdwCharSet   = DEFAULT_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4421
    } else if ((encoding == @symbol('ms-symbol'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4422
	    || (encoding == @symbol('misc-fontspecific'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4423
	fdwCharSet   = SYMBOL_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4424
    } else if ((encoding == @symbol('ms-shiftjis'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4425
	    || (encoding == @symbol('jisx0208.1983-0'))){
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4426
	fdwCharSet   = SHIFTJIS_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4427
    } else if ((encoding == @symbol('ms-gb2312'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4428
	    || (encoding == @symbol('gb2312.1980-0'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4429
	fdwCharSet   = GB2312_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4430
    } else if ((encoding == @symbol('ms-hangeul'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4431
	    || (encoding == @symbol('ksc5601.1987-0'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4432
	fdwCharSet   = HANGEUL_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4433
    } else if ((encoding == @symbol('ms-chinesebig5'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4434
	    || (encoding == @symbol('big5'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4435
	fdwCharSet   = CHINESEBIG5_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4436
    } else if (encoding == @symbol('ms-oem')) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4437
	fdwCharSet   = OEM_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4438
    } else if (encoding == @symbol('ms-johab')) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4439
	fdwCharSet   = JOHAB_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4440
    } else if ((encoding == @symbol('ms-hebrew'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4441
	    || (encoding == @symbol('ms-cp1255'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4442
	fdwCharSet   = HEBREW_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4443
    } else if ((encoding == @symbol('ms-arabic'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4444
	    || (encoding == @symbol('ms-cp1256'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4445
	fdwCharSet   = ARABIC_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4446
    } else if ((encoding == @symbol('ms-greek'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4447
	    || (encoding == @symbol('ms-cp1253'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4448
	fdwCharSet   = GREEK_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4449
    } else if ((encoding == @symbol('ms-turkish'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4450
	    || (encoding == @symbol('ms-cp1254'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4451
	fdwCharSet   = TURKISH_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4452
    } else if ((encoding == @symbol('ms-russian'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4453
	    || (encoding == @symbol('ms-cp1251'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4454
	fdwCharSet   = RUSSIAN_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4455
    } else if ((encoding == @symbol('ms-easteurope'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4456
	    || (encoding == @symbol('ms-cp1250'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4457
	fdwCharSet   = EASTEUROPE_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4458
    } else if ((encoding == @symbol('ms-baltic'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4459
	    || (encoding == @symbol('ms-cp1257'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4460
	fdwCharSet   = BALTIC_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4461
    } else if ((encoding == @symbol('ms-vietnamese'))) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4462
	fdwCharSet   = VIETNAMESE_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4463
    } else if ((encoding == @symbol('ms-thai'))) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4464
	fdwCharSet   = THAI_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4465
    } else if ((encoding == @symbol('ms-mac'))) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4466
	fdwCharSet   = MAC_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4467
#ifdef UNICODE_CHARSET
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4468
    } else if ((encoding == @symbol('ms-unicode'))) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4469
	fdwCharSet   = UNICODE_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4470
#endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4471
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4472
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4473
    if ( __isString( family ) ) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4474
	work = __stringVal( family );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4475
	if (strcmp( work, "nil" ) != 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4476
	    strncpy( faceName, work, sizeof(faceName)-1 );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4477
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4478
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4479
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4480
    /* Q: should we allow those ? (they make ST/X programs less portable to X */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4481
    if( __isString( weight ) ) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4482
	work = __stringVal( weight );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4483
	if (strcmp( work, "bold" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4484
	    fnWeight = FW_BOLD;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4485
	} else if (strcmp( work, "medium" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4486
	    fnWeight = FW_MEDIUM;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4487
	} else if (strcmp( work, "normal" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4488
	    fnWeight = FW_NORMAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4489
	} else if (strcmp( work, "light" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4490
	    fnWeight = FW_LIGHT;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4491
	} else if (strcmp( work, "demi" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4492
	    fnWeight = FW_LIGHT;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4493
	} else if (strcmp( work, "heavy" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4494
	    fnWeight = FW_HEAVY;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4495
	} else if (strcmp( work, "extraBold" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4496
	    fnWeight = FW_EXTRABOLD;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4497
	} else if (strcmp( work, "semiBold" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4498
	    fnWeight = FW_SEMIBOLD;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4499
	} else if (strcmp( work, "thin" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4500
	    fnWeight = FW_THIN;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4501
	} else if (strcmp( work, "extraLight" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4502
	    fnWeight = FW_EXTRALIGHT;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4503
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4504
    } else if (__isSmallInteger(weight)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4505
	fnWeight = __intVal(weight);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4506
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4507
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4508
    if(__isSmallInteger( logSize )) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4509
	nHeight = __intVal( logSize );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4510
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4511
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4512
    if (__isString(slant)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4513
	work2 = __stringVal( slant );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4514
	work  = __stringVal( slant );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4515
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4516
	if (strncmp(work2, "italic", 6) == 0)  {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4517
	    fdwItalic = TRUE;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4518
	    if ( work2[6] == '-' )
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4519
		strncpy( work, &work2[7], ( strlen( work2) - 7) );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4520
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4521
	    if (strncmp(work2, "oblique", 7) == 0)  {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4522
		fdwItalic = TRUE;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4523
		if ( work2[7] == '-' )
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4524
		    strncpy( work, &work2[8], ( strlen( work2) - 8) );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4525
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4526
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4527
	if (strncmp( work, "underline", 9 ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4528
	    fdwUnderline = TRUE;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4529
	    if( work[10] == '-' )
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4530
		strncpy( work2, &work[11], ( strlen( work ) - 10 ) );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4531
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4532
	if (strncmp( work2, "strikeOut", 9 ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4533
	    fdwStrikeOut = TRUE;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4534
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4535
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4536
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4537
    DPRINTF(("CreateFont face:%s h=%d w=%d wght=%d\n",
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4538
		faceName, nHeight, nWidth, fnWeight));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4539
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4540
    hFont = CreateFont( -nHeight,   /* character height - not cell height */
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4541
			nWidth,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4542
			nEscapement,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4543
			nOrientation,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4544
			fnWeight,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4545
			fdwItalic,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4546
			fdwUnderline,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4547
			fdwStrikeOut,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4548
			fdwCharSet,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4549
			fdwOutputPrecision,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4550
			fdwClipPrecision,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4551
			fdwQuality,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4552
			fdwPitchAndFamily,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4553
			faceName );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4554
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4555
    if (hFont != NULL) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4556
	DPRINTF(("createFont: %x\n", hFont));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4557
/*
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4558
    #ifdef COUNT_RESOURCES
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4559
	__cnt_font++;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4560
	RES1PRINTF(("CreateFont %d\n", __cnt_font));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4561
    #endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4562
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4563
	RETURN ( __MKEXTERNALADDRESS(hFont) );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4564
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4565
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4566
    DPRINTF(("***** ERROR createFontWithFoundry failed ERROR *****\n" ));
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4567
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4568
    ^ nil
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4569
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4570
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4571
     Display getFontWithFoundry:'*'
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4572
			 family:'courier'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4573
			 weight:'medium'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4574
			  slant:'r'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4575
			spacing:nil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4576
		      pixelSize:nil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4577
			   size:13
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4578
		       registry:'iso8859'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4579
		       encoding:'*'
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4580
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4581
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4582
    "new NT Version: 20.2.1997 / 22:33:29 / dq"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4583
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4584
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4585
primFontMetricsOf:fontId hdc:aDC intoArray:rawData
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4586
    "evaluate aBlock, passing a fonts metrics as arguments.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4587
     fill passed array as:
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4588
      ascent     -> (data at:1)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4589
      descent    -> (data at:2)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4590
      maxAscent  -> (data at:3)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4591
      maxDescent -> (data at:4)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4592
      minWidth   -> (data at:5)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4593
      maxWidth   -> (data at:6)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4594
      avgWidth   -> (data at:7).
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4595
      minChar    -> (data at:8).
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4596
      maxChar    -> (data at:9).
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4597
      defaultChar-> (data at:10).
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4598
      charSet    -> (data at:11).
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4599
"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4600
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4601
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4602
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4603
    if (__isExternalAddress(fontId)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4604
     && __isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4605
     && __isArray(rawData)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4606
     && (__arraySize(rawData) >= 11)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4607
	SIZE size;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4608
	int avgWidth;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4609
	HGDIOBJ hFont;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4610
	HGDIOBJ prevFont;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4611
	TEXTMETRIC tmet;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4612
	static char *s = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4613
	static int len;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4614
	OBJ t;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4615
	HANDLE hDC;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4616
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4617
	hFont = _HGDIOBJVal(fontId);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4618
	hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4619
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4620
	/*
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4621
	 * temporarily set this font in the tmpDC (root-) context
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4622
	 */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4623
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4624
	prevFont = SelectObject(hDC, hFont);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4625
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4626
	GetTextMetricsW(hDC, &tmet);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4627
	if (len == 0) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4628
	    len = strlen(s);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4629
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4630
#if 0
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4631
	GetTextExtentPoint32(hDC, s, len, &size);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4632
	avgWidth = (size.cx / (len / 2) + 1) / 2;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4633
#else
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4634
	avgWidth = tmet.tmAveCharWidth;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4635
#endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4636
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4637
	__ArrayInstPtr(rawData)->a_element[0] = __MKSMALLINT(tmet.tmAscent);        /* ascent     -> (data at:1) */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4638
	__ArrayInstPtr(rawData)->a_element[1] = __MKSMALLINT(tmet.tmDescent);       /* descent    -> (data at:2) */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4639
	__ArrayInstPtr(rawData)->a_element[2] = __MKSMALLINT(tmet.tmAscent);        /* maxAscent  -> (data at:3) */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4640
	__ArrayInstPtr(rawData)->a_element[3] = __MKSMALLINT(tmet.tmDescent);       /* maxDescent -> (data at:4) */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4641
	__ArrayInstPtr(rawData)->a_element[4] = __MKSMALLINT(avgWidth);             /* minWidth   -> (data at:5) */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4642
	__ArrayInstPtr(rawData)->a_element[5] = __MKSMALLINT(tmet.tmMaxCharWidth);  /* maxWidth   -> (data at:6) */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4643
	__ArrayInstPtr(rawData)->a_element[6] = __MKSMALLINT(avgWidth);             /* avgWidth   -> (data at:7) */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4644
	__ArrayInstPtr(rawData)->a_element[7] = __MKSMALLINT(tmet.tmFirstChar);     /* min        -> (data at:8) */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4645
	__ArrayInstPtr(rawData)->a_element[8] = __MKSMALLINT(tmet.tmLastChar);      /* max        -> (data at:9) */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4646
	__ArrayInstPtr(rawData)->a_element[9] = __MKSMALLINT(tmet.tmDefaultChar);   /* default    -> (data at:10) */
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4647
#if 0
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4648
	t = __charSetSymbolFor(tmet.tmCharSet);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4649
	__ArrayInstPtr(rawData)->a_element[10]= t; __STORE(rawData, t);             /* charSet    -> (data at:11) */
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4650
#endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4651
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4652
	DPRINTF(("textMetrics h=%x  avgAsc=%d avgDesc=%d minW=%d maxW=%d avgW=%d\n",
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4653
		    hFont, tmet.tmAscent, tmet.tmDescent, avgWidth, tmet.tmMaxCharWidth,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4654
		    tmet.tmAveCharWidth));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4655
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4656
	SelectObject(hDC, prevFont);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4657
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4658
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4659
    RETURN (nil);
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4660
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4661
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4662
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4663
releaseFont:aFontId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4664
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4665
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4666
    if (__isExternalAddress(aFontId)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4667
	HGDIOBJ hFont = _HGDIOBJVal(aFontId);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4668
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4669
	if (hFont) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4670
	   DPRINTF(("ReleaseFont: %x\n", hFont));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4671
	   DeleteObject(hFont);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4672
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4673
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4674
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4675
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4676
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4677
setFont:aFontId in:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4678
    "set font to be drawn in"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4679
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4680
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4681
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4682
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4683
     && __isExternalAddress(aFontId))
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4684
    {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4685
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4686
	HGDIOBJ prevFont, hFont;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4687
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4688
	hFont = _HGDIOBJVal(aFontId);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4689
	prevFont = SelectObject(hDC, hFont);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4690
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4691
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4692
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4693
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4694
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4695
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4696
    "Created: / 04-08-2006 / 12:32:53 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4697
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4698
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4699
widthOf:aString from:index1 to:index2 inFont:aFontId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4700
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4701
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4702
    unsigned char *cp;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4703
    int len, n, i1, i2, l;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4704
    OBJ cls;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4705
    int nInstBytes;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4706
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4707
    if (__bothSmallInteger(index1, index2)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4708
     && __isExternalAddress(aFontId)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4709
     && __isExternalAddressLike(__INST(gcId))
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4710
     && __isNonNilObject(aString)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4711
	HGDIOBJ hFont,prevFont;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4712
	HANDLE hDC;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4713
	SIZE tsize;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4714
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4715
#ifndef PRE_22_FEP_2007
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4716
#       define N_QUICK_CHARS    1024
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4717
	unsigned short quickWchars[N_QUICK_CHARS];
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4718
	unsigned short *wcharPtr;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4719
	int mustFree = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4720
	int i;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4721
#endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4722
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4723
	hFont = _HGDIOBJVal(aFontId);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4724
	hDC = (HANDLE)(__externalAddressVal(__INST(gcId)));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4725
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4726
	prevFont = SelectObject(hDC, hFont);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4727
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4728
	i1 = __intVal(index1) - 1;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4729
	cls = __qClass(aString);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4730
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4731
	if (i1 >= 0) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4732
	    i2 = __intVal(index2) - 1;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4733
	    if (i2 < i1) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4734
		RETURN ( __MKSMALLINT( 0 ) );
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4735
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4736
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4737
	    cp = (char *) _stringVal(aString);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4738
	    l = i2 - i1 + 1;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4739
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4740
	    if ((cls == @global(String)) || (cls == @global(Symbol))) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4741
		n = _stringSize(aString);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4742
    commonWidthChars:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4743
		if (i2 < n) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4744
		    cp += i1;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4745
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4746
#ifdef PRE_22_FEP_2007
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4747
		    GetTextExtentPoint32(hDC, cp, l, &tsize);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4748
#else
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4749
		    if (l <= N_QUICK_CHARS) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4750
			wcharPtr = quickWchars;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4751
			mustFree = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4752
		    } else {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4753
			wcharPtr = malloc(sizeof(short)*l);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4754
			if (! wcharPtr) RETURN (__MKSMALLINT(0));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4755
			mustFree = 1;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4756
		    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4757
		    for (i=0; i<l; i++) wcharPtr[i] = ((unsigned char *)cp)[i];
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4758
		    GetTextExtentPoint32W(hDC, wcharPtr, l, &tsize);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4759
		    if (mustFree) free(wcharPtr);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4760
#endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4761
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4762
#ifdef SUPERDEBUG
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4763
		    if (__debug__) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4764
			char buf[80];
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4765
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4766
			GetTextFace(hDC,80,buf);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4767
			console_printf("font1 %x %s >%s< l=%d dx=%d\n",hFont,buf,cp,l,tsize.cx);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4768
		    }
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4769
#endif
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4770
		    SelectObject(hDC, prevFont);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4771
		    RETURN ( __MKSMALLINT(tsize.cx) );
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4772
		}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4773
		RETURN (__MKSMALLINT(0));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4774
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4775
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4776
	    nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4777
	    cp += nInstBytes;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4778
	    n = __byteArraySize(aString) - nInstBytes;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4779
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4780
	    if (__isBytes(aString)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4781
		goto commonWidthChars;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4782
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4783
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4784
	    /* Unicode */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4785
	    if (__isWords(aString)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4786
		n = n / 2;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4787
		if (i2 < n) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4788
		    WIDECHAR *w_cp = (WIDECHAR *)cp;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4789
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4790
		    w_cp += i1;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4791
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4792
		    GetTextExtentPoint32W(hDC, w_cp, l, &tsize);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4793
		    SelectObject(hDC, prevFont);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4794
		    RETURN ( __MKSMALLINT(tsize.cx) );
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4795
		}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4796
		RETURN (__MKSMALLINT(0));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4797
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4798
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4799
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4800
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4801
    self primitiveFailed.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4802
    ^ 0
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4803
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4804
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4805
widthOf:aString inFont:aFontId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4806
    "return the width in pixels of a string in a specific font"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4807
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4808
    ^ self widthOf:aString from:1 to:(aString size) inFont:aFontId
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
  4809
! !
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
  4810
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4811
!WinPrinterContext methodsFor:'initialization & release'!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4812
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4813
createDC
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4814
    "Private - Create a device context for the receiver"
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  4815
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4816
    gcId := printerInfo createDC
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4817
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4818
    "Created: / 27-07-2006 / 10:21:05 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4819
    "Modified: / 02-08-2006 / 17:30:47 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4820
    "Modified: / 10-10-2006 / 18:14:28 / cg"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4821
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4822
2315
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4823
deleteDC
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4824
    "Private - Delete a device context for the receiver"
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4825
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4826
    OperatingSystem deletePrinterDC: gcId.
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4827
!
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4828
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4829
destroy
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4830
    "Destroy the GC."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4831
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4832
    |id|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4833
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4834
    id := gcId.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4835
    id notNil ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4836
	gcId := nil.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4837
	self deleteDC.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4838
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4839
"/    Lobby unregister:self.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4840
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4841
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4842
destroyGC:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4843
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4844
    if (__isExternalAddressLike(aDC)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4845
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4846
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4847
	DeleteDC(hDC);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4848
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4849
/*
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4850
#ifdef CACHE_LAST_DC
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4851
	if (lastGcData == gcData) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4852
	    _releaseDC(gcData);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4853
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4854
#endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4855
*/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4856
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4857
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4858
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4859
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4860
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4861
executor
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4862
    |aCopy|
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4863
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4864
    aCopy := WinWorkstation::PrinterDeviceContextHandle basicNew.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4865
    aCopy setDevice:device id:nil gcId:gcId.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4866
    ^ aCopy
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4867
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4868
    "Created: / 16-04-2007 / 12:39:02 / cg"
2315
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4869
!
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4870
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4871
initialize
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4872
    super initialize.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4873
"/    deviceForms := Registry new.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4874
"/    deviceColors := Registry new.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4875
    deviceFonts := CachingRegistry new cacheSize:10.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4876
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4877
2315
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4878
releaseDC
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4879
    "Private - Delete and clear the device context of the receiver."
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4880
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4881
    self deleteDC.
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
  4882
"/    device close.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4883
    gcId := nil.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4884
    self releaseDeviceFonts
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4885
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4886
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4887
releaseDeviceFonts
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4888
    deviceFonts isEmptyOrNil ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4889
	deviceFonts do:[:afont |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4890
	    afont releaseFromDevice.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4891
	].
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4892
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4893
    deviceFonts := CachingRegistry new cacheSize:10.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4894
! !
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4895
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4896
!WinPrinterContext methodsFor:'non standard methods'!
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4897
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4898
stringWidthOf:aString at:index
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4899
    "Return the width of aString up to index
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4900
     when written using the current font; expand tabs out
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4901
     to 4 spaces for calculations"
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4902
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4903
    |answer str size spaceWidth|
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4904
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4905
    index <= 0 ifTrue:[ ^ 0 ].
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4906
    str := index >= aString size ifTrue:[ aString ] ifFalse:[ aString copyFrom:1 to:index ].
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4907
    true "self font isNil" ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4908
	"if font not set yet, calculate based on default font"
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4909
	"/            extString := str asExternalString.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4910
	size := Win32OperatingSystem::WinPointStructure new.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4911
	(OperatingSystem
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4912
	    getTextExtentPoint:gcId
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4913
	    string:str
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4914
	    size:size) ifFalse:[ ^ self error ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4915
	answer := size x.
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4916
"/        Transcript showCR: 'FROM PRIM ******* ', str, '   ',  answer printString.
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4917
"/        Transcript showCR: 'FROM DEVICE ***** ', str, '   ',(self font widthOf:str on:self device) printString.
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4918
	#TODO.
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4919
    ] ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4920
	answer := self font widthOf:str on:self device
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4921
    ].
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4922
    index > aString size ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4923
	spaceWidth := self font widthOf:Character space on:self device.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4924
	answer := answer + ((index - aString size) * spaceWidth)
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4925
    ].
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4926
    ^ answer.
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4927
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4928
    "Created: / 03-08-2006 / 10:27:20 / fm"
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4929
    "Modified: / 04-08-2006 / 12:27:26 / fm"
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4930
    "Modified: / 10-10-2006 / 18:20:43 / cg"
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4931
! !
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4932
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4933
!WinPrinterContext methodsFor:'not supported yet'!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4934
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4935
displayAdvanceLineFrom:point1 to:point2
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4936
    "draw a line"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4937
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4938
    self displayAdvanceLineFromX:(point1 x) y:(point1 y)
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4939
		      toX:(point2 x) y:(point2 y)
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4940
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4941
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4942
displayAdvanceLineFromX:x0 y:y0 toX:x1 y:y1
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4943
    "draw a line (with current paint-color); apply transformation if nonNil"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4944
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4945
    |pX0 pY0 pX1 pY1 easy fgId bgId|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4946
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4947
    gcId isNil ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4948
	self initGC
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4949
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4950
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4951
    lineStyle == #doubleDashed ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4952
	"
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4953
	 if bgPaint or paint is not a real color, we have to do it the hard way ...
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4954
	"
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4955
	easy := true.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4956
	paint isColor ifFalse:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4957
	    easy := false
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4958
	] ifTrue:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4959
	    fgId := paint colorId.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4960
	    fgId isNil ifTrue:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4961
		easy := false
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4962
	    ]
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4963
	].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4964
	bgPaint isColor ifFalse:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4965
	    easy := false
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4966
	] ifTrue:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4967
	    bgId := bgPaint colorId.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4968
	    bgId isNil ifTrue:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4969
		easy := false
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4970
	    ]
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4971
	].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4972
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4973
	easy ifTrue:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4974
	    ((foreground ~~ paint) or:[background ~~ bgPaint]) ifTrue:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4975
		device setForeground:fgId background:bgId in:gcId.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4976
		foreground := paint.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4977
		background := bgPaint.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4978
	    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4979
	] ifFalse:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4980
	    'DeviceGraphicsContext [warning]: cannot draw dashes with dithered colors' errorPrintCR
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4981
	].
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4982
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4983
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4984
    transformation notNil ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4985
	pX0 := transformation applyToX:x0.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4986
	pY0 := transformation applyToY:y0.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4987
	pX1 := transformation applyToX:x1.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4988
	pY1 := transformation applyToY:y1.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4989
    ] ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4990
	pX0 := x0.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4991
	pY0 := y0.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4992
	pX1 := x1.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4993
	pY1 := y1
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4994
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4995
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4996
    pX0 := pX0 rounded.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4997
    pY0 := pY0 rounded.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4998
    pX1 := pX1 rounded.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4999
    pY1 := pY1 rounded.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5000
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5001
    device displayAdvanceLineFromX:pX0 y:pY0 toX:pX1 y:pY1 in:drawableId with:gcId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5002
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5003
    "Modified: 10.1.1997 / 17:46:32 / cg"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5004
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5005
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5006
displayAdvanceLineFromX:x0 y:y0 toX:x1 y:y1 in:ignoredDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5007
    "draw a line. If the coordinates are not integers, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5008
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5009
    self getPenForMyContext.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5010
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5011
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5012
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5013
     && __bothSmallInteger(x0, y0)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5014
     && __bothSmallInteger(x1, y1)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5015
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5016
	COLORREF fgColor;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5017
	int __x1 = __intVal(x1), __y1 = __intVal(y1);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5018
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5019
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5020
/*      DPRINTF(("displayLine: %d/%d -> %d/%d\n",
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5021
		    __intVal(x0), __intVal(y0),
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5022
		    __x1, __y1));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5023
*/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5024
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5025
/*        fgColor = GetTextColor(hDC);
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5026
 *        hPen = CreatePen(PS_SOLID, 1, fgColor);
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5027
 */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5028
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5029
	MoveToEx(hDC, __intVal(x0), __intVal(y0), NULL);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5030
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5031
	LineTo(hDC, __x1, __y1);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5032
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5033
	/*
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5034
	 * end-point ...
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5035
	 */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5036
	LineTo(hDC, __x1+1, __y1);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5037
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5038
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5039
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5040
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5041
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5042
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5043
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5044
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5045
gcForBitmap:aDrawableId
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5046
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5047
%{  /* NOCONTEXT */
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5048
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5049
    if (__isExternalAddress(aDrawableId)){
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5050
	BITMAP bitmap;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5051
	HBITMAP hBitmap = _HBITMAPVAL(aDrawableId);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5052
	HBITMAP memBM;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5053
	HANDLE compatibleDC, rootDC, hdcScreen;
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5054
   //     HANDLE printerDC = (HANDLE)(__externalAddressVal(__INST(gcId)));
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5055
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5056
	if (! hBitmap) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5057
	    RETURN (nil);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5058
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5059
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5060
	if (GetObject(hBitmap, sizeof(bitmap), &bitmap)) {
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5061
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5062
	    DDPRINTF(("bitmap info:%d\n", bitmap.bmBitsPixel));
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5063
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5064
	} else {
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5065
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5066
	    DPRINTF(("noinfo returned for bitmap\n"));
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5067
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5068
	    /* mhmh - can this happen ? */
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5069
	    bitmap.bmBitsPixel = 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5070
	}
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5071
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5072
	gcData->hBitmap = hBitmap;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5073
	gcData->bitmapColorBitCount = bitmap.bmBitsPixel;
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5074
*/
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5075
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5076
	rootDC  = CreateDC("DISPLAY", NULL, NULL, NULL);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5077
	compatibleDC = CreateCompatibleDC(rootDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5078
	SelectObject(compatibleDC, hBitmap);
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5079
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5080
   //     hdcScreen= CreateDC("NULL", NULL, NULL, NULL);
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5081
   //       compatibleDC =  rootDC;
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5082
   //     compatibleDC = CreateCompatibleDC(printerDC);
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5083
   //     compatibleDC = CreateCompatibleDC(0);
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  5084
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5085
   //     memBM = CreateCompatibleBitmap ( compatibleDC, bitmap.bmWidth, bitmap.bmHeight );
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5086
   //     SelectObject ( compatibleDC, memBM );
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5087
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5088
	RETURN (__MKEXTERNALADDRESS(compatibleDC));
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5089
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5090
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5091
	RETURN ( __MKEXTERNALADDRESS(gcData) );
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5092
*/
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5093
    }
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5094
    RETURN (nil);
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5095
%}
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5096
!
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5097
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5098
getPenForMyContext
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5099
    "Get a pen for my context"
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5100
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5101
    |maskOriginX maskOriginY|
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5102
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5103
    self maskOrigin isNil ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5104
	maskOriginX := self maskOrigin x.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5105
	maskOriginY := self maskOrigin y.
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5106
    ].
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5107
2325
634b74929d2d *** empty log message ***
fm
parents: 2324
diff changeset
  5108
%{
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5109
    HPEN hPen = 0;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5110
    HPEN prevPen;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5111
    LOGBRUSH Brush;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5112
    COLORREF fgColor;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5113
    HANDLE hDC = (HANDLE)(__externalAddressVal(__INST(gcId)));
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5114
    int lStyle, bkMode, hMask, maskOrgX, maskOrgY;
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5115
    OBJ lineStyle, capStyle, joinStyle;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5116
    int style;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5117
    int lw;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5118
    int BK_TRANSPARENT;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5119
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5120
    BK_TRANSPARENT = 1;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5121
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5122
    lw= __intVal(__INST(lineWidth));
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5123
/*    fgColor = __intVal(__INST(foreground)) & 0xffffff;     */
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5124
2325
634b74929d2d *** empty log message ***
fm
parents: 2324
diff changeset
  5125
    fgColor = GetTextColor(hDC);
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5126
    lineStyle=__INST(lineStyle);
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5127
    capStyle=__INST(capStyle);
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5128
    joinStyle=__INST(joinStyle);
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5129
    hMask= __intVal(__INST(mask));
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5130
    maskOrgX=__intVal(maskOriginX);
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5131
    maskOrgY=__intVal(maskOriginY);
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5132
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5133
    if (lineStyle == @symbol(solid)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5134
	style = PS_SOLID;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5135
    } else if (lineStyle == @symbol(dashed)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5136
	style= PS_DASH;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5137
    } else if (lineStyle == @symbol(dotted)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5138
	style= PS_DOT;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5139
    } else if (lineStyle == @symbol(dashDot)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5140
	style= PS_DASHDOT;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5141
    } else if (lineStyle == @symbol(dashDotDot)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5142
	style= PS_DASHDOTDOT;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5143
    } else
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5144
	style= PS_SOLID;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5145
    lStyle &= ~PS_STYLE_MASK;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5146
    lStyle |= style;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5147
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5148
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5149
    if (capStyle == @symbol(round)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5150
	style = PS_ENDCAP_ROUND;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5151
    } else if (capStyle == @symbol(square)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5152
	style = PS_ENDCAP_SQUARE;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5153
    } else if (capStyle == @symbol(flat)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5154
	style = PS_ENDCAP_FLAT;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5155
    } else
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5156
	style = PS_ENDCAP_FLAT;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5157
    lStyle &= ~PS_ENDCAP_MASK;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5158
    lStyle |= style;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5159
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5160
    if (joinStyle == @symbol(bevel)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5161
	style = PS_JOIN_BEVEL;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5162
    } else if (joinStyle == @symbol(miter)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5163
	style = PS_JOIN_MITER;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5164
    } else if (joinStyle == @symbol(round)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5165
	style = PS_JOIN_ROUND;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5166
    } else
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5167
	style = PS_JOIN_MITER;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5168
    lStyle &= ~PS_JOIN_MASK;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5169
    lStyle |= style;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5170
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5171
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5172
    if (((lStyle & PS_STYLE_MASK) == PS_SOLID)
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5173
     && (hMask == 0)
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5174
     && (lw /* lineWidth */ <= 1)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5175
	if (fgColor == 0 /* BlackPixel */ ) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5176
	    hPen = GetStockObject(BLACK_PEN);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5177
	    prevPen = SelectObject(hDC, hPen);
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5178
	    RETURN( __MKEXTERNALADDRESS(hPen) );
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5179
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5180
	if (fgColor == 1 /* WhitePixel */) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5181
	    hPen = GetStockObject(WHITE_PEN);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5182
	    prevPen = SelectObject(hDC, hPen);
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5183
	    RETURN( __MKEXTERNALADDRESS(hPen) );
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5184
	}
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5185
    }
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5186
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5187
    hPen = (HPEN) 0;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5188
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5189
    if (0 /* __isWinNT */) {
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5190
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5191
	if (lw == 0) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5192
	    lw = 1;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5193
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5194
	/*
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5195
	 * NT supports masked drawing with any lineStyle,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5196
	 * and also non-solid lines with any lineWidth.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5197
	 */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5198
	if (hMask) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5199
	    Brush.lbStyle = BS_PATTERN;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5200
	    Brush.lbHatch = (DWORD)hMask;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5201
	    Brush.lbColor = fgColor;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5202
	} else {
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5203
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5204
#ifndef PRE_07_APR_04
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5205
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5206
	    hPen = CreatePen((lStyle & PS_STYLE_MASK), lw, fgColor);
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5207
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5208
/*            RESPRINTF(("CreatePen %x %d(%d) %x %x\n",
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5209
 *                       lStyle,
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5210
 *                       lw, __INST(lineWidth),
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5211
 *                       fgColor, hMask));
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5212
 */
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5213
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5214
	    SetBkMode(hDC, TRANSPARENT);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5215
	    bkMode = BK_TRANSPARENT;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5216
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5217
#else
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5218
	    Brush.lbStyle = BS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5219
	    Brush.lbHatch = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5220
	    Brush.lbColor = fgColor;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5221
#endif
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5222
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5223
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5224
	if (! hPen)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5225
	{
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5226
	    hPen = ExtCreatePen(PS_GEOMETRIC | lStyle,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5227
			    lw, /* lineWidth, */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5228
			    &Brush,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5229
			    0, 0);
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5230
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5231
/*            RESPRINTF(("ExtCreatePen1 %x %d(%d) %x %x\n",
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5232
 *                       lStyle,
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5233
 *                       lw, __INST(lineWidth),
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5234
 *                       fgColor, hMask));
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5235
 */
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5236
	    if (hMask) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5237
		SetBrushOrgEx(hDC, maskOrgX, maskOrgY, 0);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5238
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5239
	}
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5240
    } else {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5241
	/*
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5242
	 * W95 only supports masked drawing with SOLID lines
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5243
	 * also, we should use COSMETIC pens if possible
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5244
	 * with non-solid lineStyles.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5245
	 */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5246
	if ((lStyle & PS_STYLE_MASK) == PS_SOLID) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5247
	    int ps = PS_GEOMETRIC;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5248
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5249
	    if (hMask) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5250
		Brush.lbStyle = BS_PATTERN;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5251
		Brush.lbHatch = (DWORD)hMask;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5252
		Brush.lbColor = fgColor;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5253
	    } else {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5254
		Brush.lbStyle = BS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5255
		Brush.lbHatch = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5256
		Brush.lbColor = fgColor;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5257
		if (lw /* lineWidth */ <= 1) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5258
		    ps = PS_COSMETIC;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5259
		}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5260
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5261
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5262
	    hPen = ExtCreatePen(ps | lStyle,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5263
				lw, /* lineWidth */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5264
				&Brush,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5265
				0, 0);
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5266
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5267
/*            RESPRINTF(("ExtCreatePen1 %x %d %x %x\n",
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5268
 *                           lStyle,
2325
634b74929d2d *** empty log message ***
fm
parents: 2324
diff changeset
  5269
 *                           lw,
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5270
 *                           fgColor, hMask));
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5271
 */
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5272
	    if (hMask) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5273
		SetBrushOrgEx(hDC, maskOrgX, maskOrgY, 0);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5274
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5275
	} else {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5276
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5277
	    if (lw == 1) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5278
		lw = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5279
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5280
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5281
	    /*
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5282
	     * dashes only supported with lineWidth 0
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5283
	     */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5284
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5285
	    hPen = CreatePen((lStyle & PS_STYLE_MASK),
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5286
			     lw,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5287
			     fgColor);
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5288
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5289
/*            RESPRINTF(("CreatePen %x %d %x\n",
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5290
 *                               (lStyle & PS_STYLE_MASK),
2325
634b74929d2d *** empty log message ***
fm
parents: 2324
diff changeset
  5291
 *                               lw,
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5292
 *                               fgColor));
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5293
 */
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5294
	    //
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5295
	    // CG: wrong; must set to opaque, if doubleDashed
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5296
	    //
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5297
	    SetBkMode(hDC, TRANSPARENT);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5298
	    bkMode = BK_TRANSPARENT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5299
	}
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5300
    }
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5301
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5302
    prevPen = SelectObject(hDC, hPen);
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5303
    RETURN (__MKEXTERNALADDRESS(hPen));
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5304
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5305
%}
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5306
!
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5307
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5308
xprimDrawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth padding:padd width:imageWidth height:imageHeight
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5309
				  x:srcx y:srcy
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5310
			       into:ignoredDrawableId
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5311
				  x:dstx y:dsty
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5312
			      width:w height:h
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5313
			       with:aDC
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5314
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5315
    "since XPutImage may allocate huge amount of stack space
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5316
     (some implementations use alloca), this must run with unlimited stack."
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5317
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5318
%{
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5319
    unsigned char fastBits[10000];
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5320
    unsigned char *b_bits = 0;
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5321
    unsigned char *allocatedBits = 0;
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5322
    unsigned char *__imageBits = 0;
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5323
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5324
    if (__isByteArray(imageBits)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5325
	__imageBits = __ByteArrayInstPtr(imageBits)->ba_element;
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5326
    } else if (__isExternalBytesLike(imageBits)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5327
	__imageBits = (unsigned char *)(__externalBytesAddress(imageBits));
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5328
    }
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5329
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5330
    if (/* ISCONNECTED
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5331
     && */  __isExternalAddressLike(aDC)
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5332
     && __bothSmallInteger(srcx, srcy)
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5333
     && __bothSmallInteger(dstx, dsty)
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5334
     && __bothSmallInteger(w, h)
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5335
     && __bothSmallInteger(imageWidth, imageHeight)
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5336
     && __bothSmallInteger(imageDepth, bitsPerPixel)
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5337
     && __isSmallInteger(padd)
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5338
     && __imageBits)
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5339
     {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5340
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5341
	struct
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5342
	{
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5343
	  BITMAPINFOHEADER bmiHeader;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5344
	  DWORD r;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5345
	  DWORD g;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5346
	  DWORD b;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5347
	} bitmap;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5348
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5349
	if (__intVal(padd) != WIN32PADDING) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5350
	    int row, col;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5351
	    unsigned char *cp;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5352
	    unsigned char *pBits;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5353
	    int b_width, b_height, bytesPerRowST, bytesPerRowWN, padding, nBytes;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5354
	    int bi = __intVal(bitsPerPixel);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5355
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5356
	    b_width = __intVal(w);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5357
	    b_height = __intVal(h);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5358
	    bytesPerRowST = (b_width * bi + (__intVal(padd)-1)) / __intVal(padd);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5359
	    bytesPerRowWN = (b_width * bi + (WIN32PADDING-1)) / WIN32PADDING * (WIN32PADDING/8);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5360
	    padding = bytesPerRowWN - bytesPerRowST;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5361
	    nBytes = b_height * bytesPerRowWN;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5362
	    /*console_printf("padd %d bs %d bw %d p %d\n",__intVal(padd),bytesPerRowST,bytesPerRowWN,padding);*/
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5363
	    if (padding) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5364
		if (nBytes < sizeof(fastBits)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5365
		    cp = b_bits = fastBits;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5366
		} else {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5367
		    cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5368
		}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5369
		if (cp) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5370
		    pBits = __imageBits;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5371
		    for (row = b_height; row; row--) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5372
			for (col = bytesPerRowST; col; col--) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5373
			    *cp++ = *pBits++;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5374
			}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5375
			cp += padding;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5376
		    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5377
		} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5378
		    goto fail;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5379
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5380
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5381
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5382
	if (b_bits == 0) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5383
	    b_bits = __imageBits;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5384
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5385
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5386
	bitmap.bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5387
	bitmap.bmiHeader.biPlanes = 1;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5388
	if (__intVal(imageDepth) == 24) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5389
	    /*bitmap.bmiHeader.biCompression = BI_BITFIELDS;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5390
	    bitmap.r = 0xff0000;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5391
	    bitmap.g = 0x00ff00;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5392
	    bitmap.b = 0x0000ff;*/
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5393
	    bitmap.bmiHeader.biCompression = BI_RGB;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5394
	} else if (__intVal(imageDepth) == 16) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5395
	    /*bitmap.bmiHeader.biCompression = BI_RGB;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5396
	    bitmap.bmiHeader.biCompression = BI_BITFIELDS;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5397
	    bitmap.b = 0x001f;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5398
	    bitmap.g = 0x07e0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5399
	    bitmap.r = 0xf800;*/
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5400
	    bitmap.b = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5401
	    bitmap.g = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5402
	    bitmap.r = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5403
	    bitmap.bmiHeader.biCompression = BI_RGB;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5404
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5405
	bitmap.bmiHeader.biSizeImage = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5406
	bitmap.bmiHeader.biXPelsPerMeter = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5407
	bitmap.bmiHeader.biYPelsPerMeter = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5408
	bitmap.bmiHeader.biClrUsed = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5409
	bitmap.bmiHeader.biClrImportant = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5410
	bitmap.bmiHeader.biWidth = __intVal(imageWidth);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5411
	bitmap.bmiHeader.biHeight = -(__intVal(imageHeight));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5412
	bitmap.bmiHeader.biBitCount = __intVal(bitsPerPixel);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5413
	/*console_printf("drawBits depth:%d bitsPerPixel:%d IW%d W:%d H:%d\n",__intVal(imageDepth),bitmap.bmiHeader.biBitCount,bitmap.bmiHeader.biWidth,__intVal(w),bitmap.bmiHeader.biHeight);*/
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5414
	SetDIBitsToDevice(hDC,__intVal(dstx),__intVal(dsty),
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5415
			      __intVal(w), __intVal(h),
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5416
			      __intVal(srcx), __intVal(srcy),
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5417
			      0,__intVal(h),
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5418
			      (void *)b_bits,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5419
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5420
	if (allocatedBits) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5421
	    free(allocatedBits);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5422
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5423
	RETURN ( true );
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5424
    }
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5425
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5426
fail: ;
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5427
/*
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5428
    PRINTF(("create temp bitmap FAILED!!!\n"));
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5429
*/
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5430
    if (allocatedBits) {
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5431
/*
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5432
	PRINTF(("freeing up temp bitmap bits ...\n"));
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5433
*/
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5434
	free(allocatedBits);
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5435
    }
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5436
%}
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5437
.
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5438
    ^ false
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5439
!
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5440
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5441
xxxdisplayLineFromX:x0 y:y0 toX:x1 y:y1 in:ignoredDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5442
    "draw a line. If the coordinates are not integers, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5443
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5444
    |penHandle|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5445
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5446
    penHandle := self getPenForMyContext.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5447
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5448
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5449
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5450
     && __isExternalAddressLike(penHandle)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5451
     && __bothSmallInteger(x0, y0)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5452
     && __bothSmallInteger(x1, y1)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5453
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5454
	HANDLE hPen = (HANDLE)(__externalAddressVal(penHandle));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5455
	COLORREF fgColor;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5456
	HANDLE prevPen;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5457
	int __x1 = __intVal(x1), __y1 = __intVal(y1);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5458
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5459
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5460
/*      DPRINTF(("displayLine: %d/%d -> %d/%d\n",
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5461
		    __intVal(x0), __intVal(y0),
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5462
		    __x1, __y1));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5463
*/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5464
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5465
/*        fgColor = GetTextColor(hDC);
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5466
 *        hPen = CreatePen(PS_SOLID, 1, fgColor);
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5467
 */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5468
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5469
	prevPen = SelectObject(hDC, hPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5470
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5471
	MoveToEx(hDC, __intVal(x0), __intVal(y0), NULL);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5472
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5473
	LineTo(hDC, __x1, __y1);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5474
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5475
	/*
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5476
	 * end-point ...
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5477
	 */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5478
	LineTo(hDC, __x1+1, __y1);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5479
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5480
	SelectObject(hDC, prevPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5481
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5482
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5483
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5484
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5485
%}
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5486
! !
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5487
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5488
!WinPrinterContext methodsFor:'printing process'!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5489
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5490
endPage
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5491
    "Informs device that we are finished writing to a page."
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  5492
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5493
    (OperatingSystem endPage:gcId) > 0 ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5494
	self error
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5495
    ]
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5496
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5497
    "Created: / 27-07-2006 / 18:20:48 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5498
    "Modified: / 01-08-2006 / 16:01:34 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5499
    "Modified: / 10-10-2006 / 18:14:44 / cg"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5500
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5501
2315
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  5502
endPrintJobWithoutRelease
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5503
    "End the print job.  Everything drawn between startPrintJob
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5504
     and endPrintJob will become one entry in the print queue."
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  5505
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5506
    |result|
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5507
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5508
    self endPage.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5509
    result := OperatingSystem endDoc:gcId.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5510
    jobid := nil.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5511
    result >= 0 ifFalse:[ self error ]
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5512
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5513
    "Created: / 27-07-2006 / 18:21:04 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5514
    "Modified: / 01-08-2006 / 16:01:38 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5515
    "Modified: / 10-10-2006 / 18:50:43 / cg"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5516
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5517
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5518
getSupportsColor
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5519
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5520
    | retVal info |
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5521
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5522
    info := (self class getPrinterInformationString: self name) asUppercase.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5523
    (info includesSubString: ',PSCRIPT,')
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5524
	ifTrue: [
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5525
	    retVal := self class postScriptBlackWhite not.
2347
e5b1c5c1ad88 supportsColor
fm
parents: 2344
diff changeset
  5526
"/            retVal := (DAPASX::DapasSystemInfo getYesNoInfoApp: 'Printer' profile: 'PostScriptBlackWhite') not.
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5527
	]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5528
	ifFalse: [
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5529
	    retVal := (info includesSubString: 'PDF')
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5530
		ifTrue: [true]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5531
		ifFalse: [self numberOfColorBitsPerPixel > 1].
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5532
    ].
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5533
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5534
    ^retVal
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5535
!
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5536
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5537
startPage
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5538
    "Starts a page."
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  5539
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5540
    (OperatingSystem startPage:gcId) > 0 ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5541
	^ self error
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5542
    ].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5543
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5544
    "Created: / 27-07-2006 / 18:25:55 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5545
    "Modified: / 28-07-2006 / 18:19:04 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5546
    "Modified: / 10-10-2006 / 18:19:02 / cg"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5547
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5548
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  5549
startPrintJob:aString fileName:aFileName
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5550
    "Start a print job, using aString as the job title; everything
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5551
     drawn between startPrintJob and endPrintJob will become
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5552
     one entry in the print queue."
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  5553
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5554
    |docInfoStruct nameAddress title fileNameAddress|
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5555
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5556
    gcId isNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5557
	self buildPrinter
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5558
    ].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5559
    abort := false.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5560
    title := aString ? 'Smalltalk/X'.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5561
    nameAddress := title asExternalBytes unprotectFromGC.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5562
    aFileName isNil ifFalse:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5563
	fileNameAddress := aFileName pathName asExternalBytes unprotectFromGC
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5564
    ].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5565
    docInfoStruct := Win32OperatingSystem::DocInfoStructure new.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5566
    docInfoStruct
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5567
	cbSize:docInfoStruct sizeInBytes;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5568
	lpszDocName:nameAddress address.
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5569
    fileNameAddress isNil ifFalse:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5570
	docInfoStruct lpszOutput:fileNameAddress address
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5571
    ].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5572
    jobid := OperatingSystem startDoc:gcId docInfo:docInfoStruct.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5573
    jobid > 0 ifFalse:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5574
	jobid = -1 ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5575
	    abort := true.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5576
	    ^ nil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5577
	].
2905
303bf86fa4bb changed: #startPrintJob:fileName:
sr
parents: 2852
diff changeset
  5578
"/        ^ self error
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5579
	OpenError raiseErrorString:'Cannot create printer job'.
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5580
    ].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5581
    self startPage
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5582
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5583
    "Created: / 27-07-2006 / 18:19:31 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5584
    "Modified: / 03-08-2006 / 15:11:19 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5585
    "Modified: / 10-10-2006 / 18:20:01 / cg"
2905
303bf86fa4bb changed: #startPrintJob:fileName:
sr
parents: 2852
diff changeset
  5586
    "Modified: / 07-04-2011 / 12:03:50 / sr"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5587
! !
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5588
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5589
!WinPrinterContext methodsFor:'queries'!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5590
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5591
hasGrayscales
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5592
    "return true, if this workstation supports grayscales
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5593
     (also true for color displays)"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5594
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5595
    ^ true
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5596
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5597
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5598
isOpen
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5599
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5600
    ^ gcId notNil
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5601
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5602
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5603
isPersistentInSnapshot
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5604
    "return true, if resources on this device are to be made
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5605
     persistent in a snapshot image."
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5606
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5607
    ^ false
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5608
!
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5609
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5610
supportsColor
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5611
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5612
    supportsColor isNil ifTrue:[supportsColor := self getSupportsColor].
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5613
    ^supportsColor
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5614
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5615
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5616
supportsGraphics
2301
135f21a3d127 refactorred OS-independent stuff
Claus Gittinger <cg@exept.de>
parents: 2299
diff changeset
  5617
    ^(OperatingSystem getDeviceCaps: gcId index: 2 "Technology") ~= 4
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5618
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5619
    "Created: / 03-08-2006 / 10:07:43 / fm"
2301
135f21a3d127 refactorred OS-independent stuff
Claus Gittinger <cg@exept.de>
parents: 2299
diff changeset
  5620
    "Modified: / 16-04-2007 / 12:44:03 / cg"
3190
437b1425507e class: WinPrinterContext
Michael Beyl <mb@exept.de>
parents: 3041
diff changeset
  5621
!
437b1425507e class: WinPrinterContext
Michael Beyl <mb@exept.de>
parents: 3041
diff changeset
  5622
437b1425507e class: WinPrinterContext
Michael Beyl <mb@exept.de>
parents: 3041
diff changeset
  5623
supportsVariableHeightFonts
437b1425507e class: WinPrinterContext
Michael Beyl <mb@exept.de>
parents: 3041
diff changeset
  5624
437b1425507e class: WinPrinterContext
Michael Beyl <mb@exept.de>
parents: 3041
diff changeset
  5625
    ^ false
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5626
! !
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5627
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5628
!WinPrinterContext methodsFor:'registration'!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5629
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5630
registerFont:aFont
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5631
    deviceFonts register:aFont.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5632
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5633
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5634
unregisterFont:aFont
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5635
    deviceFonts unregister:aFont.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5636
! !
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5637
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5638
!WinPrinterContext::WinPrinterGraphicContext class methodsFor:'documentation'!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5639
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5640
documentation
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5641
"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5642
    The class is simular to the PSGraphicsContext. It implements a
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5643
    'what you see is what you get' interface - all is scaled dependent
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5644
    on the current screen resolution
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5645
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5646
    supports margin, clipping ...
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5647
"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5648
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5649
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5650
examples
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5651
"
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5652
										[exBegin]
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5653
    |gc font|
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5654
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5655
    gc := WinPrinterContext openGraphicContext.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5656
    gc isNil ifTrue:[^ self ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5657
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5658
    [
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5659
	gc startPrintJob:'Test'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5660
	gc paint:(Color black).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5661
	gc displayLineFromX:10 y:40 toX:100 y:40.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5662
	font := (Font family:'helvetica' face:'roman' style:'bold' size:16) onDevice:(gc device).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5663
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5664
	gc font:font.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5665
	gc paint:(Color red).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5666
	gc displayString:'hallo' x:10 y:(40 + font ascent).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5667
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5668
	gc paint:(Color black).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5669
	gc displayLineFromX:10 y:(40 + font height) toX:100 y:(40 + font height).
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5670
    ] ensure:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5671
	gc close.
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5672
    ].
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5673
										[exEnd]
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5674
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5675
"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5676
! !
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5677
2353
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5678
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'accessing dimensions'!
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5679
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5680
bottomMargin
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5681
    "return the papers bottom margin measured in pixels"
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5682
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5683
    ^ 50
2353
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5684
!
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5685
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5686
leftMargin
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5687
    "return the papers left margin measured in pixels"
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5688
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5689
    ^ 50
2353
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5690
!
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5691
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5692
rightMargin
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5693
    "return the papers right margin measured in pixels"
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5694
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5695
    ^ 50
2353
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5696
!
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5697
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5698
topMargin
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5699
    "return the papers top margin measured in pixels"
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5700
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5701
    ^ 50
2353
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5702
! !
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5703
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5704
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'accessing-hooks'!
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5705
2357
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5706
pageCounter
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5707
    "answer the current page number"
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5708
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5709
    pageCounter ~~ 0 ifTrue:[^ pageCounter].
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5710
    ^ 1
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5711
!
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5712
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5713
pageNumberFormat:aFormatString
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5714
    "set the pageNumber format - the default is 'page %1'"
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5715
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5716
    pageNumberFormat := aFormatString ? ''
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5717
!
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5718
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5719
printPageNumbers:aBoolean
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5720
    "enable/disable printing of page numbers - the default is on"
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5721
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5722
    printPageNumbers := aBoolean.
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5723
! !
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5724
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5725
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'accessing-transformation'!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5726
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5727
clippingRectangle:aRectangle
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5728
    |tranlate extent lft rgt top bot|
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5729
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5730
    tranlate := self translation negated asPoint.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5731
    extent   := self extent.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5732
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5733
    lft := tranlate x.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5734
    top := tranlate y.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5735
    rgt := lft + extent x.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5736
    bot := top + extent y.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5737
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5738
    aRectangle notNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5739
	lft := lft max:aRectangle left.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5740
	top := top max:aRectangle top.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5741
	rgt := rgt min:aRectangle right.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5742
	bot := bot min:aRectangle bottom.
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5743
    ].
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5744
    super clippingRectangle:(Rectangle left:lft top:top right:rgt bottom:bot).
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5745
!
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5746
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5747
scale
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5748
    "answer the scale excluding the fontScale factor"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5749
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5750
    ^ super scale / fontScale
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5751
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5752
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5753
scale:aScale
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5754
    "set the scale and add the fontScale factor"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5755
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5756
    super scale:(fontScale * (aScale ? 1.0)).
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5757
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5758
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5759
transformation
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5760
    "answer the transformation excluding the fontScale factor"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5761
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5762
    ^ WindowingTransformation scale:(self scale)
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5763
			translation:(self translation).
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5764
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5765
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5766
transformation:aTransformation
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5767
    "set the transformation and add the fontScale factor"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5768
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5769
    |s t|
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5770
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5771
    aTransformation notNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5772
	s := aTransformation scale.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5773
	t := aTransformation translation.
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5774
    ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5775
    self scale:s.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5776
    self translation:t.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5777
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5778
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5779
translateBy:aTranslation
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5780
    "set the translation and add the fontScale factor"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5781
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5782
    aTranslation isNil ifTrue:[^ self].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5783
    self translation:( self translation + (self scale * aTranslation)).
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5784
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5785
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5786
translation
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5787
    "answer the translation excluding the fontScale factor"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5788
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5789
    |margin trans|
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5790
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5791
    margin := Point x:(self leftMargin) y:(self topMargin).
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5792
    trans  := (super translation / fontScale) rounded.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5793
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5794
    ^ trans - margin
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5795
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5796
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5797
translation:aTranslation
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5798
    "set the translation and add the fontScale factor"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5799
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5800
    |trans|
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5801
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5802
    trans := Point x:(self leftMargin) y:(self topMargin).
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5803
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5804
    aTranslation notNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5805
	trans := trans + aTranslation.
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5806
    ].
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5807
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5808
    super translation:((trans * fontScale) rounded).
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5809
! !
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5810
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5811
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'drawing strings'!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5812
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5813
displayOpaqueString:aString from:index1 to:index2 x:x y:y
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5814
    self displayString:aString from:index1 to:index2 x:x y:y.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5815
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5816
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5817
displayOpaqueString:aString x:x y:y
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5818
    |end|
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5819
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5820
    end := aString size.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5821
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5822
    end ~~ 0 ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5823
	self displayOpaqueString:aString from:1 to:end x:x y:y.
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5824
    ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5825
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5826
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5827
displayString:aString from:index1 to:index2 x:x y:y
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5828
    "setup the special scale for strings before drawing"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5829
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5830
    |tscale fscale yFont xFont|
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5831
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5832
    index2 < index1 ifTrue:[^ self].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5833
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5834
    transformation isNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5835
	self initTransformation.
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5836
    ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5837
    tscale := transformation scale.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5838
    fscale := tscale / fontScale.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5839
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5840
    xFont := x * fontScale x.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5841
    yFont := (y - font ascent) * fontScale y.    "/ MM_TEXT - Ursprung liegt oben links
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5842
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5843
    transformation scale:fscale.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5844
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5845
    super displayString:aString from:index1 to:index2
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5846
		x:xFont truncated
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5847
		y:yFont truncated.
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5848
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5849
    transformation scale:tscale.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5850
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5851
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5852
displayString:aString x:x y:y
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5853
    |end|
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5854
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5855
    end := aString size.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5856
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5857
    end ~~ 0 ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5858
	self displayString:aString from:1 to:end x:x y:y.
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5859
    ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5860
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5861
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5862
displayString:aString x:x y:y angle:drawAngle opaque:opaque
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5863
    "angles other than 0 is not yet supported"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5864
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5865
    |angle|
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5866
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5867
    angle := drawAngle.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5868
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5869
    angle >= 360 ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5870
	angle := angle - (((angle // 360)) * 360)
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5871
    ] ifFalse:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5872
	angle < 0 ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5873
	    angle := angle - (((angle // 360)) * 360).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5874
	    angle := angle + 360.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5875
	    angle >= 360 ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5876
		angle := angle - (((angle // 360)) * 360)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5877
	    ]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5878
	].
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5879
    ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5880
    angle == 0 ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5881
	super displayString:aString x:x y:y angle:drawAngle opaque:opaque.
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5882
    ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5883
! !
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5884
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5885
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'font stuff'!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5886
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5887
fontMetricsOf:fontId
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5888
    "after retrieving the metrics, we have to scale the information"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5889
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5890
    |metrics|
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5891
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5892
    metrics := super fontMetricsOf:fontId.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5893
    metrics isNil ifTrue:[^ nil ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5894
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5895
    metrics ascent:((metrics ascent / fontScale y) rounded)
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5896
	    descent:((metrics descent / fontScale y) rounded + 1)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5897
	    maxAscent:((metrics maxAscent / fontScale y) rounded)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5898
	    maxDescent:((metrics maxDescent / fontScale y) rounded + 1)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5899
	    minWidth:((metrics minWidth / fontScale x) rounded)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5900
	    maxWidth:((metrics maxWidth / fontScale x) rounded)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5901
	    avgWidth:((metrics averageWidth / fontScale x) rounded).
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5902
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5903
    ^ metrics
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5904
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5905
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5906
getFontWithFoundry:foundry family:family weight:weight
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5907
	      slant:slant spacing:spc pixelSize:pixelSize size:pointSize
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5908
	      registry:registry encoding:encoding
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5909
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5910
    "compute the pixels dependent on the Screen current resolution"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5911
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5912
    |psize|
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5913
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5914
    psize := pixelSize.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5915
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5916
    psize isNil ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5917
	psize := (pointSize * (self getLogicalPixelSizeY) / (Screen current getLogicalPixelSizeY)) rounded.
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5918
    ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5919
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5920
    ^ super getFontWithFoundry:foundry family:family weight:weight
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5921
	      slant:slant spacing:spc pixelSize:psize size:pointSize
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5922
	      registry:registry encoding:encoding
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5923
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5924
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5925
titleFont
2357
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5926
    "answer the font used for displaying page numbers..."
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5927
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5928
    titleFont isNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5929
	titleFont := Font family:'helvetica' face:'medium' style:'roman' size:10.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5930
	titleFont := titleFont onDevice:(self device).
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5931
    ].
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5932
    ^ titleFont
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5933
!
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5934
2357
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5935
titleFont:aFont
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5936
    "set the font used for displaying page numbers..."
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5937
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5938
    (aFont notNil and:[aFont ~= titleFont]) ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5939
	titleFont := aFont onDevice:(self device).
2357
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5940
    ].
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5941
!
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5942
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5943
widthOf:aString from:index1 to:index2 inFont:aFontId
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5944
    "after retrieving the width, we have to scale the width"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5945
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5946
    |w|
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5947
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5948
    w := super widthOf:aString from:index1 to:index2 inFont:aFontId.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5949
    w := (w / fontScale x) rounded.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5950
    ^ w
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5951
! !
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5952
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5953
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'initialization & release'!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5954
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5955
close
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5956
    "compatible with PSGraphicsContext"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5957
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5958
    self endPrintJob.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5959
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5960
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5961
initExtent
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5962
    "scale the extent"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5963
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5964
    fontScale := self resolution / Screen current resolution.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5965
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5966
    width  := (self printerWidthArea / fontScale x) rounded.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5967
    width  := width - self leftMargin - self rightMargin.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5968
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5969
    height := (self printerHeightArea / fontScale y) rounded.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5970
    height := height - self topMargin - self bottomMargin.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5971
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5972
    self initTransformation.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5973
!
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5974
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5975
initTransformation
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5976
    |margin|
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5977
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5978
    transformation isNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5979
	margin := Point x:(self leftMargin) y:(self topMargin).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5980
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5981
	transformation := WindowingTransformation scale:fontScale
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5982
					    translation:(margin * fontScale).
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5983
    ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5984
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5985
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5986
initialize
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5987
    super initialize.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5988
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5989
    pageCounter    := 0.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5990
    needsEndOfPage := false.
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5991
    printPageNumbers := true.
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5992
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5993
    Language == #de ifTrue:[ pageNumberFormat := 'Seite %1' ]
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5994
		   ifFalse:[ pageNumberFormat := 'page %1'  ].
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5995
! !
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5996
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5997
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'printing process'!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5998
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5999
displayTitleDo:aNoneArgAction
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  6000
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6001
    |oldClip oldTrans oldFont|
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6002
2357
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  6003
    oldClip := clipRect.
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  6004
    oldClip notNil ifTrue:[ self deviceClippingRectangle:nil ].
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  6005
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6006
    oldTrans := self translation.
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6007
    oldFont  := font.
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6008
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6009
    self  font:(self titleFont).
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6010
    self  translation:0.
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6011
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6012
    aNoneArgAction value.
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6013
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6014
    self translation:oldTrans.
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6015
    oldFont notNil ifTrue:[ self font:oldFont ].
2357
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  6016
    oldClip notNil ifTrue:[ self deviceClippingRectangle:oldClip ].
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6017
!
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6018
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6019
endPage
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6020
    "ends the current page
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6021
     if the current page is already closed by endPage, the request will be ignored"
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6022
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6023
    |s|
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6024
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6025
    needsEndOfPage ifFalse:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  6026
	^ self
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6027
    ].
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6028
    needsEndOfPage := false.
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6029
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6030
    printPageNumbers == true ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  6031
	self displayTitleDo:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  6032
	    s := pageNumberFormat bindWith:pageCounter.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  6033
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  6034
	    self displayString:s
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  6035
			     x:(self extent x - (font widthOf:s))
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  6036
			     y:(self extent y + (font ascent)).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  6037
	]
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6038
    ].
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6039
    super endPage.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6040
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6041
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6042
startPage
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6043
    "starts a new page
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6044
     if the current page is not closed by endPage, a endPage is forward to the device"
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6045
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6046
    needsEndOfPage ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  6047
	self endPage.
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6048
    ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6049
    super startPage.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6050
    needsEndOfPage := true.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6051
    pageCounter := pageCounter + 1.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6052
! !
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6053
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6054
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'queries'!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6055
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6056
pixelPerInch
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6057
    ^ Point x:(self pixelsPerInchOfScreenWidth)
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  6058
	    y:(self pixelsPerInchOfScreenHeight).
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6059
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6060
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6061
resolution
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6062
    ^ self pixelPerInch
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6063
! !
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6064
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  6065
!WinPrinterContext class methodsFor:'documentation'!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  6066
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  6067
version
3190
437b1425507e class: WinPrinterContext
Michael Beyl <mb@exept.de>
parents: 3041
diff changeset
  6068
    ^ '$Header: /cvs/stx/stx/libview2/WinPrinterContext.st,v 1.44 2013-07-04 10:57:17 mb Exp $'
2818
37b97e4ebb01 Use __isArrayLike() and __isByteArrayLike()
Stefan Vogel <sv@exept.de>
parents: 2621
diff changeset
  6069
!
37b97e4ebb01 Use __isArrayLike() and __isByteArrayLike()
Stefan Vogel <sv@exept.de>
parents: 2621
diff changeset
  6070
37b97e4ebb01 Use __isArrayLike() and __isByteArrayLike()
Stefan Vogel <sv@exept.de>
parents: 2621
diff changeset
  6071
version_CVS
3190
437b1425507e class: WinPrinterContext
Michael Beyl <mb@exept.de>
parents: 3041
diff changeset
  6072
    ^ '$Header: /cvs/stx/stx/libview2/WinPrinterContext.st,v 1.44 2013-07-04 10:57:17 mb Exp $'
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  6073
! !
3190
437b1425507e class: WinPrinterContext
Michael Beyl <mb@exept.de>
parents: 3041
diff changeset
  6074