{ fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, for details about redistributing fpGUI. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Description: Defines a Panel control. Also known as a Bevel or Frame control. This control can also draw itself like a GroupBox component. } unit gui_panel; {$mode objfpc}{$H+} interface uses Classes, SysUtils, fpgfx, gfxbase, gfx_widget; type TPanelShape = (bsBox, bsFrame, bsTopLine, bsBottomLine, bsLeftLine, bsRightLine, bsSpacer); TPanelStyle = (bsLowered, bsRaised); TPanelBorder = (bsSingle, bsDouble); TfpgAbstractPanel = class(TfpgWidget) private FPanelShape: TPanelShape; FPanelStyle: TPanelStyle; FPanelBorder: TPanelBorder; procedure SetPanelStyle(const AValue: TPanelStyle); procedure SetPanelBorder(const AValue: TPanelBorder); protected property Style: TPanelStyle read FPanelStyle write SetPanelStyle default bsRaised; property BorderStyle: TPanelBorder read FPanelBorder write SetPanelBorder default bsSingle; public constructor Create(AOwner: TComponent); override; end; TfpgBevel = class(TfpgAbstractPanel) private procedure SetPanelShape(const AValue: TPanelShape); protected procedure HandlePaint; override; published property BackgroundColor; property BorderStyle; property Shape: TPanelShape read FPanelShape write SetPanelShape default bsBox; property Style; property OnClick; property OnDoubleClick; end; TfpgPanel = class(TfpgAbstractPanel) private FAlignment: TAlignment; FLayout: TLayout; FWrapText: boolean; FLineSpace: integer; FMargin: integer; FText: string; function GetAlignment: TAlignment; procedure SetAlignment(const AValue: TAlignment); function GetLayout: TLayout; procedure SetLayout(const AValue: TLayout); function GetText: string; procedure SetText(const AValue: string); function GetFontDesc: string; procedure SetFontDesc(const AValue: string); function GetLineSpace: integer; procedure SetLineSpace(const AValue: integer); function GetMargin: integer; procedure SetMargin(const AValue: integer); function GetWrapText: boolean; procedure SetWrapText(const AValue: boolean); protected FFont: TfpgFont; procedure HandlePaint; override; public constructor Create(AOwner: TComponent); override; property Font: TfpgFont read FFont; published property Alignment: TAlignment read GetAlignment write SetAlignment default taCenter; property BackgroundColor; property BorderStyle; property FontDesc: string read GetFontDesc write SetFontDesc; property Layout: TLayout read GetLayout write SetLayout default tlCenter; property Style; property Text: string read GetText write SetText; property TextColor; property LineSpace: integer read GetLineSpace write SetLineSpace default 2; property Margin: integer read GetMargin write SetMargin default 2; property WrapText: boolean read GetWrapText write SetWrapText default False; property OnClick; property OnDoubleClick; end; TfpgGroupBox = class(TfpgAbstractPanel) private FAlignment: TAlignment; FMargin: integer; FText: string; function GetAlignment: TAlignment; procedure SetAlignment(const AValue: TAlignment); function GetText: string; procedure SetText(const AValue: string); function GetFontDesc: string; procedure SetFontDesc(const AValue: string); function GetMargin: integer; procedure SetMargin(const AValue: integer); protected FFont: TfpgFont; procedure HandlePaint; override; public constructor Create(AOwner: TComponent); override; property Font: TfpgFont read FFont; published property Alignment: TAlignment read GetAlignment write SetAlignment default taCenter; property BackgroundColor; property BorderStyle; property FontDesc: string read GetFontDesc write SetFontDesc; property Style; property Text: string read GetText write SetText; property TextColor; property Margin: integer read GetMargin write SetMargin default 2; property OnClick; property OnDoubleClick; end; function CreateBevel(AOwner: TComponent; ALeft, ATop, AWidth, AHeight: TfpgCoord; AShape: TPanelShape; AStyle: TPanelStyle): TfpgBevel; function CreatePanel(AOwner: TComponent; ALeft, ATop, AWidth, AHeight: TfpgCoord; AText: string; AStyle: TPanelStyle; AALignment: TAlignment= taCenter; ALayout: TLayout= tlCenter; AMargin: integer= 2; ALineSpace: integer= 2): TfpgPanel; function CreateGroupBox(AOwner: TComponent; ALeft, ATop, AWidth, AHeight: TfpgCoord; AText: string; AStyle: TPanelStyle; AALignment: TAlignment= taCenter; AMargin: integer= 2): TfpgGroupBox; implementation function CreateBevel(AOwner: TComponent; ALeft, ATop, AWidth, AHeight: TfpgCoord; AShape: TPanelShape; AStyle: TPanelStyle): TfpgBevel; begin Result := TfpgBevel.Create(AOwner); Result.Left := ALeft; Result.Top := ATop; Result.Width := AWidth; Result.Height := AHeight; Result.Shape := AShape; Result.Style := AStyle; end; function CreatePanel(AOwner: TComponent; ALeft, ATop, AWidth, AHeight: TfpgCoord; AText: string; AStyle: TPanelStyle; AALignment: TAlignment= taCenter; ALayout: TLayout= tlCenter; AMargin: integer= 2; ALineSpace: integer= 2): TfpgPanel; begin Result := TfpgPanel.Create(AOwner); Result.Left := ALeft; Result.Top := ATop; Result.Width := AWidth; Result.Height := AHeight; Result.FText := AText; Result.Style := AStyle; Result.FAlignment:= AAlignment; Result.FLayout := ALayout; Result.FMargin := AMargin; Result.FLineSpace:= ALineSpace; end; function CreateGroupBox(AOwner: TComponent; ALeft, ATop, AWidth, AHeight: TfpgCoord; AText: string; AStyle: TPanelStyle; AALignment: TAlignment= taCenter; AMargin: integer= 2): TfpgGroupBox; begin Result := TfpgGroupBox.Create(AOwner); Result.Left := ALeft; Result.Top := ATop; Result.Width := AWidth; Result.Height := AHeight; Result.FText := AText; Result.Style := AStyle; Result.FAlignment := AAlignment; Result.FMargin := AMargin; end; {TfpgAbstractPanel} procedure TfpgAbstractPanel.SetPanelStyle(const AValue: TPanelStyle); begin if FPanelStyle <> AValue then begin FPanelStyle := AValue; Repaint; end; end; procedure TfpgAbstractPanel.SetPanelBorder(const AValue: TPanelBorder); begin if FPanelBorder <> AValue then begin FPanelBorder := AValue; Repaint; end; end; constructor TfpgAbstractPanel.Create(AOwner: TComponent); begin inherited Create(AOwner); FPanelShape := bsBox; FPanelStyle := bsRaised; FPanelBorder := bsSingle; FWidth := 80; FHeight := 80; FFocusable := True; // otherwise children can't get focus FBackgroundColor := Parent.BackgroundColor; end; {TfpgBevel} procedure TfpgBevel.SetPanelShape(const AValue: TPanelShape); begin if FPanelShape <> AValue then begin FPanelShape := AValue; Repaint; end; end; procedure TfpgBevel.HandlePaint; begin inherited HandlePaint; Canvas.Clear(BackgroundColor); // Canvas.SetLineStyle(2, lsSolid); // Canvas.SetColor(clWindowBackground); // Canvas.DrawRectangle(1, 1, Width - 1, Height - 1); if FPanelBorder = bsSingle then Canvas.SetLineStyle(1, lsSolid) else Canvas.SetLineStyle(2, lsSolid); if Style = bsRaised then Canvas.SetColor(clHilite2) else Canvas.SetColor(clShadow2); if Shape in [bsBox] then if FPanelBorder = bsSingle then Canvas.DrawLine(0, 0, Width - 1, 0) else Canvas.DrawLine(0, 1, Width - 1, 1); if Shape in [bsFrame, bsTopLine] then Canvas.DrawLine(0, 0, Width - 1, 0); if Shape in [bsBox] then if FPanelBorder = bsSingle then Canvas.DrawLine(0, 1, 0, Height - 1) else Canvas.DrawLine(1, 1, 1, Height - 1); if Shape in [bsFrame, bsLeftLine] then Canvas.DrawLine(0, 1, 0, Height - 1); if Shape in [bsFrame, bsRightLine] then Canvas.DrawLine(Width - 2, 1, Width - 2, Height - 1); if Shape in [bsFrame, bsBottomLine] then Canvas.DrawLine(1, Height - 2, Width - 1, Height - 2); if Style = bsRaised then Canvas.SetColor(clShadow2) else Canvas.SetColor(clHilite2); if Shape in [bsFrame, bsTopLine] then Canvas.DrawLine(1, 1, Width - 2, 1); if Shape in [bsFrame, bsLeftLine] then Canvas.DrawLine(1, 2, 1, Height - 2); if Shape in [bsBox, bsFrame, bsRightLine] then Canvas.DrawLine(Width - 1, 0, Width - 1, Height - 1); if Shape in [bsBox, bsFrame, bsBottomLine] then Canvas.DrawLine(0, Height - 1, Width, Height - 1); end; {TfpgPanel} function TfpgPanel.GetAlignment: TAlignment; begin Result := FAlignment; end; procedure TfpgPanel.SetAlignment(const AValue: TAlignment); begin if FAlignment <> AValue then begin FAlignment := AValue; Repaint; end; end; function TfpgPanel.GetLayout: TLayout; begin Result := FLayout; end; procedure TfpgPanel.SetLayout(const AValue: TLayout); begin if FLayout <> AValue then begin FLayout := AValue; Repaint; end; end; function TfpgPanel.GetText: string; begin Result := FText; end; procedure TfpgPanel.SetText(const AValue: string); begin if FText <> AValue then begin FText := AValue; Repaint; end; end; function TfpgPanel.GetFontDesc: string; begin Result := FFont.FontDesc; end; procedure TfpgPanel.SetFontDesc(const AValue: string); begin FFont.Free; FFont := fpgGetFont(AValue); Repaint; end; function TfpgPanel.GetLineSpace: integer; begin Result := FLineSpace; end; procedure TfpgPanel.SetLineSpace(const AValue: integer); begin if FLineSpace <> AValue then begin FLineSpace := AValue; Repaint; end; end; function TfpgPanel.GetMargin: integer; begin Result := FMargin; end; procedure TfpgPanel.SetMargin(const AValue: integer); begin if FMargin <> AValue then begin FMargin := AValue; Repaint; end; end; function Tfpgpanel.GetWrapText: boolean; begin Result := FWrapText; end; procedure Tfpgpanel.SetWrapText(const AValue: boolean); begin if FWrapText <> AValue then begin FWrapText := AValue; Repaint; end; end; procedure TfpgPanel.HandlePaint; var lTxtFlags: TFTextFlags; begin inherited HandlePaint; Canvas.Clear(BackgroundColor); // Canvas.SetLineStyle(2, lsSolid); // Canvas.SetColor(clWindowBackground); // Canvas.DrawRectangle(1, 1, Width - 1, Height - 1); if FPanelBorder = bsSingle then Canvas.SetLineStyle(1, lsSolid) else Canvas.SetLineStyle(2, lsSolid); if Style = bsRaised then Canvas.SetColor(clHilite2) else Canvas.SetColor(clShadow2); if FPanelBorder = bsSingle then begin Canvas.DrawLine(0, 0, Width - 1, 0); Canvas.DrawLine(0, 1, 0, Height - 1); end else begin Canvas.DrawLine(0, 1, Width - 1, 1); Canvas.DrawLine(1, 1, 1, Height - 1); end; if Style = bsRaised then Canvas.SetColor(clShadow2) else Canvas.SetColor(clHilite2); Canvas.DrawLine(Width - 1, 0, Width - 1, Height - 1); Canvas.DrawLine(0, Height - 1, Width, Height - 1); Canvas.SetTextColor(FTextColor); Canvas.SetFont(Font); lTxtFlags:= []; if Enabled then Include(lTxtFlags, txtEnabled); if FWrapText then Include(lTxtFlags, txtWrap); case FAlignment of taLeftJustify: Include(lTxtFlags, txtLeft); taRightJustify: Include(lTxtFlags, txtRight); taCenter: Include(lTxtFlags, txtHCenter); end; case FLayout of tlTop: Include(lTxtFlags, txtTop); tlBottom: Include(lTxtFlags, txtBottom); tlCenter: Include(lTxtFlags, txtVCenter); end; Canvas.DrawText(FMargin, FMargin, Width - FMargin * 2, Height - FMargin * 2, FText, lTxtFlags, FLineSpace); end; constructor TfpgPanel.Create(Aowner: TComponent); begin inherited Create(AOwner); FText := 'Panel'; FFont := fpgGetFont('#Label1'); FPanelShape := bsBox; FPanelStyle := bsRaised; FWidth := 80; FHeight := 80; FFocusable := True; // otherwise children can't get focus FBackgroundColor := Parent.BackgroundColor; FAlignment := taCenter; FLayout := tlCenter; FWrapText := False; FLineSpace := 2; FMargin := 2; end; {TfpgGroupBox} function TfpgGroupBox.GetAlignment: TAlignment; begin Result := FAlignment; end; procedure TfpgGroupBox.SetAlignment(const AValue: TAlignment); begin if FAlignment <> AValue then begin FAlignment := AValue; Repaint; end; end; function TfpgGroupBox.GetText: string; begin Result := FText; end; procedure TfpgGroupBox.SetText(const AValue: string); begin if FText <> AValue then begin FText := AValue; Repaint; end; end; function TfpgGroupBox.GetFontDesc: string; begin Result := FFont.FontDesc; end; procedure TfpgGroupBox.SetFontDesc(const AValue: string); begin FFont.Free; FFont := fpgGetFont(AValue); Repaint; end; function TfpgGroupBox.GetMargin: integer; begin Result := FMargin; end; procedure TfpgGroupBox.SetMargin(const AValue: integer); begin if FMargin <> AValue then begin FMargin := AValue; Repaint; end; end; procedure TfpgGroupBox.HandlePaint; var r: TfpgRect; w: integer; lTxtFlags: TFTextFlags; begin inherited HandlePaint; Canvas.Clear(Parent.BackgroundColor); Canvas.ClearClipRect; r.SetRect(0, 5, Width, Height); Canvas.SetClipRect(r); Canvas.Clear(FBackgroundColor); lTxtFlags := TextFlagsDflt; if not Enabled then Exclude(lTxtFlags, txtEnabled); // Canvas.ClearClipRect; // Canvas.SetLineStyle(2, lsSolid); // Canvas.SetColor(clWindowBackground); // Canvas.DrawRectangle(1, 1, Width - 1, Height - 1); if FPanelBorder = bsSingle then Canvas.SetLineStyle(1, lsSolid) else Canvas.SetLineStyle(2, lsSolid); if Style = bsRaised then Canvas.SetColor(clHilite2) else Canvas.SetColor(clShadow2); if FPanelBorder = bsSingle then begin Canvas.DrawLine(0, 5, Width - 1, 5); Canvas.DrawLine(0, 6, 0, Height - 1); end else begin Canvas.DrawLine(0, 6, Width - 1, 6); Canvas.DrawLine(1, 6, 1, Height - 1); end; if Style = bsRaised then Canvas.SetColor(clShadow2) else Canvas.SetColor(clHilite2); Canvas.DrawLine(Width - 1, 5, Width - 1, Height - 1); Canvas.DrawLine(0, Height - 1, Width, Height - 1); Canvas.SetTextColor(FTextColor); Canvas.SetFont(Font); case FAlignment of taLeftJustify: begin w := FFont.TextWidth(FText) + FMargin * 2; r.SetRect(5, 0, w, FFont.Height + FMargin); Canvas.SetClipRect(r); Canvas.Clear(FBackgroundColor); if Style = bsRaised then Canvas.SetColor(clHilite2) else Canvas.SetColor(clShadow2); if FPanelBorder = bsSingle then begin Canvas.DrawLine(5, 0, w + 5, 0); Canvas.DrawLine(5, 0, 5, 6); end else begin Canvas.DrawLine(5, 1, w + 5, 1); Canvas.DrawLine(6, 0, 6, 7); end; if Style = bsRaised then Canvas.SetColor(clShadow2) else Canvas.SetColor(clHilite2); Canvas.DrawLine(w + 5, 0, w + 5, 6); Canvas.DrawText(FMargin + 5, 0, FText, lTxtFlags); end; taRightJustify: begin w := Width - FFont.TextWidth(FText) - (FMargin * 2) - 5; r.SetRect(w, 0, FFont.TextWidth(FText) + FMargin * 2, FFont.Height + FMargin); Canvas.SetClipRect(r); Canvas.Clear(FBackgroundColor); if Style = bsRaised then Canvas.SetColor(clHilite2) else Canvas.SetColor(clShadow2); if FPanelBorder = bsSingle then begin Canvas.DrawLine(w, 0, Width - 5, 0); Canvas.DrawLine(w, 0, w, 6); end else begin Canvas.DrawLine(w, 1, Width - 5, 1); Canvas.DrawLine(w + 1, 0, w + 1, 7); end; if Style = bsRaised then Canvas.SetColor(clShadow2) else Canvas.SetColor(clHilite2); Canvas.DrawLine(Width - 6, 0, Width - 6, 6); Canvas.DrawText(Width - FFont.TextWidth(FText) - FMargin - 5, 0, FText, lTxtFlags); end; taCenter: begin w := (Width - FFont.TextWidth(FText) - FMargin * 2) div 2; r.SetRect(w, 0, FFont.TextWidth(FText) + FMargin * 2, FFont.Height + FMargin); Canvas.SetClipRect(r); Canvas.Clear(FBackgroundColor); if Style = bsRaised then Canvas.SetColor(clHilite2) else Canvas.SetColor(clShadow2); if FPanelBorder = bsSingle then begin Canvas.DrawLine(w, 0, w + FFont.TextWidth(FText) + FMargin * 2, 0); Canvas.DrawLine(w, 0, w, 6); end else begin Canvas.DrawLine(w, 1, w + FFont.TextWidth(FText) + FMargin * 2, 1); Canvas.DrawLine(w + 1, 0, w + 1, 7); end; if Style = bsRaised then Canvas.SetColor(clShadow2) else Canvas.SetColor(clHilite2); Canvas.DrawLine(w + FFont.TextWidth(FText) + FMargin * 2 - 1, 0, w + FFont.TextWidth(FText) + FMargin * 2 - 1, 6); Canvas.DrawText(w + FMargin, 0, FText, lTxtFlags); end; end; end; constructor TfpgGroupBox.Create(Aowner: TComponent); begin inherited Create(AOwner); FText := 'Group box'; FFont := fpgGetFont('#Label1'); FPanelShape := bsBox; FPanelStyle := bsRaised; FWidth := 80; FHeight := 80; FFocusable := True; // otherwise children can't get focus FBackgroundColor := Parent.BackgroundColor; FAlignment := taLeftJustify; FMargin := 2; end; end.