From 1c21a6547f2e95dfa8a132991e1ed57aec39826d Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 26 Aug 2015 20:31:52 +0000 Subject: [PATCH] ColorPalette: Fix ToolbarDemo to show flipped colorpalette fully. Fix missing MouseLeave notification. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4297 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/colorpalette/colorpalette.pas | 42 ++-- .../colorpalette/demo/ToolbarDemo/unit1.lfm | 230 ++++++++++++------ .../colorpalette/demo/ToolbarDemo/unit1.pas | 166 ++++++++----- 3 files changed, 279 insertions(+), 159 deletions(-) diff --git a/components/colorpalette/colorpalette.pas b/components/colorpalette/colorpalette.pas index 55f20fe2a..575363434 100644 --- a/components/colorpalette/colorpalette.pas +++ b/components/colorpalette/colorpalette.pas @@ -28,7 +28,7 @@ # sets count of palette grid columns 0,0,0 - # inserts color r,g,b + # inserts color r,g,b ColorName 255,255,255 Pure white $NONE @@ -69,6 +69,7 @@ type TColorPaletteHintEvent = procedure (Sender: TObject; AColor: TColor; var AText: String) of object; + { TCustomColorPalette } TCustomColorPalette = class(TGraphicControl) @@ -258,6 +259,7 @@ begin FButtonHeight := 12; FButtonWidth := 12; FPrevMouseIndex := -1; + FMouseIndex := -1; FPickMode := pmImmediate; FShowColorHint := true; FGradientSteps := 3; @@ -436,6 +438,8 @@ begin Result := -1 end; end; + if (Result >= FColors.Count) or (Result < 0) then + REsult := -1; end; function TCustomColorPalette.GetHintText(AIndex: Integer): string; @@ -626,6 +630,7 @@ begin inherited; Hint := FSavedHint; FMouseIndex := -1; + ColorMouseMove(MouseColor, []); end; procedure TCustomColorPalette.MouseMove(Shift: TShiftState; X, Y: Integer); @@ -635,27 +640,24 @@ begin inherited; FMouseIndex := GetColorIndex(X, Y); - if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) and - ([ssLeft, ssRight, ssMiddle] * Shift <> []) then + C := GetColors(FMouseIndex); + ColorMouseMove(C, Shift); + + if ShowHint and FShowColorHint then begin - C := GetColors(FMouseIndex); - if ShowHint and FShowColorHint then - begin - Hint := GetHintText(FMouseIndex); - if FMouseIndex <> FPrevMouseIndex then - Application.ActivateHint(ClientToScreen(Point(X, Y))); - end; - if (FMouseIndex <> FPrevMouseIndex) then - begin - if not (FUseSpacers and (C = clNone)) then - begin - ColorMouseMove(C, Shift); - if FPickMode = pmContinuous then - ColorPick(FMouseIndex, Shift); - end; - end; + Hint := GetHintText(FMouseIndex); + if FMouseIndex <> FPrevMouseIndex then + Application.ActivateHint(ClientToScreen(Point(X, Y))); end; + if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) and + ([ssLeft, ssRight, ssMiddle] * Shift <> []) and + (FMouseIndex <> FPrevMouseIndex) and + (FUseSpacers or (C <> clNone)) and + (FPickMode = pmContinuous) + then + ColorPick(FMouseIndex, Shift); + FPrevMouseIndex := FMouseIndex; end; @@ -909,7 +911,7 @@ const 5, // ExtendedAndSystemPalette = 16 std + 4 extra + 25 system colors = 45 colors -1, // Gradient palette - color count depends on PaletteStep 10, // HTML palette - 6 // Websafe palette #2 + 6 // Websafe palette ); var i, n: Integer; diff --git a/components/colorpalette/demo/ToolbarDemo/unit1.lfm b/components/colorpalette/demo/ToolbarDemo/unit1.lfm index 604ec84fe..ee41e9b7c 100644 --- a/components/colorpalette/demo/ToolbarDemo/unit1.lfm +++ b/components/colorpalette/demo/ToolbarDemo/unit1.lfm @@ -2,22 +2,22 @@ object Form1: TForm1 Left = 290 Height = 491 Top = 160 - Width = 639 + Width = 633 Caption = 'Form1' ClientHeight = 491 - ClientWidth = 639 + ClientWidth = 633 OnCreate = FormCreate ShowHint = True LCLVersion = '1.5' - object Panel1: TPanel + object MainPanel: TPanel Left = 0 - Height = 436 - Top = 55 - Width = 639 + Height = 432 + Top = 59 + Width = 633 Align = alClient BevelOuter = bvNone - ClientHeight = 436 - ClientWidth = 639 + ClientHeight = 432 + ClientWidth = 633 TabOrder = 0 object Shape1: TShape Left = 64 @@ -32,25 +32,25 @@ object Form1: TForm1 Top = 40 Width = 146 end - object Label1: TLabel + object LblStartColor: TLabel Left = 64 Height = 56 Top = 176 Width = 146 AutoSize = False - Caption = 'Gradient start'#13#10#13#10'(Left click)' - Font.Color = clWhite + Caption = 'Gradient start' + Font.Color = clWindowText ParentColor = False ParentFont = False end - object Label2: TLabel + object LblMouseColor: TLabel Left = 224 Height = 56 Top = 176 Width = 146 AutoSize = False Caption = 'Mouse color:' - Font.Color = clWhite + Font.Color = clWindowText ParentColor = False ParentFont = False end @@ -61,42 +61,60 @@ object Form1: TForm1 Width = 146 Brush.Style = bsClear end - object Label3: TLabel + object LblEndColor: TLabel Left = 384 Height = 56 Top = 176 Width = 146 AutoSize = False - Caption = 'Gradient end'#13#10#13#10'(Right click)' - Font.Color = clWhite + Caption = 'Gradient end' + Font.Color = clWindowText ParentColor = False ParentFont = False end + object IconInfoLabel: TLabel + Left = 383 + Height = 15 + Top = 408 + Width = 237 + Alignment = taRightJustify + Anchors = [akRight, akBottom] + Caption = 'Icon from http://p.yusukekamiyamane.com/' + ParentColor = False + end end object CoolBar: TCoolBar Left = 0 - Height = 55 + Height = 59 Top = 0 - Width = 639 + Width = 633 + AutoSize = True Bands = < item Break = False Control = ToolBar - MinHeight = 45 - MinWidth = 45 - Width = 385 + MinWidth = 65 + Width = 65 + end + item + Break = False + Control = ColorPalette + MinWidth = 300 + Width = 400 end> + BorderWidth = 1 GrabStyle = gsGripper + GrabWidth = 5 + HorizontalSpacing = 2 object ToolBar: TToolBar AnchorSideLeft.Control = CoolBar AnchorSideTop.Control = CoolBar - Left = 24 - Height = 45 + Left = 13 + Height = 49 Top = 5 - Width = 356 + Width = 50 Align = alNone - AutoSize = True - BorderSpacing.Left = 22 + BorderSpacing.Left = 11 BorderSpacing.Top = 3 ButtonHeight = 45 ButtonWidth = 45 @@ -106,25 +124,7 @@ object Form1: TForm1 ShowCaptions = True TabOrder = 0 Transparent = True - object ColorPalette: TColorPalette - Left = 53 - Height = 45 - Top = 0 - Width = 303 - ButtonHeight = 15 - ButtonWidth = 16 - ColumnCount = 3 - Flipped = True - GradientSteps = 1 - PaletteKind = pkGradientPalette - PickedIndex = 0 - SelectionKind = pskThickInverted - ShowColorHint = False - UseSpacers = False - OnColorPick = ColorPaletteColorPick - ParentColor = False - OnMouseMove = ColorPaletteMouseMove - end + Wrapable = False object TbChangeOrientation: TToolButton Left = 1 Hint = 'Change orientation of toolbar' @@ -135,26 +135,40 @@ object Form1: TForm1 ImageIndex = 0 OnClick = TbChangeOrientationClick Style = tbsCheck - Wrap = True - end - object TbSpacer: TToolButton - Left = 46 - Height = 45 - Top = 0 - Width = 7 - Caption = 'TbSpacer' - ShowCaption = False - Style = tbsDivider end end + object ColorPalette: TColorPalette + AnchorSideLeft.Control = CoolBar + AnchorSideTop.Control = CoolBar + Left = 78 + Height = 45 + Top = 7 + Width = 283 + ButtonHeight = 15 + ButtonWidth = 15 + ColumnCount = 3 + Flipped = True + GradientSteps = 1 + PaletteKind = pkGradientPalette + PickedIndex = 0 + SelectionKind = pskThickInverted + UseSpacers = False + OnColorMouseMove = ColorPaletteColorMouseMove + OnColorPick = ColorPaletteColorPick + BorderSpacing.Left = 76 + BorderSpacing.Top = 5 + ParentColor = False + ParentShowHint = False + ShowHint = True + end end object ImageList: TImageList Height = 24 Width = 24 - left = 433 - top = 232 + left = 272 + top = 320 Bitmap = { - 4C69010000001800000018000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + 4C69020000001800000018000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF @@ -202,22 +216,25 @@ object Form1: TForm1 1D00C1762100C2772200FFFFFF00FFFFFF00BE741F00B96E1B00B3681600AE63 1366AD6212CCFDC849FFFBB005FFFBB005FFFCBA22FFAD6212CCAD6212CCAD62 12CCAD6212CBAD6212BDAD62129EAD621268AE631320B1661500B66B1800BC71 - 1D00C1762100C2772200FFFFFF00FFFFFF00BE741F00B96E1B00B3681600AD62 + 1D00C1762100C2772200FFFFFF00FFFFFF005F3A10005D370E00B3681600AD62 1200A95E0F66A85D0ECCFFC538FFFFB200FFFFBB19FFA85D0ECCAA5F1000AB60 1100AB601100AB601100AB601100AB601100AE631300B1661500B66B1800BC71 - 1D00C1762100C2772200FFFFFF00FFFFFF00BE741F00B96E1B00B3681600AD62 - 1200A85D0E00A4590B66A3580ACCFFC12BFFFFB914FFA3580ACCA3580A00A95E - 0F00AB601100AB601100AB601100AB601100AE631300B1661500B66B1800BC71 - 1D00C1762100C2772200FFFFFF00FFFFFF00BE741F00B96E1B00B3681600AD62 - 1200A85D0E00A3580A009F5408669E5307CCFFBD1FFF9E5307CC9E5307009E53 - 0700A85D0F00AB601100AB601100AB601100AE631300B1661500B66B1800BC71 - 1D00C1762100C2772200FFFFFF00FFFFFF00BE741F00B96E1B00B3681600AD62 - 1200A85D0E00A3580A009E5307009B5005669A4F04CC9A4F04CC9A4F04009A4F - 04009A4F0400A75C0E00AB601100AB601100AE631300B1661500B66B1800BC71 - 1D00C1762100C2772200FFFFFF00FFFFFF00BE741F00B96E1B00B3681600AD62 - 1200A85D0E00A3580A009E5307009A4F0400984D0266984D0299984D0200984D - 0200984D0200984D0200AB601100AB601100AE631300B1661500B66B1800BC71 - 1D00C1762100C2772200FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + 1D00C1762100C2772200FFFFFF00FFFFFF000000000000000000000000005731 + 0900A85D0E00A4590B66A3580ACCFFC12BFFFFB914FFA3580ACCA3580A007E46 + 0B005630090056300900563009005630090057320A0000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000000000000000 + 000000000000522C05009F5408669E5307CCFFBD1FFF9E5307CC773F06000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000001000000050000 + 000A0000001000000016000000196F3904779A4F04CC9A4F04CC0000001A0000 + 001A0000001800000014000000100000000B0000000700000003000000010000 + 00000000000000000000FFFFFF00FFFFFF0000000000000000020000000A0000 + 0014000000200000002B00000032000000336935027B723A02A6000000330000 + 00330000002F000000270000001F000000160000000D00000006000000010000 + 00000000000000000000FFFFFF00FFFFFF000000000000000001000000050000 + 000A0000001000000016000000190000001A0000001A0000001A0000001A0000 + 001A0000001800000014000000100000000B0000000700000003000000010000 + 00000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF @@ -226,6 +243,75 @@ object Form1: TForm1 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000006741 + 1500D1862D00D4892F00D68B3100D68B3100E99E3F00E99E3F00E99E3F00E99E + 3F00EA9F4099EA9F4066E79C3E00E3983B00DF943800DA8F3400D58A30009D64 + 220065401400623D1200FFFFFF000000000000000000613B1100C77C2600CD82 + 2A00D1862D00D4892F00D68B3100D68B3100DB903500E79C3E00E79C3E00E79C + 3E00E79C3ECCE79C3ECCE79C3E66E3983B00DF943800DA8F3400D58A3000D085 + 2C00CA7F2800C4792300FFFFFF00603B1000BF752000C1762100C77C2600CD82 + 2A00D1862D00D4892F00D68B3100D68B3100D68B3100DA8F3400E3983B00E398 + 3B00E3983BCCFFE498FFE3983BCCE3983B66DF943800DA8F3400D58A3000D085 + 2C00CA7F2800C4792300FFFFFF00BF752000BF752000C1762100C77C2600CD82 + 2A00D1862D00D4892F00D68B3100D68B3100D68B3100D68B3100D98E3300DF94 + 3800DF9438CCFFE397FFFFE296FFDF9438CCDF943866DA8F3400D58A3000D085 + 2C00CA7F2800C4792300FFFFFF00BF752000BF752000C1762100C77C2600CD82 + 2A00D1862D00D4892F00D68B3100D68B3100D68B3100D68B3100D68B3100D88D + 3200DA8F34CCFEE195FFFCD084FFFEE094FFDA8F34CCDA8F3466D58A3000D085 + 2C00CA7F2800C4792300FFFFFF00BF752000BF752000C1762100C77C2600CD82 + 2A00D1862D00D4892F20D58A3068D58A309ED58A30BDD58A30CBD58A30CCD58A + 30CCD58A30CCFEDD91FFF8C67AFFF9CB7FFFFDDB8FFFD58A30CCD58A3066D085 + 2C00CA7F2800C4792300FFFFFF00BF752000BF752000C1762100C77C2600CD82 + 2A0FD0852C73D48E36C8E5AF5CE3F4CB7CF3FAD88BFBFDDC90FFFDDC90FFFDDB + 8FFFFDDA8EFFFCD98DFFF5C074FFF5C074FFF7C67AFFFBD68AFFD0852CCCCF84 + 2C66CA7F2800C4792300FFFFFF00BF752000BF752000C1762100C77C2616CA7F + 28A2E0A654E0F9D588FBFAD387FFF6C67AFFF4C074FFF3BC70FFF3BB6FFFF3BB + 6FFFF3BB6FFFF3BB6FFFF3BB6FFFF3BB6FFFF3BB6FFFF4C074FFF9D084FFCA7F + 28CCC97E2866C4792300FFFFFF00BF752000BF752000C176210FC47923A2E3AE + 5DE7FAD589FFF3C175FFF0B66AFFF0B66AFFEDB467FFE5AB5DFFDBA050FFD599 + 4AFFD19545FFCE9242FFCE9242FFD19545FFD5994AFFDBA050FFE7B062FFF4C7 + 7BFFC47923CCC3782366FFFFFF00BD721E00BD721E00BE741F73D79D4CE0F9D2 + 86FFF0B76BFFEFB367FFECAF5EFFE2A347FFD99A38FFD79835FFD79835FFD798 + 35FFD79835FFD79835FFD79835FFD79835FFD79835FFD79835FFD79835FFE6B3 + 58FFBE741FCCBF752066FFFFFF00B76C1A00B86D1A20BF7825C8F4CB7FFBF2BC + 70FFEEB162FFEAA942FFE5A128FFE4A025FFE4A025FFE4A025FFE4A025FFE4A0 + 25FFE4A025FFE4A025FFE4A025FFE4A025FFE4A025FFE4A025FFECB546FFB96E + 1BCCBA6F1C66BE741F00FFFFFF00B3681600B3681668D49849E3F6C87CFFEFB1 + 59FFF1AB22FFF1AA15FFF2AD1EFFF3B025FFF3B32AFFF3B42DFFF3B42DFFF3B3 + 2CFFF3B32AFFF2AD1EFFF1A913FFF1A913FFF1A913FFF5B834FFB36816CCB469 + 1766B96E1B00BE741F00FFFFFF00AD621200AD62129EE7B669F3F5BC5EFFFBB9 + 26FFF7B930FBE6A832F0D08E29E2C37F21DABA721AD4B36916D0AE6313CDAD62 + 12CCAD6212CCFCB719FFFBB005FFFBB005FFFCBB24FFAD6212CCAE631366B368 + 1600B96E1B00BE741F00FFFFFF00A85D0E00A85D0EBDF2C26DFBEFB339F5C884 + 21DEAD6411BDA85D0E8CA95E0F56A95E0F36A95E0F1EA95E0F0DA95E0F03AA5F + 1000A85D0ECCFFB810FFFFB200FFFFBB1BFFA85D0ECCA95E0F66AD621200B368 + 16005D370E0000000000FFFFFF00A3580A00A3580ACBD1912EE6A75D0DAFA459 + 0B4BA55A0C0BA65B0D00A85D0E00A95E0F00A95E0F00A95E0F00A95E0F00A358 + 0A00A3580ACCFFB70DFFFFBA17FFA3580ACCA4590B66A85D0E00573109000000 + 00000000000000000000FFFFFF00773F06009E5307CC9E53078F78400710522C + 050029170300000000000000000000000000000000000000000000000000773F + 06009E5307CCFFB913FF9E5307CC9F540866522C050000000000000000000000 + 00000000000000000000FFFFFF0000000009743C04A1381D02330000001A0000 + 001A0000001A0000001A0000001A0000001A0000001A00000019000000170000 + 00159A4F04CC9A4F04CC713A04700000000D0000000A00000008000000060000 + 00040000000300000001FFFFFF00000000110000002300000032000000330000 + 00330000003300000033000000330000003300000033000000310000002E0000 + 002A723A02A36C3702740000001E0000001900000014000000100000000C0000 + 00080000000500000002FFFFFF000000000900000012000000190000001A0000 + 001A0000001A0000001A0000001A0000001A0000001A00000019000000170000 + 001500000013000000110000000F0000000D0000000A00000008000000060000 + 00040000000300000001FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00 } end diff --git a/components/colorpalette/demo/ToolbarDemo/unit1.pas b/components/colorpalette/demo/ToolbarDemo/unit1.pas index eb4ef0ee9..f395e2736 100644 --- a/components/colorpalette/demo/ToolbarDemo/unit1.pas +++ b/components/colorpalette/demo/ToolbarDemo/unit1.pas @@ -16,22 +16,22 @@ type ColorPalette: TColorPalette; CoolBar: TCoolBar; ImageList: TImageList; - Label1: TLabel; - Label2: TLabel; - Label3: TLabel; - Panel1: TPanel; + LblStartColor: TLabel; + LblMouseColor: TLabel; + LblEndColor: TLabel; + IconInfoLabel: TLabel; + MainPanel: TPanel; Shape1: TShape; Shape2: TShape; Shape3: TShape; ToolBar: TToolBar; TbChangeOrientation: TToolButton; - TbSpacer: TToolButton; + procedure ColorPaletteColorMouseMove(Sender: TObject; AColor: TColor; + Shift: TShiftState); procedure ColorPaletteColorPick(Sender: TObject; AColor: TColor; Shift: TShiftState); - procedure ColorPaletteMouseMove(Sender: TObject; Shift: TShiftState; X, - Y: Integer); procedure FormCreate(Sender: TObject); - procedure Panel1Paint(Sender: TObject); + procedure MainPanelPaint(Sender: TObject); procedure TbChangeOrientationClick(Sender: TObject); private { private declarations } @@ -50,65 +50,29 @@ implementation { TForm1 } -procedure TForm1.FormCreate(Sender: TObject); -begin - Toolbar.BorderSpacing.Left := 0; - Toolbar.AutoSize := true; - Coolbar.AutoSize := true; - - ColorPaletteColorPick(self, ColorPalette.Colors[0], [ssLeft]); - ColorPaletteColorPick(self, ColorPalette.Colors[ColorPalette.ColorCount-1], [ssRight]); - - // For Laz 1.4.2 where TPanel.OnPaint is not published: - Panel1.OnPaint := @Panel1Paint; -end; - -procedure TForm1.Panel1Paint(Sender: TObject); -begin - Panel1.Canvas.GradientFill(Panel1.ClientRect, - FStartColor, - FEndColor, - gdVertical - ); -end; - -procedure TForm1.TbChangeOrientationClick(Sender: TObject); +{ OnColorMouseMove is called when the mouse enters a different color button, + or when the ColorPalette is left. } +procedure TForm1.ColorPaletteColorMouseMove(Sender: TObject; AColor: TColor; + Shift: TShiftState); var - i: Integer; + clrName: String; begin - // Vertical orientation - CoolBar.AutoSize := false; - Toolbar.AutoSize := false; - if TbChangeOrientation.Down then - begin - CoolBar.Vertical := true; - CoolBar.Align := alLeft; - ToolBar.Align := alLeft; - ColorPalette.Flipped := not ColorPalette.Flipped; - ColorPalette.Top := 9999; - end - else - // Horizontal orientation - begin - CoolBar.Vertical := false; - CoolBar.Align := alTop; - ToolBar.Align := alTop; - ColorPalette.Flipped := not ColorPalette.Flipped; - ColorPalette.Left := 9999; + if ColorPalette.MouseColor = clNone then + Shape2.Brush.Style := bsClear + else begin + Shape2.Brush.Style := bsSolid; + Shape2.Brush.Color := ColorPalette.MouseColor; end; - Toolbar.AutoSize := true; - CoolBar.AutoSize := true; -end; - -procedure TForm1.ColorPaletteMouseMove(Sender: TObject; Shift: TShiftState; X, - Y: Integer); -begin - Shape2.Brush.Color := ColorPalette.MouseColor; - Label2.Caption := Format('Mouse color:'#13'%s', [ - ColorPalette.ColorNames[ColorPalette.MouseIndex] - ]); + if ColorPalette.MouseIndex = -1 then + clrName := 'clNone' + else + clrName := ColorPalette.ColorNames[ColorPalette.MouseIndex]; + LblMouseColor.Caption := 'Mouse color:'#13 + clrName; end; +{ OnColorPick is called whenever a color button is clicked. + A left-click defines the start color of the gradient of the main panel, + a right-click defines its end color. } procedure TForm1.ColorPaletteColorPick(Sender: TObject; AColor: TColor; Shift: TShiftState); begin @@ -122,8 +86,8 @@ begin Shape1.Brush.Style := bsSolid; Shape1.Brush.Color := FStartColor; end; - Label1.Caption := 'Gradient start color:'#13 + - ColorPalette.ColorNames[ColorPalette.MouseIndex] + + LblStartColor.Caption := 'Gradient start color:'#13 + + ColorPalette.ColorNames[ColorPalette.PickedIndex] + #13'(Left click)'; end; @@ -137,13 +101,81 @@ begin Shape3.Brush.Style := bsSolid; Shape3.Brush.Color := FEndColor; end; - Label3.Caption := 'Gradient end color:'#13 + - ColorPalette.ColorNames[ColorPalette.MouseIndex] + + LblEndColor.Caption := 'Gradient end color:'#13 + + ColorPalette.ColorNames[ColorPalette.PickedIndex] + #13'(Right click)'; + + IconInfoLabel.Font.Color := InvertColor(AColor); end; - Panel1.Invalidate; + AColor := RGBToColor( + (Red(FStartColor) + Red(FEndColor)) div 2, + (Green(FStartColor) + Green(FEndColor)) div 2, + (Blue(FStartColor) + Blue(FEndColor)) div 2 + ); + if Red(AColor) + Green(AColor) + Blue(AColor) < 3*128 then + AColor := clWhite else + AColor := clBlack; + + LblStartColor.Font.Color := AColor; + LblEndColor.Font.Color := AColor; + LblMouseColor.Font.Color := AColor; + + MainPanel.Invalidate; end; +procedure TForm1.FormCreate(Sender: TObject); +begin + Toolbar.BorderSpacing.Left := 0; + Toolbar.AutoSize := true; + Coolbar.AutoSize := true; + + // Paint the three color boxes + ColorPaletteColorPick(self, ColorPalette.Colors[0], [ssLeft]); + ColorPaletteColorPick(self, ColorPalette.Colors[ColorPalette.ColorCount-1], [ssRight]); + ColorPaletteColorMouseMove(self, ColorPalette.MouseColor, []); + + // For Laz 1.4.2 where TPanel.OnPaint is not published: + MainPanel.OnPaint := @MainPanelPaint; +end; + +{ Paints a color gradient onto the main panel of the form. The gradient is + defined by the FStartColor and FEndColor obtained by clicks into the + ColorPalette. } +procedure TForm1.MainPanelPaint(Sender: TObject); +begin + MainPanel.Canvas.GradientFill(MainPanel.ClientRect, + FStartColor, + FEndColor, + gdVertical + ); +end; + +{ Fires when the "Flip" button is clicked } +procedure TForm1.TbChangeOrientationClick(Sender: TObject); +var + i: Integer; +begin + // Vertical orientation + CoolBar.AutoSize := false; + if TbChangeOrientation.Down then + begin + CoolBar.Vertical := true; + CoolBar.Align := alLeft; + ColorPalette.Flipped := not ColorPalette.Flipped; + TbChangeOrientation.ImageIndex := 1; + end + else + // Horizontal orientation + begin + CoolBar.Vertical := false; + CoolBar.Align := alTop; + ColorPalette.Flipped := not ColorPalette.Flipped; + TbChangeOrientation.ImageIndex := 0; + end; + CoolBar.AutoSize := true; +end; + + end.