home *** CD-ROM | disk | FTP | other *** search
- {$L-,D-}
- unit ColorBars;
-
- interface
-
- type
-
- ColorBar = object
- MaxColor : word;
- CurColor : word;
- ch, cw : word;
- procedure Initialize( ch, cw, mc : word);
- procedure SetColor( c : word);
- function GetColor : word;
- procedure Draw;
- procedure Erase;
- function PtInRegion( px, py : word) : boolean;
- procedure Process( px, py : word);
- end;
-
- implementation
-
- uses
- MSGraph;
-
- procedure ColorBar.Initialize( ch, cw, mc : word);
- begin
- self.MaxColor := mc;
- self.ch := ch;
- self.cw := cw;
- self.CurColor := mc-1;
- end;
-
- procedure ColorBar.Draw;
- var
- n : word;
- begin
- _SetWriteMode(_GPSET);
- with self do for n := 0 to MaxColor-1 do begin
- _SetColor(MaxColor-1);
- _Rectangle( _GBORDER, 0, n*ch, cw, (n+1)*ch);
- _SetColor(n);
- _Rectangle( _GFILLINTERIOR, 1, n*ch+1, cw-1, (n+1)*ch-1);
- end;
- end;
-
- procedure ColorBar.Erase;
- begin
- _SetColor(0);
- _Rectangle( _GFILLINTERIOR, 0, 0, self.cw, self.MaxColor*self.ch);
- end;
-
- function ColorBar.PtInRegion( px, py : word) : boolean;
- begin
- PtInRegion := (px<=self.cw) and (py<=(self.MaxColor*self.ch));
- end;
-
- procedure ColorBar.Process( px, py : word);
- begin
- self.CurColor := py div self.ch;
- end;
-
- function ColorBar.GetColor : word;
- begin
- GetColor := self.CurColor;
- end;
-
- procedure ColorBar.SetColor( c : word);
- begin
- self.CurColor := c;
- end;
-
- begin
- end.
-
-
-