WinPrinterContext.st
author Claus Gittinger <cg@exept.de>
Sat, 12 May 2018 14:23:45 +0200
changeset 4088 bbf9b58f99c8
parent 3814 668e317f6672
child 3818 6219e6bc162a
child 4430 2e53d960bb78
permissions -rw-r--r--
#FEATURE by cg class: MIMETypes class changed: #initializeFileInfoMappings class: MIMETypes::MIMEType added: #asMimeType #isCHeaderType #isCPPSourceType #isCSourceType
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
3526
8dea8945255b #FEATURE
Stefan Vogel <sv@exept.de>
parents: 3190
diff changeset
    14
"{ NameSpace: Smalltalk }"
8dea8945255b #FEATURE
Stefan Vogel <sv@exept.de>
parents: 3190
diff changeset
    15
2301
135f21a3d127 refactorred OS-independent stuff
Claus Gittinger <cg@exept.de>
parents: 2299
diff changeset
    16
PrinterContext subclass:#WinPrinterContext
3719
a36b0c184dcb #UI_ENHANCEMENT by stefan
Stefan Vogel <sv@exept.de>
parents: 3709
diff changeset
    17
	instanceVariableNames:'deviceFonts hatch supportsColor title'
2348
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
    18
	classVariableNames:'PostScriptBlackWhite'
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
    19
	poolDictionaries:''
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
    20
	category:'Interface-Printing'
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
    23
WinPrinterContext subclass:#WinPrinterGraphicContext
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
    24
	instanceVariableNames:'fontScale printPageNumbers pageNumberFormat pageCounter
3709
ae76cdc6787a Delegate GraphicsContext objects
Stefan Vogel <sv@exept.de>
parents: 3526
diff changeset
    25
		needsEndOfPage titleFont width height'
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
    26
	classVariableNames:''
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
    27
	poolDictionaries:''
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
    28
	privateIn:WinPrinterContext
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
    29
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
    30
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    31
!WinPrinterContext primitiveDefinitions!
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    32
%{
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    33
#undef INT
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    34
#define INT WIN_INT
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    35
#undef Array
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    36
#define Array WIN_Array
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    37
#undef Number
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    38
#define Number WIN_Number
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    39
#undef Method
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    40
#define Method WIN_Method
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    41
#undef Point
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    42
#define Point WIN_Point
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    43
#undef Rectangle
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    44
/* #define Rectangle WIN_Rectangle */
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    45
#undef True
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    46
#define True WIN_True
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    47
#undef False
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    48
#define False WIN_False
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    49
#undef Block
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    50
#define Block WIN_Block
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    51
#undef Context
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    52
#define Context WIN_Context
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    53
#undef Date
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    54
#define Date WIN_Date
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    55
#undef Time
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    56
#define Time WIN_Time
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    57
#undef Delay
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    58
#define Delay WIN_Delay
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    59
#undef Signal
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    60
#define Signal WIN_Signal
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    61
#undef Set
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    62
#define Set WIN_Set
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    63
#undef Process
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    64
#define Process WIN_Process
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    65
#undef Processor
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    66
#define Processor WIN_Processor
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    67
#undef Message
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    68
#define Message WIN_Message
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
    69
#undef String
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
    70
#define String WIN_String
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
    71
#undef Character
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
    72
#define Character WIN_Character
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    73
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    74
#include <stdio.h>
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    75
#include <errno.h>
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    76
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    77
#ifdef __BORLANDC__
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    78
# define NOATOM
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    79
# define NOGDICAPMASKS
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    80
# define NOMETAFILE
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    81
# define NOMINMAX
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    82
# define NOOPENFILE
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    83
# define NOSOUND
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    84
# define NOWH
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    85
# define NOCOMM
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    86
# define NOKANJI
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    87
# define NOCRYPT
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    88
# define NOMCX
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    89
# define WIN32_LEAN_AND_MEAN
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    90
# include <windows.h>
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    91
# include <shellapi.h>
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    92
# include <sys\timeb.h>
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    93
# include <dir.h>
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    94
#else
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    95
# define _USERENTRY /**/
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    96
# define NOATOM
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    97
# define NOGDICAPMASKS
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    98
# define NOMETAFILE
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
    99
# define NOMINMAX
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   100
# define NOOPENFILE
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   101
# define NOSOUND
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   102
# define NOWH
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   103
# define NOCOMM
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   104
# define NOKANJI
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   105
# define NOCRYPT
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   106
# define NOMCX
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   107
# define WIN32_LEAN_AND_MEAN
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   108
# include <windows.h>
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   109
# include <sys\timeb.h>
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   110
#endif
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
#include <process.h>
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   113
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   114
#ifdef __DEF_Array
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   115
# undef Array
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   116
# define Array __DEF_Array
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   117
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   118
#ifdef __DEF_Number
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   119
# undef Number
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   120
# define Number __DEF_Number
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   121
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   122
#ifdef __DEF_Method
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   123
# undef Method
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   124
# define Method __DEF_Method
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   125
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   126
#ifdef __DEF_Point
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   127
# undef Point
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   128
# define Point __DEF_Point
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   129
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   130
#ifdef __DEF_Rectangle
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   131
# undef Rectangle
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   132
# define Rectangle __DEF_Rectangle
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   133
#else
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   134
# undef Rectangle
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   135
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   136
#ifdef __DEF_Block
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   137
# undef Block
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   138
# define Block __DEF_Block
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   139
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   140
#ifdef __DEF_Context
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   141
# undef Context
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   142
# define Context __DEF_Context
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   143
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   144
#ifdef __DEF_Date
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   145
# undef Date
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   146
# define Date __DEF_Date
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   147
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   148
#ifdef __DEF_Time
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   149
# undef Time
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   150
# define Time __DEF_Time
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   151
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   152
# ifdef __DEF_Set
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   153
#  undef Set
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   154
#  define Set __DEF_Set
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   155
# endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   156
# ifdef __DEF_Signal
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   157
#  undef Signal
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   158
#  define Signal __DEF_Signal
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   159
# endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   160
# ifdef __DEF_Delay
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   161
#  undef Delay
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   162
#  define Delay __DEF_Delay
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   163
# endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   164
# ifdef __DEF_Process
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   165
#  undef Process
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   166
#  define Process __DEF_Process
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   167
# endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   168
# ifdef __DEF_Processor
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   169
#  undef Processor
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   170
#  define Processor __DEF_Processor
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   171
# endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   172
# ifdef __DEF_Message
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   173
#  undef Message
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   174
#  define Message __DEF_Message
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   175
# endif
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   176
# ifdef __DEF_String
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   177
#  undef String
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   178
#  define String __DEF_String
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   179
# endif
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   180
# ifdef __DEF_Character
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   181
#  undef Character
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   182
#  define Character __DEF_Character
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   183
# endif
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   184
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   185
#undef INT
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   186
#define INT STX_INT
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   187
#undef UINT
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   188
#define UINT STX_UINT
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   189
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
 * some defines - tired of typing ...
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   192
 */
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   193
#define _HANDLEVal(o)        (HANDLE)(__MKCP(o))
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   194
#define _HBITMAPVAL(o)       (HBITMAP)(__MKCP(o))
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   195
#define _HWNDVal(o)          (HWND)(__MKCP(o))
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   196
#define _HPALETTEVal(o)      (HPALETTE)(__MKCP(o))
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   197
#define _HCURSORVal(o)       (HCURSOR)(__MKCP(o))
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   198
#define _HGDIOBJVal(o)       (HGDIOBJ)(__MKCP(o))
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   199
#define _LOGPALETTEVal(o)    (LOGPALETTE *)(__MKCP(o))
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   200
#define _COLORREFVal(o)      (COLORREF)(__MKCP(o))
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 WIDECHAR unsigned short
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
#define WIN32PADDING 32
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   205
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   206
#ifdef DEBUG
2325
634b74929d2d *** empty log message ***
fm
parents: 2324
diff changeset
   207
# define DPRINTF(x)              /* printf  x */
634b74929d2d *** empty log message ***
fm
parents: 2324
diff changeset
   208
# define DFPRINTF(x)             /* fprintf x */
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   209
#else
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   210
# define DPRINTF(x)              /* */
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   211
# define DFPRINTF(x)             /* */
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   212
#endif
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   213
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   214
typedef int (*intf)(int);
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   215
typedef INT (*INTF)(INT);
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   216
%}
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   217
! !
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   218
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   219
!WinPrinterContext class methodsFor:'documentation'!
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
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   222
"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   223
 COPYRIGHT (c) 2006 by eXept Software AG
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   224
	      All Rights Reserved
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   225
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   226
 This software is furnished under a license and may be used
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   227
 only in accordance with the terms of that license and with the
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   228
 inclusion of the above copyright notice.   This software may not
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   229
 be provided or otherwise made available to, or used by, any
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   230
 other person.  No title to or ownership of the software is
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   231
 hereby transferred.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   232
"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   233
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   234
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   235
documentation
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   236
"
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   237
    I am the mediator between the smalltalk printing protocol
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   238
    (which is the same as the graphics drawing protocol) and the
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   239
    windows printer.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   240
    When you open a printer, you will typically talk to me.
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   241
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   242
    [author:]
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   243
	Felix Madrid (fm@exept.de)
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   244
"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   245
! !
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   246
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   247
!WinPrinterContext class methodsFor:'instance creation'!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   248
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   249
fromPrinterInfo: aPrinterInfo
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   250
    | printerContext printerDevice hDC|
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   251
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   252
    hDC := aPrinterInfo createDC.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   253
    hDC = 0 ifTrue: [ ^self error: 'Error while opening printer.' ].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   254
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   255
    printerContext := self new.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   256
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   257
    printerDevice := printerContext.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   258
"/    printerDevice := WinPrinter on: aPrinterInfo.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   259
"/    printerDevice printerDC:hDC.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   260
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   261
    printerContext printerInfo: aPrinterInfo.
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   262
    printerContext setDevice:printerDevice id:nil gcId:hDC.
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   263
    printerContext initExtent.
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   264
    ^printerContext
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   265
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   266
    "Created: / 03-08-2006 / 12:53:52 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   267
    "Modified: / 04-08-2006 / 12:55:01 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   268
    "Modified: / 16-04-2007 / 12:36:26 / cg"
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   269
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   270
2446
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   271
newPrinter
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   272
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   273
    | printer printerInfo|
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   274
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   275
    printerInfo := PrintingDialog getPrinterInfo.
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   276
    printerInfo isNil ifTrue:[^self].
3526
8dea8945255b #FEATURE
Stefan Vogel <sv@exept.de>
parents: 3190
diff changeset
   277
    printer := self fromPrinterInfo: printerInfo.
2446
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   278
    ^ printer
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   279
!
c04a44b89cf2 changed #newPrinter
fm
parents: 2399
diff changeset
   280
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   281
openGraphicContext
2621
8eac3ee0603d *** empty log message ***
sr
parents: 2603
diff changeset
   282
    ^ self openGraphicContextWithoutDialog:false
8eac3ee0603d *** empty log message ***
sr
parents: 2603
diff changeset
   283
!
8eac3ee0603d *** empty log message ***
sr
parents: 2603
diff changeset
   284
8eac3ee0603d *** empty log message ***
sr
parents: 2603
diff changeset
   285
openGraphicContextWithoutDialog:withoutDialog
3526
8dea8945255b #FEATURE
Stefan Vogel <sv@exept.de>
parents: 3190
diff changeset
   286
    ^ self openGraphicContextWithoutDialog:withoutDialog jobName:nil
8dea8945255b #FEATURE
Stefan Vogel <sv@exept.de>
parents: 3190
diff changeset
   287
!
8dea8945255b #FEATURE
Stefan Vogel <sv@exept.de>
parents: 3190
diff changeset
   288
8dea8945255b #FEATURE
Stefan Vogel <sv@exept.de>
parents: 3190
diff changeset
   289
openGraphicContextWithoutDialog:withoutDialog jobName:jobName
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   290
    |printerInfo gc|
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   291
2621
8eac3ee0603d *** empty log message ***
sr
parents: 2603
diff changeset
   292
    printerInfo := PrintingDialog getPrinterInfoWithoutDialog:withoutDialog.
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   293
    printerInfo isNil ifTrue:[^ nil].
2352
b9196fb35b8a bugfix - name of class
ca
parents: 2351
diff changeset
   294
    gc := WinPrinterGraphicContext fromPrinterInfo:printerInfo.
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   295
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   296
    gc notNil ifTrue:[
3709
ae76cdc6787a Delegate GraphicsContext objects
Stefan Vogel <sv@exept.de>
parents: 3526
diff changeset
   297
	gc startPrintJob:jobName
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   298
    ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
   299
    ^ gc
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   300
! !
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   301
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   302
!WinPrinterContext class methodsFor:'accessing'!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   303
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   304
getPrinterInformation:printerNameString
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   305
    " 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
   306
      answer the information for the default printer."
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   307
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   308
    |h|
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   309
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   310
    h := OperatingSystem openPrinter:printerNameString.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   311
    ^ OperatingSystem
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   312
	getDocumentProperties:nil
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   313
	hPrinter:h
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   314
	pDeviceName:printerNameString.
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   315
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   316
    "Created: / 27-07-2006 / 10:22:32 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   317
    "Modified: / 01-08-2006 / 16:01:44 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   318
    "Modified: / 10-10-2006 / 18:57:45 / cg"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   319
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   320
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   321
getPrinterInformationString: printerNameString
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   322
	" 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
   323
	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
   324
	answer the information for the default printer. "
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   325
    | printerInfo result |
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   326
    printerInfo := ( String new: 80 ).
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   327
    result := OperatingSystem primGetProfileString: 'windows'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   328
	keyName:  'device'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   329
	default: ( printerNameString isNil ifTrue: [ '' ] ifFalse: [ printerNameString ] )
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   330
	returnedString: printerInfo
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   331
	size: printerInfo size.
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   332
    ^result > 0
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   333
	ifTrue: [printerInfo copyFrom: 1 to: result]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   334
	ifFalse: ['']
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   335
!
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   336
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   337
named: aName
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   338
    "Answer a new instance of Printer which represents
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   339
     the printer named aName as specified in the host
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   340
     Control Panel."
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   341
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   342
    aName isNil ifTrue: [ ^self default ].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   343
    ^self new printerInfoWithName: aName
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   344
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   345
    "Created: / 27-07-2006 / 17:51:27 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   346
    "Modified: / 02-08-2006 / 17:26:29 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   347
    "Modified: / 10-10-2006 / 17:33:29 / cg"
2348
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
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   351
    "Returns true if the postscript is b&w or returns false if the postscript is color"
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   352
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   353
    ^ PostScriptBlackWhite ? false
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   354
!
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   355
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   356
postScriptBlackWhite: aBoolean
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   357
ab36aad361f6 supportsColor
fm
parents: 2347
diff changeset
   358
    PostScriptBlackWhite := aBoolean
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   359
! !
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   360
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   361
!WinPrinterContext class methodsFor:'not supported yet'!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   362
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   363
printAdvancedLines: pairOfPointsArray
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   364
    "Opens a print dialog and prints the given lines"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   365
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   366
    | printerInfo printer |
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   367
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   368
    printerInfo := PrintingDialog getPrinterInfo.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   369
    printerInfo isNil ifTrue:[^self].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   370
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   371
    printer := self fromPrinterInfo: printerInfo.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   372
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   373
	printer startPrintJob: 'Advanced Lines'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   374
	printer foreground:Color red background:Color white.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   375
	pairOfPointsArray
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   376
	    do:[:pairOfPointsAndContext |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   377
		 |pairOfPoints|
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   378
		 pairOfPoints := pairOfPointsAndContext at:1.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   379
		 printer
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   380
		    lineWidth: (pairOfPointsAndContext at:2);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   381
		    lineStyle: (pairOfPointsAndContext at:3);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   382
		    capStyle: (pairOfPointsAndContext at:4);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   383
		    joinStyle: (pairOfPointsAndContext at:5);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   384
		    foreground: (pairOfPointsAndContext at:6);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   385
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   386
		    displayAdvanceLineFrom: (pairOfPoints at:1)  to: (pairOfPoints at:2).
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   387
	    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   388
	printer endPrintJob.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   389
    ] forkAt: 3
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   390
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   391
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   392
     WinPrinterContext printAdvancedLines:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   393
	(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
   394
	       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
   395
	       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
   396
	       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
   397
	)
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   398
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   399
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   400
    "Created: / 07-08-2006 / 12:09:48 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   401
    "Modified: / 07-08-2006 / 14:11:17 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   402
    "Modified: / 16-04-2007 / 15:37:41 / cg"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   403
! !
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   404
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   405
!WinPrinterContext class methodsFor:'testing'!
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   406
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   407
computeScaleForPrinter:aPrinter
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   408
    ^ Point x:(aPrinter pixelsPerInchOfScreenWidth / Screen current horizontalPixelPerInch)
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   409
	    y:(aPrinter pixelsPerInchOfScreenHeight / Screen current verticalPixelPerInch)
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   410
!
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   411
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   412
testPrintingDo:anOneArgBlock
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   413
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   414
    "Opens a print dialog and invokes the action with the printer"
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   415
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   416
    | printerInfo printer |
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   417
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   418
    printerInfo := PrintingDialog getPrinterInfo.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   419
    printerInfo isNil ifTrue:[^self].
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   420
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   421
    printer := self fromPrinterInfo: printerInfo.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   422
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   423
    printer startPrintJob: 'Testing'.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   424
    anOneArgBlock value:printer.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   425
    printer endPrintJob.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   426
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   427
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   428
"
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   429
self testPrintingDo:[:aPrinter| |icon|
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   430
    aPrinter scale:(self computeScaleForPrinter:aPrinter).
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   431
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   432
    aPrinter displayLineFrom:10@10   to:100@10.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   433
    aPrinter displayLineFrom:100@10  to:100@100.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   434
    aPrinter displayLineFrom:100@100 to:10@100.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   435
    aPrinter displayLineFrom:10@100  to:10@10.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   436
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   437
    icon := XPToolbarIconLibrary eraseXP28x28Icon.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   438
    icon displayOn:aPrinter x:10 y:10.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   439
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   440
].
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   441
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   442
self testPrintingDo:[:aPrinter| |scale|
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   443
    scale := self computeScaleForPrinter:aPrinter.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   444
    aPrinter scale:(1 * scale).
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   445
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   446
    aPrinter  font:(Font family:'Arial' face:'medium' size:8).
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   447
    aPrinter displayLineFrom:8@16 to:100@16.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   448
    aPrinter displayLineFrom:8@16 to:8@128.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   449
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   450
    'hallo' displayOn:aPrinter x:8 y:16.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   451
    aPrinter scale:(2 * scale).
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   452
    'hallo' displayOn:aPrinter x:4 y:32.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   453
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   454
    aPrinter scale:(4 * scale).
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   455
    'hallo' displayOn:aPrinter x:2 y:32.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   456
].
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   457
"
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   458
! !
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
   459
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   460
!WinPrinterContext class methodsFor:'testing & examples'!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   461
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   462
fillCircles: arrayOfPointsAndRadiusWithContextArray
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   463
    "Opens a print dialog and prints the given circles"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   464
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   465
    | printerInfo printer |
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   466
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   467
    printerInfo := PrintingDialog getPrinterInfo.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   468
    printerInfo isNil ifTrue:[^self].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   469
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   470
    printer := self fromPrinterInfo: printerInfo.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   471
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   472
	printer startPrintJob: 'Fill Circles'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   473
	arrayOfPointsAndRadiusWithContextArray
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   474
	    do:[:pointsAndRadiusWithContextArray |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   475
		printer foreground:(pointsAndRadiusWithContextArray at:3).
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   476
		printer fillCircle:(pointsAndRadiusWithContextArray at:1)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   477
			radius:(pointsAndRadiusWithContextArray at:2).
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   478
	    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   479
	printer endPrintJob.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   480
    ] forkAt: 3
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
     WinPrinterContext fillCircles:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   484
	(Array with: (Array with: 800@800 with: 600 with:Color red)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   485
	       with: (Array with: 1500@1500 with: 1000 with:Color blue)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   486
	       with: (Array with: 4000@2500 with: 2000 with:Color gray))
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   487
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   488
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   489
    "Created: / 07-08-2006 / 11:46:52 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   490
    "Modified: / 16-04-2007 / 15:37:34 / cg"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   491
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   492
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   493
fillHatchCircles: arrayOfPointsAndRadiusWithContextArray
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   494
    "Opens a print dialog and prints the given circles"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   495
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   496
    | printerInfo printer |
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   497
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   498
    printerInfo := PrintingDialog getPrinterInfo.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   499
    printerInfo isNil ifTrue:[^self].
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   500
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   501
    printer := self fromPrinterInfo: printerInfo.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   502
    [
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   503
	printer startPrintJob: 'Fill Hatch Circles'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   504
	arrayOfPointsAndRadiusWithContextArray
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   505
	    do:[:pointsAndRadiusWithContextArray |
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   506
		| point radius color hatch|
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   507
		point := (pointsAndRadiusWithContextArray at:1).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   508
		radius := (pointsAndRadiusWithContextArray at:2).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   509
		color := (pointsAndRadiusWithContextArray at:3).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   510
		hatch := (pointsAndRadiusWithContextArray at:4).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   511
		printer foreground: color;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   512
			hatch: hatch.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   513
		printer fillCircle:point
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   514
			radius:radius.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   515
	    ].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   516
	printer endPrintJob.
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   517
    ] forkAt: 3
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
     WinPrinterContext fillHatchCircles:
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   521
	(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
   522
	       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
   523
	       with: (Array with: 4000@2500 with: 2000 with:Color gray with: #bDiagonal))
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   524
    "
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   525
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   526
    "Created: / 07-08-2006 / 11:46:52 / fm"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   527
    "Modified: / 16-04-2007 / 15:37:34 / cg"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   528
!
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   529
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   530
fillHatchPolygons: polygonsWithContextArray
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   531
    "Opens a print dialog and prints the given polygons"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   532
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   533
    | printerInfo printer |
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   534
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   535
    printerInfo := PrintingDialog getPrinterInfo.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   536
    printerInfo isNil ifTrue:[^self].
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   537
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   538
    printer := self fromPrinterInfo: printerInfo.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   539
    [
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   540
	printer startPrintJob: 'Fill Hatch Polygons'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   541
	polygonsWithContextArray
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   542
	    do:[:polygonWithContextArray |
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   543
		 |aPolygon color hatch|
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   544
		 aPolygon := polygonWithContextArray at: 1.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   545
		 color := (polygonWithContextArray at: 2).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   546
		 hatch := (polygonWithContextArray at: 3).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   547
		 printer foreground: color;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   548
			 hatch: hatch.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   549
		 aPolygon displayFilledOn: printer.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   550
	    ].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   551
	printer endPrintJob.
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   552
    ] forkAt: 3
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   553
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   554
    "
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   555
     WinPrinterContext fillHatchPolygons:
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   556
	(Array with: (Array with: (Polygon vertices:(
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   557
				Array
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   558
				    with:100@100
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   559
				    with:600@1000
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   560
				    with:3500@4000
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   561
				    with:100@4000
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   562
				    with:100@100))
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   563
			    with: Color red
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   564
			    with: #cross)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   565
		with: (Array with: (Polygon vertices:(
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   566
				Array
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   567
				    with:1000@1000
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   568
				    with:1000@2000
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   569
				    with:2000@1000))
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   570
			     with: Color blue
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   571
			     with: #none)
2330
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
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   575
    "Created: / 07-08-2006 / 12:09:48 / fm"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   576
    "Modified: / 07-08-2006 / 14:11:17 / fm"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   577
    "Modified: / 16-04-2007 / 15:37:43 / cg"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   578
!
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   579
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   580
fillHatchRectangles: rectanglesWithHatch
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   581
    "Opens a print dialog and prints the given rectangles"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   582
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   583
    | printerInfo printer |
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   584
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   585
    printerInfo := PrintingDialog getPrinterInfo.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   586
    printerInfo isNil ifTrue:[^self].
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   587
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   588
    printer := self fromPrinterInfo: printerInfo.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   589
    [
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   590
	printer startPrintJob: 'Fill Hatch Rectangles'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   591
	printer foreground:Color blue background:Color white.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   592
	rectanglesWithHatch
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   593
	    do:[:rectangleWithHatch |
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   594
		|rectangle hatch|
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   595
		rectangle := rectangleWithHatch at: 1.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   596
		hatch := rectangleWithHatch at: 2.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   597
		printer hatch: hatch.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   598
		printer fillRectangleX: rectangle origin x
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   599
			y: rectangle origin y
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   600
			width: rectangle width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   601
			height: rectangle height.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   602
	    ].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   603
	printer endPrintJob.
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   604
    ] forkAt: 3
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   605
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   606
    "
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   607
     WinPrinterContext fillHatchRectangles:
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   608
	(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
   609
	       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
   610
	       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
   611
	       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
   612
	)
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   613
    "
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   614
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   615
    "Created: / 07-08-2006 / 11:40:48 / fm"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   616
    "Modified: / 16-04-2007 / 15:37:46 / cg"
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   617
!
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
   618
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   619
fillPolygons: polygonsWithContextArray
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   620
    "Opens a print dialog and prints the given polygons"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   621
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   622
    | printerInfo printer |
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   623
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   624
    printerInfo := PrintingDialog getPrinterInfo.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   625
    printerInfo isNil ifTrue:[^self].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   626
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   627
    printer := self fromPrinterInfo: printerInfo.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   628
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   629
	printer startPrintJob: 'Fill Polygons'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   630
	polygonsWithContextArray
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   631
	    do:[:polygonWithContextArray |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   632
		 |aPolygon|
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   633
		 aPolygon := polygonWithContextArray at: 1.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   634
		 printer foreground:(polygonWithContextArray at: 2).
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   635
		 aPolygon displayFilledOn: printer.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   636
	    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   637
	printer endPrintJob.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   638
    ] forkAt: 3
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   639
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   640
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   641
     WinPrinterContext fillPolygons:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   642
	(Array with: (Array with: (Polygon vertices:(
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   643
				Array
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   644
				    with:100@100
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   645
				    with:600@1000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   646
				    with:3500@4000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   647
				    with:100@4000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   648
				    with:100@100))
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   649
			    with: Color red)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   650
		with: (Array with: (Polygon vertices:(
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   651
				Array
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   652
				    with:1000@1000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   653
				    with:1000@2000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   654
				    with:2000@1000))
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   655
			     with: Color blue)
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   656
    )
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   657
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   658
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   659
    "Created: / 07-08-2006 / 12:09:48 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   660
    "Modified: / 07-08-2006 / 14:11:17 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   661
    "Modified: / 16-04-2007 / 15:37:43 / cg"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   662
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   663
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   664
fillRectangles: rectangles
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   665
    "Opens a print dialog and prints the given rectangles"
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   666
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   667
    | printerInfo printer |
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   668
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   669
    printerInfo := PrintingDialog getPrinterInfo.
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   670
    printerInfo isNil ifTrue:[^self].
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   671
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   672
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   673
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   674
	printer startPrintJob: 'Fill Rectangles'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   675
	printer foreground:Color blue background:Color white.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   676
	rectangles
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   677
	    do:[:rectangle |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   678
		printer fillRectangleX: rectangle origin x
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   679
			y: rectangle origin y
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   680
			width: rectangle width
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   681
			height: rectangle height.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   682
	    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   683
	printer endPrintJob.
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   684
    ] forkAt: 3
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   685
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   686
    "
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   687
     WinPrinterContext fillRectangles:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   688
	(Array with: (Rectangle left:20 top:20 width:400 height:600)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   689
	       with: (Rectangle left:500 top:700 width:600 height:400)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   690
	       with: (Rectangle left:800 top:1000 width:1600 height:2000)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   691
	       with: (Rectangle left:1040 top:1240 width:3000 height:3000)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   692
	)
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   693
    "
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   694
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   695
    "Created: / 07-08-2006 / 11:40:48 / fm"
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   696
    "Modified: / 16-04-2007 / 15:37:46 / cg"
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   697
!
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   698
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   699
print: aString font: aFont title: aTitle
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   700
    "Open a print dialog to allow printing of the given string
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   701
     using the given title & font."
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   702
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   703
    self print: aString font: aFont title: aTitle wordWrap: false
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   704
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   705
   "
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
   706
    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
   707
    WinPrinterContext print: (WinPrinterContext class sourceCodeAt:#'print:font:title:wordWrap:') font: nil title: 'Printing Test String'
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
   708
    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
   709
   "
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   710
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   711
    "Created: / 27-07-2006 / 17:52:33 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   712
    "Modified: / 03-08-2006 / 18:52:31 / fm"
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
   713
    "Modified: / 16-04-2007 / 13:54:40 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   714
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   715
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   716
print: aString font: aFont title: aTitle wordWrap: wordWrap
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   717
    "Open a print dialog to allow printing of the given string
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   718
     using the given title & font."
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   719
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   720
    | printerInfo printer |
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   721
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   722
    printerInfo := PrintingDialog getPrinterInfo.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   723
    printerInfo isNil ifTrue:[^self].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   724
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   725
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   726
    [
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   727
	printer
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   728
	    print: aString
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   729
	    font: aFont
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   730
	    title: aTitle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   731
	    wordWrap: wordWrap
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   732
	    marginsRect: nil
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   733
    ] forkAt: 3
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   734
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   735
    "
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
   736
     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
   737
     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
   738
     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
   739
    "
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   740
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   741
    "Created: / 03-08-2006 / 18:51:53 / fm"
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
   742
    "Modified: / 16-04-2007 / 15:37:31 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   743
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   744
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   745
printCircles: arrayOfPointsAndRadius
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   746
    "Opens a print dialog and prints the given circles"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   747
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   748
    | printerInfo printer |
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   749
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   750
    printerInfo := PrintingDialog getPrinterInfo.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   751
    printerInfo isNil ifTrue:[^self].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   752
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   753
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   754
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   755
	printer startPrintJob: 'Circles'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   756
	printer foreground:Color green background:Color white.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   757
	arrayOfPointsAndRadius
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   758
	    do:[:pointAndRadius |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   759
		printer displayCircle:(pointAndRadius at:1)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   760
			radius:(pointAndRadius at:2).
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   761
	    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   762
	printer endPrintJob.
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   763
    ] forkAt: 3
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   764
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   765
    "
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   766
     WinPrinterContext printCircles:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   767
	(Array with: (Array with: 800@800 with: 600)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   768
	       with: (Array with: 1500@1500 with: 1000)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   769
	       with: (Array with: 4000@2500 with: 2000))
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   770
    "
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   771
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   772
    "Created: / 07-08-2006 / 11:46:52 / fm"
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
   773
    "Modified: / 16-04-2007 / 15:37:34 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   774
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   775
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   776
printCirclesIn: rectangles
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   777
    "Opens a print dialog and prints the given circles"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   778
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   779
    | printerInfo printer |
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   780
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   781
    printerInfo := PrintingDialog getPrinterInfo.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   782
    printerInfo isNil ifTrue:[^self].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   783
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   784
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   785
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   786
	printer startPrintJob: 'Circles In Rectangles'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   787
	rectangles
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   788
	   do:[:rectangle |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   789
	       printer displayCircleIn: rectangle.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   790
	   ].
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   791
       printer endPrintJob.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   792
    ] forkAt: 3
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   793
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   794
    "
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   795
     WinPrinterContext printCirclesIn:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   796
	(Array with: (Rectangle left:20 top:20 width:400 height:600)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   797
	       with: (Rectangle left:40 top:40 width:600 height:400)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   798
	)
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   799
    "
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   800
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   801
    "Created: / 07-08-2006 / 11:48:46 / fm"
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
   802
    "Modified: / 16-04-2007 / 15:37:38 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   803
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   804
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   805
printImage: anImage
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   806
    "Opens a print dialog and prints the given image"
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   807
2384
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   808
    self printImage: anImage magnification:1.
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   809
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
     WinPrinterContext printImage: (Image fromFile:'C:\vsw311\pavheadr.gif').
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   812
     WinPrinterContext printImage: XPToolbarIconLibrary help32x32Icon.
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   813
     WinPrinterContext printImage: XPToolbarIconLibrary eraseXP28x28Icon.
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   814
     WinPrinterContext printImage: XPToolbarIconLibrary saveImageBlack22x22Icon.
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   815
     WinPrinterContext printImage: XPToolbarIconLibrary changesBrowser18x22Icon.
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   816
    "
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   817
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   818
    "Created: / 07-08-2006 / 11:46:52 / fm"
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   819
    "Modified: / 16-04-2007 / 15:37:34 / cg"
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   820
!
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   821
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   822
printImage:anImage magnification:factor
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   823
    "Opens a print dialog and prints the given image"
1c53fc6edb39 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2357
diff changeset
   824
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   825
    | printerInfo printer |
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   826
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   827
    printerInfo := PrintingDialog getPrinterInfo.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   828
    printerInfo isNil ifTrue:[^self].
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   829
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   830
    printer := self fromPrinterInfo: printerInfo.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   831
    [
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   832
	printer startPrintJob: 'Image'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   833
	printer background:Color white.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   834
	(anImage magnifiedBy:factor) displayOn:printer x:0 y:0.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
   835
	printer endPrintJob.
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   836
    ] forkAt: 3
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   837
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   838
    "
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   839
     WinPrinterContext printImage: (Image fromFile:'C:\vsw311\pavheadr.gif').
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   840
     WinPrinterContext printImage: XPToolbarIconLibrary help32x32Icon.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   841
     WinPrinterContext printImage: XPToolbarIconLibrary eraseXP28x28Icon.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   842
     WinPrinterContext printImage: XPToolbarIconLibrary saveImageBlack22x22Icon.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   843
     WinPrinterContext printImage: XPToolbarIconLibrary changesBrowser18x22Icon.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   844
    "
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   845
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   846
    "Created: / 07-08-2006 / 11:46:52 / fm"
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   847
    "Modified: / 16-04-2007 / 15:37:34 / cg"
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   848
!
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
   849
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   850
printLines: pairOfPointsWithContextArray
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   851
    "Opens a print dialog and prints the given lines"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   852
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   853
    | printerInfo printer |
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   854
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   855
    printerInfo := PrintingDialog getPrinterInfo.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   856
    printerInfo isNil ifTrue:[^self].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   857
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   858
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   859
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   860
	printer startPrintJob: 'Lines'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   861
	pairOfPointsWithContextArray
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   862
	    do:[:pairOfPointsAndContext |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   863
		 |pairOfPoints|
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   864
		 pairOfPoints := pairOfPointsAndContext at: 1.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   865
		 printer
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   866
		    foreground:(pairOfPointsAndContext at:2);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   867
		    lineWidth: (pairOfPointsAndContext at:3);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   868
		    lineStyle: (pairOfPointsAndContext at:4);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   869
		    displayLineFrom: (pairOfPoints at:1)  to: (pairOfPoints at:2).
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   870
	    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   871
	printer endPrintJob.
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   872
    ] forkAt: 3
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   873
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   874
    "
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   875
     WinPrinterContext printLines:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   876
	(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
   877
	       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
   878
	       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
   879
	       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
   880
    "
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   881
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   882
    "Created: / 07-08-2006 / 12:09:48 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   883
    "Modified: / 07-08-2006 / 14:11:17 / fm"
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
   884
    "Modified: / 16-04-2007 / 15:37:41 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   885
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   886
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   887
printPoints: aCollectionOfPoints
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   888
    "Opens a print dialog and prints the given points"
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   889
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   890
    | printerInfo printer |
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   891
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   892
    printerInfo := PrintingDialog getPrinterInfo.
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   893
    printerInfo isNil ifTrue:[^self].
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   894
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   895
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   896
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   897
	printer startPrintJob: 'Points'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   898
	aCollectionOfPoints do:[:each |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   899
	    printer displayPointX: each x y: each y.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   900
	].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   901
	printer endPrintJob.
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   902
    ] forkAt: 3
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   903
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   904
    "
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   905
     WinPrinterContext printPoints:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   906
	(Array with: (10 @ 10)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   907
	       with: (500 @ 700)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   908
	       with: (900 @ 1000)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   909
	       with: (1500 @ 1700)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   910
	       with: (2100 @ 2000)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   911
	       with: (2500 @ 2700)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   912
	)
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   913
    "
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   914
!
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   915
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   916
printPolygons: polygons
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   917
    "Opens a print dialog and prints the given polygons"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   918
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   919
    | printerInfo printer |
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   920
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   921
    printerInfo := PrintingDialog getPrinterInfo.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   922
    printerInfo isNil ifTrue:[^self].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   923
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   924
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   925
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   926
	printer startPrintJob: 'Polygons'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   927
	printer foreground:Color black background:Color white.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   928
	polygons
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   929
	    do:[:aPolygon |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   930
		 aPolygon displayStrokedOn: printer.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   931
	    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   932
	printer endPrintJob.
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   933
    ] forkAt: 3
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   934
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   935
    "
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   936
     WinPrinterContext printPolygons:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   937
	(Array with: (Polygon vertices:(
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   938
				Array
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   939
				    with:100@100
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   940
				    with:600@1000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   941
				    with:3500@4000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   942
				    with:100@4000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   943
				    with:100@100))
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   944
		with: (Polygon vertices:(
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   945
				Array
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   946
				    with:1000@1000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   947
				    with:1000@2000
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   948
				    with:2000@1000)))
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   949
    "
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   950
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   951
    "Created: / 07-08-2006 / 12:09:48 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   952
    "Modified: / 07-08-2006 / 14:11:17 / fm"
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
   953
    "Modified: / 16-04-2007 / 15:37:43 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   954
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   955
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   956
printPolylines: evenCollectionOfPoints
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   957
    "Opens a print dialog and prints the given rectangles"
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   958
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   959
    | printerInfo printer |
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   960
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   961
    printerInfo := PrintingDialog getPrinterInfo.
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   962
    printerInfo isNil ifTrue:[^self].
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   963
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   964
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   965
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   966
	printer startPrintJob: 'Polylines'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   967
	printer displayPolylines:evenCollectionOfPoints.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   968
	printer endPrintJob.
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   969
    ] forkAt: 3
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   970
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   971
    "
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   972
     WinPrinterContext printPolylines:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   973
	(Array with: (10 @ 10)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   974
	       with: (500 @ 700)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   975
	       with: (900 @ 1000)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   976
	       with: (1500 @ 1700)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   977
	       with: (2100 @ 2000)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   978
	       with: (2500 @ 2700)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   979
	)
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   980
    "
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   981
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   982
    "Created: / 07-08-2006 / 11:40:48 / fm"
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   983
    "Modified: / 16-04-2007 / 15:37:46 / cg"
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   984
!
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
   985
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
   986
printRectangles: rectanglesWithContextArray
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   987
    "Opens a print dialog and prints the given rectangles"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   988
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   989
    | printerInfo printer |
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   990
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   991
    printerInfo := PrintingDialog getPrinterInfo.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   992
    printerInfo isNil ifTrue:[^self].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   993
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   994
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
   995
    [
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   996
	printer startPrintJob: 'Rectangles'.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   997
	printer foreground:Color red background:Color white.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   998
	rectanglesWithContextArray do:[:rectangleWithContextArray |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
   999
	    |rectangle|
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1000
	    rectangle := rectangleWithContextArray at: 1.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1001
	    printer
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1002
		foreground:(rectangleWithContextArray at:2);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1003
		lineWidth: (rectangleWithContextArray at:3);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1004
		lineStyle: (rectangleWithContextArray at:4);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1005
		displayRectangleX: rectangle origin x
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1006
			y: rectangle origin y
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1007
			width: rectangle width
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1008
			height: rectangle height.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1009
	    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1010
	printer endPrintJob.
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1011
    ] forkAt: 3
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1012
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1013
    "
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  1014
     WinPrinterContext printRectangles:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1015
	(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
  1016
	       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
  1017
	       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
  1018
	       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
  1019
	       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
  1020
	)
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1021
    "
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1022
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1023
    "Created: / 07-08-2006 / 11:40:48 / fm"
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
  1024
    "Modified: / 16-04-2007 / 15:37:46 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1025
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1026
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1027
printStrings: stringAndPositionsArray
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1028
    "Opens a print dialog and prints the given strings"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1029
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1030
    | printerInfo printer |
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1031
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1032
    printerInfo := PrintingDialog getPrinterInfo.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1033
    printerInfo isNil ifTrue:[^self].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1034
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1035
    printer := self fromPrinterInfo: printerInfo.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  1036
    [
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1037
	printer startPrintJob: 'Strings with Position'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1038
	printer foreground:Color black background:Color white.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1039
	stringAndPositionsArray
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1040
	    do:[:pairOfPointsAndPosition |
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1041
		 printer displayString:(pairOfPointsAndPosition at: 1)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1042
			    x:(pairOfPointsAndPosition at: 2) x
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1043
			    y:(pairOfPointsAndPosition at: 2) y
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1044
	    ].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1045
	printer endPrintJob.
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1046
    ] forkAt: 3
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1047
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1048
    "
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  1049
     WinPrinterContext printStrings:
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1050
	(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
  1051
	       with: (Array with:'Another test string to print' with:80@200))
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1052
    "
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1053
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1054
    "Created: / 07-08-2006 / 12:09:48 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1055
    "Modified: / 07-08-2006 / 14:11:17 / fm"
2313
a3fa5abef172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2304
diff changeset
  1056
    "Modified: / 16-04-2007 / 15:37:49 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1057
! !
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1058
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1059
!WinPrinterContext methodsFor:'accessing'!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1060
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1061
depth
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1062
    ^ 24
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1063
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1064
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1065
deviceColors
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1066
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1067
    ^#()
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1068
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1069
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1070
deviceFonts
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1071
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1072
    deviceFonts isNil ifTrue:[deviceFonts := CachingRegistry new cacheSize:10.].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1073
    ^deviceFonts
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1074
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1075
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1076
getCharHeight
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1077
    "Private - answer the height of the font selected in the receiver's
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1078
     device context."
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  1079
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1080
    |textMetrics answer|
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1081
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  1082
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1083
    textMetrics := Win32OperatingSystem::TextMetricsStructure new.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1084
"/    (OperatingSystem getTextMetrics:gcId lpMetrics:textMetrics) ifFalse:[ ^ self error ].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1085
"/    Transcript showCR: 'CHAR HEIGHT PRIM ******* ', '   ',  (textMetrics tmHeight + textMetrics tmExternalLeading) printString.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1086
"/    Transcript showCR: 'CHAR HEIGHT DEVICE ***** ', '   ', (self font heightOf:'PQWEXCZ' on:self device) printString.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1087
    answer := (self font heightOf:'PQWEXCZ' on:self device).
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1088
"/    answer := textMetrics tmHeight + textMetrics tmExternalLeading.
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  1089
    ^answer
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1090
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1091
    "Created: / 02-08-2006 / 17:47:20 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1092
    "Modified: / 03-08-2006 / 10:09:01 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1093
    "Modified: / 10-10-2006 / 18:15:17 / cg"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1094
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1095
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1096
getLogicalPixelSizeX
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1097
    ^ printerInfo printQuality ? 600
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1098
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1099
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1100
getLogicalPixelSizeY
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1101
    ^ printerInfo printQuality ? 600
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1102
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1103
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1104
numberOfColorBitsPerPixel
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1105
    ^ OperatingSystem getDeviceCaps:gcId index:12 "Bitspixel"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1106
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1107
    "Created: / 03-08-2006 / 09:58:18 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1108
    "Modified: / 10-10-2006 / 18:15:40 / cg"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1109
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1110
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1111
physicalOffsetX
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1112
    ^ OperatingSystem getDeviceCaps:gcId index:112 "PhysicalOffsetX"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1113
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1114
    "Created: / 01-08-2006 / 16:28:34 / fm"
2301
135f21a3d127 refactorred OS-independent stuff
Claus Gittinger <cg@exept.de>
parents: 2299
diff changeset
  1115
    "Modified: / 16-04-2007 / 12:52:06 / cg"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1116
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1117
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1118
physicalOffsetY
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1119
    ^ OperatingSystem getDeviceCaps:gcId index:113 "PhysicalOffsetY"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1120
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1121
    "Created: / 01-08-2006 / 16:28:34 / fm"
2301
135f21a3d127 refactorred OS-independent stuff
Claus Gittinger <cg@exept.de>
parents: 2299
diff changeset
  1122
    "Modified: / 16-04-2007 / 12:52:01 / cg"
2299
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
pixelsPerInchOfScreenHeight
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1126
    ^ OperatingSystem getDeviceCaps:gcId index:90 "Logpixelsy"
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:29:16 / 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
pixelsPerInchOfScreenWidth
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1132
    ^ OperatingSystem getDeviceCaps:gcId index:88 "Logpixelsx"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1133
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1134
    "Created: / 01-08-2006 / 16:28:34 / fm"
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
printerHeightArea
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1138
    ^ (OperatingSystem getDeviceCaps:gcId index:10)
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1139
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1140
    "Modified: / 10-10-2006 / 18:18:31 / cg"
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
printerPhysicalHeight
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1144
    ^ OperatingSystem getDeviceCaps:gcId "deviceContext" index:111 "PhysicalHeight"
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
printerPhysicalWidth
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1150
    ^ OperatingSystem getDeviceCaps:gcId "deviceContext" index:110 "PhysicalWidth"
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
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1155
printerWidthArea
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1156
    ^ OperatingSystem getDeviceCaps:gcId "deviceContext" index:8 "Horzres"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1157
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1158
    "Created: / 01-08-2006 / 16:14:08 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1159
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1160
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1161
supportedImageFormats
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1162
    "return an array with supported image formats; each array entry
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1163
     is another array, consisting of depth and bitsPerPixel values."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1164
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1165
    |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
    info := IdentityDictionary new.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1168
    info at:#depth put:self depth.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1169
    info at:#bitsPerPixel put:self depth.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1170
    info at:#padding put:32.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1171
    ^ Array with:info
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
     Disply supportedImageFormats
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1175
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1176
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1177
    "Modified: / 10.9.1998 / 23:14:05 / cg"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1178
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1179
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1180
visualType
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1181
    ^ #TrueColor
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1182
! !
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1183
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1184
!WinPrinterContext methodsFor:'color stuff'!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1185
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1186
colorScaledRed:r scaledGreen:g scaledBlue:b
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1187
    "allocate a color with rgb values (0..16rFFFF) - return the color index
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1188
     (i.e. colorID)"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1189
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1190
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1191
    int id, ir, ig, ib;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1192
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1193
    if (__bothSmallInteger(r, g) && __isSmallInteger(b)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1194
	ir = (__intVal(r) >> 8) & 0xff;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1195
	ig = (__intVal(g) >> 8) & 0xff;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1196
	ib = (__intVal(b) >> 8) & 0xff;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1197
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1198
	id = RGB( ir, ig, ib);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1199
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1200
	RETURN ( __MKSMALLINT(id) );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1201
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1202
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1203
    self primitiveFailed.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1204
    ^ nil
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1205
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1206
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1207
setBackground:bgColorIndex in:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1208
    "set background color to be drawn with"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1209
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1210
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1211
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1212
    HDC hDC;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1213
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1214
    if (__isExternalAddressLike(aDC)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1215
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1216
	COLORREF bg, oldBg;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1217
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1218
	oldBg = GetBkColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1219
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1220
	bg = __intVal(bgColorIndex) & 0xffffff;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1221
/*        bg = (COLORREF)st2RGB(__intVal(bgColorIndex),gcData);         */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1222
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1223
	if (bg != oldBg) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1224
	    SetBkColor(hDC, bg);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1225
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1226
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1227
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1228
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1229
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1230
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1231
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1232
setBackgroundColor:color in:aGCId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1233
    "set background color to be drawn with"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1234
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1235
    |colorId deviceColor|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1236
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1237
    (color isOnDevice:self) ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1238
	colorId := color colorId.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1239
    ] ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1240
	deviceColor := color onDevice:self.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1241
	deviceColor notNil ifTrue:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1242
	    colorId := deviceColor colorId.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1243
	]
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1244
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1245
    colorId isNil ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1246
	'DeviceWorkstation [warning]: could not set bg color' infoPrintCR.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1247
    ] ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1248
	self setBackground:colorId in:aGCId.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1249
    ]
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1250
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1251
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1252
setForeground:fgColorIndex background:bgColorIndex in:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1253
    "set foreground and background colors to be drawn with"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1254
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1255
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1256
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1257
    if (__isExternalAddressLike(aDC)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1258
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1259
	COLORREF fg, bg, oldFg, oldBg;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1260
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1261
/*        fg = (COLORREF)st2RGB(__intVal(fgColorIndex),gcData);    */
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1262
	fg = __intVal(fgColorIndex) & 0xffffff;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1263
/*        bg = (COLORREF)st2RGB(__intVal(bgColorIndex),gcData);    */
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1264
	bg = __intVal(bgColorIndex) & 0xffffff;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1265
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1266
	oldFg = GetTextColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1267
	oldBg = GetBkColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1268
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1269
	if ((fg != oldFg) || (bg != oldBg)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1270
	    /* Pen only depends upon fg-color */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1271
	    if (fg != oldFg) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1272
		SetTextColor(hDC, fg);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1273
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1274
	    if (bg != oldBg) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1275
		SetBkColor(hDC, bg);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1276
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1277
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1278
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1279
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1280
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1281
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1282
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1283
setForeground:fgColorIndex in:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1284
    "set foreground color to be drawn with"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1285
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1286
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1287
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1288
    HDC hDC;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1289
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1290
    if (__isExternalAddressLike(aDC)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1291
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1292
	COLORREF fg, oldFg;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1293
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1294
	oldFg = GetTextColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1295
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1296
	fg = __intVal(fgColorIndex) & 0xffffff;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1297
/*        fg = (COLORREF)st2RGB(__intVal(fgColorIndex),gcData);         */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1298
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1299
	if (fg != oldFg) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1300
	    SetTextColor(hDC, fg);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1301
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1302
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1303
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1304
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1305
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1306
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1307
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1308
setForegroundColor:color in:aGCId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1309
    "set the foreground color to be drawn with"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1310
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1311
    |colorId deviceColor|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1312
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1313
    (color isOnDevice:self) ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1314
	colorId := color colorId.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1315
    ] ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1316
	deviceColor := color onDevice:self.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1317
	deviceColor notNil ifTrue:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1318
	    colorId := deviceColor colorId.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1319
	]
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1320
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1321
    colorId isNil ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1322
	'DeviceWorkstation [warning]: could not set fg color' infoPrintCR.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1323
    ] ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1324
	self setForeground:colorId in:aGCId.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1325
    ]
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1326
! !
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1327
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1328
!WinPrinterContext methodsFor:'context stuff'!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1329
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1330
getPenFor:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1331
    "set line attributes"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1332
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1333
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1334
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1335
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1336
     && __isSmallInteger(__INST(lineWidth))) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1337
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1338
	COLORREF fgColor;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1339
	HANDLE hPen, prevPen;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1340
	int lineStyleInt, capStyleInt, joinStyleInt, lineWidth;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1341
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1342
	lineWidth= __intVal(__INST(lineWidth));
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1343
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1344
	if (__INST(lineStyle) == @symbol(solid)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1345
	    lineStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1346
	} else if (__INST(lineStyle) == @symbol(dashed)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1347
	    lineStyleInt= PS_DASH;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1348
	} else if (__INST(lineStyle) == @symbol(dotted)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1349
	    lineStyleInt= PS_DOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1350
	} else if (__INST(lineStyle) == @symbol(dashDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1351
	    lineStyleInt= PS_DASHDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1352
	} else if (__INST(lineStyle) == @symbol(dashDotDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1353
	    lineStyleInt= PS_DASHDOTDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1354
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1355
	    lineStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1356
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1357
	if (__INST(capStyle) == @symbol(round)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1358
	    capStyleInt= PS_ENDCAP_ROUND;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1359
	} else if (__INST(capStyle) == @symbol(square)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1360
	    capStyleInt= PS_ENDCAP_SQUARE;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1361
	} else if (__INST(capStyle) == @symbol(flat)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1362
	    capStyleInt= PS_ENDCAP_FLAT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1363
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1364
	    capStyleInt= PS_ENDCAP_FLAT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1365
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1366
	if (__INST(joinStyle) == @symbol(bevel)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1367
	    joinStyleInt= PS_JOIN_BEVEL;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1368
	} else if (__INST(joinStyle) == @symbol(miter)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1369
	    joinStyleInt= PS_JOIN_MITER;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1370
	} else if (__INST(joinStyle) == @symbol(round)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1371
	    joinStyleInt= PS_JOIN_ROUND;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1372
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1373
	    joinStyleInt= PS_JOIN_MITER;
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
	fgColor = GetTextColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1377
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1378
	hPen = CreatePen(lineStyleInt | capStyleInt | joinStyleInt, lineWidth, fgColor);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1379
	prevPen = SelectObject(hDC, hPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1380
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1381
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1382
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1383
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1384
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1385
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1386
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1387
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1388
getPenForContext
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1389
    "set line attributes"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1390
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1391
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1392
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1393
    if (__isExternalAddressLike(__INST(gcId))
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1394
     && __isSmallInteger(__INST(lineWidth))) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1395
	HANDLE hDC = (HANDLE)(__externalAddressVal(__INST(gcId)));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1396
	COLORREF fgColor;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1397
	HANDLE hPen;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1398
	int lineStyleInt, capStyleInt, joinStyleInt, lineWidth;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1399
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1400
	lineWidth= __INST(lineWidth);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1401
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1402
	if (__INST(lineStyle) == @symbol(solid)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1403
	    lineStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1404
	} else if (__INST(lineStyle) == @symbol(dashed)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1405
	    lineStyleInt= PS_DASH;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1406
	} else if (__INST(lineStyle) == @symbol(dotted)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1407
	    lineStyleInt= PS_DOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1408
	} else if (__INST(lineStyle) == @symbol(dashDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1409
	    lineStyleInt= PS_DASHDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1410
	} else if (__INST(lineStyle) == @symbol(dashDotDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1411
	    lineStyleInt= PS_DASHDOTDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1412
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1413
	    lineStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1414
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1415
	if (__INST(capStyle) == @symbol(round)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1416
	    capStyleInt= PS_ENDCAP_ROUND;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1417
	} else if (__INST(capStyle) == @symbol(square)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1418
	    capStyleInt= PS_ENDCAP_SQUARE;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1419
	} else if (__INST(capStyle) == @symbol(flat)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1420
	    capStyleInt= PS_ENDCAP_FLAT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1421
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1422
	    capStyleInt= PS_ENDCAP_FLAT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1423
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1424
	if (__INST(joinStyle) == @symbol(bevel)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1425
	    joinStyleInt= PS_JOIN_BEVEL;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1426
	} else if (__INST(joinStyle) == @symbol(miter)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1427
	    joinStyleInt= PS_JOIN_MITER;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1428
	} else if (__INST(joinStyle) == @symbol(round)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1429
	    joinStyleInt= PS_JOIN_ROUND;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1430
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1431
	    joinStyleInt= PS_JOIN_MITER;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1432
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1433
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1434
	fgColor = GetTextColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1435
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1436
	hPen = CreatePen(lineStyleInt | capStyleInt | joinStyleInt, lineWidth, fgColor);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1437
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1438
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1439
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1440
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1441
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1442
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1443
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1444
hatch
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1445
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1446
    "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
  1447
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1448
       #none
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1449
       #horizontal              -----       HS_HORIZONTAL = 0
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1450
       #vertical                |||||       HS_VERTICAL = 1
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1451
       #fDiagonal               \\\\\       HS_FDIAGONAL = 2
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1452
       #bDiagonal               /////       HS_BDIAGONAL = 3
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1453
       #cross                   +++++       HS_CROSS = 4
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1454
       #diagonalCross           xxxxx       HS_DIAGCROSS = 5
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1455
    "
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1456
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1457
    hatch isNil ifTrue:[^#none].
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1458
    ^ hatch
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1459
!
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1460
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1461
hatch: aSymbol
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1462
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1463
    "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
  1464
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1465
       #none
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1466
       #horizontal              -----       HS_HORIZONTAL = 0
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1467
       #vertical                |||||       HS_VERTICAL = 1
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1468
       #fDiagonal               \\\\\       HS_FDIAGONAL = 2
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1469
       #bDiagonal               /////       HS_BDIAGONAL = 3
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1470
       #cross                   +++++       HS_CROSS = 4
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1471
       #diagonalCross           xxxxx       HS_DIAGCROSS = 5
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1472
    "
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1473
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1474
    hatch := aSymbol
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1475
!
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  1476
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1477
noClipIn:aWindowId gc:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1478
    "disable clipping rectangle"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1479
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1480
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1481
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1482
    if (__isExternalAddressLike(aDC)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1483
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1484
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1485
	SelectClipRgn(hDC, NULL);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1486
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1487
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1488
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1489
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1490
2399
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  1491
platformName
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  1492
    "used by #fillRoundRectangleX ...."
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1493
    ^ Smalltalk platformName asUppercase
2399
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  1494
!
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  1495
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1496
setBitmapMask:aBitmapId in:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1497
    "set or clear the drawing mask - a bitmap mask using current fg/bg"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1498
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1499
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1500
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1501
    if (__isExternalAddressLike(aDC)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1502
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1503
	HBITMAP oldM;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1504
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1505
/*        oldM = gcData->hMask;
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1506
	if (__isExternalAddress(aBitmapId))
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1507
	    gcData->hMask = _HBITMAPVAL(aBitmapId);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1508
	else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1509
	    gcData->hMask = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1510
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1511
	if (oldM != gcData->hMask) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1512
	  FLUSH_CACHED_DC(gcData);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1513
	    CPRINTF(("masks set to %x\n",gcData->hMask));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1514
	}                                                     */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1515
	RETURN (self);
2323
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
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1519
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1520
setClipX:clipX y:clipY width:clipWidth height:clipHeight in:ignoredDrawableId gc:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1521
    "clip to a rectangle"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1522
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1523
"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1524
      p--w---
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1525
      |     |
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1526
      h     |  the clipping rectangle
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1527
      |     |
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1528
      -------
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1529
	  where p = ( clipX, clipY ), w = clipWidth, h = clipHeight
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1530
"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1531
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1532
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1533
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1534
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1535
     && __bothSmallInteger(clipX, clipY)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1536
     && __bothSmallInteger(clipWidth, clipHeight) ) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1537
	HANDLE hDC;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1538
	int cX, cY, cW, cH;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1539
	POINT ptOrg;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1540
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1541
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1542
	hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1543
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1544
	GetViewportOrgEx(hDC,&ptOrg);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1545
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1546
	// set the clip rectangle
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1547
	// and offset the rectangle by the viewport origin
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1548
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1549
	cX = __intVal(clipX) + ptOrg.x;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1550
	cY = __intVal(clipY) + ptOrg.y;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1551
	cW = __intVal(clipWidth)+ ptOrg.x;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1552
	cH = __intVal(clipHeight)+ ptOrg.y;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1553
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1554
	{
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1555
	    HRGN region = CreateRectRgn(cX, cY, cX + cW, cY + cH);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1556
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1557
	    if (region == NULL ) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1558
		console_fprintf(stderr, "WinWorkstat [warning]: clipping region creation failed\n");
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1559
	    } else {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1560
		if (SelectClipRgn(hDC, region) == ERROR ) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1561
		    console_fprintf(stderr, "WinWorkstat [warning]: select clipping region failed\n");
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1562
		}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1563
		DeleteObject(region);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1564
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1565
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1566
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1567
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1568
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1569
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1570
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1571
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1572
setDashes:dashList dashOffset:offset in:aGCId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1573
    "set line attributes"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1574
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1575
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1576
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1577
    if (__isExternalAddressLike(aGCId)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1578
	DPRINTF(("WinWorkstat [warning]: dashes not (yet) implemented\n"));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1579
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1580
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1581
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1582
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1583
setLineWidth:aNumber style:lineStyle cap:capStyle join:joinStyle in:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1584
    "set line attributes"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1585
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1586
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1587
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1588
    HDC hDC;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1589
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1590
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1591
     && __isSmallInteger(aNumber)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1592
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1593
	int style;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1594
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1595
	if (lineStyle == @symbol(solid)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1596
	    style = PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1597
	} else if (lineStyle == @symbol(dashed)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1598
	    style= PS_DASH;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1599
	} else if (lineStyle == @symbol(dotted)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1600
	    style= PS_DOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1601
	} else if (lineStyle == @symbol(dashDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1602
	    style= PS_DASHDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1603
	} else if (lineStyle == @symbol(dashDotDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1604
	    style= PS_DASHDOTDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1605
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1606
	    style= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1607
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1608
	if (capStyle == @symbol(round)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1609
	    style = PS_ENDCAP_ROUND;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1610
	} else if (capStyle == @symbol(square)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1611
	    style = PS_ENDCAP_SQUARE;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1612
	} else if (capStyle == @symbol(flat)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1613
	    style = PS_ENDCAP_FLAT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1614
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1615
	    style = PS_ENDCAP_FLAT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1616
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1617
	if (joinStyle == @symbol(bevel)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1618
	    style = PS_JOIN_BEVEL;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1619
	} else if (joinStyle == @symbol(miter)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1620
	    style = PS_JOIN_MITER;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1621
	} else if (joinStyle == @symbol(round)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1622
	    style = PS_JOIN_ROUND;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1623
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1624
	    style = PS_JOIN_MITER;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1625
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1626
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1627
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1628
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1629
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1630
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1631
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1632
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1633
setMaskOriginX:orgX y:orgY in:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1634
    "set the mask origin"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1635
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1636
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1637
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1638
    if (__isExternalAddress(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1639
     && __bothSmallInteger(orgX,orgY)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1640
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1641
	int oX, oY, maskOrgX, maskOrgY;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1642
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1643
	oX = __intVal(orgX);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1644
	oY = __intVal(orgY);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1645
	if ((oX != maskOrgX)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1646
	 || (oY != maskOrgY)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1647
	    maskOrgX = __intVal(orgX);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1648
	    maskOrgY = __intVal(orgY);;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1649
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1650
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1651
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1652
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1653
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1654
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1655
setViewportOrg: aPoint
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1656
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1657
    "Sets the viewport origin (LOGICAL point (0,0)) of the device context"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1658
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  1659
    ^ OperatingSystem
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1660
	    setViewportOrg: gcId "deviceContext"
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1661
	    x: aPoint x
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1662
	    y: aPoint y
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1663
	    oldOrigin: nil
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1664
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1665
    "Created: / 01-08-2006 / 16:14:08 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1666
! !
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1667
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
  1668
!WinPrinterContext methodsFor:'drawing'!
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
  1669
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1670
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
  1671
    "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
  1672
     The angles may be floats or integer - they are given in degrees."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1673
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1674
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1675
    int __x, __y, w, h;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1676
    float angle1, angle2;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1677
    double f;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1678
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1679
    if (__isSmallInteger(startAngle))
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1680
	angle1 = (float)(__intVal(startAngle));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1681
    else if (__isFloat(startAngle)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1682
	angle1 = (float) __floatVal(startAngle);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1683
    } else if (__isShortFloat(startAngle)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1684
	angle1 = __shortFloatVal(startAngle);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1685
    } else goto bad;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1686
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1687
    if (__isSmallInteger(angle))
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1688
	angle2 = (float)(__intVal(angle));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1689
    else if (__isFloat(angle)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1690
	angle2 = (float) __floatVal(angle);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1691
    } else if (__isShortFloat(angle)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1692
	angle2 = __shortFloatVal(angle);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1693
    } else goto bad;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1694
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1695
    if (angle2 <= 0) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1696
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1697
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1698
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1699
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1700
     && __bothSmallInteger(x, y)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1701
     && __bothSmallInteger(width, height))
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1702
     {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1703
	POINT p;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1704
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1705
	DWORD clr = 0 /* 0xFFFFFFFF */;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1706
	HANDLE prevPen, hPen;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1707
	double xB, yB, xE, yE, xR, yR;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1708
	COLORREF fgColor;
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1709
	OBJ lStyleSymbol;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1710
	int lStyleInt;
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1711
	int lw;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1712
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1713
	lw= __intVal(__INST(lineWidth));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1714
	lStyleSymbol= __INST(lineStyle);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1715
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1716
	/*  PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1717
	    only works with lineWidth = 1  */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1718
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1719
	if (lStyleSymbol == @symbol(solid)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1720
	    lStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1721
	} else if (lStyleSymbol == @symbol(dashed)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1722
	    lStyleInt= PS_DASH;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1723
	} else if (lStyleSymbol == @symbol(dotted)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1724
	    lStyleInt= PS_DOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1725
	} else if (lStyleSymbol == @symbol(dashDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1726
	    lStyleInt= PS_DASHDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1727
	} else if (lStyleSymbol == @symbol(dashDotDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1728
	    lStyleInt= PS_DASHDOTDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1729
	} else if (lStyleSymbol == @symbol(insideFrame)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1730
	    lStyleInt= PS_INSIDEFRAME;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1731
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1732
	    lStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1733
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1734
	fgColor = GetTextColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1735
	hPen = CreatePen(lStyleInt, lw, fgColor);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1736
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1737
	w = __intVal(width);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1738
	h = __intVal(height);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1739
	__x = __intVal(x);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1740
	__y = __intVal(y);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1741
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1742
	    xR = w / 2;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1743
	    yR = h / 2;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1744
	    if (angle2 - angle1 >= 360) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1745
		xB = xE = __x + xR + 0.5;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1746
		yB = yE = __y /*+ yR + 0.5*/;
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
		double sin(), cos();
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1749
		float rad1, rad2;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1750
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1751
		if (angle1 <= 180)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1752
		  angle1 = 180 - angle1;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1753
		else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1754
		  angle1 = 360 + 180 - angle1;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1755
		angle2 = angle1 - angle2;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1756
		/* sigh - compute the intersections ... */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1757
		rad1 = (angle1 * 3.14159265359) / 180.0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1758
		rad2 = (angle2 * 3.14159265359) / 180.0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1759
		xB = cos(rad1) * xR;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1760
		yB = sin(rad1) * yR;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1761
		xE = cos(rad2) * xR;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1762
		yE = sin(rad2) * yR;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1763
		xB = __x + xR - xB + 0.5;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1764
		yB = __y + yR - yB + 0.5;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1765
		xE = __x + xR - xE + 0.5;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1766
		yE = __y + yR - yE + 0.5;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1767
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1768
	    prevPen = SelectObject(hDC, hPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1769
	    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
  1770
	    Arc(hDC,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1771
		__x, __y,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1772
		__x + w, __y + h,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1773
		(int)xB, (int)yB,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1774
		(int)xE, (int)yE);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1775
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1776
	    SelectObject(hDC, prevPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1777
	    DeleteObject(hPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1778
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1779
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1780
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1781
    bad: ;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1782
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1783
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1784
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1785
    "Created: / 07-08-2006 / 10:40:27 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1786
    "Modified: / 07-08-2006 / 14:44:21 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1787
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1788
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1789
displayLineFromX:x0 y:y0 toX:x1 y:y1 in:ignoredDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1790
    "draw a line. If the coordinates are not integers, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1791
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1792
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1793
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1794
     && __bothSmallInteger(x0, y0)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1795
     && __bothSmallInteger(x1, y1)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1796
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1797
	COLORREF fgColor;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1798
	HANDLE prevPen, hPen;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1799
	int __x1 = __intVal(x1), __y1 = __intVal(y1);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1800
	OBJ lStyleSymbol;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1801
	int lStyleInt;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1802
	int lw;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1803
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1804
/*      DPRINTF(("displayLine: %d/%d -> %d/%d\n",
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1805
		    __intVal(x0), __intVal(y0),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1806
		    __x1, __y1));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1807
*/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1808
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1809
	lw= __intVal(__INST(lineWidth));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1810
	lStyleSymbol= __INST(lineStyle);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1811
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1812
	/*  PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1813
	    only works with lineWidth = 1  */
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1814
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1815
	if (lStyleSymbol == @symbol(solid)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1816
	    lStyleInt= PS_SOLID;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1817
	} else if (lStyleSymbol == @symbol(dashed)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1818
	    lStyleInt= PS_DASH;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1819
	} else if (lStyleSymbol == @symbol(dotted)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1820
	    lStyleInt= PS_DOT;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1821
	} else if (lStyleSymbol == @symbol(dashDot)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1822
	    lStyleInt= PS_DASHDOT;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1823
	} else if (lStyleSymbol == @symbol(dashDotDot)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1824
	    lStyleInt= PS_DASHDOTDOT;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1825
	} else if (lStyleSymbol == @symbol(insideFrame)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1826
	    lStyleInt= PS_INSIDEFRAME;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1827
	} else
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1828
	    lStyleInt= PS_SOLID;
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
	fgColor = GetTextColor(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1831
	hPen = CreatePen(lStyleInt, lw, fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1832
	prevPen = SelectObject(hDC, hPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1833
	MoveToEx(hDC, __intVal(x0), __intVal(y0), NULL);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1834
	LineTo(hDC, __x1, __y1);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1835
	/*
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1836
	 * end-point ...
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1837
	 */
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1838
	// LineTo(hDC, __x1+1, __y1);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1839
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1840
	SelectObject(hDC, prevPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1841
	DeleteObject(hPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1842
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1843
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1844
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1845
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1846
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1847
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1848
displayPointX:px y:py in:ignoredDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1849
    "draw a point. If x/y are not integers, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1850
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1851
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1852
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1853
     && __bothSmallInteger(px, py)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1854
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1855
	POINT p;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1856
	COLORREF fgColor;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1857
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1858
	int __x = __intVal(px), __y = __intVal(py);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1859
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1860
	fgColor = GetTextColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1861
	SetPixelV(hDC, __x, __y, fgColor);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1862
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1863
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1864
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1865
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1866
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1867
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1868
displayPolygon:aPolygon in:aDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1869
    "draw a polygon, the argument aPolygon is a Collection of individual points,
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1870
     which define the polygon.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1871
     If any coordinate is not integer, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1872
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1873
    |numberOfPoints|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1874
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1875
    numberOfPoints := aPolygon size.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1876
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1877
    OBJ point, px, py;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1878
    int i, num;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1879
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1880
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1881
     /* && __isExternalAddress(aDrawableId) */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1882
     && __isSmallInteger(numberOfPoints)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1883
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1884
	POINT p;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1885
	DWORD clr = 0 /* 0xFFFFFFFF */;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1886
	HANDLE prevPen, hPen;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1887
	int lw;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1888
	COLORREF fgColor;
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1889
	OBJ lStyleSymbol;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1890
	int lStyleInt;
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1891
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1892
	lw= __intVal(__INST(lineWidth));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1893
	lStyleSymbol= __INST(lineStyle);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1894
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1895
	/*  PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1896
	    only works with lineWidth = 1  */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1897
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1898
	if (lStyleSymbol == @symbol(solid)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1899
	    lStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1900
	} else if (lStyleSymbol == @symbol(dashed)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1901
	    lStyleInt= PS_DASH;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1902
	} else if (lStyleSymbol == @symbol(dotted)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1903
	    lStyleInt= PS_DOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1904
	} else if (lStyleSymbol == @symbol(dashDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1905
	    lStyleInt= PS_DASHDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1906
	} else if (lStyleSymbol == @symbol(dashDotDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1907
	    lStyleInt= PS_DASHDOTDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1908
	} else if (lStyleSymbol == @symbol(insideFrame)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1909
	    lStyleInt= PS_INSIDEFRAME;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1910
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1911
	    lStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1912
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1913
	num = __intVal(numberOfPoints);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1914
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1915
	for (i=0; i<num; i++) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1916
	    point = __AT_(aPolygon, __MKSMALLINT(i+1));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1917
	    if (! __isPoint(point)) goto fail;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1918
	    px = _point_X(point);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1919
	    py = _point_Y(point);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1920
	    if (! __bothSmallInteger(px, py)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1921
		goto fail;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1922
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1923
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1924
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1925
	fgColor = GetTextColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1926
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1927
	hPen = CreatePen(lStyleInt, lw, fgColor);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1928
	prevPen = SelectObject(hDC, hPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1929
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1930
	for (i=0; i<num; i++) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1931
	    point = __AT_(aPolygon, __MKSMALLINT(i+1));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1932
	    px = _point_X(point);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1933
	    py = _point_Y(point);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1934
	    p.x = __intVal(px);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1935
	    p.y = __intVal(py);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1936
	    if (i == 0) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1937
		MoveToEx(hDC, p.x, p.y, NULL);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1938
	    } else {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1939
		if (i == (num-1)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1940
		    PolylineTo(hDC, &p, 1);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1941
		} else {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1942
		    LineTo(hDC, p.x, p.y);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1943
#ifdef PRE_04_JUN_04
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1944
		    /*
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1945
		     * end-point ...
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1946
		     */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1947
		    LineTo(hDC, p.x+1, p.y);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1948
#endif
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1949
		}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1950
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1951
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1952
	SelectObject(hDC, prevPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1953
	DeleteObject(hPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1954
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1955
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1956
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1957
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1958
fail: ;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1959
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1960
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1961
    "Created: / 07-08-2006 / 14:46:55 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1962
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1963
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  1964
displayPolylines:arrayOfPoints
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
  1965
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
  1966
    device displayPolylines:arrayOfPoints in:nil with:gcId
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1967
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1968
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1969
displayPolylines:aPolyline in:ignoredDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1970
    "draw a polyline, the argument aPolyline is a collection of individual points,
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1971
     which define the lines (p1/p2 pairs); must be even in size.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1972
     If any coordinate is not integer, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1973
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1974
    |numberOfPoints|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1975
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1976
    numberOfPoints := aPolyline size.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1977
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1978
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1979
    OBJ point, px, py;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1980
    int i, num;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1981
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1982
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1983
     && __isSmallInteger(numberOfPoints)) {
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  1984
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1985
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1986
	POINT p;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1987
	HANDLE prevPen, hPen;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1988
	COLORREF fgColor;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1989
	int lw;
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1990
	OBJ lStyleSymbol;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1991
	int lStyleInt;
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1992
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1993
	lw= __intVal(__INST(lineWidth));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1994
	lStyleSymbol= __INST(lineStyle);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1995
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1996
	/*  PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1997
	    only works with lineWidth = 1  */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1998
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  1999
	if (lStyleSymbol == @symbol(solid)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2000
	    lStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2001
	} else if (lStyleSymbol == @symbol(dashed)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2002
	    lStyleInt= PS_DASH;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2003
	} else if (lStyleSymbol == @symbol(dotted)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2004
	    lStyleInt= PS_DOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2005
	} else if (lStyleSymbol == @symbol(dashDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2006
	    lStyleInt= PS_DASHDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2007
	} else if (lStyleSymbol == @symbol(dashDotDot)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2008
	    lStyleInt= PS_DASHDOTDOT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2009
	} else if (lStyleSymbol == @symbol(insideFrame)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2010
	    lStyleInt= PS_INSIDEFRAME;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2011
	} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2012
	    lStyleInt= PS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2013
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2014
	fgColor = GetTextColor(hDC);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2015
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2016
	num = __intVal(numberOfPoints);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2017
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2018
	for (i=0; i<num; i++) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2019
	    point = __AT_(aPolyline, __MKSMALLINT(i+1));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2020
	    if (! __isPoint(point)) goto fail;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2021
	    px = _point_X(point);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2022
	    py = _point_Y(point);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2023
	    if (! __bothSmallInteger(px, py)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2024
		goto fail;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2025
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2026
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2027
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2028
	hPen = CreatePen(lStyleInt, lw, fgColor);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2029
	prevPen = SelectObject(hDC, hPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2030
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2031
	for (i=0; i<num; i++) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2032
	    point = __AT_(aPolyline, __MKSMALLINT(i+1));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2033
	    px = _point_X(point);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2034
	    py = _point_Y(point);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2035
	    p.x = __intVal(px);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2036
	    p.y = __intVal(py);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2037
	    DPRINTF(("printing point"));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2038
	    DPRINTF(("displayPolygon: no pen\n"));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2039
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2040
	    if ((i & 1) == 0) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2041
		MoveToEx(hDC, p.x, p.y, NULL);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2042
	    } else {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2043
		LineTo(hDC, p.x, p.y);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2044
		/*
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2045
		 * end-point ...
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2046
		 */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2047
		LineTo(hDC, p.x+1, p.y);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2048
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2049
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2050
	SelectObject(hDC, prevPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2051
	DeleteObject(hPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2052
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2053
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2054
fail: ;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2055
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2056
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2057
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2058
displayRectangleX:x y:y width:width height:height in:ignoredDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2059
    "draw a rectangle. If the coordinates are not integers, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2060
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2061
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2062
    int w, h;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2063
    int xL, yT;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2064
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2065
     && __bothSmallInteger(x, y)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2066
     && __bothSmallInteger(width, height)) {
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2067
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2068
	xL = __intVal(x);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2069
	yT = __intVal(y);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2070
	w = __intVal(width);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2071
	h = __intVal(height);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2072
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2073
	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
  2074
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2075
	if ((w >= 0) && (h >= 0)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2076
	    HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2077
	    COLORREF fgColor;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2078
	    HANDLE prevPen, hPen;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2079
	    OBJ lStyleSymbol;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2080
	    int lStyleInt;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2081
	    int lw;
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
	    lw= __intVal(__INST(lineWidth));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2084
	    lStyleSymbol= __INST(lineStyle);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2085
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2086
	    /*  PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2087
		only works with lineWidth = 1  */
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2088
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2089
	    if (lStyleSymbol == @symbol(solid)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2090
		lStyleInt= PS_SOLID;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2091
	    } else if (lStyleSymbol == @symbol(dashed)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2092
		lStyleInt= PS_DASH;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2093
	    } else if (lStyleSymbol == @symbol(dotted)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2094
		lStyleInt= PS_DOT;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2095
	    } else if (lStyleSymbol == @symbol(dashDot)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2096
		lStyleInt= PS_DASHDOT;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2097
	    } else if (lStyleSymbol == @symbol(dashDotDot)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2098
		lStyleInt= PS_DASHDOTDOT;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2099
	    } else if (lStyleSymbol == @symbol(insideFrame)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2100
		lStyleInt= PS_INSIDEFRAME;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2101
	    } else
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2102
		lStyleInt= PS_SOLID;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2103
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2104
	    fgColor = GetTextColor(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2105
	    hPen = CreatePen(lStyleInt, lw, fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2106
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2107
	    prevPen = SelectObject(hDC, hPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2108
	    MoveToEx(hDC, xL, yT, NULL);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2109
	    LineTo(hDC, xL+w, yT);       // to top-right
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2110
	    LineTo(hDC, xL+w, yT+h);     // to bot-right
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2111
	    MoveToEx(hDC, xL, yT, NULL); // back to top-left
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2112
	    LineTo(hDC, xL, yT+h);       // to bot-left
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2113
	    // 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
  2114
	    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
  2115
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2116
	    SelectObject(hDC, prevPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2117
	    DeleteObject(hPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2118
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2119
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2120
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2121
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2122
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2123
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2124
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2125
    "Created: / 28-07-2006 / 20:18:25 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2126
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2127
2399
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2128
displayRoundRectangleX:left y:top width:width height:height wCorner:wCorn hCorner:hCorn
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2129
    |right bottom wC hC wHalf hHalf|
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
    right := left + width-1.
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2132
    bottom := top + height-1.
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2133
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2134
    wC := wCorn.
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2135
    hC := hCorn.
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2136
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2137
    self scale = 1 ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2138
	wHalf := wC // 2.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2139
	hHalf := hC // 2.
2399
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2140
    ] ifFalse:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2141
	wHalf := wC / 2.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2142
	hHalf := hC / 2.
2399
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2143
    ].
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
    "top left arc"
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2146
    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
  2147
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2148
    "top right arc"
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2149
    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
  2150
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2151
    "bottom right arc"
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2152
    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
  2153
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2154
    "bottom left arc"
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2155
    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
  2156
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2157
    "top line"
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2158
    self displayLineFromX:(left + wHalf) y:top toX:(right - wHalf+1) y:top.
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2159
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2160
    "left line"
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2161
    self displayLineFromX:left y:(top + hHalf - 1) toX:left y:(bottom - hHalf).
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2162
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2163
    "bottom line"
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2164
    self displayLineFromX:(left + wHalf-1) y:bottom
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2165
		      toX:(right - wHalf ) y:bottom.
2399
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2166
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2167
    "right line"
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2168
    self displayLineFromX:right y:(top + hHalf) toX:right y:(bottom - hHalf).
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2169
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
     |v|
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2173
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2174
     (v := View new) extent:200@200; openAndWait.
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2175
     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
  2176
    "
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2177
!
1de98d034f71 round rectangles
Michael Beyl <mb@exept.de>
parents: 2384
diff changeset
  2178
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2179
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
  2180
    "draw a sub-string - draw foreground only.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2181
     If the coordinates are not integers, retry with rounded."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2182
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2183
    self
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2184
	displayString:aString
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2185
	from:index1
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2186
	to:index2
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2187
	x:x
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2188
	y:y
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2189
	in:aDrawableId
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2190
	with:aGCId
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2191
	opaque:false
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2192
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2193
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2194
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
  2195
    "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
  2196
     foreground and background characters.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2197
     If the coordinates are not integers, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2198
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2199
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2200
    unsigned char *cp;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2201
    OBJ cls;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2202
    int  i1, i2, l, n;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2203
    int nInstBytes;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2204
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2205
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2206
     && __isNonNilObject(aString)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2207
     && __bothSmallInteger(index1, index2)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2208
     && __bothSmallInteger(x, y))
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2209
    {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2210
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2211
	int pX, pY;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2212
	COLORREF fgColor;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2213
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2214
	pX = __intVal(x);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2215
	pY = __intVal(y);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2216
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2217
	if (opaque == true) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2218
	    SetBkMode(hDC, OPAQUE);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2219
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2220
	    SetBkMode(hDC, TRANSPARENT);
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
	fgColor = GetTextColor(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2223
	SetTextColor(hDC, fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2224
	SetBkColor(hDC, 0xFFFFFFFF);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2225
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2226
	cls = __qClass(aString);
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
	i1 = __intVal(index1) - 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2229
	if (i1 >= 0) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2230
	    i2 = __intVal(index2) - 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2231
	    if (i2 < i1) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2232
		goto ret;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2233
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2234
3814
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  2235
	    cp = __stringVal(aString);
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2236
	    l = i2 - i1 + 1;
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 ((cls == @global(String)) || (cls == @global(Symbol))) {
3814
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  2239
		n = __stringSize(aString);
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2240
		if (i2 < n) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2241
		    cp += i1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2242
		    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
  2243
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2244
		    if (l > 32767) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2245
			l = 32767;
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
		    if (! TextOut(hDC, pX, pY, (char *)cp, l)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2248
			DFPRINTF((stderr, "WinPrinter [warning]: Textout failed. %d\n", GetLastError()));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2249
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2250
		    goto ret;
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
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2253
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2254
	    nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2255
	    cp += nInstBytes;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2256
	    n = __byteArraySize(aString) - nInstBytes;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2257
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2258
	    if (__isBytes(aString)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2259
		if (i2 < n) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2260
		    cp += i1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2261
		    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
  2262
		    if (l > 32767) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2263
			l = 32767;
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
		    if (! TextOut(hDC, pX, pY, (char *)cp, l)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2266
			DFPRINTF((stderr, "WinPrinter [warning]: Textout failed. %d\n", GetLastError()));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2267
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2268
		    goto ret;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2269
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2270
	    }
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
	    /* Unicode */
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2273
	    if (__isWords(aString)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2274
		n = n / 2;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2275
		if (i2 < n) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2276
		    WIDECHAR *w_cp = (WIDECHAR *)cp;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2277
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2278
		    w_cp += i1;
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
		    if (! TextOutW(hDC, pX, pY, w_cp, l)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2281
			DFPRINTF((stderr, "WinPrinter [warning]: TextoutW failed. %d\n", GetLastError()));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2282
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2283
		    goto ret;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2284
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2285
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2286
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2287
ret:
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2288
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2289
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2290
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2291
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2292
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2293
    "Created: / 28-07-2006 / 20:35:19 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2294
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2295
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2296
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
  2297
    "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
  2298
     foreground and background characters.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2299
     If the coordinates are not integers, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2300
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2301
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2302
    unsigned char *cp;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2303
    OBJ cls;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2304
    int  i1, i2, l, n;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2305
    int nInstBytes;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2306
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2307
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2308
     && __isNonNilObject(aString)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2309
     && __bothSmallInteger(index1, index2)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2310
     && __bothSmallInteger(x, y))
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2311
    {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2312
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2313
	int pX, pY;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2314
	COLORREF fgColor;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2315
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2316
	pX = __intVal(x);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2317
	pY = __intVal(y);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2318
	pY -= __intVal(fontAscent);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2319
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2320
	if (opaque == true) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2321
	    SetBkMode(hDC, OPAQUE);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2322
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2323
	    SetBkMode(hDC, TRANSPARENT);
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
	fgColor = GetTextColor(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2326
	SetTextColor(hDC, fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2327
	SetBkColor(hDC, 0xFFFFFFFF);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2328
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2329
	cls = __qClass(aString);
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
	i1 = __intVal(index1) - 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2332
	if (i1 >= 0) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2333
	    i2 = __intVal(index2) - 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2334
	    if (i2 < i1) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2335
		goto ret;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2336
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2337
3814
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  2338
	    cp = __stringVal(aString);
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2339
	    l = i2 - i1 + 1;
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 ((cls == @global(String)) || (cls == @global(Symbol))) {
3814
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  2342
		n = __stringSize(aString);
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2343
		if (i2 < n) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2344
		    cp += i1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2345
		    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
  2346
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2347
		    if (l > 32767) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2348
			l = 32767;
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
		    if (! TextOut(hDC, pX, pY, (char *)cp, l)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2351
			DFPRINTF((stderr, "WinPrinter [warning]: Textout failed. %d\n", GetLastError()));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2352
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2353
		    goto ret;
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
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2356
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2357
	    nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2358
	    cp += nInstBytes;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2359
	    n = __byteArraySize(aString) - nInstBytes;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2360
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2361
	    if (__isBytes(aString)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2362
		if (i2 < n) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2363
		    cp += i1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2364
		    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
  2365
		    if (l > 32767) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2366
			l = 32767;
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
		    if (! TextOut(hDC, pX, pY, (char *)cp, l)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2369
			DFPRINTF((stderr, "WinPrinter [warning]: Textout failed. %d\n", GetLastError()));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2370
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2371
		    goto ret;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2372
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2373
	    }
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
	    /* Unicode */
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2376
	    if (__isWords(aString)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2377
		n = n / 2;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2378
		if (i2 < n) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2379
		    WIDECHAR *w_cp = (WIDECHAR *)cp;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2380
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2381
		    w_cp += i1;
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
		    if (! TextOutW(hDC, pX, pY, w_cp, l)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2384
			DFPRINTF((stderr, "WinPrinter [warning]: TextoutW failed. %d\n", GetLastError()));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2385
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2386
		    goto ret;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2387
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2388
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2389
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2390
ret:
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2391
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2392
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2393
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2394
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2395
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2396
    "Created: / 28-07-2006 / 20:35:19 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2397
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2398
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2399
displayString:aString x:x y:y in:aDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2400
    "draw a string - draw foreground only.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2401
     If the coordinates are not integers, retry with rounded."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2402
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2403
    self
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2404
	displayString:aString
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2405
	x:x
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2406
	y:y
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2407
	in:aDrawableId
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2408
	with:aDC
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2409
	opaque:false
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2410
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2411
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2412
displayString:aString x:x y:y in:aDrawableId with:aDC opaque:opaque
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2413
    "draw a string"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2414
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2415
    self displayString:aString
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2416
		  from:1
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2417
		    to:aString size
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2418
		     x:x
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2419
		     y:y
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2420
		     in:aDrawableId
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2421
		     with:aDC
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2422
		     opaque:opaque
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2423
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2424
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2425
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
  2426
	       in:ignoredDrawableId with:aDC
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2427
    "fill an arc. If any coordinate is not integer, an error is triggered.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2428
     The angles may be floats or integer - they are given in degrees."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2429
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2430
    | hatchSymbol |
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2431
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2432
    hatchSymbol := self hatch.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2433
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2434
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2435
    int __x, __y, w, h;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2436
    float angle1, angle2;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2437
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2438
    if (__isSmallInteger(startAngle))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2439
	angle1 = (float)(__intVal(startAngle));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2440
    else if (__isFloat(startAngle)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2441
	angle1 = __floatVal(startAngle);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2442
    } else if (__isShortFloat(startAngle)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2443
	angle1 = __shortFloatVal(startAngle);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2444
    } else goto bad;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2445
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2446
    if (__isSmallInteger(angle))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2447
	angle2 = (float)(__intVal(angle));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2448
    else if (__isFloat(angle)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2449
	angle2 = __floatVal(angle);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2450
    } else if (__isShortFloat(angle)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2451
	angle2 = __shortFloatVal(angle);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2452
    } else goto bad;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2453
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2454
    if (angle2 <= 0) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2455
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2456
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2457
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2458
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2459
     && __bothSmallInteger(x, y)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2460
     && __bothSmallInteger(width, height))
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2461
     {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2462
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2463
	HBRUSH hBrush, prevBrush;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2464
	HPEN prevPen = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2465
	COLORREF fgColor;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2466
	int hatch, hasHatch;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2467
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2468
	w = __intVal(width);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2469
	h = __intVal(height);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2470
	__x = __intVal(x);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2471
	__y = __intVal(y);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2472
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2473
	fgColor = GetTextColor(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2474
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2475
	hasHatch= 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2476
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2477
	if (hatchSymbol == @symbol(none)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2478
	    hasHatch= 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2479
	} else if (hatchSymbol == @symbol(horizontal)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2480
	    hatch= HS_HORIZONTAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2481
	} else if (hatchSymbol == @symbol(vertical)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2482
	    hatch= HS_VERTICAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2483
	} else if (hatchSymbol == @symbol(cross)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2484
	    hatch= HS_CROSS;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2485
	} else if (hatchSymbol == @symbol(bDiagonal)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2486
	    hatch= HS_BDIAGONAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2487
	} else if (hatchSymbol == @symbol(fDiagonal)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2488
	    hatch= HS_FDIAGONAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2489
	} else if (hatchSymbol == @symbol(diagonalCross)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2490
	    hatch= HS_DIAGCROSS;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2491
	} else
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2492
	    hasHatch= 0;
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
	if (hasHatch) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2495
	    hBrush = CreateHatchBrush(hatch, fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2496
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2497
	    hBrush = CreateSolidBrush(fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2498
	}
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
	prevBrush = SelectObject(hDC, hBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2501
	if (hBrush == 0) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2502
	    DPRINTF(("fillArc: no brush\n"));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2503
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2504
	    HPEN hPen = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2505
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2506
	    if (0 /* __isWinNT */) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2507
		fgColor = GetTextColor(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2508
		hPen = CreatePen(PS_SOLID, 1, fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2509
		prevPen = SelectObject(hDC, hPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2510
		if (hPen == 0) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2511
		    DPRINTF(("fillArc: no pen\n"));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2512
		    goto failpen;
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
	    } else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2515
		prevPen = SelectObject(hDC, GetStockObject(NULL_PEN));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2516
		w++;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2517
		h++;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2518
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2519
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2520
	    {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2521
		double xB, yB, xE, yE, xR, yR;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2522
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2523
		xR = w / 2;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2524
		yR = h / 2;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2525
		if (angle2 - angle1 >= 360) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2526
		    xB = xE = __x + xR + 0.5;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2527
		    yB = yE = __y /*+ yR + 0.5*/;
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
		    double sin(), cos();
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2530
		    float rad1, rad2;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2531
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2532
		    if (angle1 <= 180)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2533
			angle1 = 180 - angle1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2534
		    else
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2535
			angle1 = 360 + 180 - angle1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2536
		    angle2 = angle1 - angle2;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2537
		    /* sigh - compute the intersections ... */
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2538
		    rad1 = (angle1 * 3.14159265359) / 180.0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2539
		    rad2 = (angle2 * 3.14159265359) / 180.0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2540
		    xB = cos(rad1) * xR;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2541
		    yB = sin(rad1) * yR;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2542
		    xE = cos(rad2) * xR;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2543
		    yE = sin(rad2) * yR;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2544
		    xB = __x + xR - xB + 0.5;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2545
		    yB = __y + yR - yB + 0.5;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2546
		    xE = __x + xR - xE + 0.5;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2547
		    yE = __y + yR - yE + 0.5;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2548
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2549
		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
  2550
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2551
		Pie(hDC,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2552
		    __x, __y,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2553
		    __x + w + 1, __y + h + 1,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2554
		    (int)xB, (int)yB,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2555
		    (int)xE, (int)yE);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2556
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2557
		if (hPen) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2558
		    DeleteObject(hPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2559
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2560
	    }
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2561
failpen:
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2562
	    if (prevPen) SelectObject(hDC, prevPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2563
	    DeleteObject(hPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2564
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2565
	    SelectObject(hDC, prevBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2566
	    DeleteObject(hBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2567
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2568
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2569
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2570
    bad: ;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2571
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2572
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2573
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2574
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2575
fillPolygon:aPolygon in:ignoredDrawableId with:aGCId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2576
    "fill a polygon given by its points.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2577
     If any coordinate is not integer, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2578
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2579
    |numberOfPoints|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2580
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2581
    numberOfPoints := aPolygon size.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2582
    self
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2583
	primFillPolygon:aPolygon n:numberOfPoints
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  2584
	in:ignoredDrawableId with:aGCId
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2585
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2586
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2587
fillRectangleX:x y:y width:width height:height in:ignoredDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2588
    "fill a rectangle. If any coordinate is not integer, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2589
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2590
    |hatchSymbol|
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2591
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2592
    hatchSymbol := self hatch.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2593
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2594
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2595
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2596
    int w, h;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2597
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2598
     && __bothSmallInteger(x, y)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2599
     && __bothSmallInteger(width, height)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2600
	w = __intVal(width);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2601
	h = __intVal(height);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2602
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2603
	if ((w >= 0) && (h >= 0)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2604
	    HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2605
	    HBRUSH hBrush, prevBrush;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2606
	    RECT rct;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2607
	    COLORREF fgColor;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2608
	    int hatch, hasHatch;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2609
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2610
	    fgColor = GetTextColor(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2611
	    hasHatch= 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2612
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2613
	    if (hatchSymbol == @symbol(none)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2614
		hasHatch= 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2615
	    } else if (hatchSymbol == @symbol(horizontal)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2616
		hatch= HS_HORIZONTAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2617
	    } else if (hatchSymbol == @symbol(vertical)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2618
		hatch= HS_VERTICAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2619
	    } else if (hatchSymbol == @symbol(cross)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2620
		hatch= HS_CROSS;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2621
	    } else if (hatchSymbol == @symbol(bDiagonal)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2622
		hatch= HS_BDIAGONAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2623
	    } else if (hatchSymbol == @symbol(fDiagonal)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2624
		hatch= HS_FDIAGONAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2625
	    } else if (hatchSymbol == @symbol(diagonalCross)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2626
		hatch= HS_DIAGCROSS;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2627
	    } else
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2628
		hasHatch= 0;
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
	    if (hasHatch) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2631
		hBrush = CreateHatchBrush(hatch, fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2632
	    } else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2633
		hBrush = CreateSolidBrush(fgColor);
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
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2636
	    rct.left = __intVal(x);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2637
	    rct.top  = __intVal(y);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2638
	    rct.right  = rct.left + w; // + 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2639
	    rct.bottom = rct.top  + h; // + 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2640
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2641
	   prevBrush = SelectObject(hDC, hBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2642
	   FillRect(hDC, &rct, hBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2643
	   SelectObject(hDC, prevBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2644
	   DeleteObject(hBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2645
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2646
	}
2326
82077cd59898 *** empty log message ***
fm
parents: 2325
diff changeset
  2647
    }
82077cd59898 *** empty log message ***
fm
parents: 2325
diff changeset
  2648
    RETURN ( self );
2327
32f68e607e13 + displayString supports color
fm
parents: 2326
diff changeset
  2649
32f68e607e13 + displayString supports color
fm
parents: 2326
diff changeset
  2650
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2651
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2652
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2653
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2654
primFillPolygon:aPolygon n:numberOfPoints in:ignoredDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2655
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2656
    |hatchSymbol|
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2657
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2658
    hatchSymbol := self hatch.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  2659
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2660
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2661
    OBJ point, px, py;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2662
    int i, num;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2663
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2664
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2665
     && __isSmallInteger(numberOfPoints)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2666
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2667
	POINT p;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2668
	HBRUSH hBrush, prevBrush;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2669
	COLORREF fgColor;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2670
	int hatch, hasHatch;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2671
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2672
	num = __intVal(numberOfPoints);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2673
	if (num < 3) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2674
	    RETURN ( self );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2675
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2676
	for (i=0; i<num; i++) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2677
	    point = __AT_(aPolygon, __MKSMALLINT(i+1));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2678
	    if (! __isPoint(point)) goto fail;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2679
	    px = _point_X(point);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2680
	    py = _point_Y(point);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2681
	    if (! __bothSmallInteger(px, py))
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2682
		goto fail;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2683
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2684
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2685
	fgColor = GetTextColor(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2686
	hasHatch= 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2687
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2688
	if (hatchSymbol == @symbol(none)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2689
	    hasHatch= 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2690
	} else if (hatchSymbol == @symbol(horizontal)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2691
	    hatch= HS_HORIZONTAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2692
	} else if (hatchSymbol == @symbol(vertical)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2693
	    hatch= HS_VERTICAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2694
	} else if (hatchSymbol == @symbol(cross)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2695
	    hatch= HS_CROSS;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2696
	} else if (hatchSymbol == @symbol(bDiagonal)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2697
	    hatch= HS_BDIAGONAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2698
	} else if (hatchSymbol == @symbol(fDiagonal)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2699
	    hatch= HS_FDIAGONAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2700
	} else if (hatchSymbol == @symbol(diagonalCross)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2701
	    hatch= HS_DIAGCROSS;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2702
	} else
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2703
	    hasHatch= 0;
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 (hasHatch) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2706
	    hBrush = CreateHatchBrush(hatch, fgColor);
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
	    hBrush = CreateSolidBrush(fgColor);
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
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2711
	if (hBrush == 0) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2712
	    DPRINTF(("fillPolygon: no brush\n"));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2713
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2714
	    HPEN prevPen;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2715
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2716
	    prevBrush = SelectObject(hDC, hBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2717
	    prevPen = SelectObject(hDC, GetStockObject(NULL_PEN));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2718
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2719
	    BeginPath(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2720
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2721
	    for (i=0; i<num; i++) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2722
		point = __AT_(aPolygon, __MKSMALLINT(i+1));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2723
		px = _point_X(point);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2724
		py = _point_Y(point);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2725
		if (i == 0) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2726
		    MoveToEx(hDC, __intVal(px), __intVal(py), NULL);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2727
		} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2728
		    if (i == (num-1)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2729
			p.x = __intVal(px);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2730
			p.y = __intVal(py);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2731
			PolylineTo(hDC, &p, 1);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2732
		    } else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2733
			LineTo(hDC, __intVal(px), __intVal(py));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2734
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2735
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2736
	    }
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
	    EndPath(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2739
	    FillPath(hDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2740
	    SelectObject(hDC, prevPen);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2741
	    SelectObject(hDC, prevBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2742
	    DeleteObject(hBrush);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2743
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2744
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2745
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2746
fail: ;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2747
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2748
%}
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2749
!
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2750
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2751
scaleTest_displayString:aString x:x y:y
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2752
    "draw a string at the coordinate x/y -
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2753
     draw foreground-pixels only (in current paint-color),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2754
     leaving background as-is. If the transformation involves scaling,
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2755
     the fonts point-size is scaled as appropriate."
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2756
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2757
    |id pX pY fontUsed sz s fontsEncoding|
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2758
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2759
    "hook for non-strings (i.e. attributed text)"
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2760
    (aString isString not
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2761
    or:[aString isText]) ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2762
	^ aString displayOn:self x:x y:y
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2763
    ].
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2764
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2765
    gcId isNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2766
	self initGC
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2767
    ].
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2768
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2769
    fontUsed := font.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2770
    transformation notNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2771
	pX := transformation applyToX:x.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2772
	pY := transformation applyToY:y.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2773
	transformation noScale ifFalse:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2774
	    sz := font size.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2775
	    sz isNil ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2776
		"/ oops - not a real font; use original font
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2777
		fontUsed := font
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2778
	    ] ifFalse:[ |yS|
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2779
		yS := self pixelsPerInchOfScreenHeight / Screen current verticalPixelPerInch.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2780
		yS := self scale y / yS.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2781
		fontUsed := font size:(sz * yS) rounded.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2782
	    ]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2783
	]
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2784
    ] ifFalse:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2785
	pX := x.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2786
	pY := y.
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2787
    ].
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2788
    pX := pX rounded.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2789
    pY := pY rounded.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2790
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2791
    s := aString.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2792
    fontUsed := fontUsed onDevice:device.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2793
    fontsEncoding := fontUsed encoding.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2794
    (characterEncoding ~~ fontsEncoding) ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2795
	[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2796
	    s := CharacterEncoder encodeString:s from:characterEncoding into:fontsEncoding.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2797
	] on:CharacterEncoderError do:[:ex|
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2798
	    "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
  2799
	     in the new character set"
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2800
	    ex proceedWith:ex defaultValue.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2801
	].
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2802
    ].
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2803
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2804
    id := fontUsed fontId.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2805
    id isNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2806
	"hook for alien fonts"
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2807
	fontUsed displayString:s x:x y:y in:self
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2808
    ] ifFalse:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2809
	deviceFont ~~ fontUsed ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2810
	    device setFont:id in:gcId.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2811
	    deviceFont := fontUsed
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2812
	].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2813
	device displayString:s x:pX y:pY in:drawableId with:gcId
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2814
    ]
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2815
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  2816
    "Modified: 1.7.1997 / 17:08:35 / cg"
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2817
! !
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2818
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2819
!WinPrinterContext methodsFor:'drawing bitmaps'!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2820
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2821
bitsBlue
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2822
    "return the number of valid bits in the red component."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2823
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2824
"/    bitsRed isNil ifTrue:[
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2825
"/        "/ not a truecolor display
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2826
"/        ^ bitsPerRGB
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2827
"/    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2828
"/    ^ bitsRed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2829
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2830
     ^Display bitsBlue
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2831
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2832
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2833
bitsGreen
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2834
    "return the number of valid bits in the red component."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2835
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2836
"/    bitsRed isNil ifTrue:[
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2837
"/        "/ not a truecolor display
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2838
"/        ^ bitsPerRGB
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2839
"/    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2840
"/    ^ bitsRed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2841
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2842
     ^Display bitsGreen
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2843
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2844
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2845
bitsRed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2846
    "return the number of valid bits in the red component."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2847
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2848
"/    bitsRed isNil ifTrue:[
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2849
"/        "/ not a truecolor display
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2850
"/        ^ bitsPerRGB
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2851
"/    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2852
"/    ^ bitsRed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2853
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2854
     ^Display bitsRed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2855
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2856
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2857
compressColorMapImage: image
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2858
    "calculates a new color map for the image, using only used colors"
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2859
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2860
    |depth newColorMap newImage oldImage usedColors oldToNew oldBits newBits tmpBits|
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2861
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2862
    oldImage := image.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2863
    depth := oldImage depth.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2864
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2865
    oldImage photometric ~~ #palette ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2866
	Transcript showCR:'Compress colorMap: Only palette images have colormaps.'.
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
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2870
    usedColors := oldImage realUsedColors.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2871
    usedColors size == (1 bitShift:depth) ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2872
	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
  2873
	^ image
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2874
    ].
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2875
    usedColors size == oldImage colorMap size ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2876
	Transcript showCR:'Compress colorMap: Colormap already compressed - no compression.'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2877
	^ image
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2878
    ].
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2879
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2880
	"/ translation table
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2881
	oldToNew := ByteArray new:(1 bitShift:depth).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2882
	newColorMap := usedColors asArray.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2883
	newColorMap sort:self sortBlockForColors.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2884
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2885
	oldImage colorMap asArray keysAndValuesDo:[:oldIdx :clr |
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2886
	    |newPixel|
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
	    (usedColors includes:clr) ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2889
		newPixel := newColorMap indexOf:clr.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2890
		oldToNew at:oldIdx put:newPixel-1.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2891
	    ]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2892
	].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2893
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2894
	oldBits := oldImage bits.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2895
	newBits := ByteArray new:(oldBits size).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2896
	depth ~~ 8 ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2897
	    "/ expand/compress can only handle 8bits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2898
	    tmpBits := ByteArray uninitializedNew:(oldImage width*oldImage height).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2899
	    oldBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2900
		expandPixels: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:tmpBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2904
		mapping:oldToNew.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2905
	    tmpBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2906
		compressPixels:depth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2907
		width:oldImage width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2908
		height:oldImage height
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2909
		into:newBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2910
		mapping:nil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2911
	] ifFalse:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2912
	    oldBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2913
		expandPixels:depth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2914
		width:oldImage width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2915
		height:oldImage height
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2916
		into:newBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2917
		mapping:oldToNew.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2918
	].
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 := oldImage species new
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2921
			width:oldImage width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2922
			height:oldImage height
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2923
			depth:depth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2924
			fromArray:newBits.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2925
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2926
	newImage colorMap:newColorMap.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2927
	newImage fileName:oldImage fileName.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2928
	newImage mask:(oldImage mask copy).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2929
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2930
	^ newImage
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2931
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2932
    "Created: / 28.7.1998 / 20:03:11 / cg"
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2933
    "Modified: / 15.9.1998 / 17:53:32 / cg"
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2934
!
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  2935
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2936
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
  2937
		width:w height:h
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2938
    "do a bit-blt; copy bits from the rectangle defined by
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2939
     srcX/srcY and w/h from the sourceId drawable to the rectangle
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2940
     below dstX/dstY in the destId drawable. Trigger an error if any
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2941
     argument is not integer."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2942
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2943
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2944
    int     dstGcOwnerThreadID;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2945
    HWND    dstGcHWIN;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2946
    HBITMAP dstGcHBITMAP;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2947
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2948
    if (! __isExternalAddressLike(srcGCId)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2949
     || ! __isExternalAddressLike(dstGCId)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2950
	goto fail;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2951
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2952
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2953
    if (__bothSmallInteger(w, h)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2954
     && __bothSmallInteger(srcX, srcY)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2955
     && __bothSmallInteger(dstX, dstY)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2956
	HANDLE srcDC = (HANDLE)(__externalAddressVal(srcGCId));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2957
	HANDLE dstDC = (HANDLE)(__externalAddressVal(dstGCId));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2958
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2959
	int fun;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2960
	OBJ aFunctionSymbol;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2961
	int src_fg, src_bg, dst_fg, dst_bg;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2962
	char buf[5];
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2963
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2964
//          fun = dstGcData->bitbltrop2;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2965
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2966
	aFunctionSymbol= __INST(function);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2967
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2968
	if (aFunctionSymbol == @symbol(copy)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2969
	    fun = SRCCOPY /* R2_COPYPEN */ ;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2970
/*            bfun = BITBLT_COPY;                                          */
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2971
	} else if (aFunctionSymbol == @symbol(copyInverted)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2972
	    fun = NOTSRCCOPY /* R2_NOTCOPYPEN */;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2973
/*            bfun = BITBLT_COPYINVERTED;                                  */
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2974
	} else if (aFunctionSymbol == @symbol(xor)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2975
	    fun = SRCINVERT /* R2_XORPEN */;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2976
/*            bfun = BITBLT_XOR;                                           */
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2977
	} else if (aFunctionSymbol == @symbol(and)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2978
	    fun = SRCAND /* R2_MASKPEN */ ;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2979
/*            bfun = BITBLT_AND;                                           */
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2980
	} else if (aFunctionSymbol == @symbol(or)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2981
	    fun = MERGECOPY /* R2_MERGEPEN */ ;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2982
/*            bfun = BITBLT_OR;                                            */
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2983
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2984
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2985
    // convert 123 to string [buf]
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  2986
    // itoa(fun, buf, 10);
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  2987
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  2988
    //        console_printf(" ", buf);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2989
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2990
/*
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  2991
#if 0
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2992
	switch (fun) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2993
	  case BITBLT_COPY:
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2994
	    console_printf("BITBLT_COPY\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_COPYINVERTED:
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  2997
	    console_printf("BITBLT_COPYINVERTED\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_XOR:
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3000
	    console_printf("BITBLT_XOR\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
	  case BITBLT_AND:
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3003
	    console_printf("BITBLT_AND\n");
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3004
	    break;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3005
	  case BITBLT_OR:
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3006
	    console_printf("BITBLT_OR\n");
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3007
	    break;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3008
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3009
#endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3010
*/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3011
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3012
//          fun = dstGcData->bitbltrop2;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3013
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3014
	if (0 /* fun == BITBLT_COPY */) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3015
	    src_fg = dst_fg = 0xFFFFFF;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3016
	    src_bg = dst_bg = 0x000000;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3017
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3018
	    src_fg = GetTextColor(srcDC) /* srcGcData->fgColor */;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3019
	    src_bg = GetBkColor(dstDC) /* srcGcData->bgColor */;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3020
	    dst_fg = GetTextColor(srcDC) /* dstGcData->fgColor */;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3021
	    dst_bg = GetBkColor(dstDC) /* dstGcData->bgColor */;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3022
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3023
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3024
	SetBkColor(dstDC, dst_fg);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3025
	SetTextColor(dstDC, dst_bg);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3026
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3027
	SetBkColor(srcDC, src_fg);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3028
	SetTextColor(srcDC, src_bg);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3029
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3030
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3031
	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
  3032
	CPRINTF(("dst f:%x b:%x\n",GetTextColor(dstDC),GetBkColor(dstDC)));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3033
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3034
	if (BitBlt(dstDC,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3035
	     __intVal(dstX), __intVal(dstY),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3036
	     __intVal(w), __intVal(h),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3037
	     srcDC,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3038
	     __intVal(srcX), __intVal(srcY),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3039
	     fun)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3040
	   == 0
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3041
	  ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3042
	    console_fprintf(stderr, "WinWorkstation [info]: ERROR in BitBlt\n");
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3043
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3044
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3045
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3046
	if (dstGcData != srcGcData) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3047
	    SetBkColor(dstDC, dstGcData->bgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3048
	    SetTextColor(dstDC, dstGcData->fgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3049
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3050
	SetBkColor(srcDC, srcGcData->bgColor);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3051
	SetTextColor(srcDC, srcGcData->fgColor);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3052
*/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3053
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3054
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3055
	if (srcGcData != dstGcData) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3056
	    _releaseDC(srcGcData);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3057
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3058
	_releaseDC(dstGcData);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3059
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3060
	RETURN ( self );
2323
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
 fail: ;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3064
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3065
    self primitiveFailed.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3066
    ^ nil
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3067
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3068
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3069
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
  3070
    "do a bit-blt from a pix- or bitmap.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3071
     Here, fall back into copyFromId:, which should also work.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3072
     Subclasses may redefine this for more performance or if required"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3073
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3074
    ^ 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
  3075
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3076
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3077
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
  3078
		width:w height:h
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3079
    "do a bit-blt, but only copy the low-bit plane;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3080
     copy bits from the rectangle defined by
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3081
     srcX/srcY and w/h from the sourceId drawable to the rectangle
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3082
     below dstX/dstY in the destId drawable. Trigger an error if any
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3083
     argument is not integer."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3084
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3085
    ^ self
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3086
	copyFromId:sourceId
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3087
		 x:srcX y:srcY gc:srcDCId
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3088
		to:destId x:dstX y:dstY gc:dstDCId
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3089
	     width:w height:h
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3090
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3091
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3092
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
  3093
    "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
  3094
     Here, fall back into copyPlaneFromId:, which should also work.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3095
     Subclasses may redefine this for more performance or if required"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3096
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3097
    ^ 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
  3098
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3099
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3100
createBitmapFromArray:anArray width:w height:h
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3101
    |bitmapId|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3102
2325
634b74929d2d *** empty log message ***
fm
parents: 2324
diff changeset
  3103
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3104
    bitmapId := self primCreateBitmapFromArray:anArray width:w height:h.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3105
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3106
    bitmapId isNil ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3107
	'WINWORKSTATION: cannot create bitmap' errorPrintCR.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3108
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3109
    ^ bitmapId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3110
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3111
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3112
createPixmapWidth:w height:h depth:d
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3113
    "allocate a pixmap on the Xserver, the contents is undefined
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3114
     (i.e. random). Return a bitmap id or nil"
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3115
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3116
%{
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3117
    HANDLE newBitmapHandle;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3118
    HANDLE rootDC = CreateDC("DISPLAY", NULL, NULL, NULL);
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3119
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3120
    /*console_printf("CreateBitmap Color\n");*/
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3121
    if (__bothSmallInteger(w, h) && __isSmallInteger(d) /*&& ISCONNECTED */) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3122
	if (__intVal(d) == 1) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3123
	    newBitmapHandle = CreateBitmap(__intVal(w), __intVal(h) , 1, 1, NULL);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3124
	} else {
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3125
#if 0
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3126
	    if (__intVal(d) != __depth) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3127
		console_printf("invalid depth\n");
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3128
		RETURN (nil);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3129
	    }
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3130
#endif
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3131
	    newBitmapHandle = CreateCompatibleBitmap(rootDC, __intVal(w), __intVal(h) );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3132
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3133
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3134
	if (newBitmapHandle) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3135
	    RETURN ( __MKEXTERNALADDRESS(newBitmapHandle));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3136
	}
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3137
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3138
	DPRINTF(("empty bitmap handle = %x\n", newBitmapHandle));
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3139
*/
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3140
    }
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3141
    RETURN (nil);
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3142
%}
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3143
!
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3144
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3145
destroyPixmap:aDrawableId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3146
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3147
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3148
    if (__isExternalAddress(aDrawableId) /* && ISCONNECTED */ ) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3149
	HANDLE bitmapHandle = _HANDLEVal(aDrawableId);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3150
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3151
	if (bitmapHandle) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3152
	    DeleteObject(bitmapHandle);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3153
	/*    _DeleteObject(bitmapHandle, __LINE__);    */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3154
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3155
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3156
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3157
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3158
2329
f5a1833995a1 to do #displayDeviceForm:aForm x:x y:y
fm
parents: 2328
diff changeset
  3159
displayDeviceForm:aForm x:x y:y
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3160
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3161
    |sortedImage formMask bitsWithTransparency redVector greenVector blueVector|
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3162
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3163
    sortedImage := aForm.
2341
cf7b3de4f3ef *** empty log message ***
fm
parents: 2340
diff changeset
  3164
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3165
    "Image 16 bits"
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3166
    aForm depth = 16 ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3167
	bitsWithTransparency := aForm bits.
2341
cf7b3de4f3ef *** empty log message ***
fm
parents: 2340
diff changeset
  3168
    ].
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3169
    "Image 24 and 32 bits"
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3170
    aForm depth >= 24 ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3171
	|bestFormat|
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3172
	bestFormat := aForm bestSupportedImageFormatFor: Display.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3173
	bitsWithTransparency := aForm rgbImageBitsOn: Display bestFormat: bestFormat.
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3174
    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  3175
    "Image up to 8 bits"
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3176
    aForm depth <= 8 ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3177
	aForm depth < 8 ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3178
	    sortedImage := aForm asImageWithDepth: 8.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3179
	].
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3180
"/        sortedImage := self sortColorMapImage: aForm.
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3181
	sortedImage := self compressColorMapImage: sortedImage.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3182
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3183
	formMask := sortedImage mask.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3184
	formMask isNil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3185
	    ifTrue:[bitsWithTransparency := sortedImage bits ]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3186
	    ifFalse:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3187
		|bitsWithTransparencySize|
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3188
		formMask := formMask asImageWithDepth: sortedImage depth.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3189
		bitsWithTransparency := sortedImage bits copy.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3190
		bitsWithTransparencySize := bitsWithTransparency size.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3191
		formMask bits doWithIndex:[:maskBit :index |
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3192
		    bitsWithTransparencySize >= index ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3193
			maskBit == 0 ifTrue:[bitsWithTransparency at: index put: 255 "60" "bitClearAt: index"].
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3194
"/                    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
  3195
		    ].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3196
		].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3197
	].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3198
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3199
	redVector := sortedImage colorMap redVector.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3200
	greenVector := sortedImage colorMap greenVector.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3201
	blueVector := sortedImage colorMap blueVector.
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3202
    ].
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3203
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3204
    self
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3205
	 drawBits: bitsWithTransparency
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3206
	redVector: redVector
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3207
      greenVector: greenVector
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3208
       blueVector: blueVector
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3209
     bitsPerPixel: sortedImage bitsPerPixel
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3210
	    depth: sortedImage depth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3211
	    width: sortedImage width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3212
	   height: sortedImage height
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3213
	     into: self id
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3214
		x: x
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3215
		y: y
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3216
	    width: sortedImage width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3217
	   height: sortedImage height
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3218
	     with: gcId.
2329
f5a1833995a1 to do #displayDeviceForm:aForm x:x y:y
fm
parents: 2328
diff changeset
  3219
!
f5a1833995a1 to do #displayDeviceForm:aForm x:x y:y
fm
parents: 2328
diff changeset
  3220
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3221
drawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth padding:padd
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3222
			  width:imageWidth height:imageHeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3223
			      x:srcx y:srcy
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3224
			   into:ignoredDrawableId
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3225
			      x:dstx y:dsty
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3226
			  width:w height:h
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3227
			   with:aGCId
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3228
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3229
    "draw a bitImage which has depth id, width iw and height ih into
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3230
     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
  3231
     Individual source pixels have bitsPerPixel bits, allowing to draw
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3232
     depth and pixel-units to be different.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3233
     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
  3234
     depth - otherwise, primitive failure will be signalled.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3235
     Also it is assumed, that the colormap is setup correctly and the
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3236
     colors are allocated - otherwise the colors may be wrong."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3237
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3238
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3239
     sorry; I had to separate it into 2 methods, since XPutImage needs
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3240
     an unlimited stack, and thus cannot send primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3241
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3242
    (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
  3243
					width:imageWidth height:imageHeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3244
					     x:srcx y:srcy
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3245
					  into:ignoredDrawableId
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3246
					     x:(dstx rounded) y:(dsty rounded)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3247
					 width:w height:h
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3248
					  with:aGCId)
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3249
    ifFalse:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3250
	"
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3251
	 also happens, if a segmentation violation occurs in the
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3252
	 XPutImage ...
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3253
	"
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3254
	self primitiveFailed
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3255
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3256
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3257
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3258
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
  3259
			      width:imageWidth height:imageHeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3260
			       into:ignoredDrawableId
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3261
				  x:dstx y:dsty
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3262
			      width:w height:h
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3263
			       with:aGCId
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3264
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3265
    "draw a bitImage which has depth id, width iw and height ih into
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3266
     the drawable. draw a region of w/h pixels from srcx/srcy to dstx/dsty.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3267
     Individual source pixels have bitsPerPixel bits, allowing to draw
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3268
     depth and pixel-units to be different.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3269
     It has to be checked elsewhere, that the server can do it with the given
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3270
     depth - otherwise, primitive failure will be signalled.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3271
     Also it is assumed, that the colormap is setup correctly and the
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3272
     colors are allocated - otherwise the colors may be wrong."
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3273
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3274
    "
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3275
     sorry; I had to separate it into 2 methods, since XPutImage needs
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3276
     an unlimited stack, and thus cannot send primitiveFailed
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3277
    "
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3278
    (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
  3279
			      width:imageWidth height:imageHeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3280
			       into:ignoredDrawableId
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3281
				  x:(dstx rounded) y:(dsty rounded)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3282
			      width:w height:h
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3283
			       with:aGCId)
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3284
    ifFalse:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3285
	self primitiveFailed
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3286
    ].
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3287
!
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3288
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3289
primCreateBitmapFromArray:anArray width:w height:h
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3290
%{
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3291
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3292
    HBITMAP newBitmapHandle;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3293
    int b_width, b_height, bytesPerRowST, bytesPerRowWN, padding;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3294
    int row, col;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3295
    unsigned char *cp, *bPits;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3296
    unsigned char *b_bits = 0;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3297
    int index;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3298
    OBJ num;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3299
    unsigned char *allocatedBits = 0;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3300
    unsigned char fastBits[10000];
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3301
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3302
    if (__bothSmallInteger(w, h)
2818
37b97e4ebb01 Use __isArrayLike() and __isByteArrayLike()
Stefan Vogel <sv@exept.de>
parents: 2621
diff changeset
  3303
     && __isNonNilObject(anArray)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3304
	OBJ cls = __qClass(anArray);
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
	b_width = __intVal(w);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3307
	b_height = __intVal(h);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3308
	bytesPerRowST = (b_width + 7) / 8;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3309
	bytesPerRowWN = ((b_width + 15) / 16) * 2;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3310
	padding = bytesPerRowWN - bytesPerRowST;
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 ((padding == 0) && (cls == @global(ByteArray))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3313
	    b_bits = __ByteArrayInstPtr(anArray)->ba_element;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3314
	    cp = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3315
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3316
	    int nBytes = b_height * bytesPerRowWN;
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
	    if (nBytes < sizeof(fastBits)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3319
		cp = b_bits = fastBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3320
	    } else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3321
		cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3322
		if (! cp) goto fail;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3323
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3324
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3325
	if (cp) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3326
	    if (__qIsArrayLike(anArray)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3327
		OBJ *op;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3328
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3329
		index = 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3330
		op = &(__ArrayInstPtr(anArray)->a_element[index - 1]);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3331
		for (row = b_height; row; row--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3332
		    for (col = bytesPerRowST; col; col--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3333
			num = *op++;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3334
			if (! __isSmallInteger(num))
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3335
			    goto fail;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3336
			*cp++ = __intVal(num);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3337
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3338
		    cp += padding;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3339
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3340
	    } else if (__qIsByteArrayLike(anArray)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3341
		unsigned char *pBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3342
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3343
		pBits = __ByteArrayInstPtr(anArray)->ba_element;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3344
		for (row = b_height; row; row--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3345
		    for (col = bytesPerRowST; col; col--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3346
			*cp++ = ( *pBits++ /*^ 0xFF*/ );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3347
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3348
		    cp += padding;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3349
		}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3350
	    } else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3351
		goto fail;
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
	}
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
	CPRINTF(("create bitmap ...\n"));
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
	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
  3358
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3359
	if (newBitmapHandle ) {
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3360
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3361
	    DDPRINTF(("returning bitmap %x ...\n", newBitmapHandle));
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3362
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3363
	    if (allocatedBits) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3364
		free(allocatedBits);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3365
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3366
	    RETURN ( __MKEXTERNALADDRESS(newBitmapHandle));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3367
	}
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3368
    }
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3369
fail: ;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3370
/*
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3371
    DDPRINTF(("create bitmap FAILED!!!\n"));
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3372
*/
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3373
    if (allocatedBits) {
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3374
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3375
	CPRINTF(("freeing up bitmap bits ...\n"));
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3376
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3377
	free(allocatedBits);
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3378
    }
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3379
/*
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3380
    CPRINTF(("returning nil ...\n"));
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3381
*/
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3382
    RETURN ( nil );
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3383
%}
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3384
!
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3385
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3386
primDrawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth padding:padd
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3387
			      width:imageWidth height:imageHeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3388
				  x:srcx y:srcy
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3389
			       into:ignoredDrawableId
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3390
				  x:dstx y:dsty
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3391
			      width:w height:h
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3392
			       with:aGCId
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3393
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3394
    "since XPutImage may allocate huge amount of stack space
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3395
     (some implementations use alloca), this must run with unlimited stack."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3396
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3397
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3398
    unsigned char fastBits[10000];
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3399
    unsigned char *b_bits = 0;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3400
    unsigned char *allocatedBits = 0;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3401
    unsigned char *__imageBits = 0;
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 (__isByteArray(imageBits)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3404
	__imageBits = __ByteArrayInstPtr(imageBits)->ba_element;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3405
    } else if (__isExternalBytesLike(imageBits)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3406
	__imageBits = (unsigned char *)(__externalBytesAddress(imageBits));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3407
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3408
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3409
    if (/* ISCONNECTED
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3410
     && */ __isExternalAddressLike(aGCId)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3411
     && __bothSmallInteger(srcx, srcy)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3412
     && __bothSmallInteger(dstx, dsty)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3413
     && __bothSmallInteger(w, h)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3414
     && __bothSmallInteger(imageWidth, imageHeight)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3415
     && __bothSmallInteger(imageDepth, bitsPerPixel)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3416
     && __isSmallInteger(padd)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3417
     && __imageBits)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3418
     {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3419
	struct
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
	  BITMAPINFOHEADER bmiHeader;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3422
	  DWORD r;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3423
	  DWORD g;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3424
	  DWORD b;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3425
	} bitmap;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3426
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3427
	HANDLE hDC = (HANDLE)(__externalAddressVal(aGCId));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3428
	HBITMAP hBitmap = _HBITMAPVAL(__INST(drawableId));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3429
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3430
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3431
	DDPRINTF(("hDC = %x\n", hDC));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3432
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3433
	if (__intVal(padd) != WIN32PADDING) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3434
	    int row, col;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3435
	    unsigned char *cp;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3436
	    unsigned char *pBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3437
	    int b_width, b_height, bytesPerRowST, bytesPerRowWN, padding, nBytes;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3438
	    int bi = __intVal(bitsPerPixel);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3439
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3440
	    b_width = __intVal(w);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3441
	    b_height = __intVal(h);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3442
	    bytesPerRowST = (b_width * bi + (__intVal(padd)-1)) / __intVal(padd);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3443
	    bytesPerRowWN = (b_width * bi + (WIN32PADDING-1)) / WIN32PADDING * (WIN32PADDING/8);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3444
	    padding = bytesPerRowWN - bytesPerRowST;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3445
	    nBytes = b_height * bytesPerRowWN;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3446
	    /*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
  3447
	    if (padding) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3448
		if (nBytes < sizeof(fastBits)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3449
		    cp = b_bits = fastBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3450
		} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3451
		    cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
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
		if (cp) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3454
		    pBits = __imageBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3455
		    for (row = b_height; row; row--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3456
			for (col = bytesPerRowST; col; col--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3457
			    *cp++ = *pBits++;
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
			cp += padding;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3460
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3461
		} else
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3462
		    goto fail;
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
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3465
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3466
	if (b_bits == 0) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3467
	    b_bits = __imageBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3468
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3469
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3470
	bitmap.bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3471
	bitmap.bmiHeader.biPlanes = 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3472
	if (__intVal(imageDepth) == 24) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3473
	    /*bitmap.bmiHeader.biCompression = BI_BITFIELDS;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3474
	    bitmap.r = 0xff0000;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3475
	    bitmap.g = 0x00ff00;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3476
	    bitmap.b = 0x0000ff;*/
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3477
	    bitmap.bmiHeader.biCompression = BI_RGB;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3478
	} else if (__intVal(imageDepth) == 16) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3479
	    /*bitmap.bmiHeader.biCompression = BI_RGB;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3480
	    bitmap.bmiHeader.biCompression = BI_BITFIELDS;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3481
	    bitmap.b = 0x001f;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3482
	    bitmap.g = 0x07e0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3483
	    bitmap.r = 0xf800;*/
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3484
	    bitmap.b = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3485
	    bitmap.g = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3486
	    bitmap.r = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3487
	    bitmap.bmiHeader.biCompression = BI_RGB;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3488
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3489
	bitmap.bmiHeader.biSizeImage = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3490
	bitmap.bmiHeader.biXPelsPerMeter = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3491
	bitmap.bmiHeader.biYPelsPerMeter = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3492
	bitmap.bmiHeader.biClrUsed = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3493
	bitmap.bmiHeader.biClrImportant = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3494
	bitmap.bmiHeader.biWidth = __intVal(imageWidth);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3495
	bitmap.bmiHeader.biHeight = -(__intVal(imageHeight));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3496
	bitmap.bmiHeader.biBitCount = __intVal(bitsPerPixel);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3497
	/*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
  3498
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3499
	SetDIBitsToDevice(hDC,__intVal(dstx),__intVal(dsty),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3500
			      __intVal(w), __intVal(h),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3501
			      __intVal(srcx), __intVal(srcy),
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
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3506
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3507
	SetDIBits(hDC,hBitmap,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3508
			      0,__intVal(h),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3509
			      (void *)b_bits,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3510
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  3511
*/
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3512
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3513
	StretchDIBits(hDC,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3514
		      __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
  3515
		      __intVal(w), __intVal(h),                 // width & height of destination rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3516
		      __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
  3517
		      __intVal(w), __intVal(h),                 // width & height of source rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3518
		      (void *)b_bits,                           // bitmap bits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3519
		      (BITMAPINFO*)&bitmap,                     // bitmap data
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3520
		      DIB_RGB_COLORS,                           // usage options
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3521
		      SRCCOPY                                   // raster operation code
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3522
	);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3523
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3524
	if (allocatedBits) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3525
	    free(allocatedBits);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3526
	}
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
#ifndef CACHE_LAST_DC
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3529
	_releaseDC(gcData);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3530
#endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3531
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3532
	RETURN ( true );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3533
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3534
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3535
fail: ;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3536
/*
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3537
    PRINTF(("create temp bitmap FAILED!!!\n"));
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3538
*/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3539
    if (allocatedBits) {
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3540
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3541
	PRINTF(("freeing up temp bitmap bits ...\n"));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3542
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3543
	free(allocatedBits);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3544
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3545
/*
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3546
#ifndef CACHE_LAST_DC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3547
    if (hDC) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3548
	_releaseDC(gcData);
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3549
    }
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3550
#endif
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3551
*/
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3552
%}
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3553
.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3554
    ^ false
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3555
!
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3556
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3557
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
  3558
			      width:imageWidth height:imageHeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3559
			       into:ignoredDrawableId
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3560
				  x:dstx y:dsty
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3561
			      width:w height:h
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3562
			       with:aGCId
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3563
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3564
    "since XPutImage may allocate huge amount of stack space
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3565
     (some implementations use alloca), this must run with unlimited stack."
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3566
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3567
%{
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3568
    unsigned char fastBits[10000];
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3569
    unsigned char *b_bits = 0;
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3570
    unsigned char *allocatedBits = 0;
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3571
    unsigned char *__imageBits = 0;
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3572
    unsigned char *__redVector = 0;
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3573
    unsigned char *__greenVector = 0;
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3574
    unsigned char *__blueVector = 0;
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3575
    int padd = 8;
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3576
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3577
    if (__isByteArray(imageBits)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3578
	__imageBits = __ByteArrayInstPtr(imageBits)->ba_element;
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3579
    } else if (__isExternalBytesLike(imageBits)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3580
	__imageBits = (unsigned char *)(__externalBytesAddress(imageBits));
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(redVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3584
	__redVector = __ByteArrayInstPtr(redVector)->ba_element;
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3585
    } else if (__isExternalBytesLike(redVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3586
	__redVector = (unsigned char *)(__externalBytesAddress(redVector));
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(greenVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3590
	__greenVector = __ByteArrayInstPtr(greenVector)->ba_element;
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3591
    } else if (__isExternalBytesLike(greenVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3592
	__greenVector = (unsigned char *)(__externalBytesAddress(greenVector));
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 (__isByteArray(blueVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3596
	__blueVector = __ByteArrayInstPtr(blueVector)->ba_element;
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3597
    } else if (__isExternalBytesLike(blueVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3598
	__blueVector = (unsigned char *)(__externalBytesAddress(blueVector));
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3599
    }
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3600
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3601
    if (/* ISCONNECTED
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3602
     && */ __isExternalAddressLike(aGCId)
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3603
//     && __bothSmallInteger(srcx, srcy)
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3604
     && __bothSmallInteger(dstx, dsty)
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3605
     && __bothSmallInteger(w, h)
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3606
     && __bothSmallInteger(imageWidth, imageHeight)
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3607
     && __bothSmallInteger(imageDepth, bitsPerPixel)
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3608
     && __imageBits)
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3609
     {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3610
	struct
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3611
	{
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3612
	  BITMAPINFOHEADER bmiHeader;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3613
	  RGBQUAD bmiColors[256];
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3614
	} bitmap;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3615
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3616
	HANDLE hDC = (HANDLE)(__externalAddressVal(aGCId));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3617
	HBITMAP hBitmap = _HBITMAPVAL(__INST(drawableId));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3618
	int col;
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3619
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3620
	DDPRINTF(("hDC = %x\n", hDC));
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3621
*/
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3622
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3623
	if (padd != WIN32PADDING) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3624
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3625
	    int row, col;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3626
	    unsigned char *cp;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3627
	    unsigned char *pBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3628
	    int b_width, b_height, bytesPerRowST, bytesPerRowWN, padding, nBytes;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3629
	    int bi = __intVal(bitsPerPixel);
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3630
2340
7aada47a2ec0 changed #primDrawBits:redVector:greenVector:blueVector:bitsPerPixel:depth:width:height:into:x:y:width:height:with:
fm
parents: 2339
diff changeset
  3631
//            console_fprintf(stderr, "Non WIN32PADDING");
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3632
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3633
	    b_width = __intVal(w);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3634
	    b_height = __intVal(h);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3635
	    bytesPerRowST = (b_width * bi + (padd - 1 )) / padd;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3636
	    bytesPerRowWN = (b_width * bi + (WIN32PADDING-1)) / WIN32PADDING * (WIN32PADDING/8);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3637
	    padding = bytesPerRowWN - bytesPerRowST;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3638
	    nBytes = b_height * bytesPerRowWN;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3639
	    /*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
  3640
	    if (padding) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3641
		if (nBytes < sizeof(fastBits)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3642
		    cp = b_bits = fastBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3643
		} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3644
		    cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
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
		if (cp) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3647
		    pBits = __imageBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3648
		    for (row = b_height; row; row--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3649
			for (col = bytesPerRowST; col; col--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3650
			    *cp++ = *pBits++;
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
			cp += padding;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3653
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3654
		} else
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3655
		    goto fail;
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
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3658
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3659
	if (b_bits == 0) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3660
	    b_bits = __imageBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3661
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3662
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3663
	bitmap.bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3664
	bitmap.bmiHeader.biPlanes = 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3665
	bitmap.bmiHeader.biCompression = BI_RGB;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3666
	bitmap.bmiHeader.biSizeImage = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3667
	bitmap.bmiHeader.biXPelsPerMeter = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3668
	bitmap.bmiHeader.biYPelsPerMeter = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3669
	bitmap.bmiHeader.biClrUsed = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3670
	bitmap.bmiHeader.biClrImportant = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3671
	bitmap.bmiHeader.biWidth = __intVal(imageWidth);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3672
	bitmap.bmiHeader.biHeight = -(__intVal(imageHeight));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3673
	bitmap.bmiHeader.biBitCount = __intVal(bitsPerPixel);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3674
	/*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
  3675
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3676
	if (__intVal(imageDepth) <= 8) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3677
	    for(col=0;col<256;col++)
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
	      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
  3680
	      bitmap.bmiColors[col].rgbGreen = __greenVector[col];
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3681
	      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
  3682
	      bitmap.bmiColors[col].rgbReserved = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3683
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
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3686
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3687
	bitmap.bmiColors[255].rgbBlue=255;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3688
	bitmap.bmiColors[255].rgbGreen=255;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3689
	bitmap.bmiColors[255].rgbRed =255;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3690
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3691
	SetDIBitsToDevice(hDC,__intVal(dstx),__intVal(dsty),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3692
			      __intVal(w), __intVal(h),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3693
			      0, 0, /* __intVal(srcx), __intVal(srcy),    */
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3694
			      0,__intVal(h),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3695
			      (void *)b_bits,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3696
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
2338
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
	SetDIBits(hDC,hBitmap,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3699
			      0,__intVal(h),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3700
			      (void *)b_bits,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3701
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3702
*/
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3703
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3704
	StretchDIBits(hDC,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3705
		      __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
  3706
		      __intVal(w), __intVal(h),                 // width & height of destination rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3707
		      __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
  3708
		      __intVal(w), __intVal(h),                 // width & height of source rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3709
		      (void *)b_bits,                           // bitmap bits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3710
		      (BITMAPINFO*)&bitmap,                     // bitmap data
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3711
		      DIB_RGB_COLORS,                           // usage options
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3712
		      SRCCOPY                                   // raster operation code
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3713
	);
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3714
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3715
	if (allocatedBits) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3716
	    free(allocatedBits);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3717
	}
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3718
/*
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3719
#ifndef CACHE_LAST_DC
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3720
	_releaseDC(gcData);
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3721
#endif
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3722
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3723
	RETURN ( true );
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3724
    }
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3725
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3726
fail: ;
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3727
/*
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3728
    PRINTF(("create temp bitmap FAILED!!!\n"));
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3729
*/
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3730
    if (allocatedBits) {
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3731
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3732
	PRINTF(("freeing up temp bitmap bits ...\n"));
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3733
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3734
	free(allocatedBits);
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3735
    }
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3736
/*
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3737
#ifndef CACHE_LAST_DC
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3738
    if (hDC) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3739
	_releaseDC(gcData);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3740
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3741
#endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3742
*/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3743
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3744
.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3745
    ^ false
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3746
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3747
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3748
setFunction:aFunctionSymbol in:aGCId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3749
    "set alu function to be drawn with"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3750
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3751
    Transcript showCR: aFunctionSymbol printString.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3752
    function := aFunctionSymbol.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3753
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3754
"/%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3755
"/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3756
"/    if (__isExternalAddress(aGCId)) {
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3757
"/        struct gcData *gcData = _GCDATA(aGCId);
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3758
"/        int fun = -1;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3759
"/        int bfun = -1;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3760
"/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3761
"/        if (aFunctionSymbol == @symbol(copy)) {
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3762
"/            fun = R2_COPYPEN;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3763
"/            bfun = BITBLT_COPY;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3764
"/        } else if (aFunctionSymbol == @symbol(copyInverted)) {
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3765
"/            fun = R2_NOTCOPYPEN;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3766
"/            bfun = BITBLT_COPYINVERTED;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3767
"/        } else if (aFunctionSymbol == @symbol(xor)) {
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3768
"/            fun = R2_XORPEN;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3769
"/            bfun = BITBLT_XOR;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3770
"/        } else if (aFunctionSymbol == @symbol(and)) {
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3771
"/            fun = R2_MASKPEN;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3772
"/            bfun = BITBLT_AND;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3773
"/        } else if (aFunctionSymbol == @symbol(or)) {
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3774
"/            fun = R2_MERGEPEN;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3775
"/            bfun = BITBLT_OR;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3776
"/        }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3777
"/
2325
634b74929d2d *** empty log message ***
fm
parents: 2324
diff changeset
  3778
"/        if (fun
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3779
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3780
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3781
setGraphicsExposures:aBoolean in:aGCId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3782
    "set or clear the graphics exposures flag"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3783
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3784
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3785
shiftBlue
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3786
    "return the number of valid bits in the red component."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3787
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3788
"/    bitsRed isNil ifTrue:[
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3789
"/        "/ not a truecolor display
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3790
"/        ^ bitsPerRGB
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3791
"/    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3792
"/    ^ bitsRed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3793
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3794
     ^Display shiftBlue
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3795
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3796
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3797
shiftGreen
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3798
    "return the number of valid bits in the red component."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3799
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3800
"/    bitsRed isNil ifTrue:[
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3801
"/        "/ not a truecolor display
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3802
"/        ^ bitsPerRGB
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3803
"/    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3804
"/    ^ bitsRed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3805
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3806
     ^Display shiftGreen
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3807
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3808
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3809
shiftRed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3810
    "return the number of valid bits in the red component."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3811
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3812
"/    bitsRed isNil ifTrue:[
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3813
"/        "/ not a truecolor display
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3814
"/        ^ bitsPerRGB
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3815
"/    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3816
"/    ^ bitsRed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3817
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  3818
     ^Display shiftRed
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3819
!
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3820
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3821
sortBlockForColors
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3822
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3823
    ^ [:a :b |
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3824
	    a redByte == b redByte ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3825
		a greenByte == b greenByte ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3826
		    a blueByte < b blueByte
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3827
		] ifFalse:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3828
		    a greenByte < b greenByte
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3829
		]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3830
	    ] ifFalse:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3831
		a redByte < b redByte
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3832
	    ]
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3833
      ].
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3834
!
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3835
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3836
sortColorMapImage: image
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3837
    "calculates a new color map for the image, sorting colors"
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3838
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3839
    |sortBlock depth newColorMap newImage oldImage usedColors oldToNew oldBits newBits tmpBits|
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3840
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3841
    sortBlock := self sortBlockForColors.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3842
    oldImage := image.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3843
    depth := oldImage depth.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3844
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3845
    oldImage photometric ~~ #palette ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3846
	Transcript showCR:'Compress colorMap: Only palette images have colormaps.'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3847
	^ image
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3848
    ].
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3849
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3850
    usedColors := oldImage realColorMap.
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3851
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  3852
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3853
	"/ translation table
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3854
	oldToNew := ByteArray new:(1 bitShift:depth).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3855
	newColorMap := usedColors asArray.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3856
	newColorMap sort:sortBlock.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3857
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3858
	oldImage colorMap asArray keysAndValuesDo:[:oldIdx :clr |
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3859
	    |newPixel|
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
	    (usedColors includes:clr) ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3862
		newPixel := newColorMap indexOf:clr.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3863
		oldToNew at:oldIdx put:newPixel-1.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3864
	    ]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3865
	].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3866
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3867
	oldBits := oldImage bits.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3868
	newBits := ByteArray new:(oldBits size).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3869
	depth ~~ 8 ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3870
	    "/ expand/compress can only handle 8bits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3871
	    tmpBits := ByteArray uninitializedNew:(oldImage width*oldImage height).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3872
	    oldBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3873
		expandPixels: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:tmpBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3877
		mapping:oldToNew.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3878
	    tmpBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3879
		compressPixels:depth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3880
		width:oldImage width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3881
		height:oldImage height
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3882
		into:newBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3883
		mapping:nil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3884
	] ifFalse:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3885
	    oldBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3886
		expandPixels:depth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3887
		width:oldImage width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3888
		height:oldImage height
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3889
		into:newBits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3890
		mapping:oldToNew.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3891
	].
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 := oldImage species new
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3894
			width:oldImage width
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3895
			height:oldImage height
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3896
			depth:depth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3897
			fromArray:newBits.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3898
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3899
	newImage colorMap:newColorMap.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3900
	newImage fileName:oldImage fileName.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3901
	newImage mask:(oldImage mask copy).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3902
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3903
	^newImage
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3904
!
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3905
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3906
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
  3907
			      width:imageWidth height:imageHeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3908
			       into:ignoredDrawableId
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3909
				  x:dstx y:dsty
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3910
			      width:w height:h
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3911
			       with:aGCId
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3912
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3913
    "since XPutImage may allocate huge amount of stack space
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3914
     (some implementations use alloca), this must run with unlimited stack."
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3915
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3916
%{
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3917
    unsigned char fastBits[10000];
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3918
    unsigned char *b_bits = 0;
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3919
    unsigned char *allocatedBits = 0;
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3920
    unsigned char *__imageBits = 0;
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3921
    unsigned char *__redVector = 0;
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3922
    unsigned char *__greenVector = 0;
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3923
    unsigned char *__blueVector = 0;
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3924
    int padd = 8;
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3925
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3926
    if (__isByteArray(imageBits)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3927
	__imageBits = __ByteArrayInstPtr(imageBits)->ba_element;
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3928
    } else if (__isExternalBytesLike(imageBits)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3929
	__imageBits = (unsigned char *)(__externalBytesAddress(imageBits));
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(redVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3933
	__redVector = __ByteArrayInstPtr(redVector)->ba_element;
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3934
    } else if (__isExternalBytesLike(redVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3935
	__redVector = (unsigned char *)(__externalBytesAddress(redVector));
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(greenVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3939
	__greenVector = __ByteArrayInstPtr(greenVector)->ba_element;
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3940
    } else if (__isExternalBytesLike(greenVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3941
	__greenVector = (unsigned char *)(__externalBytesAddress(greenVector));
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 (__isByteArray(blueVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3945
	__blueVector = __ByteArrayInstPtr(blueVector)->ba_element;
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3946
    } else if (__isExternalBytesLike(blueVector)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3947
	__blueVector = (unsigned char *)(__externalBytesAddress(blueVector));
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3948
    }
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3949
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3950
    if (/* ISCONNECTED
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3951
     && */ __isExternalAddressLike(aGCId)
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3952
//     && __bothSmallInteger(srcx, srcy)
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3953
     && __bothSmallInteger(dstx, dsty)
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3954
     && __bothSmallInteger(w, h)
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3955
     && __bothSmallInteger(imageWidth, imageHeight)
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3956
     && __bothSmallInteger(imageDepth, bitsPerPixel)
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3957
     && __imageBits)
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3958
     {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3959
	struct
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3960
	{
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3961
	  BITMAPINFOHEADER bmiHeader;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3962
	  RGBQUAD bmiColors[256];
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3963
	} bitmap;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3964
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3965
	HANDLE hDC = (HANDLE)(__externalAddressVal(aGCId));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3966
	HBITMAP hBitmap = _HBITMAPVAL(__INST(drawableId));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3967
	int col;
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3968
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3969
	DDPRINTF(("hDC = %x\n", hDC));
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3970
*/
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3971
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3972
	if (padd != WIN32PADDING) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3973
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3974
	    int row, col;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3975
	    unsigned char *cp;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3976
	    unsigned char *pBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3977
	    int b_width, b_height, bytesPerRowST, bytesPerRowWN, padding, nBytes;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3978
	    int bi = __intVal(bitsPerPixel);
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3979
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3980
//            console_fprintf(stderr, "Non WIN32PADDING");
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  3981
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3982
	    b_width = __intVal(w);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3983
	    b_height = __intVal(h);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3984
	    bytesPerRowST = (b_width * bi + (padd - 1 )) / padd;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3985
	    bytesPerRowWN = (b_width * bi + (WIN32PADDING-1)) / WIN32PADDING * (WIN32PADDING/8);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3986
	    padding = bytesPerRowWN - bytesPerRowST;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3987
	    nBytes = b_height * bytesPerRowWN;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3988
	    /*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
  3989
	    if (padding) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3990
		if (nBytes < sizeof(fastBits)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3991
		    cp = b_bits = fastBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3992
		} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3993
		    cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
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
		if (cp) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3996
		    pBits = __imageBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3997
		    for (row = b_height; row; row--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3998
			for (col = bytesPerRowST; col; col--) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  3999
			    *cp++ = *pBits++;
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
			cp += padding;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4002
		    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4003
		} else
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4004
		    goto fail;
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
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4007
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4008
	if (b_bits == 0) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4009
	    b_bits = __imageBits;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4010
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4011
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4012
	bitmap.bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4013
	bitmap.bmiHeader.biPlanes = 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4014
	bitmap.bmiHeader.biCompression = BI_RGB;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4015
	bitmap.bmiHeader.biSizeImage = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4016
	bitmap.bmiHeader.biXPelsPerMeter = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4017
	bitmap.bmiHeader.biYPelsPerMeter = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4018
	bitmap.bmiHeader.biClrUsed = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4019
	bitmap.bmiHeader.biClrImportant = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4020
	bitmap.bmiHeader.biWidth = __intVal(imageWidth);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4021
	bitmap.bmiHeader.biHeight = -(__intVal(imageHeight));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4022
	bitmap.bmiHeader.biBitCount = __intVal(bitsPerPixel);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4023
	/*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
  4024
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4025
	if (__intVal(imageDepth) <= 8) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4026
	    for(col=0;col<256;col++)
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
	      bitmap.bmiColors[col].rgbBlue = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4029
	      bitmap.bmiColors[col].rgbGreen = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4030
	      bitmap.bmiColors[col].rgbRed = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4031
	      bitmap.bmiColors[col].rgbReserved = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4032
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4033
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4034
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4035
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4036
	bitmap.bmiColors[255].rgbBlue=255;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4037
	bitmap.bmiColors[255].rgbGreen=255;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4038
	bitmap.bmiColors[255].rgbRed =255;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4039
	bitmap.bmiColors[255].rgbReserved = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4040
	StretchDIBits(hDC,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4041
		      __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
  4042
		      __intVal(w), __intVal(h),                 // width & height of destination rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4043
		      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
  4044
		      __intVal(w), __intVal(h),                 // width & height of source rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4045
		      (void *)b_bits,                           // bitmap bits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4046
		      (BITMAPINFO*)&bitmap,                     // bitmap data
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4047
		      DIB_RGB_COLORS,                           // usage options
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4048
		      SRCAND                                   // raster operation code
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4049
	);
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4050
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4051
	if (__intVal(imageDepth) <= 8) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4052
	    for(col=0;col<256;col++)
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
	      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
  4055
	      bitmap.bmiColors[col].rgbGreen = __greenVector[col];
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4056
	      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
  4057
	      bitmap.bmiColors[col].rgbReserved = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4058
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4059
	    }
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4060
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4061
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4062
	bitmap.bmiColors[255].rgbBlue=0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4063
	bitmap.bmiColors[255].rgbGreen=0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4064
	bitmap.bmiColors[255].rgbRed =0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4065
	bitmap.bmiColors[255].rgbReserved = 0;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4066
	StretchDIBits(hDC,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4067
		      __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
  4068
		      __intVal(w), __intVal(h),                 // width & height of destination rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4069
		      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
  4070
		      __intVal(w), __intVal(h),                 // width & height of source rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4071
		      (void *)b_bits,                           // bitmap bits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4072
		      (BITMAPINFO*)&bitmap,                     // bitmap data
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4073
		      DIB_RGB_COLORS,                           // usage options
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4074
		      SRCPAINT                                  // raster operation code
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4075
	);
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4076
 */
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4077
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4078
	SetDIBitsToDevice(hDC,__intVal(dstx),__intVal(dsty),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4079
			      __intVal(w), __intVal(h),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4080
			      0, 0,
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
	SetDIBits(hDC,hBitmap,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4087
			      0,__intVal(h),
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4088
			      (void *)b_bits,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4089
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4090
*/
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4091
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4092
	StretchDIBits(hDC,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4093
		      __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
  4094
		      __intVal(w), __intVal(h),                 // width & height of destination rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4095
		      __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
  4096
		      __intVal(w), __intVal(h),                 // width & height of source rectangle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4097
		      (void *)b_bits,                           // bitmap bits
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4098
		      (BITMAPINFO*)&bitmap,                     // bitmap data
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4099
		      DIB_RGB_COLORS,                           // usage options
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4100
		      SRCCOPY                                   // raster operation code
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4101
	);
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4102
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4103
	if (allocatedBits) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4104
	    free(allocatedBits);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4105
	}
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4106
/*
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4107
#ifndef CACHE_LAST_DC
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4108
	_releaseDC(gcData);
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4109
#endif
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4110
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4111
	RETURN ( true );
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4112
    }
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4113
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4114
fail: ;
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4115
/*
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4116
    PRINTF(("create temp bitmap FAILED!!!\n"));
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4117
*/
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4118
    if (allocatedBits) {
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4119
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4120
	PRINTF(("freeing up temp bitmap bits ...\n"));
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4121
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4122
	free(allocatedBits);
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4123
    }
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4124
/*
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4125
#ifndef CACHE_LAST_DC
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4126
    if (hDC) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4127
	_releaseDC(gcData);
2343
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4128
    }
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4129
#endif
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4130
*/
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4131
%}
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4132
.
b7ef200fbfad *** empty log message ***
fm
parents: 2342
diff changeset
  4133
    ^ false
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4134
! !
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4135
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4136
!WinPrinterContext methodsFor:'font stuff'!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4137
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4138
createFontFor:aFontName
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4139
    "a basic method for font allocation; this method allows
3745
fcabc71e2930 #DOCUMENTATION
mawalch
parents: 3719
diff changeset
  4140
     any font to be acquired (even those not conforming to
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4141
     standard naming conventions, such as cursor, fixed or k14)"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4142
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4143
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4144
    HGDIOBJ hFont;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4145
    char *fn;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4146
2818
37b97e4ebb01 Use __isArrayLike() and __isByteArrayLike()
Stefan Vogel <sv@exept.de>
parents: 2621
diff changeset
  4147
    if (__isStringLike(aFontName)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4148
	fn = __stringVal(aFontName);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4149
	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
  4150
	    hFont = GetStockObject(ANSI_FIXED_FONT);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4151
	} 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
  4152
	    hFont = GetStockObject(ANSI_VAR_FONT);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4153
	} 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
  4154
	    hFont = GetStockObject(SYSTEM_FONT);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4155
	} 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
  4156
	    hFont = GetStockObject(SYSTEM_FIXED_FONT);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4157
	} 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
  4158
	    hFont = GetStockObject(DEVICE_DEFAULT_FONT);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4159
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4160
	    hFont = GetStockObject(ANSI_FIXED_FONT);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4161
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4162
	if (hFont) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4163
	    DPRINTF(("createFontFor:%s -> %x\n", fn, hFont));
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4164
	    RETURN ( __MKEXTERNALADDRESS(hFont) );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4165
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4166
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4167
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4168
    ^ nil
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4169
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4170
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4171
fontMetricsOf:fontId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4172
    "return a fonts metrics info object"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4173
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4174
    |rawData info|
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 := Array new:15.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4177
    (self primFontMetricsOf:fontId hdc:gcId intoArray:rawData) isNil ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4178
	self primitiveFailed.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4179
	^ self
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4180
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4181
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4182
    rawData at:11 put:#'ms-ansi'.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4183
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4184
    info := DeviceWorkstation::DeviceFontMetrics new.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4185
    info
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4186
      ascent:(rawData at:1)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4187
      descent:(rawData at:2)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4188
      maxAscent:(rawData at:3)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4189
      maxDescent:(rawData at:4)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4190
      minWidth:(rawData at:5)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4191
      maxWidth:(rawData at:6)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4192
      avgWidth:(rawData at:7)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4193
      minCode:(rawData at:8)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4194
      maxCode:16rFFFF "(rawData at:9)"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4195
      direction:nil
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4196
      encoding:(rawData at:11).
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4197
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4198
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4199
    ^ info
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4200
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4201
3002
a6acab3dbdea added: #getDefaultFontWithEncoding:
Stefan Vogel <sv@exept.de>
parents: 2905
diff changeset
  4202
getDefaultFontWithEncoding:encoding
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4203
    "return a default font id - used when class Font cannot
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4204
     find anything usable"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4205
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4206
     ^ self createFontFor:'fixed'
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4207
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4208
2603
875d9c41c67d pixelSize stuff
Claus Gittinger <cg@exept.de>
parents: 2602
diff changeset
  4209
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
  4210
    "try to get the specified font, return id.
87adcdcddc17 preps for pixelSize fonts
Claus Gittinger <cg@exept.de>
parents: 2482
diff changeset
  4211
     If not available, try next smaller font.
87adcdcddc17 preps for pixelSize fonts
Claus Gittinger <cg@exept.de>
parents: 2482
diff changeset
  4212
     If no font fits, return nil"
87adcdcddc17 preps for pixelSize fonts
Claus Gittinger <cg@exept.de>
parents: 2482
diff changeset
  4213
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4214
    ^ self
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4215
	getFontWithFamily:familyString
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4216
	face:faceString
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4217
	style:styleString
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4218
	size:sizeArg
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4219
	sizeUnit:#pt
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4220
	encoding:encodingSym
2602
87adcdcddc17 preps for pixelSize fonts
Claus Gittinger <cg@exept.de>
parents: 2482
diff changeset
  4221
!
87adcdcddc17 preps for pixelSize fonts
Claus Gittinger <cg@exept.de>
parents: 2482
diff changeset
  4222
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4223
getFontWithFamily:familyString face:faceString
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4224
	    style:styleArgString size:sizeArgOrNil sizeUnit:sizeUnit encoding:encodingSym
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4225
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4226
    "try to get the specified font, if not available, try the next smaller
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4227
     font."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4228
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4229
    |styleString theName theId xlatedStyle id spacing|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4230
2603
875d9c41c67d pixelSize stuff
Claus Gittinger <cg@exept.de>
parents: 2602
diff changeset
  4231
    self assert:(sizeUnit == #pt).
875d9c41c67d pixelSize stuff
Claus Gittinger <cg@exept.de>
parents: 2602
diff changeset
  4232
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4233
    styleString := styleArgString.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4234
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4235
    "special: if face is nil, allow access to X-fonts"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4236
    faceString isNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4237
	sizeArgOrNil notNil ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4238
	    theName := familyString , '-' , sizeArgOrNil printString
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4239
	] ifFalse:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4240
	    theName := familyString
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
	theName notNil ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4243
	    theId := self createFontFor:theName.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4244
	].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4245
	theId isNil ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4246
	    theId := self getDefaultFontWithEncoding:encodingSym
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4247
	].
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4248
	^ theId
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4249
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4250
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4251
    "/ spacing other than 'normal' is contained as last component
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4252
    "/ in style
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4253
    styleString notNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4254
	((styleString endsWith:'-narrow')
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4255
	 or:[styleString endsWith:'-semicondensed']) ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4256
	    |i|
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4257
	    i := styleString lastIndexOf:$-.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4258
	    spacing := styleString copyFrom:(i+1).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4259
	    styleString := styleString copyTo:(i-1).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4260
	] ifFalse:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4261
	    spacing := 'normal'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4262
	].
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4263
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4264
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4265
    xlatedStyle := styleString.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4266
    xlatedStyle notNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4267
	xlatedStyle := xlatedStyle first asString
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4268
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4269
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4270
    id := self
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4271
	    getFontWithFoundry:'*'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4272
	    family:familyString asLowercase
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4273
	    weight:faceString
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4274
	    slant:styleString "/ xlatedStyle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4275
	    spacing:spacing
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4276
	    pixelSize:nil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4277
	    size:sizeArgOrNil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4278
	    registry:'*'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4279
	    encoding:encodingSym.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4280
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4281
    id isNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4282
	(encodingSym notNil and:[encodingSym ~= '*']) ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4283
	    "/ too stupid: encodings come in both cases
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4284
	    "/
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4285
	    id := self
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4286
		    getFontWithFoundry:'*'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4287
		    family:familyString asLowercase
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4288
		    weight:faceString
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4289
		    slant:styleString "/ xlatedStyle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4290
		    spacing:spacing
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4291
		    pixelSize:nil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4292
		    size:sizeArgOrNil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4293
		    registry:'*'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4294
		    encoding:encodingSym asUppercase.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4295
	    id isNil ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4296
		id := self
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4297
			getFontWithFoundry:'*'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4298
			family:familyString asLowercase
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4299
			weight:faceString
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4300
			slant:styleString "/ xlatedStyle
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4301
			spacing:spacing
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4302
			pixelSize:nil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4303
			size:sizeArgOrNil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4304
			registry:'*'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4305
			encoding:encodingSym asLowercase.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4306
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4307
		id isNil ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4308
		    id := self
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4309
			    getFontWithFoundry:'*'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4310
			    family:familyString asLowercase
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4311
			    weight:faceString asLowercase
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4312
			    slant:styleString asLowercase
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4313
			    spacing:spacing
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4314
			    pixelSize:nil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4315
			    size:sizeArgOrNil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4316
			    registry:'*'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4317
			    encoding:encodingSym asLowercase.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4318
		]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4319
	    ]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4320
	]
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4321
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4322
    ^ id
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4324
    "Modified: 24.2.1996 / 22:37:24 / cg"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4325
    "Modified: 4.7.1996 / 11:38:47 / stefan"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4326
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4327
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4328
getFontWithFoundry:foundry family:family weight:weight
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4329
	      slant:slant spacing:spc pixelSize:pixelSize size:pointSize
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4330
	      registry:registry encoding:encodingArg
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4331
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4332
    "get the specified font, if not available, return nil.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4333
     For now, this is a poor (incomplete) emulation of the X code ...
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4334
     Individual attributes can be left empty (i.e. '') or nil to match any.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4335
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4336
     foundry:   'adobe', 'misc', 'dec', 'schumacher' ... usually '*'
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4337
     family:    'helvetica' 'courier' 'times' ...
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4338
     weight:    'bold' 'medium' 'demi' ...
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4339
     slant:     'r(oman)' 'i(talic)' 'o(blique)'
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4340
     spacing:   'narrow' 'normal' semicondensed' ... usually '*'
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4341
     pixelSize: 16,18 ... usually left empty
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4342
     size:      size in point (1/72th of an inch)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4343
     registry:  iso8859, sgi ... '*'
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4344
     encoding:  vendor specific encoding (usually '*')
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4345
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4346
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4347
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4348
     Windows-NT/95 allows the creation of a font with the following parameters
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4349
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4350
	nHeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4351
	nWidth
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4352
	nEscapement
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4353
	nOrientation
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4354
	fnWeight        FW_DONTCARE, FW_NORMAL, FW_MEDIUM, FW_BOLD, ...
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4355
	fdwItalic       TRUE or FALSE
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4356
	fdwUnderline    TRUE or FALSE
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4357
	fdwStrikeOut    TRUE or FALSE
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4358
	fdwCharSet      ANSI_CHARSET, UNICODE_, SYMBOL_, SHIFTJIS_,...
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4359
	fdwOutputPrecision      DEFAULT, STRING, CHAR, ...
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4360
	fdwClipPrecision        DEFAULT, CHAR, STROKE, MASK, ...
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4361
	fdwQuality      DEFAULT, DRAFT, or PROOF.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4362
	fdwPitchAndFamily
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4363
		DEFAULT, FIXED or VARIABLE pitch
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4364
		DECORATIVE, DONTCASE, MODERN, ROMAN, SCRIPT, or SWISS.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4365
	lpszFace
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4366
		Typeface Name
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4367
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4368
      These two above descriptions will be matched as follows:
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4369
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4370
	foundry   - ignored
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4371
	family    - mapped to type face name.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4372
	weight    - mapped to fnWeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4373
	slant     - used for style
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4374
	spacing   - NOT USED INITIALLY
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4375
	pixelSize - NOT USED INITIALLY
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4376
	size      - mapped to nHeight
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4377
	registry  - NOT USED INITIALLY
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4378
	encoding  - mapped to fdwCharSet
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4379
     "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4380
2851
fad5f9ba8014 primitives expect a symbol as encoding
Stefan Vogel <sv@exept.de>
parents: 2818
diff changeset
  4381
    |logSize encoding|
fad5f9ba8014 primitives expect a symbol as encoding
Stefan Vogel <sv@exept.de>
parents: 2818
diff changeset
  4382
fad5f9ba8014 primitives expect a symbol as encoding
Stefan Vogel <sv@exept.de>
parents: 2818
diff changeset
  4383
    encoding := encodingArg asSymbol.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4384
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4385
    pixelSize notNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4386
	logSize := pixelSize
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4387
    ] ifFalse:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4388
	logSize := (pointSize * (self getLogicalPixelSizeY) / 72.0) rounded.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4389
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4390
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4391
    HGDIOBJ hFont;
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4392
    int  nHeight, nWidth, nEscapement, nOrientation;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4393
    char* work;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4394
    char* work2;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4395
    DWORD fnWeight;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4396
    DWORD fdwItalic;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4397
    DWORD fdwUnderline;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4398
    DWORD fdwStrikeOut;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4399
    DWORD fdwCharSet;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4400
    DWORD fdwOutputPrecision;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4401
    DWORD fdwClipPrecision;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4402
    DWORD fdwQuality;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4403
    DWORD fdwPitchAndFamily;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4404
    static char faceName[256];
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4405
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4406
/* INITIALIZE */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4407
    strcpy( faceName, "NULL" );
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4408
    nHeight   = 0;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4409
    nWidth   = 0;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4410
    nEscapement = 0;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4411
    nOrientation = 0;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4412
    fnWeight = FW_NORMAL;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4413
    fdwItalic = FALSE;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4414
    fdwUnderline = FALSE;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4415
    fdwStrikeOut = FALSE;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4416
    fdwOutputPrecision = OUT_DEFAULT_PRECIS;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4417
    fdwClipPrecision   = CLIP_DEFAULT_PRECIS;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4418
    fdwQuality         = DEFAULT_QUALITY;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4419
    fdwPitchAndFamily  = FF_DONTCARE;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4420
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4421
    fdwCharSet   = ANSI_CHARSET;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4422
    if ((encoding == @symbol('ms-ansi'))) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4423
	fdwCharSet   = ANSI_CHARSET;
2852
9d0ad50e4335 changed: #getFontWithFoundry:family:weight:slant:spacing:pixelSize:size:registry:encoding:
Stefan Vogel <sv@exept.de>
parents: 2851
diff changeset
  4424
    } else if (encoding == @symbol('ms-default')
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4425
	       || encoding == @symbol(*)) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4426
	fdwCharSet   = DEFAULT_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4427
    } else if ((encoding == @symbol('ms-symbol'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4428
	    || (encoding == @symbol('misc-fontspecific'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4429
	fdwCharSet   = SYMBOL_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4430
    } else if ((encoding == @symbol('ms-shiftjis'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4431
	    || (encoding == @symbol('jisx0208.1983-0'))){
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4432
	fdwCharSet   = SHIFTJIS_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4433
    } else if ((encoding == @symbol('ms-gb2312'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4434
	    || (encoding == @symbol('gb2312.1980-0'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4435
	fdwCharSet   = GB2312_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4436
    } else if ((encoding == @symbol('ms-hangeul'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4437
	    || (encoding == @symbol('ksc5601.1987-0'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4438
	fdwCharSet   = HANGEUL_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4439
    } else if ((encoding == @symbol('ms-chinesebig5'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4440
	    || (encoding == @symbol('big5'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4441
	fdwCharSet   = CHINESEBIG5_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4442
    } else if (encoding == @symbol('ms-oem')) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4443
	fdwCharSet   = OEM_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4444
    } else if (encoding == @symbol('ms-johab')) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4445
	fdwCharSet   = JOHAB_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4446
    } else if ((encoding == @symbol('ms-hebrew'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4447
	    || (encoding == @symbol('ms-cp1255'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4448
	fdwCharSet   = HEBREW_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4449
    } else if ((encoding == @symbol('ms-arabic'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4450
	    || (encoding == @symbol('ms-cp1256'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4451
	fdwCharSet   = ARABIC_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4452
    } else if ((encoding == @symbol('ms-greek'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4453
	    || (encoding == @symbol('ms-cp1253'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4454
	fdwCharSet   = GREEK_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4455
    } else if ((encoding == @symbol('ms-turkish'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4456
	    || (encoding == @symbol('ms-cp1254'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4457
	fdwCharSet   = TURKISH_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4458
    } else if ((encoding == @symbol('ms-russian'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4459
	    || (encoding == @symbol('ms-cp1251'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4460
	fdwCharSet   = RUSSIAN_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4461
    } else if ((encoding == @symbol('ms-easteurope'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4462
	    || (encoding == @symbol('ms-cp1250'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4463
	fdwCharSet   = EASTEUROPE_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4464
    } else if ((encoding == @symbol('ms-baltic'))
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4465
	    || (encoding == @symbol('ms-cp1257'))) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4466
	fdwCharSet   = BALTIC_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4467
    } else if ((encoding == @symbol('ms-vietnamese'))) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4468
	fdwCharSet   = VIETNAMESE_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4469
    } else if ((encoding == @symbol('ms-thai'))) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4470
	fdwCharSet   = THAI_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4471
    } else if ((encoding == @symbol('ms-mac'))) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4472
	fdwCharSet   = MAC_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4473
#ifdef UNICODE_CHARSET
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4474
    } else if ((encoding == @symbol('ms-unicode'))) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4475
	fdwCharSet   = UNICODE_CHARSET;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4476
#endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4477
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4478
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4479
    if ( __isString( family ) ) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4480
	work = __stringVal( family );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4481
	if (strcmp( work, "nil" ) != 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4482
	    strncpy( faceName, work, sizeof(faceName)-1 );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4483
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4484
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4485
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4486
    /* 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
  4487
    if( __isString( weight ) ) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4488
	work = __stringVal( weight );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4489
	if (strcmp( work, "bold" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4490
	    fnWeight = FW_BOLD;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4491
	} else if (strcmp( work, "medium" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4492
	    fnWeight = FW_MEDIUM;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4493
	} else if (strcmp( work, "normal" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4494
	    fnWeight = FW_NORMAL;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4495
	} else if (strcmp( work, "light" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4496
	    fnWeight = FW_LIGHT;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4497
	} else if (strcmp( work, "demi" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4498
	    fnWeight = FW_LIGHT;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4499
	} else if (strcmp( work, "heavy" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4500
	    fnWeight = FW_HEAVY;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4501
	} else if (strcmp( work, "extraBold" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4502
	    fnWeight = FW_EXTRABOLD;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4503
	} else if (strcmp( work, "semiBold" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4504
	    fnWeight = FW_SEMIBOLD;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4505
	} else if (strcmp( work, "thin" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4506
	    fnWeight = FW_THIN;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4507
	} else if (strcmp( work, "extraLight" ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4508
	    fnWeight = FW_EXTRALIGHT;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4509
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4510
    } else if (__isSmallInteger(weight)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4511
	fnWeight = __intVal(weight);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4512
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4513
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4514
    if(__isSmallInteger( logSize )) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4515
	nHeight = __intVal( logSize );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4516
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4517
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4518
    if (__isString(slant)) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4519
	work2 = __stringVal( slant );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4520
	work  = __stringVal( slant );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4521
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4522
	if (strncmp(work2, "italic", 6) == 0)  {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4523
	    fdwItalic = TRUE;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4524
	    if ( work2[6] == '-' )
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4525
		strncpy( work, &work2[7], ( strlen( work2) - 7) );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4526
	} else {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4527
	    if (strncmp(work2, "oblique", 7) == 0)  {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4528
		fdwItalic = TRUE;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4529
		if ( work2[7] == '-' )
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4530
		    strncpy( work, &work2[8], ( strlen( work2) - 8) );
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
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4533
	if (strncmp( work, "underline", 9 ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4534
	    fdwUnderline = TRUE;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4535
	    if( work[10] == '-' )
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4536
		strncpy( work2, &work[11], ( strlen( work ) - 10 ) );
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4537
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4538
	if (strncmp( work2, "strikeOut", 9 ) == 0 ) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4539
	    fdwStrikeOut = TRUE;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4540
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4541
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4542
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4543
    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
  4544
		faceName, nHeight, nWidth, fnWeight));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4545
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4546
    hFont = CreateFont( -nHeight,   /* character height - not cell height */
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4547
			nWidth,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4548
			nEscapement,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4549
			nOrientation,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4550
			fnWeight,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4551
			fdwItalic,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4552
			fdwUnderline,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4553
			fdwStrikeOut,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4554
			fdwCharSet,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4555
			fdwOutputPrecision,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4556
			fdwClipPrecision,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4557
			fdwQuality,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4558
			fdwPitchAndFamily,
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4559
			faceName );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4560
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4561
    if (hFont != NULL) {
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4562
	DPRINTF(("createFont: %x\n", hFont));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4563
/*
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4564
    #ifdef COUNT_RESOURCES
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4565
	__cnt_font++;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4566
	RES1PRINTF(("CreateFont %d\n", __cnt_font));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4567
    #endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4568
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4569
	RETURN ( __MKEXTERNALADDRESS(hFont) );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4570
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4571
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4572
    DPRINTF(("***** ERROR createFontWithFoundry failed ERROR *****\n" ));
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4573
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4574
    ^ nil
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4575
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4576
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4577
     Display getFontWithFoundry:'*'
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4578
			 family:'courier'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4579
			 weight:'medium'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4580
			  slant:'r'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4581
			spacing:nil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4582
		      pixelSize:nil
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4583
			   size:13
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4584
		       registry:'iso8859'
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  4585
		       encoding:'*'
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4586
    "
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4587
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4588
    "new NT Version: 20.2.1997 / 22:33:29 / dq"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4589
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4590
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4591
primFontMetricsOf:fontId hdc:aDC intoArray:rawData
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4592
    "evaluate aBlock, passing a fonts metrics as arguments.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4593
     fill passed array as:
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4594
      ascent     -> (data at:1)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4595
      descent    -> (data at:2)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4596
      maxAscent  -> (data at:3)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4597
      maxDescent -> (data at:4)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4598
      minWidth   -> (data at:5)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4599
      maxWidth   -> (data at:6)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4600
      avgWidth   -> (data at:7).
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4601
      minChar    -> (data at:8).
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4602
      maxChar    -> (data at:9).
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4603
      defaultChar-> (data at:10).
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4604
      charSet    -> (data at:11).
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4605
"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4606
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4607
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4608
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4609
    if (__isExternalAddress(fontId)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4610
     && __isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4611
     && __isArray(rawData)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4612
     && (__arraySize(rawData) >= 11)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4613
	SIZE size;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4614
	int avgWidth;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4615
	HGDIOBJ hFont;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4616
	HGDIOBJ prevFont;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4617
	TEXTMETRIC tmet;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4618
	static char *s = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4619
	static int len;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4620
	OBJ t;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4621
	HANDLE hDC;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4622
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4623
	hFont = _HGDIOBJVal(fontId);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4624
	hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4625
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4626
	/*
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4627
	 * temporarily set this font in the tmpDC (root-) context
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4628
	 */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4629
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4630
	prevFont = SelectObject(hDC, hFont);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4631
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4632
	GetTextMetricsW(hDC, &tmet);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4633
	if (len == 0) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4634
	    len = strlen(s);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4635
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4636
#if 0
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4637
	GetTextExtentPoint32(hDC, s, len, &size);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4638
	avgWidth = (size.cx / (len / 2) + 1) / 2;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4639
#else
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4640
	avgWidth = tmet.tmAveCharWidth;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4641
#endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4642
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4643
	__ArrayInstPtr(rawData)->a_element[0] = __MKSMALLINT(tmet.tmAscent);        /* ascent     -> (data at:1) */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4644
	__ArrayInstPtr(rawData)->a_element[1] = __MKSMALLINT(tmet.tmDescent);       /* descent    -> (data at:2) */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4645
	__ArrayInstPtr(rawData)->a_element[2] = __MKSMALLINT(tmet.tmAscent);        /* maxAscent  -> (data at:3) */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4646
	__ArrayInstPtr(rawData)->a_element[3] = __MKSMALLINT(tmet.tmDescent);       /* maxDescent -> (data at:4) */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4647
	__ArrayInstPtr(rawData)->a_element[4] = __MKSMALLINT(avgWidth);             /* minWidth   -> (data at:5) */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4648
	__ArrayInstPtr(rawData)->a_element[5] = __MKSMALLINT(tmet.tmMaxCharWidth);  /* maxWidth   -> (data at:6) */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4649
	__ArrayInstPtr(rawData)->a_element[6] = __MKSMALLINT(avgWidth);             /* avgWidth   -> (data at:7) */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4650
	__ArrayInstPtr(rawData)->a_element[7] = __MKSMALLINT(tmet.tmFirstChar);     /* min        -> (data at:8) */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4651
	__ArrayInstPtr(rawData)->a_element[8] = __MKSMALLINT(tmet.tmLastChar);      /* max        -> (data at:9) */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4652
	__ArrayInstPtr(rawData)->a_element[9] = __MKSMALLINT(tmet.tmDefaultChar);   /* default    -> (data at:10) */
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4653
#if 0
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4654
	t = __charSetSymbolFor(tmet.tmCharSet);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4655
	__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
  4656
#endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4657
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4658
	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
  4659
		    hFont, tmet.tmAscent, tmet.tmDescent, avgWidth, tmet.tmMaxCharWidth,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4660
		    tmet.tmAveCharWidth));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4661
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4662
	SelectObject(hDC, prevFont);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4663
	RETURN (self);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4664
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4665
    RETURN (nil);
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4666
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4667
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4668
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4669
releaseFont:aFontId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4670
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4671
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4672
    if (__isExternalAddress(aFontId)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4673
	HGDIOBJ hFont = _HGDIOBJVal(aFontId);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4674
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4675
	if (hFont) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4676
	   DPRINTF(("ReleaseFont: %x\n", hFont));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4677
	   DeleteObject(hFont);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4678
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4679
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4680
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4681
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4682
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4683
setFont:aFontId in:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4684
    "set font to be drawn in"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4685
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4686
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4687
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4688
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4689
     && __isExternalAddress(aFontId))
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4690
    {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4691
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4692
	HGDIOBJ prevFont, hFont;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4693
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4694
	hFont = _HGDIOBJVal(aFontId);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4695
	prevFont = SelectObject(hDC, hFont);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4696
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4697
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4698
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4699
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4700
    self primitiveFailed
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4701
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4702
    "Created: / 04-08-2006 / 12:32:53 / fm"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4703
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4704
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4705
widthOf:aString from:index1 to:index2 inFont:aFontId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4706
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4707
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4708
    unsigned char *cp;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4709
    int len, n, i1, i2, l;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4710
    OBJ cls;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4711
    int nInstBytes;
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4712
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4713
    if (__bothSmallInteger(index1, index2)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4714
     && __isExternalAddress(aFontId)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4715
     && __isExternalAddressLike(__INST(gcId))
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4716
     && __isNonNilObject(aString)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4717
	HGDIOBJ hFont,prevFont;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4718
	HANDLE hDC;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4719
	SIZE tsize;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4720
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4721
#ifndef PRE_22_FEP_2007
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4722
#       define N_QUICK_CHARS    1024
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4723
	unsigned short quickWchars[N_QUICK_CHARS];
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4724
	unsigned short *wcharPtr;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4725
	int mustFree = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4726
	int i;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4727
#endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4728
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4729
	hFont = _HGDIOBJVal(aFontId);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4730
	hDC = (HANDLE)(__externalAddressVal(__INST(gcId)));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4731
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4732
	prevFont = SelectObject(hDC, hFont);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4733
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4734
	i1 = __intVal(index1) - 1;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4735
	cls = __qClass(aString);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4736
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4737
	if (i1 >= 0) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4738
	    i2 = __intVal(index2) - 1;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4739
	    if (i2 < i1) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4740
		RETURN ( __MKSMALLINT( 0 ) );
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4741
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4742
3814
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  4743
	    cp = (char *) __stringVal(aString);
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4744
	    l = i2 - i1 + 1;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4745
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4746
	    if ((cls == @global(String)) || (cls == @global(Symbol))) {
3814
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  4747
		n = __stringSize(aString);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4748
    commonWidthChars:
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4749
		if (i2 < n) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4750
		    cp += i1;
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4751
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4752
#ifdef PRE_22_FEP_2007
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4753
		    GetTextExtentPoint32(hDC, cp, l, &tsize);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4754
#else
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4755
		    if (l <= N_QUICK_CHARS) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4756
			wcharPtr = quickWchars;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4757
			mustFree = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4758
		    } else {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4759
			wcharPtr = malloc(sizeof(short)*l);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4760
			if (! wcharPtr) RETURN (__MKSMALLINT(0));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4761
			mustFree = 1;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4762
		    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4763
		    for (i=0; i<l; i++) wcharPtr[i] = ((unsigned char *)cp)[i];
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4764
		    GetTextExtentPoint32W(hDC, wcharPtr, l, &tsize);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4765
		    if (mustFree) free(wcharPtr);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4766
#endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4767
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4768
#ifdef SUPERDEBUG
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4769
		    if (__debug__) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4770
			char buf[80];
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4771
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4772
			GetTextFace(hDC,80,buf);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4773
			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
  4774
		    }
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4775
#endif
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4776
		    SelectObject(hDC, prevFont);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4777
		    RETURN ( __MKSMALLINT(tsize.cx) );
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4778
		}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4779
		RETURN (__MKSMALLINT(0));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4780
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4781
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4782
	    nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4783
	    cp += nInstBytes;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4784
	    n = __byteArraySize(aString) - nInstBytes;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4785
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4786
	    if (__isBytes(aString)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4787
		goto commonWidthChars;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4788
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4789
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4790
	    /* Unicode */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4791
	    if (__isWords(aString)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4792
		n = n / 2;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4793
		if (i2 < n) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4794
		    WIDECHAR *w_cp = (WIDECHAR *)cp;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4795
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4796
		    w_cp += i1;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4797
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4798
		    GetTextExtentPoint32W(hDC, w_cp, l, &tsize);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4799
		    SelectObject(hDC, prevFont);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4800
		    RETURN ( __MKSMALLINT(tsize.cx) );
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4801
		}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4802
		RETURN (__MKSMALLINT(0));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4803
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4804
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4805
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4806
%}.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4807
    self primitiveFailed.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4808
    ^ 0
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4809
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4810
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4811
widthOf:aString inFont:aFontId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4812
    "return the width in pixels of a string in a specific font"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4813
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4814
    ^ self widthOf:aString from:1 to:(aString size) inFont:aFontId
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
  4815
! !
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
  4816
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4817
!WinPrinterContext methodsFor:'initialization & release'!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4818
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4819
createDC
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4820
    "Private - Create a device context for the receiver"
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  4821
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4822
    gcId := printerInfo createDC
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4823
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4824
    "Created: / 27-07-2006 / 10:21:05 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4825
    "Modified: / 02-08-2006 / 17:30:47 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4826
    "Modified: / 10-10-2006 / 18:14:28 / cg"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4827
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4828
2315
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4829
deleteDC
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4830
    "Private - Delete a device context for the receiver"
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4831
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4832
    OperatingSystem deletePrinterDC: gcId.
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4833
!
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4834
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4835
destroy
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4836
    "Destroy the GC."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4837
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4838
    |id|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4839
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4840
    id := gcId.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4841
    id notNil ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4842
	gcId := nil.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4843
	self deleteDC.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4844
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4845
"/    Lobby unregister:self.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4846
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4847
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4848
destroyGC:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4849
%{
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4850
    if (__isExternalAddressLike(aDC)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4851
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4852
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4853
	DeleteDC(hDC);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4854
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4855
/*
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4856
#ifdef CACHE_LAST_DC
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4857
	if (lastGcData == gcData) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4858
	    _releaseDC(gcData);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4859
	}
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4860
#endif
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4861
*/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4862
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4863
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4864
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4865
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4866
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4867
executor
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4868
    |aCopy|
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4869
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4870
    aCopy := WinWorkstation::PrinterDeviceContextHandle basicNew.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4871
    aCopy setDevice:device id:nil gcId:gcId.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4872
    ^ aCopy
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4873
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  4874
    "Created: / 16-04-2007 / 12:39:02 / cg"
2315
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4875
!
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4876
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4877
initialize
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4878
    super initialize.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4879
"/    deviceForms := Registry new.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4880
"/    deviceColors := Registry new.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4881
    deviceFonts := CachingRegistry new cacheSize:10.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4882
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4883
2315
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4884
releaseDC
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4885
    "Private - Delete and clear the device context of the receiver."
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4886
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  4887
    self deleteDC.
2316
1660bcf17d63 *** empty log message ***
fm
parents: 2315
diff changeset
  4888
"/    device close.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4889
    gcId := nil.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4890
    self releaseDeviceFonts
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4891
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4892
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4893
releaseDeviceFonts
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4894
    deviceFonts isEmptyOrNil ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4895
	deviceFonts do:[:afont |
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4896
	    afont releaseFromDevice.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4897
	].
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4898
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4899
    deviceFonts := CachingRegistry new cacheSize:10.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4900
! !
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4901
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4902
!WinPrinterContext methodsFor:'non standard methods'!
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4903
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4904
stringWidthOf:aString at:index
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4905
    "Return the width of aString up to index
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4906
     when written using the current font; expand tabs out
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4907
     to 4 spaces for calculations"
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4908
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4909
    |answer str size spaceWidth|
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4910
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4911
    index <= 0 ifTrue:[ ^ 0 ].
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4912
    str := index >= aString size ifTrue:[ aString ] ifFalse:[ aString copyFrom:1 to:index ].
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4913
    true "self font isNil" ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4914
	"if font not set yet, calculate based on default font"
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4915
	"/            extString := str asExternalString.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4916
	size := Win32OperatingSystem::WinPointStructure new.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4917
	(OperatingSystem
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4918
	    getTextExtentPoint:gcId
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4919
	    string:str
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4920
	    size:size) ifFalse:[ ^ self error ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4921
	answer := size x.
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4922
"/        Transcript showCR: 'FROM PRIM ******* ', str, '   ',  answer printString.
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4923
"/        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
  4924
	#TODO.
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4925
    ] ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4926
	answer := self font widthOf:str on:self device
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4927
    ].
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4928
    index > aString size ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4929
	spaceWidth := self font widthOf:Character space on:self device.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4930
	answer := answer + ((index - aString size) * spaceWidth)
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4931
    ].
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4932
    ^ answer.
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4933
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4934
    "Created: / 03-08-2006 / 10:27:20 / fm"
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4935
    "Modified: / 04-08-2006 / 12:27:26 / fm"
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4936
    "Modified: / 10-10-2006 / 18:20:43 / cg"
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4937
! !
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  4938
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4939
!WinPrinterContext methodsFor:'not supported yet'!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4940
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4941
displayAdvanceLineFrom:point1 to:point2
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4942
    "draw a line"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4943
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4944
    self displayAdvanceLineFromX:(point1 x) y:(point1 y)
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4945
		      toX:(point2 x) y:(point2 y)
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4946
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4947
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4948
displayAdvanceLineFromX:x0 y:y0 toX:x1 y:y1
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4949
    "draw a line (with current paint-color); apply transformation if nonNil"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4950
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4951
    |pX0 pY0 pX1 pY1 easy fgId bgId|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4952
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4953
    gcId isNil ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4954
	self initGC
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4955
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4956
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4957
    lineStyle == #doubleDashed ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4958
	"
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4959
	 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
  4960
	"
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4961
	easy := true.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4962
	paint isColor ifFalse:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4963
	    easy := false
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4964
	] ifTrue:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4965
	    fgId := paint colorId.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4966
	    fgId isNil ifTrue:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4967
		easy := false
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4968
	    ]
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4969
	].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4970
	bgPaint isColor ifFalse:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4971
	    easy := false
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4972
	] ifTrue:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4973
	    bgId := bgPaint colorId.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4974
	    bgId isNil ifTrue:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4975
		easy := false
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4976
	    ]
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4977
	].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4978
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4979
	easy ifTrue:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4980
	    ((foreground ~~ paint) or:[background ~~ bgPaint]) ifTrue:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4981
		device setForeground:fgId background:bgId in:gcId.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4982
		foreground := paint.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4983
		background := bgPaint.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4984
	    ].
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4985
	] ifFalse:[
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4986
	    'DeviceGraphicsContext [warning]: cannot draw dashes with dithered colors' errorPrintCR
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4987
	].
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4988
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4989
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4990
    transformation notNil ifTrue:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4991
	pX0 := transformation applyToX:x0.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4992
	pY0 := transformation applyToY:y0.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4993
	pX1 := transformation applyToX:x1.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4994
	pY1 := transformation applyToY:y1.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  4995
    ] ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4996
	pX0 := x0.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4997
	pY0 := y0.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4998
	pX1 := x1.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  4999
	pY1 := y1
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5000
    ].
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5001
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5002
    pX0 := pX0 rounded.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5003
    pY0 := pY0 rounded.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5004
    pX1 := pX1 rounded.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5005
    pY1 := pY1 rounded.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5006
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5007
    device displayAdvanceLineFromX:pX0 y:pY0 toX:pX1 y:pY1 in:drawableId with:gcId
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5008
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5009
    "Modified: 10.1.1997 / 17:46:32 / cg"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5010
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5011
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5012
displayAdvanceLineFromX:x0 y:y0 toX:x1 y:y1 in:ignoredDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5013
    "draw a line. If the coordinates are not integers, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5014
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5015
    self getPenForMyContext.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5016
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5017
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5018
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5019
     && __bothSmallInteger(x0, y0)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5020
     && __bothSmallInteger(x1, y1)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5021
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5022
	COLORREF fgColor;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5023
	int __x1 = __intVal(x1), __y1 = __intVal(y1);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5024
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5025
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5026
/*      DPRINTF(("displayLine: %d/%d -> %d/%d\n",
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5027
		    __intVal(x0), __intVal(y0),
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5028
		    __x1, __y1));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5029
*/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5030
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5031
/*        fgColor = GetTextColor(hDC);
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5032
 *        hPen = CreatePen(PS_SOLID, 1, fgColor);
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5033
 */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5034
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5035
	MoveToEx(hDC, __intVal(x0), __intVal(y0), NULL);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5036
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5037
	LineTo(hDC, __x1, __y1);
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
	 * end-point ...
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5041
	 */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5042
	LineTo(hDC, __x1+1, __y1);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5043
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5044
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5045
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5046
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5047
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5048
%}
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5049
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5050
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5051
gcForBitmap:aDrawableId
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5052
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5053
%{  /* NOCONTEXT */
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5054
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5055
    if (__isExternalAddress(aDrawableId)){
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5056
	BITMAP bitmap;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5057
	HBITMAP hBitmap = _HBITMAPVAL(aDrawableId);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5058
	HBITMAP memBM;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5059
	HANDLE compatibleDC, rootDC, hdcScreen;
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5060
   //     HANDLE printerDC = (HANDLE)(__externalAddressVal(__INST(gcId)));
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
	if (! hBitmap) {
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5063
	    RETURN (nil);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5064
	}
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5065
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5066
	if (GetObject(hBitmap, sizeof(bitmap), &bitmap)) {
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
	    DDPRINTF(("bitmap info:%d\n", bitmap.bmBitsPixel));
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5069
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5070
	} else {
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
	    DPRINTF(("noinfo returned for bitmap\n"));
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5073
*/
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5074
	    /* mhmh - can this happen ? */
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5075
	    bitmap.bmBitsPixel = 1;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5076
	}
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5077
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5078
	gcData->hBitmap = hBitmap;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5079
	gcData->bitmapColorBitCount = bitmap.bmBitsPixel;
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5080
*/
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5081
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5082
	rootDC  = CreateDC("DISPLAY", NULL, NULL, NULL);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5083
	compatibleDC = CreateCompatibleDC(rootDC);
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5084
	SelectObject(compatibleDC, hBitmap);
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5085
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5086
   //     hdcScreen= CreateDC("NULL", NULL, NULL, NULL);
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5087
   //       compatibleDC =  rootDC;
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5088
   //     compatibleDC = CreateCompatibleDC(printerDC);
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5089
   //     compatibleDC = CreateCompatibleDC(0);
2338
d170c690a945 drawing bitmaps
fm
parents: 2330
diff changeset
  5090
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5091
   //     memBM = CreateCompatibleBitmap ( compatibleDC, bitmap.bmWidth, bitmap.bmHeight );
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5092
   //     SelectObject ( compatibleDC, memBM );
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5093
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5094
	RETURN (__MKEXTERNALADDRESS(compatibleDC));
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5095
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5096
/*
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5097
	RETURN ( __MKEXTERNALADDRESS(gcData) );
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5098
*/
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5099
    }
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5100
    RETURN (nil);
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5101
%}
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5102
!
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5103
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5104
getPenForMyContext
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5105
    "Get a pen for my context"
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5106
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5107
    |maskOriginX maskOriginY|
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5108
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5109
    self maskOrigin isNil ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5110
	maskOriginX := self maskOrigin x.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5111
	maskOriginY := self maskOrigin y.
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5112
    ].
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5113
2325
634b74929d2d *** empty log message ***
fm
parents: 2324
diff changeset
  5114
%{
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5115
    HPEN hPen = 0;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5116
    HPEN prevPen;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5117
    LOGBRUSH Brush;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5118
    COLORREF fgColor;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5119
    HANDLE hDC = (HANDLE)(__externalAddressVal(__INST(gcId)));
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5120
    int lStyle, bkMode, hMask, maskOrgX, maskOrgY;
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5121
    OBJ lineStyle, capStyle, joinStyle;
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5122
    int style;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5123
    int lw;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5124
    int BK_TRANSPARENT;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5125
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5126
    BK_TRANSPARENT = 1;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5127
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5128
    lw= __intVal(__INST(lineWidth));
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5129
/*    fgColor = __intVal(__INST(foreground)) & 0xffffff;     */
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5130
2325
634b74929d2d *** empty log message ***
fm
parents: 2324
diff changeset
  5131
    fgColor = GetTextColor(hDC);
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5132
    lineStyle=__INST(lineStyle);
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5133
    capStyle=__INST(capStyle);
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5134
    joinStyle=__INST(joinStyle);
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5135
    hMask= __intVal(__INST(mask));
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5136
    maskOrgX=__intVal(maskOriginX);
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5137
    maskOrgY=__intVal(maskOriginY);
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5138
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5139
    if (lineStyle == @symbol(solid)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5140
	style = PS_SOLID;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5141
    } else if (lineStyle == @symbol(dashed)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5142
	style= PS_DASH;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5143
    } else if (lineStyle == @symbol(dotted)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5144
	style= PS_DOT;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5145
    } else if (lineStyle == @symbol(dashDot)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5146
	style= PS_DASHDOT;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5147
    } else if (lineStyle == @symbol(dashDotDot)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5148
	style= PS_DASHDOTDOT;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5149
    } else
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5150
	style= PS_SOLID;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5151
    lStyle &= ~PS_STYLE_MASK;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5152
    lStyle |= style;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5153
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5154
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5155
    if (capStyle == @symbol(round)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5156
	style = PS_ENDCAP_ROUND;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5157
    } else if (capStyle == @symbol(square)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5158
	style = PS_ENDCAP_SQUARE;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5159
    } else if (capStyle == @symbol(flat)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5160
	style = PS_ENDCAP_FLAT;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5161
    } else
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5162
	style = PS_ENDCAP_FLAT;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5163
    lStyle &= ~PS_ENDCAP_MASK;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5164
    lStyle |= style;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5165
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5166
    if (joinStyle == @symbol(bevel)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5167
	style = PS_JOIN_BEVEL;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5168
    } else if (joinStyle == @symbol(miter)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5169
	style = PS_JOIN_MITER;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5170
    } else if (joinStyle == @symbol(round)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5171
	style = PS_JOIN_ROUND;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5172
    } else
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5173
	style = PS_JOIN_MITER;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5174
    lStyle &= ~PS_JOIN_MASK;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5175
    lStyle |= style;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5176
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5177
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5178
    if (((lStyle & PS_STYLE_MASK) == PS_SOLID)
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5179
     && (hMask == 0)
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5180
     && (lw /* lineWidth */ <= 1)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5181
	if (fgColor == 0 /* BlackPixel */ ) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5182
	    hPen = GetStockObject(BLACK_PEN);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5183
	    prevPen = SelectObject(hDC, hPen);
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5184
	    RETURN( __MKEXTERNALADDRESS(hPen) );
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5185
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5186
	if (fgColor == 1 /* WhitePixel */) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5187
	    hPen = GetStockObject(WHITE_PEN);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5188
	    prevPen = SelectObject(hDC, hPen);
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5189
	    RETURN( __MKEXTERNALADDRESS(hPen) );
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5190
	}
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5191
    }
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5192
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5193
    hPen = (HPEN) 0;
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5194
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5195
    if (0 /* __isWinNT */) {
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5196
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5197
	if (lw == 0) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5198
	    lw = 1;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5199
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5200
	/*
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5201
	 * NT supports masked drawing with any lineStyle,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5202
	 * and also non-solid lines with any lineWidth.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5203
	 */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5204
	if (hMask) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5205
	    Brush.lbStyle = BS_PATTERN;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5206
	    Brush.lbHatch = (DWORD)hMask;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5207
	    Brush.lbColor = fgColor;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5208
	} else {
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5209
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5210
#ifndef PRE_07_APR_04
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5211
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5212
	    hPen = CreatePen((lStyle & PS_STYLE_MASK), lw, fgColor);
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5213
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5214
/*            RESPRINTF(("CreatePen %x %d(%d) %x %x\n",
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5215
 *                       lStyle,
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5216
 *                       lw, __INST(lineWidth),
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5217
 *                       fgColor, hMask));
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5218
 */
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5219
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5220
	    SetBkMode(hDC, TRANSPARENT);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5221
	    bkMode = BK_TRANSPARENT;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5222
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5223
#else
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5224
	    Brush.lbStyle = BS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5225
	    Brush.lbHatch = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5226
	    Brush.lbColor = fgColor;
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5227
#endif
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5228
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5229
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5230
	if (! hPen)
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5231
	{
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5232
	    hPen = ExtCreatePen(PS_GEOMETRIC | lStyle,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5233
			    lw, /* lineWidth, */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5234
			    &Brush,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5235
			    0, 0);
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5236
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5237
/*            RESPRINTF(("ExtCreatePen1 %x %d(%d) %x %x\n",
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5238
 *                       lStyle,
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5239
 *                       lw, __INST(lineWidth),
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5240
 *                       fgColor, hMask));
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5241
 */
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5242
	    if (hMask) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5243
		SetBrushOrgEx(hDC, maskOrgX, maskOrgY, 0);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5244
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5245
	}
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5246
    } else {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5247
	/*
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5248
	 * W95 only supports masked drawing with SOLID lines
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5249
	 * also, we should use COSMETIC pens if possible
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5250
	 * with non-solid lineStyles.
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5251
	 */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5252
	if ((lStyle & PS_STYLE_MASK) == PS_SOLID) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5253
	    int ps = PS_GEOMETRIC;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5254
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5255
	    if (hMask) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5256
		Brush.lbStyle = BS_PATTERN;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5257
		Brush.lbHatch = (DWORD)hMask;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5258
		Brush.lbColor = fgColor;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5259
	    } else {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5260
		Brush.lbStyle = BS_SOLID;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5261
		Brush.lbHatch = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5262
		Brush.lbColor = fgColor;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5263
		if (lw /* lineWidth */ <= 1) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5264
		    ps = PS_COSMETIC;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5265
		}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5266
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5267
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5268
	    hPen = ExtCreatePen(ps | lStyle,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5269
				lw, /* lineWidth */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5270
				&Brush,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5271
				0, 0);
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5272
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5273
/*            RESPRINTF(("ExtCreatePen1 %x %d %x %x\n",
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5274
 *                           lStyle,
2325
634b74929d2d *** empty log message ***
fm
parents: 2324
diff changeset
  5275
 *                           lw,
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5276
 *                           fgColor, hMask));
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5277
 */
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5278
	    if (hMask) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5279
		SetBrushOrgEx(hDC, maskOrgX, maskOrgY, 0);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5280
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5281
	} else {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5282
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5283
	    if (lw == 1) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5284
		lw = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5285
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5286
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5287
	    /*
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5288
	     * dashes only supported with lineWidth 0
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5289
	     */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5290
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5291
	    hPen = CreatePen((lStyle & PS_STYLE_MASK),
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5292
			     lw,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5293
			     fgColor);
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5294
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5295
/*            RESPRINTF(("CreatePen %x %d %x\n",
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5296
 *                               (lStyle & PS_STYLE_MASK),
2325
634b74929d2d *** empty log message ***
fm
parents: 2324
diff changeset
  5297
 *                               lw,
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5298
 *                               fgColor));
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5299
 */
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5300
	    //
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5301
	    // CG: wrong; must set to opaque, if doubleDashed
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5302
	    //
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5303
	    SetBkMode(hDC, TRANSPARENT);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5304
	    bkMode = BK_TRANSPARENT;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5305
	}
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5306
    }
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5307
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5308
    prevPen = SelectObject(hDC, hPen);
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5309
    RETURN (__MKEXTERNALADDRESS(hPen));
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5310
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5311
%}
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5312
!
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5313
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5314
xprimDrawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth padding:padd width:imageWidth height:imageHeight
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5315
				  x:srcx y:srcy
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5316
			       into:ignoredDrawableId
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5317
				  x:dstx y:dsty
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5318
			      width:w height:h
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5319
			       with:aDC
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5320
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5321
    "since XPutImage may allocate huge amount of stack space
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5322
     (some implementations use alloca), this must run with unlimited stack."
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5323
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5324
%{
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5325
    unsigned char fastBits[10000];
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5326
    unsigned char *b_bits = 0;
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5327
    unsigned char *allocatedBits = 0;
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5328
    unsigned char *__imageBits = 0;
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5329
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5330
    if (__isByteArray(imageBits)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5331
	__imageBits = __ByteArrayInstPtr(imageBits)->ba_element;
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5332
    } else if (__isExternalBytesLike(imageBits)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5333
	__imageBits = (unsigned char *)(__externalBytesAddress(imageBits));
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5334
    }
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5335
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5336
    if (/* ISCONNECTED
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5337
     && */  __isExternalAddressLike(aDC)
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5338
     && __bothSmallInteger(srcx, srcy)
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5339
     && __bothSmallInteger(dstx, dsty)
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5340
     && __bothSmallInteger(w, h)
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5341
     && __bothSmallInteger(imageWidth, imageHeight)
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5342
     && __bothSmallInteger(imageDepth, bitsPerPixel)
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5343
     && __isSmallInteger(padd)
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5344
     && __imageBits)
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5345
     {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5346
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5347
	struct
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5348
	{
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5349
	  BITMAPINFOHEADER bmiHeader;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5350
	  DWORD r;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5351
	  DWORD g;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5352
	  DWORD b;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5353
	} bitmap;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5354
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5355
	if (__intVal(padd) != WIN32PADDING) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5356
	    int row, col;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5357
	    unsigned char *cp;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5358
	    unsigned char *pBits;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5359
	    int b_width, b_height, bytesPerRowST, bytesPerRowWN, padding, nBytes;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5360
	    int bi = __intVal(bitsPerPixel);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5361
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5362
	    b_width = __intVal(w);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5363
	    b_height = __intVal(h);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5364
	    bytesPerRowST = (b_width * bi + (__intVal(padd)-1)) / __intVal(padd);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5365
	    bytesPerRowWN = (b_width * bi + (WIN32PADDING-1)) / WIN32PADDING * (WIN32PADDING/8);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5366
	    padding = bytesPerRowWN - bytesPerRowST;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5367
	    nBytes = b_height * bytesPerRowWN;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5368
	    /*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
  5369
	    if (padding) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5370
		if (nBytes < sizeof(fastBits)) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5371
		    cp = b_bits = fastBits;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5372
		} else {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5373
		    cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5374
		}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5375
		if (cp) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5376
		    pBits = __imageBits;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5377
		    for (row = b_height; row; row--) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5378
			for (col = bytesPerRowST; col; col--) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5379
			    *cp++ = *pBits++;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5380
			}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5381
			cp += padding;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5382
		    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5383
		} else
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5384
		    goto fail;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5385
	    }
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5386
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5387
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5388
	if (b_bits == 0) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5389
	    b_bits = __imageBits;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5390
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5391
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5392
	bitmap.bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5393
	bitmap.bmiHeader.biPlanes = 1;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5394
	if (__intVal(imageDepth) == 24) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5395
	    /*bitmap.bmiHeader.biCompression = BI_BITFIELDS;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5396
	    bitmap.r = 0xff0000;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5397
	    bitmap.g = 0x00ff00;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5398
	    bitmap.b = 0x0000ff;*/
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5399
	    bitmap.bmiHeader.biCompression = BI_RGB;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5400
	} else if (__intVal(imageDepth) == 16) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5401
	    /*bitmap.bmiHeader.biCompression = BI_RGB;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5402
	    bitmap.bmiHeader.biCompression = BI_BITFIELDS;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5403
	    bitmap.b = 0x001f;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5404
	    bitmap.g = 0x07e0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5405
	    bitmap.r = 0xf800;*/
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5406
	    bitmap.b = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5407
	    bitmap.g = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5408
	    bitmap.r = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5409
	    bitmap.bmiHeader.biCompression = BI_RGB;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5410
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5411
	bitmap.bmiHeader.biSizeImage = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5412
	bitmap.bmiHeader.biXPelsPerMeter = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5413
	bitmap.bmiHeader.biYPelsPerMeter = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5414
	bitmap.bmiHeader.biClrUsed = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5415
	bitmap.bmiHeader.biClrImportant = 0;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5416
	bitmap.bmiHeader.biWidth = __intVal(imageWidth);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5417
	bitmap.bmiHeader.biHeight = -(__intVal(imageHeight));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5418
	bitmap.bmiHeader.biBitCount = __intVal(bitsPerPixel);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5419
	/*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
  5420
	SetDIBitsToDevice(hDC,__intVal(dstx),__intVal(dsty),
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5421
			      __intVal(w), __intVal(h),
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5422
			      __intVal(srcx), __intVal(srcy),
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5423
			      0,__intVal(h),
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5424
			      (void *)b_bits,
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5425
			      (BITMAPINFO*)&bitmap,DIB_RGB_COLORS);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5426
	if (allocatedBits) {
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5427
	    free(allocatedBits);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5428
	}
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5429
	RETURN ( true );
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5430
    }
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5431
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5432
fail: ;
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5433
/*
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5434
    PRINTF(("create temp bitmap FAILED!!!\n"));
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5435
*/
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5436
    if (allocatedBits) {
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5437
/*
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5438
	PRINTF(("freeing up temp bitmap bits ...\n"));
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5439
*/
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5440
	free(allocatedBits);
2328
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5441
    }
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5442
%}
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5443
.
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5444
    ^ false
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5445
!
90f481d446bc + displayString supports color
fm
parents: 2327
diff changeset
  5446
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5447
xxxdisplayLineFromX:x0 y:y0 toX:x1 y:y1 in:ignoredDrawableId with:aDC
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5448
    "draw a line. If the coordinates are not integers, an error is triggered."
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5449
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5450
    |penHandle|
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5451
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5452
    penHandle := self getPenForMyContext.
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5453
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5454
%{  /* NOCONTEXT */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5455
    if (__isExternalAddressLike(aDC)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5456
     && __isExternalAddressLike(penHandle)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5457
     && __bothSmallInteger(x0, y0)
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5458
     && __bothSmallInteger(x1, y1)) {
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5459
	HANDLE hDC = (HANDLE)(__externalAddressVal(aDC));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5460
	HANDLE hPen = (HANDLE)(__externalAddressVal(penHandle));
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5461
	COLORREF fgColor;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5462
	HANDLE prevPen;
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5463
	int __x1 = __intVal(x1), __y1 = __intVal(y1);
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5464
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5465
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5466
/*      DPRINTF(("displayLine: %d/%d -> %d/%d\n",
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5467
		    __intVal(x0), __intVal(y0),
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5468
		    __x1, __y1));
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5469
*/
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5470
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5471
/*        fgColor = GetTextColor(hDC);
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5472
 *        hPen = CreatePen(PS_SOLID, 1, fgColor);
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5473
 */
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5474
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5475
	prevPen = SelectObject(hDC, hPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5476
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5477
	MoveToEx(hDC, __intVal(x0), __intVal(y0), NULL);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5478
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5479
	LineTo(hDC, __x1, __y1);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5480
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5481
	/*
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5482
	 * end-point ...
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5483
	 */
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5484
	LineTo(hDC, __x1+1, __y1);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5485
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5486
	SelectObject(hDC, prevPen);
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5487
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5488
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5489
	RETURN ( self );
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5490
    }
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5491
%}
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5492
! !
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5493
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5494
!WinPrinterContext methodsFor:'printing process'!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5495
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5496
endPage
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5497
    "Informs device that we are finished writing to a page."
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  5498
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5499
    (OperatingSystem endPage:gcId) > 0 ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5500
	self error
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5501
    ]
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5502
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5503
    "Created: / 27-07-2006 / 18:20:48 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5504
    "Modified: / 01-08-2006 / 16:01:34 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5505
    "Modified: / 10-10-2006 / 18:14:44 / cg"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5506
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5507
2315
026d4d8cfb1b changed #endPrintJob
fm
parents: 2313
diff changeset
  5508
endPrintJobWithoutRelease
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5509
    "End the print job.  Everything drawn between startPrintJob
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5510
     and endPrintJob will become one entry in the print queue."
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  5511
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5512
    |result|
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5513
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5514
    self endPage.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5515
    result := OperatingSystem endDoc:gcId.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5516
    jobid := nil.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5517
    result >= 0 ifFalse:[ self error ]
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5518
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5519
    "Created: / 27-07-2006 / 18:21:04 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5520
    "Modified: / 01-08-2006 / 16:01:38 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5521
    "Modified: / 10-10-2006 / 18:50:43 / cg"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5522
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5523
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5524
getSupportsColor
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5525
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5526
    | retVal info |
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5527
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5528
    info := (self class getPrinterInformationString: self name) asUppercase.
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5529
    (info includesSubString: ',PSCRIPT,')
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5530
	ifTrue: [
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5531
	    retVal := self class postScriptBlackWhite not.
2347
e5b1c5c1ad88 supportsColor
fm
parents: 2344
diff changeset
  5532
"/            retVal := (DAPASX::DapasSystemInfo getYesNoInfoApp: 'Printer' profile: 'PostScriptBlackWhite') not.
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5533
	]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5534
	ifFalse: [
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5535
	    retVal := (info includesSubString: 'PDF')
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5536
		ifTrue: [true]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5537
		ifFalse: [self numberOfColorBitsPerPixel > 1].
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5538
    ].
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5539
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5540
    ^retVal
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5541
!
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5542
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5543
startPage
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5544
    "Starts a page."
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  5545
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5546
    (OperatingSystem startPage:gcId) > 0 ifFalse:[
2344
507334e9746f 24 and 32 bits support
fm
parents: 2343
diff changeset
  5547
	^ self error
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5548
    ].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5549
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5550
    "Created: / 27-07-2006 / 18:25:55 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5551
    "Modified: / 28-07-2006 / 18:19:04 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5552
    "Modified: / 10-10-2006 / 18:19:02 / cg"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5553
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5554
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  5555
startPrintJob:aString fileName:aFileName
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5556
    "Start a print job, using aString as the job title; everything
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5557
     drawn between startPrintJob and endPrintJob will become
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5558
     one entry in the print queue."
2317
c9bf3bf3c014 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2316
diff changeset
  5559
3719
a36b0c184dcb #UI_ENHANCEMENT by stefan
Stefan Vogel <sv@exept.de>
parents: 3709
diff changeset
  5560
    |docInfoStruct nameAddress fileNameAddress|
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5561
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5562
    gcId isNil ifTrue:[
3814
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  5563
	self buildPrinter
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
    abort := false.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5566
    title := aString ? 'Smalltalk/X'.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5567
    nameAddress := title asExternalBytes unprotectFromGC.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5568
    aFileName isNil ifFalse:[
3814
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  5569
	fileNameAddress := aFileName pathName asExternalBytes unprotectFromGC
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5570
    ].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5571
    docInfoStruct := Win32OperatingSystem::DocInfoStructure new.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5572
    docInfoStruct
3814
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  5573
	cbSize:docInfoStruct sizeInBytes;
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  5574
	lpszDocName:nameAddress address.
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5575
    fileNameAddress isNil ifFalse:[
3814
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  5576
	docInfoStruct lpszOutput:fileNameAddress address
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5577
    ].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5578
    jobid := OperatingSystem startDoc:gcId docInfo:docInfoStruct.
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5579
    jobid > 0 ifFalse:[
3814
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  5580
	jobid = -1 ifTrue:[
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  5581
	    abort := true.
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  5582
	    ^ nil
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  5583
	].
2905
303bf86fa4bb changed: #startPrintJob:fileName:
sr
parents: 2852
diff changeset
  5584
"/        ^ self error
3814
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  5585
	OpenError raiseErrorString:'Cannot create printer job'.
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5586
    ].
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5587
    self startPage
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5588
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5589
    "Created: / 27-07-2006 / 18:19:31 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5590
    "Modified: / 03-08-2006 / 15:11:19 / fm"
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5591
    "Modified: / 10-10-2006 / 18:20:01 / cg"
2905
303bf86fa4bb changed: #startPrintJob:fileName:
sr
parents: 2852
diff changeset
  5592
    "Modified: / 07-04-2011 / 12:03:50 / sr"
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5593
! !
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5594
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5595
!WinPrinterContext methodsFor:'queries'!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5596
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5597
hasGrayscales
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5598
    "return true, if this workstation supports grayscales
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5599
     (also true for color displays)"
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5600
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5601
    ^ true
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5602
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5603
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5604
isOpen
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5605
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5606
    ^ gcId notNil
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5607
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5608
2324
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5609
isPersistentInSnapshot
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5610
    "return true, if resources on this device are to be made
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5611
     persistent in a snapshot image."
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5612
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5613
    ^ false
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5614
!
5065edb4f5bd *** empty log message ***
fm
parents: 2323
diff changeset
  5615
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5616
supportsColor
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5617
2330
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5618
    supportsColor isNil ifTrue:[supportsColor := self getSupportsColor].
5f3b78d00a18 fill with hatch brush
fm
parents: 2329
diff changeset
  5619
    ^supportsColor
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5620
!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5621
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5622
supportsGraphics
2301
135f21a3d127 refactorred OS-independent stuff
Claus Gittinger <cg@exept.de>
parents: 2299
diff changeset
  5623
    ^(OperatingSystem getDeviceCaps: gcId index: 2 "Technology") ~= 4
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5624
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5625
    "Created: / 03-08-2006 / 10:07:43 / fm"
2301
135f21a3d127 refactorred OS-independent stuff
Claus Gittinger <cg@exept.de>
parents: 2299
diff changeset
  5626
    "Modified: / 16-04-2007 / 12:44:03 / cg"
3190
437b1425507e class: WinPrinterContext
Michael Beyl <mb@exept.de>
parents: 3041
diff changeset
  5627
!
437b1425507e class: WinPrinterContext
Michael Beyl <mb@exept.de>
parents: 3041
diff changeset
  5628
437b1425507e class: WinPrinterContext
Michael Beyl <mb@exept.de>
parents: 3041
diff changeset
  5629
supportsVariableHeightFonts
437b1425507e class: WinPrinterContext
Michael Beyl <mb@exept.de>
parents: 3041
diff changeset
  5630
437b1425507e class: WinPrinterContext
Michael Beyl <mb@exept.de>
parents: 3041
diff changeset
  5631
    ^ false
3806
b3ca52c3e77f #BUGFIX by Micha
Michael Beyl <mb@exept.de>
parents: 3745
diff changeset
  5632
!
b3ca52c3e77f #BUGFIX by Micha
Michael Beyl <mb@exept.de>
parents: 3745
diff changeset
  5633
b3ca52c3e77f #BUGFIX by Micha
Michael Beyl <mb@exept.de>
parents: 3745
diff changeset
  5634
supportsXftFonts
b3ca52c3e77f #BUGFIX by Micha
Michael Beyl <mb@exept.de>
parents: 3745
diff changeset
  5635
b3ca52c3e77f #BUGFIX by Micha
Michael Beyl <mb@exept.de>
parents: 3745
diff changeset
  5636
    ^ false
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5637
! !
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  5638
2323
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5639
!WinPrinterContext methodsFor:'registration'!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5640
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5641
registerFont:aFont
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5642
    deviceFonts register:aFont.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5643
!
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5644
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5645
unregisterFont:aFont
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5646
    deviceFonts unregister:aFont.
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5647
! !
c038faba10bf printing in context (without device)
fm
parents: 2317
diff changeset
  5648
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5649
!WinPrinterContext::WinPrinterGraphicContext class methodsFor:'documentation'!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5650
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5651
documentation
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5652
"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5653
    The class is simular to the PSGraphicsContext. It implements a
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5654
    '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
  5655
    on the current screen resolution
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5656
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5657
    supports margin, clipping ...
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5658
"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5659
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5660
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5661
examples
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5662
"
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5663
										[exBegin]
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5664
    |gc font|
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5665
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5666
    gc := WinPrinterContext openGraphicContext.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5667
    gc isNil ifTrue:[^ self ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5668
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5669
    [
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5670
	gc startPrintJob:'Test'.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5671
	gc paint:(Color black).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5672
	gc displayLineFromX:10 y:40 toX:100 y:40.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5673
	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
  5674
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5675
	gc font:font.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5676
	gc paint:(Color red).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5677
	gc displayString:'hallo' x:10 y:(40 + font ascent).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5678
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5679
	gc paint:(Color black).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5680
	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
  5681
    ] ensure:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5682
	gc close.
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5683
    ].
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5684
										[exEnd]
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5685
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5686
"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5687
! !
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5688
2353
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5689
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'accessing dimensions'!
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
bottomMargin
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5692
    "return the papers bottom margin measured in pixels"
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5693
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5694
    ^ 50
2353
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5695
!
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5696
3709
ae76cdc6787a Delegate GraphicsContext objects
Stefan Vogel <sv@exept.de>
parents: 3526
diff changeset
  5697
extent
ae76cdc6787a Delegate GraphicsContext objects
Stefan Vogel <sv@exept.de>
parents: 3526
diff changeset
  5698
    ^ width @ height
ae76cdc6787a Delegate GraphicsContext objects
Stefan Vogel <sv@exept.de>
parents: 3526
diff changeset
  5699
!
ae76cdc6787a Delegate GraphicsContext objects
Stefan Vogel <sv@exept.de>
parents: 3526
diff changeset
  5700
ae76cdc6787a Delegate GraphicsContext objects
Stefan Vogel <sv@exept.de>
parents: 3526
diff changeset
  5701
height
ae76cdc6787a Delegate GraphicsContext objects
Stefan Vogel <sv@exept.de>
parents: 3526
diff changeset
  5702
    ^ height
ae76cdc6787a Delegate GraphicsContext objects
Stefan Vogel <sv@exept.de>
parents: 3526
diff changeset
  5703
!
ae76cdc6787a Delegate GraphicsContext objects
Stefan Vogel <sv@exept.de>
parents: 3526
diff changeset
  5704
2353
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5705
leftMargin
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5706
    "return the papers left margin measured in pixels"
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5707
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5708
    ^ 50
2353
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5709
!
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5710
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5711
rightMargin
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5712
    "return the papers right margin measured in pixels"
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5713
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5714
    ^ 50
2353
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5715
!
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5716
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5717
topMargin
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5718
    "return the papers top margin measured in pixels"
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5719
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5720
    ^ 50
3709
ae76cdc6787a Delegate GraphicsContext objects
Stefan Vogel <sv@exept.de>
parents: 3526
diff changeset
  5721
!
ae76cdc6787a Delegate GraphicsContext objects
Stefan Vogel <sv@exept.de>
parents: 3526
diff changeset
  5722
ae76cdc6787a Delegate GraphicsContext objects
Stefan Vogel <sv@exept.de>
parents: 3526
diff changeset
  5723
width
ae76cdc6787a Delegate GraphicsContext objects
Stefan Vogel <sv@exept.de>
parents: 3526
diff changeset
  5724
    ^ width
2353
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5725
! !
d8d1a7094c63 margins - added but not yet supported
ca
parents: 2352
diff changeset
  5726
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5727
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'accessing-hooks'!
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5728
2357
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5729
pageCounter
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5730
    "answer the current page number"
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5731
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5732
    pageCounter ~~ 0 ifTrue:[^ pageCounter].
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5733
    ^ 1
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5734
!
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5735
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5736
pageNumberFormat:aFormatString
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5737
    "set the pageNumber format - the default is 'page %1'"
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5738
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5739
    pageNumberFormat := aFormatString ? ''
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5740
!
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5741
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5742
printPageNumbers:aBoolean
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5743
    "enable/disable printing of page numbers - the default is on"
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5744
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5745
    printPageNumbers := aBoolean.
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5746
! !
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5747
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5748
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'accessing-transformation'!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5749
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5750
clippingRectangle:aRectangle
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5751
    |tranlate extent lft rgt top bot|
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5752
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5753
    tranlate := self translation negated asPoint.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5754
    extent   := self extent.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5755
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5756
    lft := tranlate x.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5757
    top := tranlate y.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5758
    rgt := lft + extent x.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5759
    bot := top + extent y.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5760
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5761
    aRectangle notNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5762
	lft := lft max:aRectangle left.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5763
	top := top max:aRectangle top.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5764
	rgt := rgt min:aRectangle right.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5765
	bot := bot min:aRectangle bottom.
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5766
    ].
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5767
    super clippingRectangle:(Rectangle left:lft top:top right:rgt bottom:bot).
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5768
!
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5769
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5770
scale
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5771
    "answer the scale excluding the fontScale factor"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5772
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5773
    ^ super scale / fontScale
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
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5776
scale:aScale
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5777
    "set the scale and add the fontScale factor"
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
    super scale:(fontScale * (aScale ? 1.0)).
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5780
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5781
3719
a36b0c184dcb #UI_ENHANCEMENT by stefan
Stefan Vogel <sv@exept.de>
parents: 3709
diff changeset
  5782
scale:scale translation:aPoint
a36b0c184dcb #UI_ENHANCEMENT by stefan
Stefan Vogel <sv@exept.de>
parents: 3709
diff changeset
  5783
    self
3814
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  5784
	translation:aPoint;
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  5785
	scale:scale.
3719
a36b0c184dcb #UI_ENHANCEMENT by stefan
Stefan Vogel <sv@exept.de>
parents: 3709
diff changeset
  5786
!
a36b0c184dcb #UI_ENHANCEMENT by stefan
Stefan Vogel <sv@exept.de>
parents: 3709
diff changeset
  5787
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5788
transformation
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5789
    "answer the transformation excluding the fontScale factor"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5790
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5791
    ^ WindowingTransformation scale:(self scale)
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5792
			translation:(self translation).
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5793
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5794
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5795
transformation:aTransformation
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5796
    "set the transformation and add the fontScale factor"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5797
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5798
    |s t|
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5799
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5800
    aTransformation notNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5801
	s := aTransformation scale.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5802
	t := aTransformation translation.
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5803
    ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5804
    self scale:s.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5805
    self translation:t.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5806
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5807
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5808
translateBy:aTranslation
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5809
    "set the translation and add the fontScale factor"
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
    aTranslation isNil ifTrue:[^ self].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5812
    self translation:( self translation + (self scale * aTranslation)).
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5813
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5814
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5815
translation
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5816
    "answer the translation excluding the fontScale factor"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5817
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5818
    |margin trans|
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5819
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5820
    margin := Point x:(self leftMargin) y:(self topMargin).
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5821
    trans  := (super translation / fontScale) rounded.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5822
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5823
    ^ trans - margin
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
translation:aTranslation
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5827
    "set the translation and add the fontScale factor"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5828
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5829
    |trans|
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5830
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5831
    trans := Point x:(self leftMargin) y:(self topMargin).
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5832
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5833
    aTranslation notNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5834
	trans := trans + aTranslation.
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5835
    ].
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5836
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5837
    super translation:((trans * fontScale) rounded).
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5838
! !
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
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'drawing strings'!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5841
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5842
displayOpaqueString:aString from:index1 to:index2 x:x y:y
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5843
    self displayString:aString from:index1 to:index2 x:x y:y.
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
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5846
displayOpaqueString:aString x:x y:y
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5847
    |end|
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
    end := aString size.
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
    end ~~ 0 ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5852
	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
  5853
    ].
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
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5856
displayString:aString from:index1 to:index2 x:x y:y
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5857
    "setup the special scale for strings before drawing"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5858
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5859
    |tscale fscale yFont xFont|
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
    index2 < index1 ifTrue:[^ self].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5862
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5863
    transformation isNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5864
	self initTransformation.
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5865
    ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5866
    tscale := transformation scale.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5867
    fscale := tscale / fontScale.
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
    xFont := x * fontScale x.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5870
    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
  5871
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5872
    transformation scale:fscale.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5873
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5874
    super displayString:aString from:index1 to:index2
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5875
		x:xFont truncated
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5876
		y:yFont truncated.
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5877
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5878
    transformation scale:tscale.
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
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5881
displayString:aString x:x y:y
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5882
    |end|
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
    end := aString size.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5885
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5886
    end ~~ 0 ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5887
	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
  5888
    ].
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
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5891
displayString:aString x:x y:y angle:drawAngle opaque:opaque
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5892
    "angles other than 0 is not yet supported"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5893
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5894
    |angle|
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5895
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5896
    angle := drawAngle.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5897
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5898
    angle >= 360 ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5899
	angle := angle - (((angle // 360)) * 360)
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5900
    ] ifFalse:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5901
	angle < 0 ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5902
	    angle := angle - (((angle // 360)) * 360).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5903
	    angle := angle + 360.
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5904
	    angle >= 360 ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5905
		angle := angle - (((angle // 360)) * 360)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5906
	    ]
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5907
	].
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5908
    ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5909
    angle == 0 ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5910
	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
  5911
    ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5912
! !
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
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'font stuff'!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5915
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5916
fontMetricsOf:fontId
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5917
    "after retrieving the metrics, we have to scale the information"
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
    |metrics|
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5920
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5921
    metrics := super fontMetricsOf:fontId.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5922
    metrics isNil ifTrue:[^ nil ].
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
    metrics ascent:((metrics ascent / fontScale y) rounded)
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5925
	    descent:((metrics descent / fontScale y) rounded + 1)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5926
	    maxAscent:((metrics maxAscent / fontScale y) rounded)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5927
	    maxDescent:((metrics maxDescent / fontScale y) rounded + 1)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5928
	    minWidth:((metrics minWidth / fontScale x) rounded)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5929
	    maxWidth:((metrics maxWidth / fontScale x) rounded)
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5930
	    avgWidth:((metrics averageWidth / fontScale x) rounded).
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5931
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5932
    ^ metrics
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5933
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5934
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5935
getFontWithFoundry:foundry family:family weight:weight
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5936
	      slant:slant spacing:spc pixelSize:pixelSize size:pointSize
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5937
	      registry:registry encoding:encoding
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5938
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5939
    "compute the pixels dependent on the Screen current resolution"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5940
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5941
    |psize|
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5942
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5943
    psize := pixelSize.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5944
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5945
    psize isNil ifTrue:[
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5946
	psize := (pointSize * (self getLogicalPixelSizeY) / (Screen current getLogicalPixelSizeY)) rounded.
2351
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
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5949
    ^ super getFontWithFoundry:foundry family:family weight:weight
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5950
	      slant:slant spacing:spc pixelSize:psize size:pointSize
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5951
	      registry:registry encoding:encoding
2351
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
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5954
titleFont
2357
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5955
    "answer the font used for displaying page numbers..."
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5956
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5957
    titleFont isNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5958
	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
  5959
	titleFont := titleFont onDevice:(self device).
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5960
    ].
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5961
    ^ titleFont
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5962
!
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  5963
2357
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5964
titleFont:aFont
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5965
    "set the font used for displaying page numbers..."
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5966
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5967
    (aFont notNil and:[aFont ~= titleFont]) ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  5968
	titleFont := aFont onDevice:(self device).
2357
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5969
    ].
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5970
!
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  5971
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5972
widthOf:aString from:index1 to:index2 inFont:aFontId
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5973
    "after retrieving the width, we have to scale the width"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5974
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5975
    |w|
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5976
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5977
    w := super widthOf:aString from:index1 to:index2 inFont:aFontId.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5978
    w := (w / fontScale x) rounded.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5979
    ^ w
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5980
! !
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5981
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5982
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'initialization & release'!
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
close
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5985
    "compatible with PSGraphicsContext"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5986
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5987
    self endPrintJob.
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
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5990
initExtent
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5991
    "scale the extent"
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  5992
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5993
    fontScale := self resolution / Screen current resolution.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5994
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5995
    width  := (self printerWidthArea / fontScale x) rounded.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5996
    width  := width - self leftMargin - self rightMargin.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5997
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5998
    height := (self printerHeightArea / fontScale y) rounded.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  5999
    height := height - self topMargin - self bottomMargin.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6000
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6001
    self initTransformation.
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6002
!
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6003
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6004
initTransformation
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6005
    |margin|
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6006
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6007
    transformation isNil ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  6008
	margin := Point x:(self leftMargin) y:(self topMargin).
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  6009
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  6010
	transformation := WindowingTransformation scale:fontScale
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  6011
					    translation:(margin * fontScale).
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6012
    ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6013
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6014
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6015
initialize
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6016
    super initialize.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6017
3719
a36b0c184dcb #UI_ENHANCEMENT by stefan
Stefan Vogel <sv@exept.de>
parents: 3709
diff changeset
  6018
    device := nil.      "super initialize did set it to Screen current"
a36b0c184dcb #UI_ENHANCEMENT by stefan
Stefan Vogel <sv@exept.de>
parents: 3709
diff changeset
  6019
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6020
    pageCounter    := 0.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6021
    needsEndOfPage := false.
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6022
    printPageNumbers := true.
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6023
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6024
    Language == #de ifTrue:[ pageNumberFormat := 'Seite %1' ]
3814
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  6025
		   ifFalse:[ pageNumberFormat := 'page %1'  ].
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6026
! !
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6027
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6028
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'printing process'!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6029
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6030
displayTitleDo:aNoneArgAction
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  6031
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6032
    |oldClip oldTrans oldFont|
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6033
2357
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  6034
    oldClip := clipRect.
3719
a36b0c184dcb #UI_ENHANCEMENT by stefan
Stefan Vogel <sv@exept.de>
parents: 3709
diff changeset
  6035
    oldClip notNil ifTrue:[ self deviceClippingBounds:nil ].
2357
918859a27b27 accessing pageCounter and titleFont used for pageNumbers...
ca
parents: 2356
diff changeset
  6036
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6037
    oldTrans := self translation.
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6038
    oldFont  := font.
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6039
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6040
    self  font:(self titleFont).
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6041
    self  translation:0.
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6042
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6043
    aNoneArgAction value.
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6044
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6045
    self translation:oldTrans.
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6046
    oldFont notNil ifTrue:[ self font:oldFont ].
3719
a36b0c184dcb #UI_ENHANCEMENT by stefan
Stefan Vogel <sv@exept.de>
parents: 3709
diff changeset
  6047
    oldClip notNil ifTrue:[ self deviceClippingBounds:oldClip ].
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6048
!
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6049
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6050
endPage
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6051
    "ends the current page
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6052
     if the current page is already closed by endPage, the request will be ignored"
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6053
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6054
    |s|
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6055
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6056
    needsEndOfPage ifFalse:[
3814
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  6057
	^ self
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6058
    ].
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6059
    needsEndOfPage := false.
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6060
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6061
    printPageNumbers == true ifTrue:[
3814
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  6062
	self displayTitleDo:[
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  6063
	    self displayString:title
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  6064
		 x:(self extent x - (font widthOf:title)) // 2
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  6065
		 y:(self extent y + (font ascent)).
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  6066
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  6067
	    s := pageNumberFormat bindWith:pageCounter.
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  6068
	    self displayString:s
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  6069
			     x:(self extent x - (font widthOf:s))
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  6070
			     y:(self extent y + (font ascent)).
668e317f6672 obsolete _stringVal/_stringSize macros replaced
Claus Gittinger <cg@exept.de>
parents: 3806
diff changeset
  6071
	]
2356
a4128a41b721 support printPageNumbers pageNumberFormat
ca
parents: 2354
diff changeset
  6072
    ].
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6073
    super endPage.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6074
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6075
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6076
startPage
2354
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6077
    "starts a new page
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6078
     if the current page is not closed by endPage, a endPage is forward to the device"
8bfd1f8d2e08 support margins
ca
parents: 2353
diff changeset
  6079
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6080
    needsEndOfPage ifTrue:[
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  6081
	self endPage.
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6082
    ].
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6083
    super startPage.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6084
    needsEndOfPage := true.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6085
    pageCounter := pageCounter + 1.
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6086
! !
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6087
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6088
!WinPrinterContext::WinPrinterGraphicContext methodsFor:'queries'!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6089
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6090
pixelPerInch
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6091
    ^ Point x:(self pixelsPerInchOfScreenWidth)
3041
e0211b174c0e many bugs fixed (type errors)
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  6092
	    y:(self pixelsPerInchOfScreenHeight).
2351
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6093
!
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6094
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6095
resolution
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6096
    ^ self pixelPerInch
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6097
! !
4b133b41221a what you see is w3hat you get...
ca
parents: 2348
diff changeset
  6098
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  6099
!WinPrinterContext class methodsFor:'documentation'!
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  6100
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  6101
version
3526
8dea8945255b #FEATURE
Stefan Vogel <sv@exept.de>
parents: 3190
diff changeset
  6102
    ^ '$Header$'
2818
37b97e4ebb01 Use __isArrayLike() and __isByteArrayLike()
Stefan Vogel <sv@exept.de>
parents: 2621
diff changeset
  6103
!
37b97e4ebb01 Use __isArrayLike() and __isByteArrayLike()
Stefan Vogel <sv@exept.de>
parents: 2621
diff changeset
  6104
37b97e4ebb01 Use __isArrayLike() and __isByteArrayLike()
Stefan Vogel <sv@exept.de>
parents: 2621
diff changeset
  6105
version_CVS
3526
8dea8945255b #FEATURE
Stefan Vogel <sv@exept.de>
parents: 3190
diff changeset
  6106
    ^ '$Header$'
2299
b0576a106d03 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  6107
! !