edysoftware.com

How to make statusbar with images..?

we can draw icon on statusbar using canvas, or assign from imagelist. for this example we use imagelist, so we need 3 images to put in to imagelist : green, yellow and red.

Now ,

create new application, add button, imageslist, timer and statusbar. Add 3 images into imagelist and then double click on statusbar

• add new status panel
• Click on the second status panel
• Change the style from psText to psOwnerDraw

• on  StatusBar1DrawPanel
• Write this procedure :

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
begin
// clear panel
StatusBar1.Canvas.Pen.Color := StatusBar1.Canvas.Brush.Color;
StatusBar1.Canvas.Rectangle(rect);
StatusBar1.Canvas.Pen.Color := clWindowText;
// draw icon and message
ImageList1.Draw(StatusBar1.Canvas, Rect.Left, Rect.Top, StatusIconIndex);
ImageList1.Draw(StatusBar1.Canvas, Rect.Left+15, Rect.Top, StatusIconIndex1);
ImageList1.Draw(StatusBar1.Canvas, Rect.Left+30, Rect.Top, StatusIconIndex2);
StatusBar1.Canvas.TextOut(Rect.left + 51, Rect.top+1, StatusText);
end;

Create procedure to send message on statusbar

procedure TForm1.showstatus(msg: string=”;  panel : Integer=0; busy: integer=0);
begin
if panel = 1 then begin
StatusText := msg;
case busy of
0:
begin
StatusIconIndex := 0;
StatusIconIndex1 := 0;
StatusIconIndex2 := 0;
end;
1:
begin
StatusIconIndex := 2;
StatusIconIndex1 := 1;
StatusIconIndex2 := 0;
end;
2:
begin
StatusIconIndex := 0;
StatusIconIndex1 :=2;
StatusIconIndex2 := 1;
end;
3:
begin
StatusIconIndex := 1;
StatusIconIndex1 := 0;
StatusIconIndex2 := 2;
end;
end;
end
else
StatusBar1.Panels[panel].Text := msg;
StatusBar1.Repaint;
end;

Complete source

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ImgList, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
ImageList1: TImageList;
StatusBar1: TStatusBar;
Button2: TButton;
Timer1: TTimer;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
StatusBar2: TStatusBar;
procedure Button1Click(Sender: TObject);
procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
procedure showstatus(msg: string=”;  panel : Integer=0; busy: integer=0);
procedure Timer1Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
private

{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
StatusText          : String = ‘Initializing…’;
StatusIconIndex     : Integer = 0;
StatusIconIndex1     : Integer = 0;
StatusIconIndex2     : Integer = 0;
i:byte;
implementation

{$R *.dfm}

procedure TForm1.showstatus(msg: string=”;  panel : Integer=0; busy: integer=0);
begin
if panel = 1 then begin
StatusText := msg;
case busy of
0:
begin
StatusIconIndex := 0;
StatusIconIndex1 := 0;
StatusIconIndex2 := 0;
end;
1:
begin
StatusIconIndex := 2;
StatusIconIndex1 := 1;
StatusIconIndex2 := 0;
end;
2:
begin
StatusIconIndex := 0;
StatusIconIndex1 :=2;
StatusIconIndex2 := 1;
end;
3:
begin
StatusIconIndex := 1;
StatusIconIndex1 := 0;
StatusIconIndex2 := 2;
end;
end;
end
else
StatusBar1.Panels[panel].Text := msg;
StatusBar1.Repaint;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
showstatus(’Disconnect….’,1,1);
//StatusBar1.Repaint;
end;

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
begin
// clear panel
StatusBar1.Canvas.Pen.Color := StatusBar1.Canvas.Brush.Color;
StatusBar1.Canvas.Rectangle(rect);
StatusBar1.Canvas.Pen.Color := clWindowText;
// draw icon and message
ImageList1.Draw(StatusBar1.Canvas, Rect.Left, Rect.Top, StatusIconIndex);
ImageList1.Draw(StatusBar1.Canvas, Rect.Left+15, Rect.Top, StatusIconIndex1);
ImageList1.Draw(StatusBar1.Canvas, Rect.Left+30, Rect.Top, StatusIconIndex2);
StatusBar1.Canvas.TextOut(Rect.left + 51, Rect.top+1, StatusText);
end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin
if i>3 then i:=0;

showstatus(’Connected….’,1,i);
inc(i);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled:=true;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
showstatus(’Connected….’,1,0);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
showstatus(’Connected….’,1,1);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
showstatus(’Connected….’,1,2);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
showstatus(’Connected….’,1,3);
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
if i>3 then i:=0;

showstatus(’Connected….’,1,i);
sleep(50);
inc(i);
end;

end.

Source download