unit Unit1;
{$mode objfpc}{$H+}
interface
uses
LCLIntf, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
const
cMaxValue = 100;
cLengthNeedle = 120;
cAngle = 1.75*pi;
// = (cAngle / pi) * 180 GRAD
cStartAngle = 1.15*pi;
// = (cStartAngle / pi) * 180 GRAD
cAntialiased = true;
// Weichzeichnung
cStartPosX = -1;
// -1 --> mittig
cStartPosY = -1;
// -1 --> mittig
type
{ TfrmMain }
TfrmMain =
class(TForm)
pbVUMeter: TPaintBox;
Timer: TTimer;
procedure pbVUMeterPaint(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private-Deklarationen }
FValue : integer;
//
BackgroundImage : TBitmap;
//
procedure SetValue(
const Value: integer);
public
{ Public-Deklarationen }
property Value : integer
read FValue
write SetValue;
end;
var
frmMain: TfrmMain;
implementation
procedure TfrmMain.FormCreate(Sender: TObject);
var P : TFileName;
begin
//--
Self.DoubleBuffered := true;
// damit es nicht so flackert
//
BackgroundImage := TBitmap.Create;
//
p := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + '
hintergrund.bmp';
//
if FileExists(p)
then BackgroundImage.LoadFromFile(p)
else MessageDLG('
Bild-Datei "hintergrund.bmp" im Programm-Ordner nicht gefunden!',mtError,[mbOK],0);
//
Value := 0;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
//--
BackgroundImage.Free;
end;
procedure TfrmMain.pbVUMeterPaint(Sender: TObject);
var eX,eY : integer;
var sX,sY : integer;
var d : real;
var pS,
pE : TPoint;
var i : integer;
var f : integer;
begin
//--
with pbVUMeter.Canvas
do
begin
Brush.Color := clWhite;
Brush.Style := bsSolid;
//
Pen.Style := psSolid;
//
FillRect(pbVUMeter.ClientRect);
//
// HINTERGRUND-BILD MALEN
Draw(0,0,BackgroundImage);
//
if cStartPosX = -1
then sX := pbVUMeter.Width
div 2
else sX := cStartPosX;
//
if cStartPosY = -1
then sY := pbVUMeter.Height
div 2
else sY := cStartPosY;
//
//
d := cStartAngle - (FValue/cMaxValue)*(cAngle);
//
eX := sX + Round(cos(d)*(cLengthNeedle));
//
eY := sY - Round(sin(d)*(cLengthNeedle));
//
pS.X := sX + Round(cos(cStartAngle - cAngle)*(cLengthNeedle));
pS.Y := sY - Round(sin(cStartAngle - cAngle)*(cLengthNeedle));
//
pE.X := sX + Round(cos(cStartAngle)*(cLengthNeedle));
pE.Y := sY - Round(sin(cStartAngle)*(cLengthNeedle));
//
if cAntialiased
then f := 2
else f := 1;
//
for i := f
downto 1
do
begin
if i = 2
then Pen.Color :=
RGB(168,168,168)
else Pen.Color := clBlack;
//
Pen.Width := i;
//
Arc(sx - cLengthNeedle,sy - cLengthNeedle,sx + cLengthNeedle, sy + cLengthNeedle,ps.X,ps.Y,
pe.X,
pe.Y);
MoveTo(pS.x,pS.Y);
LineTo(sx,sy);
LineTo(
pE.X,
pE.Y);
end;
//
if cAntialiased
then f := 3
else f := 2;
//
for i := f
downto 2
do
begin
if i = 3
then Pen.Color :=
RGB(168,168,168)
else Pen.Color := clRed;
//
Pen.Width := i;
//
MoveTo(sX,sY);
LineTo(eX,eY);
end;
end;
end;
procedure TfrmMain.SetValue(
const Value: integer);
begin
//--
FValue := Value;
//
pbVUMeter.Repaint;
end;
procedure TfrmMain.TimerTimer(Sender: TObject);
begin
//--
Value := (Value + 2)
mod cMaxValue;
end;
end.
property Value : integer
read FValue
write SetValue;
end;
var
frmMain: TfrmMain;
implementation
procedure TfrmMain.FormCreate(Sender: TObject);
var P : TFileName;
begin
//--
Self.DoubleBuffered := true;
// damit es nicht so flackert
//
BackgroundImage := TBitmap.Create;
//
p := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + '
hintergrund.bmp';
//
if FileExists(p)
then BackgroundImage.LoadFromFile(p)
else MessageDLG('
Bild-Datei "hintergrund.bmp" im Programm-Ordner nicht gefunden!',mtError,[mbOK],0);
//
Value := 0;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
//--
BackgroundImage.Free;
end;
procedure TfrmMain.pbVUMeterPaint(Sender: TObject);
var eX,eY : integer;
var sX,sY : integer;
var d : real;
var pS,
pE : TPoint;
var i : integer;
var f : integer;
begin
//--
with pbVUMeter.Canvas
do
begin
Brush.Color := clWhite;
Brush.Style := bsSolid;
//
Pen.Style := psSolid;
//
FillRect(pbVUMeter.ClientRect);
//
// HINTERGRUND-BILD MALEN
Draw(0,0,BackgroundImage);
//
if cStartPosX = -1
then sX := pbVUMeter.Width
div 2
else sX := cStartPosX;
//
if cStartPosY = -1
then sY := pbVUMeter.Height
div 2
else sY := cStartPosY;
//
//
d := cStartAngle - (FValue/cMaxValue)*(cAngle);
//
eX := sX + Round(cos(d)*(cLengthNeedle));
//
eY := sY - Round(sin(d)*(cLengthNeedle));
//
pS.X := sX + Round(cos(cStartAngle - cAngle)*(cLengthNeedle));
pS.Y := sY - Round(sin(cStartAngle - cAngle)*(cLengthNeedle));
//
pE.X := sX + Round(cos(cStartAngle)*(cLengthNeedle));
pE.Y := sY - Round(sin(cStartAngle)*(cLengthNeedle));
//
if cAntialiased
then f := 2
else f := 1;
//
for i := f
downto 1
do
begin
if i = 2
then Pen.Color :=
RGB(168,168,168)
else Pen.Color := clBlack;
//
Pen.Width := i;
//
Arc(sx - cLengthNeedle,sy - cLengthNeedle,sx + cLengthNeedle, sy + cLengthNeedle,ps.X,ps.Y,
pe.X,
pe.Y);
MoveTo(pS.x,pS.Y);
LineTo(sx,sy);
LineTo(
pE.X,
pE.Y);
end;
//
if cAntialiased
then f := 3
else f := 2;
//
for i := f
downto 2
do
begin
if i = 3
then Pen.Color :=
RGB(168,168,168)
else Pen.Color := clRed;
//
Pen.Width := i;
//
MoveTo(sX,sY);
LineTo(eX,eY);
end;
end;
end;
procedure TfrmMain.SetValue(
const Value: integer);
begin
//--
FValue := Value;
//
pbVUMeter.Repaint;
end;
procedure TfrmMain.TimerTimer(Sender: TObject);
begin
//--
Value := (Value + 2)
mod cMaxValue;
end;
end.