mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-26 08:29:38 +02:00
Added code for TStatusBar
I'm now capturing WMPainT and doing the drawing myself. Shane git-svn-id: trunk@147 -
This commit is contained in:
lazarus
parent
c8872787b4
commit
596fb74e0a
@ -294,25 +294,81 @@ const
|
||||
ICC_NATIVEFNTCTL_CLASS = $00002000;
|
||||
|
||||
type
|
||||
TAlignment = Class(TWinControl)
|
||||
{ TAlignment = Class(TWinControl)
|
||||
public
|
||||
constructor Create(AOwner : TComponent);
|
||||
destructor Destroy;
|
||||
constructor Create(AOwner : TComponent); override;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
}
|
||||
TStatusPanelStyle = (psText, psOwnerDraw);
|
||||
TStatusPanelBevel = (pbNone, pbLowered, pbRaised);
|
||||
|
||||
TStatusBar = class; //forward declaration
|
||||
|
||||
TStatusPanel = class(TCollectionItem)
|
||||
private
|
||||
FText: string;
|
||||
FWidth: Integer;
|
||||
FAlignment: TAlignment;
|
||||
FBevel: TStatusPanelBevel;
|
||||
FParentBiDiMode: Boolean;
|
||||
FStyle: TStatusPanelStyle;
|
||||
FUpdateNeeded: Boolean;
|
||||
procedure SetAlignment(Value: TAlignment);
|
||||
procedure SetBevel(Value: TStatusPanelBevel);
|
||||
procedure SetStyle(Value: TStatusPanelStyle);
|
||||
procedure SetText(const Value: string);
|
||||
procedure SetWidth(Value: Integer);
|
||||
protected
|
||||
function GetDisplayName: string; override;
|
||||
public
|
||||
constructor Create(aCollection: TCollection); override;
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
published
|
||||
property Alignment: TAlignment read FAlignment write SetAlignment;
|
||||
property Bevel: TStatusPanelBevel read FBevel write SetBevel default pbLowered;
|
||||
property Style: TStatusPanelStyle read FStyle write SetStyle default psText;
|
||||
property Text: string read FText write SetText;
|
||||
property Width: Integer read FWidth write SetWidth;
|
||||
end;
|
||||
|
||||
TStatusPanels = class(TCollection)
|
||||
private
|
||||
FStatusBar: TStatusBar;
|
||||
function GetItem(Index: Integer): TStatusPanel;
|
||||
procedure SetItem(Index: Integer; Value: TStatusPanel);
|
||||
protected
|
||||
function GetOwner: TPersistent; override;
|
||||
procedure Update(Item: TCollectionItem); override;
|
||||
public
|
||||
constructor Create(StatusBar: TStatusBar);
|
||||
function Add: TStatusPanel;
|
||||
property Items[Index: Integer]: TStatusPanel read GetItem write SetItem; default;
|
||||
end;
|
||||
|
||||
TStatusBar = Class(TWinControl)
|
||||
private
|
||||
FCanvas : TCanvas;
|
||||
FPanels : TStatusPanels;
|
||||
FSimpleText : String;
|
||||
FSimplePanel : Boolean;
|
||||
FContext : Integer;
|
||||
FMessage : Integer;
|
||||
FAlignmentWidget : TAlignment;
|
||||
procedure SetPanels(Value: TStatusPanels);
|
||||
procedure SetSimpleText(Value : String);
|
||||
procedure SetSimplePanel(Value : Boolean);
|
||||
Procedure WMPaint(var Msg: TLMPaint); message LM_PAINT;
|
||||
Procedure DrawDivider(X : Integer);
|
||||
Procedure DrawBevel(xLeft, PanelNum : Integer );
|
||||
public
|
||||
constructor Create(AOwner : TComponent); override;
|
||||
destructor Destroy; override;
|
||||
property Canvas : TCanvas read FCanvas;
|
||||
published
|
||||
property Panels: TStatusPanels read FPanels write SetPanels;
|
||||
property SimpleText : String read FSimpleText write SetSimpleText;
|
||||
property SimplePanel : Boolean read FSimplePanel write SetSimplePanel;
|
||||
property Visible;
|
||||
end;
|
||||
|
||||
@ -862,7 +918,9 @@ begin
|
||||
end;
|
||||
|
||||
{$I statusbar.inc}
|
||||
{$I alignment.inc}
|
||||
{$I statuspanel.inc}
|
||||
{$I statuspanels.inc}
|
||||
{ $I alignment.inc}
|
||||
{$I listitem.inc}
|
||||
{$I listitems.inc}
|
||||
{$I customlistview.inc}
|
||||
@ -876,6 +934,11 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.3 2001/01/30 18:15:02 lazarus
|
||||
Added code for TStatusBar
|
||||
I'm now capturing WMPainT and doing the drawing myself.
|
||||
Shane
|
||||
|
||||
Revision 1.2 2000/12/29 18:33:54 lazarus
|
||||
TStatusBar's create and destroy were not set to override TWinControls so they were never called.
|
||||
Shane
|
||||
|
||||
@ -1,45 +1,146 @@
|
||||
{------------------------------------------------------------------------------}
|
||||
{ TStatusBar Constructor }
|
||||
{------------------------------------------------------------------------------}
|
||||
constructor TStatusBar.Create(AOwner : TComponent);
|
||||
constructor TStatusBar.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
|
||||
fCompStyle := csStatusBar;
|
||||
Align := alBottom;
|
||||
|
||||
Setbounds(0,TWinControl(AOwner).Height-21,TWInControl(AOwner).Width,20);
|
||||
|
||||
|
||||
FContext := 0;
|
||||
FMessage := -1;
|
||||
inherited Create(AOwner);
|
||||
fCompStyle := csStatusBar;
|
||||
ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks, csOpaque];
|
||||
Color := clBtnFace;
|
||||
Height := 19;
|
||||
Setbounds(0,TWinControl(AOwner).Height-21,TWInControl(AOwner).Width,20);
|
||||
Align := alBottom;
|
||||
FPanels := TStatusPanels.Create(Self);
|
||||
FCanvas := TControlCanvas.Create;
|
||||
TControlCanvas(FCanvas).Control := Self;
|
||||
FSimplePanel := True;
|
||||
// FSizeGrip := True;
|
||||
end;
|
||||
|
||||
|
||||
{------------------------------------------------------------------------------}
|
||||
{ TStatusBar SetSimpleText }
|
||||
{------------------------------------------------------------------------------}
|
||||
procedure TStatusBar.SetSimpleText(Value : String);
|
||||
var
|
||||
glabel : PChar;
|
||||
Msg : TLMSetControlText;
|
||||
begin
|
||||
if FSimpleText <> value then
|
||||
begin
|
||||
FSimpleText := Value;
|
||||
Msg.Panel := length(Value);//0;
|
||||
Msg.fCompStyle := fCompStyle;
|
||||
gLAbel := StrAlloc(length(value) + 1);
|
||||
StrPCopy(gLabel,Value);
|
||||
Msg.Userdata := gLabel;
|
||||
CNSendMEssage(LM_SETTEXT, Self, @Msg);
|
||||
StrDispose(gLabel);
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TStatusBar.SetSimplePanel(Value : Boolean);
|
||||
Begin
|
||||
if FSimplePanel <> Value then
|
||||
Begin
|
||||
FSimplePanel := Value;
|
||||
Invalidate;
|
||||
end;
|
||||
End;
|
||||
|
||||
procedure TStatusBar.SetPanels(Value: TStatusPanels);
|
||||
begin
|
||||
FPanels.Assign(Value);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{------------------------------------------------------------------------------}
|
||||
{ TStatusBar Destructor }
|
||||
{------------------------------------------------------------------------------}
|
||||
destructor TStatusBar.Destroy;
|
||||
begin
|
||||
FPanels.free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
Procedure TStatusBar.DrawBevel(xLeft, PanelNum : Integer );
|
||||
Begin
|
||||
|
||||
if Panels[PanelNum].Bevel = pbRaised then
|
||||
Begin
|
||||
Canvas.Pen.Color := clWhite;
|
||||
Canvas.Line(XLeft,Top,XLeft+Panels[PanelNum].Width-1,Top);
|
||||
Canvas.Line(XLeft,Top,XLeft,Top+Height-1);
|
||||
Canvas.Line(XLeft,Top+1,XLeft+Panels[PanelNum].Width-1,Top+1);
|
||||
Canvas.Line(XLeft+1,Top,XLeft+1,Top+Height-1);
|
||||
Canvas.Pen.Color := clBlack;
|
||||
Canvas.Line(XLeft,Top+Height-5,XLeft+Panels[PanelNum].Width-1,Top+Height-5);
|
||||
Canvas.Line(XLeft+Panels[PanelNum].Width-2,Top,XLeft+Panels[PanelNum].Width-2,Top+Height-1);
|
||||
Canvas.Line(XLeft,Top+Height-6,XLeft+Panels[PanelNum].Width-1,Top+Height-6);
|
||||
Canvas.Line(XLeft+Panels[PanelNum].Width-3,Top,XLeft+Panels[PanelNum].Width-3,Top+Height-2);
|
||||
end
|
||||
else
|
||||
if Panels[PanelNum].Bevel = pbLowered then
|
||||
Begin
|
||||
Canvas.Pen.Color := clBlack;
|
||||
Canvas.Line(XLeft,Top,XLeft+Panels[PanelNum].Width-1,Top);
|
||||
Canvas.Line(XLeft,Top,XLeft,Top+Height-1);
|
||||
Canvas.Line(XLeft,Top+1,XLeft+Panels[PanelNum].Width-1,Top+1);
|
||||
Canvas.Line(XLeft+1,Top,XLeft+1,Top+Height-1);
|
||||
Canvas.Pen.Color := clWhite;
|
||||
Canvas.Line(XLeft,Top+Height-5,XLeft+Panels[PanelNum].Width-1,Top+Height-5);
|
||||
Canvas.Line(XLeft+Panels[PanelNum].Width-1,Top,XLeft+Panels[PanelNum].Width-1,Top+Height-1);
|
||||
Canvas.Line(XLeft,Top+Height-6,XLeft+Panels[PanelNum].Width-1,Top+Height-6);
|
||||
Canvas.Line(XLeft+Panels[PanelNum].Width-2,Top,XLeft+Panels[PanelNum].Width-2,Top+Height-4);
|
||||
end
|
||||
else
|
||||
if Panels[PanelNum].Bevel = pbNone then
|
||||
Begin
|
||||
{ Canvas.Pen.Color := clBlack;
|
||||
Canvas.Line(XLeft,Top,XLeft+Panels[PanelNum].Width-1,Top);
|
||||
Canvas.Line(XLeft,Top,XLeft,Top+Height-1);
|
||||
Canvas.Line(XLeft,Top+Height-1,XLeft+Panels[PanelNum].Width-1,Top+Height-1);
|
||||
Canvas.Line(XLeft+Panels[PanelNum].Width-1,Top,XLeft+Panels[PanelNum].Width-1,Top+Height-1);}
|
||||
|
||||
end
|
||||
|
||||
|
||||
End;
|
||||
|
||||
Procedure TStatusBar.DrawDivider(X : Integer);
|
||||
Begin
|
||||
Canvas.Pen.Color := clWhite;
|
||||
Canvas.Line(X,Top,X,Top+Height);
|
||||
Canvas.Pen.Color := clBlack;
|
||||
Canvas.Line(X+1,Top,X+1,Top+Height);
|
||||
End;
|
||||
|
||||
|
||||
Procedure TStatusBar.WMPaint(var Msg: TLMPaint);
|
||||
var
|
||||
I : Integer;
|
||||
X,Y : Integer;
|
||||
Begin
|
||||
Writeln('[TSTATUSBAR].WMPAINT');
|
||||
inherited;
|
||||
if SimplePanel = False then
|
||||
Begin
|
||||
if Panels.Count = 0 then exit;
|
||||
Y := Top; //this shouldn't be needed but it is...
|
||||
X := Left;
|
||||
|
||||
For I := 0 to Panels.Count-1 do
|
||||
Begin
|
||||
if I = Panels.Count-1 then
|
||||
Panels[I].Width := Width-X; //this sets the last panel to the width of the statusbar
|
||||
DrawBevel(X,I);
|
||||
Canvas.TextOut(X+2,Y+2,Panels[i].Text);
|
||||
//draw divider
|
||||
if I < Panels.Count-1 then
|
||||
DrawDivider(X+Panels[i].Width);
|
||||
X := X + Panels[i].Width +1;
|
||||
Writeln('SimplePanel = False');
|
||||
Writeln('Panels[0].Text = '+Panels[0].Text);
|
||||
end;
|
||||
|
||||
// ExtTextOut(Handle,1,1,0,nil,pchar(Panels[0].Text),Length(Panels[0].Text),nil);
|
||||
end
|
||||
else
|
||||
if SimplePanel = True then
|
||||
Begin
|
||||
Canvas.TextOut(Left+2,Top+2,SimpleText);
|
||||
end;
|
||||
|
||||
End;
|
||||
|
||||
@ -747,7 +747,6 @@ end;
|
||||
{------------------------------------------------------------------------------}
|
||||
Procedure TWinControl.KeyPress(var Key: Char);
|
||||
begin
|
||||
Writeln('[KeyPress] KeyPress');
|
||||
if Assigned(FOnKeyPress) then FOnKeyPress(Self, Key);
|
||||
end;
|
||||
|
||||
@ -1268,7 +1267,6 @@ end;
|
||||
Procedure TWinControl.WMSetFocus(var Message : TLMSetFocus);
|
||||
Begin
|
||||
Assert(False, Format('Trace:TODO: [TWinControl.LMSetFocus] %s', [ClassName]));
|
||||
Writeln('Getting focus...');
|
||||
DoEnter;
|
||||
end;
|
||||
|
||||
@ -1379,6 +1377,7 @@ end;
|
||||
procedure TWInControl.WMNotify(var Message: TLMNotify);
|
||||
Begin
|
||||
if not DoControlMsg(Message.NMHdr^.hwndfrom,Message) then exit;
|
||||
|
||||
//Inherited ;
|
||||
end;
|
||||
|
||||
@ -1392,7 +1391,6 @@ end;
|
||||
procedure TWinControl.WMKillFocus(var Message: TLMKillFocus);
|
||||
begin
|
||||
Assert(False, Format('Trace: TODO: [TWinControl.LMKillFocus] %s', [ClassName]));
|
||||
Writeln('Losing focus...');
|
||||
DoExit;
|
||||
|
||||
end;
|
||||
@ -1891,6 +1889,11 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.13 2001/01/30 18:15:02 lazarus
|
||||
Added code for TStatusBar
|
||||
I'm now capturing WMPainT and doing the drawing myself.
|
||||
Shane
|
||||
|
||||
Revision 1.12 2001/01/28 21:06:07 lazarus
|
||||
Changes for TComboBox events KeyPress Focus.
|
||||
Shane
|
||||
|
||||
@ -247,44 +247,9 @@ begin
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
(* Shane 08/11/2000
|
||||
I changed the way order the info is sent.
|
||||
I send the key info on the DOWN event instead of the UP event.
|
||||
GDK_KEY_PRESS:
|
||||
begin
|
||||
EventTrace('key down', data);
|
||||
if SysKey
|
||||
then Msg.msg := LM_SYSKEYDOWN
|
||||
else Msg.msg := LM_KEYDOWN;
|
||||
Msg.KeyData := Msg.KeyData or 0{TODO: previous keystate} or $0001 {TODO: repeatcount};
|
||||
Result := DeliverPostMessage(data, msg);
|
||||
|
||||
end;
|
||||
GDK_KEY_RELEASE:
|
||||
begin
|
||||
EventTrace('key up', data);
|
||||
if SysKey
|
||||
then Msg.msg := LM_SYSKEYUP
|
||||
else Msg.msg := LM_KEYUP;
|
||||
|
||||
Flags := KF_UP or KF_REPEAT;
|
||||
Msg.KeyData := Msg.KeyData or (Flags shl 16) or $0001 {allways};
|
||||
Result := DeliverPostMessage(data, msg);
|
||||
|
||||
if KeyCode <> $FFFF
|
||||
then begin
|
||||
EventTrace('char', data);
|
||||
if SysKey then Msg.msg := LM_SYSCHAR
|
||||
else Msg.msg := LM_CHAR;
|
||||
Msg.CharCode := KeyCode;
|
||||
Result := DeliverPostMessage(data, msg);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
*)
|
||||
end;
|
||||
|
||||
|
||||
function GTKFocusCB( widget: PGtkWidget; event:PGdkEventFocus; data: gPointer) : GBoolean; cdecl;
|
||||
var
|
||||
Mess : TLMessage;
|
||||
@ -1110,6 +1075,11 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.20 2001/01/30 18:15:02 lazarus
|
||||
Added code for TStatusBar
|
||||
I'm now capturing WMPainT and doing the drawing myself.
|
||||
Shane
|
||||
|
||||
Revision 1.19 2001/01/28 03:51:42 lazarus
|
||||
Fixed the problem with Changed for ComboBoxs
|
||||
Shane
|
||||
|
||||
Loading…
Reference in New Issue
Block a user