I took a look see, and first off you forgot the lfm/lrs.. a good thing its such a simple example. ;) In something like this you should always package up the pp, lfm, & lrs, and its best if you tar/zip them up so you don't fill up everybody's mailbox!

But as for the flickering. The problem is that TWinControl Double Buffering does not yet work, this means child controls may often flash in a situation such as this one(for instance TImage will have very noticeable flashing with some images). Given what you are trying, it may make sense to compare what it _should_ like with what it actually _does_ by implementing a buffer routine in its own Paint routine. I tried it and it looked much better. This what I replaced the paint routine with :

procedure TMotoMetr.Paint;
var
  DrawHandle,
  TempHandle,
  TempBit : Longint;
begin
  DrawHandle := Canvas.Handle;
  TempHandle := CreateCompatibleDC(0);
  TempBit := CreateCompatibleBitmap(TempHandle, Width + 1, Height + 1);
  SelectObject(TempHandle, TempBit);
  Canvas.Handle := TempHandle;
  with Canvas do
  begin
    PaintBackground(Canvas);  {Hintergrundbitmap erstellen}
    PaintNeedle(Canvas);   {Zeiger des MotoMeters wird �ber das Bitmap
gelegt}
  end;
  BitBlt(DrawHandle, 0, 0, Width + 1, Height + 1, TempHandle, 0, 0,
SRCCOPY);
  DeleteObject(TempBit);
  DeleteDC(TempHandle);
  Canvas.Handle := DrawHandle;
end;

This requires LCLLinux to be added to the uses.

Also you should note that refresh will not invalidate the component(it does a bunch of nothing). To truly refresh you must call to invalidate instead.

Andrew

Hi All,

As a kind of fun measure of how far along Lazarus is, I went to the Delphi Superpage and downloaded a TGraphicControl descended component just to see how easy it was to pull it into Lazarus.

I chose TMotoMeter, originally written for Delphi 1.0 by (B. Drehzahlmesser ), which displays a simple speedometer with some danger bands on it. There was a winprocs.Polygon call that needed to be translated to a call to Polygon and a SetTextAlign command that needed to be commented out (don't know it's equivalent in lcl land) and it worked fine !

Here is a pic of it working and a copy of the source if you are interested in toying around with it.

To get the speed marker to clear itself on a change, you'll need to issue a refresh and it does flash a fair bit. I expect that will get fixed later on.... Andreas, why does it flash like that ? Which part of Graphics.pas needs to change here ?

Cheers
DC

{ **************************************************************************
* Die Unit MOTOMETR.PAS ist eine Delphi-Komponente, die ein KFZ- *
* Rundinstrument (z. B. Drehzahlmesser) simmuliert. *
* �ber Properties kann das Aussehen eingestellt werden. *
* *
* Erstellt mit: Delphi 1.0 f�r Windows *
* Erstelldatum: 24.02.1996 (B. Bauer) *
* Letzte Aenderung: 12.12.1999 (B. Bauer), Optimiert fuer Delphi 4.0 * ************************************************************************** }

unit Motometro;
interface

uses
SysUtils, lcltype, GraphType,{WinTypes, WinProcs, Messages,} Classes, Graphics, Controls,

  Forms, Dialogs;

type
  TMotoMetr = class(TGraphicControl)
  private
    FMaxValue: Longint;
    FCurPosition,FMinDangerZ,FMaxDangerZ: single;
    FUnits,FTitle: string;
    FMarks: Integer;
    FDangerZone: Boolean;
    FBackColor,FScaleColor,FFontColor,FNeedleColor,FDangerColor,FBorderColor: TColor;
    FFontName: TFontName;
    PosX, PosY, x,y,xS1,yS1,xS2,yS2, Radius: integer;
    alpha_z, alpha_bog:real;
    procedure PaintBackground(ACanvas: TCanvas);
    procedure PaintNeedle(ICanvas: TCanvas);
    procedure SetBackColor(Value: TColor);
    procedure SetScaleColor(Value: TColor);
    procedure SetFontColor(Value: TColor);
    procedure SetNeedleColor(Value: TColor);
    procedure SetPosition(Value: Single);
    procedure SetMarks(Value: Integer);
    procedure SetMaxValue(Value: Longint);
    procedure SetUnits(Value: String);
    procedure SetTitle(Value: String);
    procedure SetDangerZone(Value: Boolean);
    procedure SetMinDangerZ(Value: Single);
    procedure SetMaxDangerZ(Value: Single);
    procedure SetDangerColor(Value: TColor);
    procedure SetFontName(Value: TFontName);
    procedure SetBorderColor(Value: TColor);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    {Properties zum Einstellen des gew�nschten Aussehens der Komponente}
    property Align;
    property FontName: TFontName read FFontName write SetFontName;
    property ColorScale: TColor read FScaleColor write SetScaleColor;
    property ColorBack: TColor read FBackColor write SetBackColor;
    property ColorFont: TColor read FFontColor write SetFontColor;
    property ColorNeedle: TColor read FNeedleColor write SetNeedleColor;
    property MaxValue: Longint read FMaxValue write SetMaxValue;
    property Position: Single read FCurPosition write SetPosition;
    property Visible;
    property Marks: Integer read FMarks write SetMarks;
    property Units: String read FUnits write SetUnits;
    property Title: String read FTitle write SetTitle;
    property DangerZone: Boolean read FDangerZone write SetDangerZone;
    property DangerZoneMin: Single read FMinDangerZ write SetMinDangerZ;
    property DangerZoneMax: Single read FMaxDangerZ write SetMaxDangerZ;
    property ColorDangerZ: TColor read FDangerColor write SetDangerColor;
    property ColorBorder: TColor read FBorderColor write SetBorderColor;
  end;
  procedure Register;
implementation
constructor TMotoMetr.Create(AOwner: TComponent);
  begin
    inherited Create(AOwner);
    ControlStyle := ControlStyle + [csFramed, csOpaque];
    Canvas.Font.Color:= ClWhite;
    {Grundeinstellungen}
    Height:=210;
    Width:=210;
    FCurPosition:=0;
    FBackColor:=clSilver;
    FScaleColor:=clBlack;
    FFontColor:=clWhite;
    FFontName:='Century Gothic';
    FNeedleColor:=$000080FF;
    FMarks:=7;
    FMaxValue:=70;
    FTitle:='x 100';
    FUnits:='1/min';
    FDangerZone:=True;
    FMinDangerZ:=FMaxValue div 3;
    FMaxDangerZ:=FMaxValue div 2;
    FDangerColor:=clRed;
    FBorderColor:=clGray;
  end;
procedure TMotoMetr.Paint;
begin
  with Canvas do
  begin
      PaintBackground(Canvas);  {Hintergrundbitmap erstellen}
      PaintNeedle(Canvas);   {Zeiger des MotoMeters wird �ber das Bitmap gelegt}
    end;
  end;

{--------------------------------------------------------------------------- ---- Hintergrund wird gezeichnet und als Bitmap im Speicher abgelegt ----- ---------------------------------------------------------------------------}

procedure TMotoMetr.PaintBackground(ACanvas: TCanvas);
type TPolyArray= array[0..360] of TPoint;
     PPolyArray= ^TPolyArray;
var
  ARect: TRect;
  alpha, i, j, k: integer;
  Poly:PPolyArray;
  startDanger,StopDanger:integer;
  anzPoints:integer;
begin
  If Width > Height then                  {Radius wird optimiert}
    radius:=(Height div 2)-4;
  If Width <= Height then
    radius:=(Width div 2)-4;
  PosX:=Width div 2;
  PosY:=Height div 2;
  alpha_z:=0;
  with Canvas do
  begin
    ARect := Rect(0, 0, Width, Height);
    Brush.Color:=ColorBack;
    FillRect(ARect);
    CopyRect(ARect, Canvas, ARect);       {Hintergrundrechteck anlegen}
    Brush.Color:=ColorScale;
    Pen.Width:=3;
    Pen.Color:=ColorBorder;
    Ellipse(PosX-Radius-Pen.Width,PosY-Radius-Pen.Width,     {Skala-Grundfl�che}
            PosX+Radius+Pen.Width,PosY+Radius+Pen.Width);
    Pen.Width:=1;
    Pen.Color:=ColorBorder;
    Ellipse(PosX-Round(0.15*radius),PosY-Round(0.15*radius),      {Umrandung}
            PosX+Round(0.15*radius),PosY+Round(0.15*radius));
    {Horizontale Textzentrierung mittels Handle �ber API-Funktion}
//    SetTextAlign(ACanvas.Handle,TA_CENTER or TA_BOTTOM);
    Font.Name:=FontName;
    Font.Size:=Round((8*radius)/102);
    Font.Color:=ColorFont;
    Font.Style:=[];
    TextOut(PosX,PosY-Round(radius*0.40),Title);
    TextOut(PosX,PosY-Round(radius*0.25),Units);
    TextOut(PosX,PosY+Round(radius*0.55),'� bb');
    {-----------------------------------------------------------------------
     "Roten Bereich" erstellen. Wird vom gewuenschten Wert
     bis zum eingestellten Maximalwert gezeichnet}
  if (DangerZone = True) and (MaxValue > DangerZoneMin) and (MaxValue > 0) then
  begin
     startDanger:=Round(270*DangerZoneMin/MaxValue);
     stopDanger:=Round(270*DangerZoneMax/MaxValue);
     AnzPoints:= (StopDanger-StartDanger+1)*2;
    if anzPoints > 0 then
    begin
      getmem(Poly,(anzPoints+2)*Sizeof(TPoint));
      for alpha := 0   to (AnzPoints div 2)-1  do
      begin
        alpha_bog:=((alpha+startDanger+135)/180)*Pi;
        xS1:=Round(PosX+((radius)*cos(alpha_bog)));
        yS1:=Round(PosY+((radius)*sin(alpha_bog)));
        Poly^[alpha].x:=xS1;
        Poly^[alpha].y:=yS1;
        xS2:=Round(PosX+((radius-(radius*0.15))*cos(alpha_bog)));
        yS2:=Round(PosY+((radius-(radius*0.15))*sin(alpha_bog)));
        Poly^[AnzPoints-alpha-1].x:=xS2;
        Poly^[AnzPoints-alpha-1].y:=yS2;
      end;
      Pen.Width:=3;
      Pen.Color:=FDangerColor;
      Brush.Color:=FDangerColor;
//      winprocs.Polygon(Acanvas.handle,Poly^,AnzPoints);
      Polygon(Poly^, AnzPoints, True);
      freemem(Poly,(AnzPoints+2)*Sizeof(TPoint));
      Brush.Color:=ColorScale;
    end;
  end;
    Font.Size:=Round((9*radius)/102);
    Font.Color:=ColorFont;
    Font.Style:=[fsBold];
    {-----------------------------------------------------------------------
     Haupt-Skalenteilung und Beschriftung erstellen }
    for i:= 0 to Marks do
    if (MaxValue > 0) and (Marks > 0) then
    begin
      alpha_bog:=(alpha_z/180)*Pi+(135/180)*Pi;
      x:=Round(PosX+((radius-radius*0.28)*cos(alpha_bog)));
      y:=Round(PosY+((radius-radius*0.28)*sin(alpha_bog)));
                 {Berechnen der vertikalen Textanordnung
                                 und der Skalierung in Bezug auf die Skalenteilung}
      TextOut(x,(y+Round(TextHeight('A')/2)),FloatToStr(i*((MaxValue)/Marks)));
      yS1:=Round(PosY+((radius)*sin(alpha_bog)));
      xS1:=Round(PosX+((radius)*cos(alpha_bog)));
      MoveTo(xS1,Ys1);
      xS2:=Round(PosX+((radius-radius*0.15)*cos(alpha_bog)));
      yS2:=Round(PosY+((radius-radius*0.15)*sin(alpha_bog)));
      Pen.Width:=2;
      Pen.Color:=ColorFont;
      LineTo(xS2,yS2);
      alpha_z:=alpha_z + (270/Marks);
    end;
    {-----------------------------------------------------------------------
     Teilstriche anordnen }
    alpha_z:=0;
    for j := 0 to (Marks-1) do
    begin
      alpha_bog:=(alpha_z/180)*Pi+((135+(270/(2*Marks)))/180)*Pi;
      yS1:=Round(PosY+((radius)*sin(alpha_bog)));
      xS1:=Round(PosX+((radius)*cos(alpha_bog)));
      MoveTo(xS1,Ys1);
      xS2:=Round(PosX+((radius-radius*0.12)*cos(alpha_bog)));
      yS2:=Round(PosY+((radius-radius*0.12)*sin(alpha_bog)));
      Pen.Width:=1;
      Pen.Color:=ColorFont;
      LineTo(xS2,yS2);
      alpha_z:=alpha_z + (270/Marks);
    end;
    CopyMode := cmSrcCopy;
  end;
end;
{---------------------------------------------------------------------------
 -----------  Zeichnen und Bewegen der Nadel des MotoMeters  ---------------
 ---------------------------------------------------------------------------}
procedure TMotoMetr.PaintNeedle(ICanvas: TCanvas);
var
    alpha, xA,yA,xE,yE: integer;
begin
  with Canvas do
    If (MaxValue > 0) then
    begin
    If fCurPosition > MaxValue then fCurPosition := MaxValue;
    If fCurPosition < 0 then fCurPosition := 0;
      begin
      alpha:=Round(fCurPosition*270/MaxValue);     {Berechnen des Drehwinkels}
      Pen.Color:=ColorNeedle;
      Pen.Mode:= PMXOR;
      Pen.Width:=2;
      alpha_bog:=(alpha/180)*Pi+(135/180)*Pi;
      xA:=Round(PosX+((radius-radius*0.15)*cos(alpha_bog)));
      yA:=Round(PosY+((radius-radius*0.15)*sin(alpha_bog)));
      xE:=Round(PosX+((radius-Round(Radius*0.85))*cos(alpha_bog)));
      yE:=Round(PosY+((radius-Round(Radius*0.85))*sin(alpha_bog)));
      MoveTo(xA,yA);
      LineTo(xE,yE);
      Pen.Mode:=PMCOPY;
    end;
   end;
end;
procedure TMotoMetr.SetPosition(Value: Single);
begin
  if (FCurPosition  Value) then
  begin
    PaintNeedle(Canvas);
    FCurPosition := Value;
    PaintNeedle(Canvas);
  end;
end;
procedure TMotoMetr.SetBackcolor(Value: TColor);
begin
  If Value  FBackColor then
  begin
    FBackColor := Value;
    Refresh;
  end;
end;
procedure TMotoMetr.SetScaleColor(Value: TColor);
begin
  If Value  FScaleColor then
  begin
    FScaleColor := Value;
    Refresh;
  end;
end;
procedure TMotoMetr.SetFontColor(Value: TColor);
begin
  If Value  FFontColor then
  begin
    FFontColor := Value;
    Refresh;
  end;
end;
procedure TMotoMetr.SetNeedleColor(Value: TColor);
begin
  If Value  FNeedleColor then
  begin
    FNeedleColor := Value;
    Refresh;
  end;
end;
procedure TMotoMetr.SetMarks(Value: Integer);
begin
  If Value  FMarks then
  begin
    FMarks := Value;
    Refresh
  end;
end;
procedure TMotoMetr.SetMaxValue(Value: Longint);
begin
  If Value  FMaxValue then
  begin
    FMaxValue := Value;
    Refresh;
  end;
end;
procedure TMotoMetr.SetUnits(Value: String);
begin
  If Value  FUnits then
  begin
    FUnits := Value;
    Refresh;
  end;
end;
procedure TMotoMetr.SetTitle(Value: String);
begin
  If Value  FTitle then
  begin
    FTitle := Value;
    Refresh;
  end;
end;
procedure TMotoMetr.SetDangerZone(Value: Boolean);
begin
  If Value  FDangerZone then
  begin
    FDangerZone := Value;
    Refresh;
  end;
end;
procedure TMotoMetr.SetMinDangerZ(Value: Single);
begin
  If Value  FMinDangerZ then
  begin
    FMinDangerZ := Value;
    Refresh;
  end;
end;
procedure TMotoMetr.SetMaxDangerZ(Value: Single);
begin
  If Value  FMaxDangerZ then
  begin
    FMaxDangerZ := Value;
    Refresh;
  end;
end;
procedure TMotoMetr.SetDangerColor(Value: TColor);
begin
  If Value  FDangerColor then
  begin
    FDangerColor := Value;
    Refresh;
  end;
end;
procedure TMotoMetr.SetFontName(Value: TFontName);
begin
  If Value  FFontName then
  begin
    FFontName := Value;
    Refresh;
  end;
end;
procedure TMotoMetr.SetBorderColor(Value: TColor);
begin
  If Value  FBorderColor then
  begin
    FBorderColor := Value;
    Refresh;
  end;
end;

{ Registrierung der Komponente}

procedure Register;
begin
  RegisterComponents('Beispiele', [TMotoMetr]);
end;
end.

2002_11_04_232211_shot.jpg

unit ComponentTester;
{$mode objfpc}{$H+}
interface

uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LResources, Buttons,

  ExtCtrls, StdCtrls, ComCtrls, Motometro;

type
  TForm1 = class(TForm)
    Button1: TBUTTON;
    Panel1: TPANEL;
    Trackbar1: TTRACKBAR;
    procedure Button1CLICK(Sender: TObject);
    procedure Trackbar1CHANGE(Sender: TObject);
  private
    { private declarations }
    Mine      :  TMotoMetr;
  public
    { public declarations }
  end;
var
  Form1: TForm1;
implementation

{ TForm1 }

procedure TForm1.Button1CLICK(Sender: TObject);
begin
  Mine := TMotoMetr.Create(Panel1);
//  Mine.MaxValue := TrackBar1.Max;
  Mine.Parent := Panel1;
  Mine.Top := 0;
  Mine.Width := Panel1.Width;
end;
procedure TForm1.Trackbar1CHANGE(Sender: TObject);
begin
  Mine.Position := TrackBar1.Position;
  Mine.Refresh;
end;
initialization
  {$I componenttester.lrs}
end.

-------------- next part --------------
A non-text attachment was scrubbed...
Name: jpg00000.jpg
Type: application/octet-stream
Size: 15765 bytes
Desc: ""
Url : http://localhost/pipermail/lazarus/attachments/20021104/05f69d47/jpg00000.obj