paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 01:48:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

added fpImage reader/writer hooks to TBitmap

Browse Source 
git-svn-id: trunk@4581 -
This commit is contained in:
mattias 2003-09-08 12:21:48 +00:00
parent 9d8709e7c1
commit bf6c4c8362
7 changed files with 91 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/graphics.pp
View File

@ -886,6 +886,10 @@ type
ReaderClass: TFPCustomImageReaderClass); virtual;
procedure WriteStreamWithFPImage(Stream: TStream; WriteSize: boolean;
WriterClass: TFPCustomImageWriterClass); virtual;
procedure InitFPImageReader(ImgReader: TFPCustomImageReader); virtual;
procedure InitFPImageWriter(ImgWriter: TFPCustomImageWriter); virtual;
procedure FinalizeFPImageReader(ImgReader: TFPCustomImageReader); virtual;
procedure FinalizeFPImageWriter(ImgWriter: TFPCustomImageWriter); virtual;
{$ENDIF}
public
constructor VirtualCreate; override;
@ -1194,6 +1198,9 @@ end.
{ =============================================================================
$Log$
Revision 1.88 2003/09/08 12:21:48 mattias
added fpImage reader/writer hooks to TBitmap
Revision 1.87 2003/09/05 21:27:28 mattias
fixed types

28
lcl/include/bitmap.inc
View File

@ -679,8 +679,10 @@ begin
IntfImg:=TLazIntfImage.Create(0,0);
IntfImg.GetDescriptionFromDevice(0);
ImgReader:=ReaderClass.Create;
InitFPImageReader(ImgReader);
FImage.SaveStream.Position:=0;
IntfImg.LoadFromStream(FImage.SaveStream,ImgReader);
FinalizeFPImageReader(ImgReader);
IntfImg.CreateBitmap(ImgHandle,ImgMaskHandle);
Handle:=ImgHandle;
MaskHandle:=ImgMaskHandle;
@ -724,7 +726,9 @@ begin
IntfImg:=TLazIntfImage.Create(0,0);
IntfImg.LoadFromBitmap(Handle,0);
ImgWriter:=WriterClass.Create;
InitFPImageWriter(ImgWriter);
IntfImg.SaveToStream(MemStream,ImgWriter);
FinalizeFPImageWriter(ImgWriter);
FreeAndNil(ImgWriter);
FreeAndNil(IntfImg);
// save stream, so that further saves will be fast
@ -740,6 +744,27 @@ begin
ImgWriter.Free;
end;
end;
procedure TBitmap.InitFPImageReader(ImgReader: TFPCustomImageReader);
begin
end;
procedure TBitmap.InitFPImageWriter(ImgWriter: TFPCustomImageWriter);
begin
end;
procedure TBitmap.FinalizeFPImageReader(ImgReader: TFPCustomImageReader);
begin
end;
procedure TBitmap.FinalizeFPImageWriter(ImgWriter: TFPCustomImageWriter);
begin
end;
{$ENDIF}
procedure TBitMap.SaveToStream(Stream: TStream);
@ -854,6 +879,9 @@ end;
{ =============================================================================
$Log$
Revision 1.44 2003/09/08 12:21:48 mattias
added fpImage reader/writer hooks to TBitmap
Revision 1.43 2003/09/05 22:13:40 mattias
implemented TBitmap.Assign(TFPCustomImage)

5
lcl/include/filedialog.inc
View File

@ -85,7 +85,7 @@ end;
{------------------------------------------------------------------------------}
procedure TFileDialog.SetFilter(const value : string);
begin
FFilter := value; // make sure this is defined first before the CNSendMessage
FFilter := Value; // make sure this is defined first before the CNSendMessage
end;
{------------------------------------------------------------------------------}
@ -265,6 +265,9 @@ end;
{ =============================================================================
$Log$
Revision 1.12 2003/09/08 12:21:48 mattias
added fpImage reader/writer hooks to TBitmap
Revision 1.11 2003/09/02 21:32:56 mattias
implemented TOpenPictureDialog

47
lcl/interfaces/win32/win32callback.inc
View File

@ -684,27 +684,6 @@ Begin
Assert(False, 'Trace:WindowProc - Exit');
End;
{------------------------------------------------------------------------------
Function: TimerWindowProc
Params: Window - The window that receives a message for the timer window
Msg - The message received
WParam - Word parameter
LParam - Long-integer parameter
Returns: 0 if Msg is handled; non-zero long-integer result otherwise
Handles the messages sent to the timer window by Windows
------------------------------------------------------------------------------}
FUNCTION TimerWindowProc(window_hwnd : hwnd; msg : DWORD; wParam : WPARAM; lParam : LPARAM) : LRESULT; stdcall;
Var
TimerInfo: PWin32TimerInfo;
begin
if (msg = WM_TIMER) and (WParam<>0) then begin
TimerInfo := PWin32TimerInfo(WParam);
TimerInfo^.TimerFunc;
Result := 0;
end else Result := DefWindowProc(window_hwnd, Msg, WParam, LParam);
end;
{------------------------------------------------------------------------------
Function: ToolBtnWindowProc
Params: Window_hwnd - The window that receives a message for the window
@ -720,6 +699,29 @@ begin
Result := DefWindowProc(window_hwnd, Msg, WParam, LParam);
end;
{------------------------------------------------------------------------------
Procedure: TimerCallBackProc
Params: window_hnd - handle of window for timer message, not set in this implementation
msg - WM_TIMER message
idEvent - timer identifier
dwTime - current system time
Calls the timerfunction in the Timer Object in the LCL
------------------------------------------------------------------------------}
Procedure TimerCallBackProc(window_hwnd : hwnd; msg : DWORD; idEvent: UINT; dwTime: DWORD); stdcall;
Var
TimerInfo: PWin32TimerInfo;
n: Integer;
begin
n := FTimerData.Count;
while (n>0) do begin
dec(n);
TimerInfo := FTimerData[n];
if TimerInfo^.TimerID=idEvent
then TimerInfo^.TimerFunc;
end;
end;
{------------------------------------------------------------------------------
Function: BrowseForFolderCallback
Params: Window_hwnd - The window that receives a message for the window
@ -752,6 +754,9 @@ end;
{
$Log$
Revision 1.56 2003/09/08 12:21:48 mattias
added fpImage reader/writer hooks to TBitmap
Revision 1.55 2003/08/25 16:18:15 mattias
fixed background color of TPanel and clicks of TSpeedButton from Micha

7
lcl/interfaces/win32/win32def.pp
View File

@ -116,8 +116,8 @@ type
{ lazarus win32 Interface definition for additional timer data needed to find the callback}
PWin32TimerInfo = ^TWin32Timerinfo;
TWin32TimerInfo = record
TimerHandle: uint; // the windows timer ID for this timer
TimerFunc : TFNTimerProc; // owner function to handle timer
TimerID: UINT; // the windows timer ID for this timer
TimerFunc: TFNTimerProc; // owner function to handle timer
end;
var
@ -131,6 +131,9 @@ End.
{ =============================================================================
$Log$
Revision 1.7 2003/09/08 12:21:48 mattias
added fpImage reader/writer hooks to TBitmap
Revision 1.6 2003/08/17 12:26:00 mattias
fixed parts of the win32 intf size system

7
lcl/interfaces/win32/win32int.pp
View File

@ -59,7 +59,6 @@ Type
FGDIObjects: TDynHashArray;
FMessageQueue: TList;
FToolTipWindow: HWND;
FTimerWindow: HWND;
FAccelGroup: HACCEL;
FControlIndex: Cardinal; // Win32-API control index
FMainForm: TForm;
@ -99,7 +98,6 @@ Type
Procedure AttachMenu(Sender: TObject);
Function WinRegister: Boolean;
Function TimerWinRegister: Boolean;
Function ToolBtnWinRegister: Boolean;
Procedure SetOwner(Window: HWND; Owner: TObject);
Procedure PaintPixmap(Surface: TObject; PixmapData: Pointer);
@ -116,6 +114,7 @@ Type
{ Constructor of the class }
Constructor Create;
class function CreateVirtual: TInterfaceBase; override;
{ Destructor of the class }
Destructor Destroy; Override;
{ Initialize the API }
@ -161,7 +160,6 @@ Type
Const
BOOL_RESULT: Array[Boolean] Of String = ('False', 'True');
ClsName : array[0..20] of char = 'LazarusForm'#0;
TimerClsName : array[0..20] of char = 'LCLTimerWindow'#0;
ToolBtnClsName : array[0..20] of char = 'ToolbarButton'#0;
Var
@ -189,6 +187,9 @@ End.
{ =============================================================================
$Log$
Revision 1.38 2003/09/08 12:21:48 mattias
added fpImage reader/writer hooks to TBitmap
Revision 1.37 2003/08/28 09:10:01 mattias
listbox and comboboxes now set sort and selection at handle creation

71
lcl/interfaces/win32/win32object.inc
View File

@ -37,7 +37,6 @@ Begin
FMessageQueue := TList.Create;
FAccelGroup := 0;
FTimerData := TList.Create;
FTimerWindow := 0;
// Retrieves the height of a win32 menu
With R1 do
begin
@ -73,18 +72,11 @@ Begin
while (n > 0) do
begin
dec(n);
TimerInfo := PWin32Timerinfo (FTimerData.Items[n]);
Dispose (TimerInfo);
TimerInfo := PWin32Timerinfo(FTimerData[n]);
Dispose(TimerInfo);
FTimerData.Delete(n);
end;
end;
Assert(False,'Trace:FTimerWindow: ' + IntToStr(FTimerWindow));
if FTimerWindow<>0 then
begin
DestroyWindow(FTimerWindow);
FTimerWindow := 0;
end;
if FToolTipWindow <> 0 then
begin
@ -112,7 +104,6 @@ Begin
DestroyAcceleratorTable(FAccelGroup);
Windows.UnregisterClass(@ClsName, System.HInstance);
Windows.UnregisterClass(@TimerClsName, System.HInstance);
Windows.UnregisterClass(@ToolBtnClsName, System.HInstance);
Inherited Destroy;
@ -136,11 +127,6 @@ Begin
writeln('Trace:Win32Object.Init - Register Failed');
Exit;
End;
If Not TimerWinRegister then
Begin
Assert(False, 'Trace:Win32Object.Init - LCLTimerWindow Register Failed');
Exit;
End;
If Not ToolBtnWinRegister then
Begin
Assert(False, 'Trace:Win32Object.Init - Toolbar button Register Failed');
@ -150,9 +136,6 @@ Begin
FToolTipWindow := CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, nil, WS_POPUP Or TTS_NOPREFIX Or TTS_ALWAYSTIP, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, FParentWindow, HMENU(nil), HInstance, nil);
Windows.SendMessage(FParentWindow, TTM_ACTIVATE, WPARAM(True), 0);
FTimerWindow :=CreateWindowEx(0, @TimerClsName, nil, WS_POPUPWINDOW, 0, 0, 640, 480, 0, 0, System.HInstance, nil);
Assert(False,'Trace:FTimerWindow: ' + IntToStr(FTimerWindow));
//Init stock objects;
LogBrush.lbStyle := BS_NULL;
FStockNullBrush := CreateBrushIndirect(LogBrush);
@ -1167,9 +1150,8 @@ End;
TimerFunc: Callback
Returns: a Timer id (use this ID to destroy timer)
Design: A timer which sends a wm_timr is created,
the wm_timer is received by a hidden window,
which calls the TimerFunc in its window proc.
Design: A timer which calls TimerCallBackProc, is created.
The TimerCallBackProc calls the TimerFunc.
------------------------------------------------------------------------------}
function TWin32Object.CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : integer;
var
@ -1177,16 +1159,15 @@ var
begin
Assert(False,'Trace:Create Timer: ' + IntToStr(Interval));
Result := 0;
if (FTimerWindow<>0) and (Interval >= 1) and (TimerFunc <> nil)
then begin
if (Interval > 0) and (TimerFunc <> nil) then begin
New(TimerInfo);
TimerInfo^.TimerFunc := TimerFunc;
Result:= Windows.SetTimer(FTimerWindow,integer(TimerInfo),Interval,nil);
if Result = 0 then
Dispose(TimerInfo)
TimerInfo^.TimerID := Windows.SetTimer(0, 0, Interval, @TimerCallBackProc);
if TimerInfo^.TimerID=0 then
dispose(TimerInfo)
else begin
TimerInfo^.TimerHandle:= Result;
FTimerData.Add(TimerInfo);
Result := TimerInfo^.TimerID;
end;
end;
Assert(False,'Trace:Result: ' + IntToStr(result));
@ -1205,12 +1186,12 @@ begin
Result:= false;
Assert(False,'Trace:removing timer: '+ IntToStr(TimerHandle));
n := FTimerData.Count;
while (n > 0) do begin
dec (n);
TimerInfo := PWin32Timerinfo(FTimerData.Items[n]);
if (TimerInfo^.TimerHandle=TimerHandle) then
while (n>0) do begin
dec(n);
TimerInfo := FTimerData[n];
if (TimerInfo^.TimerID=TimerHandle) then
begin
result := Windows.KillTimer(FTimerWindow, integer(TimerInfo));
Result := Windows.KillTimer(0, TimerHandle);
FTimerData.Delete(n);
Dispose(TimerInfo);
end;
@ -1249,27 +1230,6 @@ Begin
Assert(False, 'Trace:WinRegister - Exit');
End;
Function TWin32Object.TimerWinRegister: boolean;
var
WinClass: WndClassEx;
begin
with WinClass do begin
cbSize := Sizeof(WndClassEx);
Style := 0{CS_HRedraw or CS_VRedraw};
lpfnWndProc := @TimerWindowProc;
cbClsExtra := 0;
cbWndExtra := 0;
hInstance := System.HInstance;
_hIcon := LoadIcon(0, IDI_Application);
hCursor := LoadCursor(0, IDC_Arrow);
hbrBackground := GetStockObject(LTGRAY_BRUSH);
lpszMenuName := nil;
lpszClassName := @TimerClsName;
hIconSm := LoadIcon(0, IDI_APPLICATION);
end;
result := RegisterClassEx(@WinClass) <> 0;
end;
Function TWin32Object.ToolBtnWinRegister: boolean;
var WinClass: WndClass;
begin
@ -2793,6 +2753,9 @@ End;
{
$Log$
Revision 1.106 2003/09/08 12:21:48 mattias
added fpImage reader/writer hooks to TBitmap
Revision 1.105 2003/09/06 18:37:18 mattias
fixed checkbox state and typecast bugs