Menu
▾
▴
pythianproject-cvsmail
|
From: Michael H. <mh...@us...> - 2000-12-12 22:16:06
|
Update of /cvsroot/pythianproject/Prototypes/GUISystem In directory slayer.i.sourceforge.net:/tmp/cvs-serv12095/GUISystem Modified Files: StartupForm.pas skin1.png vglClasses.pas vglStdCtrls.pas Removed Files: vglCheckBox.pas Log Message: small changes. altered GLCanvas to use better font registration system. fixed bug which caused multiple texture loading. small other changes. rearranged VGL units -mike Index: StartupForm.pas =================================================================== RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/StartupForm.pas,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -r1.6 -r1.7 *** StartupForm.pas 2000/12/12 20:40:37 1.6 --- StartupForm.pas 2000/12/12 22:15:57 1.7 *************** *** 7,11 **** uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ! StdCtrls, GLForms, GLCanvas, OpenGL, vglClasses, vglStdCtrls, vglCheckBox; type --- 7,11 ---- uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ! StdCtrls, GLForms, GLCanvas, OpenGL, vglClasses, vglStdCtrls; type *************** *** 43,46 **** --- 43,47 ---- procedure Panel1OnMouseExit(Sender:TObject); procedure ButtonOnclick(Sender:TObject); + procedure CB1OnChange(Sender:TObject); procedure go; *************** *** 173,176 **** --- 174,178 ---- CB.Color := clWhite; CB.Caption := 'This is a checkbox'; + CB.OnChanged := CB1OnChange; Button := TvglButton.Create('Button',Panel1); *************** *** 194,199 **** 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'; --- 196,201 ---- Label1 := TvglTextBox.Create('Label1',InterfaceManager.Desktop); ! Label1.Top := 300; ! Label1.Left := 20; Label1.Color := clBlack; Label1.Caption := 'Hello World'#13'This is Mike speaking to you'; *************** *** 233,236 **** --- 235,245 ---- Close; + end; + + procedure TfrmStartup.CB1OnChange(Sender: TObject); + begin + if CB.Checked then + CB.Caption := 'Checked' + else CB.Caption := 'Unchecked'; end; Index: skin1.png =================================================================== RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/skin1.png,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -r1.4 -r1.5 Binary files /tmp/cvs0yFqWn and /tmp/cvsctzQ1A differ Index: vglClasses.pas =================================================================== RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglClasses.pas,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -r1.4 -r1.5 *** vglClasses.pas 2000/12/11 19:15:12 1.4 --- vglClasses.pas 2000/12/12 22:15:57 1.5 *************** *** 248,300 **** end; - TvglButtonState = (vglbsUp, vglbsDown, vglbsOver); - TvglButton = class(TvglComponent) - protected - FImage :TGLBitmap; - FCaptionText :TGLText; - FButtonState :TvglButtonState; - procedure SetCaption(const Value: string); - procedure SetBounds(const Value: TRect); override ; - function GetCaption: string; - - function GetComponentType:string; override ; - - procedure DoOnMouseEntry; override ; - procedure DoOnMouseExit; override ; - procedure DoOnMouseDown(mb,x,y:integer); override ; - public - property Caption :string read GetCaption write SetCaption; - - constructor Create(aName:string; AOwner:TvglComponent); - destructor Destroy; override ; - - procedure DrawSelf(where:TRect); override ; - end; - - TvglTextBox = class(TvglComponent) - private - function GetFont: string; - procedure SetFont(const Value: string); - procedure SetColor(const Value: TColor); - protected - FText :TGLText; - function GetCaption: string; - procedure SetCaption(const Value: string); - function GetComponentType:string; override ; - function GetLines: TStringList; - - procedure LinesOnChange(Sender:TObject); - procedure UpdateBounds; - public - property Lines:TStringList read GetLines; - property Caption:string read GetCaption write SetCaption; - property Font :string read GetFont write SetFont; - property Color :TColor write SetColor; - - constructor Create(aName:string; aOwner:TVGLComponent); - destructor Destroy; override ; - procedure DrawSelf(where:TRect); override ; - end; - TvglMouseCursor = class(TvglComponent) protected --- 248,251 ---- *************** *** 1015,1094 **** end; - { TvglButton } - - constructor TvglButton.Create(aName: string; AOwner: TvglComponent); - begin - inherited Create(aName,AOwner); - FImage := TGLBitmap(Manager.GetResource(VGL_SKIN_1)); - FCaptionText := TGLText.Create('Arial'); - FCaptionText.SetColor(clBlack); - FButtonState := vglbsUp; - end; - - destructor TvglButton.Destroy; - begin - FImage := nil; - inherited; - end; - - procedure TvglButton.DoOnMouseDown(mb, x, y: integer); - begin - inherited DoOnMouseDown(mb,x,y); - FButtonState := vglbsDown; - end; - - procedure TvglButton.DoOnMouseEntry; - begin - inherited DoOnMouseEntry; - FButtonState := vglbsOver; - end; - - procedure TvglButton.DoOnMouseExit; - begin - inherited DoOnMouseExit; - FButtonState := vglbsUp; - end; - - procedure TvglButton.DrawSelf(where: TRect); - var tw:integer; - begin - inherited DrawSelf(where); - //@@todo - text centreing - case FButtonState of - vglbsUp: FImage.Intensity := 255; - vglbsOver: FImage.Intensity := 200; - vglbsDown: FImage.Intensity := 200; - end; - Canvas.DrawBitmapSubRect(where.Left,where.Top,VGL_SKINRECT_BUTTON,FImage); - FImage.Intensity := 255; // remember to reset!!! - tw := FCaptionText.Width[0]; - if FCaptionText.Text <> '' then - Canvas.DrawText( ((where.Right-where.Left-16))-(tw div 2), where.top+12,FCaptionText); - end; - - function TvglButton.GetCaption: string; - begin - Result := FCaptionText.Text; - end; - - function TvglButton.GetComponentType: string; - begin - Result := 'Button'; - end; - - procedure TvglButton.SetBounds(const Value: TRect); - var tmp:TRect; - begin - tmp := Value; - tmp.Right := (VGL_SKINRECT_BUTTON.Right-VGL_SKINRECT_BUTTON.Left)+tmp.Left; - tmp.Bottom := tmp.Top+(VGL_SKINRECT_BUTTON.Bottom-VGL_SKINRECT_BUTTON.Top); - inherited SetBounds(tmp); - end; - - procedure TvglButton.SetCaption(const Value: string); - begin - FCaptionText.Text := Value; - end; - { TvglMouseCursor } --- 966,969 ---- *************** *** 1110,1187 **** end; - { TvglTextBox } - - constructor TvglTextBox.Create(aName: string; aOwner: TVGLComponent); - begin - inherited Create(aName,aOwner); - FText := TGLText.Create('Arial'); - FText.Lines.OnChange := LinesOnChange; - end; - - destructor TvglTextBox.Destroy; - begin - FText.Free; - inherited Destroy; - end; - - procedure TvglTextBox.DrawSelf(where: TRect); - begin - inherited DrawSelf(where); - Canvas.DrawText(where.Left,where.Top,FText); - end; - - function TvglTextBox.GetCaption: string; - begin - Result := Lines.Text; - end; - - function TvglTextBox.GetComponentType: string; - begin - Result := 'Label'; - end; - function TvglTextBox.GetFont: string; - begin - Result := FText.FontName; - end; - - function TvglTextBox.GetLines: TStringList; - begin - Result := FText.Lines; - end; - - procedure TvglTextBox.LinesOnChange(Sender: TObject); - begin - // update bounds - UpdateBounds; - end; - - procedure TvglTextBox.SetCaption(const Value: string); - begin - Lines.Text := Value; - end; - - procedure TvglTextBox.SetColor(const Value: TColor); - begin - FText.SetColor(Value); - end; - - procedure TvglTextBox.SetFont(const Value: string); - begin - FText.FontName := Value; - end; - - procedure TvglTextBox.UpdateBounds; - var - i:integer; - longest:integer; - begin - // locate longest line - longest := 0; - for i := 0 to FText.Lines.Count-1 do - if FText.Width[i] > longest then longest := FText.Width[i]; - Width := longest; - Height := FText.Lines.Count*FText.QT.GridSquareHeight; - end; end. --- 985,989 ---- Index: vglStdCtrls.pas =================================================================== RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglStdCtrls.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -r1.1 -r1.2 *** vglStdCtrls.pas 2000/12/12 20:48:59 1.1 --- vglStdCtrls.pas 2000/12/12 22:15:57 1.2 *************** *** 25,28 **** --- 25,34 ---- VGL_SKINRECT_SCROLL_TAB :TRect = (Left:90;Top:185;Right:116;Bottom:198); + 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 TvglScrollBarKind = (sbHorizontal, sbVertical); *************** *** 47,51 **** FOnScroll: TvglScrollEvent; FPageSize: Integer; - FBackPanel :TvglPanel; FColor: TColor; FPageAlpha: Single; --- 53,56 ---- *************** *** 173,176 **** --- 178,271 ---- end; + 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; + + TvglButtonState = (vglbsUp, vglbsDown, vglbsOver); + TvglButton = class(TvglComponent) + protected + FImage :TGLBitmap; + FCaptionText :TGLText; + FButtonState :TvglButtonState; + procedure SetCaption(const Value: string); + procedure SetBounds(const Value: TRect); override ; + function GetCaption: string; + + function GetComponentType:string; override ; + + procedure DoOnMouseEntry; override ; + procedure DoOnMouseExit; override ; + procedure DoOnMouseDown(mb,x,y:integer); override ; + public + property Caption :string read GetCaption write SetCaption; + + constructor Create(aName:string; AOwner:TvglComponent); + destructor Destroy; override ; + + procedure DrawSelf(where:TRect); override ; + end; + + TvglTextBox = class(TvglComponent) + private + function GetFont: string; + procedure SetFont(const Value: string); + procedure SetColor(const Value: TColor); + protected + FText :TGLText; + function GetCaption: string; + procedure SetCaption(const Value: string); + function GetComponentType:string; override ; + function GetLines: TStringList; + + procedure LinesOnChange(Sender:TObject); + procedure UpdateBounds; + public + property Lines:TStringList read GetLines; + property Caption:string read GetCaption write SetCaption; + property Font :string read GetFont write SetFont; + property Color :TColor write SetColor; + + constructor Create(aName:string; aOwner:TVGLComponent); + destructor Destroy; override ; + procedure DrawSelf(where:TRect); override ; + end; + implementation uses *************** *** 769,800 **** var i: Integer; - TT: TGLText; begin if FScrollBar = nil then Exit; UpdateScrollBar; - { for i := 0 to FGLTexts.Count - 1 do - begin - if FGLTexts.Objects[i] <> nil then - FGLTexts.Objects[i].Free; - end;} FGLText.Lines.Clear; for i := 0 to FItems.Count - 1 do - begin - {TT := TGLText.Create(FItems[i], FGLTexttmpl.FontName, FGLTexttmpl.TextType, GLC_DEFAULT_FONT_DATA); - with TGLText(TT) do - begin - GLFFontHandle := FGLTexttmpl.GLFFontHandle; - QT := FGLTexttmpl.QT; - Red := FGLTexttmpl.Red; - Blue := FGLTexttmpl.Blue; - Green := FGLTexttmpl.Green; - Size := FGLTexttmpl.Size; - Precache := FGLTexttmpl.Precache; - end; - FGLTexts.AddObject(FItems[i], TT);} FGLText.Lines.Add(FItems[i]); - end; end; --- 864,875 ---- *************** *** 914,917 **** --- 989,1309 ---- FScrollBar.Max := FItems.Count - FScrollBar.PageSize; FScrollBar.LargeChange := FScrollBar.PageSize; + end; + + { 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; + + { TvglButton } + + constructor TvglButton.Create(aName: string; AOwner: TvglComponent); + begin + inherited Create(aName,AOwner); + FImage := TGLBitmap(Manager.GetResource(VGL_SKIN_1)); + FCaptionText := TGLText.Create('Arial'); + FCaptionText.SetColor(clBlack); + FButtonState := vglbsUp; + end; + + destructor TvglButton.Destroy; + begin + FImage := nil; + inherited; + end; + + procedure TvglButton.DoOnMouseDown(mb, x, y: integer); + begin + inherited DoOnMouseDown(mb,x,y); + FButtonState := vglbsDown; + end; + + procedure TvglButton.DoOnMouseEntry; + begin + inherited DoOnMouseEntry; + FButtonState := vglbsOver; + end; + + procedure TvglButton.DoOnMouseExit; + begin + inherited DoOnMouseExit; + FButtonState := vglbsUp; + end; + + procedure TvglButton.DrawSelf(where: TRect); + var tw:integer; + begin + inherited DrawSelf(where); + //@@todo - text centreing + case FButtonState of + vglbsUp: FImage.Intensity := 255; + vglbsOver: FImage.Intensity := 200; + vglbsDown: FImage.Intensity := 200; + end; + Canvas.DrawBitmapSubRect(where.Left,where.Top,VGL_SKINRECT_BUTTON,FImage); + FImage.Intensity := 255; // remember to reset!!! + tw := FCaptionText.Width[0]; + if FCaptionText.Text <> '' then + Canvas.DrawText( ((where.Right-where.Left-16))-(tw div 2), where.top+12,FCaptionText); + end; + + function TvglButton.GetCaption: string; + begin + Result := FCaptionText.Text; + end; + + function TvglButton.GetComponentType: string; + begin + Result := 'Button'; + end; + + procedure TvglButton.SetBounds(const Value: TRect); + var tmp:TRect; + begin + tmp := Value; + tmp.Right := (VGL_SKINRECT_BUTTON.Right-VGL_SKINRECT_BUTTON.Left)+tmp.Left; + tmp.Bottom := tmp.Top+(VGL_SKINRECT_BUTTON.Bottom-VGL_SKINRECT_BUTTON.Top); + inherited SetBounds(tmp); + end; + + procedure TvglButton.SetCaption(const Value: string); + begin + FCaptionText.Text := Value; + end; + + { TvglTextBox } + + constructor TvglTextBox.Create(aName: string; aOwner: TVGLComponent); + begin + inherited Create(aName,aOwner); + FText := TGLText.Create('Arial'); + FText.Precache := true; + FText.Lines.OnChange := LinesOnChange; + end; + + destructor TvglTextBox.Destroy; + begin + FText.Free; + inherited Destroy; + end; + + procedure TvglTextBox.DrawSelf(where: TRect); + begin + inherited DrawSelf(where); + Canvas.DrawText(where.Left,where.Top,FText); + end; + + function TvglTextBox.GetCaption: string; + begin + Result := Lines.Text; + end; + + function TvglTextBox.GetComponentType: string; + begin + Result := 'Label'; + end; + + function TvglTextBox.GetFont: string; + begin + Result := FText.FontName; + end; + + function TvglTextBox.GetLines: TStringList; + begin + Result := FText.Lines; + end; + + procedure TvglTextBox.LinesOnChange(Sender: TObject); + begin + // update bounds + FText.LinesOnChange(Sender); //call text handler to prevent overriding + UpdateBounds; + end; + + procedure TvglTextBox.SetCaption(const Value: string); + begin + Lines.Text := Value; + end; + + procedure TvglTextBox.SetColor(const Value: TColor); + begin + FText.SetColor(Value); + end; + + procedure TvglTextBox.SetFont(const Value: string); + begin + FText.FontName := Value; + end; + + procedure TvglTextBox.UpdateBounds; + var + i:integer; + longest:integer; + begin + // locate longest line + longest := 0; + for i := 0 to FText.Lines.Count-1 do + if FText.Width[i] > longest then longest := FText.Width[i]; + Width := longest; + Height := FText.Lines.Count*FText.QT.GridSquareHeight; end; --- vglCheckBox.pas DELETED --- |
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X