pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

* Implemented transparent buttons under win32

Browse Source 
* Fixed advanced demo compilation in win32

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@196 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
2007-06-28 02:14:18 +00:00
parent aa2fdf9d34
commit f1d4319067
2 changed files with 38 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

55
components/virtualtreeview-unstable/VirtualTrees.pas
View File

@@ -112,6 +112,7 @@ uses
Windows, Windows,
DelphiCompat, DelphiCompat,
{$endif} {$endif}
lclext,
virtualpanningwindow, virtualpanningwindow,
vtlogger, LCLType, LResources, LCLIntf, LMessages, Types, vtlogger, LCLType, LResources, LCLIntf, LMessages, Types,
SysUtils, Classes, Graphics, Controls, Forms, ImgList, StdCtrls, Menus, Printers, SysUtils, Classes, Graphics, Controls, Forms, ImgList, StdCtrls, Menus, Printers,
@@ -13455,6 +13456,7 @@ procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean);
const const
LineBitsDotted: array [0..8] of Word = ($55, $AA, $55, $AA, $55, $AA, $55, $AA, $55); LineBitsDotted: array [0..8] of Word = ($55, $AA, $55, $AA, $55, $AA, $55, $AA, $55);
LineBitsSolid: array [0..7] of Word = (0, 0, 0, 0, 0, 0, 0, 0); LineBitsSolid: array [0..7] of Word = (0, 0, 0, 0, 0, 0, 0, 0);
ButtonSize = 9;
var var
PatternBitmap: HBITMAP; PatternBitmap: HBITMAP;
@@ -13470,19 +13472,25 @@ begin
begin begin
// box is always of odd size // box is always of odd size
//The TCanvas of VCL does not has width and height. It cause a conflict here //The TCanvas of VCL does not has width and height. It cause a conflict here
FMinusBM.Width := ButtonSize;
FMinusBM.Width := 9; FMinusBM.Height := ButtonSize;
FMinusBM.Height := 9; {
Transparent := True; Transparent := True;
TransparentColor := clFuchsia; TransparentColor := clFuchsia;
}
//todo: remove when transparency is fixed in gtk
{$ifdef Windows}
Brush.Color := clFuchsia; Brush.Color := clFuchsia;
FillRect(Rect(0, 0, FMinusBM.Width, FMinusBM.Height)); {$else}
Brush.Color := Self.Color;
{$endif}
FillRect(Rect(0, 0, ButtonSize, ButtonSize));
if FButtonStyle = bsTriangle then if FButtonStyle = bsTriangle then
begin begin
Brush.Color := clBlack; Brush.Color := clBlack;
Pen.Color := clBlack; Pen.Color := clBlack;
Polygon([Point(0, 2), Point(8, 2), Point(4, 6)]); Polygon([Point(0, 2), Point(8, 2), Point(4, 6)]);
MaskHandle := CreateBitmapMask(Handle, ButtonSize, ButtonSize, clFuchsia);
end end
else else
begin begin
@@ -13496,29 +13504,39 @@ begin
Brush.Color := clWindow; Brush.Color := clWindow;
end; end;
Pen.Color := FColors.TreeLineColor; Pen.Color := FColors.TreeLineColor;
Rectangle(0, 0, FMinusBM.Width, FMinusBM.Height); Rectangle(0, 0, ButtonSize, ButtonSize);
Pen.Color := Self.Font.Color; Pen.Color := Self.Font.Color;
MoveTo(2, FMinusBM.Width div 2); MoveTo(2, ButtonSize div 2);
LineTo(FMinusBM.Width - 2 , FMinusBM.Width div 2); LineTo(ButtonSize - 2 , ButtonSize div 2);
if FButtonFillMode = fmTransparent then
MaskHandle := CreateBitmapMask(Handle, ButtonSize, ButtonSize, clFuchsia);
end end
else else
FMinusBM.LoadFromLazarusResource('VT_XPBUTTONMINUS'); FMinusBM.LoadFromLazarusResource('VT_XPBUTTONMINUS');
end; end;
end; end;
Logger.SendBitmap([lcPaintBitmap],'FMinusBM',FMinusBM);
with FPlusBM, Canvas do with FPlusBM, Canvas do
begin begin
FPlusBM.Width := 9; FPlusBM.Width := ButtonSize;
FPlusBM.Height := 9; FPlusBM.Height := ButtonSize;
{
Transparent := True; Transparent := True;
TransparentColor := clFuchsia; TransparentColor := clFuchsia;
}
//todo: remove when transparency is fixed in gtk
{$ifdef Windows}
Brush.Color := clFuchsia; Brush.Color := clFuchsia;
FillRect(Rect(0, 0, FPlusBM.Width, FPlusBM.Height)); {$else}
Brush.Color := Self.Color;
{$endif}
FillRect(Rect(0, 0, ButtonSize, ButtonSize));
if FButtonStyle = bsTriangle then if FButtonStyle = bsTriangle then
begin begin
Brush.Color := clBlack; Brush.Color := clBlack;
Pen.Color := clBlack; Pen.Color := clBlack;
Polygon([Point(2, 0), Point(6, 4), Point(2, 8)]); Polygon([Point(2, 0), Point(6, 4), Point(2, 8)]);
MaskHandle := CreateBitmapMask(Handle, ButtonSize, ButtonSize, clFuchsia);
end end
else else
begin begin
@@ -13531,14 +13549,15 @@ begin
fmWindowColor: fmWindowColor:
Brush.Color := clWindow; Brush.Color := clWindow;
end; end;
Pen.Color := FColors.TreeLineColor; Pen.Color := FColors.TreeLineColor;
Rectangle(0, 0, FPlusBM.Width, FPlusBM.Height); Rectangle(0, 0, ButtonSize, ButtonSize);
Pen.Color := Self.Font.Color; Pen.Color := Self.Font.Color;
MoveTo(2, FPlusBM.Width div 2); MoveTo(2, ButtonSize div 2);
LineTo(FPlusBM.Width - 2 , FPlusBM.Width div 2); LineTo(ButtonSize - 2 , ButtonSize div 2);
MoveTo(FPlusBM.Width div 2, 2); MoveTo(ButtonSize div 2, 2);
LineTo(FPlusBM.Width div 2, FPlusBM.Width - 2); LineTo(ButtonSize div 2, ButtonSize - 2);
if FButtonFillMode = fmTransparent then
MaskHandle := CreateBitmapMask(Handle, ButtonSize, ButtonSize, clFuchsia);
end end
else else
FPlusBM.LoadFromLazarusResource('VT_XPBUTTONPLUS'); FPlusBM.LoadFromLazarusResource('VT_XPBUTTONPLUS');

1
components/virtualtreeview-unstable/demos/advanced/PropertiesDemo.pas
View File

@@ -11,6 +11,7 @@ unit PropertiesDemo;
interface interface
uses uses
{$ifdef Windows} Messages, {$endif}
LCLIntf, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, LCLIntf, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, VirtualTrees, ExtCtrls, LResources; StdCtrls, VirtualTrees, ExtCtrls, LResources;