From: Kamil K. <kkr...@us...> - 2000-12-12 19:45:51
|
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'; |