OS/2 Shareware BBS: 10 Tools/10-Tools.zip/sibdemo3.zip/SOURCE.DAT/SOURCE/ADDON/SPIN.PAS

Pascal/Delphi Source File | 1998-05-02 | 13KB | 429 lines

Unit Spin;

Interface

Uses SysUtils,Classes,Forms,Graphics,StdCtrls,Buttons,ComCtrls;

Type
     TSpinButton=Class(TUpDown)
        Private
              FUpButton:TSpeedButton;
              FDownButton:TSpeedButton;
        Private
              Procedure ButtonOnPaint(Sender:TObject;Const rec:TRect);
              Function GetDownGlyph:TBitmap;
              Procedure SetDownGlyph(NewValue:TBitmap);
              Function GetDownNumGlyphs:TNumGlyphs;
              Procedure SetDownNumGlyphs(NewValue:TNumGlyphs);
              Function GetUpGlyph:TBitmap;
              Procedure SetUpGlyph(NewValue:TBitmap);
              Function GetUpNumGlyphs:TNumGlyphs;
              Procedure SetUpNumGlyphs(NewValue:TNumGlyphs);
        Public
              Procedure SetupComponent;Override;
        Published
              Property DownGlyph:TBitmap read GetDownGlyph write SetDownGlyph;
              Property DownNumGlyphs:TNumGlyphs read GetDownNumGlyphs write SetDownNumGlyphs;
              Property UpGlyph:TBitmap read GetUpGlyph write SetUpGlyph;
              Property UpNumGlyphs:TNumGlyphs read GetUpNumGlyphs write SetUpNumGlyphs;
     End;


     TSpinMode=(spSpinNumbers,spSpinList);

     TSpinEdit=Class(TControl)
        Private
              FEditorEnabled:Boolean;
              FButton:TSpinButton;
              FEdit:TEdit;
              FMinValue,FMaxValue:LongInt;
              FIncrement:LongInt;
              FItems:TStrings;
              FSpinMode:TSpinMode;
              FValue:LongInt;
        Private
              Procedure SetMaxValue(NewValue:LongInt);
              Procedure SetMinValue(NewValue:LongInt);
              Procedure SetValue(NewValue:LongInt);
              Procedure SetEditorEnabled(NewValue:Boolean);
              Procedure SetItems(NewValue:TStrings);
              Procedure SetSpinMode(NewValue:TSpinMode);
              Procedure ButtonClick(Sender:TObject);
              Procedure EditResize(Sender:TObject);
              Procedure EditChange(Sender:TObject);
        Public
              Procedure SetupComponent;Override;
              Procedure SetupShow;Override;
              Destructor Destroy;Override;
              Procedure Resize;Override;
              Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
              Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
        Public
              Property Button:TSpinButton read FButton;
              Property Edit:TEdit read FEdit;
        Published
              Property Increment:LongInt read FIncrement write FIncrement;
              Property MaxValue:LongInt read FMaxValue write SetMaxValue;
              Property MinValue:LongInt read FMinValue write SetMinValue;
              Property Value:LongInt read FValue write SetValue;
              Property EditorEnabled:Boolean read FEditorEnabled write SetEditorEnabled;
              Property Items:TStrings read FItems write SetItems;
              Property SpinMode:TSpinMode read FSpinMode write SetSpinMode;
              Property Align;
              Property ClientHeight;
              Property ClientWidth;
              Property Enabled;
              Property OnBeforePaint;
              Property OnAfterPaint;
              Property TabOrder;
              Property TabStop;
              Property PopUpMenu;
              Property OnSetupShow;
              Property OnShow;
              Property Visible;
              Property Font;
              Property ParentFont;
              Property Color;
              Property ParentColor;
              Property PenColor;
              Property ParentPenColor;
     End;

Implementation

{$R Spin}

{
╔═══════════════════════════════════════════════════════════════════════════╗
║                                                                           ║
║ Speed-Pascal/2 Version 2.0                                                ║
║                                                                           ║
║ Speed-Pascal Component Classes (SPCC)                                     ║
║                                                                           ║
║ This section: TSpinButton Class Implementation                            ║
║                                                                           ║
║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
║                                                                           ║
╚═══════════════════════════════════════════════════════════════════════════╝
}


Type TSpdBtn=Class(TBitBtn)
           Procedure DoRedraw(Const rec:TRect);
     End;


Procedure TSpdBtn.DoRedraw(Const rec:TRect);
Begin
     TBitBtn.Redraw(rec);
End;

Procedure TSpinButton.ButtonOnPaint(Sender:TObject;Const rec:TRect);
Begin
     TSpdBtn(Sender).DoRedraw(rec);
End;

Procedure TSpinButton.SetupComponent;
Var Up,Down:TSpeedButton;
    Bitmap:TBitmap;
Begin
     Inherited SetupComponent;

     Name:='SpinButton';
     Width:=20;
     Height:=25;

     //Get the buttons
     //because they are declared as private, we have to use ASM :-(
     Asm
        PUSH DWORD PTR SELF
        CALLN32 ComCtrls.GetUpRightButton
        MOV Up,EAX

        PUSH DWORD PTR SELF
        CALLN32 ComCtrls.GetDownLeftButton
        MOV Down,EAX
     End;

     Up.OnPaint:=ButtonOnPaint;
     Bitmap.Create;
     Bitmap.LoadFromResourceName('SpUp');
     Up.NumGlyphs:=1;
     Up.Glyph:=Bitmap;
     Bitmap.Destroy;
     Down.OnPaint:=ButtonOnPaint;
     Bitmap.Create;
     Bitmap.LoadFromResourceName('SpDown');
     Down.NumGlyphs:=1;
     Down.Glyph:=Bitmap;
     Bitmap.Destroy;

     FUpButton:=Up;
     FDownButton:=Down;
End;

Function TSpinButton.GetDownGlyph:TBitmap;
Begin
     Result:=FDownButton.Glyph;
End;

Procedure TSpinButton.SetDownGlyph(NewValue:TBitmap);
Begin
     FDownButton.Glyph:=NewValue;
End;

Function TSpinButton.GetDownNumGlyphs:TNumGlyphs;
Begin
     Result:=FDownButton.NumGlyphs;
End;

Procedure TSpinButton.SetDownNumGlyphs(NewValue:TNumGlyphs);
Begin
     FDownButton.NumGlyphs:=NewValue;
End;

Function TSpinButton.GetUpGlyph:TBitmap;
Begin
     result:=FUpButton.Glyph;
End;

Procedure TSpinButton.SetUpGlyph(NewValue:TBitmap);
Begin
     FUpButton.Glyph:=NewValue;
End;

Function TSpinButton.GetUpNumGlyphs:TNumGlyphs;
Begin
     Result:=FUpButton.NumGlyphs;
End;

Procedure TSpinButton.SetUpNumGlyphs(NewValue:TNumGlyphs);
Begin
     FUpButton.NumGlyphs:=NewValue;
End;

{
╔═══════════════════════════════════════════════════════════════════════════╗
║                                                                           ║
║ Speed-Pascal/2 Version 2.0                                                ║
║                                                                           ║
║ Speed-Pascal Component Classes (SPCC)                                     ║
║                                                                           ║
║ This section: TSpinEdit Class Implementation                              ║
║                                                                           ║
║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
║                                                                           ║
╚═══════════════════════════════════════════════════════════════════════════╝
}


Procedure TSpinEdit.SetupComponent;
Begin
     Inherited SetupComponent;

     Name:='SpinEdit';
     Width:=100;

     FMinValue:=0;
     FMaxValue:=100;
     FIncrement:=1;
     FSpinMode:=spSpinNumbers;
     FEditorEnabled:=True;

     FItems:=TStringList.Create;

     FEdit:=TEdit.Create(Self);
     Include(FEdit.ComponentState,csDetail);
     FEdit.Width:=100-12;
     FEdit.NumbersOnly:=True;
     FEdit.OnResize:=EditResize;
     FEdit.OnChange:=EditChange;
     FEdit.ParentFont:=True;
     FEdit.ParentColor:=True;
     FEdit.ParentPenColor:=True;
     FEdit.Parent:=Self;
     Height:=FEdit.Height;

     FButton.Create(Self);
     Include(FButton.ComponentState,csDetail);
     FButton.SetWindowPos(80,0,12,Height);
     FButton.FUpButton.OnClick:=ButtonClick;
     FButton.FDownButton.OnClick:=ButtonClick;
     FButton.ParentColor:=False;
     FButton.ParentPenColor:=False;
     FButton.Parent:=Self;
End;

Procedure TSpinEdit.EditChange(Sender:TObject);
Var i:LongInt;
    c:Integer;
Begin
     If SpinMode<>spSpinNumbers Then exit;

     Val(FEdit.Text,i,c);
     If ((c<>0)Or(i<MinValue)Or(i>MaxValue)) Then
     Begin
          If ((c=0)And(i<MinValue)) Then Value:=MinValue
          Else If ((c=0)And(i>MaxValue)) Then Value:=MaxValue;
     End
     Else
     Begin
          FValue:=i;
          If FEdit.Text<>tostr(FValue) Then FEdit.Text:=tostr(FValue);
     End;
End;

Procedure TSpinEdit.ButtonClick(Sender:TObject);
Begin
     If Sender=FButton.FUpButton Then
     Begin
          If SpinMode=spSpinNumbers Then
          Begin
               If Value<MaxValue Then Value:=Value+1;
          End
          Else
          Begin
               If Value<FItems.Count-1 Then Value:=Value+1;
          End;
     End
     Else
     Begin
          If SpinMode=spSpinNumbers Then
          Begin
               If Value>MinValue Then Value:=Value-1;
          End
          Else
          Begin
               If Value>0 Then Value:=Value-1;
          End;
     End;
End;

Procedure TSpinEdit.EditResize(Sender:TObject);
Begin
     If Height<>FEdit.Height Then Height:=FEdit.Height;
End;

Procedure TSpinEdit.SetupShow;
Begin
     Inherited SetupShow;

     FEdit.Width:=Width-12;
     FButton.Left:=Width-12;
     Height:=FEdit.Height;
     FButton.Height:=FEdit.Height;
     If SpinMode=spSpinNumbers Then FEdit.Text:=tostr(Value)
     Else If Value<FItems.Count Then FEdit.Text:=FItems[Value];
End;

Destructor TSpinEdit.Destroy;
Begin
     FItems.Destroy;
     FItems:=Nil;
     Inherited Destroy;
End;

Procedure TSpinEdit.Resize;
Begin
     Inherited Resize;

     If FEdit.Height<>Height Then FEdit.Height:=Height;
     FEdit.Width:=Width-12;
     FButton.Left:=Width-12;
     FButton.Height:=Height;
End;

Procedure TSpinEdit.SetMaxValue(NewValue:LongInt);
Begin
     FMaxValue:=NewValue;
     If Value>FMaxValue Then Value:=FMaxValue;
End;

Procedure TSpinEdit.SetMinValue(NewValue:LongInt);
Begin
     FMinValue:=NewValue;
     If Value<FMinValue Then Value:=FMinValue;
End;

Procedure TSpinEdit.SetValue(NewValue:LongInt);
Begin
     If SpinMode=spSpinNumbers Then
     Begin
          If ((NewValue<FMinValue)Or(NewValue>FMaxValue)) Then exit;
     End
     Else
     Begin
          If ((NewValue<0)Or(NewValue>FItems.Count-1)) Then exit;
     End;
     FValue:=NewValue;
     If SpinMode=spSpinNumbers Then FEdit.Text:=tostr(FValue)
     Else If FValue<FItems.Count Then FEdit.Text:=FItems[FValue];
End;

Procedure TSpinEdit.SetEditorEnabled(NewValue:Boolean);
Begin
     FEditorEnabled:=NewValue;
     FEdit.ReadOnly:=not NewValue;
End;

Procedure TSpinEdit.SetItems(NewValue:TStrings);
Begin
     If NewValue <> FItems Then FItems.Assign(NewValue);
     If SpinMode=spSpinList Then
     Begin
          If Value<0 Then Value:=0
          Else If Value>FItems.Count-1 Then Value:=FItems.Count-1
          Else FEdit.Text:=FItems[Value];
     End;
End;

Procedure TSpinEdit.SetSpinMode(NewValue:TSpinMode);
Begin
     FSpinMode:=NewValue;
     If SpinMode=spSpinNumbers Then
     Begin
          If Value<MinValue Then Value:=MinValue
          Else If Value>MaxValue Then Value:=MaxValue
          Else FEdit.Text:=tostr(Value);
          FEdit.ReadOnly:=not EditorEnabled;
     End
     Else
     Begin
          If Value<0 Then Value:=0
          Else If Value>FItems.Count-1 Then Value:=FItems.Count-1
          Else If Value<FItems.Count Then FEdit.Text:=FItems[Value];
          FEdit.ReadOnly:=True;
     End;
End;

Const rnSpinEditItems='rnSpinEditItems';

Procedure TSpinEdit.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
Var aText:PChar;
Begin
     If ResName = rnSpinEditItems Then
     Begin
          aText := @Data;
          Items.SetText(aText);
     End
     Else Inherited ReadSCUResource(ResName,Data,DataLen);
End;

Function TSpinEdit.WriteSCUResource(Stream:TResourceStream):Boolean;
Var aText:PChar;
Begin
     Result:=Inherited WriteSCUResource(Stream);
     If not Result Then exit;

     aText := Items.GetText;
     If aText <> Nil Then
     Begin
          Result := Stream.NewResourceEntry(rnSpinEditItems,aText^,Length(aText^)+1);
          StrDispose(aText);
     End;
End;

Begin
     RegisterClasses([TSpinButton,TSpinEdit]);
End.