home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / D1 / SWITCH.ZIP / GSWITCH.PAS
Encoding:
Pascal/Delphi Source File  |  1996-03-09  |  13.5 KB  |  384 lines
  1. {
  2.   Programm : SWITCH.PAS
  3.   Sprache  : Delphi
  4.   Zweck    : Schalter-Komponente
  5.   Datum    : 15, 16. Feb. 1996
  6.   Autor    : U.Jnr-
  7.  
  8.   This component simulates a luffing switch as used in many electic devices.
  9.   No Bitmaps are used, so it's fully scaleable.
  10.   
  11.   Sorry for comments are in german.
  12.  
  13.   Hint: Why do so many programers hide theire sources? Is this the real
  14.         sense of "share" ?
  15.  
  16.   Greeting from germany - enjoy...
  17. }
  18.  
  19. unit
  20.   GSwitch;
  21.  
  22. interface
  23.  
  24. uses
  25.   WinTypes, WinProcs, Messages, Classes, Controls, Graphics;
  26. {------------------------------------------------------------------------------}
  27.  
  28. type
  29.   RectArray = array[0..3] of TPoint;               {Vektorarraytyp fnr Rechteck}
  30.   TriArray = array[0..2] of TPoint;                 {Vektorarraytyp fnr Dreieck}
  31.  
  32.   TSwitch = class(TCustomControl)
  33.   private
  34.     TopShape: TriArray;                 {Dreieck Vektoren von Schalteroberseite}
  35.     OnShape: RectArray;               {Rechteck Vektoren von Schalterfront "ON"}
  36.     OffShape: RectArray;             {Rechteck Vektoren von Schalterfront "OFF"}
  37.     SideShape: RectArray;                  {Rechteck Vektoren von Schalterseite}
  38.  
  39.     FOnChanged: TNotifyEvent;                        {Verbindung zur Aussenwelt}
  40.     FOnChecked: TNotifyEvent;                        {Verbindung zur Aussenwelt}
  41.     FOnUnChecked: TNotifyEvent;                      {Verbindung zur Aussenwelt}
  42.  
  43.     FCaptionOn: TCaption;                   {Beschriftung Schalterstellung "ON"}
  44.     FCaptionOff: TCaption;                 {Beschriftung Schalterstellung "OFF"}
  45.     FChecked: Boolean;                               {Flag von Schalterstellung}
  46.     FCheckedLeft: Boolean;     {Flag ob "ON" links oder rechts dargestellt wird}
  47.     FSlope: Byte;                            {Neigung (3D Effekt) des Schalters}
  48.     FSideLength: Byte;          {Seitenabstand fnr hervorstehendes Schalterteil}
  49.     FOnColor: TColor;                               {Farbe fnr Frontfl_che "ON"}
  50.     FOffColor: TColor;                             {Farbe fnr Frontfl_che "OFF"}
  51.     FTopColor: TColor;                             {Farbe fnr Schalteroberseite}
  52.     FSideColor: TColor;                                 {Farbe fnr Seitenfl_che}
  53.     ALeft: Integer;                        {Linke Anfangsposition des Schalters}
  54.     ATop: Integer;                         {Obere Anfangsposition des Schalters}
  55.     AHeight: Integer;                                       {Hwhe des Schalters}
  56.     AWidth: Integer;                                      {Breite des Schalters}
  57.     LabelLen: Integer;                                {Halbbreite des Schalters}
  58.     LabelOfs: Integer;                       {Halbbreite fnr Spiegeldarstellung}
  59.     Side: Integer;                                 {Tempor_r in Setup verwendet}
  60.  
  61.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  62.     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  63.     procedure CallNotifyEvent;
  64.     procedure Setup;
  65.     procedure Draw;
  66.     procedure SetCaptionOn(Value: TCaption);
  67.     procedure SetCaptionOff(Value: TCaption);
  68.     procedure SetChecked(Value: Boolean);
  69.     procedure SetCheckedLeft(Value: Boolean);
  70.     procedure SetSlope(Value: Byte);
  71.     procedure SetSideLength(Value: Byte);
  72.     procedure SetOnColor(Value: TColor);
  73.     procedure SetOffColor(Value: TColor);
  74.     procedure SetTopColor(Value: TColor);
  75.     procedure SetSideColor(Value: TColor);
  76.   public
  77.     constructor Create(AOwner: TComponent); override;
  78.     procedure Paint; override;
  79.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  80.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  81.   published
  82.     property CaptionOn: TCaption read FCaptionOn write SetCaptionOn;
  83.     property CaptionOff: TCaption read FCaptionOff write SetCaptionOff;
  84.     property Checked: Boolean read FChecked write SetChecked default False;
  85.     property CheckedLeft: Boolean read FCheckedLeft write SetCheckedLeft default True;
  86.     property Slope: Byte read FSlope write SetSlope default 6;
  87.     property SideLength: Byte read FSideLength write SetSideLength default 6;
  88.     property OnColor: TColor read FOnColor write SetOnColor default clRed;
  89.     property OffColor: TColor read FOffColor write SetOffColor default clMaroon;
  90.     property TopColor: TColor read FTopColor write SetTopColor default clSilver;
  91.     property SideColor: TColor read FSideColor write SetSideColor default clSilver;
  92.     property Font;
  93.     property TabStop;
  94.     property TabOrder;
  95.     property ShowHint;
  96.  
  97.     property OnClick;
  98.     property OnMouseDown;
  99.     property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
  100.     property OnChecked: TNotifyEvent read FOnChecked write FOnChecked;
  101.     property OnUnChecked: TNotifyEvent read FOnUnChecked write FOnUnChecked;
  102.   end;
  103. {------------------------------------------------------------------------------}
  104.  
  105. procedure Register;
  106.  
  107. implementation
  108. {------------------------------------------------------------------------------}
  109.  
  110. constructor TSwitch.Create(AOwner: TComponent);
  111. begin
  112.   inherited Create(AOwner);
  113.   Caption:='';
  114.   FCaptionOn:='EIN';
  115.   FCaptionOff:='AUS';
  116.   FSlope:=6;
  117.   FSideLength:=6;
  118.   FChecked:=False;
  119.   FCheckedLeft:=True;
  120.   FOnColor:=clRed;
  121.   FOffColor:=clMaroon;
  122.   FTopColor:=clSilver;
  123.   FSideColor:=clSilver;
  124.   FOnChecked:=nil;
  125.   FOnUnChecked:=nil;
  126.   SetBounds(Left,Top,83,18 + FSlope);
  127.   Font.Name:='small fonts';
  128.   Font.Size:=7;
  129.   Font.Color:=clWhite;
  130. end;
  131. {------------------------------------------------------------------------------}
  132.  
  133. procedure TSwitch.Paint;
  134. begin
  135.   Draw;            {Keine geerbte Methode aufrufen und sofort Schalter zeichnen}
  136. end;
  137. {------------------------------------------------------------------------------}
  138.  
  139. procedure TSwitch.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  140. begin
  141.   inherited MouseDown(Button,Shift,X,Y);
  142.   if (Button = mbLeft) then
  143.   begin
  144.     SetFocus;
  145.     if ((LabelLen > 0) and (X > LabelLen)) or
  146.        ((LabelLen < 0) and (X < Abs(LabelLen))) then
  147.     begin    {Nur wenn Mausklick innerhalb des hervorgehobenen Schalterteil ist}
  148.       FChecked:=not FChecked;
  149.       CallNotifyEvent;
  150.       Invalidate;
  151.     end;
  152.   end;
  153. end;
  154. {------------------------------------------------------------------------------}
  155.  
  156. procedure TSwitch.WMSetFocus(var Message: TWMSetFocus);
  157. begin
  158.   Invalidate;
  159. end;
  160. {------------------------------------------------------------------------------}
  161.  
  162. procedure TSwitch.WMKillFocus(var Message: TWMKillFocus);
  163. begin
  164.   Invalidate;
  165. end;
  166. {------------------------------------------------------------------------------}
  167.  
  168. procedure TSwitch.KeyDown(var Key: Word; Shift: TShiftState);
  169. begin
  170.   if Focused and ((Key = VK_Space) or (Key = VK_Return)) then
  171.   begin
  172.     FChecked:=not FChecked;
  173.     CallNotifyEvent;
  174.     Invalidate;
  175.     Click;
  176.   end;
  177. end;
  178. {------------------------------------------------------------------------------}
  179.  
  180. procedure TSwitch.CallNotifyEvent;                       {Au-enwelt informieren}
  181. begin
  182.   if Assigned(FOnChanged) then FOnChanged(Self);
  183.   if FChecked and Assigned(FOnChecked) then FOnChecked(Self) else
  184.   if not FChecked and Assigned(FOnUnChecked) then FOnUnChecked(Self);
  185. end;
  186. {------------------------------------------------------------------------------}
  187.  
  188. procedure TSwitch.Draw;                                      {Schalter zeichnen}
  189. var
  190.   TW: Integer;
  191.   TH: Integer;
  192. begin
  193.   Setup;                                  {Vektoren fnr Schalterteile berechnen}
  194.   if Focused then Canvas.Rectangle(0,0,Width,AHeight + 1 + 2 * ATop);
  195.   Canvas.Pen.Color:=clWhite;                   {Umrandung von Schalter zeichnen}
  196.   Canvas.MoveTo(ALeft - 1,ATop + AHeight + 1);
  197.   Canvas.LineTo(ALeft + AWidth,ATop + AHeight + 1);      {Untere Linie in weiss}
  198.   Canvas.LineTo(ALeft + AWidth,ATop - 2);                {Rechte Linie in weiss}
  199.  
  200.   Canvas.Pen.Color:=clGray;
  201.   Canvas.MoveTo(ALeft + AWidth,ATop - 1);
  202.   Canvas.LineTo(ALeft - 1,ATop - 1);                 {Obere Linie in dunkelgrau}
  203.   Canvas.LineTo(ALeft - 1,ATop + AHeight + 1);       {Linke Linie in dunkelgrau}
  204.  
  205.   Canvas.Pen.Color:=clBlack;                      {Polygonumrandung ist schwarz}
  206.   Canvas.Brush.Style:=bsSolid;                      {Fnllfl_che ist geschlossen}
  207.   Setup;
  208.   Canvas.Brush.Color:=FTopColor;
  209.   Canvas.Polygon(TopShape);                         {Top des Schalters zeichnen}
  210.   Canvas.Brush.Color:=FSideColor;
  211.   Canvas.Polygon(SideShape);                      {Seite des Schalters zeichnen}
  212.   if FChecked then Canvas.Brush.Color:=FOnColor
  213.   else Canvas.Brush.Color:=FOffColor;
  214.   Canvas.Polygon(OnShape);                     {On Seite des Schalters zeichnen}
  215.   Canvas.Brush.Color:=FOffColor;
  216.   Canvas.Polygon(OffShape);                   {Off Seite des Schalters zeichnen}
  217.  
  218.   Canvas.Font:=Font;                                  {Gew_hlten Font nbergeben}
  219.   Canvas.Brush.Style:=bsClear;                        {Transparente Textausgabe}
  220.  
  221.   if FChecked then Caption:=FCaptionOn else Caption:=FCaptionOff;
  222.  
  223.   if LabelLen > 0 then TW:=ALeft + ((Abs(LabelLen) - Canvas.TextWidth(Caption)) div 2)
  224.   else TW:=LabelOfs + ((Abs(LabelLen) - Canvas.TextWidth(Caption)) div 2);
  225.   TH:=ATop + ((AHeight - Canvas.TextHeight(Caption)) div 2);
  226.  
  227.   Canvas.TextOut(TW,TH,Caption);
  228. end;
  229. {------------------------------------------------------------------------------}
  230.  
  231. procedure TSwitch.Setup;                  {Vektoren fnr Schalterteile berechnen}
  232. begin
  233.   ALeft:=2;                {2 Pixel linker Abstand fnr Rahmen und Focusrechteck}
  234.   ATop:=2;                 {2 Pixel oberer Abstand fnr Rahmen und Focusrechteck}
  235.   AHeight:=Height - FSlope - 2 * ATop;   {Schalterhwhe = Height - Ofs - Neigung}
  236.   AWidth:=Width - 2 * ALeft;                  {Schalterbreite = Width - 2 * Ofs}
  237.   LabelLen:=AWidth div 2;
  238.   LabelOfs:=LabelLen + ALeft;
  239.   Side:=FSideLength;
  240.   if (not FChecked and FCheckedLeft) or (not FCheckedLeft and FChecked) then
  241.   begin
  242.     LabelLen:=-LabelLen;
  243.     Side:=-FSideLength;
  244.   end;
  245.   TopShape[0].X:=LabelOfs;          {Vektoren von obere Dreieckfl_che berechnen}
  246.   TopShape[0].Y:=ATop;
  247.   TopShape[1].X:=LabelOfs + LabelLen - Side;
  248.   TopShape[1].Y:=ATop + FSlope;
  249.   TopShape[2].X:=LabelOfs + LabelLen;
  250.   TopShape[2].Y:=ATop;
  251.  
  252.   OnShape[0].X:=LabelOfs - LabelLen;   {Vektoren der "EIN" Frontseite berechnen}
  253.   OnShape[0].Y:=ATop;
  254.   OnShape[1]:=TopShape[0];
  255.   OnShape[2]:=OffShape[3];
  256.   OnShape[3].X:=OnShape[0].X;
  257.   OnShape[3].Y:=ATop + AHeight;
  258.  
  259.   OffShape[0]:=TopShape[0];            {Vektoren der "AUS" Frontseite berechnen}
  260.   OffShape[1]:=TopShape[1];
  261.   OffShape[2].X:=OffShape[1].X;
  262.   OffShape[2].Y:=OffShape[1].Y + AHeight;
  263.   OffShape[3].X:=OffShape[0].X;
  264.   OffShape[3].Y:=ATop + AHeight;
  265.  
  266.   SideShape[0]:=OffShape[1];               {Vektoren der Seitenfl_che berechnen}
  267.   SideShape[1]:=TopShape[2];
  268.   SideShape[2].X:=SideShape[1].X;
  269.   SideShape[2].Y:=ATop + AHeight;
  270.   SideShape[3]:=OffShape[2];
  271. end;
  272. {------------------------------------------------------------------------------}
  273.  
  274. procedure TSwitch.SetCaptionOn(Value: TCaption);   {Beschriftung "ON" nbergeben}
  275. begin
  276.   if FCaptionOn <> Value then
  277.   begin
  278.     FCaptionOn:=Value;
  279.     Invalidate;
  280.   end;
  281. end;
  282. {------------------------------------------------------------------------------}
  283.  
  284. procedure TSwitch.SetCaptionOff(Value: TCaption); {Beschriftung "OFF" nbergeben}
  285. begin
  286.   if FCaptionOff <> Value then
  287.   begin
  288.     FCaptionOff:=Value;
  289.     Invalidate;
  290.   end;
  291. end;
  292. {------------------------------------------------------------------------------}
  293.  
  294. procedure TSwitch.SetChecked(Value: Boolean);
  295. begin
  296.   if FChecked <> Value then
  297.   begin
  298.     FChecked:=Value;
  299.     CallNotifyEvent;
  300.     Invalidate;
  301.   end;
  302. end;
  303. {------------------------------------------------------------------------------}
  304.  
  305. procedure TSwitch.SetCheckedLeft(Value: Boolean);
  306. begin
  307.   if FCheckedLeft <> Value then
  308.   begin
  309.     FCheckedLeft:=Value;
  310.     Invalidate;
  311.   end;
  312. end;
  313. {------------------------------------------------------------------------------}
  314.  
  315. procedure TSwitch.SetSlope(Value: Byte);
  316. begin
  317.   if FSlope <> Value then
  318.   begin
  319.     FSlope:=Value;
  320.     Invalidate;
  321.   end;
  322. end;
  323. {------------------------------------------------------------------------------}
  324.  
  325. procedure TSwitch.SetSideLength(Value: Byte);
  326. begin
  327.   if (FSideLength <> Value) and (Value < Width - 4) then
  328.   begin
  329.     FSideLength:=Value;
  330.     Invalidate;
  331.   end;
  332. end;
  333. {------------------------------------------------------------------------------}
  334.  
  335. procedure TSwitch.SetOnColor(Value: TColor);
  336. begin
  337.   if FOnColor <> Value then
  338.   begin
  339.     FOnColor:=Value;
  340.     Invalidate;
  341.   end;
  342. end;
  343. {------------------------------------------------------------------------------}
  344.  
  345. procedure TSwitch.SetOffColor(Value: TColor);
  346. begin
  347.   if FOffColor <> Value then
  348.   begin
  349.     FOffColor:=Value;
  350.     Invalidate;
  351.   end;
  352. end;
  353. {------------------------------------------------------------------------------}
  354.  
  355. procedure TSwitch.SetTopColor(Value: TColor);
  356. begin
  357.   if FTopColor <> Value then
  358.   begin
  359.     FTopColor:=Value;
  360.     Invalidate;
  361.   end;
  362. end;
  363. {------------------------------------------------------------------------------}
  364.  
  365. procedure TSwitch.SetSideColor(Value: TColor);
  366. begin
  367.   if FSideColor <> Value then
  368.   begin
  369.     FSideColor:=Value;
  370.     Invalidate;
  371.   end;
  372. end;
  373. {------------------------------------------------------------------------------}
  374.  
  375. procedure Register;
  376. begin
  377.   RegisterComponents('Udo|s',[TSwitch]);
  378. end;
  379. {------------------------------------------------------------------------------}
  380.  
  381. initialization
  382. end.
  383.  
  384.