mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-18 02:59:17 +02:00
MG: scrollingwincontrol from Andrew
git-svn-id: trunk@3310 -
This commit is contained in:
parent
f5bb1e4998
commit
b12c94294c
@ -22,11 +22,9 @@
|
|||||||
|
|
||||||
ToDo:
|
ToDo:
|
||||||
- TCustomComboBox has a bug: it can not store objects
|
- TCustomComboBox has a bug: it can not store objects
|
||||||
- clipping (almost everywhere)
|
|
||||||
- TCustomComboBox don't know custom draw yet
|
- TCustomComboBox don't know custom draw yet
|
||||||
- combobox can't sort (exception)
|
- combobox can't sort (exception)
|
||||||
- backgroundcolor=clNone
|
- backgroundcolor=clNone
|
||||||
- DoubleClick on Property
|
|
||||||
|
|
||||||
- a lot more ... see XXX
|
- a lot more ... see XXX
|
||||||
}
|
}
|
||||||
|
@ -1531,65 +1531,6 @@ type
|
|||||||
property Items;
|
property Items;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TScrollBox = class(TWinControl)
|
|
||||||
private
|
|
||||||
FAutoScroll : Boolean;
|
|
||||||
Procedure SetAutoScroll(Value : Boolean);
|
|
||||||
Procedure DoAutoSize; Override;
|
|
||||||
public
|
|
||||||
constructor Create(AOwner: TComponent); override;
|
|
||||||
published
|
|
||||||
property Align;
|
|
||||||
property Anchors;
|
|
||||||
property AutoScroll : Boolean read FAutoScroll write SetAutoScroll;
|
|
||||||
property AutoSize;
|
|
||||||
//property BiDiMode;
|
|
||||||
//property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
|
|
||||||
property Constraints;
|
|
||||||
//property DockSite;
|
|
||||||
property DragCursor;
|
|
||||||
property DragKind;
|
|
||||||
property DragMode;
|
|
||||||
property Enabled;
|
|
||||||
property Color nodefault;
|
|
||||||
property Ctl3D;
|
|
||||||
property Font;
|
|
||||||
//property ParentBiDiMode;
|
|
||||||
property ParentColor;
|
|
||||||
property ParentCtl3D;
|
|
||||||
property ParentFont;
|
|
||||||
property ParentShowHint;
|
|
||||||
property PopupMenu;
|
|
||||||
property ShowHint;
|
|
||||||
property TabOrder;
|
|
||||||
property TabStop;
|
|
||||||
property Visible;
|
|
||||||
//property OnCanResize;
|
|
||||||
property OnClick;
|
|
||||||
property OnConstrainedResize;
|
|
||||||
property OnDblClick;
|
|
||||||
//property OnDockDrop;
|
|
||||||
//property OnDockOver;
|
|
||||||
property OnDragDrop;
|
|
||||||
property OnDragOver;
|
|
||||||
//property OnEndDock;
|
|
||||||
property OnEndDrag;
|
|
||||||
property OnEnter;
|
|
||||||
property OnExit;
|
|
||||||
//property OnGetSiteInfo;
|
|
||||||
property OnMouseDown;
|
|
||||||
property OnMouseMove;
|
|
||||||
property OnMouseUp;
|
|
||||||
property OnMouseWheel;
|
|
||||||
property OnMouseWheelDown;
|
|
||||||
property OnMouseWheelUp;
|
|
||||||
property OnResize;
|
|
||||||
//property OnStartDock;
|
|
||||||
property OnStartDrag;
|
|
||||||
//property OnUnDock;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
function InitCommonControl(CC: Integer): Boolean;
|
function InitCommonControl(CC: Integer): Boolean;
|
||||||
procedure CheckCommonControl(CC: Integer);
|
procedure CheckCommonControl(CC: Integer);
|
||||||
|
|
||||||
@ -1647,14 +1588,15 @@ end;
|
|||||||
{$I toolbar.inc}
|
{$I toolbar.inc}
|
||||||
{$I trackbar.inc}
|
{$I trackbar.inc}
|
||||||
{$I treeview.inc}
|
{$I treeview.inc}
|
||||||
{$I scrollbox.inc}
|
|
||||||
|
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
{ =============================================================================
|
{ =============================================================================
|
||||||
|
|
||||||
$Log$
|
$Log$
|
||||||
|
Revision 1.42 2002/09/10 06:49:18 lazarus
|
||||||
|
MG: scrollingwincontrol from Andrew
|
||||||
|
|
||||||
Revision 1.41 2002/09/09 19:04:01 lazarus
|
Revision 1.41 2002/09/09 19:04:01 lazarus
|
||||||
MG: started TTreeView dragging
|
MG: started TTreeView dragging
|
||||||
|
|
||||||
|
139
lcl/forms.pp
139
lcl/forms.pp
@ -51,14 +51,142 @@ type
|
|||||||
TScrollBarInc = 1..32768;
|
TScrollBarInc = 1..32768;
|
||||||
TScrollBarStyle = (ssRegular, ssFlat, ssHotTrack);
|
TScrollBarStyle = (ssRegular, ssFlat, ssHotTrack);
|
||||||
|
|
||||||
|
TScrollingWinControl = class;
|
||||||
|
|
||||||
TControlScrollBar = class(TPersistent)
|
TControlScrollBar = class(TPersistent)
|
||||||
|
private
|
||||||
|
FControl: TScrollingWinControl;
|
||||||
|
|
||||||
|
FAutoRange : Longint;
|
||||||
|
|
||||||
|
FKind: TScrollBarKind;
|
||||||
|
|
||||||
|
FIncrement: TScrollBarInc;
|
||||||
|
FPosition: Integer;
|
||||||
|
FRange: Integer;
|
||||||
|
FVisible: Boolean;
|
||||||
|
|
||||||
|
procedure SetPosition(Value: Integer);
|
||||||
|
procedure SetRange(Value: Integer);
|
||||||
|
procedure SetVisible(Value: Boolean);
|
||||||
|
protected
|
||||||
|
procedure AutoCalcRange;
|
||||||
|
Procedure UpdateScrollBar;
|
||||||
|
public
|
||||||
|
constructor Create(AControl: TScrollingWinControl; AKind: TScrollBarKind);
|
||||||
|
|
||||||
|
procedure Assign(Source: TPersistent); override;
|
||||||
|
|
||||||
|
function IsScrollBarVisible: Boolean;
|
||||||
|
|
||||||
|
function ScrollPos: Integer;
|
||||||
|
|
||||||
|
property Kind: TScrollBarKind read FKind;
|
||||||
|
published
|
||||||
|
property Increment: TScrollBarInc read FIncrement write FIncrement default 8;
|
||||||
|
property Position: Integer read FPosition write SetPosition default 0;
|
||||||
|
property Range: Integer read FRange write SetRange default 0;
|
||||||
|
property Visible: Boolean read FVisible write SetVisible default True;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TScrollingWinControl = class(TWinControl)
|
TScrollingWinControl = class(TWinControl)
|
||||||
private
|
private
|
||||||
//FHorzScrollBar : TControlScrollBar;
|
FHorzScrollBar : TControlScrollBar;
|
||||||
//FVertScrollBar : TControlScrollBar;
|
FVertScrollBar : TControlScrollBar;
|
||||||
//FAutoScroll : Boolean;
|
FAutoScroll : Boolean;
|
||||||
|
|
||||||
|
FOnPaint: TNotifyEvent;
|
||||||
|
|
||||||
|
FCanvas : TControlCanvas;
|
||||||
|
|
||||||
|
IsUpdating : Boolean;
|
||||||
|
|
||||||
|
procedure SetAutoScroll(Value: Boolean);
|
||||||
|
procedure SetHorzScrollBar(Value: TControlScrollBar);
|
||||||
|
procedure SetVertScrollBar(Value: TControlScrollBar);
|
||||||
|
Function StoreScrollBars : Boolean;
|
||||||
|
Protected
|
||||||
|
procedure AlignControls(AControl: TControl; var ARect: TRect); override;
|
||||||
|
procedure CreateWnd; override;
|
||||||
|
property AutoScroll: Boolean read FAutoScroll write SetAutoScroll default True;
|
||||||
|
Procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
|
||||||
|
procedure WMPaint(var message: TLMPaint); message LM_PAINT;
|
||||||
|
procedure WMSize(var Message: TLMSize); message LM_Size;
|
||||||
|
Procedure WMHScroll(var Message : TLMHScroll); message LM_HScroll;
|
||||||
|
Procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
|
||||||
|
procedure ScrollBy(DeltaX, DeltaY: Integer);
|
||||||
|
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
|
||||||
|
Public
|
||||||
|
Constructor Create(AOwner : TComponent); Override;
|
||||||
|
Destructor Destroy; Override;
|
||||||
|
|
||||||
|
procedure Paint; dynamic;
|
||||||
|
procedure PaintWindow(dc : Hdc); override;
|
||||||
|
|
||||||
|
Procedure UpdateScrollbars;
|
||||||
|
|
||||||
|
property Canvas: TControlCanvas read FCanvas;
|
||||||
|
published
|
||||||
|
property HorzScrollBar: TControlScrollBar read FHorzScrollBar write SetHorzScrollBar stored StoreScrollBars;
|
||||||
|
property VertScrollBar: TControlScrollBar read FVertScrollBar write SetVertScrollBar stored StoreScrollBars;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TScrollBox = class(TScrollingWinControl)
|
||||||
|
private
|
||||||
|
Procedure DoAutoSize; Override;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
published
|
||||||
|
property Align;
|
||||||
|
property Anchors;
|
||||||
|
property AutoScroll default True;
|
||||||
|
property AutoSize;
|
||||||
|
//property BiDiMode;
|
||||||
|
//property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
|
||||||
|
property Constraints;
|
||||||
|
//property DockSite;
|
||||||
|
property DragCursor;
|
||||||
|
property DragKind;
|
||||||
|
|
||||||
|
property DragMode;
|
||||||
|
property Enabled;
|
||||||
|
property Color nodefault;
|
||||||
|
property Ctl3D;
|
||||||
|
property Font;
|
||||||
|
//property ParentBiDiMode;
|
||||||
|
property ParentColor;
|
||||||
|
property ParentCtl3D;
|
||||||
|
property ParentFont;
|
||||||
|
property ParentShowHint;
|
||||||
|
property PopupMenu;
|
||||||
|
property ShowHint;
|
||||||
|
property TabOrder;
|
||||||
|
property TabStop;
|
||||||
|
property Visible;
|
||||||
|
//property OnCanResize;
|
||||||
|
property OnClick;
|
||||||
|
property OnConstrainedResize;
|
||||||
|
property OnDblClick;
|
||||||
|
//property OnDockDrop;
|
||||||
|
//property OnDockOver;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDragOver;
|
||||||
|
//property OnEndDock;
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnEnter;
|
||||||
|
property OnExit;
|
||||||
|
//property OnGetSiteInfo;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnMouseWheel;
|
||||||
|
property OnMouseWheelDown;
|
||||||
|
property OnMouseWheelUp;
|
||||||
|
property OnResize;
|
||||||
|
//property OnStartDock;
|
||||||
|
property OnStartDrag;
|
||||||
|
//property OnUnDock;
|
||||||
|
property OnPaint;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TIDesigner = class;
|
TIDesigner = class;
|
||||||
@ -366,7 +494,7 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Buttons, StdCtrls, Interfaces, LResources, dialogs,ExtCtrls {,designer};
|
Buttons, StdCtrls, Interfaces, LResources, dialogs,ExtCtrls {,designer}, Math;
|
||||||
|
|
||||||
const
|
const
|
||||||
FocusMessages : Boolean = true;
|
FocusMessages : Boolean = true;
|
||||||
@ -550,7 +678,8 @@ end;
|
|||||||
//==============================================================================
|
//==============================================================================
|
||||||
|
|
||||||
|
|
||||||
|
{$I scrollingwincontrol.inc}
|
||||||
|
{$I scrollbox.inc}
|
||||||
{$I form.inc}
|
{$I form.inc}
|
||||||
{$I customform.inc}
|
{$I customform.inc}
|
||||||
{$I screen.inc}
|
{$I screen.inc}
|
||||||
|
@ -154,7 +154,8 @@ end;
|
|||||||
|
|
||||||
Procedure TBitmap.LoadFromFile(Const Filename : String);
|
Procedure TBitmap.LoadFromFile(Const Filename : String);
|
||||||
begin
|
begin
|
||||||
LoadFromXPMFile(FileName);
|
Inherited;
|
||||||
|
//LoadFromXPMFile(FileName);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Procedure TBitmap.NewImage(NHandle: HBITMAP; NPallette: HPALETTE;
|
Procedure TBitmap.NewImage(NHandle: HBITMAP; NPallette: HPALETTE;
|
||||||
@ -169,20 +170,6 @@ end;
|
|||||||
|
|
||||||
procedure TBitmap.ReadStream(Stream: TStream; Size: Longint);
|
procedure TBitmap.ReadStream(Stream: TStream; Size: Longint);
|
||||||
type
|
type
|
||||||
RGBQUAD = packed record
|
|
||||||
rgbBlue : BYTE;
|
|
||||||
rgbGreen : BYTE;
|
|
||||||
rgbRed : BYTE;
|
|
||||||
// rgbReserved : BYTE;
|
|
||||||
end;
|
|
||||||
|
|
||||||
BITMAPINFO = packed record
|
|
||||||
bmiHeader : BITMAPINFOHEADER;
|
|
||||||
bmiColors : array[0..0] of RGBQUAD;
|
|
||||||
end;
|
|
||||||
|
|
||||||
PBITMAPINFO = ^BITMAPINFO;
|
|
||||||
|
|
||||||
TBitsObj = array[1..1] of byte;
|
TBitsObj = array[1..1] of byte;
|
||||||
PBitsObj = ^TBitsObj;
|
PBitsObj = ^TBitsObj;
|
||||||
|
|
||||||
@ -243,8 +230,9 @@ begin
|
|||||||
if ReadSize<>ImgSize then
|
if ReadSize<>ImgSize then
|
||||||
raise EInOutError.Create('Invalid windows bitmap (bits)');
|
raise EInOutError.Create('Invalid windows bitmap (bits)');
|
||||||
|
|
||||||
Handle := CreateBitmap(Width, Height,
|
Handle := CreateBitmap(BmpInfo^.bmiHeader.biWidth,
|
||||||
BmpInfo^.bmiHeader.biPlanes, BitsPerPixel, Bits);
|
BmpInfo^.bmiHeader.biHeight, BmpInfo^.bmiHeader.biPlanes,
|
||||||
|
BitsPerPixel, Bits);
|
||||||
|
|
||||||
finally
|
finally
|
||||||
FreeMem(Bits);
|
FreeMem(Bits);
|
||||||
@ -256,14 +244,115 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TBitmap.WriteStream(Stream: TStream; WriteSize: Boolean);
|
procedure TBitmap.WriteStream(Stream: TStream; WriteSize: Boolean);
|
||||||
var Size: longint;
|
Type
|
||||||
begin
|
TBITMAPHEADER = packed record
|
||||||
// ToDo
|
FileHeader : tagBitmapFileHeader;
|
||||||
// this is only a workaround till we can save bitmaps
|
InfoHeader : tagBitmapInfoHeader;
|
||||||
if WriteSize then begin
|
|
||||||
Size:=0;
|
|
||||||
Stream.Write(Size, SizeOf(Size));
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Procedure FillBitmapInfo(Bitmap : hBitmap; var Bits : Pointer;
|
||||||
|
Var Header : TBitmapHeader);
|
||||||
|
var
|
||||||
|
ScreenDC, DC : hDC;
|
||||||
|
DIB : TDIBSection;
|
||||||
|
BitmapHeader : TagBITMAPINFO;
|
||||||
|
begin
|
||||||
|
FillChar(DIB, SizeOf(DIB), 0);
|
||||||
|
GetObject(Bitmap, SizeOf(DIB), @DIB);
|
||||||
|
with DIB.dsbm, DIB.dsbmih do
|
||||||
|
begin
|
||||||
|
biSize := sizeof(DIB.dsbmih);
|
||||||
|
biWidth := bmWidth;
|
||||||
|
biHeight := bmHeight;
|
||||||
|
biPlanes := 1;
|
||||||
|
biBitCount := bmPlanes * bmBitsPixel;
|
||||||
|
if biSizeImage = 0 then begin
|
||||||
|
biSizeImage := ((bmWidth * biBitCount) + 31) and not 31;
|
||||||
|
biSizeImage := biSizeImage div 8;
|
||||||
|
biSizeImage := biSizeImage * Abs(bmHeight);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Bits := AllocMem(Longint(Dib.dsBmih.biSizeImage)*SizeOf(Byte));
|
||||||
|
BitmapHeader.bmiHeader := DIB.dsbmih;
|
||||||
|
ScreenDC := GetDC(0);
|
||||||
|
DC := CreateCompatibleDC(ScreenDC);
|
||||||
|
GetDIBits(DC, Bitmap, 0, Abs(Dib.dsBmih.biHeight), Bits, BitmapHeader, DIB_RGB_COLORS);
|
||||||
|
ReleaseDC(0, ScreenDC);
|
||||||
|
DeleteDC(DC);
|
||||||
|
With Header, Header.FileHeader, Header.InfoHeader do begin
|
||||||
|
InfoHeader := BitmapHeader.bmiHeader;
|
||||||
|
FillChar(FileHeader, sizeof(FileHeader), 0);
|
||||||
|
bfType := $4D42;
|
||||||
|
bfSize := SizeOf(Header) + biSizeImage;
|
||||||
|
bfOffBits := SizeOf(Header);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure DoWriteSize(Header : TBitmapHeader);
|
||||||
|
var
|
||||||
|
Size : Longint;
|
||||||
|
begin
|
||||||
|
Size := Header.FileHeader.bfSize;
|
||||||
|
if WriteSize then
|
||||||
|
Stream.WriteBuffer(Size, SizeOf(Size));
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure WriteBitmapHeader(Header : TBitmapHeader);
|
||||||
|
begin
|
||||||
|
Stream.WriteBuffer(Header, SizeOf(Header));
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure WriteTRIColorMap(Color : PLongint; size : Longint); //For OS/2 Bitmaps
|
||||||
|
var
|
||||||
|
I : Longint;
|
||||||
|
TRI : RGBTRIPLE;
|
||||||
|
begin
|
||||||
|
size := size div 3;
|
||||||
|
for i := 0 to size - 1 do
|
||||||
|
begin
|
||||||
|
Tri.rgbtBlue := Blue(Color[i]);
|
||||||
|
Tri.rgbtGreen := Green(Color[i]);
|
||||||
|
Tri.rgbtRed := Red(Color[i]);
|
||||||
|
Stream.WriteBuffer(Tri, 3);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure WriteQUADColorMap(Color : PLongint; size : Longint); //For MS Bitmaps
|
||||||
|
var
|
||||||
|
I : Longint;
|
||||||
|
Quad : RGBQUAD;
|
||||||
|
begin
|
||||||
|
size := size div 4;
|
||||||
|
for i := 0 to size - 1 do
|
||||||
|
begin
|
||||||
|
FillChar(QUAD, SizeOf(RGBQUAD),0);
|
||||||
|
Quad.rgbBlue := Blue(Color[i]);
|
||||||
|
Quad.rgbGreen := Green(Color[i]);
|
||||||
|
Quad.rgbRed := Red(Color[i]);
|
||||||
|
Stream.WriteBuffer(Quad, 4);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure WriteColorMap(Header : TBitmapHeader);
|
||||||
|
begin
|
||||||
|
///Figure out how to get colors then call Quad/Tri
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure WritePixels(Bits : PByte; Header : TBitmapHeader);
|
||||||
|
begin
|
||||||
|
Stream.WriteBuffer(Bits^, Header.InfoHeader.biSizeImage);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Bits : PByte;
|
||||||
|
Header : TBitmapHeader;
|
||||||
|
begin
|
||||||
|
FillBitmapInfo(Handle, Bits, Header);
|
||||||
|
DoWriteSize(Header);
|
||||||
|
WriteBitmapHeader(Header);
|
||||||
|
WriteColorMap(Header);
|
||||||
|
WritePixels(Bits, Header);
|
||||||
|
ReallocMem(Bits, 0);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TBitMap.SaveToStream(Stream: TStream);
|
procedure TBitMap.SaveToStream(Stream: TStream);
|
||||||
@ -371,6 +460,9 @@ end;
|
|||||||
{ =============================================================================
|
{ =============================================================================
|
||||||
|
|
||||||
$Log$
|
$Log$
|
||||||
|
Revision 1.17 2002/09/10 06:49:19 lazarus
|
||||||
|
MG: scrollingwincontrol from Andrew
|
||||||
|
|
||||||
Revision 1.16 2002/09/03 08:07:19 lazarus
|
Revision 1.16 2002/09/03 08:07:19 lazarus
|
||||||
MG: image support, TScrollBox, and many other things from Andrew
|
MG: image support, TScrollBox, and many other things from Andrew
|
||||||
|
|
||||||
|
@ -1,6 +1,17 @@
|
|||||||
Procedure TScrollBox.SetAutoScroll(Value : Boolean);
|
{
|
||||||
begin
|
*****************************************************************************
|
||||||
end;
|
* *
|
||||||
|
* This file is part of the Lazarus Component Library (LCL) *
|
||||||
|
* *
|
||||||
|
* See the file COPYING.LCL, included in this distribution, *
|
||||||
|
* for details about the copyright. *
|
||||||
|
* *
|
||||||
|
* This program is distributed in the hope that it will be useful, *
|
||||||
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||||
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||||||
|
* *
|
||||||
|
*****************************************************************************
|
||||||
|
}
|
||||||
|
|
||||||
Procedure TScrollBox.DoAutoSize;
|
Procedure TScrollBox.DoAutoSize;
|
||||||
begin
|
begin
|
||||||
|
@ -78,10 +78,20 @@ end;
|
|||||||
Procedure TStatusBar.DrawBevel(xLeft, PanelNum : Integer );
|
Procedure TStatusBar.DrawBevel(xLeft, PanelNum : Integer );
|
||||||
var
|
var
|
||||||
Colora,Colorb:TColor;
|
Colora,Colorb:TColor;
|
||||||
|
I, PL, PW : Longint;
|
||||||
Begin
|
Begin
|
||||||
|
if PanelNum = Panels.Count-1 then begin
|
||||||
|
PL := Left;
|
||||||
|
If Panels.Count > 1 then
|
||||||
|
For I := 0 to Panels.Count-2 do
|
||||||
|
PL := PL + Panels[I].Width;
|
||||||
|
PW := ClientWidth - PL;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
PW := Panels[PanelNum].Width;
|
||||||
|
|
||||||
Canvas.Brush.Color := Color;
|
Canvas.Brush.Color := Color;
|
||||||
Canvas.FillRect(Rect(XLeft,Top,XLeft+Panels[PanelNum].Width,Top+Height));
|
Canvas.FillRect(Rect(XLeft,Top,XLeft+PW,Top+Height));
|
||||||
|
|
||||||
if Panels[PanelNum].Bevel = pbRaised then
|
if Panels[PanelNum].Bevel = pbRaised then
|
||||||
begin
|
begin
|
||||||
@ -101,12 +111,11 @@ Begin
|
|||||||
Pen.Color:=Colora;
|
Pen.Color:=Colora;
|
||||||
MoveTo(XLeft,Top+Height-1);
|
MoveTo(XLeft,Top+Height-1);
|
||||||
LineTo(XLeft,Top);
|
LineTo(XLeft,Top);
|
||||||
LineTo(XLeft+Panels[PanelNum].Width-1,Top);
|
LineTo(XLeft+PW-1,Top);
|
||||||
Pen.Color:=Colorb;
|
Pen.Color:=Colorb;
|
||||||
LineTo(XLeft+Panels[PanelNum].Width-1,Top+Height-1);
|
LineTo(XLeft+PW-1,Top+Height-1);
|
||||||
LIneTo(XLeft,Top+Height-1);
|
LIneTo(XLeft,Top+Height-1);
|
||||||
End;
|
End;
|
||||||
|
|
||||||
End;
|
End;
|
||||||
|
|
||||||
|
|
||||||
@ -125,6 +134,7 @@ var
|
|||||||
I : Integer;
|
I : Integer;
|
||||||
Style : TTextStyle;
|
Style : TTextStyle;
|
||||||
R : TRect;
|
R : TRect;
|
||||||
|
PW : Longint;
|
||||||
Begin
|
Begin
|
||||||
inherited;
|
inherited;
|
||||||
Style := Canvas.TextStyle;
|
Style := Canvas.TextStyle;
|
||||||
@ -133,7 +143,7 @@ Begin
|
|||||||
Alignment := taLeftJustify;
|
Alignment := taLeftJustify;
|
||||||
WordBreak := False;
|
WordBreak := False;
|
||||||
SingleLine := True;
|
SingleLine := True;
|
||||||
Clipping := False;
|
Clipping := True;
|
||||||
ShowPrefix := False;
|
ShowPrefix := False;
|
||||||
Opaque := False;
|
Opaque := False;
|
||||||
end;
|
end;
|
||||||
@ -144,14 +154,15 @@ Begin
|
|||||||
For I := 0 to Panels.Count-1 do
|
For I := 0 to Panels.Count-1 do
|
||||||
Begin
|
Begin
|
||||||
if I = Panels.Count-1 then
|
if I = Panels.Count-1 then
|
||||||
// this sets the last panel to the width of the statusbar
|
PW := ClientWidth-R.Left
|
||||||
Panels[I].Width := ClientWidth-R.Left;
|
else
|
||||||
R.Right := R.Left + Panels[I].Width;
|
PW := Panels[I].Width;
|
||||||
|
R.Right := R.Left + PW;
|
||||||
DrawBevel(R.Left,I);
|
DrawBevel(R.Left,I);
|
||||||
InflateRect(R, -1, -1);
|
InflateRect(R, -2, -1);
|
||||||
Style.Alignment := Panels[I].Alignment;
|
Style.Alignment := Panels[I].Alignment;
|
||||||
Canvas.TextRect(R, 1, 0, Panels[i].Text, Style);
|
Canvas.TextRect(R, 0, 0, Panels[i].Text, Style);
|
||||||
InflateRect(R, 1, 1);
|
InflateRect(R, 2, 1);
|
||||||
//draw divider
|
//draw divider
|
||||||
if I < Panels.Count-1 then
|
if I < Panels.Count-1 then
|
||||||
DrawDivider(R.Right);
|
DrawDivider(R.Right);
|
||||||
|
@ -1077,6 +1077,21 @@ Begin
|
|||||||
Assert(False, Format('Trace:< [TWin32Object.GetDC] Got 0x%x', [Result]));
|
Assert(False, Format('Trace:< [TWin32Object.GetDC] Got 0x%x', [Result]));
|
||||||
End;
|
End;
|
||||||
|
|
||||||
|
function TWin32Object.GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer;
|
||||||
|
begin
|
||||||
|
Result := Windows.GetDIBits(DC, Bitmap, StartScan, NumScans, Bits, Windows.PBitmapInfo(@BitInfo)^, Usage)
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TWin32Object.GetBitmapBits(Bitmap: HBITMAP; Count: Longint; Bits: Pointer): Longint;
|
||||||
|
begin
|
||||||
|
Result := Windows.GetBitmapBits(Bitmap, Count, Bits);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TWin32Object.CreateDIBSection(DC: HDC; const p2: tagBitmapInfo; p3: UINT;
|
||||||
|
var p4: Pointer; p5: THandle; p6: DWORD): HBITMAP;
|
||||||
|
begin
|
||||||
|
Result := Windows.CreateDIBSection(DC, Windows.PBitmapInfo(@p2)^, p3, p4, p5, p6)
|
||||||
|
end;
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
Method: GetFocus
|
Method: GetFocus
|
||||||
Params: none
|
Params: none
|
||||||
@ -2290,6 +2305,9 @@ end;
|
|||||||
{ =============================================================================
|
{ =============================================================================
|
||||||
|
|
||||||
$Log$
|
$Log$
|
||||||
|
Revision 1.18 2002/09/10 06:49:24 lazarus
|
||||||
|
MG: scrollingwincontrol from Andrew
|
||||||
|
|
||||||
Revision 1.17 2002/08/30 12:32:25 lazarus
|
Revision 1.17 2002/08/30 12:32:25 lazarus
|
||||||
MG: MoveWindowOrgEx, Splitted FWinControls/FControls, TControl drawing, Better DesignerDrawing, ...
|
MG: MoveWindowOrgEx, Splitted FWinControls/FControls, TControl drawing, Better DesignerDrawing, ...
|
||||||
|
|
||||||
|
@ -46,6 +46,8 @@ Function CreateBrushIndirect(Const LogBrush: TLogBrush): HBRUSH; Override;
|
|||||||
Function CreateCaret(Handle: HWND; Bitmap: HBITMAP; Width, Height: Integer): Boolean; Override;
|
Function CreateCaret(Handle: HWND; Bitmap: HBITMAP; Width, Height: Integer): Boolean; Override;
|
||||||
Function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP; Override;
|
Function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP; Override;
|
||||||
Function CreateCompatibleDC(DC: HDC): HDC; Override;
|
Function CreateCompatibleDC(DC: HDC): HDC; Override;
|
||||||
|
function CreateDIBSection(DC: HDC; const p2: tagBitmapInfo; p3: UINT;
|
||||||
|
var p4: Pointer; p5: THandle; p6: DWORD): HBITMAP; Override;
|
||||||
Function CreateFontIndirect(Const LogFont: TLogFont): HFONT; Override;
|
Function CreateFontIndirect(Const LogFont: TLogFont): HFONT; Override;
|
||||||
Function CreatePenIndirect(Const LogPen: TLogPen): HPEN; Override;
|
Function CreatePenIndirect(Const LogPen: TLogPen): HPEN; Override;
|
||||||
{ Creates a bitmap from raw pixmap data }
|
{ Creates a bitmap from raw pixmap data }
|
||||||
@ -81,6 +83,8 @@ Function GetClientRect(Handle: HWND; Var Rect: TRect): Boolean; Override;
|
|||||||
Function GetClipBox(DC : hDC; lpRect : PRect) : Longint; Override;
|
Function GetClipBox(DC : hDC; lpRect : PRect) : Longint; Override;
|
||||||
Function GetClipRGN(DC : hDC; RGN : hRGN) : Longint; override;
|
Function GetClipRGN(DC : hDC; RGN : hRGN) : Longint; override;
|
||||||
Function GetDC(HWnd: HWND): HDC; Override;
|
Function GetDC(HWnd: HWND): HDC; Override;
|
||||||
|
function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer; Override;
|
||||||
|
function GetBitmapBits(Bitmap: HBITMAP; Count: Longint; Bits: Pointer): Longint; Override;
|
||||||
Function GetFocus: HWND; Override;
|
Function GetFocus: HWND; Override;
|
||||||
Function GetKeyState(NVirtKey: Integer): SmallInt; Override;
|
Function GetKeyState(NVirtKey: Integer): SmallInt; Override;
|
||||||
Function GetObject(GDIObj: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer; Override;
|
Function GetObject(GDIObj: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer; Override;
|
||||||
@ -172,6 +176,9 @@ Procedure DeleteCriticalSection(var CritSection: TCriticalSection); Override;
|
|||||||
{ =============================================================================
|
{ =============================================================================
|
||||||
|
|
||||||
$Log$
|
$Log$
|
||||||
|
Revision 1.14 2002/09/10 06:49:25 lazarus
|
||||||
|
MG: scrollingwincontrol from Andrew
|
||||||
|
|
||||||
Revision 1.13 2002/08/30 12:32:25 lazarus
|
Revision 1.13 2002/08/30 12:32:25 lazarus
|
||||||
MG: MoveWindowOrgEx, Splitted FWinControls/FControls, TControl drawing, Better DesignerDrawing, ...
|
MG: MoveWindowOrgEx, Splitted FWinControls/FControls, TControl drawing, Better DesignerDrawing, ...
|
||||||
|
|
||||||
|
@ -636,6 +636,12 @@ const
|
|||||||
HWND_TOPMOST = HWND(-1);
|
HWND_TOPMOST = HWND(-1);
|
||||||
HWND_NOTOPMOST = HWND(-2);
|
HWND_NOTOPMOST = HWND(-2);
|
||||||
|
|
||||||
|
const
|
||||||
|
{ DIB color table identifiers }
|
||||||
|
|
||||||
|
DIB_RGB_COLORS = 0; { color table in RGBs }
|
||||||
|
DIB_PAL_COLORS = 1; { color table in palette indices }
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
PNMHdr = ^TNMHdr;
|
PNMHdr = ^TNMHdr;
|
||||||
@ -742,6 +748,7 @@ type
|
|||||||
end;
|
end;
|
||||||
BITMAPINFOHEADER = tagBITMAPINFOHEADER;
|
BITMAPINFOHEADER = tagBITMAPINFOHEADER;
|
||||||
|
|
||||||
|
|
||||||
{ ********************************** }
|
{ ********************************** }
|
||||||
{ B I T M A P S T U F F }
|
{ B I T M A P S T U F F }
|
||||||
|
|
||||||
@ -769,6 +776,30 @@ type
|
|||||||
TDIBSection = tagDIBSECTION;
|
TDIBSection = tagDIBSECTION;
|
||||||
DIBSECTION = tagDIBSECTION;
|
DIBSECTION = tagDIBSECTION;
|
||||||
|
|
||||||
|
PRGBQUAD = ^tagRGBQUAD;
|
||||||
|
tagRGBQUAD = packed record
|
||||||
|
rgbBlue : BYTE;
|
||||||
|
rgbGreen : BYTE;
|
||||||
|
rgbRed : BYTE;
|
||||||
|
rgbReserved : BYTE;
|
||||||
|
end;
|
||||||
|
RGBQUAD = tagRGBQUAD;
|
||||||
|
|
||||||
|
PRGBTRIPLE = ^tagRGBTRIPLE;
|
||||||
|
tagRGBTRIPLE = packed record
|
||||||
|
rgbtBlue : BYTE;
|
||||||
|
rgbtGreen : BYTE;
|
||||||
|
rgbtRed : BYTE;
|
||||||
|
end;
|
||||||
|
RGBTRIPLE = tagRGBTRIPLE;
|
||||||
|
|
||||||
|
PBITMAPINFO = ^tagBITMAPINFO;
|
||||||
|
tagBITMAPINFO = packed record
|
||||||
|
bmiHeader : tagBITMAPINFOHEADER;
|
||||||
|
bmiColors : array[0..0] of tagRGBQUAD;
|
||||||
|
end;
|
||||||
|
BITMAPINFO = tagBITMAPINFO;
|
||||||
|
|
||||||
const
|
const
|
||||||
TRUETYPE_FONTTYPE = 4;
|
TRUETYPE_FONTTYPE = 4;
|
||||||
|
|
||||||
@ -1486,6 +1517,9 @@ end.
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
|
Revision 1.14 2002/09/10 06:49:18 lazarus
|
||||||
|
MG: scrollingwincontrol from Andrew
|
||||||
|
|
||||||
Revision 1.13 2002/09/03 08:07:19 lazarus
|
Revision 1.13 2002/09/03 08:07:19 lazarus
|
||||||
MG: image support, TScrollBox, and many other things from Andrew
|
MG: image support, TScrollBox, and many other things from Andrew
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user