mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-08 04:58:11 +02:00
MG: image support, TScrollBox, and many other things from Andrew
git-svn-id: trunk@3276 -
This commit is contained in:
lazarus
parent
7de1f22503
commit
539b2d26ca
@ -176,6 +176,7 @@ begin
|
||||
with CaseSensitiveCheckBox do begin
|
||||
Name:='CaseSensitiveCheckBox';
|
||||
Parent:=OptionsGroupBox;
|
||||
AutoSize := True;
|
||||
Left:=8;
|
||||
Top:=6;
|
||||
Width:=135;
|
||||
@ -188,6 +189,7 @@ begin
|
||||
with WholeWordsOnlyCheckBox do begin
|
||||
Name:='WholeWordsOnlyCheckBox';
|
||||
Parent:=OptionsGroupBox;
|
||||
AutoSize := False;
|
||||
Left:=8;
|
||||
Top:=26;
|
||||
Width:=135;
|
||||
@ -200,6 +202,7 @@ begin
|
||||
with RegularExpressionsCheckBox do begin
|
||||
Name:='RegularExpressionsCheckBox';
|
||||
Parent:=OptionsGroupBox;
|
||||
AutoSize := False;
|
||||
Left:=8;
|
||||
Top:=46;
|
||||
Width:=135;
|
||||
@ -212,6 +215,7 @@ begin
|
||||
with PromptOnReplaceCheckBox do begin
|
||||
Name:='PromptOnReplaceCheckBox';
|
||||
Parent:=OptionsGroupBox;
|
||||
AutoSize := False;
|
||||
Left:=8;
|
||||
Top:=66;
|
||||
Width:=135;
|
||||
|
||||
@ -1,8 +1,8 @@
|
||||
{
|
||||
/***************************************************************************
|
||||
idecomp.pp -
|
||||
-------------------
|
||||
TIDEComponent
|
||||
idecomp.pp
|
||||
----------
|
||||
TIDEComponent
|
||||
|
||||
|
||||
Initial Revision : Sun Mar 28 23:15:32 CST 1999
|
||||
@ -29,7 +29,7 @@
|
||||
* *
|
||||
***************************************************************************
|
||||
}
|
||||
unit idecomp;
|
||||
unit IDEComp;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
@ -40,15 +40,15 @@ interface
|
||||
|
||||
uses
|
||||
Classes, LclLinux, StdCtrls, Forms, Buttons, Menus, ComCtrls,Arrow,
|
||||
Spin, SysUtils, Controls, CompReg, Graphics, ExtCtrls, Dialogs,Calendar,ImgList
|
||||
|
||||
{$IFDEF DATABASE}
|
||||
,db
|
||||
{$ENDIF}
|
||||
{$IFDEF INTERBASE}
|
||||
,interbase
|
||||
{$ENDIF}
|
||||
;
|
||||
Spin, SysUtils, Controls, CompReg, Graphics, ExtCtrls, Dialogs, Calendar,
|
||||
ImgList
|
||||
{$IFDEF DATABASE}
|
||||
,db
|
||||
{$ENDIF}
|
||||
{$IFDEF INTERBASE}
|
||||
,interbase
|
||||
{$ENDIF}
|
||||
;
|
||||
|
||||
const
|
||||
ComponentPaletteBtnWidth = 25;
|
||||
@ -302,9 +302,6 @@ end;
|
||||
|
||||
{--------------------------------------------------}
|
||||
|
||||
|
||||
|
||||
|
||||
procedure RegisterStandardComponents(
|
||||
ARegisteredComponentList:TRegisteredComponentList);
|
||||
|
||||
@ -316,26 +313,26 @@ procedure RegisterStandardComponents(
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
RegisterComponentsProc:=@RegisterComponents;
|
||||
|
||||
RegisterComponents('Standard','Menus',[TMainMenu,TPopupMenu]);
|
||||
RegisterComponents('Standard','Buttons',[TButton]);
|
||||
RegisterComponents('Standard','StdCtrls',[TEdit,TLabel,TMemo,TCheckBox
|
||||
,TListBox,TRadioButton,TComboBox,TScrollBar,TGroupBox,TToggleBox]);
|
||||
RegisterComponents('Standard','StdCtrls',[TEdit,TLabel,TMemo,TCheckBox,
|
||||
TListBox,TRadioButton,TComboBox,TScrollBar,TGroupBox,TToggleBox]);
|
||||
RegisterComponents('Standard', 'ExtCtrls',[TPanel]);
|
||||
RegisterComponents('Additional','Buttons',[TBitBtn,TSpeedButton]);
|
||||
RegisterComponents('Additional','ExtCtrls',[TNoteBook,TPaintBox
|
||||
,TBevel,TRadioGroup,TImage]);
|
||||
RegisterComponents('Additional','ComCtrls',[TStatusBar,TListView,TTreeView
|
||||
,TProgressBar,TToolBar,TTrackbar]);
|
||||
RegisterComponents('Additional','ExtCtrls',[TNoteBook,TPaintBox,
|
||||
TBevel,TRadioGroup,TImage]);
|
||||
RegisterComponents('Additional','ComCtrls',[TStatusBar,TListView,TTreeView,
|
||||
TProgressBar,TToolBar,TTrackbar,TScrollBox]);
|
||||
RegisterComponents('Additional','ImgList',[TImageList]);
|
||||
|
||||
RegisterComponents('Misc','Calendar',[TCalendar]);
|
||||
RegisterComponents('Misc','Arrow',[TArrow]);
|
||||
|
||||
RegisterComponents('System','ExtCtrls',[TTimer]);
|
||||
RegisterComponents('Dialogs','Dialogs',[TOpenDialog,TSaveDialog
|
||||
,TColorDialog,TFontDialog]);
|
||||
RegisterComponents('Dialogs','Dialogs',[TOpenDialog,TSaveDialog,
|
||||
TColorDialog,TFontDialog]);
|
||||
|
||||
RegisterComponents('Samples','Spin',[TSpinEdit]);
|
||||
|
||||
@ -344,8 +341,10 @@ begin
|
||||
{$ENDIF}
|
||||
{$IFDEF INTERBASE}
|
||||
//Interbase
|
||||
RegisterComponents('Interbase Data Access','Interbase',[TIBStoredProc,TIBQuery,TIBDatabase]);
|
||||
RegisterComponents('Interbase Data Access','Interbase',[TIBStoredProc,
|
||||
TIBQuery,TIBDatabase]);
|
||||
{$ENDIF}
|
||||
|
||||
// unselectable components
|
||||
// components that are streamed but not selectable in the IDE
|
||||
RegisterComponents('','ExtCtrls',[TPage]);
|
||||
@ -353,13 +352,9 @@ begin
|
||||
RegisterComponents('','menus', [TMenuItem]);
|
||||
|
||||
RegisterComponentsProc:=nil;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
initialization
|
||||
|
||||
{$I images/components_images.lrs}
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -467,7 +467,6 @@ type
|
||||
TToolButton = class(TButtonControl)
|
||||
private
|
||||
FAllowAllUp: Boolean;
|
||||
FAutoSize: Boolean;
|
||||
FDown: Boolean;
|
||||
FGrouped: Boolean;
|
||||
FImageIndex: Integer;
|
||||
@ -483,7 +482,7 @@ type
|
||||
function IsCheckedStored: Boolean;
|
||||
function IsImageIndexStored: Boolean;
|
||||
function IsWidthStored: Boolean;
|
||||
procedure SetAutoSize(Value: Boolean);
|
||||
procedure SetAutoSize(const Value: Boolean); Override;
|
||||
procedure SetButtonState(State: Byte);
|
||||
procedure SetDown(Value: Boolean);
|
||||
procedure SetDropdownMenu(Value: TPopupMenu);
|
||||
@ -518,7 +517,7 @@ type
|
||||
property Index: Integer read GetIndex;
|
||||
published
|
||||
property AllowAllUp: Boolean read FAllowAllUp write FAllowAllUp default False;
|
||||
property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
|
||||
property AutoSize default False;
|
||||
property Caption;
|
||||
property Down: Boolean read FDown write SetDown stored IsCheckedStored default False;
|
||||
property DragCursor;
|
||||
@ -1492,6 +1491,63 @@ type
|
||||
property Items;
|
||||
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;
|
||||
@ -1551,6 +1607,7 @@ end;
|
||||
{$I toolbar.inc}
|
||||
{$I trackbar.inc}
|
||||
{$I treeview.inc}
|
||||
{$I scrollbox.inc}
|
||||
|
||||
|
||||
end.
|
||||
@ -1558,6 +1615,9 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.38 2002/09/03 08:07:17 lazarus
|
||||
MG: image support, TScrollBox, and many other things from Andrew
|
||||
|
||||
Revision 1.37 2002/08/17 15:45:31 lazarus
|
||||
MG: removed ClientRectBugfix defines
|
||||
|
||||
|
||||
@ -21,6 +21,7 @@ begin
|
||||
Inherited Create(AOwner);
|
||||
FCompStyle := csBitBtn;
|
||||
FGlyph := TButtonGlyph.Create;
|
||||
TButtonGlyph(FGlyph).OnChange := @GlyphChanged;
|
||||
{set default alignment}
|
||||
Align := alNone;
|
||||
FCanvas := TCanvas.Create;
|
||||
@ -68,6 +69,10 @@ Procedure TBitbtn.SetGlyph(Value : TBitmap);
|
||||
Begin
|
||||
Assert(False, 'Trace:SETGLYPH');
|
||||
TButtonGlyph(FGlyph).Glyph := Value;
|
||||
end;
|
||||
|
||||
procedure TBitBtn.GlyphChanged(Sender: TObject);
|
||||
begin
|
||||
if HandleAllocated then begin
|
||||
CNSendMessage(LM_IMAGECHANGED,Self,nil);
|
||||
Invalidate;
|
||||
|
||||
@ -23,7 +23,8 @@ end;
|
||||
|
||||
procedure TBitmap.Draw(ACanvas: TCanvas; const Rect: TRect);
|
||||
begin
|
||||
Assert(False, 'Trace:TODO: [TBitmap.Draw]');
|
||||
HandleNeeded;
|
||||
ACanvas.CopyRect(Rect, Self.Canvas, Classes.Rect(0, 0, Width, Height));
|
||||
end;
|
||||
|
||||
constructor TBitmap.Create;
|
||||
@ -50,6 +51,7 @@ end;
|
||||
|
||||
procedure TBitMap.FreeImage;
|
||||
begin
|
||||
Handle := 0;
|
||||
end;
|
||||
|
||||
function TBitmap.HandleAllocated: boolean;
|
||||
@ -74,7 +76,10 @@ begin
|
||||
end;
|
||||
|
||||
procedure TBitMap.HandleNeeded;
|
||||
var n : integer;
|
||||
var
|
||||
n : integer;
|
||||
UseWidth,
|
||||
UseHeight : Longint;
|
||||
begin
|
||||
// if FHandle = 0 then CNSendMessage(LM_CREATE, Self, nil);
|
||||
if FImage.FHandle = 0 then begin
|
||||
@ -89,9 +94,11 @@ begin
|
||||
pf32bit : n:= 32;
|
||||
else raise EInvalidOperation.Create('Unsupported bitmap format.');
|
||||
end;
|
||||
if Width<1 then Width:=1;
|
||||
if Height<1 then Height:=1;
|
||||
FImage.FHandle:= CreateBitmap(Width, Height, 1, n, nil);
|
||||
UseWidth := Width;
|
||||
UseHeight := Height;
|
||||
if UseWidth<1 then UseWidth:=1;
|
||||
if UseHeight<1 then UseHeight:=1;
|
||||
FImage.FHandle:= CreateBitmap(UseWidth, UseHeight, 1, n, nil);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -145,6 +152,10 @@ Begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TBitmap.LoadFromFile(Const Filename : String);
|
||||
begin
|
||||
LoadFromXPMFile(FileName);
|
||||
end;
|
||||
|
||||
Procedure TBitmap.NewImage(NHandle: HBITMAP; NPallette: HPALETTE;
|
||||
const NDIB : TDIBSection; OS2Format : Boolean);
|
||||
@ -158,31 +169,6 @@ end;
|
||||
|
||||
procedure TBitmap.ReadStream(Stream: TStream; Size: Longint);
|
||||
type
|
||||
BITMAP = packed record
|
||||
bmType : Longint;
|
||||
bmWidth : Longint;
|
||||
bmHeight : Longint;
|
||||
bmWidthBytes : Longint;
|
||||
bmPlanes : Word;
|
||||
bmBitsPixel : Word;
|
||||
bmBits : Pointer;
|
||||
end;
|
||||
PBITMAP = ^BITMAP;
|
||||
|
||||
BITMAPINFOHEADER = packed record
|
||||
biSize : DWORD;
|
||||
biWidth : Longint;
|
||||
biHeight : Longint;
|
||||
biPlanes : WORD;
|
||||
biBitCount : WORD;
|
||||
biCompression : DWORD;
|
||||
biSizeImage : DWORD;
|
||||
biXPelsPerMeter : Longint;
|
||||
biYPelsPerMeter : Longint;
|
||||
biClrUsed : DWORD;
|
||||
biClrImportant : DWORD;
|
||||
end;
|
||||
|
||||
RGBQUAD = packed record
|
||||
rgbBlue : BYTE;
|
||||
rgbGreen : BYTE;
|
||||
@ -211,7 +197,6 @@ var
|
||||
ImgSize:longint;
|
||||
Bits:PBitsObj;
|
||||
InfoSize: integer;
|
||||
//BmpWidth,BmpHeight:integer;
|
||||
BitsPerPixel,ColorsUsed:integer;
|
||||
begin
|
||||
FreeContext;
|
||||
@ -250,10 +235,7 @@ begin
|
||||
end;
|
||||
// Palette is fake now. Then it'll be better!
|
||||
// EInOutError.Create('Only truecolor is supported yet.');
|
||||
|
||||
//BmpHeight:=BmpInfo^.bmiHeader.biHeight;
|
||||
//BmpWidth:=BmpInfo^.bmiHeader.biWidth;
|
||||
|
||||
|
||||
ImgSize:=BmpInfo^.bmiHeader.biSizeImage;
|
||||
GetMem(Bits,ImgSize);
|
||||
try
|
||||
@ -261,7 +243,8 @@ begin
|
||||
if ReadSize<>ImgSize then
|
||||
raise EInOutError.Create('Invalid windows bitmap (bits)');
|
||||
|
||||
// ToDo: create a bitmap handle
|
||||
Handle := CreateBitmap(Width, Height,
|
||||
BmpInfo^.bmiHeader.biPlanes, BitsPerPixel, Bits);
|
||||
|
||||
finally
|
||||
FreeMem(Bits);
|
||||
@ -290,8 +273,7 @@ end;
|
||||
|
||||
procedure TBitmap.SetHandle(Value: HBITMAP);
|
||||
begin
|
||||
// TODO: get the properties from new bitmap (Width, Height)
|
||||
// When this is done, then check TPixmap.ReadStream
|
||||
// TODO: the properties from new bitmap
|
||||
with FImage do
|
||||
if FHandle <> Value then
|
||||
begin
|
||||
@ -300,6 +282,9 @@ begin
|
||||
FImage := TBitmapImage.Create;
|
||||
Reference;
|
||||
FHandle:=Value;
|
||||
FillChar(FDIB, sizeof(FDIB), 0);
|
||||
if Value <> 0 then
|
||||
GetObject(FHandle, SizeOf(FDIB), @FDIB);
|
||||
Changed(Self);
|
||||
end;
|
||||
end;
|
||||
@ -319,7 +304,8 @@ end;
|
||||
|
||||
Function TBitmap.ReleaseHandle : HBITMAP;
|
||||
Begin
|
||||
Result := GetHandle;
|
||||
If HandleAllocated then
|
||||
Result := GetHandle;
|
||||
FImage.FHandle := 0;
|
||||
end;
|
||||
|
||||
@ -331,12 +317,14 @@ end;
|
||||
|
||||
function TBitmap.GetHeight: Integer;
|
||||
begin
|
||||
Result := FHeight;
|
||||
with FImage do
|
||||
Result := FDIB.dsbm.bmHeight;
|
||||
end;
|
||||
|
||||
function TBitmap.GetWidth: Integer;
|
||||
begin
|
||||
Result := FWidth;
|
||||
with FImage do
|
||||
Result := FDIB.dsbm.bmWidth;
|
||||
end;
|
||||
|
||||
procedure TBitmap.ReadData(Stream: TStream);
|
||||
@ -354,20 +342,38 @@ end;
|
||||
|
||||
procedure TBitmap.SetWidth(Value: Integer);
|
||||
begin
|
||||
FWidth:=Value;
|
||||
// ToDo
|
||||
with FImage do
|
||||
if FDIB.dsbm.bmWidth <> Value then
|
||||
begin
|
||||
FDIB.dsbm.bmWidth := Value;
|
||||
If (Value > 0) and (Height > 0) then
|
||||
HandleNeeded
|
||||
else
|
||||
FreeImage;
|
||||
Changed(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBitmap.SetHeight(Value: Integer);
|
||||
begin
|
||||
FHeight:=Value;
|
||||
// ToDo
|
||||
with FImage do
|
||||
if FDIB.dsbm.bmHeight <> Value then
|
||||
begin
|
||||
FDIB.dsbm.bmHeight := Value;
|
||||
If (Value > 0) and (Width > 0) then
|
||||
HandleNeeded
|
||||
else
|
||||
FreeImage;
|
||||
Changed(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.16 2002/09/03 08:07:19 lazarus
|
||||
MG: image support, TScrollBox, and many other things from Andrew
|
||||
|
||||
Revision 1.15 2002/09/02 08:13:16 lazarus
|
||||
MG: fixed GraphicClass.Create
|
||||
|
||||
|
||||
@ -20,6 +20,7 @@ constructor TButtonGlyph.Create;
|
||||
begin
|
||||
// Inherited Create;
|
||||
FOriginal := TBitmap.Create;
|
||||
FOriginal.OnChange := @GlyphChanged;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------}
|
||||
@ -35,20 +36,28 @@ end;
|
||||
{ TButtonGlyph SetGlyph }
|
||||
{------------------------------------------------------------------------------}
|
||||
procedure TButtonGlyph.SetGlyph(Value : TBitmap);
|
||||
var GlyphCount : integer;
|
||||
var
|
||||
GlyphCount : integer;
|
||||
begin
|
||||
if FOriginal = Value then exit;
|
||||
// FOriginal.Assign(Value);
|
||||
FOriginal.Free;
|
||||
FOriginal:= Value;
|
||||
if (Value <> nil) and (Value.Height > 0) then begin
|
||||
if Value.Width mod Value.Height = 0 then begin
|
||||
GlyphCount:= Value.Width div Value.Height;
|
||||
FOriginal.OnChange := @GlyphChanged;
|
||||
if (FOriginal <> nil) and (FOriginal.Height > 0) then begin
|
||||
if FOriginal.Width mod FOriginal.Height = 0 then begin
|
||||
GlyphCount:= FOriginal.Width div FOriginal.Height;
|
||||
if GlyphCount > 4 then GlyphCount:= 1;
|
||||
NumGlyphs:= GlyphCount;
|
||||
FNumGlyphs:= GlyphCount;
|
||||
end;
|
||||
end;
|
||||
//Invalidate;
|
||||
GlyphChanged(FOriginal);
|
||||
end;
|
||||
|
||||
procedure TButtonGlyph.GlyphChanged(Sender: TObject);
|
||||
begin
|
||||
if Sender = FOriginal then
|
||||
if Assigned(FOnChange) then FOnChange(Self);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------}
|
||||
@ -100,6 +109,6 @@ procedure TButtonGlyph.SetNumGlyphs(Value : TNumGlyphs);
|
||||
begin
|
||||
if Value <> FNumGlyphs then begin
|
||||
FNumGlyphs := Value;
|
||||
if Assigned(FOnChange) then FOnChange(Glyph);
|
||||
GlyphChanged(FOriginal);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -35,25 +35,25 @@ end;
|
||||
procedure TCheckbox.SetText(const Value: TCaption);
|
||||
begin
|
||||
Inherited SetText(Value);
|
||||
AutoSize := FAutoSize;
|
||||
DoAutoSize;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCheckbox.SetAutoSize
|
||||
Method: TCheckbox.DoAutoSize
|
||||
Params: Value : Boolean
|
||||
Returns: nothing
|
||||
|
||||
Sets AutoSize Flag, and if True, attempts to Size to fit Caption
|
||||
Attempts to Size to fit Caption if AutoSize is True
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCheckbox.SetAutoSize(Value : Boolean);
|
||||
procedure TCheckbox.DoAutoSize;
|
||||
var
|
||||
R : TRect;
|
||||
DC : hDC;
|
||||
begin
|
||||
FAutoSize := Value;
|
||||
If not AutoSize then
|
||||
If AutoSizing or not AutoSize then
|
||||
Exit;
|
||||
if not HandleAllocated then exit;
|
||||
AutoSizing := True;
|
||||
DC := GetDC(Handle);
|
||||
Try
|
||||
R := Rect(0,0, Width, Height);
|
||||
@ -65,6 +65,7 @@ begin
|
||||
Height := R.Bottom + 2;
|
||||
Finally
|
||||
ReleaseDC(Handle, DC);
|
||||
AutoSizing := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -72,6 +73,9 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 2002/09/03 08:07:19 lazarus
|
||||
MG: image support, TScrollBox, and many other things from Andrew
|
||||
|
||||
Revision 1.5 2002/08/24 06:51:22 lazarus
|
||||
MG: from Andrew: style list fixes, autosize for radio/checkbtns
|
||||
|
||||
|
||||
@ -116,7 +116,7 @@ end;
|
||||
Procedure TCustomForm.Deactivate;
|
||||
Begin
|
||||
if Assigned(FOnDeactivate) then
|
||||
FOnDeactivate(Self);
|
||||
FOnDeactivate(Self);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -180,7 +180,7 @@ end;
|
||||
function TCustomForm.GetIconHandle: HICON;
|
||||
begin
|
||||
//writeln('[TCustomForm.GetIconHandle] ',ClassName,' ',FIcon<>nil);
|
||||
if FIcon<>nil then
|
||||
if (FIcon<>nil) and not Icon.Empty then
|
||||
Result := FIcon.Handle
|
||||
else
|
||||
Result := Application.GetIconHandle;
|
||||
@ -1025,6 +1025,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.54 2002/09/03 08:07:19 lazarus
|
||||
MG: image support, TScrollBox, and many other things from Andrew
|
||||
|
||||
Revision 1.53 2002/08/31 11:37:09 lazarus
|
||||
MG: fixed destroying combobox
|
||||
|
||||
|
||||
@ -112,6 +112,7 @@ begin
|
||||
while (FButtonList.Count<FItems.Count) do begin
|
||||
Temp := TRadioButton.Create (self);
|
||||
Temp.Name:='RadioButton'+IntToStr(FButtonList.Count);
|
||||
Temp.AutoSize := False;
|
||||
Temp.Parent := Self;
|
||||
Temp.OnClick := @Clicked;
|
||||
FButtonList.Add(Temp);
|
||||
@ -337,6 +338,9 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.14 2002/09/03 08:07:19 lazarus
|
||||
MG: image support, TScrollBox, and many other things from Andrew
|
||||
|
||||
Revision 1.13 2002/08/30 12:32:20 lazarus
|
||||
MG: MoveWindowOrgEx, Splitted FWinControls/FControls, TControl drawing, Better DesignerDrawing, ...
|
||||
|
||||
|
||||
@ -28,6 +28,7 @@ end;
|
||||
constructor TForm.Create(AOwner : TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
Icon := TIcon.Create;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -16,20 +16,119 @@
|
||||
|
||||
constructor TImage.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
fCompStyle := csImage;
|
||||
inherited Create(AOwner);
|
||||
FCompStyle := csImage;
|
||||
ControlStyle:= [csCaptureMouse, csDoubleClicks];
|
||||
FAutoSize := False;
|
||||
FCenter := False;
|
||||
FStretch := False;
|
||||
FTransparent := True;
|
||||
FPicture := TPicture.Create;
|
||||
FPicture.OnChange := @PictureChanged;
|
||||
Setbounds(0,0,100,100);
|
||||
end;
|
||||
|
||||
destructor TImage.Destroy;
|
||||
begin
|
||||
FPicture.OnChange := nil;
|
||||
FPicture.Graphic := nil;
|
||||
FPicture.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TImage.SetPicture(const AValue: TPicture);
|
||||
begin
|
||||
FPicture.Assign(AValue); //the onchange of the picture gets called and notifies that something changed.
|
||||
FPicture.Assign(AValue); //the onchange of the picture gets called and notifies that something changed.
|
||||
end;
|
||||
|
||||
procedure TImage.SetAutoSize(Value : Boolean);
|
||||
var
|
||||
ModifyWidth,
|
||||
ModifyHeight : Boolean;
|
||||
begin
|
||||
If Value then begin
|
||||
ModifyWidth := (Align = alleft) or (Align = alRight) or (Align = alNone);
|
||||
ModifyHeight := (Align = alTop) or (Align = alBottom) or (Align = alNone);
|
||||
If ModifyWidth and (Picture.Width > 0) then
|
||||
Width := Max(Picture.Width, CONSTRAINTS.MinWidth);
|
||||
If ModifyHeight and (Picture.Height > 0) then
|
||||
Height := Max(Picture.Height, CONSTRAINTS.MinHeight);
|
||||
PictureChanged(Self);
|
||||
end;
|
||||
FAutoSize := Value;
|
||||
end;
|
||||
|
||||
procedure TImage.SetStretch(Value : Boolean);
|
||||
begin
|
||||
FStretch := Value;
|
||||
PictureChanged(Self);
|
||||
end;
|
||||
|
||||
procedure TImage.SetTransparent(Value : Boolean);
|
||||
begin
|
||||
FTransparent := Value;
|
||||
PictureChanged(Self);
|
||||
end;
|
||||
|
||||
procedure TImage.SetCenter(Value : Boolean);
|
||||
begin
|
||||
FCenter := Value;
|
||||
PictureChanged(Self);
|
||||
end;
|
||||
|
||||
Procedure TImage.PictureChanged(Sender : TObject);
|
||||
begin
|
||||
CNSendMessage(LM_SETPROPERTIES,self,nil);
|
||||
If AutoSize then begin
|
||||
SetAutoSize(False);
|
||||
SetAutoSize(True);
|
||||
end;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
Procedure TImage.Paint;
|
||||
|
||||
Procedure DrawFrame;
|
||||
begin
|
||||
if csDesigning in ComponentState then begin
|
||||
With Canvas do begin
|
||||
Pen.Color := clBlack;
|
||||
Pen.Style := psDash;
|
||||
MoveTo(0, 0);
|
||||
LineTo(Width, 0);
|
||||
LineTo(Width, Height);
|
||||
LineTo(0, Height);
|
||||
LineTo(0, 0);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
RGN : longint;
|
||||
iRect : TRect;
|
||||
begin
|
||||
With Canvas do begin
|
||||
RGN := CreateRectRGN(0, 0, Width + 1, Height + 1);
|
||||
SelectClipRGN(Handle, RGN);
|
||||
DeleteObject(RGN);
|
||||
DrawFrame;
|
||||
If Picture.Graphic = nil then
|
||||
exit;
|
||||
If Stretch then
|
||||
iRect := Rect(0, 0, Width + 1, Height + 1)
|
||||
else
|
||||
iRect := Rect(0,0, Picture.Width, Picture.Height);
|
||||
If Center then
|
||||
OffsetRect(iRect,
|
||||
(Width + 1) div 2 - (iRect.Right - iRect.Left) div 2,
|
||||
(Height + 1) div 2 - (iRect.Bottom -iRect.Top) div 2);
|
||||
If Picture.Graphic.Transparent and not Transparent then
|
||||
begin
|
||||
If Picture.Graphic is TBitmap then
|
||||
Brush.Color := TBitmap(Picture.Graphic).TransparentColor
|
||||
else
|
||||
Brush.Color := clWhite;
|
||||
FillRect(iRect);
|
||||
end;
|
||||
StretchDraw(iRect, Picture.Graphic);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -45,6 +45,14 @@ begin
|
||||
Add('bmp', 'Bitmaps', TBitmap);
|
||||
Add('xpm', 'Pixmap', TPixmap);
|
||||
Add('ico', 'Icon', TIcon);
|
||||
{ ('.xpm',
|
||||
'.bmp',
|
||||
'.png',
|
||||
'.gif',
|
||||
'.jpg',
|
||||
'.jpeg',
|
||||
'.tiff');}
|
||||
|
||||
end;
|
||||
|
||||
procedure TPicFileFormatsList.Clear;
|
||||
@ -338,25 +346,27 @@ end;
|
||||
procedure TPicture.SetGraphic(Value: TGraphic);
|
||||
var
|
||||
NewGraphic: TGraphic;
|
||||
ok: boolean;
|
||||
//ok: boolean;
|
||||
begin
|
||||
NewGraphic := nil;
|
||||
if Value <> nil then begin
|
||||
NewGraphic := TGraphicClass(Value.ClassType).Create;
|
||||
NewGraphic.Assign(Value);
|
||||
//NewGraphic := TGraphicClass(Value.ClassType).Create;
|
||||
//NewGraphic.Assign(Value);
|
||||
NewGraphic := Value;//Assign Doesn't Work yet
|
||||
NewGraphic.OnChange := @Changed;
|
||||
NewGraphic.OnProgress := @Progress;
|
||||
end;
|
||||
ok:=false;
|
||||
//ok:=false;
|
||||
try
|
||||
FGraphic.Free;
|
||||
FGraphic := NewGraphic;
|
||||
Changed(Self);
|
||||
ok:=true;
|
||||
//ok:=true;
|
||||
finally
|
||||
// this try..finally construction will in case of an exception
|
||||
// not alter the error backtrace output
|
||||
if not ok then NewGraphic.Free;
|
||||
|
||||
//if not ok then NewGraphic.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -376,28 +386,23 @@ begin
|
||||
if GraphicClass = nil then
|
||||
raise EInvalidGraphic.CreateFmt('Unknown picture extension', [Ext]);
|
||||
|
||||
writeln('TPicture.LoadFromFile A ',GraphicClass.ClassName);
|
||||
NewGraphic := GraphicClass.Create;
|
||||
writeln('TPicture.LoadFromFile B ',NewGraphic.ClassName);
|
||||
NewGraphic := GraphicClass.Create;
|
||||
|
||||
ok:=false;
|
||||
try
|
||||
NewGraphic.OnProgress := @Progress;
|
||||
writeln('TPicture.LoadFromFile C ');
|
||||
NewGraphic.LoadFromFile(Filename);
|
||||
writeln('TPicture.LoadFromFile D ');
|
||||
ok:=true;
|
||||
finally
|
||||
// this try..finally construction will in case of an exception
|
||||
// not alter the error backtrace output
|
||||
if not ok then NewGraphic.Free;
|
||||
end;
|
||||
writeln('TPicture.LoadFromFile E ');
|
||||
FGraphic.Free;
|
||||
writeln('TPicture.LoadFromFile F ');
|
||||
If FGraphic <> nil then
|
||||
FGraphic.Free;
|
||||
FGraphic := NewGraphic;
|
||||
FGraphic.OnChange := @Changed;
|
||||
Changed(Self);
|
||||
writeln('TPicture.LoadFromFile END ');
|
||||
end;
|
||||
|
||||
procedure TPicture.SaveToFile(const Filename: string);
|
||||
|
||||
@ -158,25 +158,25 @@ procedure TRadioButton.SetText(const Value: TCaption);
|
||||
begin
|
||||
Inherited SetText(Value);
|
||||
RecreateWnd;
|
||||
AutoSize := FAutoSize;
|
||||
DoAutoSize;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCheckbox.SetAutoSize
|
||||
Method: TCheckbox.DoAutoSize
|
||||
Params: Value : Boolean
|
||||
Returns: nothing
|
||||
|
||||
Sets AutoSize Flag, and if True, attempts to Size to fit Caption
|
||||
Attempts to Size to fit Caption if AutoSize is True
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TRadioButton.SetAutoSize(Value : Boolean);
|
||||
procedure TRadioButton.DoAutoSize;
|
||||
var
|
||||
R : TRect;
|
||||
DC : hDC;
|
||||
begin
|
||||
FAutoSize := Value;
|
||||
If not AutoSize then
|
||||
If Autosizing or not AutoSize then
|
||||
Exit;
|
||||
if not HandleAllocated then exit;
|
||||
AutoSizing := True;
|
||||
DC := GetDC(Handle);
|
||||
Try
|
||||
R := Rect(0,0, Width, Height);
|
||||
@ -188,6 +188,7 @@ begin
|
||||
Height := R.Bottom + 2;
|
||||
Finally
|
||||
ReleaseDC(Handle, DC);
|
||||
AutoSizing := False;
|
||||
end;
|
||||
end;
|
||||
// included by stdctrls.pp
|
||||
@ -195,6 +196,9 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.7 2002/09/03 08:07:19 lazarus
|
||||
MG: image support, TScrollBox, and many other things from Andrew
|
||||
|
||||
Revision 1.6 2002/08/24 06:51:22 lazarus
|
||||
MG: from Andrew: style list fixes, autosize for radio/checkbtns
|
||||
|
||||
|
||||
@ -176,11 +176,11 @@ begin
|
||||
if FMarked then Result := Result or ButtonStates[tbsMarked];
|
||||
end;
|
||||
|
||||
procedure TToolButton.SetAutoSize(Value: Boolean);
|
||||
procedure TToolButton.SetAutoSize(const Value: Boolean);
|
||||
begin
|
||||
if Value <> AutoSize then
|
||||
begin
|
||||
FAutoSize := Value;
|
||||
Inherited SetAutoSize(Value);
|
||||
UpdateControl;
|
||||
if not (csLoading in ComponentState) and (FToolBar <> nil) and
|
||||
FToolBar.ShowCaptions then
|
||||
@ -454,6 +454,9 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2002/09/03 08:07:20 lazarus
|
||||
MG: image support, TScrollBox, and many other things from Andrew
|
||||
|
||||
Revision 1.2 2002/05/10 06:05:56 lazarus
|
||||
MG: changed license to LGPL
|
||||
|
||||
|
||||
@ -148,6 +148,7 @@ const
|
||||
DT_NOCLIP = $100;
|
||||
DT_CALCRECT = $400;
|
||||
DT_NOPREFIX = $800;
|
||||
DT_INTERNAL = $1000;
|
||||
|
||||
//==============================================
|
||||
// Draw frame constants
|
||||
@ -725,6 +726,22 @@ type
|
||||
end;
|
||||
BITMAP = tagBITMAP;
|
||||
|
||||
PBitmapInfoHeader = ^TagBitmapInfoHeader;
|
||||
tagBITMAPINFOHEADER = packed record
|
||||
biSize : DWORD;
|
||||
biWidth : Longint;
|
||||
biHeight : Longint;
|
||||
biPlanes : WORD;
|
||||
biBitCount : WORD;
|
||||
biCompression : DWORD;
|
||||
biSizeImage : DWORD;
|
||||
biXPelsPerMeter : Longint;
|
||||
biYPelsPerMeter : Longint;
|
||||
biClrUsed : DWORD;
|
||||
biClrImportant : DWORD;
|
||||
end;
|
||||
BITMAPINFOHEADER = tagBITMAPINFOHEADER;
|
||||
|
||||
{ ********************************** }
|
||||
{ B I T M A P S T U F F }
|
||||
|
||||
@ -744,7 +761,7 @@ type
|
||||
|
||||
tagDIBSECTION = packed record
|
||||
dsBm: TagBitmap;
|
||||
dsBmih: pointer;//TBitmapInfoHeader;
|
||||
dsBmih: tagBITMAPINFOHEADER;
|
||||
dsBitfields: array[0..2] of DWORD;
|
||||
dshSection: THandle;
|
||||
dsOffset: DWORD;
|
||||
@ -752,7 +769,6 @@ type
|
||||
TDIBSection = tagDIBSECTION;
|
||||
DIBSECTION = tagDIBSECTION;
|
||||
|
||||
|
||||
const
|
||||
TRUETYPE_FONTTYPE = 4;
|
||||
|
||||
@ -1470,6 +1486,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 2002/09/03 08:07:19 lazarus
|
||||
MG: image support, TScrollBox, and many other things from Andrew
|
||||
|
||||
Revision 1.12 2002/08/27 06:40:50 lazarus
|
||||
MG: ShortCut support for buttons from Andrew
|
||||
|
||||
|
||||
@ -495,15 +495,13 @@ type
|
||||
end;
|
||||
|
||||
TCheckBox = class(TCustomCheckBox)
|
||||
private
|
||||
FAutoSize : Boolean;
|
||||
procedure SetAutoSize(Value : Boolean);
|
||||
protected
|
||||
procedure DoAutoSize; Override;
|
||||
procedure SetText(const Value: TCaption); Override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
published
|
||||
property AutoSize : Boolean read FAutoSize write SetAutoSize;
|
||||
property AutoSize;
|
||||
property AllowGrayed;
|
||||
property Anchors;
|
||||
property Caption;
|
||||
@ -570,11 +568,10 @@ type
|
||||
TRadioButton = class(TCustomCheckBox)
|
||||
private
|
||||
fGroup : THandle; // handle to the previous button in the group this button belongs to
|
||||
FAutoSize : Boolean;
|
||||
procedure SetGroup (Value : THandle);
|
||||
function GetGroup : THandle;
|
||||
procedure SetAutoSize(Value : Boolean);
|
||||
protected
|
||||
procedure DoAutoSize; Override;
|
||||
procedure CreateWnd; override;
|
||||
procedure DestroyWnd; override;
|
||||
procedure SetText(const Value: TCaption); Override;
|
||||
@ -583,7 +580,7 @@ type
|
||||
property group : THandle read GetGroup write SetGroup;
|
||||
published
|
||||
property Anchors;
|
||||
property AutoSize : Boolean read FAutoSize write SetAutoSize;
|
||||
property AutoSize;
|
||||
property AllowGrayed;
|
||||
property Caption;
|
||||
property Checked;
|
||||
@ -714,7 +711,11 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.39 2002/09/03 08:07:19 lazarus
|
||||
MG: image support, TScrollBox, and many other things from Andrew
|
||||
|
||||
Revision 1.38 2002/08/30 06:46:03 lazarus
|
||||
|
||||
Use comboboxes. Use history. Prettify the dialog. Preselect text on show.
|
||||
Make the findreplace a dialog. Thus removing resiying code (handled by Anchors now anyway).
|
||||
Make Anchors work again and publish them for various controls.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user