diff --git a/RackCtls.pas b/RackCtls.pas index 4e7ad96..8ed1334 100644 --- a/RackCtls.pas +++ b/RackCtls.pas @@ -1,3 +1,4 @@ +{%encoding ISO-8859-1} unit RackCtls; { RackControls: @@ -19,18 +20,26 @@ Änderungen, die bei LEDDisplay nachfolgende Nullen bei LeadingZeros=False doch zeichnet Ergänzt von Wolfgang Kleinrath - Eigenschaft FSingleLED ergänzt von U. Conrad } + Eigenschaft FSingleLED ergänzt von U. Conrad + + Lazarus adaptation: Luca Olivetti +} interface {$I SRDefine.inc} uses - {$IFDEF SR_Win32} Windows, {$ELSE} WinTypes, WinProcs, Menus, {$ENDIF} Classes, - Graphics, Controls, ExtCtrls, SysUtils, Messages, Forms; + {$IFDEF SR_LAZARUS} LCLType, LCLIntf, LResources, LMessages, + {$ELSE} + {$IFDEF SR_Win32} Windows, {$ELSE} WinTypes, WinProcs, Menus, Messages, {$ENDIF} + {$ENDIF} + Classes, Graphics, Controls, ExtCtrls, SysUtils, Forms; type + {$IFNDEF SR_LAZARUS} TBorderStyle = (bsNone, bsSingle); + {$ENDIF} TButtonDirection = (bdBottomUp, bdLeftUp, bdNone, bdRightUp, bdTopUp); TContrast = 0..9; TDecSeparator = (dsApostrophe, dsComma, dsDoublePoint, dsHyphen, dsNone, dsPoint, dsSemicolon); @@ -88,8 +97,10 @@ TLEDButton = class(TGraphicControl) FSwitching: boolean; FTextPosition: TTextPosition; +{$IFNDEF SR_LAZARUS} FMouseDown: boolean; FOnClick: TNotifyEvent; +{$ENDIF} protected procedure Paint; override; @@ -98,10 +109,13 @@ TLEDButton = class(TGraphicControl) procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; +{$IFDEF SR_LAZARUS} + procedure MouseLeave; override; +{$ENDIF} procedure SetBeveled(newValue: boolean); procedure SetBorderStyle(newBorderStyle: TBorderStyle); procedure SetButtonDirection(NewDirection: TButtonDirection); - procedure SetColor(newColor: TColor); + procedure SetColor(newColor: TColor); {$IFDEF SR_LAZARUS}override;{$ENDIF} procedure SetColorLED(newColor: TColor); procedure SetDepth(newValue: integer); procedure SetFont(newFont: TFont); @@ -117,12 +131,19 @@ TLEDButton = class(TGraphicControl) procedure DrawGlyph(Dest:TRect); procedure DrawLED(var Dest:TRect); +{$IFDEF SR_LAZARUS} + function DialogChar(var Message: TLMKey):boolean;override; + procedure TextChanged;override; +{$ENDIF} + public constructor Create(AOwner: TComponent); override; destructor Destroy; override; +{$IFNDEF SR_LAZARUS} procedure CMTextChanged(var msg: TMessage);message CM_TEXTCHANGED; procedure CMDialogChar(var Message: TCMDialogChar);message CM_DIALOGCHAR; +{$ENDIF} published {$IFDEF SR_Delphi5_Up} @@ -149,8 +170,8 @@ TLEDButton = class(TGraphicControl) property ShowHint; property ShowLED: boolean read FShowLED write SetShowLED; property StateOn: boolean read FStateOn write SetStateOn; - property Switching: boolean read FSwitching write FSwitching; - property TextPosition: TTextPosition read FTextPosition write SetTextPosition; + property Switching: boolean read FSwitching write FSwitching default true; + property TextPosition: TTextPosition read FTextPosition write SetTextPosition default tpNone; property Visible; property OnClick; @@ -160,7 +181,12 @@ TLEDButton = class(TGraphicControl) property OnMouseUp; end; +{$IFDEF SR_LAZARUS} + //Lazarus already has a TButtonPanel in its standard components collection + TLedButtonPanel = class(TCustomPanel) +{$ELSE} TButtonPanel = class(TCustomPanel) +{$ENDIF} private FBeveled: boolean; FBorderStyle: TBorderStyle; @@ -175,8 +201,8 @@ TButtonPanel = class(TCustomPanel) procedure Paint; override; procedure SetBeveled(newValue: boolean); - procedure SetBorderStyle(newBorderStyle: TBorderStyle); - procedure SetColor(newColor: TColor); + procedure SetBorderStyle(newBorderStyle: TBorderStyle); {$IFDEF SR_LAZARUS}override;{$ENDIF} + procedure SetColor(newColor: TColor); {$IFDEF SR_LAZARUS}override;{$ENDIF} procedure SetDepth(newValue: integer); procedure SetPanelDirection(NewDirection: TButtonDirection); procedure SetShowLED(newValue: boolean); @@ -208,7 +234,9 @@ TButtonPanel = class(TCustomPanel) property FullRepaint; {$ENDIF} property Font; + {$IFNDEF SR_LAZARUS} property Locked; + {$ENDIF} property PanelDirection: TButtonDirection read FPanelDirection write SetPanelDirection; property ParentColor; property ParentCtl3D; @@ -249,7 +277,7 @@ TScrewPanel = class(TCustomPanel) protected procedure Paint; override; - procedure SetColor(newColor: TColor); + procedure SetColor(newColor: TColor); {$IFDEF SR_LAZARUS}override;{$ENDIF} procedure SetMargin(newValue: integer); procedure SetScrewSize(newValue: TScrewSize); procedure SetShowScrews(newValue: boolean); @@ -282,7 +310,9 @@ TScrewPanel = class(TCustomPanel) property FullRepaint; {$ENDIF} property Font; + {$IFNDEF SR_LAZARUS} property Locked; + {$ENDIF} property Margin: integer read FMargin write SetMargin; property ParentColor; property ParentCtl3D; @@ -372,17 +402,17 @@ TLEDDisplay = class(TGraphicControl) property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle; property ColorBackGround: TColor read FColorBackGround write setColorBackGround default clOlive; property ColorLED: TColor read FColorLED write setColorLED default cllime; - property DecSeparator: TDecSeparator read FDecSeparator write setDecSeparator; + property DecSeparator: TDecSeparator read FDecSeparator write setDecSeparator default dsComma; property DigitHeight: integer read FDigitHeight write setDigitHeight default 30; property DigitWidth: integer read FDigitWidth write setDigitWidth default 20; property DigitLineWidth: integer read FLineWidth write setLineWidth default 3; - property DrawDigitShapes: boolean read FDrawDigitShapes write SetDrawDigitShapes; + property DrawDigitShapes: boolean read FDrawDigitShapes write SetDrawDigitShapes default true; property FractionDigits: integer read FFractionDigits write setFractionDigits default 0; property Height default 36; property LeadingZeros: boolean read FLeadingZeros write setLeadingZeros default true; property LEDContrast: TContrast read FLEDContrast write SetLEDContrast; property NumDigits: integer read FNumDigits write setNumDigits default 6; - property SegmentStyle: TSegmentStyle read FSegmentStyle write setSegmentStyle; + property SegmentStyle: TSegmentStyle read FSegmentStyle write setSegmentStyle default ssBeveled; property Value: extended read FValue write setValue; property Visible; property Width default 168; @@ -453,7 +483,7 @@ TLEDMeter = class(TGraphicControl) property BevelStyle: TPanelBevel read FBevelStyle write SetBevelStyle; property Colors : TLEDMeterColors read FColors write SetColors; property Cursor; - property Direction: TMeterDirection read FDirection write SetDirection; + property Direction: TMeterDirection read FDirection write SetDirection default mdRight; property DragCursor; property DragMode; property FallbackDelay: byte read FFallbackDelay write SetFallbackDelay; @@ -483,6 +513,9 @@ procedure Register; implementation +{$IFDEF SR_LAZARUS} +uses rrColors; +{$ELSE} {$IFDEF SR_Delphi2_Up} {$R *.D32} uses rrColors {$IFNDEF SR_Delphi5_Up}, SRUtils{$ENDIF}; @@ -490,6 +523,7 @@ implementation {$R *.D16} uses SRUtils; {$ENDIF} +{$ENDIF} const @@ -573,21 +607,37 @@ function GetIntermediateColor(Color1,Color2:TColor;AContrast:integer):TColor; Result:=ChangeBrightness(Color1, -100 div 10*AContrast); {$ELSE} StartClr:=ColorToRGB(Color1); + {$IFDEF SR_LAZARUS} + YR := Red(StartClr); + YG := Green(StartClr); + YB := Blue(StartClr); + {$ELSE} YR := GetRValue(StartClr); YG := GetGValue(StartClr); YB := GetBValue(StartClr); + {$ENDIF} SR := YR; SG := YG; SB := YB; EndClr:=ColorToRGB(Color2); + {$IFDEF SR_LAZARUS} + DR := Red(EndClr)-SR; + DG := Green(EndClr)-SG; + DB := Blue(EndClr)-SB; + {$ELSE} DR := GetRValue(EndClr)-SR; DG := GetGValue(EndClr)-SG; DB := GetBValue(EndClr)-SB; + {$ENDIF} YR := SR + round(DR / 9 * AContrast); YG := SG + round(DG / 9 * AContrast); YB := SB + round(DB / 9 * AContrast); + {$IFDEF SR_LAZARUS} + Result := RGBToColor( YR, YG, YB); + {$ELSE} Result := RGB( YR, YG, YB); {$ENDIF} + {$ENDIF} end; {GetIntermediateColor} function GetOffColor(const OnColor:TColor;const AContrast:TContrast):TColor; @@ -697,8 +747,9 @@ constructor TLEDButton.Create(AOwner: TComponent); FTextPosition:=tpNone; Height:=DefaultHeight; Width:=DefaultWidth; - + {$IFNDEF SR_LAZARUS} FMouseDown:=False; + {$ENDIF} end; destructor TLEDButton.Destroy; @@ -735,6 +786,9 @@ procedure TLEDButton.SetButtonDirection(NewDirection: TButtonDirection); procedure TLEDButton.SetColor(newColor: TColor); begin if FColor<>newColor then begin + {$IFDEF SR_LAZARUS} + inherited SetColor(newColor); + {$ENDIF} FColor:=newColor; AssignBevelColors(FColor,FColorHighlight,FColorShadow,FHLContrast,FShContrast); Invalidate; @@ -1056,6 +1110,22 @@ procedure TLEDButton.DrawCaption(Dest:TRect); end; end; +{$IFDEF SR_LAZARUS} +{ +TCanvas.BrushCopy isn't implemented in Lazarus. +See http://bugs.freepascal.org/view.php?id=8047 +} + +procedure BrushCopy(DestCanvas: TCanvas; const Dest: TRect; Bitmap: TBitmap; + const Source: TRect; Color: TColor); +begin + StretchBlt(DestCanvas.Handle, Dest.Left, Dest.Top, + Dest.Right - Dest.Left, Dest.Bottom - Dest.Top, + Bitmap.Canvas.Handle, Source.Left, Source.Top, + Source.Right - Source.Left, Source.Bottom - Source.Top, SrcCopy); +end; +{$ENDIF} + procedure TLEDButton.DrawGlyph(Dest:TRect); var Source : TRect; @@ -1066,6 +1136,9 @@ procedure TLEDButton.DrawGlyph(Dest:TRect); { Größe des Destination-Rechtecks } outWidth:= FGlyph.Width div FNumGlyphs; outHeight:= FGlyph.Height; + {$IFDEF SR_LAZARUS} + if (OutWidth=1) and (OutHeight=1) then exit; + {$ENDIF} with Source do begin Top:=0; Bottom:=FGlyph.Height; @@ -1085,7 +1158,11 @@ procedure TLEDButton.DrawGlyph(Dest:TRect); Dest.Top:= ((Dest.Bottom + Dest.Top - outHeight) shr 1); Dest.Bottom:=Dest.Top+outHeight; Pen.Color := Color; + {$IFDEF SR_LAZARUS} + BrushCopy(Canvas, Dest,FGlyph,Source,FGlyph.Canvas.Pixels[0,FGlyph.Height-1]); + {$ELSE} BrushCopy(Dest,FGlyph,Source,FGlyph.Canvas.Pixels[0,FGlyph.Height-1]); + {$ENDIF} end; end; @@ -1154,6 +1231,22 @@ procedure TLEDButton.Paint; end; end; +{$IFDEF SR_LAZARUS} +function TLEDButton.DialogChar(var Message: TCMDialogChar):boolean; +begin + if IsAccellerator(Message.CharCode, Caption) then begin + if Enabled then begin + Click; + if FSwitching then + FStateOn:=not FStateOn; + Invalidate; + end; + Result := true; + end + else + Result := inherited; +end; +{$ELSE} procedure TLEDButton.CMDialogChar(var Message: TCMDialogChar); begin with Message do begin @@ -1170,37 +1263,66 @@ procedure TLEDButton.CMDialogChar(var Message: TCMDialogChar); inherited; end; end; +{$ENDIF} procedure TLEDButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - if Enabled then begin + if Enabled and (Button=mbLeft) then begin FDown:=true; Invalidate; end; + {$IFDEF SR_LAZARUS} + inherited MouseDown(Button, Shift, X, Y); + {$ELSE} FMouseDown:= True; + {$ENDIF} end; procedure TLEDButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - if Enabled then begin + if FDown and Enabled then begin FDown:=false; if FSwitching then FStateOn:=not FStateOn; Paint; + {$IFNDEF SR_LAZARUS} if Assigned(FOnClick) then FOnClick(Self); + {$ENDIF} end; - FMouseDown:= False; + {$IFDEF SR_LAZARUS} + inherited MouseUp(Button, Shift, X, Y); + {$ENDIF} end; +{$IFDEF SR_LAZARUS} +procedure TLEDButton.MouseLeave; +begin + if FDown then + begin + FDown:=false; + Paint; + end; + inherited MouseLeave; +end; +{$ENDIF} + +{$IFDEF SR_LAZARUS} +procedure TLEDButton.TextChanged; +{$ELSE} procedure TLEDButton.CMTextChanged(var msg: TMessage); +{$ENDIF} begin Invalidate; end; -{ Komponente TButtonPanel } +{ Komponente TLedButtonPanel } +{$IFDEF SR_LAZARUS} +constructor TLedButtonPanel.Create(AOwner: TComponent); +{$ELSE} constructor TButtonPanel.Create(AOwner: TComponent); +{$ENDIF} begin inherited Create(AOwner); @@ -1216,12 +1338,20 @@ constructor TButtonPanel.Create(AOwner: TComponent); Width:=DefaultWidth; end; +{$IFDEF SR_LAZARUS} +destructor TLedButtonPanel.Destroy; +{$ELSE} destructor TButtonPanel.Destroy; +{$ENDIF} begin inherited Destroy; end; +{$IFDEF SR_LAZARUS} +procedure TLedButtonPanel.SetBeveled(NewValue: boolean); +{$ELSE} procedure TButtonPanel.SetBeveled(NewValue: boolean); +{$ENDIF} begin if FBeveled<>NewValue then begin FBeveled:=NewValue; @@ -1229,7 +1359,11 @@ procedure TButtonPanel.SetBeveled(NewValue: boolean); end; end; +{$IFDEF SR_LAZARUS} +procedure TLedButtonPanel.SetBorderStyle(NewBorderStyle: TBorderStyle); +{$ELSE} procedure TButtonPanel.SetBorderStyle(NewBorderStyle: TBorderStyle); +{$ENDIF} begin if FBorderStyle<>NewBorderStyle then begin FBorderStyle:=NewBorderStyle; @@ -1237,7 +1371,11 @@ procedure TButtonPanel.SetBorderStyle(NewBorderStyle: TBorderStyle); end; end; +{$IFDEF SR_LAZARUS} +procedure TLedButtonPanel.SetPanelDirection(NewDirection: TButtonDirection); +{$ELSE} procedure TButtonPanel.SetPanelDirection(NewDirection: TButtonDirection); +{$ENDIF} begin if FPanelDirection<>NewDirection then begin FPanelDirection:=NewDirection; @@ -1245,16 +1383,27 @@ procedure TButtonPanel.SetPanelDirection(NewDirection: TButtonDirection); end; end; +{$IFDEF SR_LAZARUS} +procedure TLedButtonPanel.SetColor(newColor: TColor); +{$ELSE} procedure TButtonPanel.SetColor(newColor: TColor); +{$ENDIF} begin if FColor<>newColor then begin + {$IFDEF SR_LAZARUS} + inherited SetColor(newColor); + {$ENDIF} FColor:=newColor; AssignBevelColors(FColor,FColorHighlight,FColorShadow,FHLContrast,FShContrast); Invalidate; end; end; +{$IFDEF SR_LAZARUS} +procedure TLedButtonPanel.SetDepth(newValue: integer); +{$ELSE} procedure TButtonPanel.SetDepth(newValue: integer); +{$ENDIF} begin if FDepth<>newValue then begin FDepth:=newValue; @@ -1262,7 +1411,11 @@ procedure TButtonPanel.SetDepth(newValue: integer); end; end; +{$IFDEF SR_LAZARUS} +procedure TLedButtonPanel.SetShowLED(newValue: boolean); +{$ELSE} procedure TButtonPanel.SetShowLED(newValue: boolean); +{$ENDIF} begin if FShowLED<>newValue then begin FShowLED:=newValue; @@ -1270,7 +1423,11 @@ procedure TButtonPanel.SetShowLED(newValue: boolean); end; end; +{$IFDEF SR_LAZARUS} +procedure TLedButtonPanel.DrawBorder(Dest:TRect); +{$ELSE} procedure TButtonPanel.DrawBorder(Dest:TRect); +{$ENDIF} var i : integer; begin Dest:=GetClientRect; @@ -1436,7 +1593,11 @@ procedure TButtonPanel.DrawBorder(Dest:TRect); end; end; +{$IFDEF SR_LAZARUS} +procedure TLedButtonPanel.DrawCaption(Dest:TRect); +{$ELSE} procedure TButtonPanel.DrawCaption(Dest:TRect); +{$ENDIF} var OutText : array [0..79] of char; begin with Canvas do begin @@ -1446,7 +1607,11 @@ procedure TButtonPanel.DrawCaption(Dest:TRect); end; end; +{$IFDEF SR_LAZARUS} +procedure TLedButtonPanel.DrawLED(var Dest:TRect); +{$ELSE} procedure TButtonPanel.DrawLED(var Dest:TRect); +{$ENDIF} begin with Canvas do begin Brush.Color:=clWindowFrame; @@ -1471,7 +1636,11 @@ procedure TButtonPanel.DrawLED(var Dest:TRect); end; end; +{$IFDEF SR_LAZARUS} +procedure TLedButtonPanel.Paint; +{$ELSE} procedure TButtonPanel.Paint; +{$ENDIF} var ARect : TRect; begin Canvas.Font.Assign(Font); @@ -1513,6 +1682,9 @@ destructor TScrewPanel.Destroy; procedure TScrewPanel.SetColor(newColor: TColor); begin if FColor<>newColor then begin + {$IFDEF SR_LAZARUS} + inherited SetColor(newColor); + {$ENDIF} FColor:=newColor; AssignBevelColors(FColor,FColorHighlight,FColorShadow,FHLContrast,FShContrast); Invalidate; @@ -2166,14 +2338,14 @@ procedure TLEDMeter.Paint; else BevelWidth:=0; if (FDirection=mdRight) or (FDirection=mdLeft) then begin - DigitWidth:=(Width-(2*BevelWidth)) div FNumDigits; - DigitHeight:=Height-(2*BevelWidth); + DigitWidth:=(Self.Width-(2*BevelWidth)) div FNumDigits; + DigitHeight:=Self.Height-(2*BevelWidth); DigitLeft:=BevelWidth; DigitTop:=BevelWidth; end else begin - DigitWidth:=Width-(2*BevelWidth)-1; - DigitHeight:=(Height-(2*BevelWidth)) div FNumDigits; + DigitWidth:=Self.Width-(2*BevelWidth)-1; + DigitHeight:=(Self.Height-(2*BevelWidth)) div FNumDigits; DigitTop:=BevelWidth; DigitLeft:=BevelWidth; end; @@ -2220,9 +2392,9 @@ procedure TLEDMeter.Paint; if FDirection=mdRight then DigitLeft:=BevelWidth+(LEDNr*DigitWidth); if FDirection=mdLeft then - DigitLeft:=Width-BevelWidth-((LEDNr+1)*DigitWidth)-1; + DigitLeft:=Self.Width-BevelWidth-((LEDNr+1)*DigitWidth)-1; if FDirection=mdUp then - DigitTop:=Height-BevelWidth-((LEDNr+1)*DigitHeight); + DigitTop:=Self.Height-BevelWidth-((LEDNr+1)*DigitHeight); if FDirection=mdDown then DigitTop:=BevelWidth+(LEDNr*DigitHeight); Pen.Color:=FColors.Border; @@ -2406,10 +2578,19 @@ procedure TLEDMeter.TimerExpired(Sender: TObject); procedure Register; begin RegisterComponents('Simon', [TLEDButton]); +{$IFDEF SR_LAZARUS} + RegisterComponents('Simon', [TLedButtonPanel]); +{$ELSE} RegisterComponents('Simon', [TButtonPanel]); +{$ENDIF} RegisterComponents('Simon', [TScrewPanel]); RegisterComponents('Simon', [TLEDDisplay]); RegisterComponents('Simon', [TLEDMeter]); end; +{$IFDEF SR_LAZARUS} +initialization +{$i rackctls.lrs} +{$ENDIF} + end. diff --git a/RackCtlsPkg.lpk b/RackCtlsPkg.lpk new file mode 100644 index 0000000..bd15b04 --- /dev/null +++ b/RackCtlsPkg.lpk @@ -0,0 +1,66 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/SRDefine.inc b/SRDefine.inc index 92cb543..6df73ad 100644 --- a/SRDefine.inc +++ b/SRDefine.inc @@ -53,6 +53,17 @@ {$DEFINE SRDefines} +{$IFDEF LCL} + {$DEFINE SR_LAZARUS} + {$DEFINE SR_Delphi2} + {$DEFINE SR_Delphi3} + {$DEFINE SR_Delphi4} + {$DEFINE SR_Delphi5} + {$DEFINE SR_Delphi6} + {$DEFINE SR_Delphi7} + {$MODE DELPHI}{$H+} +{$ENDIF} + {$IFDEF WINDOWS} {$DEFINE SR_Win16} {$DEFINE SR_Windows} diff --git a/rackctls.lrs b/rackctls.lrs new file mode 100644 index 0000000..7ee8078 --- /dev/null +++ b/rackctls.lrs @@ -0,0 +1,55 @@ +LazarusResources.Add('tledbutton','PNG',[ + #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#4#3#0#0#0#18'Y '#203#0 + +#0#0'0PLTE'#128#0#0#0#0#0#0#128#0#128#128#0#0#0#128#128#0#128#0#128#128#192 + +#192#192#128#128#128#255#0#0#0#255#0#255#255#0#0#0#255#255#0#255#0#255#255 + +#255#255#255#131#3'<'#234#0#0#0#1'tRNS'#0'@'#230#216'f'#0#0#0#9'pHYs'#0#0#11 + +#19#0#0#11#19#1#0#154#156#24#0#0#0#7'tIME'#7#216#5#9#15#21','#137'`9'#210#0#0 + +#0'SIDATx'#218#149#206#193#13#192' '#8#133#225#199#6'0m'#29#193#21#156'Tn' + +#214#10'*1^'#250#223#190'@'#8'@'#140'd'#197#160'6'#211#142#250'x'#233'D'#155 + +#200'PF'#134'jH'#6#191'<'#160#217#251#144#3'4"~}D'#128#8#201'B'#223#6'_!|' + +#159#8#239#3#187#23#168'0P'#198')'#253'Xk'#0#0#0#0'IEND'#174'B`'#130 +]); +LazarusResources.Add('tledbuttonpanel','PNG',[ + #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#4#3#0#0#0#18'Y '#203#0 + +#0#0'0PLTE'#128#0#0#0#0#0#0#128#0#128#128#0#0#0#128#128#0#128#0#128#128#192 + +#192#192#128#128#128#255#0#0#0#255#0#255#255#0#0#0#255#255#0#255#0#255#255 + +#255#255#255#131#3'<'#234#0#0#0#1'tRNS'#0'@'#230#216'f'#0#0#0#9'pHYs'#0#0#11 + +#19#0#0#11#19#1#0#154#156#24#0#0#0#7'tIME'#7#216#5#9#15#20#5#210#201#144#255 + +#0#0#0'LIDATx'#218'c` '#3'0'#10#194#129#0#3#227''#24#248#1#228'|/'#135#130 + +#10't'#206''#24#167#3'?'#167#162#3#12#218'!'#28#136#196'w0'#231#7#132#243 + +#163#3#201'R'#8#231#7'PC'#163#4#144#0'q:`'#0#200#249#129#204'Av5'#165#0#0#219 + +'!R'#196#151#166'v3'#0#0#0#0'IEND'#174'B`'#130 +]); +LazarusResources.Add('tleddisplay','PNG',[ + #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#4#3#0#0#0#18'Y '#203#0 + +#0#0'0PLTE'#128#0#0#0#0#0#0#128#0#128#128#0#0#0#128#128#0#128#0#128#128#192 + +#192#192#128#128#128#255#0#0#0#255#0#255#255#0#0#0#255#255#0#255#0#255#255 + +#255#255#255#131#3'<'#234#0#0#0#1'tRNS'#0'@'#230#216'f'#0#0#0#9'pHYs'#0#0#11 + +#19#0#0#11#19#1#0#154#156#24#0#0#0#7'tIME'#7#216#5#9#15#20'2jt5'#240#0#0#0'?' + +'IDATx'#218'c` '#3't '#1#134'FA8'#144'ghDH'#128'8J'#26#29#171'V'#128#16#144 + +#211#213#209#4'F]$p'#160#6#0'Ir'#13#128'X'#15'q'#1#138#219#144']'#221#255#31 + +#1#136#12#2#0'E'#199'`'#195#130#5#214'X'#0#0#0#0'IEND'#174'B`'#130 +]); +LazarusResources.Add('tledmeter','PNG',[ + #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#4#3#0#0#0#18'Y '#203#0 + +#0#0'0PLTE'#0#0#128#128#0#0#0#128#0#128#128#0#0#0#0#128#0#128#0#128#128#192 + +#192#192#128#128#128#255#0#0#0#255#0#255#255#0#0#0#255#255#0#255#0#255#255 + +#255#255#255#232#25#249'6'#0#0#0#1'tRNS'#0'@'#230#216'f'#0#0#0#9'pHYs'#0#0#11 + +#19#0#0#11#19#1#0#154#156#24#0#0#0#7'tIME'#7#216#5#9#15#18'1'#165''''#195#204 + +#0#0#0'RIDATx'#218'c`'#224#232#232#232'h'#0#226#14#6' '#224'pqq'#249#208#226 + +#226#226#15#230'x'#206#156#242#161'EP'#16#11#7'E'#153#247#238'-'#31'Z'#140 + +#141#177'p'#200'Q'#230#181'j'#201#135#22'%%,'#28#178#149#173'Z'#133#133'C' + +#134'2'#254#255#255#255''#0#226#255#12#12#0#16#140']'#27'.'#233'n'#14#0#0#0 + +#0'IEND'#174'B`'#130 +]); +LazarusResources.Add('tscrewpanel','PNG',[ + #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#4#3#0#0#0#18'Y '#203#0 + +#0#0'0PLTE'#0#0#0#128#0#0#0#128#0#128#128#0#0#0#128#128#0#128#0#128#128#192 + +#192#192#128#128#128#255#0#0#0#255#0#255#255#0#0#0#255#255#0#255#0#255#255 + +#255#255#255'O'#19'&I'#0#0#0#1'tRNS'#0'@'#230#216'f'#0#0#0#9'pHYs'#0#0#11#19 + +#0#0#11#19#1#0#154#156#24#0#0#0#7'tIME'#7#216#5#9#15#21#17#209#8'u'#195#0#0#0 + +'BIDATx'#218'c`'#192#9'8:'#224#0#200#249#15#3'?>0p|o/'#7#131#138#10' '#231'G' + +'='#132#211#14#150#249#14#225#212#131'd'#160'l'#160':zr'#136's'#27#194's'#31 + +#24#24#224#158#251#255#129#129'8'#0#0#27#191''#163#31'A;R'#0#0#0#0'IEND'#174 + +'B`'#130 +]); diff --git a/rr.inc b/rr.inc index b1b4bf4..138dbcf 100644 --- a/rr.inc +++ b/rr.inc @@ -23,6 +23,18 @@ VER160 Delphi 7.0 VER170 Delphi 2005 } +{$IFDEF LCL} +{$DEFINE RR_LAZARUS} +{$ENDIF} + + +{$IFDEF RR_LAZARUS} + +{$MODE DELPHI}{$H+} + +{$DEFINE VER100_up} + +{$ELSE} {$B-} { Complete Boolean Evaluation } {$R-} { Range-Checking } @@ -85,6 +97,8 @@ {$ENDIF} {$ENDIF} +{$ENDIF} + {$IFDEF VER93} { Borland C++Builder 1.0 } {$DEFINE CBUILDER} {$ENDIF} diff --git a/rrColors.pas b/rrColors.pas index c0083dd..d216342 100644 --- a/rrColors.pas +++ b/rrColors.pas @@ -87,6 +87,9 @@ interface Classes, {$IFNDEF VER100_up} Controls, +{$ENDIF} +{$IFDEF RR_LAZARUS} + IntfGraphics, {$ENDIF} Graphics; @@ -120,12 +123,19 @@ function RGB2HLS(const RGB: TColorVector): TColorVector; {$IFDEF VER100_up} function GetBitmapColors(Bmp: TBitmap;var Colors: array of TColor;StartIndex: Integer): Integer; function GetBmpBitsPerPixel(ABitmap: TBitmap): Integer; +{$IFNDEF RR_LAZARUS} +//TODO procedure MapBitmapColors(Bmp: TBitmap; OldColors, NewColors: array of TColor); function SetBitmapColors(Bmp: TBitmap;Colors: array of TColor;StartIndex: Integer): Integer; {$ENDIF} +{$ENDIF} implementation +{$IFDEF RR_LAZARUS} +uses RtlConsts; +{$ELSE} uses Consts; +{$ENDIF} type PRGBTripleArray = ^TRGBTripleArray; @@ -248,6 +258,7 @@ function GetBmpBitsPerPixel(ABitmap: TBitmap): Integer; end; end; {.$DEFINE PascalCode} +{$IFNDEF RR_LAZARUS} procedure MapBitmapColors(Bmp: TBitmap; OldColors, NewColors: array of TColor); type TColorRec = packed record @@ -484,6 +495,7 @@ procedure MapBitmapColors(Bmp: TBitmap; OldColors, NewColors: array of TColor); end; end; {$ENDIF} +{$ENDIF} function HLS2RGB(const HLS: TColorVector): TColorVector; const diff --git a/tledbutton.png b/tledbutton.png new file mode 100644 index 0000000..acb270c Binary files /dev/null and b/tledbutton.png differ diff --git a/tledbuttonpanel.png b/tledbuttonpanel.png new file mode 100644 index 0000000..9c7c092 Binary files /dev/null and b/tledbuttonpanel.png differ diff --git a/tleddisplay.png b/tleddisplay.png new file mode 100644 index 0000000..9f93b93 Binary files /dev/null and b/tleddisplay.png differ diff --git a/tledmeter.png b/tledmeter.png new file mode 100644 index 0000000..f8546ac Binary files /dev/null and b/tledmeter.png differ diff --git a/tscrewpanel.png b/tscrewpanel.png new file mode 100644 index 0000000..e7d9158 Binary files /dev/null and b/tscrewpanel.png differ