Hunte Swee wrote:
>
> Can any one tell me how to make a component that has gradient
color such
> as from darkgray to lightgray. Mostly like Netscape Communicator
> Preference options?
>
> Hunte
> Hunte Information Technologies (HIT)
This may be of some help...
Q) How do I paint the color spectrum of a rainbow, and if the spectrum
is clicked on, how do I calculate what color was clicked on?
A) The following example demonstrates painting a color spectrum,
and
calculating the color of a given a point on the spectrum. Two procedures
are presented: PaintRainbow() and ColorAtRainbowPoint(). the
PaintRainbow()
procedure paints a spectrum from red to magenta if the WrapToRed
parameter
is false, or paint red to red if the WrapToRed parameter is true.
The
rainbow can
progress either in a horizontal or vertical progression. The
ColorAtRainbowPoint()
function returns a TColorRef containing the color at a given point
in
the rainbow.
Example:
procedure PaintRainbow(Dc : hDc; {Canvas to paint to}
x : integer; {Start position X}
y : integer; {Start position Y}
Width : integer; {Width of the rainbow}
Height : integer {Height of the rainbow};
bVertical : bool; {Paint verticallty}
WrapToRed : bool); {Wrap spectrum back to red}
var
i : integer;
ColorChunk : integer;
OldBrush : hBrush;
OldPen : hPen;
r : integer;
g : integer;
b : integer;
Chunks : integer;
ChunksMinus1 : integer;
pt : TPoint;
begin
OffsetViewportOrgEx(Dc,
x,
y,
pt);
if WrapToRed = false then
Chunks := 5 else
Chunks := 6;
ChunksMinus1 := Chunks - 1;
if bVertical = false then
ColorChunk := Width div Chunks else
ColorChunk := Height div Chunks;
{Red To Yellow}
r := 255;
b := 0;
for i := 0 to ColorChunk do begin
g:= (255 div ColorChunk) * i;
OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r,
g, b)));
if bVertical = false then
PatBlt(Dc, i, 0, 1, Height, PatCopy)
else
PatBlt(Dc, 0, i, Width, 1, PatCopy);
DeleteObject(SelectObject(Dc, OldBrush));
end;
{Yellow To Green}
g:=255;
b:=0;
for i := ColorChunk to (ColorChunk * 2) do begin
r := 255 - (255 div ColorChunk) * (i - ColorChunk);
OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r,
g, b)));
if bVertical = false then
PatBlt(Dc, i, 0, 1, Height, PatCopy)
else
PatBlt(Dc, 0, i, Width, 1, PatCopy);
DeleteObject(SelectObject(Dc, OldBrush));
end;
{Green To Cyan}
r:=0;
g:=255;
for i:= (ColorChunk * 2) to (ColorChunk * 3) do begin
b := (255 div ColorChunk)*(i - ColorChunk *
2);
OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r,
g, b)));
if bVertical = false then
PatBlt(Dc, i, 0, 1, Height, PatCopy)
else
PatBlt(Dc, 0, i, Width, 1, PatCopy);
DeleteObject(SelectObject(Dc,OldBrush));
end;
{Cyan To Blue}
r := 0;
b := 255;
for i:= (ColorChunk * 3) to (ColorChunk * 4) do begin
g := 255 - ((255 div ColorChunk) * (i - ColorChunk
* 3));
OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r,
g, b)));
if bVertical = false then
PatBlt(Dc, i, 0, 1, Height, PatCopy)
else
PatBlt(Dc, 0, i, Width, 1, PatCopy);
DeleteObject(SelectObject(Dc, OldBrush));
end;
{Blue To Magenta}
g := 0;
b := 255;
for i:= (ColorChunk * 4) to (ColorChunk * 5) do begin
r := (255 div ColorChunk) * (i - ColorChunk
* 4);
OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r,
g, b)));
if bVertical = false then
PatBlt(Dc, i, 0, 1, Height, PatCopy)
else
PatBlt(Dc, 0, i, Width, 1, PatCopy);
DeleteObject(SelectObject(Dc, OldBrush))
end;
if WrapToRed <> false then begin
{Magenta To Red}
r := 255;
g := 0;
for i := (ColorChunk * 5) to ((ColorChunk *
6) - 1) do begin
b := 255 -((255 div ColorChunk)
* (i - ColorChunk * 5));
OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r,g,b)));
if bVertical = false then
PatBlt(Dc, i, 0, 1,
Height, PatCopy) else
PatBlt(Dc, 0, i, Width,
1, PatCopy);
DeleteObject(SelectObject(Dc,OldBrush));
end;
end;
{Fill Remainder}
if (Width - (ColorChunk * Chunks) - 1 ) > 0 then begin
if WrapToRed <> false then begin
r := 255;
g := 0;
b := 0;
end else begin
r := 255;
g := 0;
b := 255;
end;
OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r,
g, b)));
if bVertical = false then
PatBlt(Dc,
ColorChunk * Chunks,
0,
Width - (ColorChunk * Chunks),
Height,
PatCopy) else
PatBlt(Dc,
0,
ColorChunk * Chunks,
Width,
Height - (ColorChunk * Chunks),
PatCopy);
DeleteObject(SelectObject(Dc,OldBrush));
end;
OffsetViewportOrgEx(Dc,
Pt.x,
Pt.y,
pt);
end;
function ColorAtRainbowPoint(ColorPlace : integer; {place on the
rainbow
to get the color}
RainbowWidth : integer; {width of the
rainbow}
WrapToRed : bool) : TColorRef; {does the
rainbow wrap back around to red}
var
ColorChunk : integer;
ColorChunkIndex : integer;
ColorChunkStart : integer;
begin
if ColorPlace = 0 then begin
result := RGB(255, 0, 0);
exit;
end;
{WhatChunk}
if WrapToRed <> false then
ColorChunk := RainbowWidth div 6 else
ColorChunk := RainbowWidth div 5;
ColorChunkStart := ColorPlace div ColorChunk;
ColorChunkIndex := ColorPlace mod ColorChunk;
case ColorChunkStart of
0 : result := RGB(255,
(255 div ColorChunk) * ColorChunkIndex,
0);
1 : result := RGB(255 - (255 div ColorChunk) * ColorChunkIndex,
255,
0);
2 : result := RGB(0, 255, (255 div ColorChunk) * ColorChunkIndex);
3 : result := RGB(0,
255 - (255 div ColorChunk) * ColorChunkIndex,
255);
4 : result := RGB((255 div ColorChunk) * ColorChunkIndex,
0,
255);
5 : result := RGB(255,
0,
255 - (255 div ColorChunk) * ColorChunkIndex);
else
if WrapToRed <> false then
result := RGB(255, 0, 0) else
result := RGB(255, 0, 255);
end;{Case}
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
PaintRainbow(Form1.Canvas.Handle,
0,
0,
Form1.ClientWidth,
Form1.ClientHeight,
false,
true);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
InvalidateRect(Form1.Handle, nil, false);
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Color : TColorRef;
begin
Color := ColorAtRainbowPoint(y,
Form1.ClientWidth,
true);
ShowMessage(IntToStr(GetRValue(Color)) + #32 +
IntToStr(GetGValue(Color)) + #32 +
IntToStr(GetBValue(Color)));
end;
Joe
--
Joe C. Hecht
http://home1.gte.net/joehecht/index.htm
unit Main;
interface
uses
Windows, Buttons, Messages, SysUtils, Classes, Graphics,
Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
procedure FormResize(Sender: TObject);
private
CaptionBtn : TRect;
procedure DrawCaptButton;
procedure WMNCPaint(var Msg : TWMNCPaint); message
WM_NCPaint;
procedure WMNCActivate(var Msg : TWMNCActivate);
message WM_NCACTIVATE;
procedure WMSetText(var Msg : TWMSetText); message
WM_SETTEXT;
procedure WMNCHitTest(var Msg : TWMNCHitTest);
message WM_NCHITTEST;
procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown);
message
WM_NCLBUTTONDOWN;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
const
htCaptionBtn = htSizeLast + 1;
{$R *.DFM}
procedure TForm1.DrawCaptButton;
var
xFrame,
yFrame,
xSize,
ySize : Integer;
R : TRect;
begin
//Dimensions of Sizeable Frame
xFrame := GetSystemMetrics(SM_CXFRAME);
yFrame := GetSystemMetrics(SM_CYFRAME);
//Dimensions of Caption Buttons
xSize := GetSystemMetrics(SM_CXSIZE);
ySize := GetSystemMetrics(SM_CYSIZE);
//Define the placement of the new caption button
CaptionBtn := Bounds(Width - xFrame - 4*xSize + 2,
yFrame + 2, xSize - 2, ySize - 4);
//Get the handle to canvas using Form's device context
Canvas.Handle := GetWindowDC(Self.Handle);
Canvas.Font.Name := 'Symbol';
Canvas.Font.Color := clBlue;
Canvas.Font.Style := [fsBold];
Canvas.Pen.Color := clYellow;
Canvas.Brush.Color := clBtnFace;
try
DrawButtonFace(Canvas, CaptionBtn, 1, bsAutoDetect,
False, False, False);
//Define a smaller drawing rectangle within
the button
R := Bounds(Width - xFrame - 4 * xSize + 2,
yFrame + 3, xSize - 6, ySize - 7);
with CaptionBtn do
Canvas.TextRect(R, R.Left + 2, R.Top
- 1, 'W');
finally
ReleaseDC(Self.Handle, Canvas.Handle);
Canvas.Handle := 0;
end;
end;
procedure TForm1.WMNCPaint(var Msg : TWMNCPaint);
begin
inherited;
DrawCaptButton;
end;
procedure TForm1.WMNCActivate(var Msg : TWMNCActivate);
begin
inherited;
DrawCaptButton;
end;
procedure TForm1.WMSetText(var Msg : TWMSetText);
begin
inherited;
DrawCaptButton;
end;
procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest);
begin
inherited;
with Msg do
if PtInRect(CaptionBtn, Point(XPos - Left, YPos
- Top)) then
Result := htCaptionBtn;
end;
procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
begin
inherited;
if (Msg.HitTest = htCaptionBtn) then
ShowMessage('You hit the button on the caption
bar');
end;
I got this from the web site:
http://www.alpine.net/~robert
or http://www.delumpa.com
I don't remember which one.
If you go there you can download the project to see it work.
procedure TForm1.FormResize(Sender: TObject);
begin
//Force a redraw of caption bar if form is resized
Perform(WM_NCACTIVATE, Word(Active), 0);
end;
end.
On 8 Feb 1999 13:27:53 GMT, "Antony" <agiles@tin.it> wrote:
>I've read everything I have on Turbo Pascal, but I still can't
find how to
>read/write from a serial port or, better still, 2 serial ports.
Can anyone
>give me a simple example to get me started?
The reason you haven't found anything is that there isn't much in
the
way of support for serial ports in Turbo Pascal, and the reason
for
that is that there isn't much support for serial ports from DOS.
Any
kind of serious serial port work requires either getting your hands
dirty with writing interrupt service routines, or using a third-party
toolkit. For an example of the latter, visit the Turbo Power Software
web site (www.turbopower.com) and look at Async Pro. I strongly
recommend that you use a third-party toolkit if this is anything
more
than a "hobbyist" sort of application.
For an example of the former technique, here is some very bare-bones
code for accessing serial ports:
First, the main workhorse unit, TC_COMM.PAS. This file was written
many years ago for a specific application, so there may be a few
places where it's not as generic as it could be:
--------8<--------
unit Tc_Comm; { RS-232C communications }
interface
uses Dos;
const
CommBufMin = 256;
CommBufMax = 65000;
{ comm port constants }
cpComm1 = $00;
cpComm2 = $01;
{ baud rate constants }
br110 = $00;
br150 = $20;
br300 = $40;
br600 = $60;
br1200 = $80;
br2400 = $A0;
br4800 = $C0;
br9600 = $E0;
{ parity constants }
paNone = $00;
paOdd = $08;
paEven = $18;
{ stop bits constants }
sb1 = $00;
sb2 = $04;
{ data bits constants }
db7 = $02;
db8 = $03;
{ comm error constants }
ceOK = 0; { no
error }
ceInUse = -1; { can't initialize a comm
port already in use }
ceBuffer = -2; { unable to allocate comm buffer
}
type
TCommPort = cpComm1..cpComm2;
PComm = ^TComm;
TComm = object
CommPort: TCommPort;
constructor Init (ACommPort: TCommPort; ABaudRate,
AParity,
ADataBits, AStopBits: Byte; BufferSize:
Word);
destructor Done; virtual;
function BufEmpty: Boolean; virtual;
function Read: Char; virtual;
procedure Write (C: Char); virtual;
end;
function CommError: Integer;
implementation
const
PICReg = $20;
PICMask = $21;
PICClear = $20;
BIOSSerialIntNo = $14;
CommIntNo: array[TCommPort] of Byte = ($0C,$0B);
CommIntBit: array[TCommPort] of Byte = ($10,$08);
CommData: array[TCommPort] of Word = ($03F8,$02F8);
CommInt: array[TCommPort] of Word = ($03F9,$02F9);
CommIntID: array[TCommPort] of Word = ($03FA,$02FA);
CommLineCtl: array[TCommPort] of Word = ($03FB,$02FB);
CommModemCtl: array[TCommPort] of Word = ($03FC,$02FC);
CommLineSts: array[TCommPort] of Word = ($03FD,$02FD);
CommModemSts: array[TCommPort] of Word = ($03FE,$02FE);
BufSize: array[TCommPort] of Word = (0,0);
var
BufTail,BufHead,BufSeg,BufOfs: array[TCommPort] of Word;
BufPtr,CommISRSave: array[TCommPort] of Pointer;
CommErrorVar: Integer;
procedure SetCommError (Value: Integer);
begin
CommErrorVar := Value;
end;
function CommError: Integer;
begin
CommError := CommErrorVar;
SetCommError (ceOK);
end;
procedure EnableInterrupts;
Inline ($FB); { sti }
{$S-}
procedure Comm1ISR; interrupt;
begin
Mem[BufSeg[cpComm1]:BufOfs[cpComm1]+BufTail[cpComm1]]
:= Port[CommData[cpComm1]];
Inc (BufTail[cpComm1]);
if BufTail[cpComm1] >= BufSize[cpComm1] then BufTail[cpComm1] :=
0;
EnableInterrupts;
Port[PICReg] := PICClear;
end;
procedure Comm2ISR; interrupt;
begin
Mem[BufSeg[cpComm2]:BufOfs[cpComm2]+BufTail[cpComm2]]
:= Port[CommData[cpComm2]];
Inc (BufTail[cpComm2]);
if BufTail[cpComm2] >= BufSize[cpComm2] then BufTail[cpComm2] :=
0;
EnableInterrupts;
Port[PICReg] := PICClear;
end;
{$S+}
constructor TComm.Init (ACommPort: TCommPort;
ABaudRate,AParity,ADataBits,
AStopBits: Byte; BufferSize: Word);
var
R: Registers;
Mask: Byte;
TempPtr: Pointer;
begin
SetCommError (ceOK);
if BufSize[ACommPort] <> 0 then
begin
SetCommError (ceInUse);
Fail;
end;
CommPort := ACommPort;
BufHead[CommPort] := 0;
BufTail[CommPort] := 0;
if BufferSize < CommBufMin then BufferSize := CommBufMin
else if BufferSize > CommBufMax then BufferSize := CommBufMax;
GetMem (TempPtr,BufferSize);
if TempPtr = nil then
begin
SetCommError (ceBuffer);
Fail;
end;
BufSize[CommPort] := BufferSize;
BufSeg[CommPort] := Seg (TempPtr^);
BufOfs[CommPort] := Ofs (TempPtr^);
asm
xor ah,ah
mov al,ABaudRate
or al,AParity
or al,AStopBits
or al,ADataBits
xor dx,dx
mov dl,CommPort
int BIOSSerialIntNo
end;
case CommPort of
cpComm1: SetIntVec (CommIntNo[CommPort],@Comm1ISR);
cpComm2: SetIntVec (CommIntNo[CommPort],@Comm2ISR);
end;
Port[CommModemCtl[CommPort]] := $0B;
Port[CommInt[CommPort]] := 1;
Mask := Port[PICMask];
Mask := Mask and (not CommIntBit[CommPort]);
Port[PICMask] := Mask;
end;
destructor TComm.Done;
var
Mask: Byte;
TempPtr: Pointer;
begin
Mask := Port[PICMask];
Mask := Mask or CommIntBit[CommPort];
Port[PICMask] := Mask;
TempPtr := Ptr (BufSeg[CommPort],BufOfs[CommPort]);
SetIntVec (CommIntNo[CommPort],CommISRSave[CommPort]);
FreeMem (TempPtr,BufSize[CommPort]);
BufSize[CommPort] := 0;
end;
function TComm.BufEmpty;
begin
BufEmpty := BufTail[CommPort] = BufHead[CommPort];
end;
function TComm.Read;
var
C: Char;
begin
repeat { do nothing }
until BufHead[CommPort] <> BufTail[CommPort];
Read := Char (Mem[BufSeg[CommPort]:BufOfs[CommPort] +
BufHead[CommPort]]);
Inc (BufHead[CommPort]);
if BufHead[CommPort] >= BufSize[CommPort] then BufHead[CommPort]
:= 0;
end;
procedure TComm.Write (C: Char);
begin
repeat { do nothing }
until (Port[CommLineSts[CommPort]] and $20) <> 0;
Port[CommData[CommPort]] := Byte (C);
end;
var
ExitSave: Pointer;
procedure CommExit; far;
var
Mask: Byte;
begin
ExitProc := ExitSave;
Mask := Port[PICMask];
Mask := Mask or CommIntBit[cpComm1] or CommIntBit[cpComm2];
Port[PICMask] := Mask;
SetIntVec (CommIntNo[cpComm1],CommISRSave[cpComm1]);
SetIntVec (CommIntNo[cpComm2],CommISRSave[cpComm2]);
end;
begin
ExitSave := ExitProc;
ExitProc := @CommExit;
GetIntVec (CommIntNo[cpComm1],CommISRSave[cpComm1]);
GetIntVec (CommIntNo[cpComm2],CommISRSave[cpComm2]);
end.
--------8<--------
And here's a simple terminal emulator program that demonstrates
use of
the above unit:
--------8<--------
program TerminalEmulator;
uses Crt,Tc_Comm;
const
kbNull = #$00;
kbAltX = #$2D;
kbCtrlT = #$14;
kbCtrlX = #$18;
kbEnter = #$0D;
var
Comm: TComm;
procedure MainLoop;
var
Quit: Boolean;
C: Char;
begin
Quit := False;
repeat
while not (Comm.BufEmpty) do
begin
C := Comm.Read;
Write (C);
if C = kbEnter then WriteLn;
end;
if Keypressed then
begin
C := ReadKey;
case C of
kbNull: case ReadKey of
kbAltX: Quit := True;
end;
' '..'~': Comm.Write (C);
kbCtrlT,kbCtrlX,kbEnter: Comm.Write
(C);
end;
end;
until Quit;
end;
begin
Comm.Init (cpComm1,br9600,paNone,db8,sb1,1024);
MainLoop;
end.
--------8<--------
-Steve
Ing. Franz Glaser wrote:
> Sound expects the frequency in Hertz. A (in German we name it
> so, not La) has 440 Hz and all the other notes have frequencies
> with a factor of the 12th root of 2.
Correct. The 12th root of two includes the black keys and
white keys,
but the names Do Re Mi etc. apply only to the major keys (the white
keys
in the key of C.) The American names are:
Do Re Mi Fa
So La Ti Do
C C# D D# E F F# G G#
A A# B C
261.6
440 523.3
Hz
Hz Hz
(view in fixed-pitch font)
- Rich
odtaa wrote:
> Help!! Does anyone know the codes I should put into Sound to get
Do Ray
> Me etc.
Here are the frequencies for the different notes. Consider that
the
procedure Sound does not allow floating point numbers to be passed
a a
parameter. I recommend you use Round instead of Trunc, or better,
you round
it yourself, that's some code less in your program.
C : 261.63
C# : 277.20
D : 293.66
D# : 311.60
E : 329.63
F : 349.23
F# : 370
G : 392
G# : 416
A : 440
B : 493.88
C : 523.25
C# : 554.80
You can double these values to obtain the frequency of the same
note on the
next octave. The result is not always exact, but it's a simple
formula.
On Thu, 11 Feb 1999 23:38:25 +0800, "HK Chang" <hkchang@bigfoot.com>
wrote:
>Is there any one know if turbo pascal has a more fine measuring
time unit? I
>only know that it can measure down to 1/100 second. How I have
more fine
>measuring unit?
>
>HK Chang.
Hi!
Just try the following unit. The handling is very easy:
- Turn the timer on with 'timer_on'
- Read the counter by using 'readtimer'. It returns a longint value
which shows, how many milliseconds the timer is already
running.
When you set 'freq' to a higher value, you can even get
higher
precision.
- After using the timer, you should turn it off by using 'timer_off'.
I hope, this unit works,
Bye, Christoph
------------Code-------------
unit timer;
interface
procedure timer_on;
function readtimer: longint;
procedure timer_off;
const freq=1000;
implementation
uses dos;
Var OTimerInt: pointer;
counter:word;
on: boolean;
procedure SetFrequency(Proc : pointer; Freq : word);
var izaehler : word;
oldv : pointer;
begin;
asm cli end;
izaehler := 1193180 DIV Freq;
Port[$43] := $36;
Port[$40] := Lo(IZaehler);
Port[$40] := Hi(IZaehler);
Getintvec(8,OTimerInt);
SetIntVec(8,Proc);
counter:=0;
asm sti end;
end;
procedure timer_off;
begin;
asm cli end;
port[$43] := $36;
Port[$40] := 0;
Port[$40] := 0;
SetIntVec(8,OTimerInt);
asm sti end;
on:=false;
end;
procedure Timer_interrupt; interrupt;
begin;
inc(counter);
port[$20] := $20;
end;
procedure timer_on;
begin
if on=true then
Timer_off;
on:=true;
setfrequency(@Timer_Interrupt,freq);
end;
function readtimer;
begin
readtimer:=counter;
end;
begin
on:=false;
end.
On Fri, 19 Feb 1999 08:52:21 GMT, Mivi@OCCData.Dk (Michael Vilhelmsen)
wrote:
> The last few months our programs have broked down with error 163.
> This error is not mentioned by Turbo Pascal (It stops at 162
and continueds at 200).
>
> Do anyone know what this error code means ??
> Or maybe where I can find some information on the subject ??
TP I/O errors from 150 up to 170 are errors reported
to INT_$24
(critical error handler). TP's handler extracts the error code,
adds
150 and "implants" this error code as a return value to the library
function in which this error occurs. Thus you encountered "critical
error 13 = 0Dh, sharing violation".
See Ralph Browns interrupt list for a complete reference.
Copied from Ralf Brown's Interrupt List, #s 150..170
included by Franz Glaser
Hallo Jens,
ich möchte die Struktur des BMP Formates noch etwas herausheben:
In einem Bitmap file kann ein Bitmap (BMP), ein Pointer (PTR) oder
ein
Icon (ICO) stecken.
Im File hast DU
File Header
Bitmap Header
Color Palette
Bitmap Data
Der FILE HEADER ist 14 bytes lang:
Bytes
2 FileType (4D42h "BM" für
einzelnes Bitmap)
4 FileSize (größe
des fileheaders + größe des bitmap headers -
meistens Null)
2 XHotSpot (für pointer
und icons)
2 YHotSpot (für pointer
und icons)
4 BitmapOffset hier fängt
die BitmapData an gemessen vom
Dateianfang
Bitmap Header
hier gibt es version 1.x und version 2.x Header
die ersten 4 bytes geben dir die größe des bitmap headers
ist der bitmap neader 12 byte lang, so ist es ein version 1.x bitmap,
größer 12 (mindestens 16) bedeutet Version 2.x bitmap.
Es ist wichtig das abzufragen, den die nächsten beiden Felder
sind
Breite und Höhe, in Version 1.x je 2 byte, in Version 2.x
je 4 byte
lang.
BITMAP HEADER version 1.x:
bytes
4 size of bitmapheader
wie der name schon sagt
2 breite wie der name
schon sagt
2 höhe
wie der name schon sagt
2 numplanes
Anzahl Farbebenen = 1
2 BitsPerPixel
1 (schwarz/weiß), 4, 8 oder 24 (true colour)
Gescanned wird in Zeilen, beachte, daß Breite kein scan-line-padding
berücksichtigt
Es scheint so, als ob eine Farbebene die Größe
Breite * Höhe * BitsPerPixel hätte, in Wirklichkeit aber
kommt
scan-line-padding für jede Zeile dazu (siehe unten)
BITMAP HEADER version 2.x
Byte
4 Size Größe
bitmapheader (16 <= size <= 64)
4 Breite
4 Höhe
2 numplanes
2 BitsPerPixel
und nun zusätzliche Felder
4 Kompression
0-unkomprmiert
1- 8-bit RLE
2- 4-bit RLE
3- Hufman 1D algorithmus
4- 24-Bit RLE
4 imagesize
Größe der eigentlichen bitmap Daten
4 x-resolution
Bildschirmauflösung x, kann man benutzen zum
genaueren Anzeigen
4 y-resolution
Bildschirmauflösung y
4 ColorsUsed
Anzahl der benutzen Farbeinträge (bitte
beachten, falls ColorsUsed=0 und BitsperPixel<24 dann
beinhaltet die
Palette alle möglichen Farben für die Pixeltiefe
(siehe Palette weiter
unten))
4 ColorsImportant Anzahl der
wichtigen Farbeinträge (wenn man zB
nicht alle darstellen kann, kann man wenigstens die
wichtigen Farben
dabei haben)
2 Units
muß 0 sein
2 Reserved
padding, um eine 4 Bytegrenze zu erhalten, immer 0
2 Recording
muß 0 sein, bedeutet von links nach rechts,
von unten nach oben
2 Rendering
bezeichnet Halbtonalgorithmus
0- ohne
1- error diffusion halftonig
2- processing Algorithm for Noncoded Document
Acquisition (PANDA)
3- super-circle halftonig
4 Size1
benutzt bei halftoning
4 Size2
benutzt bei halftoning
4 ColorEncoding
muß 0 sein, bedeutet RGB
4 Identifier
anwednungsspezifisch
Du musst zuerst Size lesen, denn nicht alle Felder sind immer
enthalten, Bei Size=16 zB geht es bloß bis BitsPerPixel.
Header größer
als 64 sollte wahrscheinlich ein neues Format sein.
PALETTE version 1.x
Jedes Palettenelement hat 3 byte
Byte
1 Blau (0-255)
1 Grün (0-255)
1 Rot (0-255)
Die Gröse der Palette ist
BitPerPixel Palettengröße
1
2
4
16
8
256
24
0 (true color)
Man kann diese angabe auch überprüfen:
anzahlpaletteneinträge=(BitmapOffset - BMPFileHeaderGröße
-
BitmapHeaderGröße) / GrößePalettenElement
GrößePalettenElement=3 wie wir wissen
Es ist sinnvoll zu überprüfen, den ColorsUsed kann kleiner
sein als
die oben berechnete anzahlpaletteneinträge (habe ich schon
gehabt, bei
RLE komprimierten Bitmaps)
PALETTE version 2.x
Jedes Palettenelement hat 4 byte
Byte
1 Blau (0-255)
1 Grün (0-255)
1 Rot (0-255)
0 padding (immer 0)
Ein Paletten-Element hat also 4 Byte, sonst alles wie oben. Um zu
wissen ob 3Byte oder 4Byte Paletteneinträge mußt du
also unbedingt die
größe des bitmap headers überprüfen
IMAGE DATA
Ich will jetzt nicht auf Kompression kommen, aber vielleicht doch
noch
kurz zu den eigentlichen Bitmap Daten.
Die bitmap daten sind eine Serie von entweder paletteindizes
oder den
eigentlichen RGB Farbwerten (nämlich bei True Color).
Gescanned wird in Zeilen von oben nach unten /?),
beginnend links. Eine
Scanzeile muß auf einer 4Byte Grenze enden, deshalb gibt
es padding
wenn nötig, Beim Lesen ignorieren!
Der Bildursprung liegt also links unten.
Schwarz-weiß bilder haben 8 Pixel in einem Byte, wenn eine
Zeile
fertig ist wird nicht nur das Byte aufgefült, sondern auch
bis zu drei
weitere, bis man an eine 4Byte grenze kommt.
4Bit pixel sind zu zwei pixel pro byte gepackt
8BitPixel sind ein Pixel pro Byte
Die werte sind geweils Palettenindizes
24BitPixel speichern nacheinander Rot,Grün und BlauWerte
ab, es gibt
keine Palette,
Das war die kleine Einführung, bei weiteren Fragen bitte email
(es sei
denn, es ist von generellem Interesse)
HTH,
Steffen
tpqa index | tpqa_8 back | tpqa_10 forward | tp_index | faq_page |