[Pythianproject-cvsmail] CVS: Prototypes/GUISystem vglCheckBox.pas,NONE,1.1 skin1.png,1.3,1.4 StartupForm.pas,1.4,1.5

[Kamil K. <kkr...@us...>]

Update of /cvsroot/pythianproject/Prototypes/GUISystem
In directory slayer.i.sourceforge.net:/tmp/cvs-serv27918

Modified Files:
	skin1.png StartupForm.pas 
Added Files:
	vglCheckBox.pas 
Log Message:
added TvglCheckBox component

--- NEW FILE ---
unit vglCheckBox;

interface

uses
  Windows,
  Classes,
  Graphics,
  GLCanvas,
  vglClasses;


const
  VGL_SKINRECT_CHECKBOXSET: TRect = (Left: 0; Top: 205; Right: 13; Bottom: 217);
  VGL_SKINRECT_CHECKBOXUNSET: TRect = (Left: 12; Top: 205; Right: 25; Bottom: 217);
  vglCheckOver_Intensity = 220;
  vglCheckUp_Intensity = 255;
  vglCheckDown_Intensity = 200;

type
  TvglCheckBox = class(TvglComponent)
  private
    procedure SetColor(const Value: TColor);
  protected
    FChecked: Boolean;
    FOnChanged: TNotifyEvent;
    FImage: TGLBitmap;
    FCaptionText: TGLText;
    FMouseMarkDown: Boolean;
    FMouseMarkOver: Boolean;
    FMouseOver: Boolean;
    procedure SetCaption(const Value: string);
    function GetCaption: string;
    procedure SetOnChanged(const Value: TNotifyEvent);
    procedure SetChecked(const Value: Boolean);

    procedure DoChanged; dynamic;
    function GetComponentType: string; override ;

    procedure DoOnMouseEntry; override ;
    procedure DoOnMouseExit; override ;
    procedure DoOnMouseDown(mb, x, y: Integer); override;
    procedure DoOnMouseClick(x, y: Integer); override;
    procedure DoOnMouseUp(mb, x, y: Integer); override;
    procedure DoOnMouseMove(X,Y:integer); override;
    procedure UpdateBounds;
    function GetCheckMarkBounds(where: TRect): TRect; virtual;
    function GetCheckMarkSkinRect: TRect;
    procedure CheckMarkOver(X, Y: Integer);
  public
    constructor Create(aName:string; AOwner:TvglComponent);
    destructor Destroy; override ;

    procedure DrawSelf(where:TRect); override ;
  published
    property Checked: Boolean read FChecked write SetChecked default False;
    property Color :TColor write SetColor;
    property Caption: string read GetCaption write SetCaption;
    property OnChanged: TNotifyEvent read FOnChanged write SetOnChanged;
  end;

implementation

uses
  Math;
{ TvglCheckBox }

procedure TvglCheckBox.CheckMarkOver(X, Y: Integer);
begin
  FMouseMarkOver := PointInRect(GetCheckMarkBounds(ScreenBounds), X, Y);
end;

constructor TvglCheckBox.Create(aName: string; AOwner: TvglComponent);
begin
  inherited Create(aName, AOwner);
  FImage := TGLBitmap(Manager.GetResource(VGL_SKIN_1));
//  FCaptionText := TGLText.Create('Courier New');
  FCaptionText := TGLText.Create('Arial');
  FCaptionText.Text := aName;
  FCaptionText.SetColor(clBlack);
  FMouseMarkDown := False;
  FMouseOver := False;
  FChecked := False;
  FOnChanged := nil;
  UpdateBounds;
end;

destructor TvglCheckBox.Destroy;
begin
  FImage := nil;
  inherited Destroy;
end;

procedure TvglCheckBox.DoChanged;
begin
  if Assigned(FOnChanged) then
    FOnChanged(Self);
end;

procedure TvglCheckBox.DoOnMouseClick(x, y: Integer);
begin
  inherited DoOnMouseClick(x, y);
  if PointInRect(GetCheckMarkBounds(ScreenBounds), X, Y) then
  begin
    FChecked := not FChecked;
    DoChanged;
  end;
end;

procedure TvglCheckBox.DoOnMouseDown(mb, x, y: Integer);
begin
  inherited DoOnMouseDown(mb, x, y);
  if mb <> VGL_MOUSE_LEFT then
    Exit;
  if PointInRect(GetCheckMarkBounds(ScreenBounds), X, Y) then
    FMouseMarkDown := True;
end;

procedure TvglCheckBox.DoOnMouseEntry;
begin
  inherited DoOnMouseEntry;
  FMouseOver := True;
end;

procedure TvglCheckBox.DoOnMouseExit;
begin
  inherited DoOnMouseExit;
  FMouseOver := False;
  FMouseMarkOver := False;
end;

procedure TvglCheckBox.DoOnMouseMove(X, Y: integer);
begin
  inherited DoOnMouseMove(X, Y);
  CheckMarkOver(X, Y);
end;

procedure TvglCheckBox.DoOnMouseUp(mb, x, y: Integer);
begin
  inherited DoOnMouseUp(mb, x, y);
  FMouseMarkDown := False;
end;

procedure TvglCheckBox.DrawSelf(where: TRect);
var
  MarkRect,SkinRect: TRect;
begin
  inherited DrawSelf(where);
  if (FMouseMarkDown) and (FMouseMarkOver) then
    FImage.Intensity := vglCheckDown_Intensity
  else
    if FMouseMarkOver then
      FImage.Intensity := vglCheckOver_Intensity
    else
      FImage.Intensity := vglCheckUp_Intensity;
  SkinRect := GetCheckMarkSkinRect;
  MarkRect := GetCheckMarkBounds(where);
  if FCaptionText.Text <> '' then
    Canvas.DrawText(where.Left + SkinRect.Right - SkinRect.Left + 5, where.Top, FCaptionText);
  Canvas.DrawBitmapSubRect(MarkRect.Left, MarkRect.Top, SkinRect, FImage);
  FImage.Intensity := 255;
end;


function TvglCheckBox.GetCaption: string;
begin
  Result := FCaptionText.Text;
end;

function TvglCheckBox.GetCheckMarkBounds(where: TRect): TRect;
var
  SkinRect: TRect;
begin
  SkinRect := GetCheckMarkSkinRect;
  Result.Left := where.Left;
  Result.Top := where.Top + (((where.Bottom - where.Top) - (SkinRect.Bottom - SkinRect.TOP)) div 2);
  Result.Right := Result.Left + SkinRect.Right - SkinRect.Left;
  Result.Bottom := Result.Top + SkinRect.Bottom - SkinRect.Top;
end;

function TvglCheckBox.GetCheckMarkSkinRect: TRect;
begin
  if FChecked then
    Result := VGL_SKINRECT_CHECKBOXSET
  else
    Result := VGL_SKINRECT_CHECKBOXUNSET;
end;

function TvglCheckBox.GetComponentType: string;
begin
  Result := 'CheckBox';
end;

procedure TvglCheckBox.SetCaption(const Value: string);
begin
  FCaptionText.Text := Value;
  UpdateBounds;
end;

procedure TvglCheckBox.SetChecked(const Value: Boolean);
begin
  FChecked := Value;
end;

procedure TvglCheckBox.SetColor(const Value: TColor);
begin
  FCaptionText.SetColor(Value);
end;

procedure TvglCheckBox.SetOnChanged(const Value: TNotifyEvent);
begin
  FOnChanged := Value;
end;

procedure TvglCheckBox.UpdateBounds;
var
  i:integer;
  longest:integer;
  SKINRECT: TRect;
begin
  SKINRECT := GetCheckMarkSkinRect;
  // locate longest line
  longest := 0;
  for i := 0 to FCaptionText.Lines.Count-1 do
    if FCaptionText.Width[i] > longest then longest := FCaptionText.Width[i];
  Width := longest + (SKINRECT.Right - SKINRECT.Left) + 5;
  Height := Math.Max(Math.Max(FCaptionText.Lines.Count*FCaptionText.QT.GridSquareHeight, SKINRECT.Bottom - SKINRECT.TOP + 1), Height);
end;


end.

Index: skin1.png
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/skin1.png,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
Binary files /tmp/cvsAIM9xd and /tmp/cvsMR191f differ

Index: StartupForm.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/StartupForm.pas,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -r1.4 -r1.5
*** StartupForm.pas	2000/12/11 19:15:12	1.4
--- StartupForm.pas	2000/12/12 19:45:47	1.5
***************
*** 7,11 ****
  uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
!   StdCtrls, GLForms, GLCanvas, OpenGL, vglClasses, vglStdCtrls;
  
  type
--- 7,11 ----
  uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
!   StdCtrls, GLForms, GLCanvas, OpenGL, vglClasses, vglStdCtrls, vglCheckBox;
  
  type
***************
*** 22,25 ****
--- 22,26 ----
      Label1:TvglTextBox;
      SB :TvglScrollbar;
+     CB: TvglCheckBox;
  
      Elapsed,FirstTime:Cardinal;
***************
*** 52,56 ****
    InterfaceManager :TvglInterfaceManager;
  
! function timeGetTime: Integer; external 'winmm.dll' name 'timeGetTime';
  
  implementation
--- 53,57 ----
    InterfaceManager :TvglInterfaceManager;
  
! function timeGetTime: Cardinal; external 'winmm.dll' name 'timeGetTime';
  
  implementation
***************
*** 122,127 ****
  begin
    GLForm := TGLForm.Create;
!   GLForm.FullScreen := false;
!   //GLForm.SetBounds(0,0,800,600);
    GLForm.SetBounds(0,0,640,480);
    GLForm.Caption := 'VGL Demo 1';
--- 123,128 ----
  begin
    GLForm := TGLForm.Create;
!   GLForm.FullScreen := False;
! //  GLForm.SetBounds(0,0,800,600);
    GLForm.SetBounds(0,0,640,480);
    GLForm.Caption := 'VGL Demo 1';
***************
*** 148,152 ****
    Panel1 := TvglPanel.Create('Panel1',InterfaceManager.Desktop);
    Panel1.Bounds := Rect(50,50,250,250);
!   Panel1.Textured := true;
    Panel1.OnMouseDown := Panel1OnMouseDown;
    Panel1.OnMouseEntry := Panel1OnMouseEntry;
--- 149,153 ----
    Panel1 := TvglPanel.Create('Panel1',InterfaceManager.Desktop);
    Panel1.Bounds := Rect(50,50,250,250);
!   Panel1.Textured := True;
    Panel1.OnMouseDown := Panel1OnMouseDown;
    Panel1.OnMouseEntry := Panel1OnMouseEntry;
***************
*** 163,166 ****
--- 164,175 ----
    Image1.Bounds := Rect(500,20,0,0);
  
+   CB := TvglCheckBox.Create('CheckBox1', InterfaceManager.Desktop);
+   CB.Left := 10;
+   CB.Top := 410;
+   CB.Height := 0;
+   CB.Checked := True;
+   CB.Color := clWhite;
+   CB.Caption := 'This is a checkbox';
+ 
    Button := TvglButton.Create('Button',Panel1);
    Button.Caption := 'hide image';
***************
*** 183,189 ****
  
    Label1 := TvglTextBox.Create('Label1',InterfaceManager.Desktop);
!   Label1.Top := 200;
    Label1.Left := 60;
!   Label1.Color := clWhite;
    Label1.Caption := 'Hello World'#13'This is Mike speaking to you';
  
--- 192,198 ----
  
    Label1 := TvglTextBox.Create('Label1',InterfaceManager.Desktop);
!   Label1.Top := 250;
    Label1.Left := 60;
!   Label1.Color := clBlack;
    Label1.Caption := 'Hello World'#13'This is Mike speaking to you';